DataMuseum.dk

top - download

    Length: 6952 (0x1b28)
    Types: TextFile
    Names: »RULE004.PAS«

└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
    └─⟦this⟧ »RTP\RULE004.PAS« 
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
    └─⟦this⟧ »RTP\RULE004.PAS« 
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\RULE004.PAS« 
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
    └─⟦this⟧ »RULE004.PAS« 
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
    └─⟦this⟧ »RTP\RULE004.PAS« 

TextFile

{$O+,F+}\r
unit rule004;\r
interface\r
uses pscplm,sthunit,sthcom,sthp34,mpaunit,p3cmmn,p3rw,p3math,p3addr;\r
\r
PROCEDURE rule_program_declaration\r
(\r
VAR i_code  : codes;\r
current_level : WORD;\r
var surrounding_offset: word;\r
prog_descr_offset : WORD;\r
outermost_level : BOOLEAN);\r
Implementation\r
\r
uses  rule008,rule010,rule078;\r
\r
\r
(* $SUBTITLE('------------ PROCEDURE rule_program_declaration')*)\r
PROCEDURE rule_program_declaration\r
(\r
VAR i_code: codes; (* cprogdecl *)\r
current_level: WORD;\r
var surrounding_offset: word;\r
prog_descr_offset: WORD; \r
outermost_level : BOOLEAN);\r
\r
(* ------------------------------------------------------------------------\r
Pass2Code: 04\r
program declaration::= PROGDECL(SYMBOL)<formal parameters>\r
ENDPROGDECL<block>\r
\r
Pass3Code: 04\r
program declaration::= PROGDECL(SYMBOL)<formal parameters><block>\r
\r
Symbol Table:\r
- .\r
\r
===========================================================================\r
\r
Error Messages and Warnings:\r
e_create_size\r
-.\r
External Dependencies:\r
create_size (defined in PASS3CMMN.INC)\r
plm_string_ptr (defined in PASS3CMMN.INC)\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
External Effects:\r
plm_string_ptr (defined in PASS3CMMN.INC)\r
-.\r
Stack Appetite:\r
-.\r
Comments:\r
The ST address of the label node of internal programs is stored\r
in the ST field 'typeref'.\r
'create_size' updated through the option is valid for only one\r
(the next) program declaration excluded EXTERNAL declaration.\r
-.\r
Outstanding:\r
Sketch layout of global frame.\r
-.\r
------------------------------------------------------------------------ *)\r
\r
CONST\r
(*#BEGINTEST\r
rule_version = 005;\r
this_rule = 004;\r
(*ENDTEST#*)\r
used = true;\r
\r
VAR\r
st_label_addr ,\r
st_prog_addr,\r
st_prog_type_addr: st_address;\r
\r
st_ptr: st_elemptr;\r
\r
current_offset ,\r
no_of_parameters ,\r
default_create_size ,\r
evaluation_appetite: WORD;\r
\r
is_extern_type,\r
emit_code,\r
default_size_ovflw ,\r
default_compute: BOOLEAN;\r
\r
plm_string_ix: plm_string_range;\r
Help,parsize : integer;\r
HelpSymbol : St_Address;\r
\r
(*#BEGINTEST\r
rule_test: BOOLEAN;\r
(*ENDTEST#*)\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
rule_test:= i_code IN rule_test_set;\r
\r
IF rule_test THEN\r
WRITELN\r
(\r
testoutput, ' Begin Rule ', this_rule:3,\r
' V', (pass3_version + rule_version):3\r
);\r
(*ENDTEST#*)\r
\r
elementnumber:= elementnumber + 1;\r
\r
evaluation_appetite:= 0;\r
current_offset:= process_descr_size;\r
\r
default_compute:= (create_size = 0);\r
\r
store_code(i_code); (* - i_code is 'cprogdecl'. *)\r
load_symbol(st_prog_type_addr);\r
\r
st_retrieve(st_prog_type_addr,st_ptr);\r
if st_ptr^.st_kind=ctype then st_prog_addr:=st_ptr^.typeref\r
else st_prog_addr:=st_prog_type_addr;\r
store_symbol(st_prog_addr);\r
\r
st_retrieve(st_prog_addr, st_ptr);\r
is_extern_type:= st_ptr^.st_specs = st_extern;\r
\r
emit_code:= (st_ptr^.st_specs <> st_extern) and (not is_extern_type);\r
rule_formal_parameters\r
(\r
i_code, emit_code, current_level, current_offset, surrounding_offset,\r
address_gf, st_ptr^.listref,\r
evaluation_appetite, no_of_parameters\r
);\r
(* - i_code is 'cendformal'. *)\r
\r
st_get(st_prog_addr, st_ptr);\r
\r
st_ptr^.st_paramsize:= current_offset - process_descr_size;\r
st_ptr^.prog_descr_offset:= prog_descr_offset; (* not used for outermost level programs *)\r
\r
IF (st_ptr^.st_specs <> st_extern) and (not is_extern_type) THEN\r
BEGIN\r
\r
IF outermost_level THEN\r
st_ptr^.st_specs:= st_global\r
ELSE\r
BEGIN (* - internal programn declaration - *)\r
\r
st_nameofspix(st_ptr^.st_spix, plm_string_ptr);\r
(*  TURBO\r
WITH plm_string_ptr^ DO\r
BEGIN\r
push_struc_value(length + 1, st_label_addr, st_nilladdr, used);\r
\r
sca_fill(1, length);\r
sca_fill(length, name);\r
END;\r
*)\r
IF (Computer <> RC5000) AND (Computer <> RC3502) THEN\r
BEGIN\r
push_struc_value(length(plm_string_ptr^) + 1, st_label_addr, st_nilladdr, used);\r
\r
sca_fill(1, ptr_sca_max_string(plm_string_ptr));\r
sca_fill(length(plm_string_ptr^),ptr_sca_max_string(@plm_string_ptr^[1]));\r
END;\r
\r
\r
st_get(st_prog_addr, st_ptr);\r
st_ptr^.st_family_ref:= sca_end_chain; (* special use of family_ref !! *)\r
\r
END (* - internal program declaration - *);\r
\r
st_ptr^.typeref:= st_label_addr;\r
st_ptr^.st_level:= current_level;\r
\r
default_create_size:= 0;\r
default_size_ovflw:= default_compute;\r
\r
rule_block\r
(i_code, current_level, current_offset,\r
evaluation_appetite,\r
address_gf,\r
default_create_size, default_size_ovflw, false);\r
(* - 'i_code' is 'cendblock'. 'current_offset' include\r
worst case simultaneous temporary variable offset. *)\r
\r
st_get(st_prog_addr, st_ptr);\r
\r
st_ptr^.st_varsize:= current_offset - st_ptr^.st_paramsize;\r
\r
st_ptr^.max_offset:= current_offset;\r
\r
address_gf\r
(st_ptr^.max_offset, current_offset, evaluation_appetite);\r
\r
IF default_compute THEN\r
BEGIN\r
\r
default_size_ovflw:= NOT default_size_ovflw;\r
\r
IF wadd_ovflw(default_create_size, st_ptr^.max_offset) THEN\r
default_size_ovflw:= true\r
ELSE\r
IF Computer = RC5000 THEN\r
IF wadd_ovflw( default_create_size, 20 ) THEN\r
default_size_ovflw:= true;\r
\r
IF (Computer <> RC5000) AND (Computer <> RC3502) THEN\r
BEGIN\r
IF (default_create_size < (process_descr_size + pi3_appetite)) THEN\r
default_create_size:= process_descr_size + pi3_appetite;\r
END;\r
IF default_size_ovflw THEN\r
BEGIN\r
\r
warning(this_pass, e_create_size);\r
default_create_size:= max_word\r
\r
END;\r
\r
st_ptr^.prog_createsize:= default_create_size\r
\r
END\r
ELSE\r
\r
st_ptr^.prog_createsize:= create_size;\r
\r
store_code(cendcompound);\r
store_symbol(st_prog_addr);\r
\r
IF outermost_level  THEN\r
begin\r
st_ptr^.st_external_list:= first_external;\r
IF  (Computer <> RC5000) THEN store_const_area(true);\r
end;\r
\r
create_size:= 0;\r
\r
st_get(st_prog_type_addr, st_ptr);\r
st_ptr^.st_size:= program_descr_size;\r
\r
store_code(i_code)\r
\r
END\r
ELSE\r
IF Computer = RC3502 THEN\r
  BEGIN  (* Dump The parameter *)\r
\r
    push_struc_value(wordsize+(No_Of_Parameters * 4),helpSymbol,st_NillAddr,true);\r
    No_Of_Parameters := swap(No_Of_Parameters);\r
    sca_fill(wordsize, ptr_sca_max_string(@No_Of_Parameters));\r
    St_Get(St_Prog_Addr,St_Ptr);\r
    St_Ptr^.St_Label := HelpSymbol;\r
    HelpSymbol := St_Ptr^.ListRef;\r
    WHILE Not Equal_Addr(HelpSymbol,St_StopAddr) DO\r
     BEGIN\r
       st_Retrieve(HelpSymbol,St_ptr);\r
       HelpSymbol := St_Ptr^.ListRef;\r
       extParamKind(St_Ptr^.St_Kind,St_Ptr^.TypeRef,help,parsize);\r
       help := swap(help);\r
       parsize := swap(parsize);\r
       sca_fill(wordsize, ptr_sca_max_string(@help));\r
       sca_fill(wordsize, ptr_sca_max_string(@parsize));\r
     END;\r
  END;\r
\r
\r
(* - 'i_code' is 'cendprogdecl' or 'ceom'. *)\r
\r
(*#BEGINTEST\r
IF rule_test THEN\r
WRITELN\r
(\r
testoutput, ' - End Rule ', this_rule:3,\r
' V', (pass3_version + rule_version):3,\r
'/ ', WORD(i_code):3,\r
' C.Lvl.', current_level:6,\r
' P.Dscr.Offs.', prog_descr_offset:6,\r
' C.Offs.', current_offset:6,\r
' #Params', no_of_parameters:6,\r
' Def.C.Size', default_create_size:6,\r
' EA', evaluation_appetite:6\r
);\r
(*ENDTEST#*)\r
\r
END (* procedure rule_program_declaration *);\r
END.\r
«eof»