|
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: 38960 (0x9830)
Types: TextFile
Names: »RTP86P0.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTP86P0.PAS«
{$O+,F+}\r
\r
(*\r
-------------------------------------------------------------------------\r
-- 92.05.06 2.7 HEJ Extension for objects changed T35 -> T22\r
-------------------------------------------------------------------------\r
*)\r
unit rtp86p0;\r
\r
interface\r
uses pscplm, rtp86rmx, mpaunit, sthunit, sthint, sthcom, sthp1, vmmunit, nthunit, rtp86mpa;\r
procedure rtp86pass0;\r
\r
implementation\r
(* !!! TURBO !!! *)\r
const maxword = 65535;\r
\r
var\r
pass0test: boolean;\r
helptestpass0: integer;\r
\r
\r
(**** ****)\r
\r
procedure init_sth;\r
(** Procedure initial different global constants. *)\r
(** also it generates code for predefined (standard) types. *)\r
(** Also symbol tables representation are created. *)\r
\r
type\r
alfa3 = string[3];\r
\r
var\r
a: string[12]; (** for testpurposes **)\r
\r
char_name: alfa3;\r
namestr : string;\r
i, no,\r
sthtest,\r
typeix : integer;\r
res : word;\r
c : codes;\r
st_addr, addr1: st_address;\r
integeraddr : st_address;\r
ptr, ptr1: st_elemptr;\r
\r
\r
procedure char_type( ch_name : alfa3; lgh : byte );\r
var i : integer;\r
begin\r
namestr:= ch_name;\r
st_declaration( cconstant, namestr, st_addr, ptr );\r
with ptr^ do\r
begin\r
typeref:= stdspix_to_symbol_table[ 2 ].symbol;\r
const_val:= no;\r
st_size:= charsize;\r
if no < 32 then no:= no+1 else no:= 127;\r
end; (* with ptr *)\r
st_insert_symbols( st_addr );\r
end;\r
\r
procedure stdtype(namealfa: string ; namekind: codes; typesize : word);\r
(** inserts typespix into array "stdtypespix" *)\r
(** code: standardname(spix, st_addr) *)\r
(** ST: declaration newtype endtype *)\r
begin\r
if typeix < maxstddefinitions then\r
typeix := typeix + 1\r
else fatal_error( pass1,8);\r
\r
namestr:= namealfa;\r
\r
st_newtype( namekind, addr1, ptr1 );\r
ptr1^.st_size:= typesize;\r
\r
st_declaration(ctype,namestr,st_addr,ptr);\r
\r
if typeix >= 0 then\r
with stdspix_to_symbol_table[ typeix ] do\r
begin\r
spix := st_spixofname( namestr );\r
symbolkind:= namekind;\r
size := typesize;\r
symbol := st_addr;\r
end;\r
\r
with ptr^ do\r
begin\r
typeref:= addr1;\r
st_size:= typesize;\r
case typeix of\r
7:\r
begin\r
spec_struct:= [mailboxtype];\r
st_mailboxtype_addr:= st_addr;\r
end;\r
8:\r
begin\r
spec_struct:= [referencetype];\r
st_referencetype_addr:= st_addr;\r
end;\r
9:\r
begin\r
spec_struct:= [pooltype];\r
st_pooltype_addr:= st_addr;\r
end;\r
10:\r
begin\r
spec_struct:= [processtype];\r
st_processtype_addr:= st_addr;\r
end;\r
11:\r
begin\r
spec_struct:= [porttype];\r
st_porttype_addr:= st_addr;\r
end;\r
12:\r
begin\r
spec_struct:= [chaintype];\r
st_chaintype_addr:= st_addr;\r
end\r
else if namekind = cpointertype then spec_struct := [pointertype];\r
end; (* case *)\r
end;\r
st_insert_symbols( st_addr );\r
\r
end; (*stdtype*)\r
\r
begin\r
\r
a := 'init_sth';\r
(******************)\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
(*\r
emit(cversionnumber, version_no, false, 0, false, 0, cnocode );\r
*)\r
(*** init anonymousspix ***)\r
res:= nthextend(anonymousspix, anonymousname );\r
if teststh then\r
begin\r
writeln(testoutput);\r
writeln(testoutput,'anonymous spix: ', anonymousspix);\r
end;\r
(*** end init ***)\r
\r
res:= vmmextend( stdescriptorptr^, currant_addr, node_length[cendlevel],\r
true, ptr );\r
if res <> 0 then fatal_error( vmm, res );\r
\r
st_nilladdr:= currant_addr;\r
init_element( cendlevel, ptr );\r
last_addr:= st_nilladdr;\r
last_elem:= ptr;\r
\r
last_cross:= st_nilladdr;\r
obj_addr:= st_nilladdr;\r
currant_level:= st_nilladdr;\r
\r
ptr^.st_inf.st_former:= obj_addr;\r
\r
if teststh then elem_print( ptr, last_addr );\r
elementextend( ptr, cendlevel );\r
st_stopaddr:= currant_addr;\r
if teststh then elem_print( ptr, currant_addr );\r
\r
currant_rec := st_nilladdr;\r
st_program_type_addr := st_nilladdr;\r
st_dataarea_type_addr:= st_nilladdr;\r
st_buffer_type_addr := st_nilladdr;\r
st_create_addr := st_nilladdr;\r
st_string_type_addr := st_nilladdr;\r
save_typekind:= false;\r
\r
(***** first begin ******)\r
\r
elementextend( currant_level_ptr, cendlevel );\r
currant_level:= currant_addr;\r
st_lock(currant_level_ptr);\r
currant_level_ptr^.st_inf.st_former:= st_nilladdr;\r
last_created_level:= currant_level;\r
last_created_level_ptr:= currant_level_ptr;\r
st_lock(last_created_level_ptr);\r
\r
if teststh then elem_print( currant_level_ptr, currant_level );\r
\r
update_last( ptr );\r
first_level:= currant_level;\r
next_level:= st_nilladdr;\r
first_next_level:= last_created_level;\r
obj_addr := currant_addr;\r
first_addr:= obj_addr;\r
\r
typeix := first_ix - 3;\r
\r
st_declaration( cundeclared, anonymousname, st_undeclared_addr, ptr1 );\r
\r
type_kind:= true;\r
stdtype('PTYPE',cpointertype, pointersize);\r
st_ptype_addr:= st_addr;\r
stdtype('?',csettype, wordsize);\r
st_emptyset_addr:= st_addr;\r
elementretrieve( false,true, addr1, ptr1 );\r
ptr1^.typeref:= st_addr;\r
stdtype('?',cerror, errorsize);\r
elementretrieve( false,true, st_undeclared_addr, ptr1 );\r
ptr1^.typeref:= st_addr;\r
\r
stdtype('BOOLEAN',cboolean, booleansize);\r
stdtype('CHAR',cchar, charsize);\r
\r
no:= 0;\r
char_type('NUL',3);\r
first_charspix:= ptr^.st_spix;\r
char_type('SOH',3);\r
char_type('STX',3);\r
char_type('ETX',3);\r
char_type('EOT',3);\r
char_type('ENQ',3);\r
char_type('ACK',3);\r
char_type('BEL',3);\r
char_type('BS',2);\r
char_type('HT',2);\r
char_type('LF',2); (* 10 *)\r
char_type('VT',2);\r
char_type('FF',2);\r
char_type('CR',2);\r
char_type('SO',2);\r
char_type('SI',2);\r
char_type('DLE',3);\r
char_type('DC1',3);\r
char_type('DC2',3);\r
char_type('DC3',3);\r
char_type('DC4',3); (* 20 *)\r
char_type('NAK',3);\r
char_type('SYN',3);\r
char_type('ETB',3);\r
char_type('CAN',3);\r
char_type('EM',2);\r
char_type('SUB',3);\r
char_type('ESC',3);\r
char_type('FS',2);\r
char_type('GS',2);\r
char_type('RS',2); (* 30 *)\r
char_type('US',2);\r
char_type('SP',2);\r
char_type('DEL',3);\r
\r
type_kind:= true;\r
stdtype('INTEGER',cinteger, integersize);\r
IntegerAddr := St_Addr;\r
stdtype('REAL',creal, realsize);\r
stdtype('BYTE',cbyte, bytesize);\r
{$IFDEF rtp86}\r
(* old rtp86 hha *********)stdtype('WORD',cword, wordsize);\r
{$ELSE}\r
if Computer = oldpi3 then\r
begin\r
(* new rtp86 ebk *********)stdtype('WORD',cword, wordsize);\r
end else\r
BEGIN\r
(* new rtp hha ***********)stdtype('INT16',cSubRange, 2);\r
st_get(addr1,Ptr);\r
with ptr^ do\r
begin\r
typeref := IntegerAddr;\r
subr_low := $8000;\r
subr_high := 32767;\r
end;\r
END;\r
{$ENDIF}\r
stdtype('MAILBOX',cmailbox, mailboxsize);\r
stdtype('REFERENCE',creference, referencesize);\r
stdtype('POOL',cpool, poolsize);\r
stdtype('PROCESS',cprocess, processsize);\r
stdtype('PORT',cport, portsize);\r
stdtype('CHAIN',cchain, chainsize);\r
stdtype('INT32',cdo, doublesize);\r
\r
(*\r
first_addr:= obj_addr;\r
*)\r
namestr:= 'EXCEPTION';\r
res:= nthextend( st_spix_of_exception, namestr );\r
\r
namestr:= 'BTYPE';\r
st_declaration( ctype, namestr, st_btype_addr, ptr );\r
st_insert_symbols( st_btype_addr );\r
with ptr^ do\r
begin\r
typeref:= stdspix_to_symbol_table[ 5 ].symbol;\r
st_size:= bytesize;\r
end;\r
namestr:='WTYPE';\r
st_declaration( ctype, namestr, st_wtype_addr, ptr );\r
st_insert_symbols( st_wtype_addr );\r
with ptr^ do\r
begin\r
typeref:= stdspix_to_symbol_table[ 6 ].symbol;\r
st_size:= wordsize;\r
end;\r
namestr:='RTYPE';\r
st_declaration( ctype, namestr, st_rtype_addr, ptr );\r
st_insert_symbols( st_rtype_addr );\r
with ptr^ do\r
begin\r
typeref:= stdspix_to_symbol_table[ 8 ].symbol;\r
st_size:= referencesize;\r
spec_struct:= [referencetype];\r
end;\r
\r
for i:= 0 to 1 do\r
begin\r
if i=0 then namestr:='FALSE' else namestr:='TRUE';\r
st_declaration( cconstant, namestr, st_addr, ptr );\r
with ptr^ do\r
begin\r
typeref:= stdspix_to_symbol_table[ 1 ].symbol;\r
const_val:= i;\r
st_size:= booleansize;\r
end;\r
st_insert_symbols( st_addr );\r
end;\r
if save_tab then\r
begin\r
res:= vmmretrieve(stdescriptorptr^, saveinf_addr.va_high, saveinf_addr.va_low,\r
false, true, saveinf_ptr );\r
if res <> 0 then fatal_error(vmm,res);\r
with saveinf_ptr^ do\r
begin\r
int_kind := csavecode;\r
s_nilladdr:= st_nilladdr;\r
s_stopaddr:= st_stopaddr;\r
s_btype := st_btype_addr;\r
s_wtype := st_wtype_addr;\r
s_rtype := st_rtype_addr;\r
s_ptype := st_ptype_addr;\r
s_first_addr:=first_addr;\r
s_emptyset_addr:= st_emptyset_addr;\r
s_undeclared_addr := st_undeclared_addr;\r
s_charspix := first_charspix;\r
s_anonymousspix:=anonymousspix;\r
s_spix_of_exception:=st_spix_of_exception;\r
for typeix:= first_ix to maxstddefinitions do\r
s_stdsymbol_table[ typeix ]:= stdspix_to_symbol_table[ typeix ];\r
\r
end; (* with *)\r
end; (* if save *)\r
\r
end;\r
\r
\r
procedure rtp86pass0;\r
const\r
\r
creturn = 13 (*0dh*); (* denotes a carreturn *)\r
\r
(*constants for the paging system*)\r
facilitymask = 32769(*8001h*);\r
\r
accessrights = 3;\r
noofbuffers = 1;\r
\r
var\r
(** VMM -variables **)\r
i:integer;\r
c : codes;\r
vpagesize: word;\r
\r
(** NTH - variables **)\r
npagesize,\r
hashsize: word;\r
\r
(********* **********)\r
\r
procedure call_error(e_no: word);\r
var\r
a: string[12];\r
begin\r
a := 'call-error';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
writeln(' RTP-CALL ERROR: ');\r
\r
if find_errormessage(mpa,e_no) then\r
write_errormessage\r
else\r
writeln('errorno: ', e_no);\r
\r
(* !!! TURBO goto 8888; (* exit *)\r
halt(1);\r
end; (* call-error *)\r
\r
procedure open_testoutvmm;\r
var\r
a: string[12];\r
testname: string;\r
helpname: string;\r
ext : string;\r
step : integer;\r
status: word;\r
begin\r
a := 'open-tstovmm';\r
(******************)\r
\r
(*#BEGINTEST\r
if mpatest then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
if original_testvmm > -1 then\r
begin\r
if original_testvmm >= 10000 then\r
begin\r
helpname:= 'con';\r
status:= 0;\r
assign(testoutvmm,helpname); (* connection to :co: *)\r
if status <> 0 then fatal_error(mpa,13);\r
(* VMM - testfile could not bee opened *)\r
\r
rewrite(testoutvmm);\r
if status <> 0 then fatal_error(mpa,13);\r
(* VMM - testfile could not bee opened *)\r
\r
original_testvmm := original_testvmm mod 10000;\r
\r
end (** if >= 10000 *)\r
else\r
begin\r
(*preparing extension ts<module_no> *)\r
(*for step := 1 to 12 do ext[step] := chr(space);\r
ext[1] := 't';\r
ext[2] := 's';\r
*)\r
ext := 'ts ';\r
ext[3] := chr(ord('1') +ord(vmm)-ord(pass1));\r
\r
(*fetch sourcefilename - last file name in callparams*)\r
with callparams[no_of_files] do\r
change_ext(filename,helpname,ext); (* extension: ts<ord(vmm)> *)\r
status:=0;\r
assign(testoutvmm, helpname);\r
rewrite(testoutvmm);\r
if status <> 0 then fatal_error(mpa,13);\r
(* VMM - testfile could not bee opened *)\r
end\r
end\r
else\r
begin\r
helpname:= 'con';\r
status:=0;\r
assign(testoutvmm,helpname); (* connection to :bb: *)\r
if status <> 0 then fatal_error(mpa,13);\r
(* VMM - testfile could not bee opened *)\r
\r
rewrite(testoutvmm);\r
if status <> 0 then fatal_error(mpa,13);\r
(* VMM - testfile could not bee opened *)\r
end; (* :bb: *)\r
if testvmmupdate then testvmm := original_testvmm;\r
end; (*open_testoutvmm*)\r
\r
(*INITIALIZING PAGING SYSTEM*)\r
procedure init_pagingsystem(path:string);\r
const\r
symbtab_ext='ST';(*string[12]*)\r
nametab_ext='NT';\r
vmmtest_ext='VMM';\r
\r
var\r
a: string[12];\r
namestr,\r
symbtabname : string;\r
status : word;\r
begin\r
a := 'init-pagings';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
\r
(*open console for errormessages from the paging system*)\r
stdescriptorptr:= nil;\r
nctdescriptorptr:= nil;\r
\r
(*construct symbtabname by changing extension of inputfile to .ST*)\r
change_ext(path,symbtabname,symbtab_ext);\r
(*create nameconvertiontable*)\r
change_ext(path,namestr,nametab_ext);\r
\r
(*open symboltable*)\r
\r
status:= 0;\r
if load_tab then begin\r
if active_module=pass1\r
then load_specs(true)\r
else load_specs(false);\r
end\r
else\r
begin\r
status := vmmcreatetable(stdescriptorptr,symbtabname,\r
vmaxresidents,vpagesize);\r
if status <> 0 then fatal_error( vmm, status );\r
status:= vmmextend( stdescriptorptr^, saveinf_addr,save_type_length, false,\r
saveinf_ptr );\r
saveinf_ptr^.int_kind:= csavecode;\r
\r
if status <> 0 then fatal_error(vmm,status);\r
\r
status := nthcreate(namestr,nmaxresidents,npagesize, hashsize);\r
end;\r
if status <> 0 then fatal_error(vmm,status);\r
end;\r
\r
procedure readcallparams;\r
var\r
a: string[12];\r
i : integer;\r
switchname,\r
next_param : string;\r
key,delimiter: byte;\r
error: word;\r
p,\r
testmodule: modulerange;\r
moduletable: array[modulerange] of string;\r
curropt: option_tokens;\r
currval: integer;\r
extres: ext_type;\r
\r
(*procedure change_priority;\r
var\r
a: string[12];\r
begin\r
a := 'change_prio_';\r
(******************)\r
\r
(*#BEGINTEST\r
(*if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
(*key := rqgetpriority(0, error);\r
rqsetpriority(0, key + 1, error);\r
end; (* change_prio *)\r
\r
procedure initoption;\r
var p : modulerange;\r
begin\r
save_tab:= false;\r
load_tab:= true;\r
optionbreakpoint:=false;\r
with call_options do\r
begin\r
iflist := false;\r
indexcheck := true;\r
rangecheck := true;\r
accesscheck := false;\r
overflowcheck := true;\r
code := false;\r
start := false;\r
savecode:= false;\r
loadcode:= 0;\r
createsize := 0;\r
Pagesize3502 := 0;\r
Version := 0;\r
SubVersion := 0;\r
savestr:= '';\r
loadstr:= rtpstdenv;\r
\r
for p:= pass1 to pass4 do saveafter[ p ]:= false;\r
\r
title:= '';\r
pagewidth := 0;\r
pagelength := 0;\r
indent := 0;\r
mark := 0;\r
listing := 0;\r
keyword := 0;\r
ident := 0;\r
spacing := 50;\r
xref := 0;\r
\r
end;\r
end;\r
\r
procedure initoption_text;\r
var\r
a: string[12];\r
opt: option_tokens;\r
begin\r
a := 'initoption_t';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
init_argument; (*define optiontable*)\r
(* define options to rtp86mpa by using insert_key*)\r
for opt := name_ to last_option_ do option_text[opt] := ' ';\r
option_text[start_] := 'START';\r
option_text[stop_] := 'STOP';\r
option_text[save_] := 'SAVE';\r
option_text[load_] := 'LOAD';\r
option_text[saveafter_] := 'SAVEAFTER';\r
option_text[memsw_] := 'MEM';\r
option_text[createsize_] := 'CREATESIZE';\r
option_text[Codesize_] := 'CODESIZE';\r
option_text[survive_] := 'SURVIVE';\r
option_text[time_] := 'TIME';\r
option_text[vpagesize_] := 'SPAGESIZE';\r
option_text[vpageres_] := 'SPAGERES';\r
option_text[npagesize_] := 'NPAGESIZE';\r
option_text[npageres_] := 'NPAGERES';\r
option_text[hashsize_] := 'HASHSIZE';\r
option_text[ind_] := 'IND';\r
option_text[noind_] := 'NOIND';\r
option_text[mark_] := 'MARK';\r
option_text[nomark_] := 'NOMARK';\r
option_text[ownkey_] := 'OWNKEY';\r
option_text[lckey_] := 'LCKEY';\r
option_text[uckey_] := 'UCKEY';\r
option_text[ownid_] := 'OWNID';\r
option_text[lcid_] := 'LCID';\r
option_text[ucid_] := 'UCID';\r
option_text[list_] := 'LIST';\r
option_text[nolist_] := 'NOLIST';\r
option_text[iflist_] := 'IFLIST';\r
option_text[break_] := 'BREAK';\r
option_text[spacing_] := 'SPACING';\r
option_text[xref_] := 'XREF';\r
option_text[noxref_] := 'NOXREF';\r
option_text[computer_] := 'TARGET';\r
option_text[optimize_] := 'OPTIMIZE';\r
option_text[last_c_option_] := '';\r
option_text[dummy_c1] := '';\r
option_text[dummy_c2] := '';\r
option_text[test_] := 'TEST';\r
option_text[code_] := 'CODE';\r
option_text[nocode_] := 'NOCODE';\r
option_text[ixcheck_] := 'INDEX';\r
option_text[noixcheck_] := 'NOINDEX';\r
option_text[rangecheck_] := 'RANGE';\r
option_text[norangecheck_] := 'NORANGE';\r
option_text[accesscheck_] := 'ACCESS';\r
option_text[noaccesscheck_] := 'NOACCESS';\r
option_text[oflowcheck_] := 'OVERFLOW';\r
option_text[nooflowcheck_] := 'NOOVERFLOW';\r
option_text[set_] := 'SET';\r
option_text[pagewidth_] := 'PAGEWIDTH';\r
option_text[pagelength_] := 'PAGELENGTH';\r
option_text[last_cp_option_] := '';\r
option_text[dummy_cp1] := '';\r
option_text[dummy_cp2] := '';\r
option_text[dummy_cp3] := '';\r
option_text[dummy_cp4] := '';\r
option_text[dummy_cp5] := '';\r
option_text[eject_] := 'EJECT';\r
option_text[title_] := 'TITLE';\r
option_text[subtitle_] := 'SUBTITLE';\r
option_text[liston_] := 'LISTON';\r
option_text[listoff_] := 'LISTOFF';\r
option_text[if_] := 'IF';\r
option_text[else_] := 'ELSE';\r
option_text[elseif_] := 'ELSEIF';\r
option_text[endif_] := 'ENDIF';\r
option_text[segment_] := 'SEGMENT';\r
option_text[version_] := 'VERSION';\r
option_text[include_] := 'INCLUDE';\r
option_text[default_] := 'DEFAULT';\r
\r
for opt := succ(name_) to pred(last_cp_option_) do\r
i := insert_key(option_text[ opt ]);\r
\r
end; (** initoption_text **)\r
\r
\r
procedure initmoduletable(module_id:modulerange;str:string);\r
(*initiates moduletable, which holds the names of the modules*)\r
var\r
a: string[12];\r
\r
begin\r
a := 'initmoduletb';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
moduletable[module_id] := str;\r
end;\r
\r
function findmodule(param:string):modulerange;\r
(*searches the moduletable to find the modulerange corresponding to*)\r
(*a given modulename*)\r
var\r
a: string[12];\r
pos,step:modulerange;\r
begin\r
a := 'findmodule';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
pos := exceptq;\r
step := pass0;\r
while step <> exceptq do\r
begin\r
if equalname(param,moduletable[step]) then pos := step;\r
step := succ(step);\r
end;\r
if pos = exceptq then\r
begin\r
writeln(param);\r
call_error(8);\r
(*wrong modulename in option*)\r
end\r
else findmodule := pos;\r
end;\r
\r
\r
function findvalue(param:string):integer;\r
(*converts a string to a value*)\r
var\r
a: string[12];\r
step: byte;\r
val:longint;\r
ch: char;\r
fac: word;\r
accept_ch: char;\r
begin\r
a := 'findvalue';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
val := 0;\r
fac:=10;\r
ch:=param[length(param)];\r
if (ch='h') or (ch='H') then\r
begin\r
accept_ch:=chr(ord('0')+15);\r
fac:=16;\r
delete(param,length(param),1);\r
end else accept_ch:='9';\r
for step := 1 to length(param) do\r
begin\r
ch := param[step];\r
if ('a'<=ch) and (ch<='f') then ch:=chr(ord('9')+1+ord(ch)-ord('a'));\r
if ('A'<=ch) and (ch<='F') then ch:=chr(ord('9')+1+ord(ch)-ord('A'));\r
\r
if (ch >= '0') and (ch <= accept_ch) then\r
begin\r
if val>6553(*3276*) then val:=maxword + 1\r
else\r
val := val*fac + (ord(ch) - ord('0'));\r
end\r
else\r
call_error(9);\r
(* illegal character in parameter-value *)\r
end;\r
if val>maxword then\r
begin\r
warning(pass1,139);\r
(* parameter value in call line to large *)\r
val:=maxword;\r
end;\r
\r
findvalue := val;\r
end;\r
\r
function findextension(param: string; var res: ext_type): boolean;\r
const\r
max_extlength = 3;\r
var\r
a: string[12];\r
stop,\r
found: boolean;\r
i: integer;\r
begin\r
a := 'findextensio';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
stop := false;\r
found := false;\r
res := co1;\r
\r
while not stop do\r
begin\r
found := true;\r
for i := 1 to max_extlength do\r
found := found and (param[i] = extension[res,i]);\r
\r
if (not found) and (res < cmd) then\r
res := succ(res)\r
else\r
stop := true;\r
\r
end; (* while *)\r
\r
findextension := found;\r
\r
end; (* findextension *)\r
\r
procedure add_stdenvir;\r
var\r
a: string[12];\r
fstr: string;\r
begin\r
a := 'add_stdenvir';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
no_of_files := 1;\r
(** RTPstdenvir is inserted as the first file in the list of callparams**)\r
\r
fstr:= rtpstdenv;\r
\r
with callparams[no_of_files] do\r
begin\r
filename := fstr;\r
end;\r
end; (* add_rtpstdenvir *)\r
\r
(****************************************************)\r
(*#BEGINTEST\r
procedure test_argument(d:byte; s:string; key:byte; e:word);\r
var\r
a: string[12];\r
i:integer;\r
begin\r
a := 'test_argumen';\r
writeln('delimiter: ', chr(d));\r
write( 'param: ');\r
writeln(s);\r
writeln('keyno: ', key:3);\r
writeln('err: ', e);\r
end;\r
(*ENDTEST#*)\r
(***************************************************)\r
\r
procedure param_option(opt: option_tokens);\r
var\r
a: string[12];\r
hfname: string;\r
testname: string;\r
i,value : integer;\r
begin\r
a := 'param_option';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
if (opt >= vpagesize_) and (opt <= hashsize_) then\r
begin\r
delimiter := get_argument(next_param, key, error);\r
value := findvalue(next_param);\r
end;\r
\r
case opt of\r
\r
computer_:\r
begin\r
delimiter := get_argument(next_param,key,error);\r
hfname:= 'I86' (*'PI3'*);\r
if equalname(next_param,hfname) then computer:=pi3 else\r
begin\r
hfname:= 'PARTNER';\r
if equalname(next_param,hfname) then computer:=partner else\r
begin\r
hfname:= 'TA'(*'RC5000'*);\r
if equalname(next_param,hfname) then computer:=rc5000 else\r
begin\r
hfname:= 'RC3502';\r
if equalname(next_param,hfname) then computer:= rc3502 else\r
begin\r
hfname:='OLDPI3';\r
if equalname(next_param,hfname) then computer:= oldpi3 else\r
call_error(11);\r
end;\r
end;\r
end;\r
end;\r
CASE computer of\r
RC5000 :\r
BEGIN\r
IF Call_Options.Loadstr = RtpStdEnv THEN\r
BEGIN\r
Call_Options.Loadstr := RtpStd50Env;\r
END;\r
IF CallParams[1].filename = RtpStdEnv THEN\r
Callparams[1].Filename := RtpStd50Env;\r
RtpStdEnv := RtpStd50Env;\r
\r
END;\r
RC3502 :\r
BEGIN\r
IF Call_Options.Loadstr = RtpStdEnv THEN\r
BEGIN\r
Call_Options.Loadstr := RtpStd35Env;\r
END;\r
IF CallParams[1].filename = RtpStdEnv THEN\r
Callparams[1].Filename := RtpStd35Env;\r
RtpStdEnv := RtpStd35Env;\r
\r
END;\r
oldpi3 :\r
BEGIN\r
IF Call_Options.Loadstr = RtpStdEnv THEN\r
BEGIN\r
Call_Options.Loadstr := RtpStdoEnv;\r
END;\r
IF CallParams[1].filename = RtpStdEnv THEN\r
Callparams[1].Filename := RtpStdoEnv;\r
RtpStdEnv := RtpStdoEnv;\r
\r
END;\r
ELSE\r
END;\r
end;\r
\r
optimize_: begin\r
delimiter := get_argument(next_param,key,error);\r
optimize := findvalue(next_param);\r
end;\r
\r
start_: begin\r
delimiter := get_argument(next_param,key,error);\r
active_module := findmodule(next_param);\r
if (active_module < pass1) or (active_module > pass4) then\r
errormsg( active_module, 111) else\r
begin\r
load_tab:= active_module <> pass1;\r
if not load_tab then\r
begin\r
hfname:= rtpstdenv;\r
if not file_exist(hfname) then file_missing(rtpstdenv);\r
end;\r
call_options.loadcode:= 2;\r
end;\r
if call_options.savecode then active_module:=pass1;\r
end;\r
\r
stop_: begin\r
delimiter := get_argument(next_param,key,error);\r
if not call_options.savecode then\r
stop_module := findmodule(next_param);\r
end;\r
\r
test_: begin\r
delimiter := ord(',');\r
while (delimiter = ord(',')) or (delimiter = ord(' ')) do\r
begin\r
delimiter := get_argument(next_param,key,error);\r
if (delimiter = ord('=')) or (delimiter = ord(' ')) then\r
begin\r
testmodule := findmodule(next_param);\r
delimiter := get_argument(next_param,key,error);\r
case testmodule of\r
mpa: begin\r
testmpa := findvalue(next_param);\r
assign(testoutput,'con');\r
rewrite(testoutput);\r
if testmpa>=10000 then testmpa:=0;\r
end;\r
pass1: testpass1 := findvalue(next_param);\r
pass2: testpass2 := findvalue(next_param);\r
pass3: testpass3 := findvalue(next_param);\r
pass4: testpass4 := findvalue(next_param);\r
listh: testlist := findvalue(next_param);\r
vmm: original_testvmm := findvalue(next_param);\r
pass0: begin\r
testpass0 := findvalue(next_param);\r
if testpass0 >= 10000 then\r
begin\r
assign(testoutput,'con');\r
rewrite(testoutput);\r
end\r
else\r
begin\r
with callparams[no_of_files] do\r
change_ext(filename,hfname,'ts0');\r
testname:= hfname;\r
assign(testoutput,testname);\r
rewrite(testoutput);\r
end;\r
testpass0 := testpass0 mod 10000;\r
pass0test := (testpass0 mod 256) > 0;\r
helptestpass0 := testpass0 div 256;\r
if odd(helptestpass0) (* test bit 8 *) then teststh:=true;\r
helptestpass0 := helptestpass0 div 2;\r
if odd(helptestpass0) (* test bit 9 *) then teststh:=false;\r
helptestpass0 := helptestpass0 div 2;\r
if odd(helptestpass0) (* test bit 10 *)\r
then testvmmupdate:=true;\r
helptestpass0 := helptestpass0 div 2;\r
if odd(helptestpass0) (* test bit 11 *) then testvmmupdate:=false;\r
end (** pass0 **)\r
\r
else\r
call_error(8);\r
(* wrong modulename in option *)\r
end;\r
end\r
else\r
call_error(7);\r
(* '=' expected **)\r
\r
end;(*while*)\r
end;(*test*)\r
\r
survive_: \r
begin\r
delimiter := ord(',');\r
\r
while (delimiter = ord(',')) or (delimiter = ord(' ')) do\r
begin\r
delimiter := get_argument(next_param,key,error);\r
if findextension(next_param,extres) then\r
survival[extres] := true\r
else\r
begin\r
writeln(next_param);\r
call_error(10);\r
(* Illegal file-extension *)\r
end;\r
end; (* while ',' *)\r
\r
end; (* survive *)\r
\r
set_: begin\r
delimiter := ord(',');\r
while (delimiter = ord(',')) or (delimiter=ord(' ')) do\r
begin\r
delimiter := get_argument(next_param,key,error);\r
if (delimiter = ord('=')) or (delimiter=ord(' ')) then\r
begin\r
(* creating and (or) assigning value to switch *)\r
switchname := next_param;\r
delimiter := get_argument(next_param,key,error);\r
i := findvalue(next_param);\r
\r
add_switch(switchname,i);\r
end\r
else\r
call_error(7);\r
(** '=' expected **)\r
end; (* while *)\r
end; (* setsw *)\r
\r
\r
save_:\r
begin\r
delimiter := get_argument(next_param,key,error);\r
with call_options do\r
begin\r
savestr := next_param;\r
savecode:= true;\r
if save_tab then begin\r
saveafter[pass1]:=false;\r
saveafter[pass2]:=false;\r
saveafter[pass3]:=false;\r
end;\r
stop_module:=pass2;\r
active_module:=pass1;\r
end;\r
save_tab:= true;\r
end;\r
\r
load_:\r
begin\r
delimiter := get_argument(next_param,key,error);\r
with call_options do\r
begin\r
if not start then\r
begin\r
loadstr := next_param;\r
loadcode:= 1;\r
load_tab:= true;\r
end else errormsg( active_module, 111);\r
end;\r
end;\r
\r
saveafter_:\r
begin\r
delimiter := get_argument(next_param,key,error);\r
if not call_options.savecode then\r
begin\r
p := findmodule(next_param);\r
if (p < pass1) or ( p > pass3) then errormsg(active_module, 111) else\r
begin\r
call_options.saveafter[ p ]:= true;\r
save_tab:= true;\r
extres:= dummy;\r
for i:= ord(pass1) to ord(p) do extres:= succ(extres);\r
survival[ extres ]:= true;\r
end;\r
end;\r
end;\r
\r
memsw_: begin\r
delimiter := get_argument(next_param, key, error);\r
testmemwholes := findvalue(next_param) <> 0;\r
mempooltest := true;\r
end;\r
\r
\r
\r
vpagesize_: vpagesize := value;\r
\r
vpageres_: if value > 2 then\r
vmaxresidents := value;\r
\r
npagesize_: npagesize := value;\r
\r
npageres_: nmaxresidents := value;\r
\r
hashsize_: hashsize := value;\r
\r
time_: begin\r
timetest := true;\r
delimiter:=ord(')');\r
end\r
\r
else;\r
end; (** case *)\r
\r
if not (delimiter = ord(')')) then\r
begin\r
writeln(option_text[opt] : 12);\r
call_error(6);\r
(** ')' missing **)\r
end;\r
end; (** param_option **)\r
\r
procedure add_fileoption(opt: option_tokens; sourceno: integer);\r
var\r
a: string[12];\r
begin\r
a := 'add_fileopti';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
with call_options do\r
case opt of\r
\r
iflist_ :\r
begin\r
iflist:= true;\r
listing:= 2;\r
end;\r
\r
code_: begin code := true; make_code:=true; end;\r
\r
nocode_: code := false;\r
\r
ixcheck_: indexcheck := true;\r
\r
noixcheck_: indexcheck := false;\r
\r
rangecheck_: rangecheck := true;\r
\r
norangecheck_: rangecheck := false;\r
\r
accesscheck_: accesscheck := true;\r
\r
noaccesscheck_: accesscheck := false;\r
\r
oflowcheck_: overflowcheck := true;\r
\r
nooflowcheck_: overflowcheck := false;\r
\r
liston_: listing := 4;\r
\r
listoff_: listing := 3;\r
\r
list_: listing := 2;\r
\r
nolist_: listing := 1;\r
\r
xref_: xref := 2;\r
\r
noxref_: xref := 1;\r
\r
\r
break_: optionbreakpoint := true;\r
\r
ind_: indent:=1;\r
noind_: indent:=2;\r
\r
mark_: mark:=1;\r
nomark_: mark:=2;\r
\r
ownkey_: keyword:=1;\r
lckey_: keyword:=2;\r
uckey_: keyword:=3;\r
\r
ownid_: ident:=1;\r
lcid_: ident:=2;\r
ucid_: ident:=3;\r
\r
createsize_:\r
begin\r
(*if currval>=4096 then createsize:=maxword\r
else createsize:= currval * 16;*)\r
(* convert to paragrafs *)\r
createsize := currval;\r
end;\r
\r
codesize_:\r
begin\r
pagesize3502:= currval;\r
end;\r
\r
pagewidth_: pagewidth := currval;\r
pagelength_: pagelength := currval;\r
spacing_: spacing := currval\r
\r
else;\r
end; (*case*)\r
end; (** add_fileoption**)\r
\r
procedure fname_read;\r
var\r
a: string[12];\r
index: integer;\r
begin\r
\r
a := 'fname_read';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
if no_of_files = maxcallparams then\r
call_error(3); (** too many inputfiles in call **)\r
no_of_files := no_of_files + 1;\r
with callparams[no_of_files] do\r
begin\r
filename := next_param;\r
for index:=1 to length(filename) do\r
if filename[index]='\' then filename[index]:='/';\r
if not file_exist(filename) then\r
begin\r
writeln;\r
writeln(filename);\r
call_error(2); (** inputfile does not exist **)\r
end;\r
end;\r
end; (* fname-read *)\r
\r
begin (* reads the parameters of the call of the compiler*)\r
(* using specially designed external procedures *)\r
(* procedure init_argument : defines a table which *)\r
(* is later initialized with the different optiontypes*)\r
(* procedure insert_key, which is used to initalize the*)\r
(* table with the allowed options *)\r
(* function get_argument(param,key,error):byte, which*)\r
(* reads next parameter, returns the key value, if the*)\r
(* parameter is an option, and returns the delimiter*)\r
(* which follows the parameter as the function result*)\r
\r
a:= 'readcallparm';\r
(******************)\r
\r
(*#BEGINTEST\r
if pass0test then\r
writeln(testoutput, a : 12);\r
(*ENDTEST#*)\r
\r
(*change_priority;*)\r
\r
no_of_files := 0; \r
\r
initmoduletable(pass0,'PASS0');\r
initmoduletable(pass1,'PASS1');\r
initmoduletable(pass2,'PASS2');\r
initmoduletable(pass3,'PASS3');\r
initmoduletable(pass4,'PASS4');\r
initmoduletable(listh,'LISTH');\r
initmoduletable(sth ,'STH');\r
initmoduletable(vmm,'VMM');\r
initmoduletable(mpa,'MPA');\r
\r
initoption;\r
initoption_text;\r
\r
\r
(** fetch file containig standardenvironment **)\r
add_stdenvir;\r
\r
delimiter := space;\r
\r
while delimiter <> creturn (*end of call*) do\r
begin\r
(*read next parameter*)\r
delimiter := get_argument(next_param,key,error);\r
\r
if length(next_param) > 0 then\r
(** handle parameter **)\r
case option_tokens(key) of\r
\r
name_: begin\r
fname_read;\r
end;(*name*)\r
\r
computer_,\r
optimize_,\r
start_,\r
stop_,\r
memsw_,\r
set_,\r
survive_,\r
vpagesize_,\r
vpageres_,\r
npagesize_,\r
npageres_,\r
hashsize_,\r
save_,\r
load_,\r
saveafter_,\r
test_: if delimiter = ord('(') then param_option(option_tokens(key))\r
else fname_read;\r
time_: param_option(option_tokens(key));\r
\r
code_,\r
\r
nocode_,\r
\r
ixcheck_,\r
\r
noixcheck_,\r
\r
rangecheck_,\r
\r
norangecheck_,\r
\r
accesscheck_,\r
\r
noaccesscheck_,\r
\r
oflowcheck_,\r
\r
nooflowcheck_,\r
\r
liston_,\r
\r
listoff_,\r
\r
list_,\r
\r
nolist_,\r
\r
iflist_,\r
\r
break_,\r
\r
xref_, noxref_,\r
\r
ind_, noind_,\r
mark_, nomark_,\r
ownkey_, lckey_, uckey_,\r
ownid_, lcid_, ucid_: add_fileoption(option_tokens(key), no_of_files);\r
\r
createsize_,\r
codesize_,\r
pagewidth_,\r
pagelength_,\r
spacing_:\r
if delimiter = ord('(') then\r
begin\r
curropt := option_tokens(key);\r
delimiter := get_argument(next_param, key, error);\r
currval := findvalue(next_param);\r
if not (delimiter = ord(')')) then\r
call_error(6);\r
(** ')' missing **)\r
add_fileoption(curropt, no_of_files);\r
end\r
else call_error(5);\r
(** parameter missing **)\r
\r
else\r
begin\r
write(option_text[option_tokens(key)] : 12); writeln;\r
call_error(4);\r
(** parameter may NOT appear in command-line! **)\r
end;\r
end; (*case*)\r
\r
end; (*while*)\r
\r
if (no_of_files <= 1) and not call_options.savecode then\r
call_error(1);\r
(** no inputfile in compilercall **)\r
CASE computer OF\r
partner,pi3,oldpi3 :\r
add_switch('TARGET',110);\r
RC3502:\r
add_switch('TARGET',120);\r
RC5000:\r
add_switch('TARGET',130);\r
end;\r
Add_switch('I86',110);\r
(*Add_Switch('PARTNER', 1);*)\r
Add_Switch('TA', 130);\r
Add_Switch('RC3502', 120);\r
(*Add_Switch('OLDPI3', 4);*)\r
{$IFDEF rtp86}\r
Add_Switch('LANGUAGE' ,220);\r
{$ELSE}\r
Add_Switch('LANGUAGE' ,230);\r
{$ENDIF}\r
Add_Switch('RTP2111',240);\r
Add_Switch('RTP',230);\r
Add_Switch('RTP86',220);\r
Add_Switch('RTP3502',210);\r
end; (*readcallparams*)\r
\r
begin (** main pass0 **)\r
\r
computer:= pi3;\r
optimize:= 0;\r
testmpa := -1;\r
testpass0 := -1;\r
testpass1 := -1;\r
testpass2 := -1;\r
testpass3 := -1;\r
testpass4 := -1;\r
original_testvmm := -1;\r
testvmm := -1;\r
testlist := -1;\r
mempooltest := false;\r
testmemwholes := false;\r
pass0test := false;\r
timetest := false;\r
filebufferalloc := false;\r
\r
teststh := false;\r
teststhsearch:= false;\r
testvmmupdate:= false;\r
\r
switchstart := nil;\r
switchpoint := nil;\r
\r
(** VMM - variable **)\r
vpagesize := 4096;\r
\r
(** NTH - variables **)\r
npagesize := 1024;\r
\r
vmaxresidents := (startmemavail - 70000) div (vpagesize + npagesize);\r
\r
nmaxresidents := vmaxresidents;\r
\r
hashsize := 1013;\r
\r
\r
(** Initializing structure holding possible file-extensions. **)\r
extension[dummy] := '.';\r
extension[co1] := 'M01';\r
extension[co2] := 'M02';\r
extension[co3] := 'M03';\r
\r
extension[co4] := 'POF';\r
extension[cls] := 'CLS';\r
extension[tbf] := 'TBF';\r
extension[tsf] := 'TSF';\r
extension[lst] := 'LST';\r
extension[err] := 'ERR';\r
extension[cmd] := 'CMD';\r
\r
vmmextension := 'A86';\r
nthextension := 'N86';\r
cobextension := 'M86';\r
\r
survival[dummy] := false;\r
\r
(** Initializing structure telling which file-extensions **)\r
(** to survive compilation. **)\r
survival[co1] := false;\r
survival[co2] := false;\r
survival[co3] := false;\r
survival[co4] := true;\r
survival[cls] := false;\r
survival[tbf] := false;\r
survival[tsf] := false;\r
survival[lst] := true;\r
survival[err] := false;\r
survival[cmd] := false;\r
\r
(** extensions used in save_files **)\r
ext3[pass1]:= 'A';\r
ext3[pass2]:= 'B';\r
ext3[pass3]:= 'C';\r
\r
(** initialization of STH variables **)\r
\r
first_prog:= true;\r
list_start:= false;\r
forward_exist:= false;\r
list_kind:= canonymous;\r
st_double:= enthextension + 6;\r
anonymousname:= '?';\r
new(anonymousstr);\r
anonymousstr^:= anonymousname;\r
\r
(** initialize STHTABLE node_length **)\r
\r
for c:= carraytype to cword do node_length[ c ]:= minlength+30;\r
\r
node_length[carraytype] := minlength + 18 + 11;\r
node_length[cconstant] := minlength + 5 + 22;\r
node_length[cendlevel] := levelrec_length;\r
node_length[cforstat] := minlength + 7 + 18;\r
node_length[cfunction] := minlength + 36 + 23;\r
node_length[cinspectparam]:= minlength + 7 + 18;\r
node_length[cLockVar] := minlength + 7 + 18; (* hha 30 7 85 *)\r
node_length[clabel] := minlength + 12 + 14;\r
node_length[cprocedure] := minlength + 36 + 21;\r
node_length[cprogram] := minlength + 36 + 23;\r
node_length[crecfield] := minlength + 17 + 20;\r
node_length[crecordtype] := minlength + 20 + 16;\r
node_length[cscalar] := minlength + 2 + 27;\r
node_length[cscalarelem] := minlength + 5 + 22;\r
node_length[csettype] := minlength + 12 + 18;\r
node_length[cshared] := minlength + 7 + 18;\r
node_length[csharedparam] := minlength + 7 + 18;\r
node_length[cstrucconst] := minlength + 9 + 15;\r
node_length[cstrucelem] := minlength + 9 + 15;\r
node_length[csubrange] := minlength + 12 + 18;\r
node_length[ctype] := minlength + 36 + 22;\r
node_length[cvalueparam] := minlength + 7 + 18;\r
node_length[cvar] := minlength + 7 + 18;\r
node_length[cvarparam] := minlength + 7 + 18;\r
node_length[cwithvar] := minlength + 7 + 18;\r
node_length[cwithstat] := minlength + 7 + 18;\r
node_length[cexternal] := external_length;\r
node_length[cdeclaration] := declaration_length;\r
node_length[cnewline] := newline_length;\r
\r
\r
\r
with addr0type do\r
begin\r
addrtype_mode:= direct;\r
level:= 0;\r
offset:= 0;\r
dopeoffset:= 0;\r
end;\r
\r
\r
readcallparams; (*read the compiler call line*)\r
\r
CASE Computer of\r
RC5000 :\r
BEGIN\r
extension[co4] := 'TAH';\r
vmmextension := 'A50';\r
nthextension := 'N50';\r
cobextension := 'M50';\r
node_length[cfunction] := minlength + 36 + 23 + 8;\r
node_length[clabel] := minlength + 12 + 14 + 4;\r
node_length[cprocedure] := minlength + 36 + 23 + 8;\r
node_length[cprogram] := minlength + 36 + 23 + 8;\r
node_length[ctype] := minlength + 36 + 22 + 8;\r
\r
errorsize := 0;\r
booleansize := 1;\r
charsize := 1;\r
integersize := 4;\r
realsize := 4;\r
bytesize := 1;\r
wordsize := 4;\r
mailboxsize := 16;\r
referencesize := 12;\r
poolsize := 24;\r
processsize := 8;\r
portsize := 4;\r
chainsize := 20;\r
pointersize := 4;\r
doublesize := 4;\r
END;\r
RC3502 :\r
BEGIN\r
extension[co4] := 'T22';\r
\r
vmmextension := 'A22';\r
nthextension := 'N22';\r
cobextension := 'M22';\r
\r
node_length[cfunction] := minlength + 36 + 23 + 8;\r
node_length[clabel] := minlength + 12 + 14 + 4;\r
node_length[cprocedure] := minlength + 36 + 23 + 8;\r
node_length[cprogram] := minlength + 36 + 23 + 8;\r
node_length[ctype] := minlength + 36 + 22 + 8;\r
errorsize := 0;\r
booleansize := 1;\r
charsize := 1;\r
integersize := 2;\r
realsize := 4;\r
bytesize := 1;\r
wordsize := 2;\r
mailboxsize := 7;\r
referencesize := 7;\r
poolsize := 7;\r
processsize := 6;\r
portsize := 27;\r
chainsize := 8;\r
pointersize := 3;\r
doublesize := 4;\r
END;\r
ELSE\r
BEGIN\r
errorsize := 0;\r
booleansize := 1;\r
charsize := 1;\r
integersize := 2;\r
realsize := 4;\r
bytesize := 1;\r
wordsize := 2;\r
mailboxsize := 8;\r
referencesize := 8;\r
poolsize := 13;\r
processsize := 6;\r
portsize := 7;\r
chainsize := 12;\r
pointersize := 4;\r
doublesize := 4;\r
END;\r
END;\r
mpatest := testmpa >= 0;\r
\r
\r
open_testoutvmm;\r
\r
init_pagingsystem(callparams[no_of_files].filename);\r
\r
if max_fragment > vpagesize then max_data_size:= vpagesize - minlength\r
else max_data_size:= max_fragment - minlength;\r
\r
\r
(* initialize symbol table *)\r
if not load_tab then init_sth;\r
type_kind:=false;\r
save_typekind:=false;\r
currant_rec:= st_nilladdr;\r
\r
\r
end;\r
end.\r
«eof»