home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 06 / hitech / dynarray.mod < prev    next >
Encoding:
Modula Implementation  |  1988-10-03  |  12.9 KB  |  319 lines
  1. IMPLEMENTATION MODULE DynArrayHandler;
  2. (*-------------------------------------------------------------------*
  3.  * Dieses Modul umfa₧t die Verwaltung dynamischer Arrays mit         *
  4.  * beliebigen Typen bis zu einer Elementgrö₧e von <MaxElementSize>.  *
  5.  * Die Typenkompatibilität wird über die Grö₧e der übergebenen       *
  6.  * Variablen kontrolliert. Typenkonvertierungen sind mit Variablen   *
  7.  * unterschiedlichen Typs bei gleicher Grö₧e möglich.                *
  8.  * Die Grö₧e des Arrays wird über den grö₧ten Index, der beim        *
  9.  * Schreiben von Elementen verwendet wurde, bestimmen.               *
  10.  * Lesender Zugriff auf Indizes oberhalb des grö₧ten, zum Schreiben  *
  11.  * verwendeten Index, wird mit einer Fehlermeldung quittiert.        *
  12.  *-------------------------------------------------------------------*
  13.  * Copyright 1987: Dipl.-Inform. Frank F. Wachtmeister               *
  14.  *-------------------------------------------------------------------*
  15.  * System  :  ATARI 520 ST+, SM 124, PADERCOMP DL-2, EPSON FX-105    *
  16.  * Compiler:  TDI MODULA-2/ST 0272-742796(UK)                        *
  17.  *-------------------------------------------------------------------*
  18.  * Verwendete Module, die nicht zum Grundpaket gehören:              *
  19.  *    Debugger: erhältlich über PASCAL Intern. 4/88                  *
  20.  *-------------------------------------------------------------------*
  21.  * Fehlermeldungen (ausgegeben über Debugger.Error):                 *
  22.  *  91: Storage : Created Heap not sufficient. Allocation failed.    *
  23.  * 106: DynArray: DynArray not initialized.                          *
  24.  * 107: DynArray: Array Element inkompatible with Variable.          *
  25.  * 108: DynArray: Array Index out of Bounds.                         *
  26.  * 109: DynArray: Array Address Error.                               *
  27.  * 110: DynArray: Array Element too large ( > <MaxElementSize> ).    *
  28.  *-------------------------------------------------------------------*)
  29.  
  30. FROM Debugger IMPORT stop, Error, InitDebugger, Activate,
  31.                      Into, Leaving, Message, ShowByte, ShowWord, ShowLong;
  32. FROM Storage  IMPORT CreateHeap, ALLOCATE, DEALLOCATE;
  33. FROM Streams  IMPORT Stream, Write8Bit, Read8Bit, Write16Bit, Read16Bit;
  34. FROM SYSTEM   IMPORT BYTE;
  35.  
  36. CONST DEBUG = FALSE;
  37.  
  38. TYPE
  39.    SegmentPtr  = POINTER TO SegmentType;
  40.  
  41.    SegmentType = RECORD
  42.       next : SegmentPtr;
  43.       block: ARRAY[1..MaxElementSize] OF BYTE;
  44.    END;
  45.  
  46.    DynArray = POINTER TO Deskript;  (* Opaque Type *)
  47.  
  48.    Deskript = RECORD
  49.       size,                (* Grö₧e eines Elements in Bytes          *)
  50.       index,               (* Grö₧tmöglicher Index zum Lesen         *)
  51.       anzseg: CARDINAL;    (* Anzahl initialisierter Segmente        *)
  52.       init,                (* Zeiger auf das Initialisierungssegment *)
  53.       list : SegmentPtr;   (* Zeiger auf die Segment-Liste           *)
  54.    END;
  55.  
  56.  
  57. (*-------------------------------------------------------------------*
  58.  * New kontrolliert, ob mit NEW zugewiesener Speicherplatz auch      *
  59.  * tatsächlich zugewiesen wurde.                                     *
  60.  *-------------------------------------------------------------------*)
  61. PROCEDURE New (VAR p: SegmentPtr);
  62. BEGIN
  63.    NEW (p);
  64.    IF p=NIL THEN Error (91); HALT; END;
  65. END New;
  66.  
  67. (*-------------------------------------------------------------------*
  68.  * NewSegment hängt an die Segmentliste von dyn ein Segment an.      *
  69.  * Dies Segment ist wie in dyn^.init definiert, initialisiert.       *
  70.  *-------------------------------------------------------------------*)
  71. PROCEDURE NewSegment (VAR dyn: DynArray);
  72. VAR i  : CARDINAL;
  73.     p,q: SegmentPtr;
  74. BEGIN
  75.    IF DEBUG THEN Into ('NewSegment') END;
  76.    IF dyn=NIL THEN Error (106)
  77.    ELSE
  78.       WITH dyn^ DO
  79.          p:=list; i:=0; q:=NIL;
  80.          WHILE p<>NIL DO q:=p; p:=p^.next; INC(i); END;
  81.          IF i<>anzseg THEN Error (109); END;
  82.          New (p);
  83.          IF q<>NIL THEN q^.next:=p ELSE list:=p END;
  84.          INC (anzseg);
  85.          WITH p^ DO
  86.             next:=NIL;
  87.             block:=init^.block;
  88.          END;
  89.       END;
  90.    END;
  91.    IF DEBUG THEN Leaving ('NewSegment') END;
  92. END NewSegment;
  93.  
  94. (*-------------------------------------------------------------------*
  95.  * DefDynArray definiert und initialisiert ein dynamisches Array vom *
  96.  * Typ elem. Die Variable elem wird hier auch als Initialisierung von*
  97.  * nicht explizit definierten Array-Elementen verwendet.             *
  98.  * So haben bei:                                                     *
  99.  *                                                                   *
  100.  * DefDynArray (dyn, init);                                          *
  101.  * Put (dyn, 50, a);                                                 *
  102.  *                                                                   *
  103.  * die Elemente von mit dem Index von 0 bis 49 den Wert von init;    *
  104.  * das Element mit Index 50 hat den Wert von a.                      *
  105.  *-------------------------------------------------------------------*)
  106. PROCEDURE DefDynArray (VAR dyn: DynArray; elem: ARRAY OF BYTE);
  107. VAR i,j: CARDINAL;
  108. BEGIN
  109.    IF DEBUG THEN Into ('DefDynArray') END;
  110.    IF SIZE(elem)>MaxElementSize THEN Error (110)
  111.    ELSE
  112.       NEW (dyn); IF dyn=NIL THEN Error (91)
  113.       ELSE
  114.          WITH dyn^ DO
  115.             size   := SIZE(elem);
  116.             index  := 0; anzseg:=0; list := NIL;
  117.       
  118.             New (init); (* Vorbesetzen des Initialisierungsblocks *)
  119.             i:=1; j:=0;
  120.             WITH init^ DO
  121.                next:=NIL;
  122.                REPEAT
  123.                   FOR j:=0 TO HIGH(elem) DO block[i+j]:=elem[j] END;
  124.                   i:=i+size;
  125.                UNTIL (i+size-1)>MaxElementSize;
  126.             END
  127.          END;
  128.          NewSegment (dyn);
  129.       END
  130.    END;
  131.    IF DEBUG THEN Leaving ('DefDynArray') END;
  132. END DefDynArray;
  133.  
  134. (*-------------------------------------------------------------------*
  135.  * DeleteDynArray löscht ein dynamisches Array und gibt den          *
  136.  * benötigten Speicherplatz wieder frei.                             *
  137.  *-------------------------------------------------------------------*)
  138. PROCEDURE DeleteDynArray (VAR dyn: DynArray);
  139. VAR p,q: SegmentPtr;
  140. BEGIN
  141.    IF DEBUG THEN Into ('DeleteDynArray') END;
  142.    IF dyn<>NIL THEN
  143.       WITH dyn^ DO
  144.          DISPOSE (init);
  145.          p:=list;
  146.          WHILE p<>NIL DO
  147.             q:=p^.next;
  148.             DISPOSE (p);
  149.             p:=q;
  150.          END;
  151.       END;
  152.       DISPOSE (dyn); dyn:=NIL;
  153.    END;
  154.    IF DEBUG THEN Leaving ('DeleteDynArray') END;
  155. END DeleteDynArray;
  156.  
  157.  
  158. (*-------------------------------------------------------------------*
  159.  * Get liest aus dem dynamischen Array dyn das Element mit dem       *
  160.  * Index ind und speichert es in der übergebenen Variablen elem.     *
  161.  * Ist die Grö₧e der übergebenen Variablen ungleich der Grö₧e der    *
  162.  * Array-Elemente, kommt Fehlermeldung 107.                          *
  163.  * Ist der Index ind grö₧er als die Indizes bisher geschriebenener   *
  164.  * Elemente, kommt Fehlermeldung Nr. 108.                            *
  165.  * Fehlermeldung Nr. 109: Array Address Error sollte eigentlich nicht*
  166.  * kommen und lä₧t auf einen "wildernden Pointer" schlie₧en, der     *
  167.  * hoffentlich nicht zu diesem Modul gehört.                         *
  168.  *-------------------------------------------------------------------*)
  169. PROCEDURE Get (VAR dyn: DynArray; ind: CARDINAL; VAR elem: ARRAY OF BYTE);
  170. VAR
  171.    i,
  172.    segnr,
  173.    baddr: CARDINAL;
  174.    p    : SegmentPtr;
  175. BEGIN
  176.    IF DEBUG THEN Into ('Get') END;
  177.    IF dyn=NIL THEN Error (106)
  178.    ELSE
  179.       WITH dyn^ DO
  180.          IF SIZE(elem)<>size THEN Error (107)
  181.          ELSIF ind > index      THEN Error (108) END;
  182.          
  183.          segnr   := ind DIV (MaxElementSize DIV size);
  184.          IF segnr > anzseg   THEN Error (109)
  185.          ELSE
  186.             p:=list;
  187.             WHILE segnr>0 DO DEC(segnr); p:=p^.next; END;
  188.             baddr:=(ind MOD (MaxElementSize DIV size))*size+1;
  189.             FOR i:=0 TO HIGH (elem) DO
  190.                elem[i]:=p^.block[baddr+i];
  191.             END
  192.          END
  193.       END
  194.    END;
  195.    IF DEBUG THEN Leaving ('Get') END;
  196. END Get;
  197.  
  198.  
  199. (*-------------------------------------------------------------------*
  200.  * Put speichert die Variable elem im dynamischen Array dyn unter    *
  201.  * dem Index ind ab.                                                 *
  202.  * Ist die Grö₧e der übergebenen Variablen ungleich der Grö₧e der    *
  203.  * Array-Elemente, kommt Fehlermeldung 107.                          *
  204.  * Ist der Index ind grö₧er als die Indizes bisher geschriebenener   *
  205.  * Elemente, wird das Array entsprechend erweitert.                  *
  206.  * Für diesen Fall gilt:                                             *
  207.  * Alle Elemente vom ehemals letzten Element bis zum neuen Element   *
  208.  * werden mit dem Wert des an DefDynarray übergebenen Initiali-      *
  209.  * sierungswertes besetzt.                                           *
  210.  *-------------------------------------------------------------------*)
  211. PROCEDURE Put (VAR dyn: DynArray; ind: CARDINAL; VAR elem: ARRAY OF BYTE);
  212. VAR
  213.    i,
  214.    segnr,
  215.    baddr: CARDINAL;
  216.    p    : SegmentPtr;
  217. BEGIN
  218.    IF DEBUG THEN Into ('Put') END;
  219.    IF dyn=NIL THEN Error (106)
  220.    ELSE
  221.       WITH dyn^ DO
  222.          IF SIZE(elem)<>size THEN Error (107)
  223.          ELSE
  224.             segnr   := ind DIV (MaxElementSize DIV size);
  225.             IF ind > index THEN index:=ind END;
  226.             WHILE segnr >= anzseg DO (* reserviere + initialisiere Blöcke *)
  227.                NewSegment (dyn);
  228.             END;
  229.             p:=list;
  230.             WHILE segnr>0 DO DEC(segnr); p:=p^.next; END;
  231.             baddr:=(ind MOD (MaxElementSize DIV size))*size+1;
  232.             FOR i:=0 TO HIGH (elem) DO
  233.                p^.block[baddr+i]:=elem[i];
  234.             END
  235.          END
  236.       END
  237.    END;
  238.    IF DEBUG THEN Leaving ('Put') END;
  239. END Put;
  240.  
  241. (*-------------------------------------------------------------------*
  242.  * LastIndex gibt den letzten, zum Lesen erlaubten Index des         *
  243.  * dynamischen Arrays dyn zurück.                                    *
  244.  *-------------------------------------------------------------------*)
  245. PROCEDURE LastIndex (VAR dyn: DynArray): CARDINAL;
  246. BEGIN
  247.    IF dyn=NIL THEN Error (106); RETURN (0);
  248.    ELSE
  249.       RETURN (dyn^.index);
  250.    END;
  251. END LastIndex;
  252.  
  253.  
  254. (*-------------------------------------------------------------------*
  255.  * ElementSize gibt die Grö₧e eines einzelnen Array-Elementes in     *
  256.  * Byte zurück.                                                      *
  257.  *-------------------------------------------------------------------*)
  258. PROCEDURE ElementSize (VAR dyn: DynArray): CARDINAL;
  259. BEGIN
  260.    IF dyn=NIL THEN Error (106); RETURN (0)
  261.    ELSE
  262.       RETURN (dyn^.size);
  263.    END;
  264. END ElementSize;
  265.  
  266. (*-------------------------------------------------------------------*
  267.  * LoadDynArray lädt aus dem Stream <in> die Elemente des Arrays.    *
  268.  * Die Variable elem wird hier auch als Initialisierung von nicht    *
  269.  * explizit definierten Array-Elementen verwendet.                   *
  270.  * Siehe auch DefDynArray.                                           *
  271.  * Der Stream <in> mu₧ für READ geöffnet sein und entsprechendes     *
  272.  * Format besitzen:                                                  *
  273.  * Byte 0..1: Grö₧e eines Array-Elements                             *
  274.  * Byte 2..3: Anzahl der Elemente                                    *
  275.  * Byte 4..n: Array-Elemente                                         *
  276.  *-------------------------------------------------------------------*)
  277. PROCEDURE LoadDynArray (VAR in: Stream;
  278.                         VAR dyn: DynArray; elem: ARRAY OF BYTE);
  279. VAR i,j: CARDINAL;
  280.     anzelem,
  281.     sizelem: CARDINAL;
  282. BEGIN
  283.    DefDynArray (dyn, elem);
  284.    Read16Bit (in, sizelem); Read16Bit (in, anzelem);
  285.    IF sizelem<>ElementSize(dyn) THEN
  286.       Message ('Fehler beim Laden eines Arrays:');
  287.       Error (107); 
  288.    ELSE
  289.       FOR i:=0 TO anzelem DO
  290.          FOR j:=0 TO HIGH(elem) DO Read8Bit (in, elem[j]) END;
  291.          Put (dyn, i, elem);
  292.       END
  293.    END;
  294. END LoadDynArray;
  295.  
  296.  
  297. (*-------------------------------------------------------------------*
  298.  * SaveDynArray speichert ein dynamisches Array in den Stream <out>. *
  299.  * Der Stream <out> mu₧ für READWRITE geöffnet sein.                 *
  300.  * Die Variable <elem> dient zum Typ-Check und kann einen  beliebigen*
  301.  * Wert enthalten.                                                   *
  302.  * Das Speicherformat ist in LoadDynArray beschrieben.               *
  303.  * NICHT VERGESSEN: Stream <out> SCHLIESSEN !!                       *
  304.  *-------------------------------------------------------------------*)
  305. PROCEDURE SaveDynArray (VAR out: Stream; 
  306.                         VAR dyn: DynArray; elem: ARRAY OF BYTE);
  307. VAR i,j: CARDINAL;
  308. BEGIN
  309.    Write16Bit (out, ElementSize(dyn));
  310.    Write16Bit (out, LastIndex  (dyn));
  311.    FOR i:=0 TO LastIndex (dyn) DO
  312.       Get (dyn, i, elem);
  313.       FOR j:=0 TO HIGH(elem) DO Write8Bit (out, elem[j]) END;
  314.    END;
  315. END SaveDynArray;
  316.  
  317. END DynArrayHandler.
  318.  
  319.