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

⟦9d49fe8b6⟧ TextFile

    Length: 6912 (0x1b00)
    Types: TextFile
    Names: »xepass5«

Derivation

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

TextFile

(
rename npass5pasc.nnpass5pasc
npass5pasc =,
  edit nnpass5pasc
if ok.no
finis)

; edit commands to pass5 for the new routine call instructions


l./default_lambda_versio/, r/3/5/,
p,
l./versionpass4=/, d1, i/
versionpass4 = 400;
versionpass5 = 422;  (* 81.06.19 *)
/,
p-2,


l./const_size_nn/, d,
i/

size_of_return_point = 16 ; (* 4 addresses for return, static and dynamic link 
and line table start *)
/,


; page 3
l./id_rlinetab/, d,


; page 30
l./procedure ext_scan;/,
l./while not eof(ext_pass5/, r/)/) and (ext_pass5^ <> -1)/,




; page 36
l./procedure code_call_proc(use:usemodes/,
l./out_opcode(op_pcals)/, r/ -const_size_nn//,
l./out_p_int(const_size_nn-2+paramlength/, d,




; page 39
l./procedure code_allocpool/,
l./(*init. the semaphore of the pool to nil:/,
l./op_renhb,const_size_nn/, d,


; page 40
l./procedure code_exit;/,
l./const_size_nn);/, d,


; page 43
l./procedure code_exception/,
l./const_size_nn/, d,




; page 50
l./procedure find_call;/, r/;/( var size_of_function_result : integer );/,

l./procedure find_arglist;/,
r/;/( closed_routine : boolean; var size_of_function_result : integer );/,

l./procedure find_processparam/, 
r/;/( var size_of_function_result : integer );/,




; page 68
l./find_func_call( var v : varvalue_descr);begin/,
i/

var
size_of_function_result,  (* used by find process param *)
value_size : integer; (* size of result if not yoyo *)
/,


l./if token=xprocess/, i/
size_of_function_result := 0;
(* used by find process param, changed by find_arglist *)

/,
l./find_processparam/, r/param/param( size_of_function_result )/,
l./find_call/, r/call/call( size_of_function_result )/,


; page 69



l./find_varvalue(v);/, r/;//, l1, i/

else
if size_of_function_result <> 0 then
with v do
begin
kind := 1;  (* on stack top *)
size := size_of_function_result;
end; (* with v *)

value_size := in_integer;

get_token;

/,

l./skip_token(xendfunccall)/, d,


l./procedure find_proc_call/, r/call/call( var size_of_function_result : integer )/,

l./find_processparam/, r/param/param( size_of_function_result )/,
l./find_call/, r/call/call( size_of_function_result )/,




l./procedure find_call/,
r/call/call( var size_of_function_result : integer )/,

l./,stack_size/, r/,stack_size//,

; page 70
l./if callkind<>open_callthen/, d./end;stack_size:=/, i/

paramlength := in_integer;
/,
l./find_arglist;/, r/;/( callkind <> open_call , size_of_function_result );/,
l./paramlength:=c.stack_size-stack_size/, d,




; page 72
l./procedure dyn_type_declaration/,


; page 76
l./xrecordtemplate:begin/,
l./out_op_int(op_rechw,size);/ , i/
if size <> 0 then
/,
l./out_opcode(op_uadd/, i/
if size <> 0 then
/,



; page 78
l./--->expr--->expr--->/,
l./out_op_int(op_stvlw,dope_start+4/, d, 
l./dope_start+2/, r/stvlw/stvld/, 


; page 84-85
l./procedurefind_block(outer/,
l./procedure skip_around(jump/,
l./elseout_op_id(op_stvld,id_rline/, d, i/
context_eval( -4 (* the line information is part of the activation record *) );
/,




; page 86
l./begin(*body of find block *)/,
l./param_length:=in_integer/, d,


; page 94
l./(*find the appetite of the block:*)/,
l./(*generate the epilog of the block,depending on process/, i/

param_length := in_integer;

/,

l./out_opcode(op_pexit/, r/code/_int/, r/)/, param_length + 2 )/,



; page 95
l./param_length:=0;(*don't/, d, i/
param_length := size_of_return_point; (* include room for display in the appetite *)
/,




; page 98
l./procedure find_std_call/, 
l./(* read the arglist by hand/, d,
l./token<>xvarparam/, r/var/return/,
i/
(* prameter list must start with ' returnparam , size  ' *)
/,
l./get_token;/, d./until token=xvalueparam/,

l./get_token;/, r/;/; i := in_integer; (* skip 'valueparam(2)' *)/,
l1, i/
skip_token( xvalueparam );
/,


; page 99
l./procedure find_arglist/,
r/;/( closed_routine : boolean; var size_of_function_result : integer );/,

; page 101
l./xvarparam:begin/, 
l./end;end/, i/

xreturnparam: (* reserve stack space for function result *)
begin
size_l := in_integer;
size_of_function_result := size_l; (* remember size in case of process params *)
if closed_routine then
begin
if size_l = 2 then
begin
out_op_int( op_rechw, 0 ); (* assure left byte = 0 in case of byte result !! *)
size_l := 0; (* context eval ( 2 ) has been done *)
end
else
out_op_int( op_renhb, size_l );
out_comment( ' room for function result ' );
end; (* if closed routine *)
context_eval( size_l );
get_token;
end;

/,





; page 115
l./procedure find_statement/,
l./oldwork/, r/o/size_of_function_result, o/,
l./xprocessparam:/, r/:/: begin
size_of_function_result := 0;
(* used by find process param, changed by find arglist *)
/,
l./find_proc_call/, r/;/(size_of_function_result);
end;/,




; page 118
l./procedure find_varaddr(var/,
l./end_addr:boolean/, r/end/get_next_token, end/,
l./case token of/, i/

get_next_token := true;

/,

l./otherwiseerror(pass4code/, d, i/
otherwise
begin
get_next_token := false; (* after fcall *)
(* initialize v as address on stack *)
with v do
begin
kind := stack_addr; offset := 0; access := s_frame;
size := 0;
end; (* with *)
end;
/,

l./get_token/, i/
if get_next_token then
/, l./get_token/, r/;/
else
get_next_token := true;
/,




; page 125
l./procedure find_processparam;/,
r/;/( var size_of_function_result : integer );/,
l./find_arglist;/, r/;/( true (* closed object *), size_of_function_result );/,





; page 126
l./find_proc_call;/, r/;/( size_of_function_result );/,
l./find_call/, r/call/call( size_of_function_result )/,
l./find_processparam/, r/;/( size_of_function_result );/,

l./op_stnhb/, i/

if size_of_function_result <> 0 then (* must be 2 or 4 *)
out_op_int( op_store Æ size_of_function_result, l_frame Å, offset_3 );

/,
l./skip_token(xendprocessparam/, i/

if size_of_function_result <> 0 then
(* load the function result again *)
out_op_int( op_load Æ size_of_function_result, l_frame Å , offset_3 );

/,


; page 127
l./(* body of the program:*)/, 
l./lambda_version<3/, r/<3/<5/,
l1, r/v2/v3/,




f
▶EOF◀