|
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: 21753 (0x54f9)
Types: TextFile
Names: »MPAUNIT.PAS«
└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
└─⟦this⟧ »RTP\MPAUNIT.PAS«
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
└─⟦this⟧ »MPAUNIT.PAS«
{$F+,O+}\r
unit mpaunit;\r
(** This context contains constants, types and\r
routines common for the RTP86compiler-complex **)\r
interface\r
uses pscplm;\r
(* LABELS *)\r
(* label 9999; (*exitpoint in case of fatal errors *)\r
(****** CONSTANTS ******)\r
\r
VAR\r
parsetablename,\r
errortexts,\r
rtpstdenv,\r
rtpstd50env,\r
rtpstd35env,\r
rtpstdoenv,\r
openroutinename,\r
RC5000openroutinename,\r
RC3502openroutinename,\r
oldpi3openroutinename: string[30];\r
sizeofconst : longint;\r
sizeoflinetable : longint;\r
CONST\r
space = 32; (*ordinal value of space*)\r
max_segment = 25;\r
(*** ***)\r
context_level = -1;\r
program_level = 0;\r
routine_level = 1;\r
\r
(*** ***)\r
\r
\r
first_ix = 0; (*first index in the standarddefinitions table*)\r
maxstddefinitions = 13; (*last index in the standarddefinitions table*)\r
\r
noelement = 257;\r
\r
(** The standard definitions are pt:\r
BOOLEAN, CHAR, INTEGER, REAL, BYTE, WORD, MAILBOX, REFERENCE,\r
POOL, PROCESS, PORT and CHAIN and DOUBLE.\r
The constants are to be used by pass1, pass2, pass3 ... **)\r
\r
\r
maxcallparams = 25;\r
(** Maximum number of input files to the RTP86-compiler -\r
i.e. 24 contexts and the source file **)\r
\r
(**** PAGING SYSTEM CONSTANTS ****)\r
enthextension = 8192(* 02000h *);\r
\r
(****** TYPES ******)\r
type\r
\r
(*$i codes*)\r
\r
\r
\r
spixrange = word;\r
\r
modulerange = (pass0,pass1,pass2,pass3,pass4,listh,sth,\r
vmm,mpa,exceptq,allpass,systemq);\r
\r
stdrange = first_ix .. maxstddefinitions;\r
\r
ext_type = (dummy,co1,co2,co3,co4,cls,tbf,tsf,lst,err,cmd);\r
\r
\r
option_tokens = (name_,start_,stop_,save_,load_,saveafter_,\r
memsw_,createsize_,survive_,time_,\r
vpagesize_,vpageres_,npagesize_,npageres_,hashsize_,\r
ind_,noind_,mark_,nomark_,\r
ownkey_,lckey_,uckey_,ownid_,lcid_,ucid_,\r
list_,nolist_,iflist_,break_,spacing_,xref_,noxref_,\r
computer_,optimize_,codesize_,\r
last_c_option_,dummy_c1,dummy_c2,\r
test_,code_,nocode_,ixcheck_,noixcheck_,\r
rangecheck_,norangecheck_,accesscheck_,noaccesscheck_,\r
oflowcheck_,nooflowcheck_,set_,pagewidth_,pagelength_,\r
last_cp_option_,dummy_cp1,dummy_cp2,dummy_cp3,dummy_cp4,\r
dummy_cp5,eject_,\r
title_,subtitle_,\r
liston_,listoff_,\r
if_,elseif_,else_,endif_,segment_,\r
version_,default_,last_p_option_,dummy_p2,\r
sourceno_,\r
versionpass1, versionpass2, versionpass3, versionpass4,\r
include_, dummy_p1_, last_option_);\r
\r
\r
\r
optiontype = record\r
\r
indexcheck,\r
rangecheck,\r
accesscheck,\r
overflowcheck,\r
code : boolean;\r
\r
createsize : word;\r
pagesize3502 : word;\r
Version,SubVersion : Byte;\r
(*** OPTIONS CONCERNING SOURCE LISTING ***)\r
title : string;\r
\r
pagewidth,\r
(* width > 0 *)\r
\r
pagelength,\r
(* length > 1 ---\r
=1 means nopaging *)\r
\r
indent,\r
(* ind = 1\r
noind = 2 *)\r
\r
mark,\r
(* mark = 1\r
nomark = 2 *)\r
\r
listing,\r
(* nolist = 1\r
list = 2\r
listoff = 3\r
liston = 4 *)\r
\r
keyword,\r
(* ownkey = 1\r
lckey = 2\r
uckey = 3 *)\r
\r
ident: byte;\r
(* ownid = 1\r
lcid = 2\r
ucid = 3 *)\r
\r
iflist : boolean;\r
\r
spacing : word;\r
\r
xref : byte;\r
(* noxref = 1\r
xref = 2 *)\r
\r
start : boolean;\r
\r
savecode: boolean;\r
\r
savestr : string;\r
\r
loadcode: 0..2;\r
\r
loadstr : string;\r
\r
saveafter : array [ pass1 .. pass4 ] of boolean;\r
\r
(** ALL has got the initial value = 0 **)\r
\r
end; (* optiontype *)\r
\r
\r
file_and_options = record\r
filename: string;\r
end;\r
\r
callparameters = array [1..maxcallparams] of file_and_options;\r
(** Each parameter in the call of the compiler, consists\r
of a set of options and a filename **)\r
\r
st_address = record\r
va_low,\r
va_high : word;\r
end;\r
\r
ptr_switchnode = ^switchnode;\r
\r
std_symbol_rec = record\r
symbolkind : codes;\r
spix : spixrange;\r
size : word;\r
symbol : st_address;\r
end;\r
\r
\r
switchnode = record\r
name: string;\r
value,call_value: integer;\r
next: ptr_switchnode;\r
end;\r
\r
errorrecs = record\r
pass: pass1..pass4;\r
source: 0..maxcallparams;\r
line,\r
element,\r
spixno: word;\r
kind: 1..3;\r
module_: modulerange;\r
errorno: word;\r
end; (* errorrecs *)\r
\r
\r
(***** PAGING SYSTEM TYPES ******)\r
\r
TYPE stcs_type = RECORD\r
access_low:WORD;\r
access_high: WORD;\r
disk_reads: WORD;\r
disk_writes: WORD\r
END;\r
\r
\r
const\r
max_page_data_length = 32000;\r
\r
type ptr_page_dscr_type = ^page_dscr_type;\r
page_dscr_type = record\r
va: st_address;\r
pred_ptr: ptr_page_dscr_type;\r
succ_ptr: ptr_page_dscr_type;\r
perm_locks: BYTE;\r
updated: BOOLEAN;\r
is_refered: WORD;\r
data_area: array[0..Max_page_data_length] of BYTE;\r
end;\r
\r
\r
type ptr_tbl_dscr_type= ^tbl_dscr_type;\r
tbl_dscr_type = record\r
page_size: WORD;\r
no_of_page: WORD;\r
name_va: st_address;\r
file_conn: file;\r
page_chain_head: ptr_page_dscr_type;\r
va_eoi: st_address;\r
special_va: st_address;\r
last_used_ptr: ptr_page_dscr_type;\r
no_of_residents: WORD;\r
max_residents: WORD;\r
low_page_mask: WORD;\r
bits_to_page_offset: BYTE;\r
offset_mask: WORD;\r
page_seg_size: WORD;\r
stcs: stcs_type;\r
page_ptrs: array[0..15] of ptr_page_dscr_type;\r
no_in_page_chains: array[0..15] of WORD;\r
low_check_time: WORD;\r
high_check_time: WORD;\r
end;\r
\r
(*\r
vmmtbldescraccess = RECORD\r
unitx ,\r
state : BYTE;\r
conditioncode : WORD;\r
nameptr : ^string\r
END\r
;\r
\r
vmmtabledescriptorptr = ^ vmmtbldescraccess;\r
*)\r
versionstype = packed array[1..8] of char;\r
\r
\r
ptr_symbol_chain = ^ symbol_chain;\r
symbol_chain = record symbol: st_address; next: ptr_symbol_chain end;\r
\r
computertype = (pi3,partner,rc5000,rc3502,oldpi3);\r
\r
\r
(****** VARIABLE ******)\r
var\r
releaseno,versionno : byte;\r
versionsid : versionstype;\r
\r
no_of_files: integer;\r
\r
starttimelow, starttimehigh, checktimelow, checktimehigh: word;\r
\r
\r
(** pointer to callparams **)\r
\r
callparams: callparameters;\r
call_options : optiontype;\r
\r
(**** GLOBAL OPTIONS ****)\r
\r
sourcenumber: integer; (*determines current sourcefile. Updated when\r
option(passno,SOURCENO, sourcenumber) is met.*)\r
linenumber, (*determines current linenumber in current\r
sourcefile. Updated when newline(linenumber)\r
is met*)\r
nmaxresidents,\r
vmaxresidents,\r
elementnumber: word;(*determines current elementnumber in current\r
line. Updated by those passes that counts\r
elementnumber*)\r
\r
elementspix: spixrange; (*determines spix of current element *)\r
\r
errorno, warningno: integer;\r
\r
computer : computertype;\r
optimize: integer;\r
pagesize3502 : word;\r
testmpa,testpass0,testpass1,testpass2,testpass3,testpass4,\r
testvmm,original_testvmm,testlist : integer; (*testoptions*)\r
save_tab,load_tab,\r
testvmmupdate, teststh, teststhsearch : boolean;\r
\r
ext3 : array [pass1..pass4] of char;\r
\r
option_text: array[ option_tokens ] of string[12];\r
\r
first_charspix,\r
anonymousspix : spixrange;\r
anonymousname : string;\r
anonymousstr : Ptr_string;\r
\r
stdspix_to_symbol_table : array [stdrange] of std_symbol_rec;\r
\r
switchstart,\r
switchcall,\r
switchpoint:\r
ptr_switchnode;\r
\r
make_segmentation,\r
make_code,\r
make_set: boolean;\r
last_segment: word;\r
segment_info: array[1..max_segment] of record spix:word;\r
list:ptr_symbol_chain;\r
no_of_symbol:integer;\r
size: word;\r
code_size: word;\r
line: word;\r
end;\r
\r
OptionBreakPoint : Boolean;\r
\r
\r
(******* PAGING SYSTEM VARIABLES *******)\r
\r
stdescriptorptr : ptr_tbl_dscr_type (*vmmtabledescriptorptr*) ;\r
nctdescriptorptr : ptr_tbl_dscr_type (*vmmtabledescriptorptr*) ;(* - *)\r
(**\r
traceoutputconnection : word;\r
testoutputconnection : word;\r
**)\r
testoutvmm: text; (* holds testoutput from VMM *)\r
\r
const lengthoffilebuffer = 8000;\r
type filebuffertype = array[1..lengthoffilebuffer] of byte;\r
var filebufferptr : ^filebuffertype;\r
filebufferalloc : boolean;\r
\r
(****** I/O VARIABLES *****)\r
\r
openroutine : file of byte; (* holds the openroutines*)\r
TBinFile : file;\r
(*Name of the temp binear object file. The binear\r
output of the first pass of pass4*)\r
comm: (* holds commands from PASS1 to listhandler *)\r
file; (* of 0..255; *)\r
\r
TSymFile, (* File containing the symbolic output of the\r
first pass of pass4*)\r
codelist, (* holds symbolic code listing *)\r
testoutput, (* holds the actual testoutput file *)\r
parsetables, (* holds the parsetables used by pass1 *)\r
listfile, (* holds the listing produced by the listhandler*)\r
errtxts: (* holds file containing all errortexts *)\r
text;\r
\r
errorfile: file of errorrecs;\r
\r
(* !!! TURBO !!! *)\r
fatal,error, warn,break_line : boolean;\r
open_errtxts, open_parsetables, open_openroutine,\r
open_comm, open_listfile, open_tbinfile, open_codelist, open_tsymfile,\r
open_errorfile, (* indicates whether or not ERRORFILE has been opened *)\r
firstcall_closep,\r
call_listh,\r
test_on_co,\r
exit_before: boolean;\r
\r
\r
(* for rtp86p0, sthintern, listhandlermodule;\r
label 8888; (* exitpoint in case of error in compilercall *)\r
\r
var\r
stop_module: modulerange;\r
active_module: modulerange;\r
\r
timetest,\r
mpatest,\r
testmemwholes,\r
mempooltest: boolean;\r
\r
extension: array[ext_type] of three_char;\r
vmmextension : three_char;\r
nthextension : three_char;\r
cobextension : three_char;\r
survival: array[ext_type] of boolean;\r
startmemavail : longint;\r
\r
procedure write_errormessage;\r
\r
procedure write_hex(exccode: word);\r
\r
function equalname( s, name : string ): boolean;\r
\r
\r
function find_errormessage(moduleid:modulerange; error_no:word):boolean;\r
\r
\r
procedure warning(module_id:modulerange; warning_no:word);\r
\r
procedure errormsg(module_id:modulerange;error_no:word);\r
\r
\r
procedure fatal_error(module_id:modulerange;error_no:word);\r
\r
procedure startlisthand;\r
\r
implementation\r
uses sthcom,files,list,rtp86mpa;\r
\r
function readnumber : word;\r
var\r
a: string[12];\r
ch : char;\r
w : word;\r
comment: boolean;\r
begin\r
a := 'readnumber ';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
w := 0;\r
readnumber := 0;\r
\r
repeat\r
comment := false;\r
readln(errtxts);\r
if not eof(errtxts) then read(errtxts,ch);\r
if (ch >= '0') and (ch <= '9') then\r
while ('0' <= ch) and (ch <= '9') do\r
begin\r
w := w * 10 + ( ord(ch) - ord('0') );\r
readnumber := w;\r
if not eof(errtxts) then read(errtxts,ch);\r
end\r
else (** not number **)\r
if ch = '#' then\r
(* next modulemark *)\r
readnumber := 65535 (*0ffffh*)\r
else (* comment - skip line *)\r
comment := true;\r
until (not comment) or eof(errtxts);\r
\r
end;\r
\r
function equalname(s,name:string):boolean;\r
(*check if two strings are equal *)\r
var step : integer;\r
equal : boolean;\r
begin\r
equalname:= s=name;\r
end;\r
\r
function find_errormessage(moduleid:modulerange; error_no: word):boolean;\r
var\r
a: string[12];\r
found,next_errlist: boolean;\r
ch: char;\r
number: word;\r
holdmark: string[10];\r
marktable: array[modulerange] of string[14];\r
\r
begin\r
a := 'find-errmsg ';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
found := false;\r
find_errormessage := false;\r
\r
(** modulemarks in RTP86ERROR-file **)\r
marktable[mpa] := '##MPA##';\r
marktable[pass0] := '##PASS0##';\r
marktable[pass1] := '##PASS1##';\r
marktable[pass2] := '##PASS2##';\r
marktable[pass3] := '##PASS3##';\r
marktable[pass4] := '##PASS4##';\r
marktable[sth] := '##STH##';\r
marktable[listh] := '##LISTH##';\r
marktable[vmm] := '##VMM##';\r
marktable[exceptq] := '##EXCEPT##';\r
marktable[systemq] := '##SYSTEM##';\r
\r
\r
reset(errtxts);\r
read(errtxts,ch);\r
\r
(* find modulemark *)\r
while not(found or eof(errtxts)) do\r
begin\r
while not(eof(errtxts) or (ch = '#')) do\r
begin\r
read(errtxts,ch);\r
\r
if (ch <> '#') and (not eof(errtxts)) then\r
(* skip line *)\r
readln(errtxts);\r
end;\r
\r
if ch ='#' then\r
begin (*read and compare mark *)\r
(* read mark into 'holdmark' *)\r
holdmark:='';\r
repeat\r
holdmark:=concat(holdmark,ch);\r
if not eoln(errtxts) then\r
read(errtxts,ch)\r
else ch := ' ';\r
until (ch = ' ');\r
\r
found := equalname(marktable[moduleid],holdmark);\r
\r
end; (* read and compare *)\r
end; (* find modulemark *)\r
\r
if found then\r
(* find 'error-no' *)\r
begin\r
found := false;\r
next_errlist := false;\r
\r
while not (eof(errtxts) or found or next_errlist) do\r
begin\r
number := readnumber;\r
\r
if number = 65535 (*0ffffh*) then\r
(* next modulemark encountered **)\r
next_errlist := true\r
else\r
found := error_no = number;\r
\r
end; (* while*)\r
end;\r
\r
find_errormessage := found;\r
\r
end; (** ERRORMESSAGE **)\r
\r
procedure write_errormessage;\r
var\r
ch: char;\r
a: string[12];\r
begin\r
a := 'write-errmsg';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
while not eoln(errtxts) do\r
begin\r
read(errtxts,ch);\r
write(ch);\r
end;\r
writeln;\r
end; (**write_errormessage**)\r
\r
\r
procedure write_hex(exccode: word);\r
(** procedure writes the number "exccode" in hex form **)\r
VAR\r
a: string[12];\r
i : integer;\r
(* x and Hex are used to convert exccode into hex form *)\r
x : RECORD\r
CASE b : boolean OF\r
true : (i : Word);\r
false : ( Byte1 : 0..255;\r
Byte2 : 0..255);\r
END;\r
Hex : ARRAY[0..15] OF char;\r
BEGIN\r
a := 'write-hex ';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
(* initialize Hex *)\r
FOR i := 0 TO 9 DO Hex[i] := chr(ord('0') + i);\r
FOR i := 10 TO 15 DO Hex[i] := chr(ord('A') + i - 10);\r
\r
(* write exccode *)\r
x.i := exccode;\r
write(Hex[x.Byte2 DIV 16]);\r
write(Hex[x.Byte2 MOD 16]);\r
write(Hex[x.Byte1 DIV 16]);\r
write(Hex[x.Byte1 MOD 16]);\r
writeln('H');\r
\r
END;(** write-hex**)\r
\r
procedure output_modulename(module_id: modulerange);\r
var\r
a: string[12];\r
begin\r
a := 'outp-modulen';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
case module_id of\r
mpa: writeln('MPA');\r
pass0: writeln('PARSE');\r
pass1: writeln('PARSE');\r
pass2: writeln('ANALYZE');\r
pass3: writeln('ALLOCATE');\r
pass4: writeln('OBJECT');\r
sth: writeln('SYMBOL TABLE HANDLER');\r
listh: writeln('LIST HANDLER');\r
vmm: writeln('VIRTUAL MEMORY MANAGER');\r
systemq: writeln('COMPILER');\r
exceptq: writeln(output,'EXCEPTION HANDLER')\r
else (*otherwise*)\r
writeln('unknown moduleid: ', ord(module_id));\r
end;\r
break_line:=true;\r
end; (*output-modulename *)\r
\r
\r
procedure output_element_inf;\r
var\r
elementnameptr : ptr_string;\r
a: string[12];\r
begin\r
a := 'outp-eleminf';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
if (sourcenumber > 0) and (sourcenumber <= maxcallparams) then\r
(* write out filename *)\r
write('in: ', callparams[sourcenumber].filename,': ')\r
else\r
write('During initialization.');\r
\r
if linenumber <> 0 then\r
write(' LINE:',linenumber:3,' ');\r
\r
if elementnumber <> noelement then\r
write(' ELEMENT:',elementnumber:3,' ');\r
\r
if elementspix <> anonymousspix then\r
begin\r
st_nameofspix(elementspix,elementnameptr);\r
writeln(elementnameptr^);\r
end else\r
writeln;\r
end; (* output-element-inf *)\r
\r
\r
procedure create_errorrec(moduleid: modulerange;\r
errno: word; wef_kind: byte; spix: word);\r
var\r
a: string[12];\r
erec: errorrecs;\r
begin\r
a := 'create-errec';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
with erec do\r
begin\r
if active_module<=pass1 then pass:=pass1 else\r
if active_module>pass4 then pass:=pass4 else\r
pass := active_module;\r
module_ := moduleid;\r
source := sourcenumber; \r
line := linenumber;\r
element := elementnumber;\r
spixno := spix;\r
kind := wef_kind;\r
errorno := errno;\r
end;\r
\r
(* !!! TURBO !!!\r
errorfile^ := erec;\r
if open_errorfile then\r
put(errorfile); *)\r
if open_errorfile then write(errorfile, erec);\r
\r
\r
end; (*create_errorec **)\r
\r
procedure warning(module_id:modulerange;warning_no:word);\r
var\r
a: string[12];\r
begin\r
a := 'warning ';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
writeln;\r
write('***WARNING from: ');\r
\r
output_modulename(module_id);\r
output_element_inf;\r
\r
write('***WARNING: ');\r
\r
if find_errormessage(module_id,warning_no) then\r
write_errormessage\r
else\r
writeln('warning number:',warning_no);\r
\r
warn := true;\r
warningno := warningno + 1;\r
\r
create_errorrec(module_id,warning_no,1 (*warning*),elementspix);\r
\r
\r
elementspix := anonymousspix;\r
\r
end; (* warning *)\r
\r
procedure errormsg(module_id:modulerange;error_no:word);\r
var\r
a: string[12];\r
begin\r
a := 'errormsg ';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
writeln;\r
write('***ERRORMESSAGE from: ');\r
\r
output_modulename(module_id);\r
output_element_inf;\r
\r
write('***ERROR: ');\r
\r
if find_errormessage(module_id,error_no) then\r
write_errormessage\r
else\r
writeln('error number:',error_no);\r
\r
error := true;\r
errorno := errorno + 1;\r
\r
create_errorrec(module_id,error_no,2 (*error*),elementspix);\r
\r
elementspix := anonymousspix;\r
\r
end; (* errormsg *)\r
\r
procedure fatal_error(module_id:modulerange;error_no:word);\r
(*prompts the fatal error and closes down the compilation*)\r
var\r
a: string[12];\r
begin\r
a := 'fatal-error ';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
if fatal then halt(1); (* !!! TURBO goto 8888; *)\r
fatal:=true;\r
writeln;\r
\r
write(output,'***SYSTEM ERROR from ');\r
(* if module_id = except then module_id:=systemx; *)\r
output_modulename(module_id);\r
\r
(*\r
if module_id = except then\r
begin\r
writeln(output,'EXCEPTION HANDLER:');\r
write(output,'EXCEPTION NO:');\r
write_hex(error_no); writeln;\r
end;\r
else\r
*)\r
if find_errormessage(module_id,error_no) then\r
write_errormessage\r
else\r
begin\r
write(output,'ERROR_NO:');\r
write_hex(error_no);\r
writeln;\r
end;\r
\r
if (sourcenumber > 0) and (sourcenumber <= maxcallparams) then\r
(* write out filename *)\r
write('in: ', callparams[sourcenumber].filename,': ')\r
else\r
write('During initialization.');\r
\r
if linenumber <> 0 then\r
write(' LINE:',linenumber,' ');\r
\r
\r
if module_id <> exceptq then\r
if (*module_id<>systemq) and*) (active_module<>listh) then\r
begin\r
create_errorrec(module_id, error_no, 3 (*systemerror*),elementspix);\r
end;\r
\r
elementspix := anonymousspix;\r
\r
writeln;\r
if (*module_id<>systemq) and*) (module_id<>exceptq) then startlisthand;\r
halt(1);\r
\r
end;\r
\r
procedure StartListHand;\r
BEGIN\r
if original_testvmm >= 0 then testvmm := 0 else testvmm:= -1;\r
teststh:=false;\r
teststhsearch:=false;\r
\r
\r
(**INITIATE LISTHANDLER**)\r
if call_listh then\r
begin\r
call_listh := false;\r
if active_module<>listh then make_code:=false;\r
stop_module:=active_module;\r
active_module:=listh;\r
close_files;\r
open_files(listh);\r
(* !!! TURBO !!! load_overlay(listh); *)\r
\r
\r
write('LIST');\r
\r
listhandler;\r
\r
writeln;\r
if timetest then\r
begin\r
time_used := find_time_used;\r
writeln;\r
writeln(' list', ':',time_used : 7, ' sec.');\r
end;\r
\r
end;\r
testvmm:=original_testvmm;\r
\r
\r
if firstcall_closep then\r
begin\r
firstcall_closep := false;\r
close_pagingsystem;\r
end;\r
\r
\r
(* close fileconnections for i/o-files *)\r
close_files;\r
\r
if open_errtxts then close(errtxts);\r
if open_parsetables then close(parsetables);\r
if open_openroutine then close(openroutine);\r
if open_comm then close(comm);\r
if open_listfile then close(listfile);\r
if open_errorfile then close(errorfile);\r
if open_tbinfile then close(tbinfile);\r
if open_codelist then close(codelist);\r
if open_tsymfile then close(tsymfile);\r
\r
delete_workfiles;\r
\r
if timetest then\r
begin\r
time_used := find_time_used;\r
writeln(' closing files: ',time_used : 6, ' sec.');\r
end;\r
\r
(*** ***)\r
if fatal then\r
begin\r
writeln('COMPILATION ABORTED');\r
halt(1);\r
end\r
else\r
if (error or warn) then\r
begin\r
if error then\r
begin\r
\r
if warn then\r
begin\r
writeln(warningno,' WARNINGS.');\r
end;\r
\r
writeln( errorno, ' ERRORS DETECTED. COMPILATION STOPPED.');\r
halt(1);\r
end\r
else (* no errrors *)\r
if warn then\r
begin\r
writeln(warningno,' WARNINGS. COMPILATION COMPLETED.');\r
end;\r
end\r
else\r
(** NEITHER ERRORS NOR WARNINGS **)\r
begin\r
writeln;\r
writeln('NO ERRORS DETECTED. COMPILATION COMPLETED');\r
end;\r
\r
END;\r
BEGIN\r
\r
parsetablename := systempath + 'rtppar.tab';\r
errortexts := systempath + 'rtperr.txt';\r
rtpstdenv := systempath + 'rtpstd86.env';\r
rtpstd50env := systempath + 'rtpstd50.env';\r
rtpstd35env := systempath + 'rtpstd35.env';\r
rtpstdoenv := systempath + 'rtpstdo.env';\r
openroutinename := systempath + 'rtpope86.lib';\r
RC5000openroutinename := systempath + 'rtpope50.lib';\r
RC3502openroutinename := systempath + 'rtpope35.lib';\r
oldpi3openroutinename := systempath + 'rtpopeo.lib';\r
end.\r
«eof»