DataMuseum.dk

Presents historical artifacts from the history of:

DANOSI

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DANOSI

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦7583e2fdc⟧ TextFile

    Length: 10700 (0x29cc)
    Types: TextFile
    Names: »P3RW.PAS«

Derivation

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

TextFile

{$O+,F+}\r
unit p3rw;   (* and rule000 *)\r
interface\r
uses pscplm,sthunit,sthcom,sthp34,mpaunit,files,p3cmmn;\r
\r
\r
PROCEDURE pass3_error\r
	(\r
		error_number	,\r
		error_indicator	:	WORD\r
	)\r
;\r
\r
PROCEDURE load_code\r
	(\r
	VAR\r
		code			:	codes\r
	)\r
;\r
\r
function next_code: codes;\r
\r
PROCEDURE load_arg_1\r
	(\r
	VAR\r
		arg1			: WORD\r
	)\r
;\r
\r
PROCEDURE load_arg_2\r
	(\r
	VAR\r
		arg1			,\r
		arg2			:	WORD\r
	)\r
;\r
\r
PROCEDURE load_arg_3\r
	(\r
	VAR\r
		arg1			,\r
		arg2			,\r
		arg3			:	WORD\r
	)\r
;\r
\r
\r
PROCEDURE store_newline;\r
\r
PROCEDURE store_code\r
	(\r
		code			:	codes\r
	)\r
;\r
\r
PROCEDURE store_code_1\r
	(\r
		code			:	codes;\r
		arg1			:	WORD\r
	)\r
;\r
\r
PROCEDURE store_code_2\r
	(\r
		code			:	codes;\r
		arg1			,\r
		arg2			:	WORD\r
	)\r
;\r
\r
PROCEDURE store_code_3\r
	(\r
		code			:	codes;\r
		arg1			,\r
		arg2			,\r
		arg3			:	WORD\r
	)\r
;\r
\r
\r
PROCEDURE store_code_symbol\r
	(\r
		code			:	codes;\r
		st_addr			:	st_address\r
	)\r
;\r
\r
PROCEDURE store_arg_1\r
	(\r
		arg1			:	WORD\r
	)\r
;\r
\r
\r
PROCEDURE store_load_code\r
	(\r
	VAR\r
		i_code			:	codes\r
	)\r
;\r
\r
\r
PROCEDURE copy_1;\r
\r
PROCEDURE skip\r
	(\r
		count			:	WORD\r
	)\r
;\r
\r
\r
PROCEDURE load_symbol\r
	(\r
	VAR\r
		st_addr			:	st_address\r
	)\r
;\r
\r
\r
PROCEDURE store_symbol\r
	(\r
		st_addr			:	st_address\r
	)\r
;\r
\r
\r
PROCEDURE load_store_symbol\r
	(\r
	VAR\r
		st_addr			:	st_address\r
	)\r
;\r
\r
\r
PROCEDURE copy_symbol;\r
\r
PROCEDURE skip_symbol;\r
\r
\r
  (* RULE000 *)\r
\r
PROCEDURE load_newline(VAR line_number: WORD);\r
\r
PROCEDURE copy_newline;\r
\r
PROCEDURE pass3_option(option, value : WORD);\r
PROCEDURE copy_option;\r
\r
implementation\r
(* ------------------------------------------------------------------------\r
Error Messages and Warnings:\r
-.\r
External Dependencies:\r
pass3_line  (defined in PASS3CMMN.INC)\r
linenumber  (defined in RTP86MPA.EXT)\r
-.\r
External Effects:\r
pass3_line  (defined in PASS3CMMN.INC)\r
elementnumber (defined in RTP86MPA.EXT)\r
-.\r
Comments:\r
-.\r
Outstanding:\r
-.\r
------------------------------------------------------------------------ *)\r
\r
PROCEDURE pass3_error(error_number, error_indicator: WORD);\r
\r
BEGIN\r
elementnumber:= error_indicator;\r
errormsg(this_pass, error_number);\r
fatal_error(this_pass, error_number)\r
END;\r
\r
PROCEDURE load_code(VAR code : codes);\r
label 0;\r
var\r
line: word;\r
\r
BEGIN\r
0: code:= codes(get_byte);\r
if code=cnewline then\r
begin\r
load_newline(line);\r
goto 0;\r
end\r
else\r
if code=coption then\r
begin\r
copy_option;\r
goto 0;\r
end;\r
END (* procedure load_code *);\r
\r
\r
function next_code: codes; (* look ahead on next code *)\r
label 0;\r
var cod: codes;\r
line: word;\r
begin\r
0: cod:= codes(next_byte);\r
if cod=cnewline then\r
begin\r
cod:= codes(get_byte);\r
load_newline(line);\r
goto 0;\r
end\r
else\r
if cod=coption then\r
begin\r
cod:= codes(get_byte);\r
copy_option;\r
goto 0;\r
end;\r
next_code:= cod;\r
end;\r
\r
\r
PROCEDURE load_arg_1(VAR arg1 : WORD);\r
\r
BEGIN\r
arg1:= get_2_byte;\r
END (* procedure load_arg_1 *);\r
\r
PROCEDURE load_arg_2(VAR arg1, arg2: WORD);\r
\r
BEGIN\r
arg1:= get_2_byte;\r
arg2:= get_2_byte;\r
END (* procedure load_arg_2 *);\r
\r
PROCEDURE load_arg_3(VAR arg1, arg2, arg3: WORD);\r
\r
BEGIN\r
arg1:= get_2_byte;\r
arg2:= get_2_byte;\r
arg3:= get_2_byte;\r
END (* procedure load_arg_3 *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_newline ') *)\r
PROCEDURE store_newline;\r
\r
BEGIN\r
IF (pass3_line <> linenumber) THEN\r
BEGIN\r
put_byte(word(cnewline));\r
pass3_line:= linenumber;\r
put_2_byte(pass3_line);\r
END\r
END (* procedure store_newline *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_code') *)\r
PROCEDURE store_code(code: codes);\r
\r
BEGIN\r
store_newline;\r
put_byte(word(code));\r
END (* procedure store_code *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_code_1') *)\r
PROCEDURE store_code_1(code: codes; arg1: WORD);\r
\r
BEGIN\r
store_newline;\r
put_byte(WORD(code));\r
put_2_byte(arg1);\r
END (* procedure store_code_1 *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_code_2') *)\r
PROCEDURE store_code_2(code: codes; arg1, arg2: WORD);\r
\r
BEGIN\r
store_newline;\r
put_byte(WORD(code));\r
put_2_byte(arg1);\r
put_2_byte(arg2);\r
END (* procedure store_code_2 *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_code_3') *)\r
PROCEDURE store_code_3(code: codes; arg1, arg2, arg3: WORD);\r
\r
BEGIN\r
store_newline;\r
put_byte(WORD(code));\r
put_2_byte(arg1);\r
put_2_byte(arg2);\r
put_2_byte(arg3);\r
END (* procedure store_code_3 *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_code_symbol') *)\r
PROCEDURE store_code_symbol(code: codes; st_addr: st_address);\r
\r
BEGIN\r
store_newline;\r
put_byte(WORD(code));\r
put_2_byte(st_addr.va_low);\r
put_2_byte(st_addr.va_high);\r
END (* procedure store_code_symbol *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_arg_1') *)\r
PROCEDURE store_arg_1(arg1: WORD);\r
\r
BEGIN\r
store_newline;\r
put_2_byte(arg1);\r
END (* procedure store_arg_1 *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_load_code') *)\r
PROCEDURE store_load_code(VAR i_code: codes);\r
\r
BEGIN\r
store_newline;\r
put_byte(WORD(i_code));\r
i_code:= codes(get_byte);\r
END (* procedure store_load_code *);\r
\r
(* $SUBTITLE('------------ PROCEDURE copy_1') *)\r
PROCEDURE copy_1;\r
\r
BEGIN\r
put_2_byte(get_2_byte);\r
END (* procedure copy_1 *);\r
\r
(* $SUBTITLE('------------ PROCEDURE skip') *)\r
PROCEDURE skip(count: WORD);\r
VAR dummy: WORD;\r
\r
BEGIN\r
WHILE count <> 0 DO\r
BEGIN\r
dummy:= get_2_byte;\r
count:= count - 1\r
END\r
END (* procedure skip *);\r
\r
(* $SUBTITLE('------------ PROCEDURE load_symbol') *)\r
PROCEDURE load_symbol(VAR st_addr: st_address);\r
\r
BEGIN\r
st_addr.va_low:= get_2_byte;\r
st_addr.va_high:= get_2_byte;\r
END (* procedure load_symbol *);\r
\r
(* $SUBTITLE('------------ PROCEDURE store_symbol') *)\r
PROCEDURE store_symbol(st_addr: st_address);\r
\r
BEGIN\r
put_2_byte(st_addr.va_low);\r
put_2_byte(st_addr.va_high);\r
END (* procedure store_symbol *);\r
\r
(* $SUBTITLE('------------ PROCEDURE load_store_symbol') *)\r
PROCEDURE load_store_symbol(VAR st_addr: st_address);\r
VAR help: WORD;\r
\r
BEGIN\r
help:= get_2_byte;\r
put_2_byte(help);\r
st_addr.va_low:= help;\r
help:= get_2_byte;\r
put_2_byte(help);\r
st_addr.va_high:= help;\r
END (* procedure load_store_symbol *);\r
\r
(* $SUBTITLE('------------ PROCEDURE copy_symbol') *)\r
PROCEDURE copy_symbol;\r
\r
BEGIN\r
put_2_byte(get_2_byte);\r
put_2_byte(get_2_byte);\r
END (* procedure copy_symbol *);\r
\r
(* $SUBTITLE('------------ PROCEDURE skip_symbol') *)\r
PROCEDURE skip_symbol;\r
VAR dummy: WORD;\r
BEGIN\r
dummy:= get_2_byte;\r
dummy:= get_2_byte\r
END (* procedure skip_symbol *);\r
\r
(************ RULE000 ***********************)\r
\r
(* ------------------------------------------------------------------------\r
Pass2Code: 00\r
separator ::= OPTION(PASSNO,OPT,VALUE)!NEWLINE(LINENO)\r
Pass3Code: 00\r
separator ::= OPTION(PASSNO,OPT,VALUE)!NEWLINE(LINENO)\r
Symbol Table:\r
- no action.\r
\r
===========================================================================\r
\r
Error Messages and Warnings:\r
e_option\r
e_option_value\r
e_version\r
-.\r
External Dependencies:\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
External Effects:\r
sourcenumber (defined in RTP86MPA.EXT)\r
linenumber  (defined in RTP86MPA.EXT)\r
elementnumber (defined in RTP86MPA.EXT)\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
\r
create_size  (defined in PASS3CMMN.INC)\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
Stack Appetite:\r
-.\r
Comments:\r
Compiler options with 'pass_number'='WRD(this_pass)' are not\r
dumped.\r
\r
Only the last of successive line numbers are dumped.\r
-.\r
Outstanding:\r
-.\r
------------------------------------------------------------------------ *)\r
\r
(* $SUBTITLE('------------ PROCEDURE load_newline') *)\r
PROCEDURE load_newline\r
(\r
VAR\r
line_number : WORD\r
);\r
\r
BEGIN\r
\r
load_arg_1(line_number);\r
linenumber:= line_number;\r
\r
elementnumber:= 0;\r
\r
(*#BEGINTEST\r
IF rule_test_set<>[] THEN\r
WRITELN(testoutput, ' PASS2 LINE: ', line_number:5)\r
(*ENDTEST#*) \r
\r
END (* procedure load_newline *);\r
\r
(* $SUBTITLE('------------ PROCEDURE copy_newline') *)\r
PROCEDURE copy_newline;\r
\r
BEGIN\r
\r
load_arg_1(linenumber);\r
\r
elementnumber:= 0;\r
      store_code_1(cnewline, linenumber);\r
\r
(*#BEGINTEST\r
IF rule_test_set<>[] THEN\r
WRITELN(testoutput, ' PASS2 LINE: ', linenumber:5)\r
(*ENDTEST#*) \r
\r
END (* procedure copy_newline *);\r
\r
(* $SUBTITLE('------------ PROCEDURE pass3_option') *)\r
PROCEDURE pass3_option(option, value  : WORD);\r
var\r
local_value: word;\r
BEGIN\r
\r
CASE option_tokens(option) OF\r
\r
test_:;\r
(*#BEGINTEST\r
begin\r
IF WORD(czzzz)<value THEN\r
BEGIN\r
local_value:= value div 256;\r
value:= value mod 256;\r
if testpass3>=0 then\r
begin\r
teststh:= teststh or odd(local_value);\r
local_value:= local_value div 2;\r
teststh:= teststh and not odd(local_value);\r
local_value:= local_value div 2;\r
end\r
else\r
local_value:= local_value div 4;\r
\r
testvmmupdate:= (testvmmupdate or odd(local_value)) and (original_testvmm>=0);\r
local_value:= local_value div 2;\r
testvmmupdate:= testvmmupdate and not odd(local_value);\r
local_value:= local_value div 2;\r
END;\r
\r
if testpass3>=0 then\r
IF value=WORD(caaaa) THEN\r
rule_test_set:= []\r
ELSE\r
\r
IF value>=WORD(czzzz) THEN\r
rule_test_set:= [ caaaa..czzzz ]\r
ELSE\r
rule_test_set:= rule_test_set + [ codes(value) ];\r
end; (* test_ *)\r
(*ENDTEST#*)\r
\r
ixcheck_:\r
index_check:= true;\r
\r
noixcheck_:\r
index_check:= false;\r
\r
rangecheck_:\r
range_check:= true;\r
\r
norangecheck_:\r
range_check:= false;\r
\r
accesscheck_:\r
access_check:= true;\r
\r
noaccesscheck_:\r
access_check:= false;\r
\r
oflowcheck_:\r
overflow_check:= true;\r
\r
nooflowcheck_:\r
overflow_check:= false;\r
\r
createsize_:\r
create_size:= value;\r
\r
(* OTHERWISE *) else\r
fatal_error(this_pass, e_option)\r
\r
END  (* - 'this_pass' *)\r
\r
END (* procedure pass3_option *);\r
\r
(* $SUBTITLE('------------ PROCEDURE copy_option') *)\r
PROCEDURE copy_option;\r
\r
VAR\r
pass_number ,\r
option  ,\r
value  : WORD;\r
\r
BEGIN\r
\r
load_arg_3(pass_number, option, value);\r
\r
CASE modulerange(pass_number) OF\r
\r
pass3:\r
pass3_option(option, value) ;\r
\r
vmm:\r
BEGIN\r
\r
IF option=WORD(test_) THEN\r
if testvmmupdate then\r
testvmm:= value;\r
store_code_3(coption, pass_number, option, value)\r
\r
END;\r
\r
allpass:\r
BEGIN\r
\r
IF option=WORD(sourceno_) THEN\r
sourcenumber:= value\r
ELSE\r
\r
IF option=WORD(versionpass2) THEN\r
BEGIN\r
\r
IF pass3_version div 100 < value div 100 THEN\r
fatal_error(this_pass, e_version);\r
\r
store_code_3(coption, WORD(allpass), WORD(versionpass3), pass3_version);\r
\r
END;\r
\r
store_code_3(coption, pass_number, option, value)\r
\r
END;\r
\r
(* OTHERWISE *) else\r
store_code_3(coption, pass_number, option, value)\r
END;\r
\r
(*#BEGINTEST\r
IF rule_test_set<>[] THEN\r
WRITELN\r
(testoutput, ' OPTION: ', pass_number:2, option:6, value:6)\r
(*ENDTEST#*)\r
\r
END; (* procedure copy_option *)\r
END.\r
\r
«eof»