Open Source Projects Europe

IMPLEMENTATION MODULE DynMat;

  (*------------------------------------------------------------------------*)
  (* Modul zur Verwaltung von dynamisch allokierten zweidimensionalen       *)
  (* Matrizen wie sie in Deklera definiert wurden.                          *)
  (* Modul for handling dynamicly allocated two dimensional matrices as     *)
  (* defined in Deklera.def.                                                *)
  (*------------------------------------------------------------------------*)
  (* Letzte Bearbeitung                                                     *)
  (*                                                                        *)
  (* 09.11.95, MRi: Durchsicht                                              *)
  (* 26.04.16, MRi: DEALLOCATE(Mat,m*TSIZE(ADDRESS)) fuer den Fehlerfall    *)
  (*                in AllocMat eingefuegt.                                 *)
  (*------------------------------------------------------------------------*)
  (* Implementation : Michael Riedl                                         *)
  (* Licence        : GNU Lesser General Public License (LGPL)              *)
  (*------------------------------------------------------------------------*)

  (* $Id: DynMat.mod,v 1.2 2016/04/26 19:03:18 mriedl Exp mriedl $ *)

FROM SYSTEM   IMPORT TSIZE,ADR,WORD,ADDRESS,CAST;
FROM Storage  IMPORT ALLOCATE,DEALLOCATE;
FROM Deklera  IMPORT MATRIX,PMATRIX,MaxDim;
              IMPORT Errors;

PROCEDURE AllocMat(VAR Mat : PMATRIX;
                       m,n : CARDINAL);

          CONST FFlag = "Kein Freispeicher vorhanden (DynMat.AllocMat) !";

          VAR   i,ii  : CARDINAL;

BEGIN
      Errors.Fehler:=FALSE;
      ALLOCATE(Mat,m*TSIZE(ADDRESS));
      IF (Mat = NIL) THEN
        Errors.Fehler:=TRUE;  Errors.Fehlerflag:=FFlag;
        Errors.ErrOut(FFlag); RETURN; (* !!! *)
      END;
      FOR i:=1 TO m DO
        ALLOCATE(Mat^[i],n*TSIZE(LONGREAL));
        IF (Mat^[i] = NIL) THEN
          Errors.Fehler:=TRUE; Errors.Fehlerflag:=FFlag;
          Errors.ErrOut(FFlag);
          FOR ii:=i-1 TO 1 BY -1 DO
            (* Gebe schon angeforderten Speicher zur"uck ! *)
            DEALLOCATE(Mat^[ii],n*TSIZE(LONGREAL));
          END;
          DEALLOCATE(Mat,m*TSIZE(ADDRESS));
          RETURN; (* !!! *)
        END; (* IF *)
      END;
END AllocMat;

PROCEDURE DeAllocMat(VAR Mat : PMATRIX;
                         m,n : CARDINAL);

          VAR i : CARDINAL;
BEGIN
       FOR i:=m TO 1 BY -1 DO DEALLOCATE(Mat^[i],n*TSIZE(LONGREAL)); END;
       DEALLOCATE(Mat,m*TSIZE(ADDRESS)); Mat:=NIL;
END DeAllocMat;

PROCEDURE ConvMat(VAR Mat  : MATRIX;
                  VAR PMat : PMATRIX);   (* ==> Referenz auf Mat *)

          CONST FFlag = "Kein Freispeicher vorhanden (DynMat.ConvMat) !";

          VAR i : CARDINAL;

BEGIN
      Errors.Fehler:=FALSE;
      ALLOCATE(PMat,MaxDim*TSIZE(ADDRESS));
      IF (PMat = NIL) THEN
        Errors.Fehler:=TRUE;  Errors.Fehlerflag:=FFlag;
        Errors.ErrOut(FFlag); RETURN; (* !!! *)
      END;
      FOR i:=1 TO MaxDim DO PMat^[i]:=ADR(Mat[i]); END;
END ConvMat;

PROCEDURE DeAllocConvMat(VAR Mat  : MATRIX;
                         VAR PMat : PMATRIX);   (* ==> Referenz auf Mat *)

          CONST FFlag = "Falsche Referenz (DynMat.DeAllocConvMat) !";

          VAR   i     : CARDINAL;

BEGIN
      Errors.Fehler:=FALSE;
      FOR i:=1 TO MaxDim DO
        IF (CAST(ADDRESS,PMat^[i]) # ADR(Mat[i])) THEN
          Errors.Fehler:=TRUE;  Errors.Fehlerflag:=FFlag;
          Errors.ErrOut(FFlag); RETURN; (* !!! *)
        END;
      END;
      DEALLOCATE(PMat,MaxDim*TSIZE(ADDRESS));
END DeAllocConvMat;

END DynMat.