|
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: 39023 (0x986f)
Types: TextFile
Names: »NTHUNIT.PAS«
└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
└─⟦this⟧ »RTP\NTHUNIT.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\NTHUNIT.PAS«
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\NTHUNIT.PAS«
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
└─⟦this⟧ »NTHUNIT.PAS«
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
└─⟦this⟧ »RTP\NTHUNIT.PAS«
{$O+,F+}\r
(* ---------- name table conversion handler ---------- *)\r
\r
UNIT nthunit;\r
\r
INTERFACE\r
USES pscplm, mpaunit, sthunit, vmmdump, vmmunit;\r
\r
FUNCTION nthcreate(VAR name: string;\r
max_residents, page_size, use_hash_size: WORD): WORD;\r
\r
FUNCTION nthget(VAR name: STRING; max_residents: WORD;VAR str: STRING): WORD;\r
\r
FUNCTION nthdelete: WORD;\r
\r
FUNCTION nthsave(VAR str: string): WORD;\r
\r
FUNCTION nthcrosssort(st_table: ptr_tbl_dscr_type;\r
VAR addr: st_address;\r
stop_va_high, stop_va_low: WORD): WORD;\r
\r
FUNCTION nthextend(VAR spix: WORD; VAR name: string): WORD;\r
\r
FUNCTION nthretrieve(spix: WORD; VAR name_ptr: ptr_string): WORD;\r
\r
FUNCTION nthbeginlevel: WORD;\r
\r
FUNCTION nthendlevel: WORD;\r
\r
FUNCTION nthbeginprogram: WORD;\r
\r
FUNCTION nthendprogram: WORD;\r
\r
FUNCTION nthinsertsymbol(spix, va_high, va_low: WORD): WORD;\r
\r
FUNCTION nthfindsymbol(spix: WORD; VAR va: st_address): WORD;\r
\r
\r
IMPLEMENTATION\r
\r
const\r
e_ok = 0;\r
e_fexist = 32;\r
e_fnexist = 33;\r
e_vmm_tbl_exist = 8208;\r
e_vmm_tbl_nexist = 8209;\r
e_vmm_fexist = 8210;\r
e_vmm_va_nexist = 8211;\r
e_vmm_size = 8212;\r
e_vmm_overflow = 8213;\r
e_vmm_underflow = 8214;\r
e_vmm_nresident = 8215;\r
e_vmm_memory = 8216;\r
e_vmm_va_overflow = 8217;\r
e_vmm_version = 8218;\r
\r
(* !!! TURBO !!! *)\r
max_word = 65535;\r
\r
\r
CONST\r
e_string = 8200;\r
e_exist = 8198;\r
e_nexist = 8199;\r
\r
TYPE\r
rec_type=RECORD\r
va: st_address;\r
spix: WORD;\r
str: STRING;\r
END;\r
\r
hash_rec_type =\r
RECORD\r
va :st_address;\r
spix : WORD;\r
END;\r
hash_table_type = ARRAY[0..15999] OF st_address;\r
st_table_type = ARRAY[0..127] OF st_address;\r
rec_table_type = ARRAY[0..84] OF hash_rec_type;\r
ptr_st_address = ^st_address;\r
ptr_st_table_type = ^st_table_type;\r
ptr_rec_table_type = ^rec_table_type;\r
VAR\r
hash_size,\r
hash_mask,\r
last_spix,\r
stack_offset,\r
save_on_stack,\r
last_program_niv,\r
end_program_pops: WORD;\r
\r
hash_table_ptr: ^ hash_table_type;\r
nth_table: ptr_tbl_dscr_type;\r
spix_to_nt: st_address;\r
nt_ptr: ptr_st_table_type;\r
nt_va: st_address;\r
spix_to_st: array[0..7] of st_address;\r
stack_page: st_address;\r
p_stack_page: st_address;\r
e_stack_page: st_address;\r
p_stack_offset: WORD;\r
e_stack_offset: WORD;\r
program_niv: BYTE;\r
\r
\r
FUNCTION find_node(spix: WORD; VAR node_ptr: ptr_st_address): WORD;\r
VAR\r
st_ptr: ptr_st_table_type;\r
offset, page, i_page, exc: WORD;\r
BEGIN\r
IF spix>last_spix THEN exc:= e_nexist\r
ELSE BEGIN\r
offset:= spix AND 127; (*07FH*)\r
page:= spix SHR 7;\r
i_page:= page SHR 3;\r
page:= page AND 7;\r
exc:= vmmretrieve(nth_table^,spix_to_st[page].va_high,\r
spix_to_st[page].va_low,FALSE,i_page=0,st_ptr);\r
WHILE (i_page>0) AND (exc=0) DO\r
BEGIN\r
exc:= vmmretrieve(nth_table^,st_ptr^[127].va_high,st_ptr^[127].va_low,\r
FALSE,i_page=1,st_ptr);\r
i_page:= i_page-1;\r
END;\r
END;\r
node_ptr:= @st_ptr^[offset];\r
(*#BEGINTEST\r
IF (testvmm>=0) AND (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH ERR Find node');\r
vmmdumpword(' EXC =',exc);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
find_node:= exc;\r
END; (* find_node *)\r
\r
FUNCTION set_sort_spix(f_spix, l_spix, w: WORD): WORD;\r
VAR\r
node_ptr: ptr_st_address;\r
exc: WORD;\r
BEGIN\r
WHILE f_spix<=l_spix DO\r
BEGIN\r
exc:= find_node(f_spix,node_ptr);\r
IF exc=0 THEN node_ptr^.va_low:= w\r
ELSE f_spix:= l_spix;\r
f_spix:= f_spix+1;\r
IF (f_spix AND 127) = 127 then f_spix:= f_spix+1;\r
END;\r
set_sort_spix:= exc;\r
END; (* set_sort_spix *)\r
\r
\r
FUNCTION sort_spix: WORD;\r
VAR\r
spix,\r
compare_spix,\r
right_spix,\r
return_spix,\r
next_spix: WORD;\r
node_ptr: ptr_st_address;\r
new_name_ptr: ptr_string;\r
n_name: STRING;\r
c_name_ptr: ptr_string;\r
less_than: BOOLEAN;\r
exc: WORD;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Sort spix');\r
vmmdumpword(' SPIX =',last_spix);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
exc:= find_node(1,node_ptr);\r
IF exc=0 THEN\r
BEGIN\r
node_ptr^.va_low:= 0;\r
node_ptr^.va_high:= 0;\r
spix:= 2;\r
WHILE spix<=last_spix DO\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN vmmdumpword(' SPIX =',spix);\r
(*ENDTEST#*)\r
exc:= find_node(spix,node_ptr);\r
IF node_ptr^.va_low=0 THEN\r
BEGIN\r
IF exc=0 THEN\r
BEGIN\r
node_ptr^.va_low:= 0;\r
node_ptr^.va_high:= 0;\r
compare_spix:= 1;\r
exc:= nthretrieve(spix,new_name_ptr);\r
n_name:= new_name_ptr^;\r
END;\r
IF exc<>0 THEN spix:= max_word\r
ELSE WHILE compare_spix<>0 DO\r
BEGIN\r
exc:= nthretrieve(compare_spix,c_name_ptr);\r
IF exc<>0 THEN spix:= max_word\r
ELSE BEGIN\r
less_than:= n_name < c_name_ptr^;\r
exc:= find_node(compare_spix,node_ptr);\r
IF exc<>0 THEN\r
BEGIN\r
compare_spix:= 0;\r
spix:= max_word;\r
END ELSE\r
BEGIN\r
IF less_than THEN\r
BEGIN\r
compare_spix:= node_ptr^.va_low;\r
IF compare_spix=0 THEN node_ptr^.va_low:= spix;\r
END ELSE\r
BEGIN\r
compare_spix:= node_ptr^.va_high;\r
IF compare_spix=0 THEN node_ptr^.va_high:= spix;\r
END;\r
END;\r
END;\r
END;\r
END;\r
spix:= spix+1;\r
IF (spix AND 127) = 127 THEN spix:= spix+1;\r
END;\r
END;\r
(* convert binary tree to sorted list *)\r
(* l: next spix, r: 0 *)\r
(* spix 0's node_ptr^.va_low is first spix *)\r
(*#BEGINTEST\r
IF testvmm>0 THEN \r
BEGIN\r
vmmdumproutine('NTH -1- Sort spix');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
IF exc=0 THEN\r
BEGIN\r
right_spix:= 0;\r
return_spix:= 0;\r
spix:= 1;\r
WHILE (exc=0) AND (spix<>0) DO\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN vmmdumpword(' SPIX =',spix);\r
(*ENDTEST#*)\r
exc:= find_node(spix,node_ptr);\r
WHILE (exc=0) AND (node_ptr^.va_low<>0) DO\r
BEGIN\r
next_spix:= node_ptr^.va_low;\r
node_ptr^.va_low:= return_spix;\r
return_spix:= spix;\r
spix:= next_spix;\r
exc:= find_node(spix,node_ptr);\r
END;\r
IF exc=0 THEN\r
BEGIN\r
node_ptr^.va_low:= return_spix;\r
exc:= find_node(right_spix,node_ptr);\r
END;\r
IF exc=0 THEN\r
BEGIN\r
node_ptr^.va_low:= spix;\r
exc:= find_node(spix,node_ptr);\r
END;\r
WHILE (exc=0) AND (node_ptr^.va_high=0) AND (spix<>0) DO\r
BEGIN\r
spix:= node_ptr^.va_low;\r
exc:= find_node(spix,node_ptr);\r
END;\r
IF (exc=0) AND (spix<>0) THEN\r
BEGIN\r
next_spix:= node_ptr^.va_high;\r
node_ptr^.va_high:= 0;\r
right_spix:= spix;\r
return_spix:= node_ptr^.va_low;\r
spix:= next_spix;\r
END;\r
END;\r
END; (* end of converting *)\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Sort spix');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
\r
sort_spix:= exc;\r
END; (* sort_spix *)\r
\r
FUNCTION dump_sort_spix: WORD;\r
VAR\r
spix: WORD;\r
next_spix: WORD;\r
node_ptr: ptr_st_address;\r
name_ptr: ptr_string;\r
exc: WORD;\r
BEGIN\r
vmmdumpnewline;\r
vmmdumpstring('SORTED SPIX TABLE');\r
vmmdumpnewline;\r
exc:= set_sort_spix(1,last_spix,0);\r
IF exc=0 THEN exc:= sort_spix;\r
IF exc=0 THEN exc:= find_node(0,node_ptr);\r
spix:= node_ptr^.va_low;\r
WHILE (exc=0) AND (spix<>0) DO\r
BEGIN\r
exc:= find_node(spix,node_ptr);\r
IF exc=0 THEN\r
BEGIN\r
vmmdumpskip;\r
vmmdumpword(' SPIX =',spix);\r
IF node_ptr^.va_high<>0 THEN vmmdumpword(' HIGH =',node_ptr^.va_high);\r
next_spix:= node_ptr^.va_low;\r
exc:= nthretrieve(spix,name_ptr);\r
END;\r
IF exc=0 THEN\r
BEGIN\r
vmmdumpstring(name_ptr^);\r
spix:= next_spix;\r
END;\r
vmmdumpnewline;\r
END;\r
vmmdumpnewline;\r
vmmdumpnewline;\r
dump_sort_spix:= exc;\r
END; (* dump_sort_spix *)\r
\r
FUNCTION nthcrosssort(st_table: ptr_tbl_dscr_type; VAR addr: st_address;\r
stop_va_high,stop_va_low: WORD): WORD;\r
TYPE decl_type= RECORD\r
kind: BYTE;\r
va: st_address;\r
spix: WORD;\r
END;\r
VAR\r
next_addr: st_address;\r
temp_addr: st_address;\r
decl_ptr: ^decl_type;\r
node_ptr: ptr_st_address;\r
exc: WORD;\r
BEGIN\r
exc:= set_sort_spix(1,last_spix,1);\r
IF exc=0 THEN\r
BEGIN\r
next_addr:= addr;\r
WHILE ((next_addr.va_low<>stop_va_low) OR\r
(next_addr.va_high<>stop_va_high)) AND (exc=0) DO\r
BEGIN\r
exc:= vmmretrieve(st_table^,next_addr.va_high,next_addr.va_low,\r
FALSE,FALSE,decl_ptr);\r
IF exc=0 THEN\r
BEGIN\r
next_addr:= decl_ptr^.va;\r
exc:= set_sort_spix(decl_ptr^.spix,decl_ptr^.spix,0);\r
END;\r
END;\r
END;\r
IF exc=0 THEN exc:= sort_spix;\r
IF exc=0 THEN\r
BEGIN\r
next_addr:= addr;\r
WHILE (next_addr.va_low<>stop_va_low) OR \r
(next_addr.va_high<>stop_va_high) DO\r
BEGIN\r
exc:= vmmretrieve(st_table^,next_addr.va_high,next_addr.va_low,\r
FALSE,TRUE,decl_ptr);\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
vmmdumproutine('NTH -1- Cross');\r
vmmdumpword(' SPIX =',decl_ptr^.spix);\r
vmmdumpva(next_addr.va_high,next_addr.va_low);\r
vmmdumpva(decl_ptr^.va.va_high,decl_ptr^.va.va_low);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
IF exc=0 THEN exc:= find_node(decl_ptr^.spix,node_ptr);\r
IF exc=0 THEN\r
BEGIN\r
temp_addr:= decl_ptr^.va;\r
decl_ptr^.va:= node_ptr^;\r
node_ptr^:= next_addr;\r
next_addr:= temp_addr;\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
vmmdumproutine('NTH -2- Cross');\r
vmmdumpword(' SPIX =',decl_ptr^.spix);\r
vmmdumpva(node_ptr^.va_high,node_ptr^.va_low);\r
vmmdumpva(next_addr.va_high,next_addr.va_low);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
END ELSE\r
BEGIN\r
next_addr.va_low:= stop_va_low;\r
next_addr.va_high:= stop_va_high;\r
END;\r
END;\r
next_addr:= addr;\r
IF ((next_addr.va_low<>stop_va_low) OR \r
(next_addr.va_high<>stop_va_high)) AND (exc=0) THEN\r
BEGIN\r
exc:= find_node(0,node_ptr);\r
IF exc=0 THEN exc:= find_node(node_ptr^.va_low,node_ptr);\r
WHILE (node_ptr^.va_high=0) AND (node_ptr^.va_low<=last_spix) AND\r
(node_ptr^.va_low>0) AND (exc=0)\r
DO exc:= find_node(node_ptr^.va_low,node_ptr);\r
IF exc=0 THEN exc:= vmmretrieve(st_table^,node_ptr^.va_high,node_ptr^.va_low,FALSE,TRUE,decl_ptr);\r
WHILE ((decl_ptr^.va.va_low<>0) OR (decl_ptr^.va.va_high<>0)) AND (exc=0) DO\r
BEGIN\r
IF (decl_ptr^.va.va_high=0) AND (decl_ptr^.va.va_low<=last_spix) THEN\r
BEGIN\r
exc:= find_node(decl_ptr^.va.va_low,node_ptr);\r
decl_ptr^.va:= node_ptr^;\r
END ELSE exc:= vmmretrieve(st_table^,decl_ptr^.va.va_high,decl_ptr^.va.va_low,FALSE,TRUE,decl_ptr);\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
vmmdumproutine('NTH -3- Cross');\r
vmmdumpword(' SPIX =',decl_ptr^.spix);\r
vmmdumpva(decl_ptr^.va.va_high,decl_ptr^.va.va_low);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
END;\r
IF exc=0 THEN\r
BEGIN\r
decl_ptr^.va.va_low:= stop_va_low;\r
decl_ptr^.va.va_high:= stop_va_high;\r
exc:= find_node(0,node_ptr);\r
END;\r
IF exc=0 THEN\r
BEGIN\r
exc:= find_node(node_ptr^.va_low,node_ptr);\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
vmmdumproutine('NTH -4- Cross');\r
vmmdumpva(node_ptr^.va_high,node_ptr^.va_low);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
WHILE (node_ptr^.va_high=0) AND (node_ptr^.va_low<=last_spix) AND (exc=0) DO\r
BEGIN\r
exc:= find_node(node_ptr^.va_low,node_ptr);\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
vmmdumproutine('NTH -4- Cross');\r
vmmdumpva(node_ptr^.va_high,node_ptr^.va_low);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
END;\r
addr:= node_ptr^;\r
END;\r
END;\r
END;\r
nthcrosssort:= exc;\r
END; (* nthcrosssort *)\r
\r
\r
FUNCTION nthcreate(VAR name: string;\r
max_residents, page_size, use_hash_size: WORD): WORD; \r
VAR\r
exc: WORD;\r
i: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E00) = $0600 THEN \r
BEGIN\r
vmmdumproutine('NTH --> Create');\r
vmmdumpword('MAXIMUM=',max_residents);\r
vmmdumpword(' SIZE =',page_size);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
program_niv:= 0;\r
FOR i:= 0 TO 7 DO\r
BEGIN\r
spix_to_st[i].va_low:= max_word;\r
spix_to_st[i].va_high:= max_word;\r
END;\r
hash_mask:= max_word;\r
hash_size:= use_hash_size;\r
IF use_hash_size<=1 THEN\r
BEGIN\r
IF use_hash_size=1 THEN hash_mask:= 4095 (*00FFFH*)\r
ELSE BEGIN\r
hash_size:= 201; (*000D3H*)\r
hash_mask:= 255; (*000FFH*)\r
END;\r
END ELSE\r
BEGIN\r
WHILE use_hash_size>=1 DO\r
BEGIN\r
hash_mask:= hash_mask SHL 1;\r
use_hash_size:= use_hash_size SHR 1;\r
END;\r
END;\r
hash_mask:= NOT hash_mask;\r
nth_table:= NIL;\r
exc:= vmmcreatetable(nth_table,name,max_residents,page_size);\r
IF exc=0 THEN\r
BEGIN\r
hash_table_ptr:= vmmallocate(4*hash_size,exc);\r
IF exc=0 THEN\r
BEGIN\r
FOR i:= 0 TO hash_size-1 \r
DO hash_table_ptr^[i].va_high:= max_word;\r
exc:= vmmextend(nth_table^,stack_page,512,FALSE,nt_ptr);\r
(* nt_ptr used for stack_ptr *)\r
IF exc=0 THEN\r
BEGIN\r
nt_ptr^[0].va_low:= max_word; (* stack[0].va_low *)\r
nt_ptr^[0].va_high:= max_word;(* stack[0].va_high *)\r
nt_ptr^[1].va_low:= max_word; (* stack[0].spix *)\r
nt_ptr^[126].va_high:= max_word; (* stack[84].va_high *)\r
stack_offset:= 0;\r
exc:= vmmextend(nth_table^,p_stack_page,512,FALSE,nt_ptr);\r
(* nt_ptr used for stack_ptr *)\r
IF exc=0 THEN \r
BEGIN\r
nt_ptr^[0].va_low:= max_word; (* stack[0].va_low *)\r
nt_ptr^[0].va_high:= max_word;(* stack[0].va_high *)\r
nt_ptr^[1].va_low:= max_word; (* stack[0].spix *)\r
nt_ptr^[126].va_high:= max_word; (* stack[84].va_high *)\r
p_stack_offset:= 0;\r
save_on_stack:= 1; (* do not save before first Begin Level *)\r
exc:= vmmextend(nth_table^,spix_to_st[0],512,FALSE,nt_ptr);\r
(* nt_ptr dummy *)\r
IF exc=0 THEN\r
BEGIN\r
FOR i:= 0 TO 127 DO nt_ptr^[i].va_high:= max_word;\r
exc:= vmmextend(nth_table^,spix_to_nt,512,TRUE,nt_ptr);\r
END;\r
nt_va.va_low:= spix_to_nt.va_low;\r
nt_va.va_high:= spix_to_nt.va_high;\r
last_spix:= 0;\r
END;\r
END;\r
END;\r
END;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Create');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthcreate:= exc;\r
END; (* nthcreate *)\r
\r
FUNCTION nthget(VAR name: STRING; max_residents: WORD;VAR str: STRING ): WORD;\r
VAR\r
conn: file;\r
read_bytes: WORD;\r
exc: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E00) = $0600 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Get');\r
vmmdumpword('MAXIMUM=',max_residents);\r
vmmdumpstring(str);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
program_niv:= 0;\r
exc:= vmmgetspecial(nth_table,name,max_residents,str,conn);\r
IF exc=0 THEN blockread(conn,hash_size,10,read_bytes);\r
IF (exc=0) AND (read_bytes<>10) THEN exc:= e_vmm_tbl_nexist;\r
IF exc=0 THEN blockread(conn,spix_to_nt,4,read_bytes);\r
IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;\r
IF exc=0 THEN blockread(conn,nt_va,4,read_bytes);\r
IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;\r
IF exc=0 THEN blockread(conn,stack_page,4,read_bytes);\r
IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;\r
IF exc=0 THEN blockread(conn,p_stack_page,4,read_bytes);\r
IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;\r
IF exc=0 THEN blockread(conn,spix_to_st[0],32,read_bytes);\r
IF (exc=0) AND (read_bytes<>32) THEN exc:= e_vmm_tbl_nexist;\r
IF exc=0 THEN hash_table_ptr:= vmmallocate(4*hash_size,exc);\r
IF exc=0 THEN blockread(conn,hash_table_ptr^,4*hash_size,read_bytes);\r
IF (exc=0) AND (read_bytes<>4*hash_size) THEN exc:= e_vmm_tbl_nexist;\r
IF exc=0 THEN close(conn);\r
p_stack_offset:= 0;\r
IF exc=0 THEN exc:= vmmretrieve(nth_table^,nt_va.va_high,nt_va.va_low,\r
TRUE,TRUE,nt_ptr);\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Get');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthget:= exc;\r
END; (* nthget *)\r
\r
FUNCTION nthdelete: WORD;\r
VAR\r
(*#BEGINTEST\r
name_ptr: ptr_string;\r
rec_ptr: ^rec_type;\r
step: WORD;\r
spixs: WORD;\r
chains: WORD;\r
temp_depth: WORD;\r
max_depth: WORD;\r
(*ENDTEST#*)\r
exc: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
BEGIN\r
IF (WORD(testvmm) AND $0E00) = $0600 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Delete');\r
vmmdumpnewline; \r
END;\r
IF (WORD(testvmm) AND $0C01) = $0001 THEN\r
BEGIN\r
exc := dump_sort_spix;\r
vmmdumpnewline;\r
vmmdumpstring('SPIX TABLE');\r
vmmdumpnewline;\r
FOR step:= 1 TO last_spix DO\r
BEGIN\r
IF (step AND $07F) <> $07F THEN\r
BEGIN\r
vmmdumpskip;\r
vmmdumpword(' SPIX =',step);\r
exc:= nthretrieve(step,name_ptr);\r
IF exc=0 THEN vmmdumpstring(name_ptr^);\r
vmmdumpnewline;\r
END;\r
END;\r
vmmdumpnewline;\r
END;\r
IF (WORD(testvmm) AND $0C02) = $0002 THEN\r
BEGIN\r
vmmdumpnewline;\r
vmmdumpstring('HASH TABLE');\r
vmmdumpnewline;\r
chains:= 0;\r
spixs:= 0; \r
max_depth:= 0;\r
FOR step:= 1 TO hash_size-1 DO\r
BEGIN\r
rec_ptr:= @hash_table_ptr^[step];\r
temp_depth:= 0;\r
WHILE (rec_ptr^.va.va_high<>max_word) AND (exc=0) DO\r
BEGIN\r
vmmdumpskip;\r
IF temp_depth=0 THEN \r
BEGIN\r
chains:= chains+1;\r
vmmdumpword(' HASH =',step);\r
END ELSE vmmdumpskip;\r
temp_depth:= temp_depth+1;\r
spixs:= spixs+1;\r
exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,FALSE,FALSE,rec_ptr);\r
IF exc=0 THEN vmmdumpstring(rec_ptr^.str);\r
vmmdumpnewline;\r
END;\r
IF max_depth<temp_depth THEN max_depth:= temp_depth;\r
END;\r
vmmdumpnewline;\r
vmmdumpskip;\r
vmmdumpword(' SPIXS=',spixs);\r
vmmdumpword(' CHAINS=',chains);\r
vmmdumpword(' DEPTH=',max_depth);\r
vmmdumpnewline;\r
vmmdumpnewline;\r
END;\r
END;\r
(*ENDTEST#*)\r
\r
exc:= vmmdeletetable(nth_table);\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Delete');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthdelete:= exc;\r
END; (* nthdelete *)\r
\r
\r
FUNCTION nthsave(VAR str: string ): WORD;\r
VAR\r
conn: file;\r
exc: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E00) = $0600 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Save'); \r
vmmdumpstring(str);\r
vmmdumpnewline; \r
END;\r
(*ENDTEST#*)\r
exc:= vmmsavespecial(nth_table^,str,conn);\r
IF exc=0 THEN blockwrite(conn,hash_size,10);\r
IF exc=0 THEN blockwrite(conn,spix_to_nt,4);\r
IF exc=0 THEN blockwrite(conn,nt_va,4);\r
IF exc=0 THEN blockwrite(conn,stack_page,4);\r
IF exc=0 THEN blockwrite(conn,p_stack_page,4);\r
IF exc=0 THEN blockwrite(conn,spix_to_st[0],32);\r
IF exc=0 THEN blockwrite(conn,hash_table_ptr^,4*hash_size);\r
IF exc=0 THEN close(conn);\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Save');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthsave:= exc;\r
END; (* nthsave *)\r
\r
\r
FUNCTION nthextend(VAR spix: WORD; VAR name: STRING): WORD;\r
VAR\r
i: WORD;\r
rec_ptr: ^rec_type;\r
temp_ptr, l_temp_ptr: ptr_st_table_type;\r
hash: WORD;\r
rotate: BYTE;\r
offset, page, i_page: WORD;\r
exc: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E01) = $0601 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Extend');\r
vmmdumpstring(name);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
hash:= LENGTH(name);\r
exc:= 0;\r
rotate:= 3;\r
FOR i:= 1 TO LENGTH(name) DO\r
BEGIN\r
spix:= ORD(name[i]);\r
IF spix>=96 THEN exc:= e_string;\r
hash:= hash XOR (spix SHL rotate);\r
rotate:= (rotate AND $07) + 5;\r
END;\r
hash:= hash mod hash_size;\r
rec_ptr:= @hash_table_ptr^[hash];\r
WHILE (rec_ptr^.va.va_high<>max_word) AND (exc=0) DO\r
BEGIN\r
exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,FALSE,FALSE,rec_ptr);\r
IF (exc=0) AND (name = rec_ptr^.str) THEN\r
BEGIN\r
spix:= rec_ptr^.spix;\r
exc:= e_exist;\r
END;\r
END;\r
IF exc=0 THEN\r
BEGIN\r
last_spix:= last_spix+1;\r
offset:= last_spix AND 127; (*07FH*)\r
IF offset=127 THEN\r
BEGIN\r
page:= (last_spix+1) SHR 7;\r
i_page:= page SHR 3;\r
page:= page AND 7;\r
IF i_page=0 THEN\r
BEGIN\r
exc:= vmmextend(nth_table^,spix_to_st[page],512,FALSE,temp_ptr);\r
(* temp_ptr dummy *)\r
IF exc=0 THEN FOR i:= 0 TO 127 DO temp_ptr^[i].va_high:= max_word;\r
END ELSE\r
BEGIN\r
rec_ptr:= @spix_to_st[page];\r
WHILE (i_page>1) AND (exc=0) DO\r
BEGIN\r
exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,FALSE,FALSE,temp_ptr);\r
rec_ptr:= @temp_ptr^[127];\r
i_page:= i_page-1;\r
END;\r
IF exc=0 THEN exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,TRUE,TRUE,temp_ptr);\r
l_temp_ptr:= temp_ptr;\r
IF exc=0 THEN\r
BEGIN\r
exc:= vmmextend(nth_table^,temp_ptr^[127],512,FALSE,temp_ptr);\r
IF exc=0 THEN\r
BEGIN\r
FOR i:= 0 TO 127 DO temp_ptr^[i].va_high:= max_word;\r
exc:= vmmunlock(nth_table^,l_temp_ptr);\r
END;\r
END;\r
END;\r
IF exc=0 THEN exc:= vmmextend(nth_table^,nt_ptr^[127],512,TRUE,temp_ptr);\r
IF exc=0 THEN\r
BEGIN\r
exc:= vmmunlock(nth_table^,nt_ptr);\r
nt_va.va_low:= nt_ptr^[127].va_low;\r
nt_va.va_high:= nt_ptr^[127].va_high;\r
nt_ptr:= temp_ptr;\r
last_spix:= last_spix+1;\r
offset:= 0;\r
END;\r
END;\r
IF exc=0 THEN exc:= vmmextend(nth_table^,nt_ptr^[offset],LENGTH(name)+7,FALSE,rec_ptr);\r
IF exc=0 THEN\r
BEGIN\r
rec_ptr^.spix:= last_spix;\r
spix:= last_spix;\r
rec_ptr^.va.va_low:= hash_table_ptr^[hash].va_low;\r
rec_ptr^.va.va_high:= hash_table_ptr^[hash].va_high;\r
hash_table_ptr^[hash].va_low:= nt_ptr^[offset].va_low;\r
hash_table_ptr^[hash].va_high:= nt_ptr^[offset].va_high;\r
rec_ptr^.str:= name;\r
END;\r
END;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D01) = $0501) OR \r
((exc<>0) AND (exc<>e_exist)) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Extend');\r
IF exc=0 THEN vmmdumpword(' SPIX =',spix);\r
vmmdumpstring(name);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthextend:= exc;\r
END; (* nthextend *)\r
\r
\r
\r
FUNCTION nthretrieve(spix: WORD;VAR name_ptr: ptr_string): WORD;\r
VAR\r
exc: WORD;\r
hash: WORD;\r
rec_ptr: ^rec_type;\r
offset: WORD;\r
i_page: WORD;\r
h_nt_page_ptr: ptr_st_table_type;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E02) = $0602 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Retrive');\r
vmmdumpword(' SPIX =',spix);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
IF spix<=last_spix THEN\r
BEGIN\r
offset:= spix AND 127; (*07FH*)\r
i_page:= spix SHR 7;\r
exc:= vmmretrieve(nth_table^,spix_to_nt.va_high,spix_to_nt.va_low,FALSE,FALSE,h_nt_page_ptr);\r
WHILE i_page>0 DO\r
BEGIN\r
IF exc=0 THEN exc:= vmmretrieve(nth_table^,h_nt_page_ptr^[127].va_high,\r
h_nt_page_ptr^[127].va_low,FALSE,FALSE,h_nt_page_ptr);\r
i_page:= i_page-1;\r
END;\r
IF exc=0 THEN\r
BEGIN\r
exc:= vmmretrieve(nth_table^,h_nt_page_ptr^[offset].va_high,\r
h_nt_page_ptr^[offset].va_low,FALSE,FALSE,rec_ptr);\r
name_ptr:= @rec_ptr^.str;\r
END;\r
END ELSE exc:= e_nexist;\r
IF (exc<>0) AND (testvmm>=0) THEN\r
BEGIN\r
vmmdumproutine('NTH Retrieve');\r
vmmdumpnewline;\r
END;\r
\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D02) = $0502) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Retrieve');\r
vmmdumpword(' SPIX =',spix);\r
IF exc=0 THEN vmmdumpstring(name_ptr^);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
\r
nthretrieve:= exc;\r
END; (* nthretrieve *)\r
\r
FUNCTION nthinsertsymbol(spix, va_high, va_low: WORD): WORD;\r
VAR\r
st_ptr: ptr_st_table_type;\r
stack_ptr: ptr_rec_table_type;\r
new_stack_ptr: ptr_rec_table_type;\r
help: WORD;\r
state: BYTE;\r
h_va_high, h_va_low, offset, page, i_page, exc: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E10) = $0610 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Insert');\r
vmmdumpword(' SPIX =',spix);\r
vmmdumpva(va_high,va_low);\r
vmmdumpword(' NIV =',save_on_stack);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
state:= 0;\r
offset:= spix AND 127; (*07FH*)\r
page:= spix SHR 7;\r
i_page:= page SHR 3;\r
page:= page AND 7;\r
if (spix=290) or (spix=289) then\r
spix := spix;\r
exc:= vmmretrieve(nth_table^,spix_to_st[page].va_high,\r
spix_to_st[page].va_low,FALSE,i_page=0,st_ptr);\r
WHILE (i_page>0) AND (exc=0) DO\r
BEGIN\r
state:= 1;\r
exc:= vmmretrieve(nth_table^,st_ptr^[127].va_high,st_ptr^[127].va_low,FALSE,i_page=1,st_ptr);\r
i_page:= i_page-1;\r
END;\r
h_va_low:= st_ptr^[offset].va_low;\r
h_va_high:= st_ptr^[offset].va_high;\r
st_ptr^[offset].va_low:= va_low;\r
st_ptr^[offset].va_high:= va_high;\r
IF (save_on_stack>1) AND (exc=0) THEN\r
BEGIN\r
state:= 2;\r
exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);\r
stack_offset:= stack_offset+1;\r
IF stack_offset=84 THEN \r
BEGIN\r
help:= stack_ptr^[84].va.va_high;\r
IF help=max_word THEN\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0F10) = $0410 THEN\r
BEGIN\r
vmmdumproutine('NTH NEW Insert');\r
vmmdumpva(stack_page.va_high,stack_page.va_low);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
IF exc=0 THEN exc:= vmmlock(nth_table^,stack_ptr);\r
IF exc=0 THEN exc:= vmmextend(nth_table^,stack_ptr^[84].va,512,FALSE,new_stack_ptr);\r
IF exc=0 THEN\r
BEGIN\r
exc:= vmmunlock(nth_table^,stack_ptr);\r
new_stack_ptr^[0].va.va_low:= stack_page.va_low;\r
new_stack_ptr^[0].va.va_high:= stack_page.va_high;\r
new_stack_ptr^[0].spix:= max_word;\r
new_stack_ptr^[84].va.va_high:= max_word;\r
stack_offset:= 1;\r
stack_page.va_low:= stack_ptr^[84].va.va_low;\r
stack_page.va_high:= stack_ptr^[84].va.va_high;\r
stack_ptr:= new_stack_ptr;\r
END;\r
END ELSE\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0F10) = $0410 THEN\r
BEGIN\r
vmmdumproutine('NTH NEXT Insert');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
stack_page.va_low:= stack_ptr^[84].va.va_low;\r
stack_page.va_high:= stack_ptr^[84].va.va_high;\r
IF exc=0 THEN\r
BEGIN\r
state:= 3;\r
exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);\r
END;\r
stack_offset:= 1;\r
END;\r
END;\r
stack_ptr^[stack_offset].va.va_low:= h_va_low;\r
stack_ptr^[stack_offset].va.va_high:= h_va_high;\r
stack_ptr^[stack_offset].spix:= spix;\r
IF (spix>last_spix) AND (testvmm>=0) THEN\r
BEGIN\r
vmmdumproutine('NTH Spix');\r
vmmdumpword(' SPIX = ',spix);\r
vmmdumpnewline;\r
END;\r
END;\r
\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D10) = $0510) OR (exc<>0) THEN \r
BEGIN\r
vmmdumproutine('NTH <-- Insert');\r
IF (exc<>0) THEN \r
BEGIN\r
vmmdumpbyte(' STATE =',state);\r
vmmdumpword(' SPIX = ',spix);\r
END;\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthinsertsymbol:= exc;\r
END; (* nthinsertsymbol *)\r
\r
FUNCTION nthbeginlevel: WORD;\r
VAR\r
stack_ptr: ptr_rec_table_type;\r
new_stack_ptr: ptr_rec_table_type;\r
help, exc: WORD; \r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E04) = $0604 THEN \r
BEGIN\r
vmmdumproutine('NTH --> BeginLevel');\r
vmmdumpnewline; \r
END;\r
(*ENDTEST#*)\r
\r
exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);\r
stack_offset:= stack_offset+1;\r
IF (stack_offset=84) AND (exc=0) THEN\r
BEGIN\r
help:= stack_ptr^[84].va.va_high;\r
IF help=max_word THEN\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0F04) = $0404 THEN\r
BEGIN\r
vmmdumproutine('NTH NEW BeginLevel');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
exc:= vmmlock(nth_table^,stack_ptr);\r
IF exc=0 THEN exc:= vmmextend(nth_table^,stack_ptr^[84].va,512,FALSE,new_stack_ptr);\r
IF exc=0 THEN\r
BEGIN\r
exc:= vmmunlock(nth_table^,stack_ptr);\r
new_stack_ptr^[0].va.va_low:= stack_page.va_low;\r
new_stack_ptr^[0].va.va_high:= stack_page.va_high;\r
new_stack_ptr^[0].spix:= max_word;\r
new_stack_ptr^[84].va.va_high:= max_word;\r
stack_offset:= 1;\r
stack_page.va_low:= stack_ptr^[84].va.va_low;\r
stack_page.va_high:= stack_ptr^[84].va.va_high;\r
stack_ptr:= new_stack_ptr;\r
END;\r
END ELSE\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0F04) = $0404 THEN\r
BEGIN\r
vmmdumproutine('NTH NEXT BeginLevel');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
stack_page.va_low:= stack_ptr^[84].va.va_low;\r
stack_page.va_high:= stack_ptr^[84].va.va_high;\r
exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);\r
stack_offset:= 1;\r
END;\r
END;\r
IF exc=0 THEN stack_ptr^[stack_offset].spix:= 0;\r
save_on_stack:= save_on_stack+1;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D04) = $0504) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- BeginLevel');\r
vmmdumpword(' NIV =',save_on_stack);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthbeginlevel:= exc;\r
END; (* nthbeginlevel *)\r
\r
FUNCTION nthpopstack: WORD;\r
VAR\r
stack_ptr: ptr_rec_table_type;\r
spix, exc: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN \r
IF (WORD(testvmm) AND $0E08) = $0608 THEN\r
BEGIN\r
vmmdumproutine('NTH --> PopStack');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
exc:= vmmretrieve(nth_table^,e_stack_page.va_high,e_stack_page.va_low,TRUE,FALSE,stack_ptr);\r
spix:= stack_ptr^[e_stack_offset].spix;\r
WHILE (spix<>0) AND (exc=0) DO\r
BEGIN\r
IF (e_stack_offset=0) THEN\r
BEGIN\r
IF testvmm=200 THEN\r
BEGIN\r
vmmdumproutine('NTH Pop Stack');\r
vmmdumpva(stack_ptr^[0].va.va_high,stack_ptr^[0].va.va_low);\r
vmmdumpnewline;\r
END;\r
exc:= vmmunlock(nth_table^,stack_ptr);\r
e_stack_page.va_low:= stack_ptr^[0].va.va_low;\r
e_stack_page.va_high:= stack_ptr^[0].va.va_high;\r
IF exc=0 THEN exc:= vmmretrieve(nth_table^,e_stack_page.va_high,e_stack_page.va_low,TRUE,FALSE,stack_ptr);\r
e_stack_offset:= 83;\r
END ELSE\r
BEGIN\r
exc:= nthinsertsymbol(spix,stack_ptr^[e_stack_offset].va.va_high,stack_ptr^[e_stack_offset].va.va_low);\r
e_stack_offset:= e_stack_offset-1;\r
END;\r
spix:= stack_ptr^[e_stack_offset].spix;\r
END;\r
e_stack_offset:= e_stack_offset-1;\r
IF exc=0 THEN exc:= vmmunlock(nth_table^,stack_ptr);\r
IF (exc<>0) AND (testvmm>=0) THEN\r
BEGIN\r
vmmdumproutine('NTH End');\r
vmmdumpword(' OFFSET=',e_stack_offset);\r
vmmdumpword(' LSPIX =',last_spix);\r
vmmdumpnewline;\r
END;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Popstack');\r
IF exc<>0 THEN\r
BEGIN\r
vmmdumpword(' OFFSET=',e_stack_offset);\r
vmmdumpword(' LSPIX =',last_spix);\r
END;\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthpopstack:= exc;\r
END; (* nthpopstack *)\r
\r
FUNCTION nthendlevel: WORD;\r
VAR\r
exc: WORD;\r
help: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E08) = $0608 THEN\r
BEGIN \r
vmmdumproutine('NTH --> EndLevel');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
help:= save_on_stack;\r
save_on_stack:= 0;\r
e_stack_page.va_low:= stack_page.va_low;\r
e_stack_page.va_high:= stack_page.va_high; \r
e_stack_offset:= stack_offset;\r
exc:= nthpopstack;\r
save_on_stack:= help-1;\r
stack_page.va_low:= e_stack_page.va_low;\r
stack_page.va_high:= e_stack_page.va_high;\r
stack_offset:= e_stack_offset;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- EndLevel');\r
vmmdumpword(' NIV =',save_on_stack);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthendlevel:= exc;\r
END; (* nthendlevel *)\r
\r
FUNCTION nthbeginprogram: WORD;\r
VAR\r
exc: WORD;\r
help: WORD;\r
help2: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E08) = $0608 THEN\r
BEGIN\r
vmmdumproutine('NTH --> BeginProgram');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
help:= save_on_stack;\r
e_stack_page.va_low:= stack_page.va_low;\r
e_stack_page.va_high:= stack_page.va_high;\r
e_stack_offset:= stack_offset;\r
IF program_niv=0 THEN \r
BEGIN\r
save_on_stack:= 0;\r
exc:= nthpopstack;\r
stack_page.va_low:= e_stack_page.va_low;\r
stack_page.va_high:= e_stack_page.va_high;\r
stack_offset:= e_stack_offset;\r
IF exc=0 THEN exc:= nthbeginlevel;\r
save_on_stack:= help;\r
END ELSE\r
BEGIN\r
save_on_stack:= 4095; (*0FFFH*)\r
stack_page.va_low:= p_stack_page.va_low;\r
stack_page.va_high:= p_stack_page.va_high;\r
stack_offset:= p_stack_offset;\r
exc:= nthbeginlevel;\r
help2:= help-last_program_niv;\r
end_program_pops:= help2-1;\r
WHILE help2>2 DO\r
BEGIN\r
IF exc=0 THEN exc:= nthpopstack;\r
help2:= help2-1;\r
IF exc=0 THEN exc:= nthbeginlevel;\r
END;\r
IF exc=0 THEN exc:= nthpopstack;\r
IF exc=0 THEN exc:= nthpopstack;\r
p_stack_page.va_low:= stack_page.va_low;\r
p_stack_page.va_high:= stack_page.va_high;\r
p_stack_offset:= stack_offset;\r
stack_page.va_low:= e_stack_page.va_low;\r
stack_page.va_high:= e_stack_page.va_high;\r
stack_offset:= e_stack_offset;\r
save_on_stack:= help-2;\r
IF exc=0 THEN exc:= nthbeginlevel;\r
IF exc=0 THEN exc:= nthbeginlevel;\r
END;\r
program_niv:= program_niv+1;\r
last_program_niv:= save_on_stack;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- BeginProgram');\r
vmmdumpword(' NIV =',save_on_stack);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthbeginprogram:= exc;\r
END; (* nthbeginprogram *)\r
\r
\r
FUNCTION nthendprogram: WORD;\r
VAR\r
exc: WORD;\r
help: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E08) = $0608 THEN\r
BEGIN\r
vmmdumproutine('NTH --> EndProgram');\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
exc:= 0;\r
IF program_niv>1 THEN\r
BEGIN\r
last_program_niv := last_program_niv - end_program_pops - 1;\r
help:= save_on_stack;\r
save_on_stack:= max_word;\r
e_stack_page.va_low:= p_stack_page.va_low;\r
e_stack_page.va_high:= p_stack_page.va_high;\r
e_stack_offset:= p_stack_offset;\r
exc:= 0;\r
WHILE end_program_pops>1 DO\r
BEGIN\r
IF exc=0 THEN exc:= nthpopstack;\r
IF exc=0 THEN exc:= nthbeginlevel;\r
end_program_pops:= end_program_pops-1;\r
END;\r
IF exc=0 THEN exc:= nthpopstack;\r
save_on_stack:= help;\r
p_stack_page.va_low:= e_stack_page.va_low;\r
p_stack_page.va_high:= e_stack_page.va_high;\r
p_stack_offset:= e_stack_offset;\r
END;\r
program_niv:= program_niv-1;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- EndProgram');\r
vmmdumpword(' NIV =',save_on_stack);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthendprogram:= exc;\r
END; (* nthendprogram *)\r
\r
\r
FUNCTION nthfindsymbol(spix: WORD; VAR va: st_address): WORD;\r
VAR\r
st_ptr: ptr_st_table_type;\r
offset, page, i_page, exc: WORD;\r
BEGIN\r
(*#BEGINTEST\r
IF testvmm>0 THEN\r
IF (WORD(testvmm) AND $0E20) = $0620 THEN\r
BEGIN\r
vmmdumproutine('NTH --> Find');\r
vmmdumpword(' SPIX =',spix);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
IF spix>last_spix THEN exc:= e_nexist\r
ELSE BEGIN\r
offset:= spix AND 127; (*07FH*)\r
page:= spix SHR 7;\r
i_page:= page SHR 3;\r
page:= page AND 7;\r
if spix = 290 then\r
spix := 290; (* hha *)\r
exc:= vmmretrieve(nth_table^,spix_to_st[page].va_high,spix_to_st[page].va_low,FALSE,FALSE,st_ptr);\r
WHILE (i_page>0) AND (exc=0) DO\r
BEGIN\r
exc:= vmmretrieve(nth_table^,st_ptr^[127].va_high,st_ptr^[127].va_low,FALSE,FALSE,st_ptr);\r
i_page:= i_page-1;\r
END;\r
va.va_low:= st_ptr^[offset].va_low;\r
va.va_high:= st_ptr^[offset].va_high;\r
IF (va.va_high=max_word) AND (exc=0) THEN\r
BEGIN\r
exc:= e_nexist;\r
va.va_low:= max_word;\r
END;\r
END;\r
IF (exc<>0) AND (testvmm>=0) THEN\r
BEGIN\r
vmmdumproutine('NTH Find');\r
vmmdumpword(' SPIX = ',spix);\r
vmmdumpnewline;\r
END;\r
(*#BEGINTEST\r
IF testvmm>=0 THEN\r
IF ((WORD(testvmm) AND $0D20) = $0520) OR (exc<>0) THEN\r
BEGIN\r
vmmdumproutine('NTH <-- Find');\r
vmmdumpword(' SPIX = ',spix);\r
IF exc=0 THEN vmmdumpva(va.va_high,va.va_low);\r
vmmdumpnewline;\r
END;\r
(*ENDTEST#*)\r
nthfindsymbol:= exc;\r
END; (* nthfindsymbol *)\r
\r
BEGIN \r
END.\r
«eof»