DataMuseum.dk

top - metrics - download

    Length: 8448 (0x2100)
    Types: TextFileVerbose
    Names: »xxeditpass4«

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

TextFileVerbose

; editpass4
;(edit pass4text
;finis)

; page 1

l./versionpass4 = /,   d1,   i/

versionpass4 = 400;  (* 4.00   date : 81.05.22  *)
versionpass3 = 2;    (* pass 3 version must be 2.xx *)
/,  
p-1







; page 9


l./context_kind = /,
l./var_param,/,   r/value_param,/value_param,    return_param,/,


; page 11

l./array_types, index_types,/,
r/a/direct_return, a/,

l./: boolean/,  r/ :/, param_list : /,


l./undef_nix,/, 
i/
niltype_nix,
/,




; page 20

l./procedure initialize;/,


; page 21

l./export:=false;/,   l1,  i/
param_list:=true;
/,


; page 22

l./array_types:=/,    i/
direct_return:=[int_type, char_type, bool_type, scalar_type, 
dyn_subrange, pointer_type];/,


; page 30
l./procedure std_name/,
l./xniltype:/, 
l./size:=0/, r/0/2/,
i/
niltype_nix := nix;
/,






; page 32

l./procedure sub_def;/,


; page 33

l./size:=var_size(min,max);/,   i/
dynamic:=false;
/,
l./begin (*dynamic*)/,
l./offset:=alloc_var(/,  i/
word_allign;
/,

l./error(not_implemented)/,  l1,  i/
min:=0;  max:=1;
/,


; page 35

l./procedure array_def(pack/,

; page 36

l./offset:=alloc_var(array_template_size);/,
i/
word_allign;
/,


l./procedure pool_def/,
l./data_size:=size/, i/
if stack[t] = niltype_nix then
data_size := 0  else
/,



; page 44

l./procedure formal_param(c:/,
i/

function alloc_process_param : integer;  (* return = param length *)
var type_nix, no, param_size, byte_displ, parameter_length : integer;
begin
for no:=param_number - 1 downto 0 do
with nametable[ stack[t-no] ] do begin
type_nix:=comp_type;
if context = value_param then
param_size:=nametable[type_nix].size
else
param_size:=pointer_length;
if nametable[type_nix].dynamic then begin
error(error_dyn);
param_size:=0;
end;
byte_displ:=0;
if (* **z80** *) versionz80 then begin
if param_size = byte_length then param_size:=word_length;
end
else
begin (* **lambda** *)
if nametable[type_nix].context in index_types then
if param_size = byte_length then byte_displ:=1;
if odd(param_size) then param_size:=param_size+1;
end;
niv:=current_niv;
offset:=alloc_var(param_size);
offset:=offset+byte_displ;
end; (* for .. with .. *)
if (* **z80** *) versionz80 then
parameter_length:=-current_offset
else
(* **lambda** *)
parameter_length:=current_offset + 1;
display[this_level].parameter_length:=parameter_length;
alloc_process_param:=parameter_length;
end;  (* alloc process param *)

function alloc_routine_param : integer;  (* return = param length *)
var q, no, parameter_offset, return_size, param_size,
parameter_length, byte_displ : integer;

function alloc_param(size : integer) : integer;
begin
if (* **z80** *) versionz80 then begin
(* parameter_offset >= 0 *)
alloc_param:=parameter_offset;
if top_address - parameter_offset >= size then
parameter_offset:=parameter_offset + size
else
error(address_overflow);
end
else
begin
(* **lambda** *)
(* parameter_offset <= 0 *)
if top_address + parameter_offset >= size then
parameter_offset:=parameter_offset - size
else
error(address_overflow);
alloc_param:=parameter_offset;
end;
end; (* alloc_param *)

begin (* alloc routine param *)
return_size:=0;
q:=param_number - 1;
if mode = func_mode then
with nametable[ stack[t-q] ] do begin
if nametable[comp_type].context in direct_return then begin
context:=return_param;
return_size:=nametable[comp_type].size;
if return_size=byte_length then return_size:=word_length;
end;
if nametable[comp_type].dynamic then error(error_dyn);
end;
if (* **z80** *) versionz80 then
parameter_offset:=0
else
(* **lambda** *)
parameter_offset:=-1;
parameter_length:=0;
for no:=0 to q do
with nametable[ stack[t-no] ] do begin
if context = var_param then
param_size:=pointer_length
else
(* value param and return param *)
with nametable[ comp_type] do begin
param_size:=size;
if dynamic then begin
error(error_dyn);
param_size:=0;
end;
end;
byte_displ:=0;
if (* **z80** *) versionz80 then begin
if param_size = byte_length then param_size:=word_length;
end
else
begin (* **lambda** *)
if nametable[comp_type].context in index_types then
if param_size = byte_length then byte_displ:=1;
if odd(param_size) then param_size:=param_size + 1;
end;
parameter_length:=parameter_length + param_size;
niv:=current_niv;
offset:=alloc_param(param_size);
offset:=offset + byte_displ;
end; (* for ... with .. *)
parameter_length:=parameter_length - return_size;
alloc_routine_param:=parameter_length;
end; (* alloc routine param *)
/,



l./procedure formal_param(c:/,
l./if c=value_param/,
d./if odd(parm_size) then/,  d,
l./niv:=current_niv;/,  d2,



; page 43

l./procedure new_block;/,
l./if (* **z80**/, 
d./display[this_level]./,
l./proc_mode, func_mode:/,   l2,  i/
if param_list then
parameter_length:=alloc_routine_param
else
parameter_length:=size;   (* routine previous defined *)
param_list:=true;
/,
l./size:=parameter/,  d,  i/
display[this_level].parameter_length:=parameter_length;
size:=parameter_length;
/,
l./put_arg1(/,  d,
l./process_mode:/,   l1,  i/
parameter_length:=alloc_process_param;
/,

l./procedure external_;/,
l./if (* **z80/,  d4,  i/
size:=alloc_routine_param;
/,

l./procedure forward_;/,
l./size:=/,  r/current_offset/alloc_routine_param/,
l./current_offset:=nametable/,   d,  i/
param_list:=false;
/,







; page 45

l./procedure end_block;/,
l./if (* **z80/,   d6,   i/
if (* **lambda** *) not versionz80 then
var_length:=var_length+1;
if mode = process_mode then
var_length:=var_length - display[this_level].parameter_length
else
var_length:=var_length - activation_record_length;
/,



l./put1(zlength/,  r/)/, display[this_level].parameter_length)/,
r/1/2/,



; page 55

l./procedure equality(op:/,


; page 56
l./int_type,char_type,bool_type,scalar_type:/,
r/:/,dyn_subrange:/,




; page 57
l./procedure inclusion;/,
l./load_expr;pop;/, i/
get_pushed_consts;
/,










; page 58

l./procedure func_call;/,
l1,  r/;/;   via_stack : boolean;/,
l./put1(zextfunccall/,   r/1/2/,   r/)/, size)/,
l./else put2(zfunccall/,   r/)/, size)/,
r/2/3/,
l./result_size:=size;/,  l1,  i/
via_stack:=context in direct_return;
/,
l./context:=func_result;/,   l1,   i/
if not via_stack then begin
/,
l./offset:=q;/,  l1,  i/
end (* not via stack *)
else
alloc_size:=0;
/,
l./with ops/,   i/
via_stack:=via_stack or (std>0);
/,
l./func_value:=std=0/,  r/std=0/via_stack/,


l./procedure end_func_call;/,
l./if ops/,  r/if/if not/,
l./put0(zendfunccall/,   r/)/,ops[ot].size)/,
r/0/1/,


l./procedure proc_call;/,
l./put1(zextproccall/,   r/1/2/,   r/)/, size)/,
l./put2(zproccall/,  r/2/3/,  r/)/,size)/,



; page 60

l./procedure actual;/,
l1,  i/
var s : integer;
/,
l./ops[ot].size:=/,   l1,   i/
s:=ops[ot].size;
if s < word_length then s := word_length;
/,
l./otherwise put_arg2(addr_typ/,  l2,  i/
return_param:  put1(zreturnparam, s);
/,



l./procedure end_actual;/,
l./var_param:/,   l1,  i/
return_param:  ;  (* no action *)
/,


; page 69
l./procedure var_;/,
l./with ops[ot]do/, i/
ops[ot].func_value := false;
/,


; page 70
l./procedure arrow;/,
l./if waiting/, i/
if ops[ot].func_value then begin
type_ref;
with ops[ot] do begin
state := addr;
context := expr;
func_value := false;
end; (* with *)
end
else begin
/,

l./end;/, i/
end;
/,


; page 76
l./procedure end_struc;/,
l./dynamic:=false;if/, i/
func_value := false;
/,




f
«eof»