|
|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8820 (0x2274)
Types: TextFile
Names: »RTP86P3.PAS«
└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
└─⟦this⟧ »RTP\RTP86P3.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTP86P3.PAS«
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\RTP86P3.PAS«
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
└─⟦this⟧ »RTP86P3.PAS«
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
└─⟦this⟧ »RTP\RTP86P3.PAS«
{$O+,F+}\r
unit rtp86p3;\r
interface\r
\r
procedure rtp86pass3;\r
implementation\r
uses pscplm,sthunit,sthcom,sthp34,mpaunit,rtp86mpa,files,p3cmmn,\r
p3rw,p3addr,rule004,\r
rule005,rule015,rule016,rule037,rule078;\r
PROCEDURE rtp86pass3;\r
\r
(* ------------------------------------------------------------------------\r
Pass2Code: 01\r
compilation unit ::= <context list><body>\r
\r
Pass3Code: 01\r
compilation unit ::= <context list><body>\r
Symbol Table:\r
-.\r
\r
===========================================================================\r
\r
Error Messages and Warnings:\r
e_token\r
-.\r
External Dependencies:\r
std_routine_list (defined in PASS3CMMN.INC)\r
std_routine (defined in PASS3CMMN.INC)\r
plm_string (defined in PASS3CMMN.INC)\r
protected_types (defined in PASS3CMMN.INC)\r
linenumber (defined in RTP86MPA.EXT)\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
External Effects:\r
pass3_line (defined in PASS3CMMN.INC)\r
create_size (defined in PASS3CMMN.INC)\r
std_routine_list (defined in PASS3CMMN.INC)\r
std_routine (defined in PASS3CMMN.INC)\r
plm_string (defined in PASS3CMMN.INC)\r
stmnt_stck_top (defined in PASS3CMMN.INC)\r
protected_types (defined in PASS3CMMN.INC)\r
fam_type_declaration (defined in PASS3CMMN.INC)\r
access_check (defined in PASS3CMMN.INC)\r
range_check (defined in PASS3CMMN.INC)\r
index_check (defined in PASS3CMMN.INC)\r
overflow_check (defined in PASS3CMMN.INC)\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
Stack Appetite:\r
-.\r
Comments:\r
-.\r
Outstanding:\r
Is it relevant to check the list of predefined routines for\r
completeness?\r
-.\r
------------------------------------------------------------------------ *)\r
\r
CONST\r
(*#BEGINTEST\r
rule_version = 005;\r
this_rule = 001;\r
(*ENDTEST#*)\r
\r
outermost_level = TRUE;\r
\r
VAR\r
\r
step: integer;\r
\r
current_offset ,\r
evaluation_appetite ,\r
default_create_size : WORD;\r
\r
default_compute : BOOLEAN;\r
\r
i_code : codes;\r
addr: st_address;\r
\r
(*#BEGINTEST\r
rule_test : BOOLEAN;\r
(*ENDTEST#*)\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
rule_test_set:= [];\r
IF testpass3 <> - 1 THEN\r
pass3_option(WORD(test_), testpass3);\r
\r
rule_test:= ccontext 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
(* $SUBTITLE('------------ Context List')*)\r
\r
(* --------------------------------------------------------------------\r
Pass2Code: 02\r
context list ::= <context declaration>ENDINCLUDE\r
context declaration ::= !context declaration\r
!constant declaration\r
!type declaration\r
!external routine declaration\r
\r
Pass3Code: 02\r
context list ::= <context declaration>\r
context declaration ::= !context declaration\r
!type declaration\r
!external routine declaration\r
-------------------------------------------------------------------- *)\r
CASE Computer of\r
RC5000 :\r
BEGIN\r
dope_size_subrange := 8;\r
dope_size_array := 16;\r
dope_size_set := 12;\r
static_link_size := 4;\r
\r
local_return_appetite := 4;\r
global_return_appetite := 4;\r
Semaphore_Size := 12;\r
gf_shared_param_size := 12; (* = shared size *)\r
shared_var_size := 24; (* = semaphore_size + shared size *)\r
program_descr_size := 44;\r
\r
END\r
ELSE\r
IF Computer = RC3502 THEN\r
BEGIN\r
dope_size_subrange := 4;\r
dope_size_array := 8;\r
dope_size_set := 6;\r
static_link_size := 2;\r
program_descr_size := 25;\r
\r
\r
local_return_appetite := 4;\r
global_return_appetite := 4;\r
Semaphore_Size := 8;\r
gf_shared_param_size := 10; (* = shared size *)\r
shared_var_size := 18; (* = semaphore_size + shared size *)\r
END\r
ELSE\r
BEGIN\r
dope_size_subrange := 4;\r
dope_size_array := 8;\r
dope_size_set := 6;\r
static_link_size := 2;\r
program_descr_size := 34;\r
\r
\r
local_return_appetite := 2;\r
global_return_appetite := 4;\r
Semaphore_Size := 8;\r
gf_shared_param_size := 10; (* = shared size *)\r
shared_var_size := 18; (* = semaphore_size + shared size *)\r
END\r
\r
\r
END;\r
\r
new(e_stck(** TURBO, 0 *) ); (* max sized expression stack *)\r
e_stck^.stack_size:= 1024;\r
\r
NEW( std_routine_list );\r
\r
\r
std_routine:= SUCC( std_routine_begin );\r
\r
REPEAT\r
\r
CASE std_routine OF\r
\r
std_ord:\r
BEGIN\r
plm_string := 'ORD';\r
END;\r
\r
std_chr:\r
BEGIN\r
plm_string := 'CHR';\r
END;\r
\r
std_int:\r
BEGIN\r
plm_string := 'INT';\r
END;\r
\r
std_wrd:\r
BEGIN\r
plm_string := 'WRD';\r
END;\r
\r
std_byt:\r
BEGIN\r
plm_string := 'BYT';\r
END;\r
\r
std_abs:\r
BEGIN\r
plm_string := 'ABS';\r
END;\r
\r
std_succ:\r
BEGIN\r
plm_string := 'SUCC';\r
END;\r
\r
std_pred:\r
BEGIN\r
plm_string := 'PRED';\r
END;\r
\r
std_inc:\r
BEGIN\r
plm_string := 'INC';\r
END;\r
\r
std_dec:\r
BEGIN\r
plm_string := 'DEC';\r
END;\r
\r
std_link:\r
BEGIN\r
plm_string := 'LINK';\r
END;\r
\r
std_unlink:\r
BEGIN\r
plm_string := 'UNLINK';\r
END;\r
\r
std_create:\r
BEGIN\r
plm_string := 'CREATE';\r
END;\r
\r
std_new:\r
begin\r
plm_string := 'NEW';\r
end;\r
{$IFNDEF RTP86}\r
std_GetBuf : plm_String := 'GETBUF';\r
std_GetBufDelay : plm_String := 'GETBUFDELAY';\r
std_ChainDeQueue : plm_String := 'CHAINDEQUEUE';\r
std_ChainEnQueue : plm_String := 'CHAINENQUEUE';\r
std_pop : plm_String := 'POP';\r
std_push : plm_String := 'PUSH';\r
std_signal : plm_String := 'SIGNAL';\r
std_wait : plm_String := 'WAIT';\r
std_waitdelay : plm_String := 'WAITDELAY';\r
{$ENDIF}\r
\r
(* OTHERWISE *) ELSE\r
END;\r
\r
std_routine_list^[ std_routine ]:= st_spixofname( plm_string );\r
\r
std_routine:= SUCC( std_routine )\r
\r
UNTIL ( std_routine = std_routine_end );\r
\r
\r
pass3_line:= 0;\r
create_size:= 0;\r
\r
default_compute:= false;\r
\r
fam_type_declaration:= false;\r
\r
access_check:= false;\r
range_check:= true;\r
index_check:= true;\r
overflow_check:= true;\r
\r
protected_types:= [ pooltype, chaintype, processtype, mailboxtype, mailboxpointer,\r
porttype, referencetype, pointertype, programtype ];\r
\r
current_offset:= 0;\r
\r
sca_chainhead:= st_stopaddr;\r
sca_end_chain:= st_stopaddr;\r
\r
stmnt_stck_top:= 1;\r
\r
load_code( i_code ); (* - read ahead - *)\r
\r
WHILE i_code<>cendinclude DO\r
\r
BEGIN\r
\r
evaluation_appetite:= 0;\r
\r
CASE i_code OF\r
cconstdecl:\r
rule_constant_declaration(i_code, program_level, current_offset);\r
\r
ctypedecl:\r
rule_type_declaration\r
( i_code,\r
program_level, current_offset,\r
address_gf,\r
evaluation_appetite\r
);\r
\r
cprocdecl,\r
cfuncdecl:\r
rule_routine_declaration\r
(i_code, routine_level - 1, current_offset,\r
default_create_size, default_compute,\r
outermost_level);\r
\r
cendfuncdecl,\r
cendtypedecl,\r
cendprocdecl:;\r
\r
ceos: (* shift from load source *)\r
shift_source;\r
\r
\r
(*OTHERWISE*) ELSE\r
fatal_error( this_pass, e_token_002 )\r
\r
END (* - CASE i_code OF ... - *);\r
\r
load_code( i_code ) (* - read ahead -. *)\r
\r
END (* - WHILE ... context list - *);\r
\r
store_code(cendinclude);\r
\r
files_set_mark; (* set file mark after common context(s) *)\r
\r
sca_end_cntxt:= sca_end_chain;\r
current_comp_unit_number:= 0;\r
\r
load_code( i_code ); (* - 'i_code' is 'cendinclude' - read ahead - *)\r
\r
(* $SUBTITLE('------------ Body')*)\r
(* --------------------------------------------------------------------\r
Pass2Code: 01.2\r
body ::= <body declaration>EOM\r
body declaration ::= body declaration\r
!program declaration\r
!routine declaration\r
Pass3Code: 01.2\r
body ::= <body declaration>EOM\r
body declaration ::= body declaration\r
!program declaration\r
!routine declaration\r
-------------------------------------------------------------------- *)\r
\r
REPEAT (* - UNTIL 'i_code' is 'ceom' - *)\r
current_comp_unit_number:= current_comp_unit_number+1;\r
IF (Computer <> RC5000) OR (current_Comp_Unit_Number = 1) THEN\r
BEGIN\r
first_external:= st_nilladdr; (* start with empty list of called externals *)\r
last_external:= st_nilladdr;\r
END;\r
CASE i_code OF\r
\r
cprocdecl,\r
cfuncdecl:\r
begin\r
rule_routine_declaration\r
(i_code, routine_level - 1, current_offset,\r
default_create_size, default_compute,\r
outermost_level);\r
end;\r
\r
cvardecl:\r
begin\r
load_symbol(addr);\r
load_code(i_code);\r
if i_code<>cprogdecl then\r
fatal_error( this_pass, e_token_001 );\r
rule_program_declaration\r
(i_code, program_level, current_offset,\r
default_create_size, outermost_level);\r
load_code(i_code);\r
if i_code<>cendvar then\r
fatal_error( this_pass, e_token_001 );\r
end;\r
\r
cendvar:\r
load_code(i_code);\r
\r
cprogdecl:\r
begin\r
rule_program_declaration\r
(i_code, program_level, current_offset,\r
default_create_size, outermost_level);\r
end;\r
\r
\r
(* OTHERWISE*) ELSE\r
fatal_error( this_pass, e_token_001 )\r
\r
END;\r
\r
load_code( i_code ) (* - read ahead - *)\r
\r
UNTIL ( i_code = ceom ) (* - end of body - *);\r
\r
(* $SUBTITLE('------------ PROCEDURE rtp86pass3')*)\r
\r
IF (Computer = RC5000) THEN store_const_area(true);\r
\r
store_code( i_code );\r
\r
dispose( std_routine_list );\r
\r
dispose(e_stck(* TURBO ,0 *));\r
\r
(*#BEGINTEST\r
IF rule_test THEN\r
BEGIN\r
WRITELN( testoutput, ' - End Rule ', this_rule:3 );\r
END;\r
(*ENDTEST#*)\r
\r
END; (* procedure rule_compilation_unit *)\r
END.\r
«eof»