DataMuseum.dk

top - metrics - download

    Length: 13824 (0x3600)
    Types: TextFile
    Names: »headpass3«

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

TextFile

program platonpass3 (
input,  (* used when reading pass3errors *)
output, (* used for testoutput *)
pass1file = 'pass1code', (* contains pass1-output *)
pass1labels = 'pass1labels' , (* contains labeldefs from pass1 *)
pass3file = 'pass3code' (* contains output from pass3 *)
);

label 999; (* exit from pass3 main program *)

const

version = '80.10.21';
own_passno = 3;
(*$T+*)
æ
nilname = 0; max_names = 600;
niltype = 601; max_types = 800;
nillabel = 950; max_labels = 999;
nilopand = 1000; max_opands = 1500;
nilstring = 2000; max_strings = 2010;
max_levels = 20;
å

nilname = 0;           (* dummy index in 'names' *)
niltype = 0;           (* dummy index in 'types' *)
nillabel = 0;          (* dummy index in 'labels' *)
nilopand = 0;          (* dummy index in 'opands' *)
nilstring = 0;         (* dummy index in 'strings' *)

max_names = 2000;      (* max index in 'names' *)
max_types = 300;       (* max index in 'types' *)
max_labels = 20;       (* max index in 'labels' *)
max_opands = 1500;     (* max index in 'opands' *)
max_levels = 20;       (* max index in 'namestack' *)
max_strings = 1000;     (* max index in 'strings' *)
max_pushnames = 100;   (* max index in 'pushnamestack' *)
max_nested_calls = 20; (* max index in 'calls' *)

lines_pr_page = 45;    (* used for nice testoutput *)

max_spix = 4095;       (* max value of 'spix' *)
max_labelscopenumber = 100000; (* max value of 'labelscope' *)

lowestlevel = 1;       (* first used namelevel *)
process_block = 0;     (* blocknumber for process variables *)
maxstring = 12;        (* number of chars per string portion *)

compilertest = true;   (* determines amount of 'superflous' testing *)

type

nameptr = nilname .. max_names;
typeptr = niltype .. max_types;
labelptr = nillabel .. max_labels;
opandptr = nilopand .. max_opands;
stringptr = nilstring .. max_strings;
str_index = 1 .. maxstring;

spixrange = 0 .. max_spix;
labelrange = 0 .. max_labelscopenumber;
levelrange = 0 .. max_levels;
pushrange = 0 .. max_pushnames;
callrange = 0 .. max_nested_calls;

(* define codes in pass1file/pass1labels *)
codes =
(cnames);

(* end pass 1 codes *)


stdname_range = canonymous .. cord;

(* define codes in pass3file *)
pass3codes =
(pnames);
(* end pass 3 codes *)

(* include pass3errors from stdfile *)
pass3errors =
(noerror);

(* define parameters to procedure 'stop' *)
stopcodes = (
too_many_names,
too_many_types,
too_many_strings,
too_many_labels,
too_many_opands,
too_many_levels,
too_many_pushnames,
too_many_nested_calls);

levelkinds = (
processlevel,
firstwith, nextwith,
firstlock, nextlock,
irrell_level);

(* define pass3 programming error-codes *)
comp_errorcodes =
(unknown_namekind,
unknown_argkind,
unknown_opcode,
unknown_paramkind,
unknown_routinekind,
unknown_spix,
unknown_stdtype_name,
unknown_typekind,
unknown_rectype,
inconsist_alloc,
unstack_nontype);


(* operator modes *)
opmodes = (unary, binary);

(* components of a type *)
components = (t_simple, t_semaphore, t_pool, t_reference, t_shadow,
t_pointer, t_readonly);

content_set = set of components;

label_states = (outside_scope, inside_scope, hidden_by_lock_or_channel);

(*QQQ*)

namenode = packed record
nextname: nameptr      ; (* used to chain names of same level *)
spix    : spixrange    ; (* spelling index of identifier *)
namekind: codes        ; (* kind of identifier: var, const, function etc *)
typename: nameptr      ; (* points to the namenode of the type (unless namekind = 'ctype' *)
typ     : typeptr      ; (* only relevant if namekind = 'ctype' *)
params  : nameptr      ; (* routine etc: first formal parameter name *)
forward_decl: boolean  ; (* true, when after 'forward' *)
external_decl: boolean ; (* true, when after 'external' *)
func_assigned: boolean; (* true, when funcval is used *)
usedlevel: levelrange  ; (* nillevel, if never used, otherwise some namelevel *)
end;



typenode = packed record
typekind: codes        ; (* kind of type: subrange, array etc *)
emitted:  boolean      ; (* true, when type has been emitted *)
contents: content_set  ; (* describes the components of the type *)
packflag: boolean      ; (* true, if type is packed *)
element: nameptr       ; (* depends on 'typekind':
                         -    scalar: first scalarname
                         -    record: first field name
                         -    array : typename of elements
                         -    set   : typename of elements
                         -    pool  : typename of elements
                         -    pointer: typename of element
                         -    readonly: typename of element
                         -    alias : typename of alias type
                         *)
index:    nameptr      ; (* depends on 'typekind':
                         -    subrange: typename of limits
                         -    array   : typename of index
                         *)
subexpr:  opandptr     ; (* depends on 'typekind':
                         -    subrange: pointer to 'both' expressions
                         -    pool:     pointer to cardinality-expr
                         *)
end;

(*QQQ*)

labelnode = packed record
prevlabel : labelptr   ; (* used to chain to other label def's *)
labelspix : spixrange  ; (* spelling index of label *)
labelname : nameptr    ; (* points to the label-declaration namenode *)
labelscope: labelrange ; (* scope number of label *)
hiddenscope: labelrange; (* scopenumber of lock-or-channel which hides this label *)
labelstate: label_states; (* used to determine 'visability' *)
multflag  : boolean    ; (* true, if multiple defined *)
used_from_inner_routines: boolean; (* true, if used from inner routines *)
end;



opandnode = packed record
opcode     : codes     ; (* kind of operand/operator *)
op_lineno  : integer   ; (* line number *)
left       : opandptr  ; (* left subtree *)
rigth      : opandptr  ; (* rigth subtree *)
next       : opandptr  ; (* opand to the left of reduced tree *)
op_name    : nameptr   ; (* name of operand, if 'id' *)
op_value   : stringptr ; (* relevant, if 'literal' *)
op_typename: nameptr   ; (* typename of reduced tree *)
op_packflag: boolean   ; (* true, if the opand is packed *)
end;



namestacknode = packed record
firstname : nameptr    ; (* points to first name of a level *)
lastname  : nameptr    ; (* points to last  name of a level *)
namelistkind: levelkinds; (* defines kind of list *)
withname  : nameptr    ; (* holds the name of the pseudo var *)
end;



stringnode = packed record
nextstr  : stringptr   ; (* pointer to next string portion *)
stringlgt: integer     ; (* length of remaining part *)
str: packed array Æ str_index Å of char; (* contains the portion *)
end;



callnode = packed record
(* the record holds stacked values of global variables *)
callkind      : codes;      (* holds: 'actkind' *)
callformal    : nameptr;    (* holds: 'curformal' *)
callowner     : nameptr;    (* holds: 'arglist_owner' *)
call_afterfunc: boolean;    (* holds: 'after_funccall' *)
call_functemp : nameptr;     (* holds: 'functempvar' *)
call_countprocess: integer;  (* holds: 'count_processparam' *)
end;

var
cur_lineno: integer;   (* current line number from pass1file *)
lineno    : integer;   (* last read lineno from pass1 *)
cur_opandno: integer;  (* number of operands on current line *)
emit_lineno:integer;   (* current emitted lineno in pass3file *)
curname:    nameptr;   (* current name node *)
cur_routine:nameptr;   (* current routine *)
cur_typename: nameptr; (* namenode of current type *)
cur_typenode: typeptr; (* corresponding typenode *)
cur_blockno: integer;  (* lexicographical level *)
cur_labelscope: labelrange; (* updated by: begin/end label scope *)
cur_namekind: codes;   (* updated by 'declaration' (and 'newtype') *)
rectype: codes;        (* record type of current input-record *)
namelevel: levelrange; (* current name level *)
levelkind: levelkinds; (* kind of (future) namelevel *)
lastgloballevel: levelrange; (* identifies last environment level *)
processparamlevel: levelrange; (* used when searching identifiers *)
pushnameindex: pushrange; (* index in pushnamestack *)
callindex    : callrange; (* index in calls *)

(* the following variables are results from 'searchspix' etc *)
retrieved_level: levelrange; (* undef, if name was'nt found *)
retrieved_name : nameptr;    (* nilname, if name was'nt found *)

(* variables used when processing actual parameter lists *)
curformal     : nameptr; (* points into formal parameter list *)
argkind       : codes;   (* separates into: argument, index, struc etc *)
arglist_owner: nameptr; (* points to the routinename or arraytypename or typename *)
functempvar   : nameptr; (* points to temporary namenode *)
count_processparam: integer;  (* number of process-'calls' in arglist *)

testinput: boolean;    (* determines printing of input-records *)
testoutput: boolean;   (* determines printing of output-records *)
testing:   boolean;    (* = (testinput or testoutput) *)
testlinecnt: integer;  (* used for changing page during testprinting *)

freenames: nameptr;    (* list of free name node *)
freetypename: nameptr; (* list of free type nodes, linked via namenodes *)
freestrings: stringptr; (* list of free string nodes *)
freelabels: labelptr;  (* list of free label nodes *)
freeopands: opandptr;  (* list of free opand nodes *)

listfirst: nameptr;    (* first name in current declaration list *)
listlast:  nameptr;    (* last  name in current declaration list *)
listtop:   nameptr;    (* used when scanning the current decl list *)
lastlabel: labelptr;   (* last name in list of defined labels *)

endpass1:  boolean;    (* false, until 'eom'-record has been read *)
call_pass4: boolean;    (* true, until first error in pass3 *)
lambda_version: boolean; (* true, unless z80-version *)
after_funccall: boolean;  (* flag to determine 'endfunccall' *)
insert_in_front: boolean; (* true: names are inserted in front else in rear *)
before_assign: boolean; (* true: identifier cannot be function or process *)
afterdecl: boolean;    (* flag to determine <end-decl> in a routine *)
expecting_block: boolean; (* flag to determine <first decl> in a routine *)
var_initialization: boolean;  (* true, if initialization in var-decl *)
expr_release: boolean; (* true, if expression must be released after emit *)
retain_top: boolean;   (* true, if stacktop must be reused *)
start_of_protected: boolean;  (* true when starting channel or lock statements *)
expr_level: integer;   (* controls beginning of whole expression *)

dummy_typenode: typeptr; (* std type entry *)
error_typename: nameptr; (* std name entry *)
error_typenode: typeptr; (* std type entry *)

envir_spix: spixrange; (* working location ? *)
newspix    : spixrange; (* holds spix of fieldname *)

maxstdspix: integer;   (* holds max spix with special interrest *)
anonymous_spix: spixrange; (* initialized during startup *)
exception_spix: spixrange; (* initialized durring startup *)

boolean_typename: nameptr;
integer_typename: nameptr;
char_typename   : nameptr;
shadow_typename   : nameptr;
reference_typename: nameptr;
text_typename     : nameptr; (* internally used for text-literals *)
processrec_typename: nameptr;
son_typename    : nameptr;
nil_typename    : nameptr;

exception_procname: nameptr;
abs_procname    : nameptr;
succ_procname   : nameptr;
pred_procname   : nameptr;
ord_procname    : nameptr;

for_typename: nameptr;  (* holds typename of current for-variable *)
for_basetypename: nameptr; (* holds simplified typename of for-variable *)
case_typename: nameptr; (* holds typename of current case-expression *)
with_typename: nameptr; (* work-location: holds typename of with-variable *)

indexname: nameptr;     (* working location *)
elemname:  nameptr;     (* working location *)

paramkind: codes;       (* used when checking formal parameters *)
not_allowed: content_set; (* holds the illegal parameter contents *)

opand_procname: opandptr; (* holds 'literal'-operand, with routine name *)

for_expr: opandptr;     (* holds the end-value expression of a for-statement *)

stacktop: opandptr;     (* points to current top of opands *)
nexttop:  opandptr;     (* points to 'next' of current top-opand *)

(* the following variables are used when resolving opand-types *)
lefttypename:  nameptr;
leftbasekind:  codes;
leftelement:   nameptr;
rigthtypename: nameptr;
rigthbasekind: codes;
rigthelement:  nameptr;
exprtypename:  nameptr;
exprbasekind:  codes;
exprelement:   nameptr;

errorcode: pass3errors; (* working location *)

no_of_errors: integer;

cur_date: alfa;  (* string holding current date *)
cur_time: alfa;  (* string holding current time *)

names:   array Æ nameptr Å of namenode;
types:   array Æ typeptr Å of typenode;
labels:  array Æ labelptr Å of labelnode;
opands:  array Æ opandptr Å of opandnode;
namestack: array Æ levelrange Å of namestacknode;
strings: array Æ stringptr Å of stringnode;
pushnamestack: array Æ pushrange Å of nameptr;
calls: array Æ callrange Å of callnode;

convtable: array Æ codeindex Å of codes;

stdspix_table: array Æ stdname_range Å of integer;

error_bitmap: packed array Æ noerror .. lastpass3error Å of boolean;

pass1file: file of integer;
pass1labels: file of integer;
pass3file: file of integer;
▶EOF◀