{$O+,F+}
(* ----------   name table conversion handler   ---------- *)

UNIT nthunit;

INTERFACE
USES pscplm, mpaunit, sthunit, vmmdump, vmmunit;

FUNCTION nthcreate(VAR name: string;
                   max_residents, page_size, use_hash_size: WORD): WORD;

FUNCTION nthget(VAR name: STRING; max_residents: WORD;VAR str: STRING): WORD;

FUNCTION nthdelete: WORD;

FUNCTION nthsave(VAR str: string): WORD;

FUNCTION nthcrosssort(st_table: ptr_tbl_dscr_type;
                      VAR addr: st_address;
                      stop_va_high, stop_va_low: WORD): WORD;

FUNCTION nthextend(VAR spix: WORD; VAR name: string): WORD;

FUNCTION nthretrieve(spix: WORD; VAR name_ptr: ptr_string): WORD;

FUNCTION nthbeginlevel: WORD;

FUNCTION nthendlevel: WORD;

FUNCTION nthbeginprogram: WORD;

FUNCTION nthendprogram: WORD;

FUNCTION nthinsertsymbol(spix, va_high, va_low: WORD): WORD;

FUNCTION nthfindsymbol(spix: WORD; VAR va: st_address): WORD;


IMPLEMENTATION

const
  e_ok = 0;
  e_fexist = 32;
  e_fnexist = 33;
  e_vmm_tbl_exist = 8208;
  e_vmm_tbl_nexist = 8209;
  e_vmm_fexist = 8210;
  e_vmm_va_nexist = 8211;
  e_vmm_size = 8212;
  e_vmm_overflow = 8213;
  e_vmm_underflow = 8214;
  e_vmm_nresident = 8215;
  e_vmm_memory = 8216;
  e_vmm_va_overflow = 8217;
  e_vmm_version = 8218;

(* !!! TURBO !!! *)
  max_word = 65535;


CONST
  e_string = 8200;
  e_exist = 8198;
  e_nexist = 8199;

TYPE
  rec_type=RECORD
             va: st_address;
             spix: WORD;
             str: STRING;
           END;

  hash_rec_type =
    RECORD
      va :st_address;
      spix : WORD;
    END;
  hash_table_type = ARRAY[0..15999] OF st_address;
  st_table_type = ARRAY[0..127] OF st_address;
  rec_table_type = ARRAY[0..84] OF hash_rec_type;
  ptr_st_address = ^st_address;
  ptr_st_table_type = ^st_table_type;
  ptr_rec_table_type = ^rec_table_type;
VAR
  hash_size,
  hash_mask,
  last_spix,
  stack_offset,
  save_on_stack,
  last_program_niv,
  end_program_pops: WORD;

  hash_table_ptr: ^ hash_table_type;
  nth_table: ptr_tbl_dscr_type;
  spix_to_nt: st_address;
  nt_ptr: ptr_st_table_type;
  nt_va: st_address;
  spix_to_st: array[0..7] of st_address;
  stack_page: st_address;
  p_stack_page: st_address;
  e_stack_page: st_address;
  p_stack_offset: WORD;
  e_stack_offset: WORD;
  program_niv: BYTE;


FUNCTION find_node(spix: WORD; VAR node_ptr: ptr_st_address): WORD;
VAR
  st_ptr: ptr_st_table_type;
  offset, page, i_page, exc: WORD;
BEGIN
  IF spix>last_spix THEN exc:= e_nexist
  ELSE BEGIN
    offset:= spix AND 127; (*07FH*)
    page:= spix SHR 7;
    i_page:= page SHR 3;
    page:= page AND 7;
    exc:= vmmretrieve(nth_table^,spix_to_st[page].va_high,
                      spix_to_st[page].va_low,FALSE,i_page=0,st_ptr);
    WHILE (i_page>0) AND (exc=0) DO
    BEGIN
      exc:= vmmretrieve(nth_table^,st_ptr^[127].va_high,st_ptr^[127].va_low,
                        FALSE,i_page=1,st_ptr);
      i_page:= i_page-1;
    END;
  END;
  node_ptr:= @st_ptr^[offset];
(*#BEGINTEST
  IF (testvmm>=0) AND (exc<>0) THEN
  BEGIN
    vmmdumproutine('NTH  ERR  Find node');
    vmmdumpword('   EXC =',exc);
    vmmdumpnewline;
  END;
(*ENDTEST#*)
  find_node:= exc;
END; (* find_node *)

FUNCTION set_sort_spix(f_spix, l_spix, w: WORD): WORD;
VAR
  node_ptr: ptr_st_address;
  exc: WORD;
BEGIN
  WHILE f_spix<=l_spix DO
  BEGIN
    exc:= find_node(f_spix,node_ptr);
    IF exc=0 THEN node_ptr^.va_low:= w
    ELSE f_spix:= l_spix;
    f_spix:= f_spix+1;
    IF (f_spix AND 127) = 127 then f_spix:= f_spix+1;
  END;
  set_sort_spix:= exc;
END; (* set_sort_spix *)


FUNCTION sort_spix: WORD;
VAR
  spix,
  compare_spix,
  right_spix,
  return_spix,
  next_spix: WORD;
  node_ptr: ptr_st_address;
  new_name_ptr: ptr_string;
  n_name: STRING;
  c_name_ptr: ptr_string;
  less_than: BOOLEAN;
  exc: WORD;

BEGIN
(*#BEGINTEST
IF testvmm>0 THEN
BEGIN
 vmmdumproutine('NTH  -->  Sort spix');
 vmmdumpword('  SPIX =',last_spix);
 vmmdumpnewline;
END;
(*ENDTEST#*)
  exc:= find_node(1,node_ptr);
  IF exc=0 THEN
  BEGIN
    node_ptr^.va_low:= 0;
    node_ptr^.va_high:= 0;
    spix:= 2;
    WHILE spix<=last_spix DO
    BEGIN
(*#BEGINTEST
IF testvmm>0 THEN vmmdumpword('  SPIX =',spix);
(*ENDTEST#*)
      exc:= find_node(spix,node_ptr);
      IF node_ptr^.va_low=0 THEN
      BEGIN
        IF exc=0 THEN
        BEGIN
          node_ptr^.va_low:= 0;
          node_ptr^.va_high:= 0;
          compare_spix:= 1;
          exc:= nthretrieve(spix,new_name_ptr);
          n_name:= new_name_ptr^;
        END;
        IF exc<>0 THEN spix:= max_word
        ELSE WHILE compare_spix<>0 DO
          BEGIN
            exc:= nthretrieve(compare_spix,c_name_ptr);
            IF exc<>0 THEN spix:= max_word
            ELSE BEGIN
              less_than:= n_name < c_name_ptr^;
              exc:= find_node(compare_spix,node_ptr);
              IF exc<>0 THEN
              BEGIN
                compare_spix:= 0;
                spix:= max_word;
              END ELSE
              BEGIN
                IF less_than THEN
                BEGIN
                  compare_spix:= node_ptr^.va_low;
                  IF compare_spix=0 THEN node_ptr^.va_low:= spix;
                END ELSE
                BEGIN
                  compare_spix:= node_ptr^.va_high;
                  IF compare_spix=0 THEN node_ptr^.va_high:= spix;
                END;
              END;
            END;
        END;
      END;
      spix:= spix+1;
      IF (spix AND 127) = 127 THEN spix:= spix+1;
    END;
  END;
  (* convert binary tree to sorted list *)
  (* l: next spix, r: 0                 *)
  (* spix 0's node_ptr^.va_low is first spix      *)
(*#BEGINTEST
IF testvmm>0 THEN 
BEGIN
 vmmdumproutine('NTH  -1-  Sort spix');
 vmmdumpnewline;
END;
(*ENDTEST#*)
  IF exc=0 THEN
  BEGIN
    right_spix:= 0;
    return_spix:= 0;
    spix:= 1;
    WHILE (exc=0) AND (spix<>0) DO
    BEGIN
(*#BEGINTEST
IF testvmm>0 THEN vmmdumpword('  SPIX =',spix);
(*ENDTEST#*)
      exc:= find_node(spix,node_ptr);
      WHILE (exc=0) AND (node_ptr^.va_low<>0) DO
      BEGIN
        next_spix:= node_ptr^.va_low;
        node_ptr^.va_low:= return_spix;
        return_spix:= spix;
        spix:= next_spix;
        exc:= find_node(spix,node_ptr);
      END;
      IF exc=0 THEN
      BEGIN
        node_ptr^.va_low:= return_spix;
        exc:= find_node(right_spix,node_ptr);
      END;
      IF exc=0 THEN
      BEGIN
        node_ptr^.va_low:= spix;
        exc:= find_node(spix,node_ptr);
      END;
      WHILE (exc=0) AND (node_ptr^.va_high=0) AND (spix<>0) DO
      BEGIN
        spix:= node_ptr^.va_low;
        exc:= find_node(spix,node_ptr);
      END;
      IF (exc=0) AND (spix<>0) THEN
      BEGIN
        next_spix:= node_ptr^.va_high;
        node_ptr^.va_high:= 0;
        right_spix:= spix;
        return_spix:= node_ptr^.va_low;
        spix:= next_spix;
      END;
    END;
  END; (* end of converting *)
(*#BEGINTEST
IF testvmm>0 THEN
BEGIN
 vmmdumproutine('NTH  <--  Sort spix');
 vmmdumpnewline;
END;
(*ENDTEST#*)

  sort_spix:= exc;
END; (* sort_spix *)

FUNCTION dump_sort_spix: WORD;
VAR
  spix: WORD;
  next_spix: WORD;
  node_ptr: ptr_st_address;
  name_ptr: ptr_string;
  exc: WORD;
BEGIN
  vmmdumpnewline;
  vmmdumpstring('SORTED SPIX TABLE');
  vmmdumpnewline;
  exc:= set_sort_spix(1,last_spix,0);
  IF exc=0 THEN exc:= sort_spix;
  IF exc=0 THEN exc:= find_node(0,node_ptr);
  spix:= node_ptr^.va_low;
  WHILE (exc=0) AND (spix<>0) DO
  BEGIN
    exc:= find_node(spix,node_ptr);
    IF exc=0 THEN
    BEGIN
      vmmdumpskip;
      vmmdumpword('  SPIX =',spix);
      IF node_ptr^.va_high<>0 THEN vmmdumpword('  HIGH =',node_ptr^.va_high);
      next_spix:= node_ptr^.va_low;
      exc:= nthretrieve(spix,name_ptr);
    END;
    IF exc=0 THEN
    BEGIN
      vmmdumpstring(name_ptr^);
      spix:= next_spix;
    END;
    vmmdumpnewline;
  END;
  vmmdumpnewline;
  vmmdumpnewline;
  dump_sort_spix:= exc;
END; (* dump_sort_spix *)

FUNCTION nthcrosssort(st_table: ptr_tbl_dscr_type; VAR addr: st_address;
                      stop_va_high,stop_va_low: WORD): WORD;
TYPE decl_type= RECORD
                  kind: BYTE;
                  va: st_address;
                  spix: WORD;
                END;
VAR
  next_addr: st_address;
  temp_addr: st_address;
  decl_ptr: ^decl_type;
  node_ptr: ptr_st_address;
  exc: WORD;
BEGIN
  exc:= set_sort_spix(1,last_spix,1);
  IF exc=0 THEN
  BEGIN
    next_addr:= addr;
    WHILE ((next_addr.va_low<>stop_va_low) OR
          (next_addr.va_high<>stop_va_high)) AND (exc=0) DO
    BEGIN
      exc:= vmmretrieve(st_table^,next_addr.va_high,next_addr.va_low,
                        FALSE,FALSE,decl_ptr);
      IF exc=0 THEN
      BEGIN
        next_addr:= decl_ptr^.va;
        exc:= set_sort_spix(decl_ptr^.spix,decl_ptr^.spix,0);
      END;
    END;
  END;
  IF exc=0 THEN exc:= sort_spix;
  IF exc=0 THEN
  BEGIN
    next_addr:= addr;
    WHILE (next_addr.va_low<>stop_va_low) OR 
          (next_addr.va_high<>stop_va_high) DO
    BEGIN
      exc:= vmmretrieve(st_table^,next_addr.va_high,next_addr.va_low,
                        FALSE,TRUE,decl_ptr);
(*#BEGINTEST
      IF testvmm>0 THEN
      BEGIN
        vmmdumproutine('NTH  -1-  Cross');
        vmmdumpword('  SPIX =',decl_ptr^.spix);
        vmmdumpva(next_addr.va_high,next_addr.va_low);
        vmmdumpva(decl_ptr^.va.va_high,decl_ptr^.va.va_low);
        vmmdumpnewline;
      END;
(*ENDTEST#*)
      IF exc=0 THEN exc:= find_node(decl_ptr^.spix,node_ptr);
      IF exc=0 THEN
      BEGIN
        temp_addr:= decl_ptr^.va;
        decl_ptr^.va:= node_ptr^;
        node_ptr^:= next_addr;
        next_addr:= temp_addr;
(*#BEGINTEST
IF testvmm>0 THEN
BEGIN
 vmmdumproutine('NTH  -2-  Cross');
 vmmdumpword('  SPIX =',decl_ptr^.spix);
 vmmdumpva(node_ptr^.va_high,node_ptr^.va_low);
 vmmdumpva(next_addr.va_high,next_addr.va_low);
 vmmdumpnewline;
END;
(*ENDTEST#*)
      END ELSE
      BEGIN
        next_addr.va_low:= stop_va_low;
        next_addr.va_high:= stop_va_high;
      END;
    END;
    next_addr:= addr;
    IF ((next_addr.va_low<>stop_va_low) OR 
       (next_addr.va_high<>stop_va_high)) AND (exc=0) THEN
    BEGIN
      exc:= find_node(0,node_ptr);
      IF exc=0 THEN exc:= find_node(node_ptr^.va_low,node_ptr);
      WHILE (node_ptr^.va_high=0) AND (node_ptr^.va_low<=last_spix) AND
            (node_ptr^.va_low>0) AND (exc=0)
      DO exc:= find_node(node_ptr^.va_low,node_ptr);
      IF exc=0 THEN exc:= vmmretrieve(st_table^,node_ptr^.va_high,node_ptr^.va_low,FALSE,TRUE,decl_ptr);
      WHILE ((decl_ptr^.va.va_low<>0) OR (decl_ptr^.va.va_high<>0)) AND (exc=0) DO
      BEGIN
        IF (decl_ptr^.va.va_high=0) AND (decl_ptr^.va.va_low<=last_spix) THEN
        BEGIN
          exc:= find_node(decl_ptr^.va.va_low,node_ptr);
          decl_ptr^.va:= node_ptr^;
        END ELSE exc:= vmmretrieve(st_table^,decl_ptr^.va.va_high,decl_ptr^.va.va_low,FALSE,TRUE,decl_ptr);
(*#BEGINTEST
IF testvmm>0 THEN
BEGIN
 vmmdumproutine('NTH  -3-  Cross');
 vmmdumpword('  SPIX =',decl_ptr^.spix);
 vmmdumpva(decl_ptr^.va.va_high,decl_ptr^.va.va_low);
 vmmdumpnewline;
END;
(*ENDTEST#*)
      END;
      IF exc=0 THEN
      BEGIN
        decl_ptr^.va.va_low:= stop_va_low;
        decl_ptr^.va.va_high:= stop_va_high;
        exc:= find_node(0,node_ptr);
      END;
      IF exc=0 THEN
      BEGIN
        exc:= find_node(node_ptr^.va_low,node_ptr);
(*#BEGINTEST
IF testvmm>0 THEN
BEGIN
 vmmdumproutine('NTH  -4-  Cross');
 vmmdumpva(node_ptr^.va_high,node_ptr^.va_low);
 vmmdumpnewline;
END;
(*ENDTEST#*)
        WHILE (node_ptr^.va_high=0) AND (node_ptr^.va_low<=last_spix) AND (exc=0) DO
        BEGIN
          exc:= find_node(node_ptr^.va_low,node_ptr);
(*#BEGINTEST
IF testvmm>0 THEN
BEGIN
 vmmdumproutine('NTH  -4-  Cross');
 vmmdumpva(node_ptr^.va_high,node_ptr^.va_low);
 vmmdumpnewline;
END;
(*ENDTEST#*)
        END;
        addr:= node_ptr^;
      END;
    END;
  END;
  nthcrosssort:= exc;
END; (* nthcrosssort *)


FUNCTION nthcreate(VAR name: string;
                   max_residents, page_size, use_hash_size: WORD): WORD; 
VAR
  exc: WORD;
  i: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E00) = $0600 THEN  
    BEGIN
      vmmdumproutine('NTH  -->  Create');
      vmmdumpword('MAXIMUM=',max_residents);
      vmmdumpword('  SIZE =',page_size);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  program_niv:= 0;
  FOR i:= 0 TO 7 DO
  BEGIN
    spix_to_st[i].va_low:= max_word;
    spix_to_st[i].va_high:= max_word;
  END;
  hash_mask:= max_word;
  hash_size:= use_hash_size;
  IF use_hash_size<=1 THEN
  BEGIN
    IF use_hash_size=1 THEN hash_mask:= 4095 (*00FFFH*)
    ELSE BEGIN
      hash_size:= 201; (*000D3H*)
      hash_mask:= 255; (*000FFH*)
    END;
  END ELSE
  BEGIN
    WHILE use_hash_size>=1 DO
    BEGIN
      hash_mask:= hash_mask SHL 1;
      use_hash_size:= use_hash_size SHR 1;
    END;
  END;
  hash_mask:= NOT hash_mask;
  nth_table:= NIL;
  exc:= vmmcreatetable(nth_table,name,max_residents,page_size);
  IF exc=0 THEN
  BEGIN
    hash_table_ptr:= vmmallocate(4*hash_size,exc);
    IF exc=0 THEN
    BEGIN
      FOR i:= 0 TO hash_size-1 
      DO hash_table_ptr^[i].va_high:= max_word;
      exc:= vmmextend(nth_table^,stack_page,512,FALSE,nt_ptr);
      (* nt_ptr used for stack_ptr *)
      IF exc=0 THEN
      BEGIN
        nt_ptr^[0].va_low:= max_word; (* stack[0].va_low *)
        nt_ptr^[0].va_high:= max_word;(* stack[0].va_high *)
        nt_ptr^[1].va_low:= max_word; (* stack[0].spix *)
        nt_ptr^[126].va_high:= max_word; (* stack[84].va_high *)
        stack_offset:= 0;
        exc:= vmmextend(nth_table^,p_stack_page,512,FALSE,nt_ptr);
        (* nt_ptr used for stack_ptr *)
        IF exc=0 THEN 
        BEGIN
          nt_ptr^[0].va_low:= max_word; (* stack[0].va_low *)
          nt_ptr^[0].va_high:= max_word;(* stack[0].va_high *)
          nt_ptr^[1].va_low:= max_word; (* stack[0].spix *)
          nt_ptr^[126].va_high:= max_word; (* stack[84].va_high *)
          p_stack_offset:= 0;
          save_on_stack:= 1; (* do not save before first Begin Level *)
          exc:= vmmextend(nth_table^,spix_to_st[0],512,FALSE,nt_ptr);
          (* nt_ptr dummy *)
          IF exc=0 THEN
          BEGIN
            FOR i:= 0 TO 127 DO nt_ptr^[i].va_high:= max_word;
            exc:= vmmextend(nth_table^,spix_to_nt,512,TRUE,nt_ptr);
          END;
          nt_va.va_low:= spix_to_nt.va_low;
          nt_va.va_high:= spix_to_nt.va_high;
          last_spix:= 0;
        END;
      END;
    END;
  END;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  Create');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthcreate:= exc;
END; (* nthcreate *)

FUNCTION nthget(VAR name: STRING; max_residents: WORD;VAR str: STRING ): WORD;
VAR
 conn: file;
 read_bytes: WORD;
 exc: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E00) = $0600 THEN
    BEGIN
      vmmdumproutine('NTH  -->  Get');
      vmmdumpword('MAXIMUM=',max_residents);
      vmmdumpstring(str);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  program_niv:= 0;
  exc:= vmmgetspecial(nth_table,name,max_residents,str,conn);
  IF exc=0 THEN blockread(conn,hash_size,10,read_bytes);
  IF (exc=0) AND (read_bytes<>10) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN blockread(conn,spix_to_nt,4,read_bytes);
  IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN blockread(conn,nt_va,4,read_bytes);
  IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN blockread(conn,stack_page,4,read_bytes);
  IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN blockread(conn,p_stack_page,4,read_bytes);
  IF (exc=0) AND (read_bytes<>4) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN blockread(conn,spix_to_st[0],32,read_bytes);
  IF (exc=0) AND (read_bytes<>32) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN hash_table_ptr:= vmmallocate(4*hash_size,exc);
  IF exc=0 THEN blockread(conn,hash_table_ptr^,4*hash_size,read_bytes);
  IF (exc=0) AND (read_bytes<>4*hash_size) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN close(conn);
  p_stack_offset:= 0;
  IF exc=0 THEN exc:= vmmretrieve(nth_table^,nt_va.va_high,nt_va.va_low,
                                  TRUE,TRUE,nt_ptr);
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  Get');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthget:= exc;
END; (* nthget *)

FUNCTION nthdelete: WORD;
VAR
(*#BEGINTEST
   name_ptr: ptr_string;
   rec_ptr: ^rec_type;
   step: WORD;
   spixs: WORD;
   chains: WORD;
   temp_depth: WORD;
   max_depth: WORD;
(*ENDTEST#*)
  exc: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
  BEGIN
    IF (WORD(testvmm) AND $0E00) = $0600 THEN
    BEGIN
      vmmdumproutine('NTH  -->  Delete');
      vmmdumpnewline;  
    END;
    IF (WORD(testvmm) AND $0C01) = $0001 THEN
    BEGIN
      exc :=  dump_sort_spix;
      vmmdumpnewline;
      vmmdumpstring('SPIX TABLE');
      vmmdumpnewline;
      FOR step:= 1 TO last_spix DO
      BEGIN
        IF (step AND $07F) <> $07F THEN
        BEGIN
          vmmdumpskip;
          vmmdumpword('  SPIX =',step);
          exc:= nthretrieve(step,name_ptr);
          IF exc=0 THEN vmmdumpstring(name_ptr^);
          vmmdumpnewline;
        END;
      END;
      vmmdumpnewline;
    END;
    IF (WORD(testvmm) AND $0C02) = $0002 THEN
    BEGIN
      vmmdumpnewline;
      vmmdumpstring('HASH TABLE');
      vmmdumpnewline;
      chains:= 0;
      spixs:= 0;  
      max_depth:= 0;
      FOR step:= 1 TO hash_size-1 DO
      BEGIN
        rec_ptr:= @hash_table_ptr^[step];
        temp_depth:= 0;
        WHILE (rec_ptr^.va.va_high<>max_word) AND (exc=0) DO
        BEGIN
          vmmdumpskip;
          IF temp_depth=0 THEN 
          BEGIN
            chains:= chains+1;
            vmmdumpword('  HASH =',step);
          END ELSE vmmdumpskip;
          temp_depth:= temp_depth+1;
          spixs:= spixs+1;
          exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,FALSE,FALSE,rec_ptr);
          IF exc=0 THEN vmmdumpstring(rec_ptr^.str);
          vmmdumpnewline;
        END;
        IF max_depth<temp_depth THEN max_depth:= temp_depth;
      END;
      vmmdumpnewline;
      vmmdumpskip;
      vmmdumpword('  SPIXS=',spixs);
      vmmdumpword(' CHAINS=',chains);
      vmmdumpword('  DEPTH=',max_depth);
      vmmdumpnewline;
      vmmdumpnewline;
    END;
  END;
(*ENDTEST#*)

  exc:= vmmdeletetable(nth_table);
(*#BEGINTEST
IF testvmm>=0 THEN
IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN
BEGIN
 vmmdumproutine('NTH  <--  Delete');
 vmmdumpnewline;
END;
(*ENDTEST#*)
  nthdelete:= exc;
END; (* nthdelete *)


FUNCTION nthsave(VAR str: string ): WORD;
VAR
  conn: file;
  exc: WORD;
BEGIN
(*#BEGINTEST
IF testvmm>0 THEN
  IF (WORD(testvmm) AND $0E00) = $0600 THEN
  BEGIN
    vmmdumproutine('NTH  -->  Save');  
    vmmdumpstring(str);
    vmmdumpnewline; 
  END;
(*ENDTEST#*)
  exc:= vmmsavespecial(nth_table^,str,conn);
  IF exc=0 THEN blockwrite(conn,hash_size,10);
  IF exc=0 THEN blockwrite(conn,spix_to_nt,4);
  IF exc=0 THEN blockwrite(conn,nt_va,4);
  IF exc=0 THEN blockwrite(conn,stack_page,4);
  IF exc=0 THEN blockwrite(conn,p_stack_page,4);
  IF exc=0 THEN blockwrite(conn,spix_to_st[0],32);
  IF exc=0 THEN blockwrite(conn,hash_table_ptr^,4*hash_size);
  IF exc=0 THEN close(conn);
(*#BEGINTEST
  IF testvmm>=0 THEN
  IF ((WORD(testvmm) AND $0D00) = $0500) OR (exc<>0) THEN
  BEGIN
    vmmdumproutine('NTH  <--  Save');
    vmmdumpnewline;
  END;
(*ENDTEST#*)
  nthsave:= exc;
END; (* nthsave *)


FUNCTION nthextend(VAR spix: WORD; VAR name: STRING): WORD;
VAR
  i: WORD;
  rec_ptr: ^rec_type;
  temp_ptr, l_temp_ptr: ptr_st_table_type;
  hash: WORD;
  rotate: BYTE;
  offset, page, i_page: WORD;
  exc: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E01) = $0601 THEN
    BEGIN
      vmmdumproutine('NTH  -->  Extend');
      vmmdumpstring(name);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  hash:= LENGTH(name);
  exc:= 0;
  rotate:= 3;
  FOR i:= 1 TO LENGTH(name) DO
  BEGIN
    spix:= ORD(name[i]);
    IF spix>=96 THEN exc:= e_string;
    hash:= hash XOR (spix SHL rotate);
    rotate:= (rotate AND $07) + 5;
  END;
  hash:= hash mod hash_size;
  rec_ptr:= @hash_table_ptr^[hash];
  WHILE (rec_ptr^.va.va_high<>max_word) AND (exc=0) DO
  BEGIN
    exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,FALSE,FALSE,rec_ptr);
    IF (exc=0) AND (name = rec_ptr^.str) THEN
    BEGIN
      spix:= rec_ptr^.spix;
      exc:= e_exist;
    END;
  END;
  IF exc=0 THEN
  BEGIN
    last_spix:= last_spix+1;
    offset:= last_spix AND 127; (*07FH*)
    IF offset=127 THEN
    BEGIN
      page:= (last_spix+1) SHR 7;
      i_page:= page SHR 3;
      page:= page AND 7;
      IF i_page=0 THEN
      BEGIN
        exc:= vmmextend(nth_table^,spix_to_st[page],512,FALSE,temp_ptr);
        (* temp_ptr dummy *)
        IF exc=0 THEN FOR i:= 0 TO 127 DO temp_ptr^[i].va_high:= max_word;
      END ELSE
      BEGIN
        rec_ptr:= @spix_to_st[page];
        WHILE (i_page>1) AND (exc=0) DO
        BEGIN
          exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,FALSE,FALSE,temp_ptr);
          rec_ptr:= @temp_ptr^[127];
          i_page:= i_page-1;
        END;
        IF exc=0 THEN exc:= vmmretrieve(nth_table^,rec_ptr^.va.va_high,rec_ptr^.va.va_low,TRUE,TRUE,temp_ptr);
        l_temp_ptr:= temp_ptr;
        IF exc=0 THEN
        BEGIN
          exc:= vmmextend(nth_table^,temp_ptr^[127],512,FALSE,temp_ptr);
          IF exc=0 THEN
          BEGIN
            FOR i:= 0 TO 127 DO temp_ptr^[i].va_high:= max_word;
            exc:= vmmunlock(nth_table^,l_temp_ptr);
          END;
        END;
      END;
      IF exc=0 THEN exc:= vmmextend(nth_table^,nt_ptr^[127],512,TRUE,temp_ptr);
      IF exc=0 THEN
      BEGIN
        exc:= vmmunlock(nth_table^,nt_ptr);
        nt_va.va_low:= nt_ptr^[127].va_low;
        nt_va.va_high:= nt_ptr^[127].va_high;
        nt_ptr:= temp_ptr;
        last_spix:= last_spix+1;
        offset:= 0;
      END;
    END;
    IF exc=0 THEN exc:= vmmextend(nth_table^,nt_ptr^[offset],LENGTH(name)+7,FALSE,rec_ptr);
    IF exc=0 THEN
    BEGIN
      rec_ptr^.spix:= last_spix;
      spix:= last_spix;
      rec_ptr^.va.va_low:= hash_table_ptr^[hash].va_low;
      rec_ptr^.va.va_high:= hash_table_ptr^[hash].va_high;
      hash_table_ptr^[hash].va_low:= nt_ptr^[offset].va_low;
      hash_table_ptr^[hash].va_high:= nt_ptr^[offset].va_high;
      rec_ptr^.str:= name;
    END;
  END;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D01) = $0501) OR 
       ((exc<>0) AND (exc<>e_exist)) THEN
    BEGIN
      vmmdumproutine('NTH  <--  Extend');
      IF exc=0 THEN vmmdumpword('  SPIX =',spix);
      vmmdumpstring(name);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthextend:= exc;
END; (* nthextend *)



FUNCTION nthretrieve(spix: WORD;VAR name_ptr: ptr_string): WORD;
VAR
  exc: WORD;
  hash: WORD;
  rec_ptr: ^rec_type;
  offset: WORD;
  i_page: WORD;
  h_nt_page_ptr: ptr_st_table_type;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E02) = $0602 THEN
    BEGIN
      vmmdumproutine('NTH  -->  Retrive');
      vmmdumpword('  SPIX =',spix);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  IF spix<=last_spix THEN
  BEGIN
    offset:= spix AND 127; (*07FH*)
    i_page:= spix SHR 7;
    exc:= vmmretrieve(nth_table^,spix_to_nt.va_high,spix_to_nt.va_low,FALSE,FALSE,h_nt_page_ptr);
    WHILE i_page>0 DO
    BEGIN
      IF exc=0 THEN exc:= vmmretrieve(nth_table^,h_nt_page_ptr^[127].va_high,
                          h_nt_page_ptr^[127].va_low,FALSE,FALSE,h_nt_page_ptr);
      i_page:= i_page-1;
    END;
    IF exc=0 THEN
    BEGIN
      exc:= vmmretrieve(nth_table^,h_nt_page_ptr^[offset].va_high,
                        h_nt_page_ptr^[offset].va_low,FALSE,FALSE,rec_ptr);
      name_ptr:= @rec_ptr^.str;
    END;
  END ELSE exc:= e_nexist;
  IF (exc<>0) AND (testvmm>=0) THEN
  BEGIN
    vmmdumproutine('NTH  Retrieve');
    vmmdumpnewline;
  END;

(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D02) = $0502) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  Retrieve');
      vmmdumpword('  SPIX =',spix);
      IF exc=0 THEN vmmdumpstring(name_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  nthretrieve:= exc;
END; (* nthretrieve *)

FUNCTION nthinsertsymbol(spix, va_high, va_low: WORD): WORD;
VAR
  st_ptr: ptr_st_table_type;
  stack_ptr: ptr_rec_table_type;
  new_stack_ptr: ptr_rec_table_type;
  help: WORD;
  state: BYTE;
  h_va_high, h_va_low, offset, page, i_page, exc: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
  IF (WORD(testvmm) AND $0E10) = $0610 THEN
  BEGIN
    vmmdumproutine('NTH  -->  Insert');
    vmmdumpword('  SPIX =',spix);
    vmmdumpva(va_high,va_low);
    vmmdumpword('   NIV =',save_on_stack);
    vmmdumpnewline;
  END;
(*ENDTEST#*)
  state:= 0;
  offset:= spix AND 127; (*07FH*)
  page:= spix SHR 7;
  i_page:= page SHR 3;
  page:= page AND 7;
  if (spix=290) or (spix=289) then
  spix := spix;
  exc:= vmmretrieve(nth_table^,spix_to_st[page].va_high,
                    spix_to_st[page].va_low,FALSE,i_page=0,st_ptr);
  WHILE (i_page>0) AND (exc=0) DO
  BEGIN
    state:= 1;
    exc:= vmmretrieve(nth_table^,st_ptr^[127].va_high,st_ptr^[127].va_low,FALSE,i_page=1,st_ptr);
    i_page:= i_page-1;
  END;
  h_va_low:= st_ptr^[offset].va_low;
  h_va_high:= st_ptr^[offset].va_high;
  st_ptr^[offset].va_low:= va_low;
  st_ptr^[offset].va_high:= va_high;
  IF (save_on_stack>1) AND (exc=0) THEN
  BEGIN
    state:= 2;
    exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);
    stack_offset:= stack_offset+1;
    IF stack_offset=84 THEN 
    BEGIN
      help:= stack_ptr^[84].va.va_high;
      IF help=max_word THEN
      BEGIN
(*#BEGINTEST
        IF testvmm>0 THEN
          IF (WORD(testvmm) AND $0F10) = $0410 THEN
          BEGIN
            vmmdumproutine('NTH  NEW  Insert');
            vmmdumpva(stack_page.va_high,stack_page.va_low);
            vmmdumpnewline;
          END;
(*ENDTEST#*)
        IF exc=0 THEN exc:= vmmlock(nth_table^,stack_ptr);
        IF exc=0 THEN exc:= vmmextend(nth_table^,stack_ptr^[84].va,512,FALSE,new_stack_ptr);
        IF exc=0 THEN
        BEGIN
          exc:= vmmunlock(nth_table^,stack_ptr);
          new_stack_ptr^[0].va.va_low:= stack_page.va_low;
          new_stack_ptr^[0].va.va_high:= stack_page.va_high;
          new_stack_ptr^[0].spix:= max_word;
          new_stack_ptr^[84].va.va_high:= max_word;
          stack_offset:= 1;
          stack_page.va_low:= stack_ptr^[84].va.va_low;
          stack_page.va_high:= stack_ptr^[84].va.va_high;
          stack_ptr:= new_stack_ptr;
        END;
      END ELSE
      BEGIN
(*#BEGINTEST
        IF testvmm>0 THEN
          IF (WORD(testvmm) AND $0F10) = $0410 THEN
          BEGIN
            vmmdumproutine('NTH  NEXT Insert');
            vmmdumpnewline;
          END;
(*ENDTEST#*)
        stack_page.va_low:= stack_ptr^[84].va.va_low;
        stack_page.va_high:= stack_ptr^[84].va.va_high;
        IF exc=0 THEN
        BEGIN
          state:= 3;
          exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);
        END;
        stack_offset:= 1;
      END;
    END;
    stack_ptr^[stack_offset].va.va_low:= h_va_low;
    stack_ptr^[stack_offset].va.va_high:= h_va_high;
    stack_ptr^[stack_offset].spix:= spix;
    IF (spix>last_spix) AND (testvmm>=0) THEN
    BEGIN
      vmmdumproutine('NTH  Spix');
      vmmdumpword(' SPIX = ',spix);
      vmmdumpnewline;
    END;
  END;

(*#BEGINTEST
  IF testvmm>=0 THEN
  IF ((WORD(testvmm) AND $0D10) = $0510) OR (exc<>0) THEN  
  BEGIN
    vmmdumproutine('NTH  <--  Insert');
    IF (exc<>0) THEN 
    BEGIN
      vmmdumpbyte(' STATE =',state);
      vmmdumpword(' SPIX = ',spix);
    END;
    vmmdumpnewline;
  END;
(*ENDTEST#*)
  nthinsertsymbol:= exc;
END; (* nthinsertsymbol *)

FUNCTION nthbeginlevel: WORD;
VAR
 stack_ptr: ptr_rec_table_type;
 new_stack_ptr: ptr_rec_table_type;
 help, exc: WORD;  
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E04) = $0604 THEN 
    BEGIN
      vmmdumproutine('NTH  -->  BeginLevel');
      vmmdumpnewline; 
    END;
(*ENDTEST#*)

  exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);
  stack_offset:= stack_offset+1;
  IF (stack_offset=84) AND (exc=0) THEN
  BEGIN
    help:= stack_ptr^[84].va.va_high;
    IF help=max_word THEN
    BEGIN
(*#BEGINTEST
      IF testvmm>0 THEN
        IF (WORD(testvmm) AND $0F04) = $0404 THEN
        BEGIN
          vmmdumproutine('NTH  NEW  BeginLevel');
          vmmdumpnewline;
        END;
(*ENDTEST#*)
      exc:= vmmlock(nth_table^,stack_ptr);
      IF exc=0 THEN exc:= vmmextend(nth_table^,stack_ptr^[84].va,512,FALSE,new_stack_ptr);
      IF exc=0 THEN
      BEGIN
        exc:= vmmunlock(nth_table^,stack_ptr);
        new_stack_ptr^[0].va.va_low:= stack_page.va_low;
        new_stack_ptr^[0].va.va_high:= stack_page.va_high;
        new_stack_ptr^[0].spix:= max_word;
        new_stack_ptr^[84].va.va_high:= max_word;
        stack_offset:= 1;
        stack_page.va_low:= stack_ptr^[84].va.va_low;
        stack_page.va_high:= stack_ptr^[84].va.va_high;
        stack_ptr:= new_stack_ptr;
      END;
    END ELSE
    BEGIN
(*#BEGINTEST
      IF testvmm>0 THEN
        IF (WORD(testvmm) AND $0F04) = $0404 THEN
        BEGIN
          vmmdumproutine('NTH  NEXT BeginLevel');
          vmmdumpnewline;
        END;
(*ENDTEST#*)
      stack_page.va_low:= stack_ptr^[84].va.va_low;
      stack_page.va_high:= stack_ptr^[84].va.va_high;
      exc:= vmmretrieve(nth_table^,stack_page.va_high,stack_page.va_low,FALSE,TRUE,stack_ptr);
      stack_offset:= 1;
    END;
  END;
  IF exc=0 THEN stack_ptr^[stack_offset].spix:= 0;
  save_on_stack:= save_on_stack+1;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D04) = $0504) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  BeginLevel');
      vmmdumpword('   NIV =',save_on_stack);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthbeginlevel:= exc;
END; (* nthbeginlevel *)

FUNCTION nthpopstack: WORD;
VAR
  stack_ptr: ptr_rec_table_type;
  spix, exc: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN  
    IF (WORD(testvmm) AND $0E08) = $0608 THEN
    BEGIN
      vmmdumproutine('NTH  -->  PopStack');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  exc:= vmmretrieve(nth_table^,e_stack_page.va_high,e_stack_page.va_low,TRUE,FALSE,stack_ptr);
  spix:= stack_ptr^[e_stack_offset].spix;
  WHILE (spix<>0) AND (exc=0) DO
  BEGIN
    IF (e_stack_offset=0) THEN
    BEGIN
      IF testvmm=200 THEN
      BEGIN
        vmmdumproutine('NTH  Pop Stack');
        vmmdumpva(stack_ptr^[0].va.va_high,stack_ptr^[0].va.va_low);
        vmmdumpnewline;
      END;
      exc:= vmmunlock(nth_table^,stack_ptr);
      e_stack_page.va_low:= stack_ptr^[0].va.va_low;
      e_stack_page.va_high:= stack_ptr^[0].va.va_high;
      IF exc=0 THEN exc:= vmmretrieve(nth_table^,e_stack_page.va_high,e_stack_page.va_low,TRUE,FALSE,stack_ptr);
      e_stack_offset:= 83;
    END ELSE
    BEGIN
      exc:= nthinsertsymbol(spix,stack_ptr^[e_stack_offset].va.va_high,stack_ptr^[e_stack_offset].va.va_low);
      e_stack_offset:= e_stack_offset-1;
    END;
    spix:= stack_ptr^[e_stack_offset].spix;
  END;
  e_stack_offset:= e_stack_offset-1;
  IF exc=0 THEN exc:= vmmunlock(nth_table^,stack_ptr);
  IF (exc<>0) AND (testvmm>=0) THEN
  BEGIN
    vmmdumproutine('NTH  End');
    vmmdumpword(' OFFSET=',e_stack_offset);
    vmmdumpword(' LSPIX =',last_spix);
    vmmdumpnewline;
  END;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  Popstack');
      IF exc<>0 THEN
      BEGIN
        vmmdumpword(' OFFSET=',e_stack_offset);
        vmmdumpword(' LSPIX =',last_spix);
      END;
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthpopstack:= exc;
END; (* nthpopstack *)

FUNCTION nthendlevel: WORD;
VAR
 exc: WORD;
 help: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E08) = $0608 THEN
    BEGIN  
      vmmdumproutine('NTH  -->  EndLevel');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  help:= save_on_stack;
  save_on_stack:= 0;
  e_stack_page.va_low:= stack_page.va_low;
  e_stack_page.va_high:= stack_page.va_high; 
  e_stack_offset:= stack_offset;
  exc:= nthpopstack;
  save_on_stack:= help-1;
  stack_page.va_low:= e_stack_page.va_low;
  stack_page.va_high:= e_stack_page.va_high;
  stack_offset:= e_stack_offset;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  EndLevel');
      vmmdumpword('   NIV =',save_on_stack);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthendlevel:= exc;
END; (* nthendlevel *)

FUNCTION nthbeginprogram: WORD;
VAR
 exc: WORD;
 help: WORD;
 help2: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E08) = $0608 THEN
    BEGIN
      vmmdumproutine('NTH  -->  BeginProgram');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  help:= save_on_stack;
  e_stack_page.va_low:= stack_page.va_low;
  e_stack_page.va_high:= stack_page.va_high;
  e_stack_offset:= stack_offset;
  IF program_niv=0 THEN 
  BEGIN
    save_on_stack:= 0;
    exc:= nthpopstack;
    stack_page.va_low:= e_stack_page.va_low;
    stack_page.va_high:= e_stack_page.va_high;
    stack_offset:= e_stack_offset;
    IF exc=0 THEN exc:= nthbeginlevel;
    save_on_stack:= help;
  END ELSE
  BEGIN
    save_on_stack:= 4095; (*0FFFH*)
    stack_page.va_low:= p_stack_page.va_low;
    stack_page.va_high:= p_stack_page.va_high;
    stack_offset:= p_stack_offset;
    exc:= nthbeginlevel;
    help2:= help-last_program_niv;
    end_program_pops:= help2-1;
    WHILE help2>2 DO
    BEGIN
      IF exc=0 THEN exc:= nthpopstack;
      help2:= help2-1;
      IF exc=0 THEN exc:= nthbeginlevel;
    END;
    IF exc=0 THEN exc:= nthpopstack;
    IF exc=0 THEN exc:= nthpopstack;
    p_stack_page.va_low:= stack_page.va_low;
    p_stack_page.va_high:= stack_page.va_high;
    p_stack_offset:= stack_offset;
    stack_page.va_low:= e_stack_page.va_low;
    stack_page.va_high:= e_stack_page.va_high;
    stack_offset:= e_stack_offset;
    save_on_stack:= help-2;
    IF exc=0 THEN exc:= nthbeginlevel;
    IF exc=0 THEN exc:= nthbeginlevel;
  END;
  program_niv:= program_niv+1;
  last_program_niv:= save_on_stack;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  BeginProgram');
      vmmdumpword('   NIV =',save_on_stack);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthbeginprogram:= exc;
END; (* nthbeginprogram *)


FUNCTION nthendprogram: WORD;
VAR
  exc: WORD;
  help: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E08) = $0608 THEN
    BEGIN
      vmmdumproutine('NTH  -->  EndProgram');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  exc:= 0;
  IF program_niv>1 THEN
  BEGIN
    last_program_niv :=  last_program_niv - end_program_pops - 1;
    help:= save_on_stack;
    save_on_stack:= max_word;
    e_stack_page.va_low:= p_stack_page.va_low;
    e_stack_page.va_high:= p_stack_page.va_high;
    e_stack_offset:= p_stack_offset;
    exc:= 0;
    WHILE end_program_pops>1 DO
    BEGIN
      IF exc=0 THEN exc:= nthpopstack;
      IF exc=0 THEN exc:= nthbeginlevel;
      end_program_pops:= end_program_pops-1;
    END;
    IF exc=0 THEN exc:= nthpopstack;
    save_on_stack:= help;
    p_stack_page.va_low:= e_stack_page.va_low;
    p_stack_page.va_high:= e_stack_page.va_high;
    p_stack_offset:= e_stack_offset;
  END;
  program_niv:= program_niv-1;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D08) = $0508) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  EndProgram');
      vmmdumpword('   NIV =',save_on_stack);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthendprogram:= exc;
END; (* nthendprogram *)
  

FUNCTION nthfindsymbol(spix: WORD; VAR va: st_address): WORD;
VAR
 st_ptr: ptr_st_table_type;
 offset, page, i_page, exc: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E20) = $0620 THEN
    BEGIN
      vmmdumproutine('NTH  -->  Find');
      vmmdumpword('  SPIX =',spix);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  IF spix>last_spix THEN exc:= e_nexist
  ELSE BEGIN
    offset:= spix AND 127; (*07FH*)
    page:= spix SHR 7;
    i_page:= page SHR 3;
    page:= page AND 7;
    if spix = 290 then
    spix := 290;  (* hha *)
    exc:= vmmretrieve(nth_table^,spix_to_st[page].va_high,spix_to_st[page].va_low,FALSE,FALSE,st_ptr);
    WHILE (i_page>0) AND (exc=0) DO
    BEGIN
      exc:= vmmretrieve(nth_table^,st_ptr^[127].va_high,st_ptr^[127].va_low,FALSE,FALSE,st_ptr);
      i_page:= i_page-1;
    END;
    va.va_low:= st_ptr^[offset].va_low;
    va.va_high:= st_ptr^[offset].va_high;
    IF (va.va_high=max_word) AND (exc=0) THEN
    BEGIN
      exc:= e_nexist;
      va.va_low:= max_word;
    END;
  END;
  IF (exc<>0) AND (testvmm>=0) THEN
  BEGIN
    vmmdumproutine('NTH  Find');
    vmmdumpword(' SPIX = ',spix);
    vmmdumpnewline;
  END;
(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D20) = $0520) OR (exc<>0) THEN
    BEGIN
      vmmdumproutine('NTH  <--  Find');
      vmmdumpword(' SPIX = ',spix);
      IF exc=0 THEN vmmdumpva(va.va_high,va.va_low);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  nthfindsymbol:= exc;
END; (* nthfindsymbol *)
 
BEGIN 
END.