DataMuseum.dk

top - download

    Length: 4131 (0x1023)
    Types: TextFile
    Names: »RULE016.PAS«

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

TextFile

{$O+,F+}\r
unit rule016;\r
interface\r
uses pscplm,sthunit,sthcom,sthp34,mpaunit,files,p3cmmn;\r
PROCEDURE rule_type_declaration\r
	(\r
	VAR\r
		i_code				:	codes;\r
		current_level		:	WORD;\r
	VAR\r
		current_offset		:	WORD;\r
		address : addressprocedure;\r
	VAR\r
		evaluation_appetite	:	WORD\r
	)\r
;\r
\r
\r
implementation\r
uses p3rw,p3math,p3addr,rule008,rule018;\r
\r
PROCEDURE rule_type_declaration\r
((* Call Return *)\r
VAR\r
i_code : codes; (* *)\r
current_level : WORD; (* *)\r
VAR\r
current_offset : WORD; (* *)\r
address : addressprocedure;\r
VAR\r
evaluation_appetite : WORD (* *)\r
);\r
\r
(* ------------------------------------------------------------------------\r
Pass2Code: 16\r
type declaration ::= TYPEDECL(SYMBOL)<formal parameters>\r
<defining type>ENDTYPEDECL\r
\r
Pass3Code: 16\r
-.\r
Symbol Table:\r
-.\r
\r
===========================================================================\r
\r
Error Messages and Warnings:\r
-.\r
External Dependencies:\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
External Effects:\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
Stack Appetite:\r
-.\r
Comments:\r
-.\r
Outstanding:\r
-.\r
------------------------------------------------------------------------ *)\r
\r
CONST\r
rule_version = 005;\r
(*#BEGINTEST\r
this_rule = 016;\r
(*ENDTEST#*)\r
code = true;\r
\r
VAR\r
(*#BEGINTEST\r
rule_test : BOOLEAN;\r
(*ENDTEST#*)\r
saved_eval_app,\r
saved_cur_offset,\r
no_of_params,\r
type_size : WORD;\r
type_dynamic : boolean;\r
st_symbol : st_address;\r
st_ptr : st_elemptr;\r
(* tog *) return_appetite: word;\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
rule_test := i_code IN rule_test_set;\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
load_symbol(st_symbol);\r
\r
st_retrieve(st_symbol, st_ptr);\r
(* tog *)return_appetite:=local_return_appetite;\r
dope_addr_offset:= 4;\r
\r
if next_code<>cendformal then\r
begin (* family type definition *)\r
(* tog *)if not st_ptr^.st_t_local_near then\r
begin\r
(* tog *)return_appetite:=global_return_appetite;\r
dope_addr_offset:= 6;\r
end;\r
if winc_ovflw(current_level) then\r
errormsg(this_pass, e_routine_nesting);\r
saved_cur_offset:= current_offset;\r
saved_eval_app:= evaluation_appetite;\r
evaluation_appetite:= 0;\r
current_offset:= static_link_size+(*local_ TOG *)return_appetite+address_size;\r
(*             static link     return address     actual dope address *)\r
end;\r
\r
rule_formal_parameters\r
(\r
i_code, code, current_level, current_offset, saved_cur_offset, address_lf,\r
st_ptr^.listref, evaluation_appetite, no_of_params\r
);\r
\r
if no_of_params>0 then\r
begin\r
st_get(st_symbol, st_ptr);\r
(* insert size of parameter list, each parameter occupy one word *)\r
st_ptr^.type_paramsize:=\r
current_offset-(static_link_size+(*local_ TOG *)return_appetite+address_size);\r
IF Computer = RC3502 THEN St_Ptr^.Type_Address.Level := Current_Level;\r
IF Computer = RC5000 then\r
   Dope_Addr_Offset := St_Ptr^.Type_Paramsize + 8;\r
current_offset:= st_ptr^.type_paramsize;\r
fam_type_declaration:= true;\r
store_code_symbol(cthunkdecl, st_symbol);\r
end;\r
\r
rule_defining_type\r
(\r
i_code, code, st_symbol,\r
current_level, current_offset, address,\r
type_size, evaluation_appetite,\r
type_dynamic\r
);\r
if type_dynamic then\r
begin\r
st_get(st_symbol, st_ptr);\r
st_ptr^.spec_struct:= st_ptr^.spec_struct + [dynamictype];\r
end;\r
\r
if no_of_params>0 then\r
begin\r
store_code_symbol(cendthunk, st_symbol);\r
if not type_dynamic then st_get(st_symbol, st_ptr);\r
\r
(* current_offset is size of type descriptor *)\r
(* !!!!!!! TOG !!!!!!!   dette er noget griseri ???????? *)\r
(* derfor maa jeg finde stoerreslsen i typeref           *)\r
type_size:= current_offset;\r
st_ptr^.st_size:= type_size;\r
st_ptr^.st_file_mark:=files_pos;\r
st_ptr^.st_type_maxoffset:= evaluation_appetite;\r
fam_type_declaration:= false;\r
current_offset:= saved_cur_offset;\r
evaluation_appetite:= saved_eval_app;\r
end;\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, type_size:6\r
);\r
(*ENDTEST#*)\r
\r
END (* procedure rule_type_declaration *);\r
END.\r
«eof»