(* ---------------    VIRTUAL MEMORY MANAGER    --------------- *)
{$F+,O+}
unit vmmunit;


interface
uses pscplm, mpaunit, vmmdump;

FUNCTION vmmallocate(seg_size: word; VAR exc: word): POINTER;
FUNCTION vmmcreatetable(VAR user_tbl_ptr: ptr_tbl_dscr_type;
                        VAR vmm_tbl_name: string;
                        max_residents, page_size: word): WORD;
FUNCTION vmmdeletetable(VAR user_tbl_ptr: ptr_tbl_dscr_type): WORD;
FUNCTION vmmgetspecial(VAR user_tbl_ptr: ptr_tbl_dscr_type;
                       VAR vmm_tbl_name: string;
                       max_residents: WORD;
                       VAR str: string;
                       VAR conn: file): WORD;
FUNCTION vmmgettable(VAR user_tbl_ptr: ptr_tbl_dscr_type;
                     VAR vmm_tbl_name: string;
                     max_residents: WORD;
                     VAR str: string;
                     VAR special: st_address): WORD;
FUNCTION vmmsavespecial(VAR vmm_tbl_dscr: tbl_dscr_type;
                          VAR str: string;
                          VAR conn: FILE): WORD;
FUNCTION vmmsavetable(VAR user_tbl: tbl_dscr_type;
                      VAR str: string;
                      special_va_high, special_va_low: WORD): WORD;
FUNCTION vmmretrieve(VAR vmm_tbl_dscr: tbl_dscr_type;
                      va_high_offset, va_low_offset: WORD;
                      page_lock, page_update: BOOLEAN;
                      VAR rec_ptr): WORD;
FUNCTION vmmextend(VAR vmm_tbl_dscr: tbl_dscr_type;
                   VAR va: st_address;  (* - address of virtual address of searched record. *)
                   record_size: WORD;  (* - size of requested record. *)
                   lock_page: BOOLEAN;    (* - true: permanent lock. false: no permanent lock. *)
                   VAR rec_ptr (* - address of pointer to new record. *)
                  ): WORD;
FUNCTION vmmextendcopy(VAR vmm_tbl_dscr: tbl_dscr_type; (* - address of table descriptor. *)
                       VAR va: st_address; (* - address of virtual address of searched record. *)
                       record_size: WORD; (* - size of requested record. *)
                       lock_page: BOOLEAN; (* - true: permanent lock. false: no permanent lock. *)
                       VAR rec_ptr; (* - address of pointer to new record. *)
                       va_to_copy_high, va_to_copy_low: WORD):WORD;
FUNCTION vmmlock(VAR vmm_tbl_dscr: tbl_dscr_type;
                     vmm_page_dscr_ptrr: pointer): WORD;
FUNCTION vmmunlock(VAR vmm_tbl_dscr: tbl_dscr_type;
                       vmm_page_dscr_ptrr: pointer): WORD;
FUNCTION vmmupdate(VAR vmm_tbl_dscr: tbl_dscr_type;
                       vmm_page_dscr_ptrr: pointer): 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;


CONST
  write_access = 2;
  read_access = 1;
  read_write_access = 3;
  seek_rel_backw = 1;
  seek_abs_loc = 2;
  seek_rel_forw = 3;
  seek_eof_rel_backw = 4;
VAR
  min_va_low: WORD;
  min_va_high: WORD;
  
     

(* ---------------       UNSIGNED ARIT          -------------- *)
FUNCTION u_add_dw_w(VAR dw: st_address; w: word ):BOOLEAN;
BEGIN
  dw.va_low:= dw.va_low + w;
  IF dw.va_low<w THEN BEGIN
    dw.va_high:= dw.va_high + 1;
    u_add_dw_w:= dw.va_high<>0;
  END ELSE
    u_add_dw_w:= true;
END;




(* ---------------         VMMALLOCATE        --------------- *)
FUNCTION vmmallocate(seg_size: word; VAR exc: word): POINTER;
VAR
  addr:  POINTER;
BEGIN
  seg_size := seg_size + 16;

  getmem(addr, seg_size);
  addr := ptr(seg(addr^) + 1,0);
  exc:= 0;
  vmmallocate:= addr;
END;

 
(* ---------------        VMMDEALLOCATE       --------------- *)
PROCEDURE vmmdeallocate(VAR seg_ptr: ptr_page_dscr_type; VAR exc: word);
BEGIN
  exc:= 0;
  (* dqfree( seg( seg_ptr ), exc ); !!! TURBO !!! *)
  IF ( exc = e_ok ) THEN seg_ptr:= nil;
END;

(* ---------------     VMMLOCATECANDIDATE    --------------- *)

FUNCTION vmmlocatecandidate(VAR vmm_tbl_dscr: tbl_dscr_type; VAR rec_ptr: ptr_page_dscr_type): word;
VAR
  vmm_page_dscr_ptr: ptr_page_dscr_type;
 (* vmm_page_dscr: page_dscr_type; hha *)
  page_offset: WORD;
  step: WORD;
  best_is_refered: WORD;
  exc_code: WORD;
  dummy_exc: WORD;
  state: BYTE;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E20) = $0A20 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Locate Cand.');
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  exc_code:= e_ok;
  state:= 0;
  WHILE ( exc_code = e_ok ) AND ( state < 3 ) DO
  BEGIN
    state:= state + 1;
    CASE state OF
     0: ;
     1:  BEGIN
          (* start address: *)
          vmm_page_dscr_ptr:= vmm_tbl_dscr.page_chain_head;
          rec_ptr:= nil;
          (* locate resident page to receive off core resident *)
          best_is_refered:=max_word;
          FOR step:=2 TO vmm_tbl_dscr.no_of_page DO
          BEGIN
(*#BEGINTEST
            IF testvmm>0 THEN
              IF (WORD(testvmm) AND $0F20) = $0820 THEN
              BEGIN
                vmmdumproutine('VMM  -1-  Locate Cand.');
                vmmdumpva(vmm_page_dscr_ptr^.va.va_high,vmm_page_dscr_ptr^.va.va_low);
                vmmdumplocks(vmm_page_dscr_ptr^.perm_locks);
                vmmdumpptr(vmm_page_dscr_ptr^);
                vmmdumpnewline;
              END;
(*ENDTEST#*)
             vmm_page_dscr_ptr:=vmm_page_dscr_ptr^.succ_ptr;
             IF (best_is_refered>vmm_page_dscr_ptr^.is_refered) AND
                (vmm_page_dscr_ptr^.perm_locks=0) THEN
             BEGIN
               best_is_refered:=vmm_page_dscr_ptr^.is_refered;
               rec_ptr:=vmm_page_dscr_ptr;
             END;
           END;

           vmm_page_dscr_ptr:= rec_ptr;
           IF ( rec_ptr = nil ) THEN exc_code:= e_vmm_memory;

         END;
      2: BEGIN
           IF vmm_page_dscr_ptr^.updated THEN
           BEGIN
           if vmm_page_dscr_ptr^.va.va_high <> 0 then
           state := 2;
             seek( vmm_tbl_dscr.file_conn, longint(vmm_page_dscr_ptr^.va) );
           END ELSE state:= 3;  (* ! *)
         END;
      3: BEGIN
(*#BEGINTEST
           vmm_tbl_dscr.stcs.disk_writes:= vmm_tbl_dscr.stcs.disk_writes+1;
(*ENDTEST#*)
           blockwrite( vmm_tbl_dscr.file_conn, vmm_page_dscr_ptr^.data_area,
                    vmm_tbl_dscr.page_size );
         END;
    END; (* CASE state OF 0..3 *)
  END;  (* WHILE exc_code = e_ok *)

(*#BEGINTEST
  IF (testvmm>=0) AND (exc_code<>e_ok) THEN
  BEGIN
    vmmdumproutine('VMM  ERR  Locate Cand.');
    vmmdumpline;
    vmmdumperror(state,exc_code);
    vmmdumpnewline;
  END;
(*ENDTEST#*)

(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D20) = $0920 THEN
    BEGIN
      vmmdumproutine('VMM  <--  Locate Cand.');
      vmmdumpskip;
      vmmdumpskip;
      vmmdumpptr(rec_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  vmmlocatecandidate:=exc_code;
END; (*vmmlocatecandidate*)


(* ------------      VMMLOCATERESIDENT    ------------- *)

FUNCTION vmmlocateresident(VAR vmm_tbl_dscr: tbl_dscr_type;
                           va_low_offset, va_high_offset: word;
                           VAR vmm_page_dscr_ptr: ptr_page_dscr_type): boolean;
VAR
  temp_page_dscr_ptr: ptr_page_dscr_type;
  chain_no: WORD;
  help: boolean;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E10) = $0A10 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Locate Resident');
      vmmdumpva(va_high_offset,va_low_offset);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  va_low_offset:= va_low_offset AND vmm_tbl_dscr.low_page_mask;
  chain_no:= (va_low_offset SHR vmm_tbl_dscr.bits_to_page_offset) AND 15;
  temp_page_dscr_ptr:= vmm_tbl_dscr.page_ptrs[chain_no];
  chain_no:= vmm_tbl_dscr.no_in_page_chains[chain_no] + 1;
  WHILE chain_no>1 DO
  BEGIN
    IF (temp_page_dscr_ptr^.va.va_low=va_low_offset) AND
       (temp_page_dscr_ptr^.va.va_high=va_high_offset)
    THEN chain_no:= 0
    ELSE BEGIN
      chain_no:= chain_no-1;
      temp_page_dscr_ptr:= temp_page_dscr_ptr^.pred_ptr;
    END;
  END;
  IF chain_no=0 THEN
  BEGIN
    vmm_page_dscr_ptr:= temp_page_dscr_ptr;
    help:= true;
  END ELSE
  BEGIN
    vmm_page_dscr_ptr:=nil;
    help:= false;
  END;

(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D10) = $0910 THEN
    BEGIN
      vmmdumproutine('VMM  <--  Locate Resident');
      vmmdumpword('  LOW = ',OFS(vmm_page_dscr_ptr^));
      vmmdumpword(' HIGH = ',SEG(vmm_page_dscr_ptr^));
      vmmdumpptr(vmm_page_dscr_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  vmmlocateresident:= help;
END; (* vmmlocateresident *)


(* ---------------        VMMCHAINPAGE       --------------- *)
PROCEDURE vmmchainpage(VAR vmm_tbl_dscr: tbl_dscr_type;
                       va_low_offset, va_high_offset: word;
                       VAR vmm_page_dscr: page_dscr_type);
VAR
  chain_no: WORD;
  vmm_succ_page_dscr_ptr: ptr_page_dscr_type;
  vmm_pred_page_dscr_ptr: ptr_page_dscr_type;
BEGIN
  chain_no:= (va_low_offset SHR vmm_tbl_dscr.bits_to_page_offset) AND 15;
  IF vmm_tbl_dscr.no_in_page_chains[chain_no] = 0 THEN
  BEGIN
    vmm_succ_page_dscr_ptr:= vmm_tbl_dscr.page_chain_head;
    vmm_pred_page_dscr_ptr:= vmm_succ_page_dscr_ptr^.pred_ptr;
  END ELSE
  BEGIN
    vmm_pred_page_dscr_ptr:= vmm_tbl_dscr.page_ptrs[chain_no];
    vmm_succ_page_dscr_ptr:= vmm_pred_page_dscr_ptr^.succ_ptr;
  END;
  vmm_tbl_dscr.page_ptrs[chain_no]:= @vmm_page_dscr;
  vmm_succ_page_dscr_ptr^.pred_ptr:= @vmm_page_dscr;
  vmm_pred_page_dscr_ptr^.succ_ptr:= @vmm_page_dscr;
  vmm_tbl_dscr.no_in_page_chains[chain_no]:= vmm_tbl_dscr.no_in_page_chains[chain_no] + 1;
  vmm_page_dscr.va.va_low:= va_low_offset;
  vmm_page_dscr.va.va_high:= va_high_offset;
  vmm_page_dscr.succ_ptr:= vmm_succ_page_dscr_ptr;
  vmm_page_dscr.pred_ptr:= vmm_pred_page_dscr_ptr;
  vmm_page_dscr.perm_locks:= 0;
  vmm_page_dscr.updated:= false;
END; (* vmmchainpage *)


(* ---------------       VMMUNCHAINPAGE      --------------- *)
PROCEDURE vmmunchainpage(VAR vmm_tbl_dscr: tbl_dscr_type;
                         VAR vmm_page_dscr: page_dscr_type);
VAR
  chain_no: WORD;
  neighb_page_ptr: ptr_page_dscr_type;
  (* neighb_page_dscr = neighb_page_ptr^ *)
BEGIN
  chain_no:= (vmm_page_dscr.va.va_low SHR vmm_tbl_dscr.bits_to_page_offset) AND 15;
  IF @vmm_page_dscr = vmm_tbl_dscr.page_ptrs[chain_no]
  THEN vmm_tbl_dscr.page_ptrs[chain_no]:= vmm_page_dscr.pred_ptr;
  vmm_tbl_dscr.no_in_page_chains[chain_no]:=
    vmm_tbl_dscr.no_in_page_chains[chain_no] - 1;
  neighb_page_ptr:= vmm_page_dscr.pred_ptr;
  neighb_page_ptr^.succ_ptr:= vmm_page_dscr.succ_ptr;
  neighb_page_ptr:= vmm_page_dscr.succ_ptr;
  neighb_page_ptr^.pred_ptr:= vmm_page_dscr.pred_ptr;
END; (* vmmunchainpage *)


(* ---------------       VMMCREATETABLE      --------------- *)
FUNCTION vmmcreatetable(VAR user_tbl_ptr: ptr_tbl_dscr_type;
                        VAR vmm_tbl_name: string;
                        max_residents, page_size: word): WORD;
VAR
  vmm_tbl_dscr_ptr: ptr_tbl_dscr_type;
  page_dscr_ptr: ptr_page_dscr_type;
  stcs_ptr: ptr_page_dscr_type;
  temp_vmm_tbl_dscr: tbl_dscr_type;
  rec_ptr: ptr_page_dscr_type;
  virtual_addr: st_address;
  state: BYTE;
  step: WORD;
  exc_code: WORD;
  help_str_ptr: ptr_string;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E00) = $0A00 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Create');
      vmmdumpskip;
      vmmdumpsize(page_size);
      vmmdumpsize(max_residents);
      vmmdumpstring(vmm_tbl_name);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  vmm_tbl_dscr_ptr:= @temp_vmm_tbl_dscr;
  state:= 0;
  exc_code:= e_ok;
  page_dscr_ptr:= nil;
  rec_ptr:= nil;
(* !!! TURBO !!!  vmm_tbl_dscr_ptr^.file_conn:= max_word; *)
  vmm_tbl_dscr_ptr^.page_chain_head:= nil;
  vmm_tbl_dscr_ptr^.stcs.access_low:= 0;
  vmm_tbl_dscr_ptr^.stcs.access_high:= 0;
  vmm_tbl_dscr_ptr^.stcs.disk_reads:= 0;
  vmm_tbl_dscr_ptr^.stcs.disk_writes:= 0;
  vmm_tbl_dscr_ptr^.va_eoi.va_low:= min_va_low;
  vmm_tbl_dscr_ptr^.va_eoi.va_high:= min_va_high;
  vmm_tbl_dscr_ptr^.no_of_residents:= 0;
  vmm_tbl_dscr_ptr^.max_residents:= 1; (* max user for table descriptor *)
  vmm_tbl_dscr_ptr^.no_of_page:= 0;
  (* - Round 'page_size' to nearest higher power of two. *)
  (* - and page_size can contain table descriptor        *)
  vmm_tbl_dscr_ptr^.bits_to_page_offset:=0;
  IF page_size<SIZEOF(tbl_dscr_type) THEN page_size:=SIZEOF(tbl_dscr_type);
  vmm_tbl_dscr_ptr^.page_size:= page_size;
  vmm_tbl_dscr_ptr^.low_page_mask:= max_word;
  WHILE ( 1 < page_size ) DO
  BEGIN
    vmm_tbl_dscr_ptr^.low_page_mask:= vmm_tbl_dscr_ptr^.low_page_mask SHL 1;
    page_size:= page_size SHR 1;
    vmm_tbl_dscr_ptr^.bits_to_page_offset:=vmm_tbl_dscr_ptr^.bits_to_page_offset+1;
  END;
  page_size:= ( NOT vmm_tbl_dscr_ptr^.low_page_mask ) + 1;  (* - nearest lower power of two. *)
  IF ( vmm_tbl_dscr_ptr^.page_size <> page_size ) THEN
  BEGIN
    vmm_tbl_dscr_ptr^.low_page_mask:= vmm_tbl_dscr_ptr^.low_page_mask SHL 1;
    vmm_tbl_dscr_ptr^.bits_to_page_offset:=vmm_tbl_dscr_ptr^.bits_to_page_offset+1;
  END;
  vmm_tbl_dscr_ptr^.offset_mask:= NOT vmm_tbl_dscr_ptr^.low_page_mask;
  vmm_tbl_dscr_ptr^.page_size:= vmm_tbl_dscr_ptr^.offset_mask + 1;
  vmm_tbl_dscr_ptr^.page_seg_size:= vmm_tbl_dscr_ptr^.page_size + SIZEOF( page_dscr_type ) - max_page_data_length - 1;
  vmm_tbl_dscr_ptr^.no_in_page_chains[0]:= 1;
  FOR step:=1 TO 15 DO vmm_tbl_dscr_ptr^.no_in_page_chains[step]:= 0;
  WHILE ( exc_code = e_ok ) AND ( state < 10 ) DO
  BEGIN
    state:= state + 1;

(*#BEGINTEST
    IF testvmm>0 THEN
      IF (WORD(testvmm) AND $0E00) = $0A00 THEN
      BEGIN
        vmmdumproutine('VMM  ---  Create');
        vmmdumpskip;
        vmmdumpstring(vmm_tbl_name);
        IF state>7 THEN  vmmdumpptr(rec_ptr^);
        IF state>9 THEN BEGIN
          help_str_ptr:= ptr_string(rec_ptr);
          vmmdumpstring(help_str_ptr^);
        END;
        vmmdumpnewline;
      END;
(*ENDTEST#*)
    CASE state of
     0: ;
     1: IF ( user_tbl_ptr <> nil ) THEN exc_code:= e_vmm_tbl_exist;
     2: (* allocate first page to hold table description. *)
        page_dscr_ptr:=
          ptr_page_dscr_type(
            vmmallocate( vmm_tbl_dscr_ptr^.page_seg_size, exc_code ));
     3: BEGIN
          page_dscr_ptr^.va.va_low:= min_va_low;
          page_dscr_ptr^.va.va_high:= min_va_high;
          page_dscr_ptr^.pred_ptr:= page_dscr_ptr;
          page_dscr_ptr^.succ_ptr:= page_dscr_ptr;
          page_dscr_ptr^.perm_locks:= 0;
          page_dscr_ptr^.updated:= false;
          vmm_tbl_dscr_ptr^.page_ptrs[0]:= page_dscr_ptr;
          vmm_tbl_dscr_ptr:= @page_dscr_ptr^.data_area[0];
          user_tbl_ptr:= @page_dscr_ptr^.data_area[0];
          MOVE(temp_vmm_tbl_dscr, vmm_tbl_dscr_ptr^, SIZEOF( tbl_dscr_type ) );
          vmm_tbl_dscr_ptr^.page_chain_head:= page_dscr_ptr;
          vmm_tbl_dscr_ptr^.no_of_residents:= vmm_tbl_dscr_ptr^.no_of_residents + 1;
          state:= 4; (* no test of file already exist *)
        END;
     4: BEGIN
          assign(vmm_tbl_dscr_ptr^.file_conn, vmm_tbl_name );
          IF ( exc_code = e_fnexist ) THEN exc_code:= e_ok ELSE
          IF ( exc_code = e_fexist ) THEN
          BEGIN (* - file exists. *)
            (*dqdetach( vmm_tbl_dscr_ptr^.file_conn, exc_code ); !!! TURBO !!! *)
            exc_code:= e_vmm_fexist;
          END;
        END;
     5:  assign(vmm_tbl_dscr_ptr^.file_conn, vmm_tbl_name );
     6:  rewrite( vmm_tbl_dscr_ptr^.file_conn, 1);
     7: exc_code:= vmmextend( vmm_tbl_dscr_ptr^, virtual_addr,
                              SIZEOF( tbl_dscr_type ), true, rec_ptr );
     8: exc_code:= vmmextend( vmm_tbl_dscr_ptr^, vmm_tbl_dscr_ptr^.name_va,
                              LENGTH(vmm_tbl_name) + 1, false, rec_ptr );
     9: MOVE( vmm_tbl_name, rec_ptr^, LENGTH(vmm_tbl_name) + 1 );
     10: BEGIN
           vmm_tbl_dscr_ptr^.max_residents:= max_residents+vmm_tbl_dscr_ptr^.no_of_residents;
           (* add use of table descriptor *)
         END;
    END; (* CASE state OF 0..10 *)
  END; (* WHILE exc_code = e_ok *)

(*#BEGINTEST
  IF (testvmm>=0) AND (exc_code<>e_ok) THEN 
  BEGIN 
    vmmdumproutine('VMM  ERR  Create');
    vmmdumpline;
    vmmdumperror(state,exc_code);
    vmmdumpnewline;
  END;
(*ENDTEST#*)


(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D00) = $0900 THEN
    BEGIN
      vmmdumproutine('VMM  <--  Create');
      help_str_ptr:= ptr_string(rec_ptr);
      vmmdumpstring(help_str_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  vmmcreatetable:= exc_code;
END; (* vmmcreatetable *)


(* ---------------       VMMDELETETABLE      --------------- *)
FUNCTION vmmdeletetable(VAR user_tbl_ptr: ptr_tbl_dscr_type): WORD;
VAR
  vmm_tbl_dscr_ptr: ptr_tbl_dscr_type;
  (* vmm_tbl_dscr = vmm_tbl_dscr_ptr^ *)
  state: BYTE;
  exc_code: WORD;
  file_name_ptr: ptr_string;
  vmm_page_dscr_ptr: ptr_page_dscr_type;
  (* vmm_page_dscr = vmm_page_dscr_ptr^ *)

BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E00) = $0A00 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Delete');
      vmmdumpskip;
      vmmdumpskip;
      vmmdumpptr(user_tbl_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  vmm_tbl_dscr_ptr:= user_tbl_ptr;
  exc_code:= e_ok;
  state:= 0;
  WHILE ( exc_code = e_ok ) AND ( state < 7 ) DO
  BEGIN
    state:= state + 1;
    CASE state OF
     0: ;
     1:  IF ( vmm_tbl_dscr_ptr = nil )
        THEN exc_code:= e_vmm_tbl_nexist
        ELSE exc_code:= vmmretrieve(vmm_tbl_dscr_ptr^,
                                    vmm_tbl_dscr_ptr^.name_va.va_high,
                                    vmm_tbl_dscr_ptr^.name_va.va_low,
                                    false,false,
                                    ptr_page_dscr_type(file_name_ptr));
     2: BEGIN
(*#BEGINTEST
          IF testvmm>=0 THEN 
            vmmdumpstcs(file_name_ptr^,vmm_tbl_dscr_ptr^.stcs);
(*ENDTEST#*)
          close(vmm_tbl_dscr_ptr^.file_conn);
          IF exc_code = e_ok 
          THEN erase( vmm_tbl_dscr_ptr^.file_conn ); (*file_name_ptr^*)
          state:= 6; (* skip deallocate of pages *)
        END;
     3: BEGIN
          vmm_page_dscr_ptr:= vmm_tbl_dscr_ptr^.page_chain_head;
          vmm_page_dscr_ptr:= vmm_page_dscr_ptr^.succ_ptr;
        END;
     4: vmmunchainpage( vmm_tbl_dscr_ptr^, vmm_page_dscr_ptr^ );
     5: vmmdeallocate( vmm_page_dscr_ptr, exc_code );
     6: BEGIN
          vmm_tbl_dscr_ptr^.no_of_residents:= vmm_tbl_dscr_ptr^.no_of_residents - 1;
          IF ( 0 < vmm_tbl_dscr_ptr^.no_of_residents )
          THEN  (* loop *) state:= 2;
        END;
     7:  user_tbl_ptr:= nil;
    END; (* CASE state OF 0..7 *)
  END; (* WHILE exc_code = e_ok *)

(*#BEGINTEST
  IF (testvmm>=0) AND (exc_code<>e_ok) THEN 
  BEGIN 
    vmmdumproutine('VMM  ERR  Delete');
    vmmdumpline; 
    vmmdumperror(state,exc_code);
    vmmdumpnewline;
  END;
(*ENDTEST#*)


(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D00) = $0900 THEN
    BEGIN
      vmmdumproutine('VMM  <--  Delete');
      vmmdumpstring(file_name_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  vmmdeletetable:= exc_code;
END; (* vmmdeletetable *)



FUNCTION vmmgetspecial(VAR user_tbl_ptr: ptr_tbl_dscr_type;
                       VAR vmm_tbl_name: string;
                       max_residents: WORD;
                       VAR str: string;
                       VAR conn: FILE): WORD;
VAR
  p_size: WORD;
  p_no: WORD;
  step: WORD;
  read_bytes: WORD;
  vmm_tbl_dscr_ptr: ptr_tbl_dscr_type;
  (* vmm_tbl_dscr = vmm_tbl_dscr_ptr^ *)
  page_dscr_ptr: ptr_page_dscr_type;
  (* page_dscr = page_dscr_ptr *)
  va: st_address;
  rec_ptr: ptr_page_dscr_type;
  exc: WORD;

BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E00) = $0A00 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Get');
      vmmdumpsize(max_residents);
      vmmdumpstring(str);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  exc:= 0;
  assign(conn,str);
  IF exc=0 THEN reset(conn, 1);
  IF exc=0 THEN blockread(conn,p_size,2,read_bytes);
  IF (exc=0) AND (read_bytes<>2) THEN exc:= e_vmm_tbl_nexist;
  IF (exc=0) AND (p_size<SIZEOF(tbl_dscr_type)) THEN exc:= e_vmm_tbl_nexist;
  IF exc=0 THEN page_dscr_ptr:=
    ptr_page_dscr_type(vmmallocate(p_size+SIZEOF(page_dscr_type) - max_page_data_length -1,exc));
  IF exc=0 THEN
  BEGIN
    page_dscr_ptr^.va.va_low:= min_va_low;
    page_dscr_ptr^.va.va_high:= min_va_high;
    page_dscr_ptr^.pred_ptr:= page_dscr_ptr;
    page_dscr_ptr^.succ_ptr:= page_dscr_ptr;
    page_dscr_ptr^.perm_locks:= 1;
    page_dscr_ptr^.updated:= false;
    vmm_tbl_dscr_ptr:= @page_dscr_ptr^.data_area[0];
    vmm_tbl_dscr_ptr^.page_size:= p_size;
    blockread(conn,page_dscr_ptr^.data_area[2],p_size-2,read_bytes);
    IF (exc=0) AND (read_bytes<>p_size-2) THEN exc:= e_vmm_tbl_nexist;
    p_no:= vmm_tbl_dscr_ptr^.no_of_page;
    vmm_tbl_dscr_ptr^.page_chain_head:= page_dscr_ptr;
    vmm_tbl_dscr_ptr^.no_of_page:= 1;
    vmm_tbl_dscr_ptr^.last_used_ptr:= page_dscr_ptr;
    vmm_tbl_dscr_ptr^.no_of_residents:= 1;
    vmm_tbl_dscr_ptr^.max_residents:= max_residents + 1 ;
    vmm_tbl_dscr_ptr^.stcs.access_low:= 1;
    vmm_tbl_dscr_ptr^.stcs.access_high:= 0;
    vmm_tbl_dscr_ptr^.stcs.disk_reads:= 0;
    vmm_tbl_dscr_ptr^.stcs.disk_writes:= 0;
    vmm_tbl_dscr_ptr^.va_eoi.va_low:= min_va_low;
    vmm_tbl_dscr_ptr^.va_eoi.va_high:= min_va_high;
    IF u_add_dw_w(vmm_tbl_dscr_ptr^.va_eoi,p_size) THEN
    ELSE exc:= e_vmm_va_overflow;
    vmm_tbl_dscr_ptr^.page_ptrs[0]:= page_dscr_ptr;
    vmm_tbl_dscr_ptr^.no_in_page_chains[0]:= 1;
    FOR step:= 1 TO 15 DO vmm_tbl_dscr_ptr^.no_in_page_chains[step]:= 0;
  END;
  IF exc=0 THEN assign(vmm_tbl_dscr_ptr^.file_conn, vmm_tbl_name);
  IF exc=0 THEN rewrite(vmm_tbl_dscr_ptr^.file_conn,1);
  FOR step:= 2 TO p_no DO
  BEGIN
     IF exc=0 THEN exc:= vmmextend(vmm_tbl_dscr_ptr^,va,p_size,false,rec_ptr);
    IF exc=0 THEN
     blockread(conn,rec_ptr^,p_size,read_bytes);
    IF (exc=0) AND (read_bytes<>p_size) THEN exc:= e_vmm_tbl_nexist;
  END;
  IF exc=0 THEN exc:= vmmextend(vmm_tbl_dscr_ptr^,vmm_tbl_dscr_ptr^.name_va,
                                 LENGTH(vmm_tbl_name) + 1,false,rec_ptr);
  IF exc=0 THEN MOVE(vmm_tbl_name, rec_ptr^ , LENGTH(vmm_tbl_name)+1);
  IF exc=0 THEN 
  BEGIN
    user_tbl_ptr:= vmm_tbl_dscr_ptr;
    IF (checktimelow=0) AND (checktimehigh=0) THEN
    BEGIN
      checktimelow:= vmm_tbl_dscr_ptr^.low_check_time;
      checktimehigh:= vmm_tbl_dscr_ptr^.high_check_time;
    END ELSE
    BEGIN
      IF (checktimelow<>vmm_tbl_dscr_ptr^.low_check_time) OR
         (checktimehigh<>vmm_tbl_dscr_ptr^.high_check_time)
      THEN exc:=e_vmm_version;
    END;
  END;
  vmmgetspecial:= exc;
END; (* vmmgetspecial *)

FUNCTION vmmgettable(VAR user_tbl_ptr: ptr_tbl_dscr_type;
                     VAR vmm_tbl_name: string;
                     max_residents: WORD;
                     VAR str: string;
                     VAR special: st_address): WORD;
VAR
  tbl_ptr: ptr_tbl_dscr_type;
  conn: FILE;
  exc: WORD;
BEGIN
  exc:= vmmgetspecial(user_tbl_ptr, vmm_tbl_name,
                       max_residents,str,conn);
  IF exc=0 THEN close(conn);
  tbl_ptr:= user_tbl_ptr;
  special.va_low:= tbl_ptr^.special_va.va_low;
  special.va_high:= tbl_ptr^.special_va.va_high;

(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D00) = $0900) OR (exc<>0) THEN 
    BEGIN
      vmmdumproutine('VMM  <--  Get');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  vmmgettable:= exc;
END; (* vmmgettable *)


(* ------------     VMM SAVE ----------- *)

FUNCTION vmmsavespecial(VAR vmm_tbl_dscr: tbl_dscr_type;
                          VAR str: string;
                          VAR conn: FILE): WORD;
VAR
  i: WORD;
  va: st_address;
  rec_ptr: ptr_page_dscr_type;
  exc: WORD;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E00) = $0A00 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Save');
      vmmdumpptr(vmm_tbl_dscr);
      vmmdumpstring(str);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  exc:= 0;
  vmm_tbl_dscr.low_check_time:= starttimelow;
  vmm_tbl_dscr.high_check_time:= starttimehigh;
  assign(conn,str);
  IF exc=0 THEN rewrite(conn,1);
  va.va_low:= min_va_low;
  va.va_high:= min_va_high;
  FOR i:= 1 TO vmm_tbl_dscr.no_of_page DO
  BEGIN
    IF exc=0 THEN exc:= vmmretrieve(vmm_tbl_dscr,va.va_high,va.va_low,
                        false,false,rec_ptr);
    IF exc=0 THEN blockwrite(conn,rec_ptr^,vmm_tbl_dscr.page_size);
    IF exc=0 THEN
    BEGIN
      IF u_add_dw_w(va,vmm_tbl_dscr.page_size) THEN
      ELSE exc:= e_vmm_va_overflow;
    END;
  END;
  vmmsavespecial:= exc;
END; (* vmmsavespecial *)

FUNCTION vmmsavetable(VAR user_tbl: tbl_dscr_type;
                      VAR str: string;
                      special_va_high, special_va_low: WORD): WORD;
VAR
  conn: FILE;
  exc: WORD;
BEGIN
  user_tbl.special_va.va_low:= special_va_low;
  user_tbl.special_va.va_high:= special_va_high;
  exc:= vmmsavespecial(user_tbl, str , conn);
  IF exc=0 THEN close(conn);

(*#BEGINTEST
  IF testvmm>=0 THEN
    IF ((WORD(testvmm) AND $0D00) = $0900) OR (exc<>0) THEN 
    BEGIN
      vmmdumproutine('VMM  <--  Save');
      vmmdumpnewline;  
    END;
(*ENDTEST#*)
  vmmsavetable:= exc;
END; (* vmmsavetable *)

      

FUNCTION vmmretrieve(VAR vmm_tbl_dscr: tbl_dscr_type;
                      va_high_offset, va_low_offset: WORD;
                      page_lock, page_update: BOOLEAN;
                      VAR rec_ptr): WORD;
VAR
  read_bytes: WORD;
  vmm_page_dscr_ptr: ptr_page_dscr_type;
  help_rec_ptr: ptr_page_dscr_type;
  (* vmm_page_dscr = vmm_page_dscr_ptr^ *)
  page_offset: WORD;
  step: WORD;
  cand_ptr: ptr_page_dscr_type;
  exc_code: WORD;
  dummy_exc: WORD;
  state: BYTE;
  help_va: st_address;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E02) = $0A02 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Retrieve');
      vmmdumpva(va_high_offset,va_low_offset);
      vmmdumpline;
      IF page_lock THEN    vmmdumpstring('lock  ');
      IF page_update THEN    vmmdumpstring('update');
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  exc_code:= e_ok;
  state:= 0;
  IF vmm_tbl_dscr.stcs.access_low = max_word THEN
  BEGIN
(*#BEGINTEST
    vmm_tbl_dscr.stcs.access_high:= vmm_tbl_dscr.stcs.access_high + 1;
(*ENDTEST#*)
    vmm_tbl_dscr.stcs.access_low:= 0;
    (* for all resident pages: is_refered = 0 *)
    vmm_page_dscr_ptr:= vmm_tbl_dscr.page_chain_head;
    FOR step:= 1 TO vmm_tbl_dscr.no_of_page DO
    BEGIN
      vmm_page_dscr_ptr^.is_refered:= 0;
      vmm_page_dscr_ptr:= vmm_page_dscr_ptr^.succ_ptr;
    END;
  END ELSE vmm_tbl_dscr.stcs.access_low:= vmm_tbl_dscr.stcs.access_low + 1;
  WHILE ( exc_code = e_ok ) AND ( state < 8 ) DO
  BEGIN
    state:= state + 1;
    CASE state OF
     0: ;
     1: BEGIN
          page_offset:= va_low_offset AND vmm_tbl_dscr.offset_mask;
          va_low_offset:= va_low_offset XOR page_offset;
          IF vmmlocateresident( vmm_tbl_dscr, va_low_offset,
                                  va_high_offset, help_rec_ptr )
          THEN  state:= 7;
          vmm_page_dscr_ptr:= help_rec_ptr;
        END;
     2: IF (va_high_offset>=vmm_tbl_dscr.va_eoi.va_high) AND
           ((va_low_offset>vmm_tbl_dscr.va_eoi.va_low) OR
           (va_high_offset>vmm_tbl_dscr.va_eoi.va_high))
        THEN exc_code:= e_vmm_va_nexist;
     3:  exc_code:= vmmlocatecandidate( vmm_tbl_dscr, help_rec_ptr );
     4: vmmunchainpage( vmm_tbl_dscr, help_rec_ptr^ );
     5: vmmchainpage(vmm_tbl_dscr,va_low_offset,va_high_offset,help_rec_ptr^);
     6:BEGIN
           help_va.va_low:= va_low_offset;
           help_va.va_high:= va_high_offset;
           seek(vmm_tbl_dscr.file_conn, longint(help_va)); (* !!! TURBO !!! *)
       end;
     7: BEGIN
          vmm_page_dscr_ptr:= help_rec_ptr;
          vmm_tbl_dscr.last_used_ptr:= help_rec_ptr;
(*#BEGINTEST
          vmm_tbl_dscr.stcs.disk_reads:= vmm_tbl_dscr.stcs.disk_reads +1;
(*ENDTEST#*)
          blockread(vmm_tbl_dscr.file_conn, vmm_page_dscr_ptr^.data_area,
                               vmm_tbl_dscr.page_size,read_bytes);
(*#BEGINTEST
            IF testvmm>0 THEN
              IF (WORD(testvmm) AND $0F02) = $0802 THEN
              BEGIN
                vmmdumproutine('VMM  -6-  Retrieve');
                vmmdumpline;
                vmmdumpsize(read_bytes);
                vmmdumpnewline;
              END;
(*ENDTEST#*)
          IF (vmm_tbl_dscr.page_size<>read_bytes) AND (exc_code=e_ok)
          THEN exc_code:= e_vmm_va_nexist;
        END;
     8: BEGIN  (* resident page. *)
          help_rec_ptr:= @vmm_page_dscr_ptr^.data_area[page_offset];
                    (*         if va_high_offset <> 0 then
                            state :=8;*)
          vmm_page_dscr_ptr^.is_refered:= vmm_tbl_dscr.stcs.access_low;
          IF page_lock THEN
          BEGIN
            IF vmm_page_dscr_ptr^.perm_locks=255
            THEN exc_code:= e_vmm_overflow
            ELSE vmm_page_dscr_ptr^.perm_locks:= vmm_page_dscr_ptr^.perm_locks + 1;
          END;
          (* ? overflow ? *)
          IF page_update THEN vmm_page_dscr_ptr^.updated:= true;
        END;
    END;  (* CASE state OF 0..8 *)
  END; (* WHILE exc_code = e_ok *)

(*#BEGINTEST
  IF (testvmm>=0) AND (exc_code<>e_ok) THEN
  BEGIN
    vmmdumproutine('VMM  ERR  Retrieve');
    vmmdumpva(va_high_offset,va_low_offset OR page_offset);
    vmmdumpline;
    vmmdumpnewline;
    vmmdumproutine(' ');
    vmmdumperror(state,exc_code);
    vmmdumpnewline;
  END;
(*ENDTEST#*)

(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D02) = $0902 THEN
    BEGIN
      vmmdumproutine('VMM  <--  Retrieve');
      vmmdumpskip;
      vmmdumplocks(vmm_page_dscr_ptr^.perm_locks);
      vmmdumpptr(help_rec_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  POINTER(rec_ptr):= help_rec_ptr;
  vmmretrieve:= exc_code;
END; (* vmmretrieve *)


(* ---------------          VMMEXTEND         --------------- *)
FUNCTION vmmextend(VAR vmm_tbl_dscr: tbl_dscr_type;
                   VAR va: st_address;  (* - address of virtual address of searched record. *)
                   record_size: WORD;  (* - size of requested record. *)
                   lock_page: BOOLEAN;    (* - true: permanent lock. false: no permanent lock. *)
                   VAR rec_ptr (* - address of pointer to new record. *)
                  ): WORD;
VAR
  help_rec_ptr: ptr_page_dscr_type;
  page_offset: WORD;
  exc_code: WORD;
  state: BYTE;
BEGIN
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E01) = $0A01 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Extend');
      vmmdumpva(vmm_tbl_dscr.va_eoi.va_high,vmm_tbl_dscr.va_eoi.va_low);
      vmmdumpsize(record_size);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  exc_code:= e_ok;
  state:= 0;
  page_offset:= vmm_tbl_dscr.va_eoi.va_low AND vmm_tbl_dscr.offset_mask;
  WHILE ( exc_code = e_ok ) AND ( state < 6 ) DO
  BEGIN
    state:= state + 1;
    CASE state OF
     0: ;
     1: IF ( vmm_tbl_dscr.page_size < record_size ) THEN exc_code:= e_vmm_size
        ELSE BEGIN
          IF ( vmm_tbl_dscr.page_size - page_offset ) < record_size THEN
          BEGIN  (* - page boundary. Adjust EOI. *)
            vmm_tbl_dscr.va_eoi.va_low:= vmm_tbl_dscr.va_eoi.va_low AND vmm_tbl_dscr.low_page_mask;
            IF u_add_dw_w( vmm_tbl_dscr.va_eoi, vmm_tbl_dscr.page_size )
            THEN
              BEGIN
                vmm_tbl_dscr.no_of_page:= vmm_tbl_dscr.no_of_page + 1;
                 (* - address space for a new page. *)
              END
            ELSE exc_code:= e_vmm_va_overflow;
          END ELSE (* - ELSE room in existing page. *)
                IF page_offset=0 THEN vmm_tbl_dscr.no_of_page:= vmm_tbl_dscr.no_of_page+1;
        END;
     2: IF vmmlocateresident( vmm_tbl_dscr, vmm_tbl_dscr.va_eoi.va_low,
                                vmm_tbl_dscr.va_eoi.va_high, help_rec_ptr )
        THEN state:= 4
        ELSE BEGIN
          IF ( vmm_tbl_dscr.no_of_residents = vmm_tbl_dscr.max_residents )
          THEN exc_code:= vmmlocatecandidate(vmm_tbl_dscr, help_rec_ptr)
          ELSE BEGIN
            help_rec_ptr:=
              ptr_page_dscr_type(vmmallocate(vmm_tbl_dscr.page_seg_size,exc_code));
            IF ( exc_code = e_ok )
            THEN vmm_tbl_dscr.no_of_residents:= vmm_tbl_dscr.no_of_residents + 1;
            state:= 3;
          END;
        END;
     3: vmmunchainpage(vmm_tbl_dscr, help_rec_ptr^);
     4: (* 'rec_ptr.stored_rec_ptr' is adressing an idle page . *)
        (* Chain before page with table descriptor (VA 0, 0)   *)
        vmmchainpage(vmm_tbl_dscr, vmm_tbl_dscr.va_eoi.va_low,
                       vmm_tbl_dscr.va_eoi.va_high,help_rec_ptr^);
     5: exc_code:= vmmretrieve(vmm_tbl_dscr,vmm_tbl_dscr.va_eoi.va_high,
                                vmm_tbl_dscr.va_eoi.va_low,lock_page,
                                true (* implicit update *),help_rec_ptr);
     6: BEGIN
          va := vmm_tbl_dscr.va_eoi;
          IF u_add_dw_w(vmm_tbl_dscr.va_eoi, record_size ) THEN;
             (* - has been checked: new EOI. *)
        END;
    END; (* CASE state OF 0..6 *)
  END; (* WHILE exc_code = e_ok *)

(*#BEGINTEST
  IF (testvmm>=0) AND (exc_code<>e_ok) THEN
  BEGIN  
    vmmdumproutine('VMM  ERR  Extend');
    vmmdumpline;
    vmmdumperror(state,exc_code);
    vmmdumpnewline;
  END;
(*ENDTEST#*)

(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D01) = $0901 THEN 
    BEGIN
      vmmdumproutine('VMM  <--  Extend');
      vmmdumpva(va.va_high,va.va_low);
      vmmdumpskip;
      vmmdumpptr(help_rec_ptr^);
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  POINTER(rec_ptr):= help_rec_ptr;
  vmmextend:= exc_code;
END; (* vmmextend *)

(* ---------------          VMMEXTENDCOPY         --------------- *)
FUNCTION vmmextendcopy(VAR vmm_tbl_dscr: tbl_dscr_type; (* - address of table descriptor. *)
                       VAR va: st_address; (* - address of virtual address of searched record. *)
                       record_size: WORD; (* - size of requested record. *)
                       lock_page: BOOLEAN; (* - true: permanent lock. false: no permanent lock. *)
                       VAR rec_ptr; (* - address of pointer to new record. *)
                       va_to_copy_high, va_to_copy_low: WORD):WORD;
VAR
  help_rec_ptr: ptr_page_dscr_type;
  copy_ptr: ptr_page_dscr_type;
  exc: WORD;
BEGIN
  exc:= vmmextend(vmm_tbl_dscr,va,record_size,true,help_rec_ptr);
  IF exc=0 THEN
  BEGIN
    exc:= vmmretrieve(vmm_tbl_dscr,va_to_copy_high,va_to_copy_low,
                       false,false,copy_ptr);
    IF exc=0 THEN
    BEGIN
      MOVE(copy_ptr^ ,help_rec_ptr^ ,record_size);
      IF NOT lock_page THEN exc:= vmmunlock(vmm_tbl_dscr,help_rec_ptr);
    END;
  END;
  POINTER(rec_ptr):= help_rec_ptr;
  vmmextendcopy:= exc;
END; (* vmmextendcopy *)


(* ---------------           VMMLOCK          --------------- *)
FUNCTION vmmlock(VAR vmm_tbl_dscr: tbl_dscr_type;
                     vmm_page_dscr_ptrr: pointer): WORD;
VAR
  vmm_page_dscr_ptr: ptr_page_dscr_type;
  exc_code: WORD;
BEGIN
  vmm_page_dscr_ptr:=vmm_page_dscr_ptrr;
  (*#BEGINTEST
  IF testvmm>0 THEN;
    IF (WORD(testvmm) AND $0E04) = $0A04 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Lock');
      vmmdumpptr(vmm_page_dscr_ptr^);
      vmmdumpline;
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  exc_code:= e_ok;
  vmm_page_dscr_ptr:= PTR(SEG(vmm_page_dscr_ptr^),0);
  IF ( vmm_page_dscr_ptr^.perm_locks < 255 )
  THEN vmm_page_dscr_ptr^.perm_locks:= vmm_page_dscr_ptr^.perm_locks + 1
  ELSE  (* - logic error: lock overflow - *) exc_code:= e_vmm_overflow;

(*#BEGINTEST
  IF (testvmm>=0) AND (exc_code<>e_ok) THEN
  BEGIN
    vmmdumproutine('VMM  ERR  Lock');
    vmmdumpptr(vmm_page_dscr_ptr^);
    vmmdumpnewline;
    vmmdumproutine(' ');
    vmmdumpline;
    vmmdumperror(1,exc_code);
    vmmdumpnewline;
  END;
(*ENDTEST#*)

(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D04) = $0904 THEN
    BEGIN
      vmmdumproutine('VMM  <--  Lock');
      vmmdumpskip;
      vmmdumplocks(vmm_page_dscr_ptr^.perm_locks);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  vmmlock:= exc_code;
END; (* vmmlock *)

(* ---------------          VMMUNLOCK         --------------- *)
FUNCTION vmmunlock(VAR vmm_tbl_dscr: tbl_dscr_type;
                       vmm_page_dscr_ptrr: pointer): WORD;
VAR
  vmm_page_dscr_ptr: ptr_page_dscr_type;
  exc_code: WORD;
BEGIN
  vmm_page_dscr_ptr:=vmm_page_dscr_ptrr;
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0E08) = $0A08 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Unlock');
      vmmdumpptr(vmm_page_dscr_ptr^);
      vmmdumpline;
      vmmdumpnewline;
    END;
(*ENDTEST#*)

  exc_code:= e_ok;
  vmm_page_dscr_ptr:=PTR(SEG(vmm_page_dscr_ptr^),0);

  IF ( 0 < vmm_page_dscr_ptr^.perm_locks ) THEN
  BEGIN
    vmm_page_dscr_ptr^.perm_locks:= vmm_page_dscr_ptr^.perm_locks - 1;
(*#BEGINTEST
    IF testvmm>0 THEN
      IF (WORD(testvmm) AND $0F08) = $0808 THEN
      BEGIN
        vmmdumproutine('VMM  -U-  Unlock');
        vmmdumpptr(vmm_page_dscr_ptr^);
        vmmdumpline;
        vmmdumpnewline;
      END;
(*ENDTEST#*)
  END ELSE
  (* - logic error: - lock underflow *) exc_code:= e_vmm_underflow;

(*#BEGINTEST
  IF (testvmm>=0) AND (exc_code<>e_ok) THEN
  BEGIN
    vmmdumproutine('VMM  ERR  Unlock');
    vmmdumpptr(vmm_page_dscr_ptr^);
    vmmdumpline;
    vmmdumpnewline;
    vmmdumproutine(' ');
    vmmdumperror(1,exc_code);
    vmmdumpnewline;
  END;
(*ENDTEST#*)
(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D08) = $0908 THEN 
    BEGIN
      vmmdumproutine('VMM  <--  Unlock');
      vmmdumpskip;
      vmmdumplocks(vmm_page_dscr_ptr^.perm_locks);
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  vmmunlock:= exc_code;
END; (* vmmunlock *)


(* ---------------           VMMUPDATE          --------------- *)
FUNCTION vmmupdate(VAR vmm_tbl_dscr: tbl_dscr_type;
                       vmm_page_dscr_ptrr: pointer): WORD;
VAR
  vmm_page_dscr_ptr: ptr_page_dscr_type;
  exc_code: WORD;
BEGIN
  vmm_page_dscr_ptr := vmm_page_dscr_ptrr;
(*#BEGINTEST
  IF testvmm>0 THEN;
    IF (WORD(testvmm) AND $0E04) = $0A04 THEN
    BEGIN
      vmmdumproutine('VMM  -->  Update');
      vmmdumpptr(vmm_page_dscr_ptr^);
      vmmdumpline;
      vmmdumpnewline;
    END;
(*ENDTEST#*)
    exc_code:= e_ok;
    vmm_page_dscr_ptr:= PTR(SEG(vmm_page_dscr_ptr^),0);
    vmm_page_dscr_ptr^.updated:= TRUE;

(*#BEGINTEST
  IF testvmm>0 THEN
    IF (WORD(testvmm) AND $0D04) = $0904 THEN
    BEGIN
      vmmdumproutine('VMM  <--  Update');
      vmmdumpskip;
      vmmdumpnewline;
    END;
(*ENDTEST#*)
  vmmupdate:= exc_code;
END; (* vmmupdate *)

(* INITIALIZATION *)
BEGIN
  min_va_low:= 0;
  min_va_high:= 0;
END.