DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦8c25e9990⟧ TextFile

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »emainpass3«

Derivation

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »emainpass3« 

TextFile

(nmainpass3 = edit mainpass3
if ok.no
  finis)


; side 103
l./(*start of main program *)/,

; side 104
; 81 04 01
l./cbeginlevel:begin/,
l./newnamelevel;/, i/
cur_dyn_var_level := namelevel;
/,

l./cendlevel:/, l./endnamelevel;end;/, i/
cur_dyn_var_level := namelevel;
/,


; side 107
l./cexternal,cforward:/,
l./if cur_blockno <> process_block/, d./else/,



; side 110
l./cendconstantdecl:/,
l./with opands Æ stacktop Å/,
l./begin/, d,
l./op_packflag:=true;/, d1,
l./emit_and_release/, i/

const_decl := true;/,
l./emitid(/, i/
const_decl := false;
/,



; side 112-113
l./cenddeclarations:begin/,
l./curname:=nextname;end;end;/, i/

cur_dyn_var_level := maxint; (* all varianble levels are legal *)
/,


; side 114
l./cendcode,cendblock:/,
l./releasenames(namestack/, i/
(* release local declared variables, nb ! only precent if "endblock" *)
if rectype = cendblock then
/,


; side 115
l./ctypeid:/,
l./contents := types Æ names/, i/
index    := types Æ names Æ element Å . typ Å . index;
/,




; side 118
l./creal,cniltype:/,
l./if(rectype=cscalar)or/, d, 
l./(rectype=crecord)then/, r/(/if /, r/)//,
l./pushlist/, i/
begin
/, l./pushlist;/, r/;/;
newnamelevel;
end;/,
l./if rectype=cscalarthen/, l./with/, i/
begin
pushlist;
/,
l./endnamelevel;/, r/;/;
end;/,


l./cendscalar:/,
l./contents := Æ t_simple Å;/, r/con/(* con/, r/;/;  *)/,



; side 119
l./cendsubrange:/,
l./contents:= Æ t_simple Å;/, r/con/(* con/, r/;/;  *)/,



; side 121
l./cendrecord:begin/,
l./(*transfer/, i/

endnamelevel;
/,

l./cendset:/,
l./contents:= Æ t_simple Å;/, r/con/(* con/, r/;/;  *)/,



; side 123
l./cendreadonly,cendpointer:/,
l./contents := Æ t_pointer Å/,
l./begin/, d./(* whereas t_froz_ptr is safe/,
r/.contents;/. contents + Æ t_readonly Å;/,
l1, d1,



; side 129
l./cwithvar:begin/,
l./newnamelevel;/, l1, i/

cur_dyn_var_level := namelevel;
/,

; side 130
l./cnolocaldecl:;(*blind*)/, r/;(*blind*)/
cur_dyn_var_level := maxint;/,

l./cendlocaldeclare:/,
;side 131
l./emit(xlock);poptype;end;/, i/

cur_dyn_var_level := maxint;
/,


; side 133
l./cendassign:/,
l./test_value_compatible(assign_incompatible/,
l./with opandsÆnexttop/, i/
if opands Æ nexttop Å . op_typename <> opands Æ stacktop Å . op_typename then
/,


; side 135
l./cid:begincurname:=usename/,
l./end;(*beforeassign/,
l./if namekind=crecfield/, i/
begin
if retrieved_level >= cur_dyn_var_level then
begin
if (namekind <> cconstant) and (namekind <> cscalarelem) 
and (namekind <> ctype) then
error( illegal_scope_of_type_component );
end
else
/,
l./end(*if recfield/,
r/end/end;/, l./else/, r/else/if namekind <> crecfield then/,

l./newopand(cid,typename/, r/;/;

end; (* with namesÆ curname Å *)/,




; side 137
l./cfield:/,
l./newspix:= passin;/, l1, i/

(* if the previous 'variable' is parameterless functioncall, then... *)
with opands Æ stacktop Å do
if opcode = cid then
with names Æ op_name Å do  (* namenode of (possible) function name *)
if namekind = cfunction then
begin
pushcall;
prepare_call (stacktop);
terminate_call (stacktop);
end;
/,


; side 138   81.03.24
l./cplus,/, r/c/cand,
cor,
cxor,
c/,

; side 139
l./cdiv,/, 
l./cand,/, d./end;/,

; side 140
l./cnot:/, 
l./boolean type/, r/type/or integer type/,
l./assure(stacktop,bool/, d1, i/
resolvetype (stacktop, exprtypename, exprelement, exprbasekind);

if not lambda_version and (exprtypename <> boolean_typename) then
error( monadic_error );

if (exprtypename = integer_typename) or ( exprtypename = boolean_typename ) then
oper( unary, rectype, exprtypename )
else
suppress_error( exprbasekind, monadic_error);
/,


f
▶EOF◀