home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 12 / extra / virtarr1.mod < prev    next >
Encoding:
Modula Definition  |  1988-09-30  |  6.3 KB  |  215 lines
  1. (*******************************************************)
  2. (*                   VIRTARR1.MOD                      *)
  3. (*  Definitions- und Implementationsmodul von VARRSYS  *)
  4. (*         Virtuelle Speicherverwaltung in M2          *)
  5. (*         (C) 1988 Peter H. Seewann & TOOLBOX         *)
  6. (*******************************************************)
  7.  
  8. DEFINITION MODULE VARRSYS;
  9.   FROM SYSTEM IMPORT ADDRESS;
  10.  
  11.   TYPE VirtualArray;
  12.   (* Opaquer Datentyp - die interne Struktur ist für *)
  13.   (* die Applikation uninteressant                   *)
  14.  
  15.   PROCEDURE DefineVArray( name     : ARRAY OF CHAR;
  16.                           tsize    : CARDINAL;
  17.                           inMem    : CARDINAL       )
  18.                                         : VirtualArray;
  19.   PROCEDURE OpenVArray(     V  : VirtualArray; 
  20.                         VAR ok : BOOLEAN       );
  21.   PROCEDURE CloseVArray( VAR  V      : VirtualArray;
  22.                               delete,
  23.                               reuse  : BOOLEAN       );
  24.   PROCEDURE VElement( i : CARDINAL;
  25.                       V : VirtualArray ): ADDRESS;
  26.   PROCEDURE VHigh( V : VirtualArray ): CARDINAL;
  27. END VARRSYS.
  28.  
  29.  
  30. IMPLEMENTATION MODULE VARRSYS;
  31.  
  32.   FROM SYSTEM IMPORT
  33.     ADDRESS, TSIZE;
  34.  
  35.   FROM CODELIB IMPORT
  36.     FillWords;
  37.  
  38.   FROM Storage IMPORT
  39.     ALLOCATE, DEALLOCATE;
  40.  (*
  41.   FROM VIRTMEM IMPORT 
  42.     ReadBlock, WriteBlock;
  43.  *)
  44.   FROM FILESYS IMPORT
  45.     WRITEBYTES, READBYTES, FILE, CREATE, WRITE,
  46.     UserHandle, IOR, ResultType,
  47.     SETEOF, SETPOS, CLOSE, DELETE, OPEN, AccessType;
  48.  
  49.   TYPE
  50.     VirtualArray = POINTER TO TVirtArray;
  51.     TVirtArray   = RECORD
  52.                      handle    : FILE;
  53.                      fname     : ARRAY [ 0 .. 11 ] OF CHAR;
  54.                      typesize  : CARDINAL;
  55.                                  (* Größe des Datentyps *)
  56.                      elements  : CARDINAL;
  57.                            (* echte Anzahl der Elemente *)
  58.                      worksize  : CARDINAL;
  59.                        (* Anzahl der speicherresidenten *)
  60.                        (* Elemente *)
  61.                      currI0    : CARDINAL;
  62.                       (* erstes der speicherresidenten  *)
  63.                       (* Elemente *)
  64.                      workspace : ADDRESS
  65.                                  (* Puffer *)
  66.                    END;
  67.  
  68.   PROCEDURE DefineVArray( name     : ARRAY OF CHAR;
  69.                           tsize    : CARDINAL;
  70.                           inMem    : CARDINAL       )
  71.                                             : VirtualArray;
  72.   VAR
  73.       va    : VirtualArray;
  74.       sz,i  : CARDINAL;
  75.   BEGIN
  76.     ALLOCATE( va, TSIZE( TVirtArray ) );
  77.     WITH va^ DO
  78.       i := 0;
  79.       WHILE ( i < 8 ) & ( i <= HIGH( name ) )
  80.               & ( name[i] # 0c ) DO
  81.         fname[i] := name[i];
  82.         INC( i )
  83.       END;
  84.       fname[i] := '.';
  85.       INC( i );
  86.       fname[i] := 'V';(* Dateiname a. d. Typennamen kon-   *)
  87.       INC( i );       (* struieren u. m. Standardextension *)
  88.       fname[i] := 'A';(* versehen                          *)
  89.       INC( i );
  90.       fname[i] := 'R';
  91.       INC( i );
  92.       IF i <= 11
  93.         THEN
  94.           fname[i] := 0c
  95.       END;
  96.       CREATE( handle, fname, TRUE ); (* Datei anlegen *)
  97.       typesize := tsize;
  98.       elements := inMem;
  99.       worksize := inMem;
  100.       sz := inMem * tsize;
  101.       ALLOCATE( workspace, sz );
  102.       (* ACHTUNG !!!!!! siehe Kommentar im Text *)
  103.       IF workspace = NIL
  104.         THEN
  105.           DEALLOCATE( va, TSIZE( TVirtArray ) );
  106.           RETURN NIL
  107.       END;
  108.       WRITEBYTES( handle, workspace, sz );
  109.       CLOSE( handle );  (* Plattenbereich initialisieren *)
  110.       currI0 := 0
  111.     END;
  112.     RETURN va
  113.   END DefineVArray;
  114.  
  115.   PROCEDURE OpenVArray(     V  : VirtualArray; 
  116.                         VAR ok : BOOLEAN       );
  117.   VAR 
  118.       sz : CARDINAL;                 (* Array eröffnen *)
  119.   BEGIN
  120.     ok := V # NIL;
  121.     IF ~ ok
  122.       THEN
  123.         RETURN
  124.     END;
  125.     WITH V^ DO
  126.       OPEN( handle, fname, readwritemode );
  127.       ok := IOR( handle ) = OK;
  128.       IF ok & ( workspace = NIL )
  129.         THEN
  130.           sz := worksize * typesize;
  131.           ALLOCATE( workspace, sz );
  132.           ok := workspace # NIL;
  133.           IF ok THEN
  134.             READBYTES( handle, workspace, sz );
  135.             currI0 := 0;
  136.           END
  137.       END
  138.     END
  139.   END OpenVArray;
  140.  
  141.   PROCEDURE CloseVArray(VAR V : VirtualArray;
  142.                         delete,                 (* Datei *)
  143.                         reuse  : BOOLEAN   );   (* Array *)
  144.   VAR
  145.       sz : CARDINAL;
  146.   BEGIN
  147.     WITH V^ DO
  148.       sz := worksize * typesize;
  149.       IF ~ delete
  150.         THEN
  151.           WRITEBYTES( handle, workspace, sz )
  152.       END;
  153.       CLOSE( handle );
  154.       IF delete
  155.         THEN
  156.           DELETE( fname )
  157.       END;
  158.       DEALLOCATE( workspace, worksize * typesize );
  159.       elements := 0;
  160.       IF ~ reuse
  161.         THEN
  162.           DEALLOCATE( V, TSIZE( TVirtArray ) )
  163.       END
  164.     END
  165.   END CloseVArray;
  166.  
  167.   PROCEDURE VElement( i : CARDINAL;
  168.                       V : VirtualArray ): ADDRESS;
  169.   VAR
  170.       retaddr : ADDRESS;
  171.       sz      : CARDINAL;
  172.       extion  : BOOLEAN;
  173.   BEGIN
  174.     extion := FALSE;
  175.     WITH V^ DO
  176.       IF ( i < currI0 ) OR ( i >= currI0 + worksize )
  177.         THEN
  178.           sz := worksize * typesize;
  179.           SETPOS( handle,
  180.                   VAL( LONGINT, currI0 * typesize ),
  181.                   FALSE );
  182.           WRITEBYTES( handle, workspace, sz );
  183.           IF i >= elements 
  184.             THEN
  185.               extion := TRUE;
  186.               FillWords( 0, sz DIV 2, workspace );
  187.               SETEOF( handle );
  188.               WHILE i >= elements DO
  189.                 WRITEBYTES( handle, workspace, sz );
  190.                 INC( elements, worksize )
  191.               END
  192.           END;
  193.           currI0 := i DIV worksize * worksize;
  194.           SETPOS( handle, VAL(LONGINT,currI0*typesize),
  195.                   FALSE );
  196.           IF ~ extion
  197.             THEN
  198.               READBYTES( handle, workspace, sz )
  199.           END
  200.       END;
  201.       retaddr := workspace;
  202.       INC( retaddr, ( i - currI0 ) * typesize );
  203.       RETURN retaddr
  204.     END
  205.   END VElement;
  206.  
  207.   PROCEDURE VHigh( V : VirtualArray ): CARDINAL;
  208.   BEGIN
  209.     RETURN V^.elements - 1
  210.   END VHigh;
  211.  
  212.             (* Kein Initialisierungsteil erforderlich *)
  213.  
  214. END VARRSYS.
  215.