Add extracted sources from floppy disk images

Some files have no textual representation (yet) and were added as raw
dataspaces.

4 files changed, 1233 insertions, 0 deletions

diff --git a/datatype/complex b/datatype/complex
new file mode 100644
index 0000000..e2139d0
--- /dev/null
+++ b/datatype/complex
@@ -0,0 +1,115 @@
+ 
+PACKET complex DEFINES COMPLEX,:=,complex zero,complex one,complex i, 
+                       complex,realpart,imagpart,CONJ,+,-,*,/,=,<>, 
+                       put,get, ABS, sqrt, phi, dphi :
+ 
+TYPE COMPLEX = STRUCT(REAL re,im); 
+COMPLEX PROC complex zero: COMPLEX :(0.0,0.0). END PROC complex zero; 
+COMPLEX PROC complex one : COMPLEX :(1.0,0.0). END PROC complex one; 
+COMPLEX PROC complex i   : COMPLEX :(0.0,1.0). END PROC complex i; 
+ 
+OP := (COMPLEX VAR dest, COMPLEX CONST source) :
+ 
+  CONCR (dest) := CONCR (source)
+ 
+ENDOP := ;
+ 
+COMPLEX PROC complex(REAL CONST re,im): 
+   COMPLEX :(re,im). 
+END PROC complex; 
+ 
+REAL PROC realpart(COMPLEX CONST number): 
+           number.re. 
+END PROC realpart; 
+ 
+REAL PROC imagpart(COMPLEX CONST number): 
+           number.im. 
+END PROC imagpart ;
+ 
+COMPLEX OP CONJ(COMPLEX CONST number): 
+   COMPLEX :( number.re,- number.im). 
+END OP CONJ; 
+ 
+BOOL OP =(COMPLEX CONST a,b): 
+   IF   a.re=b.re 
+   THEN a.im=b.im 
+   ELSE FALSE 
+   FI. 
+END OP =; 
+ 
+BOOL OP <>(COMPLEX CONST a,b): 
+   IF   a.re=b.re 
+   THEN a.im<>b.im 
+   ELSE TRUE 
+   FI. 
+END OP <>; 
+ 
+COMPLEX OP +(COMPLEX CONST a,b): 
+   COMPLEX :(a.re+b.re,a.im+b.im). 
+END OP +; 
+ 
+COMPLEX OP -(COMPLEX CONST a,b): 
+   COMPLEX :(a.re-b.re,a.im-b.im). 
+END OP -; 
+ 
+COMPLEX OP *(COMPLEX CONST a,b): 
+   REAL VAR re of a::a.re,im of a ::a.im, 
+            re of b::b.re,im of b ::b.im; 
+   COMPLEX :(re of a*re of b- im of a *im of b, 
+             re of a*im of b+ im of a*re of b). 
+END OP *; 
+ 
+COMPLEX OP /(COMPLEX CONST a,b): 
+   REAL VAR re of a::a.re,im of a::a.im, 
+            re of b::b.re,im of b::b.im; 
+   REAL VAR sqare sum of re and im ::b.re*b.re+b.im*b.im; 
+   COMPLEX :( (re of a * re of b + im of a * im of b)/sqare sum of re and im,
+              (im of a *re of b - re of a*im of b)/sqare sum of re and im). 
+END OP /; 
+ 
+PROC get(COMPLEX VAR a): 
+   REAL VAR realpart,imagpart; 
+   get(realpart);get(imagpart); 
+   a:= COMPLEX :(realpart,imagpart); 
+END PROC get; 
+ 
+PROC put(COMPLEX CONST a): 
+   put(a.re);put(" ");put(a.im); 
+END PROC put; 
+ 
+REAL PROC dphi(COMPLEX CONST x): 
+ IF   imagpart(x)=0.0 THEN reell
+ ELIF realpart(x)=0.0 THEN imag 
+ ELIF realpart(x)>0.0 THEN realpositiv 
+ ELSE realnegativ 
+ FI. 
+reell: IF sign(realpart(x)) < 0 THEN 180.0 ELSE 0.0 FI. 
+imag: IF imagpart(x)>0.0 THEN 90.0 ELSE 270.0 FI. 
+realpositiv:IF imagpart(x)>0.0 THEN arctand(realpart(x)/imagpart(x)) 
+                               ELSE
+arctand(realpart(x)/imagpart(x))+360.0 FI. 
+realnegativ: arctand(realpart(x)/imagpart(x))+180.0. 
+END PROC dphi; 
+ 
+REAL PROC phi(COMPLEX CONST x): 
+dphi(x)*3.141592653689793/180.0. 
+END PROC phi; 
+ 
+COMPLEX PROC sqrt(COMPLEX CONST x): 
+IF x=complex zero THEN x 
+ELIF realpart(x)<0.0 THEN 
+complex(imagpart(x)/(2.0*real(sign(imagpart(x)))
+        *sqrt((ABSx-realpart(x))/2.0)), 
+        real(sign(imagpart(x)))*sqrt((ABS x-realpart(x))/2.0)) 
+ELSE complex(sqrt((ABS x+realpart(x))/2.0), 
+     imagpart(x)/(2.0*sqrt((ABS x+realpart(x))/2.0)))
+FI. 
+ 
+END PROC sqrt; 
+ 
+REAL OP ABS(COMPLEX CONST x): 
+ sqrt(realpart(x)*realpart(x)+imagpart(x)*imagpart(x)). 
+END OP ABS; 
+ 
+END PACKET complex; 
+
diff --git a/datatype/longint b/datatype/longint
new file mode 100644
index 0000000..e78bb52
--- /dev/null
+++ b/datatype/longint
@@ -0,0 +1,423 @@
+PACKET longint    DEFINES LONGINT,        (* Autoren: S.Baumann,A.Bentrup *)
+                          :=,             (*          T.Sillke *)
+                          <,              (* Stand:   17.03.81 *)
+                          >, 
+                          <=,
+                          >=,
+                          <>,
+                          =,
+                          -,
+                          +,
+                          *,
+                          **,
+                          ABS,
+                          abs,
+                          DECR,
+                          DIV,
+                          get,
+                          INCR,
+                          int,
+                        (*last rest,*)
+                          longint,
+                          max,
+                          max longint,
+                          min,
+                          MOD,
+                          put,
+                          random,
+                          SIGN,
+                          sign,
+                          text,
+                          zero:
+ 
+TYPE LONGINT = TEXT;
+ 
+LONGINT VAR   result,aleft,aright;
+TEXT    VAR   ergebnis,x,y,z,h;
+INT     VAR   v byte,slr,sll;
+INT     CONST snull    :: code("0"), mtl :: 300 ;
+TEXT    CONST negativ  :: code(127),max digit :: code(99),null :: code(0),
+              overflow :: "LONGINT overflow",eins :: code(1); 
+BOOL    VAR   vorl,vorr,vleft,vright;
+
+OP := (LONGINT VAR left, LONGINT CONST right) :
+   CONCR(left) := CONCR(right)
+END OP :=;
+ 
+BOOL OP <  (LONGINT CONST left,right) :
+   slr := sign(right)*length(right);
+   sll := sign(left )*length(left );
+   IF slr <> sll THEN
+      IF slr > sll THEN TRUE ELSE FALSE FI
+   ELSE IF slr>0
+        THEN CONCR(left) < CONCR(right)
+        ELSE CONCR(left) > CONCR(right) FI
+   FI
+END  OP < ;
+ 
+BOOL OP >  (LONGINT CONST left,right) :
+   slr := sign(right)*length(right);
+   sll := sign(left )*length(left );
+   IF slr <> sll THEN
+      IF slr < sll THEN TRUE ELSE FALSE FI
+   ELSE IF slr>0
+        THEN CONCR(left) > CONCR(right)
+        ELSE CONCR(left) < CONCR(right) FI
+   FI
+END  OP > ;
+ 
+BOOL OP <= (LONGINT CONST left,right) :
+   NOT (left > right)
+END  OP <=;
+ 
+BOOL OP >= (LONGINT CONST left,right) :
+   NOT (left < right)
+END  OP >=;
+ 
+BOOL OP <> (LONGINT CONST left,right) :
+   CONCR (left) <> CONCR (right)
+END OP  <>;
+ 
+BOOL OP =  (LONGINT CONST left,right) :
+   CONCR (left) =  CONCR (right)
+END  OP = ;
+ 
+LONGINT OP - (LONGINT CONST arg) : 
+   SELECT  code(CONCR(arg)SUB1)  OF
+     CASE 0  : zero
+     CASE 127: LONGINT : (subtext(CONCR(arg),2))
+     OTHERWISE LONGINT : (negativ + CONCR(arg))
+   END SELECT
+END OP -;
+ 
+LONGINT OP + (LONGINT CONST arg) :   arg  END OP +;
+ 
+LONGINT OP - (LONGINT CONST left,right) :
+   IF   CONCR(left ) = null       THEN LEAVE - WITH -right
+   ELIF CONCR(right) = null       THEN LEAVE - WITH   left
+   ELIF sign(left) <> sign(right) THEN LEAVE - WITH left + (-right) FI;
+   betrag(left,right);
+   BOOL CONST betrag max :: aleft > aright;
+   IF   betrag max
+        THEN result := LONGINT : (CONCR(aleft ) SUB CONCR(aright))
+        ELSE result := LONGINT : (CONCR(aright) SUB CONCR(aleft )) FI;
+        kuerze fuehrende nullen(CONCR(result),null);
+   IF   vleft  XOR  betrag max  THEN -result ELSE result FI
+END OP -;
+ 
+LONGINT OP + (LONGINT CONST left,right) :
+   IF   sign(left) <> sign(right) THEN LEAVE + WITH left - (-right) FI;
+   betrag(left,right);
+   IF aleft > aright
+      THEN result := LONGINT : (CONCR(aleft ) ADD CONCR(aright))
+      ELSE result := LONGINT : (CONCR(aright) ADD CONCR(aleft )) FI;
+   IF vleft THEN result ELSE -result FI
+END OP +;
+ 
+LONGINT OP * (LONGINT CONST left,right) :
+   IF   CONCR(left) = null OR CONCR(right) = null THEN LEAVE * WITH zero
+   ELIF length(left) + length(right) > mtl THEN errorstop (overflow) FI;
+   betrag(left,right);
+   IF   aleft < aright 
+        THEN result := LONGINT : (CONCR(aright) MUL CONCR(aleft ))
+        ELSE result := LONGINT : (CONCR(aleft ) MUL CONCR(aright))  FI;
+   IF   length(CONCR(result)) = mtl  THEN errorstop(overflow) FI;
+   IF   vleft XOR vright THEN -result ELSE result FI
+END OP *;
+ 
+LONGINT OP ** (LONGINT CONST arg,exp) :
+   IF exp > longint(max int) THEN errorstop (overflow) FI;
+   arg ** int(exp)
+END OP **;
+ 
+LONGINT OP ** (LONGINT CONST arg,INT CONST exp) :
+   IF   exp < 0 THEN errorstop ("LONGINT OP ** : negativ exp")
+   ELIF CONCR(arg)=null AND exp=0 THEN errorstop(text(0 ** 0)) FI;
+   IF   exp = 0  THEN one
+   ELIF exp = 1  THEN arg
+   ELIF sign(arg) = -1 AND exp MOD 2 <> 0
+        THEN -LONGINT:(CONCR(abs(arg))EXPexp) 
+        ELSE  LONGINT:(CONCR(abs(arg))EXPexp) FI
+END OP **; 
+ 
+LONGINT OP ABS (LONGINT CONST arg) : abs(arg) END OP ABS;
+ 
+LONGINT PROC abs (LONGINT CONST a) : 
+ IF (CONCR(a)SUB1)=negativ THEN LONGINT:(subtext(CONCR(a),2)) ELSE a FI
+END PROC abs;
+ 
+OP DECR (LONGINT VAR result,LONGINT CONST ab) :
+   result := result - ab;
+END OP DECR;
+ 
+LONGINT OP DIV (LONGINT CONST left,right) :
+   IF CONCR(right) = null THEN error stop("LONGINT OP DIV by zero") FI;
+   betrag(left,right);        h    := CONCR(aright);
+   y := null + CONCR(aleft ); vorl := vleft;
+   z := null + CONCR(aright); vorr := vright;
+   IF aleft < aright THEN y:=CONCR(aleft); LEAVE DIV WITH zero FI;
+   INT  VAR try,i,cr1 :: code(z SUB 2),cr2,cr3,zw;
+   BOOL VAR sh :: length(z) <> 2;
+   IF sh THEN cr3:=code(zSUB3); cr2:=10*cr1+cr3DIV10; cr3:=100*cr1+cr3 FI;
+   CONCR(result) := "";
+   FOR i FROM 0 UPTO length(y)-length(z) REP
+      laufe eine abschaetzung durch; 
+      CONCR (result) CAT code(try)
+   PER;  kuerze fuehrende nullen(y,null);
+   IF(CONCR(result)SUB1)=nullTHEN CONCR(result):=subtext(CONCR(result),2)FI;
+   IF vleft XOR vright THEN -result ELSE result FI.
+ 
+   laufe eine abschaetzung durch :
+      zw := 100*code(y SUB i+1) + code(y SUB i+2);
+      IF zw < 3276 AND sh THEN IF zw < 327
+      THEN try := min((100*zw + code(ySUBi+3))     DIV cr3, 99)
+      ELSE try := min(( 10*zw + code(ySUBi+3)DIV10)DIV cr2, 99) FI
+      ELSE try := min(     zw                      DIV cr1, 99) FI;
+       x := z MUL code(try); 
+      WHILE x > subtext(y,i+1,i+length(x)) REP
+            try DECR 1;   x := x SUB z     PER;
+      replace(y,i + 1,subtext(y,i + 1,i + length(x)) SUB x) 
+END OP DIV;
+ 
+PROC get (LONGINT VAR result) : 
+   get (ergebnis);
+   result := longint(ergebnis);
+END PROC get;
+ 
+PROC get (FILE VAR file,LONGINT VAR result) :
+   get(file,ergebnis);
+   result := longint(ergebnis);
+END PROC get;
+ 
+OP INCR (LONGINT VAR result,LONGINT CONST dazu) : 
+   result := result + dazu;
+END OP INCR;
+ 
+INT PROC int (LONGINT CONST longint) :
+   IF length(longint) > 3 
+      THEN max int + 1
+      ELSE ergebnis := (3-length(longint))*null + CONCR(abs(longint));
+           (code(ergebnis SUB 1)  * 10000 +
+            code(ergebnis SUB 2)  * 100   +
+            code(ergebnis SUB 3)) * sign(longint)
+   FI
+END PROC int;
+ 
+LONGINT PROC longint (INT CONST int) :
+   CONCR(result) :=  code( abs(int)            DIV 10000) +
+                     code((abs(int) MOD 10000) DIV 100)   +
+                     code( abs(int) MOD 100);
+   kuerze fuehrende nullen (CONCR(result),null);
+   IF int < 1 THEN -result ELSE result FI
+END PROC longint;
+ 
+LONGINT PROC longint (TEXT CONST text) :
+   INT  VAR i;
+   ergebnis := compress(text);
+   BOOL VAR minus :: (ergebnisSUB1) = "-"; 
+   IF (ergebnisSUB1)="+" OR minus THEN ergebnis:=subtext(ergebnis,2) FI;
+   kuerze fuehrende nullen(ergebnis,"0");
+   kuerze die unzulaessigen zeichen aus ergebnis;
+   schreibe ergebnis im hundertersystem in result;
+   result mit vorzeichen.
+
+   kuerze die unzulaessigen zeichen aus ergebnis :
+      ergebnis := subtext(ergebnis,1,letztes zulaessiges zeichen).
+   letztes zulaessiges zeichen :
+      FOR i FROM 1 UPTO length(ergebnis) REP 
+      UNTIL pos("0123456789", ergebnis SUB i) = 0 PER;
+      i - 1.
+   schreibe ergebnis im hundertersystem in result :
+      sll := length(ergebnis);
+      IF sll MOD 2 <> 0 THEN ergebnis := "0"+ergebnis; sll INCR 1 FI; 
+      i := 1; CONCR(result) := "";
+      REP schreibe ein zeichen im hundertersystem in result;
+          i INCR 2
+      UNTIL i >= sll PER.
+   schreibe ein zeichen im hundertersystem in result :
+      CONCR(result) CAT code((code(ergebnis SUB i    ) - snull) * 10 +
+                              code(ergebnis SUB i + 1) - snull).
+   result mit vorzeichen : 
+      IF ergebnis="" THEN zero ELIF minus THEN -result ELSE result FI
+END PROC longint;
+ 
+LONGINT PROC max (LONGINT CONST left,right) :
+   IF left > right THEN left ELSE right FI
+END PROC max;
+ 
+LONGINT PROC max longint :
+   LONGINT : ((mtl - 1) * max digit)
+END PROC max longint;
+ 
+LONGINT PROC min (LONGINT CONST left,right) :
+   IF left < right THEN left ELSE right FI
+END PROC min;
+ 
+LONGINT OP MOD (LONGINT CONST left,right) :
+   IF CONCR(right) = null THEN errorstop("LONGINT OP MOD by zero") FI;
+   result := left DIV right; last rest 
+END OP MOD;
+ 
+PROC put (LONGINT CONST longint) :
+   INT  VAR i :: 1,zwei ziffern;
+   IF sign(longint) = -1 THEN out("-"); i:=2 FI;
+   out(text(code(CONCR(longint) SUB i)));
+   FOR i FROM i + 1 UPTO length(CONCR(longint)) REP
+       zwei ziffern := code(CONCR(longint) SUB i);
+       out(code(zwei ziffern DIV 10 + snull));
+       out(code(zwei ziffern MOD 10 + snull));
+   PER;out(" ")
+END PROC put;
+ 
+PROC put (FILE VAR file,LONGINT CONST longint) :
+   put(file,text(longint));
+END PROC put;
+ 
+LONGINT PROC random (LONGINT CONST lower bound,upper bound) :
+   INT VAR i; x := CONCR(upper bound - lower bound - one); y := "";
+   FOR i FROM 1 UPTO length(x) REP y CAT code(random(0,99)) PER;
+   upper bound - (LONGINT : (y) MOD LONGINT : (x)) 
+END PROC random;
+ 
+INT OP SIGN (LONGINT CONST arg) : sign(arg) END OP SIGN;
+ 
+INT PROC sign (LONGINT CONST arg) :
+   SELECT code(CONCR(arg) SUB 1) OF
+      CASE 0   :  0
+      CASE 127 : -1
+      OTHERWISE   1
+   END SELECT
+END PROC sign;
+ 
+TEXT PROC text (LONGINT CONST longint) :
+   INT  VAR i::1,zwei ziffern; ergebnis := "";
+   IF sign(longint) = -1 THEN ergebnis := "-"; i:=2  FI;
+   ergebnis CAT text (code (CONCR (longint) SUB i ) ) ;
+   FOR i FROM i+1 UPTO length(CONCR(longint)) REP
+      zwei ziffern := code(CONCR(longint) SUB i);
+      ergebnis CAT code(zwei ziffern DIV 10 + snull);
+      ergebnis CAT code(zwei ziffern MOD 10 + snull) 
+   PER;   ergebnis
+END PROC text;
+ 
+TEXT PROC text (LONGINT CONST longint,INT CONST length) :
+   x := text(longint); sll := LENGTH x;
+   IF sll > length THEN length * "*" ELSE (length - sll)*" " + x FI
+END PROC text; 
+
+LONGINT PROC last rest :
+  IF y=null THEN LEAVE last rest WITH zero FI; 
+  IF vorl XOR vorr THEN y := h SUB y; kuerze fuehrende nullen(y,null);
+                        vorl := TRUE FI;
+  IF NOTvorr THEN y:=negativ+y; vorr := TRUE FI; LONGINT:(y) 
+END PROC last rest;
+ 
+LONGINT PROC zero :   LONGINT : (null)   END PROC zero;
+LONGINT PROC one  :   LONGINT : (""1"")  END PROC one;
+ 
+ 
+(* ----------------------- INTERNE HILFSPROZEDUREN ----------------------- *)
+ 
+TEXT OP ADD (TEXT CONST left,right) :
+   INT  VAR   carrybit :: 0,i,dif :: length(left) - length(right);
+   ergebnis := left; 
+   FOR i FROM length(left) DOWNTO dif + 1 REP
+      replace(ergebnis,i,das result der addition)
+   PER;
+   IF carrybit = 1 THEN addiere den uebertrag  FI; 
+   ergebnis.
+ 
+   das result der addition :
+      v byte := (code(left SUB i) + code(right SUB i - dif) + carrybit);
+      IF v byte > 99 
+         THEN carrybit := 1; code(v byte - 100)
+         ELSE carrybit := 0; code(v byte)
+      FI. 
+   addiere den uebertrag :
+      FOR i FROM i DOWNTO 1
+          WHILE (ergebnis SUB i) >= max digit REP
+          replace(ergebnis,i,null) 
+      PER;
+      IF (ergebnis SUB 1) = null  OR  dif = 0
+         THEN pruefe auf longint overflow 
+         ELSE replace(ergebnis,i,code(code(ergebnis SUB i) + 1))
+      FI.
+   pruefe auf longint overflow :
+      IF length(ergebnis) = mtl - 1 THEN errorstop(overflow) FI;
+      ergebnis := eins + ergebnis
+END OP ADD;
+ 
+PROC betrag (LONGINT CONST a, b) :
+   vleft := (CONCR(a)SUB1)<>negativ; vright := (CONCR(b)SUB1)<>negativ;
+   IF vleft  THEN aleft :=a ELSE CONCR(aleft ):=subtext(CONCR(a),2) FI;
+   IF vright THEN aright:=b ELSE CONCR(aright):=subtext(CONCR(b),2) FI
+END PROC betrag;
+
+TEXT OP EXP (TEXT CONST arg,INT CONST exp) :
+   INT VAR zaehler :: exp;
+   x := arg; z := eins;
+   REP  IF zaehler MOD 2 = 1 THEN z := z MUL x FI; 
+        zaehler := zaehler DIV 2; x := x MUL x 
+   UNTIL zaehler = 1 PER;
+    x MUL z 
+END OP EXP;
+ 
+PROC kuerze fuehrende nullen ( TEXT VAR text,TEXT CONST snull) :
+   INT VAR i;
+   text := subtext(text,erste nicht snull).
+ 
+   erste nicht snull :
+   FOR i FROM 1 UPTO length (text) - 1 REP
+   UNTIL (text SUB i) <> snull PER;
+   i
+END PROC kuerze fuehrende nullen;
+ 
+INT PROC length (LONGINT CONST a) : 
+  IF (CONCR(a)SUB1)=negativ THEN length(CONCR(a))-1 ELSE length(CONCR(a)) FI
+END PROC length;
+ 
+TEXT OP MUL (TEXT CONST left,right) :
+   INT VAR i,j,carrybit,v,w;
+   ergebnis := (length(left) + length(right) - 1) * null;
+   FOR i FROM length(ergebnis) DOWNTO length(left) REP
+       v := i - length(left); w := length(right) - length(ergebnis) + i;
+       carrybit := 0;
+      FOR j FROM length(left) DOWNTO 1 REP
+            replace(ergebnis,v + j,result der addition)
+      PER;
+       replace(ergebnis,v,code(code(ergebnis SUB v) + carrybit));
+   PER;
+   IF carrybit = 0 THEN ergebnis ELSE code(carrybit) + ergebnis FI.
+
+   result der addition :
+      v byte := code(right    SUB w) * code(left SUB j) + carrybit +
+                code(ergebnis SUB v + j);
+      carrybit := v byte DIV 100;
+      code(v byte MOD 100)
+END OP MUL;
+ 
+TEXT OP SUB (TEXT CONST left,right) : 
+   INT  VAR   carrybit :: 0,i,dif :: length(left) - length(right);
+   ergebnis := left;
+   FOR i FROM length(left) DOWNTO dif + 1 REP 
+       replace(ergebnis,i,das result der subtraktion);
+   PER;
+   IF carrybit = 1 THEN subtrahiere den uebertrag FI;
+   ergebnis.
+ 
+   das result der subtraktion :
+      v byte := (code(left SUB i) - code(right SUB i - dif) - carrybit);
+      IF v byte < 0 
+         THEN carrybit := 1;code(v byte + 100)
+         ELSE carrybit := 0;code(v byte)
+      FI.
+   subtrahiere den uebertrag :
+      FOR i FROM i DOWNTO 2 
+          WHILE (ergebnis SUB i) = null REP
+          replace(ergebnis,i,max digit)
+      PER;
+      replace(ergebnis,i,code(code(ergebnis SUB i) - 1))
+END OP SUB;
+ 
+END PACKET longint;
+
diff --git a/datatype/matrix b/datatype/matrix
new file mode 100644
index 0000000..d9de9fb
--- /dev/null
+++ b/datatype/matrix
@@ -0,0 +1,482 @@
+PACKET matrix DEFINES MATRIX, matrix, idn,  (* Stand : 16.06.86 wk   *)
+                      :=, sub,              (* Autor : H.Indenbirken *)
+                      row, column,
+                      COLUMNS,
+                      ROWS,
+                      DET, 
+                      INV, 
+                      TRANSP, 
+                      transp,
+                      replace row, replace column,
+                      replace element,
+                      get, put,
+                      =, <>,
+                      +, -, * :
+
+TYPE MATRIX = STRUCT (INT rows, columns, VECTOR elems);
+TYPE INITMATRIX = STRUCT (INT rows, columns, REAL value, BOOL idn);
+
+MATRIX VAR a :: idn (1);
+INT VAR i;
+
+(****************************************************************************
+PROC dump (MATRIX CONST m) :
+  put line (text (m.rows) + " Reihen, " + text (m.columns) + " Spalten.");
+  dump (m.elems)  .
+
+END PROC dump;
+****************************************************************************)
+
+OP := (MATRIX VAR l, MATRIX CONST r) :
+  CONCR (l) := CONCR (r);
+END OP :=;
+
+OP := (MATRIX VAR l, INITMATRIX CONST r) :
+  l.rows    := r.rows;
+  l.columns := r.columns;
+  l.elems   := vector (r.rows*r.columns, r.value);
+  IF r.idn
+  THEN idn FI  .
+
+idn :
+  INT VAR i;
+  FOR i FROM 1 UPTO r.rows
+  REP replace (l.elems, calc pos (l.columns, i, i), 1.0) PER
+
+END OP :=;
+ 
+INITMATRIX PROC matrix (INT CONST rows, columns, REAL CONST value) :
+  IF rows <= 0
+  THEN errorstop ("PROC matrix : rows <= 0")
+  ELIF columns <= 0
+  THEN errorstop ("PROC matrix : columns <= 0") FI;
+
+  INITMATRIX : (rows, columns, value, FALSE)
+
+END PROC matrix;
+
+INITMATRIX PROC matrix (INT CONST rows, columns) :
+  matrix (rows, columns, 0.0)
+
+END PROC matrix;
+
+INITMATRIX PROC idn (INT CONST size) :
+  IF size <= 0
+  THEN errorstop ("MATRIX PROC idn : size <= 0") FI;
+
+  INITMATRIX : (size, size, 0.0, TRUE)
+
+END PROC idn;
+
+VECTOR PROC row (MATRIX CONST m, INT CONST i) :
+  VECTOR VAR v :: vector (m.columns);
+  INT VAR j, k :: 1, pos :: (i-1) * m.columns;
+  FOR j FROM pos+1 UPTO pos + m.columns
+  REP replace (v, k, m.elems SUB j);
+      k INCR 1
+  PER;
+  v
+
+END PROC row;
+
+VECTOR PROC column (MATRIX CONST m, INT CONST j) :
+  VECTOR VAR v :: vector (m.rows);
+  INT VAR i, k :: j;
+  FOR i FROM 1 UPTO m.rows
+  REP replace (v, i, m.elems SUB k);
+      k INCR m.columns
+  PER;
+  v
+
+END PROC column;
+
+INT OP COLUMNS (MATRIX CONST m) :
+  m.columns
+
+END OP COLUMNS;
+
+INT OP ROWS (MATRIX CONST m) :
+  m.rows
+
+END OP ROWS;
+
+REAL PROC sub (MATRIX CONST a, INT CONST row, column) :
+  a.elems SUB calc pos (a.columns, row, column)
+
+END PROC sub;
+
+PROC replace row (MATRIX VAR m, INT CONST rowindex, VECTOR CONST rowvalue) :
+  test ("PROC replace row : ", "LENGTH rowvalue", "COLUMNS m",
+        LENGTH rowvalue, m.columns);
+  test ("PROC replace row : row ", rowindex, m.rows);
+
+  INT VAR i, pos :: (rowindex-1) * m.columns;
+  FOR i FROM 1 UPTO m.columns
+  REP replace (m.elems, pos+i, rowvalue SUB i) PER
+
+END PROC replace row;
+
+PROC replace column (MATRIX VAR m, INT CONST columnindex,
+                     VECTOR CONST columnvalue) :
+  test ("PROC replace column : ", "LENGTH columnvalue", "ROWS m",
+        LENGTH columnvalue, m.rows);
+  test ("PROC replace column : column ", columnindex, m.columns);
+
+  INT VAR i;
+  FOR i FROM 1 UPTO m.rows
+  REP replace (m.elems, calc pos (m.columns, i, columnindex),
+               columnvalue SUB i) PER
+
+END PROC replace column;
+
+PROC replace element (MATRIX VAR a, INT CONST row, column, REAL CONST x) :
+  test ("PROC replace element : row ", row, a.rows);
+  test ("PROC replace element : column ", column, a.columns);
+  replace (a.elems, calc pos (a.columns, row, column), x)
+
+END PROC replace element;
+
+BOOL OP = (MATRIX CONST l, r) :
+  IF l.rows <> r.rows
+  THEN FALSE
+  ELIF l.columns <> r.columns
+  THEN FALSE
+  ELSE l.elems = r.elems FI
+
+END OP =;
+
+BOOL OP <> (MATRIX CONST l, r) :
+  IF l.rows <> r.rows
+  THEN TRUE
+  ELIF l.columns <> r.columns
+  THEN TRUE
+  ELSE l.elems <> r.elems FI
+
+END OP <>;
+
+INT PROC calc pos (INT CONST columns, z, s) :
+ (z-1) * columns + s
+END PROC calc pos;
+
+MATRIX OP + (MATRIX CONST m) :
+  m
+
+END OP +;
+
+MATRIX OP + (MATRIX CONST l, r) :
+  test ("MATRIX OP + : ", "ROWS l", "ROWS r", l.rows, r.rows);
+  test ("MATRIX OP + : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns);
+
+  a := l;
+  INT VAR i;
+  FOR i FROM 1 UPTO l.rows * l.columns
+  REP replace (a.elems, i, (l.elems SUB i) + (r.elems SUB i))
+  PER;
+  a
+
+END OP +;
+
+MATRIX OP - (MATRIX CONST m) :
+  a := m;
+  INT VAR i;
+  FOR i FROM 1 UPTO m.rows * m.columns
+  REP replace (a.elems, i, -a.elems SUB i)
+  PER;
+  a
+
+END OP -;
+
+MATRIX OP - (MATRIX CONST l, r) :
+  test ("MATRIX OP - : ", "ROWS l", "ROWS r", l.rows, r.rows);
+  test ("MATRIX OP - : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns);
+
+  a := l;
+  INT VAR i;
+  FOR i FROM 1 UPTO l.rows * l.columns
+  REP replace (a.elems, i, (l.elems SUB i) - (r.elems SUB i))
+  PER;
+  a
+
+END OP -;
+
+MATRIX OP * (REAL CONST x, MATRIX CONST m) :
+ m*x
+
+END OP *;
+
+MATRIX OP * (MATRIX CONST m, REAL CONST x) :
+  a := m;
+  INT VAR i;
+  FOR i FROM 1 UPTO m.rows * m.columns
+  REP replace (a.elems, i, x*m.elems SUB i) PER;
+  a
+
+END OP *;
+
+VECTOR OP * (VECTOR CONST v, MATRIX CONST m) :
+  test ("VECTOR OP * : ", "LENGTH v", "ROWS m", LENGTH v, m.rows);
+  VECTOR VAR result :: vector (m.columns);                       (*wk*)
+  INT VAR i;
+  FOR i FROM 1 UPTO m.columns
+  REP replace (result, i, v * column (m, i)) PER;
+  result  .
+
+END OP *;
+
+VECTOR OP * (MATRIX CONST m, VECTOR CONST v) :
+  test ("VECTOR OP * : ", "COLUMNS m", "LENGTH v", COLUMNS m, LENGTH v);
+  VECTOR VAR result :: vector (m.rows);                          (*wk*)
+  INT VAR i;
+  FOR i FROM 1 UPTO m.rows 
+  REP replace (result, i, row (m, i) * v) PER;
+  result  .
+
+END OP *;
+
+MATRIX OP * (MATRIX CONST l, r) :
+  test ("MATRIX OP * : ","COLUMNS l","ROWS r", l.columns, r.rows);
+
+  a.rows := l.rows;
+  a.columns := r.columns;
+  a.elems := vector (a.rows*a.columns)
+  INT VAR i, j;
+  FOR i FROM 1 UPTO a.rows
+  REP FOR j FROM 1 UPTO a.columns
+      REP VECTOR VAR rl :: row (l, i), cr :: column (r, j);
+          replace (a.elems, calc pos (a.columns, i, j), rl * cr)
+      PER
+  PER;
+  a  .
+
+END OP *;
+
+PROC get (MATRIX VAR a, INT CONST rows, columns) :
+ 
+  a := matrix (rows,columns);
+  INT VAR i, j;
+  VECTOR VAR v;
+  FOR i FROM 1 UPTO rows
+  REP get (v, columns);
+      store row
+  PER  .
+
+store row :
+  FOR j FROM 1 UPTO a.columns
+  REP replace (a.elems, calc pos (a.columns, i, j), v SUB j)
+  PER  .
+
+END PROC get;
+
+PROC put (MATRIX CONST a, INT CONST length, fracs) :
+  INT VAR i, j;
+  FOR i FROM 1 UPTO a.rows
+  REP FOR j FROM 1 UPTO a.columns
+      REP put (text (sub (a, i, j), length, fracs)) PER;
+      line (2);
+  PER
+
+END PROC put;
+
+PROC put (MATRIX CONST a) :
+  INT VAR i, j;
+  FOR i FROM 1 UPTO a.rows
+  REP FOR j FROM 1 UPTO a.columns
+      REP TEXT CONST number :: "                 " + text (sub (a, i, j));
+          put (subtext (number, LENGTH number - 15))
+      PER;
+      line (2);
+  PER
+
+END PROC put;
+
+TEXT VAR error :: "";
+PROC test (TEXT CONST proc, l text, r text, INT CONST left, right) :
+  IF left <> right
+  THEN error := proc;
+       error CAT l text;
+       error CAT " (";
+       error CAT text (left);
+       error CAT ") <> ";
+       error CAT r text;
+       error CAT " (";
+       error CAT text (right);
+       error CAT ")";
+       errorstop (error)
+  FI  .
+
+END PROC test;
+
+PROC test (TEXT CONST proc, INT CONST i, n) :
+  IF i < 1
+  THEN error := proc;
+       error CAT "subscript underflow (";
+       error CAT text (i);
+       error CAT ")";
+       errorstop (error)
+  ELIF i > n
+  THEN error := proc;
+       error CAT "subscript overflow (i=";
+       error CAT text (i);
+       error CAT ", max=";
+       IF n <= 0
+       THEN error CAT "undefined"
+       ELSE error CAT text (n) FI;
+       error CAT ")";
+       errorstop (error)
+  FI
+
+END PROC test;
+
+
+MATRIX OP TRANSP (MATRIX CONST m) :
+  MATRIX VAR a :: m;
+  transp (a);
+  a
+
+END OP TRANSP;
+
+PROC transp (MATRIX VAR m) :
+  INT VAR k :: 1, n :: m.rows*m.columns;
+  a := m;
+  FOR i FROM 2 UPTO n
+  REP replace (m.elems, i, a.elems SUB position) PER;
+  a := idn (1);
+  i := m.rows;
+  m.rows := m.columns;
+  m.columns := i  .
+
+position :
+  k INCR m.columns;
+  IF k > n
+  THEN k DECR (n-1) FI;
+  k  .
+END PROC transp;
+
+MATRIX OP INV (MATRIX CONST m) :
+  a := m;
+  ROW 32 INT VAR pivots;
+  INT VAR i, j, k :: ROWS a, n :: COLUMNS a, pos;
+
+  IF n <> k
+  THEN errorstop ("MATRIX OP INV : no square matrix") FI;
+
+  initialisiere die pivotpositionen;
+
+  FOR j FROM 1 UPTO n
+  REP pivotsuche (a, j, pos);
+      IF sub (a, pos, pos) = 0.0
+      THEN errorstop ("MATRIX OP INV : singular matrix") FI;
+      zeilentausch (a, j, pos);
+      merke dir die vertauschung;
+      transformiere die matrix
+  PER;
+
+  spaltentausch;
+  a  .
+
+initialisiere die pivotpositionen :
+  FOR i FROM 1 UPTO n
+  REP pivots [i] := i PER  .
+
+merke dir die vertauschung :
+  IF pos > j
+  THEN INT VAR hi :: pivots [j];
+       pivots [j] := pivots [pos];
+       pivots [pos] := hi
+  FI  .
+
+transformiere die matrix :
+  REAL VAR h := 1.0/sub (a, j, j);
+
+  FOR k FROM 1 UPTO n
+  REP IF k <> j
+      THEN FOR i FROM 1 UPTO n
+           REP IF i <> j
+               THEN replace element (a, i, k, sub (a, i, k) -
+                                     sub (a, i, j)*sub (a, j, k)*h);
+               FI
+           PER;
+       FI
+  PER;
+
+  FOR k FROM 1 UPTO n
+  REP replace element (a, j, k, -h*sub (a, j, k));
+      replace element (a, k, j,  h*sub (a, k, j))
+  PER;
+  replace element (a, j, j, h)  .
+
+spaltentausch :
+  VECTOR VAR v :: vector (n);
+  FOR i FROM 1 UPTO n
+  REP FOR k FROM 1 UPTO n
+      REP replace (v, pivots [k], sub(a, i, k)) PER; 
+      replace row (a, i, v) 
+  PER  .
+
+END OP INV;
+
+REAL OP DET (MATRIX CONST m) :
+  IF COLUMNS m <> ROWS m
+  THEN errorstop ("REAL OP DET : no square matrix") FI;
+
+  a := m;
+  INT VAR i, j, k, n :: COLUMNS m, pos;
+  REAL VAR merker := 1.0; 
+  FOR j FROM 1 UPTO n
+  REP pivotsuche (a, j, pos);
+      IF j<> pos 
+        THEN zeilentausch (a, j, pos);
+             zeilen tausch merken 
+      FI; 
+      transformiere die matrix
+  PER;
+  produkt der pivotelemente  .
+
+transformiere die matrix : 
+  REAL VAR hp := sub(a,j,j); 
+  IF hp = 0.0 
+    THEN LEAVE DET WITH 0.0 
+    ELSE REAL VAR h := 1.0/hp;
+  FI;
+  FOR i FROM j+1 UPTO n
+  REP FOR k FROM j+1 UPTO n
+      REP replace element (a, i, k, sub (a, i, k) -
+                           sub (a, i, j)*h*sub (a, j, k))
+      PER
+  PER  .
+
+produkt der pivotelemente :
+  REAL VAR produkt :: sub (a, 1, 1);
+  FOR j FROM 2 UPTO n
+  REP produkt := produkt * sub (a, j, j) PER;
+  a := idn (1);
+  produkt * merker.
+
+zeilen tausch merken: 
+  merker := merker * (-1.0). 
+ 
+END OP DET;
+
+PROC pivotsuche (MATRIX CONST a, INT CONST start pos, INT VAR pos) :
+  REAL VAR max :: abs (sub (a, start pos, start pos));
+  INT VAR i;
+  pos := start pos;
+
+  FOR i FROM start pos+1 UPTO COLUMNS a
+  REP IF abs (sub (a, i, start pos)) > max
+      THEN max := abs (sub (a, i, start pos));
+           pos := i
+      FI
+  PER  .
+
+END PROC pivotsuche;
+
+PROC zeilentausch (MATRIX VAR a, INT CONST old pos, pos) :
+  VECTOR VAR v := row (a, pos);
+  replace row (a, pos, row (a, old pos));
+  replace row (a, old pos, v)  .
+
+END PROC zeilentausch;
+
+END PACKET matrix;
+
diff --git a/datatype/vector b/datatype/vector
new file mode 100644
index 0000000..5c9e896
--- /dev/null
+++ b/datatype/vector
@@ -0,0 +1,213 @@
+PACKET vector DEFINES VECTOR, :=, vector,         (* Autor : H.Indenbirken *)
+                      SUB, LENGTH, length, norm,  (* Stand : 21.10.83      *)
+                      nilvector, replace, =, <>,
+                      +, -, *, /,
+                      get, put :
+
+
+TYPE VECTOR = STRUCT (INT lng, TEXT elem);
+TYPE INITVECTOR = STRUCT (INT lng, REAL value);
+
+INT VAR i;
+TEXT VAR t :: "12345678";
+VECTOR VAR v :: nilvector;
+
+(****************************************************************************
+PROC dump (VECTOR CONST v) :
+  put line (text (v.lng) + " Elemente :");
+  FOR i FROM 1 UPTO v.lng
+  REP put line (text (i) + ": " + text (element i)) PER  .
+
+element i :
+  v.elem RSUB i  .
+
+END PROC dump;
+****************************************************************************)
+
+OP := (VECTOR VAR l, VECTOR CONST r) :
+  l.lng := r.lng;
+  l.elem := r.elem
+
+END OP :=;
+
+OP := (VECTOR VAR l, INITVECTOR CONST r) :
+  l.lng := r.lng;
+  replace (t, 1, r.value);
+  l.elem := r.lng * t
+
+END OP :=;
+
+INITVECTOR PROC nilvector :
+   vector (1, 0.0)
+
+END PROC nilvector;
+
+INITVECTOR PROC vector (INT CONST lng, REAL CONST value) :
+  IF lng <= 0
+  THEN errorstop ("PROC vector : lng <= 0") FI;
+  INITVECTOR : (lng, value)
+
+END PROC vector;
+
+INITVECTOR PROC vector (INT CONST lng) :
+  vector (lng, 0.0)
+
+END PROC vector;
+
+REAL OP SUB (VECTOR CONST v, INT CONST i) :
+  test ("REAL OP SUB : ", v, i);
+  v.elem RSUB i
+
+END OP SUB;
+
+INT OP LENGTH (VECTOR CONST v) :
+  v.lng
+
+END OP LENGTH;
+
+INT PROC length (VECTOR CONST v) :
+  v.lng
+
+END PROC length;
+
+REAL PROC norm (VECTOR CONST v) :
+  REAL VAR result :: 0.0;
+  FOR i FROM 1 UPTO v.lng
+  REP result INCR ((v.elem RSUB i)**2) PER;
+  sqrt (result)  .
+
+END PROC norm;
+
+PROC replace (VECTOR VAR v, INT CONST i, REAL CONST r) :
+  test ("PROC replace : ", v, i);
+  replace (v.elem, i, r)
+
+END PROC replace;
+
+BOOL OP = (VECTOR CONST l, r) :
+  l.elem = r.elem
+END OP =;
+
+BOOL OP <> (VECTOR CONST l, r) :
+  l.elem <> r.elem
+END OP <>;
+
+VECTOR OP + (VECTOR CONST v) :
+  v
+END OP +;
+
+VECTOR OP + (VECTOR CONST l, r) :
+  test ("VECTOR OP + : ", l, r);
+  v := l;
+  FOR i FROM 1 UPTO v.lng
+  REP replace (v.elem, i, (l.elem RSUB i) + (r.elem RSUB i)) PER;
+  v
+
+END OP +;
+
+VECTOR OP - (VECTOR CONST a) :
+  v := a;
+  FOR i FROM 1 UPTO v.lng
+  REP replace (v.elem, i, - (a.elem RSUB i)) PER;
+  v
+
+END OP -;
+
+VECTOR OP - (VECTOR CONST l, r) :
+  test ("VECTOR OP - : ", l, r);
+  v := l;
+  FOR i FROM 1 UPTO v.lng
+  REP replace (v.elem, i, (l.elem RSUB i) - (r.elem RSUB i)) PER;
+  v
+END OP -;
+
+REAL OP * (VECTOR CONST l, r) :
+  test ("REAL OP * : ", l, r);
+  REAL VAR x :: 0.0;
+  FOR i FROM 1 UPTO l.lng
+  REP x INCR ((l.elem RSUB i) * (r.elem RSUB i)) PER;
+  x
+
+END OP *;
+
+VECTOR OP * (VECTOR CONST v, REAL CONST r) :
+  r*v
+
+END OP *;
+
+VECTOR OP * (REAL CONST r, VECTOR CONST a) :
+  v := a;
+  FOR i FROM 1 UPTO v.lng
+  REP replace (v.elem, i, r*(a.elem RSUB i)) PER;
+  v
+
+END OP *;
+
+VECTOR OP / (VECTOR CONST a, REAL CONST r) :
+  v := a;
+  FOR i FROM 1 UPTO v.lng
+  REP replace (v.elem, i, (a.elem RSUB i)/r) PER;
+  v
+
+END OP /;
+
+TEXT VAR error :: "";
+PROC test (TEXT CONST proc, VECTOR CONST v, INT CONST i) :
+  IF i > v.lng
+  THEN error := proc;
+       error CAT "subscript overflow (LENGTH v=";
+       error CAT text (v.lng);
+       error CAT ", i=";
+       error CAT text (i);
+       error CAT ")";
+       errorstop (error)
+  ELIF i < 1
+  THEN error := proc;
+       error CAT "subscript underflow (i = ";
+       error CAT text (i);
+       error CAT ")";
+       errorstop (error)
+  FI  .
+
+END PROC test;
+
+PROC test (TEXT CONST proc, VECTOR CONST a, b) :
+  IF a.lng <> b.lng
+  THEN error := proc;
+       error CAT "LENGTH a (";
+       IF a.lng <= 0
+       THEN error CAT "undefined"
+       ELSE error CAT text (a.lng) FI;
+       error CAT ") <> LENGTH b (";
+       error CAT text (b.lng);
+       error CAT ")";
+       errorstop (error)
+  FI
+
+END PROC test;
+
+PROC get (VECTOR VAR v, INT CONST lng) :
+  v.lng := lng;
+  v.elem := lng * "12345678";
+  REAL VAR x;
+  FOR i FROM 1 UPTO lng
+  REP get (x);
+      replace (v.elem, i, x)
+  PER  .
+
+END PROC get;
+
+PROC put (VECTOR CONST v, INT CONST length, fracs) :
+  FOR i FROM 1 UPTO v.lng
+  REP put (text (v.elem RSUB i, length, fracs)) PER
+
+END PROC put;
+
+PROC put (VECTOR CONST v) :
+  FOR i FROM 1 UPTO v.lng
+  REP put (text (v.elem RSUB i)) PER
+
+END PROC put;
+
+END PACKET vector;
+