470 files changed, 160022 insertions, 0 deletions

diff --git a/system/at/1.8.7/source-disk b/system/at/1.8.7/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/system/at/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/system/at/1.8.7/src/AT Generator b/system/at/1.8.7/src/AT Generator
new file mode 100644
index 0000000..d3bfd6d
--- /dev/null
+++ b/system/at/1.8.7/src/AT Generator
@@ -0,0 +1,135 @@
+(*************************************************************************)
+(*** Generiert Für IBM-AT einen neuen SYSUR-Zweig.                     ***)
+(*** Danach wird die eingebaute Hardwareuhr für die Systemzeit benutzt ***)
+(*** und andere Partitionen können mit neuem 'shutup' gebootet werden. ***)
+(***                                                                   ***)
+(*** Autor : W. Sauerwein                             Stand : 15.07.86 ***)
+(*************************************************************************)
+
+LET ack = 0,
+    nak = 1;
+ 
+cl eop (1, 4);
+erzeuge collector;
+erzeuge archive manager;
+erzeuge operator;
+erzeuge configurator;
+loesche collector;
+forget ("AT Generator", quiet);
+break.
+
+loesche collector :
+   end (/"colly");
+   put ("Collector gelöscht.");
+   line (2).
+
+erzeuge collector :
+   put line ("Generating 'Collector'...");
+   begin ("colly", PROC generate collector, t);
+   warte auf meldung;
+   IF answer = nak THEN end (/"colly");
+                        errorstop (meldung)
+   FI.
+   TASK VAR t.
+
+erzeuge archive manager :
+   put line ("Generating 'ARCHIVE'...");
+   end (/"ARCHIVE");
+   begin ("ARCHIVE", PROC archive manager, t).
+
+erzeuge operator :
+   put line ("Generating 'OPERATOR'...");
+   end (/"OPERATOR");
+   begin ("OPERATOR", PROC monitor, t).
+ 
+erzeuge configurator :
+   put line ("Generating 'configurator'...");
+   end (/"configurator");
+   begin ("configurator", PROC generate configurator, t); 
+   warte auf meldung;
+   IF answer = nak THEN errorstop (meldung) FI.
+ 
+warte auf meldung : 
+   DATASPACE VAR ds; INT VAR answer; 
+   wait (ds, answer, t);
+   BOUND TEXT VAR m := ds;
+   TEXT VAR meldung := m;
+   forget (ds).
+ 
+PROC generate collector :
+
+   disable stop;
+   fetch all (/"configurator");
+   DATASPACE VAR ds := nilspace;
+   BOUND TEXT VAR m := ds; m := "";
+   send (father, mess, ds);
+   forget (ds);
+   free global manager.
+ 
+mess : IF is error THEN m := error message;
+                        nak
+                   ELSE ack FI.
+
+END PROC generate collector;
+
+PROC generate configurator :
+
+   disable stop;
+   fetch all (/"colly");
+   DATASPACE VAR ds := nilspace; 
+   BOUND TEXT VAR m := ds; m := "";
+   send (father, mess, ds);
+   forget (ds);
+   enable stop;
+   new configuration;
+   setup;
+   global manager (PROC ( DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 
+                   configuration manager with time).
+
+mess : IF is error THEN m := error message;
+                        nak
+                   ELSE ack FI.
+
+END PROC generate configurator;
+
+TEXT PROC inverse (TEXT CONST t):
+  ""15"" + t + " " + ""14""
+END PROC inverse;
+
+PROC put center (TEXT CONST t):
+   put center (t, 80)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t):
+   put center (zeile, t, 80)
+END PROC put center;
+
+PROC put center (TEXT CONST t, INT CONST gesamtbreite):
+   INT VAR cy;
+   get cursor (cy, cy);
+   put center (cy, t, gesamtbreite)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):
+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);
+   put (t).
+END PROC put center;
+
+PROC cl eol: 
+  out (""5"") 
+END PROC cl eol;
+
+PROC cl eop: 
+  out (""4"") 
+END PROC cl eop; 
+ 
+PROC cl eol (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eol 
+END PROC cl eol; 
+ 
+PROC cl eop (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eop 
+END PROC cl eop; 
+
diff --git a/system/at/1.8.7/src/AT Utilities b/system/at/1.8.7/src/AT Utilities
new file mode 100644
index 0000000..760e728
--- /dev/null
+++ b/system/at/1.8.7/src/AT Utilities
@@ -0,0 +1,1057 @@
+(*************************************************************************)
+(*** AT-spezifische Software, die zum Lesen der Hardwareuhr und        ***)
+(*** Booten in anderen Partitionen benötigt wird.                      ***)
+(***                                                                   ***)
+(*** Zusammengestellt und geändert : Werner Sauerwein, GMD             ***)
+(***                         Stand : 31.10.86                          ***)
+(*************************************************************************)
+
+PACKET splitting DEFINES  low byte,     (* Copyright (C) 1985       *)
+                          high byte,    (* Martin Schönbeck, Spenge *)
+                          low word,     (* Stand: 13.09.85          *)
+                          high word: 
+ 
+INT PROC high byte (INT CONST value):
+ 
+    TEXT VAR x := "  ";
+    replace (x, 1, value);
+    code (x SUB 2)
+
+END PROC high byte;
+
+INT PROC low byte (INT CONST value):
+ 
+    TEXT VAR x := "  ";
+    replace (x, 1, value);
+    code (x SUB 1)
+
+END PROC low byte; 
+ 
+INT PROC high word (REAL CONST double precission int):
+
+    int (double precission int / 65536.0)
+
+END PROC high word;
+
+INT PROC low word (REAL CONST double precission int): 
+ 
+    string of low bytes ISUB 1.
+
+string of low bytes:
+    code (int (double precission int MOD 256.0)) +
+    code (int ((double precission int MOD 65536.0) / 256.0)). 
+ 
+END PROC low word; 
+
+END PACKET splitting;
+
+
+PACKET basic block io DEFINES
+ 
+  read block,
+  write block:
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code):
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, 0, block no, return code).
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, 0, block no, return code).
+ 
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block; 
+
+PROC read block (DATASPACE VAR ds, INT CONST ds page,
+                 REAL CONST archive block):
+
+   enable stop;
+   read block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht gelesen werden");
+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+
+END PROC read block;
+
+PROC write block (DATASPACE CONST ds, INT CONST ds page,
+                  REAL CONST archive block):
+
+   enable stop;
+   write block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht geschrieben werden");
+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+
+END PROC write block;
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 REAL CONST block no,
+                 INT VAR return code):
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, high word (block no),
+                             low word (block no), return code).
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 REAL CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, high word (block no),
+                              low word (block no), return code).
+ 
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block; 
+
+END PACKET basic block io;
+
+
+PACKET utilities DEFINES getchoice, cleol, cleop, inverse, put center:
+ 
+INT PROC get choice (INT CONST von, bis, TEXT VAR retchar):
+  get choice (von, bis, von, retchar)
+END PROC get choice;
+
+INT PROC get choice (INT CONST von, bis, zusatz, TEXT VAR retchar):
+   LET return  = ""13"",
+       escape  = ""27"",
+       left    = ""8"";
+   TEXT VAR buffer; 
+   INT VAR cx, cy;
+   get cursor (cx, cy); out (" " + left);
+   REP
+      REP 
+         cursor (cx, cy); buffer := incharety;
+      UNTIL input ok OR buffer = escape PER; 
+      IF buffer = escape THEN retchar := escape;
+                              LEAVE get choice WITH 0
+      FI;
+      out (buffer); 
+      leseschleife bis left or ret;
+      IF retchar = left   THEN out (left + " ") FI;
+      IF retchar = escape THEN LEAVE get choice WITH 0 FI
+   UNTIL retchar = return OR retchar = escape PER;
+   int (buffer). 
+ 
+input ok : (buffer >= text (von) AND buffer <= text (bis)) OR buffer = text (zusatz).
+
+leseschleife bis left or ret:
+   REP 
+     inchar (retchar) 
+   UNTIL retchar = return OR retchar = left OR retchar = escape PER.
+
+END PROC get choice;
+
+PROC cl eol (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eol 
+END PROC cl eol; 
+ 
+PROC cl eop (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eop 
+END PROC cl eop; 
+
+
+PROC cl eol: 
+  out (""5"") 
+END PROC cl eol;
+
+PROC cl eop: 
+  out (""4"") 
+END PROC cl eop; 
+
+TEXT PROC inverse (TEXT CONST t):
+  ""15"" + t + " " + ""14""
+END PROC inverse; 
+ 
+PROC put center (TEXT CONST t):
+   put center (t, 80)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t):
+   put center (zeile, t, 80)
+END PROC put center;
+
+PROC put center (TEXT CONST t, INT CONST gesamtbreite):
+   INT VAR cy;
+   get cursor (cy, cy);
+   put center (cy, t, gesamtbreite)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):
+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);
+   put (t).
+END PROC put center;
+
+END PACKET utilities
+
+
+PACKET part DEFINES activate, show actual partition table:
+                                           (* Copyright (C) 1985       *)
+                                           (* Martin Schönbeck, Spenge *)
+                                           (* Stand      : 02.02.86    *)
+                                           (* Changed by : W.Sauerwein *)
+                                           (*              I.Ley       *)
+                                           (* Stand      : 03.10.86    *) 
+    LET fd channel           = 28;
+
+ROW 256 INT VAR boot block;
+INT VAR boot block session := session - 1;
+
+PROC get boot block:
+    IF boot block session <> session
+       THEN hole aktuellen boot block
+    FI.
+
+hole aktuellen boot block:
+    disable stop;
+    DATASPACE VAR dummy ds := nilspace;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table := dummy ds; 
+    get external block (dummy ds, 2, 0, fd channel); 
+    IF NOT is error
+        THEN transfer data to boot block
+    FI; 
+    forget (dummy ds). 
+ 
+transfer data to boot block:
+    IF not valid boot block
+        THEN try to get valid boot block from file
+    FI;
+    boot block := partition table. block;
+    boot block session := session.
+
+not valid boot block:
+    partition table. block [256] <> boot indicator OR
+    it is an old boot block of eumel.
+
+boot indicator: -21931.
+
+it is an old boot block of eumel:
+    partition table. block [1] = 1514.
+
+try to get valid boot block from file:
+    forget (dummy ds);
+    partition table := old ("bootblock");
+    IF is error THEN LEAVE transfer data to boot block FI.
+ 
+END PROC get boot block;
+
+PROC put boot block:
+    IF boot block ist uptodate
+        THEN schreibe block auf platte
+        ELSE errorstop ("boot block nicht uptodate")
+    FI.
+
+boot block ist uptodate:
+    boot block session = session.
+
+schreibe block auf platte:
+    disable stop;
+    DATASPACE VAR dummy ds := nilspace;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table := dummy ds; 
+    transfer data to dataspace;
+    put external block (dummy ds, 2, 0, fd channel); 
+    forget (dummy ds). 
+ 
+transfer data to dataspace:
+    partition table. block := boot block.
+
+END PROC put boot block;
+
+INT PROC partition type (INT CONST partition):
+    low byte (boot block [entry (partition) + 2])
+END PROC partition type;
+
+REAL PROC partition start (INT CONST partition):
+    unsigned low word + high word.
+
+unsigned low word:
+    real (low byte (boot block [entry (partition) + 4])) +
+    real (high byte (boot block [entry (partition) + 4])) * 256.0.
+
+high word:
+    real (boot block [entry (partition) + 5]).
+
+END PROC partition start;
+
+INT PROC partition word 0 (INT CONST partition):
+   boot block (entry (partition))
+END PROC partition word 0;
+
+INT PROC first track (INT CONST partition):
+    high byte (boot block [entry (partition) + 1]) 
+    + 4 * (low byte (boot block [entry (partition) + 1]) AND (128 + 64)) 
+END PROC first track;
+
+INT PROC last track (INT CONST partition):
+    high byte (boot block [entry (partition) + 3]) 
+    + 4 * (low byte (boot block [entry (partition) + 3]) AND (128 + 64)) 
+END PROC last track;
+
+BOOL PROC partition activ (INT CONST partition):
+    low byte (boot block [entry (partition)]) = 128
+END PROC partition activ;
+
+REAL PROC partition size (INT CONST partition):
+    unsigned low word + high word.
+
+unsigned low word:
+    real (low byte (boot block [entry (partition) + 6])) +
+    real (high byte (boot block [entry (partition) + 6])) * 256.0.
+
+high word:
+    real (boot block [entry (partition) + 7]).
+
+END PROC partition size;
+
+INT PROC tracks: 
+   get value (-10, fd channel) 
+END PROC tracks; 
+
+PROC activate (INT CONST part type):
+    IF partition type exists AND is possible type
+         THEN deactivate all partitions and
+              activate desired partition
+         ELSE errorstop ("Gewünschte Partitionart gibt es nicht")
+    FI.
+
+is possible type:
+   part type > 0 AND
+   part type < 256.
+
+partition type exists:
+    INT VAR partition;
+    FOR partition FROM 1 UPTO 4 REP
+         IF partition type (partition) = part type 
+             THEN LEAVE partition type exists WITH TRUE
+         FI;
+    PER;
+    FALSE.
+
+deactivate all partitions and activate desired partition:
+    FOR partition FROM 1 UPTO 4 REP
+         deactivate this partition;
+         IF partition type (partition) = part type
+              THEN activate partition
+         FI
+    PER;
+    put boot block.
+
+deactivate this partition:
+    set bit (boot block [entry (partition)], 7);
+    (* first setting needed, because reset bit does xor *)
+    reset bit (boot block [entry (partition)], 7).
+
+activate partition:
+    set bit (boot block [entry (partition)], 7)
+
+END PROC activate;
+
+INT PROC entry (INT CONST partition):
+    get boot block;
+    256 - 5 * 8 + (partition * 8)
+END PROC entry;
+
+INT PROC get value (INT CONST control code, channel for value): 
+    enable stop; 
+    INT VAR old channel := channel;
+    continue (channel for value); 
+    INT VAR value; 
+    control (control code, 0, 0, value); 
+    continue (old channel); 
+    value 
+END PROC get value; 
+ 
+PROC get external block (DATASPACE VAR ds, INT CONST ds page,
+                                             archive block, get channel):
+   INT VAR old channel := channel; 
+   continue (get channel);
+   disable stop;
+   read block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht gelesen werden");
+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+   continue (old channel).
+END PROC get external block;
+
+PROC put external block (DATASPACE CONST ds, INT CONST ds page,
+                                             archive block, get channel):
+   INT VAR old channel := channel; 
+   continue (get channel);
+   disable stop;
+   write block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht geschrieben werden");
+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+   continue (old channel).
+END PROC put external block;
+ 
+(**************************************************************************)
+ 
+   LET                           max partitions           =   4;
+   ROW max partitions INT  VAR   part list;
+   ROW max partitions INT  VAR   part type, part active,
+                                 part first track, part last track;
+   ROW max partitions REAL VAR   part start,
+                                 part size;
+                      INT  VAR   zylinder,
+                                 startzeile tabelle      ::   1,
+                                 active partition,
+                                 partitions,
+                                 partition, i, j, help;
+
+                                 
+PROC get actual partition data :
+   get boot block;
+   zylinder := tracks;
+   FOR i FROM 1 UPTO max partitions REP
+      part type        (i) := partition type (i);
+      part first track (i) := first track (i);
+      part last track  (i) := last track (i);
+      part start       (i) := partition start (i);
+      part size        (i) := partition size (i);
+      part active      (i) := partition word 0 (i);
+      IF partition activ (i) THEN active partition := i FI
+   PER;
+   get number of installed partitions;
+   generate part list.
+
+get number of installed partitions :
+   partitions := 0;
+   FOR i FROM 1 UPTO max partitions REP
+     IF part type (i) <> 0 THEN partitions INCR 1 FI
+   PER.
+
+generate part list :
+   FOR i FROM 1 UPTO max partitions REP
+      IF part type (i) <> 0 THEN part list (i) := i
+                            ELSE part list (i) := 0
+      FI;
+   PER;
+   schiebe nullen nach hinten;
+   sort part list.
+
+schiebe nullen nach hinten :
+   i := 1; INT VAR k := 0;
+   REP k INCR 1;
+       IF part list (i) = 0 THEN circle
+                            ELSE i INCR 1
+       FI
+   UNTIL k = max partitions - 1 PER.
+
+circle :
+   FOR j FROM i UPTO max partitions - 1 REP
+      part list (j) := part list (j + 1)
+   PER;
+   part list (max partitions) := 0.
+
+sort part list :
+   FOR i FROM 2 UPTO partitions REP
+      FOR j FROM 1 UPTO i - 1 REP
+          IF part first track (part list (i)) < part first track (part list (j))
+             THEN tausche FI
+      PER
+   PER.
+
+tausche :
+   help := part list (i);
+   part list (i) := part list (j);
+   part list (j) := help.
+
+END PROC get actual partition data;
+
+
+PROC show partition table :
+   headline;
+   devide table;
+   columns;
+   underlines;
+   rows;
+   footlines.
+
+head line :
+   cl eop (1, startzeile tabelle);
+   put center (inverse ("                       "
+                      + "Aktuelle Partitions - Tabelle"
+                      + "                       ")).
+
+devide table :
+   FOR i FROM 1 UPTO 8
+   REP
+      cursor (50, startzeile tabelle + i); out (inverse (""))
+   PER.
+
+columns :
+   cursor ( 1, startzeile tabelle + 2);
+   out (" Nr. System    Typ-Nr. Zustand Größe Start Ende");
+   cursor (54, startzeile tabelle + 2);
+   out ("Plattengröße / Zylinder ").
+
+underlines :
+   cursor ( 1, startzeile tabelle + 3);
+   out ("-------------------------------------------------");
+   cursor (52, startzeile tabelle + 3);
+   out ("--------------------------").
+
+rows :
+   FOR i FROM 1 UPTO max partitions
+   REP cursor (2, startzeile tabelle + 3 + i);
+       put (text (i) + " :")
+   PER.
+
+footlines:
+   cursor (1, startzeile tabelle + 9);
+   put center (inverse (75 * " ")).
+
+END PROC show partition table;
+
+PROC update table :
+   get actual partition data;
+   FOR i FROM 1 UPTO partitions REP update partition PER;
+   FOR i FROM partitions + 1 UPTO max partitions REP rubout partition PER;
+   zeige plattengroesse.
+
+update partition :
+   partition := part list (i);
+   show partition.
+
+rubout partition :
+   cursor (6, startzeile tabelle + 3 + i);
+   out ("                                          ").
+
+show partition :
+   cursor (6, startzeile tabelle + 3 + i);
+   put (name + type + zustand  + groesse + startspur + endspur).
+
+name : subtext (subtext (part name, 1, 9)
+              + "          ", 1, 10).
+
+type : text (part type (partition), 5) + "   ".
+
+zustand   : IF active partition = partition THEN (" aktiv ")
+                                            ELSE ("       ")
+            FI.
+
+startspur : " " + text (part first track (partition), 5).
+endspur   :       text (part last track   (partition), 6).
+groesse   :       text (part groesse, 5).
+
+zeige plattengroesse :
+   put gesamt;
+   put noch freie;
+   put maximaler zwischenraum.
+
+put maximaler zwischenraum :
+   cursor (54, startzeile tabelle + 6);
+   put ("max. zusammenh. : " + text (maximaler zwischenraum, 4)).
+
+put gesamt :
+   cursor (54, startzeile tabelle + 4);
+   put ("insgesamt       : " + text (zylinder, 4)).
+
+put noch freie :
+   cursor (54, startzeile tabelle + 5);
+   put ("davon noch frei : " + text (freie zylinder, 4)).
+
+part groesse :
+   partition groesse (partition).
+
+part name :
+   SELECT part type (partition) OF
+     CASE              1 : "DOS"
+     CASE 69, 70, 71, 72 : "EUMEL"
+     OTHERWISE text (part type (partition))
+   END SELECT.
+
+freie zylinder :
+   zylinder - belegte zylinder.
+
+belegte zylinder :
+   help := 0;
+   FOR i FROM 1 UPTO partitions REP
+      help INCR partition groesse (part list (i))
+   PER;
+   help.
+
+END PROC update table;
+ 
+INT PROC maximaler zwischenraum :
+   IF partitions = 0 THEN zylinder
+                     ELSE max (maximaler platz vor und zwischen den partitionen,
+                               platz hinter letzter partition)
+   FI.
+
+maximaler platz vor und zwischen den partitionen :
+   help := platz vor erster partition;
+   FOR i FROM 1 UPTO partitions - 1
+   REP
+      help := max (help, begin of part i plus 1 - end of part i - 1)
+   PER;
+   help.
+
+platz vor erster partition :
+   part first track (part list (1)).
+
+platz hinter letzter partition :
+   zylinder - part last track (part list (partitions)) - 1.
+
+begin of part i plus 1 :
+   part first track (part list (i + 1)).
+
+end of part i :
+   part last track (part list (i)).
+
+END PROC maximaler zwischenraum;
+
+INT PROC partition groesse (INT CONST part) :
+   part last track (part) - part first track (part) + 1
+END PROC partition groesse;
+
+PROC show actual partition table:
+   show partition table;
+   update table;
+   line (4)
+END PROC show actual partition table;
+
+PROC show actual partition table (ROW max partitions INT VAR typnr):
+   show actual partition table;
+   FOR i FROM 1 UPTO max partitions REP
+      typnr (i) := partition type (part list (i))
+   PER;
+END PROC show actual partition table;
+
+END PACKET part;
+
+
+PACKET hw clock DEFINES hw clock:        (* Copyright (C) 1985       *)
+                                         (* Martin Schönbeck, Spenge *)
+LET clock length  = 7,                   (* Stand: 06.11.85          *)
+    clock command = 4;
+
+BOUND STRUCT (ALIGN dummy,
+              ROW clock length INT clock field) VAR clock data;
+
+REAL PROC hw clock:
+ 
+    disable stop;
+    get clock;
+    hw date + hw time.
+
+get clock:
+    DATASPACE VAR ds := nilspace;
+    clock data := ds;
+    INT VAR return code, actual channel := channel;
+    go to shard channel;
+    blockin (ds, 2, -clock command, 0, return code);
+    IF actual channel = 0 THEN break (quiet)
+                          ELSE continue (actual channel)
+    FI;
+    IF return code <> 0 
+        THEN errorstop ("Keine Hardware Uhr vorhanden");
+    FI;
+    put clock into text;
+    forget (ds).
+
+put clock into text:
+    TEXT VAR clock text := clock length * "  ";
+    INT VAR i;
+    FOR i FROM 1 UPTO clock length REP
+         replace (clock text, i, clock data. clock field [i]);
+    PER.
+
+go to shard channel:
+    INT VAR retry;
+    FOR retry FROM 1 UPTO 20 REP
+        continue (32);
+        IF is error
+            THEN clear error;
+                 pause (30)
+        FI;
+    UNTIL channel = 32 PER.
+
+hw date:
+    date (day + "." + month + "." + year).
+
+day:    subtext (clock text, 7, 8).
+
+month:  subtext (clock text, 5, 6).
+
+year:   subtext (clock text, 1, 4).
+
+hw time:
+    time (hour + ":" + minute + ":" + second).
+
+hour:   subtext (clock text, 9, 10).
+
+minute: subtext (clock text, 11, 12).
+
+second: subtext (clock text, 13, 14).
+
+END PROC hw clock;
+
+END PACKET hw clock
+
+
+PACKET old shutup DEFINES old shutup,       (* Copyright (C) 1985       *)
+                          old save system:  (* Martin Schönbeck, Spenge *)
+                                            (* Stand: 06.11.85          *)
+PROC old shutup : shutup END PROC old shutup;
+
+PROC old save system : save system END PROC old save system;
+
+END PACKET old shutup;
+
+
+PACKET new shutup DEFINES shutup,
+                          shutup dialog,
+                          save system,
+                          generate shutup manager,
+                          generate shutup dialog manager:
+
+LET ack = 0;
+
+PROC shutup:
+ 
+    system down (PROC old shutup)
+
+END PROC shutup;
+
+PROC shutup (INT CONST new system):
+ 
+    IF new system <> 0
+         THEN prepare for new system
+    FI;
+    system down (PROC old shutup).
+
+prepare for new system:
+    activate (new system);
+    prepare for rebooting.
+
+prepare for rebooting:
+    INT VAR old channel := channel;
+    continue (32);
+    INT VAR dummy;
+    control (-5, 0, 0, dummy);
+    break (quiet);
+    continue (old channel).
+
+END PROC shutup;
+
+PROC save system:
+ 
+    IF yes ("Leere Floppy eingelegt")
+       THEN system down (PROC old save system)
+    FI
+
+END PROC save system;
+
+PROC system down (PROC operation):
+
+   BOOL VAR dialogue :: command dialogue;
+   command dialogue (FALSE);
+   operation;
+   command dialogue (dialogue);
+   IF command dialogue
+      THEN wait for configurator;
+           show date;
+   FI.
+
+show date:
+   page;
+   line (2); 
+   put ("      Heute ist der"); putline (date);
+   put ("      Es ist"); put (time of day); putline ("Uhr");
+   line (2).
+
+END PROC system down;
+
+DATASPACE VAR ds := nilspace;
+
+PROC wait for configurator:
+
+   INT VAR i, receipt;
+   FOR i FROM 1 UPTO 20 WHILE configurator exists REP
+      pause (30);
+      forget (ds);
+      ds := nilspace;
+      ping pong (configurator, ack, ds, receipt)
+   UNTIL receipt >= 0 PER.
+
+configurator exists:
+   disable stop;
+   TASK VAR configurator := task ("configurator");
+   clear error;
+   NOT is niltask (configurator).
+
+END PROC wait for configurator;
+
+PROC generate shutup manager:
+ 
+     generate shutup manager ("shutup", 0);
+
+END PROC generate shutup manager;
+
+PROC generate shutup manager (TEXT CONST name, INT CONST new system):
+ 
+     TASK VAR son;
+     shutup question := name;
+     new system for manager := new system;
+     begin (name, PROC shutup manager, son)
+
+END PROC generate shutup manager;
+
+INT VAR new system for manager;
+TEXT VAR shutup question;
+
+PROC shutup manager:
+
+     disable stop;
+     command dialogue (TRUE);
+     REP 
+        break;
+        line ;
+        IF yes (shutup question)
+            THEN clear error;
+                 shutup (new system for manager);
+                 pause (300);
+        FI;
+     PER
+
+END PROC shutup manager;
+
+PROC shutup dialog:
+   init;
+   show actual partition table (typnr);
+   REP
+      enter part number;
+      get cursor (cx, cy);
+      IF NOT escaped CAND yes (shutup question)
+         THEN message;
+              shutup (partition type);
+              LEAVE shutup dialog
+      FI;
+   PER.
+
+shutup question:
+   IF partition null
+      THEN "Shutup ausführen"
+      ELSE "Shutup nach Partition mit Typnummer " + text (typnr (partition)) + " ausführen"
+   FI.
+
+message:
+   cl eol (1, cy);
+   put line ("Bitte auf ENDE - Meldung warten !").
+
+partition type:
+   IF partition = 0
+      THEN 0
+      ELSE typnr (partition)
+   FI.
+
+init:
+   LET  startzeile menu  =  12, 
+        escape           = ""27"",
+        max partitions   =   4;
+
+   ROW max partitions INT VAR typnr;
+   INT VAR partition, cx, cy;
+   TEXT VAR retchar.
+
+partition null:
+   partition = 0 COR typnr (partition) = 0.
+
+enter part number :
+   cl eop (1, startzeile menu);
+   cursor (54, startzeile menu    ); put ("Abbruch mit <ESC>");
+   cursor (54, startzeile menu + 1); put ("Shutup ohne Wechsel mit <0>");
+   cursor ( 1, startzeile menu);
+   put ("Zu welcher Partition wollen Sie wechseln :");
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          partition := get choice (0, 4, retchar);
+          IF sure escaped THEN LEAVE shutup dialog FI;
+      UNTIL NOT escaped PER;
+      IF partition <> 0 CAND NOT partition exists
+         THEN fehler;
+              put ("Diese Partition gibt es nicht")
+      FI;
+   UNTIL partition = 0 OR partition exists PER;
+   cl eol (54, startzeile menu);
+   cl eol (54, startzeile menu + 1);
+   cl eop (1, cy + 2).
+
+partition exists:
+   typnr (partition) <> 0.
+
+escaped :
+   retchar = escape.
+
+sure escaped :
+   IF escaped THEN cl eop (1, 20); cursor (1, 22);
+                   IF yes ("Shutup-Dialog abbrechen") THEN TRUE
+                                                      ELSE cl eop (1, 20);
+                                                           FALSE
+                   FI
+              ELSE FALSE
+   FI.
+
+fehler :
+   cl eop (1, 20);
+   put (""7"" + inverse ("FEHLER :")); line (2).
+
+END PROC shutup dialog;
+
+PROC generate shutup dialog manager:
+     TASK VAR son;
+     begin ("shutup dialog", PROC shutup dialog manager, son)
+END PROC generate shutup dialog manager;
+
+PROC shutup dialog manager:
+     disable stop;
+     command dialogue (TRUE);
+     REP 
+        break; line;
+        clear error;
+        INT VAR sess := session;
+        shutup dialog;
+        IF sess <> session THEN pause (300) FI;
+     PER;
+END PROC shutup dialog manager;
+
+END PACKET new shutup
+
+
+PACKET config manager with time DEFINES configuration manager ,
+                                        configuration manager with time :
+                                      (* Copyright (C) 1985       *)
+INT VAR old session := 0;             (* Martin Schönbeck, Spenge *)
+                                      (* Stand: 06.11.85          *)
+PROC configuration manager: 
+ 
+   configurate;
+   break;
+   global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 
+                      configuration manager with time) 
+ 
+END PROC configuration manager; 
+ 
+PROC configuration manager with time (DATASPACE VAR ds, INT CONST order, 
+                                      phase, TASK CONST order task): 
+ 
+    IF old session <> session
+      THEN
+        disable stop;
+        set clock (hw clock); 
+        set clock (hw clock); (* twice, to avoid all paging delay *) 
+        IF is error THEN IF online THEN put error; clear error; pause (100)
+                                   ELSE clear error
+        FI FI;
+        old session := session;
+        set autonom;
+    FI; 
+    configuration manager (ds, order, phase, order task); 
+
+END PROC configuration manager with time; 
+
+END PACKET config manager with time;
+
diff --git a/system/at/1.8.7/src/AT install b/system/at/1.8.7/src/AT install
new file mode 100644
index 0000000..11f9b55
--- /dev/null
+++ b/system/at/1.8.7/src/AT install
@@ -0,0 +1,93 @@
+(*************************************************************************)
+(*** Insertiert alle notwendigen Pakete, damit ein AT-System generiert ***)
+(*** werden kann, das die Hardwareuhr lesen und Partitionen bedienen   ***)
+(*** kann. Startet den "AT Generator".                                 ***)
+(***                                                                   ***)
+(*** Autor : W. Sauerwein                             Stand : 15.07.86 ***)
+(*************************************************************************)
+
+erste bildschirmmeldung;
+IF ich bin single THEN putline ("Die AT-spezifische Software ist nur auf Multi-User-Systemen benutzbar !")
+                  ELSE hole dateien vom archiv;
+                       insertiere alle pakete;
+                       put line ("Running ""AT Generator""...");
+                       run ("AT Generator")
+FI;
+forget ("AT install", quiet).
+
+ich bin single : (pcb (9) AND 255) <= 1.
+
+insertiere alle pakete :
+   insert and say ("AT Utilities").
+
+erste bildschirmmeldung :
+   page;
+   put center (" Generator für AT-spezifische Software gestartet."); line;
+   put center ("--------------------------------------------------");
+   line (2).
+
+hole dateien vom archiv :
+   TEXT VAR datei;
+   datei := "AT Utilities";             hole wenn noetig;
+   datei := "AT Generator";             hole wenn noetig;
+   release (archive);
+   line.
+
+hole wenn noetig :
+   IF NOT exists (datei) THEN
+      put line ("Loading """ + datei + """...");
+      fetch (datei, archive)
+   FI.
+
+PROC insert and say (TEXT CONST datei) :
+
+   INT VAR cx, cy;
+   put line ("Inserting """ + datei + """...");
+   get cursor (cx, cy);
+   insert (datei);
+   cl eop (cx, cy); line;
+   forget (datei, quiet).
+
+END PROC insert and say;
+
+TEXT PROC inverse (TEXT CONST t):
+  ""15"" + t + " " + ""14""
+END PROC inverse;
+
+PROC put center (TEXT CONST t):
+   put center (t, 80)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t):
+   put center (zeile, t, 80)
+END PROC put center;
+
+PROC put center (TEXT CONST t, INT CONST gesamtbreite):
+   INT VAR cy;
+   get cursor (cy, cy);
+   put center (cy, t, gesamtbreite)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):
+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);
+   put (t).
+END PROC put center;
+
+PROC cl eol: 
+  out (""5"") 
+END PROC cl eol;
+
+PROC cl eop: 
+  out (""4"") 
+END PROC cl eop; 
+ 
+PROC cl eol (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eol 
+END PROC cl eol; 
+ 
+PROC cl eop (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eop 
+END PROC cl eop; 
+
diff --git a/system/at/unknown/src/AT Generator b/system/at/unknown/src/AT Generator
new file mode 100644
index 0000000..ef98535
--- /dev/null
+++ b/system/at/unknown/src/AT Generator
@@ -0,0 +1,134 @@
+(*************************************************************************)

+(*** Generiert Für IBM-AT einen neuen SYSUR-Zweig.                     ***)

+(*** Danach wird die eingebaute Hardwareuhr für die Systemzeit benutzt ***)

+(*** und andere Partitionen können mit neuem 'shutup' gebootet werden. ***)

+(***                                                                   ***)

+(*** Autor : W. Sauerwein                             Stand : 15.07.86 ***)

+(*************************************************************************)

+

+LET ack = 0,

+    nak = 1;

+ 

+cl eop (1, 4);

+erzeuge collector;

+erzeuge archive manager;

+erzeuge operator;

+erzeuge configurator;

+loesche collector;

+forget ("AT Generator", quiet);

+break.

+

+loesche collector :

+   end (/"colly");

+   put ("Collector gelöscht.");

+   line (2).

+

+erzeuge collector :

+   put line ("Generating 'Collector'...");

+   begin ("colly", PROC generate collector, t);

+   warte auf meldung;

+   IF answer = nak THEN end (/"colly");

+                        errorstop (meldung)

+   FI.

+   TASK VAR t.

+

+erzeuge archive manager :

+   put line ("Generating 'ARCHIVE'...");

+   end (/"ARCHIVE");

+   begin ("ARCHIVE", PROC archive manager, t).

+

+erzeuge operator :

+   put line ("Generating 'OPERATOR'...");

+   end (/"OPERATOR");

+   begin ("OPERATOR", PROC monitor, t).

+ 

+erzeuge configurator :

+   put line ("Generating 'configurator'...");

+   end (/"configurator");

+   begin ("configurator", PROC generate configurator, t); 

+   warte auf meldung;

+   IF answer = nak THEN errorstop (meldung) FI.

+ 

+warte auf meldung : 

+   DATASPACE VAR ds; INT VAR answer; 

+   wait (ds, answer, t);

+   BOUND TEXT VAR m := ds;

+   TEXT VAR meldung := m;

+   forget (ds).

+ 

+PROC generate collector :

+

+   disable stop;

+   fetch all (/"configurator");

+   DATASPACE VAR ds := nilspace;

+   BOUND TEXT VAR m := ds; m := "";

+   send (father, mess, ds);

+   forget (ds);

+   free global manager.

+ 

+mess : IF is error THEN m := error message;

+                        nak

+                   ELSE ack FI.

+

+END PROC generate collector;

+

+PROC generate configurator :

+

+   disable stop;

+   fetch all (/"colly");

+   DATASPACE VAR ds := nilspace; 

+   BOUND TEXT VAR m := ds; m := "";

+   send (father, mess, ds);

+   forget (ds);

+   enable stop;

+   new configuration;

+   setup;

+   global manager (PROC ( DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 

+                   configuration manager with time).

+

+mess : IF is error THEN m := error message;

+                        nak

+                   ELSE ack FI.

+

+END PROC generate configurator;

+

+TEXT PROC inverse (TEXT CONST t):

+  ""15"" + t + " " + ""14""

+END PROC inverse;

+

+PROC put center (TEXT CONST t):

+   put center (t, 80)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t):

+   put center (zeile, t, 80)

+END PROC put center;

+

+PROC put center (TEXT CONST t, INT CONST gesamtbreite):

+   INT VAR cy;

+   get cursor (cy, cy);

+   put center (cy, t, gesamtbreite)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):

+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);

+   put (t).

+END PROC put center;

+

+PROC cl eol: 

+  out (""5"") 

+END PROC cl eol;

+

+PROC cl eop: 

+  out (""4"") 

+END PROC cl eop; 

+ 

+PROC cl eol (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eol 

+END PROC cl eol; 

+ 

+PROC cl eop (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eop 

+END PROC cl eop; 

diff --git a/system/at/unknown/src/AT Utilities b/system/at/unknown/src/AT Utilities
new file mode 100644
index 0000000..bfdee15
--- /dev/null
+++ b/system/at/unknown/src/AT Utilities
@@ -0,0 +1,601 @@
+(*************************************************************************)

+(*** AT-spezifische Software, die zum Lesen der Hardwareuhr und        ***)

+(*** Booten in anderen Partitionen benötigt wird.                      ***)

+(***                                                                   ***)

+(*** Zusammengestellt und geändert : Werner Sauerwein, GMD             ***)

+(***                         Stand : 17.07.86                          ***)

+(*************************************************************************)

+

+PACKET splitting DEFINES  low byte,     (* Copyright (C) 1985       *)

+                          high byte,    (* Martin Schönbeck, Spenge *)

+                          low word,     (* Stand: 13.09.85          *)

+                          high word: 

+ 

+INT PROC high byte (INT CONST value):

+ 

+    TEXT VAR x := "  ";

+    replace (x, 1, value);

+    code (x SUB 2)

+

+END PROC high byte;

+

+INT PROC low byte (INT CONST value):

+ 

+    TEXT VAR x := "  ";

+    replace (x, 1, value);

+    code (x SUB 1)

+

+END PROC low byte; 

+ 

+INT PROC high word (REAL CONST double precission int):

+

+    int (double precission int / 65536.0)

+

+END PROC high word;

+

+INT PROC low word (REAL CONST double precission int): 

+ 

+    string of low bytes ISUB 1.

+

+string of low bytes:

+    code (int (double precission int MOD 256.0)) +

+    code (int ((double precission int MOD 65536.0) / 256.0)). 

+ 

+END PROC low word; 

+END PACKET splitting;

+

+PACKET basic block io DEFINES

+ 

+  read block,

+  write block:

+

+PROC read block (DATASPACE VAR ds,

+                 INT CONST ds page no, 

+                 INT CONST block no,

+                 INT VAR return code):

+  read block; 

+  retry if read error.

+ 

+read block: 

+  block in (ds, ds page no, 0, block no, return code).

+ 

+retry if read error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    read block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN block in (ds, ds page no, 0, 0, return code) 

+  FI. 

+ 

+END PROC read block;

+ 

+PROC write block (DATASPACE CONST ds,

+                 INT CONST ds page no, 

+                 INT CONST block no,

+                 INT VAR return code):

+  write block; 

+  retry if write error. 

+ 

+write block: 

+  block out (ds, ds page no, 0, block no, return code).

+ 

+retry if write error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    write block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN disable stop;

+         DATASPACE VAR dummy ds := nilspace;

+         block in (dummy ds, 2, 0, 0, return code);

+         forget (dummy ds);

+         enable stop

+  FI. 

+ 

+END PROC write block; 

+

+PROC read block (DATASPACE VAR ds, INT CONST ds page,

+                 REAL CONST archive block):

+

+   enable stop;

+   read block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht gelesen werden");

+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+

+END PROC read block;

+

+PROC write block (DATASPACE CONST ds, INT CONST ds page,

+                  REAL CONST archive block):

+

+   enable stop;

+   write block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht geschrieben werden");

+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+

+END PROC write block;

+

+PROC read block (DATASPACE VAR ds,

+                 INT CONST ds page no, 

+                 REAL CONST block no,

+                 INT VAR return code):

+  read block; 

+  retry if read error.

+ 

+read block: 

+  block in (ds, ds page no, high word (block no),

+                             low word (block no), return code).

+ 

+retry if read error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    read block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN block in (ds, ds page no, 0, 0, return code) 

+  FI. 

+ 

+END PROC read block;

+ 

+PROC write block (DATASPACE CONST ds,

+                 INT CONST ds page no, 

+                 REAL CONST block no,

+                 INT VAR return code):

+  write block; 

+  retry if write error. 

+ 

+write block: 

+  block out (ds, ds page no, high word (block no),

+                              low word (block no), return code).

+ 

+retry if write error: 

+  INT VAR retry;

+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 

+    reset to block 0 if fifth try; 

+    write block 

+  PER. 

+ 

+reset to block 0 if fifth try: 

+  IF retry = 5 

+    THEN disable stop;

+         DATASPACE VAR dummy ds := nilspace;

+         block in (dummy ds, 2, 0, 0, return code);

+         forget (dummy ds);

+         enable stop

+  FI. 

+ 

+END PROC write block; 

+END PACKET basic block io;

+

+(**************************************************************************)

+

+PACKET part DEFINES activate :             (* Copyright (C) 1985       *)

+                                           (* Martin Schönbeck, Spenge *)

+                                           (* Stand      : 02.02.86    *)

+                                           (* Changed by : W.Sauerwein *)

+                                           (* Stand      : 04.07.86    *)

+    LET fd channel           = 28;

+

+ROW 256 INT VAR boot block;

+INT VAR boot block session := session - 1;

+

+PROC get boot block:

+ 

+    IF boot block session <> session

+       THEN hole aktuellen boot block

+    FI.

+

+hole aktuellen boot block:

+    disable stop;

+    DATASPACE VAR dummy ds := nilspace;

+    BOUND STRUCT (ALIGN dummy, 

+                  ROW 256 INT block) VAR partition table := dummy ds; 

+    get external block (dummy ds, 2, 0, fd channel); 

+    IF NOT is error

+        THEN transfer data to boot block

+    FI; 

+    forget (dummy ds). 

+ 

+transfer data to boot block:

+    IF not valid boot block

+        THEN try to get valid boot block from file

+    FI;

+    boot block := partition table. block;

+    boot block session := session.

+

+not valid boot block:

+    partition table. block [256] <> boot indicator OR

+    it is an old boot block of eumel.

+

+boot indicator: -21931.

+

+it is an old boot block of eumel:

+    partition table. block [1] = 1514.

+

+try to get valid boot block from file:

+    forget (dummy ds);

+    partition table := old ("bootblock");

+    IF is error THEN LEAVE transfer data to boot block FI.

+ 

+END PROC get boot block;

+

+PROC put boot block:

+ 

+    IF boot block ist uptodate

+        THEN schreibe block auf platte

+        ELSE errorstop ("boot block nicht uptodate")

+    FI.

+

+boot block ist uptodate:

+    boot block session = session.

+

+schreibe block auf platte:

+    disable stop;

+    DATASPACE VAR dummy ds := nilspace;

+    BOUND STRUCT (ALIGN dummy, 

+                  ROW 256 INT block) VAR partition table := dummy ds; 

+    transfer data to dataspace;

+    put external block (dummy ds, 2, 0, fd channel); 

+    forget (dummy ds). 

+ 

+transfer data to dataspace:

+    partition table. block := boot block.

+

+END PROC put boot block;

+

+INT PROC partition type (INT CONST partition):

+

+    low byte (boot block [entry (partition) + 2])

+

+END PROC partition type;

+

+PROC activate (INT CONST part type):

+

+    IF partition type exists AND is possible type

+         THEN deactivate all partitions and

+              activate desired partition

+         ELSE errorstop ("Gewünschte Partitionart gibt es nicht")

+    FI.

+

+is possible type:

+   part type > 0 AND

+   part type < 256.

+

+partition type exists:

+    INT VAR partition;

+    FOR partition FROM 1 UPTO 4 REP

+         IF partition type (partition) = part type 

+             THEN LEAVE partition type exists WITH TRUE

+         FI;

+    PER;

+    FALSE.

+

+deactivate all partitions and activate desired partition:

+    FOR partition FROM 1 UPTO 4 REP

+         deactivate this partition;

+         IF partition type (partition) = part type

+              THEN activate partition

+         FI

+    PER;

+    put boot block.

+

+deactivate this partition:

+    set bit (boot block [entry (partition)], 7);

+    (* first setting needed, because reset bit does xor *)

+    reset bit (boot block [entry (partition)], 7).

+

+activate partition:

+    set bit (boot block [entry (partition)], 7)

+

+END PROC activate;

+

+INT PROC entry (INT CONST partition):

+

+    get boot block;

+    256 - 5 * 8 + (partition * 8)

+

+END PROC entry;

+

+PROC get external block (DATASPACE VAR ds, INT CONST ds page,

+                                             archive block, get channel):

+

+   INT VAR old channel := channel; 

+   continue (get channel);

+   disable stop;

+   read block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht gelesen werden");

+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+   continue (old channel).

+

+END PROC get external block;

+

+PROC put external block (DATASPACE CONST ds, INT CONST ds page,

+                                             archive block, get channel):

+

+   INT VAR old channel := channel; 

+   continue (get channel);

+   disable stop;

+   write block (ds, ds page, archive block, error);

+   INT VAR error;

+   SELECT error OF

+      CASE 0:

+      CASE 1: error stop ("Platte kann nicht geschrieben werden");

+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));

+      CASE 3: error stop ("Versorgungsfehler Archiv");

+      OTHERWISE error stop ("unbekannter Fehler auf Platte");

+   END SELECT;

+   continue (old channel).

+

+END PROC put external block;

+END PACKET part;

+ 

+(**************************************************************************)

+

+PACKET hw clock DEFINES hw clock:        (* Copyright (C) 1985       *)

+                                         (* Martin Schönbeck, Spenge *)

+LET clock length  = 7,                   (* Stand: 06.11.85          *)

+    clock command = 4;

+

+BOUND STRUCT (ALIGN dummy,

+              ROW clock length INT clock field) VAR clock data;

+

+REAL PROC hw clock:

+ 

+    disable stop;

+    get clock;

+    hw date + hw time.

+

+get clock:

+    DATASPACE VAR ds := nilspace;

+    clock data := ds;

+    INT VAR return code, actual channel := channel;

+    go to shard channel;

+    blockin (ds, 2, -clock command, 0, return code);

+    IF actual channel = 0 THEN break (quiet)

+                          ELSE continue (actual channel)

+    FI;

+    IF return code <> 0 

+        THEN errorstop ("Keine Hardware Uhr vorhanden");

+    FI;

+    put clock into text;

+    forget (ds).

+

+put clock into text:

+    TEXT VAR clock text := clock length * "  ";

+    INT VAR i;

+    FOR i FROM 1 UPTO clock length REP

+         replace (clock text, i, clock data. clock field [i]);

+    PER.

+

+go to shard channel:

+    INT VAR retry;

+    FOR retry FROM 1 UPTO 20 REP

+        continue (32);

+        IF is error

+            THEN clear error;

+                 pause (30)

+        FI;

+    UNTIL channel = 32 PER.

+

+hw date:

+    date (day + "." + month + "." + year).

+

+day:    subtext (clock text, 7, 8).

+

+month:  subtext (clock text, 5, 6).

+

+year:   subtext (clock text, 1, 4).

+

+hw time:

+    time (hour + ":" + minute + ":" + second).

+

+hour:   subtext (clock text, 9, 10).

+

+minute: subtext (clock text, 11, 12).

+

+second: subtext (clock text, 13, 14).

+

+END PROC hw clock;

+END PACKET hw clock

+

+(**************************************************************************)

+

+PACKET old shutup DEFINES old shutup,       (* Copyright (C) 1985       *)

+                          old save system:  (* Martin Schönbeck, Spenge *)

+                                            (* Stand: 06.11.85          *)

+PROC old shutup : shutup END PROC old shutup;

+

+PROC old save system : save system END PROC old save system;

+END PACKET old shutup;

+

+PACKET new shutup DEFINES shutup,

+                          ms dos,

+                          save system,

+                          generate ms dos manager,

+                          generate shutup manager:

+

+LET ack = 0;

+

+PROC shutup:

+ 

+    system down (PROC old shutup)

+

+END PROC shutup;

+

+PROC shutup (INT CONST new system):

+ 

+    IF new system <> 0

+         THEN prepare for new system

+    FI;

+    system down (PROC old shutup).

+

+prepare for new system:

+    activate (new system);

+    prepare for rebooting.

+

+prepare for rebooting:

+    INT VAR old channel := channel;

+    continue (32);

+    INT VAR dummy;

+    control (-5, 0, 0, dummy);

+    break (quiet);

+    continue (old channel).

+

+END PROC shutup;

+

+PROC ms dos:

+

+    shutup (1)

+

+END PROC ms dos;

+

+PROC save system:

+ 

+    IF yes ("Leere Floppy eingelegt")

+       THEN system down (PROC old save system)

+    FI

+

+END PROC save system;

+

+PROC system down (PROC operation):

+

+   BOOL VAR dialogue :: command dialogue;

+   command dialogue (FALSE);

+   operation;

+   command dialogue (dialogue);

+   IF command dialogue

+      THEN wait for configurator;

+           show date;

+   FI.

+

+show date:

+   page;

+   line (2); 

+   put ("      Heute ist der"); putline (date);

+   put ("      Es ist"); put (time of day); putline ("Uhr");

+   line (2).

+

+END PROC system down;

+

+DATASPACE VAR ds := nilspace;

+

+PROC wait for configurator:

+

+   INT VAR i, receipt;

+   FOR i FROM 1 UPTO 20 WHILE configurator exists REP

+      pause (30);

+      forget (ds);

+      ds := nilspace;

+      ping pong (configurator, ack, ds, receipt)

+   UNTIL receipt >= 0 PER.

+

+configurator exists:

+   disable stop;

+   TASK VAR configurator := task ("configurator");

+   clear error;

+   NOT is niltask (configurator).

+

+END PROC wait for configurator;

+

+PROC generate shutup manager:

+ 

+     generate shutup manager ("shutup", 0);

+

+END PROC generate shutup manager;

+

+PROC generate ms dos manager:

+ 

+     generate shutup manager ("ms dos", 1);

+

+END PROC generate ms dos manager;

+

+PROC generate shutup manager (TEXT CONST name, INT CONST new system):

+ 

+     TASK VAR son;

+     shutup question := name;

+     new system for manager := new system;

+     begin (name, PROC shutup manager, son)

+

+END PROC generate shutup manager;

+

+INT VAR new system for manager;

+TEXT VAR shutup question;

+

+PROC shutup manager:

+

+     disable stop;

+     command dialogue (TRUE);

+     REP 

+        break;

+        line ;

+        IF yes (shutup question)

+            THEN clear error;

+                 shutup (new system for manager);

+                 pause (300);

+        FI;

+     PER

+

+END PROC shutup manager;

+END PACKET new shutup

+

+(**************************************************************************)

+

+PACKET config manager with time DEFINES configuration manager ,

+                                        configuration manager with time :

+                                      (* Copyright (C) 1985       *)

+INT VAR old session := 0;             (* Martin Schönbeck, Spenge *)

+                                      (* Stand: 06.11.85          *)

+PROC configuration manager: 

+ 

+   configurate;

+   break;

+   global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 

+                      configuration manager with time) 

+ 

+END PROC configuration manager; 

+ 

+PROC configuration manager with time (DATASPACE VAR ds, INT CONST order, 

+                                      phase, TASK CONST order task): 

+ 

+    IF old session <> session

+      THEN

+        disable stop;

+        set clock (hw clock); 

+        set clock (hw clock); (* twice, to avoid all paging delay *) 

+        IF is error THEN IF online THEN put error; clear error; pause (100)

+                                   ELSE errorstop (error message)

+        FI FI;

+        old session := session;

+        set autonom;

+    FI; 

+    configuration manager (ds, order, phase, order task); 

+

+END PROC configuration manager with time; 

+END PACKET config manager with time;

diff --git a/system/at/unknown/src/AT install b/system/at/unknown/src/AT install
new file mode 100644
index 0000000..c02b514
--- /dev/null
+++ b/system/at/unknown/src/AT install
@@ -0,0 +1,92 @@
+(*************************************************************************)

+(*** Insertiert alle notwendigen Pakete, damit ein AT-System generiert ***)

+(*** werden kann, das die Hardwareuhr lesen und Partitionen bedienen   ***)

+(*** kann. Startet den "AT Generator".                                 ***)

+(***                                                                   ***)

+(*** Autor : W. Sauerwein                             Stand : 15.07.86 ***)

+(*************************************************************************)

+

+erste bildschirmmeldung;

+IF ich bin single THEN putline ("Die AT-spezifische Software ist nur auf Multi-User-Systemen benutzbar !")

+                  ELSE hole dateien vom archiv;

+                       insertiere alle pakete;

+                       put line ("Running ""AT Generator""...");

+                       run ("AT Generator")

+FI;

+forget ("AT install", quiet).

+

+ich bin single : (pcb (9) AND 255) <= 1.

+

+insertiere alle pakete :

+   insert and say ("AT Utilities").

+

+erste bildschirmmeldung :

+   page;

+   put center (" Generator für AT-spezifische Software gestartet."); line;

+   put center ("--------------------------------------------------");

+   line (2).

+

+hole dateien vom archiv :

+   TEXT VAR datei;

+   datei := "AT Utilities";             hole wenn noetig;

+   datei := "AT Generator";             hole wenn noetig;

+   release (archive);

+   line.

+

+hole wenn noetig :

+   IF NOT exists (datei) THEN

+      put line ("Loading """ + datei + """...");

+      fetch (datei, archive)

+   FI.

+

+PROC insert and say (TEXT CONST datei) :

+

+   INT VAR cx, cy;

+   put line ("Inserting """ + datei + """...");

+   get cursor (cx, cy);

+   insert (datei);

+   cl eop (cx, cy); line;

+   forget (datei, quiet).

+

+END PROC insert and say;

+

+TEXT PROC inverse (TEXT CONST t):

+  ""15"" + t + " " + ""14""

+END PROC inverse;

+

+PROC put center (TEXT CONST t):

+   put center (t, 80)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t):

+   put center (zeile, t, 80)

+END PROC put center;

+

+PROC put center (TEXT CONST t, INT CONST gesamtbreite):

+   INT VAR cy;

+   get cursor (cy, cy);

+   put center (cy, t, gesamtbreite)

+END PROC put center;

+

+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):

+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);

+   put (t).

+END PROC put center;

+

+PROC cl eol: 

+  out (""5"") 

+END PROC cl eol;

+

+PROC cl eop: 

+  out (""4"") 

+END PROC cl eop; 

+ 

+PROC cl eol (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eol 

+END PROC cl eol; 

+ 

+PROC cl eop (INT CONST cx, cy): 

+   cursor (cx, cy); 

+   cl eop 

+END PROC cl eop; 

diff --git a/system/base/1.7.5/source-disk b/system/base/1.7.5/source-disk
new file mode 100644
index 0000000..5708023
--- /dev/null
+++ b/system/base/1.7.5/source-disk
@@ -0,0 +1 @@
+175_src/source-code-1.7.5.img
diff --git a/system/base/1.7.5/src/advertising b/system/base/1.7.5/src/advertising
new file mode 100644
index 0000000..45f73ef
--- /dev/null
+++ b/system/base/1.7.5/src/advertising
@@ -0,0 +1,35 @@
+(* ------------------- VERSION 1     06.03.86 ------------------- *)
+PACKET advertising DEFINES                    (* Autor: J.Liedtke *)
+ 
+  eumel must advertise :
+
+
+LET myself id field = 9 ;
+
+
+PROC eumel must advertise :
+
+  IF online AND channel <= 15
+    THEN out (""1""4"") ;
+         IF station is not zero
+           THEN out (""15"Station: ") ;
+                out (text (station number)) ;
+                out (" "14"")
+         FI ;
+         cursor (60,1) ;
+         out (""15"Terminal: ") ;
+         out (text (channel)) ;
+         out (" "14"") ;
+         cursor (22,5) ;
+   (*    out ("E U M E L    Pilot-Version /M"13""10""10""10"")   *)
+         out ("E U M E L    Version 1.7.5.10 /M+ "13""10""10""10"")
+  FI .
+
+station is not zero :  pcb (myself id field) >= 256 .
+
+station number      :  pcb (myself id field) DIV 256 .
+
+ENDPROC eumel must advertise ;
+ 
+ENDPACKET advertising ;
+
diff --git a/system/base/1.7.5/src/basic transput b/system/base/1.7.5/src/basic transput
new file mode 100644
index 0000000..5608bb1
--- /dev/null
+++ b/system/base/1.7.5/src/basic transput
@@ -0,0 +1,177 @@
+
+PACKET basic transput DEFINES
+                      out ,
+                      outsubtext ,
+                      outtext ,
+                      TIMESOUT ,
+                      cout ,
+                      display ,
+                      inchar ,
+                      incharety ,
+                      cat input ,
+                      pause ,
+                      cursor ,
+                      get cursor ,
+                      channel ,
+                      online ,
+                      control ,
+                      blockout ,
+                      blockin :
+ 
+ 
+
+LET channel field  = 4 ,
+    blank times 64 =
+    "                                                                " ;
+
+LET BLOCKIO = STRUCT (ALIGN page align, ROW 256 INT buffer) ,
+              buffer page = 2 ;
+
+BOUND BLOCKIO VAR block io ;
+DATASPACE VAR block io ds ;
+INITFLAG VAR this packet := FALSE ;
+
+
+PROC out (TEXT CONST text ) : 
+ EXTERNAL 60 
+ENDPROC out ; 
+ 
+PROC outsubtext ( TEXT CONST source, INT CONST from ) : 
+ EXTERNAL 62 
+END PROC outsubtext; 
+ 
+PROC outsubtext (TEXT CONST source, INT CONST from, to) : 
+ EXTERNAL 63 
+END PROC outsubtext;
+
+PROC outtext ( TEXT CONST source, INT CONST from, to ) : 
+  out subtext (source, from, to) ; 
+  INT VAR trailing ;
+  IF from <= LENGTH source 
+    THEN trailing := to - LENGTH source 
+    ELSE trailing := to + 1 - from 
+  FI ;
+  IF trailing > 0 
+    THEN trailing TIMESOUT " " 
+  FI 
+ENDPROC outtext ;
+
+OP TIMESOUT (INT CONST times, TEXT CONST text) : 
+
+  IF text = " "
+    THEN fast timesout blank
+    ELSE timesout
+  FI .
+
+fast timesout blank :
+  INT VAR i := 0 ;
+  WHILE i + 64 < times REP
+    out (blank times 64) ;
+    i INCR 64
+  PER ;
+  outsubtext (blank times 64, 1, times - i) .
+
+timesout :
+  FOR i FROM 1 UPTO times REP 
+    out(text) 
+  ENDREP .
+
+ENDOP TIMESOUT ;
+ 
+PROC display (TEXT CONST text) :
+  IF online
+    THEN out (text)
+  FI
+ENDPROC display ;
+
+PROC inchar (TEXT VAR character ) :
+ EXTERNAL 64
+ENDPROC inchar ;
+ 
+TEXT PROC incharety :
+ EXTERNAL 65
+END PROC incharety ;
+ 
+TEXT PROC incharety (INT CONST time limit) :
+ internal pause (time limit) ;
+ incharety
+ENDPROC incharety ;
+ 
+PROC pause (INT CONST time limit) :
+ internal pause (time limit) ;
+ TEXT CONST dummy := incharety
+ENDPROC pause ;
+ 
+PROC pause :
+ TEXT VAR dummy; inchar (dummy)
+ENDPROC pause ;
+
+PROC internal pause (INT CONST time limit) :
+ EXTERNAL 66
+ENDPROC internal pause ;
+
+PROC cat input (TEXT VAR t, esc char) :
+ EXTERNAL 68
+ENDPROC cat input ;
+
+ 
+PROC cursor (INT CONST x, y) :
+ out (""6"") ;
+ out (code(y-1)) ;
+ out (code(x-1)) ;
+ENDPROC cursor ;
+ 
+PROC get cursor (INT VAR x, y) :
+  EXTERNAL 67
+ENDPROC get cursor ;
+ 
+PROC cout (INT CONST number) :
+  EXTERNAL 61
+ENDPROC cout ;
+
+
+INT PROC channel :
+  pcb (channel field)
+ENDPROC channel ;
+
+BOOL PROC online :
+  pcb (channel field) <> 0
+ENDPROC online ;
+ 
+
+PROC control (INT CONST code1, code2, code3, INT VAR return code) :
+  EXTERNAL 84
+ENDPROC control ;
+
+PROC blockout (ROW 256 INT CONST block, INT CONST code1, code2,
+               INT VAR return code) :
+
+  access block io ds ;
+  block io.buffer := block ;
+  blockout (block io ds, buffer page, code1, code2, return code) .
+
+access block io ds :
+  IF NOT initialized (this packet)
+    THEN block io ds := nilspace
+  FI ;
+  block io := block io ds .
+
+ENDPROC blockout ;
+
+PROC blockin (ROW 256 INT VAR block, INT CONST code1, code2,
+              INT VAR return code) :
+
+  access block io ds ;
+  blockin (block io ds, buffer page, code1, code2, return code) ;
+  block := block io.buffer .
+
+access block io ds :
+  IF NOT initialized (this packet)
+    THEN block io ds := nilspace
+  FI ;
+  block io := block io ds .
+
+ENDPROC blockin ;
+
+ENDPACKET basic transput ;
+
diff --git a/system/base/1.7.5/src/bits b/system/base/1.7.5/src/bits
new file mode 100644
index 0000000..e9e84e7
--- /dev/null
+++ b/system/base/1.7.5/src/bits
@@ -0,0 +1,78 @@
+
+PACKET bits DEFINES
+
+    AND ,
+    OR ,
+    XOR ,
+    bit ,
+    lowest reset ,
+    lowest set ,
+    reset bit ,
+    rotate ,
+    set bit :
+
+LET bits per int = 16 ;
+
+ROW bits per int INT VAR bit mask := ROW bits per int INT:
+    (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1) ;
+
+PROC rotate (INT VAR bits, INT CONST number of bits) :
+  EXTERNAL 83
+ENDPROC rotate ;
+
+INT OP AND (INT CONST left, right) :
+  EXTERNAL 124
+ENDOP AND ;
+
+INT OP OR (INT CONST left, right) :
+  EXTERNAL 125
+ENDOP OR ;
+
+INT OP XOR (INT CONST left, right) :
+  EXTERNAL 121
+ENDOP XOR ;
+
+BOOL PROC bit (INT CONST bits, bit no) :
+
+  (bits AND bit mask (bit no+1)) <> 0
+
+ENDPROC bit ;
+
+PROC set bit (INT VAR bits, INT CONST bit no) :
+
+  bits := bits OR bit mask (bit no+1)
+
+ENDPROC set bit ;
+
+PROC reset bit (INT VAR bits,INT CONST bit no) :
+
+  bits := bits XOR (bits AND bit mask (bit no+1))
+
+ENDPROC reset bit ;
+
+INT PROC lowest set (INT CONST bits) :
+
+  INT VAR mask index ;
+  FOR mask index FROM 1 UPTO 16 REP
+    IF (bits AND bit mask (mask index)) <> 0
+      THEN LEAVE lowest set WITH mask index - 1
+    FI
+  PER ;
+  -1
+
+ENDPROC lowest set ;
+
+INT PROC lowest reset (INT CONST bits) :
+
+  INT VAR mask index ;
+  FOR mask index FROM 1 UPTO bits per int REP
+    IF (bits AND bit mask (mask index)) = 0
+      THEN LEAVE lowest reset WITH mask index - 1
+    FI
+  PER ;
+  -1
+
+ENDPROC lowest reset ;
+
+ENDPACKET bits ;
+
diff --git a/system/base/1.7.5/src/bool b/system/base/1.7.5/src/bool
new file mode 100644
index 0000000..5bf1e65
--- /dev/null
+++ b/system/base/1.7.5/src/bool
@@ -0,0 +1,16 @@
+ 
+PACKET bool DEFINES  XOR, true, false :
+ 
+BOOL CONST true := TRUE ,
+           false:= FALSE ;
+
+BOOL OP XOR (BOOL CONST left, right) :
+ 
+  IF left THEN NOT right
+          ELSE right
+  FI
+ 
+ENDOP XOR ;
+ 
+ENDPACKET bool ;
+
diff --git a/system/base/1.7.5/src/command dialogue b/system/base/1.7.5/src/command dialogue
new file mode 100644
index 0000000..3011187
--- /dev/null
+++ b/system/base/1.7.5/src/command dialogue
@@ -0,0 +1,123 @@
+
+PACKET command dialogue DEFINES                (* Autor: J.Liedtke *)
+                                               (* Stand:  25.11.83 *)
+       command dialogue ,
+       say ,
+       yes ,
+       no ,
+       param position ,
+       last param ,
+       std ,
+       QUIET ,
+       quiet :
+ 
+
+LET up      = ""3"" ,
+    right   = ""2"" ,
+    cr lf   = ""13""10"" ,
+    param pre  = " (""" ,
+    param post = """)"13""10"" ;
+ 
+
+TEXT VAR std param := "" ;
+ 
+BOOL VAR dialogue flag := TRUE ;
+
+INT VAR param x := 0 ;
+
+
+TYPE QUIET = INT ;
+
+QUIET PROC quiet :
+  QUIET:(0)
+ENDPROC quiet ;
+
+ 
+BOOL PROC command dialogue :
+  dialogue flag
+ENDPROC command dialogue ;
+ 
+PROC command dialogue (BOOL CONST status) :
+  dialogue flag := status
+ENDPROC command dialogue ;
+ 
+ 
+BOOL PROC yes (TEXT CONST question) :
+ 
+  IF dialogue flag
+    THEN ask question
+    ELSE TRUE
+  FI .
+ 
+ask question :
+  out (question) ;
+  skip previous input chars ;
+  out (" (j/n) ? ") ;
+  get answer ;
+  IF correct answer
+    THEN out (answer) ;
+         out (cr lf) ;
+         positive answer
+    ELSE out (""7"") ;
+         LENGTH question + 9 TIMESOUT ""8"" ;
+         yes (question)
+  FI .
+ 
+get answer :
+  TEXT VAR answer ;
+  inchar (answer) .
+ 
+correct answer :
+  pos ("jnyJNY", answer) > 0 .
+ 
+positive answer :
+  pos ("jyJY", answer) > 0 .
+
+skip previous input chars :
+  REP UNTIL incharety = "" PER .
+ 
+ENDPROC yes ;
+ 
+BOOL PROC no (TEXT CONST question) :
+ 
+  NOT yes (question)
+ 
+ENDPROC no ;
+ 
+PROC say (TEXT CONST message) :
+ 
+  IF dialogue flag
+    THEN out (message)
+  FI
+ 
+ENDPROC say ;
+ 
+PROC param position (INT CONST x) :
+ 
+  param x := x
+
+ENDPROC param position ;
+
+TEXT PROC last param :
+ 
+  IF param x > 0 AND online
+    THEN out (up) ;
+         param x TIMESOUT right ;
+         out (param pre) ;
+         out (std param) ;
+         out (param post)
+  FI ;
+  std param .
+ 
+ENDPROC last param ;
+ 
+PROC last param (TEXT CONST new) :
+  std param := new
+ENDPROC last param ;
+
+TEXT PROC std :
+  std param
+ENDPROC std ;
+
+ENDPACKET command dialogue ;
+
diff --git a/system/base/1.7.5/src/command handler b/system/base/1.7.5/src/command handler
new file mode 100644
index 0000000..756382b
--- /dev/null
+++ b/system/base/1.7.5/src/command handler
@@ -0,0 +1,290 @@
+(* ------------------- VERSION 2     05.05.86 ------------------- *)
+PACKET command handler DEFINES                (* Autor: J.Liedtke *)
+
+       get command , 
+       analyze command , 
+       do command , 
+       command error ,
+       cover tracks :
+ 
+ 
+LET cr lf        = ""4""13""10"" ,
+    esc k        = ""27"k" ,
+    command pre  = ""4""13"      " ,
+    command post = ""13""10"      " ,
+ 
+    max command length = 2010 ,
+
+    tag type = 1 ,
+    texttype = 4 ,
+    eof type = 7 ;
+ 
+ 
+TEXT VAR command handlers own command line := "" ,
+         previous command line := "" ,
+         symbol ,
+         procedure ,
+         pattern ,
+         error note := "" ;
+ 
+INT VAR  symbol type ;
+
+ 
+PROC get command (TEXT CONST command text) :
+
+  get command (command text, command handlers own command line)
+
+ENDPROC get command ;
+
+PROC get command (TEXT CONST command text, TEXT VAR command line) :
+
+  set line nr (0) ;
+  error protocoll ;
+  get command from console .
+ 
+error protocoll :
+  IF is error
+    THEN put error ;
+         clear error
+    ELSE command line := "" ;
+  FI .
+ 
+get command from console :
+  normalize cursor ;
+  REP
+    out (command pre) ;
+    out (command text) ;
+    out (command post) ;
+    editget command
+  UNTIL command line <> "" PER ;
+  param position (LENGTH command line) ;
+  out (command post) .
+ 
+editget command :
+  TEXT VAR exit char ;
+  REP
+    get cursor (x, y) ;
+    editget (command line, max command length, x size - x,
+             "", "k", exit char) ;
+    ignore halt errors during editget ;
+    break quiet if command line is too long ;
+    IF exit char = esc k
+      THEN cursor to begin of command input ;
+           command line := previous command line
+    ELIF LENGTH command line > 1
+      THEN previous command line := command line ;
+           LEAVE editget command
+    ELSE   LEAVE editget command
+    FI
+  PER .
+
+normalize cursor :
+  INT VAR x, y;
+  out (crlf) ;
+  get cursor (x, y) ;
+  cursor (x, y) .
+ 
+ignore halt errors during editget :
+  IF is error
+    THEN clear error
+  FI .
+
+break quiet if command line is too long :
+  IF command line is too long
+    THEN command line := "break (quiet)"
+  FI .
+
+command line is too long :
+  LENGTH command line = max command length .
+
+cursor to begin of command input :
+  out (command pre) .
+
+ENDPROC get command ;
+ 
+
+PROC analyze command ( TEXT CONST command list,
+                       INT CONST permitted type, 
+                       INT VAR command index, number of params, 
+                       TEXT VAR param 1, param 2) :
+
+  analyze command (command list, command handlers own command line,
+                   permitted type, command index,
+                   number of params, param 1, param 2)
+
+ENDPROC analyze command ;
+
+PROC analyze command ( TEXT CONST command list, command line,
+                       INT CONST permitted type, 
+                       INT VAR command index, number of params, 
+                       TEXT VAR param 1, param 2) :
+
+  error note := "" ;
+  scan (command line) ;
+  next symbol ;
+  IF symbol type <> tag type AND symbol <> "?"
+    THEN error ("Name ungueltig") ;
+         impossible command
+  ELIF pos (command list, symbol) > 0
+    THEN procedure name ;
+         parameter list pack option ;
+         nothing else in command line ;
+         decode command
+    ELSE impossible command
+  FI .
+ 
+procedure name :
+  procedure := symbol ;
+  next symbol .
+ 
+parameter list pack option :
+  number of params := 0 ;
+  param 1 := "" ;
+  param 2 := "" ;
+  IF symbol = "("
+    THEN next symbol ;
+         parameter list ;
+         IF symbol <> ")" AND error note = ""
+           THEN error (") fehlt")
+         FI
+  ELIF symbol type <> eof type
+    THEN error ("( fehlt")
+  FI .
+ 
+parameter list :
+  parameter (param 1, number of params, permitted type) ;
+  IF symbol = ","
+    THEN next symbol ;
+         parameter (param 2, number of params, permitted type) ;
+  FI .
+ 
+nothing else in command line :
+  next symbol ;
+  IF symbol <> ""
+    THEN error ("Kommando zu schwierig")
+  FI .
+
+decode command :
+  command index := index (command list, procedure, number of params) .
+ 
+impossible command :
+  command index := 0 .
+ 
+ENDPROC analyze command ;
+ 
+PROC parameter (TEXT VAR param, INT VAR number of params,
+                INT CONST permitted type) :
+ 
+  IF symbol type = text type OR symbol type = permitted type
+    THEN param := symbol ;
+         number of params INCR 1 ;
+         next symbol
+    ELSE error ("Parameter ist kein TEXT ("" fehlt)")
+  FI
+ 
+ENDPROC parameter ;
+ 
+INT PROC index (TEXT CONST list, procedure, INT CONST params) :
+ 
+  pattern := procedure ;
+  pattern CAT ":" ;
+  IF procedure name found
+    THEN get colon pos ;
+         get dot pos ;
+         get end pos ;
+         get command index ;
+         get param index ;
+         IF param index >= 0
+           THEN command index + param index
+           ELSE - command index
+         FI
+    ELSE 0
+  FI .
+ 
+procedure name found :
+  INT VAR index pos := pos (list, pattern) ;
+  WHILE index pos > 0 REP
+    IF index pos = 1  COR  (list SUB index pos - 1) <= "9"
+      THEN LEAVE procedure name found WITH TRUE 
+    FI ;
+    index pos := pos (list, pattern, index pos + 1) 
+  PER ;
+  FALSE .
+ 
+get param index :
+  INT CONST param index :=
+            pos (list, text (params), dot pos, end pos) - dot pos - 1 .
+ 
+get command index :
+  INT CONST command index :=
+            int ( subtext (list, colon pos + 1, dot pos - 1) ) .
+ 
+get colon pos :
+  INT CONST colon pos := pos (list, ":", index pos) .
+ 
+get dot pos :
+  INT CONST dot pos := pos (list, ".", index pos) .
+ 
+get end pos :
+  INT CONST end pos := dot pos + 4 .
+ 
+ENDPROC index ;
+ 
+PROC do command :
+
+  do (command handlers own command line)
+
+ENDPROC do command ;
+
+PROC error (TEXT CONST message) :
+ 
+  error note := message ;
+  scan ("") ;
+  procedure := "-"
+ 
+ENDPROC error ;
+ 
+PROC command error :
+
+  disable stop ;
+  IF error note <> ""
+    THEN errorstop (error note) ;
+         error note := ""
+  FI ;
+  enable stop
+
+ENDPROC command error ;
+
+
+PROC next symbol :
+ 
+  next symbol (symbol, symbol type)
+ 
+ENDPROC next symbol ;
+ 
+
+PROC cover tracks :
+
+  cover tracks (command handlers own command line) ;
+  cover tracks (previous command line) ;
+  erase buffers of compiler and do packet .
+
+erase buffers of compiler and do packet :
+  do (command handlers own command line) .
+
+ENDPROC cover tracks ;
+
+PROC cover tracks (TEXT VAR secret) :
+
+  INT VAR i ;
+  FOR i FROM 1 UPTO LENGTH secret REP
+    replace (secret, i, " ")
+  PER ;
+  WHILE LENGTH secret < 13 REP
+    secret CAT " "
+  PER
+
+ENDPROC cover tracks ;
+
+ENDPACKET command handler ;
+
diff --git a/system/base/1.7.5/src/dataspace b/system/base/1.7.5/src/dataspace
new file mode 100644
index 0000000..3045a53
--- /dev/null
+++ b/system/base/1.7.5/src/dataspace
@@ -0,0 +1,74 @@
+(* ------------------- VERSION 3     22.04.86 ------------------- *)
+PACKET dataspace DEFINES 
+
+    := ,
+    nilspace ,
+    forget ,
+    type ,
+    heap size ,
+    storage ,
+    ds pages ,
+    next ds page ,
+    blockout ,
+    blockin ,
+    ALIGN :
+
+
+LET myself id field   = 9 ,
+    lowest ds number  = 4 ,
+    highest ds number = 255 ;
+
+TYPE ALIGN = ROW 252 INT ;
+
+OP := (DATASPACE VAR dest, DATASPACE CONST source ) : 
+  EXTERNAL 70
+ENDOP := ;
+ 
+DATASPACE PROC nilspace : 
+  EXTERNAL 69
+ENDPROC nilspace ;
+ 
+PROC forget (DATASPACE CONST dataspace ) :
+  EXTERNAL 71
+ENDPROC forget ;
+ 
+PROC type (DATASPACE CONST ds, INT CONST type) :
+  EXTERNAL 72
+ENDPROC type ;
+ 
+INT PROC type (DATASPACE CONST ds) :
+  EXTERNAL 73
+ENDPROC type ;
+ 
+INT PROC heap size (DATASPACE CONST ds) :
+  EXTERNAL 74
+ENDPROC heap size ;
+
+INT PROC storage (DATASPACE CONST ds) :
+  (ds pages (ds) + 1) DIV 2
+ENDPROC storage ;
+
+INT PROC ds pages (DATASPACE CONST ds) :
+  pages (ds, pcb (myself id field))
+ENDPROC ds pages ;
+
+INT PROC pages (DATASPACE CONST ds, INT CONST task nr) :
+  EXTERNAL 88
+ENDPROC pages ;
+
+INT PROC next ds page (DATASPACE CONST ds, INT CONST page nr) :
+  EXTERNAL 87
+ENDPROC next ds page ;
+
+PROC blockout (DATASPACE CONST ds, INT CONST page nr, code1, code2,
+               INT VAR return code) :
+  EXTERNAL 85
+ENDPROC blockout ;
+
+PROC blockin (DATASPACE VAR ds, INT CONST page nr, code1, code2,
+              INT VAR return code) :
+  EXTERNAL 86
+ENDPROC blockin ;
+
+ENDPACKET dataspace ;
+
diff --git a/system/base/1.7.5/src/date handling b/system/base/1.7.5/src/date handling
new file mode 100644
index 0000000..66da110
--- /dev/null
+++ b/system/base/1.7.5/src/date handling
@@ -0,0 +1,303 @@
+PACKET date handling DEFINES date, time,        (*  Autor: H. Indenbirken  *)
+                             time of day,       (*  Stand:  02.06.1986 (wk)*)
+                             month, day , year ,
+                             hour ,
+                             minute,
+                             second :
+
+LET middle yearlength = 31557380.0,
+    weeklength =    604800.0,
+    daylength  =     86400.0,
+    hours      =      3600.0,
+    minutes    =        60.0,
+    seconds    =         1.0;
+
+
+(* Tage bis zum Jahr 01.01.1900: 693970.25   5.995903e10   Sekunden        *)
+(* Dieser Tag ist ein Montag                                               *)
+
+REAL VAR begin of today := 0.0 , end of today := 0.0 ;
+
+TEXT VAR today , result ;
+
+
+ROW 12 REAL CONST previous days :: ROW 12 REAL : (0.0, 2678400.0, 5097600.0,
+                                           7776000.0, 10368000.0, 13046400.0,
+                                          15638400.0, 18316800.0, 20995200.0,
+                                          23587200.0, 26265600.0, 28857600.0);
+ 
+REAL PROC day: day length END PROC day;
+REAL PROC hour: hours     END PROC hour;
+REAL PROC minute: minutes END PROC minute;
+REAL PROC second: seconds END PROC second;
+
+TEXT PROC date :
+
+  IF clock (1) < begin of today OR end of today <= clock (1)
+  THEN begin of today := clock (1) ;
+       end of today := floor (begin of today/daylength)*daylength+daylength;
+       today := date (begin of today)
+  FI ;
+  today
+ 
+ENDPROC date ;
+
+TEXT PROC date (REAL CONST datum):
+  INT VAR year :: int (datum/middle yearlength),
+          day  :: int (((datum - datum MOD daylength) MOD middle yearlength) / daylength) + 1;
+
+correct kalendary day;
+ 
+  calculate month and correct day;
+  result := daytext;
+  result CAT monthtext;
+  result CAT yeartext;
+  change all (result, " ", "0") ;
+  result .
+
+correct kalendary day:
+  IF day >= 60 AND NOT leapyear 
+  THEN day INCR 1 FI  .
+
+leapyear:
+  IF year MOD 100 = 0 
+    THEN year MOD 400 = 0
+    ELSE year MOD 4 = 0 
+  FI.
+
+calculate month and correct day:
+  INT VAR month;
+  IF day > 182
+  THEN IF day > 274
+       THEN IF day > 305
+            THEN IF day > 335
+                 THEN month := 12;
+                      day DECR 335
+                 ELSE month := 11;
+                      day DECR 305
+                 FI
+            ELSE month := 10;
+                 day DECR 274
+            FI
+       ELSE IF day > 213
+            THEN IF day > 244
+                 THEN month := 9;
+                      day DECR 244
+                 ELSE month := 8;
+                      day DECR 213
+                 FI
+            ELSE month := 7;
+                 day DECR 182
+            FI
+       FI 
+  ELSE IF day > 91
+       THEN IF day > 121
+            THEN IF day > 152
+                 THEN month := 6;
+                      day DECR 152
+                 ELSE month := 5;
+                      day DECR 121
+                 FI
+            ELSE month := 4;
+                 day DECR 91
+            FI
+       ELSE IF day > 31
+            THEN IF day > 60
+                 THEN month := 3;
+                      day DECR 60
+                 ELSE month := 2;
+                      day DECR 31
+                 FI
+            ELSE month := 1 FI
+       FI 
+  FI  .
+
+daytext :
+  text (day, 2) + "."   .
+
+monthtext :
+  text (month,2) + "."   .
+
+yeartext:
+  IF 1900 <= year AND year < 2000
+    THEN text (year - 1900, 2)
+    ELSE text (year, 4)
+  FI   .
+
+END PROC date;
+
+TEXT PROC day (REAL CONST datum):
+  SELECT int ((datum MOD weeklength)/daylength) OF
+  CASE 1: "Donnerstag"
+  CASE 2: "Freitag"
+  CASE 3: "Samstag"
+  CASE 4: "Sonntag"
+  CASE 5: "Montag"
+  CASE 6: "Dienstag"
+  OTHERWISE "Mittwoch" ENDSELECT  .
+END PROC day;
+
+TEXT PROC month (REAL CONST datum):
+  SELECT int (subtext (date (datum), 4, 5)) OF
+  CASE  1: "Januar"
+  CASE  2: "Februar"
+  CASE  3: "März"
+  CASE  4: "April"
+  CASE  5: "Mai"
+  CASE  6: "Juni"
+  CASE  7: "Juli"
+  CASE  8: "August"
+  CASE  9: "September"
+  CASE 10: "Oktober"
+  CASE 11: "November"
+  OTHERWISE "Dezember" ENDSELECT  .
+
+END PROC month;
+
+TEXT PROC year (REAL CONST datum) :
+
+  TEXT VAR buffer := subtext (date (datum), 7) ;
+  IF LENGTH buffer = 2
+    THEN "19" + buffer
+    ELSE buffer
+  FI .
+
+ENDPROC year ;
+
+TEXT PROC time of day :
+  time of day (clock (1))
+ENDPROC time of day ;
+
+TEXT PROC time of day (REAL CONST value) :
+  subtext (time (value MOD daylength), 1, 5)
+ENDPROC time of day ;
+
+TEXT PROC time (REAL CONST value) :
+  time (value,10)
+ENDPROC time ;
+
+TEXT PROC time (REAL CONST value, INT CONST length) :
+  result := "" ;
+  IF length > 7
+    THEN result CAT hour ;
+         result CAT ":" 
+  FI ;
+  result CAT minute ;
+  result CAT ":" ;
+  result CAT rest ;
+  change all (result, " ", "0") ;
+  result .
+
+hour :
+  text (int (value/hours), length-8) .
+
+minute :
+  text (int (value/minutes MOD 60.0), 2)  .
+
+rest :
+  text (value MOD minutes, 4, 1) .
+
+END PROC time ; 
+
+REAL PROC date (TEXT CONST datum) :
+  split and check datum;
+  real (day no)*daylength +
+  previous days [month no] + calendary day +
+  floor (real (year no)*middleyearlength / daylength)*daylength  .
+
+split and check datum:
+  INT CONST day no :: first no;
+  IF NOT last conversion ok 
+  THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI;
+
+  INT CONST month no :: second no;
+  IF NOT last conversion ok OR month no < 1 OR month no > 12
+  THEN errorstop ("inkorrekte Datumsangabe (Monat) : " + datum) FI;
+
+  INT CONST year no :: third no + century;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Jahr) : " + datum) FI;
+
+  IF day no < 1 OR day no > size of month
+  THEN errorstop ("inkorrekte Datumsangabe (Tag) : " + datum) FI  .
+
+century:
+  IF (length (datum) - second pos) <= 2
+  THEN 1900
+  ELSE 0 FI  .
+
+size of month:
+  SELECT month no OF
+  CASE 1, 3, 5, 7, 8, 10, 12: 31
+  CASE 4, 6, 9, 11: 30
+  OTHERWISE february size ENDSELECT  .
+
+february size:
+  IF leapyear
+  THEN 29
+  ELSE 28 FI  .
+
+calendary day:
+  IF month no > 2 AND leapyear 
+  THEN daylength
+  ELSE 0.0 FI  .
+
+leapyear:
+  year no MOD 4 = 0  AND year no MOD 400 <> 0  .
+
+first no:
+  INT CONST first pos :: pos (datum, ".");
+  int (subtext (datum, 1, first pos-1))  .
+
+second no:
+  INT CONST second pos :: pos (datum, ".", first pos+1);
+  int (subtext (datum, first pos + 1, second pos-1))  .
+
+third no:
+  int (subtext (datum, second pos + 1))  .
+
+END PROC date;
+
+REAL PROC time (TEXT CONST time) :
+  split and check time;
+  hour + min + sec  .
+
+split and check time:
+  REAL CONST hour :: hour no * hours;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Stunde) : " + time) FI;
+
+  REAL CONST min  :: min no * minutes;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Minute) : " + time) FI;
+
+  REAL CONST sec :: sec no;
+  IF NOT last conversion ok
+  THEN errorstop ("inkorrekte Datumsangabe (Sekunde) : " + time) FI;
+
+  set conversion (hour ok AND min ok AND sec ok)  .
+ 
+hour no:
+  INT CONST hour pos :: pos (time, ":");
+  real (subtext (time, 1, hour pos-1))  .
+
+min no:
+  INT VAR min pos :: pos (time, ":", hour pos+1);
+  IF min pos = 0 
+    THEN real (subtext (time, hour pos + 1, LENGTH time))
+    ELSE real (subtext (time, hour pos + 1, min pos-1)) 
+  FI .
+
+sec no:
+  IF min pos = 0
+    THEN 0.0
+    ELSE real (subtext (time, min pos + 1)) 
+  FI .
+
+hour ok: 0.0 <= hour AND hour < daylength  .
+min ok:  0.0 <= min  AND min  < hours  .
+sec ok:  0.0 <= sec  AND sec  < minutes  .
+END PROC time;
+ 
+END PACKET datehandling
+
diff --git a/system/base/1.7.5/src/editor b/system/base/1.7.5/src/editor
new file mode 100644
index 0000000..62af2db
--- /dev/null
+++ b/system/base/1.7.5/src/editor
@@ -0,0 +1,2959 @@
+PACKET editor paket DEFINES                           (*  EDITOR   121   *)
+       (**********)                                   (*  19.07.85 -bk-  *)
+                                                      (*  10.09.85 -ws-  *)
+                                                      (*  25.04.86 -sh-  *)
+        edit, editget,                                (*  06.06.86 -wk-  *)
+        quit, quit last,                              (*  04.06.86 -jl-  *)
+        push, type,
+        word wrap, margin,
+        write permission,
+        set busy indicator,
+        two bytes,
+        is kanji esc, 
+        within kanji,
+        rubin mode,
+        is editget,
+        getchar,                      nichts neu,
+        getcharety,                   satznr neu,
+        is incharety,                 ueberschrift neu,
+        get window,                   zeile neu,
+        get editcursor,               abschnitt neu,
+        get editline,                 bildabschnitt neu,
+        put editline,                 bild neu,
+        aktueller editor,             alles neu,
+        groesster editor,             satznr zeigen,
+        open editor,                  ueberschrift zeigen,
+        editfile,                     bild zeigen:
+
+
+LET     hop            = ""1"",       right          = ""2"",
+        up char        = ""3"",       clear eop      = ""4"",
+        clear eol      = ""5"",       cursor pos     = ""6"",
+        piep           = ""7"",       left           = ""8"",
+        down char      = ""10"",      rubin          = ""11"",
+        rubout         = ""12"",      cr             = ""13"",
+        mark key       = ""16"",      abscr          = ""17"",
+        inscr          = ""18"",      dezimal        = ""19"",
+        backcr         = ""20"",      esc            = ""27"",
+        dach           = ""94"",      blank          = " ";
+ 
+
+LET     no output      = 0,           out zeichen    = 1,
+        out feldrest   = 2,           out feld       = 3,
+        clear feldrest = 4;
+ 
+LET     FELDSTATUS = STRUCT (INT  stelle, alte stelle, rand, limit,
+                                  anfang, marke, laenge, verschoben,
+                             BOOL einfuegen, fliesstext, write access,
+                             TEXT tabulator);
+FELDSTATUS VAR feldstatus;
+ 
+TEXT VAR begin mark := ""15"",
+         end mark   := ""14"";
+ 
+TEXT VAR separator := "", kommando := "", audit := "", zeichen := "",
+         satzrest := "", merksatz := "", alter editsatz := "";
+ 
+INT  VAR kommando zeiger := 1, umbruchstelle, umbruch verschoben,
+         zeile, spalte, output mode := no output, postblanks := 0,
+         min schreibpos, max schreibpos, cpos, absatz ausgleich;
+
+BOOL VAR lernmodus := FALSE, separator eingestellt := FALSE,
+         invertierte darstellung := FALSE, absatzmarke steht,
+         cursor diff := FALSE, editget modus := FALSE,
+         two byte mode := FALSE, std fliesstext := TRUE;.
+ 
+schirmbreite : x size - 1 . 
+schirmhoehe  : y size . 
+maxbreite    : schirmbreite - 2 .
+maxlaenge    : schirmhoehe - 1 . 
+marklength   : mark size .;
+
+initialisiere editor; 
+ 
+.initialisiere editor :
+  anfang := 1; zeile := 0; verschoben := 0; tabulator := "";
+  einfuegen := FALSE; fliesstext := TRUE; zeileneinfuegen := FALSE;
+  marke := 0; bildmarke := 0; feldmarke := 0.;
+
+(********************************  editget  ********************************)
+ 
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge,
+              TEXT CONST sep, res, TEXT VAR exit char) :
+  IF editlaenge < 1 THEN errorstop ("Fenster zu klein") FI; 
+  separator := ""13""; separator CAT sep;
+  separator eingestellt := TRUE;
+  TEXT VAR reservierte editget tasten := ""11""12"" ;
+  reservierte editget tasten CAT res ;
+  disable stop;
+  absatz ausgleich := 0; exit char := ""; get cursor;
+  FELDSTATUS CONST alter feldstatus := feldstatus;
+  feldstatus := FELDSTATUS : (1, 1, spalte - 1, editlimit,
+                              1, 0, editlaenge, 0,
+                              FALSE, FALSE, TRUE, "");
+  konstanten neu berechnen;
+  output mode := out feld;
+  feld editieren;
+  zeile verlassen;
+  feldstatus := alter feldstatus;
+  konstanten neu berechnen;
+  separator := "";
+  separator eingestellt := FALSE .
+ 
+feld editieren :
+  REP
+    feldeditor (editsatz, reservierte editget tasten);
+    IF   is error
+    THEN kommando zeiger := 1; kommando := ""; LEAVE feld editieren
+    FI ;
+    TEXT VAR t, zeichen; getchar (zeichen);
+    IF   zeichen ist separator
+    THEN exit char := zeichen; LEAVE feld editieren
+    ELIF zeichen = hop
+    THEN feldout (editsatz, stelle); getchar (zeichen)
+    ELIF zeichen = mark key
+    THEN output mode := out feld
+    ELIF zeichen = abscr
+    THEN exit char := cr; LEAVE feld editieren
+    ELIF zeichen = esc
+    THEN getchar (zeichen); auf exit pruefen;
+         IF   zeichen = rubout                                       (*sh*)
+         THEN IF   marke > 0
+              THEN merksatz := subtext (editsatz, marke, stelle - 1);
+                   change (editsatz, marke, stelle - 1, "");
+                   stelle := marke; marke := 0; konstanten neu berechnen
+              FI
+         ELIF zeichen = rubin
+         THEN t := subtext (editsatz, 1, stelle - 1);
+              t CAT merksatz;
+              satzrest := subtext (editsatz, stelle);
+              t CAT satzrest;
+              stelle INCR LENGTH merksatz;
+              merksatz := ""; editsatz := t
+         ELIF zeichen ist kein esc kommando                          (*wk*)
+                       AND
+              kommando auf taste (zeichen) <> ""
+         THEN editget kommando ausfuehren
+         FI ;
+         output mode := out feld
+    FI
+  PER .
+ 
+zeichen ist kein esc kommando :                                      (*wk*)
+  pos (hop + left + right, zeichen) = 0 .
+
+zeile verlassen :
+  IF   marke > 0 OR verschoben <> 0
+  THEN stelle DECR verschoben; verschoben := 0; feldout (editsatz, 0)
+  ELSE cursor (rand + 1 + min (LENGTH editsatz, editlaenge), zeile)
+  FI .
+ 
+zeichen ist separator : pos (separator, zeichen) > 0 .
+ 
+auf exit pruefen :
+  IF   pos (res, zeichen) > 0
+  THEN exit char := esc + zeichen; LEAVE feld editieren
+  FI .
+ 
+editget kommando ausfuehren :
+  editget zustaende sichern ;
+  do (kommando auf taste (zeichen)) ;
+  alte editget zustaende wieder herstellen ;
+  IF stelle < marke THEN stelle := marke FI;
+  konstanten neu berechnen .
+
+editget zustaende sichern :                                          (*wk*)
+  BOOL VAR alter editget modus := editget modus;
+  FELDSTATUS VAR feldstatus vor do kommando := feldstatus ;
+  INT VAR zeile vor do kommando := zeile ;
+  TEXT VAR separator vor do kommando := separator ;
+  BOOL VAR separator eingestellt vor do kommando := separator eingestellt ;
+  editget modus := TRUE ;
+  alter editsatz := editsatz .
+
+alte editget zustaende wieder herstellen :
+  editget modus := alter editget modus ;
+  editsatz := alter editsatz;
+  feldstatus := feldstatus vor do kommando ;
+  zeile := zeile vor do kommando ;
+  separator := separator vor do kommando ;
+  separator eingestellt := separator eingestellt vor do kommando .
+
+END PROC editget;
+ 
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, TEXT VAR exit char) :
+  editget (editsatz, editlimit, x size - x cursor, "", "", exit char)
+END PROC editget;                                       (* 05.07.84 -bk- *)
+ 
+PROC editget (TEXT VAR editsatz, TEXT CONST sep, res, TEXT VAR exit char) :
+  editget (editsatz, max text length, x size - x cursor, sep, res, exit char)
+END PROC editget;                                       (* 05.07.84 -bk- *)
+ 
+PROC editget (TEXT VAR editsatz) :
+  TEXT VAR exit char;                                   (* 05.07.84 -bk- *)
+  editget (editsatz, max text length, x size - x cursor, "", "", exit char)
+END PROC editget;
+ 
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge) :
+  TEXT VAR exit char;
+  editget (editsatz, editlimit, editlaenge, "", "", exit char)
+ENDPROC editget;
+
+(*******************************  feldeditor  ******************************)
+
+TEXT VAR reservierte feldeditor tasten ;                             (*jl*)
+
+PROC feldeditor (TEXT VAR satz, TEXT CONST res) :
+  enable stop;
+  reservierte feldeditor tasten := ""1""2""8"" ;
+  reservierte feldeditor tasten CAT res;
+  absatzmarke steht := (satz SUB LENGTH satz) = blank;
+  alte stelle merken;
+  cursor diff bestimmen und ggf ausgleichen;
+  feld editieren;
+  absatzmarke updaten .
+ 
+alte stelle merken : alte stelle := stelle .
+ 
+cursor diff bestimmen und ggf ausgleichen :
+  IF   cursor diff
+  THEN stelle INCR 1; cursor diff := FALSE
+  FI ;
+  IF   stelle auf zweitem halbzeichen
+  THEN stelle DECR 1; cursor diff := TRUE
+  FI .
+
+feld editieren :
+  REP
+    feld optisch aufbereiten;
+    kommando annehmen und ausfuehren
+  PER .
+ 
+absatzmarke updaten :
+  IF   absatzmarke soll stehen
+  THEN IF NOT absatzmarke steht THEN absatzmarke schreiben (TRUE) FI
+  ELSE IF     absatzmarke steht THEN absatzmarke schreiben (FALSE) FI
+  FI .
+ 
+absatzmarke soll stehen : (satz SUB LENGTH satz) = blank .
+ 
+feld optisch aufbereiten :
+  stelle korrigieren;
+  verschieben wenn erforderlich;
+  randausgleich fuer doppelzeichen;
+  output mode behandeln;
+  ausgabe verhindern .
+ 
+randausgleich fuer doppelzeichen :
+  IF   stelle = max schreibpos CAND stelle auf erstem halbzeichen 
+  THEN verschiebe (1)
+  FI .
+
+stelle korrigieren :
+  IF stelle auf zweitem halbzeichen THEN stelle DECR 1 FI .
+
+stelle auf erstem halbzeichen  : within kanji (satz, stelle + 1) .
+
+stelle auf zweitem halbzeichen : within kanji (satz, stelle) .
+
+output mode behandeln :
+  SELECT output mode OF
+    CASE no output      : im markiermode markierung anpassen
+    CASE out zeichen    : zeichen ausgeben; LEAVE output mode behandeln
+    CASE out feldrest   : feldrest neu schreiben
+    CASE out feld       : feldout (satz, stelle)
+    CASE clear feldrest : feldrest loeschen
+  END SELECT;
+  schreibmarke positionieren (stelle) .
+ 
+ausgabe verhindern : output mode := no output .
+ 
+im markiermode markierung anpassen :
+  IF markiert THEN markierung anpassen FI .
+
+markierung anpassen :
+  IF   stelle > alte stelle
+  THEN markierung verlaengern
+  ELIF stelle < alte stelle
+  THEN markierung verkuerzen
+  FI .
+ 
+markierung verlaengern :
+  invers out (satz, alte stelle, stelle, "", end mark) .
+ 
+markierung verkuerzen :
+  invers out (satz, stelle, alte stelle, end mark, "") .
+ 
+zeichen ausgeben :
+  IF   NOT markiert
+  THEN out (zeichen)
+  ELIF mark refresh line mode
+  THEN feldout (satz, stelle); schreibmarke positionieren (stelle)
+  ELSE out (begin mark); markleft; out (zeichen); out (end mark); markleft
+  FI .
+ 
+markleft : 
+  marklength TIMESOUT left .
+ 
+feldrest neu schreiben :
+  IF   NOT markiert
+  THEN feldrest unmarkiert neu schreiben
+  ELSE feldrest markiert neu schreiben
+  FI ; 
+  WHILE postblanks > 0 CAND x cursor <= rand + laenge REP
+    out (blank); postblanks DECR 1
+  PER ; postblanks := 0 .
+ 
+feldrest unmarkiert neu schreiben :
+  schreibmarke positionieren (alte stelle);
+  out subtext mit randbehandlung (satz, alte stelle, stelle am ende) .
+ 
+feldrest markiert neu schreiben :
+  markierung verlaengern; out subtext mit randbehandlung
+                          (satz, stelle, stelle am ende - 2 * marklength) .
+ 
+kommando annehmen und ausfuehren :
+  kommando annehmen; kommando ausfuehren .
+ 
+kommando annehmen :
+  getchar (zeichen); kommando zurueckweisen falls noetig .
+
+kommando zurueckweisen falls noetig :
+  IF   NOT write access CAND zeichen ist druckbar
+  THEN benutzer warnen; kommando ignorieren
+  FI .
+
+benutzer warnen : out (piep) .
+
+kommando ignorieren :
+  zeichen := ""; LEAVE kommando annehmen und ausfuehren . 
+
+kommando ausfuehren :
+  neue satzlaenge bestimmen;
+  alte stelle merken;
+  IF   zeichen ist separator
+  THEN feldeditor verlassen
+  ELIF zeichen ist druckbar
+  THEN fortschreiben
+  ELSE funktionstasten behandeln
+  FI .
+ 
+neue satzlaenge bestimmen : INT VAR satzlaenge := LENGTH satz .
+
+feldeditor verlassen :
+  IF NOT absatzmarke steht THEN blanks abschneiden FI;               (*sh*)
+  push (zeichen); LEAVE feld editieren .
+
+blanks abschneiden :
+  INT VAR letzte non blank pos := satzlaenge;
+  WHILE letzte non blank pos > 0 CAND (satz SUB letzte non blank pos) = blank REP 
+    letzte non blank pos DECR 1
+  PER; satz := subtext (satz, 1, letzte non blank pos) .
+
+zeichen ist druckbar : zeichen >= blank .
+ 
+zeichen ist separator :
+  separator eingestellt CAND pos (separator, zeichen) > 0 .
+ 
+fortschreiben :
+  zeichen in satz eintragen;
+  IF is kanji esc (zeichen) THEN kanji zeichen schreiben FI;
+  bei erreichen von limit ueberlauf behandeln .
+ 
+zeichen in satz eintragen :
+  IF   hinter dem satz
+  THEN satz mit leerzeichen auffuellen und zeichen anfuegen
+  ELIF einfuegen
+  THEN zeichen vor aktueller position einfuegen
+  ELSE altes zeichen ersetzen
+  FI .
+ 
+hinter dem satz : stelle > satzlaenge .
+ 
+satz mit leerzeichen auffuellen und zeichen anfuegen :
+  satz AUFFUELLENMIT blank;
+  zeichen anfuegen;
+  output mode := out zeichen .
+ 
+zeichen anfuegen   : satz CAT zeichen; neue satzlaenge bestimmen .
+zeichen ignorieren : benutzer warnen; LEAVE kommando ausfuehren .
+ 
+zeichen vor aktueller position einfuegen :
+  insert char (satz, zeichen, stelle);
+  neue satzlaenge bestimmen;
+  output mode := out feldrest .
+ 
+altes zeichen ersetzen :
+  replace (satz, stelle, zeichen);
+  IF   stelle auf erstem halbzeichen
+  THEN output mode := out feldrest; replace (satz, stelle + 1, blank)
+  ELSE output mode := out zeichen 
+  FI .
+
+kanji zeichen schreiben :
+  alte stelle merken;
+  stelle INCR 1; getchar (zeichen);
+  IF   zeichen < ""64"" THEN zeichen := ""64"" FI;
+  IF   hinter dem satz
+  THEN zeichen anfuegen
+  ELIF einfuegen
+  THEN zeichen vor aktueller position einfuegen
+  ELSE replace (satz, stelle, zeichen)
+  FI ;
+  output mode := out feldrest .
+
+bei erreichen von limit ueberlauf behandeln :                        (*sh*)
+  IF   satzlaenge kritisch
+  THEN in naechste zeile falls moeglich
+  ELSE stelle INCR 1
+  FI .
+
+satzlaenge kritisch :
+  IF   stelle >= satzlaenge
+  THEN satzlaenge = limit
+  ELSE satzlaenge = limit + 1
+  FI .
+
+in naechste zeile falls moeglich :
+  IF   fliesstext AND umbruch moeglich OR NOT fliesstext AND stelle >= satzlaenge
+  THEN in naechste zeile
+  ELSE stelle INCR 1
+  FI .
+
+umbruch moeglich :
+  INT CONST st := stelle; stelle := limit;
+  INT CONST ltzt wortanf := letzter wortanfang (satz);
+  stelle := st; einrueckposition (satz) < ltzt wortanf .
+
+in naechste zeile :
+  IF   fliesstext 
+  THEN ueberlauf und oder umbruch 
+  ELSE ueberlauf ohne umbruch 
+  FI . 
+ 
+ueberlauf und oder umbruch : 
+  INT VAR umbruchpos := 1; 
+  umbruchposition bestimmen; 
+  loeschposition bestimmen; 
+  IF   stelle = satzlaenge 
+  THEN ueberlauf mit oder ohne umbruch
+  ELSE umbruch mit oder ohne ueberlauf
+  FI . 
+ 
+umbruchposition bestimmen : 
+  umbruchstelle := stelle; 
+  stelle := satzlaenge; 
+  umbruchpos := max (umbruchpos, letzter wortanfang (satz)); 
+  stelle := umbruchstelle . 
+ 
+loeschposition bestimmen : 
+  INT VAR loeschpos := umbruchpos;
+  WHILE davor noch blank REP loeschpos DECR 1 PER . 
+ 
+davor noch blank : 
+  loeschpos > ganz links CAND (satz SUB (loeschpos - 1)) = blank . 
+ 
+ganz links : max (1, marke) .
+ 
+ueberlauf mit oder ohne umbruch :
+  IF   zeichen = blank OR loeschpos = ganz links 
+  THEN stelle := 1; ueberlauf ohne umbruch 
+  ELSE ueberlauf mit umbruch
+  FI .
+
+ueberlauf ohne umbruch : push (cr) .
+
+ueberlauf mit umbruch :
+  ausgabe verhindern;
+  umbruchkommando aufbereiten; 
+  auf loeschposition positionieren . 
+ 
+umbruchkommando aufbereiten : 
+  zeichen := hop + rubout + inscr;
+  satzrest := subtext (satz, umbruchpos);
+  zeichen CAT satzrest;
+  IF   stelle ist im umgebrochenen teil
+  THEN insert char (zeichen, backcr, max (stelle - umbruchpos + 1, 0) + 4); 
+       zeichen CAT backcr
+  FI ;
+  push (zeichen) .
+ 
+stelle ist im umgebrochenen teil : stelle >= loeschpos . 
+ 
+auf loeschposition positionieren : stelle := loeschpos .
+ 
+umbruch mit oder ohne ueberlauf :
+  umbruchposition anpassen; 
+  IF   stelle ist im umgebrochenen teil 
+  THEN umbruch mit ueberlauf 
+  ELSE umbruch ohne ueberlauf 
+  FI . 
+ 
+umbruchposition anpassen : 
+  IF   zeichen = blank 
+  THEN umbruchpos := stelle + 1; 
+       umbruchposition bestimmen; 
+       neue loeschposition bestimmen 
+  FI . 
+ 
+neue loeschposition bestimmen : 
+  loeschpos := umbruchpos; 
+  WHILE davor noch blank AND stelle noch nicht erreicht REP loeschpos DECR 1 PER . 
+ 
+stelle noch nicht erreicht : loeschpos > stelle + 1 .
+
+umbruch mit ueberlauf : ueberlauf mit umbruch . 
+ 
+umbruch ohne ueberlauf : 
+  zeichen := inscr; 
+  satzrest := subtext (satz, umbruchpos); 
+  zeichen CAT satzrest;
+  zeichen CAT up char + backcr; 
+  umbruchstelle INCR 1; umbruch verschoben := verschoben;
+  satz := subtext (satz, 1, loeschpos - 1); 
+  schreibmarke positionieren (loeschpos); feldrest loeschen; 
+  output mode := out feldrest;
+  push (zeichen) . 
+ 
+funktionstasten behandeln :
+  SELECT pos (kommandos, zeichen) OF
+    CASE c hop     : hop kommandos behandeln
+    CASE c esc     : esc kommandos behandeln
+    CASE c right   : nach rechts oder ueberlauf
+    CASE c left    : wenn moeglich ein schritt nach links
+    CASE c tab     : zur naechsten tabulator position
+    CASE c dezimal : dezimalen schreiben
+    CASE c rubin   : einfuegen umschalten
+    CASE c rubout  : ein zeichen loeschen
+    CASE c abscr, c inscr, c down : feldeditor verlassen
+    CASE c up      : eine zeile nach oben                            (*sh*)
+    CASE c cr      : ggf absatz erzeugen 
+    CASE c mark    : markieren umschalten
+    CASE c backcr  : zurueck zur umbruchstelle
+    OTHERWISE      : sondertaste behandeln
+  END SELECT .
+ 
+kommandos :
+  LET c hop     =  1,                 c right   =  2,
+      c up      =  3,                 c left    =  4,
+      c tab     =  5,                 c down    =  6,
+      c rubin   =  7,                 c rubout  =  8,
+      c cr      =  9,                 c mark    = 10,
+      c abscr   = 11,                 c inscr   = 12,
+      c dezimal = 13,                 c esc     = 14, 
+      c backcr  = 15; 
+
+  ""1""2""3""8""9""10""11""12""13""16""17""18""19""27""20"" .
+ 
+dezimalen schreiben : IF write access THEN dezimaleditor (satz) FI .
+
+zurueck zur umbruchstelle: 
+  IF   umbruch stelle > 0 THEN stelle := umbruch stelle FI;
+  IF   verschoben <> umbruch verschoben 
+  THEN verschoben := umbruch verschoben; output mode := out feld 
+  FI . 
+ 
+hop kommandos behandeln :
+  TEXT VAR zweites zeichen; getchar (zweites zeichen);
+  zeichen CAT zweites zeichen;
+  SELECT pos (hop kommandos, zweites zeichen) OF
+    CASE h hop    : nach links oben
+    CASE h right  : nach rechts blaettern
+    CASE h left   : nach links blaettern
+    CASE h tab    : tab position definieren oder loeschen
+    CASE h rubin  : zeile splitten
+    CASE h rubout : loeschen oder rekombinieren
+    CASE h cr, h up, h down : feldeditor verlassen
+    OTHERWISE     : zeichen ignorieren
+  END SELECT .
+ 
+hop kommandos :
+  LET h hop    = 1,                   h right  = 2,
+      h up     = 3,                   h left   = 4,
+      h tab    = 5,                   h down   = 6,
+      h rubin  = 7,                   h rubout = 8,
+      h cr     = 9;
+ 
+  ""1""2""3""8""9""10""11""12""13"" .
+ 
+nach links oben :
+  stelle := max (marke, anfang) + verschoben; feldeditor verlassen .
+ 
+nach rechts blaettern :
+  INT CONST rechter rand := stelle am ende - markierausgleich;
+  IF   stelle ist am rechten rand
+  THEN stelle INCR laenge - 2 * markierausgleich + ausgleich fuer doppelzeichen
+  ELSE stelle := rechter rand
+  FI ;
+  IF satzlaenge <= limit THEN stelle := min (stelle, limit) FI;
+  alte einrueckposition mitziehen .
+ 
+stelle ist am rechten rand :
+  stelle auf erstem halbzeichen CAND stelle = rechter rand - 1
+                                COR  stelle = rechter rand .
+
+ausgleich fuer doppelzeichen : stelle - rechter rand .
+
+nach links blaettern :
+  INT CONST linker rand := stelle am anfang;
+  IF   stelle = linker rand
+  THEN stelle DECR laenge - 2 * markierausgleich
+  ELSE stelle := linker rand
+  FI ;
+  stelle := max (ganz links, stelle);
+  alte einrueckposition mitziehen .
+ 
+tab position definieren oder loeschen :
+  IF   stelle > LENGTH tabulator
+  THEN tabulator AUFFUELLENMIT right; tabulator CAT dach
+  ELSE replace (tabulator, stelle, neues tab zeichen)
+  FI ;
+  feldeditor verlassen .
+ 
+neues tab zeichen :
+  IF (tabulator SUB stelle) = right THEN dach ELSE right FI .
+ 
+zeile splitten :
+  IF write access THEN feldeditor verlassen ELSE zeichen ignorieren FI .
+ 
+loeschen oder rekombinieren :
+  IF   NOT write access
+  THEN zeichen ignorieren
+  ELIF hinter dem satz
+  THEN zeilen rekombinieren
+  ELIF auf erstem zeichen
+  THEN ganze zeile loeschen
+  ELSE zeilenrest loeschen
+  FI .
+ 
+zeilen rekombinieren : feldeditor verlassen .
+auf erstem zeichen   : stelle = 1 .
+ganze zeile loeschen : satz := ""; feldeditor verlassen .
+ 
+zeilenrest loeschen :
+  change (satz, stelle, satzlaenge, ""); 
+  output mode := clear feldrest .
+ 
+esc kommandos behandeln :
+  getchar (zweites zeichen); 
+  zeichen CAT zweites zeichen;
+  auf exit pruefen;
+  SELECT pos (esc kommandos, zweites zeichen) OF
+    CASE e hop   : lernmodus umschalten
+    CASE e right : zum naechsten wort
+    CASE e left  : zum vorigen wort
+    OTHERWISE    : belegte taste ausfuehren 
+  END SELECT .
+ 
+auf exit pruefen :
+  IF pos (res, zweites zeichen) > 0 THEN feldeditor verlassen FI .
+ 
+esc kommandos :
+  LET e hop      =  1,
+      e right    =  2,
+      e left     =  3;
+ 
+  ""1""2""8"" .
+ 
+lernmodus umschalten :
+  IF lernmodus THEN lernmodus ausschalten ELSE lernmodus einschalten FI;
+  feldeditor verlassen .
+ 
+lernmodus ausschalten :
+  lernmodus := FALSE;
+  belegbare taste erfragen;
+  audit := subtext (audit, 1, LENGTH audit - 2);
+  IF   taste = hop 
+  THEN (* lernsequenz nicht auf taste legen *)          (* 16.08.85 -ws- *)
+  ELSE lernsequenz auf taste legen (taste, audit)
+  FI ;
+  audit := "" .
+ 
+belegbare taste erfragen :
+  TEXT VAR taste; getchar (taste);
+  WHILE taste ist reserviert REP
+    benutzer warnen; getchar (taste)
+  PER .
+ 
+taste ist reserviert :                                  (* 16.08.85 -ws- *)
+  taste <> hop CAND pos (reservierte feldeditor tasten, taste) > 0 .
+ 
+lernmodus einschalten : audit := ""; lernmodus := TRUE .
+ 
+zum vorigen wort :
+  IF   stelle > 1
+  THEN stelle DECR 1; stelle := letzter wortanfang (satz);
+       alte einrueckposition mitziehen;
+       IF (satz SUB stelle) <> blank THEN LEAVE zum vorigen wort FI
+  FI ;
+  feldeditor verlassen .
+ 
+zum naechsten wort :
+  IF kein naechstes wort THEN feldeditor verlassen FI .
+ 
+kein naechstes wort :
+  BOOL VAR im alten wort := TRUE;
+  INT VAR i;
+  FOR i FROM stelle UPTO satzlaenge REP
+    IF   im alten wort
+    THEN im alten wort := (satz SUB i) <> blank
+    ELIF (satz SUB i) <> blank
+    THEN stelle := i; LEAVE kein naechstes wort WITH FALSE
+    FI
+  PER;
+  TRUE .
+ 
+belegte taste ausfuehren :
+  IF   ist kommando taste
+  THEN feldeditor verlassen
+  ELSE gelerntes ausfuehren
+  FI .
+ 
+ist kommando taste : taste enthaelt kommando (zweites zeichen) .
+ 
+gelerntes ausfuehren :
+  push (lernsequenz auf taste (zweites zeichen)) .                   (*sh*)
+ 
+nach rechts oder ueberlauf :
+  IF   fliesstext COR stelle < limit OR satzlaenge > limit 
+  THEN nach rechts
+  ELSE auf anfang der naechsten zeile
+  FI .
+ 
+nach rechts :
+  IF stelle auf erstem halbzeichen THEN stelle INCR 2 ELSE stelle INCR 1 FI;
+  alte einrueckposition mitziehen .
+
+auf anfang der naechsten zeile : push (abscr) .
+
+nach links : stelle DECR 1; alte einrueckposition mitziehen .
+
+alte einrueckposition mitziehen :
+  IF   satz ist leerzeile
+  THEN alte einrueckposition := stelle
+  ELSE alte einrueckposition := min (stelle, einrueckposition (satz))
+  FI .
+
+satz ist leerzeile :
+  satz = "" OR satz = blank . 
+
+wenn moeglich ein schritt nach links :
+  IF   stelle = ganz links
+  THEN zeichen ignorieren
+  ELSE nach links
+  FI .
+ 
+zur naechsten tabulator position :
+  bestimme naechste explizite tabulator position;
+  IF   tabulator gefunden
+  THEN explizit tabulieren
+  ELIF stelle <= satzlaenge
+  THEN implizit tabulieren
+  ELSE auf anfang der naechsten zeile
+  FI .
+ 
+bestimme naechste explizite tabulator position :
+  INT VAR tab position := pos (tabulator, dach, stelle + 1);
+  IF   tab position > limit AND satzlaenge <= limit
+  THEN tab position := 0
+  FI .
+ 
+tabulator gefunden : tab position <> 0 .
+ 
+explizit tabulieren : stelle := tab position; push (dezimal) .
+ 
+implizit tabulieren :
+  tab position := einrueckposition (satz);
+  IF   stelle <  tab position
+  THEN stelle := tab position
+  ELSE stelle := satzlaenge + 1
+  FI .
+ 
+einfuegen umschalten :
+  IF NOT write access THEN zeichen ignorieren FI;                    (*sh*)
+  einfuegen := NOT einfuegen;
+  IF einfuegen THEN einfuegen optisch anzeigen FI;
+  feldeditor verlassen .
+ 
+einfuegen optisch anzeigen :
+  IF   markiert
+  THEN out (begin mark); markleft; out (dach left); warten;
+       out (end mark); markleft
+  ELSE out (dach left); warten;
+       IF   stelle auf erstem halbzeichen
+       THEN out text (satz, stelle, stelle + 1)
+       ELSE out text (satz, stelle, stelle)
+       FI
+  FI .
+ 
+markiert  : marke > 0 .
+dach left : ""94""8"" .
+ 
+warten :
+  TEXT VAR t := incharety (2);
+  kommando CAT t; IF lernmodus THEN audit CAT t FI .
+ 
+ein zeichen loeschen :
+  IF   NOT write access THEN zeichen ignorieren FI;                  (*sh*)
+  IF   zeichen davor soll geloescht werden
+  THEN nach links oder ignorieren
+  FI ;
+  IF   NOT hinter dem satz THEN aktuelles zeichen loeschen FI .
+ 
+zeichen davor soll geloescht werden :
+  hinter dem satz COR markiert .
+ 
+nach links oder ignorieren :
+  IF   stelle > ganz links
+  THEN nach links                                                    (*sh*)
+  ELSE zeichen ignorieren
+  FI .
+ 
+aktuelles zeichen loeschen :
+  stelle korrigieren; alte stelle merken;
+  IF   stelle auf erstem halbzeichen
+  THEN delete char (satz, stelle);
+       postblanks INCR 1
+  FI ;
+  delete char (satz, stelle);
+  postblanks INCR 1;
+  neue satzlaenge bestimmen;
+  output mode := out feldrest .
+
+eine zeile nach oben :                                               (*sh*)
+  IF   NOT absatzmarke steht CAND NOT ist teil eines umbruchkommandos 
+  THEN blanks abschneiden
+  FI ;
+  push (zeichen); LEAVE feld editieren .
+
+ist teil eines umbruchkommandos : (kommando SUB kommandozeiger) = backcr .
+
+ggf absatz erzeugen :                                                (*sh*)
+  IF   write access
+  THEN IF   NOT absatzmarke steht THEN blanks abschneiden FI;
+       IF   stelle > LENGTH satz AND fliesstext AND NOT absatzmarke steht
+       THEN satz CAT blank
+       FI 
+  FI ; push (zeichen); LEAVE feld editieren .
+
+markieren umschalten :
+  IF   markiert
+  THEN marke := 0;      maxschreibpos INCR marklength; cpos DECR marklength
+  ELSE marke := stelle; maxschreibpos DECR marklength; cpos INCR marklength;
+       verschieben wenn erforderlich
+  FI ;
+  feldeditor verlassen .
+ 
+sondertaste behandeln : push (esc + zeichen) .
+END PROC feldeditor;
+ 
+PROC dezimaleditor (TEXT VAR satz) :
+  INT VAR dezimalanfang := stelle;
+  zeichen einlesen;
+  IF dezimalstartzeichen CAND ueberschreibbar THEN dezimalen schreiben FI;
+  push (zeichen) .
+ 
+zeichen einlesen    : TEXT VAR zeichen; getchar (zeichen) .
+dezimalzeichen      : pos (dezimalen, zeichen) > 0 AND nicht separator .
+dezimalstartzeichen : pos (startdezimalen, zeichen) > 0 AND nicht separator .
+dezimalen           : "0123456789" .
+startdezimalen      : "+-0123456789" .
+nicht separator     : pos (separator, zeichen) = 0 .
+ 
+ueberschreibbar :
+  dezimalanfang > LENGTH satz OR
+  pos (ueberschreibbare zeichen, satz SUB dezimalanfang) > 0 .
+ 
+ueberschreibbare zeichen : " ,.+-0123456789" . 
+ 
+dezimalen schreiben :
+  REP
+    dezimale in satz eintragen;
+    dezimalen zeigen;
+    zeichen einlesen;
+    dezimalanfang DECR 1
+  UNTIL dezimaleditor beendet PER;
+  stelle INCR 1 .
+ 
+dezimale in satz eintragen :
+  IF   dezimalanfang > LENGTH satz
+  THEN satz AUFFUELLENMIT blank; satz CAT zeichen
+  ELSE delete char (satz, dezimalanfang); insert char (satz, zeichen, stelle)
+  FI .
+ 
+dezimalen zeigen :
+  INT VAR min dezimalschreibpos := max (min schreibpos, dezimalanfang);
+  IF markiert THEN markiert zeigen ELSE unmarkiert zeigen FI;
+  schreibmarke positionieren (stelle) .
+ 
+markiert : marke > 0 .
+ 
+markiert zeigen :
+  invers out (satz, min dezimalschreibpos, stelle, "", end mark);
+  out (zeichen) .
+ 
+unmarkiert zeigen :
+  schreibmarke positionieren (min dezimalschreibpos);
+  out subtext (satz, min dezimalschreibpos, stelle) .
+ 
+dezimaleditor beendet :
+  NOT dezimalzeichen OR
+  dezimalanfang < max (min schreibpos, marke) OR
+  NOT ueberschreibbar .
+END PROC dezimaleditor;
+
+BOOL PROC is editget :
+  editget modus
+END PROC is editget ;
+
+PROC get editline (TEXT VAR editline, INT VAR editpos, editmarke) :
+  IF   editget modus
+  THEN editline := alter editsatz;
+       editpos := stelle
+  FI ;
+  editmarke := marke
+END PROC get editline;
+
+PROC put editline (TEXT CONST editline, INT CONST editpos, editmarke) :
+  IF   editget modus
+  THEN alter editsatz := editline;
+       stelle := max (editpos, 1);
+       marke := max (editmarke, 0)
+  FI 
+END PROC put editline;
+
+BOOL PROC within kanji (TEXT CONST satz, INT CONST stelle) :
+  count directly prefixing kanji esc bytes;
+  number of kanji esc bytes is odd .
+ 
+count directly prefixing kanji esc bytes :
+  INT VAR pos := stelle - 1, kanji esc bytes := 0; 
+  WHILE pos > 0 CAND is kanji esc (satz SUB pos) REP
+    kanji esc bytes INCR 1; pos DECR 1
+  PER .
+
+number of kanji esc bytes is odd :
+  (kanji esc bytes AND 1) <> 0 .
+END PROC within kanji;
+
+BOOL PROC is kanji esc (TEXT CONST char) :                           (*sh*)
+  two byte mode CAND
+  (char >= ""129"" AND char <= ""159"" OR char >= ""224"" AND char <= ""239"")
+END PROC is kanji esc;
+ 
+BOOL PROC two bytes : two byte mode END PROC two bytes; 
+
+PROC two bytes (BOOL CONST new mode) :
+  two byte mode := new mode
+END PROC two bytes;
+
+PROC outtext (TEXT CONST source, INT CONST from, to) :
+  out subtext mit randbehandlung (source, from, to);
+  INT VAR trailing;
+  IF   from <= LENGTH source
+  THEN trailing := to - LENGTH source
+  ELSE trailing := to - from + 1
+  FI ; trailing TIMESOUT blank
+END PROC outtext;
+
+PROC out subtext mit randbehandlung (TEXT CONST satz, INT CONST von, bis) :
+  IF   von > bis
+  THEN
+  ELIF bis >= LENGTH satz COR NOT within kanji (satz, bis + 1)
+  THEN out subtext mit anfangsbehandlung (satz, von, bis)
+  ELSE out subtext mit anfangsbehandlung (satz, von, bis - 1); out (blank)
+  FI
+END PROC out subtext mit randbehandlung;
+
+PROC out subtext mit anfangsbehandlung (TEXT CONST satz, INT CONST von, bis) :
+  IF   von > bis
+  THEN
+  ELIF von = 1 COR NOT within kanji (satz, von)
+  THEN out subtext (satz, von, bis)
+  ELSE out (blank); out subtext (satz, von + 1, bis)
+  FI
+END PROC out subtext mit anfangsbehandlung;
+
+PROC get cursor   :  get cursor (spalte, zeile)     END PROC get cursor;
+
+INT PROC x cursor :  get cursor; spalte             END PROC x cursor;
+ 
+BOOL PROC write permission :   write access   END PROC write permission; 
+ 
+PROC push (TEXT CONST ausfuehrkommando) :
+  IF   ausfuehrkommando = ""                                         (*sh*)
+  THEN
+  ELIF kommando = ""
+  THEN kommando := ausfuehrkommando
+  ELIF (kommando SUB kommando zeiger - 1) = ausfuehrkommando
+  THEN kommando zeiger DECR 1
+  ELIF replace moeglich 
+  THEN kommando zeiger DECR laenge des ausfuehrkommandos; 
+       replace (kommando, kommando zeiger, ausfuehrkommando) 
+  ELSE insert char (kommando, ausfuehrkommando, kommando zeiger)
+  FI . 
+ 
+replace moeglich : 
+  INT CONST laenge des ausfuehrkommandos := LENGTH ausfuehrkommando; 
+  kommando zeiger > laenge des ausfuehrkommandos . 
+END PROC push;
+ 
+PROC type (TEXT CONST ausfuehrkommando) :
+  kommando CAT ausfuehrkommando
+END PROC type;
+ 
+INT PROC stelle am anfang : anfang + verschoben END PROC stelle am anfang;
+ 
+INT PROC stelle am ende   : stelle am anfang+laenge-1 END PROC stelle am ende;
+ 
+INT PROC markierausgleich : SIGN marke * marklength END PROC markierausgleich;
+ 
+PROC verschieben wenn erforderlich :
+  IF   stelle > max schreibpos
+  THEN verschiebe (stelle - max schreibpos)
+  ELIF stelle < min schreibpos
+  THEN verschiebe (stelle - min schreibpos)
+  FI
+END PROC verschieben wenn erforderlich;
+ 
+PROC verschiebe (INT CONST i) :
+  verschoben     INCR i;
+  min schreibpos INCR i;
+  max schreibpos INCR i;
+  cpos           DECR i;
+  output mode := out feld; 
+  schreibmarke positionieren (stelle)                   (* 11.05.85 -ws- *)
+END PROC verschiebe;
+ 
+PROC konstanten neu berechnen :
+  min schreibpos := anfang + verschoben;
+  IF   min schreibpos < 0                               (* 17.05.85 -ws- *)
+  THEN min schreibpos DECR verschoben; verschoben := 0 
+  FI ; 
+  max schreibpos := min schreibpos + laenge - 1 - markierausgleich;
+  cpos := rand + laenge - max schreibpos
+END PROC konstanten neu berechnen;
+ 
+PROC schreibmarke positionieren (INT CONST sstelle) :
+  cursor (cpos + sstelle, zeile)
+END PROC schreibmarke positionieren;
+ 
+PROC simple feldout (TEXT CONST satz, INT CONST dummy) :
+  (* PRECONDITION : NOT markiert AND verschoben = 0 *)
+  (*                AND feldrest schon geloescht    *)
+  schreibmarke an feldanfang positionieren;
+  out subtext mit randbehandlung (satz, anfang, anfang + laenge - 1);
+  IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI .
+ 
+schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) .
+END PROC simple feldout;
+ 
+PROC feldout (TEXT CONST satz, INT CONST sstelle) :
+  schreibmarke an feldanfang positionieren;
+  feld ausgeben;
+  feldrest loeschen;
+  IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI . 
+
+schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) .
+ 
+feld ausgeben :
+  INT VAR von := anfang + verschoben, bis := von + laenge - 1;
+  IF   nicht markiert
+  THEN unmarkiert ausgeben
+  ELIF markiertes nicht sichtbar
+  THEN unmarkiert ausgeben
+  ELSE markiert ausgeben
+  FI .
+ 
+nicht markiert : marke <= 0 .
+
+markiertes nicht sichtbar :
+  bis DECR marklength * (1 + SIGN sstelle); marke > bis + 1 .
+ 
+unmarkiert ausgeben :
+  out subtext mit randbehandlung (satz, von, bis) . 
+ 
+markiert ausgeben :
+  INT VAR smarke := max (von, marke);
+  out text (satz, von, smarke - 1); out (begin mark);
+  verschiedene feldout modes behandeln .
+ 
+verschiedene feldout modes behandeln :
+  IF   sstelle = 0
+  THEN out subtext mit randbehandlung (satz, smarke, bis); out (end mark)
+  ELSE out text (satz, smarke, zeilenrand); out (end mark);          (*sh*)
+       out subtext mit randbehandlung (satz, sstelle, bis)
+  FI .
+ 
+zeilenrand : min (bis, sstelle - 1) . 
+END PROC feldout;
+ 
+PROC absatzmarke schreiben (BOOL CONST schreiben) :
+  IF   fliesstext AND nicht markiert
+  THEN cursor (rand + 1 + laenge, zeile);
+       out (absatzmarke) ;
+       absatzmarke steht := TRUE
+  FI .
+ 
+nicht markiert : marke <= 0 .
+ 
+absatzmarke :
+  IF   NOT schreiben
+  THEN "  "
+  ELIF marklength > 0
+  THEN ""15""14""
+  ELSE ""15" "14" "
+  FI .
+END PROC absatzmarke schreiben;
+ 
+PROC invers out (TEXT CONST satz, INT CONST von, bis, TEXT CONST pre, post) :
+  IF   mark refresh line mode
+  THEN feldout (satz, stelle)
+  ELSE schreibmarke positionieren (von);
+       out (begin mark); markleft; out (pre);
+       out text (satz, von, bis - 1); out (post)
+  FI .
+
+markleft : 
+  marklength TIMESOUT left .
+ 
+END PROC invers out;
+ 
+PROC feldrest loeschen :
+  IF   rand + laenge < maxbreite COR invertierte darstellung
+  THEN INT VAR x; get cursor (x, zeile);
+       (rand + laenge - x + 1 + absatz ausgleich) TIMESOUT blank;    (*sh*)
+       cursor (x, zeile)
+  ELSE out (clear eol); absatzmarke steht := FALSE
+  FI 
+END PROC feldrest loeschen;
+ 
+OP AUFFUELLENMIT (TEXT VAR satz, TEXT CONST fuellzeichen) :
+  INT VAR i;
+  FOR i FROM stelle - LENGTH satz DOWNTO 2 REP
+    satz CAT fuellzeichen
+  PER 
+END OP AUFFUELLENMIT;
+ 
+INT PROC einrueckposition (TEXT CONST satz) :                        (*sh*)
+  IF   fliesstext AND satz = blank
+  THEN anfang
+  ELSE max (pos (satz, ""33"", ""254"", 1), 1)
+  FI
+END PROC einrueckposition;
+ 
+INT PROC letzter wortanfang (TEXT CONST satz) :                      (*sh*)
+  INT CONST ganz links := max (1, marke);
+  BOOL VAR noch nicht im neuen wort := TRUE;
+  INT  VAR i;
+  FOR i FROM stelle DOWNTO ganz links REP
+      IF   noch nicht im neuen wort
+      THEN noch nicht im neuen wort := char = blank
+      ELIF is kanji esc (char)
+      THEN LEAVE letzter wortanfang WITH i 
+      ELIF nicht mehr im neuen wort
+      THEN LEAVE letzter wortanfang WITH i + 1
+      FI
+  PER ;
+  ganz links .
+
+char : satz SUB i .
+
+nicht mehr im neuen wort : char = blank COR within kanji (satz, i) .
+END PROC letzter wortanfang;
+
+PROC getchar (TEXT VAR zeichen) :
+  IF   kommando = ""
+  THEN inchar (zeichen); IF lernmodus THEN audit CAT zeichen FI
+  ELSE zeichen := kommando SUB kommando zeiger;
+       kommando zeiger INCR 1;
+       IF   kommando zeiger > LENGTH kommando
+       THEN kommando zeiger := 1; kommando := ""
+       FI ;
+       IF   LENGTH kommando - kommando zeiger < 3
+       THEN kommando CAT inchety
+       FI
+  FI .
+END PROC getchar;
+
+TEXT PROC inchety : 
+  IF   lernmodus
+  THEN TEXT VAR t := incharety; audit CAT t; t
+  ELSE incharety
+  FI
+END PROC inchety;
+ 
+BOOL PROC is incharety (TEXT CONST muster) :
+  IF   kommando = ""
+  THEN TEXT CONST t := inchety;
+       IF t = muster THEN TRUE ELSE kommando := t; FALSE FI
+  ELIF (kommando SUB kommando zeiger) = muster
+  THEN kommando zeiger INCR 1;
+       IF   kommando zeiger > LENGTH kommando
+       THEN kommando zeiger := 1; kommando := ""
+       FI ;
+       TRUE
+  ELSE FALSE
+  FI
+END PROC is incharety;
+ 
+TEXT PROC getcharety :
+  IF   kommando = ""
+  THEN inchety
+  ELSE TEXT CONST t := kommando SUB kommando zeiger;
+       kommando zeiger INCR 1;
+       IF   kommando zeiger > LENGTH kommando
+       THEN kommando zeiger := 1; kommando := ""
+       FI ; t
+  FI
+END PROC getcharety;
+ 
+PROC get editcursor (INT VAR x, y) :                                 (*sh*)
+  IF actual editor > 0 THEN aktualisiere bildparameter FI;
+  x := rand - (anfang + verschoben - 1 - markierausgleich) + stelle;
+  y := zeile .
+
+  aktualisiere bildparameter :
+    INT VAR old x, old y; get cursor (old x, old y);
+    dateizustand holen; bildausgabe steuern; satznr zeigen;
+    fenster zeigen; zeile := bildrand + zeilennr; cursor (old x, old y) .
+END PROC get editcursor;
+
+(************************* Zugriff auf Feldstatus *************************).
+
+stelle       : feldstatus.stelle .
+alte stelle  : feldstatus.alte stelle .
+rand         : feldstatus.rand .
+limit        : feldstatus.limit .
+anfang       : feldstatus.anfang .
+marke        : feldstatus.marke .
+laenge       : feldstatus.laenge .
+verschoben   : feldstatus.verschoben .
+einfuegen    : feldstatus.einfuegen .
+fliesstext   : feldstatus.fliesstext .
+write access : feldstatus.write access .
+tabulator    : feldstatus.tabulator .
+
+(***************************************************************************)
+
+LET undefinierter bereich =  0,     nix            =  1,
+    bildzeile             =  2,     akt satznr     =  2,
+    abschnitt             =  3,     ueberschrift   =  3,
+    bild                  =  4,     fehlermeldung  =  4;
+ 
+LET BILDSTATUS = STRUCT (INT feldlaenge, kurze feldlaenge,
+                             bildrand, bildlaenge, kurze bildlaenge,
+                             ueberschriftbereich, bildbereich,
+                             erster neusatz, letzter neusatz,
+                             old zeilennr, old lineno, old mark lineno,
+                        BOOL zeileneinfuegen, old line update,
+                        TEXT satznr pre, ueberschrift pre,
+                             ueberschrift text, ueberschrift post, old satz,
+                        FRANGE old range,
+                        FILE file),
+    EDITSTATUS = STRUCT (FELDSTATUS feldstatus, BILDSTATUS bildstatus),
+    max editor = 10,
+    EDITSTACK  = ROW max editor EDITSTATUS;
+ 
+BILDSTATUS VAR bildstatus ;
+EDITSTACK VAR editstack;
+ 
+ROW max editor INT VAR einrueckstack;
+
+BOOL VAR markiert;
+TEXT VAR filename, tab, bildsatz, bildzeichen, fehlertext,
+         akt bildsatz ;
+INT  VAR zeilennr, satznr, bildanfang, bildmarke, feldmarke,
+         actual editor := 0, max used editor := 0,
+         letzer editor auf dieser datei,
+         alte einrueckposition := 1;
+
+INT PROC aktueller editor :  actual editor  END PROC aktueller editor;
+ 
+INT PROC groesster editor : max used editor END PROC groesster editor;
+
+(******************************  bildeditor  *******************************)
+
+PROC bildeditor (TEXT CONST res, PROC (TEXT CONST) kommando interpreter) :
+  evtl fehler behandeln;
+  enable stop;
+  TEXT VAR reservierte tasten := ""11""12""27"bf" ;
+  reservierte tasten CAT res ;
+  INT CONST my highest editor := max used editor;
+  laenge := feldlaenge;
+  konstanten neu berechnen;
+  REP
+    markierung justieren;
+    altes feld nachbereiten;
+    feldlaenge einstellen;
+    ueberschrift zeigen;
+    fenster zeigen ;
+    zeile bereitstellen;
+    zeile editieren;
+    kommando ausfuehren
+  PER .
+ 
+evtl fehler behandeln :
+  IF   is error
+  THEN fehlertext := errormessage;
+       IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI;
+       clear error
+  ELSE fehlertext := ""
+  FI .
+ 
+markierung justieren :
+  IF   bildmarke > 0
+  THEN IF   satznr <= bildmarke
+       THEN bildmarke := satznr;
+            stelle := max (stelle, feldmarke);
+            marke := feldmarke
+       ELSE marke := 1
+       FI
+  FI . 
+ 
+zeile bereitstellen : IF hinter letztem satz THEN insert record (file) FI .
+hinter letztem satz : lineno (file) > lines (file) .
+ 
+altes feld nachbereiten : 
+  IF   old line update AND lineno (file) <> old lineno 
+  THEN IF   verschoben <> 0 
+       THEN verschoben := 0; konstanten neu berechnen;
+       FI ;
+       INT CONST alte zeilennr := old lineno - bildanfang + 1;
+       IF   alte zeilennr > 0 AND alte zeilennr <= aktuelle bildlaenge 
+       THEN INT CONST m := marke;
+            IF   lineno (file) < old lineno
+            THEN marke := 0
+            ELIF old lineno = bildmarke
+            THEN marke := min (feldmarke, LENGTH old satz + 1)
+            ELSE marke := min (marke,     LENGTH old satz + 1)
+            FI ;
+            zeile := bildrand + alte zeilennr;
+            feldout (old satz, 0); marke := m 
+       FI
+  FI ;
+  old line update := FALSE; old satz := "" .
+
+feldlaenge einstellen : 
+  INT CONST alte laenge := laenge;
+  IF   zeilennr > kurze bildlaenge
+  THEN laenge := kurze feldlaenge
+  ELSE laenge := feldlaenge
+  FI ; 
+  IF   laenge <> alte laenge
+  THEN konstanten neu berechnen
+  FI .
+ 
+zeile editieren :
+  zeile := bildrand + zeilennr;
+  exec (PROC (TEXT VAR, TEXT CONST) feldeditor, file, reservierte tasten);
+  old lineno := satznr;
+  IF   markiert oder verschoben
+  THEN old line update := TRUE; read record (file, old satz)
+  FI .
+ 
+markiert oder verschoben : markiert COR verschoben <> 0 .
+ 
+kommando ausfuehren : 
+  getchar (bildzeichen);
+  SELECT pos (kommandos, bildzeichen) OF
+    CASE x hop   : hop kommando verarbeiten
+    CASE x esc   : esc kommando verarbeiten
+    CASE x up    : zum vorigen satz
+    CASE x down  : zum folgenden satz
+    CASE x rubin : zeicheneinfuegen umschalten
+    CASE x mark  : markierung umschalten
+    CASE x cr    : eingerueckt mit cr                  (*  08.06.85 -ws- *) 
+    CASE x inscr : eingerueckt zum folgenden satz
+    CASE x abscr : zum anfang des folgenden satzes
+  END SELECT .
+ 
+kommandos :
+  LET x hop   = 1,                    x up    = 2,
+      x down  = 3,                    x rubin = 4,
+      x cr    = 5,                    x mark  = 6,
+      x abscr = 7,                    x inscr = 8,
+      x esc   = 9;
+ 
+  ""1""3""10""11""13""16""17""18""27"" .
+ 
+zeicheneinfuegen umschalten :
+  rubin segment in ueberschrift eintragen;
+  neu (ueberschrift, nix) .
+ 
+rubin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 9, rubin segment) .
+ 
+rubin segment :
+  IF einfuegen THEN "RUBIN" ELSE "....." FI .
+
+hop kommando verarbeiten :
+  getchar (bildzeichen);
+  read record (file, bildsatz);
+  SELECT pos (hop kommandos, bildzeichen) OF
+    CASE y hop    : nach oben
+    CASE y cr     : neue seite
+    CASE y up     : zurueckblaettern
+    CASE y down   : weiterblaettern
+    CASE y tab    : put tabs (file, tabulator); neu (ueberschrift, nix)
+    CASE y rubout : zeile loeschen
+    CASE y rubin  : zeileneinfuegen umschalten
+  END SELECT .
+ 
+hop kommandos :
+  LET y hop    = 1,                   y up     = 2,
+      y tab    = 3,                   y down   = 4,
+      y rubin  = 5,                   y rubout = 6,
+      y cr     = 7;
+ 
+  ""1""3""9""10""11""12""13"" .
+ 
+zeileneinfuegen umschalten :
+  zeileneinfuegen := NOT zeileneinfuegen;
+  IF   zeileneinfuegen
+  THEN zeile aufspalten; logisches eof setzen
+  ELSE leere zeile am ende loeschen; logisches eof loeschen
+  FI ; restbild zeigen .
+ 
+zeile aufspalten :
+  IF   stelle <= LENGTH bildsatz OR stelle = 1
+  THEN loesche ggf trennende blanks und spalte zeile
+  FI .
+ 
+loesche ggf trennende blanks und spalte zeile:          (* 26.06.84 -bk- *) 
+  INT VAR first non blank pos := stelle; 
+  WHILE first non blank pos <= length (bildsatz) CAND 
+        (bildsatz SUB first non blank pos) = blank REP 
+    first non blank pos INCR 1 
+  PER ; 
+  split line and indentation;                                        (*sh*)
+  first non blank pos := stelle - 1;
+  WHILE first non blank pos >= 1 CAND
+        (bildsatz SUB first non blank pos) = blank REP 
+    first non blank pos DECR 1 
+  PER;
+  bildsatz := subtext (bildsatz, 1, first non blank pos); 
+  write record (file, bildsatz) .
+ 
+split line and indentation : 
+  split line (file, first non blank pos, TRUE) .
+
+logisches eof setzen :
+  down (file); col (file, 1);
+  set range (file, 1, 1, old range); up (file) .
+ 
+leere zeile am ende loeschen :
+  to line (file, lines (file));
+  IF len (file) = 0 THEN delete record (file) FI;
+  to line (file, satznr) .
+ 
+logisches eof loeschen :
+  col (file, stelle); set range (file, old range) .
+ 
+restbild zeigen :
+  erster neusatz := satznr;
+  letzter neusatz := bildanfang + bildlaenge - 1;
+  rest segment in ueberschrift eintragen;
+  neu (ueberschrift, abschnitt) .
+ 
+rest segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 25, rest segment) .
+ 
+rest segment :
+  IF zeileneinfuegen THEN "REST" ELSE "...." FI .
+
+esc kommando verarbeiten :
+  getchar (bildzeichen);
+  eventuell zeichen zurueckweisen;                      (* 04.05.85 -ws- *)
+  IF   taste ist reserviert
+  THEN belegte taste ausfuehren
+  ELSE fest vordefinierte esc funktion
+  FI ; ende nach quit .
+ 
+eventuell zeichen zurueckweisen :                       (* 04.05.85 -ws- *)
+  IF   NOT write access CAND NOT erlaubte taste
+  THEN benutzer warnen; LEAVE kommando ausfuehren 
+  FI .
+
+erlaubte taste     : pos (zulaessige zeichen, bildzeichen) > 0 . 
+zulaessige zeichen : res + ""1""2""8""27"bfq" . 
+benutzer warnen    : out (piep) . 
+
+ende nach quit :
+  IF max used editor < my highest editor THEN LEAVE bildeditor FI .
+ 
+taste ist reserviert : pos (res, bildzeichen) > 0 .
+ 
+fest vordefinierte esc funktion :
+  read record (file, bildsatz); 
+  SELECT pos (esc kommandos, bildzeichen) OF
+    CASE z hop    : lernmodus umschalten
+    CASE z esc    : kommandodialog versuchen
+    CASE z left   : zum vorigen wort
+    CASE z right  : zum naechsten wort
+    CASE z b      : bild an aktuelle zeile angleichen
+    CASE z f      : belegte taste ausfuehren
+    CASE z rubout : markiertes vorsichtig loeschen
+    CASE z rubin  : vorsichtig geloeschtes einfuegen
+    OTHERWISE     : belegte taste ausfuehren
+  END SELECT .
+ 
+esc kommandos :
+  LET z hop     =  1,                 z right   =  2,
+      z left    =  3,                 z rubin   =  4,
+      z rubout  =  5,                 z esc     =  6,
+      z b       =  7,                 z f       =  8;
+
+  ""1""2""8""11""12""27"bf" .
+ 
+zum vorigen wort :
+  IF   vorgaenger erlaubt
+  THEN vorgaenger; read record (file, bildsatz);
+       stelle := LENGTH bildsatz + 1; push (esc + left)
+  FI .
+ 
+vorgaenger erlaubt :
+  satznr > max (1, bildmarke) .
+
+zum naechsten wort :
+  IF nicht auf letztem satz THEN weitersuchen wenn nicht gefunden FI .
+ 
+nicht auf letztem satz : line no (file) < lines (file) .
+ 
+weitersuchen wenn nicht gefunden :
+  nachfolgenden satz holen;
+  IF   (nachfolgender satz SUB anfang) = blank
+  THEN push (abscr + esc + right)
+  ELSE push (abscr)
+  FI .
+ 
+nachfolgenden satz holen :
+  down (file); read record (file, nachfolgender satz); up (file) .
+ 
+bild an aktuelle zeile angleichen :
+  anfang INCR verschoben; verschoben := 0;
+  margin segment in ueberschrift eintragen;
+  neu (ueberschrift, bild) .
+ 
+margin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 2, margin segment) .
+ 
+margin segment :
+  IF   anfang <= 1
+  THEN "......"
+  ELSE TEXT VAR margin text := "M" + text (anfang);
+       (6 - LENGTH margin text) * "." + margin text
+  FI .
+
+belegte taste ausfuehren :
+  kommando analysieren (bildzeichen, PROC(TEXT CONST) kommando interpreter) .
+ 
+kommandodialog versuchen:
+  IF   fenster ist zu schmal fuer dialog
+  THEN kommandodialog ablehnen
+  ELSE kommandodialog fuehren
+  FI .
+ 
+fenster ist zu schmal fuer dialog : laenge < 20 .
+ 
+kommandodialog ablehnen :
+  fehlertext := "zu schmal fuer ESC ESC"; neu (fehlermeldung, nix) .
+ 
+kommandodialog fuehren:
+  INT VAR x0, x1, x2, x3, y;
+  get cursor (x0, y);
+  cursor (rand + 1, bildrand + zeilennr);
+  get cursor (x1, y);
+  out (begin mark); out (monitor meldung);
+  get cursor (x2, y);
+  (laenge - LENGTH monitor meldung - marklength) TIMESOUT blank;
+  get cursor (x3, y);
+  out (end mark); out (blank);
+  kommandozeile editieren;
+  ueberschrift zeigen;
+  absatz ausgleich := 2;                                             (*sh*)
+  IF kommandotext = "" THEN LEAVE kommandodialog fuehren FI;
+  kommando auf taste legen ("f", kommandotext);
+  kommando analysieren ("f", PROC(TEXT CONST) kommando interpreter);
+  IF   fehlertext <> ""
+  THEN push (esc + esc + esc + "k")
+  ELIF markiert 
+  THEN zeile neu 
+  FI .
+ 
+kommandozeile editieren :
+  TEXT VAR kommandotext := "";
+  cursor (x1, y); out (begin mark);
+  disable stop;
+  darstellung invertieren; 
+  editget schleife;
+  darstellung invertieren; 
+  enable stop;
+  cursor (x3, y); out (end mark);
+  exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
+  cursor (x0, y) .
+ 
+darstellung invertieren :
+  TEXT VAR dummy := begin mark; begin mark := end mark; end mark := dummy;
+  invertierte darstellung := NOT invertierte darstellung .
+ 
+editget schleife :
+  TEXT VAR exit char;
+  REP
+    cursor (x2, y);
+    editget (kommandotext, max textlength, rand + laenge - x cursor,
+             "", "k?!", exit char);
+    neu (ueberschrift, nix);
+    IF   exit char = ""27"k"
+    THEN kommando text := kommando auf taste ("f")
+    ELIF exit char = ""27"?"
+    THEN TEXT VAR taste; getchar (taste);
+         kommando text := kommando auf taste (taste)
+    ELIF exit char = ""27"!"
+    THEN getchar (taste);
+         IF   ist reservierte taste
+         THEN set busy indicator;                                    (*sh*)
+              out ("FEHLER: """ + taste + """ ist reserviert"7"")
+         ELSE kommando auf taste legen (taste, kommandotext);
+              kommandotext := ""; LEAVE editget schleife
+         FI 
+    ELSE LEAVE editget schleife
+    FI
+  PER .
+ 
+ist reservierte taste : pos (res, taste) > 0 .
+monitor meldung       : "gib kommando : " .
+ 
+neue seite : bildanfang := satznr; zeilennr := 1; neu (akt satznr, bild) .
+ 
+weiterblaettern :
+  INT CONST akt bildlaenge := aktuelle bildlaenge;
+  IF   nicht auf letztem satz
+  THEN erster neusatz := satznr;
+       IF   zeilennr >= akt bildlaenge
+       THEN bildanfang INCR akt bildlaenge; neu (akt satznr, bild)
+       FI ;
+       satznr := min (lines (file), bildanfang + akt bildlaenge - 1);
+       letzter neusatz := satznr;
+       toline (file, satznr);
+       stelle DECR verschoben;
+       neu (akt satznr, nix);
+       zeilennr := satznr - bildanfang + 1;
+       IF markiert THEN neu (nix, abschnitt) FI;
+       einrueckposition bestimmen
+  FI .
+ 
+zurueckblaettern :
+  IF   vorgaenger erlaubt
+  THEN IF   zeilennr <= 1
+       THEN bildanfang := max (1, bildanfang - aktuelle bildlaenge);
+            neu (akt satznr, bild)
+       FI ;
+       nach oben; einrueckposition bestimmen
+  FI .
+ 
+zeile loeschen :
+  IF   stelle = 1
+  THEN delete record (file);
+       erster neusatz := satznr;
+       letzter neusatz := bildanfang + bildlaenge - 1;
+       neu (nix, abschnitt)
+  ELSE zeilen rekombinieren
+  FI .
+ 
+zeilen rekombinieren :
+  IF   nicht auf letztem satz
+  THEN aktuellen satz mit blanks auffuellen;
+       delete record (file);
+       nachfolgenden satz lesen;
+       bildsatz CAT nachfolgender satz ohne fuehrende blanks;
+       write record (file, bildsatz);
+       erster neusatz := satznr;
+       letzter neusatz := bildanfang + bildlaenge - 1;
+       neu (nix, abschnitt)
+  FI .
+ 
+aktuellen satz mit blanks auffuellen :
+  bildsatz AUFFUELLENMIT blank .
+ 
+nachfolgenden satz lesen :
+  TEXT VAR nachfolgender satz;
+  read record (file, nachfolgender satz) .
+ 
+nachfolgender satz ohne fuehrende blanks :
+  satzrest := subtext (nachfolgender satz,
+     einrueckposition (nachfolgender satz)); satzrest .
+ 
+zeile aufsplitten :
+  nachfolgender satz := "";
+  INT VAR i;
+  FOR i FROM 2 UPTO min (stelle, einrueckposition (bildsatz)) REP
+    nachfolgender satz CAT blank
+  PER;
+  satzrest := subtext (bildsatz, naechste non blank position);
+  nachfolgender satz CAT satzrest;
+  bildsatz := subtext (bildsatz, 1, stelle - 1);
+  write record (file, bildsatz);
+  down (file); insert record (file);
+  write record (file, nachfolgender satz); up (file) .
+ 
+naechste non blank position :
+  INT VAR non blank pos := stelle;
+  WHILE (bildsatz SUB non blank pos) = blank REP
+    non blank pos INCR 1
+  PER; non blank pos .
+ 
+zum vorigen satz :
+  IF vorgaenger erlaubt THEN vorgaenger; einrueckposition bestimmen FI .
+ 
+zum folgenden satz :                                    (* 12.09.85 -ws- *)
+  IF nachfolger erlaubt THEN nachfolger; einrueckposition bestimmen 
+                        ELSE col (file, len (file) + 1); neu (nix, nix)
+  FI .
+
+einrueckposition bestimmen :                            (* 27.08.85 -ws- *)
+  read record (file, akt bildsatz);
+  INT  VAR neue einrueckposition := einrueckposition (akt bildsatz);
+  IF   akt bildsatz ist leerzeile
+  THEN alte einrueckposition := max (stelle, neue einrueckposition)
+  ELSE alte einrueckposition := min (stelle, neue einrueckposition)
+  FI .
+
+akt bildsatz ist leerzeile :
+  akt bildsatz = "" OR akt bildsatz = blank . 
+
+zum anfang des folgenden satzes :
+  IF nachfolger erlaubt THEN nachfolger; stelle := anfang FI .
+ 
+nachfolger erlaubt :
+  write access COR nicht auf letztem satz .
+ 
+eingerueckt mit cr : 
+  IF NOT nachfolger erlaubt THEN LEAVE eingerueckt mit cr FI;        (*sh*)
+  read record (file, bildsatz); 
+  INT VAR epos := einrueckposition (bildsatz);
+  nachfolger; col (file, 1); 
+  IF   eof (file) 
+  THEN IF   LENGTH bildsatz <= epos 
+       THEN stelle := alte einrueckposition 
+       ELSE stelle := epos 
+       FI 
+  ELSE read record (file, bildsatz); 
+       stelle := einrueckposition (bildsatz); 
+       IF   bildsatz ist leerzeile                     (* 29.08.85 -ws- *)
+       THEN stelle := alte einrueckposition;
+            aktuellen satz mit blanks auffuellen
+       FI
+  FI ; 
+  alte einrueckposition := stelle . 
+ 
+bildsatz ist leerzeile :
+  bildsatz = "" OR bildsatz = blank . 
+
+eingerueckt zum folgenden satz :                                     (*sh*)
+  IF NOT nachfolger erlaubt OR NOT write access
+    THEN LEAVE eingerueckt zum folgenden satz
+  FI; 
+  alte einrueckposition merken; 
+  naechsten satz holen; 
+  neue einrueckposition bestimmen; 
+  alte einrueckposition := stelle . 
+ 
+alte einrueckposition merken : 
+  read record (file, bildsatz);
+  epos := einrueckposition (bildsatz);
+  auf aufzaehlung pruefen;
+  IF epos > LENGTH bildsatz THEN epos := anfang FI.
+ 
+auf aufzaehlung pruefen :
+  BOOL CONST aufzaehlung gefunden :=
+       ist aufzaehlung CAND vorher absatzzeile CAND wort folgt;
+  IF   aufzaehlung gefunden THEN epos := anfang des naechsten wortes FI .
+
+ist aufzaehlung :
+  INT CONST wortende := pos (bildsatz, blank, epos, epos + 20) - 1;
+  SELECT pos ("-*).:" , bildsatz SUB wortende) OF
+    CASE 1,2 : wortende =  epos 
+    CASE 3,4 : wortende <= epos + 7
+    CASE 5   : TRUE
+    OTHERWISE: FALSE
+  ENDSELECT .
+ 
+vorher absatzzeile :
+  IF   satznr = 1
+  THEN TRUE
+  ELSE up (file);
+       INT  CONST vorige satzlaenge := len (file);
+       BOOL CONST vorher war absatzzeile :=
+       subtext (file, vorige satzlaenge, vorige satzlaenge) = blank;
+       down (file); vorher war absatzzeile
+  FI .
+ 
+wort folgt : 
+  INT CONST anfang des naechsten wortes :=
+  pos (bildsatz, ""33"", ""254"", wortende + 1); 
+  anfang des naechsten wortes > wortende .
+ 
+naechsten satz holen : 
+  nachfolger; col (file, 1);
+  IF   eof (file) 
+  THEN bildsatz := ""
+  ELSE IF   neue zeile einfuegen erforderlich 
+       THEN insert record (file); bildsatz := ""; 
+            letzter neusatz := bildanfang + bildlaenge - 1 
+       ELSE read record (file, bildsatz);
+            letzter neusatz := satznr;
+            ggf trennungen zurueckwandeln und umbruch indikator einfuegen 
+       FI ;
+       erster neusatz := satznr;
+       neu (nix, abschnitt)
+  FI . 
+ 
+neue zeile einfuegen erforderlich :
+  BOOL CONST war absatz := war absatzzeile;
+  war absatz COR neuer satz ist zu lang .
+ 
+war absatzzeile : 
+  INT VAR wl := pos (kommando, up backcr, kommando zeiger); 
+  wl = 0 COR (kommando SUB (wl - 1)) = blank . 
+ 
+neuer satz ist zu lang : laenge des neuen satzes >= limit .
+
+laenge des neuen satzes : 
+  IF   len (file) > 0 
+  THEN len (file) + wl 
+  ELSE wl + epos 
+  FI . 
+ 
+up backcr : ""3""20"" .
+ 
+ggf trennungen zurueckwandeln und umbruch indikator einfuegen :
+  LET trenn k      = ""220"",
+      trenn strich = ""221"";
+  TEXT VAR umbruch indikator;
+  IF   letztes zeichen ist trenn strich
+  THEN entferne trenn strich;
+       IF   letztes zeichen = trenn k
+       THEN wandle trenn k um
+       FI ;
+       umbruch indikator := up backcr 
+  ELIF letztes umgebrochenes zeichen ist kanji 
+  THEN umbruch indikator := up backcr
+  ELSE umbruch indikator := blank + up backcr
+  FI ;
+  change (kommando, wl, wl+1, umbruch indikator) . 
+ 
+letztes umgebrochenes zeichen ist kanji : within kanji (kommando, wl-1) .
+ 
+letztes zeichen ist trenn strich :
+  TEXT CONST last char := letztes zeichen;
+  last char = trenn strich COR
+  last char = "-" CAND wl > 2 CAND (kommando SUB (wl-2)) <> blank .
+ 
+letztes zeichen       : kommando SUB (wl-1) .
+entferne trenn strich : delete char (kommando, wl-1); wl DECR 1 .
+wandle trenn k um     : replace (kommando, wl-1, "c") .
+loesche indikator     : delete char (kommando, wl) . 
+ 
+neue einrueckposition bestimmen : 
+  IF   aufzaehlung gefunden CAND bildsatz ist leerzeile 
+  THEN stelle := epos
+  ELIF NOT bildsatz ist leerzeile  
+  THEN stelle := einrueckposition (bildsatz)
+  ELIF war absatz COR auf letztem satz
+  THEN stelle := epos
+  ELSE down (file); read record (file, nachfolgender satz);
+       up   (file); stelle := einrueckposition (nachfolgender satz)
+  FI ; 
+  IF   ist einfuegender aber nicht induzierter umbruch 
+  THEN loesche indikator;
+       umbruchstelle := stelle + wl - kommando zeiger - anzahl der stz;
+       umbruchverschoben := 0
+  FI . 
+ 
+auf letztem satz : NOT nicht auf letztem satz .
+
+ist einfuegender aber nicht induzierter umbruch :
+  wl := pos (kommando, backcr, kommando zeiger); 
+  wl > 0 CAND (kommando SUB (wl - 1)) <> up char . 
+ 
+anzahl der stz : 
+  TEXT CONST umgebrochener anfang := subtext (kommando, kommando zeiger, wl-1); 
+  INT VAR anz := 0, anf := pos (umgebrochener anfang, ""1"", ""31"", 1);
+  WHILE anf > 0 REP 
+    anz INCR 1; anf := pos (umgebrochener anfang, ""1"", ""31"", anf + 1) 
+  PER; anz .
+ 
+markiertes vorsichtig loeschen :
+  IF   write access CAND markiert
+  THEN clear removed (file);
+       IF   nur im satz markiert
+       THEN behandle einen satz
+       ELSE behandle mehrere saetze
+       FI
+  FI .
+ 
+nur im satz markiert : line no (file) = bildmarke .
+ 
+behandle einen satz :
+  insert record (file);
+  satzrest := subtext (bildsatz, marke, stelle - 1);
+  write record (file, satzrest);
+  remove (file, 1);
+  change (bildsatz, marke, stelle - 1, "");
+  stelle := marke;
+  marke := 0; bildmarke := 0; feldmarke := 0;
+  markiert := FALSE; mark (file, 0, 0);
+  konstanten neu berechnen;
+  IF   bildsatz = ""
+  THEN delete record (file);
+       erster neusatz := satznr;
+       letzter neusatz := bildanfang + bildlaenge - 1;
+       neu (nix, abschnitt)
+  ELSE write record (file, bildsatz);
+       neu (nix, bildzeile)
+  FI .
+ 
+behandle mehrere saetze :
+  erster neusatz := bildmarke;
+  letzter neusatz := bildanfang + bildlaenge - 1;
+  zeile an aktueller stelle auftrennen;
+  ersten markierten satz an markieranfang aufspalten;
+  markierten bereich entfernen;
+  bild anpassen .
+ 
+zeile an aktueller stelle auftrennen :
+  INT VAR markierte saetze := line no (file) - bildmarke + 1;
+  IF   nicht am ende der zeile
+  THEN IF   nicht am anfang der zeile
+       THEN zeile aufsplitten
+       ELSE up (file); markierte saetze DECR 1
+       FI
+  FI .
+ 
+nicht am anfang der zeile : stelle > 1 .
+nicht am ende der zeile   : stelle <= LENGTH bildsatz .
+ 
+ersten markierten satz an markieranfang aufspalten :
+  to line (file, line no (file) - (markierte saetze - 1));
+  read record (file, bildsatz);
+  stelle := feldmarke;
+  IF   nicht am anfang der zeile
+  THEN IF   nicht am ende der zeile 
+       THEN zeile aufsplitten
+       ELSE markierte saetze DECR 1
+       FI ;
+       to line (file, line no (file) + markierte saetze)
+  ELSE to line (file, line no (file) + markierte saetze - 1)
+  FI ;
+  read record (file, bildsatz) .
+ 
+markierten bereich entfernen :
+  zeilen nr := line no (file) - markierte saetze - bildanfang + 2;
+  remove (file, markierte saetze);
+  marke := 0; bildmarke := 0; feldmarke := 0;
+  markiert := FALSE; mark (file, 0, 0); 
+  konstanten neu berechnen;
+  stelle := 1 .
+ 
+bild anpassen :
+  satz nr := line no (file);
+  IF   zeilen nr <= 1
+  THEN bildanfang := line no (file); zeilen nr := 1;
+       neu (akt satznr, bild)
+  ELSE neu (akt satznr, abschnitt)
+  FI . 
+ 
+vorsichtig geloeschtes einfuegen :
+  IF   NOT write access OR removed lines (file) = 0
+  THEN LEAVE vorsichtig geloeschtes einfuegen
+  FI ;
+  IF   nur ein satz
+  THEN in aktuellen satz einfuegen
+  ELSE aktuellen satz aufbrechen und einfuegen
+  FI .
+ 
+nur ein satz : removed lines (file) = 1 .
+ 
+in aktuellen satz einfuegen :
+  reinsert (file);
+  read record (file, nachfolgender satz);
+  delete record (file);
+  TEXT VAR t := bildsatz;
+  bildsatz := subtext (t, 1, stelle - 1);
+  aktuellen satz mit blanks auffuellen;                              (*sh*)
+  bildsatz CAT nachfolgender satz;
+  satzrest := subtext (t, stelle);
+  bildsatz CAT satzrest;
+  write record (file, bildsatz);
+  stelle INCR LENGTH nachfolgender satz;
+  neu (nix, bildzeile) .
+ 
+aktuellen satz aufbrechen und einfuegen :
+  INT CONST alter bildanfang := bildanfang;
+  old lineno := satznr;
+  IF   stelle = 1
+  THEN reinsert (file);
+       read record (file, bildsatz)
+  ELIF stelle > LENGTH bildsatz
+  THEN down (file);
+       reinsert (file);
+       read record (file, bildsatz)
+  ELSE INT VAR von := stelle;
+       WHILE (bildsatz SUB von) = blank REP von INCR 1 PER;
+       satzrest := subtext (bildsatz, von, LENGTH bildsatz);
+       INT VAR bis := stelle - 1;
+       WHILE (bildsatz SUB bis) = blank REP bis DECR 1 PER;
+       bildsatz := subtext (bildsatz, 1, bis);
+       write record (file, bildsatz);
+       down (file);
+       reinsert (file);
+       read record (file, bildsatz);
+       nachfolgender satz := einrueckposition (bildsatz) * blank;
+       nachfolgender satz CAT satzrest;
+       down (file); insert record (file);
+       write record (file, nachfolgender satz); up (file)
+  FI ;
+  stelle := max (1, LENGTH bildsatz);                   (* 22.06.84 -bk- *)
+  satz nr := line no (file);
+  zeilennr INCR satznr - old lineno;
+  zeilennr := min (zeilennr, aktuelle bildlaenge);
+  bildanfang := satznr - zeilennr + 1;
+  IF   bildanfang veraendert 
+  THEN abschnitt neu (bildanfang, 9999) 
+  ELSE abschnitt neu (old lineno, 9999) 
+  FI ;
+  neu (akt satznr, nix).
+ 
+bildanfang veraendert : bildanfang <> alter bildanfang . 
+ 
+lernmodus umschalten :
+  learn segment in ueberschrift eintragen; neu (ueberschrift, nix) .
+ 
+learn segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 19, learn segment) .
+ 
+learn segment :
+  IF lernmodus THEN "LEARN" ELSE "....." FI .
+ 
+markierung umschalten :
+  IF markiert THEN markierung ausschalten ELSE markierung einschalten FI .
+ 
+markierung einschalten :
+  bildmarke := satznr; feldmarke := marke; markiert := TRUE;
+  mark (file, bildmarke, feldmarke);
+  neu (nix, bildzeile) .
+ 
+markierung ausschalten :
+  erster neusatz := max (bildmarke, bildanfang);
+  letzter neusatz := satznr;
+  bildmarke := 0; feldmarke := 0; markiert := FALSE;
+  mark (file, 0, 0);
+  IF   erster neusatz = letzter neusatz
+  THEN neu (nix, bildzeile)
+  ELSE neu (nix, abschnitt)
+  FI .
+END PROC bildeditor;
+ 
+PROC neu (INT CONST ue bereich, b bereich) :
+  ueberschriftbereich := max (ueberschriftbereich, ue bereich);
+  bildbereich := max (bildbereich, b bereich)
+END PROC neu;
+ 
+ 
+PROC nach oben :
+  letzter neusatz := satznr;
+  satznr := max (bildanfang, bildmarke);
+  toline (file, satznr);
+  stelle DECR verschoben;
+  zeilennr := satznr - bildanfang + 1;
+  erster neusatz := satznr;
+  IF   markiert
+  THEN neu (akt satznr, abschnitt)
+  ELSE neu (akt satznr, nix)
+  FI
+END PROC nach oben;
+ 
+INT PROC aktuelle bildlaenge :
+  IF stelle - stelle am anfang < kurze feldlaenge
+    AND feldlaenge > 0
+  THEN bildlaenge                                                    (*wk*)
+  ELSE kurze bildlaenge
+  FI
+END PROC aktuelle bildlaenge;
+ 
+PROC vorgaenger :
+  up (file); satznr DECR 1;
+  marke := 0; stelle DECR verschoben;
+  IF   zeilennr = 1
+  THEN bildanfang DECR 1; neu (ueberschrift, bild)
+  ELSE zeilennr DECR 1; neu (akt satznr, nix);                       (*sh*)
+       IF markiert THEN neu (nix, bildzeile) FI
+  FI 
+END PROC vorgaenger;
+ 
+PROC nachfolger :
+  down (file); satznr INCR 1;
+  stelle DECR verschoben;
+  IF   zeilennr = aktuelle bildlaenge
+  THEN bildanfang INCR 1;
+       IF   rollup erlaubt
+       THEN rollup
+       ELSE neu (ueberschrift, bild)
+       FI
+  ELSE neu (akt satznr, nix); zeilennr INCR 1                        (*sh*)
+  FI ;
+  IF   markiert THEN neu (nix, bildzeile) FI .
+ 
+rollup erlaubt :
+  kurze bildlaenge = maxlaenge AND kurze feldlaenge = maxbreite .
+ 
+rollup :
+  out (down char);
+  IF   bildzeichen = inscr
+  THEN neu (ueberschrift, nix)
+  ELIF is cr or down CAND (write access COR nicht auf letztem satz)  (*sh*)
+  THEN neu (nix, bildzeile)
+  ELSE neu (ueberschrift, bildzeile)
+  FI .
+ 
+is cr or down :
+  IF kommando = "" THEN kommando := inchety FI;
+  kommando char = down char COR kommando char = cr .
+ 
+kommando char : kommando SUB kommando zeiger .
+
+nicht auf letztem satz : line no (file) < lines (file) . 
+END PROC nachfolger;
+ 
+BOOL PROC next incharety is (TEXT CONST muster) :
+  INT CONST klen := LENGTH kommando - kommando zeiger + 1,
+            mlen := LENGTH muster;
+  INT VAR i; FOR i FROM 1 UPTO mlen - klen REP kommando CAT inchety PER;
+  subtext (kommando, kommando zeiger, kommando zeiger + mlen - 1) = muster
+END PROC next incharety is;
+ 
+PROC quit last:                                         (* 22.06.84 -bk- *) 
+  IF   actual editor > 0 AND actual editor < max used editor 
+  THEN verlasse alle groesseren editoren 
+  FI . 
+ 
+verlasse alle groesseren editoren : 
+  open editor (actual editor + 1); quit .
+END PROC quit last; 
+ 
+PROC quit : 
+  IF actual editor > 0 THEN verlasse aktuellen editor FI .
+ 
+verlasse aktuellen editor :
+  disable stop;
+  INT CONST aktueller editor := actual editor;
+  in innersten editor gehen; 
+  REP 
+    IF zeileneinfuegen THEN hop rubin simulieren FI;
+    ggf bildschirmdarstellung korrigieren;
+    innersten editor schliessen 
+  UNTIL aktueller editor > max used editor PER; 
+  actual editor := max used editor . 
+ 
+in innersten editor gehen : open editor (max used editor) . 
+ 
+hop rubin simulieren : 
+  zeileneinfuegen := FALSE; 
+  leere zeilen am dateiende loeschen;                                (*sh*)
+  ggf bildschirmdarstellung korrigieren;
+  logisches eof loeschen . 
+ 
+innersten editor schliessen : 
+  max used editor DECR 1; 
+  IF   max used editor > 0 
+  THEN open editor (max used editor);
+       bildeinschraenkung aufheben 
+  FI . 
+ 
+logisches eof loeschen :
+  col (file, stelle); set range (file, old range) .
+ 
+leere zeilen am dateiende loeschen :                    (* 15.08.85 -ws- *)
+  satz nr := line no (file) ; 
+  to line (file, lines (file)) ;
+  WHILE lines (file) > 1 AND bildsatz ist leerzeile REP 
+    delete record (file); 
+    to line (file, lines (file)) 
+  PER;
+  toline (file, satznr) .
+
+bildsatz ist leerzeile :
+  TEXT VAR bildsatz;
+  read record (file, bildsatz);
+  ist leerzeile .
+
+ist leerzeile :
+  bildsatz = "" OR bildsatz = blank . 
+
+ggf bildschirmdarstellung korrigieren :
+  satz nr DECR 1;                             (* für Bildschirmkorrektur *)
+  IF   satznr > lines (file)
+  THEN zeilen nr DECR satz nr - lines (file);
+       satz nr := lines (file); 
+       dateizustand retten
+  FI . 
+
+bildeinschraenkung aufheben :
+  laenge := feldlaenge;
+  kurze feldlaenge := feldlaenge;
+  kurze bildlaenge := bildlaenge;
+  neu (nix, bild) .
+END PROC quit;
+ 
+PROC nichts neu       : neu (nix,          nix)  END PROC nichts neu;
+ 
+PROC satznr neu       : neu (akt satznr,   nix)  END PROC satznr neu;
+ 
+PROC ueberschrift neu : neu (ueberschrift, nix)  END PROC ueberschrift neu;
+ 
+PROC zeile neu :
+  INT CONST zeile := line no (file);
+  abschnitt neu (zeile, zeile)
+END PROC zeile neu;
+ 
+PROC abschnitt neu (INT CONST von satznr, bis satznr) :
+  IF   von satznr <= bis satznr
+  THEN erster neusatz  := min (erster neusatz, von satznr);
+       letzter neusatz := max (letzter neusatz, bis satznr);
+       neu (nix, abschnitt)
+  ELSE abschnitt neu (bis satznr, von satznr) 
+  FI
+END PROC abschnitt neu;
+ 
+PROC bildabschnitt neu (INT CONST von zeile, bis zeile) :            (*sh*)
+  IF   von zeile <= bis zeile 
+  THEN erster neusatz  := max (1, von zeile + bildanfang - 1); 
+       letzter neusatz := min (bildlaenge, bis zeile + bildanfang - 1); 
+       IF   von zeile < 1
+       THEN neu (ueberschrift, abschnitt)
+       ELSE neu (nix         , abschnitt) 
+       FI
+  ELSE bildabschnitt neu (bis zeile, von zeile) 
+  FI 
+END PROC bildabschnitt neu; 
+ 
+PROC bild neu : neu (nix, bild) END PROC bild neu;                   (*sh*)
+ 
+PROC bild neu (FILE VAR f) :
+  INT CONST editor no := abs (editinfo (f)) DIV 256;
+  IF   editor no > 0 AND editor no <= max used editor
+  THEN IF   editor no = actual editor
+       THEN bild neu
+       ELSE editstack (editor no).bildstatus.bildbereich := bild
+       FI
+  FI
+END PROC bild neu; 
+ 
+PROC alles neu :
+  neu (ueberschrift, bild);
+  INT VAR i;
+  FOR i FROM 1 UPTO max used editor REP
+    editstack (i).bildstatus.bildbereich := bild;
+    editstack (i).bildstatus.ueberschriftbereich := ueberschrift
+  PER
+END PROC alles neu;
+ 
+PROC satznr zeigen :
+  out (satznr pre); out (text (text (lineno (file)), 4))
+END PROC satznr zeigen;
+ 
+PROC ueberschrift zeigen :
+  SELECT ueberschriftbereich OF
+    CASE akt satznr    : satznr zeigen;
+                         ueberschriftbereich := nix
+    CASE ueberschrift  : ueberschrift schreiben;
+                         ueberschriftbereich := nix
+    CASE fehlermeldung : fehlermeldung schreiben;
+                         ueberschriftbereich := ueberschrift
+  END SELECT
+END PROC ueberschrift zeigen;
+ 
+PROC fenster zeigen :
+  SELECT bildbereich OF
+    CASE bildzeile :
+         zeile := bildrand + zeilennr;
+         IF   line no (file) > lines (file)
+         THEN feldout ("", stelle)
+         ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle)
+         FI
+    CASE abschnitt :
+         bild ausgeben
+    CASE bild :
+         erster neusatz := 1;
+         letzter neusatz := 9999;
+         bild ausgeben
+    OTHERWISE :
+         LEAVE fenster zeigen
+  END SELECT;
+  erster neusatz := 9999;
+  letzter neusatz := 0;
+  bildbereich := nix 
+END PROC fenster zeigen ;
+ 
+PROC bild ausgeben :
+  BOOL CONST schreiben ist ganz einfach := NOT markiert AND verschoben = 0;
+  INT  CONST save marke := marke,
+             save verschoben := verschoben,
+             save laenge := laenge,
+             act lineno := lineno (file),
+             von := max (1, erster neusatz - bildanfang + 1);
+  INT   VAR  bis := min (letzter neusatz - bildanfang + 1, bildlaenge);
+  IF kurze feldlaenge <= 0 THEN bis := min (bis, kurze bildlaenge) FI;
+  IF von > bis THEN LEAVE bild ausgeben FI;
+  verschoben := 0;
+  IF   markiert
+  THEN IF   mark lineno (file) < bildanfang + von - 1
+       THEN marke := anfang
+       ELSE marke := 0
+       FI
+  FI ;
+  abschnitt loeschen und neuschreiben;
+  to line (file, act lineno);
+  laenge := save laenge;
+  verschoben := save verschoben;
+  marke := save marke .
+ 
+markiert : mark lineno (file) > 0 .
+ 
+abschnitt loeschen und neuschreiben :
+  abschnitt loeschen;
+  INT VAR line number := bildanfang + von - 1;
+  to line (file, line number);
+  abschnitt schreiben .
+ 
+abschnitt loeschen :
+  cursor (rand + 1, bildrand + von);
+  IF   bildrest darf komplett geloescht werden
+  THEN out (clear eop)
+  ELSE zeilenweise loeschen
+  FI .
+ 
+bildrest darf komplett geloescht werden :
+  bis = maxlaenge AND kurze bildlaenge = maxlaenge
+                  AND kurze feldlaenge = maxbreite .
+ 
+zeilenweise loeschen :
+  INT VAR i;
+  FOR i FROM von UPTO bis REP
+    check for interrupt;
+    feldlaenge einstellen;
+    feldrest loeschen;
+    IF i < bis THEN out (down char) FI
+  PER .
+ 
+feldlaenge einstellen :
+  IF   ganze zeile sichtbar
+  THEN laenge := feldlaenge
+  ELSE laenge := kurze feldlaenge
+  FI .
+ 
+ganze zeile sichtbar : i <= kurze bildlaenge .
+ 
+abschnitt schreiben :
+  INT CONST last line := lines (file);
+  FOR i FROM von UPTO bis
+  WHILE line number <= last line REP
+    check for interrupt;
+    feldlaenge einstellen;
+    zeile schreiben;
+    down (file);
+    line number INCR 1
+  PER .
+ 
+check for interrupt :
+  kommando CAT inchety;
+  IF   kommando <> "" 
+  THEN IF   zeilen nr = 1 CAND up command CAND vorgaenger erlaubt
+       THEN LEAVE abschnitt loeschen und neuschreiben
+       ELIF zeilen nr = bildlaenge CAND down command CAND nicht letzter satz
+       THEN LEAVE abschnitt loeschen und neuschreiben
+       FI
+  FI .
+ 
+vorgaenger erlaubt :
+  satznr > max (1, bildmarke) .
+
+up command : next incharety is (""3"") COR next incharety is (""1""3"") .
+ 
+down command :
+  next incharety is (""10"") CAND bildlaenge < maxlaenge
+  COR next incharety is (""1""10"") .
+ 
+nicht letzter satz : act lineno < lines (file) .
+ 
+zeile schreiben :
+  zeile := bildrand + i;
+  IF   schreiben ist ganz einfach
+  THEN exec (PROC (TEXT CONST, INT CONST) simple feldout, file, 0)
+  ELSE zeile kompliziert schreiben
+  FI ;
+  IF   line number = old lineno THEN old line update := FALSE FI .
+ 
+zeile kompliziert schreiben :
+  IF   line number = mark lineno (file) THEN marke := mark col (file) FI;
+  IF   line number = act lineno
+  THEN verschoben := save verschoben; 
+       exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
+       verschoben := 0; marke := 0
+  ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, 0);
+       IF line number = mark lineno (file) THEN marke := anfang FI
+  FI .
+END PROC bild ausgeben;
+ 
+PROC bild zeigen :                                                   (* wk *)
+
+  dateizustand holen ;
+  ueberschrift zeigen ;
+  bildausgabe steuern ;
+  bild neu ;
+  fenster zeigen ;
+  oldline no := satznr ;
+  old line update := FALSE ;
+  old satz := "" ;
+  old zeilennr := satznr - bildanfang + 1 ;
+  dateizustand retten .
+
+ENDPROC bild zeigen ;
+
+PROC ueberschrift initialisieren :                                   (*sh*)
+  satznr pre  :=
+       cursor pos + code (bildrand - 1) + code (rand + feldlaenge - 6);
+  ueberschrift pre :=
+       cursor pos + code (bildrand - 1) + code (rand) + mark anf; 
+  ueberschrift text := ""; INT VAR i;
+  FOR i FROM 16 UPTO feldlaenge REP ueberschrift text CAT "." PER;
+  ueberschrift post :=  blank + mark end + "Zeile     " + mark anf; 
+  ueberschrift post CAT blank + mark end + "  ";
+  filename := headline (file);
+  filename := subtext (filename, 1, feldlaenge - 24);
+  insert char (filename, blank, 1); filename CAT blank;
+  replace (ueberschrift text, filenamepos, filename);
+  rubin segment in ueberschrift eintragen;
+  margin segment in ueberschrift eintragen;
+  rest segment in ueberschrift eintragen;
+  learn segment in ueberschrift eintragen .
+ 
+filenamepos    : (LENGTH ueberschrift text - LENGTH filename + 3) DIV 2 .
+mark anf       : begin mark + mark ausgleich. 
+mark end       :  end  mark + mark ausgleich.
+mark ausgleich : (1 - sign (max (mark size, 0))) * blank .
+
+rubin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 9, rubin segment) .
+ 
+rubin segment :
+  IF einfuegen THEN "RUBIN" ELSE "....." FI .
+
+margin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 2, margin segment) .
+ 
+margin segment :
+  IF   anfang <= 1
+  THEN "......"
+  ELSE TEXT VAR margin text := "M" + text (anfang);
+       (6 - LENGTH margin text) * "." + margin text
+  FI .
+
+rest segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 25, rest segment) .
+ 
+rest segment :
+  IF zeileneinfuegen THEN "REST" ELSE "...." FI .
+
+learn segment in ueberschrift eintragen :
+  replace (ueberschrift text, feldlaenge - 19, learn segment) .
+ 
+learn segment :
+  IF lernmodus THEN "LEARN" ELSE "....." FI .
+ 
+END PROC ueberschrift initialisieren;
+ 
+PROC ueberschrift schreiben :
+  replace (ueberschrift post, satznr pos, text (text (lineno (file)), 4));
+  out (ueberschrift pre); out (ueberschrift text); out (ueberschrift post);
+  get tabs (file, tab);
+  IF   pos (tab, dach) > 0
+  THEN out (ueberschrift pre);
+       out subtext (tab, anfang + 1, anfang + feldlaenge - 1);
+       cursor (rand + 1 + feldlaenge, bildrand); out (end mark)
+  FI .
+
+  satznr pos : IF mark size > 0 THEN 9 ELSE 10 FI .                  (*sh*)
+END PROC ueberschrift schreiben;
+ 
+PROC fehlermeldung schreiben :
+  ueberschrift schreiben;
+  out (ueberschrift pre);
+  out ("FEHLER: ");
+  out subtext (fehlertext, 1, feldlaenge - 21);
+  out (blank);
+  out (piep);
+  cursor (rand + 1 + feldlaenge, bildrand); out (end mark)
+END PROC fehlermeldung schreiben;
+ 
+PROC set busy indicator : 
+  cursor (rand + 2, bildrand) 
+END PROC set busy indicator; 
+ 
+PROC kommando analysieren (TEXT CONST taste,
+                           PROC (TEXT CONST) kommando interpreter) :
+  disable stop;
+  bildausgabe normieren;
+  zustand in datei sichern;
+  editfile modus setzen;
+  kommando interpreter (taste);
+  editfile modus zuruecksetzen;
+  IF actual editor <= 0 THEN LEAVE kommando analysieren FI;
+  absatz ausgleich := 2;                                             (*sh*)
+  konstanten neu berechnen;
+  neues bild bei undefinierter benutzeraktion;
+  evtl fehler behandeln;
+  zustand aus datei holen; 
+  bildausgabe steuern . 
+ 
+editfile modus setzen :
+  BOOL VAR alter editget modus := editget modus ;
+  editget modus := FALSE .
+
+editfile modus zuruecksetzen :
+  editget modus := alter editget modus .
+
+evtl fehler behandeln :
+  IF   is error
+  THEN fehlertext := errormessage;
+       IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI;
+       clear error
+  ELSE fehlertext := ""
+  FI .
+ 
+zustand in datei sichern :
+  old zeilennr := zeilennr;
+  old mark lineno := bildmarke;
+  dateizustand retten .
+ 
+zustand aus datei holen :
+  dateizustand holen;
+  IF   letzer editor auf dieser datei <> actual editor
+  THEN zurueck auf alte position; neu (ueberschrift, bild) 
+  FI .
+ 
+zurueck auf alte position :
+  to line (file, old lineno);
+  col (file, alte stelle);
+  IF   fliesstext
+  THEN editinfo (file,   old zeilennr)
+  ELSE editinfo (file, - old zeilennr)
+  FI ; dateizustand holen .
+ 
+bildausgabe normieren :
+  bildbereich := undefinierter bereich;
+  erster neusatz := 9999;
+  letzter neusatz := 0 .
+ 
+neues bild bei undefinierter benutzeraktion :
+  IF bildbereich = undefinierter bereich THEN alles neu FI .
+END PROC kommando analysieren;
+ 
+PROC bildausgabe steuern :
+  IF   markiert
+  THEN IF   old mark lineno = 0
+       THEN abschnitt neu (bildmarke, satznr);
+            konstanten neu berechnen
+       ELIF stelle veraendert                                        (*sh*)
+       THEN zeile neu 
+       FI
+  ELIF old mark lineno > 0
+  THEN abschnitt neu (old mark lineno, (max (satznr, old lineno)));
+       konstanten neu berechnen
+  FI ;
+  IF   satznr <> old lineno
+  THEN neu (akt satznr, nix);
+       neuen bildaufbau bestimmen
+  ELSE zeilennr := old zeilennr 
+  FI ;
+  zeilennr := min (min (zeilennr, satznr), aktuelle bildlaenge);
+  bildanfang := satznr - zeilennr + 1 .
+
+stelle veraendert : stelle <> alte stelle . 
+
+neuen bildaufbau bestimmen :
+  zeilennr := old zeilennr + satznr - old lineno;
+  IF   1 <= zeilennr AND zeilennr <= aktuelle bildlaenge
+  THEN im fenster springen
+  ELSE bild neu aufbauen
+  FI .
+ 
+im fenster springen : 
+  IF markiert THEN abschnitt neu (old lineno, satznr) FI .
+ 
+bild neu aufbauen :
+  neu (nix, bild); zeilennr := max (1, aktuelle bildlaenge DIV 2) .
+END PROC bildausgabe steuern;
+
+PROC word wrap (BOOL CONST b) :
+  IF   actual editor = 0
+  THEN std fliesstext := b
+  ELSE fliesstext in datei setzen
+  FI .
+ 
+fliesstext in datei setzen :
+  fliesstext := b;
+  IF fliesstext veraendert THEN editinfo (file, - editinfo (file)) FI;
+  neu (ueberschrift, bild) .
+ 
+fliesstext veraendert :
+  fliesstext AND editinfo (file) < 0 OR
+  NOT fliesstext AND editinfo (file) > 0 .
+END PROC word wrap;
+ 
+BOOL PROC word wrap :                                                (*sh*)
+  IF   actual editor = 0
+  THEN std fliesstext 
+  ELSE fliesstext 
+  FI 
+END PROC word wrap;
+
+INT PROC margin :   anfang   END PROC margin;
+ 
+PROC margin (INT CONST i) :                                          (*sh*)
+  IF   anfang <> i CAND i > 0 AND i < 16001 
+  THEN anfang := i; neu (ueberschrift, bild);
+       margin segment in ueberschrift eintragen
+  ELSE IF i >= 16001 OR i < 0
+         THEN errorstop ("ungueltige Anfangsposition (1 - 16000)")
+       FI
+  FI .
+
+margin segment in ueberschrift eintragen :
+  replace (ueberschrift text, 2, margin segment) .
+ 
+margin segment :
+  IF   anfang <= 1
+  THEN "......"
+  ELSE TEXT VAR margin text := "M" + text (anfang);
+       (6 - LENGTH margin text) * "." + margin text
+  FI .
+
+END PROC margin;
+ 
+BOOL PROC rubin mode :   rubin mode (actual editor)   END PROC rubin mode;
+
+BOOL PROC rubin mode (INT CONST editor nr) :                         (*sh*)
+  IF   editor nr < 1 OR editor nr > max used editor
+  THEN errorstop ("Editor nicht eroeffnet")
+  FI ;
+  IF   editor nr = actual editor
+  THEN einfuegen
+  ELSE editstack (editor nr).feldstatus.einfuegen 
+  FI
+END PROC rubin mode;
+
+PROC edit (INT CONST i, TEXT CONST res,
+           PROC (TEXT CONST) kommando interpreter) :
+  edit (i, i, i, res, PROC (TEXT CONST) kommando interpreter)
+END PROC edit;
+ 
+PROC edit (INT CONST von, bis, start, TEXT CONST res,
+           PROC (TEXT CONST) kommando interpreter) :
+  disable stop;
+  IF   von < bis
+  THEN edit (von+1, bis, start, res, PROC (TEXT CONST) kommando interpreter);
+       IF max used editor < von THEN LEAVE edit FI;
+       open editor (von)
+  ELSE open editor (start)
+  FI ;
+  absatz ausgleich := 2;
+  bildeditor (res, PROC (TEXT CONST) kommando interpreter);
+  cursor (1, schirmhoehe);
+  IF   is error
+  THEN kommando zeiger := 1; kommando := ""; quit
+  FI ;
+  IF   lernmodus CAND actual editor = 0 THEN warnung ausgeben FI .   (*sh*)
+
+  warnung ausgeben : 
+    out (clear eop); out ("WARNUNG: Lernmodus nicht ausgeschaltet"13""10"") .
+END PROC edit;
+ 
+PROC dateizustand holen :
+  modify (file);
+  get tabs (file, tabulator);
+  zeilennr und fliesstext und letzter editor aus editinfo decodieren;
+  limit := max line length (file);
+  stelle := col (file);
+  markiert := mark (file);
+  IF   markiert
+  THEN markierung holen
+  ELSE keine markierung
+  FI ;
+  satz nr := lineno (file);
+  IF   zeilennr > aktuelle bildlaenge                                (*sh*)
+  THEN zeilennr := min (satznr, aktuelle bildlaenge); bild neu
+  ELIF zeilennr > satznr
+  THEN zeilennr := min (satznr, aktuelle bildlaenge)
+  FI ; zeilennr := max (zeilennr, 1);
+  bildanfang := satz nr - zeilennr + 1 .
+ 
+zeilennr und fliesstext und letzter editor aus editinfo decodieren :
+  zeilennr := edit info (file);
+  IF   zeilennr = 0
+  THEN zeilennr := 1;
+       fliesstext := std fliesstext
+  ELIF zeilennr > 0
+  THEN fliesstext := TRUE
+  ELSE zeilennr := - zeilennr;
+       fliesstext := FALSE
+  FI ;
+  letzer editor auf dieser datei := zeilennr DIV 256;
+  zeilennr := zeilennr MOD 256 .
+ 
+markierung holen :
+  bildmarke := mark lineno (file);
+  feldmarke := mark col (file);
+  IF   line no (file) <= bildmarke
+  THEN to line (file, bildmarke);
+       marke := feldmarke;
+       stelle := max (stelle, feldmarke)
+  ELSE marke := 1
+  FI .
+ 
+keine markierung :
+  bildmarke := 0;
+  feldmarke := 0;
+  marke     := 0 .
+END PROC dateizustand holen;
+ 
+PROC dateizustand retten :
+  put tabs (file, tabulator);
+  IF   fliesstext
+  THEN editinfo (file,    zeilennr + actual editor * 256)
+  ELSE editinfo (file, - (zeilennr + actual editor * 256))
+  FI ;
+  max line length (file, limit);
+  col (file, stelle);
+  IF   markiert
+  THEN mark (file, bildmarke, feldmarke)
+  ELSE mark (file, 0, 0)
+  FI 
+END PROC dateizustand retten;
+ 
+PROC open editor (FILE CONST new file, BOOL CONST access) :
+  disable stop; quit last;
+  neue bildparameter bestimmen;
+  open editor (actual editor + 1, new file, access, x, y, x len, y len). 
+ 
+neue bildparameter bestimmen :
+  INT VAR x, y, x len, y len;
+  IF   actual editor > 0
+  THEN teilbild des aktuellen editors
+  ELSE volles bild
+  FI .
+ 
+teilbild des aktuellen editors :
+  get editcursor (x, y); bildgroesse bestimmen;
+  IF   fenster zu schmal                                             (*sh*)
+  THEN enable stop; errorstop ("Fenster zu klein")
+  ELIF fenster zu kurz
+  THEN verkuerztes altes bild nehmen
+  FI .
+
+bildgroesse bestimmen :
+  x len := rand + feldlaenge - x + 3;
+  y len := bildrand + bildlaenge - y + 1 .
+ 
+fenster zu schmal : x > schirmbreite - 17 .
+fenster zu kurz   : y > schirmhoehe  -  1 .
+
+verkuerztes altes bild nehmen :
+  x := rand + 1; y := bildrand + 1;
+  IF fenster zu kurz THEN enable stop; errorstop ("Fenster zu klein") FI;
+  x len := feldlaenge + 2;
+  y len := bildlaenge;
+  kurze feldlaenge := 0;
+  kurze bildlaenge := 1 . 
+
+volles bild :
+  x := 1; y := 1; x len := schirmbreite; y len := schirmhoehe .
+END PROC open editor;
+ 
+PROC open editor (INT CONST editor nr,
+                  FILE CONST new file, BOOL CONST access,
+                  INT CONST x start, y, x len start, y len) :
+  INT VAR x := x start,
+  x len := x len start;
+  IF   editor nr > max editor
+  THEN errorstop ("zu viele Editor-Fenster")
+  ELIF editor nr > max used editor + 1 OR editor nr < 1
+  THEN errorstop ("Editor nicht eroeffnet")
+  ELIF fenster ungueltig
+  THEN errorstop ("Fenster ungueltig")
+  ELSE neuen editor stacken
+  FI .
+ 
+fenster ungueltig :
+  x < 1  COR  x > schirmbreite  COR  y < 1  COR  y > schirmhoehe  COR
+  x len - 2 <= 15  COR  y len - 1 < 1  COR
+  x + x len - 1 > schirmbreite  COR  y + y len - 1 > schirmhoehe .
+ 
+neuen editor stacken :
+  disable stop;
+  IF   actual editor > 0 AND ist einschraenkung des alten bildes
+  THEN dateizustand holen;
+       aktuelles editorbild einschraenken;
+       arbeitspunkt in das restbild positionieren;
+       abgrenzung beruecksichtigen
+  FI ;
+  aktuellen zustand retten;
+  neuen zustand setzen;
+  neues editorbild zeigen;
+  actual editor := editor nr;
+  IF   actual editor > max used editor
+  THEN max used editor := actual editor
+  FI .
+ 
+ist einschraenkung des alten bildes :
+  x > rand      CAND  x + x len = rand + feldlaenge + 3  CAND
+  y > bildrand  CAND  y + y len = bildrand + bildlaenge + 1 .
+ 
+aktuelles editorbild einschraenken :
+  kurze feldlaenge := x - rand - 3;
+  kurze bildlaenge := y - bildrand - 1 .
+
+arbeitspunkt in das restbild positionieren :
+  IF   stelle > 3
+  THEN stelle DECR 3; alte stelle := stelle
+  ELSE WHILE zeilennr > 1 AND zeilennr > kurze bildlaenge REP
+         vorgaenger
+       PER; old lineno := satznr 
+  FI .
+ 
+abgrenzung beruecksichtigen :
+  IF   x - rand > 1
+  THEN balken malen;
+       x INCR 2;
+       x len DECR 2
+  FI .
+ 
+balken malen :
+  INT VAR i;
+  FOR i FROM 0 UPTO y len-1 REP
+    cursor (x, y+i); out (kloetzchen)                                (*sh*)
+  PER .
+ 
+kloetzchen : IF mark size > 0 THEN ""15""14"" ELSE ""15" "14" " FI .
+
+aktuellen zustand retten :
+  IF   actual editor > 0
+  THEN dateizustand retten;
+       editstack (actual editor).feldstatus := feldstatus;
+       editstack (actual editor).bildstatus := bildstatus;
+       einrueckstack (actual editor) := alte einrueckposition
+  FI .
+ 
+neuen zustand setzen :
+  FRANGE VAR frange;
+  feldstatus := FELDSTATUS :
+    (1, 1, x-1, 0, 1, 0, x len-2, 0, FALSE, TRUE, access, "");
+  bildstatus := BILDSTATUS :
+    (x len-2, x len-2, y, y len-1, y len-1, ueberschrift, bild, 
+     0, 0, 1, 0, 0, FALSE, FALSE, "", "", "", "", "", frange, new file);
+  alte einrueckposition := 1;
+  dateizustand holen;
+  ueberschrift initialisieren .
+ 
+neues editorbild zeigen :
+  ueberschrift zeigen; fenster zeigen
+END PROC open editor;
+ 
+PROC open editor (INT CONST i) :
+  IF   i < 1 OR i > max used editor
+  THEN errorstop ("Editor nicht eroeffnet")
+  ELIF actual editor <> i
+  THEN switch editor
+  FI .
+ 
+switch editor :
+  aktuellen zustand retten;
+  actual editor := i;
+  neuen zustand setzen;
+  IF   kein platz mehr fuer restfenster
+  THEN eingeschachtelte editoren vergessen;
+       bildeinschraenkung aufheben
+  ELSE neu (nix, nix)
+  FI .
+
+aktuellen zustand retten :
+  IF   actual editor > 0
+  THEN editstack (actual editor).feldstatus := feldstatus;
+       editstack (actual editor).bildstatus := bildstatus;
+       einrueckstack (actual editor) := alte einrueckposition;
+       dateizustand retten
+  FI .
+ 
+neuen zustand setzen :
+  feldstatus := editstack (i).feldstatus;
+  bildstatus := editstack (i).bildstatus;
+  alte einrueckposition := einrueckstack (i);
+  dateizustand holen .
+
+kein platz mehr fuer restfenster :
+  kurze feldlaenge < 1 AND kurze bildlaenge < 1 .
+ 
+eingeschachtelte editoren vergessen :
+  IF actual editor < max used editor
+    THEN open editor (actual editor + 1) ;
+         quit
+  FI ;
+  open editor (i) .
+
+bildeinschraenkung aufheben :
+  laenge := feldlaenge;
+  kurze feldlaenge := feldlaenge;
+  kurze bildlaenge := bildlaenge;
+  neu (ueberschrift, bild) .
+END PROC open editor;
+ 
+FILE PROC editfile :
+  IF   actual editor = 0 OR editget modus
+  THEN errorstop ("Editor nicht eroeffnet")
+  FI ; file
+END PROC editfile;
+
+PROC get window (INT VAR x, y, x size, y size) :
+  x := rand + 1;
+  y := bildrand;
+  x size := feldlaenge + 2;
+  y size := bildlaenge + 1
+ENDPROC get window;
+
+(************************* Zugriff auf Bildstatus *************************).
+
+feldlaenge          : bildstatus.feldlaenge .
+kurze feldlaenge    : bildstatus.kurze feldlaenge .
+bildrand            : bildstatus.bildrand .
+bildlaenge          : bildstatus.bildlaenge .
+kurze bildlaenge    : bildstatus.kurze bildlaenge .
+ueberschriftbereich : bildstatus.ueberschriftbereich .
+bildbereich         : bildstatus.bildbereich .
+erster neusatz      : bildstatus.erster neusatz .
+letzter neusatz     : bildstatus.letzter neusatz .
+old zeilennr        : bildstatus.old zeilennr .
+old lineno          : bildstatus.old lineno .
+old mark lineno     : bildstatus.old mark lineno .
+zeileneinfuegen     : bildstatus.zeileneinfuegen .
+old line update     : bildstatus.old line update .
+satznr pre          : bildstatus.satznr pre .
+ueberschrift pre    : bildstatus.ueberschrift pre .
+ueberschrift text   : bildstatus.ueberschrift text .
+ueberschrift post   : bildstatus.ueberschrift post .
+old satz            : bildstatus.old satz .
+old range           : bildstatus.old range .
+file                : bildstatus.file .
+
+END PACKET editor paket;
+
diff --git a/system/base/1.7.5/src/elan do interface b/system/base/1.7.5/src/elan do interface
new file mode 100644
index 0000000..72026a7
--- /dev/null
+++ b/system/base/1.7.5/src/elan do interface
@@ -0,0 +1,57 @@
+
+PACKET elan do interface DEFINES                  (*Autor: J.Liedtke *)
+                                                  (*Stand: 08.11.85  *)
+    do ,
+    no do again :
+ 
+ 
+LET no ins = FALSE ,
+    no lst = FALSE ,
+    no check = FALSE ,
+    no sermon = FALSE ,
+    compile line mode = 2 ,
+    do again mode = 4 ,
+    max command length = 2000 ;
+
+
+INT VAR do again mod nr := 0 ;
+TEXT VAR previous command := "" ;
+
+DATASPACE VAR ds ;
+
+ 
+PROC do (TEXT CONST command) :
+
+  enable stop ;
+  IF LENGTH command > max command length
+    THEN errorstop ("Kommando zu lang")
+  ELIF do again mod nr <> 0 AND command = previous command
+    THEN do again
+    ELSE previous command := command ;
+         compile and execute
+  FI .
+
+do again :
+  elan (do again mode, ds, "", do again mod nr,
+        no ins, no lst, no check, no sermon) .
+
+compile and execute :
+  elan (compile line mode, ds, command, do again mod nr,
+        no ins, no lst, no check, no sermon) .
+
+ENDPROC do ;
+ 
+PROC no do again :
+
+  do again mod nr := 0 
+
+ENDPROC no do again ;
+ 
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 
+           INT VAR start module number,
+           BOOL CONST ins, lst, rt check, ser) :
+  EXTERNAL 256
+ENDPROC elan ;
+
+ENDPACKET elan do interface ;
+
diff --git a/system/base/1.7.5/src/error handling b/system/base/1.7.5/src/error handling
new file mode 100644
index 0000000..34db65d
--- /dev/null
+++ b/system/base/1.7.5/src/error handling
@@ -0,0 +1,142 @@
+
+PACKET error handling DEFINES
+ 
+    enable stop ,
+    disable stop ,
+    is error ,
+    clear error ,
+    errormessage ,
+    error code ,
+    error line ,
+    put error ,
+    errorstop ,
+    stop :
+ 
+ 
+LET cr lf            = ""13""10"" ,
+    line nr field    = 1 ,
+    error line field = 2 ,
+    error code field = 3 ,
+    syntax error code= 100 ,
+
+    error pre        = ""7""13""10""5"FEHLER : " ;
+
+
+TEXT VAR errortext := "" ;
+ 
+ 
+PROC enable stop :
+  EXTERNAL 75
+ENDPROC enable stop ;
+
+PROC disable stop :
+  EXTERNAL 76
+ENDPROC disable stop ;
+
+PROC set error stop (INT CONST code) :
+  EXTERNAL 77
+ENDPROC set error stop ;
+ 
+BOOL PROC is error : 
+  EXTERNAL 78
+ENDPROC is error ; 
+ 
+PROC clear error :
+  EXTERNAL 79
+ENDPROC clear error ;
+
+PROC select error message :
+
+  SELECT error code OF
+    CASE 1 : error text := "'halt' vom Terminal"
+    CASE 2 : error text := "Stack-Ueberlauf"
+    CASE 3 : error text := "Heap-Ueberlauf"
+    CASE 4 : error text := "INT-Ueberlauf"
+    CASE 5 : error text := "DIV durch 0"
+    CASE 6 : error text := "REAL-Ueberlauf"
+    CASE 7 : error text := "TEXT-Ueberlauf"
+    CASE 8 : error text := "zu viele DATASPACEs"
+    CASE 9 : error text := "Ueberlauf bei Subskription"
+    CASE 10: error text := "Unterlauf bei Subskription"
+    CASE 11: error text := "falscher DATASPACE-Zugriff"
+    CASE 12: error text := "INT nicht initialisiert"
+    CASE 13: error text := "REAL nicht initialisiert"
+    CASE 14: error text := "TEXT nicht initialisiert"
+    CASE 15: error text := "nicht implementiert"
+    CASE 16: error text := "Block unlesbar"
+    CASE 17: error text := "Codefehler"
+  END SELECT 
+
+ENDPROC select error message ;
+
+TEXT PROC error message : 
+ 
+  select error message ;
+  error text
+ 
+ENDPROC error message ;
+ 
+INT PROC error code :
+
+  pcb (error code field) 
+
+ENDPROC error code ;
+
+INT PROC error line :
+ 
+  IF is error
+    THEN pcb (error line field)
+    ELSE 0
+  FI
+ 
+ENDPROC error line ;
+ 
+PROC syntax error (TEXT CONST message) :
+
+  INTERNAL 259 ;
+  errorstop (syntax error code, message) .
+
+ENDPROC syntax error ;
+
+PROC errorstop (TEXT CONST message) :
+
+  errorstop (0, message) ;
+
+ENDPROC errorstop ;
+
+PROC errorstop (INT CONST code, TEXT CONST message) :
+
+  IF NOT is error
+    THEN error text := message ;
+         set error stop (code)
+  FI
+
+ENDPROC errorstop ;
+ 
+PROC put error :
+ 
+  IF is error
+    THEN select error message ;
+         IF error text <> ""
+           THEN put error message
+         FI
+  FI .
+ 
+put error message :
+  out (error pre) ;
+  out (error text) ;
+  IF error line > 0
+    THEN out (" bei Zeile "); out (text (error line)) ;
+  FI ; 
+  out (cr lf) .
+
+ENDPROC put error ;
+ 
+PROC stop :
+
+  errorstop ("stop")
+
+ENDPROC stop ;
+
+ENDPACKET error handling ;
+
diff --git a/system/base/1.7.5/src/eumel coder part 1 b/system/base/1.7.5/src/eumel coder part 1
new file mode 100644
index 0000000..83974f7
--- /dev/null
+++ b/system/base/1.7.5/src/eumel coder part 1
@@ -0,0 +1,866 @@
+PACKET eumel coder part 1                          (* Autor: U. Bartling *) 
+       DEFINES run, run again, 
+               insert,
+               prot, prot off,
+               check, check on, check off,
+               warnings, warnings on, warnings off, 
+
+               help, bulletin, packets 
+               : 
+ 
+(**************************************************************************)
+(*                                                                        *) 
+(*                         E U M E L  -  C O D E R                        *) 
+(*                                                                        *) 
+(*                                                                        *) 
+(*   Zur Beschreibung des Coders siehe                                    *) 
+(*         U.Bartling, J. Liedtke: EUMEL-Coder-Interface                  *) 
+(*                                                                        *) 
+(*   Stand der Dokumentation  : 13.02.1986                                *) 
+(*   Stand der Implementation : 16.04.1986                                *) 
+(*                                                                        *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+                   (***** Globale Variable *****) 
+
+TEXT VAR object name;
+ 
+FILE VAR bulletin file; 
+ 
+INT VAR hash table pointer, nt link, permanent pointer, param link,
+        index, mode, word;
+ 
+BOOL VAR found, end of params;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  1. Interface zum ELAN-Compiler            10.04.1986  *) 
+(*                              1.7.5.4                                   *)
+(*                                                                        *) 
+(*   Beschreibung der      Tabellen (-groessen),                          *) 
+(*                         internen Vercodung von Typen                   *) 
+(*                    und  Kennungen .                                    *) 
+(*   Initialisieren und Beenden des Compilers,                            *) 
+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+LET  begin of hash table         =     0 ,
+     end of hash table           =  1023 ,
+ 
+     begin of permanent table    = 22784 ,
+       before first pt entry     = 22784 ,
+       first permanent entry     = 22785 ,
+     end of permanent table      = 32767 , 
+
+     wordlength                  =     1 ,  (* compile  u n d  run time *)
+     two word length             =     2 ,
+     three word length           =     3 ,
+ 
+     permanent param const             = 10000 ,
+     permanent param var               = 20000 ,
+     permanent proc op                 = 30000 ,
+     permanent type                    = 30000 ,
+     permanent row                     =    10 ,
+     permanent struct                  =    11 ,
+     permanent param proc              =    12 ,
+(*   permanent param proc end marker   =     0 , *)
+     permanent type field              =     0 ,
+
+     ptt limit                         = 10000 ,
+     begin of pt minus ptt limit       = 12784 ,
+ 
+     void                              =     0 ,
+     int                               =     1 ,
+     real                              =     2 ,
+     string                            =     3 ,
+     bool                              =     5 ,
+     bool result                       =     6 ,
+     dataspace                         =     7 ,
+     row                               =    10 ,
+     struct                            =    11 ,
+
+     const                             =     1 , 
+     var                               =     2 ,
+(*   proc                              =     3 , *)
+(*   denoter                           =     5 , *)
+     bold                              =     2 ,
+ 
+     ins                               = TRUE ,
+     no ins                            = FALSE ,
+     no lst                            = FALSE ,
+     sermon                            = TRUE  ,
+     no sermon                         = FALSE ,
+ 
+     run again mode                    =     0 ,
+     compile file mode                 =     1 ,
+
+     warning message                   =     2 , 
+     error message                     =     4 ,
+ 
+     point line                        = "..............." ;
+ 
+INT CONST permanent packet            :=     -2 ,
+          permanent end               :=     -3 ;
+
+
+INT  VAR run again mod nr             :=     0 ;
+ 
+ 
+                     (***** Start/Ende *****)
+ 
+PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, 
+           INT VAR start module number, BOOL CONST ins, lst, rtc, ser) :
+  EXTERNAL 256
+ENDPROC elan ;
+ 
+                   (***** Hash/Namenstabelle *****) 
+.
+next hash entry :
+     hash table pointer INCR wordlength .
+
+end of hash table reached :
+     hash table pointer > end of hash table .
+
+yet another nt entry :
+     nt link := cdb int (nt link) ;
+     nt link <> 0 . ;
+ 
+PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : 
+    EXTERNAL 10031
+ENDPROC declare object ; 
+ 
+PROC to object (TEXT CONST searched object) : 
+     hash ;
+     search nt entry .
+
+hash :
+     hash code := 0 ;
+     FOR index FROM 1 UPTO LENGTH searched object REP
+         addmult cyclic
+     ENDREP .
+
+addmult cyclic :
+     hash code INCR hash code ;
+     IF hash code > end of hash table THEN wrap around FI ;
+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .
+
+wrap around :
+     hash code DECR end of hash table .
+
+hash code : nt link .
+
+search nt entry :
+     found := FALSE ;
+     WHILE yet another nt entry REP
+          read current entry ;
+          IF object name = searched object 
+             THEN found := TRUE ;
+                  LEAVE to object
+          FI
+     PER .
+
+read current entry :
+     permanent pointer := cdb int (nt link + wordlength) ;
+     object name := cdb text (nt link + two word length)
+ENDPROC to object ;
+
+
+                 (***** Permanent Tabelle *****) 
+.
+next procedure :
+     permanent pointer := cdb int (permanent pointer) . ;
+
+PROC next pt param :
+     mode := cdb int (param link) MOD ptt limit ;
+     param link INCR wordlength ;
+     IF   mode = permanent row    THEN skip over permanent row 
+     ELIF mode = permanent struct THEN skip over permanent struct
+     FI ;
+     set end marker if end of list .
+
+skip over permanent row :
+     param link INCR wordlength ;
+     next pt param .
+
+skip over permanent struct :
+     REP
+         next pt param ;
+         mode := cdb int (param link)
+     UNTIL mode = permanent type field PER ;
+     param link INCR wordlength
+ENDPROC next pt param ;
+
+PROC set end marker if end of list :
+     mode := cdb int (param link) ;
+     end of params := mode >= permanent proc op OR mode <= 0 
+ENDPROC set end marker if end of list ;
+
+PROC get type and mode (INT VAR type) : 
+     mode := cdb int (param link) ;
+     IF mode = permanent param proc THEN type of param proc
+                                    ELSE type of object
+     FI .
+
+type of param proc : 
+     param link INCR wordlength ;
+     get type and mode (type) ;
+     mode := permanent param proc .
+
+type of object :
+     IF mode < 0 THEN type := 2769 + (32767 + mode) ;
+                      mode := 0
+                 ELSE type := mode MOD ptt limit ;
+                      mode DECR type ;
+                      translate type if necessary ;
+                      translate mode if necessary 
+     FI .
+
+translate type if necessary :
+     IF permanent row or struct THEN translate type FI .
+
+translate type :
+     type := param link - begin of pt minus ptt limit .
+
+translate mode if necessary : 
+    IF   mode = permanent param const THEN mode := const
+    ELIF mode = permanent param var   THEN mode := var
+    FI .
+
+permanent row or struct :
+     type = permanent row OR type = permanent struct
+ENDPROC get type and mode ;
+ 
+
+                 (***** Allgemeine Zugriffsprozeduren *****) 
+
+INT PROC cdb int (INT CONST index) :
+   EXTERNAL 116
+ENDPROC cdb int ;
+
+TEXT PROC cdb text (INT CONST index) :
+   EXTERNAL 117
+ENDPROC cdb text ;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                 10. Inspector                              16.04.1986  *)
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+INT VAR line number, pattern length, packet link,
+        begin of packet, last packet entry, indentation;
+
+TEXT VAR bulletin name, type and mode, pattern, buffer;
+ 
+DATASPACE VAR bulletin ds :: nilspace ;
+
+.packet name :
+     cdb text (cdb int(packet link + wordlength) + two word length) .
+
+.within editor :
+    aktueller editor > 0 .  ;
+
+PROC name of type (INT CONST type) :
+            SELECT type OF
+     CASE void              :
+     CASE int               : type and mode CAT "INT"
+     CASE real              : type and mode CAT "REAL"
+     CASE string            : type and mode CAT "TEXT"
+     CASE bool, bool result : type and mode CAT "BOOL"
+     CASE dataspace         : type and mode CAT "DATASPACE"
+     CASE row               : type and mode CAT "ROW "
+     CASE struct            : type and mode CAT "STRUCT"
+     OTHERWISE              : complex type
+            ENDSELECT .
+
+complex type :
+     IF type > ptt limit THEN perhaps permanent struct or row
+                         ELSE get complex type
+     FI .
+
+perhaps permanent struct or row :
+     index := type + begin of pt minus ptt limit ;
+     mode := cdb int (index) MOD ptt limit ;
+     IF   mode = permanent row    THEN get permanent row 
+     ELIF mode = permanent struct THEN get permanent struct
+                                  ELSE type and mode CAT "-"
+     FI .
+
+get complex type :
+     index := type + begin of permanent table ;
+     IF is complex type THEN get name
+                        ELSE type and mode CAT "-"
+     FI .
+
+is complex type :
+     permanent type definition mode = permanent type .
+
+get name :
+     type and mode CAT cdb text (link to type name + two word length) .
+
+link to type name :
+     cdb int (index + three word length) .
+
+permanent type definition mode :
+     cdb int (index + wordlength) .
+
+get permanent row :
+     INT VAR t; 
+     type and mode CAT "ROW " ;
+     type and mode CAT text (cdb int (index + wordlength)) ;
+     type and mode CAT " " ;
+     param link := index + two wordlength ;
+     get type and mode (t) ;
+     name of type (t) .
+ 
+get permanent struct :
+     type and mode CAT "STRUCT ( ... )" 
+ENDPROC name of type ;
+
+PROC help (TEXT CONST proc name) :
+     prep bulletin ;
+     prep help ;
+     scan (object name) ;
+     next symbol (pattern) ;
+     packet link := end of permanent table ;
+     IF function = 0 THEN standard help
+                     ELSE asterisk help
+     FI .
+
+prep help :
+     object name := compress (proc name) ;
+     INT VAR function :: 0 ;
+     INT CONST l :: LENGTH object name ;
+     IF l > 1 AND object name <> "**"
+        THEN IF (object name SUB l) = "*"
+               THEN function INCR 2 ;
+                    delete char (object name, l)
+             FI ;
+             IF (object name SUB 1) = "*"
+               THEN function INCR 1 ;
+                    delete char (object name, 1)
+             FI ;
+             IF another asterisk THEN wrong function FI
+     FI.
+
+another asterisk :
+     pos (object name, "*") <> 0 .
+
+wrong function :
+     errorstop ("unzulaessige Sternfunktion") .
+
+standard help :
+     to object (pattern) ;
+     IF found THEN display
+              ELSE error stop ("unbekannt: " + proc name)
+     FI .
+
+display :
+     WHILE permanent pointer <> 0 REP
+         put name of packet if necessary ;
+         put specifications (pattern) ;
+         next procedure
+     ENDREP ;
+     show bulletin file .
+ 
+put name of packet if necessary :
+     IF new packet THEN packet link := permanent pointer ;
+                        find begin of packet ;
+                        writeline (2) ;
+                        write packet name
+     FI .
+
+find begin of packet :
+     REP 
+         packet link DECR wordlength
+     UNTIL begin of packet found PER .
+
+begin of packet found :
+     cdb int (packet link) = permanent packet .
+
+new packet :
+     permanent pointer < packet link .
+
+asterisk help :
+     hash table pointer := begin of hash table ;
+     pattern length := LENGTH pattern - 1 ;
+     REP
+        list all objects in current hash table chain ;
+        next hash entry
+     UNTIL end of hash table reached ENDREP ;
+     show bulletin file .
+
+list all objects in current hash table chain :
+     nt link := hash table pointer ;
+     WHILE yet another nt entry REP
+        permanent pointer := cdb int (nt link + wordlength) ;
+        object name := cdb text (nt link + two word length) ;
+        IF matching THEN into bulletin FI
+     PER .
+
+matching :
+     INT CONST p :: pos (object name, pattern) ;
+     SELECT function OF
+         CASE 1 :   p <> 0 AND p = LENGTH object name - pattern length
+         CASE 2 :   p = 1
+         CASE 3 :   p <> 0
+         OTHERWISE  FALSE
+     ENDSELECT .
+
+into bulletin :
+     object names into bulletin (BOOL PROC not end of chain)
+ENDPROC help ;
+ 
+BOOL PROC not end of chain :
+     permanent pointer <> 0 
+ENDPROC not end of chain ;
+
+PROC write packet name :
+     indentation := 0 ;
+     write line ;
+     write bulletin line ("PACKET ") ;
+     indentation := 7 ;
+     object name := packet name ;
+     write bulletin line (object name) ;
+     write bulletin line (":") ;
+     writeline (2)
+ENDPROC write packet name ;
+
+PROC put specifications (TEXT CONST proc name) :
+     put obj name (proc name) ;
+     to first param ;
+     IF NOT end of params THEN put param list FI ;
+     put result ;
+     writeline .
+ 
+to first param :
+     param link := permanent pointer + word length ;
+     set end marker if end of list .
+
+put result :
+     INT VAR type;
+     get type and mode (type) ;
+     IF type <> void THEN type and mode := "  --> " ;
+                          name of type (type) ;
+                          write bulletin line (type and mode)
+     FI
+ENDPROC put specifications ;
+
+PROC put param list : 
+     write bulletin line (" (") ;
+     REP
+         INT VAR type, param mode;
+         get type and mode (type) ;
+         param mode := mode ;
+         put type and mode ;
+         maybe param proc ;
+         next pt param ;
+         IF end of params THEN write bulletin line (")") ;
+                               LEAVE put param list 
+         FI ;
+         write bulletin line (", ") ;
+     PER .
+
+put type and mode :
+     type and mode := "" ;
+     name of type (type) ;
+     type and mode CAT name of mode ;
+     write bulletin line (type and mode) .
+
+name of mode :
+     IF   param mode = const THEN " CONST"
+     ELIF param mode = var   THEN " VAR"
+                             ELSE " PROC"
+     FI .
+
+maybe param proc :
+     IF mode = permanent param proc THEN put virtual params FI .
+
+put virtual params :
+     skip over result type if complex type ;
+     IF NOT end of virtual params THEN put param list FI.
+
+skip over result type if complex type :
+     next pt param .
+
+end of virtual params :
+    end of params
+ENDPROC put param list ;
+
+PROC next packet :
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF   word = permanent packet THEN true return
+         ELIF end of permanents       THEN false return
+         FI ;
+     ENDREP .
+
+true return :
+     found := TRUE ;
+     LEAVE next packet .
+
+false return :
+     found := FALSE ;
+     LEAVE next packet .
+
+end of permanents :
+     word = permanent end OR packet link > end of permanent table 
+ENDPROC next packet ;
+
+PROC prep bulletin :
+     forget (bulletin ds) ;
+     bulletin ds := nilspace ;
+     bulletin file := sequential file (output, bulletin ds) ;
+     line number := 0 ;
+     buffer := ""
+ENDPROC prep bulletin ;
+
+PROC show bulletin file :
+     IF within editor THEN ueberschrift neu FI ;
+     DATASPACE VAR local ds :: bulletin ds ;
+     FILE VAR local file :: sequential file (modify, local ds) ;
+     show (local file) ;
+     forget (local ds)
+ENDPROC show bulletin file ;
+
+PROC write bulletin line (TEXT CONST line) :
+     IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ;
+     buffer CAT line
+ENDPROC write bulletin line ;
+
+PROC writeline  :
+     write (bulletin file, buffer) ;
+     line (bulletin file) ;
+     line number INCR 1 ;
+     cout (line number) ;
+     buffer := indentation * " "
+ENDPROC writeline ;
+
+PROC writeline (INT CONST times) :
+     IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ;
+                                          writeline
+                                     ELSE index := times
+     FI ;
+     line (bulletin file, index) ;
+     line number INCR index;
+     indentation := 0 ;
+     cout (line number)
+ENDPROC writeline ;
+ 
+PROC bulletin (TEXT CONST packet name) :
+     prep bulletin ;
+     scan (packet name) ;
+     next symbol (pattern) ;
+     to packet ; 
+     IF found THEN list packet ;
+                   show bulletin file
+              ELSE error stop (packet name + " ist kein Paketname")
+     FI . 
+ 
+to packet :
+     last packet entry := 0 ;
+     get nametab link of packet name ;
+     packet link := before first pt entry ;
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF word < 0 THEN IF   word = permanent packet THEN packet found
+                          ELIF word = permanent end    THEN return
+                          FI
+         FI
+     ENDREP .
+
+get nametab link of packet name :
+     to object (pattern) ;
+     IF NOT found THEN error stop ("unbekanntes Paket :" + packet name) ;
+                       LEAVE to packet
+     FI .
+
+packet found :
+     IF cdb int (packet link + wordlength) = nt link
+        THEN last packet entry := packet link FI .
+
+return : 
+     IF last packet entry <> 0 THEN found := TRUE ;
+                                    packet link := last packet entry
+                               ELSE found := FALSE
+     FI ;
+     LEAVE to packet
+ENDPROC bulletin ;
+ 
+PROC list packet :
+     begin of packet := packet link + word length ;
+     write packet name ; 
+     find end of packet ;
+     run through nametab and list all packet objects .
+ 
+find end of packet :
+     last packet entry := begin of packet ;
+     REP
+         last packet entry INCR wordlength ;
+         word := cdb int (last packet entry) ;
+     UNTIL end of packet entries PER .
+
+end of packet entries :
+     word = permanent packet OR word = permanent end .
+
+run through nametab and list all packet objects :
+     hashtable pointer := begin of hashtable ;
+     REP
+         nt link := hashtable pointer ;
+         list objects of current packet in this chain ;
+         next hash entry
+     UNTIL end of hashtable reached ENDREP .
+
+list objects of current packet in this chain :
+     WHILE yet another nt entry REP 
+         permanent pointer := cdb int (nt link + wordlength) ;
+         put objects of this name
+     PER .
+
+put objects of this name :
+     IF there is at least one object of this name in the current packet
+       THEN into bulletin FI .
+
+there is at least one object of this name in the current packet :
+     REP
+        IF permanent pointer >= begin of packet AND
+           permanent pointer < last packet entry
+           THEN LEAVE there is at least one object of this name
+                      in the current packet WITH TRUE FI ;
+        next procedure
+     UNTIL permanent pointer = 0 PER ;
+     FALSE .
+
+into bulletin :
+     object name := cdb text (nt link + two word length) ;
+     object names into bulletin (BOOL PROC within packet)
+ENDPROC list packet ;
+
+BOOL PROC within packet :
+     permanent pointer >= begin of packet AND 
+     permanent pointer < last packet entry
+ENDPROC within packet ;
+
+PROC object names into bulletin (BOOL PROC link ok) :
+     scan (object name) ;
+     next symbol (object name, mode) ;
+     IF type definition THEN put type definition
+                        ELSE put object definitions
+     FI .
+
+type definition :
+     mode = bold AND no params .
+
+no params :
+     cdb int (permanent pointer + word length) >= permanent type .
+
+put type definition :
+     put obj name (object name) ;
+     write bulletin line ("TYPE ") ;
+     writeline (1) .
+
+put object definitions :
+     WHILE link ok REP
+         put specifications (object name) ;
+         next procedure
+     ENDREP 
+ENDPROC object names into bulletin ;
+ 
+PROC bulletin :
+     prep bulletin ;
+     packet link := first permanent entry ;
+     REP
+         list packet ;
+         write line (4) ;
+         next packet
+     UNTIL NOT found PER ;
+     show bulletin file
+ENDPROC bulletin ;
+
+PROC put obj name (TEXT CONST name) :
+     buffer := "      " ;
+     bulletin name := point line ;
+     change (bulletin name, 1, end of line or name, name) ;
+     buffer CAT bulletin name ;
+     indentation := LENGTH buffer + 1 .
+
+end of line or name :
+     min (LENGTH name, LENGTH bulletin name)
+ENDPROC put obj name ;
+
+PROC packets :
+     prep bulletin ;
+     packet link := first permanent entry ;
+     REP
+         object name := packet name ;
+         put obj name (object name) ;
+         write line ;
+         next packet 
+     UNTIL NOT found PER ;
+     show bulletin file
+ENDPROC packets ;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                 11. ELAN Run-Interface                     09.01.1986  *) 
+(*                                                                        *) 
+(*   Uebersetzen von ELAN-Programmen                                      *) 
+(*   Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler           *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+ 
+BOOL VAR list option     := FALSE ,
+         check option    :=  TRUE ,
+         warning option  := FALSE , 
+         listing enabled := FALSE ;
+
+FILE VAR listing file ;
+
+TEXT VAR listing file name := "" ;
+ 
+ 
+PROC run (TEXT CONST file name) : 
+  enable stop ;
+  IF NOT exists (file name)
+    THEN errorstop ("""" + file name + """ gibt es nicht")
+  FI ;
+  last param (file name) ;
+  run elan (file name, no ins)
+END PROC run;
+ 
+PROC run :
+  run (last param)
+ENDPROC run ;
+ 
+PROC run again :
+  IF run again mod nr <> 0
+    THEN elan (run again mode, bulletin file, "", run again mod nr, 
+               no ins, no lst, check option, no sermon)
+    ELSE errorstop ("'run again' nicht moeglich")
+  FI
+ENDPROC run again ;
+ 
+PROC insert (TEXT CONST file name) : 
+  enable stop ;
+  IF NOT exists (file name)
+    THEN errorstop ("""" + file name + """ gibt es nicht")
+  FI ;
+  last param (file name) ;
+  run elan (file name, ins)
+ENDPROC insert ;
+ 
+PROC insert :
+  insert (last param)
+ENDPROC insert ;
+ 
+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :
+  FILE VAR source := sequential file (modify, file name) ;
+  IF listing enabled
+    THEN open listing file
+  FI ;
+
+  disable stop ;
+  no do again ;
+  elan (compile file mode, source, "" , run again mod nr,
+        insert option, list option, check option, sermon) ;
+ 
+  IF anything noted AND command dialogue
+    THEN ignore halt during compiling ;
+         note edit (source) ;
+         last param (file name) ; 
+         errorstop ("")
+  FI .
+
+ignore halt during compiling :
+  IF is error
+    THEN put error ;
+         clear error ;
+         pause (5)
+  FI .
+
+open listing file :
+  listing file := sequential file (output, listing file name) ;
+  max line length (listing file, 130)
+
+ENDPROC run elan ;
+
+PROC out text (TEXT CONST text, INT CONST out type) :
+  INTERNAL 257 ; 
+  IF online
+    THEN out (text)
+  FI ;
+  IF out type = error message OR (warning option AND out type = warning message) 
+    THEN note (text) ; 
+  FI ;
+  IF listing enabled
+    THEN write (listing file, text)
+  FI
+ENDPROC out text ;
+
+PROC out line (INT CONST out type) :
+  INTERNAL 258 ; 
+  IF online
+    THEN out (""13""10"")
+  FI ;
+  IF out type = error message
+       OR (warning option AND out type = warning message)
+    THEN note line
+  ELIF listing enabled
+    THEN line (listing file)
+  FI
+ENDPROC out line ;
+
+PROC prot (TEXT CONST file name) :
+  list option := TRUE ;
+  listing file name := file name ;
+  listing enabled := TRUE
+ENDPROC prot ;
+ 
+PROC prot off :
+  list option := FALSE ;
+  listing enabled := FALSE
+ENDPROC prot off ;
+
+BOOL PROC prot :
+  list option
+ENDPROC prot ;
+ 
+PROC check on :
+  check option := TRUE
+ENDPROC check on ;
+ 
+PROC check off :
+  check option := FALSE
+ENDPROC check off ;
+ 
+BOOL PROC check :
+  check option
+ENDPROC check ;
+
+PROC warnings on :                    
+  warning option := TRUE    
+ENDPROC warnings on ;    
+ 
+PROC warnings off : 
+  warning option := FALSE 
+ENDPROC warnings off ; 
+ 
+BOOL PROC warnings : 
+  warning option 
+ENDPROC warnings ; 
+ 
+ENDPACKET eumel coder part 1 ;
+
diff --git a/system/base/1.7.5/src/file b/system/base/1.7.5/src/file
new file mode 100644
index 0000000..530dcb3
--- /dev/null
+++ b/system/base/1.7.5/src/file
@@ -0,0 +1,2122 @@
+(* ------------------- VERSION 35     02.06.86 ------------------- *)
+PACKET file handling DEFINES     (* Autoren: J.Liedtke, D.Martinek *)
+       (***********) 
+ 
+       FILE,
+       :=,
+       sequential file,
+       reorganize,
+       input,
+       output,
+       modify,
+       close,
+       putline,
+       getline,
+       put,
+       get,
+       write ,
+       line,
+       reset,
+       down,
+       up,
+       downety,
+       uppety,
+       pattern found,
+       to first record,
+       to line,
+       to eof,
+       insert record,
+       delete record,
+       read record,
+       write record,
+       is first record,
+       eof,
+       line no,
+       FRANGE,
+       set range,
+       reset range ,
+       remove,
+       clear removed,
+       reinsert,
+       max line length,
+       edit info,
+       line type ,
+       copy attributes ,
+       headline,
+       put tabs,
+       get tabs,
+       col,
+       word,
+       at,
+       removed lines,
+       exec,
+       pos ,
+       len ,
+       subtext ,
+       change ,
+       lines ,
+       segments ,
+       mark ,
+       mark line no ,
+       mark col ,
+       set marked range ,
+       split line ,
+       concatenate line ,
+       prefix ,
+       sort ,
+       lexsort :
+
+
+(**********************************************************************)
+(*                                                                    *)
+(*  Terminologie:                                                     *)
+(*                                                                    *)
+(*                                                                    *)
+(*     ATOMROW       Menge aller Atome eines FILEs.                   *)
+(*                   Die einzelnen Atome haben zwar eine Position     *)
+(*                   im Row, aber in dieser Betrachtung keine         *)
+(*                   logische Reihenfolge.                            *)
+(*                                                                    *)
+(*     ATOM          Basiselement, kann eine Zeile der Datei und die  *)
+(*                   zugehoerige Verwaltungsinformation aufnehmen     *)
+(*                                                                    *)
+(*     CHAIN         Zyklisch geschlossene Kette von Segmenten.       *)
+(*                                                                    *)
+(*     SEGMENT       Teilbereich des Atomrows, enthaelt 1 oder mehr   *)
+(*                   zusammenhaengende Atoms.                         *)
+(*                   Jedes Segment hat ein Vorgaenger- und ein        *)
+(*                   Nachfolgersegment.                               *)
+(*                   Jedes Segment enthaelt einen logisch zumsammen-  *)
+(*                   haengenden Teile einer Sequence.                 *)
+(*                                                                    *)
+(*     SEQUENCE      Logische Folge von Lines.                        *)
+(*                   Jede Sequence ist Teil einer Chain oder besteht  *)
+(*                   vollstaendig daraus:                             *)
+(*                                                                    *)
+(*                        SEG1--SEG2--SEG3--SEG4--SEG5                *)
+(*                          :----sequence----:                        *)
+(*                                                                    *)
+(*                   Die 'Reihenfolge' ebenso wie die 'Anzahl' der    *)
+(*                   Lines ist eine wesentliche Eigenschaft einer     *)
+(*                   Sequence.                                        *)
+(*                                                                    *)
+(*     LINE          Ein Atom als Element ein Sequence betrachtet.    *)
+(*                                                                    *)
+(*                                                                    *)
+(**********************************************************************)
+(*                                                                    *)
+(* Eigenschaften:                                                     *)
+(*                                                                    *)
+(*     Folgende Mengen bilden eine Zerlegung (im math. Sinn) einer    *)
+(*     gesamten Datei:                                                *)
+(*                        used segment chain                          *)
+(*                        scratch segment chain                       *)
+(*                        free segment chain                          *)
+(*                        unused tail                                 *)
+(*                                                                    *)
+(*     Fuer jedes X aus (used, scratch, free) gelten:                 *)
+(*                                                                    *)
+(*     'X sequence' ist echte Teilmenge von 'X segment chain'.        *)
+(*                                                                    *)
+(*                       (Daraus folgt, es gibt keine leere 'chain'.) *)
+(*                                                                    *)
+(*     'X segment chain' ist zyklisch gekettet.                       *)
+(*                                                                    *)
+(*     Alle Atome von 'X segment chain' haben definierten Inhalt.     *)
+(*                                                                    *)
+(**********************************************************************)
+ 
+ 
+LET file size    = 4075 ,
+    nil          = 0 ,
+ 
+    free root    = 1 ,
+    scratch root = 2 ,
+    used root    = 3 ,
+    first unused = 4 ;
+ 
+ 
+LET SEQUENCE = STRUCT (INT index, segment begin, segment end,
+                       INT line no, lines),
+    SEGMENT  = STRUCT (INT succ, pred, end),
+    ATOM     = STRUCT (SEGMENT seg, INT type, TEXT line),
+    ATOMROW  = ROW filesize ATOM,
+ 
+    LIST     = STRUCT (SEQUENCE used, INT prefix lines, postfix lines,
+                       SEQUENCE scratch, free, INT unused tail,
+                       INT mode, col, limit, edit info, mark line, mark col,
+                       ATOMROW atoms);
+ 
+TYPE FILE = BOUND LIST ;
+ 
+TYPE FRANGE = STRUCT (INT pre, post, BOOL pre was split, post was split);
+
+
+OP := (FRANGE VAR left, FRANGE CONST right):
+  CONCR (left) := CONCR (right)
+ENDOP := ;
+
+
+OP := (FILE VAR left, FILE CONST right):
+  EXTERNAL 260
+END OP :=;
+
+
+PROC becomes (INT VAR a, b) :
+  INTERNAL 260  ;
+  a := b
+END PROC becomes;
+ 
+ 
+PROC initialize (FILE VAR f) :
+ 
+   f.used     := SEQUENCE : (used root, used root, used root, 1, 0);
+   f.prefix lines  := 0;
+   f.postfix lines := 0;
+   f.free     := SEQUENCE : (free root, free root, free root, 1, 0);
+   f.scratch  := SEQUENCE : (scratch root, scratch root, scratch root, 1, 0);
+   f.unused tail := first unused;
+
+   f.limit := 77;
+   f.edit info := 0;
+   f.col := 1 ;
+   f.mark line := 0 ;
+   f.mark col := 0 ;
+
+   INT VAR i;
+   FOR i FROM 1 UPTO 3 REP
+     root (i).seg  := SEGMENT : (i, i, i);
+     root (i).line := ""
+   PER;
+   put tabs (f, "") .
+ 
+root : f.atoms .
+ 
+END PROC initialize;
+ 
+ 
+(**********************************************************************)
+(*                                                                    *)
+(*        Segment Handler         (SEGMENTs & CHAINs)                 *)
+(*                                                                    *)
+(**********************************************************************)
+
+INT PROC segs (SEQUENCE CONST s, ATOMROW CONST atom) :
+
+  INT VAR number of segments := 0 ,
+  actual segment := s.segment begin ;
+  REP
+    number of segments INCR 1 ;
+    actual segment := atom (actual segment).seg.succ
+  UNTIL actual segment = s.segment begin PER ;
+  number of segments .
+
+ENDPROC segs ;
+
+ 
+PROC next segment (SEQUENCE VAR s, ATOMROW CONST atom) :
+ 
+  disable stop;
+  s.line no INCR (s.segment end - s.index + 1);
+  INT CONST new segment index := actual segment.succ;
+  s.segment begin := new segment index;
+  s.segment end   := new segment.end;
+  s.index         := new segment index .
+
+actual segment :  atom (s.segment begin).seg .
+new segment :     atom (new segment index).seg .
+ 
+END PROC next segment;
+ 
+ 
+PROC previous segment (SEQUENCE VAR s, ATOMROW CONST atom) :
+
+  disable stop;
+  s.line no DECR (s.index - s.segment begin + 1);
+  INT CONST new segment index := actual segment.pred;
+  s.segment begin := new segment index;
+  s.segment end   := new segment.end;
+  s.index         := s.segment end .
+ 
+actual segment :  atom (s.segment begin).seg .
+new segment :     atom (new segment index).seg .
+ 
+END PROC previous segment;
+ 
+ 
+PROC split segment (SEQUENCE VAR s, ATOMROW VAR atom) :
+
+  disable stop;
+  IF not at segment top
+    THEN split segment at actual position
+  FI .
+
+split segment at actual position :
+  INT CONST pred index   := s.segment begin,
+            actual index := s.index,
+            succ index   := pred.succ;
+
+  actual.pred  := pred index;
+  actual.succ  := succ index;
+  actual.end   := s.segment end;
+ 
+  pred.succ    := actual index;
+  pred.end     := actual index - 1;
+ 
+  succ.pred    := actual index;
+ 
+  s.segment begin := actual index .
+ 
+not at segment top : s.index > s.segment begin .
+
+pred   : atom (pred index).seg .
+ 
+actual : atom (actual index).seg .
+ 
+succ   : atom (succ index).seg .
+ 
+END PROC split segment;
+ 
+
+PROC join segments (ATOMROW VAR atom,
+                    INT CONST first index, INT VAR second index) :
+ 
+  disable stop;
+  IF first seg.end + 1 = second index
+    THEN attach second to first segment
+    ELSE link first to second segment
+  FI .
+ 
+attach second to first segment :
+  first seg.end  := second seg.end;
+  INT VAR successor of second := second seg.succ;
+  IF successor of second = second index
+    THEN first seg.succ := first index
+    ELSE join segments (atom, first index, successor of second)
+  FI;
+  second index := first index .
+ 
+link first to second segment :
+  first seg.succ  := second index;
+  second seg.pred := first index .
+ 
+first seg :  atom (first index).seg .
+second seg : atom (second index).seg .
+ 
+END PROC join segments;
+ 
+ 
+PROC delete segments (SEQUENCE VAR from, ATOMROW VAR atom,
+                      INT CONST first index, last index, lines) :
+ 
+  determine surrounding segments and new atom index;
+  join surrounding segments;
+  update sequence descriptor .
+ 
+determine surrounding segments and new atom index :
+  INT VAR pred index   := first seg.pred,
+          actual index := last seg.succ;
+  from.index := actual index .
+ 
+join surrounding segments :
+  join segments (atom, pred index, actual index) .
+ 
+update sequence descriptor :
+  from.segment begin := actual index;
+  from.segment end := actual seg.end;
+  from.lines DECR lines .
+ 
+actual seg :  atom (actual index).seg .
+first seg :   atom (first index).seg .
+last seg :    atom (last index).seg .
+ 
+END PROC delete segments;
+ 
+ 
+PROC insert segments (SEQUENCE VAR into, ATOMROW VAR atom,
+                      INT CONST first index, last index, lines) :
+ 
+  join into sequence and new segments;
+  update sequence descriptor .
+ 
+join into sequence and new segments :
+  INT VAR actual index := into.index,
+          pred index   := actual seg.pred;
+  join segments (atom, last index, actual index);
+  actual index := first index;
+  join segments (atom, pred index, actual index) .
+ 
+update sequence descriptor :
+  into.index := first index;
+  into.segment begin := actual index;
+  into.segment end := actual seg.end;
+  into.lines INCR lines .
+ 
+actual seg :  atom (actual index).seg .
+ 
+END PROC insert segments;
+ 
+ 
+PROC next atom (SEQUENCE VAR s, ATOMROW CONST atom) :
+ 
+  IF s.line no <= s.lines
+    THEN to next atom
+    ELSE errorstop ("'down' nach Dateiende")
+  FI .
+ 
+to next atom :
+  disable stop;
+  IF s.index = s.segment end
+    THEN next segment (s, atom)
+    ELSE s.index INCR 1;
+         s.line no INCR 1
+  FI
+ 
+END PROC next atom;
+ 
+ 
+PROC next atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) :
+ 
+  INT CONST destination line := min (s.line no + times, s.lines + 1);
+  jump upto destination segment;
+  position within destination segment .
+ 
+jump upto destination segment :
+  WHILE s.line no + length of actual segments tail < destination line REP
+    next segment (s, atom);
+  PER .
+ 
+position within destination segment :
+  disable stop;
+  s.index INCR (destination line - s.line no);
+  s.line no := destination line .
+ 
+length of actual segments tail :   s.segment end - s.index .
+ 
+END PROC next atoms;
+ 
+ 
+PROC previous atom (SEQUENCE VAR s, ATOMROW CONST atom) :
+ 
+  IF s.line no > 1
+    THEN to previous atom
+    ELSE errorstop ("'up' am Dateianfang")
+  FI .
+ 
+to previous atom :
+  disable stop;
+  IF s.index = s.segment begin
+    THEN previous segment (s, atom)
+    ELSE s.index DECR 1;
+         s.line no DECR 1
+  FI
+ 
+END PROC previous atom;
+ 
+ 
+PROC previous atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) :
+ 
+  INT CONST destination line := max (1, s.line no - times);
+  jump back to destination segment;
+  position within destination segment .
+ 
+jump back to destination segment :
+  WHILE s.line no - length of actual segments head > destination line REP
+    previous segment (s, atom);
+  PER .
+ 
+position within destination segment :
+  disable stop;
+  s.index DECR (s.line no - destination line);
+  s.line no := destination line .
+ 
+length of actual segments head :   s.index - s.segment begin .
+ 
+END PROC previous atoms;
+
+
+TEXT VAR pre, pat, pattern0;
+INT VAR last search line ;
+
+PROC search down (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                  INT CONST max lines, INT VAR column) :
+
+  INT CONST start col := column ,
+            start line := s.lineno ;
+  last search line := min (s.lines, s.lineno + max lines) ;
+  pre:= somefix (pattern) ;
+  pattern0 := pattern ** 0 ;
+  down in atoms (s, atom, pre, column); 
+  IF NOT (last search succeeded CAND like pattern)
+    THEN try again
+  FI; 
+  last search succeeded := TRUE ;
+  column := matchpos (0) . 
+ 
+try again: 
+  WHILE s.line no < last search line
+    REP next atom (s, atom) ;
+        column := 1 ; 
+        down in atoms (s, atom, pre, column); 
+        IF last search succeeded CAND like pattern
+          THEN LEAVE try again
+        FI
+    PER; 
+    column := 1 + LENGTH record; 
+    last search succeeded := FALSE ;
+    LEAVE search down. 
+
+like pattern :
+  correct position ;
+  pat := any (column-1) ;
+  pat CAT any ;
+  pat CAT pattern0 ;
+  pat CAT any ;
+  record LIKE pat .
+
+correct position :
+  IF s.lineno = start line
+    THEN column := start col
+    ELSE column := 1
+  FI .
+
+record : atom (s.index).line .
+
+ENDPROC search down ;
+
+PROC down in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                    INT VAR column) :
+ 
+  last search succeeded := FALSE ;
+  search forwards in actual line ;
+  IF NOT found AND s.line no < last search line
+    THEN search in following lines
+  FI ;
+  IF found
+    THEN last search succeeded := TRUE
+    ELSE set column behind last char
+  FI .
+
+set column behind last char :
+  column := LENGTH atom (s.index).line + 1 .
+
+search forwards in actual line :
+  IF pattern <> ""
+    THEN column := pos (atom (s.index).line, pattern, column)
+  ELIF column > LENGTH atom (s.index).line
+    THEN column := 0
+  FI .
+
+search in following lines :
+  next atom (s, atom) ;
+  IF pattern = ""
+    THEN column := 1 ;
+         LEAVE search in following lines
+  FI ;
+  REP
+    search forwards through segment ;
+    update file position forwards ;
+    IF found OR s.line no = last search line
+      THEN LEAVE search in following lines
+      ELSE next segment (s, atom)
+    FI
+  PER .
+
+search forwards through segment :
+  INT VAR search index := s.index ,
+  last index := min (s.segment end, s.index+(last search line-s.line no));
+  REP
+    column := pos (atom (search index).line, pattern) ;
+    IF found OR search index = last index
+      THEN LEAVE search forwards through segment
+    FI ;
+    search index INCR 1
+  PER .
+
+update file position forwards :
+  disable stop ;
+  s.line no INCR (search index - s.index) ;
+  s.index := search index ;
+  enable stop .
+
+found :  column > 0 .
+
+ENDPROC down in atoms ;
+
+TEXT PROC prefix (TEXT CONST pattern) : 
+ 
+  INT VAR invalid char pos := pos (pattern, ""0"", ""31"", 1) ; 
+  SELECT invalid char pos OF  
+    CASE 0    : pattern 
+    CASE 1    : ""                                              
+    OTHERWISE : subtext (pattern, 1, invalid char pos - 1) 
+  ENDSELECT . 
+ 
+ENDPROC prefix ; 
+
+PROC search up (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                INT CONST max lines, INT VAR column) :
+
+     last search line := max (1, s.lineno - max lines) ;
+     pre:= prefix (pattern);
+     pattern0 := pattern ** 0;
+     remember start point ;
+     up in atoms (s, atom, pre, column); 
+     IF   NOT (last search succeeded CAND last pattern in line found)
+     THEN try again 
+     FI; 
+     last search succeeded := TRUE ;
+     column := matchpos (0) . 
+ 
+  try again: 
+     WHILE s.lineno > last search line OR column > 1
+     REP   previous atom (s, atom); 
+           column := LENGTH record ;
+           up in atoms (s, atom, pre, column); 
+           IF last search succeeded CAND last pattern in line found
+             THEN LEAVE try again
+           FI 
+     PER; 
+     column := 1; 
+     last search succeeded := FALSE ;
+     LEAVE search up. 
+
+  remember start point :
+     INT VAR c:= column, r:= s.lineno;.
+
+  last pattern in line found :
+    column := 2 ;
+    WHILE like pattern CAND right of start REP
+      column := matchpos (0) +1
+    PER ;
+    column DECR 1 ;
+    like pattern CAND right of start .
+
+  like pattern :
+     pat := any (column-1) ;
+     pat CAT any ;
+     pat CAT pattern0 ;
+     pat CAT any ;
+     record LIKE pat .
+
+  right of start : (r > s.lineno COR c >= matchpos(0)) .
+  record         : atom (s.index).line .
+
+ENDPROC search up ;
+
+PROC up in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern,
+                  INT VAR column) :
+
+  last search succeeded := FALSE ;
+  search backwards in actual line ;
+  IF NOT found AND s.line no > last search line
+    THEN search in preceeding lines
+  FI ;
+  IF found
+    THEN last search succeeded := TRUE
+    ELSE column := 1
+  FI .
+
+search backwards in actual line :
+  IF pattern = ""
+    THEN LEAVE search backwards in actual line
+  FI ;
+  INT VAR last pos , new pos := 0 ;
+  REP
+    last pos := new pos ;
+    new pos := pos (atom (s.index).line, pattern, last pos+1) ;
+  UNTIL new pos = 0 OR new pos > column PER ;
+  column := last pos .
+
+search in preceeding lines :
+  previous atom (s, atom) ;
+  IF pattern = ""
+    THEN column := LENGTH atom (s.index).line + 1 ;
+         last search succeeded := TRUE ;
+         LEAVE search in preceeding lines
+  FI ;
+  REP
+    search backwards through segment ;
+    update file position backwards ;
+    IF found OR s.line no = last search line
+      THEN LEAVE search in preceeding lines
+      ELSE previous segment (s, atom)
+    FI
+  PER .
+
+search backwards through segment :
+  INT VAR search index := s.index ,
+  last index := max (s.segment begin, s.index-(s.line no-last search line));
+  REP
+    new pos := 0 ;
+    REP
+      column := new pos ;
+      new pos := pos (atom (search index).line, pattern, column+1) ;
+    UNTIL new pos = 0 PER ;
+    IF found OR search index = last index
+      THEN LEAVE search backwards through segment
+    FI ;
+    search index DECR 1
+  PER .
+
+update file position backwards :
+  disable stop ;
+  s.line no DECR (s.index - search index) ;
+  s.index := search index ;
+  enable stop .
+
+found :  column > 0 .
+
+ENDPROC up in atoms ;
+
+BOOL VAR last search succeeded ;
+
+BOOL PROC pattern found :
+  last search succeeded
+ENDPROC pattern found ;
+
+
+
+PROC delete atom (SEQUENCE VAR used, free, ATOMROW VAR atom) :
+ 
+  disable stop;
+  IF used.line no <= used.lines
+    THEN delete actual atom
+    ELSE errorstop ("'delete' am Dateiende")
+  FI .
+ 
+delete actual atom :
+  position behind actual free segment;
+  split segment (used, atom);
+  INT VAR actual index := used.index;
+  cut off tail of actual used segment;
+  delete segments (used, atom, actual index, actual index, 1);
+  insert segments (free, atom, actual index, actual index, 1) .
+ 
+position behind actual free segment :
+  IF free.line no <= free.lines
+    THEN next segment (free, atom)
+  FI .
+ 
+cut off tail of actual used segment :
+  IF actual index <> used.segment end
+    THEN used.index INCR 1;
+         split segment (used, atom);
+         used.index DECR 1 
+  FI .
+ 
+END PROC delete atom;
+ 
+ 
+PROC insert atom (SEQUENCE VAR used, free,INT VAR unused, ATOMROW VAR atom) :
+ 
+  disable stop;
+  split segment (used, atom);
+  IF free.lines > 0
+    THEN insert new atom from free sequence
+  ELIF unused <= file size
+    THEN insert new atom from unused tail
+  ELSE   errorstop ("FILE-Ueberlauf")
+  FI .
+ 
+insert new atom from free sequence :
+  get a free segments head;
+  make this atom to actual segment;
+  transfer from free to used chain .
+ 
+get a free segments head :
+  IF actual free segment is root segment
+    THEN previous segment (free, atom)
+  FI;
+  position to actual segments head .
+ 
+position to actual segments head :
+  INT VAR actual index := free.segment begin;
+  free.line no DECR (free.index - actual index);
+  free.index := actual index .
+ 
+make this atom to actual segment :
+  IF free.segment end > actual index
+    THEN free.index INCR 1;
+         split segment (free, atom);
+         free.index DECR 1
+  FI .
+ 
+transfer from free to used chain :
+  delete segments (free, atom, actual index, actual index, 1);
+  insert segments (used, atom, actual index, actual index, 1);
+  atom (actual index).line := "" .
+ 
+insert new atom from unused tail :
+  actual index := unused;
+  atom (actual index).seg := 
+                      SEGMENT:(actual index, actual index, actual index);
+  atom (actual index).line := "";
+  insert segments (used, atom, actual index, actual index, 1);
+  unused INCR 1 .
+ 
+actual free segment is root segment :    free.segment begin = free root .
+ 
+END PROC insert atom;
+ 
+ 
+PROC insert next (SEQUENCE VAR used, free, INT VAR unused, ATOMROW VAR atom,
+                  TEXT CONST record) :
+ 
+  IF used.line no > used.lines
+    THEN insert atom (used, free, unused, atom)
+  ELIF actual position before unused nonempty atomrow part
+    THEN forward and insert atom by simple extension of used atomrow part
+    ELSE next atom (used, atom);
+         insert atom (used, free, unused, atom)
+  FI;
+  atom (used.index).line := record .
+ 
+forward and insert atom by simple extension of used atomrow part :
+  used.line no INCR 1;
+  used.lines INCR 1;
+  used.index INCR 1;
+  used.segment end INCR 1;
+  atom (used.segment begin).seg.end INCR 1;
+  unused INCR 1 .
+ 
+actual position before unused nonempty atomrow part :
+  used.index = unused - 1 AND unused part not empty .
+ 
+unused part not empty :  unused <= file size .
+ 
+END PROC insert next;
+ 
+ 
+PROC transfer subsequence (SEQUENCE VAR source, dest, 
+                           ATOMROW VAR atom, INT CONST size) :
+ 
+  IF size > 0
+    THEN INT VAR subsequence size := min (size, source.line no);
+         mark begin of source part;
+         mark end of source part;
+         split destination sequence;
+         transfer part
+  FI .
+ 
+mark begin of source part :
+  previous atoms (source, atom, subsequence size - 1);
+  split segment (source, atom);
+  INT CONST first := source.segment begin .
+ 
+mark end of source part :
+  next atoms (source, atom, subsequence size - 1);
+  INT CONST last := source.segment begin;
+  next atom (source, atom);
+  split segment (source, atom) .
+ 
+split destination sequence :
+  split segment (dest, atom) .
+ 
+transfer part :
+  disable stop;
+  delete segments (source, atom, first, last, subsequence size);
+  source.line no DECR subsequence size;
+  insert segments (dest, atom, first, last, subsequence size);
+  next atoms (dest, atom, subsequence size - 1) .
+ 
+END PROC transfer subsequence;
+ 
+
+
+(********************************************************************)
+(*****                                                          *****)
+(*****                  FILE handler                            *****)
+(*****                                                          *****)
+(********************************************************************)
+
+
+ 
+LET file type    = 1003 ,
+    file type 16 = 1002 ,
+
+    closed       = 0,
+    inp          = 1,
+    outp         = 2,
+    mod          = 3,
+    end          = 4,
+
+    max limit    = 16000,
+    super limit  = 16001;
+
+ 
+TYPE TRANSPUTDIRECTION = INT;
+ 
+ 
+TRANSPUTDIRECTION PROC input :
+  TRANSPUTDIRECTION : (inp)
+END PROC input;
+ 
+ 
+TRANSPUTDIRECTION PROC output :
+  TRANSPUTDIRECTION : (outp)
+END PROC output;
+ 
+ 
+TRANSPUTDIRECTION PROC modify :
+  TRANSPUTDIRECTION : (mod)
+END PROC modify;
+ 
+ 
+FILE VAR result file;
+ 
+ 
+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,
+                            DATASPACE CONST ds) :
+  IF   type (ds) = file type
+  THEN result := ds
+  ELIF type (ds) < 0
+  THEN result := ds; type (ds, file type); initialize (result file)
+  ELSE enable stop; errorstop ("Datenraum hat falschen Typ")
+  FI;
+  reset (result file, mode);
+  result file .
+ 
+result : CONCR (result file) .
+
+END PROC sequential file;
+
+
+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST name) :
+
+  IF   exists (name)
+  THEN get dataspace if file
+  ELIF CONCR (mode) <> inp
+  THEN get new file space
+  ELSE errorstop (""""+name+""" gibt es nicht") ; enable stop
+  FI;
+  update status if necessary;
+  reset (result file, mode);
+  result file .
+
+get dataspace if file :
+  IF type (old (name)) = file type 16
+    THEN reorganize (name)
+  FI ;
+  result := old (name, file type) ;
+  IF is 170 file
+    THEN result.col := 1 ;
+         result.mark line := 0 ;
+         result.mark col  := 0
+  FI .
+
+is 170 file : result.mark col < 0 .
+
+get new file space :
+  result := new (name);
+  IF   NOT is error
+  THEN type (old (name), file type); initialize (result file)
+  FI .
+
+update status if necessary :
+  IF   CONCR (mode) <> inp
+  THEN status (name, ""); headline (result file, name)
+  FI .
+ 
+result : CONCR (result file) .
+ 
+END PROC sequential file;
+ 
+ 
+PROC reset (FILE VAR f) :
+
+  IF f.mode = end
+    THEN reset (f, input)
+    ELSE reset (f, TRANSPUTDIRECTION:(f.mode))
+  FI .
+
+ENDPROC reset ;
+
+PROC reset (FILE VAR f, TRANSPUTDIRECTION CONST mode) :
+
+  IF f.mode <> mod OR new mode <> mod
+    THEN f.mode := new mode ;
+         initialize file index 
+  FI .
+
+initialize file index :
+  IF new mode = outp
+    THEN to line without check (f, f.used.lines);
+         col := super limit
+    ELSE to line without check (f, 1);
+         col := 1 ;
+         IF new mode = inp AND file is empty
+           THEN f.mode := end
+         FI
+  FI .
+ 
+file is empty : f.used.lines = 0 .
+ 
+new mode  : CONCR (mode) .
+
+col :   CONCR (CONCR (f)).col .
+ 
+END PROC reset;
+ 
+ 
+PROC input (FILE VAR f) :
+ 
+  reset (f, input) .
+ 
+END PROC input;
+ 
+ 
+PROC output (FILE VAR f) :
+ 
+  reset (f, output)
+ 
+END PROC output;
+ 
+ 
+PROC modify (FILE VAR f) :
+ 
+  reset (f, modify)
+
+END PROC modify;
+ 
+ 
+PROC close (FILE VAR f) :
+ 
+  f.mode := closed .
+
+END PROC close;
+ 
+ 
+PROC check mode (FILE CONST f, INT CONST mode) :
+ 
+  IF f.mode = mode
+    THEN LEAVE check mode
+    ELIF f.mode = closed
+    THEN errorstop ("Datei zu!")
+    ELIF f.mode = mod
+    THEN errorstop ("unzulaessiger Zugriff auf modify-FILE")
+    ELIF mode = mod
+    THEN errorstop ("Zugriff nur auf modify-FILE zulaessig")
+    ELIF f.mode = end
+    THEN errorstop ("Leseversuch nach Dateiende")
+    ELIF mode = inp
+    THEN errorstop ("Leseversuch auf output-FILE")
+    ELIF mode = outp
+    THEN errorstop ("Schreibversuch auf input-FILE")
+  FI .
+ 
+END PROC check mode;
+ 
+ 
+PROC to line without check (FILE VAR f, INT CONST destination line) :
+ 
+  INT CONST distance := destination line - f.used.line no;
+  IF   distance > 0
+    THEN next atoms (f.used, f.atoms, distance)
+  ELIF distance < 0
+    THEN previous atoms (f.used, f.atoms, - distance)
+  FI .
+ 
+END PROC to line without check;
+ 
+ 
+PROC to line (FILE VAR f, INT CONST destination line) :
+ 
+  check mode (f, mod);
+  to line without check (f, destination line)
+ 
+END PROC to line;
+ 
+ 
+PROC to first record (FILE VAR f) :
+ 
+  to line (f, 1)
+ 
+END PROC to first record;
+ 
+ 
+PROC to eof (FILE VAR f) :
+ 
+  to line (f, f.used.lines + 1) .
+ 
+END PROC to eof;
+ 
+ 
+PROC putline (FILE VAR f, TEXT CONST word) :
+ 
+  write (f, word);
+  col := super limit .
+ 
+col : CONCR (CONCR (f)).col .
+ 
+END PROC putline;
+ 
+ 
+PROC delete record (FILE VAR f) :
+ 
+  check mode (f, mod);
+  delete atom (f.used, f.free, f.atoms) .
+ 
+END PROC delete record;
+ 
+ 
+PROC insert record (FILE VAR f) :
+ 
+  check mode (f, mod);
+  insert atom (f.used, f.free, f.unused tail, f.atoms) .
+ 
+END PROC insert record;
+ 
+ 
+PROC down (FILE VAR f) :
+ 
+  check mode (f, mod);
+  next atom (f.used, f.atoms) .
+ 
+END PROC down ;
+ 
+PROC up (FILE VAR f) :
+ 
+  check mode (f, mod);
+  previous atom (f.used, f.atoms) .
+ 
+END PROC up ;
+
+PROC down (FILE VAR f, INT CONST n) :
+
+  to line (f, lineno (f) + n)
+
+ENDPROC down ;
+
+PROC up (FILE VAR f, INT CONST n) :
+
+  to line (f, lineno (f) - n)
+
+ENDPROC up ;
+
+ 
+PROC write record (FILE VAR f, TEXT CONST record) :
+ 
+  check mode (f, mod);
+  IF   not at eof
+    THEN f.atoms (f.used.index).line := record
+    ELSE errorstop ("'write' nach Dateiende")
+  FI .
+ 
+not at eof :  f.used.line no <= f.used.lines .
+ 
+END PROC write record;
+ 
+ 
+PROC read record (FILE CONST f, TEXT VAR record) :
+ 
+  check mode (f, mod);
+  record := f.atoms (f.used.index).line .
+ 
+END PROC read record;
+ 
+ 
+PROC line (FILE VAR f) :
+ 
+  IF   mode = end
+    THEN errorstop ("Leseversuch nach Dateiende")
+    ELIF mode = inp
+    THEN next atom (f.used, f.atoms); col := 1; check eof
+    ELIF mode = outp
+    THEN IF col <= max limit
+           THEN col := super limit
+           ELSE append empty line
+         FI
+  FI .
+ 
+append empty line :
+  insert next (f.used, f.free, f.unused tail, f.atoms, "") .
+ 
+col : CONCR (CONCR (f)).col .
+ 
+mode : CONCR (CONCR (f)).mode .
+ 
+check eof :
+  IF eof (f) THEN mode := end FI .
+ 
+END PROC line;
+ 
+ 
+PROC line (FILE VAR f, INT CONST lines) :
+ 
+  INT VAR i; FOR i FROM 1 UPTO lines REP line (f) PER
+ 
+END PROC line;
+ 
+
+PROC getline (FILE VAR f, TEXT VAR text) :
+
+  check mode (f, inp);
+  text := subtext (record, f.col);
+  IF f.used.line no >= f.used.lines
+    THEN f.mode := end ;
+         set end of file
+    ELSE to next line ;
+         f.col := 1
+  FI .
+
+to next line :
+  next atom (f.used, f.atoms) .
+
+set end of file :
+  f.col := LENGTH record + 1 .
+
+record : f.atoms (f.used.index).line .
+
+END PROC getline;
+ 
+ 
+BOOL PROC is first record (FILE CONST f) :
+ 
+  check mode (f, mod);
+  f.used.line no = 1 .
+ 
+END PROC is first record;
+ 
+ 
+BOOL PROC eof (FILE CONST f) :
+ 
+  IF   line no < lines THEN FALSE
+  ELIF line no = lines THEN col > LENGTH record
+  ELSE                      TRUE
+  FI .
+
+line no :  f.used.line no .
+lines   :  f.used.lines .
+col     :  f.col .
+record  :  f.atoms (f.used.index).line .
+ 
+END PROC eof;
+ 
+ 
+INT PROC line no (FILE CONST f) :
+ 
+  f.used.line no .
+ 
+END PROC line no;
+
+
+PROC line type (FILE VAR f, INT CONST t) :
+
+  f.atoms (f.used.index).type := t .
+
+ENDPROC line type ;
+
+INT PROC line type (FILE CONST f) :
+
+  f.atoms (f.used.index).type .
+
+ENDPROC line type ;
+ 
+ 
+PROC put (FILE VAR f, TEXT CONST word) :
+ 
+  check mode (f, outp);
+  IF col + LENGTH word > f.limit
+    THEN append new line
+    ELSE record CAT word
+  FI;
+  record CAT " ";
+  col := LENGTH record + 1 .
+ 
+append new line :
+  insert next (f.used, f.free, f.unused tail, f.atoms, word) .
+ 
+record : f.atoms (f.used.index).line .
+col :    f.col .
+ 
+END PROC put;
+
+ 
+PROC put (FILE VAR f, INT CONST value) :
+ 
+  put (f, text (value))
+ 
+END PROC put;
+ 
+ 
+PROC put (FILE VAR f, REAL CONST real) :
+ 
+  put (f, text (real))
+ 
+END PROC put;
+ 
+ 
+PROC write (FILE VAR f, TEXT CONST word) :
+ 
+  check mode (f, outp);
+  IF col + LENGTH word - 1 > f.limit
+    THEN append new line
+    ELSE record CAT word
+  FI;
+  col := LENGTH record + 1 .
+ 
+append new line :
+  insert next (f.used, f.free, f.unused tail, f.atoms, word) .
+ 
+record : f.atoms (f.used.index).line .
+col    : f.col .
+ 
+END PROC write;
+ 
+ 
+PROC get (FILE VAR f, TEXT VAR word, TEXT CONST separator) :
+ 
+  check mode (f, inp);
+  skip separators;
+  IF word found
+    THEN get word
+    ELSE try to find word in next line
+  FI .
+ 
+skip separators :
+  INT CONST separator length := LENGTH separator;
+  WHILE is separator REP col INCR separator length PER .
+
+is separator : 
+  subtext (record, col, col + separator length - 1) = separator .
+ 
+word found : col <= LENGTH record .
+ 
+get word :
+  INT VAR end of word := pos (record, separator, col) - 1;
+  IF separator found
+    THEN get text upto separator
+    ELSE get rest of record
+  FI .
+ 
+separator found : end of word >= 0 .
+ 
+get text upto separator :
+  word := subtext (record, col, end of word);
+  col := end of word + separator length + 1;
+  IF col > LENGTH record THEN line (f) FI .
+ 
+get rest of record :
+  word := subtext (record, col); line (f) .
+ 
+record : f.atoms (f.used.index).line .
+col    : f.col .
+ 
+try to find word in next line :
+  line (f); IF eof (f) THEN word := "" ELSE get (f, word, separator) FI .
+ 
+END PROC get;
+ 
+ 
+PROC get (FILE VAR f, TEXT VAR word, INT CONST max length) :
+ 
+  check mode (f, inp);
+  IF word is only a part of record
+    THEN get text of certain length
+    ELSE get rest of record
+  FI .
+ 
+word is only a part of record :
+  col <= LENGTH record - max length .
+ 
+get text of certain length :
+  word := text (record, max length, col);
+  col INCR max length .
+
+get rest of record :
+  word := subtext (record, col); line (f) .
+ 
+record : f.atoms (f.used.index).line .
+col    : f.col .
+ 
+END PROC get;
+ 
+ 
+PROC get (FILE VAR f, TEXT VAR word) :
+ 
+  get (f, word, " ")
+ 
+END PROC get;
+ 
+ 
+TEXT VAR number word;
+ 
+ 
+PROC get (FILE VAR f, INT VAR number) :
+ 
+  get (f, number word);
+  number := int (number word)
+ 
+END PROC get;
+ 
+ 
+PROC get (FILE VAR f, REAL VAR number) :
+ 
+  get (f, number word);
+  number := real (number word)
+ 
+END PROC get;
+ 
+ 
+TEXT VAR split record ;
+INT VAR indentation ;
+
+PROC split line (FILE VAR f, INT CONST split col) :
+
+  split line (f, split col, TRUE)
+
+ENDPROC split line ;
+
+PROC split line (FILE VAR f, INT CONST split col, BOOL CONST note indentation ) :
+
+  IF note indentation 
+    THEN get indentation 
+    ELSE indentation := 0
+  FI ;
+  get split record ;
+  insert split record and indentation ;
+  cut off old record .
+
+get indentation :
+  indentation := pos (actual record,""33"",""254"",1) - 1 ;
+  IF indentation < 0 OR indentation >= split col
+    THEN indentation := split col - 1
+  FI .
+
+get split record :
+  split record := subtext (actual record, split col, max limit) .
+
+insert split record and indentation :
+  down (f) ;
+  insert record (f) ;
+  INT VAR i ;
+  FOR i FROM 1 UPTO indentation REP
+    actual record CAT " "
+  PER ; 
+  actual record CAT split record ;
+  up (f) .
+
+cut off old record :
+  actual record := subtext (actual record, 1, split col-1) .
+
+actual record : f.atoms (f.used.index).line .
+
+ENDPROC split line ;
+
+PROC concatenate line (FILE VAR f, BOOL CONST delete blanks) :
+
+  down (f) ;
+  split record := actual record ;
+  IF delete blanks
+    THEN delete leading blanks
+  FI ;
+  delete record (f) ;
+  up (f) ;
+  actual record CAT split record .
+
+delete leading blanks :
+  INT CONST non blank col := pos (split record, ""33"", ""254"", 1) ;
+  IF non blank col > 0
+    THEN split record := subtext (split record, non blank col)
+  FI .
+
+actual record :  f.atoms (f.used.index).line .
+
+ENDPROC concatenate line ;
+
+PROC concatenate line (FILE VAR f) :
+  concatenate line (f, TRUE)
+ENDPROC concatenate line ;
+
+PROC reorganize :
+ 
+  reorganize (last param)
+ 
+END PROC reorganize;
+ 
+ 
+TEXT VAR file record ;
+
+PROC reorganize (TEXT CONST file name) :
+ 
+  enable stop ;
+  FILE VAR input file, output file;
+  DATASPACE VAR scratch space;
+  INT CONST type of dataspace := type (old (file name)) ;
+  INT VAR counter;
+ 
+  last param (file name);
+  IF type of dataspace = file type
+    THEN reorganize new to new
+  ELIF type of dataspace = file type 16
+    THEN reorganize old to new
+    ELSE errorstop ("Datenraum hat falschen Typ")
+  FI;
+  replace file space by scratch space .
+ 
+reorganize new to new :
+  input  file := sequential file (input, file name);
+  disable stop ;
+  scratch space := nilspace ;
+  output file := sequential file (output, scratch space);
+  copy attributes (input file, output file) ;
+
+  FOR counter FROM 1 UPTO 9999
+  WHILE NOT eof (input file) REP
+    cout (counter);
+    getline (input file, file record);
+    putline (output file, file record);
+    check for interrupt
+  PER .
+ 
+reorganize old to new :
+  LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT record);
+  LET OLDFILE = BOUND ROW 4075 OLDRECORD;
+  LET dateianker = 2, freianker = 1;
+  INT VAR index := dateianker;
+ 
+  OLDFILE VAR old file := old (file name);
+  disable stop;
+  scratch space := nilspace;
+  output file := sequential file (output, scratch space);
+  get old attributes ;
+ 
+  say ("Datei wird in 1.7-Format gewandelt: ") ;
+
+  FOR counter FROM 1 UPTO 9999
+  WHILE NOT end of old file REP
+    cout (counter);
+    index := next record;
+    file record := record of old file ;
+    IF pos (file record, ""128"", ""250"", 1) > 0
+      THEN change special chars
+    FI ;
+    putline (output file, file record);
+    check for interrupt
+  PER .
+ 
+get old attributes :
+  get old headline ;
+  get old limit and tabs .
+
+get old headline :
+  headline (output file, old file (dateianker).record) .
+
+get old limit and tabs :
+  file record := old file (freianker).record ;
+  max line length (output file, int (subtext (file record, 11, 15))) ;
+  put tabs (output file, subtext (file record, 16)) .
+
+change special chars :
+  change all (file record, ""193"", ""214"") (* Ae *) ;
+  change all (file record, ""207"", ""215"") (* Oe *) ;
+  change all (file record, ""213"", ""216"") (* Ue *) ;
+  change all (file record, ""225"", ""217"") (* ae *) ;
+  change all (file record, ""239"", ""218"") (* oe *) ;
+  change all (file record, ""245"", ""219"") (* ue *) ;
+  change all (file record, ""235"", ""220"") (* k  *) ;
+  change all (file record, ""173"", ""221"") (* -  *) ;
+  change all (file record, ""163"", ""222"") (* fis   *) ;
+  change all (file record, ""160"", ""223"") (* blank *) ;
+  change all (file record, ""194"", ""251"") (* eszet *) .
+
+end of old file :      next record = dateianker .
+
+next record :          old file (index).succ .
+ 
+record of old file :   old file (index).record .
+ 
+check for interrupt :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN errorstop ("Speicherengpass")
+  FI ;
+  IF is error
+    THEN forget (scratch space) ; LEAVE reorganize
+  FI .
+ 
+replace file space by scratch space :
+  headline (output file, file name);
+  forget (file name, quiet) ;
+  type (scratch space, file type);
+  copy (scratch space, file name);
+  forget (scratch space) .
+
+END PROC reorganize;
+
+
+PROC set range (FILE VAR f, INT CONST start line, start col,
+                FRANGE VAR old range) :
+
+  check mode (f, mod);
+  IF valid restriction parameters
+    THEN prepare last line ;
+         prepare first line ;
+         save old range ;
+         set new range
+    ELSE errorstop ("FRANGE ungueltig")
+  FI .
+
+valid restriction parameters :
+  start line > 0 AND start col > 0 AND start before or at actual point .
+
+start before or at actual point :
+  start line < line no (f)  OR
+  start line = line no (f) AND start col <= col (f) .
+
+prepare last line :
+  INT VAR last line ;
+  IF col (f) > 1
+    THEN split line (f, col(f), FALSE)
+  FI .
+
+prepare first line :
+  IF start col > 1
+    THEN split start line ;
+  FI .
+
+split start line :
+  INT VAR old line no := line no (f) ;
+  to line (f, start line) ;
+  split line (f, start col, FALSE) ;
+  to line (f, old line no + 1) .
+
+save old range :
+  old range.pre := f.prefix lines ;
+  old range.post:= f.postfix lines .
+
+set new range :
+  get pre lines ;
+  get post lines ;
+  disable stop ;
+  f.prefix lines INCR pre lines ;
+  f.postfix lines INCR post lines ;
+  f.used.lines DECR (post lines + pre lines) ;
+  f.used.line no DECR pre lines .
+
+get pre lines :
+  INT VAR pre lines ;
+  IF start col = 1
+    THEN old range.pre was split := FALSE ;
+         pre lines := start line - 1
+    ELSE old range.pre was split := TRUE ;
+         pre lines := start line
+  FI .
+
+get post lines :
+  INT VAR post lines ;
+  IF col (f) = 1
+    THEN old range.post was split := FALSE ;
+         post lines := lines (f) - line no (f) + 1
+    ELSE old range.post was split := TRUE ;
+         post lines := lines (f) - line no (f)
+  FI .
+
+END PROC set range;
+
+
+PROC set range (FILE VAR f, FRANGE VAR new range) :
+
+  check mode (f, mod);
+  INT CONST pre add  := prefix - new range.pre,
+            post add := postfix - new range.post;
+  IF pre add < 0 OR post add < 0
+    THEN errorstop ("FRANGE ungueltig")
+    ELSE set new range;
+         undo splitting if necessary ;
+         make range var invalid
+  FI .
+ 
+set new range :
+  disable stop;
+  prefix DECR pre add;
+  postfix DECR post add;
+  used.line no INCR pre add;
+  used.lines INCR (pre add + post add) .
+
+undo splitting if necessary :
+  IF new range.pre was split
+    THEN concatenate first line
+  FI ;
+  IF new range.post was split
+    THEN concatenate last line
+  FI .
+
+concatenate first line :
+  INT VAR old line := line no (f) ;
+  to line (f, pre add) ;
+  concatenate line (f, FALSE) ;
+  to line (f, old line - 1) .
+
+concatenate last line :
+  old line := line no (f) ;
+  to line (f, lines (f) - post add) ;
+  concatenate line (f, FALSE) ;
+  to line (f, old line) .
+
+make range var invalid :
+  new range.pre := maxint .
+ 
+used :    f.used .
+prefix :  f.prefix lines .
+postfix : f.postfix lines .
+ 
+END PROC set range;
+ 
+PROC reset range (FILE VAR f) :
+
+  FRANGE VAR complete ;
+  complete.pre := 0 ;
+  complete.post:= 0 ;
+  complete.pre was split := FALSE ;
+  complete.post was split:= FALSE ;
+  set range (f, complete)
+
+ENDPROC reset range ;
+
+PROC remove (FILE VAR f, INT CONST size) :
+ 
+  check mode (f, mod);
+  transfer subsequence (f.used, f.scratch, f.atoms, size) .
+ 
+END PROC remove;
+ 
+ 
+PROC clear removed (FILE VAR f) :
+ 
+  check mode (f, mod);
+  transfer subsequence (f.scratch, f.free, f.atoms, f.scratch.lines) .
+ 
+END PROC clear removed;
+ 
+ 
+PROC reinsert (FILE VAR f) :
+ 
+  check mode (f, mod);
+  transfer subsequence (f.scratch, f.used, f.atoms, f.scratch.lines) .
+ 
+END PROC reinsert;
+
+
+PROC copy attributes (FILE CONST source file, FILE VAR dest file) :
+
+  dest.limit                     := source.limit ;
+  dest.atoms (free root).line    := source.atoms (free root).line ;
+  dest.atoms (scratch root).line := source.atoms (scratch root).line ;
+  dest.edit info                 := source.edit info .
+
+dest   : CONCR (CONCR (dest file)) .
+source : CONCR (CONCR (source file)) .
+
+ENDPROC copy attributes ;
+ 
+ 
+INT PROC max line length (FILE CONST f) :
+ 
+  f.limit .
+ 
+END PROC max line length;
+ 
+ 
+PROC max line length (FILE VAR f, INT CONST new limit) :
+ 
+  IF new limit > 0 AND new limit <= max limit
+    THEN f.limit := new limit
+  FI .
+ 
+END PROC max line length;
+ 
+ 
+TEXT PROC headline (FILE CONST f) :
+ 
+  f.atoms (free root).line .
+
+END PROC headline;
+ 
+ 
+PROC headline (FILE VAR f, TEXT CONST head) :
+ 
+  f.atoms (free root).line := head .
+ 
+END PROC headline;
+ 
+ 
+PROC get tabs (FILE CONST f, TEXT VAR tabs) :
+ 
+  tabs := f.atoms (scratch root).line .
+ 
+END PROC get tabs;
+ 
+ 
+PROC put tabs (FILE VAR f, TEXT CONST tabs) :
+ 
+  f.atoms (scratch root).line := tabs .
+ 
+END PROC put tabs;
+
+ 
+INT PROC edit info (FILE CONST f) :
+ 
+  f.edit info .
+ 
+END PROC edit info;
+ 
+ 
+PROC edit info (FILE VAR f, INT CONST info) : 
+ 
+  f.edit info := info .
+ 
+END PROC edit info;
+ 
+ 
+INT PROC lines (FILE CONST f) :
+ 
+  f.used.lines .
+ 
+END PROC lines;
+ 
+ 
+INT PROC removed lines (FILE CONST f) :
+ 
+  f.scratch.lines .
+ 
+END PROC removed lines;
+
+
+INT PROC segments (FILE CONST f) :
+
+  segs(f.used,f.atoms) + segs(f.scratch,f.atoms) + segs(f.free,f.atoms) - 2 .
+
+ENDPROC segments ;
+
+
+INT PROC col (FILE CONST f) :
+
+  f.col
+
+ENDPROC col ;
+
+PROC col (FILE VAR f, INT CONST new column) :
+
+  IF new column > 0
+    THEN f.col := new column
+  FI
+
+ENDPROC col ;
+
+TEXT PROC word (FILE CONST f) :
+
+  word (f, " ")
+
+ENDPROC word ;
+
+TEXT PROC word (FILE CONST f, TEXT CONST delimiter) :
+
+  INT VAR del pos := pos (f, delimiter, col (f)) ;
+  IF del pos = 0
+    THEN del pos := len (f) + 1
+  FI ;
+  subtext (f, col (f), del pos - 1)
+
+ENDPROC word ;
+
+TEXT PROC word (FILE CONST f, INT CONST max length) :
+
+  subtext (f, col (f), col (f) + max length - 1)
+
+ENDPROC word ;
+
+BOOL PROC at (FILE CONST f, TEXT CONST word) :
+
+  pat := any (column-1) ;
+  pat CAT word ;
+  pat CAT any ;
+  record LIKE pat .
+
+column : f.col .
+record : f.atoms (f.used.index).line .
+
+ENDPROC at ;
+
+ 
+PROC exec (PROC (TEXT VAR, TEXT CONST) proc, FILE VAR f, TEXT CONST t) :
+ 
+  proc (record, t) .
+ 
+record : f.atoms (f.used.index).line .
+ 
+END PROC exec;
+ 
+ 
+PROC exec (PROC (TEXT VAR, INT CONST) proc, FILE VAR f, INT CONST i) :
+ 
+  proc (record, i) .
+
+record : f.atoms (f.used.index).line .
+ 
+END PROC exec;
+ 
+INT PROC pos (FILE CONST f, TEXT CONST pattern, INT CONST i) :
+ 
+  pos (record, pattern, i) .
+ 
+record : f.atoms (f.used.index).line .
+ 
+END PROC pos ;
+
+PROC down (FILE VAR f, TEXT CONST pattern) :
+
+  down (f, pattern, file size)
+
+ENDPROC down ;
+
+PROC down (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col + 1 ;
+  search down (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC down ;
+
+PROC downety (FILE VAR f, TEXT CONST pattern) :
+ 
+  downety (f, pattern, file size)
+
+ENDPROC downety ;
+
+PROC downety (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col ;
+  search down (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC downety ;
+
+PROC up (FILE VAR f, TEXT CONST pattern) :
+
+  up (f, pattern, file size)
+
+ENDPROC up ;
+
+PROC up (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col - 1 ;
+  search up (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC up ;
+
+PROC uppety (FILE VAR f, TEXT CONST pattern) :
+
+  uppety (f, pattern, file size)
+
+ENDPROC uppety ;
+
+PROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST max line) :
+
+  check mode (f,mod) ;
+  INT VAR pattern pos := f.col ;
+  search up (f.used, f.atoms, pattern, max line, pattern pos) ;
+  f.col := pattern pos
+
+ENDPROC uppety ;
+
+
+INT PROC len (FILE CONST f) :
+
+  length (record) .
+
+record : f.atoms (f.used.index).line .
+
+ENDPROC len ;
+
+TEXT PROC subtext (FILE CONST f, INT CONST from, to) :
+
+  subtext (record, from, to) .
+
+record : f.atoms (f.used.index).line .
+
+ENDPROC subtext ;
+
+PROC change (FILE VAR f, INT CONST from, to, TEXT CONST new) :
+
+  check mode (f, mod) ;
+  change (record, from, to, new) .
+
+record : f.atoms (f.used.index).line .
+
+ENDPROC change ;
+
+ 
+BOOL PROC mark (FILE CONST f) :
+
+  f.mark line > 0
+
+ENDPROC mark ;
+
+PROC mark (FILE VAR f, INT CONST line no, col) :
+
+  IF line no > 0
+    THEN f.mark line := line no + f.prefix lines ;
+         f.mark col  := col
+    ELSE f.mark line := 0 ;
+         f.mark col  := 0
+  FI 
+
+ENDPROC mark ;
+
+INT PROC mark line no (FILE CONST f) :
+
+  IF f.mark line = 0
+    THEN 0
+    ELSE max (1, f.mark line - f.prefix lines)
+  FI
+
+ENDPROC mark line no ;
+
+INT PROC mark col (FILE CONST f) :
+
+  IF f.mark line = 0
+    THEN 0
+  ELIF f.mark line <= f.prefix lines
+    THEN 1
+  ELSE f.mark col
+  FI
+
+ENDPROC mark col ;
+
+PROC set marked range (FILE VAR f, FRANGE VAR old range) :
+
+  IF mark (f)
+    THEN set range (f, mark line no (f), mark col (f), old range)
+    ELSE old range := previous range of file
+  FI .
+
+previous range of file :
+  FRANGE : (f.prefix lines, f.postfix lines, FALSE, FALSE) .
+
+ENDPROC set marked range ;
+
+
+(*****************************************************************)
+
+                                                  (* Autor: P.Heyderhoff *) 
+                                                  (* Stand: 11.10.83     *) 
+ 
+BOUND LIST VAR datei; 
+INT  VAR sortierstelle, sortanker;
+BOOL VAR ascii sort;
+TEXT VAR median, tausch , links, rechts;
+ 
+PROC sort (TEXT CONST dateiname) : 
+     sort (dateiname, 1)
+END PROC sort; 
+ 
+PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : 
+     ascii sort := TRUE ;
+     sortierstelle := sortieranfang; sortiere (dateiname)
+END PROC sort; 
+ 
+PROC lex sort (TEXT CONST dateiname) :
+     lex sort (dateiname, 1)
+ENDPROC lex sort ;
+
+PROC lex sort (TEXT CONST dateiname, INT CONST sortieranfang) :
+     ascii sort := FALSE ;
+     sortierstelle := sortieranfang; sortiere (dateiname)
+ENDPROC lex sort ;
+
+PROC sortiere (TEXT CONST dateiname) :
+
+  reorganize file if necessary ;
+  sort file .
+
+reorganize file if necessary :
+  FILE VAR f := sequential file (modify, dateiname) ;
+  IF segments (f) > 1
+    THEN reorganize (dateiname)
+  FI .
+
+sort file :
+  f := sequential file (modify, dateiname) ;
+  INT CONST sortende := lines (f) + 3 ;
+  sortanker := 1 + 3 ;
+  datei := old (dateiname) ;
+  quicksort(sortanker, sortende) .
+
+END PROC sortiere; 
+ 
+PROC quicksort ( INT CONST anfang, ende ) : 
+     IF   anfang < ende 
+     THEN INT VAR p,q; 
+          spalte    (anfang, ende, p, q); 
+          quicksort (anfang, q); 
+          quicksort (p, ende)    FI 
+END PROC quicksort; 
+ 
+PROC spalte (INT CONST anfang, ende, INT VAR p, q): 
+     fange an der seite an und waehle den median; 
+     ruecke p und q so dicht wie moeglich zusammen; 
+     hole ggf median in die mitte . 
+ 
+   fange an der seite an und waehle den median : 
+     p := anfang; q := ende ; 
+     INT CONST m :: (p + q) DIV 2 ; 
+     median := subtext(datei m, sortierstelle) . 
+ 
+   ruecke p und q so dicht wie moeglich zusammen : 
+     REP schiebe p und q so weit wie moeglich auf bzw ab; 
+         IF p < q THEN vertausche die beiden FI 
+     UNTIL p > q END REP . 
+ 
+   vertausche die beiden : 
+     tausch := datei p; datei p := datei q; datei q := tausch; 
+     p INCR 1; q DECR 1 . 
+ 
+   schiebe p und q so weit wie moeglich auf bzw ab : 
+     WHILE p kann groesser werden REP p INCR 1 END REP; 
+     WHILE q kann kleiner  werden REP q DECR 1 END REP . 
+ 
+   p kann groesser werden : 
+     IF p <= ende 
+       THEN links := subtext (datei p, sortierstelle) ;
+            IF ascii sort
+              THEN median >= links
+              ELSE median LEXGREATEREQUAL links
+            FI
+       ELSE FALSE 
+     FI . 
+ 
+   q kann kleiner werden : 
+     IF q >= anfang 
+       THEN rechts := subtext(datei q, sortierstelle) ;
+            IF ascii sort
+              THEN rechts >= median 
+              ELSE rechts LEXGREATEREQUAL median
+            FI
+       ELSE FALSE 
+     FI . 
+ 
+   hole ggf median in die mitte : 
+     IF   m < q THEN vertausche m und q 
+     ELIF m > p THEN vertausche m und p FI . 
+ 
+   vertausche m und q : 
+     tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . 
+ 
+   vertausche m und p : 
+     tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . 
+ 
+   datei m :  datei.atoms (m).line . 
+   datei p :  datei.atoms (p).line . 
+   datei q :  datei.atoms (q).line . 
+ 
+END PROC spalte; 
+
+END PACKET file handling;
+
diff --git a/system/base/1.7.5/src/functions b/system/base/1.7.5/src/functions
new file mode 100644
index 0000000..9f338ff
--- /dev/null
+++ b/system/base/1.7.5/src/functions
@@ -0,0 +1,760 @@
+PACKET  editor functions  DEFINES                     (* FUNCTIONS - 052 *)
+        (**************)                              (*  17.07.85 -bk-  *)
+                                                      (*  10.09.85 -ws-  *)
+        edit,                                         (*  25.04.86 -sh-  *)
+        show,                                         (*  27.05.86 -wk-  *)
+        U, 
+        D,
+        T,
+        up,
+        down,
+        downety,
+        uppety,
+        to line,
+        PUT,
+        GET,
+        P,
+        G,
+        limit,
+        len,
+        eof,
+        C,
+        change to,
+        CA,
+        change all,
+        lines,
+        line no,
+        col,
+        mark,
+        at,
+        word,
+        std kommando interpreter,
+        note,
+        note line,
+        note edit,
+        anything noted,
+        note file:
+ 
+ 
+LET     marker       = "^",
+        ersatzmarker = "'",
+        schritt      = 50,
+        file size    = 4072,
+        write acc    = TRUE,
+        read acc     = FALSE;
+ 
+LET     bold         = 2,
+        integer      = 3,
+        string       = 4,
+        end of file  = 7;
+ 
+LET     std res      = "eqvw19dpgn"9"";
+ 
+FILE VAR edfile;
+BOOL VAR from scratchfile :: FALSE;
+TEXT VAR kommandotext, tabulator, zeile;
+ 
+
+PROC std kommando interpreter (TEXT CONST taste) :
+  enable stop ; 
+  edfile := editfile;
+  set busy indicator; 
+  SELECT pos (std res, taste) OF
+    CASE 1 (*e*)  : edit 
+    CASE 2 (*q*)  : quit
+    CASE 3 (*v*)  : quit last
+    CASE 4 (*w*)  : open editor (next editor)
+    CASE 5 (*1*)  : toline (1); col (1)
+    CASE 6 (*9*)  : toline (lines); col (len+1)
+    CASE 7 (*d*)  : d case 
+    CASE 8 (*p*)  : p case 
+    CASE 9 (*g*)  : g case 
+    CASE 10(*n*)  : note edit
+    CASE 11(*tab*): change tabs
+    OTHERWISE     : echtes kommando analysieren
+  END SELECT . 
+ 
+d case :
+  IF   mark
+  THEN PUT ""; mark (FALSE); from scratchfile := TRUE
+  ELSE textzeile auf taste legen
+  FI .
+
+p case :
+  IF   mark                                                          (*sh*)
+  THEN IF   write permission 
+       THEN PUT ""; push(""27""12""); from scratchfile := TRUE
+       ELSE out (""7"")
+       FI
+  ELSE textzeile auf taste legen
+  FI .
+
+g case :
+  IF   write permission                                              (*sh*)
+  THEN IF   from scratchfile 
+       THEN GET "" 
+       ELSE IF is editget
+              THEN push (lernsequenz auf taste ("g")); nichts neu
+            FI
+       FI
+  ELSE out (""7"")
+  FI .
+
+textzeile auf taste legen : 
+  read record (edfile, zeile); 
+  zeile := subtext (zeile, col);
+  lernsequenz auf taste legen ("g", zeile);
+  from scratchfile := FALSE; zeile neu . 
+
+next editor :
+  (aktueller editor MOD groesster editor) + 1 .
+ 
+change tabs :
+  get tabs (edfile, tabulator) ;
+  IF   pos (tabulator, marker) <> 0
+  THEN change all (tabulator, marker, ersatzmarker)
+  ELSE change all (tabulator, ersatzmarker, marker)
+  FI ;
+  put tabs (edfile, tabulator) ;
+  ueberschrift neu .
+ 
+echtes kommando analysieren :
+  kommandotext := kommando auf taste (taste);
+  IF   kommandotext = ""
+  THEN nichts neu; LEAVE std kommando interpreter
+  FI ;
+  scan (kommandotext);
+  TEXT VAR s1; INT VAR t1; next symbol (s1, t1);
+  TEXT VAR s2; INT VAR t2; next symbol (s2, t2);
+  IF   t1 = integer AND t2 = end of file THEN toline (int (s1))
+  ELIF t1 = string  AND t2 = end of file THEN down (s1)
+  ELIF perhaps simple up or down         THEN
+  ELIF perhaps simple changeto           THEN
+  ELSE do (kommandotext)
+  FI . 
+ 
+perhaps simple up or down :
+  IF   t1 = bold
+  THEN TEXT VAR s3; INT VAR t3; next symbol (s3, t3);
+       IF   t3 <> end of file THEN FALSE
+       ELIF s1 = "U"          THEN perhaps simple up
+       ELIF s1 = "D"          THEN perhaps simple down
+                              ELSE FALSE
+       FI
+  ELSE FALSE
+  FI .
+ 
+perhaps simple up :
+  IF   t2 = string  THEN up (s2);       TRUE 
+  ELIF t2 = integer THEN up (int (s2)); TRUE 
+                    ELSE                FALSE 
+  FI . 
+ 
+perhaps simple down : 
+  IF   t2 = string  THEN down (s2);       TRUE 
+  ELIF t2 = integer THEN down (int (s2)); TRUE 
+                    ELSE                  FALSE 
+  FI .
+ 
+perhaps simple changeto : 
+  IF   t1 = string AND s2 = "C" AND t3 is string AND t4 is eof 
+  THEN s1 C s3; TRUE 
+  ELSE FALSE 
+  FI . 
+ 
+t3 is string : 
+  next symbol (s3, t3); 
+  t3 = string . 
+
+t4 is eof : 
+  TEXT VAR s4; INT VAR t4; 
+  next symbol (s4, t4); 
+  t4 = end of file . 
+END PROC std kommando interpreter; 
+
+ 
+PROC edit (FILE VAR f) : 
+  enable stop; 
+  IF aktueller editor > 0                                            (*wk*)
+    THEN ueberschrift neu
+  FI ;
+  open editor (f, write acc);
+  edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
+END PROC edit;
+ 
+ 
+PROC edit (FILE VAR f, INT CONST x, y, x size, y size) :
+  enable stop;
+  open editor (groesster editor + 1, f, write acc, x, y, x size, y size);
+  edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
+END PROC edit;
+ 
+
+PROC edit (FILE VAR f, TEXT CONST res, PROC (TEXT CONST) kdo interpreter) :
+  enable stop;
+  open editor (f, write acc);
+  edit (groesster editor, res, PROC(TEXT CONST) kdo interpreter)
+END PROC edit;
+ 
+ 
+PROC edit :
+  IF   aktueller editor > 0
+  THEN dateiname einlesen;
+       edit (dateiname)
+  ELSE edit (last param)
+  FI .
+ 
+dateiname einlesen :
+  INT VAR x, y; get editcursor (x, y);
+  IF x < x size - 17                                                 (*sh*)
+  THEN cursor (x, y);
+       out (""15"Dateiname:"14"");
+       (x size-14-x) TIMESOUT " ";
+       (x size-14-x) TIMESOUT ""8"";
+       TEXT VAR dateiname := std;
+       editget (dateiname);
+       trailing blanks entfernen; 
+       quotes entfernen
+  ELSE errorstop ("Fenster zu klein")
+  FI .
+ 
+trailing blanks entfernen: 
+  INT VAR i := LENGTH dateiname; 
+  WHILE (dateiname SUB i) = " " REP i DECR 1 PER; 
+  dateiname := subtext (dateiname, 1, i) . 
+ 
+quotes entfernen :
+  IF   (dateiname SUB 1) = """" AND (dateiname SUB LENGTH dateiname) = """"
+  THEN dateiname := subtext (dateiname, 2, LENGTH dateiname - 1)
+  FI .
+END PROC edit;
+ 
+ 
+PROC edit (TEXT CONST filename) :
+  IF   filename <> ""
+  THEN edit named file
+  ELSE errorstop ("Name ungueltig")
+  FI . 
+ 
+edit named file :
+  last param (filename);
+  IF   exists (filename) COR yes ("""" + filename + """ neu einrichten")
+  THEN IF aktueller editor > 0 THEN ueberschrift neu FI;             (*sh*)
+       FILE VAR f := sequential file (modify, filename);
+       headline (f, filename); edit (f); last param (filename)
+  ELSE errorstop ("")
+  FI .
+END PROC edit;
+ 
+ 
+PROC edit (TEXT CONST filename, INT CONST x, y, x size, y size) :
+  last param (filename);
+  IF exists (filename) COR yes ("""" + filename + """ neu einrichten")
+  THEN FILE VAR f := sequential file (modify, filename);
+       headline (f, filename); edit (f, x, y, x size, y size);
+       last param (filename)
+  ELSE errorstop ("")
+  FI
+END PROC edit;
+ 
+ 
+PROC edit (INT CONST i) :
+  edit (i, std res, PROC (TEXT CONST) std kommando interpreter)
+END PROC edit;
+ 
+ 
+PROC show (FILE VAR f) :
+  enable stop; 
+  open editor (f, read acc);
+  edit(groesster editor, std res, PROC(TEXT CONST) std kommando interpreter);
+END PROC show;
+ 
+
+PROC show (TEXT CONST filename) :                                    (*sh*)
+  last param (filename);
+  IF   exists (filename)
+  THEN FILE VAR f := sequential file (modify, filename);
+       show (f); last param (filename)
+  ELSE errorstop ("""" + filename + """ gibt es nicht") 
+  FI
+END PROC show; 
+
+ 
+PROC show :
+  show (last param)
+END PROC show;
+ 
+ 
+DATASPACE VAR local space;
+INT  VAR zeilenoffset;
+TEXT VAR kopierzeile;
+ 
+ 
+OP PUT (TEXT CONST filename) :
+  nichts neu;
+  IF   mark 
+  THEN markierten bereich in datei schreiben
+  FI .
+ 
+markierten bereich in datei schreiben :
+  disable stop;
+  zieldatei vorbereiten;
+  quelldatei oeffnen;
+  IF   noch genuegend platz in der zieldatei                         (*sh*)
+  THEN zeilenweise kopieren
+  ELSE errorstop ("FILE-Ueberlauf")
+  FI ;
+  quelldatei schliessen;
+  zieldatei schliessen;
+  set busy indicator .
+
+zieldatei vorbereiten :
+  FRANGE VAR ganze zieldatei;
+  IF exists (filename) THEN forget (filename); ueberschrift neu FI;
+  FILE VAR destination;
+  IF   filename = ""
+  THEN forget (local space); local space := nilspace;
+       destination := sequential file (output, local space)
+  ELSE destination := sequential file (modify, filename) ;
+       INT CONST groesse der zieldatei := lines (destination);       (*sh*)
+       set marked range (destination, ganze zieldatei) ;
+       output (destination)
+  FI .
+
+quelldatei oeffnen :
+  zeilenoffset := mark line no (edfile) - 1;
+  INT CONST old line := line no, old col := col;
+  FRANGE VAR ganze datei;
+  set range (edfile, mark lineno (edfile), mark col (edfile), ganze datei);
+  input (edfile) .
+ 
+noch genuegend platz in der zieldatei :
+  lines + groesse der zieldatei < file size .
+
+zeilenweise kopieren :
+  enable stop;
+  satznr neu;
+  INT VAR zeile;
+  FOR zeile FROM 1 UPTO lines (edfile) REP
+    getline (edfile, kopierzeile);
+    putline (destination, kopierzeile);
+    satznr zeigen
+  PER .
+ 
+quelldatei schliessen :
+  modify (edfile);
+  set range (edfile, ganze datei);
+  to line (old line);
+  col (old col) .
+ 
+zieldatei schliessen :
+  IF   filename <> ""
+  THEN INT CONST last line written := line no (destination) ;
+       modify (destination) ;
+       to line (destination, last line written) ;
+       col (destination, len (destination) + 1) ;
+       bild neu (destination) ;
+       set range (destination, ganze zieldatei)
+  FI .
+END OP PUT;
+
+ 
+OP P (TEXT CONST filename) :
+  PUT filename
+END OP P ;
+
+
+OP GET (TEXT CONST filename) :                                       (*sh*)
+  IF   NOT write permission
+  THEN errorstop ("Schreibversuch auf 'show'-Datei")
+  FI ;
+  quelldatei oeffnen;
+  IF   nicht mehr genuegend platz im editfile 
+  THEN quelldatei schliessen; errorstop ("FILE-Ueberlauf")
+  FI ;
+  disable stop;
+  zieldatei oeffnen;
+  zeilenweise kopieren ;
+  zieldatei schliessen;
+  quelldatei schliessen;
+  set busy indicator .
+
+quelldatei oeffnen :
+  FILE VAR source;
+  FRANGE VAR ganze quelldatei;
+  IF   filename = ""
+  THEN source := sequential file (input, local space)
+  ELSE IF NOT exists (filename) 
+       THEN errorstop ("""" + filename + """ gibt es nicht")
+       FI ;
+       source := sequential file (modify, filename); 
+       INT CONST old line := line no (source),
+                 old col  := col (source);
+       set marked range (source, ganze quelldatei);
+       input (source)
+  FI .
+ 
+nicht mehr genuegend platz im editfile :
+  lines (source) + lines >= file size .
+
+zeilenweise kopieren :
+  enable stop;
+  satznr neu;
+  INT VAR zeile;
+  FOR zeile FROM 1 UPTO lines (source) REP
+    getline (source, kopierzeile);
+    putline (edfile, kopierzeile);
+    satznr zeigen
+  PER .
+ 
+zieldatei oeffnen :
+  zeilenoffset := line no - 1;
+  leere datei in editfile einschachteln;
+  output (edfile) .
+ 
+leere datei in editfile einschachteln :
+  INT CONST range start col := col;
+  FRANGE VAR ganze datei;
+  set range (edfile, line no, col, ganze datei);
+  IF lines = 1 THEN delete record (edfile) FI .
+ 
+quelldatei schliessen :
+  IF   filename <> ""
+  THEN modify (source);
+       set range (source, ganze quelldatei);
+       to line (source, old line);
+       col (source, old col)
+  FI .
+ 
+zieldatei schliessen :
+  modify (edfile);
+  to line (lines);
+  col (range start col);
+  set range (edfile, ganze datei);
+  abschnitt neu (zeilenoffset + 1, lines) .
+END OP GET;
+
+ 
+OP G (TEXT CONST filename) :
+  GET filename
+END OP G;
+ 
+ 
+INT PROC len :
+  len (edfile)
+END PROC len;
+ 
+ 
+PROC col (INT CONST stelle) :
+  nichts neu; col (edfile, stelle)
+END PROC col;
+ 
+ 
+INT PROC col :
+  col (edfile)
+END PROC col;
+ 
+ 
+PROC limit (INT CONST limit) :
+  nichts neu; max line length (edfile, limit)
+END PROC limit;
+ 
+ 
+INT PROC limit :
+  max line length (edfile)
+END PROC limit;
+ 
+ 
+INT PROC lines :
+  lines (edfile)
+END PROC lines;
+ 
+ 
+INT PROC line no :
+  line no (edfile)
+END PROC line no;
+ 
+ 
+PROC to line (INT CONST satz nr) :
+  satznr neu;
+  edfile := editfile; 
+  IF   satz nr > lines 
+  THEN toline (edfile, lines); col (len + 1)
+  ELSE to line (edfile, satz nr)
+  FI
+END PROC to line;
+ 
+ 
+OP T (INT CONST satz nr) :
+  to line (satz nr)
+END OP T;
+ 
+ 
+PROC down (INT CONST anz) :
+  nichts neu; down (edfile, anz)
+END PROC down;
+ 
+ 
+OP D (INT CONST anz) :
+  down (anz)
+END OP D;
+ 
+ 
+PROC up (INT CONST anz) :
+  nichts neu; up (edfile, anz)
+END PROC up;
+ 
+ 
+OP U (INT CONST anz) :
+  up (anz)
+END OP U;
+ 
+ 
+PROC down (TEXT CONST muster) :
+  nichts neu;
+  REP
+    down (muster, schritt - line no MOD schritt);
+    IF   pattern found
+    THEN LEAVE down
+    ELSE satznr zeigen
+    FI
+  UNTIL eof PER
+END PROC down;
+ 
+ 
+OP D (TEXT CONST muster) :
+  down (muster)
+END OP D;
+ 
+ 
+PROC down (TEXT CONST muster, INT CONST anz) :
+  nichts neu; down (edfile, muster, anz)
+END PROC down;
+ 
+ 
+PROC up (TEXT CONST muster) :
+  nichts neu;
+  REP
+    up (muster, (line no - 1) MOD schritt + 1);
+    IF   pattern found
+    THEN LEAVE up
+    ELSE satznr zeigen
+    FI
+  UNTIL line no = 1 PER
+END PROC up;
+ 
+ 
+OP U (TEXT CONST muster) :
+  up (muster)
+END OP U;
+ 
+ 
+PROC up (TEXT CONST muster, INT CONST anz) :
+  nichts neu; up (edfile, muster, anz)
+END PROC up;
+ 
+ 
+PROC downety (TEXT CONST muster) :
+  nichts neu;
+  IF   NOT at (muster)
+  THEN down (muster)
+  FI
+END PROC downety;
+ 
+
+PROC downety (TEXT CONST muster, INT CONST anz) :
+  nichts neu; downety (edfile, muster, anz)
+END PROC downety;
+ 
+
+PROC uppety (TEXT CONST muster) :
+  nichts neu;
+  IF   NOT at (muster)
+  THEN up (muster)
+  FI
+END PROC uppety;
+
+ 
+PROC uppety (TEXT CONST muster, INT CONST anz) :
+  nichts neu; uppety (edfile, muster, anz)
+END PROC uppety;
+
+ 
+OP C (TEXT CONST old, new) :
+  change to (old, new)
+END OP C;
+ 
+OP C (TEXT CONST replacement) : 
+  IF   NOT write permission                                          (*sh*)
+  THEN errorstop ("Schreibversuch auf 'show'-Datei")
+  FI ;
+  IF   at (edfile, match(0))
+  THEN zeile neu; change (edfile, matchpos(0), matchend(0), replacement)
+  FI
+END OP C; 
+ 
+PROC change to (TEXT CONST old, new) :
+  IF   NOT write permission                                          (*sh*)
+  THEN errorstop ("Schreibversuch auf 'show'-Datei")
+  FI ;
+  nichts neu;
+  REP
+    downety (old, schritt - line no MOD schritt);
+    IF   pattern found
+    THEN change (edfile, matchpos(0), matchend(0), new);
+         col (col + LENGTH new); zeile neu;
+         LEAVE changeto
+    ELSE satznr zeigen
+    FI
+  UNTIL eof PER 
+END PROC change to;
+ 
+ 
+OP CA (TEXT CONST old, new) :
+  change all (old, new)
+END OP CA;
+ 
+
+PROC change all (TEXT CONST old, new) :
+  WHILE NOT eof REP old C new PER
+END PROC change all;
+ 
+ 
+BOOL PROC eof :
+  eof (edfile)
+END PROC eof;
+ 
+ 
+BOOL PROC mark :
+  mark (edfile)
+END PROC mark;
+ 
+ 
+PROC mark (BOOL CONST mark on) :
+  nichts neu;
+  IF   mark on
+  THEN mark (edfile, line no, col)
+  ELSE mark (edfile, 0, 0)
+  FI
+END PROC mark;
+ 
+ 
+BOOL PROC at (TEXT CONST pattern) :
+  at (edfile, pattern)
+END PROC at;
+ 
+TEXT PROC word :
+  word (edfile)
+END PROC word;
+
+ 
+TEXT PROC word (TEXT CONST sep) :
+  word (edfile, sep)
+END PROC word;
+
+ 
+TEXT PROC word (INT CONST len) :
+ word (edfile, len)
+END PROC word;
+ 
+ 
+LET no access = 0,
+    edit access = 1,
+    output access = 2;
+ 
+INT VAR last note file mode;
+FILE VAR notebook; 
+INITFLAG VAR this packet := FALSE;
+DATASPACE VAR note ds;
+ 
+ 
+PROC note (TEXT CONST text) :
+  access note file (output access);
+  write (notebook, text)
+END PROC note;
+ 
+
+PROC note (INT CONST number) :
+  access note file (output access);
+  put (notebook, number)
+END PROC note;
+ 
+
+PROC note line :
+  access note file (output access);
+  line (notebook)
+END PROC note line;
+ 
+
+BOOL PROC anything noted :
+  access note file (no access);
+  last note file mode = output access
+END PROC anything noted;
+ 
+
+FILE PROC note file :
+  access note file (output access);
+  notebook
+END PROC note file;
+ 
+
+PROC note edit (FILE VAR context) :                                  (*sh*)
+  access note file (edit access);
+  make notebook erasable;
+  IF aktueller editor = 0
+    THEN open editor (1, context, write acc, 1, 1, x size - 1, y size)
+  FI ;
+  get window size;
+  IF   window large enough
+  THEN include note editor;
+       edit (aktueller editor-1, aktueller editor, aktueller editor-1,
+             std res, PROC (TEXT CONST) std kommando interpreter)
+  FI .
+ 
+get window size : 
+  INT VAR x, y, windows x size, windows y size; 
+  get window (x, y, windows x size, windows y size) .
+ 
+window large enough :
+  windows y size > 4 .
+ 
+include note editor :
+  open editor (aktueller editor + 1, notebook, write acc,
+               x, y + (windows y size + 1) DIV 2,
+               windows x size, windows y size DIV 2) .
+ 
+make notebook erasable :
+  last note file mode := edit access .
+END PROC note edit;
+ 
+
+PROC note edit :
+  access note file (edit access);
+  make notebook erasable;
+  edit (notebook) .
+ 
+make notebook erasable :
+  last note file mode := edit access .
+END PROC note edit;
+ 
+ 
+PROC access note file (INT CONST new mode) :
+  disable stop;
+  initialize note ds if necessary;
+  IF   last note file mode < new mode
+  THEN forget (note ds);
+       note ds := nilspace;
+       notebook := sequential file (output, note ds);
+       headline (notebook, "notebook");
+       last note file mode := new mode
+  FI .
+ 
+initialize note ds if necessary :
+  IF   NOT initialized (this packet)
+  THEN note ds := nilspace;
+       last note file mode := no access
+  FI .
+END PROC access note file;
+
+END PACKET editor functions;
+
diff --git a/system/base/1.7.5/src/init b/system/base/1.7.5/src/init
new file mode 100644
index 0000000..471a717
--- /dev/null
+++ b/system/base/1.7.5/src/init
@@ -0,0 +1,251 @@
+ "run again impossible"
+ "recursive run"
+ "                              " 
+ " Compiler Error : " 
+"              "
+"                                    |" 
+" Fehler entdeckt  " 
+"Keine Fehler gefunden,  "
+" " 
+"       *******  ENDE DER UEBERSETZUNG  *******" 
+"FEHLER bei >> " 
+" <<  " 
+"weiter bei "
+"TEXTende (Anfuehrungszeichen) fehlt irgendwo"
+"Kommentarende fehlt irgendwo" 
+"nach dem Hauptprogramm darf kein Paket folgen"
+"ungueltiger Name fuer ein DEFINES-Objekt" 
+"':' fehlt"
+"nach ENDPACKET folgt nicht der Paketname" 
+"ENDPACKET fehlt" 
+"CONST oder VAR fehlt" 
+"ungueltiger Name"
+" ',' in Deklarationsliste fehlt"
+"ist nicht der PROC Name"
+"fehlerhaftes Ende des Hauptprogramms"
+"ENDPROC fehlt" 
+"PROC/OP Schachtelung unzulaessig" 
+"OP darf kein Parameter sein"
+"steht mehrfach im PACKET Interface" 
+" ist mehrfach deklariert" 
+"ist schon als Datenobjekt deklariert"
+"ist schon als PROC/OP deklariert" 
+"')' nach Parameterliste erwartet" 
+"Standard-Schluesselwort kann nicht redefiniert werden"
+"ungueltig als BOLD" 
+"'(' fehlt"
+"CONST bzw VAR nicht bei Strukturfeldern" 
+"'=' fehlt" 
+"Schluesselwort wird im Paket schon andersartig verwandt"
+"Datentyp fehlt" 
+"ungueltiger OP Name"
+"OP muss monadisch oder dyadisch sein" 
+"ist nicht der OP Name" 
+"ENDOP fehlt" 
+"Name nach ENDPROC fehlt" 
+"Name nach ENDOP fehlt" 
+"';' fehlt"
+"END END ist Unsinn"
+"Dieses END... kenne ich nicht"
+"ROW Groesse ist kein INT" 
+"ROW Groesse ist kein Denoter"
+"Ein ROW muss mindestens ein Element haben"
+"ROW Groesse fehlt" 
+"Parameter kann man nicht initialisieren"
+"Konstanten muessen initialisiert werden"
+"'::' verwenden"
+"')' fehlt" 
+"Exponent fehlt"
+"Undefinierter Typ" 
+"Rekursiv definierter Typ" 
+"Mehrfach definierter Selektor" 
+"Variable bzw. Abkuerzung in der Paket-Schnittstelle" 
+"undefinierte ROW Groesse"
+"Typ Deklarationen nur im Paketrumpf" 
+"CONST bzw. VAR ohne Zusammenhang" 
+"ist nicht deklariert, steht aber in der Paket-Schnittstelle" 
+"ist nicht deklariert"
+"unbekanntes Kommando"
+"THIS IS NO CORRECT EXTERNAL NUMBER." 
+"Schluesselwort unzulaessig"
+"Name erwartet" 
+"Denoter erwartet"
+"ENDPROC ohne Zusammenhang"
+"ENDOP ohne Zusammenhang"
+"Refinement ohne Zusammenhang"
+"Delimiter zwischen Paket-Refinement und Deklaration fehlt"
+"unzulaessiges Selektor-Symbol (kein Name)"
+"BOUND Schachtelungen unzulaessig"
+"BOUND-Objekte unzulaessig als Parameter"
+"Textende fehlt" 
+"TEXT-Denoter zu lang"
+
+"Denoter-Wert wird fuer diese Maschine zu gross" 
+"Compiler-Fehler, wenden Sie sich an Ihren Systemberater!"
+"ist ein zusammenhangloses Schluesselwort"
+"'::' nur fuer Initialisierungen, sonst ':='"
+"welches Objekt soll verlassen werden?"
+"du bist gar nicht innerhalb dieses Refinements"
+"nur die eigene PROC / OP kann verlassen werden"
+"THEN fehlt"
+"FI fehlt"
+"BOOL-Ausdruck erwartet" 
+"ELSE-Teil ist notwendig, da ein Wert geliefert wird"
+"INT-Ausdruck erwartet"
+"OF fehlt"
+"Keine Typanpassung moeglich"
+"CASE-Label fehlt"
+"mindestens eine CASE-Anweisung geben"
+"CASE-Label ist zu gross (skipped)" 
+"mehrfach definiertes CASE-Label"
+"ungueltiges Zeichen nach CASE-Label" 
+"OTHERWISE-Teil fehlt"
+"END SELECT fehlt" 
+"rekursiver Aufruf eines Refinements"
+" wird nicht benutzt" 
+"';' oder Operator ('+','-',...) fehlt"
+"undefinierter monadischer Operator" 
+"undefinierter dyadischer Operator" 
+"Auf die Feinstruktur des Typs kann man nicht mehr zugreifen" 
+"fuer diesen Typ nicht definierter Selektor" 
+"INT,REAL,BOOL,TEXT koennen nicht selektiert werden"
+"bei ROWs nur Subscription"
+"nicht selektierbar" 
+"unzulaessiger Index fuer Subscription"
+"'[' ohne Zusammenhang"
+"']' ohne Zusammenhang"
+"']' nach Subscription fehlt"
+"ungueltig zwischen Anweisungen"
+"nur die letzte Anweisung eines Abschnitts darf einen Wert liefern"
+"Der Paketrumpf kann keinen Wert liefern" 
+"anstelle des letzten Symbols wurde ein Operand erwartet" 
+"Der Schleifenrumpf darf keinen Wert liefern"
+"die Laufvariable muss eine INT VAR sein"
+"wird schon in einer aeusseren Schleife als Laufvariable benutzt"
+"FROM erwartet"
+"UPTO bzw DOWNTO fehlt"
+"REPEAT fehlt"
+"END REP fehlt"
+"die Konstante darf nicht veraendert werden"
+"in einer FOR-Schleife darf die Laufvariable nicht veraendert werden"
+"falscher Typ des Resultats" 
+"ist CONST, es wird aber ein VAR Parameter verlangt"
+"unbekannte Prozedur"
+"Parameter-Prozedur liefert falsches Resultat" 
+"Anzahl bzw. Typen der Parameter sind falsch"
+"unbekannte Parameter-Prozedur" 
+"aktuelle Parameter-Prozedur hat CONST-, formale hat VAR-Parameter"
+"Kein Konstruktor moeglich, da die Feinstruktur hier unbekannt ist"
+"zu wenig Felder angegeben"
+"zu viele Felder angegeben"
+"unzulaessiger Trenner zwischen Feldern"
+"Feld hat falschen Typ"
+"falsche Element-Anzahl im ROW-Konstruktor" 
+"Dieser Typ kann nicht noch mehr konkretisiert werden"
+"BOUND-Objekt zu gross"
+
+"Warnung in Zeile "
+"   Zeile "
+"in Zeile "
+" <----+---> " 
+" TYPE undefiniert "
+" MODE undefiniert "
+"Parameter spezifiziert: "
+"Parameter Typ(en) sind: "
+" B Code, "
+" B Paketdaten generiert"
+"Operand: "
+"Operanden: "
+", "
+"erwartet "
+"gefunden "
+" "
+ 
+(* 001 *)    END
+(* 002 *)    ENDPACKET 
+(* 003 *)    ENDOP
+(* 004 *)    ENDOPERATOR
+(* 005 *)    ENDPROC 
+(* 006 *)    ENDPROCEDURE 
+(* 007 *)    PACKET
+(* 008 *)    OP 
+(* 009 *)    OPERATOR 
+(* 010 *)    PROC 
+(* 011 *)    PROCEDURE 
+(* 012 *)    FI 
+(* 013 *)    ENDIF
+(* 014 *)    ENDREP
+(* 015 *)    ENDREPEAT 
+(* 016 *)    PER 
+(* 017 *)    ELIF 
+(* 018 *)    ELSE
+(* 019 *)    UNTIL 
+(* 020 *)    CASE
+(* 021 *)    OTHERWISE
+(* 022 *)    ENDSELECT
+(* 023 *)    INTERNAL
+(* 024 *)    DEFINES
+(* 025 *)    LET 
+(* 026 *)    TYPE
+(* 027 *)    INT
+(* 028 *)    REAL
+(* 029 *)    DATASPACE
+(* 030 *)    TEXT
+(* 031 *)    BOOL
+(* 032 *)    BOUND
+(* 033 *)    ROW
+(* 034 *)    STRUCT
+(* 035 *)    CONST 
+(* 036 *)    VAR 
+(* 037 INIT CONTROL *)    INTERNAL
+(* 038 *)     CONCR
+(* 039 *)     REP
+(* 040 *)     REPEAT
+(* 041 *)     SELECT
+(* 042 *)     EXTERNAL
+(* 043 *)     IF
+(* 044 *)     THEN 
+(* 045 *)     OF
+(* 046 *)     FOR
+(* 047 *)     FROM
+(* 048 *)     UPTO 
+(* 049 *)     DOWNTO
+(* 050 *)     WHILE
+(* 051 *)     LEAVE
+(* 052 *)     WITH
+(* 053 *)     TRUE
+(* 054 *)     FALSE
+(* 055 *)     ::  SBL  :=  INCR  DECR 
+(* 056 *)     + - * / DIV MOD
+              **
+              AND
+              CAND
+              OR
+              COR
+              NOT
+              =  <>  >  >= < <= 
+(*040  *)     MAIN 
+(*043*)  ENDOFFILE 
+ 
+PACKET a :
+
+PROC out (TEXT CONST t) :
+  EXTERNAL 60
+ENDPROC out ;
+
+PROC out text (TEXT CONST t, INT CONST typ) :
+  INTERNAL 257 ;
+  IF typ = typ
+    THEN out (t)
+  FI
+ENDPROC out text ;
+
+PROC out line (INT CONST typ) :
+  INTERNAL 258 ;
+  IF typ = typ
+    THEN out (""13""10"")
+  FI
+ENDPROC out line ;
+
+ENDPACKET a ; 
+
diff --git a/system/base/1.7.5/src/integer b/system/base/1.7.5/src/integer
new file mode 100644
index 0000000..aefb77f
--- /dev/null
+++ b/system/base/1.7.5/src/integer
@@ -0,0 +1,265 @@
+(* -------------------   STAND :        23.10.85 --------------------*)
+PACKET integer DEFINES text, int, MOD,
+                       sign, SIGN, abs, ABS, **, min, max, minint, maxint,
+                       random, initialize random ,
+                       last conversion ok, set conversion :
+ 
+INT PROC minint : -32767 - 1 ENDPROC minint ;
+
+INT PROC maxint : 32767 ENDPROC maxint ;
+ 
+ 
+TEXT PROC text (INT CONST number) : 
+ 
+  IF   number =  minint THEN "-32768"
+  ELIF number <  0      THEN "-" + text(-number) 
+  ELIF number <= 9      THEN code (number + 48) 
+                        ELSE text (number DIV 10) + digit 
+  FI . 
+ 
+digit : 
+  code ( number MOD 10 + 48 ) . 
+ 
+ENDPROC text ;
+ 
+TEXT PROC text (INT CONST number, length) : 
+ 
+  TEXT VAR result := text (number) ;
+  INT CONST number length := LENGTH result ;
+  IF number length < length 
+    THEN (length - number length) * " " + result 
+  ELIF number length > length 
+    THEN length * "*" 
+  ELSE   result 
+  FI 
+ 
+ENDPROC text ;
+ 
+INT PROC int (TEXT CONST number) : 
+ 
+  skip blanks and sign ;
+  get value ;
+  result . 
+ 
+skip blanks and sign : 
+  BOOL VAR number is positive ;
+  INT VAR pos := 1 ;
+  skip blanks ;
+  IF (number SUB pos) = "-"
+    THEN number is positive := FALSE ;
+         pos INCR 1
+  ELIF (number SUB pos) = "+"
+    THEN number is positive := TRUE ;
+         pos INCR 1
+  ELSE   number is positive := TRUE
+  FI . 
+ 
+get value : 
+  INT VAR value ;
+  get first digit ;
+  WHILE is digit REP 
+    value := value * 10 + digit ; 
+    pos INCR 1 
+  PER ;
+  set conversion ok result .
+
+get first digit :
+  IF is digit
+    THEN value := digit ;
+         pos INCR 1
+    ELSE set conversion (FALSE) ;
+         LEAVE int WITH 0
+  FI .
+ 
+is digit : 0 <= digit AND digit <= 9 . 
+ 
+digit : code (number SUB pos) - 48 .
+ 
+result : 
+  IF number is positive
+    THEN   value 
+    ELSE - value 
+  FI .
+ 
+set conversion ok result :
+  skip blanks ;
+  conversion ok := (pos > LENGTH number) .
+ 
+skip blanks :
+  WHILE (number SUB pos) = " " REP
+    pos INCR 1
+  PER .
+ 
+ENDPROC int ;
+ 
+INT OP MOD (INT CONST left, right) : 
+ 
+  EXTERNAL 43
+ 
+ENDOP MOD ;
+
+INT PROC sign (INT CONST argument) : 
+ 
+  IF argument < 0 THEN -1 
+  ELIF argument > 0 THEN 1 
+  ELSE 0 
+  FI 
+ 
+ENDPROC sign ; 
+ 
+INT OP SIGN (INT CONST argument) : 
+  sign (argument) 
+ENDOP SIGN ;
+ 
+INT PROC abs (INT CONST argument) : 
+ 
+  IF argument > 0 THEN argument 
+  ELSE - argument 
+  FI 
+ 
+ENDPROC abs ;
+ 
+INT OP ABS (INT CONST argument) : 
+  abs (argument) 
+ENDOP ABS ;
+ 
+INT OP ** (INT CONST arg, exp) : 
+ 
+  INT VAR x := arg , z := 1 ,
+          counter := exp ;
+ 
+  IF exp = 0 
+    THEN LEAVE ** WITH 1
+  ELIF exp < 0
+    THEN LEAVE ** WITH 1 DIV arg
+  FI ;
+ 
+  WHILE counter >= 2 REP 
+    calculate new x and z ;
+    counter := counter DIV 2 ;
+  ENDREP ;
+  z * x . 
+ 
+calculate new x and z : 
+  IF counter is not even 
+    THEN z := z * x 
+  FI ;
+  x := x * x . 
+ 
+counter is not even : 
+  counter MOD 2 = 1 . 
+ 
+ENDOP ** ;
+ 
+INT PROC min (INT CONST first, second) : 
+ 
+  IF first < second THEN first ELSE second FI 
+ 
+ENDPROC min ;
+ 
+INT PROC max (INT CONST first, second) : 
+ 
+  IF first > second THEN first ELSE second FI 
+ 
+ENDPROC max ; 
+ 
+ 
+ 
+BOOL VAR conversion ok := TRUE ;
+ 
+BOOL PROC last conversion ok :
+  conversion ok
+ENDPROC last conversion ok ;
+ 
+PROC set conversion (BOOL CONST success) :
+  conversion ok := success
+ENDPROC set conversion ;
+ 
+ 
+ 
+(*******************************************************************)
+(*                                                                 *)
+(*                                        Autor: A. Flammenkamp    *)
+(*       RANDOM GENERATOR                                          *)
+(*                                                                 *)
+(*                         x    :=  4095 * x  MOD (4095*4096+4093) *)
+(*                          n+1             n                      *)
+(*                                                                 *)
+(*                         Periode: 2**24-4  >  16.0e6             *)
+(*                                                                 *)
+(*       Beachte:  x = 4096 * x1 + x0,  0 <= x0,x1 < 4096          *)
+(*                                                                 *)
+(*******************************************************************)
+
+
+INT VAR high := 1, low := 0 ;
+
+PROC initialize random (INT CONST start) :
+
+  low := start MOD 4096 ;
+  IF start < 0
+    THEN high := 256 + 16 + start DIV 4096 ;
+         IF low <> 0 THEN high DECR 1 FI
+    ELSE high := 256 + start DIV 4096
+  FI
+
+ENDPROC initialize random ;
+
+INT PROC random (INT CONST lower bound, upper bound) :
+
+  compute new random value ;
+  normalize high ;
+  normalize low ;
+  map into interval .
+
+compute new random value :
+  (*  (high,low) := (low-high , 3*high-low) *)
+  high := low - high ;
+  low INCR low - 3 * high .
+
+normalize high :
+  IF high < 0
+    THEN high INCR 4096 ; low DECR 3
+  FI .
+
+normalize low :
+  (*  high INCR low DIV 4096 ;
+      low := low MOD 4096
+  *)
+  IF low >= 4096 THEN low overflow
+  ELIF low < 0   THEN low underflow
+  FI .
+
+low overflow :
+  IF low >= 8192
+    THEN low DECR 8192 ; high INCR 2
+    ELSE low DECR 4096 ; high INCR 1 ; post normalization
+  FI .
+
+post normalization :
+  (*  IF (high,low) >= (4095,4093)
+        THEN (high,low) DECR (4095,4093)
+      FI
+  *)
+  IF high >= 4095
+    THEN IF    low >= 4093 THEN high DECR 4095 ; low DECR 4093
+         ELIF high  = 4096 THEN high := 0      ; low INCR 3
+         FI
+  FI .
+
+low underflow :
+  low INCR 4096 ; high DECR 1 .
+
+map into interval :
+  INT VAR number := high MOD 16 - 8 ;
+  number INCR 4095 * number + low ;
+  IF lower bound <= upper bound
+    THEN lower bound + number MOD (upper bound - lower bound + 1)
+    ELSE upper bound + number MOD (lower bound - upper bound + 1)
+  FI .
+
+ENDPROC random ;
+
+
+ENDPACKET integer ;
+
diff --git a/system/base/1.7.5/src/local manager b/system/base/1.7.5/src/local manager
new file mode 100644
index 0000000..48d024b
--- /dev/null
+++ b/system/base/1.7.5/src/local manager
@@ -0,0 +1,373 @@
+(* ------------------- VERSION 2     24.02.86 ------------------- *)
+PACKET local manager                         (* Autor: J.Liedtke  *) 
+ 
+  DEFINES 
+          create,        (* neue lokale Datei einrichten *) 
+          new,           (* 'create' und Datei liefern   *) 
+          old,           (* bestehende Datei liefern     *) 
+          forget,        (* lokale Datei loeschen        *) 
+          exists,        (* existiert Datei (lokal) ?    *) 
+          status,        (* setzt und liefert Status     *)
+          rename,        (* Umbenennung                  *) 
+          copy ,         (* Datenraum in Datei kopieren  *) 
+          enter password,(* Passwort einfuehren          *)
+          write password ,
+          read password ,
+          write permission ,
+          read permission ,
+          begin list ,
+          get list entry ,
+          all :
+
+ 
+ 
+LET size = 200 ,
+    nil  = 0 ;
+
+INT VAR index ; 
+ 
+TEXT VAR system write password := "" ,
+         system read password := "" ,
+         actual password ;
+
+INITFLAG VAR this packet := FALSE ;
+
+DATASPACE VAR password space ;
+
+BOUND ROW size STRUCT (TEXT write, read) VAR passwords ;
+ 
+ 
+THESAURUS VAR dir := empty thesaurus ;
+
+ROW size STRUCT (DATASPACE ds,
+                 BOOL protected,
+                 TEXT status) VAR crowd ;
+ 
+
+PROC initialize if necessary :
+
+  IF NOT initialized (this packet)
+    THEN system write password := "" ;
+         system read password := "" ;
+         dir := empty thesaurus ;
+         password space := nilspace ;
+         passwords := password space 
+  FI
+
+ENDPROC initialize if necessary ;
+
+ 
+ 
+PROC create (TEXT CONST name) : 
+ 
+IF exists (name )
+  THEN error (name, "existiert bereits") ; 
+       index := nil 
+  ELSE insert and initialize entry 
+FI . 
+ 
+insert and initialize entry : 
+  disable stop ;
+  insert (dir, name, index) ; 
+  IF index <> nil 
+    THEN crowd (index).ds := nilspace ;
+         IF is error
+           THEN delete (dir, name, index) ;
+                LEAVE create 
+         FI ;
+         status (name, "") ;
+         crowd (index).protected := FALSE
+  ELIF NOT is error
+    THEN errorstop ("zu viele Dateien")
+  FI . 
+ 
+ENDPROC create ; 
+ 
+DATASPACE PROC new (TEXT CONST name) : 
+ 
+  create (name) ; 
+  IF index <> nil 
+    THEN crowd (index).ds 
+    ELSE nilspace 
+  FI 
+ 
+ENDPROC new ; 
+ 
+DATASPACE PROC old (TEXT CONST name) : 
+ 
+  initialize if necessary ;
+  index := link (dir, name) ;
+  IF index = 0
+    THEN error (name, "gibt es nicht") ;
+         nilspace
+    ELSE space
+  FI .
+
+space : crowd (index).ds .
+ 
+ENDPROC old ; 
+ 
+DATASPACE PROC old (TEXT CONST name, INT CONST expected type) :
+
+  initialize if necessary ;
+  index := link (dir, name) ;
+  IF index = 0
+    THEN error (name, "gibt es nicht") ;
+         nilspace
+  ELIF type (space) <> expected type
+    THEN errorstop ("Datenraum hat falschen Typ") ;
+         nilspace
+    ELSE space
+  FI .
+
+space : crowd (index).ds .
+
+ENDPROC old ;
+
+BOOL PROC exists (TEXT CONST name) : 
+ 
+  initialize if necessary ;
+  dir CONTAINS name 
+ 
+ENDPROC exists ; 
+ 
+PROC forget (TEXT CONST name ) : 
+ 
+  initialize if necessary ;
+  say ("""") ;
+  say (name) ;
+  IF   NOT exists (name)   THEN say (""" existiert nicht") 
+  ELIF yes (""" loeschen") THEN forget (name, quiet)
+  FI .
+ 
+ENDPROC forget ;
+
+PROC forget (TEXT CONST name, QUIET CONST q) :
+  
+  initialize if necessary ;
+  disable stop ;
+  delete (dir, name, index) ; 
+  IF index <> nil 
+    THEN forget ( crowd (index).ds ) ;
+         crowd (index).status := ""
+  FI .
+ 
+ENDPROC forget ; 
+ 
+PROC forget :
+ 
+  BOOL VAR status := command dialogue ;
+  command dialogue (TRUE) ;
+  forget (last param) ;
+  command dialogue (status)
+ 
+ENDPROC forget ;
+ 
+PROC status (TEXT CONST name, status text) :
+ 
+  initialize if necessary ;
+  INT VAR index := link (dir, name) ; 
+  IF index > 0 
+    THEN crowd (index).status := date + " " + text (status text, 4)
+  FI 
+ 
+ENDPROC status ; 
+ 
+TEXT PROC status (TEXT CONST name) :
+ 
+  initialize if necessary ;
+  INT VAR index := link (dir, name) ;
+  IF index > 0
+    THEN crowd (index).status
+    ELSE ""
+  FI
+ 
+ENDPROC status ;
+ 
+PROC status (INT CONST pos, TEXT CONST status pattern) :
+ 
+  initialize if necessary ;
+  INT VAR index := 0 ;
+  WHILE index < highest entry (dir) REP
+    index INCR 1 ;
+    replace (actual status, pos , status pattern)
+  PER .
+ 
+actual status : crowd (index).status .
+ 
+ENDPROC status ;
+ 
+PROC copy (DATASPACE CONST source, TEXT CONST dest name) : 
+ 
+  IF exists (dest name)
+    THEN error (dest name, "existiert bereits") 
+    ELSE copy file
+  FI .
+ 
+copy file :
+  disable stop ;
+  create ( dest name ) ;
+  INT VAR index := link (dir, dest name) ;
+  IF index > nil
+    THEN forget (crowd (index).ds) ;
+         crowd (index).ds := source 
+  FI 
+ 
+ENDPROC copy ; 
+ 
+PROC copy (TEXT CONST source name, dest name) :
+ 
+  copy (old (source name), dest name)
+ 
+ENDPROC copy ;
+ 
+PROC rename (TEXT CONST old name, new name) : 
+ 
+  IF exists (new name)
+    THEN error (new name, "existiert bereits")
+  ELIF exists (old name)
+    THEN rename (dir, old name, new name) ;
+         last param (new name)
+  ELSE   error (old name, "gibt es nicht")
+  FI .
+ 
+ENDPROC rename ;
+ 
+ 
+PROC begin list :
+ 
+  initialize if necessary ;
+  index := 0
+ 
+ENDPROC begin list ;
+ 
+PROC get list entry (TEXT VAR entry, status text) :
+ 
+  get (dir, entry, index) ;
+  IF found 
+    THEN status text := crowd (index).status ;
+    ELSE status text := "" ;
+  FI .
+ 
+found : index > 0 .
+ 
+ENDPROC get list entry ;
+ 
+ 
+TEXT PROC write password :
+ 
+  system write password
+ 
+ENDPROC write password ;
+ 
+TEXT PROC read password :
+ 
+  system read password
+ 
+ENDPROC read password ;
+ 
+
+PROC enter password (TEXT CONST password) :
+ 
+  initialize if necessary ;
+  say (""3""5"") ;
+  INT CONST slash pos := pos (password, "/") ;
+  IF slash pos = 0
+    THEN system write password := password ;
+         system read password  := password
+    ELSE system write password := subtext (password, 1, slash pos-1) ;
+         system read password  := subtext (password, slash pos+1)
+  FI .
+ 
+ENDPROC enter password ;
+ 
+PROC enter password (TEXT CONST file name, write pass, read pass) :
+ 
+  INT CONST index := link (dir, file name) ;
+  IF index > 0
+    THEN set protect password
+  FI .
+
+set protect password :
+  IF write pass = "" AND read pass = ""
+    THEN crowd (index).protected := FALSE
+    ELSE crowd (index).protected := TRUE ;
+         passwords (index).write := write pass ;
+         passwords (index).read  := read pass
+  FI .
+ 
+ENDPROC enter password ;
+ 
+INT PROC password index (TEXT CONST file name) :
+
+  initialize if necessary ;
+  INT CONST index := link (dir, file name) ;
+  IF index > 0 CAND crowd (index).protected
+    THEN index
+    ELSE 0
+  FI
+
+ENDPROC password index ;
+
+BOOL PROC read permission (TEXT CONST name, supply password) :
+ 
+  (****************************************************************) 
+  (*  for reasons of data security the password check algorithm   *)
+  (*  must not copy parts of the file password into variables     *)
+  (*  located in the standard dataspace!                          *)
+  (****************************************************************)
+
+  access file password ;
+  file has no password COR (supply password <> "-" AND read password match) .
+
+read password match :
+  file password.read = supply password OR file password.read = "" .
+
+access file password :
+  INT CONST pw index := password index (name) .
+
+file password :  passwords (pw index) .
+
+file has no password :  pw index = 0 .
+
+ENDPROC read permission ;
+ 
+BOOL PROC write permission (TEXT CONST name, supply password) :
+ 
+  (****************************************************************) 
+  (*  for reasons of data security the password check algorithm   *)
+  (*  must not copy parts of the file password into variables     *)
+  (*  located in the standard dataspace!                          *)
+  (****************************************************************)
+
+  access file password ;
+  file has no password COR (supply password <> "-" AND write password match).
+
+write password match :
+  file password.write = supply password OR file password.write = "" .
+
+access file password :
+  INT CONST pw index := password index (name) .
+
+file password :  passwords (pw index) .
+
+file has no password :  pw index = 0 .
+
+ENDPROC write permission ;
+ 
+THESAURUS PROC all :
+
+  initialize if necessary ;
+  THESAURUS VAR result := dir ; (*ueberfluessig ab naechstem Compiler *)
+  result
+
+ENDPROC all ;
+
+PROC error (TEXT CONST file name, error text) :
+
+  errorstop ("""" + file name + """ " + error text)
+
+ENDPROC error ;
+
+ENDPACKET local manager ;
+
diff --git a/system/base/1.7.5/src/local manager 2 b/system/base/1.7.5/src/local manager 2
new file mode 100644
index 0000000..8f70301
--- /dev/null
+++ b/system/base/1.7.5/src/local manager 2
@@ -0,0 +1,41 @@
+ 
+PACKET local manager part 2 DEFINES            (* Autor: J.Liedtke *)
+                                               (* Stand: 25.02.85  *)
+  list :
+ 
+ 
+TEXT VAR file name, status text;
+
+
+PROC list :
+ 
+  disable stop ;
+  DATASPACE VAR ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) ;
+  headline (list file, "list") ;
+  list (list file) ;
+  show (list file) ;
+  forget (ds) .
+ 
+ENDPROC list ;
+ 
+PROC list (FILE VAR f) :
+ 
+  enable stop ;
+  begin list ;
+  putline (f, "") ;
+  REP
+    get list entry (file name, status text) ;
+    IF file name = ""
+      THEN LEAVE list
+    FI ;
+    write (f, status text + "  """ ) ;
+    write (f, file name) ;
+    write (f, """") ;
+    line (f)
+  PER .
+ 
+ENDPROC list ;
+ 
+ENDPACKET local manager part 2 ;
+
diff --git a/system/base/1.7.5/src/mathlib b/system/base/1.7.5/src/mathlib
new file mode 100644
index 0000000..c726495
--- /dev/null
+++ b/system/base/1.7.5/src/mathlib
@@ -0,0 +1,268 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PACKET mathlib DEFINES sqrt, **, exp, ln, log2, log10, e, pi,
+                       sin, cos, tan, sind, cosd, tand,
+                       arctan, arctand, random, initializerandom :
+ 
+LET  pii   =  3.141592653589793238462,
+     pi2   =  1.570796326794896619231,
+     pi3   =  1.047197551196597746154,
+     pi6   =  0.523598775598298873077,
+     pi4   =  1.273239544735162686151,
+     ln2   =  0.693147180559945309417,
+     lg2   =  0.301029995663981195213,
+     ln10  =  2.302585092994045684018,
+     lge   =  0.434294481903251827651,
+     ei    =  2.718281828459045235360,
+     pi180 = 57.295779513082320876798,
+     sqrt3 =  1.732050807568877293527,
+     sqr3  =  0.577350269189625764509,
+     sqr3p2=  3.732050807568877293527,
+     sqr3m2=  0.267949192431122706473,
+     sqr2  =  0.707106781186547524400;
+
+REAL VAR rdg::0.4711; 
+ 
+REAL PROC pi:   pii     END PROC pi; 
+REAL PROC e :   ei      END PROC e; 
+ 
+REAL PROC  ln  ( REAL CONST x ): 
+     log2(x) * ln2
+END PROC ln; 
+ 
+REAL PROC log10( REAL CONST x ): 
+     log2(x) * lg2 
+END PROC log10; 
+
+REAL PROC log2 ( REAL CONST z ): 
+ REAL VAR t, summe::0.0, x::z;
+ IF   x=1.0  THEN 0.0
+ ELIF x>0.0  THEN normal
+             ELSE errorstop("log2: " + text (x,20)); 0.0   FI. 
+
+normal: 
+  IF   x >= 0.5   THEN  normalise downwards 
+                  ELSE  normalise upwards      FI; 
+  IF   x < sqr2   THEN  summe := summe - 0.75; t := trans8
+                  ELSE  summe := summe - 0.25; t := trans2  FI;
+  summe + reihenentwicklung. 
+ 
+ normalise downwards: 
+  WHILE  x >= 8.0 REP    x := 0.0625 * x;  summe:=summe+4.0  PER; 
+  WHILE  x >= 1.0 REP    x :=    0.5 * x;  summe:=summe+1.0  PER. 
+ 
+ normalise upwards: 
+  WHILE x<=0.0625 REP    x :=   16.0 * x;  summe:=summe-4.0  PER; 
+  WHILE x<= 0.5   REP    x :=    2.0 * x;  summe:=summe-1.0  PER. 
+ 
+ trans8: (x - 0.5946035575013605)/(x + 0.5946035575013605). 
+ trans2: (x - 0.8408964152537145)/(x + 0.8408964152537145).
+ 
+ reihenentwicklung:  x := t * t;         t * 0.06405572387119384648 * 
+  ((((((3.465*x+4.095)*x+5.005)*x+6.435)*x+9.009)*x+15.015)*x+45.045)
+END PROC log2;
+ 
+REAL PROC sqrt ( REAL CONST z ): 
+  REAL VAR y0, y1, x::z; 
+  INT  VAR p :: decimal exponent(x) DIV 2; 
+  IF   p <= -64  THEN 0.0
+  ELIF x < 0.0  THEN errorstop("sqrt: " + text (x,20)); 0.0
+                ELSE nontrivial    FI. 
+ 
+ nontrivial: 
+  set exp (decimal exponent (x) -p-p, x);
+  IF x<10.0 THEN x := 5.3176703 - 40.760905/( 8.408065 + x )
+            ELSE x := 16.81595  - 1288.973 /( 84.08065 + x )  FI; 
+  y0 := x;
+  set exp (decimal exponent (x) + p, y0);
+  y1 := 0.5 * ( y0 + z/y0 ); 
+  y0 := 0.5 * ( y1 + z/y1 ); 
+  y1 := 0.5 * ( y0 + z/y0 ); 
+        0.5 * ( y1 + z/y1 ) 
+END PROC sqrt; 
+ 
+REAL PROC exp ( REAL CONST z ): 
+ REAL VAR x::z, a::1.0;  BOOL VAR negativ :: x<0.0;
+ IF   negativ        THEN x := -x  FI;
+ IF   x>292.42830676 
+   THEN IF NOT negativ THEN errorstop ("REAL-Ueberlauf") FI ; 0.0
+ ELIF x<=0.0001 
+   THEN ( 0.5*z + 1.0 ) * z + 1.0
+   ELSE approx 
+ FI.
+ 
+ approx: 
+ IF x > ln10 
+ THEN x := lge*x; 
+      a := 1.0;
+      set exp (int(x), a);
+      x := frac(x)*ln10
+ FI;
+ IF x >= 2.0   THEN a := 7.389056098930650227230*a; x := x-2.0   FI;
+ IF x >= 1.0   THEN a := 2.718281828459045235360*a; x := x-1.0   FI;
+ IF x >= 0.5   THEN a := 1.648721270700128146848*a; x := x-0.5   FI;
+ IF x >= 0.25  THEN a := 1.284025416687741484073*a; x := x-0.25  FI;
+ IF x >= 0.125 THEN a := 1.133148453066826316829*a; x := x-0.125 FI;
+ IF x >= 0.0625THEN a := 1.064494458917859429563*a; x := x-0.0625FI;
+ a:=a/50.4*(((((((0.01*x+0.07)*x+0.42)*x+2.1)*x+8.4)*x+25.2)*x+50.4)*x+50.4);
+ IF negativ THEN 1.0/a ELSE a FI .
+
+ENDPROC exp ;
+
+REAL PROC tan (REAL CONST x): 
+  IF x < 0.0 THEN - tg( -x * pi4)
+             ELSE   tg(  x * pi4)  FI
+END PROC tan; 
+ 
+REAL PROC tand (REAL CONST x): 
+  IF x < 0.0 THEN - tg( -x / 45.0)
+             ELSE   tg(  x / 45.0) FI
+END PROC tand; 
+ 
+REAL PROC tg (REAL CONST x ): 
+  REAL VAR q::floor(x), s::x-q; INT VAR n;
+  q := q - floor(0.25*q) * 4.0 ; 
+  IF q < 2.0
+  THEN IF q < 1.0
+       THEN n:=0;
+       ELSE n:=1; s := 1.0 - s FI
+  ELSE IF q < 3.0
+       THEN n:=2;
+       ELSE n:=3; s := 1.0 - s FI
+  FI;
+  q := s * s;
+  q := (((((((((-5.116186989653120e-11*q-5.608325022830701e-10)*q- 
+  9.526170109403018e-9)*q-1.517906721393745e-7)*q-2.430939946375515e-6)*q- 
+  3.901461426385464e-5)*q-6.324811612385572e-4)*q-1.076606829172646e-2)*q- 
+  0.2617993877991508)*q+pi4); 
+
+  SELECT n OF
+  CASE 0 : s/q
+  CASE 1 : q/s
+  CASE 2 : -q/s
+  OTHERWISE : -s/q ENDSELECT  .
+
+END PROC tg;
+
+REAL PROC sin ( REAL CONST x ): 
+  REAL VAR y, r, q;
+  IF x < 0.0 THEN y := -x; q := 4.0 ELSE y := x; q := 0.0 FI;
+  y := y * pi4;
+  r := floor(y);
+  sincos( q+r , y-r )
+END PROC sin; 
+ 
+REAL PROC sind ( REAL CONST x ): 
+  REAL VAR y, r, q; 
+  IF x < 0.0 THEN y := -x; q := 4.0 ELSE y := x; q := 0.0 FI;
+  y := y / 45.0;
+  r := floor(y);
+  sincos( q+r , y-r )
+END PROC sind; 
+ 
+REAL PROC cos ( REAL CONST x ): 
+  REAL VAR y, q; 
+  IF x < 0.0 THEN y := -x ELSE y := x FI;
+  y := y * pi4;
+  q := floor(y); 
+  sincos( q+2.0, y-q )
+END PROC cos; 
+ 
+REAL PROC cosd ( REAL CONST x ): 
+  REAL VAR y, q; 
+  IF x < 0.0 THEN y := -x ELSE y := x FI;
+  y := y / 45.0;
+  q := floor(y);
+  sincos( q+2.0, y-q )
+END PROC cosd; 
+ 
+REAL PROC sincos ( REAL CONST q, y ): 
+ REAL VAR r :: q - floor( 0.125*q + 0.1 ) * 8.0;
+ IF r >= 4.0 THEN IF r >= 6.0 THEN IF r >= 7.0 THEN - sin approx(1.0-y)
+                                               ELSE - cos approx(y)  FI
+                              ELSE IF r >= 5.0 THEN - cos approx(1.0-y)
+                                               ELSE - sin approx(y)  FI FI
+             ELSE IF r >= 2.0 THEN IF r >= 3.0 THEN   sin approx(1.0-y)
+                                               ELSE   cos approx(y)  FI
+                              ELSE IF r >= 1.0 THEN   cos approx(1.0-y)
+                                               ELSE   sin approx(y)  FI FI FI
+END PROC sincos; 
+ 
+REAL PROC sin approx ( REAL CONST x ): 
+ REAL VAR z::x*x; 
+ x*((((((0.6877101540593035e-11*z-0.1757149296873372e-8)*z+0.3133616216672568
+ e-6)*z-0.3657620415845891e-4)*z+0.2490394570188737e-2)*z-0.807455121882e-1)*
+ z+0.7853981633974483)
+END PROC sin approx; 
+ 
+REAL PROC cos approx ( REAL CONST x ): 
+ REAL VAR z::x*x; 
+ ((((((-0.3857761864560276e-12*z+0.115004970178141e-9)*z-0.246113638267419e-7
+ )*z+0.3590860445885748e-5)*z-0.3259918869266875e-3)*z+0.1585434424381541e-1)
+ *z-0.3084251375340425)*z+1.0
+END PROC cos approx; 
+ 
+REAL PROC arctan ( REAL CONST y ): 
+ REAL VAR f, z, x; BOOL VAR neg :: y < 0.0;
+ IF   neg   THEN x := -y ELSE x := y FI;
+ IF   x>1.0 THEN f := a ELSE f := -b; neg := NOT neg FI;
+ z := x * x;
+ x := x/(((((((0.0107090276046822*z-0.01647757182108040)*z 
+      +0.02177846332482151)*z-0.03019339673273880)*z+0.04656083561183398)*z 
+      -0.0888888888888888)*z+0.3333333333333333)*z+1.0);
+ IF   neg   THEN  x - f  ELSE  f - x  FI.
+
+ a:IF x>sqr3p2 THEN x := 1.0/x; pi2 ELSE x := 4.0/(sqrt3+x+x+x)-sqr3; pi3 FI.
+ b:IF x<sqr3m2 THEN   0.0           ELSE x := sqrt3 - 4.0/(sqrt3+x);  pi6 FI
+END PROC arctan; 
+ 
+REAL PROC arctand ( REAL CONST x ): 
+  arctan(x) * pi180
+END PROC arctand; 
+ 
+REAL OP ** ( REAL CONST b, e ): 
+ IF b=0.0 
+   THEN IF e=0.0 THEN 1.0 ELSE 0.0 FI
+ ELIF b < 0.0 
+   THEN errorstop("("+text(b,20)+") ** "+text(e)); (-b) ** e
+ ELSE   exp( e * log2( b ) * ln2 )
+ FI
+END OP **;
+ 
+REAL OP ** ( REAL CONST a, INT CONST b ) : 
+
+  REAL VAR p := 1.0 ,
+           r := a ;
+  INT VAR  n := ABS b ,
+           m ; 
+  IF (a = 0.0 OR a = -0.0) 
+    THEN IF b = 0
+           THEN 1.0
+           ELSE 0.0
+         FI
+    ELSE WHILE n>0 REP
+           m := n DIV 2 ;
+           IF m + m = n
+             THEN n := m ;
+                  r := r*r 
+             ELSE n DECR 1 ;
+                  p := p*r
+           FI
+         END REP ; 
+         IF b>0
+           THEN p
+           ELSE 1.0 / p
+         FI
+  FI .
+
+END OP ** ; 
+ 
+REAL PROC random: 
+  rdg:=rdg+pii;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=frac(rdg);rdg
+END PROC random; 
+ 
+PROC initializerandom ( REAL CONST z ): 
+  rdg := frac(z) 
+END PROC initializerandom; 
+ 
+END PACKET mathlib; 
+
diff --git a/system/base/1.7.5/src/pattern match b/system/base/1.7.5/src/pattern match
new file mode 100644
index 0000000..f6190d8
--- /dev/null
+++ b/system/base/1.7.5/src/pattern match
@@ -0,0 +1,768 @@
+PACKET pattern match DEFINES                     (* Author: P.Heyderhoff *) 
+                                                 (* Date:   09.06.1986   *) 
+    -, 
+    OR, 
+    **, 
+    any, 
+    notion, 
+    bound, 
+    match, 
+    matchpos, 
+    matchend, 
+    somefix, 
+    UNLIKE, 
+    LIKE : 
+ 
+(*------- Operation codes of the internal intermeadiate language: --------*) 
+ 
+LET 
+    z        = ""0"", 
+    stopz    = ""1""0"", 
+    closez   = ""2""0"", 
+    closor   = ""2""0""3""0"", 
+    or       = ""3"", 
+    oralpha  = ""3""5"", 
+    open2    = ""4""0""4""0"", 
+    alpha    = ""5"", 
+    alphaz   = ""5""0"", 
+    lenz     = ""6""0"", 
+    nilz     = ""6""0""0""0""7""0"",      (* =    any (0)     *) 
+    starz    = ""7""0"", 
+    star     = ""8""0""2""7""0""1""0"",   (* =    any ** 1    *) 
+    powerz   = ""8""0"", 
+    powerz0  = ""8""0""1"", 
+    notionz  = ""9""0"", 
+    fullz    = ""10""0"", 
+    boundz   = ""11""0""; 
+(*------------------------------------------------------------------------*) 
+ 
+LET undefined = 0,                                   (* fixleft value     *) 
+    forcer    = 0,                                   (* vaHue parameter   *) 
+    delimiter = " !""#$%&'()*+,-./:;<=>?§^_`­";      (* for 'PROC notion' *) 
+ 
+TEXT OP - (TEXT CONST alphabet ): 
+     p:= ""; 
+     INT VAR j; 
+     FOR j FROM 0 UPTO 255 
+     REP IF   pos(alphabet,code(j)) = 0 
+         THEN p CAT code(j) 
+         FI 
+     PER; 
+     p 
+  ENDOP -; 
+ 
+TEXT OP OR (TEXT CONST a, b): 
+     open2 + notnil (a) + closor + notnil (b) + closez 
+  ENDOP OR; 
+ 
+TEXT OP ** (TEXT CONST p, INT CONST x): 
+     powerz + code (1+x) + notnil (p) + stopz 
+  ENDOP **; 
+ 
+TEXT CONST any:= starz; 
+ 
+TEXT PROC any (INT CONST n): 
+     TEXT VAR t:= "  "; 
+     replace (t, 1, ABSn); 
+     lenz + t + starz 
+  ENDPROC any; 
+ 
+TEXT PROC any (TEXT CONST a): alphaz + a + starz ENDPROC any; 
+ 
+TEXT PROC any (INT CONST n, TEXT CONST a): 
+     TEXT VAR t:= "  "; 
+     replace (t, 1, ABSn); 
+     lenz + t + alphaz + a + starz  
+  ENDPROC any; 
+ 
+TEXT PROC notion (TEXT CONST t): notionz + notnil(t) + stopz ENDPROC notion; 
+ 
+TEXT PROC notnil (TEXT CONST t): 
+     IF   t = "" 
+     THEN nilz 
+     ELSE t 
+     FI 
+  ENDPROC notnil; 
+ 
+TEXT CONST bound := boundz; 
+ 
+TEXT PROC full (TEXT CONST t): fullz + t + stopz ENDPROC full; 
+ 
+TEXT PROC match (INT CONST x): 
+     subtext (p, matchpos(x), matchend(x)) 
+  ENDPROC match; 
+ 
+INT PROC matchpos (INT CONST x): mapos (1 + x MOD 256) ENDPROC matchpos; 
+ 
+INT PROC matchend (INT CONST x): maend (1 + x MOD 256) - 1 
+ ENDPROC matchend; 
+ 
+(*----------------- GLOBAL VARIABLES: -----------------------------------*) 
+ 
+ROW  256 INT VAR 
+                 (* Table of match registers. Each entry consists of two *) 
+                 (* pointers, which points to the TEXT object 't'        *) 
+     mapos,      (* points to the beginning of the match                 *) 
+     maend;      (* points to the position after the end of match        *) 
+ 
+INT  VAR ppos, tpos,   (* workpositions in pattern 'p' and text 't'      *) 
+         floatpos,     (* accumulation of all pending floatlengths       *) 
+         failpos,      (* result of 'PROC in alpha'                      *) 
+         plen, tlen,   (* length of pattern 'p' and length of text 't'   *) 
+         skipcount,    (* for track forward skipping                     *) 
+         multi, vari;  (* for handling of nonexclusive alternatives      *) 
+ 
+TEXT VAR p,            (* the pattern to be find  or some result         *) 
+         stack,        (* stack of pending assignments                   *) 
+         alphabet:=""; (* result of 'PROC find alpha', reset to nil      *) 
+                       (* after its usage by 'find any'                  *) 
+ 
+BOOL VAR fix,          (* text position is fixed and not floating        *) 
+         no vari;      (* not variing the order of alternatives          *) 
+ 
+TEXT PROC somefix (TEXT CONST pattern): 
+  
+     (* delivers the first text occuring unconditionally in the pattern *) 
+ 
+     p:= pattern; 
+     INT VAR j:= 1, n:= 0, k, len:= LENGTH p; 
+     REP 
+         SELECT text( subtext (p, j, j+1), 2) ISUB 1 OF 
+         CASE 1,3,7,9,10,11: j INCR 2 
+         CASE 2:             j INCR 2; n DECR 1 (* condition closed *) 
+         CASE 4:             j INCR 2; n INCR 1 (* condition opened *) 
+         CASE 5:             j := pos (p, starz, j+2) + 2 
+         CASE 6:             j INCR 4 
+         CASE 8:             j INCR 3 
+         OTHERWISE   k:= pos(p, z, j+1) - 1; 
+                     IF k <= 0 THEN k:= 1+len FI; 
+                     IF   star found
+                     THEN change (p, starpos, starpos, star);
+                          len:= LENGTH p;
+                          k:= starpos
+                     FI; 
+                     IF n =  0 CAND ( p SUB k ) <> or CAND k > j
+                     THEN LEAVE somefix WITH subtext(p,j,k-1) 
+                     ELSE j:=k 
+                     FI 
+         ENDSELECT 
+     UNTIL j > len 
+     PER; 
+     "" .
+
+  star found:   
+     INT VAR starpos:= pos (p, "*", j);
+     starpos > 0 CAND starpos <= k .
+     
+  ENDPROC somefix; 
+ 
+PROC skip (TEXT CONST p, BOOL CONST upto or): 
+ 
+     (* skips 'ppos' upto the end of the opened nest, n = nesting level *) 
+ 
+     INT VAR n:= 0; 
+     REP 
+         SELECT text (subtext (p, ppos, ppos+1), 2) ISUB 1 OF 
+         CASE 1,2:    IF   n = 0 
+                      THEN LEAVE skip 
+                      FI; 
+                      ppos INCR 2; 
+                      nDECR1 
+         CASE 3:      IF   n = 0 CAND upto or 
+                      THEN LEAVE skip 
+                      FI; 
+                      ppos INCR 2 
+         CASE 7:      ppos INCR 2 
+         CASE 4,9,10,11: ppos INCR 2; 
+                      n INCR 1 
+         CASE 5:      ppos:= pos (p, starz, ppos+2) + 2 
+         CASE 6:      ppos INCR 4 
+         CASE 8:      ppos INCR 3; 
+                      n INCR 1 
+         OTHERWISE    ppos:= pos(p, z, ppos+1) - 1; 
+                      IF   ppos < 0 
+                      THEN ppos:= plen; 
+                           LEAVE skip 
+                      FI 
+         ENDSELECT 
+     PER 
+  ENDPROC skip; 
+ 
+BOOL OP UNLIKE (TEXT CONST t, p): NOT ( t LIKE p ) ENDOP UNLIKE; 
+ 
+BOOL OP LIKE (TEXT CONST t, pattern): 
+     init; 
+     BOOL CONST found:= find (t,1,1, fixresult, floatresult); 
+     save; 
+     found. 
+ 
+  init:    no vari:= TRUE; 
+           vari:= 0; 
+           tlen:= 1 + LENGTH t; 
+           p:= full (pattern); 
+           IF   pos (p, bound) > 0 
+           THEN 
+                IF   subtext (p, 14, 15) = bound 
+                THEN p:= subtext (p, 1, 8) + powerz0 + subtext (p, 16) 
+                FI; 
+                plen:= LENGTH p - 7;  
+                IF   subtext (p, plen, plen+1) = bound  
+                THEN p:= subtext (p, 1, plen - 1) + stopz + stopz 
+                FI; 
+           FI; 
+           plen:= LENGTH p + 1; 
+           INT VAR fixresult, floatresult; 
+           tpos:= 1; 
+           floatpos:= 0; 
+           stack:= ""; 
+           alphabet:= ""; 
+           fix:= TRUE; 
+           skipcount:= 0; 
+           multi:= 0. 
+ 
+  save:    p:= t 
+ 
+  ENDOP LIKE; 
+ 
+(*-------- Realisation of the pattern matching algorithms 'find' --------*) 
+ 
+BOOL PROC find 
+     (TEXT CONST t, INT CONST unit, from, INT VAR fixleft, floatlen): 
+ 
+     initialize; 
+     BOOL CONST found:= pattern unit; 
+     SELECT next command * unit OF 
+            CASE 0,1,2:         found 
+            CASE 3:             next; 
+                                find alternative 
+            OTHERWISE           find concatenation 
+     ENDSELECT . 
+ 
+  find alternative: 
+     IF   found 
+     THEN save left position; 
+          backtrack; 
+          IF   find pattern CAND better 
+          THEN note multiplicity 
+          ELSE back to first one 
+          FI 
+     ELSE backtrack multi 
+     FI. 
+ 
+  better:               permutation XOR more left. 
+ 
+  permutation:          vari MOD 2 = 1. 
+ 
+  save left position:   j:= fixleft. 
+ 
+  more left:            j > fixleft. 
+ 
+  backtrack multi:      multi:= 2 * backmulti + 1; 
+                        vari:= backvari DIV 2; 
+                        find pattern. 
+ 
+  note multiplicity:    multi:= 2 * multi + 1; 
+                        vari:= vari DIV 2; 
+                        TRUE. 
+ 
+  back to first one:    backtrack; 
+                        IF   find first subpattern 
+                        THEN skip (p, FALSE); 
+                             note multiplicity 
+                        ELSE errorstop ("pattern"); 
+                             FALSE 
+                        FI. 
+ 
+  find concatenation: 
+     IF   found 
+     THEN IF ppos=plen COR find pattern COR track forward 
+          COR ( multi > backmulti CAND vari = 0 CAND find variation ) 
+          THEN TRUE 
+          ELSE backtrack; FALSE 
+          FI 
+     ELSE skip (p, TRUE); FALSE 
+     FI. 
+ 
+  track forward:                   (* must be performed before variation *) 
+     j:=0; 
+     last multi:= multi; 
+     last vari:= vari; 
+     WHILE skipcount = 0 
+     REP   IF tlen = tpos 
+           THEN LEAVE track forward WITH FALSE 
+           FI; 
+           backtrack; 
+           j INCR 1; 
+           skipcount:= j 
+     UNTIL find first subpattern CAND find pattern 
+     PER; 
+     j:= skipcount; 
+     skipcount:=0; 
+     j=0. 
+ 
+  find variation: 
+     multi:= last multi; 
+     vari:= last vari; 
+     FOR k FROM 1 UPTO (multi+1) DIV (backmulti+1) - 1 
+     REP backtrack with variation; 
+         IF   find first subpattern CAND find pattern 
+         THEN vari:=0; 
+              LEAVE find variation WITH TRUE 
+         FI 
+     PER; 
+     FALSE. 
+ 
+  backtrack with variation: 
+     backtrack; 
+     vari:= k. 
+ 
+  find pattern: 
+     find (t, 1, ppos+forcer, fixresult, floatresult) CAND keep result. 
+ 
+  find first subpattern: 
+     find (t, 0, from, fixresult, floatresult) CAND keep result . 
+ 
+  initialize: 
+     INT  VAR   j, 
+                k, 
+                fixresult, 
+                floatresult, 
+                last multi, 
+                last vari; 
+     BOOL CONST backfix:= fix; 
+     TEXT CONST backstack:= stack; 
+     floatlen:= 0; 
+     INT  CONST back:= tpos, 
+                backfloat:= floatpos, 
+                backskip:= skipcount, 
+                backmulti:= multi, 
+                backvari:= vari; 
+     fixleft:= fixleft0. 
+ 
+  fixleft0: IF fix THEN back ELSE undefined FI. 
+ 
+  backtrack: 
+     fix:= backfix; 
+     tpos:= back; 
+     fixleft:= fixleft0; 
+     floatlen:= 0; 
+     floatpos:= backfloat; 
+     stack:= backstack; 
+     skipcount:= backskip; 
+     multi:= backmulti; 
+     vari:= backvari. 
+ 
+  keep result: 
+     IF   fixleft = undefined 
+     THEN IF   fixresult = undefined 
+          THEN floatlen INCR floatresult 
+          ELSE fixleft  := fixresult - floatlen; 
+               floatpos DECR floatlen; 
+               floatlen:= 0 
+          FI 
+     FI; 
+     TRUE. 
+ 
+  pattern unit: 
+     init ppos; 
+     SELECT command OF 
+            CASE 1,2:   find end 
+            CASE 3:     find nil 
+            CASE 4:     find choice 
+            CASE 5:     find alphabet 
+            CASE 6:     find fixlength any 
+            CASE 7:     find varlength any 
+            CASE 8:     find and store match 
+            CASE 9:     find notion 
+            CASE 10:    find full 
+            CASE 11:    next; find nil 
+            OTHERWISE   find plain text                     END SELECT. 
+ 
+  init ppos:    ppos:= from + 2. 
+ 
+  command:      text (subtext (p, from, from+1), 2) ISUB 1. 
+ 
+  next command: text (subtext (p, ppos, ppos+1), 2) ISUB 1. 
+ 
+  next:         ppos INCR 2. 
+ 
+  find end:     ppos DECR 2; 
+                fixleft:= tpos; 
+                LEAVE find WITH TRUE; 
+                TRUE. 
+ 
+  find nil:     ppos DECR 2; 
+                fixleft:= tpos; 
+                TRUE. 
+ 
+  find choice:  IF   find pattern 
+                THEN next; TRUE 
+                ELSE next; FALSE 
+                FI. 
+ 
+  find plain text: find text upto next command; 
+                   IF   fix        THEN allow fix position only 
+                   ELIF text found THEN allow variable position 
+                                   ELSE allow backtrack 
+                   FI. 
+ 
+  find text upto next command: 
+     ppos:= pos (p, z, from + 1); 
+     IF   ppos = 0 
+     THEN ppos:= plen 
+     ELSE ppos DECR 1 
+     FI; 
+     IF   star found
+     THEN change (p, starpos, starpos, star);
+          plen:= 1 + LENGTH p;
+          ppos:= starpos
+     FI;     
+     tpos:= pos (t, subtext (p, from, ppos - 1), tpos). 
+ 
+  star found:
+     INT VAR starpos:= pos (p, "*", from);
+     starpos > 0 CAND starpos <= ppos .
+
+  text found: 
+     WHILE skipcount > 0 CAND tpos > 0 
+     REP   skipcount DECR 1; 
+           tpos:= pos (t, subtext(p,from,ppos-1), tpos+1) 
+     PER; 
+     tpos > 0 .
+ 
+  allow fix position only: 
+     IF   tpos = back 
+     THEN tpos INCR (ppos-from); TRUE 
+     ELSE tpos:= back; 
+          from = ppos 
+     FI. 
+ 
+  allow variable position: 
+     IF   alphabet = "" COR in alpha (t, back, tpos)  
+     THEN fix it; 
+          tpos INCR (ppos-from); 
+          TRUE 
+     ELSE tpos:= back; 
+          FALSE 
+     FI. 
+ 
+  allow backtrack: 
+     tpos:= back; 
+     IF   from = ppos 
+     THEN fix it; 
+          TRUE 
+     ELSE FALSE 
+     FI . 
+ 
+  find alphabet: 
+     j:= pos (p, starz, ppos); 
+     alphabet:= subtext (p, ppos, j-1); 
+     ppos := j; 
+     TRUE. 
+ 
+  find fixlength any: 
+     get length value; 
+     find alpha attribut; 
+     IF   alphabet = "" 
+     THEN find any with fix length 
+     ELSE find any in alphabet with fix length 
+     FI. 
+ 
+  get length value: 
+     floatlen:= subtext(p, ppos, ppos+1) ISUB 1;
+     ppos INCR 4. 
+ 
+  find alpha attribut: 
+     IF (p SUB (ppos-2)) = alpha CAND find alphabet 
+     THEN next 
+     FI. 
+ 
+  find any with fix length: 
+     tpos INCR floatlen; 
+     IF   tpos > tlen 
+     THEN tpos:= back; 
+          floatlen:=0; 
+          FALSE 
+     ELSE IF   fix THEN floatlen:= 0 
+          ELIF floatlen = 0 
+          THEN fix it                         (* unlike niltext 6.6. *) 
+          ELSE floatpos INCR floatlen 
+          FI; 
+          TRUE 
+     FI. 
+ 
+  find any in alphabet with fix length: 
+     IF   first character in alpha 
+     THEN IF NOT fix THEN fix it FI; 
+          set fix found 
+     ELSE set fix not found 
+     FI. 
+ 
+  first character in alpha: 
+    (fix COR advance) CAND in alpha (t, tpos, tpos+floatlen). 
+ 
+  advance: 
+     FOR tpos FROM back UPTO tlen 
+     REP IF   pos (alphabet, t SUB tpos) > 0 
+         THEN LEAVE advance WITH TRUE 
+         FI 
+     PER; 
+     FALSE. 
+ 
+  fix it: 
+     fixleft:= back-floatpos; 
+     make fix (back); 
+     fixleft:= tpos. 
+ 
+  set fix found: 
+     tpos INCR floatlen; 
+     floatlen:= 0; 
+     alphabet:= ""; 
+     TRUE. 
+ 
+  set fix not found:    tpos:= back; 
+                        alphabet:= ""; 
+                        floatlen:= 0; 
+                        FALSE. 
+ 
+  find varlength any:   IF   alphabet = "" 
+                        THEN really any 
+                        ELSE find varlength any in alphabet 
+                        FI. 
+ 
+  really any:           IF   fix 
+                        THEN fix:= FALSE; 
+                             fixleft:= tpos 
+                        ELIF floatpos = 0 
+                        THEN fixleft:= tpos                  (* 6.6. *) 
+                        FI; 
+                        TRUE . 
+ 
+  find varlength any in alphabet: 
+                        IF fix THEN fixleft := tpos FI; 
+                        IF   fix CAND pos (alphabet, t SUB tpos) > 0 
+                        COR  NOT fix CAND advance 
+                        THEN IF NOT fix THEN fix it FI; 
+                             set var found 
+                        ELSE set var not found 
+                        FI. 
+ 
+  set var found:        tpos:= end of varlength any; 
+                        alphabet:= ""; 
+                        TRUE. 
+  set var not found:    tpos:= back; 
+                        alphabet:= ""; 
+                        FALSE. 
+  end of varlength any: IF   NOT in alpha(t,tpos,tlen) 
+                        THEN failpos 
+                        ELSE tlen 
+                        FI. 
+ 
+  find and store match: get register name; 
+                        IF  find pattern 
+                        THEN next; 
+                             store; 
+                             TRUE 
+                        ELSE next; 
+                             FALSE 
+                        FI. 
+ 
+  store:                IF   fix 
+                        THEN mapos (reg):= fixleft; 
+                             maend (reg):= tpos 
+                        ELSE stack CAT code(floatlen) + 
+                                       code(floatpos) + code(fixleft) + c 
+                        FI. 
+ 
+  get register name:    TEXT CONST c:= p SUB (ppos); 
+                        INT  VAR reg:= code (c); 
+                        ppos INCR 1. 
+ 
+  find notion:    float notion; 
+                  exhaust notion . 
+ 
+  float notion:   j:= back; 
+                  REP IF   find pattern 
+                      THEN IF   is notion (t, fixleft) 
+                           THEN LEAVE find notion WITH TRUE 
+                           ELIF backfix 
+                           THEN LEAVE float notion 
+                           ELSE go ahead FI 
+                      ELIF j=back 
+                      THEN next; 
+                           LEAVE find notion WITH FALSE 
+                      ELSE LEAVE float notion 
+                      FI 
+                  PER. 
+ 
+  go ahead:       j INCR 1; 
+                  IF simple THEN j:= max (tpos, j) FI; 
+                  notion backtrack. 
+ 
+  simple:         k:= from; 
+                  REP k := pos (p, z, k+2); 
+                      IF   k > ppos-3 
+                      THEN LEAVE simple WITH TRUE 
+                      ELIF pos (oralpha, p SUB k-1) > 0 
+                      THEN LEAVE simple WITH FALSE 
+                      FI 
+                  PER; 
+                  FALSE. 
+ 
+  notion backtrack: tpos:= j; 
+                  fix:= backfix; 
+                  fixleft:= fixleft0; 
+                  floatlen:= 0; 
+                  floatpos:= backfloat + tpos - back; 
+                  stack:= backstack; 
+                  ppos:= from + 2 . 
+ 
+  exhaust notion: IF   notion expansion 
+                  COR  multi > backmulti 
+                  CAND no vari 
+                  CAND notion variation 
+                  THEN TRUE 
+                  ELSE backtrack; FALSE 
+                  FI. 
+ 
+  notion expansion: j:= 0; 
+                  multi:= last multi; 
+                  vari:= last vari; 
+                  WHILE skipcount = 0 
+                  REP skip and try PER; 
+                  j:= skipcount; 
+                  skipcount:= 0; 
+                  j = 0. 
+ 
+  skip and try:   backtrack; 
+                  j INCR 1; 
+                  skipcount:=j; 
+                  ppos:= from + 2; 
+                  IF   find pattern 
+                  THEN IF    is notion (t, fixleft) 
+                       THEN  LEAVE find notion WITH TRUE 
+                       FI 
+                  ELSE next; LEAVE find notion WITH FALSE 
+                  FI . 
+ 
+  notion variation: no vari:= FALSE; 
+                  last multi:= multi; 
+                  last vari:= vari; 
+                  FOR k FROM 1 UPTO (multi+1) DIV (backmulti+1) - 1 
+                  REP backtrack with variation; 
+                      IF   find first subpattern 
+                      THEN no vari:= TRUE; 
+                           LEAVE find notion WITH TRUE 
+                      FI 
+                  PER; 
+                  no vari:= TRUE; 
+                  FALSE. 
+ 
+  find full: 
+    find pattern CAND (end of line COR exhaust line). 
+ 
+  end of line: 
+    next; 
+    IF   fix 
+    THEN tpos = tlen 
+    ELSE tpos:= tlen; 
+         make fix (1); 
+         TRUE 
+    FI. 
+ 
+  exhaust line: 
+    IF   full expansion COR multi > 0 CAND no vari CAND full variation 
+    THEN TRUE ELSE backtrack; 
+         FALSE 
+    FI. 
+ 
+  full expansion: 
+     j:=0; 
+     last multi:= multi; 
+     last vari:= vari; 
+     WHILE skipcount = 0 
+     REP   IF tlen = tpos 
+           THEN LEAVE full expansion WITH FALSE 
+           FI; 
+           backtrack; 
+           j INCR 1; 
+           skipcount:= j; 
+           ppos:=from + 2 
+     UNTIL find pattern CAND tpos=tlen 
+     PER; 
+     j:= skipcount; 
+     skipcount:=0; 
+     j=0. 
+ 
+  full variation: 
+    no vari:= FALSE; 
+    multi:= last multi; 
+    vari:= last vari; 
+    FOR k FROM 1 UPTO multi 
+    REP backtrack with variation; 
+        IF   find first subpattern 
+        THEN no vari:= TRUE; 
+             LEAVE find WITH TRUE 
+        FI 
+    PER; 
+    no vari:= TRUE; 
+    FALSE. 
+ 
+ ENDPROC find; 
+ 
+BOOL PROC is notion (TEXT CONST t, INT CONST fixleft): 
+     ppos INCR 2; 
+     (    NOT  fix 
+          COR  tpos = tlen 
+          COR  pos (delimiter, t SUB tpos)   > 0 
+          COR  pos (delimiter, t SUB tpos-1) > 0 
+          COR  (t SUB tpos)  <= "Z" 
+          CAND (t SUB tpos-1) > "Z"   ) 
+     CAND (    fixleft <= 1 
+          COR  pos (delimiter, t SUB fixleft-1) > 0 
+          COR  pos (delimiter, t SUB fixleft)   > 0 
+          COR  (t SUB fixleft)    > "Z" 
+          CAND (t SUB fixleft-1) <= "Z"   ) 
+ 
+ END PROC is notion; 
+ 
+PROC make fix (INT CONST back): 
+     WHILE stack not empty 
+     REP  INT VAR reg:= code (stack SUB top), 
+                  pos:= code (stack SUB top-1), 
+                  len:= code (stack SUB top-3), 
+                  dis:= code (stack SUB top-2) - floatpos; 
+          maend(reg):= min (tpos + dis, tlen);              (* 6.6. *) 
+          mapos(reg):= pos or fix or float; 
+          stack:= subtext (stack,1,top-4) 
+     PER; 
+     fix:= TRUE; 
+     floatpos:= 0 . 
+ 
+     stack not empty: INT VAR top:= LENGTH stack; 
+                      top > 0. 
+ 
+     pos or fix or float: 
+          IF   pos = undefined 
+          THEN IF len = 0 
+               THEN min (back + dis, tlen) 
+               ELSE maend(reg) - len 
+               FI 
+          ELSE pos 
+          FI. 
+ 
+ ENDPROC make fix; 
+ 
+BOOL PROC in alpha (TEXT CONST t, INT CONST from, to): 
+     FOR failpos FROM from UPTO to - 1 
+     REP IF   pos (alphabet, t SUB failpos) = 0 
+         THEN LEAVE in alpha WITH FALSE 
+         FI 
+     PER; 
+     TRUE 
+  ENDPROC in alpha; 
+ 
+TEXT PROC notion (TEXT CONST t, INT CONST r): notion (t) ** r ENDPROC notion; 
+ 
+ENDPACKET pattern match; 
+
diff --git a/system/base/1.7.5/src/pcb control b/system/base/1.7.5/src/pcb control
new file mode 100644
index 0000000..9bf0e2d
--- /dev/null
+++ b/system/base/1.7.5/src/pcb control
@@ -0,0 +1,79 @@
+
+PACKET pcb and init control DEFINES         (* Autor: J.Liedtke *)
+                                            (* Stand: 25.08.84  *)
+  session ,
+  pcb ,
+  set line nr ,
+  clock ,
+  INITFLAG ,
+  := ,
+  initialized ,
+  storage ,
+  id ,
+  ke :
+
+
+LET line number field     = 1 ,
+    myself id field       = 9 ;
+
+TYPE INITFLAG = INT ;
+
+
+INT PROC session :
+  EXTERNAL 126
+ENDPROC session ;
+
+INT PROC pcb (INT CONST field) :
+  EXTERNAL 80
+ENDPROC pcb ;
+
+PROC write pcb (INT CONST task nr, field, value) :
+  EXTERNAL 105
+ENDPROC write pcb ;
+
+PROC set line nr (INT CONST value) :
+  write pcb (pcb (myself id field), line number field, value)
+ENDPROC set line nr ;
+
+
+OP := (INITFLAG VAR flag, BOOL CONST flagtrue) :
+
+  IF flagtrue
+    THEN CONCR (flag) := myself no
+    ELSE CONCR (flag) := 0
+  FI .
+
+myself no :   pcb (myself id field) AND 255 .
+
+ENDOP := ;
+
+BOOL PROC initialized (INITFLAG VAR flag) :
+
+  IF CONCR (flag) = myself no
+    THEN TRUE
+    ELSE CONCR (flag) := myself no ;
+         FALSE
+  FI .
+
+myself no :   pcb (myself id field) AND 255 .
+
+ENDPROC initialized ;
+
+REAL PROC clock (INT CONST nr) :
+  EXTERNAL 102
+ENDPROC clock ;
+
+PROC storage (INT VAR size, used) :
+  EXTERNAL 89
+ENDPROC storage ;
+
+INT PROC id (INT CONST no) :
+  EXTERNAL 129
+ENDPROC id ;
+
+PROC ke :
+  EXTERNAL 6
+ENDPROC ke ;
+
+ENDPACKET pcb and init control ;
+
diff --git a/system/base/1.7.5/src/real b/system/base/1.7.5/src/real
new file mode 100644
index 0000000..3e3c651
--- /dev/null
+++ b/system/base/1.7.5/src/real
@@ -0,0 +1,442 @@
+(* ------------------- VERSION 6     05.05.86 ------------------- *)
+PACKET real DEFINES                           (* Autor: J.Liedtke *) 
+ 
+   text , 
+   int ,
+   real ,
+   round ,
+   floor , 
+   frac ,
+   decimal exponent ,
+   set exp ,
+   INCR ,
+   DECR ,
+   abs , 
+   ABS , 
+   sign ,
+   SIGN ,
+   MOD ,
+   min ,
+   max ,
+   max real ,
+   small real :
+ 
+LET mantissa length = 13 ,
+    digit zero index = 1 ,
+    digit nine index = 10 ;
+INT CONST 
+    decimal point index := -1 ; 
+
+TEXT VAR mantissa ;
+
+ROW 10 REAL VAR real digit ;
+ 
+INT VAR i ; REAL VAR d := 0.0 ;
+FOR i FROM 1 UPTO 10 REP
+  real digit (i) := d ;
+  d := d + 1.0
+PER ;
+ 
+REAL PROC max real : 9.999999999999e126 ENDPROC max real ;
+ 
+REAL PROC small real : 1.0e-12 ENDPROC small real ;
+ 
+PROC sld (INT CONST in, REAL VAR real, INT VAR out) :
+  EXTERNAL 96
+ENDPROC sld ; 
+ 
+INT PROC decimal exponent (REAL CONST mantissa) : 
+  EXTERNAL 97
+ENDPROC decimal exponent ; 
+
+PROC set exp (INT CONST exponent, REAL VAR number) : 
+  EXTERNAL 98
+ENDPROC set exp ;
+ 
+REAL PROC tenpower (INT CONST exponent) :
+  REAL VAR result := 1.0 ;
+  set exp (exponent, result) ;
+  result
+ENDPROC tenpower ;
+
+REAL PROC floor (REAL CONST real) : 
+  EXTERNAL 99
+ENDPROC floor ; 
+ 
+REAL PROC round (REAL CONST real, INT CONST digits) : 
+ 
+  REAL VAR result := real ;
+  IF (real <> 0.0) CAND (decimal exponent (real) + digits < mantissa length)
+    THEN round result ;
+  FI ;
+  result .
+
+round result :
+  set exp (decimal exponent (result) + digits, result) ;
+  IF result >= 0.0
+    THEN result := floor (result + 0.5)
+    ELSE result := floor (result - 0.5)
+  FI ;
+  IF result <> 0.0
+    THEN set exp (decimal exponent (result) - digits, result)
+  FI .
+
+ENDPROC round ; 
+ 
+TEXT VAR result ;
+ 
+TEXT PROC text (REAL CONST real) : 
+ 
+  REAL VAR value := rounded to seven digits ; 
+  IF value = 0.0 
+    THEN "0.0" 
+    ELSE 
+      process sign ; 
+      get mantissa (value) ; 
+      INT CONST exponent := decimal exponent (value) ; 
+      get short mantissa ; 
+      IF exponent > 7 OR exponent < LENGTH short mantissa - 7 
+        THEN scientific notation 
+        ELSE short notation 
+      FI 
+    FI . 
+ 
+rounded to seven digits : 
+  round ( real * tenpower( -decimal exponent(real) ) , 6 ) 
+        * tenpower ( decimal exponent(real) ) . 
+ 
+process sign : 
+  IF value < 0.0 
+    THEN result := "-" ; 
+         value := - value 
+    ELSE result := "" 
+  FI . 
+ 
+get short mantissa : 
+  INT VAR i := 7 ; 
+  WHILE (mantissa SUB i) = "0" REP 
+    i DECR 1 
+  UNTIL i=1 END REP ; 
+  TEXT CONST short mantissa := subtext (mantissa, 1, i) . 
+ 
+scientific notation : 
+  result CAT (mantissa SUB 1) ; 
+  result CAT "." ; 
+  result CAT subtext (mantissa, 2, 7) ; 
+  result + "e" + text (exponent) . 
+ 
+short notation : 
+  IF exponent < 0
+    THEN result + "0." + (-exponent - 1) * "0" + short mantissa
+    ELSE result CAT subtext (short mantissa, 1, exponent+1) ; 
+         result CAT (exponent+1 - LENGTH short mantissa) * "0" ; 
+         result CAT "." ; 
+         result CAT subtext (short mantissa, exponent+2) ;
+         IF LENGTH short mantissa < exponent + 2 
+           THEN result + "0"
+           ELSE result
+         FI
+  FI . 
+ 
+ENDPROC text ; 
+ 
+PROC get mantissa (REAL CONST number) :
+
+  REAL VAR real mantissa := number ;
+  mantissa := "" ;
+  INT VAR i , digit ;
+  FOR i FROM 1 UPTO mantissa length REP
+    sld (0, real mantissa, digit) ;
+    mantissa CAT code (digit + 48)
+  PER ;
+
+ENDPROC get mantissa ;
+
+TEXT PROC text (REAL CONST real, INT CONST length) :
+
+  INT CONST mantissa length := min (length - 7, 13) ;
+  IF mantissa length > 0
+    THEN construct scientific notation
+    ELSE result := length * "*"
+  FI ;
+  result .
+
+construct scientific notation :
+  REAL VAR value := rounded real ;
+  IF value = 0.0
+    THEN result := subtext (" 0.0                ", 1, length) 
+    ELSE process sign ;
+         process mantissa ;
+         process exponent
+  FI .
+
+rounded real :
+  round (real * tenpower ( -decimal exponent (real)) , mantissa length - 1)
+  * tenpower (decimal exponent (real)) .
+
+process sign :
+  IF value < 0.0
+    THEN result := "-"
+    ELSE result := "+"
+  FI .
+
+process mantissa :
+  get mantissa (value) ;
+  result CAT (mantissa SUB 1) ;
+  result CAT "." ;
+  result CAT subtext (mantissa, 2, mantissa length) .
+
+process exponent :
+  IF decimal exponent (value) >= 0
+    THEN result CAT "e+"
+    ELSE result CAT "e-"
+  FI ;
+  result CAT text (ABS decimal exponent (value), 3) ;
+  change all (result, " ", "0") .
+
+ENDPROC text ;
+
+TEXT PROC text (REAL CONST real, INT CONST length, fracs) :
+ 
+  REAL VAR value := round (real, fracs) ;
+  INT VAR  exponent  := decimal exponent (value) ;
+           IF value = 0.0 THEN exponent := 0 FI ;
+  INT VAR  floors    := exponent + 1 ,
+           floor length := length - fracs - 1 ;
+           IF value < 0.0 THEN floor length DECR 1 FI ;
+ 
+  IF value too big
+    THEN length * "*"
+    ELSE transformed value
+  FI .
+ 
+transformed value :
+  process leading blanks and sign ;
+  get mantissa (value) ;
+  result CAT subtext (mantissa, 1, floors) ;
+  IF LENGTH mantissa < floors
+    THEN result CAT (floors - LENGTH mantissa) * "0"
+  FI ;
+  result CAT "." ;
+  IF exponent < 0
+    THEN result CAT (-floors) * "0" ;
+         result CAT subtext (mantissa, 1, length - LENGTH result)
+    ELSE result CAT subtext (mantissa, floors+1, floors + fracs)
+  FI ;
+  IF LENGTH result < length
+    THEN result CAT (length - LENGTH result) * "0"
+  FI ;
+  result .
+ 
+process leading blanks and sign :
+  result := (floor length - max(floors,0)) * " " ;
+  IF value < 0.0
+    THEN result CAT "-" ;
+         value := - value
+  FI .
+ 
+value too big :
+  floors > floor length .
+ 
+ENDPROC text ;
+ 
+REAL PROC real (TEXT CONST text) : 
+ 
+  skip leading blanks ;
+  sign ; 
+  mantissa part ; 
+  exponent ; 
+  result .
+ 
+skip leading blanks :
+  INT VAR pos := 1 ;
+  skip blanks .
+ 
+skip blanks :
+  WHILE (text SUB pos) = " " REP
+    pos INCR 1
+  PER .
+ 
+sign : 
+  BOOL VAR negative ; 
+  IF (text SUB pos) = "-" 
+    THEN negative := TRUE ; 
+         pos INCR 1
+  ELIF (text SUB pos) = "+" 
+    THEN negative := FALSE ; 
+         pos INCR 1
+  ELSE   negative := FALSE
+  FI . 
+ 
+mantissa part: 
+  REAL VAR value ;
+  INT VAR exponent pos := 0 ;
+  get first digit ;
+  WHILE pos <= LENGTH text REP 
+    digit := code (text SUB pos) - 47 ; 
+    IF digit >= digit zero index AND digit <= digit nine index
+      THEN value := value * 10.0 + real digit (digit) ;
+           pos INCR 1 
+    ELIF digit = decimal point index AND exponent pos = 0
+      THEN pos INCR 1 ;
+           exponent pos := pos
+    ELSE LEAVE mantissa part 
+    FI 
+  END REP . 
+ 
+get first digit :
+  INT VAR digit := code (text SUB pos) - 47 ;
+  IF digit = decimal point index
+    THEN pos INCR 1 ;
+         exponent pos := pos ;
+         digit := code (text SUB pos) - 47
+  FI ;
+  IF digit >= digit zero index AND digit <= digit nine index
+    THEN value := real digit (digit) ;
+         pos INCR 1
+    ELSE set conversion (FALSE) ;
+         LEAVE real WITH 0.0
+  FI .
+
+exponent : 
+  INT VAR exp ;
+  IF exponent pos > 0
+    THEN exp := exponent pos - pos
+    ELSE exp := 0
+  FI ;
+  IF (text SUB pos) = "e" 
+    THEN exp INCR int (subtext(text,pos+1)) 
+    ELSE no more nonblank chars permitted
+  FI . 
+ 
+no more nonblank chars permitted :
+  skip blanks ;
+  IF pos > LENGTH text
+    THEN set conversion (TRUE)
+    ELSE set conversion (FALSE)
+  FI .
+ 
+result : 
+  value := value * tenpower (exp) ; 
+  IF negative 
+    THEN - value 
+    ELSE value 
+  FI . 
+ 
+ENDPROC real ; 
+ 
+ 
+REAL PROC abs (REAL CONST value) : 
+ 
+  IF value >= 0.0 
+    THEN  value 
+    ELSE -value 
+  FI 
+ 
+ENDPROC abs ; 
+ 
+REAL OP ABS (REAL CONST value) : 
+ 
+  abs (value) 
+ 
+ENDOP ABS ; 
+ 
+INT PROC sign (REAL CONST value) :
+ 
+  IF   value < 0.0 THEN -1
+  ELIF value = 0.0 THEN  0
+  ELSE                   1
+  FI
+ 
+ENDPROC sign ;
+ 
+INT OP SIGN (REAL CONST value) :
+ 
+  sign (value)
+ 
+ENDOP SIGN ;
+ 
+REAL OP MOD (REAL CONST left, right) :
+ 
+  REAL VAR result := left - floor (left/right) * right ;
+  IF result < 0.0
+    THEN result + abs (right)
+    ELSE result
+  FI
+ 
+ENDOP MOD ;
+ 
+REAL PROC frac (REAL CONST value) :
+ 
+  value - floor (value)
+ 
+ENDPROC frac ;
+ 
+REAL PROC max (REAL CONST a, b) :
+ 
+  IF a > b THEN a ELSE b FI
+ 
+ENDPROC max ;
+ 
+REAL PROC min (REAL CONST a, b) :
+ 
+  IF a < b THEN a ELSE b FI
+ 
+ENDPROC min ;
+ 
+OP INCR (REAL VAR dest, REAL CONST increment) :
+ 
+  dest := dest + increment
+ 
+ENDOP INCR ;
+ 
+OP DECR (REAL VAR dest, REAL CONST decrement) : 
+ 
+  dest := dest - decrement
+ 
+ENDOP DECR ;
+ 
+INT PROC int (REAL CONST value) :
+ 
+  IF value = minint value
+    THEN minint
+    ELSE compute int result ;
+         IF value < 0.0
+           THEN - result
+           ELSE   result
+         FI
+  FI .
+
+compute int result :
+  INT VAR result := 0, digit ,i ;
+  REAL VAR mantissa := value ;
+ 
+  FOR i FROM 0 UPTO decimal exponent (value) REP
+    sld (0, mantissa, digit) ;
+    result := result * 10 + digit 
+  PER .
+
+minint value :  - 32768.0 .
+minint       :  - 32767 - 1 .
+ 
+ENDPROC int ;
+ 
+REAL PROC real (INT CONST value) :
+ 
+  IF value < 0
+    THEN - real (-value)
+  ELIF value < 10
+    THEN real digit (value+1)
+    ELSE split value into head and last digit ;
+         real (head) * 10.0 + real digit (last digit+1)
+  FI .
+ 
+split value into head and last digit :
+  INT CONST
+  head := value DIV 10 ,
+  last digit := value - head * 10 .
+ 
+ENDPROC real ;
+ 
+ENDPACKET real ;
+
diff --git a/system/base/1.7.5/src/scanner b/system/base/1.7.5/src/scanner
new file mode 100644
index 0000000..35a632c
--- /dev/null
+++ b/system/base/1.7.5/src/scanner
@@ -0,0 +1,325 @@
+(* ------------------- VERSION 4     14.05.86 ------------------- *)
+PACKET scanner DEFINES                 (* Autor: J.Liedtke        *)
+ 
+       scan , 
+       continue scan ,
+       next symbol :
+ 
+ 
+LET tag     = 1 ,
+    bold    = 2 , 
+    number  = 3 ,
+    text    = 4 ,
+    operator= 5 ,
+    delimiter = 6 , 
+    end of file = 7 , 
+    within comment = 8 ,
+    within text    = 9 ;
+
+LET digit 0       = 48 ,
+    digit 9       = 57 ,
+    upper case a  = 65 ,
+    upper case z  = 90 ,
+    lower case a  = 97 ,
+    lower case z  = 122;
+
+
+TEXT VAR line := "" , 
+         char := "" ,
+         chars:= "" ;
+ 
+INT VAR  position  := 0 ,
+         comment depth ;
+BOOL VAR continue text ;
+ 
+ 
+PROC scan (TEXT CONST scan text) : 
+ 
+  comment depth := 0 ;
+  continue text := FALSE ;
+  continue scan (scan text)
+ 
+ENDPROC scan ;
+ 
+PROC continue scan (TEXT CONST scan text) :
+ 
+  line := scan text ;
+  position  := 0 ;
+  nextchar 
+ 
+ENDPROC continue scan ;
+
+PROC next symbol (TEXT VAR symbol) : 
+ 
+  INT VAR type ;
+  next symbol (symbol, type) 
+ 
+ENDPROC next symbol ;
+ 
+PROC next symbol (TEXT VAR symbol, INT VAR type) : 
+ 
+  skip blanks ;
+  IF   is begin comment          THEN process comment
+  ELIF comment depth > 0         THEN comment depth DECR 1 ;
+                                      process comment
+  ELIF is quote OR continue text THEN process text 
+  ELIF is lower case letter      THEN process tag 
+  ELIF is upper case letter      THEN process bold 
+  ELIF is digit                  THEN process number
+  ELIF is delimiter              THEN process delimiter
+  ELIF is niltext                THEN eof
+  ELSE process operator 
+  FI . 
+ 
+ 
+process comment :
+  read comment ;
+  IF comment depth = 0
+    THEN next symbol (symbol, type)
+    ELSE type := within comment ;
+         symbol := ""
+  FI .
+ 
+process tag : 
+  type := tag ;
+  assemble chars (lower case a, lower case z) ;
+  symbol := chars ;
+  REP 
+    skip blanks ;
+    IF is lower case letter
+      THEN assemble chars (lower case a, lower case z)
+    ELIF is digit
+      THEN assemble chars (digit 0, digit 9)
+    ELSE   LEAVE process tag
+    FI ;
+    symbol CAT chars
+  PER ;
+  nextchar .
+ 
+process bold : 
+  type := bold ;
+  assemble chars (upper case a, upper case z) ;
+  symbol := chars .
+ 
+process number :
+  type := number ;
+  assemble chars (digit 0, digit 9) ;
+  symbol := chars ;
+  IF char = "." AND ahead char is digit
+    THEN process fraction ;
+         IF char = "e"
+           THEN process exponent
+         FI
+  FI .
+
+ahead char is digit :
+  digit 0 <= code (ahead char) AND code (ahead char) <= digit 9 .
+
+process fraction :
+  symbol CAT char ;
+  nextchar ;
+  assemble chars (digit 0, digit 9) ;
+  symbol CAT chars .
+
+process exponent :
+  symbol CAT char ;
+  nextchar ;
+  IF char = "+" OR char = "-"
+    THEN symbol CAT char ;
+         nextchar
+  FI ;
+  assemble chars (digit 0, digit 9) ;
+  symbol CAT chars .
+ 
+process text : 
+  type := text ;
+  symbol := "" ;
+  IF continue text
+    THEN continue text := FALSE
+    ELSE next char
+  FI ;
+  WHILE not end of text REP 
+    assemble chars (35, 254) ;
+    symbol CAT chars ;
+    IF NOT is quote
+      THEN symbol CAT char ;
+           nextchar
+    FI
+  ENDREP . 
+ 
+not end of text : 
+  IF is niltext 
+    THEN continue text := TRUE ; type := within text ; FALSE
+  ELIF is quote 
+    THEN end of text or exception
+  ELSE TRUE 
+  FI . 
+ 
+end of text or exception :
+  next char ;
+  IF is quote
+    THEN get quote ;        TRUE
+  ELIF is digit
+    THEN get special char ; TRUE
+  ELSE   FALSE
+  FI .
+ 
+get quote :
+  symbol CAT char ;
+  nextchar .
+
+get special char :
+  assemble chars (digit 0, digit 9) ;
+  symbol CAT code (int (chars) ) ;
+  nextchar .
+ 
+process delimiter : 
+  type := delimiter ;
+  symbol := char ;
+  nextchar . 
+ 
+process operator : 
+  type := operator ; 
+  symbol := char ;
+  nextchar ;
+  IF symbol = ":" 
+    THEN IF char = "=" OR char = ":" 
+           THEN symbol := ":=" ;
+                nextchar 
+           ELSE type := delimiter 
+         FI 
+  ELIF is relational double char 
+    THEN symbol CAT char ;
+         nextchar 
+  ELIF symbol = "*" AND char = "*" 
+    THEN symbol := "**" ; 
+         next char 
+  FI .
+ 
+eof : 
+  type := end of file ;
+  symbol := "" .
+ 
+is lower case letter : 
+     lower case a <= code (char) AND code (char) <= lower case z . 
+ 
+is upper case letter : 
+     upper case a <= code (char) AND code (char) <= upper case z .
+ 
+is digit :
+     digit 0 <= code (char) AND code (char) <= digit 9 . 
+ 
+is delimiter : pos ( "()[].,;" , char ) > 0 . 
+ 
+is relational double char : 
+  TEXT VAR double := symbol + char ; 
+  double = "<>" OR double = "<=" OR double = ">=" . 
+ 
+is quote : char = """" .
+ 
+is niltext : char = "" . 
+ 
+is begin comment : char = "{" OR char = "(" AND ahead char = "*" .
+ 
+ENDPROC next symbol ;
+ 
+PROC next char : 
+ 
+  position INCR 1 ;
+  char := line SUB position
+ 
+ENDPROC next char ;
+ 
+PROC skip blanks :
+ 
+  position := pos (line, ""33"", ""254"", position) ;
+  IF position = 0
+    THEN position := LENGTH line + 1
+  FI ;
+  char := line SUB position .
+
+ENDPROC skip blanks ;
+ 
+TEXT PROC ahead char : 
+ 
+  line SUB position+1 
+ 
+ENDPROC ahead char ; 
+
+PROC assemble chars (INT CONST low, high) :
+
+  INT CONST begin := position ;
+  position behind valid text ;
+  chars := subtext (line, begin, position-1) ;
+  char := line SUB position .
+
+position behind valid text :
+  position := pos (line, ""32"", code (low-1), begin) ;
+  IF position = 0
+    THEN position := LENGTH line + 1
+  FI ;
+  INT CONST higher pos := pos (line, code (high+1), ""254"", begin) ;
+  IF higher pos <> 0 AND higher pos < position
+    THEN position := higher pos
+  FI .
+
+ENDPROC assemble chars ;
+
+ 
+PROC read comment : 
+ 
+  TEXT VAR last char ; 
+  comment depth INCR 1 ;
+  REP 
+    last char := char ; 
+    nextchar ; 
+    IF is begin comment
+      THEN read comment
+    FI ;
+    IF char = ""
+      THEN LEAVE read comment
+    FI
+  UNTIL is end comment PER ; 
+  comment depth DECR 1 ;
+  next char ;
+  skip blanks .
+ 
+is end comment :
+  char = "}" OR char = ")" AND last char = "*" .
+ 
+is begin comment :
+  char = "{" OR char = "(" AND ahead char = "*" .
+ 
+ENDPROC read comment ;
+ 
+
+PROC scan (FILE VAR f) :
+
+  getline (f, line) ;
+  scan (line)
+
+ENDPROC scan ; 
+
+PROC next symbol (FILE VAR f, TEXT VAR symbol) :
+
+  INT VAR type ;
+  next symbol (f, symbol, type)
+
+ENDPROC next symbol ;
+
+TEXT VAR scanned ;
+
+PROC next symbol (FILE VAR f, TEXT VAR symbol, INT VAR type) :
+
+  next symbol (symbol, type) ;
+  WHILE type >= 7 AND NOT eof (f) REP
+    getline (f, line) ;
+    continue scan (line) ;
+    next symbol (scanned, type) ;
+    symbol CAT scanned
+  PER .
+
+ENDPROC next symbol ;
+
+ENDPACKET scanner ;
+
diff --git a/system/base/1.7.5/src/screen b/system/base/1.7.5/src/screen
new file mode 100644
index 0000000..7e64961
--- /dev/null
+++ b/system/base/1.7.5/src/screen
@@ -0,0 +1,33 @@
+
+PACKET screen description DEFINES
+
+     xsize, ysize, marksize, mark refresh line mode :
+
+
+INT VAR xs := 80, ys := 24, ms := 1;
+
+INT PROC xsize: xs END PROC xsize;
+
+INT PROC ysize: ys END PROC ysize;
+
+INT PROC marksize: ms END PROC marksize;
+
+PROC xsize (INT CONST i): xs := i END PROC xsize;
+
+PROC ysize (INT CONST i): ys := i END PROC ysize;
+
+PROC marksize (INT CONST i): ms := i END PROC marksize;
+
+ 
+BOOL VAR line mode := FALSE; 
+ 
+BOOL PROC mark refresh line mode:
+  line mode
+END PROC mark refresh line mode;
+ 
+PROC mark refresh line mode (BOOL CONST b): 
+  line mode := b 
+END PROC mark refresh line mode; 
+ 
+END PACKET screen description ;
+
diff --git a/system/base/1.7.5/src/std transput b/system/base/1.7.5/src/std transput
new file mode 100644
index 0000000..94c51db
--- /dev/null
+++ b/system/base/1.7.5/src/std transput
@@ -0,0 +1,264 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PACKET std transput DEFINES 
+ 
+    sysout ,
+    sysin ,
+    put ,
+    putline ,
+    line ,
+    page ,
+    write ,
+    get ,
+    getline , 
+    get secret line :
+ 
+ 
+LET cr              = ""13"" ,
+    cr lf           = ""13""10"" ,
+    home clear      = ""1""4"" ,
+    esc             = ""27"" ,
+    rubout          = ""12"" ,
+    bell            = ""7"" ,
+    back blank back = ""8" "8"" ,
+    del line cr lf  = ""5""13""10"" ;
+
+TEXT VAR number word , exit char ;
+
+BOOL VAR console output := TRUE, console input := TRUE ;
+
+FILE VAR outfile, infile ;
+TEXT VAR outfile name := "", infile name := "" ;
+
+
+PROC sysout (TEXT CONST file name) :
+
+  outfile name := file name ;
+  IF file name = ""
+    THEN console output := TRUE
+    ELSE outfile := sequential file (output, file name) ;
+         console output := FALSE
+  FI
+
+ENDPROC sysout ;
+
+TEXT PROC sysout :
+  outfile name
+ENDPROC sysout ;
+
+PROC sysin (TEXT CONST file name) :
+
+  infile name := file name ;
+  IF file name = ""
+    THEN console input := TRUE
+    ELSE infile := sequential file (input, file name) ;
+         console input := FALSE
+  FI
+
+ENDPROC sysin ;
+
+TEXT PROC sysin :
+  infile name
+ENDPROC sysin ;
+
+
+PROC put (TEXT CONST word) :
+
+  IF console output
+    THEN out (word) ; out (" ")
+    ELSE put (outfile, word)
+  FI
+
+ENDPROC put ;
+
+PROC put (INT CONST number) :
+
+  put (text (number))
+
+ENDPROC put ;
+
+PROC put (REAL CONST number) :
+
+  put (text (number))
+
+ENDPROC put ;
+
+PROC putline (TEXT CONST textline) :
+
+  IF console output
+    THEN out (textline) ; out (cr lf)
+    ELSE putline (outfile, textline)
+  FI
+
+ENDPROC putline ;
+
+PROC line :
+
+  IF console output
+    THEN out (cr lf)
+    ELSE line (outfile)
+  FI 
+
+ENDPROC line ;
+
+PROC line (INT CONST times) :
+
+  INT VAR i ;
+  FOR i FROM 1 UPTO times REP
+    line
+  PER
+
+ENDPROC line ;
+
+PROC page :
+
+  IF console output
+    THEN out (home clear)
+  FI
+
+ENDPROC page ;
+
+PROC write (TEXT CONST word) :
+
+  IF console output 
+    THEN out (word)
+    ELSE write (outfile, word)
+  FI
+
+ENDPROC write ;
+
+
+PROC get (TEXT VAR word) : 
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word)
+  FI .
+
+get from console :
+  REP
+    word := "" ;
+    editget (word, " ", "", exit char) ;
+    echoe exit char
+  UNTIL word <> "" AND word <> " " PER ;
+  delete leading blanks .
+ 
+delete leading blanks :
+  WHILE (word SUB 1) = " " REP
+    word := subtext (word,2)
+  PER .
+ 
+ENDPROC get ;
+ 
+PROC get (TEXT VAR word, TEXT CONST separator) : 
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word, separator)
+  FI .
+
+get from console :
+  word := "" ;
+  editget (word, separator, "", exit char) ;
+  echoe exit char .
+
+ENDPROC get ;
+ 
+PROC echoe exit char :
+ 
+  IF exit char = ""13""
+    THEN out (""13""10"")
+    ELSE out (exit char)
+  FI
+ 
+ENDPROC echoe exit char ;
+ 
+PROC get (INT VAR number) :
+
+  get (number word) ;
+  number := int (number word)
+
+ENDPROC get ;
+
+PROC get (REAL VAR number) :
+
+  get (number word) ;
+  number := real (number word) 
+
+ENDPROC get ;
+
+PROC get (TEXT VAR word, INT CONST length) :
+ 
+  IF console input
+    THEN get from console
+    ELSE get (infile, word, length)
+  FI .
+
+get from console :
+  word := "" ;
+  editget (word, length, exit char) ;
+  echoe exit char .
+ 
+ENDPROC get ;
+ 
+PROC getline (TEXT VAR textline) : 
+
+  IF console input
+    THEN get from console
+    ELSE getline (infile, textline)
+  FI .
+
+get from console :
+  textline := "" ;
+  editget (textline, "", "", exit char) ;
+  echoe exit char
+ 
+ENDPROC getline ;
+ 
+PROC get secret line (TEXT VAR textline) :
+
+  TEXT VAR char ;
+  textline := "" ;
+  get start cursor position ;
+  get line very secret ;
+  IF char = esc
+    THEN get line little secret
+  FI ;
+  cursor to start position ;
+  out (del line cr lf) .
+
+get line very secret :
+  REP
+    inchar (char) ;
+    IF char = esc OR char = cr
+      THEN LEAVE get line very secret
+    ELIF char = rubout
+      THEN delete last char
+    ELIF char >= " "
+      THEN textline CAT char ;
+           out (".")
+    ELSE   out (bell)
+    FI
+  PER .
+
+delete last char :
+  IF LENGTH textline = 0
+    THEN out (bell)
+    ELSE out (back blank back) ;
+         delete char (textline, LENGTH textline)
+  FI .
+
+get line little secret :
+  cursor to start position ;
+  editget (textline, "", "", exit char) .
+
+get start cursor position :
+  INT VAR x, y; 
+  get cursor (x, y) .
+
+cursor to start position :
+  cursor (x, y) .
+
+ENDPROC get secret line ;
+
+ENDPACKET std transput ;
+
diff --git a/system/base/1.7.5/src/tasten b/system/base/1.7.5/src/tasten
new file mode 100644
index 0000000..752303b
--- /dev/null
+++ b/system/base/1.7.5/src/tasten
@@ -0,0 +1,113 @@
+
+PACKET  tasten verwaltung  DEFINES                                (* #009 *)
+        (***************) 
+ 
+        lernsequenz auf taste legen, 
+        lernsequenz auf taste, 
+        kommando auf taste legen,
+        kommando auf taste,
+        taste enthaelt kommando,
+        std tastenbelegung :
+ 
+ 
+
+LET kommandoidentifikation = ""0"" ,
+    esc = ""27"" ,
+    niltext = "" ,
+    hop right left up down cr tab rubin rubout mark esc
+            = ""1""2""8""3""10""13""9""11""12""16""27"" ;
+ 
+ 
+ROW 256 TEXT VAR belegung;
+INT VAR i; FOR i FROM 1 UPTO 256 REP belegung (i) := "" PER;
+ 
+std tastenbelegung;
+ 
+ 
+PROC lernsequenz auf taste legen (TEXT CONST taste, lernsequenz) :
+ 
+  belege (belegung (code (taste) + 1), taste, lernsequenz)
+ 
+ENDPROC lernsequenz auf taste legen ;
+ 
+PROC belege (TEXT VAR tastenpuffer, TEXT CONST taste, lernsequenz) :
+  tastenpuffer := lernsequenz ;
+  verhindere rekursives lernen .
+ 
+verhindere rekursives lernen :
+  loesche alle folgen esc taste aber nicht esc esc taste ;
+  IF taste ist freies sonderzeichen
+    THEN change all (tastenpuffer, taste, niltext)
+  FI .
+ 
+loesche alle folgen esc taste aber nicht esc esc taste :
+  INT VAR i := pos (tastenpuffer, esc + taste) ;
+  WHILE i > 0 REP
+    IF ist esc esc taste
+      THEN i INCR 1
+      ELSE change (tastenpuffer, i, i+1, niltext)
+    FI ;
+    i := pos (tastenpuffer, esc + taste, i)
+  PER .
+ 
+ist esc esc taste :
+  (tastenpuffer SUB i-1) = esc AND (tastenpuffer SUB i-2) <> esc .
+ 
+taste ist freies sonderzeichen :
+  taste < ""32"" AND
+  pos (hop right left up down cr tab rubin rubout mark esc, taste) = 0 .
+ 
+END PROC belege ;
+ 
+ 
+TEXT PROC lernsequenz auf taste (TEXT CONST taste) :
+  IF   taste enthaelt kommando (taste)
+  THEN ""
+  ELSE belegung (code (taste) + 1)
+  FI
+END PROC lernsequenz auf taste;
+ 
+ 
+PROC kommando auf taste legen (TEXT CONST taste, kommando) :
+ 
+  belegung (code (taste) + 1) := kommandoidentifikation;
+  belegung (code (taste) + 1) CAT kommando
+ 
+END PROC kommando auf taste legen;
+ 
+ 
+TEXT PROC kommando auf taste (TEXT CONST taste) :
+  IF   taste enthaelt kommando (taste)
+  THEN subtext (belegung (code (taste) + 1), 2)
+  ELSE ""
+  FI
+END PROC kommando auf taste;
+ 
+ 
+BOOL PROC taste enthaelt kommando (TEXT CONST taste) :
+  (belegung (code (taste) + 1) SUB 1) = kommandoidentifikation
+END PROC taste enthaelt kommando;
+ 
+ 
+PROC std tastenbelegung:
+  lernsequenz auf taste legen ("(", ""91"");
+  lernsequenz auf taste legen (")", ""93"");
+  lernsequenz auf taste legen ("<", ""123"");
+  lernsequenz auf taste legen (">", ""125"");
+  lernsequenz auf taste legen ("A", ""214"");
+  lernsequenz auf taste legen ("O", ""215"");
+  lernsequenz auf taste legen ("U", ""216"");
+  lernsequenz auf taste legen ("a", ""217"");
+  lernsequenz auf taste legen ("o", ""218"");
+  lernsequenz auf taste legen ("u", ""219"");
+  lernsequenz auf taste legen ("k", ""220"");
+  lernsequenz auf taste legen ("-", ""221"");
+  lernsequenz auf taste legen ("#", ""222"");
+  ler�sequenz auf taste legen (" ", ""223"");
+  lernsequenz auf taste legen ("B", ""251"");
+  lernsequenz auf taste legen ("s", ""251"");
+END PROC std tastenbelegung;
+ 
+ 
+END PACKET tasten verwaltung;
+
diff --git a/system/base/1.7.5/src/text b/system/base/1.7.5/src/text
new file mode 100644
index 0000000..4c659cf
--- /dev/null
+++ b/system/base/1.7.5/src/text
@@ -0,0 +1,391 @@
+(* ------------------- VERSION 3     06.03.86 ------------------- *)
+PACKET text DEFINES
+ 
+            max text length ,
+            SUB ,
+            subtext ,
+            text ,
+            length , LENGTH ,
+            CAT ,
+            + ,
+            * ,
+            replace ,
+            change ,
+            change all ,
+            compress ,
+            pos ,
+            code ,
+            ISUB ,
+            RSUB ,
+            delete char ,
+            insert char ,
+            delete int ,
+            insert int ,
+            heap size ,
+            collect heap garbage ,
+            stranalyze ,
+            LEXEQUAL ,
+            LEXGREATER ,
+            LEXGREATEREQUAL :
+
+ 
+ 
+TEXT VAR text buffer , tail buffer ;
+ 
+INT CONST max text length := 32000 ;
+ 
+TEXT OP SUB (TEXT CONST text, INT CONST pos ) :
+ EXTERNAL 48
+END OP SUB ;
+ 
+TEXT PROC subtext (TEXT CONST source, INT CONST from, to ):
+ EXTERNAL 49 
+ENDPROC subtext ;
+ 
+TEXT PROC subtext (TEXT CONST source, INT CONST from ) : 
+ EXTERNAL 50 
+ENDPROC subtext ; 
+ 
+INT PROC code (TEXT CONST text) :
+ EXTERNAL 46
+END PROC code ;
+ 
+TEXT PROC code (INT CONST code) :
+ EXTERNAL 47 
+ENDPROC code ;
+
+INT OP ISUB (TEXT CONST text, INT CONST index) :
+ EXTERNAL 44
+ENDOP ISUB ;
+ 
+PROC replace (TEXT VAR text, INT CONST index, value) :
+ EXTERNAL 45
+ENDPROC replace ;
+
+REAL OP RSUB (TEXT CONST text, INT CONST index) :
+ EXTERNAL 100
+ENDOP RSUB ;
+
+PROC replace (TEXT VAR text, INT CONST index, REAL CONST code) :
+ EXTERNAL 101
+ENDPROC replace ;
+ 
+ 
+PROC replace (TEXT VAR dest, INT CONST pos, TEXT CONST source) : 
+ EXTERNAL 51 
+ENDPROC replace ; 
+ 
+TEXT PROC text (TEXT CONST source, INT CONST length ) : 
+
+  IF length < LENGTH source 
+     THEN text buffer := subtext (source,1,length) 
+     ELSE text buffer := source ;
+          mit blanks auffuellen 
+  FI ; 
+  text buffer .
+ 
+mit blanks auffuellen : 
+  INT VAR i ;
+  FOR i FROM 1 UPTO length - LENGTH source REP
+    text buffer CAT " "
+  PER .
+
+ENDPROC text ; 
+ 
+TEXT PROC text (TEXT CONST source, INT CONST length, from) : 
+  text ( subtext (source, from) , length ) 
+ENDPROC text ; 
+ 
+OP CAT (TEXT VAR right, TEXT CONST left ) :
+ EXTERNAL 52 
+ENDOP CAT ;
+ 
+TEXT OP + (TEXT CONST left, right) : 
+ text buffer := left ;
+ text buffer CAT right ; 
+ text buffer
+ENDOP + ; 
+ 
+TEXT OP * (INT CONST times, TEXT CONST source ) : 
+
+  text buffer := "" ;
+  INT VAR i ;
+  FOR i FROM 1 UPTO times REP
+    text buffer CAT source
+  PER ;
+  text buffer
+
+ENDOP * ;
+ 
+INT PROC length (TEXT CONST text ) : 
+ EXTERNAL 53 
+ENDPROC length ; 
+ 
+INT OP LENGTH (TEXT CONST text ) : 
+ EXTERNAL 53 
+ENDOP LENGTH ;
+ 
+INT PROC pos (TEXT CONST source, pattern) : 
+ EXTERNAL 54 
+ENDPROC pos ; 
+ 
+INT PROC pos (TEXT CONST source, pattern, INT CONST from) : 
+ EXTERNAL 55 
+ENDPROC pos ;
+
+INT PROC pos (TEXT CONST source, pattern, INT CONST from, to) :
+ EXTERNAL 56 
+ENDPROC pos ;
+ 
+INT PROC pos (TEXT CONST source, low, high, INT CONST from) :
+ EXTERNAL 58
+ENDPROC pos ;
+
+TEXT PROC compress (TEXT CONST text) : 
+ 
+  INT VAR begin, end ;
+ 
+  search first non blank ;
+  search last non blank ;
+  text buffer := subtext (text, begin, end) ;
+  text buffer .
+ 
+search first non blank : 
+  begin := 1 ;
+  WHILE (text SUB begin) = " " REP
+    begin INCR 1
+  PER .
+ 
+search last non blank : 
+  end := LENGTH text ;
+  WHILE (text SUB end) = " " REP
+    end DECR 1
+  PER .
+ 
+ENDPROC compress ;
+ 
+PROC change (TEXT VAR destination, INT CONST from, to, TEXT CONST new) :
+ 
+  IF LENGTH new = to - from + 1 AND to <= LENGTH destination
+    THEN replace (destination, from, new)
+    ELSE change via buffer
+  FI .
+
+change via buffer :
+  text buffer := subtext (destination, 1, from-1) ;
+  text buffer CAT new ;
+  tail buffer := subtext (destination, to + 1) ;
+  text buffer CAT tail buffer ;
+  destination := text buffer
+ 
+ENDPROC change ;
+ 
+PROC change (TEXT VAR destination, TEXT CONST old, new) :
+ 
+  INT CONST position := pos (destination, old) ;
+  IF position > 0
+    THEN change (destination, position, position + LENGTH old -1, new)
+  FI
+ 
+ENDPROC change ;
+ 
+PROC change all (TEXT VAR destination, TEXT CONST old, new) :
+ 
+  INT VAR position := pos (destination, old) ;
+  IF LENGTH old = LENGTH new
+    THEN change by replace
+    ELSE change by change
+  FI .
+
+change by replace :
+  WHILE position > 0 REP
+    replace (destination, position, new) ;
+    position := pos (destination, old, position + LENGTH new)
+  PER .
+
+change by change :
+  WHILE position > 0 REP
+    change (destination, position, position + LENGTH old - 1 , new) ;
+    position := pos (destination, old, position + LENGTH new)
+  PER .
+ 
+ENDPROC change all ;
+ 
+PROC delete char (TEXT VAR string, INT CONST delete pos) : 
+ 
+  IF delete pos > 0
+    THEN tail buffer := subtext (string, delete pos + 1) ;
+         string := subtext (string, 1, delete pos - 1) ;
+         string CAT tail buffer
+  FI
+ 
+END PROC delete char ; 
+ 
+PROC insert char (TEXT VAR string, TEXT CONST char,
+                  INT CONST insert pos) : 
+ 
+  IF insert pos > 0 AND insert pos <= LENGTH string + 1
+    THEN tail buffer := subtext (string, insert pos) ;
+         string := subtext (string, 1, insert pos - 1) ;
+         string CAT char ;
+         string CAT tail buffer
+  FI
+ 
+END PROC insert char ; 
+ 
+INT PROC heap size :
+  EXTERNAL 93
+ENDPROC heap size ;
+
+PROC collect heap garbage :
+  EXTERNAL 94
+ENDPROC collect heap garbage ;
+
+PROC stranalyze (ROW 256 INT CONST table, INT VAR sum, INT CONST max sum,
+                 TEXT CONST string, INT VAR index, INT CONST to,
+                 INT VAR exit code) :
+  EXTERNAL 57
+ENDPROC stranalyze ;
+
+(*******************************************************************)
+(* lexikographische Vergleiche                                     *)
+(* Nach DIN 5007, Abschnitt 1 und Abschnitt 3.2 (Bindestrich)      *)
+(* Autor: Rainer Hahn, Jochen Liedtke                              *)
+(* Stand: 1.7.4 (Jan. 1985)                                        *)
+(*******************************************************************)
+LET first umlaut = ""214"" ,
+    umlauts      = ""214""215""216""217""218""219""251"" ;
+
+ 
+TEXT VAR left letter, right letter; 
+ 
+BOOL OP LEXEQUAL (TEXT CONST left, right) : 
+ 
+  compare (left, right) ; 
+  left letter = right letter 
+ 
+ENDOP LEXEQUAL ; 
+ 
+BOOL OP LEXGREATER (TEXT CONST left, right) : 
+ 
+  compare (left, right) ; 
+  left letter > right letter 
+ 
+ENDOP LEXGREATER ; 
+ 
+BOOL OP LEXGREATEREQUAL (TEXT CONST left, right) : 
+ 
+  compare (left, right) ; 
+  left letter >= right letter 
+ 
+ENDOP LEXGREATEREQUAL ; 
+ 
+PROC compare (TEXT CONST left, right) :
+ 
+  to begin of lex relevant text ; 
+  REP 
+    get left letter ; 
+    get right letter 
+  UNTIL NOT letter match OR both ended PER . 
+ 
+to begin of lex relevant text : 
+  INT VAR 
+  left pos  := pos (left, ""65"",""254"", 1) , 
+  right pos := pos (right,""65"",""254"", 1) ;
+  IF left pos = 0
+    THEN left pos := LENGTH left + 1
+  FI ;
+  IF right pos = 0
+    THEN right pos := LENGTH right + 1
+  FI .
+
+get left letter :
+  left letter := left SUB left pos ;
+  left pos INCR 1 .
+
+get right letter :
+  right letter := right SUB right pos ;
+  right pos INCR 1 .
+
+letter match :
+  IF left letter = right letter
+    THEN TRUE
+    ELSE dine (left, left letter, left pos) ;
+         dine (right, right letter, right pos) ;
+         IF exactly one letter is double letter
+           THEN expand other letter
+         FI ;
+         left letter = right letter
+  FI .
+
+exactly one letter is double letter :
+  LENGTH left letter <> LENGTH right letter.
+
+expand other letter :
+  IF LENGTH left letter = 1
+    THEN left letter CAT (left SUB left pos) ;
+         left pos INCR 1
+    ELSE right letter CAT (right SUB right pos) ;
+         right pos INCR 1
+  FI .
+
+both ended : left letter = "" .
+
+ENDPROC compare ;
+
+PROC dine (TEXT CONST string, TEXT VAR char, INT VAR string pos) :
+
+  skip non letter chars ;
+  IF is capital letter
+    THEN translate to small letter
+  ELIF char >= first umlaut
+    THEN translate umlaut
+  FI .
+
+skip non letter chars :
+  WHILE NOT (is letter OR end of string) REP
+    char := string SUB string pos ;
+    string pos INCR 1
+  PER .
+
+translate to small letter :
+  char := code (code (char) + 32) .
+
+translate umlaut :
+  SELECT pos (umlauts, char) OF
+    CASE 1,4 : char := "ae"
+    CASE 2,5 : char := "oe"
+    CASE 3,6 : char := "ue"
+    CASE 7   : char := "ss"
+  ENDSELECT .
+
+is capital letter : 
+  INT VAR char code := code (char) ;
+  65 <= char code AND char code <= 90 .
+
+is letter :
+  char code := code (char) OR 32 ;
+  (97 <= char code AND char code <= 122)  OR  char code >= 128 .
+
+end of string : char = "" .
+
+ENDPROC dine ;
+
+OP CAT (TEXT VAR result, INT CONST number) :
+    result CAT "  ";
+    replace (result, LENGTH result DIV 2, number);
+END OP CAT;
+ 
+PROC insert int (TEXT VAR result, INT CONST insert pos, number) :
+    INT VAR pos := insert pos * 2 - 1; 
+    change  (result, pos, pos - 1, "  ");
+    replace (result, insert pos, number);
+END PROC insert int;
+ 
+PROC delete int (TEXT VAR result, INT CONST delete pos) :
+    INT VAR pos := delete pos * 2;
+    change  (result, pos - 1, pos, "")
+END PROC delete int; 
+ 
+ENDPACKET text ;
+
diff --git a/system/base/1.7.5/src/texter errors b/system/base/1.7.5/src/texter errors
new file mode 100644
index 0000000..9c4383d
--- /dev/null
+++ b/system/base/1.7.5/src/texter errors
@@ -0,0 +1,284 @@
+(* ------------------- VERSION 66 vom 06.03.86 -------------------- *)
+PACKET texter errors and common DEFINES
+   only command line,
+   skip input,
+   char pos move,
+   begin of this char,
+   number chars,
+   display and pause,
+   report text processing error,
+   report text processing warning:
+
+(* Programm zur zentralen Haltung aller Fehlermeldungen der Textkosmetik
+   Autor: Rainer Hahn
+   Stand: 1.7.1 Febr. 1984
+          1.7.3 Juli    "
+          1.7.4 Febr. 1985
+ *)
+
+LET escape = ""27"";
+
+TEXT VAR fehlerdummy;
+
+BOOL PROC only command line (TEXT CONST zeile):
+INT VAR anfang, ende;
+LET kommando zeichen = "#";
+  IF pos (zeile, kommando zeichen) = 1
+    THEN ende := pos (zeile, kommando zeichen, 2); 
+         IF ende > 0
+           THEN zaehle kommandos durch;
+                LEAVE only command line WITH richtiges kommandoende
+         FI
+  FI;
+  FALSE.
+ 
+zaehle kommandos durch:
+  WHILE ende + 1 = pos (zeile, kommando zeichen, ende +1) REP
+    anfang := pos (zeile, kommando zeichen, ende + 1);
+    ende   := pos (zeile, kommando zeichen, anfang + 1)
+  END REP.
+ 
+richtiges kommandoende:
+  ende > 0 AND
+     (ende = length (zeile) OR (ende = length (zeile) - 1 AND absatzzeile)).
+ 
+absatzzeile:
+  (zeile SUB length (zeile)) = " ". 
+END PROC only command line;
+
+PROC skip input:
+  REP
+    TEXT CONST zeichen :: incharety;
+    IF zeichen = escape
+      THEN errorstop ("Abbruch durch ESC")
+    FI
+  UNTIL zeichen = "" END REP
+END PROC skip input;
+
+PROC char pos move (TEXT CONST ein text, INT VAR zpos, INT CONST richtung):
+  zpos INCR richtung;
+  IF within kanji (ein text, zpos)
+    THEN zpos INCR richtung
+  FI
+END PROC char pos move;
+
+PROC begin of this char (TEXT CONST ein text, INT VAR zpos):
+  IF zpos < 1 OR zpos > length (ein text)
+    THEN display and pause (7)
+    ELSE suche zeichenposition
+  FI.
+
+suche zeichenposition:
+  IF within kanji (ein text, zpos)
+    THEN zpos DECR 1
+  FI.
+END PROC begin of this char;
+
+INT PROC number chars (TEXT CONST ein text, INT CONST von pos, bis pos):
+  INT VAR index :: von pos, anz :: 0;
+  WHILE index <= bis pos REP
+   IF index > length (ein text) OR index > bis pos
+     THEN display and pause (5); LEAVE number chars WITH 0
+   FI;
+   IF is kanji esc (ein text SUB index)
+     THEN index INCR 2
+     ELSE index INCR 1
+   FI;
+   anz INCR 1
+ END REP;
+ anz
+END PROC number chars;
+
+PROC display and pause (INT CONST nr):
+  line ; put ("LINER ERROR"); put (nr); pause
+END PROC display and pause;
+
+PROC report text processing error (INT CONST error nr,
+                                  INT CONST line nr,
+                                  TEXT VAR  message, 
+                                  TEXT CONST addition):
+ 
+  einfache meldung aufbauen; 
+  meldung in fehlerdatei ausgeben. 
+ 
+einfache meldung aufbauen: 
+  message := "FEHLER Zeile ";
+  message CAT text (line nr);
+  message CAT ": ";
+  message CAT simple message;
+  message CAT " ";
+  message CAT addition.
+ 
+meldung in fehlerdatei ausgeben: 
+  note (message);
+  note line;
+  fehlerdummy := "   >>> ";
+  fehlerdummy CAT zusatz;
+  note (fehlerdummy);
+  note line.
+ 
+simple message:
+  SELECT error nr OF
+  CASE 1: "Unbekannter Schriftyp ignoriert:"
+  CASE 2: "#-Zeichen fehlt"
+  CASE 3: "foot in Fußnote (ignoriert)"
+  CASE 4: "cm-Angabe fehlt (REAL) (ignoriert):"
+  CASE 5: "INT-Parameter erwartet (ignoriert):"
+  CASE 6: "(versuchte) Trennung in Macro-Text"
+  CASE 7: "ie-Anweisung fehlt bei Seitenende"
+  CASE 8: "Unbekannte Anweisung (ignoriert):"
+  CASE 9: "Nicht kompilierbares Programm:"
+  CASE 10: "Einrückung (Leerzeichen am Zeilenanfang) zu groß"
+  CASE 11: "Anweisung hier nicht erlaubt (ignoriert):"
+  CASE 12: "Tabellen-Position liegt innerhalb eines b pos:"
+  CASE 13: "free-Wert > Textteil der Seite (ignoriert)"
+  CASE 14: "Mehr als 1 Zeichen in pagenr (ignoriert)"
+  CASE 15: "Macro innerhalb eines Macros definiert (ignoriert):"
+  CASE 16: "Mehr als drei Seitenzeichen"
+  CASE 17: "Mehr als zehn Zeilen im Index"
+  CASE 18: "Index Parameter inkorrekt (ignoriert): "
+  CASE 19: "Hinter Anweisung darf nichts mehr stehen (ignoriert):"
+  CASE 20: "Doppelter Index ignoriert:"
+  CASE 21: "ib(..) fehlt:"
+  CASE 22: "Inkorrekte Anweisung:"
+  CASE 23: "2 Byte Zeichen ohne zweites Zeichen am Zeilenende"
+  CASE 24: "free-Wert größer Seitenlänge (ignoriert):"
+  CASE 25: "Seitenende in head, bottom oder foot-Bereich plaziert"
+  CASE 26: "Anzahl columns < 2 ignoriert"
+  CASE 27: "INT-Parameter <= 0 ignoriert:"
+  CASE 28: "Kein Textzeichen vor oder hinter b"
+  CASE 29: "Nochmaliges columns ohne columns end (ignoriert)"
+  CASE 30: "set count-Parameter inkorrekt (ignoriert):"
+  CASE 31: "end ohne vorangehendes head, bottom oder foot"
+  CASE 32: "Max. Anzahl von Tabellen-Positionen überschritten"
+  CASE 33: "Macro-Aufruf oder -Definition in einem Macro (ignoriert):"
+  CASE 34: "counter nicht initialisiert (ignoriert):"
+  CASE 35: "store counter Kennung bereits vorhanden (ignoriert):"
+  CASE 36: "Spaltenbreite > limit"
+  CASE 37: "Zentimeter-Angabe in limit = 0 (ignoriert)"
+  CASE 38: "Zentimeter-Angabe inkorrekt (ignoriert):"
+  CASE 39: "Zentimeter-Angabe > als eingestelltes limit (ignoriert):"
+  CASE 40: "Makro-Definition (ignoriert):"
+  CASE 41: "Nochmaliges table ohne table end (ignoriert)"
+  CASE 42: "pos bereits hier gesetzt (ignoriert):"
+  CASE 43: "Druckposition (pos) nicht vorhanden:"
+  CASE 44: "Text breiter als Spalte bei:"
+  CASE 45: "rpos überschreibt vorherige Spalte bei:"
+  CASE 46: "cpos überschreibt vorherige Spalte bei:"
+  CASE 47: "dpos überschreibt vorherige Spalte bei:"
+  CASE 48: "Geblockter Text breiter als Spalte bei:"
+  CASE 49: "table end fehlt"
+  CASE 50: "Zentrierzeichen für dpos fehlt bei:"
+  CASE 51: "e-Anweisung ohne vorangehendes d oder u"
+  CASE 52: "fehlendes e auf dieser Zeile"
+  CASE 53: "Wort mit Exponent oder Index zu lang"
+  CASE 54: "Modifikation bereits angeschaltet bei on:"
+  CASE 55: "Modifikation nicht angeschaltet bei off:"
+  CASE 56: "Index bereits angeschaltet bei ib:"
+  CASE 57: "Index nicht angeschaltet bei ie:"
+  CASE 58: "Inkorrekte direkte Drucker-Anweisung (TEXT-Denoter):"
+  CASE 59: "tableend ohne vorangehendes table"
+  CASE 60: "put counter fehlt für:"
+  CASE 61: "store counter fehlt für:"
+  OTHERWISE ""
+  ENDSELECT.
+ 
+zusatz:
+  SELECT error nr OF
+  CASE 1: "type-Anweisung korrigieren"
+  CASE 2: "Bitte Einfügen"
+  CASE 3: "Geschachtelte Fußnoten sind nicht möglich"
+  CASE 4: "Beispiel: limit(16.0)"
+  CASE 5: "Beispiele: page(4), pagenr(""%"",4)"
+  CASE 6: "Trennung erscheint nicht im Ausdruck!"
+  CASE 7: "Index in Indexdatei ggf. vervollständigen"
+  CASE 10: "für Zeilenbreite (limit): Leerzeichen entfernen"
+  CASE 11: "(In head-, bottom- und foot-Bereichen)"
+  CASE 13: "Parameterwert verkleinern"
+  CASE 14: "Beispiel: pagenr(""$"",5)"
+  CASE 15: "Macros kontrollieren und ggf. neu laden"
+  CASE 16: "sind z.Z. nicht zugelassen"
+  CASE 17: "ie(..) vergessen?"
+  CASE 18: "1.Parameter gibt die Index-Nummer (1-10) an. Beispiel: ie(9)"
+  CASE 19: "Anweisung muß alleine oder am Zeilenende stehen"
+  CASE 24: "in einem head, bottom oder foot-Bereich"
+  CASE 25: "Vor oder hinter den Bereich plazieren"
+  CASE 26: "1.Parameter in columns korrigieren"
+  CASE 27: "Beispiel: page(20)"
+  CASE 29: "page und columnsend vorher einfügen"
+  CASE 30: "Beispiele: setcount(0); setcount(27)"
+  CASE 31: "end ggf. entfernen" 
+  CASE 34: "Bitte set counter einfuegen"
+  CASE 37: "Muß positiv sein"
+  CASE 38: "Beispiel: limit(16.0)"
+  CASE 40: "pos-Anweisungen vor table plazieren"
+  CASE 41: "tableend vergessen?"
+  CASE 42: "Bitte pos-Anweisungen überprüfen"
+  CASE 43: "in clear pos-Anweisung"
+  CASE 48: "Ggf. lineform über die Spalte"
+  CASE 49: "Bitte vor Dateiende einfügen"
+  CASE 51, 52: "Bitte u und d-Anweisungen kontrollieren"
+  CASE 53: "e-Anweisung vergessen?"
+  CASE 54, 55, 56, 57: "Anweisung in angegebener Zeilennummer überprüfen"
+  CASE 60: "Bitte store counter Anweisungen überprüfen"
+  OTHERWISE "Bitte Korrigieren"
+  END SELECT.
+END PROC report text processing error;
+
+PROC report text processing warning (INT CONST error nr,
+                                     INT CONST line nr,
+                                     TEXT VAR  message, 
+                                     TEXT CONST addition):
+ 
+  einfache meldung aufbauen; 
+  meldung in fehlerdatei ausgeben. 
+ 
+einfache meldung aufbauen: 
+  message := "WARNUNG Zeile ";
+  message CAT text (line nr);
+  message CAT ": ";
+  message CAT simple message;
+  message CAT " ";
+  message CAT addition.
+ 
+meldung in fehlerdatei ausgeben: 
+  note (message);
+  note line;
+  fehlerdummy := "   >>> ";
+  fehlerdummy CAT zusatz;
+  note (fehlerdummy);
+  note line.
+ 
+simple message:
+  SELECT error nr OF
+  CASE 1, 2: ""
+  CASE 3: "Nicht referenziert:"
+  CASE 4: "Ziel-Referenz fehlt:"
+  CASE 5: "Modifikation bei Dateiende nicht ausgeschaltet:"
+  CASE 6: "Index bei Dateiende nicht ausgeschaltet:"
+  CASE 7: "Nicht getrenntes Wort zu lang für Zeilenbreite:"
+  CASE 8: "Umschaltung auf gleichen Schrifttyp:"
+  CASE 9: "Kennzeichen schon vorhanden (Duplikat ignoriert):"
+  CASE 10: "Tabellenzeile breiter als limit"
+  CASE 11: "Mehr Spalten als Tabellen-Positionen bei:"
+  CASE 12: "Überschreibung nach"
+  CASE 13: "Leerzeichen vor:"
+  CASE 14: "Weniger Spalten als Tabellen-Positionen"
+  CASE 15: "counter mit dieser Kennung bereits initialisiert:"
+  OTHERWISE ""
+  ENDSELECT.
+ 
+zusatz:
+  SELECT error nr OF
+  CASE 3: "topage oder value fehlt"
+  CASE 4: "goalpage oder value fehlt" 
+  CASE 7: "Bitte nachträglich trennen!" 
+  CASE 8: "Schrifttyp wurde darum nicht verändert!"
+  CASE 9: "count und goalpage überprüfen"
+  CASE 12: "Bitte fehlende Leerzeichen einfügen"
+  CASE 13: "erzeugt ggf. zusätzliche Leerzeile"
+  OTHERWISE "Bitte überprüfen"
+  END SELECT.
+END PROC report text processing warning;
+END PACKET texter errors and common;
+
diff --git a/system/base/1.7.5/src/thesaurus b/system/base/1.7.5/src/thesaurus
new file mode 100644
index 0000000..5ef7251
--- /dev/null
+++ b/system/base/1.7.5/src/thesaurus
@@ -0,0 +1,332 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PACKET thesaurus handling                (* Autor: J.Liedtke      *)
+ 
+       DEFINES     THESAURUS , 
+                   := , 
+                   empty thesaurus , 
+                   insert,          (* fuegt ein Element ein *) 
+                   delete,          (* loescht ein Element falls vorhanden*) 
+                   rename,          (* aendert ein Element falls vorhanden*)
+                   CONTAINS ,       (* stellt fest, ob enthalten *)
+                   link ,           (* index in thesaurus        *) 
+                   name ,           (* name of entry             *)
+                   get ,            (* get next entry ("" is eof)*)
+                   highest entry :  (* highest valid index of thes*)
+
+
+TYPE THESAURUS = TEXT ;
+ 
+LET thesaurus size = 200 ,
+    nil = 0 ,
+    niltext = "" ,
+    max name length = 80 ,
+
+    begin entry char = ""0"" ,
+    end entry char   = ""1"" ,
+
+    nil entry        = ""0""1"" ,
+    nil name         = "" ,
+
+    quote            = """" ;
+
+TEXT VAR entry ;
+INT VAR  cache index := 0 ,
+         cache pos ;
+
+
+PROC access (THESAURUS CONST thesaurus, TEXT CONST name) :
+
+  construct entry ;
+  IF NOT cache identifies entry
+    THEN search through thesaurus list
+  FI ;
+  IF entry found
+    THEN cache index := code (list SUB (cache pos - 1))
+    ELSE cache index := 0
+  FI .
+
+construct entry :
+  entry := begin entry char ;
+  entry CAT name ;
+  decode invalid chars (entry, 2) ;
+  entry CAT end entry char .
+
+search through thesaurus list :
+  cache pos := pos (list, entry) .
+
+cache identifies entry :
+  cache pos <> 0 AND
+  pos (list, entry, cache pos, cache pos + LENGTH entry) = cache pos .
+
+entry found :  cache pos > 0 .
+
+list :  CONCR (thesaurus) .
+
+ENDPROC access ;
+
+PROC access (THESAURUS CONST thesaurus, INT CONST index) :
+
+  IF cache identifies index
+    THEN cache index := index ;
+         construct entry
+    ELSE cache pos := pos (list, code (index) + begin entry char) ;
+         IF entry found
+           THEN cache pos INCR 1 ;
+                cache index := index ;
+                construct entry
+           ELSE cache index := 0 ;
+                entry := niltext
+         FI
+  FI .
+
+construct entry :
+  entry := subtext (list, cache pos, pos (list, end entry char, cache pos)) .
+
+cache identifies index :
+  subtext (list, cache pos-1, cache pos) = code (index) + begin entry char .
+
+entry found :  cache pos > 0 .
+
+list :    CONCR (thesaurus) .
+
+ENDPROC access ;
+
+
+
+THESAURUS PROC empty thesaurus :
+
+  THESAURUS : (""1"")
+
+ENDPROC empty thesaurus ; 
+ 
+ 
+OP := (THESAURUS VAR dest, THESAURUS CONST source ) : 
+ 
+  CONCR (dest) := CONCR (source) .
+
+ENDOP := ; 
+ 
+TEXT VAR insert name ;
+
+PROC insert (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : 
+ 
+  insert name := name ;
+  decode invalid chars (insert name, 1) ;
+  IF insert name = "" OR LENGTH insert name > max name length
+    THEN index := nil ; errorstop ("Name unzulaessig")
+    ELSE insert element
+  FI .
+ 
+insert element :
+  search free entry ;
+  IF   entry found 
+    THEN insert into directory 
+    ELSE add entry to directory if possible
+  FI .
+
+search free entry :
+  access (thesaurus, nil name) .
+
+insert into directory :
+  change (list, cache pos + 1, cache pos, insert name) ;
+  index := cache index .
+
+add entry to directory if possible :
+  INT CONST next free index := code (list SUB LENGTH list) ;
+  IF next free index <= thesaurus size
+    THEN add entry to directory
+    ELSE directory overflow
+  FI .
+
+add entry to directory :
+  list CAT begin entry char ;
+  cache pos := LENGTH list ;
+  cache index := next free index ;
+  list CAT insert name ;
+  list CAT end entry char + code (next free index + 1) ;
+  index := cache index .
+
+directory overflow :
+  index := nil .
+
+entry found :   cache index > 0 .
+
+list :          CONCR (thesaurus) .
+
+ENDPROC insert ; 
+ 
+PROC decode invalid chars (TEXT VAR name, INT CONST start pos) :
+
+  INT VAR invalid char pos := pos (name, ""0"", ""31"", start pos) ;
+  WHILE invalid char pos > 0 REP
+    change (name, invalid char pos, invalid char pos, decoded char) ;
+    invalid char pos := pos (name, ""0"", ""31"", invalid char pos)
+  PER .
+
+decoded char :  quote + text(code(name SUB invalid char pos)) + quote.
+
+ENDPROC decode invalid chars ;
+
+PROC insert (THESAURUS VAR thesaurus, TEXT CONST name) :
+
+  INT VAR index ;
+  insert (thesaurus, name, index) ;
+  IF index = nil AND NOT is error
+    THEN errorstop ("THESAURUS-Ueberlauf")
+  FI .
+
+ENDPROC insert ;
+
+PROC delete (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index) : 
+ 
+  access (thesaurus, name) ;
+  index := cache index ;
+  delete (thesaurus, index) .
+
+ENDPROC delete ;
+
+PROC delete (THESAURUS VAR thesaurus, INT CONST index) :
+
+  access (thesaurus, index) ;
+  IF entry found
+    THEN delete entry
+  FI .
+
+delete entry :
+  IF is last entry of thesaurus
+    THEN cut off as much as possible
+    ELSE set to nil entry
+  FI .
+
+set to nil entry :
+  change (list, cache pos, cache pos + LENGTH entry - 1, nil entry) . 
+
+cut off as much as possible :
+  WHILE predecessor is also nil entry REP
+    set cache to this entry
+  PER ;
+  list := subtext (list, 1, cache pos - 1) ;
+  erase cache .
+
+predecessor is also nil entry :
+  subtext (list, cache pos - 3, cache pos - 2) = nil entry .
+
+set cache to this entry :
+  cache pos DECR 3 .
+
+erase cache :
+  cache pos := 0 ;
+  cache index := 0 .
+
+is last entry of thesaurus :
+  pos (list, end entry char, cache pos) = LENGTH list - 1 .
+
+list :     CONCR (thesaurus) .
+
+entry found :   cache index > nil .
+
+ENDPROC delete ;
+
+ 
+BOOL OP CONTAINS (THESAURUS CONST thesaurus, TEXT CONST name ) : 
+ 
+  IF   name = niltext OR LENGTH name > max name length
+    THEN FALSE
+    ELSE access (thesaurus, name) ; entry found
+  FI . 
+ 
+entry found :   cache index > nil . 
+ 
+ENDOP CONTAINS ; 
+ 
+PROC rename (THESAURUS VAR thesaurus, TEXT CONST old, new) :
+ 
+  rename (thesaurus, link (thesaurus, old), new)
+
+ENDPROC rename ;
+
+PROC rename (THESAURUS VAR thesaurus, INT CONST index, TEXT CONST new) :
+
+  insert name := new ;
+  decode invalid chars (insert name, 1) ;
+  IF insert name = "" OR LENGTH insert name > max name length 
+    THEN errorstop ("Name unzulaessig")
+    ELSE change to new name
+  FI .
+ 
+change to new name :
+  access (thesaurus, index) ;
+  IF cache index <> 0 AND entry <> ""
+    THEN change (list, cache pos + 1, cache pos + LENGTH entry - 2, insert name)
+  FI .
+
+list :    CONCR (thesaurus) .
+
+ENDPROC rename ;
+ 
+INT PROC link (THESAURUS CONST thesaurus, TEXT CONST name) : 
+ 
+  access (thesaurus, name) ;
+  cache index .
+
+ENDPROC link ; 
+ 
+TEXT PROC name (THESAURUS CONST thesaurus, INT CONST index) : 
+ 
+  access (thesaurus, index) ;
+  subtext (entry, 2, LENGTH entry - 1) .
+
+ENDPROC name ;
+
+PROC get (THESAURUS CONST thesaurus, TEXT VAR name, INT VAR index) :
+
+  identify index ;
+  REP
+    to next entry
+  UNTIL end of list COR valid entry found PER .
+
+identify index :
+  IF index = 0
+    THEN cache index := 0 ;
+         cache pos   := 1
+    ELSE access (thesaurus, index)
+  FI .
+
+to next entry :
+  cache pos := pos (list, begin entry char, cache pos + 1) ;
+  IF cache pos > 0
+    THEN get entry
+    ELSE get nil entry
+  FI .
+
+get entry :
+  cache index INCR 1 ;
+  index := cache index ;
+  name := subtext (list, cache pos + 1, end entry pos - 1) .
+
+get nil entry :
+  cache index := 0 ;
+  cache pos := 0 ;
+  index := 0 ;
+  name := "" .
+
+end entry pos :     pos (list, end entry char, cache pos) .
+
+end of list :       index = 0 .
+
+valid entry found : name <> "" .
+
+list :              CONCR (thesaurus) .
+
+ENDPROC get ;
+
+INT PROC highest entry (THESAURUS CONST thesaurus) :              (*840813*)
+
+  code (list SUB LENGTH list) - 1 .
+
+list :   CONCR (thesaurus) .
+
+ENDPROC highest entry ;
+
+ENDPACKET thesaurus handling ;
+
diff --git a/system/base/unknown/src/SPOLMAN5.ELA b/system/base/unknown/src/SPOLMAN5.ELA
new file mode 100644
index 0000000..99d4ec2
--- /dev/null
+++ b/system/base/unknown/src/SPOLMAN5.ELA
@@ -0,0 +1,1003 @@
+PACKET queue handler DEFINES enter into que,

+                             exists in que,

+                             all in que,

+                             erase from que, 

+                             erase last top of que,

+                             get top of que, 

+                             restore ,

+                             list que, 

+                             info, killer,first, 

+                             que status, 

+                             que empty,

+                             set entry types,

+                             change entry types,

+                             initialize que:

+ 

+ 

+LET que size    = 100, 

+ 

+    empty       =   0, 

+    used        =   1,

+    blocked     =   2, 

+    nil         =   0,

+    user  error =  99,

+    unused char =   ""0"", 

+    used char   =   ""1"", 

+    blocked char=   ""2"", 

+    ENTRY       = STRUCT(TEXT title, TASK origin, TEXT origin name, 

+                         DATASPACE space, INT storage,    acc code ) ; 

+ 

+ROW que size ENTRY VAR que ; 

+ 

+TEXT VAR status list; 

+BOOL VAR n ok := FALSE; 

+INT  VAR top of que,

+         first que entry, 

+         last que entry,

+         index ;

+ 

+.entry: que[index]. ;

+ 

+PROC initialize que : 

+  FOR index FROM 1 UPTO que size REP 

+    forget( entry.space ); 

+    entry.acc code := empty

+  END REP ; 

+  first que entry := nil;

+  last que entry  := nil; 

+  top of que      := nil;

+  index           := nil; 

+  status list     := que size * unused char; 

+END PROC initialize que ; 

+ 

+initialize que ; 

+

+(****************** Interne Queue-Zugriffsoperationen **********************)

+ 

+INT PROC next (INT CONST pre) : 

+  pre MOD que size + 1 

+END PROC next ; 

+ 

+PROC block (INT CONST entry number) : 

+  que [entry number].acc code := blocked; 

+  replace (status list,entry number,blocked char); 

+ENDPROC block; 

+ 

+PROC unblock (INT CONST entry number) : 

+  que [entry number].acc code := used; 

+  replace (status list,entry number,used char); 

+ENDPROC unblock; 

+ 

+PROC to next que entry: 

+  REP 

+    IF index = last que entry OR index = nil

+      THEN index := nil ; LEAVE to next que entry 

+    FI ;

+    index := next(index)

+  UNTIL entry.acc code <> empty PER 

+END PROC to next que entry ; 

+ 

+PROC to first que entry : 

+  index := first que entry 

+END PROC to first que entry ; 

+ 

+PROC search que entry (TEXT CONST title, TASK CONST origin) : 

+ 

+  check if index identifies entry ;

+  IF last que entry = nil 

+    THEN index := nil 

+    ELSE index := last que entry ; 

+         REPEAT 

+           IF is wanted entry 

+             THEN LEAVE search que entry 

+           FI ; 

+           IF index = first que entry 

+             THEN index := nil 

+             ELSE index DECR 1 ; 

+                  IF index = 0 

+                    THEN index := que size 

+                  FI 

+           FI 

+         UNTIL index = nil PER 

+  FI. 

+ 

+is wanted entry: 

+ 

+  entry.acc code <> empty CAND 

+  entry.title    =  title CAND 

+ (entry.origin   =  origin OR 

+  origin = niltask ).

+ 

+check if index identifies entry: 

+ 

+  IF index <> nil CAND is wanted entry 

+    THEN LEAVE search que entry 

+  FI 

+ 

+END PROC search que entry ; 

+ 

+PROC exec erase :

+ 

+    forget (entry.space) ; entry.acc code := empty ; 

+    replace (status list,index,unused char); 

+    try to cut off queue ends. 

+ 

+try to cut off queue ends: 

+ 

+  WHILE first entry is not valid REP 

+    check if que empty ; 

+    first que entry := next(first que entry) 

+  END REP ; 

+  WHILE last entry is not valid REP 

+    make index invalid if necessary ; 

+    last que entry DECR 1 ; 

+    IF last que entry = 0 

+      THEN last que entry := que size 

+    FI 

+  END REP . 

+ 

+first entry is not valid: 

+     que [first que entry].acc code = empty. 

+ 

+last entry is not valid: 

+     que [last que entry].acc code = empty. 

+ 

+check if que empty: 

+     IF first que entry = last que entry 

+       THEN first que entry := nil ;

+            last que entry  := nil ; 

+            index := nil ; 

+            LEAVE try to cut off queue ends

+     FI.

+

+make index invalid if necessary: 

+     IF index = last que entry 

+       THEN index := nil 

+     FI. 

+ 

+END PROC exec erase ;

+ 

+PROC exec first: 

+  IF next (last que entry) = first que entry 

+    THEN errorstop ("Queue ist voll - vorziehen unmoeglich") 

+  ELIF index = top of que 

+    THEN errorstop ("Auftrag wird bereits bearbeitet") 

+  ELIF entry.acc code = empty 

+    THEN errorstop ("undefinierter Queue-Eintrag. /exec first") 

+    ELSE first que entry DECR 1 ; 

+         IF first que entry = 0 

+           THEN first que entry := que size 

+         FI ; 

+         que[first que entry] := que[index] ; 

+         replace (status list,first que entry,code (entry.acc code)); 

+         exec erase 

+  FI 

+END PROC exec first ; 

+ 

+PROC erase last top of que: 

+  IF top of que <> nil 

+    THEN index := top of que; exec erase;

+         top of que := nil 

+  FI 

+END PROC erase last top of que;

+ 

+ 

+(******************  Behandlung von DATASPACE-typen  ***********************)

+ 

+LET semicolon = ";" , 

+    colon     = ":" , 

+    quote     = """"; 

+TEXT VAR entry types ::   ""   ; 

+ 

+BOOL PROC no permitted type (DATASPACE CONST ds) : 

+  TEXT CONST type nr :: semicolon + text(type(ds)) + colon; 

+  INT  CONST t pos   :: pos (entry types,type nr) ; 

+  entry types <> "" CAND t pos = 0 

+END PROC no permitted type ; 

+ 

+TEXT PROC record of que entry: 

+  IF entry.acc code = empty 

+    THEN errorstop ("undefinierter Queue-Eintrag. /record");"" 

+    ELSE TEXT VAR record :: "" ; 

+         record CAT storage in k ; 

+         record CAT type of entry ; 

+         record CAT name of entry ; 

+         record CAT origin of entry ; 

+         IF entry.acc code = blocked THEN record CAT "- blocked -" FI;

+         record

+  FI. 

+ 

+storage in k: 

+ 

+  text (entry.storage,3) + " K  ". 

+ 

+type of entry: 

+ 

+  IF entry types = "" 

+    THEN 12 * "?" 

+    ELSE TEXT CONST type nr :: semicolon + text(type(entry.space)) + colon ; 

+         INT CONST semi colon pos :: pos (entry types, type nr), 

+                   start type     :: semi colon pos + LENGTH type nr , 

+                   end type       :: pos(entrytypes,semicolon,starttype)-1; 

+         IF semi colon pos = 0 

+           THEN 12 * "?" 

+           ELSE text( subtext(entry types, starttype, endtype),12)

+         FI 

+  FI. 

+ 

+name of entry: 

+ 

+  text (quote+ entry.title +quote, 20) .

+ 

+origin of entry: 

+ 

+  IF entry.origin = niltask 

+    THEN 20 * " "

+    ELSE text (" TASK: "+entry.origin name,20) 

+  FI 

+ 

+END PROC record of que entry ;

+ 

+PROC set entry types (TEXT CONST t) : 

+  check if void ;

+  IF first char is no semicolon

+    THEN entry types := semicolon

+    ELSE entry types := "" 

+  FI;

+  entry types CAT t ; 

+  IF last char is no semicolon

+    THEN entry types CAT semicolon 

+  FI.

+

+check if void: 

+  IF t = "" 

+    THEN entry types := ""; 

+         LEAVE set entry types 

+  FI. 

+ 

+first char is no semicolon: 

+  (t SUB 1) <> semicolon. 

+ 

+last char is no semicolon: 

+  (t SUB length(t)) <> semicolon 

+ 

+END PROC set entry types ; 

+ 

+PROC change entry types: 

+  TEXT VAR t :: entry types;

+  line;putline("Entrytypes :");

+  editget(t); 

+  set entry types (t) 

+END PROC change entry types; 

+ 

+ 

+(************************ Std Zugriffe auf Queue ***************************)

+ 

+ 

+PROC erase from que (TEXT CONST title, TASK CONST origin) : 

+  search que entry (title, origin) ; 

+  IF index = nil 

+    THEN errorstop ("Auftrag existiert nicht. /erase")

+  ELIF index = top of que 

+    THEN errorstop (user error, "Dieser Auftrag wird bereits bearbeitet") 

+    ELSE exec erase 

+  FI 

+END PROC erase from que ; 

+ 

+BOOL PROC exists in que (TEXT CONST title, TASK CONST origin) : 

+  search que entry (title, origin) ; 

+  index <> nil 

+END PROC exists in que ; 

+ 

+PROC info (BOOL CONST b) : n ok := b ENDPROC info; 

+ 

+THESAURUS PROC all in que (TASK CONST origin) : 

+ 

+  THESAURUS VAR result := empty thesaurus ; 

+  to first que entry ; 

+  WHILE index <> 0 REP 

+    IF entry.origin = origin OR origin = niltask 

+      THEN insert (result, entry.title)

+    FI ; 

+    to next que entry

+  END REP ; 

+  result 

+ 

+END PROC all in que ; 

+ 

+PROC enter into que (TEXT CONST title, TASK CONST origin, 

+                     DATASPACE CONST space ):

+ 

+  IF next(last que entry) = first que entry 

+    THEN errorstop ("Queue zu voll")

+  ELIF no permitted type (space)  OR title = ""

+    THEN errorstop (user error, "Auftrag wird nicht angenommen")

+    ELSE last que entry := next(last que entry); 

+         index := last que entry;

+         entry := ENTRY: 

+            ( title, origin,task name, space, storage(space), used ) ; 

+         IF first que entry = nil 

+           THEN first que entry := 1 

+         FI ; 

+         replace (status list,last que entry,used char); 

+  FI. 

+ 

+task name : 

+  TEXT VAR name of task :: name (origin); 

+  IF name of task = "stemmer" AND n ok THEN "stemmi" ELSE name of task FI. 

+ 

+END PROC enter into que ; 

+ 

+PROC get top of que (DATASPACE VAR top space) : 

+  forget (top space) ;

+  IF que empty 

+    THEN errorstop ("kein Auftrag vorhanden. /get") 

+    ELSE erase last top of que; 

+         top of que := first que entry; 

+         IF que [top of que].acc code = blocked THEN 

+            wrap around if necessary

+         ELSE top space := que [first que entry].space ; FI; 

+  FI . 

+ 

+wrap around if necessary : 

+ 

+  IF entry is allowed to be printed THEN 

+     give it to spool manager 

+  ELSE enter into end of queue FI. 

+ 

+entry is allowed to be printed : 

+  pos (status list,used char) = nil. 

+ 

+give it to spool manager : 

+  top space := que [first que entry].space; 

+  que [first que entry].acc code := used. 

+ 

+enter into end of queue : 

+  top space := que [first que entry].space; 

+  enter into que (que [first que entry].title,que [first que entry].origin 

+                  ,top space); 

+  index := first que entry; 

+  IF entry.acc code = blocked THEN block (index) FI; 

+  get top of que (top space). 

+ 

+END PROC get top of que ; 

+ 

+PROC restore:

+  top of que := nil 

+END PROC restore ; 

+ 

+BOOL PROC que empty:                         (* 'top of que' gilt nicht *)

+  first que entry = last que entry AND 

+  top of que      = last que entry. 

+END PROC que empty ; 

+ 

+PROC que status (INT VAR size, TEXT VAR top title, 

+                 TASK VAR top origin, TEXT VAR top origin name ): 

+ 

+  size := last que entry - first que entry ;  (* geloeschte Eintraege *)

+  IF size < 0                                 (* zaehlen mit !!       *)

+    THEN size INCR que size                   (* (aber nicht 'top' )  *)

+  FI ; 

+  IF top of que <> nil 

+    THEN top title       := que [top of que].title ; 

+         top origin      := que [top of que].origin ; 

+         top origin name := que [top of que].origin name

+    ELSE size INCR 1 ; 

+         top title       := "" ; 

+         top origin      := niltask ;

+         top origin name := "" 

+  FI 

+END PROC que status ;

+

+TEXT VAR sep :: 79 * "_", record :: "", 

+         ask :: "editieren (e),kopieren (k),loeschen (l)," + 

+                "vorziehen (v),duplizieren (d),"13""10"" + 

+                "print --> quickprint (q),blockieren (b),freigeben (f)," + 

+                "weiter (w) ? "; 

+ 

+PROC info : 

+ 

+     to first que entry; 

+     WHILE index <> nil REP 

+       record := record of que entry; 

+       WHILE index <> top of que REPEAT 

+         ask user what to do; 

+         out (input char); 

+         exec command

+       UNTIL command index = 1 PER; 

+       to next que entry; 

+     PER. 

+ 

+ask user what to do : 

+ 

+     out (""13""10"");out (sep);out (""13""10""13""10""); 

+     out (record); 

+     out (""13""10""10"");out (ask); 

+     INT VAR command index; TEXT VAR input char; 

+     REPEAT 

+       inchar (input char); 

+       command index := pos ("w eklvdqbf",input char); 

+     UNTIL command index > 0 PER. 

+ 

+exec command : 

+ 

+     SELECT command index OF 

+      CASE 3 : INT VAR old dataspace type := type (entry.space); 

+               type (entry.space,1003); 

+               FILE VAR f :: sequentialfile (modify,entry.space); 

+               edit (f); line (2); 

+               type (entry.space,old dataspace type) 

+      CASE 4 : forget (entry.title,quiet); 

+               copy (entry.space,entry.title); 

+               type (old (entry.title),1003) 

+      CASE 5 : exec erase ;command index := 1 

+      CASE 6 : exec first ;command index := 1

+      CASE 7 : INT VAR dummy no := index; 

+               enter into que (que [dummy no].title,que [dummy no].origin, 

+                               que [dummy no].space) 

+      CASE 8 : type (entry.space,1103) ;record := record of que entry; 

+      CASE 9 : block (index) ;record := record of que entry;

+      CASE 10: unblock (index); record := record of que entry; 

+     ENDSELECT. 

+ 

+ENDPROC info; 

+ 

+PROC list que (FILE VAR f, DATASPACE VAR ds) : 

+  open listfile ;

+  to first que entry ; 

+  WHILE index <> nil REP 

+    TEXT VAR record :: record of que entry ; 

+    IF index = top of que 

+      THEN record := text(record,60) ; 

+           record CAT ""15"wird bearbeitet"14""

+    FI ;

+    putline (f,record) ;

+    to next que entry

+  END REP.

+ 

+open listfile:

+ 

+  forget (ds) ; 

+  ds := nilspace ; 

+  f := sequentialfile (output,ds) ; 

+  headline (f, name(myself) + " - Queue") ; 

+  line (f)

+

+END PROC list que ; 

+ 

+PROC killer : info ENDPROC killer; 

+PROC first  : info ENDPROC first; 

+ 

+END PACKET queue handler ; 

+ 

+(***************************************************************************)

+(*   Programm zur Verwaltung einer Servertask                              *)

+(*        (benutzt 'queue handler')                                        *)

+(*        Autor: A.Vox                                                     *)

+(*        Stand: 3.6.85                                                    *)

+(*                                                                         *)

+(***************************************************************************)

+PACKET spool manager DEFINES server status, 

+                             server modus, 

+                             server task, 

+                             server channel, 

+                             server routine, 

+                             server fail msg, 

+ 

+                             log edit, 

+                             logline, 

+                             logfilename,

+                             check, 

+                             feed server if hungry, 

+                             check if server vanished, 

+ 

+                             spool manager, 

+                             get title and origin, 

+

+                             start, 

+                             stop, 

+                             pause, 

+                             spool info, 

+                             list, 

+                             spool maintenance: 

+ 

+ 

+     LET user error = 99;

+ 

+     LET { Status: }       { Modus: }

+         init = 0,         active  = 0,

+         work = 1,         paused  = 1, 

+         wait = 2,         stopped = 2,

+         dead = 3;

+ 

+     LET cmd form feed             = ""12""; 

+ 

+INT VAR status :: init,

+        modus  :: stopped;

+ 

+TASK VAR server  :: niltask; 

+TEXT VAR routine :: "", 

+         fail msg:: ""; 

+INT VAR channel  :: 0;

+(************ Globale Variablen fuer alle 'que status'-Aufrufe ************) 

+ 

+INT  VAR que size; 

+TEXT VAR actual title, 

+         actual origin name; 

+TASK VAR actual origin; 

+ 

+ 

+(*********** Zugriffsoperationen auf wichtige Paketvariablen **************)

+ 

+TASK PROC  servertask    : server       END PROC servertask; 

+INT  PROC  serverstatus  : status       END PROC serverstatus; 

+INT  PROC  servermodus   : modus        END PROC servermodus; 

+TEXT PROC  serverroutine : routine      END PROC serverroutine; 

+TEXT PROC  serverfailmsg : fail msg     END PROC serverfailmsg;

+INT  PROC  serverchannel : channel      END PROC serverchannel; 

+ 

+PROC serverroutine (TEXT CONST neu): 

+  routine := neu 

+END PROC serverroutine; 

+ 

+PROC serverfailmsg (TEXT CONST neu): 

+  failmsg := neu 

+END PROC serverfailmsg; 

+ 

+PROC serverchannel (INT CONST neu): 

+  channel := neu 

+END PROC serverchannel; 

+ 

+(************************* Basic Spool Routines ***************************) 

+ 

+TEXT CONST logfilename :: "Vorkommnisse"; 

+FILE VAR logfile; 

+ 

+TEXT VAR fail title  :: "" ;

+TASK VAR fail origin :: niltask ; 

+REAL VAR fail time   :: 0.0 ; 

+ 

+PROC logline (TEXT CONST mess): 

+  logfile := sequential file(output, logfilename) ; 

+  clear file if too large ; 

+  put(logfile, date);

+  put(logfile, time of day); 

+  put(logfile, " : ");

+  putline(logfile, mess) 

+END PROC logline ; 

+ 

+PROC log edit: 

+  enable stop ; 

+  IF NOT exists(logfilename) 

+    THEN errorstop ("keine Eintragungen vorhanden") 

+    ELSE logfile := sequentialfile(modify,logfilename) ; 

+         position to actual page; 

+         edit(logfile);

+         line (2); 

+         forget (logfilename); 

+  FI. 

+ 

+position to actual page: 

+ 

+  INT CONST begin of last page :: lines(logfile)-22 ; 

+  logfile := sequential file(modify,logfilename); 

+  IF begin of last page < 1 

+    THEN toline(logfile,1) 

+    ELSE toline(logfile,begin of last page) 

+  FI

+ 

+END PROC logedit; 

+ 

+PROC clear file if too large: 

+  IF lines(logfile) > 1000 

+    THEN modify (logfile) ; 

+         toline (logfile, 900) ; 

+         remove (logfile, 900) ; 

+         clear removed (logfile) ;

+         output (logfile) 

+  FI 

+END PROC clear file if too large ; 

+ 

+PROC end server (TEXT CONST mess): 

+  access catalogue; 

+  IF exists (server) CAND son(myself) = server 

+    THEN end(server) 

+  FI; 

+  failtime := clock(1); 

+  que status (que size, fail title, fail origin, actual origin name) ; 

+  logline (mess) ; 

+  IF fail title <> "" 

+    THEN logline(""""+fail title+""" von Task: "+actual origin name) 

+    ELSE logline("kein Auftrag betroffen") 

+  FI ; 

+  status := dead ; 

+  server := niltask 

+END PROC end server; 

+ 

+PROC check (TEXT CONST title, TASK CONST origin): 

+  check if server vanished ; 

+  IF less than 3 days ago AND 

+     was failure          AND 

+     title matches        AND 

+     origin matches 

+    THEN fail origin := myself ; 

+         errorstop (user error, """"+fail title+""" abgebrochen")

+  FI. 

+ 

+less than 3 days ago: 

+  clock(1) < fail time + 3.0 * day. 

+ 

+origin matches: 

+  (origin = fail origin OR origin = niltask). 

+ 

+title matches: 

+  (title  = fail title  OR title  = ""). 

+ 

+was failure: 

+  fail title <> ""

+ 

+END PROC check ; 

+ 

+PROC start server: 

+  begin (PROC server start,server) ; 

+  status := init 

+END PROC start server; 

+ 

+PROC server start: 

+  disable stop ; 

+  IF channel <> 0 

+    THEN continue (channel) ; 

+  FI ;

+  command dialogue (FALSE) ; 

+  out (cmd form feed); 

+  do (routine) ; 

+  IF is error 

+    THEN call(logline code, "Server-Fehler :",father); 

+         call(logline code, error message, father) ; 

+         call(logline code, "Zeile: " + text(errorline) +

+                            " Code: " + text(errorcode)  ,father) 

+    ELSE call(logline code, "Ende des Server-Programms erreicht",father) 

+  FI ; 

+  IF online 

+    THEN out (fail msg) 

+  FI ; 

+  call (terminate code,fail msg, father) ;

+  end (myself) 

+END PROC server start ;

+ 

+PROC check if server vanished: 

+  IF NOT (server = nil task) CAND NOT exists (server) 

+    THEN end server ("Server gestorben :") ; 

+         start server 

+  FI 

+END PROC check if server vanished; 

+ 

+ 

+(*************************** Manager Routines *****************************)

+ 

+   LET ack              = 0,

+       second phase ack = 5,

+       not existing nak = 6,

+ 

+       begin code       = 4, 

+       fetch code       = 11, 

+       save code        = 12,

+       exists code      = 13, 

+       erase code       = 14, 

+       list code        = 15, 

+       all code         = 17, 

+       clear code       = 18, 

+       release code     = 20, 

+       check code       = 22, 

+ 

+       terminate code   = 25, 

+       logline code     = 26, 

+       get title code   = 27, 

+ 

+       continue code    = 100; 

+ 

+ 

+DATASPACE VAR packet space ; 

+INT VAR reply ; 

+BOUND STRUCT(TEXT f name,a,b) VAR msg ; 

+.f name: msg.f name. ; 

+ 

+TEXT VAR save title :: "";

+FILE VAR listfile; 

+ 

+PROC get title and origin (TEXT VAR title, origin): 

+  forget (packet space) ; 

+  packet space := nilspace ; 

+  call (father, get title code, packet space, reply) ;

+  IF reply = ack 

+    THEN msg := packet space ; 

+         title := msg.f name ; 

+         origin := msg.a ; 

+         forget (packet space)

+    ELSE forget (packet space) ; 

+         errorstop ("'get title' nicht erfolgreich. Antwort="+text(reply)) 

+  FI 

+END PROC get title and origin; 

+ 

+PROC feed server if hungry:

+  check if server vanished ; 

+  IF status = wait AND NOT que empty 

+    THEN get top of que (packet space) ; 

+         send (server, ack, packet space, reply) ; 

+         forget (packet space) ;

+         IF reply = ack 

+           THEN status := work 

+           ELSE restore ; 

+                end server ("Server nimmt keinen Auftrag an") ; 

+                start server 

+         FI 

+  FI 

+ENDPROC feed server if hungry;

+ 

+PROC server request (DATASPACE VAR ds, INT CONST order, phase) : 

+ 

+  enable stop ; 

+  msg := ds ; 

+  SELECT order OF 

+    CASE terminate code: terminate 

+    CASE logline code:   logline (f name)   ;send(server, ack, ds)

+    CASE get title code: send title 

+    OTHERWISE 

+      IF order = fetch code CAND f name = "-" 

+        THEN send top of que 

+        ELSE freemanager (ds,order,phase,server) 

+      FI 

+  END SELECT ; 

+  forget(ds). 

+ 

+terminate: 

+  end server ("Server terminiert :") ; 

+  start server.

+ 

+send title: 

+  forget (ds) ; 

+  ds := nilspace ; 

+  msg := ds ; 

+  que status (que size, msg.f name, actual origin, msg.a) ; 

+  send (server, ack, ds).

+ 

+send top of que: 

+  status := wait ; 

+  erase last top of que ;

+  IF modus = active 

+    THEN feed server if hungry

+  FI 

+ 

+END PROC server request; 

+ 

+PROC spool manager(DATASPACE VAR ds, INT CONST order, phase, 

+                   TASK CONST order task) : 

+ 

+  IF ordertask < myself 

+    THEN server request (ds,order,phase) 

+  ELIF ordertask = supervisor

+    THEN system request 

+  ELSE spool command (ds,order,phase,order task) 

+  FI; 

+  check storage; 

+  error protocol. 

+ 

+check storage: 

+  INT VAR size, used; 

+  storage(size,used); 

+  IF used > size 

+    THEN logline("Speicher-Engpass :"); 

+         initialize que; 

+         logline("Queue geloescht !!"); 

+         stop 

+  FI. 

+ 

+error protocol: 

+  IF is error AND error code <> user error 

+    THEN logline ("Spool-Fehler :") ; 

+         logline (errormessage) ; 

+         logline ("   Zeile: " + text(errorline) + 

+                  "   Code: "  + text(errorcode) ) 

+  FI. 

+ 

+system request: 

+  IF order > continue code 

+    THEN call (supervisor,order,ds,reply) ; 

+         forget(ds) ; 

+         IF reply = ack 

+           THEN spool maintenance 

+         FI 

+  FI 

+ 

+END PROC spool manager; 

+ 

+PROC spool command (DATASPACE VAR ds, INT CONST order, phase, 

+                    TASK CONST order task): 

+ 

+  enable stop ; 

+  check if server vanished ;

+  msg := ds ; 

+  SELECT order OF 

+    CASE begin code : special begin 

+    CASE fetch code:  y get logfile 

+    CASE save code :  y save 

+    CASE exists code: y exists 

+    CASE erase code:  y erase 

+    CASE list code:   y list 

+    CASE all code:    y all 

+    CASE release code, 

+         clear code:  y restart 

+    CASE check code:  y check 

+    OTHERWISE errorstop (user error, "Kein Kommando fuer SPOOLER") 

+  END SELECT. 

+ 

+special begin : 

+   INT VAR dummy; 

+   call (public,begin code,ds,dummy); 

+   send (order task,ack,ds). 

+ 

+y get logfile: 

+  forget(ds) ; 

+  ds := old(logfilename) ; 

+  send (ordertask, ack, ds). 

+ 

+y erase: 

+  IF NOT exists in que (f name,ordertask) 

+    THEN manager message(""""+f name+""" steht nicht in der Queue")

+  ELIF phase = 1 

+    THEN manager question (""""+f name+""" aus der Queue loeschen") 

+    ELSE erase from que (f name,ordertask) ; 

+         send (ordertask, ack, ds) 

+  FI. 

+ 

+y save: 

+  IF phase = 1 

+    THEN save title := f name ; 

+         send (order task,second phase ack,ds); 

+    ELSE enter into que (save title, ordertask, ds) ; 

+         IF modus = active 

+           THEN feed server if hungry

+         FI ; 

+         send (order task,ack,ds); 

+  FI. 

+ 

+y list: 

+  list que (listfile,ds) ; 

+  send (ordertask, ack, ds). 

+ 

+y all: 

+  forget(ds) ; 

+  ds := nilspace ; 

+  BOUND THESAURUS VAR all names := ds ; 

+  all names := all in que (ordertask) ; 

+  send (ordertask, ack, ds). 

+ 

+y exists: 

+  IF exists in que (f name,ordertask) 

+    THEN send (ordertask, ack, ds) 

+    ELSE send (ordertask, not existing nak, ds) 

+  FI. 

+ 

+y check: 

+  check (f name,ordertask) ; 

+  questatus (que size, actual title, actual origin, actual origin name) ; 

+  IF there is a title   AND

+     is actual origin   AND 

+     is actual title 

+    THEN manager message (""""+f name+""" wird soeben bearbeitet") 

+  ELIF exists in que (f name,ordertask) 

+    THEN manager message (""""+f name+""" steht noch in der Queue") 

+    ELSE errorstop (usererror, """"+f name+""" steht nicht in der Queue") 

+  FI. 

+ 

+  there is a title:  actual title <> "" .

+  is actual origin:  ordertask = actual origin .

+  is actual title : (f name = "" OR f name = actual title) . 

+ 

+y restart: 

+  questatus (que size, actual title, actual origin, actual origin name) ;

+  IF actual origin = ordertask 

+    THEN IF phase = 1 

+           THEN manager question (""""+actual title+""" unterbrechen") 

+           ELSE end server ("unterbrochen durch Auftraggeber :") ; 

+                start server ; 

+                IF order = clear code 

+                  THEN restore 

+                  ELSE erase last top of que

+                FI ; 

+                manager message ("Auftrag unterbrochen") 

+         FI

+    ELSE errorstop (usererror, "kein eigener Auftrag") 

+  FI

+

+END PROC spool command ; 

+ 

+PROC start: 

+  IF modus = stopped 

+    THEN start server ; 

+         modus := active; 

+         message ("Server aktiviert") 

+  ELIF modus = paused 

+    THEN modus := active ; 

+         message ("'Pause'-Modus zurueckgesetzt") ; 

+         feed server if hungry

+    ELSE message ("Server bereits aktiv") 

+  FI 

+END PROC start; 

+ 

+PROC stop: 

+  IF modus <> stopped 

+    THEN end server ("Gestoppt :"); 

+         modus := stopped ;

+         status := init ; 

+         message ("Server gestoppt") 

+    ELSE message ("Server bereits gestoppt") 

+  FI 

+END PROC stop; 

+ 

+PROC pause: 

+  IF modus = active 

+    THEN modus := paused ; 

+         message ("'Pause'-Modus gesetzt")

+  ELIF modus = paused 

+    THEN message ("'Pause'-Modus bereits gesetzt")

+    ELSE errorstop ("Server ist gestoppt") 

+  FI 

+END PROC pause; 

+ 

+PROC message (TEXT CONST mess): 

+  say(""13""10"") ; 

+  say(mess) ; 

+  say(""13""10"") 

+END PROC message ; 

+ 

+PROC list: 

+  list que(listfile,packet space) ; 

+  show(listfile) 

+END PROC list; 

+ 

+PROC spool maintenance: 

+  command dialogue (TRUE);

+  IF exists(logfilename) 

+    THEN logedit 

+  FI; 

+  WHILE online REP

+    get command ("gib spool kommando :") ;

+    do command 

+  END REP ; 

+  command dialogue (FALSE) ; 

+  break ; 

+  set autonom 

+END PROC spool maintenance ;

+ 

+PROC spoolinfo: 

+  check if server vanished ;

+  que status (que size, actual title, actual origin, actual origin name) ; 

+  line(2) ; 

+  putline("Queue :") ; 

+  put("Auslastung :");put(que size); line;

+  IF actual title <> "" 

+    THEN put("Aktueller Auftrag :");putline(actual title); 

+         put("         von Task :");putline(actual origin name) 

+  FI ; 

+  line ; 

+  putline("Server :"); 

+  put("Status :"); 

+  SELECT status OF 

+    CASE init : putline("initialisiert") 

+    CASE work : putline("arbeitet") 

+    CASE wait : putline("wartet")

+    OTHERWISE   putline("gestorben")

+  END SELECT ;

+  put("Modus  :"); 

+  SELECT modus OF 

+    CASE active : putline("aktiv") 

+    CASE paused : putline("pausierend") 

+    OTHERWISE     putline("gestoppt") 

+  END SELECT ; 

+  put("Kanal  :");put(pcb(server,4));

+  line(2) 

+END PROC spool info 

+ 

+END PACKET spool manager; 

+ 

diff --git a/system/base/unknown/src/STD.ELA b/system/base/unknown/src/STD.ELA
new file mode 100644
index 0000000..047db9a
--- /dev/null
+++ b/system/base/unknown/src/STD.ELA
@@ -0,0 +1,220 @@
+PACKET command dialogue DEFINES                (* Autor: J.Liedtke *)

+                                               (* Stand:  26.04.82 *)

+       command dialogue ,

+       say ,

+       yes ,

+       no ,

+       param position ,

+       last param :

+ 

+ 

+LET up      = ""3"" ,

+    right   = ""2"" ,

+    param pre  = " (""" ,

+    param post = """)"13""10"" ;

+

+TEXT VAR std param := "" ;

+ 

+BOOL VAR dialogue flag := TRUE ;

+

+INT VAR param x := 0 ;

+ 

+ 

+BOOL PROC command dialogue :

+  dialogue flag

+ENDPROC command dialogue ;

+ 

+PROC command dialogue (BOOL CONST status) :

+  dialogue flag := status

+ENDPROC command dialogue ;

+ 

+ 

+BOOL PROC yes (TEXT CONST question) :

+ 

+  IF dialogue flag

+    THEN ask question

+    ELSE TRUE

+  FI .

+ 

+ask question :

+  put (question) ;

+  skip previous input chars ;

+  put ("(j/n) ?") ;

+  get answer ;

+  IF correct answer

+    THEN putline (answer) ;

+         positive answer

+    ELSE out (""7"") ;

+         LENGTH question + 9 TIMESOUT ""8"" ;

+         yes (question)

+  FI .

+ 

+get answer :

+  TEXT VAR answer ;

+  inchar (answer) .

+ 

+correct answer :

+  pos ("jnyJNY", answer) > 0 .

+ 

+positive answer :

+  pos ("jyJY", answer) > 0 .

+

+skip previous input chars :

+  REP UNTIL incharety = "" PER .

+ 

+ENDPROC yes ;

+ 

+BOOL PROC no (TEXT CONST question) :

+ 

+  NOT yes (question)

+ 

+ENDPROC no ;

+ 

+PROC say (TEXT CONST message) :

+ 

+  IF dialogue flag

+    THEN out (message)

+  FI

+ 

+ENDPROC say ;

+ 

+PROC param position (INT CONST x) :

+ 

+  param x := x

+

+ENDPROC param position ;

+

+TEXT PROC last param :

+ 

+  IF param x > 0

+    THEN out (up) ;

+         param x TIMESOUT right ;

+         out (param pre) ;

+         out (std param) ;

+         out (param post)

+  FI ;

+  std param

+ 

+ENDPROC last param ;

+ 

+PROC last param (TEXT CONST new) :

+  std param := new

+ENDPROC last param ;

+

+ENDPACKET command dialogue ;

+

+

+PACKET input DEFINES                         (* Stand: 01.05.81 *)

+ 

+    get ,

+    getline , 

+    get secret line :

+ 

+ 

+LET cr              = ""13"" ,

+    esc             = ""27"" ,

+    rubout          = ""12"" ,

+    bell            = ""7"" ,

+    back blank back = ""8" "8"" ,

+    del line cr lf  = ""5""13""10"" ;

+

+PROC get (TEXT VAR word) : 

+ 

+  REP

+    get (word, " ")

+  UNTIL word <> "" AND word <> " " PER ;

+  delete leading blanks .

+ 

+delete leading blanks :

+  WHILE (word SUB 1) = " " REP

+    word := subtext (word,2)

+  PER .

+ 

+ENDPROC get ;

+ 

+PROC get (TEXT VAR word, TEXT CONST separator) : 

+ 

+  word := "" ;

+  feldseparator (separator) ;

+  editget (word) ;

+  feldseparator ("") ;

+  echoe last char

+ 

+ENDPROC get ;

+ 

+PROC echoe last char :

+ 

+  TEXT CONST last char := feldzeichen ;

+  IF last char = ""13""

+    THEN out (""13""10"")

+    ELSE out (last char)

+  FI

+ 

+ENDPROC echoe last char ;

+ 

+PROC get (TEXT VAR word, INT CONST length) :

+ 

+  word := "" ;

+  feldseparator ("") ;

+  editget (word, length, length) ;

+  echoe last char 

+ 

+ENDPROC get ;

+ 

+PROC getline (TEXT VAR line ) : 

+ 

+  line := "" ;

+  feldseparator ("") ;

+  editget (line) ;

+  echoe last char

+ 

+ENDPROC getline ;

+ 

+PROC get secret line (TEXT VAR line) :

+

+  TEXT VAR char ;

+  line := "" ;

+  get start cursor position ;

+  get line very secret ;

+  IF char = esc

+    THEN get line little secret

+  FI ;

+  cursor to start position ;

+  out (del line cr lf) .

+

+get line very secret :

+  REP

+    inchar (char) ;

+    IF char = esc OR char = cr

+      THEN LEAVE get line very secret

+    ELIF char = rubout

+      THEN delete last char

+    ELIF char >= " "

+      THEN line CAT char ;

+           out (".")

+    ELSE   out (bell)

+    FI

+  PER .

+

+delete last char :

+  IF LENGTH line = 0

+    THEN out (bell)

+    ELSE out (back blank back) ;

+         delete char (line, LENGTH line)

+  FI .

+

+get line little secret :

+  feldseparator ("") ;

+  cursor to start position ;

+  editget (line) .

+

+get start cursor position :

+  INT VAR x, y; 

+  get cursor (x, y) .

+

+cursor to start position :

+  cursor (x, y) .

+

+ENDPROC get secret line ;

+

+ENDPACKET input ;

diff --git a/system/base/unknown/src/STDPLOT.ELA b/system/base/unknown/src/STDPLOT.ELA
new file mode 100644
index 0000000..be55e33
--- /dev/null
+++ b/system/base/unknown/src/STDPLOT.ELA
@@ -0,0 +1,365 @@
+PACKET std plot DEFINES                         (* J. Liedtke 06.02.81 *)

+                                                (* H.Indenbirken, 19.08.82 *)

+  transform,

+  set values,

+

+  clear ,

+  begin plot ,

+  end plot ,

+  dir move,

+  dir draw ,

+  pen,

+  pen info :

+ 

+LET pen down    = "*"8"" ,

+    y raster = 43,

+    display hor  = 78.0,

+    display vert = 43.0;

+ 

+INT CONST up         :=  1 ,

+          right      :=  1 ,

+          down       := -1 ,

+          left       := -1 ;

+ 

+REAL VAR h min limit :: 0.0, h max limit :: display hor,

+         v min limit :: 0.0, v max limit :: display vert,

+         h :: display hor/2.0, v :: display vert/2.0,

+         size hor :: 23.5, size vert :: 15.5;

+

+ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL :

+                          (ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),

+                           ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));

+ROW 5 ROW 5 REAL VAR result;

+INT VAR i, j;

+

+ROW 5 ROW 5 REAL OP * (ROW 5 ROW 5 REAL CONST l, r) :

+  ROW 5 ROW 5 REAL VAR erg;

+  FOR i FROM 1 UPTO 5

+  REP FOR j FROM 1 UPTO 5

+      REP erg [i] [j] := zeile i mal spalte j

+      PER

+  PER;

+  erg  .

+

+zeile i mal spalte j :

+  INT VAR k;

+  REAL VAR summe :: 0.0;

+  FOR k FROM 1 UPTO 5

+  REP summe INCR zeile i * spalte j PER;

+  summe  .

+

+zeile i :  l [i] [k]  .

+

+spalte j : r [k] [j]  .

+

+END OP *;

+ 

+PROC set values (ROW 3 ROW 2 REAL CONST size, 

+                 ROW 2 ROW 2 REAL CONST limits,

+                 ROW 3 REAL CONST angles,

+                 ROW 2 REAL CONST oblique,

+                 ROW 3 REAL CONST perspective) :

+  norm p;

+  set views;

+  calc two dim extrema;

+  calc limits;

+  calc result values  .

+

+norm p :

+  p := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (1.0/dx,    0.0,    0.0, 0.0, 0.0),

+  ROW 5 REAL : (   0.0, 1.0/dy,    0.0, 0.0, 0.0),

+  ROW 5 REAL : (   0.0,    0.0, 1.0/dz, 0.0, 0.0),

+  ROW 5 REAL : (   0.0,    0.0,    0.0, 1.0, 0.0),

+  ROW 5 REAL : (size [1][1]/dx,  size [2][1]/dy,

+                size [3][1]/dz, 0.0, 1.0))  .

+

+dx : size [1][2] - size [1][1]  .

+dy : size [2][2] - size [2][1]  .

+dz : size [3][2] - size [3][1]  .

+

+set views :

+  REAL VAR sin a := sind (angles [1]),  cos a := cosd (angles [1]),

+           sin p := sind (angles [2]),  cos p := cosd (angles [2]),

+           sin t := sind (angles [3]),  cos t := cosd (angles [3]),

+           norm a :: oblique [1] * p [1][1],

+           norm b :: oblique [2] * p [2][2],

+           norm cx :: perspective [1] * p [1][1],

+           norm cy :: perspective [2] * p [2][2],

+           norm cz :: perspective [3] * p [3][3];

+

+  result := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (cos p*cos t, -sin p, cos p*sin t, 0.0, 0.0),

+  ROW 5 REAL : (sin p*cos t,  cos p, sin p*sin t, 0.0, 0.0),

+  ROW 5 REAL : (     -sin t,    0.0,       cos t, 0.0, 0.0),

+  ROW 5 REAL : (        0.0,    0.0,         0.0, 1.0, 0.0),

+  ROW 5 REAL : (        0.0,    0.0,         0.0, 0.0, 1.0));

+  p := p*result;

+

+ 

+  result := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (     1.0,      0.0, 0.0,     0.0, 0.0),

+  ROW 5 REAL : (     0.0,      1.0, 0.0,     0.0, 0.0),

+  ROW 5 REAL : (  norm a,   norm b, 0.0, norm cz, 0.0),

+  ROW 5 REAL : (-norm cx, -norm cy, 0.0,     1.0, 0.0),

+  ROW 5 REAL : (     0.0,      0.0, 0.0,     0.0, 1.0));

+  p := p * result;

+

+  result := ROW 5 ROW 5 REAL :

+ (ROW 5 REAL : (cos a,-sin a, 0.0, 0.0, 0.0),

+  ROW 5 REAL : (sin a, cos a, 0.0, 0.0, 0.0), 

+  ROW 5 REAL : (  0.0,   0.0, 1.0, 0.0, 0.0),

+  ROW 5 REAL : (  0.0,   0.0, 0.0, 1.0, 0.0),

+  ROW 5 REAL : (  0.0,   0.0, 0.0, 0.0, 1.0));

+  p := p * result  .

+

+calc two dim extrema :

+  REAL VAR max x :: - max real, min x :: max real,

+           max y :: - max real, min y :: max real, x, y;

+

+  transform (size [1][1], size [2][1], size [3][1], x, y);

+  extrema;

+  transform (size [1][2], size [2][1], size [3][1], x, y);

+  extrema;

+  transform (size [1][2], size [2][2], size [3][1], x, y);

+  extrema;

+  transform (size [1][1], size [2][2], size [3][1], x, y);

+  extrema;

+  transform (size [1][1], size [2][1], size [3][2], x, y);

+  extrema;

+  transform (size [1][2], size [2][1], size [3][2], x, y);

+  extrema;

+  transform (size [1][2], size [2][2], size [3][2], x, y);

+  extrema;

+  transform (size [1][1], size [2][2], size [3][2], x, y);

+  extrema  .

+

+extrema :

+  min x := min (min x, x);

+  max x := max (max x, x);

+ 

+  min y := min (min y, y);

+  max y := max (max y, y) .

+ 

+calc limits :

+  IF all limits smaller than 2

+  THEN prozente

+  ELSE zentimeter FI  .

+

+all limits smaller than 2 :

+  limits [1][2] < 2.0 AND limits [2][2] < 2.0  .

+

+prozente :

+  h min limit := limits [1][1] * display hor * (size vert/size hor);

+  h max limit := limits [1][2] * display hor * (size vert/size hor);

+ 

+  v min limit := limits [2][1] * display vert;

+  v max limit := limits [2][2] * display vert  .

+ 

+zentimeter : 

+  h min limit := display hor * (limits [1][1]/size hor);

+  h max limit := display hor * (limits [1][2]/size hor);

+ 

+  v min limit := display vert * (limits [2][1]/size vert);

+  v max limit := display vert * (limits [2][2]/size vert)  .

+

+calc result values :

+  REAL VAR sh := (h max limit - h min limit) / (max x - min x),

+           sv := (v max limit - v min limit) / (max y - min y),

+           dh := h min limit - min x*sh,

+           dv := v min limit - min y*sv;

+

+  result := ROW 5 ROW 5 REAL :

+           (ROW 5 REAL : ( sh, 0.0, 0.0, 0.0, 0.0),

+            ROW 5 REAL : (0.0,  sv, 0.0, 0.0, 0.0),

+            ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),

+            ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),

+            ROW 5 REAL : ( dh,  dv, 0.0, 0.0, 1.0));

+  p := p * result  .

+ 

+END PROC set values;

+ 

+PROC transform (REAL CONST x, y, z, REAL VAR h, v) :

+  REAL CONST w :: 1.0/(x*p [1][4] + y*p [2][4] + z*p [3][4] + p [4][4]);

+

+  h := (x*p [1][1]+y*p [2][1]+z*p [3][1]+p [4][1])*w + p [5][1];

+  v := (x*p [1][2]+y*p [2][2]+z*p [3][2]+p [4][2])*w + p [5][2];

+END PROC transform;

+

+(**************************  Eigentliches plot *************************)

+INT VAR x pos := 0 ,

+        y pos := 0 ,

+        new x pos ,

+        new y pos ;

+ 

+ROW 24 TEXT VAR display;

+clear ;

+ 

+PROC clear :

+

+  INT VAR i;

+  display (1) := 79 * " " ;

+  FOR i FROM 2 UPTO 24

+  REP display [i] := display [1]

+  PER;

+  out (""6""2""0""4"")

+ 

+END PROC clear ;

+ 

+PROC begin plot :

+

+  cursor (x pos + 1,  24 - (y pos) DIV 2 )

+ 

+ENDPROC begin plot ;

+ 

+PROC end plot :

+ 

+ENDPROC end plot ;

+ 

+PROC dir move (REAL CONST x, y, z) :

+  transform (x, y, z, h, v);

+  move (round (h), round (v))

+

+END PROC dir move;

+

+PROC move (INT CONST x val, y val) :

+ 

+  x pos := x val;

+  y pos := y val

+

+ENDPROC move ;

+ 

+PROC dir draw (REAL CONST x, y, z) :

+  transform (x, y, z, h, v);

+  draw (round (h), round (v))

+

+END PROC dir draw;

+

+PROC draw (INT CONST x val, y val) :

+

+  new x pos := x val;

+  new y pos := y val;

+

+  plot vector (new x pos - x pos, new y pos - y pos) ;

+ 

+END PROC draw ;

+ 

+PROC dir draw (TEXT CONST text, REAL CONST angle, height) :

+  out (""6"");

+  out (code (23 - (y pos DIV 2)));

+  out (code (x pos));

+

+  out (text)

+ 

+END PROC dir draw;

+ 

+INT VAR act no :: 1, act thickness :: 1, act line type :: 1;

+

+PROC pen (INT CONST no, thickness, line type) :

+  act no := no;

+  act thickness := thickness;

+  act line type := line type

+ 

+ENDPROC pen ;

+

+PROC pen info (INT VAR no, thickness, line type) :

+  no := act no;

+  thickness := act thickness;

+  line type := act line type

+

+END PROC pen info;

+ 

+PROC plot vector (INT CONST dx , dy) :

+ 

+  IF dx >= 0

+    THEN IF   dy >  dx THEN vector (y pos, x pos, dy, dx, up, right)

+         ELIF dy >   0 THEN vector (x pos, y pos, dx, dy, right, up)

+ 

+         ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down)

+         ELSE               vector (y pos, x pos, -dy, dx, down, right)

+         FI

+    ELSE IF   dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left)

+         ELIF dy >   0 THEN vector (x pos, y pos, -dx, dy, left, up)

+ 

+         ELIF dy >  dx THEN vector (x pos, y pos, -dx, -dy, left, down)

+         ELSE               vector (y pos, x pos, -dy, -dx, down, left)

+         FI

+  FI .

+ 

+ENDPROC plot vector ;

+ 

+PROC vector (INT VAR x pos, y pos; INT CONST dx, dy, right, up) :

+

+  prepare first step ;

+  INT VAR i ;

+  FOR i FROM 1 UPTO dx REP

+    do one step

+  PER .

+ 

+prepare first step :

+  point;

+  INT VAR old error := 0 ,

+          up right error := dy - dx ,

+          right error    := dy .

+ 

+do one step :

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

+  abs (old error + right error) < abs (old error + up right error) .

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  point ;

+  old error INCR right error .

+ 

+ENDPROC vector ;

+ 

+ 

+PROC point :

+  INT CONST line :: y pos DIV 2;

+  BOOL CONST above :: (y pos MOD 2) = 1;

+  TEXT CONST point :: display [line+1] SUB (x pos+1),

+             new point :: calculated point;

+ 

+  replace (display [line+1], x pos+1, new point);

+  out (""6"") ;

+  out (code (23-line)) ;

+  out (code (x pos)) ;

+  out (new point) .

+ 

+calculated point :

+  IF above

+  THEN IF point = "," OR point = "|"

+       THEN "|"

+       ELSE "'" FI

+  ELSE IF point = "'" OR point = "|"

+       THEN "|"

+       ELSE "," FI

+  FI

+ 

+END PROC point;

+ 

+REAL CONST real max int := real (max int);

+INT PROC round (REAL CONST x) :

+  IF x > real max int

+  THEN max int

+  ELIF x < 0.0

+  THEN 0

+  ELSE int (x + 0.5) FI

+

+END PROC round;

+

+ENDPACKET std plot ;

diff --git a/system/base/unknown/src/bildeditor b/system/base/unknown/src/bildeditor
new file mode 100644
index 0000000..c84a300
--- /dev/null
+++ b/system/base/unknown/src/bildeditor
@@ -0,0 +1,722 @@
+ 

+PACKET  b i l d e d i t o r  DEFINES              (* Autor: P.Heyderhoff   *)

+        (*****************)                       (* Stand: 06.02.82       *)

+                                                  (* Vers.: 1.6.0          *)

+        bildeditor,                               (* test des bildeditors, *)

+        schreiberlaubnis,

+        zeile unveraendert,

+        feldanfangsmarke,

+        bildmarksatz,

+        bildeinfuegen,

+        bildneu,

+        bildzeile,

+        bildmarke,

+        bildstelle,

+        bildlaenge,

+        bildmaxlaenge,

+        bildsatz,

+        bildrand :

+ 

+ 

+LET anker = 2, freianker = 1, satzmax = 4075,

+    DATEI = ROW satzmax STRUCT (INT nachfolger, vorgaenger, index,

+                                fortsetzung, TEXT inhalt);

+ 

+INT VAR stelle   :: anker, marke  :: 0, satz   :: 1, zeile :: 1,

+        zeilen :: 0, maxlaenge :: 23, laenge :: maxlaenge, rand :: 0,

+        marksatz :: 0, alte feldstelle :: 1, alte feldmarke :: 0;

+ 

+TEXT VAR kommando :: "", teil :: "", zeichen :: "";

+ 

+BOOL VAR neu :: TRUE, zeileneu :: TRUE, ueberschriftneu :: FALSE,

+         einfuegen :: FALSE, schreiben erlaubt :: TRUE; 

+ 

+LET hop mark rubout up down cr          = ""1""16""12""3""10""13"",

+    hop cr mark down up right rubin     = ""1""13""16""10""3""2""11"",

+    hop rubin rubout down up cr tab esc = ""1""11""12""10""3""13""9""27"",

+    blank = " ", hop = ""1"", clear eop = ""4"", clear eol = ""5"",

+    left = ""8"", right = ""2"", up = ""3"", down = ""10"", bell = ""7"",

+    tab = ""9"", cr = ""13"", escape = ""27"", begin mark = ""15"",

+    end mark = ""14"", hoechstes steuerzeichen = ""31"", escape q = ""27"q",

+    rubin = ""11"", mark = ""16"", down clear eol = ""10""5"";

+ 

+(******************  z u g r i f f s p r o z e d u r e n  ******************)

+ 

+BOOL PROC schreiberlaubnis :

+  schreiben erlaubt

+END PROC schreiberlaubnis;

+ 

+PROC schreiberlaubnis (BOOL CONST b) :

+  schreiben erlaubt := b

+END PROC schreiberlaubnis;

+ 

+BOOL PROC bildneu :

+  neu

+END PROC bildneu;

+ 

+PROC bildneu (BOOL CONST b) :

+  neu := b

+END PROC bildneu;

+ 

+PROC bildeinfuegen (BOOL CONST b):

+  einfuegen := b

+END PROC bildeinfuegen;

+ 

+INT PROC bildmarke :

+  marke

+END PROC bildmarke;

+ 

+PROC bildmarke (INT CONST i) :

+  marke := i

+END PROC bildmarke;

+ 

+INT PROC feldanfangsmarke :

+  alte feldmarke

+END PROC feldanfangsmarke;

+ 

+PROC feldanfangsmarke (INT CONST i) :

+  alte feldmarke := i

+END PROC feldanfangsmarke;

+ 

+INT PROC bildstelle :

+  stelle

+END PROC bildstelle;

+ 

+PROC bildstelle (INT CONST i) :

+  stelle := i

+END PROC bildstelle;

+ 

+INT PROC bildmarksatz :

+  marksatz

+END PROC bildmarksatz;

+ 

+PROC bildmarksatz (INT CONST i) :

+  marksatz := i

+END PROC bildmarksatz;

+ 

+INT PROC bildsatz :

+  satz

+END PROC bildsatz;

+ 

+PROC bildsatz (INT CONST i) :

+  satz := i

+END PROC bildsatz;

+ 

+INT PROC bildzeile :

+  zeile

+END PROC bildzeile;

+ 

+PROC bildzeile (INT CONST i) :

+  zeile := min (i, laenge)

+END PROC bildzeile;

+ 

+INT PROC bildlaenge :

+  laenge

+END PROC bildlaenge;

+ 

+PROC bildlaenge (INT CONST i) :

+  laenge := i

+END PROC bildlaenge;

+ 

+PROC bildmaxlaenge (INT CONST i) : 

+  maxlaenge := i 

+END PROC bildmaxlaenge; 

+ 

+INT PROC bildrand :

+  rand

+END PROC bildrand;

+ 

+PROC bildrand (INT CONST i) :

+  rand := i

+END PROC bildrand;

+ 

+INT PROC max (INT CONST a, b) :

+  IF a > b THEN a ELSE b FI

+END PROC max;

+ 

+PROC zeile unveraendert :

+  zeileneu := FALSE

+END PROC zeile unveraendert;

+ 

+ 

+(**************************  b i l d e d i t o r  **************************)

+ 

+PROC bildeditor (DATEI VAR datei) :

+ 

+     INTERNAL 293 ; 

+ 

+  INT  VAR j;

+ 

+  kommando := feldkommando;

+  IF   neu

+  THEN bild ausgeben (datei) 

+  ELIF zeileneu

+  THEN satz ausgeben (datei); ueberschriftneu := TRUE 

+  ELSE feldposition; zeileneu := TRUE

+  FI;

+  REPEAT

+    IF   neu             THEN bild ausgeben (datei) 

+    ELIF ueberschriftneu THEN ueberschrift  (datei) 

+    FI ;

+    IF   stelle = anker

+         THEN IF   schreiben erlaubt

+              THEN satz erzeugen (datei, stelle); (* gestrichen z:=z *)

+                   satz ausgeben (datei)

+              ELSE feldkommando (escape q); out(bell); LEAVE bildeditor 

+              FI

+    FI ;

+    feldbearbeitung; 

+    IF   zeichen <> escape THEN kommandoausfuehrung FI

+  UNTIL  zeichen =  escape

+  END REPEAT; 

+  feldkommando (kommando) .

+ 

+feldbearbeitung :

+  feldkommando (kommando); 

+  IF   schreiben erlaubt

+  THEN feldeditor (inhalt); kommando := feldkommando

+  ELSE teil := inhalt; feldeditor (teil);

+       IF   teil <> inhalt

+       THEN kommando := escape q; kommando CAT teil

+       ELSE kommando := feldkommando

+       FI

+  FI;

+  zeichen := kommando SUB 1;

+  feldnachbehandlung .

+ 

+ 

+feldnachbehandlung :

+  IF   inhalt = ""

+  THEN IF   schreiben erlaubt

+       THEN IF   zeichen > hoechstes steuerzeichen

+            THEN inhalt   := subtext (kommando, 1, feldlimit);

+                 kommando := subtext (kommando, feldlimit+1);

+                 feldout (inhalt); zeichen := cr

+  FI   FI   FI . 

+ 

+kommandoausfuehrung :

+  delete char (kommando, 1);

+  IF   marke > 0

+  THEN bildmarkeditor (datei) 

+  ELSE 

+    SELECT pos (hop cr mark down up right rubin, zeichen) OF

+    CASE 1: 

+      zeichen := kommando SUB 1; delete char (kommando, 1);

+      SELECT pos (hop rubin rubout down up cr tab esc, zeichen) OF

+      CASE 1: oben links

+      CASE 2: IF   schreiben erlaubt

+              THEN zeilen einfuegen  ELSE out (bell) FI

+      CASE 3: IF   schreiben erlaubt

+              THEN zeile ausfuegen   ELSE out (bell) FI

+      CASE 4: weiterblaettern

+      CASE 5: zurueckblaettern

+      CASE 6: neue seite

+      CASE 7: ueberschriftneu := TRUE

+      CASE 8: lernmodus umschalten

+      OTHERWISE zeichen := ""; out (bell)

+      END SELECT

+    CASE 2: neue zeile

+    CASE 3: markieren beginnen

+    CASE 4: naechster satz

+    CASE 5: vorgaenger (datei)

+    CASE 6: feldposition (feldanfang); naechster satz

+    CASE 7: ueberschriftneu := TRUE;

+    OTHERWISE

+      IF   zeichen > hoechstes steuerzeichen

+      THEN IF schreiben erlaubt THEN ueberlauf FI

+      ELSE insert char (kommando, zeichen, 1);

+           insert char (kommando, escape,  1)

+      FI

+    END SELECT

+  FI . 

+ 

+oben links :

+  ueberschriftneu := TRUE;

+  WHILE zeile > 1 REP vorgaenger (datei) PER;

+  feldposition (feldanfang) .

+ 

+zeile ausfuegen : 

+  IF   feldstelle = 1

+  THEN satz loeschen (datei); 

+       IF   stelle = anker THEN vorgaenger (datei) FI

+  ELSE zeilen rekombinieren

+  FI .

+ 

+zeilen einfuegen :

+  ueberschriftneu := TRUE;

+  IF   einfuegen 

+  THEN einfuegen := FALSE;

+       IF inhalt = ""     THEN satz loeschen (datei) FI;

+       IF zeilen < laenge THEN bild ausgeben (datei) FI 

+  ELSE einfuegen := TRUE; 

+       IF   logischer satzanfang

+       THEN satz erzeugen (datei, stelle);

+            IF zeilen >= zeile THEN bildrest loeschen FI;

+            zeilen := zeile; satz ausgeben (datei)

+       ELSE IF   feldstelle <= LENGTH inhalt

+            THEN zeile auftrennen

+            FI;

+            IF   zeile < zeilen 

+            THEN nachfolger (datei); bildrest loeschen; 

+                 vorgaenger (datei); zeilen := zeile

+            FI ; feldposition

+       FI

+  FI .

+ 

+logischer satzanfang :

+  FOR j FROM feldanfang UPTO feldstelle - 1

+  REP IF   (inhalt SUB j) = "" 

+      THEN LEAVE logischer satzanfang WITH TRUE

+      ELIF (inhalt SUB j) <> " "

+      THEN LEAVE logischer satzanfang WITH FALSE

+      FI

+  END REP; TRUE . 

+ 

+zeilen rekombinieren :

+  IF   eof (datei) THEN

+  ELSE inhalt CAT (feldstelle-1-LENGTH inhalt) * " ";

+       inhalt CAT datei (datei (stelle).nachfolger).inhalt;

+       stelle := datei (stelle).nachfolger;

+       satz loeschen (datei, stelle); 

+       stelle := datei (stelle).vorgaenger;

+       bildausgeben (datei)

+  FI .

+ 

+zeile auftrennen :

+  marke  := stelle; (feldende-feldstelle+1) TIMESOUT " "; 

+  stelle := datei (stelle).nachfolger;

+  satz erzeugen (datei, stelle);

+  inhalt := subtext (datei (datei (stelle).vorgaenger).inhalt, feldstelle);

+  stelle := marke; marke := 0; 

+  inhalt := subtext (inhalt, 1, feldstelle-1) .

+ 

+weiterblaettern :

+  ueberschriftneu := TRUE;

+  IF   eof (datei)

+  THEN out (bell)

+  ELSE IF   zeile = laenge

+       THEN nachfolger (datei); zeile := 1; bild ausgeben (datei)

+       ELIF einfuegen

+       THEN IF zeile = zeilen THEN bild ausgeben (datei) FI

+       FI;

+       WHILE zeile < zeilen AND stelle <> anker 

+       REP nachfolger (datei) END REP;

+       IF   stelle = anker

+       THEN vorgaenger (datei) 

+  FI   FI .

+ 

+zurueckblaettern :

+  ueberschriftneu := TRUE;

+  IF   satz > 1

+  THEN IF   zeile = 1

+       THEN vorgaenger (datei); zeile := laenge

+       FI;

+       WHILE zeile > 1 AND satz > 1

+       REP vorgaenger (datei) PER;

+       zeile := 1

+  FI .

+ 

+ueberlauf :

+  insert char (kommando, zeichen, 1);

+  feldposition (feldanfang); feld einruecken (inhalt); nachfolger (datei);

+  satz erzeugen (datei, stelle); 

+  inhalt := ""0"" ;                    (* 12.01.81 *)

+  IF   zeile <= zeilen OR neu

+  THEN bild ausgeben (datei) ELSE satz ausgeben (datei)

+  FI ;

+  inhalt := "" .

+ 

+lernmodus umschalten :

+  feldlernmodus (NOT feldlernmodus);

+  ueberschriftneu := TRUE; 

+  IF   feldlernmodus 

+  THEN feldaudit (""); zeichen := ""

+  ELSE insert char (kommando, escape, 1);

+       insert char (kommando, hop, 1)

+  FI.

+ 

+neue seite :

+  feldstelle (feldanfang); zeile := 1; neu := TRUE . 

+ 

+neue zeile : 

+  BOOL VAR wirklich einfuegen := einfuegen;

+  IF   feldstelle > LENGTH inhalt OR feldstelle >= feldende

+  THEN feldposition (feldanfang); feld einruecken (inhalt); nachfolger(datei)

+  ELIF einfuegen AND logischer satzanfang

+  THEN feldposition (feldanfang); feldeinruecken (inhalt)

+  ELSE feldposition (feldanfang); nachfolger (datei);

+       wirklich einfuegen := FALSE

+  FI;

+  IF   stelle = anker THEN

+  ELIF wirklich einfuegen

+  THEN satz erzeugen (datei, stelle);

+       IF   zeile <= zeilen OR neu

+       THEN bild ausgeben (datei)

+       ELSE satz ausgeben (datei)

+       FI

+  ELIF neu THEN

+  ELSE IF   zeile > zeilen

+       THEN satz ausgeben (datei)

+       FI;

+       FOR j FROM feldanfang UPTO min (feldstelle, LENGTH inhalt)

+       REP  IF   (inhalt SUB j) <> blank

+            THEN feldposition (j); LEAVE neue zeile FI 

+       PER 

+  FI . 

+ 

+naechster satz :

+  nachfolger (datei);

+  IF   neu 

+  THEN IF   stelle = anker

+       THEN IF   datei (datei (stelle).vorgaenger).inhalt = ""

+            THEN stelle := datei (stelle).vorgaenger; satz DECR 1;

+                 neu := FALSE

+       FI   FI

+  ELIF zeile <= zeilen THEN

+  ELIF stelle = anker  THEN

+  ELSE satz ausgeben (datei)

+  FI .

+ 

+markieren beginnen :

+  IF   feldstelle <= min (LENGTH inhalt, feldende)

+  THEN feldmarke (feldstelle); marke := stelle; 

+       marksatz := satz; satz ausgeben (datei);

+       alte feldmarke := feldmarke

+  ELSE out (bell)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC bildeditor;

+ 

+ 

+(********************  b i l d - m a r k e d i t o r  **********************)

+ 

+PROC bildmarkeditor (DATEI VAR datei) :

+  INT  VAR j, k;

+ 

+  IF   zeichen  = right OR zeichen = tab

+  THEN zeichen := down;

+       feldposition (feldanfang)

+  FI;

+  SELECT pos (hop mark rubout up down cr, zeichen) OF

+    CASE 1: zeichen := kommando SUB 1; delete char (kommando, 1);

+            IF   zeichen = up

+            THEN rueckblaetternd demarkieren

+            ELIF zeichen = down

+            THEN weiterblaetternd markieren

+            ELSE out (bell)

+            FI;

+            zeichen := ""

+    CASE 2: markieren beenden

+    CASE 3: IF schreiben erlaubt

+            THEN markiertes loeschen

+            ELSE out (bell)

+            FI

+    CASE 4: zeile demarkieren

+    CASE 5,6: zeile markieren

+    OTHERWISE insert char (kommando, zeichen, 1);

+              insert char (kommando, escape,  1)

+  END SELECT;

+  IF   marke > 0

+  THEN IF   stelle = marke

+       THEN feldmarke (alte feldmarke)

+       ELSE feldmarke (feldanfang)

+       FI

+  FI .

+ 

+markieren beenden :

+  feldmarke (0); alte feldmarke := 0; 

+  IF   marke = stelle

+  THEN satz ausgeben (datei); ueberschriftneu := TRUE; 

+       marke := 0;

+  ELSE marke := 0; neu := TRUE

+  FI .

+ 

+markiertes loeschen :

+  IF   stelle = marke

+  THEN satzausschnitt loeschen

+  ELSE letzten satz bis stelle loeschen;

+       ersten satz ab marke loeschen;

+       alle zwischensaetze loeschen;

+       IF   zeile <= 1 

+       THEN zeile := 1

+       FI;

+       feldstelle (feldanfang); feldmarke (0);

+       alte feldmarke := 0; marke := 0; neu := TRUE 

+  FI . 

+ 

+satzausschnitt loeschen :

+  inhalt := subtext (inhalt, 1, feldmarke-1) + subtext (inhalt, feldstelle);

+  feldstelle (feldmarke); feldmarke (0); marke := 0; 

+  IF   inhalt = ""

+  THEN satz loeschen (datei)

+  ELSE satz ausgeben (datei)

+  FI .

+ 

+letzten satz bis stelle loeschen :

+  IF   feldstelle > LENGTH inhalt

+  THEN satz loeschen (datei, stelle)

+  ELIF feldstelle > feldanfang

+  THEN inhalt := subtext (inhalt, feldstelle)

+  FI .

+ 

+ersten satz ab marke loeschen :

+  INT CONST altstelle := stelle;

+  stelle := marke;

+  IF   alte feldmarke = 1

+  THEN satz loeschen (datei, stelle);

+       satz DECR 1; zeile DECR 1

+  ELSE IF   alte feldmarke <= LENGTH inhalt

+       THEN inhalt := text (inhalt, alte feldmarke-1)

+       FI;

+       stelle := datei (stelle).nachfolger

+  FI .

+ 

+alle zwischensaetze loeschen :

+  WHILE stelle <> altstelle

+  REP satzloeschen (datei, stelle);

+      satz DECR 1; zeile DECR 1

+  PER .

+ 

+zeile markieren : 

+  IF   zeichen = cr

+  THEN feldstelle (feldanfang)

+  FI;

+  IF   eof (datei) 

+  THEN feldstelle (feldende)

+  ELSE nachfolger (datei)

+  FI;

+  markierung justieren (datei);

+  satz ausgeben (datei) . 

+ 

+zeile demarkieren :

+  IF   stelle = marke

+  THEN out (bell); LEAVE zeile demarkieren

+  FI;

+  feldmarke (0); satz ausgeben (datei);

+  vorgaenger (datei);

+  markierung justieren (datei);

+  satz ausgeben (datei) .

+ 

+weiterblaetternd markieren :

+  IF zeile >= laenge THEN zeile := 0 FI; out (hop); 

+  WHILE NOT eof (datei)

+  REP nachfolger (datei) UNTIL zeile = laenge PER;

+  IF   eof (datei)

+  THEN feldstelle (feldende); 

+  FI;

+  neu := TRUE .

+ 

+rueckblaetternd demarkieren :

+  IF   stelle = marke

+  THEN out (bell); LEAVE rueckblaetternd demarkieren

+  FI;

+  FOR j FROM 1 UPTO laenge 

+  WHILE stelle <> marke

+  REP vorgaenger (datei) PER;

+  neu := TRUE .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC bildmarkeditor;

+ 

+PROC markierung justieren (DATEI CONST datei) :

+  IF   feldstelle > LENGTH inhalt

+  THEN feldstelle (min (feldende, LENGTH inhalt) + 1)

+  FI;

+  IF   stelle =  marke

+  THEN feldmarke (alte feldmarke);

+       IF   feldstelle < feldmarke

+       THEN feldstelle (feldmarke)

+       FI

+  ELSE feldmarke (feldanfang)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC markierung justieren;

+ 

+PROC vorgaenger (DATEI VAR datei) :

+  IF   eof (datei) 

+  THEN IF   inhalt = "" THEN satz loeschen (datei)

+  FI   FI ; 

+  stelle := datei (stelle).vorgaenger; satz DECR 1;

+  IF   stelle = anker

+  THEN out (bell); stelle := datei (anker).nachfolger;

+       satz := 1; zeile := 1

+  ELIF zeile > 1

+  THEN out (up); zeile DECR 1

+  ELSE neu := TRUE

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC vorgaenger;

+ 

+PROC nachfolger (DATEI CONST datei) :

+  stelle := datei (stelle).nachfolger; satz INCR 1; zeile INCR 1;

+  IF   zeile <= laenge 

+  THEN out (down) 

+  ELIF laenge <> maxlaenge 

+  THEN neu := TRUE ; zeile := laenge

+  FI 

+END PROC nachfolger;

+ 

+PROC  bild ausgeben (DATEI VAR datei) :

+ 

+  IF marke > 0 THEN markierung justieren (datei) FI;

+  alte feldstelle := feldstelle; feldstelle (feldende+1);

+  INT VAR altstelle :: stelle, altsatz  :: satz,

+          altzeile  :: zeile,  altmarke :: feldmarke;

+  ueberschrift (datei); 

+  IF   marke > 0 OR neu

+  THEN zurueck zur ersten zeile;

+       cursor (1, rand+2) FI; 

+  IF   (rand+laenge) = maxlaenge THEN out (clear eop) FI;

+  WHILE zeile <= laenge AND stelle <> anker

+  REP zeile schreiben PER; 

+  feldstelle (alte feldstelle);

+  feldmarke (altmarke);

+  zeilen := zeile - 1;

+  IF   zeile > laenge 

+  THEN zeile := laenge; feldposition

+  ELSE bildrest loeschen

+  FI;

+  (zeile - altzeile) TIMESOUT up;

+  zeile := altzeile; satz := altsatz; stelle := altstelle;

+  neu   := FALSE .

+ 

+zurueck zur ersten zeile :

+  IF   eof (datei) 

+  THEN WHILE inhalt = "" AND datei(stelle).vorgaenger <> anker

+       REP vorgaenger (datei) END REP;

+       altstelle := stelle; altsatz := satz; altzeile := zeile;

+  FI;

+  WHILE zeile > 1 AND datei (stelle).vorgaenger <> anker

+  REP IF   stelle = marke

+      THEN feldmarke (0)

+      FI;

+      vorgaenger (datei)

+  PER;

+  altzeile DECR (zeile-1); zeile := 1 .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+zeile schreiben :

+   IF stelle = marke     THEN feldmarke  (alte feldmarke)  FI;

+   IF stelle = altstelle THEN feldstelle (alte feldstelle) FI;

+   feldout (inhalt);

+   IF   stelle = altstelle

+   THEN feldmarke (0)

+   ELIF feldmarke > feldanfang

+   THEN feldmarke (feldanfang)

+   FI;

+   zeile INCR 1;

+   IF   zeile <= laenge

+   THEN stelle := datei (stelle).nachfolger;

+        satz INCR 1; out (down)

+   FI .

+ 

+END PROC bild ausgeben;

+ 

+PROC ueberschrift (DATEI CONST datei) : 

+  cursor (feldrand+1, rand+1); out(begin mark);

+  INT CONST punkte :: 

+  (feldende-feldanfang-13-length(datei(anker).inhalt)) DIV 2;

+  punkte TIMESOUT "."; out (" ", datei(anker).inhalt, " .");

+  cursor (feldrand+3, rand+1);

+  IF   feldeinfuegen

+  THEN out ("RUBIN"2""2"")

+  ELSE out (""2""2""2""2""2""2""2"") FI;

+  IF   einfuegen

+  THEN out ("INS")

+  ELSE out (""2""2""2"") FI;

+  IF   feldlernmodus THEN out ("..LEARN.") FI;

+  cursor (feldrand+feldende-feldanfang-9-punkte, rand+1);

+  punkte TIMESOUT ".";

+  out (" zeile     ", end mark, "  ");

+  cursor (feldrand+feldende-feldanfang-2, rand+1) ;

+  IF   satz <= zeile THEN out("1")

+  ELSE out (text (satz-zeile+1))  FI;

+  cursor (feldrand+2, rand+1);

+  feldtab (tabulator);

+  outsubtext (tabulator, feldanfang+1, min (feldende, LENGTH tabulator));

+  cursor (1, rand+zeile+1); feldposition;

+  ueberschriftneu := FALSE 

+ 

+END PROC ueberschrift;

+ 

+TEXT VAR tabulator;

+ 

+PROC satz ausgeben (DATEI VAR datei) : 

+  IF   zeile > laenge

+  THEN roll up

+  ELIF zeile > zeilen

+  THEN zeilen INCR 1

+  FI;

+  feldout (datei (stelle).inhalt); feldposition .

+roll up :

+  out (down); cursor (1, rand + zeile); zeile DECR 1 .

+END PROC satz ausgeben;

+ 

+PROC satz loeschen (DATEI VAR datei) :

+  satz loeschen (datei, stelle); zeilen DECR 1;

+  IF   zeile > zeilen

+  THEN bildrest loeschen;

+       IF stelle <> anker THEN satz ausgeben (datei) FI

+  ELSE bild ausgeben (datei)

+  FI

+END PROC satz loeschen;

+ 

+PROC bildrest loeschen :

+  out (cr); feldrand TIMESOUT right;

+  IF   (rand+laenge) = maxlaenge

+  THEN out (clear eop)

+  ELSE out (up);

+       (laenge-zeile+1) TIMESOUT (down clear eol);

+       (laenge-zeile)   TIMESOUT up

+  FI;

+  feldposition

+END PROC bildrest loeschen;

+ 

+BOOL PROC eof (DATEI CONST datei) :

+  datei (stelle).nachfolger = anker

+END PROC eof;

+ 

+(*************************** schrott *************************************)

+ 

+PROC satz erzeugen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 291 ;

+END  PROC satz erzeugen; 

+ 

+PROC satz loeschen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+(************************** testprogramm ***********************************)

+(*

+PROC test des bildeditors :

+ 

+  IF   NOT exists ("test")

+  THEN FILE VAR file 1 := sequential file (modify, "test"); close (file 1)

+  FI ;

+  DATASPACE VAR ds := old ("test");

+  BOUND DATEI VAR datei := ds ;

+  feldwortweise (NOT feldwortweise);

+  bildneu (TRUE); bildmarke (0); 

+  bildstelle (CONCR(datei) (anker).nachfolger); bildsatz (1);

+  feldmarke (0); feldseparator (""); feldstelle (1) ;

+  REP b i l d   e d i t o r  (CONCR (datei));

+      out (""7""); feldkommando ("") 

+  UNTIL (feldkommando SUB 1) = ""27""

+  PER;

+ 

+END PROC test des bildeditors;

+*)

+END PACKET bildeditor;

diff --git a/system/base/unknown/src/command handler b/system/base/unknown/src/command handler
new file mode 100644
index 0000000..3e06280
--- /dev/null
+++ b/system/base/unknown/src/command handler
@@ -0,0 +1,239 @@
+ 

+PACKET command handler DEFINES                (* Autor: J.Liedtke *)

+                                              (* Stand:  29.02.82 *)

+       command handler ,

+       do command ,

+       command error ,

+       set command :

+ 

+ 

+LET esc          = ""27"" ,

+    esc k        = ""27"k" ,

+    cr lf        = ""4""13""10"" ,

+    command pre  = ""4""13"      " ,

+    command post =    ""13""10"      " ,

+ 

+    tag type = 1 ,

+    texttype = 4 ,

+    eof type = 7 ;

+ 

+ 

+TEXT VAR command line := "" ,

+         previous command line := "" ,

+         symbol ,

+         procedure ,

+         pattern ,

+         error note := "" ;

+ 

+INT VAR  symbol type ,

+         allowed type := 0 ;

+ 

+ 

+PROC set command (TEXT CONST command, INT CONST type) :

+

+  param position (0) ;

+  command line := command ;

+  allowed type := type

+ 

+ENDPROC set command ;

+ 

+PROC do command :

+ 

+  do (command line)

+

+ENDPROC do command ;

+

+ 

+PROC command handler ( TEXT CONST command list,

+                       INT VAR command index, number of params,

+                       TEXT VAR param 1, param 2,

+                       TEXT CONST command text ) :

+ 

+prepare and get command ;

+command handler (command list,command index,number of params,param1,param2).

+ 

+prepare and get command :

+  set line nr (0) ;

+  error protocoll ;

+  get command from console .

+ 

+error protocoll :

+  IF is error

+    THEN put error ;

+         clear error

+    ELSE command line := "" ;

+  FI .

+ 

+get command from console :

+  INT VAR x, y;

+  out (crlf) ;

+  get cursor (x, y) ;

+  cursor (x, y) ;

+  REP

+    out (command pre) ;

+    out (command text) ;

+    out (command post) ;

+    editget command

+  UNTIL command line <> "" PER ;

+  param position (LENGTH command line) ;

+  out (command post) .

+ 

+editget command :

+  feldaudit ("") ;

+  feldlernmodus (FALSE) ;

+  REP

+    feldtabulator ("") ;

+    feldseparator (esc) ;

+    editget (command line) ;

+    ignore halt errors during editget ;

+    IF feldzeichen = esc k

+      THEN command line := previous command line

+      ELSE previous command line := command line ;

+           LEAVE editget command

+    FI

+  PER .

+

+ignore halt errors during editget :

+  IF is error

+    THEN clear error

+  FI .

+

+ENDPROC command handler ;

+ 

+PROC command handler ( TEXT CONST command list,

+                       INT VAR command index, number of params,

+                       TEXT VAR param 1, param 2) :

+ 

+  scan (command line) ;

+  next symbol ;

+  IF pos (command list, symbol) > 0

+    THEN procedure name ;

+         parameter list pack option ;

+         nothing else in command line ;

+         decode command

+    ELSE impossible command

+  FI .

+ 

+procedure name :

+  IF symbol type = tag type OR symbol = "?"

+    THEN procedure := symbol ;

+         next symbol

+    ELSE error ("incorrect procedure name")

+  FI .

+ 

+parameter list pack option :

+  number of params := 0 ;

+  param 1 := "" ;

+  param 2 := "" ;

+  IF symbol = "("

+    THEN next symbol ;

+         parameter list ;

+         IF symbol <> ")"

+           THEN error (") expected")

+         FI

+  ELIF symbol type <> eof type

+    THEN error ("( expected")

+  FI .

+ 

+parameter list :

+  parameter (param 1, number of params) ;

+  IF symbol = ","

+    THEN next symbol ;

+         parameter (param 2, number of params) ;

+  FI ;

+  IF symbol <> ")"

+    THEN error (") expected")

+  FI .

+ 

+nothing else in command line :

+  next symbol ;

+  IF symbol <> ""

+    THEN error ("command too complex")

+  FI .

+

+decode command :

+  command index := index (command list, procedure, number of params) .

+ 

+impossible command :

+  command index := 0 .

+ 

+ENDPROC command handler ;

+ 

+PROC parameter (TEXT VAR param, INT VAR number of params) :

+ 

+  IF symbol type = text type OR symbol type = allowed type

+    THEN param := symbol ;

+         number of params INCR 1 ;

+         next symbol

+    ELSE error ("parameter is no text denoter ("" missing!)")

+  FI

+ 

+ENDPROC parameter ;

+ 

+INT PROC index (TEXT CONST list, procedure, INT CONST params) :

+ 

+  pattern := procedure ;

+  pattern CAT ":" ;

+  INT CONST index pos := pos (list, pattern) ;

+  IF procedure name found

+    THEN get colon pos ;

+         get dot pos ;

+         get end pos ;

+         get command index ;

+         get param index ;

+         IF param index >= 0

+           THEN command index + param index

+           ELSE - command index

+         FI

+    ELSE 0

+  FI .

+ 

+procedure name found :

+  index pos > 0  AND  (list SUB index pos - 1) <= "9"  .

+ 

+get param index :

+  INT CONST param index :=

+            pos (list, text (params), dot pos, end pos) - dot pos - 1 .

+ 

+get command index :

+  INT CONST command index :=

+            int ( subtext (list, colon pos + 1, dot pos - 1) ) .

+ 

+get colon pos :

+  INT CONST colon pos := pos (list, ":", index pos) .

+ 

+get dot pos :

+  INT CONST dot pos := pos (list, ".", index pos) .

+ 

+get end pos :

+  INT CONST end pos := dot pos + 4 .

+ 

+ENDPROC index ;

+ 

+PROC error (TEXT CONST message) :

+ 

+  error note := message ;

+  scan ("") ;

+  procedure := "-"

+ 

+ENDPROC error ;

+ 

+PROC command error :

+

+  disable stop ;

+  IF error note <> ""

+    THEN errorstop (error note) ;

+         error note := ""

+  FI ;

+  enable stop

+

+ENDPROC command error ;

+

+

+PROC next symbol :

+ 

+  next symbol (symbol, symbol type)

+ 

+ENDPROC next symbol ;

+ 

+iNDPACKET command handler ;

diff --git a/system/base/unknown/src/dateieditorpaket b/system/base/unknown/src/dateieditorpaket
new file mode 100644
index 0000000..8aedb2d
--- /dev/null
+++ b/system/base/unknown/src/dateieditorpaket
@@ -0,0 +1,743 @@
+ 

+PACKET  d a t e i e d i t o r  paket  DEFINES     (* Autor: P.Heyderhoff *)

+        (*******************)                     (* Stand: 19.02.82     *)

+                                                  (* Vers.: 1.6.0        *)

+        define escape ,

+        dateieditor :

+ 

+LET satzmax = 4075, dateianker = 2, left = ""8"", escape = ""27"",

+    hop = ""1"", right = ""2"", hoechstes steuerzeichen = ""31"", 

+    clear = ""1""4"", hop and mark = ""1""15"", code f = "f",

+    clear line mark = ""5""14"", bell = ""7"", freianker = 1, down = ""10"",

+    begin mark = ""15"", end mark = ""14"", escape escape = ""27""27"",

+    clear eol and mark = ""5""15"";

+ 

+LET DATEI = ROW satzmax STRUCT (INT nachfolger, vorgaenger, index,

+                                    fortsetzung, TEXT inhalt);

+FOR j FROM 1 UPTO 127 REP escapefkt (j) := "" PER;

+INT  VAR j, haltzeile :: satzmax, symboltyp, typ,

+         zahlwert, stelle, satz, marke, maxbildlaenge :: 23;

+FILE VAR sekundaerfile ;

+TEXT VAR zeichen :: "", ersatz   :: "", kommando :: "",

+         symbol  :: "", textwert :: "", lernsequenz::"";

+BOOL VAR war fehler, boolwert;

+LET op1namen = 

+";+;-;BEGIN;COL;GET;HALT;LIMIT;MARK;PUT;IF;NOT;REPEAT;WRITE;SIZE"; 

+LET b =  5, c = 11, g = 15, h = 19, l = 24, m = 30,

+    p = 35, i = 39, n = 42, r = 46, w = 53, s=59;

+LET op2namen = "&+&-&*&/&;&CHANGETO;&OR"; 

+LET plus = 1, minus = 3, mal = 5, durch = 7, semicolon = 9,

+    changecode = 11, or = 21;

+LET proznamen = ";col;row;halt;limit;mark;len;eof;";

+LET pcol =  1, prow  =  5, phalt =  9, plimit = 14, pmark = 20,

+    plen = 25, peof  = 29;

+LET void      =  0,    (* keine angabe des typs      *)

+    tag       =  1,    (* typ: lower case letter     *)

+    bold      =  2,    (* typ: upper case letter     *)

+    integer   =  3,    (* typ: digit                 *)

+    texttyp   =  4,    (* typ: quote                 *)

+    operator  =  5,    (* typ: operator +-*=<> ** := *)

+    delimiter =  6,    (* typ: delimiter ( ) , ; .   *)

+    eol       =  7,    (* typ: niltext, Zeilenende   *)

+    bool      =  8;    (* typ: boolean               *)

+LET varimax   = 10;

+INT VAR freivar :: 1;

+ROW varimax INT  VAR varzahlwert, vartyp;

+ROW varimax TEXT VAR vartextwert, varname;

+FOR j FROM 1 UPTO varimax

+REP vartextwert (j) := ""; varname (j) := "" PER;

+ 

+ROW 127 TEXT VAR escapefkt;

+ 

+ 

+(*************************  d a t e i e d i t o r  *************************)

+ 

+PROC dateieditor (DATEI VAR datei) :

+ 

+  INTERNAL 295 ;

+ 

+  REP   datei editieren

+  UNTIL (feldkommando SUB 1) <> escape

+  PER .

+ 

+datei editieren :

+  war fehler := FALSE ;

+  zeichen := feldkommando SUB 2;

+  IF   zeichen = "q" OR zeichen = "w"

+  THEN LEAVE dateieditor

+  ELIF zeichen = escape

+  THEN kommando ermitteln

+  ELSE tastenkommando ermitteln ;    (* Li 19.1.82 *)

+       abbruchtest;

+       feldkommando (subtext (feldkommando, 3))

+  FI;

+  a u s f u e h r e n .

+ 

+tastenkommando ermitteln :

+  IF zeichen > ""0"" AND zeichen < ""128""

+    THEN kommando := escapefkt (code (zeichen)) (* Li 06.01.82 *)

+    ELSE kommando := ""

+  FI .

+

+abbruchtest :

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+ 

+kommando ermitteln :

+  IF   (feldkommando SUB 1) = hop

+  THEN lernsequenz auf taste legen;

+       feldkommando (subtext (feldkommando, 4));

+       LEAVE datei editieren

+  FI;

+  feldkommando (subtext (feldkommando, 3));

+  kommando := ""; dialog; analysieren .

+ 

+dialog:

+  REP   kommandodialog;

+        IF   (feldzeichen SUB 1) <> escape OR kommando <> "?"

+        THEN LEAVE dialog

+        ELIF (feldzeichen SUB 2) > ""0"" THEN   (* Li 19.02.82 *)

+        kommando := escapefkt (code (feldzeichen SUB 2) MOD 128 )

+        ELSE kommando := ""

+        FI

+  PER .

+ 

+lernsequenz auf taste legen :

+  lernsequenz := feldaudit;

+  lernsequenz := subtext (lernsequenz, 1, LENGTH lernsequenz - 3);

+  INT CONST lerncode := code (feldkommando SUB 3) MOD 128 ;

+  escapefkt (lerncode) := "W""" ;

+  escapefkt (lerncode) CAT lernsequenz ;          (* Li 5.1.81 *)

+  escapefkt (lerncode) CAT """" .

+ 

+kommandodialog :

+  INT CONST feldlaenge :: max (feldende-feldanfang-21, 6) ;

+  cursor (feldrand+1, bildrand+bildzeile+1);

+  out (begin mark, "gib editor kommando: "); 

+  feldlaenge TIMESOUT "."; out(end mark);

+  bildneu (TRUE);

+  cursor (feldrand+23, bildrand+bildzeile+1); feldseparator (escape);

+  editget (kommando, 255, feldlaenge); feldseparator ("") .

+ 

+analysieren :

+  IF   (feldzeichen SUB 1) = escape AND (feldzeichen SUB 2) > ""0"" (*02.82*)

+  THEN escapefkt (code (feldzeichen SUB 2) MOD 128) := kommando; (* Li 5.1.*)

+       LEAVE datei editieren

+  ELIF kommando = ""

+  THEN LEAVE datei editieren

+  ELIF (kommando SUB 1) = "?"

+  THEN kommandos erklaeren;

+       LEAVE datei editieren

+  ELIF pos ("quit", kommando) = 1

+  THEN feldkommando (escape escape);

+       LEAVE dateieditor

+  ELSE escapefkt (code (code f)) := kommando 

+  FI .

+ 

+ausfuehren : 

+  haltzeile := satzmax;

+  IF   kommando = ""

+  THEN zeile unveraendert

+  ELSE scan (kommando); nextsymbol;

+       IF   a u s d r u c k  (datei)

+       THEN IF symboltyp <> eol THEN fehler bearbeiten FI

+       FI;

+       IF war fehler THEN inchar (zeichen)  (* warten *)  FI

+   FI .

+ 

+kommandos erklaeren : 

+  out (clear); 

+  putline ("kommandos fuer den benutzer :"); line;

+  putline ("quit      : beendet das editieren");

+  putline ("  n       : positioniert auf zeile n");

+  putline ("+ n       : blaettert n zeilen vorwaerts");

+  putline ("- n       : blaettert n zeilen rueckwaerts");

+  putline (" ""z""      : sucht angegebene zeichenkette ");

+  putline ("""muster"" CHANGETO ""ersatz"" :");

+  putline ("            muster wird durch ersatz ersetzt"); 

+  putline ("HALT   n  : sieht anhalten des suchens in zeile n vor");

+  putline ("GET   ""d"" : kopiert datei d und markiert");

+  putline ("PUT   ""d"" : schreibt markierten abschnitt in datei d");

+  putline ("LIMIT  n  : setzt schreibende auf spalte n");

+  putline ("BEGIN  n  : setzt feldanfang auf spalte n");

+  putline ("SIZE   n  : setzt bildlaenge auf n"); line;

+  putline ("?ESCx     : zeigt kommando auf escapetaste x");

+  inchar (zeichen) .

+ 

+END PROC dateieditor; 

+ 

+PROC define escape (TEXT CONST cmd char, kommando) :

+  escapefkt (code (cmd char) MOD 128) := kommando

+END PROC define escape ;

+ 

+ 

+(********************  h i l f s - p r o z e d u r e n  ********************)

+ 

+PROC fehler bearbeiten :

+  IF NOT war fehler

+  THEN war fehler := TRUE; bildneu (TRUE);

+       out (""2""2""2"  kommandofehler bei ",symbol," erkannt.");

+       out (clear line mark)

+  FI

+END PROC fehler bearbeiten;

+ 

+BOOL PROC fehler : fehler bearbeiten; FALSE END PROC fehler;

+ 

+BOOL PROC klammerzu :

+  IF   symbol = ")"

+  THEN nextsymbol; TRUE

+  ELSE fehler

+  FI

+END PROC klammerzu;

+ 

+PROC nextsymbol :

+  nextsymbol (symbol, symboltyp);

+  IF symboltyp = eol THEN symbol := "kommandoende" FI

+END PROC nextsymbol;

+ 

+PROC eof (DATEI VAR datei) :

+  boolwert := (bildstelle = dateianker); typ := void

+END PROC eof;

+ 

+PROC nachsatz (DATEI CONST datei) :

+  stelle := datei (stelle).nachfolger;

+  satz INCR 1; protokoll

+END PROC nachsatz;

+ 

+PROC vorsatz  (DATEI CONST datei) :

+  stelle := datei (stelle).vorgaenger;

+  satz DECR 1; protokoll

+END PROC vorsatz;

+ 

+ 

+PROC protokoll :

+  cout (satz) ;

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+END PROC protokoll;

+ 

+ 

+(*******************  s p r i n g e n  und  s u c h e n  *******************)

+ 

+PROC row (DATEI VAR datei) : 

+  IF ziel voraus THEN vorwaerts springen ELSE rueckwaerts springen FI;

+  bildsatz (satz); bildstelle (stelle); typ := void; bildneu (TRUE) .

+ 

+ziel voraus :

+  satz := bildsatz; stelle := bildstelle;

+  IF   zahlwert > satz

+  THEN TRUE

+  ELIF zahlwert <= satz DIV 2 AND bildmarke = 0

+  THEN stelle := datei (dateianker).nachfolger; satz := 1; TRUE

+  ELSE FALSE

+  FI .

+ 

+vorwaerts springen :

+  IF zahlwert <= 0

+    THEN fehler bearbeiten

+  FI ;

+  WHILE stelle <> dateianker AND satz < zahlwert

+  REP nachsatz (datei) UNTIL war fehler PER;

+  IF   stelle = dateianker AND satz > 1 

+  THEN vorsatz (datei);

+       feldstelle (LENGTH (datei (stelle).inhalt)+1)

+  FI .

+ 

+rueckwaerts springen :

+  WHILE stelle <> bildmarke  AND satz > zahlwert

+  REP vorsatz (datei) UNTIL war fehler PER .

+ 

+END PROC row;

+ 

+PROC search (DATEI VAR datei) :

+  stelle := bildstelle;

+  IF textwert <> "" THEN contextadressierung FI;

+  typ := void .

+ 

+contextadressierung : 

+  j := feldstelle - 1; satz := bildsatz;

+  WHILE noch nicht gefunden REP nachsatz (datei) UNTIL war fehler PER;

+  IF    stelle = dateianker

+  THEN  vorsatz (datei);

+        feldstelle (LENGTH (datei (stelle).inhalt)+1)

+  ELIF  j > 0

+  THEN  feldstelle ((LENGTH textwert)+j)

+  FI;

+  IF    bildstelle <> stelle

+  THEN  bildstelle (stelle); bildsatz (satz); bildneu (TRUE)

+  FI .

+ 

+noch nicht gefunden : 

+  j := pos (datei (stelle).inhalt, textwert, j+1); 

+  j = 0 AND stelle <> dateianker AND satz < haltzeile .

+ 

+END PROC search; 

+ 

+ 

+(********************  vom file holen, in file bringen  ********************)

+ 

+PROC vom file holen (DATEI VAR datei, TEXT VAR textwert) :

+  stelle := bildstelle; satz := bildsatz;

+  IF   datei eroeffnung korrekt

+  THEN IF stelle = dateianker THEN satz erzeugen (datei, stelle) FI;

+       zeile auftrennen; file kopieren; kopiertes markieren;

+       bildstelle (stelle); bildsatz (satz); bildmarke (marke)

+  FI ; textwert := "" .

+ 

+datei eroeffnung korrekt :

+  IF   textwert = ""

+  THEN sekundaerfile := sequential file (input); NOT eof (sekundaerfile)

+  ELIF exists (textwert)

+  THEN sekundaerfile := sequential file (input, textwert);

+       NOT eof (sekundaerfile) 

+  ELSE FALSE

+  FI .

+ 

+file kopieren : 

+  INT VAR altstelle;

+  FOR j FROM 0 UPTO satzmax WHILE NOT eof (sekundaerfile) 

+  REP nachsatz (datei); altstelle := stelle;

+      satz erzeugen (datei, stelle);

+      IF stelle = altstelle THEN LEAVE file kopieren FI; 

+      getline (sekundaerfile, inhalt)

+  UNTIL war fehler

+  PER .

+ 

+zeile auftrennen : 

+  marke := stelle; bildmarksatz (satz);

+  nachsatz (datei); satz erzeugen (datei, stelle);

+  inhalt := subtext (datei (marke).inhalt, feldstelle);

+  vorsatz (datei); inhalt := text (inhalt, feldstelle-1) . 

+ 

+kopiertes markieren : 

+  nachsatz (datei);

+  IF inhalt = "" THEN satz loeschen (datei, stelle) FI;

+  vorsatz (datei);

+  IF   datei (marke).inhalt = "" 

+  THEN satz loeschen (datei, marke); satz DECR 1;

+  ELSE marke := datei (marke).nachfolger; bildmarksatz (bildmarksatz+1)

+  FI; 

+  feldmarke (feldanfang); feldanfangsmarke (feldanfang);

+  feldstelle (1+LENGTH inhalt); bildneu (TRUE) .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+END PROC vom file holen; 

+ 

+PROC in file bringen ( DATEI VAR datei, TEXT VAR textwert) :

+  neuen sekundaerfile erzeugen;

+  marke := bildstelle; stelle := bildmarke; satz := bildmarksatz;

+  IF   stelle = marke 

+  THEN IF   feldmarke <> feldstelle

+       THEN putline (sekundaerfile,

+                     subtext (inhalt, feldmarke, feldstelle-1)) 

+       FI

+  ELSE IF   feldanfangsmarke <= LENGTH inhalt

+       THEN putline (sekundaerfile, subtext (inhalt, feldanfangsmarke))

+       FI;  schreiben;

+       IF   feldstelle > feldanfang 

+       THEN putline (sekundaerfile, subtext (inhalt, 1, feldstelle-1)) 

+       FI

+  FI .

+ 

+schreiben: 

+  REP nachsatz (datei);

+      IF stelle = marke OR war fehler THEN LEAVE schreiben FI;

+      putline (sekundaerfile, inhalt) 

+  PER .

+ 

+neuen sekundaerfile erzeugen : 

+  IF   textwert = ""

+    THEN sekundaerfile := sequential file (output) ;

+    ELSE IF   exists (textwert) 

+         THEN forget (textwert)

+         FI;

+         IF   exists (textwert)

+         THEN LEAVE in file bringen

+         FI;

+         sekundaerfile := sequential file (output, textwert)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+END PROC in file bringen; 

+ 

+ 

+(*************************  i n t e r p r e t e r  *************************)

+ 

+BOOL PROC primary (DATEI VAR datei) : 

+ 

+  SELECT symboltyp OF

+    CASE integer :

+         IF   LENGTH symbol <= 4            (* Li 20.01.82 *)

+         THEN zahlwert := int (symbol);

+              typ := symboltyp;

+              nextsymbol; TRUE

+         ELSE fehler

+         FI

+    CASE texttyp :

+         textwert := symbol; typ := symboltyp; nextsymbol; TRUE

+    CASE delimiter :

+         IF   symbol = "("

+         THEN nextsymbol;

+              IF ausdruck (datei) THEN klammerzu ELSE fehler FI

+         ELSE fehler

+         FI

+    CASE tag :

+         INT CONST pcode :: pos (proznamen, ";" + symbol + ";");

+         IF   pcode = 0

+         THEN is variable

+         ELSE nextsymbol; prozedurieren

+         FI

+    CASE bold, operator :

+         INT CONST op1code :: pos (op1namen, ";" + symbol);

+         IF   op1code = 0

+         THEN fehler

+         ELIF op1code = r                   (* Li 12.01.81 *)

+         THEN wiederholung (datei)

+         ELSE nextsymbol ;

+              IF primary (datei)

+              THEN operieren 

+              ELSE fehler

+              FI

+         FI

+     OTHERWISE : fehler

+   END SELECT .

+ 

+is variable : 

+  INT  VAR var :: 1;

+  WHILE varname (var) <> symbol AND var <> freivar REP var INCR 1 PER;

+  IF   var = freivar

+  THEN varname (var) := symbol; nextsymbol;

+       IF   symbol = ":="

+       THEN deklarieren

+       ELSE LEAVE is variable WITH fehler

+       FI

+  ELSE nextsymbol

+  FI;

+  IF symbol = ":=" THEN nextsymbol; assignieren ELSE dereferenzieren FI .

+ 

+dereferenzieren :

+  typ := vartyp (var); zahlwert := varzahlwert (var);

+  textwert := vartextwert (var); TRUE .

+ 

+assignieren :

+  IF   primary (datei)

+  THEN IF   typ = integer

+       THEN varzahlwert (var) := zahlwert

+       ELIF typ = texttyp

+       THEN vartextwert (var) := textwert

+       ELSE fehler bearbeiten

+       FI;

+       vartyp (var) := typ; typ := void

+  ELSE fehler bearbeiten

+  FI;

+  NOT war fehler .

+ 

+deklarieren :

+  IF   freivar = varimax

+  THEN fehler bearbeiten

+  ELSE freivar INCR 1

+  FI .

+ 

+prozedurieren :

+  typ := integer;

+  SELECT pcode OF 

+    CASE pcol   : zahlwert := feldstelle

+    CASE plen   : zahlwert := LENGTH (datei (bildstelle).inhalt)

+    CASE prow   : zahlwert := bildsatz

+    CASE phalt  : zahlwert := haltzeile

+    CASE plimit : zahlwert := feldlimit

+    CASE pmark  : zahlwert := bildmarke

+    CASE peof   : eof (datei) 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  NOT war fehler .

+ 

+operieren :

+  SELECT op1code OF

+    CASE plus  : zahlwert INCR bildsatz; row (datei)

+    CASE minus : zahlwert := bildsatz - zahlwert; row (datei)

+    CASE b     : begin

+    CASE c     : col 

+    CASE g     : get 

+    CASE h     : halt 

+    CASE l     : limit 

+    CASE m     : mark

+    CASE p     : put

+    CASE i     : if 

+    CASE w     : write

+    CASE s     : size 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  typ := void; TRUE .

+ 

+begin : 

+  zahlwert := zahlwert MOD 180;

+  feldende (feldende+zahlwert-feldanfang); feldanfang (zahlwert) .

+ 

+col :

+  zahlwert := zahlwert MOD 256; feldstelle (zahlwert) .

+ 

+get : 

+  IF   bildmarke <= 0 AND schreiberlaubnis

+  THEN vom file holen (datei, textwert)

+  FI .

+ 

+halt :

+  haltzeile := zahlwert .

+ 

+limit :

+  zahlwert := zahlwert MOD 256; feldlimit (zahlwert) .

+ 

+mark :

+  IF   zahlwert = 0

+  THEN bildmarke (0); feldmarke (0); bildneu (TRUE) 

+  ELSE bildmarke (bildstelle); feldmarke (feldstelle);

+       bildmarksatz (bildsatz)

+  FI .

+ 

+put : 

+  IF bildmarke > 0 THEN in file bringen (datei, textwert) FI .

+ 

+if : 

+  IF   bedingung (datei) 

+  THEN IF   boolwert 

+       THEN IF   pos ("THEN", symbol) = 1 

+            THEN nextsymbol;

+                 IF   ausdruck (datei)

+                 THEN skip elseteil

+                 ELSE fehler bearbeiten

+                 FI 

+            ELSE fehler bearbeiten

+            FI

+       ELSE skip thenteil; 

+            IF   j = 1

+            THEN elseteil

+            ELIF j <> 5

+            THEN fehler bearbeiten

+            FI

+       FI

+  ELSE fehler bearbeiten

+  FI .

+ 

+elseteil :

+  IF   ausdruck (datei)

+  THEN IF symbol = "FI" THEN nextsymbol ELSE fehler bearbeiten FI

+  FI .

+ 

+skip elseteil : 

+  WHILE symboltyp <> eol AND pos ("FI", symbol) <> 1 REP nextsymbol PER; 

+  nextsymbol .

+ 

+skip thenteil : 

+  WHILE (symboltyp <> eol) AND nicht elsefi REP nextsymbol PER; 

+  nextsymbol .

+ 

+nicht elsefi : 

+  j := pos ("ELSEFI", symbol); j = 0 . 

+ 

+write :

+  feldkommando (textwert); zeile unveraendert .

+ 

+size :

+  IF   bildlaenge > maxbildlaenge

+  THEN maxbildlaenge := bildlaenge

+  FI;

+  bildlaenge (max (1, min (zahlwert, maxbildlaenge)));

+  bildzeile  (min (bildzeile, bildlaenge)); 

+  bildrand (0); bildneu (TRUE); page .

+ 

+END PROC primary; 

+ 

+ 

+(***********  w i e d e r h o l u n g ,   b e d i n g u n g  ***************)

+ 

+BOOL PROC wiederholung (DATEI VAR datei) : 

+ 

+  fix scanner ;              (* Li 12.01.81 *)

+  wiederholt interpretieren;

+  skip endrep; typ := void;

+  NOT war fehler .

+ 

+wiederholt interpretieren :

+  REP reset scanner; nextsymbol;           (* 12.01.81 *)

+      WHILE ausdruck (datei) REP UNTIL until PER; abbruchtest

+  UNTIL ende der wiederholung

+  PER .

+ 

+until : 

+  IF   pos ("UNTIL", symbol) = 1

+  THEN nextsymbol;

+       IF   primary (datei) THEN FI;

+       IF   bedingung (datei) 

+       THEN IF   boolwert

+            THEN LEAVE wiederholt interpretieren;TRUE

+            ELSE TRUE

+            FI

+       ELSE fehler

+       FI

+  ELSE TRUE

+  FI .

+ 

+ende der wiederholung :

+  IF war fehler

+    THEN TRUE

+  ELIF datei (stelle).nachfolger = dateianker

+    THEN feldstelle > LENGTH (datei (stelle).inhalt)

+  ELSE FALSE

+  FI .

+ 

+skip endrep :

+  WHILE pos ("ENDREPEAT", symbol) <> 1 AND symboltyp <> eol 

+  REP nextsymbol PER;

+  nextsymbol .

+ 

+abbruchtest :

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+ 

+END PROC wiederholung; 

+ 

+BOOL PROC bedingung (DATEI VAR datei) : 

+  INT VAR relator; 

+  relator := pos ("=><<=>=<>", symbol); 

+  IF   relator = 0

+  THEN fehler

+  ELSE IF typ = texttyp THEN relator INCR 8 FI;

+       nextsymbol; 

+       INT VAR operandtyp :: typ, operandzahlwert :: zahlwert; 

+       TEXT VAR operandtextwert :: textwert; 

+       IF   primary (datei) THEN FI; 

+       IF   operandtyp <> typ

+       THEN fehler

+       ELSE boolwert := vergleich; typ := bool; TRUE 

+       FI

+  FI .

+ 

+vergleich : 

+  SELECT relator OF 

+    CASE  1 : operandzahlwert =  zahlwert 

+    CASE  2 : operandzahlwert >  zahlwert 

+    CASE  3 : operandzahlwert <  zahlwert 

+    CASE  4 : operandzahlwert <= zahlwert 

+    CASE  6 : operandzahlwert >= zahlwert 

+    CASE  8 : operandzahlwert <> zahlwert 

+    CASE  9 : operandtextwert =  textwert 

+    CASE 10 : operandtextwert >  textwert 

+    CASE 11 : operandtextwert <  textwert 

+    CASE 12 : operandtextwert <= textwert 

+    CASE 14 : operandtextwert >= textwert 

+    CASE 16 : operandtextwert <> textwert 

+    OTHERWISE fehler

+  END SELECT .

+ 

+END PROC bedingung; 

+ 

+(****************************  a u s d r u c k  ****************************)

+ 

+BOOL PROC ausdruck (DATEI VAR datei) : 

+  INT VAR opcode, operandtyp, operandzahlwert;

+  TEXT VAR operandtextwert;

+  IF   primary (datei)

+  THEN BOOL VAR war operation :: TRUE;

+       WHILE operator AND war operation

+       REP IF   primary (datei)

+           THEN war operation := operator verarbeiten

+           ELSE war operation := FALSE

+           FI

+       PER;

+       war operation

+  ELSE fehler

+  FI .

+ 

+operator :

+  IF   kommandoende

+  THEN IF   typ = integer

+       THEN row (datei)

+       ELIF typ = texttyp

+       THEN search (datei)

+       FI

+  FI;

+  opcode := pos (op2namen, "&" + symbol);

+  IF   opcode = 0

+  THEN FALSE

+  ELSE nextsymbol; operandtyp := typ;

+       operandzahlwert := zahlwert;

+       operandtextwert := textwert;

+       NOT war fehler

+  FI .

+ 

+operator verarbeiten :

+  SELECT opcode OF

+    CASE plus :

+         IF   typ = integer

+         THEN zahlwert := operandzahlwert + zahlwert

+         ELSE textwert := operandtextwert + textwert

+         FI

+    CASE minus : 

+         zahlwert := operandzahlwert - zahlwert

+    CASE mal :

+         IF   typ = integer

+         THEN zahlwert := operandzahlwert * zahlwert

+         ELSE textwert := operandzahlwert * textwert

+         FI

+    CASE durch :

+         zahlwert := operandzahlwert DIV zahlwert

+    CASE changecode : 

+         change

+    CASE semicolon : 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  NOT war fehler .

+ 

+change : 

+  IF   bildmarke <= 0 AND schreiberlaubnis AND bildstelle <> dateianker

+  THEN ersatz := textwert; textwert := operandtextwert; search (datei);

+       INT VAR fstelle :: feldstelle;

+       IF   textwert = "" AND ersatz <> "" AND fstelle > LENGTH inhalt 

+       THEN inhalt := text (inhalt, fstelle-1)

+       FI;

+       IF   subtext (inhalt, fstelle-LENGTH textwert, fstelle-1) = textwert 

+       THEN fstelle := fstelle - LENGTH textwert; 

+            FOR j FROM 1 UPTO LENGTH ersatz 

+            REP IF   j <=  LENGTH textwert 

+                THEN replace     (inhalt, fstelle, ersatz SUB j) 

+                ELSE insert char (inhalt, ersatz SUB j, fstelle)

+                FI;

+                fstelle INCR 1

+            PER;

+            FOR j FROM 1+LENGTH ersatz UPTO LENGTH textwert 

+            REP delete char (inhalt, fstelle) PER;

+       FI;

+       feldstelle (fstelle); typ := void

+  ELSE fehler bearbeiten

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+kommandoende :

+  SELECT pos (";FIELSEENDREPEATUNTIL", symbol) OF

+    CASE 1,2,4,8,17 : TRUE

+    OTHERWISE symboltyp = eol

+  END SELECT .

+ 

+END PROC ausdruck;

+ 

+(************************** schrott ****************************************)

+ 

+PROC satz erzeugen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 291 ;

+END  PROC satz erzeugen; 

+ 

+PROC satz loeschen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+END PACKET dateieditorpaket;

diff --git a/system/base/unknown/src/editor b/system/base/unknown/src/editor
new file mode 100644
index 0000000..63f2f19
--- /dev/null
+++ b/system/base/unknown/src/editor
@@ -0,0 +1,210 @@
+ 

+PACKET editor DEFINES                          (* Autor: P.Heyderhoff *) 

+                                               (* Stand: 26.04.82     *) 

+    edit ,                                     (* Vers.: 1.6.3        *)

+    show ,

+    editmode :

+ 

+FILE VAR file 1, file 2 ;

+ 

+PROC edit (FILE VAR file) :

+  x edit (file) ;

+ENDPROC edit ;

+ 

+PROC edit (FILE VAR file 1, file 2) :

+  x edit (file 1, file 2 )

+ENDPROC edit ;

+ 

+PROC edit (TEXT CONST file name) :

+  last param (file name) ;

+  IF exists (file name)

+    THEN edit 1 (file name)

+  ELIF yes ("neue datei einrichten")

+    THEN edit 1 (file name)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit ;

+ 

+PROC edit :

+  edit (last param)

+ENDPROC edit ;

+ 

+PROC edit 1 (TEXT CONST name) :

+  file 1 := sequential file (modify, name) ;

+  IF NOT is error

+    THEN edit (file 1)

+  FI

+ENDPROC edit 1 ;

+ 

+PROC edit (TEXT CONST file name 1, file name 2) :

+  IF exists (file name 1)

+    THEN edit 2 (file name 1, file name 2)

+  ELIF yes ("erste datei neu einrichten")

+    THEN edit 2 (file name 1, file name 2)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit ;

+ 

+PROC edit 2 (TEXT CONST file name 1, file name 2) :

+  file 1 := sequential file (modify, file name 1) ;

+  IF exists (file name 2)

+    THEN file 2 := sequential file (modify, file name 2) ;

+         edit (file 1, file 2)

+  ELIF yes ("zweite datei neu einrichten")

+    THEN file 2 := sequential file (modify, file name 2) ;

+         edit (file 1, file 2)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit 2 ;

+ 

+PROC show (FILE VAR file) :

+  schreiberlaubnis (FALSE) ;

+  edit (file) ;

+  schreiberlaubnis (TRUE)

+ENDPROC show ;

+ 

+PROC show (TEXT CONST file name) :

+  IF exists (file name)

+    THEN file 1 := sequential file (modify, file name) ;

+         show (file 1) ;

+    ELSE errorstop ("file does not exist")

+  FI

+ENDPROC show ;

+ 

+PROC editmode :

+  feldwortweise (NOT feldwortweise) ;

+  say ("      ") ;

+  IF feldwortweise

+    THEN say ("Fließtext"13""10"")

+    ELSE say ("kein Umbruch"13""10"")

+  FI .

+

+ENDPROC editmode ;

+

+ 

+(******************************  e d i t o r  ******************************)

+ 

+LET DATEI = ROW 4075 STRUCT (INT nachfolger, vorgaenger, index,

+                            fortsetzung, TEXT inhalt),

+    freianker = 1, dateianker = 2, satzmax = 4075,

+    bottom = ""6""23""0"" , escape = ""27"", escape w = ""27"w";

+ 

+BOOL VAR war kein wechsel ;

+TEXT VAR tabulator :: 77*" ";

+ 

+ 

+PROC editor (DATEI VAR datei) : 

+  enable stop ;

+  grundzustand;

+  zustand aus datei holen ; 

+ 

+  REP b i l d   e d i t o r  (datei);

+      d a t e i e d i t o r  (datei)

+  UNTIL (feldkommando SUB 1) = escape

+  PER;

+  war kein wechsel := (feldkommando SUB 2) <> "w";

+  feldkommando (subtext (feldkommando, 3));

+ 

+  IF schreiberlaubnis THEN zustand in datei retten FI;

+  schreiberlaubnis (TRUE);

+  out (bottom) .

+ 

+grundzustand :

+  bildneu (TRUE); bildeinfuegen (FALSE); bildmarke (0);

+  feldmarke (0); feldseparator (""); feldstelle(1);

+  feldeinfuegen (FALSE).

+ 

+zustand in datei retten : 

+  inhalt :=  text (bildstelle, 5);

+  inhalt CAT text (bildsatz,   5);

+  inhalt CAT text (bildzeile,  5);

+  inhalt CAT text (feldlimit,  5);

+  feldtab (tabulator);

+  inhalt CAT tabulator .

+ 

+zustand aus datei holen :

+  INT CONST satz nr := int (subtext (inhalt, 1, 5)) ;

+  IF satz nr > 0

+    THEN bildstelle (satz nr)

+    ELSE bildstelle (datei (dateianker).nachfolger)

+  FI ;

+  bildsatz   (int (subtext (inhalt, 6, 10)));

+  bildzeile  (int (subtext (inhalt, 11, 15)));

+  feldlimit  (int (subtext (inhalt, 16, 20)));

+  tabulator := subtext (inhalt, 21) ; 

+  feldtabulator (tabulator) .

+ 

+inhalt :

+  datei (freianker).inhalt . 

+ 

+END PROC editor;

+ 

+PROC y edit (DATEI VAR datei) :

+  editor (datei);

+  close

+END PROC y edit;

+ 

+LET begin mark = ""15"", endmark blank = ""14"  ";

+ 

+PROC y edit (DATEI VAR erste datei, zweite datei) :

+  INT CONST alte laenge := bildlaenge - 1;

+  INT VAR laenge := alte laenge DIV 2, flen := feldende - feldanfang + 2;

+  bildlaenge (laenge); feldkommando (escape w);

+  zweimal editieren;

+  bildlaenge (alte laenge + 1); bildrand (0);

+  close .

+ 

+zweimal editieren:

+  page;

+  REP cursor (  1, laenge + 2); out (begin mark);

+      cursor(flen, laenge + 2); out (endmark blank); 

+      bildrand (0); editor (erste datei); laenge anpassen;

+      IF war kein wechsel THEN LEAVE zweimal editieren FI;

+      bildrand (alte laenge + 1 - laenge); 

+      editor (zweite datei); laenge anpassen

+  UNTIL war kein wechsel

+  PER .

+ 

+laenge anpassen :

+  laenge := bildlaenge;

+  IF laenge = 1 THEN laenge := 2 FI;

+  IF   laenge <= alte laenge - 2

+  THEN laenge := alte laenge - laenge

+  ELSE laenge := 2

+  FI ; bildlaenge (laenge) .

+END PROC y edit;

+ 

+(**************** schrott ***********************)

+ 

+PROC x edit (FILE VAR f) :

+  EXTERNAL 296

+ENDPROC x edit ;

+ 

+PROC x edit (FILE VAR f1, f2) :

+  EXTERNAL 297

+ENDPROC x edit ;

+ 

+LET FDATEI= STRUCT ( BOUND DATEI f ,

+                     INT index, pointer, line counter,

+                         mode, max line length, max page length,

+                     BOOL edit status unchanged) ;

+ 

+PROC x edit (FDATEI VAR f1) :

+  INTERNAL 296 ;

+  y edit (CONCR (f1.f))

+ENDPROC x edit ; 

+ 

+PROC x edit (FDATEI VAR f1, f2) :

+  INTERNAL 297 ;

+  y edit (CONCR (f1.f), CONCR (f2.f))

+ENDPROC x edit ;

+ 

+PROC dateieditor (DATEI VAR d) :

+  EXTERNAL 295

+ENDPROC dateieditor ;

+ 

+PROC bildeditor (DATEI VAR d) :

+  EXTERNAL 293

+ENDPROC bildeditor ;

+ 

+ENDPACKET editor ;

diff --git a/system/base/unknown/src/elan b/system/base/unknown/src/elan
new file mode 100644
index 0000000..744003d
--- /dev/null
+++ b/system/base/unknown/src/elan
@@ -0,0 +1,245 @@
+ 

+PACKET local manager part 2 DEFINES            (* Autor: J.Liedtke *)

+                                               (* Stand: 29.04.80  *)

+  list ,

+  file names :

+ 

+ 

+FILE VAR list file ;

+TEXT VAR file name, status text;

+ 

+PROC list :

+ 

+  list file := sequential file (output) ;

+  headline (list file, "list") ;

+  list (list file) ;

+  show (list file) ;

+  close

+ 

+ENDPROC list ;

+ 

+PROC list (FILE VAR f) :

+ 

+  begin list ;

+  putline (f, "") ;

+  REP

+    get list entry (file name, status text) ;

+    IF file name = ""

+      THEN LEAVE list

+    FI ;

+    out (f, status text + "  """ ) ;

+    out (f, file name) ;

+    out (f, """") ;

+    line (f)

+  PER

+ 

+ENDPROC list ;

+ 

+PROC file names (FILE VAR f) :

+ 

+  begin list ;

+  REP

+    get list entry (file name, status text) ;

+    IF file name = ""

+      THEN LEAVE file names

+    FI ;

+    putline (f, file name)

+  PER

+ 

+ENDPROC file names ;

+

+ENDPACKET local manager part 2 ;

+ 

+ 

+PACKET elan DEFINES                               (*Autor: J.Liedtke *)

+                                                  (*Stand: 01.05.82  *)

+    do ,

+    run ,

+    run again ,

+    insert ,

+    prot ,

+    prot off ,

+    check on ,

+    check off :

+ 

+ 

+LET newinit option = FALSE ,

+    ins = TRUE ,

+    no ins = FALSE ,

+    lst = TRUE ,

+    no lst = FALSE ,

+    compiler dump option = FALSE ,

+    sys option = TRUE ,

+    stop at first error = TRUE ,

+    multiple error analysis = FALSE ,

+    sermon = TRUE ,

+    no sermon = FALSE ,

+

+    run again mode = 0 ,

+    compile file mode = 1 ,

+    compile line mode = 2 ,

+

+    error message = 4 ;

+

+BOOL VAR list option := FALSE ,

+         check option := TRUE ,

+         errors occurred ;

+

+INT VAR run again mod nr := 0 ;

+DATASPACE VAR ds ;

+

+FILE VAR error file, source file ;

+ 

+ 

+PROC do (TEXT CONST command) :

+

+  INT VAR dummy mod ;

+  run again mod nr := 0 ;

+  errors occurred := FALSE ;

+  elan (compile line mode, ds, command, dummy mod,

+        newinit option, no ins, compiler dump option, no lst, sys option,

+        check option, stop at first error, no sermon) ;

+  IF errors occurred

+    THEN forget (ds) ;

+         errorstop ("")

+  FI

+ 

+ENDPROC do ;

+ 

+ 

+PROC run (TEXT CONST file name) : 

+ 

+  last param (file name) ;

+  run elan (file name, no ins)

+ 

+END PROC run;

+ 

+PROC run :

+ 

+  run (last param)

+ 

+ENDPROC run ;

+ 

+PROC run again :

+ 

+  IF run again mod nr > 0

+    THEN INT VAR mod := run again mod nr ;

+         elan (run again mode, ds, "", run again mod nr,

+               newinit option, no ins, compiler dump option, no lst, 

+               sys option, check option, stop at first error, no sermon)

+    ELSE errorstop ("run again impossible")

+  FI

+ 

+ENDPROC run again ;

+ 

+PROC insert (TEXT CONST file name) : 

+ 

+  last param (file name) ;

+  run elan (file name, ins)

+ 

+ENDPROC insert ;

+ 

+PROC insert :

+ 

+  insert (last param)

+ 

+ENDPROC insert ;

+ 

+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :

+

+  IF exists (file name)

+    THEN compile and execute

+    ELSE errorstop ("file does not exist")

+  FI .

+

+compile and execute :

+  disable stop ;

+  errors occurred := FALSE ;

+  elan (compile file mode, old (file name, 1002), "" , run again mod nr,

+        newinit option, insert option, compiler dump option, list option,

+        sys option, check option, multiple error analysis, sermon) ;

+ 

+  IF errors occurred

+    THEN ignore halt during compiling ;

+         errors occurred := FALSE ;

+         enable stop ;

+         source file := sequential file (modify, file name) ;

+         modify (error file) ;

+         edit (error file, source file) ;

+         forget (ds)

+  FI .

+

+ignore halt during compiling :

+  IF is error

+    THEN put error ;

+         clear error ;

+         pause (5)

+  FI .

+

+ENDPROC run elan ;

+

+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 

+           INT VAR start module number,

+           BOOL CONST newinit, ins, dump, lst, sys, rt check, error1, ser) :

+  EXTERNAL 256

+ENDPROC elan ;

+

+PROC out text (TEXT CONST text, INT CONST out type) :

+

+  INTERNAL 257 ;

+  out (text) ;

+  IF out type = error message 

+    THEN access error file ;

+         out (error file, text)

+  FI .

+ 

+access error file :

+  IF NOT errors occurred

+    THEN open error file

+  FI .

+

+ENDPROC out text ;

+

+PROC out line (INT CONST out type) :

+

+  INTERNAL 258 ;

+  out (""13""10"") ;

+  IF out type = error message

+    THEN access error file ;

+         line (error file)

+  FI .

+

+access error file :

+  IF NOT errors occurred

+    THEN open error file

+  FI .

+

+ENDPROC out line ;

+

+PROC open error file :

+

+  errors occurred := TRUE ;

+  forget (ds) ;

+  ds := nilspace ;

+  error file := sequential file (output, ds) ;

+  headline (error file, "errors")

+

+ENDPROC open error file ;

+

+PROC prot :

+  list option := TRUE

+ENDPROC prot ;

+ 

+PROC prot off :

+  list option := FALSE

+ENDPROC prot off ;

+ 

+PROC check on :

+  check option := TRUE

+ENDPROC check on ;

+ 

+PROC check off :

+  check option := FALSE

+ENDPROC check off ;

+ 

+ENDPACKET elan ;

diff --git a/system/base/unknown/src/feldeditor b/system/base/unknown/src/feldeditor
new file mode 100644
index 0000000..4156111
--- /dev/null
+++ b/system/base/unknown/src/feldeditor
@@ -0,0 +1,747 @@
+ 

+PACKET  f e l d e d i t o r  DEFINES              (* Autor: P.Heyderhoff *)

+        (*****************)                       (* Stand: 12.04.82     *)

+                                                  (* Vers.: 1.6.0        *)

+        editget,

+        feldeditor,

+        feldout,

+        feldposition,

+        feldeinruecken,

+        feldtab,

+        feldtabulator,

+        feldseparator,

+        feldmarke,

+        feldstelle,

+        feldwortweise,

+        feldanfang,

+        feldende,

+        feldrand,

+        feldlimit,

+        feldaudit,

+        feldzeichen,

+        feldkommando,

+        feldeinfuegen,

+        feldlernmodus,

+        is incharety,

+        getchar,

+        min :

+ 

+ 

+TEXT VAR tabulator :: "", separator :: "", fzeichen ::"",

+         kommando  :: "", audit     :: "";

+ 

+INT  VAR fmarke  ::  0, fstelle :: 1, frand :: 0, limit :: 77,

+         fanfang ::  1, dyn fanfang :: fanfang,  flaenge, fj,

+         fende   :: 77, dyn fende   :: fende, dezimalen :: 0;

+ 

+BOOL VAR wortweise      :: FALSE, feinfuegen :: FALSE,

+         blankseparator :: FALSE, lernmodus  :: FALSE,

+         war absatz; 

+ 

+LET blank = " ", hop=""1"", right=""2"", up=""3"", clear eop=""4"",

+    clear eol=""5"", bell=""7"", left=""8"", tab=""9"", down=""10"",

+    rubin=""11"", rubout=""12"", cr=""13"", mark=""16"", escape=""27"",

+    hoechstes steuerzeichen=""31"", dach=""94"", end mark=""14"", begin

+    mark=""15"", clear=""1""4"", hop tab=""1""9"", hop rubin=""1""11"",

+    hop rubout=""1""12"", hop cr=""1""13"", cr down=""13""10"",

+    right left tab rubout escape = ""2""8""9""12""27"", hop escape=""1""27"",

+    left left=""8""8"", left endmark=""8""14"", endmark left=""14""8"",

+    left right=""8""2"", blank left=" "8"",

+    blank left rubout=" "8""12"", absatzmarke=""15""14"", 

+    hop esc right left tab rubin rubout cr = ""1""27""2""8""9""11""12""13"",

+    hop esc right left tab down cr         = ""1""27""2""8""9""10""13"";

+ 

+(***************************  p r o z e d u r e n  *************************)

+ 

+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editfende):

+ 

+  disable stop ;  (* J.Liedtke 10.02.82 *)

+

+  INT CONST altflaenge :: LENGTH editsatz, altfrand :: frand,

+            altfmarke  :: fmarke, altfstelle :: fstelle,

+            altfanfang :: fanfang, altfende  :: fende, altlimit :: limit;

+  BOOL CONST altwortweise :: wortweise, altfeinfuegen :: feinfuegen;

+  fmarke := 0; fstelle := 1; fanfang := 1; dyn fanfang := 1; 

+  fende  := editfende MOD 256; dyn fende := fende;

+  limit  := editlimit MOD 256; wortweise := FALSE;

+  feinfuegen := FALSE; 

+  INT VAR x, y; get cursor (x,y); frand := x-1; 

+  out (editsatz);   cursor (x,y); 

+  REP

+    feldeditor (editsatz);

+    IF   (kommando SUB 1) = escape OR (kommando SUB 1) = hop 

+    THEN delete char (kommando, 1)

+    FI;

+    delete char (kommando, 1) 

+  UNTIL fzeichen = cr OR (fzeichen SUB 1) = separator OR is error

+  PER;

+  cursor (x + 1 + editflaenge - dyn fanfang, y); 

+  fmarke := altfmarke;  fstelle := altfstelle; fanfang := altfanfang;

+  dyn fanfang := fanfang; fende := altfende; dyn fende := fende;

+  limit := altlimit;  wortweise := altwortweise; frand := altfrand;

+  feinfuegen := altfeinfuegen . 

+ 

+editflaenge :

+  min (dyn fende, flaenge) .

+ 

+END PROC editget;

+ 

+PROC editget (TEXT VAR editsatz) :

+  INT VAR x, y; get cursor (x,y);

+  editget (editsatz, 255, fende-fanfang+2+frand-x)

+END PROC editget;

+ 

+PROC feldout (TEXT CONST satz) :

+  INT VAR x, y;

+  flaenge := min (fende, LENGTH satz);

+  out (cr);

+  frand TIMESOUT right; feldrest loeschen (fanfang);

+  IF   fmarke > 0

+  THEN outsubtext (satz, fanfang, fmarke-1); out (begin mark);

+       outsubtext (satz, fmarke, min (fstelle-1,flaenge));

+       out (end mark); outsubtext (satz, fstelle, flaenge);

+  ELIF absatzmarke noetig (satz) 

+  THEN get cursor (x,y); outsubtext (satz, fanfang, flaenge); 

+       cursor (x + fende + 1 - fanfang, y); out (absatzmarke)

+  ELSE outsubtext (satz, fanfang, flaenge)

+  FI

+END PROC feldout;

+ 

+ 

+PROC feld einruecken (TEXT CONST satz) :

+ 

+  IF   fstelle = fanfang

+  THEN fstelle := neue einrueckposition;

+       (fstelle-fanfang) TIMESOUT right

+  FI .

+ 

+neue einrueckposition :

+  INT VAR suchindex;

+  FOR suchindex FROM fanfang UPTO min (LENGTH satz, fende)

+  REP  IF   (satz SUB suchindex) <> blank

+       THEN LEAVE neue einrueckposition WITH suchindex

+       FI

+  PER;

+  fanfang .

+ 

+END PROC feld einruecken;

+ 

+TEXT PROC feldzeichen :

+  fzeichen

+END PROC feldzeichen;

+ 

+TEXT PROC feldkommando :

+  kommando

+END PROC feldkommando;

+ 

+PROC feldkommando (TEXT CONST t) :

+  kommando := t

+END PROC feldkommando;

+ 

+PROC feldtab (TEXT VAR t) :

+  t := tabulator

+END PROC feldtab;

+ 

+PROC feldtabulator (TEXT CONST t) :

+  tabulator := t

+END PROC feldtabulator;

+ 

+TEXT PROC feldseparator :

+  separator

+END PROC feldseparator;

+ 

+PROC feldseparator (TEXT CONST t) :

+  separator := t; blankseparator := t = blank

+END PROC feldseparator;

+ 

+TEXT PROC feldaudit :

+  audit

+END PROC feldaudit;

+ 

+PROC feldaudit (TEXT CONST a) :

+  audit := a

+END PROC feldaudit;

+ 

+BOOL PROC feldlernmodus :

+  lernmodus

+END PROC feldlernmodus;

+ 

+PROC feldlernmodus (BOOL CONST b) :

+  lernmodus := b 

+END PROC feldlernmodus;

+ 

+BOOL PROC feldeinfuegen :

+  feinfuegen

+END PROC feldeinfuegen;

+ 

+PROC feldeinfuegen (BOOL CONST b):

+  feinfuegen := b

+END PROC feldeinfuegen;

+ 

+BOOL PROC feldwortweise :

+  wortweise

+END PROC feldwortweise;

+ 

+PROC feldwortweise (BOOL CONST b) :

+  wortweise := b

+END PROC feldwortweise;

+ 

+INT PROC feldmarke :

+  fmarke

+END PROC feldmarke;

+ 

+PROC feldmarke (INT CONST i) :

+  fmarke  := i MOD 256

+END PROC feldmarke;

+ 

+INT PROC feldstelle :

+  fstelle

+END PROC feldstelle;

+ 

+PROC feldstelle (INT CONST i) :

+  fstelle := i MOD 256

+END PROC feldstelle;

+ 

+INT PROC feldanfang :

+  fanfang

+END PROC feldanfang;

+ 

+PROC feldanfang (INT CONST i) :

+  fanfang := i MOD 256; dyn fanfang := fanfang

+END PROC feldanfang;

+ 

+INT PROC feldende :

+  fende

+END PROC feldende;

+ 

+PROC feldende (INT CONST i) :

+  fende := i MOD 256; dyn fende := fende

+END PROC feldende;

+ 

+INT PROC feldrand :

+  frand

+END PROC feldrand;

+ 

+PROC feldrand (INT CONST i) :

+  frand := i MOD 256

+END PROC feldrand;

+ 

+INT PROC feldlimit :

+  limit

+END PROC feldlimit;

+ 

+PROC feldlimit (INT CONST i) :

+  limit := i MOD 256

+END PROC feldlimit;

+ 

+PROC feldposition :

+  INT VAR x, y;

+  IF   fstelle <= fende

+  THEN IF   fstelle < fanfang

+       THEN fstelle := fanfang;

+            IF fanfang > fende

+            THEN fende := fanfang; dyn fende := fanfang

+            FI

+       FI

+  ELSE fstelle := fende;

+       IF   fanfang > fende

+       THEN fanfang := fende; dyn fanfang := fende

+       FI

+  FI;

+  get cursor(x,y); cursor(1+frand+fstelle-fanfang+fmarke oder fstelle, y). 

+ 

+fmarke oder fstelle :

+  IF fmarke > 0 THEN 1 ELSE 0 FI .

+ 

+END PROC feldposition;

+ 

+PROC feldposition (INT CONST i) :

+  fstelle := i; feldposition

+END PROC feldposition;

+ 

+BOOL PROC absatzmarke noetig (TEXT CONST satz) : 

+ 

+  IF   wortweise

+  THEN (satz SUB LENGTH satz) = blank 

+  ELSE FALSE

+  FI

+END PROC absatzmarke noetig;

+ 

+PROC zeile neu schreiben (TEXT CONST satz) :

+  INT VAR x,y; get cursor (x,y);

+  flaenge := min (dyn fende, LENGTH satz);

+  cursor (1+frand, y);

+  feldrest loeschen (dyn fanfang);

+  outsubtext (satz, dyn fanfang, flaenge);

+  cursor (x,y)

+END PROC zeile neu schreiben;

+ 

+PROC feldrest loeschen (INT CONST fstelle):

+  INT VAR x,y;

+  IF   frand + fende <= 76

+  THEN get cursor (x,y); (1 + dyn fende - fstelle) TIMESOUT blank;

+       cursor (x,y)

+  ELSE out (clear eol); war absatz := FALSE 

+  FI

+END PROC feldrest loeschen;

+ 

+TEXT OP SUBB (TEXT CONST t, INT CONST i) :

+  IF i <= LENGTH t THEN t SUB i ELSE blank FI

+END OP SUBB;

+ 

+INT PROC min (INT CONST a, b):

+  IF a < b THEN a ELSE b FI

+END PROC min;

+ 

+BOOL PROC is incharety (TEXT CONST muster) :

+ 

+  fzeichen := incharety; 

+  IF   fzeichen = ""

+  THEN FALSE

+  ELSE IF   lernmodus 

+       THEN audit CAT fzeichen;

+            IF fzeichen = """" THEN audit CAT fzeichen

+       FI   FI ;

+       IF   fzeichen = muster 

+       THEN kommando := ""; TRUE

+       ELSE kommando CAT fzeichen; FALSE

+  FI   FI

+END PROC is incharety; 

+ 

+PROC getchar (TEXT VAR fzeichen) :

+ 

+  IF   kommando = ""

+  THEN inchar (fzeichen)

+  ELSE fzeichen := kommando SUB 1;

+       delete char (kommando, 1);

+       kommando CAT incharety

+  FI;

+  IF   lernmodus

+  THEN audit CAT fzeichen;

+       IF   fzeichen = """"

+       THEN audit CAT fzeichen

+       FI

+  FI .

+END PROC getchar;

+ 

+ 

+(**************************  f e l d e d i t o r  **************************)

+ 

+PROC feldeditor (TEXT VAR satz) :

+

+  enable stop ; (* J. Liedtke 10.02.82 *)

+

+  INT VAR x, y;

+  BOOL VAR inkompetent :: FALSE; war absatz := absatzmarke noetig (satz);

+  IF   fstelle <= fende 

+  THEN IF fstelle < fanfang THEN feldposition FI

+  ELSE feldposition

+  FI;

+  flaenge := min (fende, LENGTH satz);

+ 

+  REP  e i n g a b e  UNTIL inkompetent PER;

+ 

+  blanks abschneiden;

+  IF dyn fanfang <> fanfang THEN zurechtruecken FI;

+  IF   NOT war absatz AND absatzmarke noetig (satz) 

+  THEN absatzmarke schreiben

+  ELIF war absatz AND NOT absatzmarke noetig (satz)

+  THEN absatzmarke loeschen

+  FI .

+ 

+absatzmarke schreiben : 

+  get cursor (x,y); cursor (frand+fende-fanfang+2, y); out (absatzmarke);

+  cursor (x,y) .

+ 

+absatzmarke loeschen : 

+  get cursor (x,y); cursor (frand+fende-fanfang+2, y); out ("  ");

+  cursor (x,y) .

+ 

+zurechtruecken :

+  fstelle DECR (dyn fanfang - fanfang);

+  dyn fanfang := fanfang; dyn fende := fende;

+  zeile neu schreiben (satz) .

+ 

+blanks abschneiden :

+  flaenge := LENGTH satz;

+  FOR fj FROM flaenge DOWNTO 0 WHILE (satz SUB fj) = blank

+  REP delete char (satz, fj) PER;

+  IF fj < flaenge THEN satz CAT blank FI .

+ 

+eingabe :

+  IF   fmarke <= 0

+  THEN s c h r e i b e d i t o r;

+       IF   ueberlaufbedingung

+       THEN ueberlauf

+       ELSE a u s f u e h r e n

+       FI

+  ELSE m a r k e d i t o r

+  FI .

+ 

+ueberlaufbedingung :

+  IF   fstelle <= dyn fende

+  THEN IF   fstelle <= limit

+       THEN FALSE

+       ELSE fzeichen > hoechstes steuerzeichen

+       FI

+  ELSE TRUE

+  FI .

+ 

+ueberlauf :

+  IF   fstelle > limit

+  THEN IF   wortweise OR fstelle > LENGTH satz

+       THEN ueberlauf in naechste zeile; LEAVE ueberlauf

+       FI

+  FI;

+  IF   fstelle >  dyn fende

+  THEN fstelle := dyn fende; out (left);

+       zeile um eins nach links verschieben

+  FI .

+ 

+ueberlauf in naechste zeile :

+  IF   wortweise

+  THEN umbrechen

+  ELSE out (bell); kommando := cr

+  FI;

+  inkompetent := TRUE .

+ 

+umbrechen :

+  IF   LENGTH satz > limit

+  THEN kommando CAT  subtext (satz, limit+1);

+       FOR fj FROM LENGTH satz DOWNTO fstelle

+       REP kommando CAT left PER;

+       satz := subtext (satz, 1, limit)

+  FI;

+  fj := limit;

+  zeichen zuruecknehmen;

+  (fstelle-fj) TIMESOUT left; fstelle := fj; feldrest loeschen (fstelle);

+  IF kommando = "" THEN kommando := blank left rubout FI;

+  blanks loeschen.

+ 

+blanks loeschen: 

+  REP   fj DECR 1;

+        IF (satz SUB fj) <> blank THEN LEAVE blanks loeschen FI;

+        delete char (satz, fj)

+  PER .

+ 

+zeichen zuruecknehmen: 

+  REP   fzeichen := satz SUB fj; delete char (satz, fj);

+        IF fzeichen = blank THEN LEAVE zeichen zuruecknehmen FI;

+        insert char (kommando, fzeichen, 1);

+        IF fj = fanfang     THEN LEAVE zeichen zuruecknehmen FI;

+        fj DECR1

+  PER.

+ 

+ausfuehren :

+  dezimalen := 0;

+  SELECT pos (hop esc right left tab rubin rubout cr, fzeichen) OF

+    CASE 1 : getchar (fzeichen);

+             SELECT pos (right left tab rubout escape, fzeichen) OF

+               CASE 1 : zum rechten frand

+               CASE 2 : zum linken  frand

+               CASE 3 : tabulator setzen

+               CASE 4 : zeile loeschen

+               CASE 5 : bei lernmodus ein zeichen lesen

+               OTHERWISE hop return

+             END SELECT

+    CASE 2 : escape aktion

+    CASE 3 : nach rechts

+    CASE 4 : nach links

+    CASE 5 : nach tabulator

+    CASE 6 : feinfuegen umschalten

+    CASE 7 : ausfuegen

+    CASE 8 : ggf absatz erzeugen; return

+    OTHERWISE return

+  END SELECT .

+ 

+ggf absatz erzeugen : 

+  IF   wortweise

+  THEN IF   fstelle > LENGTH satz

+       THEN IF   (satz SUB LENGTH satz) <> blank

+            THEN satz CAT blank; fstelle INCR 1

+            FI

+       FI

+  FI .

+ 

+nach rechts :

+  IF   fstelle < dyn fende AND (fstelle < limit OR fstelle < flaenge)

+  THEN out (right); fstelle INCR1

+  ELIF LENGTH satz > dyn fende

+  THEN zeile um eins nach links verschieben

+  ELSE return

+  FI .

+ 

+nach links :

+  IF   fstelle > dyn fanfang

+  THEN out (left); fstelle DECR1

+  ELIF dyn fanfang = fanfang

+  THEN out (bell)

+  ELSE zeile um eins nach rechts verschieben

+  FI .

+ 

+bei lernmodus ein zeichen lesen :

+  IF   lernmodus

+  THEN getchar (fzeichen); return;

+       fzeichen := escape

+  FI;

+  hop return; fzeichen := hop escape .

+ 

+zeile um eins nach links  verschieben :

+  dyn fanfang INCR 1; dyn fende INCR 1;

+  fstelle := dyn fende; zeile neu schreiben (satz) .

+ 

+zeile um eins nach rechts verschieben :

+  dyn fanfang DECR 1; dyn fende DECR 1;

+  fstelle := dyn fanfang; zeile neu schreiben (satz) .

+ 

+feinfuegen umschalten :

+  IF   feinfuegen

+  THEN feinfuegen := FALSE

+  ELSE feinfuegen := TRUE; get cursor (x,y); out (dach);

+       outsubtext (satz, fstelle, flaenge);

+       cursor (x,y); pause (1); 

+       feldrest loeschen (fstelle);

+       outsubtext (satz, fstelle, flaenge);

+       cursor (x,y) 

+  FI;

+  return .

+ 

+ausfuegen :

+  IF   flaenge < dyn fanfang OR fstelle > flaenge

+  THEN IF   fstelle = flaenge + 1 AND fstelle > dyn fanfang 

+       THEN fstelle := flaenge; out (left)

+       ELSE out (bell);

+            LEAVE ausfuegen

+       FI

+  FI;

+  ausfuegeoperation; delete char (satz, fstelle);

+  flaenge := min (dyn fende, LENGTH satz) .

+ 

+ausfuegeoperation :

+  get cursor (x,y); outsubtext (satz, fstelle+1, flaenge+1);

+  out (blank); cursor (x,y) .

+ 

+zum linken frand :

+  IF   fstelle > fanfang

+  THEN get cursor (x,y); cursor (1+frand, y); 

+       IF   dyn fanfang = fanfang

+       THEN fstelle := fanfang

+       ELSE verschieben an linken frand

+       FI

+  FI .

+ 

+zum rechten frand :

+  fj := min (dyn fende, limit); get cursor (x,y);

+  IF   LENGTH satz >  fj

+  THEN IF   fstelle >= LENGTH satz

+       THEN out (bell)

+       ELIF LENGTH satz > dyn fende

+       THEN verschieben an rechten frand

+       ELSE cursor (x + LENGTH satz - fstelle, y);

+            fstelle := LENGTH satz

+       FI

+  ELIF fstelle < fj

+  THEN cursor (x + fj-fstelle, y); fstelle := fj

+  FI .

+ 

+verschieben an linken  frand :

+  dyn fanfang := fanfang; dyn fende := fende;

+  fstelle := fanfang; zeile neu schreiben (satz).

+ 

+verschieben an rechten frand :

+  (dyn fende - fstelle) TIMESOUT right;

+  dyn fanfang INCR (LENGTH satz - dyn fende); dyn fende := LENGTH satz;

+  fstelle := dyn fende; zeile neu schreiben (satz).

+ 

+nach tabulator :

+  fj := pos (tabulator, "^", fstelle+1);

+  IF   fj = 0

+  THEN IF   (satz SUB fstelle) = blank AND fstelle = fanfang

+       THEN IF   satz = blank 

+            THEN fstelle INCR 1; out (right)

+            ELSE out (blank left); feld einruecken (satz);

+            FI;

+            LEAVE nach tabulator

+       ELIF flaenge < dyn fende AND fstelle <= flaenge

+       THEN fj := flaenge + 1

+       FI

+  ELSE dezimalen := 1

+  FI;

+  IF   fj > 0 AND fj <= dyn fende

+  THEN outsubtext (satz, fstelle, fj-1); fstelle := fj

+  ELSE (fstelle-dyn fanfang) TIMESOUT left;

+       fstelle := dyn fanfang; insert char (kommando, down, 1)

+  FI .

+ 

+tabulator setzen :

+  IF   (tabulator SUB fstelle) = "^"

+  THEN fzeichen := right

+  ELSE fzeichen := "^"

+  FI;

+  WHILE fstelle > LENGTH tabulator

+  REP  tabulator CAT right PER;

+  replace (tabulator, fstelle, fzeichen);

+  insert char (kommando,   tab, 1);

+  insert char (kommando, hop, 1);

+  inkompetent := TRUE .

+ 

+zeile loeschen :

+  IF   fstelle = 1 

+  THEN satz := ""; feldrest loeschen (fstelle); hop return

+  ELIF fstelle <= flaenge

+  THEN REP delete char (satz, LENGTH satz)

+       UNTIL fstelle > LENGTH satz

+       PER;

+       flaenge := fstelle - 1; feldrest loeschen (fstelle)

+  ELSE hop return

+  FI .

+ 

+(***********************  s c h r e i b e d i t o r  ***********************)

+ 

+schreibeditor :

+  REP   getchar (fzeichen);

+        IF   fzeichen <= hoechstes steuerzeichen THEN LEAVE schreibeditor

+        ELIF separator bedingung                 THEN LEAVE schreibeditor

+        ELSE f o r t s c h r e i b e n           FI 

+  PER .

+ 

+separatorbedingung :

+  IF   blankseparator

+  THEN IF   flaenge + 2 <= fstelle

+       THEN insert char (kommando, fzeichen, 1);

+            fzeichen := blank

+       FI

+  FI;

+  fzeichen = separator .

+ 

+fortschreiben :

+  IF   dezimalen > 0 THEN dezimaltabulator FI;

+  out (fzeichen);

+  IF   fstelle > flaenge

+  THEN anhaengen

+  ELIF dezimalen = 0 AND feinfuegen

+  THEN insert char (satz, fzeichen, fstelle)

+  ELSE replace     (satz, fstelle, fzeichen)

+  FI;

+  flaenge := min (dyn fende, LENGTH satz);

+  fstelle INCR 1;

+  IF   feinfuegen AND dezimalen = 0 AND fstelle <= flaenge

+  THEN zeilenrest neu schreiben

+  FI;

+  IF   fstelle > dyn fende

+  OR   fstelle > limit AND (wortweise OR fstelle > flaenge)

+  THEN LEAVE schreibeditor

+  FI .

+ 

+zeilenrest neu schreiben :

+  get cursor (x,y); outsubtext (satz, fstelle, flaenge); cursor (x,y) .

+ 

+dezimaltabulator :

+  IF   fzeichen < "0" OR fzeichen > "9"

+  THEN dezimalen := 0

+  ELIF dezimalen = 1

+  THEN IF   (satz SUB fstelle) = blank OR fstelle > flaenge

+       THEN dezimalen := 2

+       ELSE dezimalen := 0

+       FI

+  ELIF (satz SUB fstelle-dezimalen) = blank

+  THEN replace (satz, fstelle-dezimalen,

+                subtext (satz, fstelle-dezimalen+1, fstelle-1)) ;

+       dezimalen TIMESOUT left;

+       outsubtext (satz, fstelle-dezimalen, fstelle-2);

+       dezimalen INCR 1; fstelle DECR 1

+  ELSE dezimalen := 0

+  FI .

+ 

+anhaengen :

+  FOR fj FROM flaenge+2 UPTO fstelle

+  REP satz CAT blank PER;

+  satz CAT fzeichen .

+ 

+ 

+(**************************  m a r k e d i t o r  **************************)

+ 

+markeditor :

+  getchar (fzeichen);

+  SELECT pos (hop esc right left tab down cr, fzeichen) OF

+    CASE 1 : getchar (fzeichen);

+             IF   fzeichen = right THEN markierung maximal

+             ELIF fzeichen = left  THEN markierung minimal

+             ELSE hop return

+             FI

+    CASE 2 : escape aktion

+    CASE 3 : markierung verlaengern

+    CASE 4 : markierung verkuerzen

+    CASE 5 : markierung bis tab verlaengern

+    CASE 6,7 : zeilenrest markieren

+    OTHERWISE IF   fzeichen <= hoechstes steuerzeichen

+              THEN return

+              ELSE out (bell)

+              FI

+  END SELECT .

+ 

+markierung verlaengern :

+  IF   fstelle <= flaenge

+  THEN out (satz SUB fstelle, end mark left); fstelle INCR 1

+  ELSE return

+  FI .

+ 

+markierung maximal :

+  IF   fstelle <= flaenge

+  THEN outsubtext (satz, fstelle, flaenge); out (end mark left);

+       fstelle := flaenge + 1

+  FI .

+ 

+zeilenrest markieren :

+  IF   fstelle <= flaenge

+  THEN outsubtext (satz, fstelle, flaenge);

+       out (end mark left);

+       (flaenge-fstelle+2) TIMESOUT left

+  FI;

+  return .

+ 

+markierung verkuerzen :

+  IF   fstelle > fmarke

+  THEN fstelle DECR 1;

+       out (left end mark, satz SUBB fstelle, left left)

+  ELSE out (bell)

+  FI .

+ 

+markierung minimal :

+  IF   fstelle > fmarke

+  THEN (fstelle-fmarke) TIMESOUT left; out (end mark);

+       outsubtext (satz, fmarke, fstelle-1);

+       (fstelle-fmarke+1) TIMESOUT left; fstelle := fmarke

+  FI .

+ 

+markierung bis tab verlaengern :

+  fj := pos (tabulator, "^", fstelle + 1);

+  IF   fj = 0

+  THEN fj := flaenge - fstelle + 1; IF fj <= 0 THEN return FI

+  ELSE fj DECR fstelle

+  FI;

+  IF   fj > 0

+  THEN outsubtext (satz, fstelle, min (fstelle+fj-1, flaenge));

+       out (end mark left)

+  FI;

+  fstelle INCR fj;

+  IF fstelle > (dyn fende+1) THEN return FI .

+ 

+ 

+(******************* allgemein verwendete refinements *********************)

+ 

+return :

+  insert char (kommando, fzeichen, 1);

+  inkompetent := TRUE .

+ 

+hop return :

+  return; insert char (kommando, hop, 1) .

+ 

+escape aktion :

+  getchar (fzeichen); return;

+  insert char (kommando, escape, 1);

+  insert char (fzeichen, escape, 1) .

+ 

+END PROC feldeditor;

+ 

+END PACKET feldeditor;

diff --git a/system/base/unknown/src/file b/system/base/unknown/src/file
new file mode 100644
index 0000000..e556bec
--- /dev/null
+++ b/system/base/unknown/src/file
@@ -0,0 +1,810 @@
+ 

+PACKET file DEFINES                            (* Autor: J.Liedtke *)

+                                               (* Stand: 30.04.82  *)

+       FILE ,

+       := ,

+       input ,

+       output ,

+       modify ,

+       sequential file ,

+       getline ,

+       putline ,

+       line ,

+       reset ,

+       eof ,

+       put ,

+       get ,

+       page ,

+       out ,

+       eop ,

+       close ,

+       max line length ,

+       max page length ,

+       read record , 

+       write record , 

+       forward , 

+       backward , 

+       delete record , 

+       insert record , 

+       to first record ,

+       to eof , 

+       is first record , 

+       headline ,

+       copy attributes ,

+       reorganize ,

+       feldeditor ,

+       feldout ,

+       feldeinruecken ,

+       pos ,

+       change ,

+       subtext ,

+       sort :

+ 

+ 

+ 

+TYPE FILE = STRUCT ( BOUND DATEI f ,

+                     INT index, pointer, line counter,

+                         mode, max line length, max page length,

+                     BOOL edit status unchanged) ;

+ 

+TYPE TRANSPUTDIRECTION = INT ;

+ 

+LET closed = 1 ,

+    in     = 2 ,

+    outp   = 3 ,

+    mod    = 4 ,

+    end    = 5 ,

+    escape = ""27"" ,

+

+    nullzustand    = "    0    1    1" ,

+

+    max length = 15 000 ;    (*  < maxint/2 because 2 * maxlength possible*)

+

+ 

+TRANSPUTDIRECTION PROC input :

+  TRANSPUTDIRECTION : ( in )

+ENDPROC input ;

+ 

+TRANSPUTDIRECTION PROC output :

+  TRANSPUTDIRECTION : ( outp )

+ENDPROC output ;

+ 

+TRANSPUTDIRECTION PROC modify :

+  TRANSPUTDIRECTION : ( mod )

+ENDPROC modify ;

+ 

+LET DATEI = ROW 4075 STRUCT (

+                INT nachfolger, vorgaenger, index, fortsetzung,

+                TEXT inhalt ) ;

+ 

+LET anker = 2 ,

+    freianker = 1 ;

+ 

+TEXT VAR number word ;

+

+FILE VAR result file ;

+ 

+DATASPACE VAR scratch space ;

+close ;

+ 

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode) :

+ 

+  IF CONCR (mode) = outp

+    THEN close

+  FI ;

+  sequential file (mode, scratch space)

+ 

+ENDPROC sequential file ;

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,

+                           DATASPACE VAR ds) :

+ 

+  IF type (ds) = 1002

+    THEN result file.f := ds

+  ELIF type (ds) < 0

+    THEN result file.f := ds ;

+         type (ds, 1002) ;

+         datei initialisieren (CONCR (result file.f))

+  ELSE   errorstop ("dataspace has wrong type") ;

+         result file.f := scratch space

+  FI ;

+  result file.mode := CONCR (mode) ;

+  reset (result file) ;

+  result file.max line length := max line length (result file) ;

+  result file.max page length := 0 ;

+ 

+  result file .

+ 

+ENDPROC sequential file ;

+ 

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,

+                           TEXT CONST name ) :

+ 

+  IF exists (name)

+    THEN get dataspace if file

+  ELIF CONCR (mode) <> in

+    THEN get new file space

+  ELSE errorstop ("input file not existing") ;

+       result file.f := scratch space

+  FI ;

+  IF CONCR (mode) <> in

+    THEN status (name, "") ;

+         headline (result file, name)

+  FI ;

+  result file.mode := CONCR (mode) ;

+  reset (result file) ;

+  result file.max line length := max line length (result file) ;

+  result file.max page length := 0 ;

+ 

+  result file .

+ 

+get new file space :

+  result file.f := new (name) ;

+  IF NOT is error

+    THEN type (old (name), 1002) ;

+         datei initialisieren ( CONCR (result file.f) )

+  FI .

+ 

+get dataspace if file :

+  result file.f := old (name, 1002) .

+ 

+ENDPROC sequential file ;

+ 

+INT PROC max line length (FILE CONST file) :

+ 

+  int (subtext (zustand, 16, 20)) .

+ 

+zustand : 

+  CONCR (file.f) (freianker).inhalt .

+

+ENDPROC max line length ;

+ 

+PROC max line length (FILE VAR file, INT CONST length) :

+ 

+  replace (zustand, 16, text (length,5)) .

+ 

+zustand : 

+  CONCR (file.f) (freianker).inhalt .

+ 

+ENDPROC max line length ;

+ 

+PROC headline (FILE VAR file, TEXT CONST head) :

+ 

+  CONCR (file.f)(anker).inhalt := head

+ 

+ENDPROC headline ;

+ 

+TEXT PROC headline (FILE VAR file) :

+ 

+  CONCR (file.f)(anker).inhalt

+ 

+ENDPROC headline ;

+ 

+PROC copy attributes (FILE CONST source, FILE VAR dest) :

+

+  dest attributes := source attributes ;

+  reset edit status (dest) ;

+  dest headline   := source headline .

+

+dest attributes :   CONCR (dest.f) (freianker).inhalt .

+source attributes : CONCR (source.f) (freianker).inhalt .

+

+dest headline :     CONCR (dest.f) (anker).inhalt .

+source headline :   CONCR (source.f) (anker).inhalt .

+

+ENDPROC copy attributes ;

+

+

+PROC input (FILE VAR file) :

+ 

+  file.mode := in ;

+  reset (file)

+ 

+ENDPROC input ;

+ 

+PROC output (FILE VAR file) :

+ 

+  file.mode := outp ;

+  reset (file)

+ 

+ENDPROC output ;

+ 

+PROC modify (FILE VAR file) :

+ 

+  file.mode := mod ;

+  reset (file)

+ 

+ENDPROC modify ;

+ 

+ 

+PROC putline (FILE VAR file, TEXT CONST record) :

+ 

+  check mode (file, outp) ;

+  line (file) ;

+  CONCR (file.f)(file.index).inhalt := record ;

+  file.pointer := max length

+ 

+ENDPROC putline ;

+ 

+ 

+PROC getline (FILE VAR file, TEXT VAR record) :

+ 

+  check mode (file, in) ;

+  line (file) ;

+  record := CONCR (file.f)(file.index).inhalt ;

+  file.pointer := max length

+ 

+ENDPROC getline ;

+ 

+ 

+PROC line (FILE VAR file) :

+ 

+  file.index := CONCR (file.f) (file.index).nachfolger ;

+  file.pointer  := 0 ;

+  IF file.mode = in

+    THEN check eof

+  ELIF file.mode = outp

+    THEN satz erzeugen (CONCR (file.f), file.index) ;

+         CONCR (file.f)(file.index).inhalt := "" ;

+         perhaps implicit page feed

+  FI .

+ 

+check eof :

+  IF eof

+    THEN file.mode := end

+  FI .

+ 

+eof : CONCR (file.f)(file.index).nachfolger = anker .

+ 

+perhaps implicit page feed :

+  file.line counter INCR 1 ;

+  IF file.line counter = file.max page length

+    THEN page (file)

+  FI .

+ 

+ENDPROC line ;

+ 

+PROC check mode (FILE CONST file, INT CONST mode) :

+ 

+  IF file.mode = mode

+      THEN LEAVE check mode

+  ELIF file.mode = closed

+      THEN errorstop ("file not open")

+  ELIF file.mode = mod

+      THEN errorstop ("operation not in transputdirection 'modify'")

+  ELIF mode = mod

+      THEN errorstop ("operation only in transputdirection 'modify'")

+  ELIF file.mode = end

+      THEN IF eof (file) THEN errorstop ("input after end of file") FI

+  ELIF mode = in

+      THEN errorstop ("input access to output file")

+  ELIF mode = outp

+      THEN errorstop ("output access to input file")

+  FI

+ 

+ENDPROC check mode ;

+ 

+PROC reset (FILE VAR file) :

+ 

+  file.pointer := max length ;

+  file.line counter := 0 ;

+  file.edit status unchanged := TRUE ;

+  initialize file index ;

+  set correct file mode .

+ 

+initialize file index :

+  IF file.mode = outp

+    THEN file.index := last record

+    ELSE file.index := anker

+  FI .

+ 

+set correct file mode :

+  IF file.mode = end

+    THEN file.mode := in

+  FI ;

+  IF file.mode = in AND empty file

+    THEN file.mode := end

+  FI .

+ 

+last record : CONCR (file.f) (anker).vorgaenger .

+ 

+empty file  : CONCR (file.f) (anker).nachfolger = anker .

+ 

+ENDPROC reset ;

+ 

+BOOL PROC eof (FILE CONST file) :

+ 

+  IF file.mode = end

+    THEN end of record

+  ELIF file.mode = mod

+    THEN file.index = anker

+    ELSE FALSE

+  FI .

+ 

+end of record :

+  file.pointer >= length (CONCR (file.f)(file.index).inhalt) .

+ 

+ENDPROC eof ;

+ 

+PROC line (FILE VAR file, INT CONST lines) :

+ 

+  check mode (file, outp) ;

+  INT VAR i ;

+  FOR i FROM 1 UPTO lines REP

+    line (file)

+  PER

+ 

+ENDPROC line ;

+ 

+PROC page (FILE VAR file) :

+ 

+  file.line counter := 0 ;

+  putline (file, "#page")

+ 

+ENDPROC page ;

+ 

+BOOL PROC eop (FILE CONST file) :

+ 

+  CONCR (file.f)(file.index).inhalt = "#page"

+ 

+ENDPROC eop ;

+ 

+PROC put (FILE VAR file, TEXT CONST word) :

+ 

+  check mode (file, outp) ;

+  IF file.pointer + LENGTH word >= file.max line length

+    THEN line (file)

+  FI ;

+  put word (CONCR (file.f)(file.index).inhalt, word, file.pointer)

+ 

+ENDPROC put ;

+ 

+PROC put word (TEXT VAR record, TEXT CONST word, INT VAR pointer) :

+ 

+  IF pointer > 0

+    THEN record CAT " " ;

+  FI ;

+  record CAT word ;

+  pointer := LENGTH record

+ 

+ENDPROC put word ;

+ 

+PROC put (FILE VAR f, INT CONST value) :

+ 

+  put (f, text (value) )

+ 

+ENDPROC put ;

+ 

+PROC put (FILE VAR f, REAL CONST real) :

+ 

+  put (f, text (real) )

+ 

+ENDPROC put ;

+ 

+PROC out (FILE VAR file, TEXT CONST word) :

+ 

+  check mode (file, outp) ;

+  IF file.pointer + LENGTH word >= file.max line length

+    THEN line (file)

+  FI ;

+  record CAT word ;

+  file.pointer INCR LENGTH word .

+ 

+record : CONCR (file.f)(file.index).inhalt .

+ 

+ENDPROC out ;

+ 

+PROC get (FILE VAR file, TEXT VAR word, TEXT CONST separator) :

+ 

+  check mode (file, in) ;

+  get word (CONCR (file.f)(file.index).inhalt, word,

+            file.pointer, max length, separator)

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR file, TEXT VAR word, INT CONST max length) :

+ 

+  check mode (file, in) ;

+  get word (CONCR (file.f)(file.index).inhalt, word,

+            file.pointer, max length, "")

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR file, TEXT VAR word) :

+ 

+  check mode (file, in) ;

+  next word (file, CONCR (file.f)(file.index).inhalt, word)

+ 

+ENDPROC get ;

+ 

+PROC next word (FILE VAR file, TEXT CONST record, TEXT VAR word) :

+ 

+  get next non blank char ;

+  IF char found

+    THEN get word (record, word, file.pointer, max length, " ")

+  ELIF last line of file

+    THEN word := "" ;

+         file.pointer := max length

+    ELSE line (file) ;

+         get (file, word)

+  FI .

+ 

+get next non blank char :

+  TEXT VAR char ;

+  REP

+    file.pointer INCR 1 ;

+    char := record SUB file.pointer

+  UNTIL char <> " " PER ;

+  file.pointer DECR 1 .

+ 

+char found :  char <> "" .

+ 

+last line of file :

+  CONCR (file.f) (anker).nachfolger = anker .

+ 

+ENDPROC next word ;

+ 

+PROC get (FILE VAR f, INT VAR number) :

+ 

+  get (f, number word) ;

+  number := int (number word)

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR f, REAL VAR number) :

+ 

+  get (f, number word) ;

+  number := real (number word)

+ 

+ENDPROC get ;

+ 

+PROC get word (TEXT CONST record, TEXT VAR word, INT VAR pointer,

+               INT CONST max length, TEXT CONST separator) :

+ 

+  INT VAR end of word := pos (record, separator, pointer+1) - 1 ;

+  IF end of word < 0

+    THEN end of word := pointer + max length

+  FI ;

+  word := subtext (record, pointer+1, end of word) ;

+  pointer := end of word + 1

+ 

+ENDPROC get word ;

+ 

+PROC close (FILE VAR file) :

+ 

+  file.mode := closed

+ 

+ENDPROC close ;

+ 

+PROC close :

+ 

+  disable stop ;

+  forget (scratch space) ;

+  scratch space := nilspace

+ 

+ENDPROC close ;

+ 

+INT PROC max page length (FILE CONST file) :

+  file.max page length

+ENDPROC max page length ;

+ 

+PROC max page length (FILE VAR file, INT CONST length) :

+  file.max page length := length

+ENDPROC max page length

+ 

+ 

+PROC read record (FILE CONST file, TEXT VAR record) : 

+ 

+  check mode (file, mod) ;

+  record := CONCR (file.f) (file.index).inhalt 

+ 

+ENDPROC read record ; 

+ 

+PROC write record (FILE VAR file, TEXT CONST record) : 

+ 

+  check mode (file, mod) ;

+  CONCR (file.f) (file.index).inhalt := record 

+ 

+ENDPROC write record ; 

+ 

+PROC forward (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.index <> anker 

+    THEN file.index := CONCR (file.f) (file.index).nachfolger 

+    ELSE errorstop ("forward at eof") 

+  FI 

+ 

+ENDPROC forward ; 

+ 

+PROC backward (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := CONCR (file.f) (file.index).vorgaenger ; 

+  IF file.index = anker 

+    THEN to first record (file) ; 

+         errorstop ("backward at first record") 

+  FI 

+ 

+ENDPROC backward ; 

+ 

+PROC delete record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.edit status unchanged

+    THEN reset edit status (file)

+  FI ;

+  satz loeschen (CONCR (file.f), file.index) 

+ 

+ENDPROC delete record ; 

+ 

+PROC insert record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.edit status unchanged

+    THEN reset edit status (file)

+  FI ;

+  satz erzeugen (CONCR (file.f), file.index) 

+ 

+ENDPROC insert record ; 

+ 

+PROC to first record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := CONCR (file.f) (anker).nachfolger 

+ 

+ENDPROC to first record ; 

+ 

+PROC to eof (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := anker 

+ 

+ENDPROC to eof ; 

+ 

+BOOL PROC is first record (FILE CONST file) : 

+ 

+  file.index = CONCR (file.f) (anker).nachfolger 

+ 

+ENDPROC is first record ; 

+ 

+PROC reset edit status (FILE VAR file) :

+ 

+  replace (zustand, 1, nullzustand) ;

+  file.edit status unchanged := FALSE .

+ 

+zustand :  CONCR (file.f)(freianker).inhalt .

+ 

+ENDPROC reset edit status ;

+ 

+ 

+FILE VAR scratch , file ;

+TEXT VAR record ;

+ 

+LET esc = ""27"" ;

+ 

+PROC reorganize (TEXT CONST file name) :

+ 

+  IF exists (file name)

+    THEN last param (file name) ;

+         reorganize file

+    ELSE errorstop ("file does not exist")

+  FI .

+ 

+reorganize file :

+  scratch := sequential file (output) ;

+  headline (scratch, file name) ;

+  IF format 15

+    THEN set to 16 file type ; 

+         file := sequential file (input, file name)

+    ELSE file := sequential file (input, file name) ;

+         copy attributes (file, scratch) 

+  FI ;

+ 

+  disable stop ;

+

+  INT VAR counter := 0 ;

+  WHILE NOT eof (file) REP

+    getline (file, record) ;

+    putline (scratch, record) ;

+    counter INCR 1 ;

+    cout (counter) ;

+    IF is incharety (escape) OR is error

+      THEN close ;

+           LEAVE reorganize

+    FI

+  PER ;

+  forget file ;

+  copy (scratch space, file name) ;

+  close .

+ 

+forget file :

+  BOOL CONST old status := command dialogue ;

+  command dialogue (FALSE) ;

+  forget (file name) ;

+  command dialogue (old status) .

+ 

+format 15 :  type (old (file name)) = 1001 .

+

+set to 16 file type :

+  type (old (file name), 1002) .

+

+ENDPROC reorganize ;

+ 

+PROC reorganize :

+ 

+  reorganize (last param)

+ 

+ENDPROC reorganize ;

+ 

+PROC feldout (FILE CONST file, TEXT CONST satz) :

+ 

+  feldout ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldout ;

+ 

+PROC feldeinruecken (FILE CONST file, TEXT CONST satz) :

+ 

+  feldeinruecken ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldeinruecken ;

+ 

+PROC feldeditor (FILE VAR file, TEXT CONST satz) :

+ 

+  feldeditor ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldeditor ;

+ 

+INT PROC pos (FILE CONST file, TEXT CONST pattern, INT CONST from) :

+ 

+  pos ( CONCR (file.f) (file.index).inhalt, pattern, from )

+ 

+ENDPROC pos ;

+ 

+PROC change (FILE VAR file, INT CONST from, to, TEXT CONST new) :

+ 

+  change ( CONCR (file.f) (file.index).inhalt, from, to, new )

+ 

+ENDPROC change ;

+ 

+TEXT PROC subtext (FILE CONST file, INT CONST from) :

+ 

+  record := subtext ( CONCR (file.f) (file.index).inhalt, from ) ;

+  record

+ 

+ENDPROC subtext ;

+ 

+TEXT PROC subtext (FILE CONST file, INT CONST from, to) :

+ 

+  record := subtext ( CONCR (file.f) (file.index).inhalt, from, to ) ;

+  record

+ 

+ENDPROC subtext ;

+ 

+(*  sortieren sequentieller Dateien                  Autor: P.Heyderhoff *) 

+                                                  (* Stand: 14.11.80     *) 

+ 

+BOUND DATEI VAR datei; 

+INT  VAR sortierstelle, sortanker, byte;

+TEXT VAR median, tausch ;

+ 

+PROC sort (TEXT CONST dateiname) : 

+     sortierstelle := feldanfang; sort (dateiname, "")

+ END PROC sort; 

+ 

+PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : 

+     sortierstelle := sortieranfang; sort (dateiname, "")

+ END PROC sort; 

+ 

+PROC sort (TEXT CONST dateiname, feldname) :

+     IF   exists (dateiname)

+     THEN datei := old (dateiname); 

+          IF   CONCR(datei) (freianker).nachfolger <> freianker 

+          THEN reorganize (dateiname) 

+          FI ; 

+          sortanker := 3;

+          IF   feldname = ""

+          THEN byte := 0

+          ELSE feldname in feldnummer uebersetzen

+          FI;

+          quicksort(sortanker, CONCR(datei)(freianker).fortsetzung-1) 

+     FI .

+feldname in feldnummer uebersetzen :

+    byte := pos (CONCR(datei) (sortanker).inhalt, feldname);

+    IF   byte > 0

+    THEN byte := pos (CONCR(datei) (sortanker).inhalt, code(255-byte))

+    FI;

+    IF   byte = 0 

+    THEN errorstop ("sort: feldname"); LEAVE sort

+    FI ; sortanker INCR 1 .

+ END PROC sort; 

+ 

+PROC quicksort ( INT CONST anfang, ende ) : 

+     IF   anfang < ende 

+     THEN INT VAR p,q; 

+          spalte    (anfang, ende, p, q); 

+          quicksort (anfang, q); 

+          quicksort (p, ende)    FI 

+ END PROC quicksort; 

+ 

+PROC spalte (INT CONST anfang, ende, INT VAR p, q): 

+     fange an der seite an und waehle den median; 

+     ruecke p und q so dicht wie moeglich zusammen; 

+     hole ggf median in die mitte . 

+ 

+   fange an der seite an und waehle den median : 

+     p := anfang; q := ende ; 

+     INT CONST m :: (p + q) DIV 2 ; 

+     median := subtext(datei m, merkmal m) . 

+ 

+   ruecke p und q so dicht wie moeglich zusammen : 

+     REP schiebe p und q so weit wie moeglich auf bzw ab; 

+         IF p < q THEN vertausche die beiden FI 

+     UNTIL p > q END REP . 

+ 

+   vertausche die beiden : 

+     tausch := datei p; datei p := datei q; datei q := tausch; 

+     p INCR 1; q DECR 1 . 

+ 

+   schiebe p und q so weit wie moeglich auf bzw ab : 

+     WHILE p kann groesser werden REP p INCR 1 END REP; 

+     WHILE q kann kleiner  werden REP q DECR 1 END REP . 

+ 

+   p kann groesser werden : 

+     IF p <= ende THEN subtext (datei p, merkmal p) <= median ELSE FALSE FI . 

+ 

+   q kann kleiner werden : 

+     IF q >= anfang THEN subtext(datei q,merkmal q) >= median ELSE FALSE FI . 

+ 

+   hole ggf median in die mitte : 

+     IF   m < q THEN vertausche m und q 

+     ELIF m > p THEN vertausche m und p FI . 

+ 

+   vertausche m und q : 

+     tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . 

+ 

+   vertausche m und p : 

+     tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . 

+ 

+   merkmal m :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei m SUB byte) FI .

+ 

+   merkmal p :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei p SUB byte) FI .

+ 

+   merkmal q :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei q SUB byte) FI .

+ 

+   datei m :  CONCR(datei)(m).inhalt . 

+   datei p :  CONCR(datei)(p).inhalt . 

+   datei q :  CONCR(datei)(q).inhalt . 

+ 

+END PROC spalte; 

+ 

+ 

+(*********** schrott ************)

+ 

+OP := (FILE VAR a, FILE CONST b) :

+  EXTERNAL 294

+ENDOP := ;

+ 

+PROC becomes (ROW 8 INT VAR a, b) :

+  INTERNAL 294 ;

+  a := b

+ENDPROC becomes ;

+ 

+PROC datei initialisieren (DATEI VAR datei) : 

+  EXTERNAL 290 ;

+END  PROC datei initialisieren; 

+ 

+PROC satz erzeugen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 291;

+END  PROC satz erzeugen; 

+ 

+PROC satz loeschen (DATEI VAR datei, INT VAR satz): 

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+ENDPACKET file ;

diff --git a/system/base/unknown/src/init b/system/base/unknown/src/init
new file mode 100644
index 0000000..02b8e74
--- /dev/null
+++ b/system/base/unknown/src/init
@@ -0,0 +1,250 @@
+ " Compiler Error : " 

+"              "

+"               |" 

+" Fehler entdeckt  " 

+"Keine Fehler gefunden,  "

+" Sekunden CPU-Zeit verbraucht"

+"       *******  ENDE DER UEBERSETZUNG  *******" 

+"FEHLER bei >> " 

+" <<  " 

+"weiter bei "

+"   ("      ")  " 

+"EOF im Programm" 

+"EOF beim Skippen" 

+"EOF im TEXT Denoter" 

+"EOF im Kommentar" 

+"' nach Bold fehlt"

+"das MAIN PACKET muss das letzte sein" 

+"ungueltiger Name fuer ein Interface Objekt" 

+"':' fehlt"

+"nach ENDPACKET folgt nicht der Paketname" 

+"ENDPACKET fehlt" 

+"CONST oder VAR fehlt" 

+"ungueltiger Name"

+" ',' in Deklarationsliste fehlt"

+"ist nicht der PROC Name"

+"fehlerhaftes Endes des MAIN PACKET" 

+"ENDPROC fehlt" 

+"PROC/OP Schachtelung unzulaessig" 

+"OP darf kein Parameter sein"

+"steht mehrfach im PACKET Interface" 

+"Mehrfachdeklaration" 

+"ist schon als Datenobjekt deklariert"

+"ist schon als PROC/OP deklariert" 

+"')' nach Parameterliste erwartet" 

+"Standard-Schluesselwort kann nicht redefiniert werden"

+"ungueltig als BOLD" 

+"'(' fehlt"

+"CONST bzw VAR nicht bei Strukturfeldern" 

+"'=' fehlt" 

+"Schluesselwort wird im Paket schon andersartig verwandt"

+"Dieser Typ ist schon definiert" 

+"ungueltiger Deklarierer" 

+"ungueltiger OP Name"

+"OP muss monadisch oder dyadisch sein" 

+"ist nicht der OP Name" 

+"ENDOP fehlt" 

+"Name nach ENDPROC fehlt" 

+"Name nach ENDOP fehlt" 

+"END END ist Unsinn"

+"Diese END... kenne ich nicht"

+"ROW Groesse ist kein INT" 

+"ROW Groesse ist kein Denoter"

+"Ein ROW muss mindestens ein Element haben"

+"ROW Groesse fehlt" 

+"Parameter kann man nicht initialisieren"

+"Konstanten muessen initialisert werden"

+"'::' verwenden"

+"')' fehlt" 

+"Nachkommastellen fehlen" 

+"Exponent fehlt"

+"Undefinierter Typ" 

+"Rekursiv definierter Typ" 

+"Mehrfach definierter Selektor" 

+"VARs koennen aus dem Paket nicht herausgereicht werden" 

+"NO SHORTHAND DECLARATION IN THIS SCOPE FOR ROW SIZE DENOTER."

+"Typ Deklarationen nur im Paketrumpf" 

+"CONST bzw. VAR ohne Zusammenhang" 

+"ist nicht deklariert, steht aber in der Paket-Schnittstelle" 

+"ist nicht deklariert"

+"Typ ist schon deklariert" 

+"THIS IS NO CORRECT EXTERNAL NUMBER." 

+" EXTERNAL und INTERNAL unzulaessig"

+"Name erwartet" 

+"Denoter erwartet"

+"ENDPROC ohne Zusammenhang"

+"ENDOP ohne Zusammenhang"

+"Refinement ohne Zusammenhang"

+"Delimiter zwischen Paket-Refinement und Deklaration fehlt"

+"unzulaessiges Selektor-Symbol (kein Name)"

+"BOUND Schachtelungen unzulaessig"

+"Textende fehlt" 

+

+"Denoter-Wert wird fuer diese Maschine zu gross" 

+"NOBODY SHOULD EVER WRITE THAT, Uli ! " 

+"ist ein zusammenhangloses Schluesselwort"

+"'::' nur fuer Initialisierungen, sonst ':='"

+"welches Objekt soll verlassen werden?"

+"du bist gar nicht innerhalb dieses Refinements"

+"nur die eigene PROC / OP kann verlassen werden"

+"THEN fehlt"

+"FI fehlt"

+"BOOL - Ausdruck erwartet" 

+"ELSE - Teil ist notwendig, da ein Wert geliefert wird"

+"Mit ELIF kann kein IF-Statement beginnen"

+"INT - Ausdruck erwartet"

+"OF fehlt"

+"Keine Typanpassung moeglich"

+"CASE - Label fehlt"

+"CASE - Label ist zu gross (skipped)" 

+"mehrfach definiertes CASE-Label"

+"ungueltiges Zeichen nach CASE-Label" 

+" OTHERWISE PART fehlt"

+"END SELECT fehlt" 

+"DEAR USER, PLEASE BE REMINDED OF NOT CALLING REFINEMENTS RECURSIVLY !"

+"Dieses Refinement wird nicht benutzt" 

+"Zwischen diesen Symbolen fehlt ein Operator oder ein ';'"

+"undefinierter monadischer Operator" 

+"undefinierter dyadischer Operator" 

+"Operator vor '(' fehlt" 

+"kann nicht redefiniert werden" 

+"Auf die Feinstruktur des Typs kann man nicht mehr zugreifen" 

+"fuer diesen Typ nicht definierter Selektor" 

+"Primitive Typen koennen nicht selektiert werden"

+"bei ROWs nur Subscription"

+"ungueltiger Selectand" 

+"unzulaessiger Index fuer Subscription"

+"'[' ohne Zusammenhang"

+"']' ohne Zusammenhang"

+"']' nach Subscription fehlt"

+"',' ungueltig zwischen UNITs"

+"':' ungueltig zwischen UNITs"

+"';' fehlt"

+"nur die letzte UNIT einer SECTION darf einen Wert liefern"

+"Der Paketrumpf kann keinen Wert liefern" 

+"anstelle des letzten Symbols wurde ein Operand erwartet" 

+"Der Schleifenrumpf darf keinen Wert liefern"

+"INT VAR erwartet"

+"wird schon in einer aeusseren Schleife als Laufvariable benutzt"

+"FROM erwartet"

+"UPTO bzw DOWNTO fehlt"

+"REPEAT fehlt"

+"END REP fehlt"

+"UNTIL ohne Zusammenhang"

+"Die Konstante darf nicht mit ':=' veraendert werden"

+"In einer FOR-Schleife darf die Laufvariable nicht veraendert werden"

+"falscher Typ des Resultats" 

+"ist CONST, es wird aber ein VAR Parameter verlangt"

+"unbekannte Prozedur"

+"Parameter-Prozedur liefert falsches Resultat" 

+"Es gibt keine Prozedur mit diesen Parametern"

+"unbekannte Parameter-Prozedur" 

+"VIRTUAL PARAM MODE INCONSISTENCE" 

+"INCONSISTENCE BETWEEN THE PARAMETERS OF THE ACTUAL AND THE FORMAL PARAM PROC

+EDURE "

+"nicht deklariertes Objekt"

+"THIS OBJECT IS USED OUTSIDE IT'S RANGE"

+"Kein TYPE DISPLAY moeglich, da die Feinstruktur hier unbekannt ist"

+"zu wenig Felder angegeben"

+"zu viele Felder angegeben"

+"unzulaessiger Trenner zwischen Feldern"

+"Dies Feld hat einen falschen Typ"

+"THIS ROW DISPLAY DOES NOT HAVE THE CORRECT NUMBER OF ELEMENTS." 

+"Dieser Typ kann nicht noch mehr konkretisiert werden"

+

+"Warnung in Zeile"

+"   Zeile "

+"in Zeile "

+"<----+--->" 

+" TYPE undefiniert "

+" MODE undefiniert "

+"Parameter spezifiziert "

+"Parameter Typ(en) sind "

+" B Code, "

+" B Paketdaten generiert"

+"Operandentyp"

+"Typ des linken Operanden "

+"Typ des rechten Operanden "

+"erwartet "

+"gefunden "

+ "NULL   1TEST   1NOT    2INCR   1DECR 

+ 1MOV2   2MOV8   2MOVS   2EQI    2LSEQI

+ 2EQR    2LSEQR  2COMPLI 2COMPLR 2ADDI 

+ 3SUBI   3MULTI  3DIVI   3ADDR   3SUBR 

+ 3MULTR  3DIVR   3AND    2OR     2BRANCH

+8BTRUE  8BFALSE 8ACCDS  2ALIAS  5RETURN

+0MOVE   3CASE   3SUBS   5SUBS2  4SUBS8

+ 4SUBS16 4SEL    3BSTL   6ESTL   7HEAD 

+ 1PACKET 1BOOL   1NBOOL  1" 

+ 

+(*000  *)    END    INTERNAL   BOUND 

+(*001  *)    PACKET 

+(*002  *)    ENDPACKET 

+(*003  *)    DEFINES 

+(*003 A*)    LET 

+(*004  *)    PROCEDURE 

+(*005  *)    PROC 

+(*006  *)    ENDPROC 

+(*006A *)    ENDPROCEDURE 

+(*007  *)    OPERATOR 

+(*008  *)    OP 

+(*009  *)    ENDOP 

+(*009A *)    ENDOPERATOR 

+(*010  *)    TYPE 

+(*011  *)    INT 

+(*012  *)    REAL 

+(*013  *)    DATASPACE 

+(*015  *)    TEXT 

+(*016  *)    BOOL 

+(*017  *)    CONST 

+(*018  *)    VAR 

+(* INIT CONTROL *)  INTERNAL 

+(*019  *)    ROW 

+(*0191 *)    STRUCT CONCR 

+(*0193*)   ACTUAL 

+(*020  *)    REP 

+(*020A *)    REPEAT 

+(*021  *)    ENDREP 

+(*021A *)    ENDREPEAT PER 

+(*022  *)    SELECT 

+(*023  *)    ENDSELECT 

+(*0235 *)    EXTERNAL 

+(*024 *)     IF    (*024A *)   ENDIF 

+(*021  *)     THEN 

+(*022  *)     ELIF 

+(*023  *)     ELSE 

+(*024  *)     FI 

+(*026  *)     OF 

+(*026A *)     CASE 

+(*027  *)     OTHERWISE 

+(*029  *)     FOR 

+(*030  *)     FROM 

+(*031  *)     UPTO 

+(*032  *)     DOWNTO 

+(*034  *)     UNTIL 

+(*035  *)     WHILE 

+(*036  *)     LEAVE   WITH 

+(*0361 *)     TRUE 

+(*362 *)    FALSE 

+(*038  *)     :: SBL = := INCR DECR 

+(*039  *)     + - * / DIV MOD ** AND CAND OR COR NOT   <> > >= < <= 

+(*040  *)     MAIN 

+(*043*)  ENDOFFILE 

+ 

+PACKET a :

+

+PROC out (TEXT CONST t) :

+  EXTERNAL 60

+ENDPROC out ;

+

+PROC out text (TEXT CONST t, INT CONST typ) :

+  INTERNAL 257 ;

+  out (t)

+ENDPROC out text ;

+

+PROC out line (INT CONST typ) :

+  INTERNAL 258 ;

+  out (""13""10"")

+ENDPROC out line ;

+

+ENDPACKET a ; 

diff --git a/system/base/unknown/src/integer b/system/base/unknown/src/integer
new file mode 100644
index 0000000..0e1d19d
--- /dev/null
+++ b/system/base/unknown/src/integer
@@ -0,0 +1,134 @@
+ 

+PACKET integer DEFINES 

+               sign, SIGN, abs, ABS, **, min, max, maxint,

+               get, random, initialize random :

+ 

+INT PROC maxint : 32767 ENDPROC maxint ;

+ 

+INT PROC sign (INT CONST argument) : 

+ 

+  IF argument < 0 THEN -1 

+  ELIF argument > 0 THEN 1 

+  ELSE 0 

+  FI 

+ 

+ENDPROC sign ; 

+ 

+INT OP SIGN (INT CONST argument) : 

+  sign (argument) 

+ENDOP SIGN ;

+ 

+INT PROC abs (INT CONST argument) : 

+ 

+  IF argument > 0 THEN argument 

+  ELSE - argument 

+  FI 

+ 

+ENDPROC abs ;

+ 

+INT OP ABS (INT CONST argument) : 

+  abs (argument) 

+ENDOP ABS ;

+ 

+INT OP ** (INT CONST arg, exp) : 

+ 

+  INT VAR x := arg , z := 1 ,

+          counter := exp ;

+ 

+  IF exp < 0 THEN errorstop ("INT OP ** : negative exponent") FI ;

+  IF arg = 0 AND exp = 0 

+    THEN errorstop (" 0 ** 0 is not defined") 

+  FI ;

+  IF exp = 0 THEN x := 1 FI ;

+ 

+  WHILE counter >= 2 REP 

+    calculate new x and z ;

+    counter := counter DIV 2 ;

+  ENDREP ;

+  z * x . 

+ 

+calculate new x and z : 

+  IF counter is not even 

+    THEN z := z * x 

+  FI ;

+  x := x * x . 

+ 

+counter is not even : 

+  counter MOD 2 = 1 . 

+ 

+ENDOP ** ;

+ 

+INT PROC min (INT CONST first, second) : 

+ 

+  IF first < second THEN first ELSE second FI 

+ 

+ENDPROC min ;

+ 

+INT PROC max (INT CONST first, second) : 

+ 

+  IF first > second THEN first ELSE second FI 

+ 

+ENDPROC max ; 

+ 

+ 

+PROC get (INT VAR number) :

+ 

+  get (word) ;

+  number := int (word) 

+ 

+ENDPROC get ;

+ 

+TEXT VAR word := "" ;

+ 

+ 

+ 

+(************************************************)

+(***                                          ***)

+(***          generator     32 650            ***)

+(***                                          ***)

+(************************************************)

+ 

+(*  INT-Zufallsgenerator mit Periode 32650      *)  (*Autor: Bake    *)

+                                                    (*Gymnasium Aspe *)

+ 

+INT VAR   z1 ::  14,   (* fuer den generator mit periode   25 *)

+          z2 :: 345;   (* fuer den generator mit periode 1306 *)

+ 

+ 

+     INT PROCEDURE   random   (INT CONST ugrenze, ogrenze) :

+   (*******************************************************)

+ 

+generator 25;

+generator 1306;

+(zufallszahl MOD intervallgroesse) + ugrenze.

+ 

+(* Durch MOD wird bei grosser 'intervallgroesse' der vordere

+   Bereich doppelt ueberdeckt, also keine Gleichverteilung. heinrichs 

+   24.04.81 *)

+

+

+     generator 25 :

+z1 := (11 * z1 + 18) MOD 25

+(* erster generator. liefert alle zahlen zwischen 0 und 24. *).

+ 

+     generator 1306 :

+z2 := (24 * z2 + 23) MOD 1307

+(* zweiter generator. liefert alle zahlen zwischen 0 und 1305. *).

+ 

+     zufallszahl : 

+z1 + z2 * 25  (* diese zahl liegt zwischen 0 und 32 649 *).

+ 

+     intervallgroesse :   ogrenze - ugrenze + 1

+ 

+END PROC   random ;

+ 

+ 

+  PROCEDURE   initialize random   (INT CONST wert) :

+(**************************************************)

+ 

+z1 := wert MOD 25;

+z2 := wert MOD 1306

+ 

+END PROC   initialize random ;

+ 

+ENDPACKET integer ; 

diff --git a/system/base/unknown/src/mathlib b/system/base/unknown/src/mathlib
new file mode 100644
index 0000000..be44ff6
--- /dev/null
+++ b/system/base/unknown/src/mathlib
@@ -0,0 +1,359 @@
+ 

+PACKET mathlib DEFINES sqrt,**,exp,ln,log2,log10,sin,cos, 

+                       tan,arctan,sind,cosd,tand,arctand,e,pi,

+                       random,initializerandom :

+ 

+ 

+REAL VAR rdg::0.4711; 

+ 

+REAL PROC pi: 

+   3.141592653589793. 

+END PROC pi; 

+ 

+REAL PROC e: 

+  2.718281828459045. 

+END PROC e; 

+ 

+REAL PROC ln(REAL CONST x): 

+LET ln2= 0.6931471805599453; 

+log2(x)*ln2. 

+END PROC ln; 

+ 

+REAL PROC log2(REAL CONST z): 

+INT VAR k::0,p::0; 

+REAL VAR m::0.0,x::z,t::0.0,summe::0.0; 

+IF   x>0.0 

+THEN normal 

+ELSE errorstop("log2 mit negativer zahl");4711.4711 

+FI. 

+normal: 

+ IF   x>=0.5 

+ THEN normalise downwards 

+ ELSE normalise upwards 

+  FI; 

+  IF   x>=0.1 AND x< 0.7071067811865475 THEN 

+       t:=(x-0.5946035575013605)/(x+0.5946035575013605); 

+       summe:=reihenentwicklung (t) - 0.75 

+  FI; 

+  IF  x>=0.7071067811865475 AND x < 1.0 THEN 

+      t:=(x - 0.8408964152537145)/(x+0.8408964152537145); 

+      summe:= reihenentwicklung(t)-0.25 

+  FI; 

+  summe-real(p - 4*k). 

+ 

+ normalise downwards: 

+  WHILE  x>= 16.0 REP 

+    x:=x/16.0;k:=k+1; 

+  END REP; 

+  WHILE  x>=0.5 REP 

+    x:=x/2.0;p:=p-1; 

+  END REP. 

+ 

+ normalise upwards: 

+  WHILE x<=0.0625 REP 

+    x:=x*16.0;k:=k-1; 

+  END REP; 

+  WHILE x<= 0.5 REP 

+    x:=x*2.0;p:=p+1; 

+  END REP. 

+ 

+END PROC log2; 

+ 

+REAL PROC reihenentwicklung(REAL CONST x):

+  REAL VAR i::39.0,s::1.0/39.0; 

+  LET ln2=0.6931471805599453; 

+  WHILE i>1.0 REP 

+    i:=i-2.0;s:=s*x*x + 1.0/i; 

+  END REP; 

+  s*2.0*x/ln2. 

+END PROC reihenentwicklung; 

+ 

+REAL PROC log10(REAL CONST x): 

+  LET lg2=0.301029995664; 

+  log2(x)*lg2. 

+END PROC log10; 

+ 

+REAL PROC sqrt(REAL CONST z): 

+  REAL VAR y0,y1,x::z; 

+  INT VAR p::0; 

+  BOOL VAR q::FALSE; 

+  IF   x<0.0 

+  THEN errorstop("sqrt von negativer zahl");0.0

+  ELSE correct 

+  FI. 

+ 

+ correct: 

+  IF   x=0.0 

+  THEN 0.0 

+  ELSE nontrivial 

+  FI. 

+ 

+ nontrivial: 

+  IF   x<0.01 

+  THEN small 

+  ELSE notsmall 

+  FI. 

+ 

+ 

+ notsmall: 

+  IF   x>1.0 

+  THEN big 

+  ELSE normal 

+  FI. 

+ 

+ small: 

+  WHILE x<0.01 REP 

+    p:=p-1;x:=x*100.0; 

+  END REP; 

+  normal. 

+ 

+ big: 

+  WHILE x>=1.0 REP

+    p:=p+1;x:=x/100.0; 

+  END REP; 

+  normal. 

+ 

+ normal: 

+  IF   x<0.1 

+  THEN x:=x*10.0;q:=TRUE 

+  FI; 

+  y0:=10.0**p*(1.681595-1.288973/(0.8408065+x)); 

+  IF   q 

+  THEN y0:=y0/3.162278 

+  FI; 

+  y1:=(y0+z/y0)/2.0; 

+  y0:=(y1+z/y1)/2.0; 

+  y1:=(y0+z/y0)/2.0; 

+  (y1-z/y1)/2.0+z/y1. 

+ 

+END PROC sqrt; 

+ 

+REAL PROC exp(REAL CONST z): 

+  REAL VAR c,d,x::z, a, b ; 

+  IF   x<-180.2187 

+  THEN 0.0 

+  ELIF x<0.0 

+  THEN 1.0/exp(-x) 

+  ELIF x=0.0 

+  THEN 1.0 

+  ELSE x:=x/0.6931471805599453;approx 

+  FI. 

+ 

+ approx: 

+  a:=floor(x/4.0)+1.0; 

+  b:=floor(4.0*a-x); 

+  c:=(4.0*a-b-x)*16.0; 

+  d:=(c -floor(c))/16.0; 

+  d:=d*0.6931471805599453; 

+  ( (16.0 POWER a) / (2.0 POWER b) / (1.044273782427419 POWER c ))* 

+  ((((((0.135910788320380e-2*d-0.8331563191293753e-2)*d 

+  +0.4166661437490328e-1)*d-0.1666666658727157)*d+0.4999999999942539)*d 

+  - 0.9999999999999844)*d+1.0). 

+ 

+ENDPROC exp ; 

+ 

+REAL OP POWER (REAL CONST basis, exponent) : 

+ 

+  IF floor (exponent) = 0.0 

+    THEN 1.0 

+    ELSE power 

+  FI . 

+ 

+power : 

+  REAL VAR counter := floor (abs (exponent)) - 1.0 , 

+           result  := basis ; 

+  WHILE counter > 0.0 REP 

+    result := result * basis ; 

+    counter := counter - 1.0 

+  PER ; 

+  IF exponent > 0.0 

+    THEN result 

+    ELSE 1.0 / result 

+  FI . 

+ 

+ENDOP POWER ; 

+ 

+REAL PROC tan (REAL CONST x): 

+  REAL VAR p; 

+  p:=1.273239544735168*ABSx; 

+  tg(p)*sign(x). 

+END PROC tan; 

+ 

+REAL PROC tand(REAL CONST x): 

+  REAL VAR p; 

+  p:=0.02222222222222222*ABSx; 

+  tg(p)*sign(x). 

+END PROC tand; 

+ 

+REAL PROC tg(REAL CONST x): 

+  REAL VAR r,s,u,q; 

+  q:=floor(x);r:=x-q; 

+  IF q = floor(q/2.0) * 2.0 

+  THEN s:=r 

+  ELSE s:=(1.0-r) 

+  FI; 

+  q:= q - floor(q/4.0) * 4.0 ; 

+  u:=s*s; 

+  s:=s*0.785398163397448; 

+  s:=s/(((((((((-0.4018243865271481e-10*u-0.4404768172667185e-9)*u- 

+  0.748183650813680e-8)*u-0.119216115119129e-6)*u-0.1909255769212821e-5)*u- 

+0.3064200638849133e-4)*u-0.4967495424202482e-3)*u-0.8455650263333471e-2)*u- 

+  0.2056167583560294)*u+1.0); 

+  IF   q=0.0 

+  THEN s 

+  ELIF q=3.0 

+  THEN -s 

+  ELIF q=1.0 

+  THEN 1.0/s 

+  ELSE -1.0/s 

+  FI . 

+ 

+END PROC tg;

+ 

+REAL PROC sin(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x*1.273239544735168; 

+  q:=int(y); 

+  r:=y-real(q); 

+  IF   x<0.0 

+  THEN q:=q+4 

+  FI; 

+  sincos(q,r). 

+END PROC sin; 

+ 

+REAL PROC sind(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABSx/45.0; 

+  q:=int(y); 

+  r:=y-real(q); 

+  IF   x<0.0 

+  THEN q:=q+4 

+  FI; 

+  sincos(q,r). 

+END PROC sind; 

+ 

+ 

+REAL PROC cos(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x*1.273239544735168; 

+  q:=int(y); 

+  r:=y-real(q); 

+  q:=q+2; 

+  sincos(q,r). 

+END PROC cos; 

+ 

+REAL PROC cosd(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x/45.0; 

+  q:=int(y); 

+  r:=y-real(q); 

+  q:=q+2; 

+  sincos(q,r). 

+END PROC cosd; 

+ 

+ 

+REAL PROC sincos(INT VAR q,REAL VAR r): 

+  SELECT q MOD 8 + 1 OF 

+  CASE 1 : sin approx(r) 

+  CASE 2 : cos approx (1.0-r) 

+  CASE 3 : cos approx(r) 

+  CASE 4 : sin approx(1.0-r) 

+  CASE 5 : - sin approx(r) 

+  CASE 6 : - cos approx(1.0-r) 

+  CASE 7 : - cos approx(r) 

+  CASE 8 : - sin approx(1.0-r) 

+  OTHERWISE 0.0 

+  END SELECT 

+END PROC sincos; 

+ 

+REAL PROC sin approx(REAL CONST x): 

+  REAL VAR z::x*x; 

+  x*((((((0.6877101540593035e-11*z-0.1757149296873372e-8)*z+0.313361621667256

+8

+e-6)*z-0.3657620415845891e-4)*z+0.2490394570188737e-2)*z-0.807455121882e-1 

+)*z+0.7853981633974483). 

+END PROC sin approx; 

+ 

+REAL PROC cos approx(REAL CONST x): 

+  REAL VAR z::x*x; 

+  (((((( -0.3857761864560276e-12*z+0.115004970178141e-9)*z-0.246113638267419e

+-7)*z+0.3590860445885748e-5)*z-0.3259918869266875e-3)*z+0.1585434424381541e-1

+)*z-0.3084251375340425)*z+1.0. 

+END PROC cos approx; 

+ 

+REAL PROC arctan(REAL CONST x): 

+REAL VAR z::x*x; 

+IF   x<0.0 THEN -arctan(-x) 

+ELIF x>1.0 THEN 3.141592653589792/2.0-arctan(1.0/x) 

+ELIF x*1.0e16>2.67949192431e15   THEN pi/6.0+arctan(1.732050807568877-4.0 

+/(x+1.732050807568877)) 

+ELSE  x/(((((((0.0107090276046822*z-0.01647757182108040)*z 

+      +0.02177846332482151)*z-0.03019339673273880)*z+0.04656083561183398)*z 

+      -0.0888888888888888)*z+0.3333333333333333)*z+1.0)FI. 

+END PROC arctan; 

+ 

+REAL PROC arctand(REAL CONST x): 

+  arctan(x)/3.1415926589793*180.0. 

+END PROC arctand; 

+ 

+ 

+BOOL PROC even(INT CONST number): 

+ (number DIV 2)*2=number. 

+END PROC even; 

+ 

+REAL OP **(REAL CONST base,exponent): 

+  IF   base<0.0 

+  THEN errorstop("hoch mit negativer basis") 

+  FI; 

+  IF   base=0.0 

+  THEN test exponent 

+  ELSE

+      exp(exponent*ln(base)) 

+  FI. 

+ 

+ test exponent: 

+  IF   exponent=0.0 

+  THEN errorstop("0**0 geht nicht");4711.4711 

+  ELSE 0.0 

+  FI. 

+ 

+END OP **; 

+ 

+ 

+REAL PROC sign(REAL CONST number): 

+  IF   number >0.0  THEN 1.0 

+  ELIF number <0.0  THEN -1.0 

+  ELSE 0.0 

+  FI. 

+END PROC sign ;

+ 

+REAL OP **(REAL CONST a,INT CONST b): 

+REAL VAR p::1.0,r::a;INT VAR n::ABS b; 

+WHILE n>0 REP 

+  IF   n MOD 2=0 

+  THEN n:=n DIV 2;r:=r*r 

+  ELSE n DECR 1;p:=p*r 

+  FI; 

+END REP; 

+IF   b>0 

+THEN p 

+ELSE 1.0/p 

+FI. 

+END OP **; 

+ 

+ 

+ 

+REAL PROC random: 

+rdg:=rdg+pi;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=frac(rdg);rdg. 

+END PROC random; 

+ 

+ 

+PROC initializerandom(REAL CONST z): 

+ rdg:=z; 

+END PROC initializerandom; 

+ 

+END PACKET mathlib; 

diff --git a/system/base/unknown/src/real b/system/base/unknown/src/real
new file mode 100644
index 0000000..a2ab9c3
--- /dev/null
+++ b/system/base/unknown/src/real
@@ -0,0 +1,378 @@
+ 

+PACKET real DEFINES                            (* Autor: J.Liedtke *) 

+                                               (* Stand: 30.04.80  *) 

+   text , 

+   int ,

+   real ,

+   round ,

+   floor , 

+   frac ,

+   INCR ,

+   DECR ,

+   abs , 

+   ABS , 

+   sign ,

+   SIGN ,

+   MOD ,

+   min ,

+   max ,

+   put , 

+   get , 

+   max real ,

+   small real :

+

+LET mantissa length = 13 ;

+

+TEXT VAR mantissa ;

+

+ROW 10 REAL VAR real digit ;

+ 

+INT VAR i ; REAL VAR d := 0.0 ;

+FOR i FROM 1 UPTO 10 REP

+  real digit (i) := d ;

+  d := d + 1.0

+PER ;

+ 

+REAL PROC max real : 9.999999999999e126 ENDPROC max real ;

+ 

+REAL PROC small real : 1.0e-12 ENDPROC small real ;

+ 

+PROC sld (INT CONST in, REAL VAR real, INT VAR out) :

+  EXTERNAL 96 

+ENDPROC sld ; 

+ 

+INT PROC decimal exponent (REAL CONST mantissa) : 

+  EXTERNAL 97 

+ENDPROC decimal exponent ; 

+ 

+PROC set exp (INT CONST exponent, REAL VAR number) : 

+  EXTERNAL 98 

+ENDPROC set exp ; 

+ 

+REAL PROC tenpower (INT CONST exponent) :

+  REAL VAR result := 1.0 ;

+  set exp (exponent, result) ;

+  result

+ENDPROC tenpower ;

+

+REAL PROC floor (REAL CONST real) : 

+  EXTERNAL 99 

+ENDPROC floor ; 

+ 

+REAL PROC round (REAL CONST real, INT CONST digits) : 

+ 

+  REAL VAR result := real ;

+  IF (real <> 0.0) CAND (decimal exponent (real) + digits < mantissa length)

+    THEN round result ;

+  FI ;

+  result .

+

+round result :

+  set exp (decimal exponent (result) + digits, result) ;

+  IF result >= 0.0

+    THEN result := floor (result + 0.5)

+    ELSE result := floor (result - 0.5)

+  FI ;

+  set exp (decimal exponent (result) - digits, result) .

+

+ENDPROC round ; 

+ 

+TEXT VAR result ;

+ 

+TEXT PROC text (REAL CONST real) : 

+ 

+  REAL VAR value := rounded to seven digits ; 

+  IF value = 0.0 

+    THEN "0.0" 

+    ELSE 

+      process sign ; 

+      get mantissa (value) ; 

+      INT CONST exponent := decimal exponent (value) ; 

+      get short mantissa ; 

+      IF exponent > 7 OR exponent < LENGTH short mantissa - 7 

+        THEN scientific notation 

+        ELSE short notation 

+      FI 

+    FI . 

+ 

+rounded to seven digits : 

+  round ( real * tenpower( -decimal exponent(real) ) , 6 ) 

+        * tenpower ( decimal exponent(real) ) . 

+ 

+process sign : 

+  IF value < 0.0 

+    THEN result := "-" ; 

+         value := - value 

+    ELSE result := "" 

+  FI . 

+ 

+get short mantissa : 

+  INT VAR i := 7 ; 

+  WHILE (mantissa SUB i) = "0" REP 

+    i DECR 1 

+  UNTIL i=1 END REP ; 

+  TEXT CONST short mantissa := subtext (mantissa, 1, i) . 

+ 

+scientific notation : 

+  result CAT (mantissa SUB 1) ; 

+  result CAT "." ; 

+  result CAT subtext (mantissa, 2, 7) ; 

+  result + "e" + text (exponent) . 

+ 

+short notation : 

+  result CAT subtext (short mantissa, 1, exponent+1) ; 

+  result CAT (exponent+1 - LENGTH short mantissa) * "0" ; 

+  result CAT "." ; 

+  IF exponent < 0 

+    THEN result + (-exponent-1) * "0" + short mantissa 

+    ELSE result + subtext (short mantissa, exponent+2) 

+  FI . 

+ 

+ENDPROC text ; 

+ 

+PROC get mantissa (REAL CONST number) :

+

+  REAL VAR real mantissa := number ;

+  mantissa := "" ;

+  INT VAR i , digit ;

+  FOR i FROM 1 UPTO mantissa length REP

+    sld (0, real mantissa, digit) ;

+    mantissa CAT code (digit + 48)

+  PER ;

+

+ENDPROC get mantissa ;

+

+PROC put (REAL CONST real) : 

+ 

+  put (text (real) ) 

+ 

+ENDPROC put ; 

+ 

+TEXT PROC text (REAL CONST real, INT CONST length, fracs) :

+ 

+  REAL VAR value := round (real, fracs) ;

+  INT VAR  exponent  := decimal exponent (value) ;

+           IF value = 0.0 THEN exponent := 0 FI ;

+  INT VAR  floors    := exponent + 1 ,

+           floor length := length - fracs - 1 ;

+           IF value < 0.0 THEN floor length DECR 1 FI ;

+ 

+  IF value too big

+    THEN length * "*"

+    ELSE transformed value

+  FI .

+ 

+transformed value :

+  process leading blanks and sign ;

+  get mantissa (value) ;

+  result CAT subtext (mantissa, 1, floors) ;

+  IF LENGTH mantissa < floors

+    THEN result CAT (floors - LENGTH mantissa) * "0"

+  FI ;

+  result CAT "." ;

+  IF exponent < 0

+    THEN result CAT (-floors) * "0" ;

+         result CAT subtext (mantissa, 1, length - LENGTH result)

+    ELSE result CAT subtext (mantissa, floors+1, floors + fracs)

+  FI ;

+  IF LENGTH result < length

+    THEN result CAT (length - LENGTH result) * "0"

+  FI ;

+  result .

+ 

+process leading blanks and sign :

+  result := (floor length - max(floors,0)) * " " ;

+  IF value < 0.0

+    THEN result CAT "-" ;

+         value := - value

+  FI .

+ 

+value too big :

+  floors > floor length .

+ 

+ENDPROC text ;

+ 

+REAL PROC real (TEXT CONST text) : 

+ 

+  skip leading blanks ;

+  sign ; 

+  mantissa part ; 

+  exponent ; 

+  check correct conversion ;

+  result . 

+ 

+skip leading blanks :

+  INT VAR pos := 1 ;

+  skip blanks .

+ 

+skip blanks :

+  WHILE (text SUB pos) = " " REP

+    pos INCR 1

+  PER .

+ 

+sign : 

+  BOOL VAR negative ; 

+  IF (text SUB pos) = "-" 

+    THEN negative := TRUE ; 

+         pos INCR 1

+  ELIF (text SUB pos) = "+" 

+    THEN negative := FALSE ; 

+         pos INCR 1

+  ELSE   negative := FALSE

+  FI . 

+ 

+mantissa part: 

+  REAL VAR value := 0.0 ; 

+  INT VAR exponent pos := 0 ;

+  WHILE pos <= LENGTH text REP 

+    TEXT VAR digit := text SUB pos ; 

+    IF digit <= "9" AND digit >= "0" 

+      THEN value := value * 10.0 + real digit (code (digit) - 47) ;

+           pos INCR 1 

+    ELIF digit = "." 

+      THEN pos INCR 1 ;

+           exponent pos := pos

+    ELSE LEAVE mantissa part 

+    FI 

+  END REP . 

+ 

+exponent : 

+  INT VAR exp ;

+  IF exponent pos > 0

+    THEN exp := exponent pos - pos

+    ELSE exp := 0

+  FI ;

+  IF (text SUB pos) = "e" 

+    THEN exp INCR int (subtext(text,pos+1)) 

+  FI . 

+ 

+check correct conversion :

+  skip blanks ;

+  IF pos > LENGTH text

+    THEN set conversion (TRUE)

+    ELSE set conversion (FALSE)

+  FI .

+ 

+result : 

+  value := value * tenpower (exp) ; 

+  IF negative 

+    THEN - value 

+    ELSE value 

+  FI . 

+ 

+ENDPROC real ; 

+ 

+TEXT VAR word ;

+ 

+PROC get (REAL VAR value) : 

+ 

+  get (word) ; 

+  value := real (word) 

+ 

+ENDPROC get ; 

+ 

+REAL PROC abs (REAL CONST value) : 

+ 

+  IF value >= 0.0 

+    THEN  value 

+    ELSE -value 

+  FI 

+ 

+ENDPROC abs ; 

+ 

+REAL OP ABS (REAL CONST value) : 

+ 

+  abs (value) 

+ 

+ENDOP ABS ; 

+ 

+INT PROC sign (REAL CONST value) :

+ 

+  IF   value < 0.0 THEN -1

+  ELIF value = 0.0 THEN  0

+  ELSE                   1

+  FI

+ 

+ENDPROC sign ;

+ 

+INT OP SIGN (REAL CONST value) :

+ 

+  sign (value)

+ 

+ENDOP SIGN ;

+ 

+REAL OP MOD (REAL CONST left, right) :

+ 

+  REAL VAR result := left - floor (left/right) * right ;

+  IF left < 0.0

+    THEN result + abs (right)

+    ELSE result

+  FI

+ 

+ENDOP MOD ;

+ 

+REAL PROC frac (REAL CONST value) :

+ 

+  value - floor (value)

+ 

+ENDPROC frac ;

+ 

+REAL PROC max (REAL CONST a, b) :

+ 

+  IF a > b THEN a ELSE b FI

+ 

+ENDPROC max ;

+ 

+REAL PROC min (REAL CONST a, b) :

+ 

+  IF a < b THEN a ELSE b FI

+ 

+ENDPROC min ;

+ 

+OP INCR (REAL VAR dest, REAL CONST increment) :

+ 

+  dest := dest + increment

+ 

+ENDOP INCR ;

+ 

+OP DECR (REAL VAR dest, REAL CONST decrement) : 

+ 

+  dest := dest - decrement

+ 

+ENDOP DECR ;

+ 

+INT PROC int (REAL CONST value) :

+ 

+  INT VAR result := 0, digit ,i ;

+  REAL VAR mantissa := value ;

+ 

+  FOR i FROM 0 UPTO decimal exponent (value) REP

+    sld (0, mantissa, digit) ;

+    result := result * 10 + digit 

+  PER ;

+ 

+  IF value < 0.0

+    THEN - result

+    ELSE   result

+  FI

+ 

+ENDPROC int ;

+ 

+REAL PROC real (INT CONST value) :

+ 

+  IF value < 0

+    THEN - real (-value)

+  ELIF value < 10

+    THEN real digit (value+1)

+    ELSE split value into head and last digit ;

+         real (head) * 10.0 + real digit (last digit+1)

+  FI .

+ 

+split value into head and last digit :

+  INT CONST

+  head := value DIV 10 ,

+  last digit := value - head * 10 .

+ 

+ENDPROC real ;

+ 

+ENDPACKET real ; 

diff --git a/system/base/unknown/src/scanner b/system/base/unknown/src/scanner
new file mode 100644
index 0000000..ed04699
--- /dev/null
+++ b/system/base/unknown/src/scanner
@@ -0,0 +1,255 @@
+ 

+PACKET scanner DEFINES                (* Autor: J.Liedtke        *)

+                                      (* Stand: 30.12.81         *)

+       scan , 

+       continue scan ,

+       next symbol , 

+       fix scanner ,

+       reset scanner :

+ 

+ 

+LET tag     = 1 ,

+    bold    = 2 , 

+    integer = 3 ,

+    text    = 4 ,

+    operator= 5 ,

+    delimiter = 6 , 

+    end of file = 7 , 

+    within comment = 8 ,

+    within text    = 9 ;

+ 

+ 

+TEXT VAR line := "" , 

+         char := "" ; 

+ 

+INT VAR  position  := 0 ,

+         reset position ,

+         comment depth ;

+BOOL VAR continue text ;

+ 

+ 

+PROC scan (TEXT CONST scan text) : 

+ 

+  comment depth := 0 ;

+  continue text := FALSE ;

+  continue scan (scan text)

+ 

+ENDPROC scan ;

+ 

+PROC continue scan (TEXT CONST scan text) :

+ 

+  line := scan text ;

+  position  := 0 ;

+  next non blank char ;

+  reset position := position

+ 

+ENDPROC continue scan ;

+

+PROC fix scanner :

+

+  reset position := position

+

+ENDPROC fix scanner ;

+

+PROC reset scanner :

+

+  position := reset position ;

+  char := line SUB position

+

+ENDPROC reset scanner ;

+ 

+PROC next symbol (TEXT VAR symbol) : 

+ 

+  INT VAR type ;

+  next symbol (symbol, type) 

+ 

+ENDPROC next symbol ;

+ 

+PROC next symbol (TEXT VAR symbol, INT VAR type) : 

+ 

+  skip blanks ;

+  symbol := "" ;

+  IF   is niltext THEN eof

+  ELIF is comment THEN process comment

+  ELIF is text THEN process text 

+  ELIF is lower case letter THEN process tag 

+  ELIF is upper case letter THEN process bold 

+  ELIF is digit THEN process integer

+  ELIF is delimiter THEN process delimiter

+  ELSE  process operator 

+  FI . 

+ 

+skip blanks : 

+  IF char = " " 

+    THEN next non blank char 

+  FI . 

+ 

+ 

+process comment :

+  read comment ;

+  IF comment depth = 0

+    THEN next symbol (symbol, type)

+    ELSE type := within comment

+  FI .

+ 

+process tag : 

+  type := tag ;

+  REP 

+    symbol CAT char ;

+    next non blank char 

+  UNTIL NOT (is lower case letter OR is digit) ENDREP .

+ 

+process bold : 

+  type := bold ;

+  REP 

+    symbol CAT char ; 

+    next char 

+  UNTIL NOT is upper case letter ENDREP .

+ 

+process integer :

+  type := integer ;

+  REP 

+    symbol CAT char ; 

+    next non blank char 

+  UNTIL NOT (is digit OR char = ".") ENDREP . 

+ 

+process text : 

+  type := text ;

+  IF continue text

+    THEN continue text := FALSE

+    ELSE next char

+  FI ;

+  WHILE not end of text REP 

+    symbol CAT char ;

+    next char 

+  ENDREP . 

+ 

+not end of text : 

+  IF is niltext 

+    THEN continue text := TRUE ; type := within text ; FALSE

+  ELIF is quote 

+    THEN end of text or exception

+  ELSE TRUE 

+  FI . 

+ 

+end of text or exception :

+  next char ;

+  IF is quote

+    THEN TRUE

+  ELIF is digit

+    THEN get special char ; TRUE

+  ELSE FALSE

+  FI .

+ 

+get special char :

+  TEXT VAR special symbol ;

+  next symbol (special symbol) ;

+  char := code ( int (special symbol ) ) .

+ 

+process delimiter : 

+  type := delimiter ;

+  symbol := char ;

+  next non blank char . 

+ 

+process operator : 

+  type := operator ; 

+  symbol := char ;

+  nextchar ;

+  IF symbol = ":" 

+    THEN IF char = "=" OR char = ":" 

+           THEN symbol := ":=" ;

+                nextchar 

+           ELSE type := delimiter 

+         FI 

+  ELIF is relational double char 

+    THEN symbol CAT char ;

+         nextchar 

+  ELIF symbol = "*" AND char = "*" 

+    THEN symbol := "**" ; 

+         next char 

+  FI .

+ 

+eof : 

+  type := end of file ;

+  symbol := "" .

+ 

+is lower case letter :  char lies in (97, 122) . 

+ 

+is upper case letter :  char lies in (65, 90) . 

+ 

+is digit :  char lies in (48, 57) . 

+ 

+is delimiter : pos ( "()[].,;" , char ) > 0 AND char <> "" . 

+ 

+is relational double char : 

+  TEXT VAR double := symbol + char ; 

+  double = "<>" OR double = "<=" OR double = ">=" . 

+ 

+is text : is quote OR continue text .

+ 

+is quote : char = """" .

+ 

+is niltext : char = "" . 

+ 

+is comment :

+  IF comment depth = 0

+    THEN char = "{" OR char = "(" AND ahead char = "*"

+    ELSE comment depth DECR 1 ; TRUE

+  FI .

+ 

+ENDPROC next symbol ;

+ 

+PROC next char : 

+ 

+  position INCR 1 ;

+  char := line SUB position

+ 

+ENDPROC next char ;

+ 

+PROC next non blank char : 

+ 

+  REP 

+   position INCR 1 

+  UNTIL (line SUB position) <> " " ENDREP ;

+  char := line SUB position

+ 

+ENDPROC next non blank char ; 

+ 

+TEXT PROC ahead char : 

+ 

+  line SUB position+1 

+ 

+ENDPROC ahead char ; 

+ 

+BOOL PROC char lies in (INT CONST lower bound, upper bound) : 

+ 

+  lower bound <= code(char) AND code(char) <= upper bound 

+ 

+ENDPROC char lies in ;

+ 

+PROC read comment : 

+ 

+  TEXT VAR last char ; 

+  comment depth INCR 1 ;

+  REP 

+    last char := char ; 

+    nextchar ; 

+    IF is begin comment

+      THEN read comment

+    FI ;

+    IF char = ""

+      THEN LEAVE read comment

+    FI

+  UNTIL is end comment PER ; 

+  comment depth DECR 1 ;

+  next nonblank char . 

+ 

+is end comment :

+  char = "}" OR char = ")" AND last char = "*" .

+ 

+is begin comment :

+  char = "{" OR char = "(" AND ahead char = "*" .

+ 

+ENDPROC read comment ;

+ 

+ENDPACKET scanner ;

diff --git a/system/base/unknown/src/stdescapeset b/system/base/unknown/src/stdescapeset
new file mode 100644
index 0000000..0c69ea7
--- /dev/null
+++ b/system/base/unknown/src/stdescapeset
@@ -0,0 +1,31 @@
+PACKET  std escape set                              (* Autor: P.Heyderhoff *)

+        (************)                              (* Stand: 20.01.1981   *)

+                                                    (* Vers.: 1.5.5        *)

+DEFINES std escape set :

+ 

+PROC std escape set : 

+ 

+  define escape ("p", "IFmark>0THEN PUT"""";W""""12""""FI") ;

+  define escape ("g", "GET"""";M0") ;

+  define escape ("d", "IFmark>0THEN PUT"""";M0ELSE GET"""";M0FI");

+  define escape ("B", "W""""194""""") ;

+  define escape ("A", "W""""193""""") ;

+  define escape ("O", "W""""207""""") ;

+  define escape ("U", "W""""213""""") ;

+  define escape ("a", "W""""225""""") ;

+  define escape ("o", "W""""239""""") ;

+  define escape ("u", "W""""245""""") ;

+  define escape ("z", "C1;""""C(((limit-len)/2)*"" "")") ;

+  define escape ("l", "i:=col;C1;M1;Ci;W""""12""""") ;

+  define escape ("h", "S11") ;

+  define escape ("v", "S23") ;

+  define escape ("1", "1;C1"); 

+  define escape ("9", "9999;C(len+1)");

+  define escape (""2"", """ """);

+  define escape (""10"","+1;R Clen;"" ""Ucol>lenE");

+  define escape (""3"", "R-1;Hrow;Clen;"" ""Ucol>lenE"); 

+  define escape (""8"", "COL(col-10)");

+ 

+ENDPROC std escape set ;

+ 

+ENDPACKET std escape set ; 

diff --git a/system/dos/1.8.7/doc/dos-dat-handbuch b/system/dos/1.8.7/doc/dos-dat-handbuch
new file mode 100644
index 0000000..a1e4fd4
--- /dev/null
+++ b/system/dos/1.8.7/doc/dos-dat-handbuch
@@ -0,0 +1,650 @@
+____________________________________________________________________________ 
+ 
+ 
+#on("b")##on ("u")# 
+#center#Betriebssystem E U M E L 
+#off ("u")# 
+ 
+ 
+#center#MS-DOS-DAT 
+ 
+ 
+ 
+ 
+#off("b")# 
+#center#Lizenzfreie Software der 
+#on ("b")# 
+ 
+#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, 
+#center#5205 Sankt Augustin 
+ 
+ 
+#off("b")# 
+#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für 
+#center#nichtkommerzielle Zwecke gestattet. 
+ 
+#center#Gewährleistung und Haftung werden ausgeschlossen 
+ 
+ 
+____________________________________________________________________________ 
+#page# 
+#free(4.5)# 
+ 
+#center#Lesen und Schreiben 
+#center#von 
+#center#MS-DOS Dateien 
+ 
+#on ("b")##center#MS-DOS-DAT#off ("b")# 
+#free(1.5)# 
+ 
+ 
+#center#Version 2.0 
+ 
+#center#Stand 10.09.87 
+#page# 
+#pagenr ("%",1)##setcount (1)##block##pageblock##count per page# 
+#headeven# 
+% #center#MS-DOS-DAT 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#MS-DOS-DAT#right#% 
+#center#____________________________________________________________ 
+ 
+#end# 
+#on("bold")# 
+#ib#1. Allgemeines#ie# 
+#off ("b")# 
+ 
+Dieses Programm ermöglicht MS-DOS Dateien vom EUMEL aus von Disketten zu
+lesen und auf Disketten zu schreiben. Die Benutzerschnittstelle ist ähnlich der des
+EUMEL-Archivs organisiert. Der Benutzer kommuniziert mit einer Task des
+EUMEL-Systems, nämlich mit der Task 'DOS'. Diese wickelt dann über das Archiv­
+laufwerk die Diskettenzugriffe ab. Der Benutzer meldet die MS-DOS Diskette mit
+'reserve ("...", /"DOS")' an und kann dann mit 'list (/"DOS")', 'fetch ("...", /"DOS")',
+'save ("...", /"DOS")' und weiteren Kommandos auf die MS-DOS Diskette zugreifen.
+Für das Schreiben und Lesen (save, fetch) stehen insgesamt 7 verschiedene Be­
+triebsarten zur Verfügung. Man kann in eine Datei im ASCII Code mit und ohne
+Anpassung der Umlaute, im IBM-ASCII Code, im Atari-ST Code oder ganz ohne
+Codeumsetzung lesen bzw. schreiben. Die Betriebsart selbst wird beim Anmelden der
+MS-DOS Diskette durch den Textparameter des 'reserve'-Kommandos bestimmt. 
+ 
+Die gleiche Benutzerschnittstelle gilt für die Kommunikation mit der Task 'DOS HD'.
+Diese Task liest und schreibt aber nicht auf der Diskette, sondern in der MS-DOS
+Partition der Festplatte (falls vorhanden). 
+ 
+ 
+#on("bold")# 
+#ib#2. Benutzeranleitung #ie# 
+#off ("b")# 
+Im Normalfall will man als Benutzer eine EUMEL-Textdatei auf eine MS-DOS
+Diskette schreiben oder eine mit z.B. Word-Star erstellte MS-DOS-Textdatei in
+das EUMEL-System einlesen (implementierte Formate siehe Abschnitt 3). 
+ 
+Lesen einer MS-DOS-Datei: 
+ 
+#linefeed (1.25)# 
+#on ("b")# 
+  reserve ("file ascii german", /"DOS"); 
+  (* MS-DOS-Diskette ins Laufwerk einlegen *) 
+  fetch (filename, /"DOS"); 
+  release (/"DOS") 
+#off ("b")# 
+ 
+Schreiben einer MS-DOS-Datei: 
+ 
+#on ("b")# 
+  reserve ("file ascii german", /"DOS"); 
+  (* MS-DOS-Diskette ins Laufwerk einlegen *) 
+  save (filename, /"DOS"); 
+  release (/"DOS") 
+#off("b")# 
+#linefeed (1.0)# 
+ 
+ 
+Sollen statt der Umlaute []{|}\ verwendet werden, so ist statt "file ascii german" "file
+ascii" einzustellen. Eine genaue Beschreibung aller 7 möglichen Betriebsarten wird in
+Abschnitt 6 gegeben. Der Dateiname 'file name' unterliegt den im Abschnitt 4 be­
+schriebenen Einschränkungen. 
+ 
+ 
+#on("bold")# 
+#ib#3. Implementierte Formate#ie# 
+#off("b")#
+ 
+Diese Hardware ermöglicht das Bearbeiten von MS-DOS Disketten mit Hilfe der
+Task /"DOS" und (falls es sich um einen MS-DOS fähigen Rechner mit MS-DOS Parti­
+tion auf der Festplatte handelt) das Bearbeiten von Daten in der MS-DOS Partition
+der Platte. 
+ 
+#on("bold")# 
+#ib#3.1 Arbeiten mit der Task /"DOS"#ie# 
+#off ("b")# 
+ 
+Die Task /"DOS" verwendet das Archivlaufwerk als MS-DOS Datenträger. Es sind
+alle mit dem IBM-Format der DOS Version 2 und 3 kompatiblen Formate für 5.25
+Zoll und 3.5 Zoll Disketten implementiert, sofern diese 512 Byte große Sektoren
+verwenden und im ersten Sektor einen erweiterten BIOS-Parameterblock (BPB)
+enthalten (hierzu gehören auch mit dem Atari ST bearbeitete Disketten). Weiterhin
+sind die beiden von IBM verwendeten Formate der DOS Version 1 implementiert (5.25
+Zoll, ein- bzw. zweiseitig, 40 Spuren a 8 Sektoren). 
+ 
+Die einzige Hardwarevoraussetzung besteht darin, daß der Hardwareanpassungs­
+modul (SHard) alle von DOS benutzten Sektoren lesen und schreiben können muß. 
+ 
+#on("bold")# 
+#ib#3.2 Arbeiten mit der Task /"DOS HD"#ie# 
+#off ("b")# 
+ 
+Die Task /"DOS HD" verwendet die MS-DOS Partition der Festplatte als Daten­
+träger (falls eine solche vorhanden ist und das SHard diese ansprechen kann). Hier
+gibt es keine Beschränkungen bezüglich des Plattentyps. 
+ 
+ 
+#on("bold")# 
+#ib#4. Dateibenennung#ie# 
+#off ("b")# 
+ 
+Die Namen für MS-DOS Dateien unterliegen bestimmten Regeln. Ein Dateiname
+kann aus 
+-  einem bis acht Zeichen  oder 
+-  einem bis acht Zeichen gefolgt von einem Punkt und einer Namenserweiterung
+   von einem bis drei Zeichen 
+bestehen. 
+ 
+Gültige Zeichen sind 
+-  die Buchstaben A bis Z 
+-  die Ziffern 0 bis 9 
+-  die Sonder- und Satzzeichen $ \# & § ! ( ) { } 
+ 
+Da weitere Sonderzeichen in verschiedenen MS-DOS Versionen in unterschiedlich­
+em Umfang erlaubt sind, ist ihre Verwendung beim Schreiben (save) vom EUMEL aus
+nicht zugelassen. Beim Lesen und Löschen dagegen sind sie erlaubt. 
+ 
+Außerdem sind die Buchstaben a - z erlaubt. Diese werden beim Zugriff auf das
+MS-DOS Inhaltsverzeichnis (Directory) in große Buchstaben konvertiert. Durch das
+Kommando 'fetch ("Test", /"DOS")' wird also die MS-DOS Datei mit dem Namen
+'TEST' in die EUMEL Datei mit dem Namen 'Test' gelesen; 'save ("test", /"DOS")'
+überschreibt dann die MS-DOS-Datei 'TEST' (natürlich nach Anfrage). 
+ 
+ 
+#on("bold")# 
+#ib#5. Beschreibung der Kommandos#ie# 
+#off ("b")# 
+ 
+In diesem Abschnitt steht der Begriff Dostask beim Arbeiten mit der Floppy für die
+Task /"DOS" und beim Arbeiten mit der MS-DOS Partition der Platte für die Task
+/"DOS HD". Analog steht der Begriff Dosbereich beim Arbeiten mit der Floppy für die
+Floppy und beim Arbeiten mit der MS-DOS Partition der Platte für diese Partition. 
+ 
+#on("bold")# 
+THESAURUS OP ALL (TASK CONST task) 
+#off ("b")# 
+  Wird der 'ALL'-Operator für die Dostask aufgerufen, so wird ein Thesaurus ge­
+  liefert. In diesem Thesaurus sind alle im Dosbereich vorhandenen Dateien einge­
+  tragen. Die vorhandenen Unterinhaltsverzeichnisse (Subdirectories) werden nicht
+  eingetragen. 
+ 
+ 
+#on("bold")# 
+PROC check (TEXT CONST filename, TASK CONST task) 
+#off ("b")# 
+  Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' im Dosbe­
+  reich prüfgelesen. Es werden nur die mit Daten belegten Blöcke prüfgelesen. Sollen
+  auch der Einträge im Inhaltsverzeichnis überprüft werden, so erreicht man dies
+  durch vorheriges neues Anmelden mit der Prozedur 'reserve'. 
+ 
+ 
+#on("bold")# 
+PROC clear (TASK CONST task) 
+#off ("b")# 
+  Durch Aufruf dieser Prozedur für die Task /"DOS" wird die gesamte Diskette ge­
+  löscht. Mit dieser Prozedur können #on ("u")#nur MS-DOS formatierte Disketten#off ("u")# behandelt
+  werden. Soll eine Diskette dagegen für den Gebrauch unter MS-DOS initialisiert
+  werden, so ist sie auf einem MS-DOS-Rechner zu formatieren. 
+ 
+  Der Aufruf dieser Prozedur für die Task /DOS HD" ist aus Sicherheitsgründen nicht
+  erlaubt. 
+ 
+ 
+#on("bold")# 
+PROC erase (TEXT CONST filename, TASK CONST task) 
+#off ("b")# 
+  Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' im Dosbe­
+  reich gelöscht. 
+ 
+ 
+#on("bold")# 
+BOOL PROC exists (TEXT CONST name, TASK CONST task) 
+#off ("b")# 
+  Wird diese Prozedur für die Dostask aufgerufen, so liefert sie 'TRUE', falls eine
+  Datei mit dem Namen 'name' im Dosbereich existiert. Andernfalls liefert sie
+  'FALSE'. 
+ 
+ 
+#on("bold")# 
+PROC fetch (TEXT CONST filename, TASK CONST task) 
+#off ("b")# 
+  Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' aus dem
+  Dosbereich gelesen. Hierbei wird in der beim Anmelden (reserve ("...", dostask))
+  bestimmten Betriebsart gelesen (siehe Abschnitt 6). 
+ 
+ 
+#on("bold")# 
+PROC list (TASK CONST task) 
+#off ("b")# 
+  Wird diese Prozedur für die Dostask aufgerufen, so werden alle Dateien des In­
+  haltsverzeichnisses und alle Unterverzeichnisse des Dosbereichs aufgelistet. 
+ 
+ 
+#on("bold")# 
+PROC release (TASK CONST task) 
+#off ("b")# 
+  Der Aufruf dieser Prozedur für die Task Dostask hebt deren Reservierung auf.
+  Gleichzeitig wird auch der für block i/o benutzte Kanal freigegeben, so daß bei
+  Benutzung der Task /"DOS" der Archivkanal durch das EUMEL-Archiv wieder
+  benutzt werden kann. 
+ 
+  Um möglichst effizient arbeiten zu können, werden Inhaltsverzeichnis und Ket­
+  tungsblock des Dosbereichs als Kopie im EUMEL gehalten. Der hierdurch belegte
+  Speicher wird beim 'release' wieder freigegeben. Dies ist bei kleinen Systemen
+  besonders wichtig. 
+ 
+ 
+#on("bold")# 
+PROC reserve (TEXT CONST mode, TASK CONST task) 
+#off ("b")# 
+  Durch Aufruf für die Dostask werden Operationen mit dem Dosbereich angemel­
+  det. Gleichzeitig koppelt sich die Dostask an den entsprechenden Kanal an.
+  (/"DOS" an Kanal 31 und /"DOS HD" an Kanal 29). Die Anmeldung wird abge­
+  lehnt, wenn der für die MS-DOS Operationen benötigte Kanal belegt ist (z.B. bei
+  Kanal 31 durch eine Archiv­Operation). Ähnlich wie beim EUMEL-Archiv bleibt
+  diese Reservierung bis 5 Minuten nach dem letzten Zugriff gültig. 
+ 
+  Wird beim Arbeiten mit der Task /"DOS" die MS-DOS Diskette gewechselt, so
+  muß erneut 'reserve ("...", /"DOS")' aufgerufen werden. Nur so ist gewährleistet,
+  daß das Inhaltsverzeichnis der neuen Diskette geladen wird. 
+ 
+  Der Text 'mode' gibt die Betriebsart für das Schreiben und Lesen der Diskette
+  sowie den Pfad für das Bearbeiten von Subdirectories an und nicht wie beim
+  EUMEL-Archiv den Diskettennamen. Es gilt folgende Systax: 
+ 
+    modus :[\directory][\directory]...[\directory] 
+ 
+  Hierbei sind die Angaben in eckigen Klammern optional. Wird kein Pfad angege­
+  ben, so wird mit dem Hauptdirektory der Diskette gearbeitet. Ansonsten wird mit
+  dem Directory gearbeitet, welches durch den hinter dem Doppelpunkt angegeben
+  Pfad bezeichnet wird. Als 'modus' können alle in Abschnitt 6 beschriebenen Be­
+  triebsarten verwendet werden. 
+ 
+ 
+#on("bold")# 
+PROC save (TEXT CONST filename, TASK CONST task) 
+#off ("b")# 
+  Durch Aufruf dieser Prozedur für die Dostask wird die Datei 'filename' in den
+  Dosbereich geschrieben. Hierbei wird in der beim Anmelden (reserve ("...",
+  dostask)) bestimmten Betriebsart geschrieben (siehe Abschnitt 6). 
+ 
+ 
+#on("bold")# 
+#ib#6. Die Betriebsarten von 'fetch' und 'save'#ie# 
+ 
+#ib#6.1 Betriebsart: file ascii#ie# 
+ 
+#on("bold")# 
+fetch ("filename", dostask) 
+#off ("b")# 
+  Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei
+  werden von allen Zeichen nur die niederwertigen 7 Bit gemäß DIN 66 003, ASCII
+  Code, internationale Referenzversion interpretiert. Die Datei wird so aufbereitet, daß
+  ein Bearbeiten mit dem EUMEL-Editor möglich ist. Dies geschieht folgenderma­
+  ßen: 
+    -  Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. 
+    -  Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line­
+       feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird
+       eumelseitig die aktuelle Zeile beendet. 
+    -  Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem
+       wird ein Satz mit dem Inhalt "\#page\#" eingefügt. 
+    -  TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. 
+    -  'Ctrl z' in der MS-DOS Datei wird als Dateiende interpretiert. Fehlt dieses,
+       so wird bis zum letzten Zeichen des letzten Sektors der Datei gelesen. 
+    -  Alle anderen Zeichen mit 0 <= code (zeichen) <=  31 (Steuerzeichen)
+       werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird
+       als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). 
+ 
+ 
+#on("bold")# 
+save ("filename", dostask) 
+#off ("b")# 
+  Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS
+  wird der ASCII Code, internationale Referenzversion gemäß DIN 66 003 verwendet.
+  Dies geschieht folgendermaßen: 
+    -  Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge­
+       schütztes Blank) werden in -, k, \# und Blank umgesetzt. 
+    -  Alle in der internationalen Referenzversion des ASCII Codes vorhandenen
+       Eumel-Zeichen werden auf diese abgebildet. 
+    -  Alle in der internationalen Referenzversion des ASCII Codes nicht vorhande­
+       nen Eumel-Zeichen werden durch eine Ersatzdarstellung dargestellt (der
+       Code des Zeichens wird als 3 stellige Dezimalzahl eingeschlossen von
+       \#-Zeichen dargestellt) 
+    -  Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei­
+       tenvorschubsteuerzeichen (""12"") umgewandelt. 
+    -  Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz­
+       darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen
+       Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h.
+       durch das entsprechende Zeichen ersetzt). 
+    -  Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt 
+    -  Am Ende der Datei wird 'ctrl z' angehängt. 
+ 
+ 
+#on("bold")# 
+#ib#6.2 Betriebsart: file ascii german#ie# 
+ 
+fetch ("filename", dostask) 
+#off ("b")# 
+  Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei
+  werden von allen Zeichen nur die niederwertigen 7 Bit gemäß DIN 66 003, ASCII
+  Code, deutsche Referenzversion interpretiert. Die Datei wird so aufbereitet, daß ein
+  Bearbeiten mit dem EUMEL-Editor möglich ist. Dies geschieht wie in der Be­
+  triebsart 'file ascii', jedoch stehen statt []{}|\ die Umlaute und ß zur Verfügung. 
+ 
+ 
+#on("bold")# 
+save ("filename", dostask) 
+#off ("b")# 
+  Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS
+  wird der ASCII Code, deutsche Referenzversion gemäß DIN 66 003 verwendet. Dies
+  geschieht wie in der Betriebsart 'file ascii', jedoch stehen statt []{}|\ die Umlaute
+  zur Verfügung. 
+ 
+ 
+#on("bold")# 
+#ib#6.3 Betriebsart: file ibm#ie# 
+ 
+fetch ("filename", dostask) 
+#off ("b")# 
+  Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei
+  werden alle Zeichen wie in der von IBM verwendeten Version des ASCII Codes
+  interpretiert. Die Datei wird so aufbereitet, daß ein Bearbeiten mit dem EUMEL-
+  Editor möglich ist. Dies geschieht folgendermaßen: 
+    -  Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. 
+    -  Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line­
+       feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird
+       eumelseitig die aktuelle Zeile beendet. 
+    -  Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem
+       wird ein Satz mit dem Inhalt "\#page\#" eingefügt. 
+    -  TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. 
+    -  Alle anderen Zeichen mit 0 <= code (zeichen) <=  31 (Steuerzeichen)
+       werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird
+       als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). 
+ 
+ 
+#on("bold")# 
+save ("filename", dostask) 
+#off ("b")# 
+  Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS
+  wird der ASCII Code in der von IBM verwendeten Version verwendet. Dies ge­
+  schieht folgendermaßen: 
+    -  Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge­
+       schütztes Blank) werden in -, k, \# und Blank umgesetzt. 
+    -  Alle in der IBM Version des ASCII Codes vorhandenen Eumel-Zeichen
+       werden auf diese abgebildet. 
+    -  Alle in der IBM Version des ASCII Codes nicht vorhandenen Eumel-Zeichen
+       werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird
+       als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt) 
+    -  Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei­
+       tenvorschubsteuerzeichen (""12"") umgewandelt. 
+    -  Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz­
+       darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen
+       Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h.
+       durch das entsprechende Zeichen ersetzt). 
+    -  Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt 
+ 
+ 
+#on("bold")# 
+#ib#6.4 Betriebsart: file atari st#ie# 
+ 
+fetch ("filename", dostask) 
+#off ("b")# 
+  Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei
+  werden alle Zeichen wie in der vom Atari ST verwendeten Version des ASCII Codes
+  interpretiert. Die Datei wird so aufbereitet, daß ein Bearbeiten mit dem EUMEL-
+  Editor möglich ist. Dies geschieht folgendermaßen: 
+    -  Alle im EUMEL darstellbaren Zeichen werden auf diese abgebildet. 
+    -  Die Zeichenfolgen CR LF, LF CR, LF, CR (CR = carriage return, LF = line­
+       feed) beenden einen Satz in der MS-DOS-Datei. Dementsprechend wird
+       eumelseitig die aktuelle Zeile beendet. 
+    -  Das Zeichen FF (form feed) beendet eumelseitig die aktuelle Zeile. Außerdem
+       wird ein Satz mit dem Inhalt "\#page\#" eingefügt. 
+    -  TAB's (Code 9) werden mit Blanks zur nächsten 8ter-Position expandiert. 
+    -  Alle anderen Zeichen mit 0 <= code (zeichen) <=  31 (Steuerzeichen)
+       werden durch eine Ersatzdarstellung dargestellt (der Code des Zeichens wird
+       als 3 stellige Dezimalzahl eingeschlossen von \#-Zeichen dargestellt). 
+ 
+ 
+#on("bold")# 
+save ("filename", dostask) 
+#off ("b")# 
+  Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Unter MS-DOS
+  wird der ASCII Code in der vom Atari ST verwendeten Version verwendet. Dies
+  geschieht folgendermaßen: 
+    -  Die EUMEL-spezifischen Druckzeichen (Trenn -, Trenn k, Druck \#, ge­
+       schütztes Blank) werden in -, k, \# und Blank umgesetzt. 
+    -  Alle in der vom Atari ST verwendeten Version des ASCII Codes vorhandenen
+       Eumel-Zeichen werden auf diese abgebildet. 
+    -  Alle in der vom Atari ST verwendeten  Version des ASCII Codes nicht
+       vorhandenen Eumel-Zeichen werden durch eine Ersatzdarstellung dargestellt
+       (der Code des Zeichens wird als 3 stellige Dezimalzahl eingeschlossen von
+       \#-Zeichen dargestellt) 
+    -  Steht in einer Zeile nur das Kommando '\#page\#' so wird dieses in ein Sei­
+       tenvorschubsteuerzeichen (""12"") umgewandelt. 
+    -  Eine dreistellige Dezimalzahl eingeschlossen von \# Zeichen wird als Ersatz­
+       darstellung für das Zeichen mit dem durch die Dezimalzahl angegebenen
+       Code betrachte. Diese Ersatzdarstellung wird beim Schreiben aufgelöst (d.h.
+       durch das entsprechende Zeichen ersetzt). 
+    -  Nach jeder Zeile wird 'carriage return' und ' linefeed' angefügt 
+ 
+ 
+#on("bold")# 
+#ib#6.5 Betriebsart: file transparent#ie# 
+ 
+fetch ("filename", dostask) 
+#off ("b")# 
+  Die MS-DOS Datei 'filename' wird in die EUMEL-Datei 'filename' kopiert. Dabei
+  werden von allen Zeichen alle 8 Bit interpretiert. Es werden keine Zeichen einge­
+  fügt, gelöscht oder gewandelt. Somit stehen dann auch CR und LF Zeichen in der
+  EUMEL-Datei. 
+ 
+  Da eine solche Datei noch Steuerzeichen enthält, ist beim Bearbeiten mit dem
+  Editor Vorsicht geboten. 
+ 
+ 
+#on("bold")# 
+save ("filename", dostask) 
+#off ("b")# 
+  Die EUMEL-Datei 'filename' wird nach MS-DOS geschrieben. Es werden keine
+  Codeumsetzungen durchgeführt. Insbesondere muß die EUMEL-Datei auch die CR
+  LF Sequenzen für das Zeilenende enthalten. 
+ 
+ 
+#on("bold")# 
+#ib#6.6 Betriebsart: row text#ie# 
+#off ("b")# 
+ 
+Diese Betriebsart ist nur für Programmierer interessant. Sie ist für die Umsetzung
+exotischer Codes in den EUMEL-Code mittels ELAN-Programmen gedacht. 
+ 
+#on("bold")# 
+fetch ("filename", dostask) 
+#off ("b")# 
+  Die MS-DOS Datei 'filename' wird in einen Datenraum mit folgender Struktur
+  kopiert: 
+ 
+    STRUCT (INT benutzte texte, ROW 4000 TEXT datensatz) 
+ 
+  Dabei bekommt der Datenraum den Type 1000. Der Integer 'benutzte texte' gibt an,
+  wieviele Elemente des ROW 4000 TEXT benutzt sind. In jedem benutzten Element
+  des ROW 4000 TEXT steht der Inhalt einer logischen Gruppe der MS-DOS Disket­
+  te. (Eine logische Gruppe umfaßt bei einer einseitig beschriebenen MS-DOS
+  Diskette 512 Byte und bei einer zweiseitig beschriebenen 1024 bzw. 2048 Byte). In
+  dieser Betriebsart werden keine Zeichen der MS-DOS Datei konvertiert oder
+  interpretiert, so daß also auch alle Steuerzeichen erhalten bleiben. 
+ 
+ 
+#on("bold")# 
+save ("filename", dostask) 
+#off ("b")# 
+  Hier bezeichnet 'filename' einen Datenraum der Struktur: 
+ 
+    STRUCT (INT benutzte texte, ROW 4000 TEXT datensatz) 
+ 
+  Dieser Datenraum muß den Type 1000 haben. 
+  Es werden die benutzten Texte (1 bis benutzte texte) aneinandergehängt und ohne
+  irgendwelche Konvertierungen bzw. Interpretationen als MS-DOS Datei 'filename'
+  geschrieben. Dies bedeutet, daß die Texte auch alle von MS-DOS benötigten
+  Steuerzeichen (z.B. 'ctrl z' als Dateiendekennzeichen) enthalten müssen. 
+ 
+ 
+#on("bold")# 
+#ib#6.7 Betriebsart: ds#ie# 
+#off ("b")# 
+Diese Betriebsart ist nur für den Programmierer interessant. Sie ermöglicht das Abbil­
+den von Datenstrukturen zwischen MS-DOS und EUMEL. 
+ 
+#on("bold")# 
+fetch ("filename", dostask) 
+#off ("b")# 
+  Die MS-DOS Datei 'filename' wird blockweise in den Datenraum 'filename' ko­
+  piert. Hierbei wird der erste Block der MS-DOS Datei in die 2. Seite des Daten­
+  raums kopiert. (Die 2. Seite eines Datenraums ist die erste, die von einer Daten­
+  struktur voll überdeckt werden kann). 
+ 
+ 
+#on("bold")# 
+save ("filename", dostask) 
+#off ("b")# 
+  Der Datenraum 'filename' wird ab seiner 2. Seite in die MS-DOS Datei 'filename'
+  geschrieben. Hierbei werden alle Seiten des Datenraums (auch die nicht allokier­
+  ten) bis einschließlich der letzten allokierten Datenraumseite geschrieben. 
+ 
+ 
+#on("bold")# 
+#ib#7. Installation#ie# 
+#off ("b")# 
+ 
+Die Software zur Generierung der Tasks /"DOS" und /"DOS HD" wird auf einem
+EUMEL-Archiv ausgeliefert. 
+ 
+#on("bold")# 
+#ib#7.1 Installation der Task /"DOS"#ie# 
+            
+#ib#7.1.1 Installation im Multi-User#ie# 
+#off ("b")# 
+ 
+Die Software muß in einer privilegierten Task mit dem Namen 'DOS' installiert wer­
+den. Dies geschieht folgendermaßen: 
+ 
+ 
+  begin  ("DOS", "SYSUR") 
+ 
+  archive  ("austausch"); 
+  fetch    ("dos inserter", archive); 
+  run      ("dos inserter") 
+ 
+ 
+Danach stehen die Prozeduren 
+ 
+ 
+  PROC dos manager 
+  PROC dos manager   (INT CONST channel) 
+ 
+ 
+zur Verfügung. Beide Prozeduren machen die aufrufende Task zur Kommunikations­
+task für das Schreiben und Lesen von MS-DOS Disketten. Die erste benutzt dazu
+den Archivkanal (Kanal 31), bei der zweiten ist der Kanal über den Parameter ein­
+stellbar. Eine dieser Prozeduren muß jetzt aufgerufen werden. 
+ 
+#on("bold")# 
+#ib#7.1.2. Installation im Single-User#ie# 
+#off ("b")# 
+ 
+Die Software wird im Monitor ('gib Kommando'-Modus) durch folgende Kommandos
+installiert: 
+ 
+ 
+  archive  ("austausch"); 
+  fetch    ("dos inserter", archive); 
+  run      ("dos inserter") 
+ 
+ 
+Für das Schreiben und Lesen von MS-DOS Disketten wird der Archivkanal (Kanal
+31) benutzt. 
+ 
+ 
+#on("bold")# 
+#ib#7.2 Installation der Task /"DOS HD"#ie# 
+#off ("b")# 
+ 
+Die Software muß in einer privilegierten Task mit dem Namen 'DOS HD' installiert
+werden. Dies geschieht folgendermaßen: 
+ 
+ 
+  begin  ("DOS HD", "SYSUR") 
+ 
+  archive  ("austausch"); 
+  fetch    ("dos hd inserter", archive); 
+  run      ("dos hd inserter") 
+ 
+ 
+Danach steht die Prozedur 
+ 
+ 
+  PROC dos manager 
+ 
+ 
+zur Verfügung. Sie macht die aufrufende Task zur Kommunikationstask für das
+Schreiben und Lesen in der MS-DOS Partition der Platte. Sie benutzt dazu den
+Kanal 29, der, wie im Portierungshandbuch für den 8086 beschrieben, implementiert
+sein muß. 
+ 
+#page# 
+#headeven# 
+#end# 
+ 
+ 
+ 
+ 
+ 
+Herausgegeben von: 
+ 
+   Gesellschaft für Mathematik und Datenverarbeitung mbH 
+   (GMD) 
+   Schloß Birlinghoven 
+   5205 Sankt Augustin 1 
+ 
+   und 
+ 
+   Hochschulrechenzentrum der Universität Bielefeld 
+   (HRZ) 
+   Universitätsstraße 
+   4800 Bielefeld 1 
+ 
+Autor: 
+ 
+   Frank Klapper 
+ 
+überarbeitet von: 
+ 
+   Thomas Müller 
+   Hansgeorg Freese (GMD) 
+ 
+Umschlaggestaltung: 
+ 
+   Hannelotte Wecken 
+
+
+
+
+
+
diff --git a/system/dos/1.8.7/source-disk b/system/dos/1.8.7/source-disk
new file mode 100644
index 0000000..cc5ebe0
--- /dev/null
+++ b/system/dos/1.8.7/source-disk
@@ -0,0 +1 @@
+187_ergos/04_dos.img
diff --git a/system/dos/1.8.7/src/block i-o b/system/dos/1.8.7/src/block i-o
new file mode 100644
index 0000000..554fcca
--- /dev/null
+++ b/system/dos/1.8.7/src/block i-o
@@ -0,0 +1,180 @@
+PACKET disk block io DEFINES                    (* Copyright (C) 1986 *)
+                                                (* Frank Klapper      *)
+                                                (* 05.01.87           *)
+  read disk block,
+  read disk block and close work if error,
+  read disk cluster, 
+  write disk block,
+  write disk block and close work if error,
+  write disk cluster,
+  first non dummy ds page,
+
+  block no dump modus:
+
+BOOL VAR block no dump flag := FALSE;
+ 
+LET write normal = 0;
+
+INT CONST first non dummy ds page := 2;
+
+INT VAR error;
+
+PROC read disk block (DATASPACE VAR ds,
+                      INT CONST ds page no, 
+                      INT CONST block no):
+  IF block no dump flag THEN dump ("READ ", block no) FI;
+  check rerun;
+  read block (ds, ds page no, eublock (block no), error); 
+  IF error > 0
+    THEN lesefehler (error)
+  FI.
+ 
+END PROC read disk block;
+ 
+PROC read disk block (DATASPACE VAR ds,
+                      INT CONST ds page no, 
+                      REAL CONST block no):
+  IF block no dump flag THEN dump ("READ ", block no) FI;
+  check rerun;
+  read block (ds, ds page no, eublock (block no), error); 
+  IF error > 0
+    THEN lesefehler (error)
+  FI.
+ 
+END PROC read disk block;
+ 
+PROC read disk block and close work if error (DATASPACE VAR ds,
+                                              INT CONST ds page no, 
+                                              INT CONST block no):
+  IF block no dump flag THEN dump ("READ ", block no) FI;
+  check rerun;
+  read block (ds, ds page no, eublock (block no), error); 
+  IF error > 0
+    THEN close work;
+         lesefehler (error)
+  FI.
+ 
+END PROC read disk block and close work if error;
+ 
+PROC read disk block and close work if error (DATASPACE VAR ds,
+                                              INT CONST ds page no, 
+                                              REAL CONST block no):
+  IF block no dump flag THEN dump ("READ ", block no) FI;
+  check rerun;
+  read block (ds, ds page no, eublock (block no), error); 
+  IF error > 0
+    THEN close work;
+         lesefehler (error)
+  FI.
+ 
+END PROC read disk block and close work if error;
+
+PROC read disk cluster (DATASPACE VAR ds, 
+                        INT CONST first ds page no,
+                        REAL CONST cluster no): 
+  IF block no dump flag THEN dump ("CLUSTER ", cluster no) FI;
+  INT VAR i;
+  FOR i FROM 0 UPTO  sectors per cluster - 1 REP
+    read disk block (ds, first ds page no + i, block no + real (i))
+  PER.
+ 
+block no:
+  begin of cluster (cluster no).
+ 
+END PROC read disk cluster; 
+ 
+PROC lesefehler (INT CONST fehler code):
+  error stop (fehlertext).
+
+fehlertext:
+  SELECT fehler code OF
+    CASE 1: "Diskettenlaufwerk nicht betriebsbereit"
+    CASE 2: "Lesefehler"
+    OTHERWISE "Lesefehler " + text (fehler code)
+  END SELECT.
+
+END PROC lesefehler;
+
+PROC write disk block (DATASPACE CONST ds,
+                      INT CONST ds page no, 
+                      INT CONST block no):
+  IF block no dump flag THEN dump ("WRITE", block no) FI;
+  check rerun;
+  write block (ds, ds page no, write normal, eublock (block no), error); 
+  IF error > 0
+    THEN schreibfehler (error)
+  FI.
+ 
+END PROC write disk block;
+ 
+PROC write disk block (DATASPACE CONST ds,
+                      INT CONST ds page no, 
+                      REAL CONST block no):
+  IF block no dump flag THEN dump ("WRITE", block no) FI;
+  check rerun;
+  write block (ds, ds page no, write normal, eublock (block no), error); 
+  IF error > 0
+    THEN schreibfehler (error)
+  FI.
+ 
+END PROC write disk block;
+ 
+PROC write disk block and close work if error (DATASPACE CONST ds,
+                                              INT CONST ds page no, 
+                                              INT CONST block no):
+  IF block no dump flag THEN dump ("WRITE", block no) FI;
+  check rerun;
+  write block (ds, ds page no, write normal, eublock (block no), error); 
+  IF error > 0
+    THEN close work;
+         schreibfehler (error)
+  FI.
+ 
+END PROC write disk block and close work if error;
+ 
+PROC write disk block and close work if error (DATASPACE CONST ds,
+                                              INT CONST ds page no, 
+                                              REAL CONST block no):
+  IF block no dump flag THEN dump ("WRITE", block no) FI;
+  check rerun;
+  write block (ds, ds page no, write normal, eublock (block no), error); 
+  IF error > 0
+    THEN close work;
+         schreibfehler (error)
+  FI.
+ 
+END PROC write disk block and close work if error;
+
+PROC write disk cluster (DATASPACE CONST ds,
+                        INT CONST first ds page no,
+                        REAL CONST cluster no): 
+  IF block no dump flag THEN dump ("CLUSTER ", cluster no) FI;
+  INT VAR i;
+  FOR i FROM 0 UPTO sectors per cluster - 1 REP
+    write disk block (ds, first ds page no + i, block no + real (i))
+  PER.
+ 
+block no:
+  begin of cluster (cluster no).
+ 
+END PROC write disk cluster; 
+ 
+PROC schreibfehler (INT CONST fehler code):
+  error stop (fehlertext).
+
+fehlertext:
+  SELECT fehler code OF
+    CASE 1: "Diskettenlaufwerk nicht betriebsbereit"
+    CASE 2: "Schreibfehler"
+    OTHERWISE "Schreibfehler " + text (fehler code)
+  END SELECT.
+
+END PROC schreibfehler;
+
+PROC block no dump modus (BOOL CONST status):
+  block no dump flag := status
+
+END PROC block no dump modus;
+
+END PACKET disk block io;
+
diff --git a/system/dos/1.8.7/src/bpb ds b/system/dos/1.8.7/src/bpb ds
new file mode 100644
index 0000000..dabf721
--- /dev/null
+++ b/system/dos/1.8.7/src/bpb ds
diff --git a/system/dos/1.8.7/src/dir.dos b/system/dos/1.8.7/src/dir.dos
new file mode 100644
index 0000000..08456b5
--- /dev/null
+++ b/system/dos/1.8.7/src/dir.dos
@@ -0,0 +1,693 @@
+PACKET dir DEFINES                            (* Copyright (c) 1986, 87 *)
+                                              (* Frank Klapper          *)
+  open dir,                                   (* 02.03.88               *)
+  insert dir entry,
+  delete dir entry,
+  init dir ds,
+  file info,
+  format dir,
+
+  dir list,
+  file   exists,
+  subdir exists,
+  all files,
+  all subdirs:
+ 
+LET max dir entrys = 1000;
+
+(*-------------------------------------------------------------------------*)
+
+INITFLAG VAR dir block ds used := FALSE;
+DATASPACE VAR dir block ds;
+BOUND STRUCT (ALIGN dummy, ROW 64 REAL daten) VAR dir block;
+REAL VAR last read dir block no;
+
+PROC init dir block io:
+  last read dir block no := -1.0;
+  IF NOT initialized (dir block ds used)
+    THEN dir block ds := nilspace;
+         dir block := dir block ds
+  FI.
+
+END PROC init dir block io;
+
+PROC read dir block (REAL CONST block nr):
+  IF last read dir block no <> block nr
+    THEN last read dir block no := -1.0;
+         read disk block and close work if error (dir block ds, 2, block nr);
+         last read dir block no := block nr
+  FI.
+
+END PROC read dir block;
+
+PROC write dir block (REAL CONST block nr):
+  write disk block and close work if error (dir block ds, 2, block nr);
+  last read dir block no := block nr.
+
+END PROC write dir block;
+
+PROC write dir block:
+  IF last read dir block no < 0.0
+    THEN error stop ("Lesefehler")
+  FI;
+  write dir block (last read dir block no)
+
+END PROC write dir block;
+
+PROC get dir entry (TEXT VAR entry buffer, INT CONST block entry no):
+  (* 0 <= block entry no <= 15 *)
+  entry buffer := 32 * ".";
+  INT CONST replace offset := 4 * block entry no;
+  replace (entry buffer, 1, dir block.daten [replace offset + 1]);
+  replace (entry buffer, 2, dir block.daten [replace offset + 2]);
+  replace (entry buffer, 3, dir block.daten [replace offset + 3]);
+  replace (entry buffer, 4, dir block.daten [replace offset + 4]).
+
+END PROC get dir entry;
+
+PROC put dir entry (TEXT CONST entry buffer, INT CONST block entry no):
+  (* 0 <= block entry no <= 15 *)
+  INT CONST offset := 4 * block entry no;
+  dir block.daten [offset + 1] := entry buffer RSUB 1;
+  dir block.daten [offset + 2] := entry buffer RSUB 2;
+  dir block.daten [offset + 3] := entry buffer RSUB 3;
+  dir block.daten [offset + 4] := entry buffer RSUB 4.
+
+END PROC put dir entry;
+
+(*-------------------------------------------------------------------------*)
+
+LET DIRPOS = REAL;                  (* 16.0 * msdos block nr + entry no *)
+                                    (* 0 <= entry no <= 15              *)
+
+DIRPOS PROC dirpos (REAL CONST block nr, INT CONST entry nr):
+  block nr * 16.0 + real (entry nr).
+
+END PROC dir pos;
+
+REAL PROC block no (DIRPOS CONST p):
+  floor (p / 16.0)
+
+END PROC block no;
+
+INT PROC entry no (DIRPOS CONST p):
+  int (p MOD 16.0)
+
+END PROC entry no;
+
+PROC incr (DIRPOS VAR p):
+  p INCR 1.0.
+
+END PROC incr;
+
+(*-------------------------------------------------------------------------*)
+
+LET FREELIST = STRUCT (ROW max dir entrys DIRPOS stack,
+                       INT stacktop,
+                       DIRPOS begin of free area,
+                              end of dir,
+                       REAL dir root);                  (* erste Clusterno, 0 für Main Dir *)
+ 
+PROC init free list (FREELIST VAR flist, REAL CONST root):
+  flist.stacktop           := 0;
+  flist.begin of free area := dir pos (9.0e99, 0);
+  flist.end of dir         := dir pos (-1.0, 0);
+  flist.dir root           := root.
+
+END PROC init free list;
+ 
+PROC store (FREELIST VAR flist, DIRPOS CONST free pos):
+  flist.stacktop INCR 1;
+  flist.stack [flist.stack top] := free pos.
+
+END PROC store;
+
+PROC store begin of free area (FREELIST VAR flist, DIRPOS CONST begin):
+  flist.begin of free area := begin
+
+END PROC store begin of free area;
+
+PROC store end of dir (FREELIST VAR flist, DIRPOS CONST end):
+  flist.end of dir := end
+
+END PROC store end of dir;
+
+DIRPOS PROC free dirpos (FREELIST VAR flist):
+  enable stop;
+  DIRPOS VAR result;
+  IF flist.stacktop > 0
+    THEN pop
+    ELIF NOT free area empty
+    THEN first of free area
+    ELIF expansion alloweded
+    THEN allocate new dir cluster;
+         result := free dirpos (flist)
+    ELSE error stop ("Directory voll")
+  FI;
+  result.
+
+pop:
+  result := flist.stack [flist.stacktop];
+  flist.stacktop DECR 1.
+
+free area empty:
+  flist.begin of free area > flist.end of dir.
+
+first of free area:
+  result := flist.begin of free area;
+  incr (flist.begin of free area).
+
+expansion alloweded:
+  flist.dir root >= 2.0.
+
+allocate new dir cluster:
+  REAL CONST new dir cluster :: available fat entry;
+  REAL VAR last entry no;
+  search last entry no of fat chain;
+  fat entry (new dir cluster, last fat chain entry);
+  fat entry (last entry no, new dir cluster);
+  write fat;
+  store begin of free area (flist, dir pos (first new block, 0));
+  store end   of dir       (flist, dir pos (last  new block, 15));
+  init new dir cluster.
+
+search last entry no of fat chain:
+  last entry no := flist.dir root;
+  WHILE NOT is last fat chain entry (fat entry (last entry no)) REP
+    last entry no := fat entry (last entry no)
+  PER.
+
+first new block:
+  begin of cluster (new dir cluster).
+
+last new block:
+  begin of cluster (new dir cluster) + real (sectors per cluster - 1).
+
+init new dir cluster:
+  TEXT CONST empty dir entry :: 32 * ""0"";
+  INT VAR i;
+  FOR i FROM 0 UPTO 15 REP
+    put dir entry (empty dir entry, i)
+  PER;
+  disable stop;
+  REAL VAR block no := first new block;
+  WHILE block no <= last new block REP
+    write dir block (block no)
+  PER.
+
+END PROC free dirpos; 
+
+(*-------------------------------------------------------------------------*)
+
+LET FILEENTRY = STRUCT (TEXT date and time,
+                        REAL size,
+                             first cluster, 
+                        DIRPOS dirpos),
+
+    FILELIST = STRUCT (THESAURUS thes,
+                       ROW max dir entrys FILEENTRY entry);
+
+PROC init file list (FILELIST VAR flist):
+  flist.thes := empty thesaurus.
+
+END PROC init file list;
+
+PROC store file entry (FILELIST VAR flist, TEXT CONST entry text, DIRPOS CONST position):
+  INT VAR entry index;
+  insert (flist.thes, file name, entry index);
+  store file entry (flist.entry [entry index], entry text, position).
+ 
+file name:
+  TEXT CONST name pre  :: compress (subtext (entry text, 1, 8)),
+             name post :: compress (subtext (entry text, 9, 11));
+  IF name post <> ""
+    THEN name pre + "." + name post
+    ELSE name pre
+  FI.
+
+END PROC store file entry;
+
+PROC store file entry (FILEENTRY VAR fentry, TEXT CONST entry text, DIRPOS CONST position):
+  fentry.first cluster := real (entry text ISUB 14);
+  fentry.date and time := dos date + "  " + dos time;
+  fentry.size          := dint (entry text ISUB 15, entry text ISUB 16);
+  fentry.dirpos        := position.
+
+dos date:
+  day + "." + month + "." + year. 
+ 
+day: 
+  text2 (code (entry text SUB 25) MOD 32).
+ 
+month:
+  text2 (code (entry text SUB 25) DIV 32 + 8 * (code (entry text SUB 26) MOD 2)).
+ 
+year:
+  text (80 + code (entry text SUB 26) DIV 2, 2).
+
+dos time:
+  hour + ":" + minute. 
+ 
+hour: 
+  text2 (code (entry text SUB 24) DIV 8).
+ 
+minute: 
+  text2 (code (entry text SUB 23) DIV 32 + 8 * (code (entry text SUB 24) MOD 8)).
+ 
+END PROC store file entry;
+
+TEXT PROC text2 (INT CONST intvalue):
+  IF intvalue < 10
+    THEN "0" + text (intvalue)
+    ELSE text (int value)
+  FI.
+
+END PROC text2;
+
+DIRPOS PROC file entry pos (FILELIST CONST flist, TEXT CONST file name):
+  INT CONST link index :: link (flist.thes, file name);
+  IF link index = 0
+    THEN error stop ("Die Datei """ + file name + """ gibt es nicht")
+  FI;
+  flist.entry [link index].dir pos.
+
+END PROC file entry pos;
+
+PROC delete (FILELIST VAR flist, TEXT CONST file name):
+  INT VAR dummy;
+  delete (flist.thes, file name, dummy).
+
+END PROC delete;
+
+PROC file info (FILELIST CONST flist, TEXT CONST file name, REAL VAR first cluster no, storage):
+  INT CONST link index :: link (flist.thes, file name);
+  IF link index = 0
+    THEN error stop ("Die Datei """ + file name + """ gibt es nicht")
+  FI;
+  first cluster no := flist.entry [link index].first cluster;
+  storage          := flist.entry [link index].size
+
+END PROC file info;
+
+BOOL PROC contains (FILELIST VAR flist, TEXT CONST file name):
+  flist.thes CONTAINS file name
+
+END PROC contains;
+
+PROC list (FILE VAR f, FILELIST CONST flist):
+  INT VAR index := 0;
+  TEXT VAR name;
+  get (flist.thes, name, index);
+  WHILE index > 0 REP
+    list file;
+    get (flist.thes, name, index)
+  PER.
+
+list file:
+  write (f, centered name);
+  write (f, "  ");
+  write (f, text (flist.entry [index].size, 11, 0));
+  write (f, " Bytes belegt      ");
+  write (f, flist.entry [index].date and time); 
+(*COND TEST*)
+  write (f, "  +++  "); 
+  write (f, text (flist.entry [index].first cluster)); 
+(*ENDCOND*)
+  line (f).
+
+centered name:
+  INT VAR point pos := pos (name, ".");
+  IF point pos > 0
+    THEN name pre + "." + name post
+    ELSE text (name, 12)
+  FI.
+
+name pre:
+  text (subtext (name, 1, point pos - 1), 8).
+
+name post:
+  text (subtext (name, point pos + 1, point pos + 4), 3).
+ 
+END PROC list;
+
+(*-------------------------------------------------------------------------*)
+ 
+LET DIRENTRY = REAL,
+
+    DIRLIST = STRUCT (THESAURUS thes,
+                      ROW max dir entrys DIRENTRY entry);
+
+PROC init dir list (DIRLIST VAR dlist):
+  dlist.thes := empty thesaurus.
+
+END PROC init dir list;
+
+PROC store subdir entry (DIRLIST VAR dlist, TEXT CONST entry text):
+  INT VAR entry index;
+  insert (dlist.thes, subdir name, entry index);
+  dlist.entry [entry index] := real (entry text ISUB 14).
+
+subdir name:
+  TEXT CONST name pre  :: compress (subtext (entry text, 1, 8)),
+             name post :: compress (subtext (entry text, 9, 11));
+  IF name post <> ""
+    THEN name pre + "." + name post
+    ELSE name pre
+  FI.
+
+END PROC store subdir entry;
+
+REAL PROC first cluster of subdir (DIRLIST CONST dlist, TEXT CONST name):
+  INT CONST link index := link (dlist.thes, name);
+  IF link index = 0
+    THEN error stop ("Das Unterverzeichnis """ + name + """ gibt es nicht")
+  FI;
+  dlist.entry [link index].
+
+END PROC first cluster of subdir;
+
+BOOL PROC contains (DIRLIST CONST dlist, TEXT CONST subdir name):
+  dlist.thes CONTAINS subdir name
+
+END PROC contains;
+
+PROC list (FILE VAR f, DIRLIST CONST dlist):
+  INT VAR index := 0;
+  TEXT VAR name;
+  get (dlist.thes, name, index);
+  WHILE index > 0 REP
+    list dir;
+    get (dlist.thes, name, index)
+  PER.
+
+list dir:
+  write (f, centered name);
+  write (f, "   <DIR>");
+(*COND TEST*)
+  write (f, "  +++  ");                                 
+  write (f, text (dlist.entry [index]));  
+(*ENDCOND*)
+  line (f).
+
+centered name:
+  INT VAR point pos := pos (name, ".");
+  IF point pos > 0
+    THEN name pre + "." + name post
+    ELSE text (name, 12)
+  FI.
+
+name pre:
+  text (subtext (name, 1, point pos - 1), 8).
+
+name post:
+  text (subtext (name, point pos + 1, point pos + 4), 3).
+ 
+END PROC list;
+
+(*-------------------------------------------------------------------------*)
+
+LET DIR = BOUND STRUCT (FILELIST filelist,
+                        DIRLIST dirlist, 
+                        FREELIST freelist,
+                        TEXT path);
+ 
+DIR VAR dir;
+DATASPACE VAR dir ds;
+INITFLAG VAR dir ds used := FALSE;
+
+PROC open dir (TEXT CONST path string):
+  init dir block io;
+  init dir ds;
+  dir.path := path string;
+  load main dir;
+  TEXT VAR rest path := path string;
+  WHILE rest path <> "" REP
+    TEXT CONST sub dir name := next sub dir name (rest path);
+    load sub dir
+  PER.
+
+load main dir:
+  init file list (dir.filelist);
+  init dir  list (dir.dirlist);
+  init free list (dir.free list, 0.0);
+  store end of dir (dir.freelist, dirpos (last main dir sector, 15));
+  BOOL VAR was last dir sector := FALSE;
+  REAL VAR block no := first main dir sector;
+  INT VAR i;
+  FOR i FROM 1 UPTO dir sectors REP
+      load dir block (block no, was last dir sector);
+      block no INCR 1.0
+      UNTIL was last dir sector
+  PER. 
+
+first main dir sector:
+  real (begin of dir).
+
+last main dir sector:
+  real (begin of dir + dir sectors - 1).
+
+load sub dir:
+  REAL VAR cluster no := first cluster of sub dir (dir.dirlist, sub dir name);
+  was last dir sector := FALSE;
+  init file list (dir.filelist);
+  init dir  list (dir.dirlist);
+  init free list (dir.free list, cluster no);
+  WHILE NOT is last fat chain entry (cluster no) REP
+    load sub dir entrys of cluster;
+    cluster no := fat entry (cluster no)
+    UNTIL was last dir sector
+  PER.
+
+load sub dir entrys of cluster:
+  store end of dir (dir.freelist, dirpos (last block no of cluster, 15));
+  block no := begin of cluster (cluster no);
+  FOR i FROM 1 UPTO sectors per cluster REP
+    load dir block (block no, was last dir sector);
+    block no INCR 1.0
+    UNTIL was last dir sector
+  PER.
+
+last block no of cluster:
+  begin of cluster (cluster no) + real (sectors per cluster - 1).
+
+END PROC open dir;
+
+PROC load dir block (REAL CONST block no, BOOL VAR was last block): 
+  was last block := FALSE;
+  read dir block (block no);
+  INT VAR entry no;
+  TEXT VAR entry;
+  FOR entry no FROM 0 UPTO 15 REP 
+    get dir entry (entry, entry no);
+    process entry
+    UNTIL was last block
+  PER.
+
+process entry:
+  SELECT pos (""0"."229"", entry SUB 1) OF
+    CASE 1: end of dir search
+    CASE 2: (* root des aktuellen directorys oder des übergeordneten, also nichts tun *)
+    CASE 3: free entry
+    OTHERWISE volume label or file entry or subdir entry
+  END SELECT.
+
+end of dir search:
+  was last block := TRUE;
+  store begin of free area (dir.freelist, dir pos (block no, entry no)).
+
+free entry:
+  store (dir.freelist, dir pos (block no, entry no)).
+
+volume label or file entry or subdir entry:
+  INT CONST byte 11 :: code (entry SUB 12);
+  IF (byte 11 AND 8) > 0
+    THEN (* volume label *)
+  ELIF (byte 11 AND 16) > 0
+    THEN sub dir entry
+    ELSE file entry
+  FI.
+
+sub dir entry:
+  store subdir entry (dir.dir list, entry).
+
+file entry:
+  store file entry (dir.file list, entry, dir pos (block no, entry no)).
+
+END PROC load dir block; 
+ 
+TEXT PROC next subdir name (TEXT VAR path string):
+  TEXT VAR subdir name;
+  IF (path string SUB 1) <> "\"
+    THEN error stop ("ungültige Pfadbezeichnung")
+  FI;
+  INT CONST backslash pos :: pos (path string, "\", 2);
+  IF backslash pos = 0
+    THEN subdir name := subtext (path string, 2);
+         path string := ""
+    ELSE subdir name := subtext (path string, 2, backslash pos - 1);
+         path string := subtext (path string, backslash pos)
+  FI;
+  dos name (subdir name, read modus).
+
+END PROC next subdir name;
+
+PROC init dir ds:
+  IF initialized (dir ds used)
+    THEN forget (dir ds)
+  FI;
+  dir ds := nilspace;
+  dir := dir ds.
+
+END PROC init dir ds;
+
+PROC insert dir entry (TEXT CONST name, REAL CONST start cluster, storage):
+  DIRPOS CONST ins pos :: free dirpos (dir.free list);
+  TEXT CONST entry string :: entry name + ""32"" + (10 * ""0"") + dos time +
+                             dos date + entry start cluster + entry storage;
+  write entry on disk;
+  write entry in dir ds.
+
+entry name:
+  INT CONST point pos := pos (name, ".");
+  IF point pos > 0
+    THEN subtext (name, 1, point pos - 1) + (9 - point pos) * " " +
+         subtext (name, point pos + 1) + (3 - LENGTH name + point pos) * " "
+    ELSE name + (11 - LENGTH name) * " "
+  FI.
+ 
+dos time:
+  TEXT CONST akt time :: time of day (clock (1));
+  code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8).
+
+hour:
+  int (subtext (akt time, 1, 2)).
+
+minute:
+  int (subtext (akt time, 4, 5)).
+
+dos date:
+  TEXT CONST akt date :: date (clock (1));
+  code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8).
+
+day: 
+  int (subtext (akt date, 1, 2)).
+
+month:
+  int (subtext (akt date, 4, 5)).
+
+year:
+  int (subtext (akt date, 7, 8)).
+
+entry start cluster:
+  TEXT VAR buffer2 := "12";
+  replace (buffer2, 1, low word (start cluster));
+  buffer2.
+
+entry storage:
+  TEXT VAR buffer4 := "1234";
+  replace (buffer4, 1, low  word (storage));
+  replace (buffer4, 2, high word (storage));
+  buffer4.
+
+write entry on disk:
+  read dir block (block no (ins pos));
+  put dir entry (entry string, entry no (ins pos));
+  write dir block.
+
+write entry in dir ds:
+  store file entry (dir.file list, entry string, ins pos).
+
+END PROC insert dir entry;
+
+PROC delete dir entry (TEXT CONST name):
+  TEXT VAR entry;
+  DIRPOS CONST del pos :: file entry pos (dir.filelist, name);
+  read dir block (block no (del pos));
+  get dir entry (entry, entry no (del pos));
+  put dir entry (""229"" + subtext (entry, 2, 32), entry no (del pos));
+  write dir block;
+  delete (dir.filelist, name);
+  store (dir.freelist, del pos).
+
+END PROC delete dir entry;
+
+PROC format dir:
+  init dir block io;
+  init dir ds;
+  build empty dir block;
+  REAL VAR block no := real (begin of dir);
+  disable stop;
+  FOR i FROM 1 UPTO dir sectors REP
+    write dir block (block no);
+    block no INCR 1.0
+  PER;
+  enable stop;
+  dir.path := "";
+  init file list (dir.file list);
+  init dir  list (dir.dir  list);
+  init free list (dir.free list, 0.0);
+  store begin of free area (dir.free list, dir pos (real (begin of dir), 0));
+  store end of dir (dir.free list, dir pos (last main dir sector, 15)).
+
+build empty dir block:
+  INT VAR i;
+  FOR i FROM 0 UPTO 15 REP
+    put dir entry (32 * ""0"",  i)
+  PER.
+
+last main dir sector:
+  real (begin of dir + dir sectors - 1).
+
+END PROC format dir;
+ 
+PROC file info (TEXT CONST file name, REAL VAR start cluster, size):
+  file info (dir.file list, file name, start cluster, size)
+
+END PROC file info;
+
+THESAURUS PROC all files:
+  THESAURUS VAR t := dir.filelist.thes;
+  t
+
+END PROC all files;
+
+THESAURUS PROC all subdirs:
+  dir.dirlist.thes
+
+END PROC all subdirs;
+
+BOOL PROC file exists (TEXT CONST file name):
+  contains (dir.filelist, file name)
+
+END PROC file exists;
+
+BOOL PROC subdir exists (TEXT CONST subdir name):
+  contains (dir.dirlist, subdir name)
+
+END PROC subdir exists;
+
+PROC dir list (DATASPACE VAR ds):
+  open list file;
+  head line (list file, list file head);
+  list (list file, dir.file list);
+  list (list file, dir.dir list).
+
+open list file:
+  forget (ds);
+  ds := nilspace;
+  FILE VAR list file := sequential file (output, ds);
+  putline (list file, "").
+ 
+list file head:
+  "DOS" + path string.
+
+path string:
+  IF dir.path <> ""
+    THEN "     PATH: " + dir.path
+    ELSE ""
+  FI.
+
+END PROC dir list;
+
+END PACKET dir;
+
diff --git a/system/dos/1.8.7/src/disk descriptor.dos b/system/dos/1.8.7/src/disk descriptor.dos
new file mode 100644
index 0000000..0b0d7fc
--- /dev/null
+++ b/system/dos/1.8.7/src/disk descriptor.dos
@@ -0,0 +1,339 @@
+PACKET dos disk DEFINES                       (* Copyright (C) 1986, 87 *)
+                                              (* Frank Klapper          *)
+  (* Referenz: 3-22 *)                        (* 11.09.87               *)
+
+  open dos disk,
+
+  sectors per cluster,
+  fat copies,
+  dir sectors,
+  media descriptor,
+  fat sectors,
+
+  begin of fat,
+  fat entrys,
+  begin of dir,
+  begin of cluster,
+  cluster size,
+
+  bpb exists,
+  write bpb,
+
+  eu block,
+
+  bpb dump modus:
+
+INITFLAG VAR bpb ds initialisiert := FALSE;
+DATASPACE VAR bpb ds;
+BOUND STRUCT (ALIGN dummy, ROW 512 INT daten) VAR bpb;
+
+BOOL VAR bpb dump flag := FALSE;
+
+REAL VAR begin of data area;
+INT  VAR sectors per track,
+         heads;
+
+IF exists ("shard interface")
+  THEN load shard interface table
+FI;
+
+TEXT CONST bpb type 254 :: ""00""00""00"" +
+                           ""69""85""77""69""76""66""80""66"" +
+                           ""00""02"" +
+                           ""01"" +
+                           ""01""00"" +
+                           ""02"" +
+                           ""64""00"" +
+                           ""64""01"" +
+                           ""254"" +
+                           ""01""00"" +
+                           ""08""00"" +
+                           ""01""00"" +
+                           ""00""00"",
+           bpb type 255 :: ""00""00""00"" +
+                           ""69""85""77""69""76""66""80""66"" +
+                           ""00""02"" +
+                           ""02"" +
+                           ""01""00"" +
+                           ""02"" +
+                           ""112""00"" +
+                           ""128""02"" +
+                           ""255"" +
+                           ""01""00"" +
+                           ""08""00"" +
+                           ""02""00"" +
+                           ""00""00"";
+
+PROC open dos disk:
+  enable stop;
+  bpb ds an bound koppeln;
+  bpb lesen;
+  IF bpb ungueltig
+    THEN versuche pseudo bpb zu verwenden
+  FI;
+  ueberpruefe bpb auf gueltigkeit;
+  globale variablen initialisieren;
+  IF bpb dump flag
+    THEN dump schreiben
+  FI.
+
+bpb ds an bound koppeln:
+  IF NOT initialized (bpb ds initialisiert)
+    THEN bpb ds := nilspace;
+         bpb := bpb ds
+  FI.
+
+bpb lesen:
+  INT VAR return;
+  check rerun;
+  read block (bpb ds, 2, 0, return);
+  IF return <> 0
+    THEN lesefehler (return)
+  FI.
+
+bpb ungueltig:
+  (* Byte 12 = Byte 13 = ... = Byte 23 <==> Word 6 = ... = Word 11 *)
+  INT VAR word no;
+  FOR word no FROM 6 UPTO 10 REP
+    IF bpb.daten [word no + 1] <> bpb.daten [word no + 2]
+      THEN LEAVE bpb ungueltig WITH FALSE
+    FI
+  PER;
+  TRUE.
+
+versuche pseudo bpb zu verwenden:
+  lies ersten fat sektor;
+  IF fat sektor gueltig und pseudo bpb vorhanden
+    THEN pseudo bpb laden
+    ELSE error stop ("Format unbekannt")
+  FI.
+
+lies ersten fat sektor:
+  (* da der bpb in diesem Fall ungültig, lese ich den fat sektor in den bpb
+     Datenraum                                                             *)
+  check rerun;
+  read block (bpb ds, 2, 1, return);
+  IF return <> 0
+    THEN lesefehler (return)
+  FI.
+
+fat sektor gueltig und pseudo bpb vorhanden:
+  TEXT VAR fat start := "1234";
+  replace (fat start, 1, bpb.daten [1]);
+  replace (fat start, 2, bpb.daten [2]);
+  (fat start SUB 2) = ""255"" CAND (fat start SUB 3) = ""255"" CAND
+  pseudo bpb vorhanden.
+
+pseudo bpb vorhanden:
+  pos (""254""255"", fat start SUB 1) > 0.
+
+pseudo bpb laden:
+  INT VAR i;
+  FOR i FROM 1 UPTO 15 REP
+    bpb.daten [i] := bpb puffer ISUB i
+  PER.
+
+bpb puffer:
+  IF pseudo bpb name = ""255""
+    THEN bpb type 255
+    ELSE bpb type 254
+  FI.
+
+pseudo bpb name:
+  fat start SUB 1.
+
+ueberpruefe bpb auf gueltigkeit:
+  IF bytes per sector <> 512
+    THEN error stop ("DOS Format nicht implementiert (unzulässige Sektorgröße)")
+  FI;
+  IF (fat sectors > 64)
+    THEN error stop ("ungültige DOS Disk (BPB)")
+  FI.
+
+globale variablen initialisieren:
+  sectors per track  := bpb byte (25) * 256 + bpb byte (24);
+  heads              := bpb byte (27) * 256 + bpb byte (26);
+  begin of data area := real (reserved sectors + fat copies * fat sectors + dir sectors).
+
+dump schreiben:
+  dump ("Sektoren pro Cluster", sectors per cluster);
+  dump ("Fat Kopien          ", fat copies);
+  dump ("Dir Sektoren        ", dir sectors);
+  dump ("Media Descriptor    ", media descriptor);
+  dump ("Sektoren pro Fat    ", fat sectors);
+  dump ("Fat Anfang (0)      ", begin of fat (0));
+  dump ("Fat Einträge        ", fat entrys);
+  dump ("Dir Anfang          ", begin of dir).
+
+END PROC open dos disk;
+
+PROC lesefehler (INT CONST fehler code):
+  error stop (fehlertext).
+
+fehlertext:
+  SELECT fehler code OF
+    CASE 1: "Diskettenlaufwerk nicht betriebsbereit"
+    CASE 2: "Lesefehler"
+    OTHERWISE "Lesefehler " + text (fehler code)
+  END SELECT.
+
+END PROC lesefehler;
+
+TEXT VAR konvertier puffer := "12";
+
+INT PROC bpb byte (INT CONST byte no):
+  replace (konvertier puffer, 1, bpb.daten [byte no DIV 2 + 1]);
+  code (konvertier puffer SUB puffer pos).
+
+puffer pos:
+  IF even byte no
+    THEN 1
+    ELSE 2
+  FI.
+
+even byte no:
+  (byte no MOD 2) = 0.
+
+END PROC bpb byte;
+
+INT PROC bytes per sector:
+  bpb byte (12) * 256 + bpb byte (11)
+
+END PROC bytes per sector;
+
+INT PROC sectors per cluster:
+  bpb byte (13)
+
+END PROC sectors per cluster;
+
+INT PROC reserved sectors:
+  bpb byte (15) * 256 + bpb byte (14)
+
+END PROC reserved sectors;
+
+INT PROC fat copies:
+  bpb byte (16)
+
+END PROC fat copies;
+
+INT PROC dir sectors:
+  dir entrys DIV dir entrys per sector.
+
+dir entrys:
+  bpb byte (18) * 256 + bpb byte (17).
+
+dir entrys per sector:
+  16.
+
+END PROC dir sectors;
+
+REAL PROC dos sectors:
+  real (bpb byte (20)) * 256.0 + real (bpb byte (19))
+
+END PROC dos sectors;
+
+INT PROC media descriptor:
+  bpb byte (21)
+
+END PROC media descriptor;
+
+INT PROC fat sectors:
+  bpb byte (23) * 256 + bpb byte (22)
+
+END PROC fat sectors;
+
+INT PROC begin of fat (INT CONST fat copy no):
+  (* 0 <= fat copy no <= fat copies - 1 *)
+  reserved sectors + fat copy no * fat sectors
+
+END PROC begin of fat;
+
+INT PROC fat entrys:
+  anzahl daten cluster + 2.
+
+anzahl daten cluster:
+  int ((dos sectors - tabellen sektoren) / real (sectors per cluster)).
+
+tabellen sektoren:
+  real (reserved sectors + fat copies * fat sectors + dir sectors).
+
+END PROC fat entrys;
+
+INT PROC begin of dir:
+  reserved sectors + fat copies * fat sectors.
+
+END PROC begin of dir;
+
+REAL PROC begin of cluster (REAL CONST cluster no):
+  begin of data area + (cluster no - 2.0) * real (sectors per cluster)
+
+END PROC begin of cluster;
+
+INT PROC cluster size:
+  512 * sectors per cluster
+
+END PROC cluster size;
+
+BOOL PROC bpb exists (INT CONST no):
+
+  exists ("bpb ds") AND no > 0 AND no < 4.
+
+END PROC bpb exists;
+
+PROC write bpb (INT CONST no):
+  INT VAR return;
+  write block (old ("bpb ds"), no + 1, 0, 0, return);
+  IF return <> 0
+    THEN error stop ("Schreibfehler")
+  FI.
+
+END PROC write bpb;
+
+(* Da DOS-Partitionen maximal 32 MByte groß sein können, können die Blocknummern
+   durch 16 BIT unsigned Integer dargestellt werden. Die Werte die die 'eublock'-
+   Prozeduren liefern sind als solche zu verstehen                          *)
+
+INT PROC eu block (INT CONST dos block no):
+  IF hd version
+    THEN dos block no
+    ELSE dos block no floppy format
+  FI.
+
+dos block no floppy format:
+  IF page format
+    THEN head * eu sectors per head + trac * eu sectors + sector
+    ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector
+  FI.
+
+page format:
+  eu heads < 0.
+
+sector:
+  dos block no MOD sectors per track.
+
+trac:
+  (dos block no DIV sectors per track) DIV heads.
+
+head:
+  (dos block no DIV sectors per track) MOD heads.
+
+eu sectors per head:
+  eu sectors * eu tracks.
+
+eu sectors:
+  eu last sector - eu first sector + 1.
+
+END PROC eu block;
+
+INT PROC eu block (REAL CONST dos block no):
+  eublock (low word (dos block no)).
+
+END PROC eublock;
+
+PROC bpb dump modus (BOOL CONST status):
+  bpb dump flag := status
+
+END PROC bpb dump modus;
+
+END PACKET dos disk;
+
diff --git a/system/dos/1.8.7/src/dos hd inserter b/system/dos/1.8.7/src/dos hd inserter
new file mode 100644
index 0000000..24be82b
--- /dev/null
+++ b/system/dos/1.8.7/src/dos hd inserter
@@ -0,0 +1,41 @@
+IF NOT single user
+  THEN do ("IF name (myself) <> ""DOS HD"" THEN error stop (""Bitte der Task den Namen 'DOS HD' geben und neu starten"") FI");
+FI;
+
+archive ("austausch");
+check off;
+command dialogue (FALSE);
+fetch ("insert.dos", archive);
+fetch ("bpb ds", archive);
+IF single user
+  THEN do (PROC (TEXT CONST) gen s, ALL "insert.dos");
+       gen s ("manager/S.dos")
+  ELSE fetch (ALL "insert.dos", archive);
+       fetch ("manager/M.dos", archive);
+       release (archive);
+       do (PROC (TEXT CONST) gen m, ALL "insert.dos");
+       gen m ("manager/M.dos");
+FI;
+do ("hd version (TRUE)");
+forget ("insert.dos", quiet);
+forget ("dos hd inserter", quiet);
+IF NOT single user
+  THEN do ("dos manager (29)")
+FI.
+
+single user:
+  (pcb (9) AND 255) = 1.
+
+PROC gen m (TEXT CONST name):
+  insert (name);
+  forget (name, quiet)
+
+END PROC gen m;
+
+PROC gen s (TEXT CONST t):
+  fetch (t, archive);
+  insert (t);
+  forget (t, quiet)
+
+END PROC gen s;
+
diff --git a/system/dos/1.8.7/src/dos inserter b/system/dos/1.8.7/src/dos inserter
new file mode 100644
index 0000000..2f70b28
--- /dev/null
+++ b/system/dos/1.8.7/src/dos inserter
@@ -0,0 +1,59 @@
+IF NOT single user
+  THEN do ("IF name (myself) <> ""DOS"" THEN error stop (""Bitte der Task den Namen 'DOS' geben und neu starten"") FI");
+FI; 
+ 
+archive ("austausch");
+check off;
+command dialogue (FALSE);
+hol ("shard interface");
+hol ("bpb ds");
+hol ("insert.dos");
+IF single user
+  THEN do (PROC (TEXT CONST) gen s, ALL "insert.dos");
+       gen s ("manager/S.dos")
+  ELSE do (PROC (TEXT CONST) hol, ALL "insert.dos");
+       hol ("manager/M.dos");
+       release (archive);
+       do (PROC (TEXT CONST) gen m, ALL "insert.dos");
+       gen m ("manager/M.dos");
+       putline ("jetzt mit 'dos manager' bzw. 'dos manager (channnel)' starten");
+FI;
+do ("hd version (FALSE)");
+do ("load shard interface table");
+forget ("shard interface", quiet);
+forget ("insert.dos", quiet);
+forget ("dos inserter", quiet).
+ 
+single user:
+  (pcb (9) AND 255) = 1.
+ 
+PROC gen m (TEXT CONST name):
+  insert (name);
+  forget (name, quiet)
+ 
+END PROC gen m;
+ 
+PROC gen s (TEXT CONST t):
+  hol (t);
+  insert (t);
+  forget (t, quiet)
+ 
+END PROC gen s;
+ 
+PROC hol (TEXT CONST t):
+  IF NOT exists (t)
+    THEN fetch (t, archive)
+  FI
+ 
+END PROC hol;
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+ 
+
+
diff --git a/system/dos/1.8.7/src/dump b/system/dos/1.8.7/src/dump
new file mode 100644
index 0000000..5138162
--- /dev/null
+++ b/system/dos/1.8.7/src/dump
@@ -0,0 +1,49 @@
+PACKET dump DEFINES 
+ 
+  dump:
+
+TEXT VAR ergebnis := "";
+
+PROC dump (TEXT CONST kommentar, dump text):
+  ergebnis := kommentar;
+  ergebnis CAT ": ";
+  INT VAR i;
+  FOR i FROM 1 UPTO LENGTH dump text REP
+    zeichen schreiben
+  PER;
+  ergebnis schreiben.
+
+zeichen schreiben:
+  INT CONST char code :: code (dump text SUB i);
+  IF char code < 32
+     THEN ergebnis CAT ("$" + text (char code) + "$")
+     ELSE ergebnis CAT code (char code)
+  FI.
+
+END PROC dump;
+
+PROC dump (TEXT CONST kommentar, INT CONST dump int):
+  ergebnis := kommentar;
+  ergebnis CAT ": ";
+  ergebnis CAT text (dump int);
+  ergebnis schreiben.
+
+END PROC dump;
+
+PROC dump (TEXT CONST kommentar, REAL CONST dump real):
+  ergebnis := kommentar;
+  ergebnis CAT ": ";
+  ergebnis CAT text (dump real);
+  ergebnis schreiben.
+
+END PROC dump;
+
+PROC ergebnis schreiben:
+  FILE VAR f := sequential file (output, "logbuch");
+  putline (f, ergebnis);
+  ergebnis := "".
+
+END PROC ergebnis schreiben;
+
+END PACKET dump;
+
diff --git a/system/dos/1.8.7/src/eu disk descriptor b/system/dos/1.8.7/src/eu disk descriptor
new file mode 100644
index 0000000..5a61367
--- /dev/null
+++ b/system/dos/1.8.7/src/eu disk descriptor
@@ -0,0 +1,107 @@
+PACKET eu disk DEFINES                       (* Copyright (C) 1986, 87 *)
+                                             (* Frank Klapper          *)
+                                             (* 05.01.87               *)
+  load shard interface table,
+  open eu disk,
+  eu size,
+  eu heads,
+  eu tracks,
+  eu first sector,
+  eu last sector:
+
+LET table length = 15,
+ 
+    size field         = 1,
+    head field         = 2,
+    track field        = 3,
+    first sector field = 4,
+    last  sector field = 5;
+
+ROW table length ROW 5 INT VAR format table;
+
+INT VAR table top := 0,
+        table pointer;
+
+PROC open eu disk:
+  enable stop;
+  init check rerun;
+  IF hd version
+    THEN LEAVE open eu disk
+  FI;
+  INT CONST blocks := archive blocks;
+  IF blocks <= 0
+    THEN error stop ("keine Diskette eingelegt")
+  FI;
+  search format table entry.
+
+search format table entry:
+  IF table top < 1
+    THEN error stop ("SHard-Interfacetabelle nicht geladen")
+  FI;
+  table pointer := 1;
+  WHILE format table [table pointer][size field] <> blocks REP
+    table pointer INCR 1;
+    IF table pointer > table top
+      THEN error stop ("Diskettenformat nicht implementiert")
+    FI
+  PER.
+
+END PROC open eu disk;
+
+PROC load shard interface table:
+  FILE VAR f := sequential file (input, "shard interface");
+  TEXT VAR line;
+  table top := 0;
+  WHILE NOT eof (f) REP
+    get line (f, line);
+    IF (line SUB 1) <> ";"
+      THEN load line
+    FI
+  PER.
+
+load line:
+  table top INCR 1;
+  IF table top > table length
+    THEN error stop ("Shard Interface Tabelle zu groß")
+  FI;
+  INT VAR blank pos := 1;
+  format table [table top][size field]         := next int;
+  format table [table top][head field]         := next int;
+  format table [table top][track field]        := next int; 
+  format table [table top][first sector field] := next int;
+  format table [table top][last  sector field] := next int.
+
+next int:
+  line := compress (subtext (line, blank pos)) + " ";
+  blank pos := pos (line, " ");
+  int (subtext (line, 1, blank pos - 1)).
+
+END PROC load shard interface table;
+ 
+INT PROC eu size:
+  format table [table pointer][size field]
+
+END PROC eu size;
+
+INT PROC eu heads:
+  format table [table pointer][head field]
+
+END PROC eu heads;
+
+INT PROC eu tracks:
+  format table [table pointer][track field]
+
+END PROC eu tracks;
+
+INT PROC eu first sector:
+  format table [table pointer][first sector field]
+
+END PROC eu first sector;
+
+INT PROC eu last sector:
+  format table [table pointer][last sector field]
+
+END PROC eu last sector;
+
+END PACKET eu disk;
+
diff --git a/system/dos/1.8.7/src/fat.dos b/system/dos/1.8.7/src/fat.dos
new file mode 100644
index 0000000..2890b1a
--- /dev/null
+++ b/system/dos/1.8.7/src/fat.dos
@@ -0,0 +1,369 @@
+PACKET dos fat DEFINES                      (* Copyright (C) 1985, 86, 87 *)
+                                            (* Frank Klapper              *)
+                                            (* 11.09.87                   *)
+  read fat,
+  write fat,
+  first fat block ok,
+  clear fat ds,
+  format fat,
+
+  fat entry,
+  last fat chain entry,
+  is last fat chain entry,
+  erase fat chain,
+  available fat entry:
+
+  (* Referenz: 4. *)
+
+LET fat size                = 16 384, (* maximal 64 Sektoren a 512 Byte (256 Worte) *)
+    max anzahl fat sektoren = 64;
+
+LET FAT = BOUND STRUCT (ALIGN dummy,
+                        ROW 256 INT block row,      (* für Kopie des 1. Fatsektors *)
+                        ROW fat size INT fat row); 
+
+DATASPACE VAR fat ds;
+INITFLAG  VAR fat ds used := FALSE;
+FAT       VAR fat struktur;
+
+.fat: fat struktur.fat row.
+
+REAL VAR erster moeglicher freier eintrag;
+
+BOOL VAR kleines fat format;
+
+PROC read fat:
+  fat ds initialisieren;
+  fat bloecke lesen;
+  fat format bestimmen;
+  erster moeglicher freier eintrag := 2.0.
+
+fat ds initialisieren:
+  clear fat ds;
+  fat struktur := fat ds.
+
+fat bloecke lesen:
+  LET kein testblock = FALSE;
+  INT VAR block no;
+  FOR block no FROM 0 UPTO fat sectors - 1 REP
+     fat block lesen (block no, kein testblock)
+  PER.
+
+fat format bestimmen:
+  IF fat entrys <= 4086
+    THEN kleines fat format := TRUE
+    ELSE kleines fat format := FALSE
+  FI.
+
+END PROC read fat;
+
+PROC write fat:
+  disable stop;
+  INT VAR block nr;
+  FOR block nr FROM 0 UPTO fat sectors - 1 REP
+    fat block schreiben (block nr)
+  PER.
+
+END PROC write fat;
+
+BOOL PROC first fat block ok:
+  (* überprüft, ob der erste Block der Fat auf Diskette und im Speicher
+     gleich ist                                                        *)
+  enable stop;
+  LET testblock = TRUE;
+  fat block lesen (0, testblock);
+  INT VAR i;
+  FOR i FROM 1 UPTO 256 REP
+    vergleiche woerter
+  PER; 
+  TRUE.
+
+vergleiche woerter:
+  IF fat [i] <> fat struktur.block row [i] 
+    THEN LEAVE first fat block ok WITH FALSE
+  FI. 
+
+END PROC first fat block ok;
+
+PROC clear fat ds:
+  IF initialized (fat ds used)
+    THEN forget (fat ds)
+  FI;
+  fat ds := nilspace.
+
+END PROC clear fat ds;
+
+PROC format fat:
+  fat ds initialisieren;
+  fat format bestimmen;
+  erster moeglicher freier eintrag := 2.0;
+  write first four fat bytes;
+  write other fat bytes;
+  vermerke schreibzugriffe;
+  write fat.
+
+fat ds initialisieren:
+  clear fat ds;
+  fat struktur := fat ds.
+
+fat format bestimmen:
+  IF fat entrys <= 4086
+    THEN kleines fat format := TRUE
+    ELSE kleines fat format := FALSE
+  FI.
+
+write first four fat bytes:
+  fat [1] := word (media descriptor, 255);
+  IF kleines fat format
+    THEN fat [2] := word (255, 0)
+    ELSE fat [2] := word (255, 255)
+  FI.
+
+write other fat bytes:
+  INT VAR i;
+  FOR i FROM 3 UPTO 256 * fat sectors REP
+    fat [i] := 0
+  PER.
+
+vermerke schreibzugriffe:
+  FOR i FROM 0 UPTO fat sectors - 1 REP
+    schreibzugriff (i)
+  PER.
+
+END PROC format fat;
+
+(*-------------------------------------------------------------------------*)
+
+REAL PROC fat entry (REAL CONST real entry no):
+  (* 0 <= entry no <= 22 000 *)
+  INT CONST entry no :: int (real entry no);
+  IF kleines fat format
+    THEN construct 12 bit value
+    ELSE dint (fat [entry no + 1], 0)
+  FI.
+
+construct 12 bit value:
+  INT CONST first byte no := entry no + entry no DIV 2;
+  IF entry no MOD 2 = 0
+    THEN real ((right byte MOD 16) * 256 + left byte)
+    ELSE real (right byte * 16 + left byte DIV 16)
+  FI.
+
+left byte:
+  fat byte (first byte no).
+
+right byte:
+  fat byte (first byte no + 1).
+
+END PROC fat entry;
+
+TEXT VAR convert buffer := "12";
+
+INT PROC fat byte (INT CONST no): 
+  replace (convert buffer, 1, word); 
+  IF even byte no
+    THEN code (convert buffer SUB 1)
+    ELSE code (convert buffer SUB 2)
+  FI. 
+ 
+even byte no:
+  no MOD 2 = 0.
+
+word: 
+  fat [no DIV 2 + 1]. 
+
+END PROC fat byte; 
+ 
+PROC fat entry (REAL CONST real entry no, real value):
+  (* 0 <= entry no <= 22 000 *)
+  INT CONST entry no :: int (real entry no),
+            value    :: low word (real value);
+  IF kleines fat format
+    THEN write 12 bit value
+    ELSE fat [entry no + 1] := value;
+         schreibzugriff (entry no DIV 256)
+  FI;
+  update first possible available entry.
+
+write 12 bit value:
+  INT CONST first byte no :: entry no + entry no DIV 2;
+  schreibzugriff (fat block of first  byte);
+  schreibzugriff (fat block of second byte);
+  write value.
+
+fat block of first byte:
+  first byte no DIV 512.
+
+fat block of second byte:
+  second byte no DIV 512.
+
+write value:
+  IF even entry no
+    THEN write fat byte (first  byte no, value MOD 256);
+         write fat byte (second byte no,
+                        (right byte DIV 16) * 16 + value DIV 256)
+    ELSE write fat byte (first byte no,
+                         (left byte MOD 16) + 16 * (value MOD 16));
+         write fat byte (second byte no, value DIV 16)
+  FI.
+
+even entry no:
+  entry no MOD 2 = 0.
+
+second byte no:
+  first byte no + 1.
+
+left byte:
+  fat byte (first byte no).
+
+right byte:
+  fat byte (second byte no).
+
+update first possible available entry:
+  IF value = 0
+    THEN erster moeglicher freier eintrag :=
+         min (erster moeglicher freier eintrag, real entry no)
+  FI.
+
+END PROC fat entry; 
+
+PROC write fat byte (INT CONST byte no, new value):
+  read old word;
+  change byte;
+  write new word.
+
+read old word: 
+  replace (convert buffer, 1, word).
+
+write new word:
+  word := convert buffer ISUB 1.
+
+word:
+  fat [byte no DIV 2 + 1].
+
+change byte:
+  replace (convert buffer, byte pos, code (new value)).
+
+byte pos:
+  byte no MOD 2 + 1.
+
+END PROC write fat byte;
+
+REAL PROC last fat chain entry:
+  IF kleines fat format
+    THEN  4 088.0
+    ELSE 65 528.0
+  FI.
+
+END PROC last fat chain entry;
+
+BOOL PROC is last fat chain entry (REAL CONST value):
+  value >= last fat chain entry
+
+END PROC is last fat chain entry;
+
+PROC erase fat chain (REAL CONST first entry no):
+  REAL VAR next entry no := first entry no,
+           act  entry no := 0.0;
+  WHILE next entry exists REP
+    act entry no  := next entry no;
+    next entry no := fat entry (act entry no);
+    fat entry (act entry no, 0.0)
+  PER.
+
+next entry exists:
+  NOT is last fat chain entry (next entry no).
+
+END PROC erase fat chain; 
+
+REAL PROC available fat entry:
+  (* da die fat weniger als 22 000 Einträge umfaßt, kann ich diese als
+     INTEGER berechnen                                                   *)
+  INT VAR i;
+  REAL VAR real i := erster moeglicher freier eintrag;
+  FOR i FROM int (erster moeglicher freier eintrag) UPTO fat entrys - 1 REP
+    IF fat entry (real i) = 0.0
+      THEN erster moeglicher freier eintrag := real i;
+           LEAVE available fat entry WITH erster moeglicher freier eintrag
+    FI;
+    real i INCR 1.0
+  PER;
+  close work;
+  error stop ("MS-DOS Datentraeger voll");
+  1.0e99.
+
+END PROC available fat entry;
+
+(*-------------------------------------------------------------------------*)
+
+PROC fat block lesen (INT CONST block nr, BOOL CONST test block):
+  (* 0 <= block nr <= fat sectors - 1 *)
+  disable stop;
+  IF NOT test block
+    THEN kein schreibzugriff (block nr)
+  FI;
+  INT VAR kopie nr;
+  FOR kopie nr FROM 0 UPTO fat copies - 1 REP
+    clear error;
+    read disk block (fat ds, ds seiten nr, disk block nr)
+    UNTIL NOT is error
+  PER;
+  IF is error
+    THEN close work
+  FI.
+
+ds seiten nr:
+  IF test block
+    THEN 2
+    ELSE block nr + 2 + 1
+  FI.
+
+disk block nr:
+  begin of fat (kopie nr) + block nr.
+
+END PROC fat block lesen;
+
+PROC fat block schreiben (INT CONST block nr):
+  IF war schreibzugriff (block nr)
+    THEN wirklich schreiben
+  FI.
+
+wirklich schreiben:
+  disable stop;
+  INT VAR kopie nr;
+  FOR kopie nr FROM 0 UPTO fat copies - 1 REP
+    write disk block and close work if error (fat ds, ds seiten nr, disk block nr)
+  PER;
+  kein schreibzugriff (block nr).
+
+ds seiten nr:
+  block nr + 2 + 1.
+
+disk block nr:
+  begin of fat (kopie nr) + block nr.
+
+END PROC fat block schreiben;
+
+(*-------------------------------------------------------------------------*)
+
+ROW max anzahl fat sektoren BOOL VAR schreib zugriff tabelle;
+
+PROC schreibzugriff (INT CONST fat sektor):
+  schreibzugriff tabelle [fat sektor + 1] := TRUE
+
+END PROC schreibzugriff;
+
+PROC kein schreibzugriff (INT CONST fat sektor):
+  schreibzugriff tabelle [fat sektor + 1] := FALSE
+
+END PROC kein schreibzugriff;
+
+BOOL PROC war schreibzugriff (INT CONST fat sektor):
+  schreibzugriff tabelle [fat sektor + 1]
+
+END PROC war schreibzugriff;
+
+(*-------------------------------------------------------------------------*)
+
+END PACKET dos fat;
+
diff --git a/system/dos/1.8.7/src/fetch b/system/dos/1.8.7/src/fetch
new file mode 100644
index 0000000..7cb7571
--- /dev/null
+++ b/system/dos/1.8.7/src/fetch
@@ -0,0 +1,371 @@
+PACKET fetch DEFINES                   (* Copyright (C) 1985, 86, 87 *)
+                                       (* Frank Klapper              *)
+                                       (* 27.04.87                   *) 
+  fetch,
+  check file:
+
+LET ascii             = 1,
+    ascii german      = 2,
+    transparent       = 3,
+    row text          = 5,
+    ds                = 6,
+    dump              = 7,
+    atari st          = 10,
+    ibm               = 11,
+
+  (*line end chars    = ""10""12""13"",*)
+    min line end char = ""10"",
+    max line end char = ""13"",
+    lf                = ""10"",
+    cr                = ""13"",
+    tab code          = 9,
+    lf  code          = 10,
+    ff  code          = 12,
+    cr  code          = 13,
+    ctrl z            = ""26"", 
+
+    page cmd          = "#page#",
+
+    row text length   = 4000,
+    row text type     = 1000;
+
+BOUND STRUCT (INT size,
+              ROW row text length TEXT cluster row) VAR cluster struct;
+
+FILE VAR file;
+
+TEXT VAR buffer;
+INT VAR buffer length;
+
+PROC fetch (TEXT CONST name, DATASPACE VAR file ds, INT CONST mode):
+
+  SELECT mode OF 
+    CASE ascii, ascii german, atari st, ibm, transparent:
+                      fetch filemode (file ds, name, mode)
+    CASE row text   : fetch row textmode (file ds, name)
+    CASE ds         : fetch dsmode       (file ds, name)
+    CASE dump       : fetch dumpmode     (file ds, name)
+    OTHERWISE error stop ("Unzulässige Betriebsart")
+  END SELECT.
+
+END PROC fetch;
+
+PROC fetch filemode (DATASPACE VAR file space, TEXT CONST name,
+                     INT CONST code type):
+  enable stop;
+  initialize fetch filemode;
+  open fetch dos file (name);
+  WHILE NOT was last fetch cluster REP
+    get text of cluster;
+    write lines;
+(***************************************)
+    IF lines (file) > 3900
+      THEN putline (file, ">>> FREMDDATEI FUER EUMEL ZU LANG. ES KÖNNEN DATEN FEHLEN <<<");
+           LEAVE fetch filemode
+    FI;
+(***************************************)
+  UNTIL file end via ctrl z
+  PER;
+  write last line if necessary; 
+  close fetch dos file.
+ 
+initialize fetch filemode:
+  buffer := "";
+  buffer length := 0;
+  forget (file space);
+  file space := nilspace;
+  file := sequential file (output, file space);
+  BOOL VAR file end via ctrl z := FALSE.
+ 
+get text of cluster:
+  cat next fetch dos cluster (buffer);
+  IF ascii code
+    THEN ctrl z is buffer end
+  FI;
+  adapt code (buffer, buffer length + 1, code type);
+  buffer length := length (buffer).
+
+ascii code:
+  (code type = ascii) OR (code type = ascii german).
+
+ctrl z is buffer end:
+  INT  CONST ctrl z pos :: pos (buffer, ctrl z, buffer length + 1);
+  file end via ctrl z := ctrl z pos > 0;
+  IF file end via ctrl z
+    THEN buffer := subtext (buffer, 1, ctrl z pos - 1);
+         buffer length := length (buffer)
+  FI.
+
+write lines:
+  INT VAR line begin pos := 1, line end pos;
+  compute line end pos;
+  WHILE line end pos > 0 REP
+    putline (file, subtext (buffer, line begin pos, line end pos));
+    exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type);
+    line begin pos := line end pos + 1;
+    compute line end pos
+  PER;
+  buffer := subtext (buffer, line begin pos);
+  buffer length := length (buffer);
+  IF buffer length > 5 000
+    THEN putline (file, buffer);
+         exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type);
+         buffer := "";
+         buffer length := 0
+  FI.
+
+compute line end pos:
+  line end pos := line begin pos;
+  REP
+    line end pos := pos (buffer, min line end char, max line end char, line end pos);
+    INT CONST line end code :: code (buffer SUB line end pos);
+    SELECT line end code OF
+      CASE lf code: look for cr
+      CASE 11     : line end pos INCR 1
+      CASE cr code: look for lf
+    END SELECT
+  UNTIL line end code <> 11
+  PER.
+
+look for cr:
+  IF line end pos = buffer length
+    THEN line end pos := 0
+  ELIF (buffer SUB line end pos + 1) = cr
+    THEN line end pos INCR 1
+  FI.
+
+look for lf:
+  IF line end pos = buffer length
+    THEN line end pos := 0
+  ELIF (buffer SUB line end pos + 1) = lf
+    THEN line end pos INCR 1
+  FI.
+
+write last line if necessary:
+  IF buffer length > 0
+    THEN putline (file, buffer);
+         exec (PROC (TEXT CONST, INT CONST) control char conversion, file, code type);
+  FI.
+
+END PROC fetch filemode;
+
+PROC adapt code (TEXT VAR text buffer, INT CONST start pos, code type):
+  SELECT code type OF
+    CASE ascii       : cancel bit 8
+    CASE ascii german: cancel bit 8; ascii german adaption
+    CASE atari st    : atari st adaption
+    CASE ibm         : ibm adaption
+  (*CASE transparent : do nothing *)
+  END SELECT.
+
+cancel bit 8:
+  INT VAR set pos := pos (text buffer, ""128"", ""255"", start pos);
+  WHILE set pos > 0 REP
+    replace (text buffer, set pos, seven bit char);
+    set pos := pos (text buffer, ""128"", ""255"", set pos + 1)
+  PER.
+
+seven bit char:
+  code (code (text buffer SUB set pos) AND 127).
+
+ascii german adaption:
+  change all by replace (text buffer, start pos, "[", "Ä");
+  change all by replace (text buffer, start pos, "\", "Ö");
+  change all by replace (text buffer, start pos, "]", "Ü");
+  change all by replace (text buffer, start pos, "{", "ä");
+  change all by replace (text buffer, start pos, "|", "ö");
+  change all by replace (text buffer, start pos, "}", "ü");
+  change all by replace (text buffer, start pos, "~", "ß").
+
+atari st adaption:
+  change all by replace (text buffer, start pos, ""142"", "Ä");
+  change all by replace (text buffer, start pos, ""153"", "Ö");
+  change all by replace (text buffer, start pos, ""154"", "Ü");
+  change all by replace (text buffer, start pos, ""132"", "ä");
+  change all by replace (text buffer, start pos, ""148"", "ö");
+  change all by replace (text buffer, start pos, ""129"", "ü");
+  change all by replace (text buffer, start pos, ""158"", "ß").
+
+ibm adaption:
+  change all by replace (text buffer, start pos, ""142"", "Ä");
+  change all by replace (text buffer, start pos, ""153"", "Ö");
+  change all by replace (text buffer, start pos, ""154"", "Ü");
+  change all by replace (text buffer, start pos, ""132"", "ä");
+  change all by replace (text buffer, start pos, ""148"", "ö");
+  change all by replace (text buffer, start pos, ""129"", "ü");
+  change all by replace (text buffer, start pos, ""225"", "ß").
+
+END PROC adapt code;
+
+PROC change all by replace (TEXT VAR string, INT CONST begin pos,
+                            TEXT CONST old, new):
+
+  INT VAR p := pos (string, old, begin pos);
+  WHILE p > 0 REP
+    replace (string, p, new);
+    p := pos (string, old, p + 1)
+  PER.
+
+END PROC change all by replace;
+
+PROC control char conversion (TEXT VAR string, INT CONST code type):
+
+  IF code type <> transparent
+    THEN code conversion
+  FI.
+
+code conversion:
+  INT VAR p := pos (string, ""0"", ""31"", 1);
+  WHILE p > 0 REP
+    convert char;
+    p := pos (string, ""0"", ""31"", p)
+  PER.
+
+convert char:
+  INT CONST char code := code (string SUB p);
+  SELECT char code OF
+    CASE tab code: expand tab
+    CASE lf  code: change (string, p, p, "")
+    CASE ff  code: change (string, p, p, page cmd)
+    CASE cr  code: change (string, p, p, "")
+    OTHERWISE ersatzdarstellung
+  END SELECT.
+
+expand tab:
+  change (string, p, p, (8 - (p - 1) MOD 8) * " ").
+
+ersatzdarstellung:
+  TEXT CONST t := text (char code);
+  change (string, p, p, "#" + (3 - length (t)) * "0" + t + "#").
+
+END PROC control char conversion;
+
+PROC fetch rowtextmode (DATASPACE VAR file space,
+                        TEXT CONST name):
+  enable stop; 
+  open fetch dos file (name);
+  initialize fetch rowtext mode;
+  WHILE NOT was last fetch cluster REP
+    cluster struct.size INCR 1;
+    cluster struct.cluster row [cluster struct.size] := "";
+    cat next fetch dos cluster (cluster struct.cluster row [cluster struct.size])
+  PER; 
+  close fetch dos file.
+ 
+initialize fetch row text mode:
+  forget (file space);
+  file space := nilspace;
+  cluster struct := file space;
+  type (file space, row text type);
+  cluster struct.size := 0.
+
+END PROC fetch rowtext mode;
+
+PROC fetch ds mode (DATASPACE VAR in ds, TEXT CONST name):
+  enable stop;
+  open fetch dos file (name);
+  init fetch dsmode;
+  WHILE NOT was last fetch cluster REP
+    read next fetch dos cluster (in ds, ds block no);
+  PER; 
+  close fetch dos file.
+ 
+init fetch dsmode:
+  forget (in ds);
+  in ds := nilspace;
+  INT VAR ds block no := 2.
+
+END PROC fetch ds mode;
+
+PROC fetch dumpmode (DATASPACE VAR file space, TEXT CONST name):
+  enable stop; 
+  open fetch dos file (name);
+  initialize fetch dumpmode;
+  WHILE NOT was last fetch cluster REP
+    TEXT VAR cluster buffer := "";
+    cat next fetch dos cluster (cluster buffer);
+    dump cluster
+    UNTIL offset > 50 000.0
+  PER; 
+  close fetch dos file.
+ 
+initialize fetch dump mode:
+  BOOL VAR fertig := FALSE;
+  REAL VAR offset := 0.0;
+  forget (file space);
+  file space := nilspace;
+  file := sequential file (output, file space).
+
+dump cluster:
+  TEXT VAR dump line;
+  INT VAR line, column;
+  FOR line FROM 0 UPTO (cluster size DIV 16) - 1 REP
+    build dump line;
+    putline (file, dump line);
+    offset INCR 16.0
+  UNTIL fertig
+  PER.
+
+build dump line:
+  TEXT VAR char line := "";
+  dump line := text (offset, 6, 0);
+  dump line := subtext (dump line, 1, 5);
+  dump line CAT "   ";
+  FOR column FROM 0 UPTO 7 REP
+    convert char;
+    dump line CAT " "
+  PER;
+  dump line CAT " ";
+  FOR column FROM 8 UPTO 15 REP
+    convert char;
+    dump line CAT " "
+  PER;
+  dump line CAT "  ";
+  dump line CAT char line.
+
+convert char:
+  TEXT CONST char :: cluster buffer SUB (line * 16 + column + 1);
+  IF char = ""
+    THEN fertig := TRUE;
+         dump line CAT "  ";
+         LEAVE convert char
+  FI;
+  INT CONST char code := code (char);
+  LET hex chars = "0123456789ABCDEF";
+  dump line CAT (hex chars SUB (char code DIV 16 + 1));
+  dump line CAT (hex chars SUB (char code MOD 16 + 1));
+  charline CAT show char.
+
+show char:
+  IF (char code > 31 AND char code < 127)
+    THEN char
+    ELSE "." 
+  FI.
+
+END PROC fetch dump mode;
+
+PROC check file (TEXT CONST name):
+  disable stop;
+  DATASPACE VAR test ds := nilspace;
+  enable check file (name, test ds);
+  forget (test ds);
+  IF is error
+    THEN clear error;
+         error stop ("Fehler beim Prüflesen der Datei """ + name + """")
+  FI.
+
+END PROC check file;
+
+PROC enable check file (TEXT CONST name, DATASPACE VAR test ds):
+  enable stop;
+  open fetch dos file (name);
+  WHILE NOT was last fetch cluster REP
+    INT VAR dummy := 2;
+    read next fetch dos cluster (test ds, dummy)
+  PER; 
+  close fetch dos file.
+ 
+END PROC enable check file;
+
+END PACKET fetch;
+
diff --git a/system/dos/1.8.7/src/fetch save interface b/system/dos/1.8.7/src/fetch save interface
new file mode 100644
index 0000000..27b4925
--- /dev/null
+++ b/system/dos/1.8.7/src/fetch save interface
@@ -0,0 +1,70 @@
+PACKET fetch save DEFINES                   (* Copyright (C) 1986 *)
+                                            (* Frank Klapper      *)
+  save fetch mode,                          (* 22.04.87           *)
+  path:
+
+LET ascii        = 1,
+    ascii german = 2,
+    transparent  = 3,
+    row text     = 5,
+    ds           = 6,
+    dump         = 7,
+    atari st     = 10,
+    ibm          = 11;
+
+INT PROC save fetch mode (TEXT CONST reserve string):
+  TEXT VAR modus;
+  INT CONST p := pos (reserve string, ":");
+  IF p = 0
+    THEN modus := reserve string
+    ELSE modus := subtext (reserve string, 1, p - 1)
+  FI;
+  modus normieren;
+  IF modus = "FILEASCII"
+    THEN ascii
+  ELIF modus = "FILEASCIIGERMAN"
+    THEN asciigerman
+  ELIF modus = "FILEATARIST"
+    THEN atari st
+  ELIF modus = "FILEIBM"
+    THEN ibm
+  ELIF modus = "FILETRANSPARENT"
+    THEN transparent
+  ELIF modus = "ROWTEXT"
+    THEN row text
+  ELIF modus = "DS"
+    THEN ds
+  ELIF modus = "DUMP"
+    THEN dump
+    ELSE error stop ("Unzulässige Betriebsart"); -1
+  FI.
+
+modus normieren:
+  change all (modus, " ", "");
+  INT VAR i;
+  FOR i FROM 1 UPTO LENGTH modus REP
+    INT CONST char code :: code (modus SUB i);
+    IF is lower case
+      THEN replace (modus, i, upper case char)
+    FI
+  PER.
+
+is lower case:
+  char code > 96 AND char code < 123.
+
+upper case char:
+  code (char code - 32).
+
+END PROC save fetch mode;
+
+TEXT PROC path (TEXT CONST reserve string):
+  INT CONST p :: pos (reserve string, ":");
+  IF p = 0
+    THEN ""
+    ELSE subtext (reserve string, p + 1)
+  FI.
+
+END PROC path;
+ 
+END PACKET fetch save;
+
diff --git a/system/dos/1.8.7/src/get put interface.dos b/system/dos/1.8.7/src/get put interface.dos
new file mode 100644
index 0000000..1d6de92
--- /dev/null
+++ b/system/dos/1.8.7/src/get put interface.dos
@@ -0,0 +1,368 @@
+PACKET dos get put DEFINES                   (* Copyright (C) 1986, 87 *)
+                                             (* Frank Klapper          *)
+                                             (* 11.12.87               *)
+  log modus,
+
+  open   dos disk,
+  close  dos disk,
+  access dos disk,
+
+  open  fetch dos file,
+  close fetch dos file,
+  cat  next fetch dos cluster,
+  read next fetch dos cluster,
+  was last fetch cluster,
+
+  open save dos file,
+  write next save dos cluster,
+  close save dos file,
+
+  erase dos file,
+
+  all dosfiles,
+  all dossubdirs,
+  dosfile exists,
+  dos list,
+
+  clear dos disk,
+  format dos disk:
+
+BOOL VAR log flag := FALSE;
+
+PROC log modus (BOOL CONST status):
+  log flag := status
+
+END PROC log modus;
+
+(*-------------------------------------------------------------------------*)
+
+LET max cluster size = 8192,   (* 8192 * 8 = 64 KB *)
+    reals per sector = 64;
+
+LET CLUSTER = BOUND STRUCT (ALIGN dummy, 
+                            ROW max cluster size REAL cluster row); 
+ 
+CLUSTER VAR cluster;
+DATASPACE VAR cluster ds;
+INITFLAG VAR cluster ds used := FALSE;
+
+TEXT VAR convert buffer;
+INT  VAR convert buffer length;
+
+PROC init cluster handle:
+  IF initialized (cluster ds used)
+    THEN forget (cluster ds)
+  FI;
+  cluster ds            := nilspace;
+  cluster               := cluster ds;
+  convert buffer        := "";
+  convert buffer length := 0.
+
+END PROC init cluster handle;
+
+PROC cat cluster text (REAL CONST cluster no, TEXT VAR destination, INT CONST to):
+  read disk cluster (cluster ds, 2, cluster no);
+  init convert buffer;
+  INT VAR i;
+  FOR i FROM 1 UPTO sectors per cluster * reals per sector REP
+    replace (convert buffer, i, cluster.cluster row [i])
+  PER;
+  destination CAT subtext (convert buffer, 1, to).
+
+init convert buffer:
+  IF convert buffer length < cluster size
+    THEN convert buffer CAT (cluster size - convert buffer length) * "*";
+         convert buffer length := cluster size
+  FI.
+
+END PROC cat cluster text;
+
+PROC write text to cluster (REAL CONST cluster no, TEXT CONST string):
+  IF LENGTH string < cluster size
+    THEN execute write text (text (string, cluster size))
+    ELSE execute write text (string)
+  FI;
+  write disk cluster (cluster ds, 2, cluster no).
+
+END PROC write text to cluster;
+
+PROC execute write text (TEXT CONST string):
+  INT VAR i;
+  FOR i FROM 1 UPTO sectors per cluster * reals per sector REP
+    cluster.cluster row [i] := string RSUB i
+  PER.
+
+END PROC execute write text;
+
+(*-------------------------------------------------------------------------*)
+
+BOOL VAR disk open := FALSE;
+TEXT VAR act path;
+
+REAL VAR last access time;
+
+PROC open dos disk (TEXT CONST path):
+  IF log flag THEN dump ("open dos disk", path) FI;
+  enable stop;
+  close work;
+  init cluster handle;
+  act path  := path;
+  disk open := TRUE
+
+END PROC open dos disk;
+
+PROC close dos disk:
+  IF log flag THEN dump ("close dos disk", "") FI;
+  enable stop;
+  disk open := FALSE;
+  close work;
+  init cluster handle;               (* Datenraumespeicher freigeben *)
+  clear fat ds;
+  init dir ds.
+
+END PROC close dos disk;
+
+PROC access dos disk:
+  enable stop;
+  IF NOT disk open
+    THEN error stop ("DOS-Arbeit nicht eröffnet")
+  FI;
+  IF work closed COR (last access more than 5 seconds ago CAND disk changed)
+    THEN open eu disk;          (* hier wird der RERUN Check initialisiert *)
+         open dos disk;
+         read fat;
+         open dir (act path);
+         last access time := clock (1);
+         open work
+  FI.
+
+last access more than 5 seconds ago:
+  abs (clock (1) - last access time) > 5.0.
+
+disk changed:
+  IF hd version
+    THEN FALSE
+    ELSE last access time := clock (1);
+         NOT first fat block ok
+  FI.
+
+END PROC access dos disk;
+
+(*-------------------------------------------------------------------------*)
+
+REAL VAR next fetch cluster,
+         fetch rest;                (* in Bytes *)
+
+PROC open fetch dos file (TEXT CONST file name):
+  IF log flag THEN dump ("open fetch dos file", file name) FI;
+  enable stop;
+  access dos disk;
+  file info (file name, next fetch cluster, fetch rest).
+
+END PROC open fetch dos file;
+
+BOOL PROC was last fetch cluster:
+  IF log flag THEN dump ("was last fetch cluster", "") FI;
+  is last fat chain entry (next fetch cluster) OR fetch rest <= 0.0.
+
+END PROC was last fetch cluster;
+
+PROC cat next fetch dos cluster (TEXT VAR buffer):
+  IF log flag THEN dump ("cat next fetch dos cluster", "") FI;
+  enable stop;
+  IF was last fetch cluster
+    THEN error stop ("fetch nach Dateiende")
+  FI;
+  IF fetch rest < real (cluster size)
+    THEN cat cluster text (next fetch cluster, buffer, int (fetch rest));
+         fetch rest := 0.0
+    ELSE cat cluster text (next fetch cluster, buffer, cluster size);
+         fetch rest DECR real (cluster size)
+  FI;
+  last access time := clock (1);
+  next fetch cluster := fat entry (next fetch cluster).
+
+END PROC cat next fetch dos cluster;
+
+PROC read next fetch dos cluster (DATASPACE VAR read ds, INT VAR start page):
+  IF log flag THEN dump ("read next fetch dos cluster", start page) FI;
+  enable stop;
+  IF was last fetch cluster
+    THEN error stop ("fetch nach Dateiende")
+  FI;
+  read disk cluster (read ds, start page, next fetch cluster);
+  last access time := clock (1);
+  start page INCR sectors per cluster;
+  next fetch cluster := fat entry (next fetch cluster);
+  IF fetch rest < real (cluster size)
+    THEN fetch rest := 0.0
+    ELSE fetch rest DECR real (cluster size)
+  FI.
+
+END PROC read next fetch dos cluster;
+
+PROC close fetch dos file:
+  IF log flag THEN dump ("close fetch dos file", "") FI;
+
+END PROC close fetch dos file;
+
+(*-------------------------------------------------------------------------*)
+
+TEXT VAR save name;
+REAL VAR first save cluster,
+         last save cluster,
+         save size;
+
+PROC open save dos file (TEXT CONST file name):
+  IF log flag THEN dump ("open save dos file", file name) FI;
+  enable stop;
+  access dos disk;
+  IF file exists (file name) OR subdir exists (file name)
+    THEN error stop ("die Datei """ + file name + """ gibt es schon")
+  FI;
+  save name := file name;
+  first save cluster := -1.0;
+  save size := 0.0.
+
+END PROC open save dos file;
+
+PROC write next save dos cluster (TEXT CONST buffer):
+  IF log flag THEN dump ("write next save dos cluster", "") FI;
+  enable stop;
+  REAL CONST save cluster := available fat entry;
+  write text to cluster (save cluster, buffer);
+  last access time := clock (1);
+  save size INCR real (LENGTH buffer);
+  IF first save cluster < 2.0
+    THEN first save cluster := save cluster
+    ELSE fat entry (last save cluster, save cluster)
+  FI;
+  fat entry (save cluster, last fat chain entry);
+  last save cluster := save cluster.
+
+END PROC write next save dos cluster;
+
+PROC write next save dos cluster (DATASPACE CONST save ds, INT VAR start page):
+  IF log flag THEN dump ("write next save dos cluster", start page) FI;
+  enable stop;
+  REAL CONST save cluster := available fat entry;
+  write disk cluster (save ds, start page, save cluster);
+  last access time := clock (1);
+  start page INCR sectors per cluster;
+  save size INCR real (cluster size);
+  IF first save cluster < 2.0
+    THEN first save cluster := save cluster
+    ELSE fat entry (last save cluster, save cluster)
+  FI;
+  fat entry (save cluster, last fat chain entry);
+  last save cluster := save cluster.
+
+END PROC write next save dos cluster;
+
+PROC close save dos file:
+  IF log flag THEN dump ("close save dos file", "") FI;
+  enable stop;
+  IF first save cluster < 2.0
+    THEN LEAVE close save dos file
+  FI;
+  fat entry (last save cluster, last fat chain entry);
+  write fat;
+  insert dir entry (save name, first save cluster, save size);
+  last access time := clock (1).
+
+END PROC close save dos file;
+
+(*-------------------------------------------------------------------------*)
+
+PROC erase dos file (TEXT CONST file name):
+  IF log flag THEN dump ("erase dos file", file name) FI;
+  enable stop;
+  access dos disk;
+  REAL VAR first cluster, size;
+  file info (file name, first cluster, size);
+  delete dir entry (file name);
+  erase fat chain (first cluster);
+  write fat;
+  last access time := clock (1).
+
+END PROC erase dos file;
+
+(*-------------------------------------------------------------------------*)
+
+THESAURUS PROC all dosfiles:
+  IF log flag THEN dump ("all dosfile", "") FI;
+  enable stop;
+  access dos disk;
+  all files.
+
+END PROC all dosfiles;
+
+THESAURUS PROC all dossubdirs:
+  IF log flag THEN dump ("all subdirs", "") FI;
+  enable stop;
+  access dos disk;
+  all subdirs.
+
+END PROC all dossubdirs;
+
+BOOL PROC dos file exists (TEXT CONST file name):
+  IF log flag THEN dump ("dos file exists", file name) FI;
+  enable stop;
+  access dos disk;
+  file exists (file name).
+
+END PROC dos file exists;
+
+PROC dos list (DATASPACE VAR list ds):
+  IF log flag THEN dump ("dos list", "") FI;
+  enable stop;
+  access dos disk;
+  dir list (list ds).
+
+END PROC dos list;
+
+(*-------------------------------------------------------------------------*)
+
+PROC clear dos disk:
+  IF log flag THEN dump ("clear dos disk", "") FI;
+  enable stop;
+  IF hd version
+    THEN error stop ("nicht implementiert")
+    ELSE access dos disk;
+         format dir;
+         format fat;
+         last access time := clock (1)
+  FI.
+
+END PROC clear dos disk;
+
+PROC format dos disk (INT CONST format code):
+
+  IF log flag THEN dump ("format dos disk (" + text (format code) + ")", "") FI;
+  enable stop;
+  IF NOT disk open
+    THEN error stop ("DOS-Arbeit nicht eröffnet")
+  FI;
+  IF hd version
+    THEN error stop ("nicht implementiert")
+    ELSE do format
+  FI.
+
+do format:
+  IF bpb exists (format code)
+    THEN close work;
+         format archive (format code);
+         open eu disk;
+         write bpb (format code);
+         open dos disk;
+         format dir;       (* enthält 'open dir' *)
+         format fat;       (* enthält 'read fat' *)
+         open work
+    ELSE error stop ("Format unzulässig")
+  FI;
+  last access time := clock (1).
+
+END PROC format dos disk;
+
+END PACKET dos get put;
+
diff --git a/system/dos/1.8.7/src/insert.dos b/system/dos/1.8.7/src/insert.dos
new file mode 100644
index 0000000..14f98cd
--- /dev/null
+++ b/system/dos/1.8.7/src/insert.dos
@@ -0,0 +1,14 @@
+dump
+konvert
+open
+eu disk descriptor
+disk descriptor.dos
+block i/o
+name conversion.dos
+fat.dos
+dir.dos
+get put interface.dos
+fetch save interface
+fetch
+save 
+
diff --git a/system/dos/1.8.7/src/konvert b/system/dos/1.8.7/src/konvert
new file mode 100644
index 0000000..c5c4c43
--- /dev/null
+++ b/system/dos/1.8.7/src/konvert
@@ -0,0 +1,75 @@
+PACKET konvert DEFINES                               (* Copyright (C) 1986 *)
+                                                     (* Frank Klapper      *)
+                                                     (* 28.10.86           *)
+  high byte,
+  low byte,
+  word,
+  change low byte,
+  change high byte,
+  dint,
+  high word,
+  low word:
+
+INT PROC high byte (INT CONST value):
+  TEXT VAR x := "  ";
+  replace (x, 1, value);
+  code (x SUB 2)
+
+END PROC high byte;
+
+INT PROC low byte (INT CONST value):
+  TEXT VAR x := "  ";
+  replace (x, 1, value);
+  code (x SUB 1)
+
+END PROC low byte; 
+ 
+INT PROC word (INT CONST low byte, high byte):
+  TEXT CONST x :: code (low byte) + code (high byte);
+  x ISUB 1
+
+END PROC word;
+
+PROC change low byte (INT VAR word, INT CONST low byte):
+  TEXT VAR x := "  ";
+  replace (x, 1, word);
+  replace (x, 1, code (low byte));
+  word := x ISUB 1
+
+END PROC change low byte;
+
+PROC change high byte (INT VAR word, INT CONST high byte):
+  TEXT VAR x := "  ";
+  replace (x, 1, word);
+  replace (x, 2, code (high byte));
+  word := x ISUB 1
+
+END PROC change high byte;
+
+REAL PROC dint (INT CONST low word, high word):
+  real low word + 65536.0 * real high word.
+
+real low word:
+  real (low byte (low word)) + 256.0 * real (high byte (low word)).
+
+real high word:
+  real (low byte (high word)) + 256.0 * real (high byte (high word)).
+
+END PROC dint;
+
+INT PROC high word (REAL CONST double precission int):
+  int (double precission int / 65536.0)
+
+END PROC high word;
+
+INT PROC low word (REAL CONST double precission int): 
+  string of low bytes ISUB 1.
+
+string of low bytes:
+  code (int (double precission int MOD 256.0)) +
+  code (int ((double precission int MOD 65536.0) / 256.0)). 
+ 
+END PROC low word; 
+ 
+END PACKET konvert;
+
diff --git a/system/dos/1.8.7/src/manager-M.dos b/system/dos/1.8.7/src/manager-M.dos
new file mode 100644
index 0000000..e27c513
--- /dev/null
+++ b/system/dos/1.8.7/src/manager-M.dos
@@ -0,0 +1,211 @@
+PACKET dos manager multi DEFINES             (* Copyright (C) 1985, 86, 87 *)
+                                             (* Frank Klapper              *)
+  provide channel,                           (* 16.10.87                   *)
+  dos manager:
+ 
+LET std archive channel = 31,
+
+    ack              = 0,
+    second phase ack = 5,
+    false code       = 6,
+
+    fetch code       = 11,
+    save code        = 12,
+    exists code      = 13,
+    erase code       = 14,
+    list code        = 15,
+    all code         = 17,
+    clear code       = 18,
+    reserve code     = 19,
+    free code        = 20,
+    check read code  = 22,
+    format code      = 23,
+
+    log code         = 78,
+
+    quote            = """";
+
+BOUND STRUCT (TEXT name, pass) VAR msg;
+
+TASK VAR order task;
+
+INT VAR dos channel;
+
+INT VAR fetch save modus;
+
+REAL VAR last access time := 0.0;
+
+TASK VAR disk owner := niltask; 
+
+TEXT VAR save file name;
+
+PROC provide channel (INT CONST channel):
+  dos channel := channel
+
+END PROC provide channel;
+
+IF hd version
+  THEN provide channel (29)
+  ELSE provide channel (std archive channel)
+FI;
+
+PROC dos manager:
+  dos manager (dos channel)
+
+END PROC dos manager;
+
+PROC dos manager (INT CONST channel):
+  dos channel := channel;
+  task password ("-");
+  global manager
+        (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) 
+
+END PROC dos manager;
+
+PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,
+                  TASK CONST from task):
+  enable stop;
+  order task := from task;
+  msg := ds;
+  IF NOT (order task = disk owner) AND 
+     order code <> free code AND order code <> reserve code
+    THEN errorstop ("DOS nicht angemeldet")
+  FI;
+  IF order task = disk owner
+    THEN last access time := clock (1)
+  FI;
+  SELECT order code OF 
+    CASE fetch code     : fetch file 
+    CASE save code      : save file
+    CASE erase code     : erase file
+    CASE clear code     : clear disk
+    CASE exists code    : exists file
+    CASE list code      : list disk
+    CASE all code       : deliver directory
+    CASE reserve code   : reserve
+    CASE free code      : free
+    CASE check read code: check
+    CASE format code    : format
+    CASE log code       : send log
+    OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))
+  END SELECT.
+
+fetch file:
+  fetch (dos name (msg.name, read modus), ds, fetch save modus);
+  manager ok (ds).
+
+check:
+  check file (dos name (msg.name, read modus));
+  manager message (expanded name (msg.name, read modus) + " ohne Fehler gelesen"). 
+
+format:
+  IF phase = 1
+    THEN manager question ("Diskette formatieren")
+    ELSE format dos disk (int (msg.name));
+         manager ok (ds)
+  FI.
+
+save file:
+  IF phase = 1
+    THEN save first phase
+    ELSE save second phase
+  FI.
+
+save first phase:
+  save file name := dos name (msg.name, write modus);
+  IF dos file exists (save file name)
+    THEN manager question (expanded name (msg.name, write modus) + " auf der MS-DOS Disk ueberschreiben")
+    ELSE send (order task, second phase ack, ds)
+  FI.
+
+save second phase:
+  IF dos file exists (save file name)
+    THEN erase dos file (save file name)
+  FI;
+  save (save file name, ds, fetch save modus);
+  forget (ds) ;
+  ds := nilspace ;
+  manager ok (ds).
+
+clear disk: 
+  IF phase = 1
+    THEN manager question ("Diskette loeschen")
+    ELSE clear dos disk;
+         manager ok (ds)
+  FI.
+
+erase file:
+  IF dos file exists (dos name (msg.name, read modus))
+    THEN IF phase = 1
+           THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")
+           ELSE erase dos file (dos name (msg.name, read modus));
+                manager ok (ds)
+         FI
+    ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")
+  FI.
+ 
+exists file:
+  IF dos file exists (dos name (msg.name, read modus))
+    THEN manager ok (ds)
+    ELSE send (order task, false code, ds)
+  FI.
+
+list disk:
+  dos list (ds);
+  manager ok (ds).
+
+send log:
+  forget (ds);
+  ds := old ("logbuch");
+  manager ok (ds).
+
+deliver directory:
+  forget (ds);
+  ds := nilspace;
+  BOUND THESAURUS VAR all names := ds;
+  all names := all dos files;
+  manager ok (ds).
+
+reserve:
+  IF reserve or free permitted
+    THEN continue channel (dos channel);
+         disk owner := from task;
+         fetch save modus := save fetch mode (msg.name);
+         open dos disk (path (msg.name));
+         forget ("logbuch", quiet);
+         manager ok (ds)
+    ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")
+  FI.
+
+reserve or free permitted :
+  from task = disk owner OR last access more than five minutes ago
+  OR disk owner = niltask OR NOT
+  (exists (disk owner) OR station(disk owner) <> station (myself)).
+
+last access more than five minutes ago :
+  abs (last access time - clock (1)) > 300.0.
+
+free: 
+  IF reserve or free permitted
+    THEN close dos disk;
+         disk owner := niltask;
+         break (quiet);
+         manager ok (ds)
+    ELSE manager message ("DOS nicht angemeldet")
+  FI.
+
+END PROC dos manager;
+
+PROC manager ok (DATASPACE VAR ds):
+  send (order task, ack, ds);
+  last access time := clock (1).
+
+END PROC manager ok;
+
+TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):
+  text (quote + dos name (name, status) + quote, 14)
+
+END PROC expanded name;
+
+END PACKET dos manager multi;
+
diff --git a/system/dos/1.8.7/src/manager-S.dos b/system/dos/1.8.7/src/manager-S.dos
new file mode 100644
index 0000000..23885e6
--- /dev/null
+++ b/system/dos/1.8.7/src/manager-S.dos
@@ -0,0 +1,268 @@
+PACKET dos single DEFINES                       (* Copyright (C) 1985 *)
+                                                (* Frank Klapper      *)
+                                                (* 11.09.87           *)
+  /,
+  dos,
+  provide dos channel,
+  archive,
+  reserve,
+  release,
+  save,
+  fetch,
+  erase,
+  check,
+  exists,
+  ALL,
+  SOME,
+  clear,
+  list, 
+  format:
+
+LET std archive channel = 31,
+    main    channel = 1;
+
+INT VAR dos channel := std archive channel;
+INT VAR fetch save modus;
+
+TYPE DOSTASK = TEXT;
+
+DOSTASK CONST dos := "DOS";
+
+OP := (DOSTASK VAR d, TEXT CONST t):
+  CONCR (d) := t
+
+END OP :=;
+
+DOSTASK OP / (TEXT CONST text):
+  DOSTASK VAR d;
+  CONCR (d) := text;
+  d
+
+END OP /;
+
+BOOL PROC is dostask (DOSTASK CONST d):
+  CONCR (d) = "DOS"
+
+END PROC is dos task;
+
+PROC provide dos channel (INT CONST channel no):
+  dos channel := channel no
+
+END PROC provide dos channel;
+
+DATASPACE VAR space := nilspace;
+forget (space);
+
+PROC reserve (TEXT CONST string, DOSTASK CONST task):
+   IF is dostask (task)
+    THEN fetch save modus := save fetch mode (string);
+         open dos disk (path (string))
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+END PROC reserve;
+
+PROC archive (TEXT CONST string, DOSTASK CONST task):
+  reserve (string, task)
+
+END PROC archive;
+
+PROC release (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN close dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+END PROC release;
+
+PROC fetch (TEXT CONST name, DOSTASK CONST from):
+  IF is dostask (from)
+    THEN fetch from dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+fetch from dos disk:
+  IF NOT exists (name) COR overwrite permitted
+    THEN do fetch 
+  FI.
+
+overwrite permitted:
+  say ("eigene Datei """) ; 
+  say (name) ; 
+  yes (""" auf der Diskette ueberschreiben"). 
+
+do fetch:
+  last param (name);
+  disable stop;
+  continue (dos channel);
+  fetch (dos name (name, read modus), space, fetch save modus);
+  continue (main channel);
+  IF NOT is error
+    THEN forget (name, quiet);
+         copy (space, name)
+  FI;
+  forget (space).
+
+END PROC fetch;
+
+PROC erase (TEXT CONST name, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN do erase dos file
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+do erase dos file:
+  IF NOT exists (name, /"DOS")
+    THEN error stop ("die Datei """ + name + """ gibt es nicht")
+  ELIF yes ("""" + dos name (name, read modus)+ """ auf Der Diskette loeschen")
+    THEN disable stop;
+         continue (dos channel);
+         erase dos file (dos name (name, read modus));
+         continue (main channel)
+  FI.
+
+END PROC erase;
+
+PROC save (TEXT CONST name, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN save to dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+save to dos disk:
+  TEXT CONST save file name :: dos name (name, write modus);
+  disable stop;
+  continue (dos channel);
+  IF NOT dos file exists (save file name) COR overwrite permitted
+    THEN IF dos file exists (save file name)
+           THEN erase dos file (save file name)
+         FI;
+         save (save file name, old (name), fetch save modus);
+  FI;
+  continue (main channel).
+
+overwrite permitted:
+  continue (main channel);
+  BOOL CONST result :: yes ("""" + save file name + """ auf der Diskette ueberschreiben");
+  continue (dos channel);
+  result.
+
+END PROC save;
+
+PROC check (TEXT CONST name, DOSTASK CONST from):
+  IF is dostask (from)
+    THEN disable stop;
+         continue (dos channel);
+         check file (dos name (name, read modus));
+         continue (main channel)
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+END PROC check;
+
+BOOL PROC exists (TEXT CONST name, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN disable stop;
+         continue (dos channel);
+         BOOL VAR dummy := dos file exists (dos name (name, read modus));
+         continue (main channel);
+         enable stop;
+         dummy
+    ELSE error stop ("die angesprochene Task existiert nicht"); FALSE
+  FI.
+
+END PROC exists;
+
+PROC list (DOSTASK CONST from):
+  forget (space);
+  space := nilspace;
+  FILE VAR list file := sequential file (output, space);
+  list (list file, from);
+  modify (list file);
+  show (list file);
+  forget (space).
+
+ENDPROC list;
+
+PROC list (FILE VAR list file, DOSTASK CONST from):
+  IF is dos task (from)
+    THEN list dos disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+list dos disk:
+  disable stop;
+  continue (dos channel);
+  dos list (space);
+  continue (main channel);
+  enable stop;
+  output (list file);
+  FILE VAR list source := sequential file (output, space);
+  TEXT VAR line;
+  WHILE NOT eof (list source) REP
+    getline (list source, line);
+    putline (list file,   line)
+  PER.
+
+END PROC list;
+
+THESAURUS OP ALL (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN disable stop;
+         continue (dos channel);
+         THESAURUS VAR dummy := all dos files;
+         continue (main channel);
+         enable stop;
+         dummy
+    ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus
+  FI.
+
+END OP ALL;
+
+THESAURUS OP SOME (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN disable stop;
+         continue (dos channel);
+         THESAURUS VAR dummy := all dos files;
+         continue (main channel);
+         enable stop;
+         SOME dummy
+    ELSE error stop ("die angesprochene Task existiert nicht"); empty thesaurus
+  FI.
+
+END OP SOME;
+
+PROC clear (DOSTASK CONST task):
+  IF is dos task (task)
+    THEN clear disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+clear disk:
+  disable stop;
+  IF yes ("Diskette loeschen")
+    THEN continue (dos channel);
+         clear dos disk;
+         continue (main channel)
+  FI.
+
+END PROC clear;
+
+PROC format (INT CONST format code, DOSTASK CONST task):
+  IF is dos task (task)
+    THEN format disk
+    ELSE error stop ("die angesprochene Task existiert nicht")
+  FI.
+
+format disk:
+  disable stop;
+  IF yes ("Diskette formatieren")
+    THEN continue (dos channel);
+         format dos disk (format code);
+         continue (main channel)
+  FI.
+
+END PROC format;
+
+END PACKET dos single;
+
diff --git a/system/dos/1.8.7/src/name conversion.dos b/system/dos/1.8.7/src/name conversion.dos
new file mode 100644
index 0000000..e72d838
--- /dev/null
+++ b/system/dos/1.8.7/src/name conversion.dos
@@ -0,0 +1,77 @@
+PACKET name conversion DEFINES                  (* Copyright (C) 1985 *)
+                                                (* Frank Klapper      *)
+  dos name,                                     (* 31.12.86           *)
+
+  read  modus,
+  write modus:
+
+BOOL CONST read  modus :: TRUE,
+           write modus :: NOT read modus;
+
+LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&§!()-{}`_",
+    lower case chars = "abcdefghijklmnopqrstuvwxyz";
+
+TEXT PROC dos name (TEXT CONST eu name, BOOL CONST read write modus):
+  enable stop;
+  INT CONST point pos :: pos (eu name, ".");
+  IF name extension exists
+    THEN changed name with extension
+    ELSE changed name without extension
+  FI.
+
+name extension exists:
+  point pos > 0.
+
+changed name with extension:
+  TEXT CONST name pre  :: compress (subtext (eu name, 1, point pos - 1)),
+             name post :: compress (subtext (eu name, point pos + 1));
+  IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3
+    THEN error
+  FI;
+  IF LENGTH name post = 0
+    THEN new name (name pre, read write modus)
+    ELSE new name (name pre, read write modus) + "."
+       + new name (name post, read write modus)
+  FI.
+
+changed name without extension:
+  IF LENGTH eu name > 8 OR LENGTH euname < 1
+    THEN error
+  FI;
+  new name (eu name, read write modus).
+
+error:
+  error stop ("Unzulässiger Name").
+
+END PROC dos name;
+
+TEXT PROC new name (TEXT CONST old name, BOOL CONST read write modus):
+  TEXT VAR new := "";
+  INT VAR count;
+  FOR count FROM 1 UPTO LENGTH old name REP
+    convert char
+  PER;
+  new.
+
+convert char:
+  TEXT CONST char :: old name SUB count;
+  IF is lower case char
+    THEN new CAT (upper case chars SUB string pos)
+  ELIF is upper case char OR read write modus
+    THEN new CAT char
+  ELSE error stop ("Unzulässiger Name")
+  FI.
+
+is lower case char:
+  pos (lower case chars, char) > 0.
+
+is upper case char:
+  pos (upper case chars, char) > 0. 
+
+string pos:
+  pos (lower case chars, char).
+
+END PROC new name; 
+ 
+END PACKET name conversion;
+
diff --git a/system/dos/1.8.7/src/open b/system/dos/1.8.7/src/open
new file mode 100644
index 0000000..518c4b8
--- /dev/null
+++ b/system/dos/1.8.7/src/open
@@ -0,0 +1,66 @@
+PACKET open DEFINES                             (* Copyright (C) 1986 *)
+                                                (* Frank Klapper      *)
+  open  work,                                   (* 05.01.87           *)
+  close work,
+  work opened,
+  work closed,
+  init check rerun,
+  check rerun,
+
+  hd version:
+
+BOOL VAR open;
+INT VAR old session;
+
+BOOL VAR hd flag := FALSE;
+
+INITFLAG VAR packet := FALSE;
+
+PROC open work:
+  open := TRUE
+
+END PROC open work;
+
+PROC close work:
+  open := FALSE
+
+END PROC close work;
+
+BOOL PROC work opened:
+  IF NOT initialized (packet)
+    THEN close work
+  FI;
+  open
+
+END PROC work opened;
+
+BOOL PROC work closed:
+  NOT work opened
+
+END PROC work closed;
+
+PROC init check rerun:
+  old session := session
+
+END PROC init check rerun;
+
+PROC check rerun:
+  IF session <> old session
+    THEN close work;
+         error stop ("Diskettenzugriff im RERUN")
+  FI.
+
+END PROC check rerun;
+
+PROC hd version (BOOL CONST status):
+  hd flag := status
+
+END PROC hd version;
+
+BOOL PROC hd version:
+  hd flag
+
+END PROC hd version;
+
+END PACKET open;
+
diff --git a/system/dos/1.8.7/src/save b/system/dos/1.8.7/src/save
new file mode 100644
index 0000000..7e67e91
--- /dev/null
+++ b/system/dos/1.8.7/src/save
@@ -0,0 +1,233 @@
+PACKET save DEFINES                   (* Copyright (C) 1985, 86, 87 *)
+                                      (* Frank Klapper              *)
+                                      (* 27.04.87                   *)
+  save:
+
+LET ascii        = 1,
+    ascii german = 2,
+    transparent  = 3,
+    row text     = 5,
+    ds           = 6,
+    atari st     = 10,
+    ibm          = 11,
+
+    ff           = ""12"",
+    ctrl z       = ""26"",
+    cr lf        = ""13""10"",
+
+    row text mode length = 4000;
+
+TEXT VAR buffer;
+
+BOUND STRUCT (INT size,
+              ROW row text mode length TEXT cluster row) VAR cluster struct;
+
+PROC save (TEXT CONST file name, DATASPACE CONST file ds, INT CONST mode):
+
+  SELECT mode OF 
+    CASE ascii, ascii german, atari st, ibm, transparent:
+                      save filemode (file ds, filename, mode)
+    CASE row text   : save row textmode (file ds, filename)
+    CASE ds         : save dsmode       (file ds, filename)
+    OTHERWISE error stop ("Unzulässige Betriebsart")
+  END SELECT.
+
+END PROC save;
+
+PROC save filemode (DATASPACE CONST file space, TEXT CONST name, INT CONST code type):
+
+  enable stop;
+  open save dos file (name);
+  FILE VAR file := sequential file (modify, file space);
+  buffer := "";
+  INT VAR line no;
+  FOR line no FROM 1 UPTO lines (file) REP
+    to line (file, line no);
+    buffer cat file line;
+    WHILE length (buffer) >= cluster size REP
+      write next save dos cluster (subtext (buffer, 1, cluster size));
+      buffer := subtext (buffer, cluster size + 1)
+    PER
+  PER;
+  IF ascii code
+    THEN buffer CAT ctrl z
+  FI;
+  write rest;
+  close save dos file;
+  buffer := "".
+
+buffer cat file line:
+  exec (PROC (TEXT CONST, INT CONST) cat adapted line, file, code type).
+ 
+ascii code:
+  (code type = ascii) OR (code type = ascii german).
+
+write rest:
+  WHILE buffer <> ""
+    REP write next save dos cluster (subtext (buffer, 1, cluster size));
+        buffer := subtext (buffer, cluster size + 1)
+  PER.
+ 
+END PROC save filemode; 
+ 
+PROC cat adapted line (TEXT VAR line, INT CONST code type):
+
+  IF code type = transparent
+    THEN buffer CAT line
+    ELSE change esc sequences;
+         change eumel print chars;
+         SELECT code type OF
+           CASE ascii       : ascii change
+           CASE ascii german: ascii german change
+           CASE atari st    : atari st change
+           CASE ibm         : ibm change
+         END SELECT;
+         buffer CAT line;
+         IF (line SUB length (line)) <> ff
+           THEN buffer CAT cr lf
+         FI
+  FI.
+
+change esc sequences:
+  change all (line, "#page#", ff);
+  INT VAR p := pos (line, "#");
+  WHILE p > 0 REP
+    IF is esc sequence
+      THEN change (line, p, p+4, coded char)
+    FI;
+    p := pos (line, "#", p+1)
+  PER.
+
+is esc sequence:
+  LET digits = "0123456789";
+  (line SUB (p+4)) = "#"         CAND pos (digits, line SUB p+1) > 0 CAND
+  pos (digits, line SUB p+2) > 0 CAND pos (digits, line SUB p+3) > 0.
+
+coded char:
+  code (int (subtext (line, p+1, p+3))).
+
+change eumel print chars:
+  p := pos (line, ""220"", ""223"", 1);
+  WHILE p > 0 REP
+    replace (line, p, std char);
+    p := pos (line, ""220"", ""223"", p + 1)
+  PER.
+
+std char:
+ "k-# " SUB (code (line SUB p) - 219).
+
+ascii change: 
+  change all (line, "ß", "#251#");
+  p := pos (line, "Ä", "ü", 1);
+  WHILE p > 0 REP
+    change (line, p, p, ersatzdarstellung (line SUB p));
+    p := pos (line, "Ä", "ü", p + 1)
+  PER.
+
+ascii german change: 
+  change all (line, "[", "#091#");
+  change all (line, "\", "#092#");
+  change all (line, "]", "#093#");
+  change all (line, "{", "#123#");
+  change all (line, "|", "#124#");
+  change all (line, "}", "#125#");
+  change all (line, "~", "#126#");
+  change all (line, "ß", ""126"");
+  p := pos (line, "Ä", "ü", 1);
+  WHILE p > 0 REP
+    replace (line, p, umlaut in ascii german);
+    p := pos (line, "Ä", "ü", p + 1)
+  PER.
+
+umlaut in ascii german:
+  "[\]{|}" SUB (code (line SUB p) - 213).
+
+ibm change: 
+  change all (line, "ß", ""225"");
+  p := pos (line, "Ä", "ü", 1);
+  WHILE p > 0 REP
+    replace (line, p, umlaut in ibm);
+    p := pos (line, "Ä", "ü", p + 1)
+  PER.
+
+atari st change: 
+  change all (line, "ß", ""158"");
+  p := pos (line, "Ä", "ü", 1);
+  WHILE p > 0 REP
+    replace (line, p, umlaut in ibm);
+    p := pos (line, "Ä", "ü", p + 1)
+  PER.
+
+umlaut in ibm:
+  ""142""153""154""132""148""129"" SUB (code (line SUB p) - 213).
+
+END PROC cat adapted line;
+
+TEXT PROC ersatzdarstellung (TEXT CONST char):
+
+  TEXT CONST t :: text (code (char SUB 1));
+  "#" + (3 - length (t)) * "0" + t + "#"
+
+END PROC ersatzdarstellung;
+
+PROC save rowtextmode (DATASPACE CONST space, TEXT CONST name):
+
+  enable stop;
+  open save dos file (name);
+  init save row textmode;
+  WHILE line no < cluster struct.size REP
+    fill buffer;
+    write next save dos cluster (subtext (buffer, 1, cluster size));
+    remember rest
+  PER;
+  write rest;
+  close save dos file;
+  buffer := "".
+
+init save rowtextmode:
+  cluster struct  := space;
+  buffer := "";
+  INT VAR line no := 0.
+
+fill buffer:
+  WHILE line no < cluster struct.size AND NOT buffer full REP
+    line no INCR 1;
+    buffer CAT cluster struct.cluster row [line no]
+  PER.
+
+buffer full:
+  LENGTH buffer >= cluster size.
+
+remember rest:
+  buffer := subtext (buffer, cluster size + 1).
+
+write rest:
+  WHILE buffer <> ""
+    REP write next save dos cluster (subtext (buffer, 1, cluster size));
+        remember rest
+  PER.
+
+END PROC save rowtextmode;
+ 
+PROC save ds mode (DATASPACE CONST out ds, TEXT CONST name):
+
+  enable stop;
+  open save dos file (name);
+  INT VAR page no := first non dummy ds page;
+  get last allocated ds page; 
+  WHILE page no <= last allocated ds page REP
+    write next save dos cluster (out ds, page no);
+  PER;
+  close save dos file.
+
+get last allocated ds page:
+  INT VAR last allocated ds page := -1, 
+          i;
+  FOR i FROM 1 UPTO ds pages (out ds) REP
+    last allocated ds page := next ds page (out ds, last allocated ds page) 
+  PER.
+
+END PROC save ds mode;
+
+END PACKET save;
+
diff --git a/system/dos/1.8.7/src/shard interface b/system/dos/1.8.7/src/shard interface
new file mode 100644
index 0000000..20d9b76
--- /dev/null
+++ b/system/dos/1.8.7/src/shard interface
@@ -0,0 +1,20 @@
+; ';' in Spalte 1 kennzeichnet eine Kommentarzeile
+; alle Werte müssen durch Blanks getrennt werden
+;
+;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen
+;                         negativ für seitenorientiertes Lesen
+;
+;size     heads   tracks    first sectors  last sector
+;=====================================================
+320        1       40         1              8
+360        1       40         1              9
+640       -2       40         1              8
+720       -2       40         1              9
+800        2       40         1             10
+1440      -2       80         1              9
+1600       2       80         1             10
+2400      -2       80         1             15
+1232       1       77         0             15
+2464      -2       77         0             15
+; END OF FILE
+
diff --git a/system/dos/1986/doc/DSKDOS.ELA b/system/dos/1986/doc/DSKDOS.ELA
new file mode 100644
index 0000000..69bc714
--- /dev/null
+++ b/system/dos/1986/doc/DSKDOS.ELA
@@ -0,0 +1,967 @@
+#type ("17.klein")# 

+prefix of extended fcb:

+

+ offset  size  name

+     -7     1     flag byte          255

+     -6     5     reserved

+     -1     1     attribute byte     2=hidden file, 4=system file

+

+normal fcb format:

+

+ offset  size  name

+      0     1     drive number       0=default (for open), 1=A, 2=B

+      1     8     filename           8 chars, left aligned and padded

+                                     (if necessary) with blanks

+      9     3     extension          3 chars, left aligned and padded

+                                     (if necessary) with blanks

+     12     2     current block      pointer to the block of 128 records

+                                     containing the current record

+                                     (0 after open)

+     14     2     record size        logical record size in bytes

+                                     (128 after open, changed eventually)

+     16     4     file size          file size in bytes (1. byte low)

+     20     2     date of last write 20:mmmddddd 21:yyyyyyym

+     22     2     time of last write 22:mmmsssss 23:hhhhhmmm

+     24     8     reserved

+     32     1     current record     pointer to one of the 128 records in

+                                     the block (not initialized by open)

+                                     must be set before sequential read/write

+     33     4     relative record    pointer to selected record

+                                     (counting from the beginning of file by 0)

+                                     not initialized by open

+                                     must be set before sequential read/write

+                                     record size less than

+                                     64 bytes: both words used

+                                     else only first 3 bytes

+

+fields of directory entry:

+

+ offset  size  name

+      0     8  filename           8 chars, left aligned and padded

+                                  (if necessary) with blanks

+                                  special use of first byte:

+                                  0  : end of allocated directory

+                                  229: free directory entry

+      8     3  extension          3 chars, left aligned and padded

+                                  (if necessary) with blanks

+     11     1  attributes          1: read only file

+                                   2: hidden file

+                                   4: system file

+                                   8: entry is the volume's id

+                                  16: entry is subdirectory's name

+                                  32: archive bit (set, when written to)

+     12    10  reserved

+     22     2  time of last write 22:mmmsssss 23:hhhhhmmm

+     24     2  date of last write 24:mmmddddd 25:yyyyyyym

+     26     2  reserved

+     28     4  file size          file size in bytes (1. byte low)

+

+directory structure:

+

+ - the root directory has a fixed number of entries

+ - entries that represent a subdirectory have a special attribute in their

+   entry set

+ - the subdirectories are themselves files which records are of the same type

+   as those in the root directory

+ - the number of entries in subdirectories are not limited

+ - the length of a path to a subdirectory is not limited

+

+application of the directory entry fields on subdirectory entries:

+

+ volume id    : present at root, only one entry has this attribute

+ directory    : the directory entry represents itself an directory

+ read only    : meaningless

+ archive      : meaningless

+ hidden/system: prevents directories from beeing found, function $3B

+                will still work

+

+ms-dos interrupts:

+

+ $20 : program terminate

+     call:

+           CS: segment address

+     terminates process, returns control to parent process,

+     file handles are closed, disk cache cleaned, file buffers flushed

+     programm terminate, alt-c and critical error addresses are restored

+     new programs should use function $4C

+ $21 : function request

+     call:

+           AH: function number

+           other registers dependent on function

+ $22 to $24 :

+     address locations for msdos use

+     can be changed by function $25

+ $22 : terminate address

+ $23 : alt-c exit address

+     address of an alt-c routine

+ $24 : fatal error abort address

+     address of the error handler

+     BP:SI can contain further information

+     not called if error occurs during absolute disk operations (int $25,$26)

+ $25 : absolute disk read

+     call:

+           AL: drive number

+           DS:BX: disk transfer address

+           CX: number of sectors

+           DX: beginning relative sector

+     return:

+             CF: 0=successful

+                 1=unsuccessful

+             AL: error code if unsuccessful

+ $26 : absolute disk write

+     call:

+           AL: drive number

+           DS:BX: disk transfer address

+           CX: number of sectors

+           DX: beginning relative sector

+     return:

+             CF: 0=successful

+                 1=unsuccessful

+             AL: error code if unsuccessful

+ $27 : terminate but stay resident

+     call:

+           CS:DX: first byte following the code

+     new programms should use function $31

+

+ms-dos function requests:

+

+ $00 : terminate program

+     call:

+           AH: $00

+           CS: segment of programm prefix

+ $01 : read keyboard and echo

+     call:

+           AH: $01

+     return:

+             AL: character typed

+     waits for input, echos and returns it

+     alt-c will call interrupt

+ $02 : display character

+     call:

+           AH: $02

+           DL: character to be displayed

+     alt-c will call interrupt

+ $03 : auxiliary input

+     call:

+           AH: $03

+     return:

+             AL: character from auxiliary device

+     waits for input, alt-c will call interrupt

+ $04 : auxiliary output

+     call:

+           AH: $04

+           DL: character to output

+     alt-c will call interrupt

+ $05 : print character

+     call:

+           AH: $05

+           DL: character for printer

+     alt-c will call interrupt

+ $06 : direct console i/o

+     call:

+           AH: $06

+           DL: $FF: check for keyboard input

+               otherwise: display DL on screen

+     return:

+             ZF: 0=no char available

+                 1=char was read

+             AL: char if read

+ $07 : direct konsole input

+     call:

+           AH: $07

+     return:

+             AL: character from keyboard

+     waits for character

+ $08 : read keyboard

+     call:

+           AH: $08

+     return:

+             AL: character from keyboard

+     waits for character, alt-c will call interrupt

+ $09 : display string

+     call:

+           AH: $09

+           DS:DX: string, ending with '$'

+ $0A : buffered keyboard input

+     call:

+           AH: $0A

+           DS:DX: input buffer

+                  byte 1: maximum number of chars in buffer (with CR)

+                       2: actual number of chars in buffer (set by function)

+                       3-n: must be at least as long as the max

+     waits for chars, allows editing, ignores overflow,

+     alt-c will call interrupt

+ $0B : check keyboard status

+     call:

+           AH: $0B

+     return:

+             AL:   0=no chars in type-ahead buffer

+                 255=chars available

+ $0C : flush buffer and read keyboard

+     call:

+           AH: $0C

+           AL: $01,$06,$07,$08 or $0A: corresponding function is called

+               other values: no further processing

+     return:

+             AL: 0=type ahead buffer was flushed, no processing performed

+ $0D : disk reset

+     call:

+           AH: $0D

+     all disk buffers are flushed, no directory updates performed

+ $0E : select disk

+     call:

+           AH: $0E

+           DL: drive number, 1=A, 2=B, ..

+     return:

+             AL: number of logical drives

+ $0F : open file

+     call:

+           AH: $0F

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                     if drive code was 0, it is set to the default

+                     current block is set to 0

+                     record size is set to 128

+                     file size, time and date of last modification are set

+                     from directory

+                     the default record size must be set, if not 128

+                     before performing a sequential (random) operation,

+                     current record (relative record) field must be set

+                 255=no directory entry found

+

+ $10 : close file

+     call:

+           AH: $10

+           DS:DX: opened fcb

+     return:

+             AL:   0=directory entry found

+                 255=no directory entry found

+ $11 : search for first entry

+     call:

+           AH: $11

+           DS:DX: unopened fcb

+     return:

+               0=directory entry found

+                 fcb (normal or extended) is created

+                 at the disk transfer address

+             255=no directory entry found

+     to search for hidden or system files, the fcb must be extended

+     see notes on search attributes

+ $12 : search for next entry

+     call:

+           AH: $12

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                     fcb (normal or extended) is created

+                     at the disk transfer address

+                 255=no directory entry found

+     the fcb must be one used previously in a call to $11

+ $13 : delete file

+     call:

+           AH: $13

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                 255=no directory entry found

+     deletes all files with matching names

+ $14 : sequential read

+     call:

+           AH: $14

+           DS:DX: opened fcb

+     return:

+             AL: 0=read completed successfully

+                 1=eof, no data in the record

+                 2=dta too small, not enough space to read without exceeding

+                   the segment boundaries, read cancelled

+                 3=eof, partial record was read and padded to the record

+                   length with zeros

+     the record pointed to by the current block and current record

+     is loaded to the disk transfer address and the fields are incremented

+ $15 : sequential write

+     call:

+           AH: $15

+           DS:DX: opened fcb

+     return:

+             AL: 0=write completed successfully

+                 1=disk full, write canceled

+                 2=dta too small to write one record without exceeding the

+                   segment boundaries, write canceled

+     the record pointed to by the current block and current record

+     are written from the disk transfer address and the fields are incremented

+ $16 : create file

+     call:

+           AH: $16

+           DS:DX: unopened fcb

+     return:

+             AL:   0=empty directory entry found

+                 255=no empty entry available and file didn't exist before

+     if the file does already exist, it is made a zero length file

+     else it is created if an empty entry is found

+ $17 : rename file

+     call:

+           AH: $17

+           DS:DX: modified fcb

+     return:

+             AL:   0=directory entry found

+                 255=no directory entry found or destination already exists

+     the fcb must contain the search file name and another file name

+     at offset $11

+ $19 : current disk

+     call:

+           AH: $19

+     return:

+             AL: selected drive (0=A, 1=B, .. )

+ $1A : set disk transfer address

+     call:

+           AH: $1A

+           DS:DX: disk transfer address

+     default is $80 in the psp

+ $21 : random read

+     call:

+           AH: $21

+           DS:DX: opened fcb

+     return:

+             0=read completed successfully

+             1=eof, no data read

+             2=dta too small, read canceled

+             3=eof, partial record, padded with zeros

+     the current block and current record fields are set to match the

+     relative record field, then the record is loaded

+ $22 : random write

+     call:

+           AH: $22

+           DS:DX: opened fcb

+     return:

+             AL: 0=write completed successfully

+                 1=disk full

+                 2=dta too small, read canceled

+ $23 : file size

+     call:

+           AH: $23

+           DS:DX: unopened fcb

+     return:

+             AL:   0=directory entry found

+                     the relative record field is set to the number

+                     of records in the file

+                 255=no directory entry found

+     the record size field must be set

+ $24 : set relative record

+     call:

+           AH: $24

+           DS:DX: opened fcb

+     the relative record field is set to the same record as the current block

+     an the current record field

+ $25 : set vector

+     call:

+           AH: $25

+           AL: interrupt number

+           DS:DX: interrupt handling routine

+ $27 : random block read

+     call:

+           AH: $27

+           DS:DX: opened fcb

+           CX: number of blocks to read

+     return:

+             AL: 0=read completed successfully

+                 1=eof, no data read

+                 2=end of segment, read canceled

+                 3=eof, partial record, padded with zeros

+             CX: number of blocks read

+     the reading starts at the relative record

+     the current block, current record and relative record field are updated

+ $28 : random block write

+     call:

+           AH: $28

+           DS:DX: opened fcb

+           CX: number of records to write

+               0=set file size

+                 the file size field of thedirectory entry is set to the number

+                 of records specified by the relative record field

+     return:

+             AL: 0=write completed successfully

+                 1=disk full, no records written

+                 2=end of dta-segment, read canceled

+             CX: number of blocks written

+     the writing starts at the relative record

+     the current block, current record and relative record field are updated

+ $29 : parse file name

+     call:

+           AH: $29

+           AL: controls parsing

+               bit 0: if file separators are encountered

+                      (: . ; , = + / " [ ] \ < ] | blank tab)

+                     0: all parsing stops

+                     1: leading separators are ignored

+               bit 1: if the string does not contain a drive letter

+                     0: the fcb drive number is set to 0 (default)

+                     1: the fcb drive number is not changed

+               bit 2: if the string does not contain a filename

+                     0: the fcb filename is set to 8 blanks

+                     1: the fcb filename is not changed

+               bit 3: if the string does not contain an extension

+                     0: the fcb extension is set to three blanks

+                     1: the fcb extension is not changed

+           DS:SI: string to parse

+                  filename terminators include all filename separators

+                  plus any control character

+           ES:DI: if the string contained a valid filename,

+                  it points to an unopened fcb

+                  else ES:DI+1 points to a blank

+     return:

+             AL:   0=no wild card characters

+                   1=wild card characters used

+                 255=drive letter invalid

+             DS:SI: first byte past string that was parsed

+                    if the filename contains an asterisk,

+                    all folowing letters are set to question mark

+             ES:DI: unopened fcb

+                    if filename is found, an unopened fcb is created here

+ $2A : get date

+     call:

+           AH: $2A

+     return:

+             CX: year (1980-2099)

+             DH: month (1-12)

+             DL: day (1-31)

+             AL: day of week (0=sun, .., 6=sat)

+ $2B : set date

+     call:

+           AH: $2B

+           CX: year (1980-2099)

+           DH: month (1-12)

+           DL: day (1-31)

+     return:

+             AL:   0=date was valid

+                 255=date was invalid

+ $2C : get time

+     call:

+           AH: $2C

+     return:

+             CH: hour (0-23)

+             CL: minutes (0-59)

+             DH: seconds (0-59)

+             DL: hundredths (0-99)

+ $2D : set time

+     call:

+           AH: $2D

+           CH: hour (0-23)

+           CL: minutes (0-59)

+           DH: seconds (0-59)

+           DL: hundredths (0-99)

+     return:

+             AL:   0=time was valid

+                 255=time was invalid

+ $2E : set/reset verify flag

+     call:

+           AH: $2E

+           AL: 0=do not verify

+               1=verify

+ $2F : get disk transfer address

+     call:

+           AH: $2F

+     return:

+             ES:BX: points to disk transfer address

+ $30 : get dos version number

+     call:

+           AH: $30

+     return:

+             AL: major version number

+             AH: minor version number

+ $31 : keep process

+     call:

+           AH: $31

+           AL: exit code

+           DX: memory size in paragraphs

+     attemts to set the initial allocation block to a specific size

+     in paragraphs, will not free up other allocation blocks belonging

+     to that process, the exit code is available via function $4D

+ $33 : alt-c check

+     call:

+           AH: $33

+           AL: function

+               0=request current state

+               1=set state

+           DL: if setting

+               0=off

+               1=on

+     return:

+             AL: 255=al parameter was not in range 0..1

+             DL: if requesting current state

+                 0=off

+                 1=on

+     if check is on, every system call executes the check,

+     else only the device operations

+ $35 : get interrupt vector

+     call:

+           AH: $35

+           AL: interrupt number

+     return:

+             ES:BX: pointer to interrupt routine

+ $36 : get disk free space

+     call:

+           AH: $36

+           DL: drive (0=default, .....)

+     return:

+             BX: available clusters

+             DX: clusters per drive

+             CX: bytes per sector

+             AX: $FFFF=drive number invalid

+                 otherwise sectors per cluster

+ $38 : return country-dependent information

+     call:

+           AH: $38

+           DS:DX: pointer to 32 byte memory area

+                  area format:

+                  size     name

+                  2        date/time format

+                           0=usa standard    h:m:s m/d/y

+                           1=europe standard h:m:s d/m/y

+                           2=japan standard  y/m/d h:m:s

+                  5 asciz  currency symbol

+                  2 asciz  thousands separator

+                  2 asciz  decimal separator

+                  2 asciz  date separator

+                  2 asciz  time separator

+                  1        bit field

+                           bit 0: 0=currency symbol precedes amount

+                                  1=symbol comes after amount

+                           bit 1: 0=symbol immediately precedes the amount

+                                  1=space between symbol and amount

+                  1        currency places

+                           figures after decimal point of currency amounts

+                  1        time format

+                           0=12 hour time

+                           1=24 hour time

+                  4        case mapping call

+                           FAR procedure performs country-specific

+                           lower- to uppercase mapping

+                  2 asciz  data list separator

+                  if dx=-1 and the country code in AL is found,

+                  the current country is set accordingly

+

+           AL: function code

+               0=current country

+               or country code (usually international telephone prefix)

+               must be 0 in msdos 2.0 (only fully implemented after 2.01)

+     return:

+             CARRY: 1

+                    AX: 2=file not found

+             CARRY: 0

+                    DS:DX: filled with country data

+ $39 : create subdirectory

+     call:

+           AH: $39

+           DS:DX: pointer to pathname (asciz)

+     return:

+             CARRY: 1

+                    AX: 3=path not found

+                        5=access denied

+                          no room in parent,

+                          directory already exists or device was specified

+             CARRY: 0=no error

+ $3A : remove a directory entry

+     call:

+           AH: $3A

+           DS:DX: pointer to pathname (asciz)

+     return:

+             CARRY: 1

+                    AX:  3=path not found

+                         5=access denied

+                           directory not empty, not a directory, root directory

+                        16=current directory

+             CARRY: 0=no error

+ $3B : change the current directory

+     call:

+           AH: $3B

+           DS:DX: pointer to pathname (asciz)

+     return:

+             CARRY: 1

+                    AX: 3=path not found

+             CARRY: 0=no error

+ $3C : create a file

+     call:

+           AH: $3C

+           DS:DX: pointer to pathname

+           CX: file attribute

+     return:

+             CARRY: 1

+                    AX: 3=path not found

+                        4=too many open files

+                          file was created, but no room for handle

+                        5=access denied

+                          uncreatable attribute (directory or volume id),

+                          a file with a more inklusive attribute set exists,

+                          or a directory with the same name exists

+             CARRY: 0

+                    AX is handle number

+                    handle is open for read/write

+     creates a new file or truncates existing to length 0

+ $3D : open a file

+     call:

+           AH: $3D

+           DS:DX: pointer to pathname (asciz)

+           AL: access

+               0=open for reading

+               1=open for writing

+               2=open for both

+     return:

+             CARRY: 1

+                    AX:  2=file not found

+                         4=too many open files

+                           no file handles available

+                         5=access denied

+                           attempted to open a directory, volume id or

+                           a read only file for writing

+                        12=invalid access

+                           AL was not in range 0..2

+             CARRY: 0

+                    AX is handle number

+     read/write pointer is set to the first byte of the file

+     and the record size is set to 1

+     the returned file handle must be used in subsequent operations

+ $3E : close a file handle

+     call:

+           AH: $3E

+           BX: file handle

+     return:

+             CARRY: 1

+                    6=invalid handle (not currently open)

+             CARRY: 0=no error

+     the associated file is closed, buffers are flushed

+ $3F : read from file/device

+     call:

+           AH: $3F

+           DS:DX: pointer to buffer

+           CX: bytes to read

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 5=access denied

+                          not opened for read

+                        6=invalid handle (not currently open)

+             CARRY: 0

+                    AX: number of bytes read

+                        0=eof

+ $40 : write to file/device

+     call:

+           AH: $40

+           DS:DX: pointer to buffer

+           CX: bytes to write

+               if 0, the file size is set to the current position

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 5=access denied

+                        6=invalid handle

+             CARRY: 0

+                    AX: number of bytes written

+                        is error if not the same number as requested

+ $41 : delete a directory entry

+     call:

+           AH: $41

+           DS:DX: pointer to pathname

+     return:

+             CARRY: 1

+                    AX: 2=file not found

+                        5=access denied

+                          directory or read only

+             CARRY: 0=no error

+ $42 : move file pointer

+     call:

+           AH: $42

+           CX:DX: distance to move, in bytes

+           AL: method of moving

+               0=move pointer to offset from beginning of file

+               1=move to offset from current location

+               2=move to offset from eof

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 1=invalid function

+                          AL not in range 0..2

+                        6=invalid handle

+             CARRY 0:

+                   DX:AX: new pointer location

+     moves the read/write file pointer

+ $43 : change attributes

+     call:

+           AH: $43

+           DS:DX: pointer to pathname (asciz)

+           AL: function

+               0=return in CX

+               1=set to CX

+           CX: if AL=1

+               attribute to be set

+     return:

+             CARRY: 1

+                    AX: 1=invalid function

+                          AL not in range 0..1

+                        3=path not found

+                        5=access denied

+                          CX contained attributes that can not be changed

+                             (directory, volume id)

+             CARRY: 0

+                    if AL=0

+                    CX: attributes

+ $44 : i/o control for devices

+     call:

+           AH: $44

+           BX: handle

+           BL: (for calls AL=4, 5) drive: 0=default, ..

+           DS:DX: data or buffer

+           CX: bytes to read or write

+           AL: function code

+               calls 0,1: bits of DX (DH must be 0 on a set call)

+                          0:    iscin

+                          1:    iscot

+                          2:    isnul

+                          3:    isclk

+                          4:    specl

+                          5:    raw

+                          6:    eof

+                          7:    isdev

+                          8-13: reserved

+                          14:   ctrl

+                          15:   res

+                          if isdev=0 then channel is a disk file

+                             eof: 0=channel has been written

+                             bits 0-5 are block device number for the channel

+                                  (0=a, 1=b, ..)

+                          if isdev=1 then channel is device

+                             eof  : 0=end of file on input

+                             raw  : 0=this device is cooked

+                                    1=device in raw mode

+                             isclk: 1=clock

+                             isnul: 1=nul

+                             iscot: 1=console output

+                             iscin: 1=console input

+                             specl: 1=device is special

+                             ctrl : 0=device can not do control strings

+                                      via calls 2,3

+                                    1=can do control

+               0=get device information (returned in DX)

+               1=set device information (according to DX)

+               calls 2,5: arbitrary control strings sent or received

+                          to or from a device

+                          call syntax is the same as in read/write calls,

+                          except for 4 and 5, which take drive number in BL

+                          instead of a handle in BX

+                          an invalid function error is returned, if

+                          the ctrl bit is 0

+               2=read CX number of bytes to DS:DX from device control channel

+               3=write CX number of bytes from DS:DX to device control channel

+               4=read CX number of bytes to DS:DX from device control channel

+                 drive number in BL (0=default, ..)

+               5=write CX number of bytes from DS:DX to device control channel

+                 drive number in BL (0=default, ..)

+               calls 6,7: check, if a file handle is ready for i/o

+                          intended for status of handles associated with

+                          devices, but checks of file handles are allowed

+                          and defined: input: always ready (255), until eof

+                                              then always not ready (0)

+                                       output: always ready

+               6=get input status

+               7=get output status

+     return:

+             CARRY: 1

+                    AX:  1=invalid function

+                         5=access denied

+                         6=invalid handle

+                        13=invalid data

+             CARRY: 0

+                    AL: 2,3,4,5

+                    AX: count transferred

+                    AL: 6,7

+                          0=not ready

+                        255=ready

+     sets or gets device information associated with an open handle

+     or sends or receives a control string to or from a device handle or device

+     if the function is used for files, only functions 0,6,7 are defined

+ $45 : duplicate a file handle

+     call:

+           AH: $45

+           BX: file handle

+     return:

+             CARRY: 1

+                    AX: 4=too many files open

+                        6=invalid handle

+             CARRY: 0

+                    AX: new file handle

+     retruns a new handle that refers to the same file

+ $46 : force a duplicate of a handle

+     call:

+           AH: $46

+           BX: existing file handle

+           CX: new file handle

+     return:

+             CARRY: 1

+                    AX: 4=too many open files

+                        6=invalid handle

+             CARRY: 0=no error

+     CX then refers to the same file as BX, eventually, CX is closed first

+ $47 : return text of current directory

+     call:

+           AH: $47

+           DS:SI: pointer to 64 byte area

+           DL: drive number (0=default, ..)

+     return:

+             CARRY: 1

+                    AX: 15=invalid drive

+             CARRY: 0=no error

+     the path name does not contain the leading separators

+ $48 : allocate memory

+     call:

+           AH: $48

+           BX: size of memory to be allocated

+     return:

+             CARRY: 1

+                    AX: 7=arena trashed

+                          internal consistency has been destroyed

+                        8=not enough memory

+                    BX: maximum size that could be allocated

+             CARRY: 0

+                    AX:0: pointer to the allocated memory

+ $49 : free allocated memory

+     call:

+           AH: $49

+           ES: segment address of memory area to be freed

+     return:

+             CARRY: 1

+                    AX: 7=arena trashed

+                          internal consistency has been destroyed

+                        9=invalid block

+                          the block was not allocated by $49

+             CARRY: 0=no error

+     returns a piece of memory to the system pool that was allocated with $49

+ $4A : modify allocated memory blocks

+     call:

+           AH: $4A

+           ES: segment address of memory area

+           BX: requested memory area

+     return:

+             CARRY: 1

+                    AX: 7=arena trashed

+                          internal consistency has been destroyed

+                        8=not enough memory

+                        9=invalid block

+                          the block was not allocated by $49

+                    BX: maximum size possible

+             CARRY: 0=no error

+     attempts to grow or shrink an allocated block

+ $4B : load and execute a program

+     call:

+           AH: $4B

+           DS:DX: pointer to pathname (asciz)

+           ES:BX: pointer to parameter block

+                  for AL=0:

+                  size    name

+                  2       segment address of environment

+                  4       pointer to command line at $80

+                  4       pointer to default fcb to be passed at $5C

+                  4       pointer to default fcb to be passed at $6C

+                  for AL=3:

+                  size    name

+                  2       segment address where file will be loaded

+                  2       relocation factor to be applied to the image

+           AL: 0=load and execute

+               3=load (overlay)

+     return:

+             CARRY: 1

+                    AX:  1=invalid function

+                           AL was not in range 0,3

+                         2=file not found

+                         8=not enough memory

+                        10=bad environment

+                           larger than 32K

+                        11=bad format

+                           EXE file contained inconsistent information

+             CARRY: 0=no error

+     all open files of a parent are copied to the child process

+     also inherited is an environment (block of text strings less than 32K)

+     a zero environment address causes the child to inherit then parents

+     environment unchanged

+ $4C : terminate process

+     call:

+           AH: $4C

+           AL: return code

+ $4D : retrieve then return code of a child

+     call:

+           AH: $4D

+     return:

+             AX: exit code

+                 high byte: 0=terminate/abort

+                            1=alt-c

+                            2=hard error

+                            3=terminate and stay resident

+     returns code only once

+ $4E : find match file

+     call:

+           AH: $4E

+           DS:DX: pointer to pathname

+           CX: search attributes

+     return:

+             CARRY: 1

+                    AX:  2=file not found

+                        18=no more files

+             CARRY: 0=no error

+     data block is written to current dma address:

+      size    name

+      21      reserved for subsequent calls

+       1      attribute found

+       2      time

+       2      date

+       2      low(size)

+       2      high(size)

+      13      packed name

+     subsequent calls: see $4F

+ $4F : step through a directory matching files

+     call:

+           AH: $4F

+     return:

+             CARRY: 1

+                    AX: 18=no more files

+             CARRY: 0=no error

+     only used for subsequent calls after $4E

+     dma address must point to the parablock

+ $54 : return current setting of verify after write flag

+     call:

+           AH: $54

+     return:

+             current verify flag value

+ $56 : move a directory entry

+     call:

+           AH: $56

+           DS:DX: pointer to pathname of existing file

+           ES:DI: pointer to new pathname

+     return:

+             CARRY: 1

+                    AX:  2=file not found

+                         5=access denied

+                           path is directory or new file exists

+                           or directory entry could not be created

+                        17=not same device

+             CARRY: 0=no error

+     attempts to rename a file in the directory of one device

+ $57 : get/set date/time of file

+     call:

+           AH: $57

+           AL: 0=get date and time

+               1=set date and time

+           BX: file handle

+           CX: if AL=1

+               time to be set

+           DX: if AL=1

+               date to be set

+     return:

+             CARRY: 1

+                    AX: 1=invalid function

+                        6=invalid handle

+             CARRY: 0=no error

+                    CX: if AL=0

+                        time

+                    DX: if AL=0

+                        date

+     date and time are not recorded until file is closed

+

diff --git a/system/dos/1986/src/252 b/system/dos/1986/src/252
new file mode 100644
index 0000000..b4369b6
--- /dev/null
+++ b/system/dos/1986/src/252
diff --git a/system/dos/1986/src/253 b/system/dos/1986/src/253
new file mode 100644
index 0000000..c7a4494
--- /dev/null
+++ b/system/dos/1986/src/253
diff --git a/system/dos/1986/src/254 b/system/dos/1986/src/254
new file mode 100644
index 0000000..f71eeb6
--- /dev/null
+++ b/system/dos/1986/src/254
diff --git a/system/dos/1986/src/255 b/system/dos/1986/src/255
new file mode 100644
index 0000000..d21b649
--- /dev/null
+++ b/system/dos/1986/src/255
diff --git a/system/dos/1986/src/COND.TXT b/system/dos/1986/src/COND.TXT
new file mode 100644
index 0000000..02cb949
--- /dev/null
+++ b/system/dos/1986/src/COND.TXT
@@ -0,0 +1,5 @@
+FLOPPY = TRUE

+HDU    = FALSE

+TEST   = FALSE

+DOS    = TRUE

+CPM    = FALSE

diff --git a/system/dos/1986/src/block i-o b/system/dos/1986/src/block i-o
new file mode 100644
index 0000000..4336746
--- /dev/null
+++ b/system/dos/1986/src/block i-o
@@ -0,0 +1,104 @@
+PACKET disk block io DEFINES                    (* Copyright (C) 1986 *)

+                                                (* Frank Klapper      *)

+                                                (* 25.03.86           *)

+  read disk block,

+  read disk cluster, 

+  write disk block,

+  write disk cluster,

+  io error,

+  first non dummy ds page:

+ 

+INT CONST first non dummy ds page := 2;

+

+INT VAR error;

+

+PROC read disk block (DATASPACE VAR ds,

+                      INT CONST ds page no, 

+                      INT CONST block no,

+                      INT VAR error):

+  check rerun;

+  read block (ds, ds page no, eublock (block no), error). 

+ 

+END PROC read disk block;

+ 

+PROC read disk block (DATASPACE VAR ds,

+                      INT CONST ds page no, 

+                      INT CONST block no):

+  check rerun;

+  read block (ds, ds page no, eublock (block no), error); 

+  IF error <> 0 

+    THEN io error (error)

+  FI. 

+ 

+END PROC read disk block;

+ 

+PROC read disk block (DATASPACE VAR ds,

+                      INT CONST block no):

+  read disk block (ds, first non dummy ds page, block no)

+

+END PROC read disk block; 

+

+PROC read disk cluster (DATASPACE VAR ds, 

+                        INT CONST first ds page no,

+                        INT CONST cluster no): 

+  INT VAR i;

+  FOR i FROM 0 UPTO sectors per cluster - 1 REP

+    read disk block (ds, first ds page no + i, block no + i)

+  PER.

+ 

+block no:

+  first block no of cluster (cluster no).

+ 

+END PROC read disk cluster; 

+ 

+PROC write disk block (DATASPACE CONST ds,

+                       INT CONST ds page no, 

+                       INT CONST block no,

+                       INT VAR error):

+  check rerun;

+  write block (ds, ds page no, 0,eu block (block no), error). 

+ 

+END PROC write disk block; 

+ 

+PROC write disk block (DATASPACE CONST ds,

+                       INT CONST ds page no, 

+                       INT CONST block no):

+  check rerun;

+  write block (ds, ds page no, 0, eu block (block no), error); 

+  IF error <> 0 

+    THEN io error (error)

+  FI. 

+ 

+END PROC write disk block; 

+ 

+PROC write disk block (DATASPACE CONST ds,

+                       INT CONST block no): 

+  write disk block (ds, first non dummy ds page, block no)

+

+END PROC write disk block; 

+

+PROC write disk cluster (DATASPACE CONST ds, 

+                        INT CONST first ds page no,

+                        INT CONST cluster no): 

+  INT VAR i;

+  FOR i FROM 0 UPTO sectors per cluster - 1 REP

+    write disk block (ds, first ds page no + i, block no + i)

+  PER.

+ 

+block no:

+  first block no of cluster (cluster no).

+ 

+END PROC write disk cluster; 

+ 

+PROC io  error (INT CONST error code):

+  SELECT error code OF 

+    CASE 1: errorstop ("Laufwerk nicht betriebsbereit") 

+    CASE 2: errorstop ("Schreib-/Lesefehler") 

+    CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") 

+    CASE 4: errorstop ("Block nicht lesbar")

+    OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) 

+  END SELECT. 

+

+END PROC io error; 

+ 

+END PACKET disk block io;

diff --git a/system/dos/1986/src/cluster b/system/dos/1986/src/cluster
new file mode 100644
index 0000000..ef2720b
--- /dev/null
+++ b/system/dos/1986/src/cluster
@@ -0,0 +1,109 @@
+PACKET cluster DEFINES                       (* Copyright (C) 1986 *)

+                                             (* Frank Klapper      *)

+                                             (* 19.03.86           *)

+

+  CLUSTER, 

+  :=, 

+  text,

+  text 32,            (* typical dir entry *)

+  write text,

+  write text 32,

+  reduce cluster buffer:

+ 

+LET max cluster size = 8192;   (* 8192 * 8 = 64 KB *)

+

+TYPE CLUSTER = BOUND STRUCT (ALIGN dummy, 

+                             ROW max cluster size REAL cluster row); 

+ 

+TEXT VAR string;

+INT VAR string length;

+ 

+INT VAR sector no, eight byte pos, index;

+

+reduce cluster buffer;

+

+.reals per sector:        sector size DIV 8.

+.reals per std eu sector: 512 DIV 8.

+

+PROC reduce cluster buffer:

+  string := 32 * "*";

+  string length := 32.

+

+END PROC reduce cluster buffer;

+

+OP := (CLUSTER VAR cluster, DATASPACE VAR ds):

+  CONCR (cluster) := ds 

+ 

+END OP :=; 

+ 

+TEXT PROC text (CLUSTER CONST cluster, INT CONST from, to):

+  init string;

+  FOR sector no FROM 0 UPTO sectors per cluster - 1 REP

+    get text of sector

+  PER;

+  subtext (string, from, to).

+ 

+init string:

+  IF string length < cluster size

+    THEN string := cluster size * "*";

+         string length := cluster size

+  FI.

+

+get text of sector:

+  FOR eight byte pos FROM 1 UPTO reals per sector REP

+    replace (string, string index, cluster.cluster row [row index]) 

+  PER.

+

+string index:

+  reals per sector * sector no + eight byte pos.

+

+row index:

+  reals per std eu sector * sector no + eight byte pos.

+

+END PROC text;

+

+TEXT PROC text 32 (CLUSTER CONST cluster, INT CONST part):

+  FOR index FROM 1 UPTO 4 REP

+    replace (string, index, cluster.cluster row [index + 4 * part])

+  PER;

+  subtext (string, 1, 32).

+ 

+END PROC text 32;

+

+PROC write text (CLUSTER VAR cluster,

+                 TEXT CONST string):

+  IF LENGTH string < cluster size

+    THEN execute write text (cluster, text (string, cluster size))

+    ELSE execute write text (cluster, string)

+  FI.

+

+END PROC write text;

+

+PROC execute write text (CLUSTER VAR cluster,

+                         TEXT CONST string):

+  FOR sector no FROM 0 UPTO sectors per cluster - 1 REP

+    write text of sector

+  PER.

+

+write text of sector:

+  FOR eight byte pos FROM 1 UPTO reals per sector REP

+    cluster.cluster row [row index] := string RSUB (string index) 

+  PER.

+

+row index:

+  reals per std eu sector * sector no + eight byte pos.

+

+string index:

+  reals per sector * sector no + eight byte pos.

+

+

+END PROC execute write text;

+

+PROC write text 32 (CLUSTER VAR cluster, TEXT CONST string, INT CONST part):

+  FOR index FROM 1 UPTO 4 REP

+    cluster.cluster row [index + 4 * part] := string RSUB (index)

+  PER;

+

+END PROC write text 32;

+

+END PACKET cluster;

diff --git a/system/dos/1986/src/disk descriptor.dos.fd b/system/dos/1986/src/disk descriptor.dos.fd
new file mode 100644
index 0000000..9de8cf0
--- /dev/null
+++ b/system/dos/1986/src/disk descriptor.dos.fd
@@ -0,0 +1,290 @@
+PACKET dos disk DEFINES                       (* Copyright (C) 1985, 86 *)

+                                              (* Frank Klapper          *)

+  first fat byte,                             (* 30.05.86               *)

+  begin of fat,

+  number of fat sectors, 

+  number of fat entrys, 

+  number of fat copies,

+  begin of dir,

+  number of dir sectors,

+  begin of data area,

+  sectors per cluster,

+  cluster size,

+  sector size,

+

+  eublock,

+  first block no of cluster,

+

+  reset disk attributes,

+  set disk attributes:

+ 

+LET dir entrys per block    = 16,

+    first non dummy ds page = 2;

+

+LET DOSDISK = STRUCT (INT sectors per cluster,

+                          number of reserved sectors,

+                          number of fats,

+                          number of dir sectors,

+                          first fat byte,

+                          number of fat sectors,

+                          heads,

+                          sectors per track,

+                          tracks,

+                          number of fat entrys,

+                     REAL size);

+

+LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row);

+

+INT CONST sector size :: 512;

+

+TEXT VAR bpb := 32 * " ";

+

+INITFLAG VAR bpb ds used := FALSE;

+

+DATASPACE VAR bpb ds;

+

+BLOCK VAR bpb block;

+

+DOSDISK VAR disk format;

+BOUND DOSDISK VAR format table;

+

+INT VAR eu sectors,

+        xbegin of data area;

+

+INT PROC eublock (INT CONST nr):

+(*COND FLOPPY*)

+  IF page format

+    THEN head * eu sectors per head + trac * eu sectors + sector

+    ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector

+  FI.

+

+page format:

+  eu heads < 0.

+

+sector:

+  nr MOD disk format.sectors per track.

+

+trac: 

+  (nr DIV disk format.sectors per track) DIV disk format.heads.

+

+head:

+  (nr DIV disk format.sectors per track) MOD disk format.heads.

+

+eu sectors per head:

+  eu sectors * eu tracks.

+

+(*ENDCOND*)

+(*COND HDU

+  nr

+

+ENDCOND*)

+

+END PROC eublock;

+

+INT PROC first block no of cluster (INT CONST cluster no):

+  IF cluster no < 2

+    THEN error stop ("interner Fehler")

+  FI;

+  begin of data area + (cluster no - 2) * sectors per cluster.

+

+END PROC first block no of cluster;

+

+INT PROC first fat byte:

+  disk format.first fat byte

+

+END PROC first fat byte;

+ 

+INT PROC number of fat copies:

+  disk format.number of fats

+

+END PROC number of fat copies;

+

+INT PROC number of fat sectors:

+  disk format.number of fat sectors 

+

+END PROC number of fat sectors;

+

+INT PROC number of fat entrys:

+  disk format.number of fat entrys

+

+END PROC number of fat entrys;

+

+INT PROC number of dir sectors:

+  disk format.number of dir sectors 

+

+END PROC number of dir sectors;

+

+INT PROC begin of fat (INT CONST no):

+  disk format.number of reserved sectors + no * disk format.number of fat sectors

+

+END PROC begin of fat;

+

+INT PROC begin of dir:

+  disk format.number of reserved sectors + 

+  disk format.number of fats * disk format.number of fat sectors

+ 

+END PROC begin of dir;

+

+INT PROC begin of data area:

+  xbegin of data area

+

+END PROC begin of data area;

+

+INT PROC sectors per cluster:

+  disk format.sectors per cluster 

+

+END PROC sectors per cluster;

+

+INT PROC cluster size:

+  disk format.sectors per cluster * 512

+

+END PROC cluster size;

+

+PROC set disk attributes (INT CONST first fat byte):

+  enable stop;

+(*COND FLOPPY*)

+  get bios parameter block; 

+  IF is valid bpb

+    THEN load disk data from bpb

+    ELSE load disk disk data from ds

+  FI;

+  eu sectors := eu last sector - eu first sector +1;

+(*ENDCOND*)

+  xbegin of data area := disk format.number of reserved sectors +

+        disk format.number of fats * disk format.number of fat sectors +

+        disk format.number of dir sectors; 

+(*COND FLOPPY*)

+  test compatibility 

+ 

+.is valid bpb:

+  first fat byte < 252 OR code (bpb SUB 22) = first fat byte.

+

+load disk disk data from ds:

+  IF exists (text (first fat byte))

+    THEN format table := old (text (first fat byte));

+         copy values

+    ELSE error stop ("DOS-Diskettenformat nicht implementiert")

+  FI.

+

+copy values:

+  disk format.sectors per cluster        := format table.sectors per cluster; 

+  disk format.number of reserved sectors := format table.number of reserved sectors; 

+  disk format.number of fats             := format table.number of fats;

+  disk format.size                       := format table.size;

+  disk format.number of dir sectors      := format table.number of dir sectors;

+  disk format.first fat byte             := format table.first fat byte;

+  disk format.number of fat sectors      := format table.number of fat sectors;

+  disk format.heads                      := format table.heads;

+  disk format.sectors per track          := format table.sectors per track;

+  disk format.tracks                     := format table.tracks;

+  disk format.number of fat entrys       := format table.number of fat entrys.

+

+test compatibility:

+  IF disk format.sectors per track > eu sectors

+    OR eu tracks <> disk format.tracks

+    OR abs (eu heads) < disk format.heads

+    OR disk format.number of reserved sectors <> 1

+    THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar")

+  FI; 

+(*ENDCOND*)

+ 

+END PROC set disk attributes;

+

+PROC reset disk attributes:

+(*COND FLOPPY*)

+  disk format.sectors per cluster        := 1;

+  disk format.number of reserved sectors := 1;

+  disk format.number of fats             := 1;

+  disk format.size                       := real (eu size);

+  disk format.number of dir sectors      := 4;

+  disk format.first fat byte             := 255;

+  disk format.number of fat sectors      := 1;

+  disk format.heads                      := eu heads;

+  disk format.sectors per track          := eu tracks;

+  disk format.tracks                     := eu sectors;

+  disk format.number of fat entrys       := 100.

+

+(*ENDCOND*)

+(*COND HDU

+  get bios parameter block; 

+  load disk data from bpb (248).

+

+ENDCOND*)

+

+END PROC reset disk attributes;

+

+PROC get bios parameter block:

+  init bpb ds;

+  read bpb;

+  copy bpb block to bpb text.

+

+init bpb ds:

+  IF NOT initialized (bpb ds used)

+    THEN bpb ds := nilspace;

+         bpb block := bpb ds

+  FI.

+

+read bpb:

+  INT VAR error;

+  read block (bpb ds, first non dummy ds page, 0, error);

+  IF error <> 0

+    THEN SELECT error OF 

+           CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit") 

+           CASE 2: errorstop ("Schreib-/Lesefehler") 

+           CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") 

+           OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) 

+         END SELECT

+  FI.

+

+copy bpb block to bpb text:

+  replace (bpb, 1, bpb block. block row [1]);

+  replace (bpb, 2, bpb block. block row [2]);

+  replace (bpb, 3, bpb block. block row [3]); 

+  replace (bpb, 4, bpb block. block row [4]).

+

+END PROC get bios parameter block;

+

+PROC load disk data from bpb:

+  disable stop;

+  enable load disk data from bpb;

+  IF is error

+    THEN clear error;

+         enable stop;

+         error stop ("Bios-Parameterblock ungültig")

+  FI.

+

+END PROC load disk data from bpb;

+

+PROC enable load disk data from bpb:

+  disk format.sectors per cluster        := code (bpb SUB 14);

+  disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15);

+  disk format.number of fats             := code (bpb SUB 17);

+  disk format.number of dir sectors      := dir entrys DIV dir entrys per block; 

+  disk format.size                       := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20));

+  disk format.first fat byte             := code (bpb SUB 22);

+  disk format.number of fat sectors      := code (bpb SUB 24) * 256 + code (bpb SUB 23); 

+  disk format.heads                      := dos heads;

+  disk format.sectors per track          := code (bpb SUB 26) * 256 + code (bpb SUB 25);

+  disk format.tracks                     :=

+        int(disk format.size / real(disk format.sectors per track * disk format.heads));

+  disk format.number of fat entrys       := fat entrys.

+ 

+dir entrys:

+  code (bpb SUB 19) * 256 + code (bpb SUB 18).

+

+dos heads:

+  code (bpb SUB 28) * 256 + code (bpb SUB 27).

+

+fat entrys:

+  data clusters + 2.

+

+data clusters:

+  int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)).

+

+no of table sectors:

+  disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors +

+  disk format.number of dir sectors. 

+

+END PROC enable load disk data from bpb;

+

+END PACKET dos disk;

diff --git a/system/dos/1986/src/disk descriptor.dos.hd b/system/dos/1986/src/disk descriptor.dos.hd
new file mode 100644
index 0000000..0627b62
--- /dev/null
+++ b/system/dos/1986/src/disk descriptor.dos.hd
@@ -0,0 +1,290 @@
+PACKET dos disk DEFINES                       (* Copyright (C) 1985, 86 *)

+                                              (* Frank Klapper          *)

+  first fat byte,                             (* 30.05.86               *)

+  begin of fat,

+  number of fat sectors, 

+  number of fat entrys, 

+  number of fat copies,

+  begin of dir,

+  number of dir sectors,

+  begin of data area,

+  sectors per cluster,

+  cluster size,

+  sector size,

+

+  eublock,

+  first block no of cluster,

+

+  reset disk attributes,

+  set disk attributes:

+ 

+LET dir entrys per block    = 16,

+    first non dummy ds page = 2;

+

+LET DOSDISK = STRUCT (INT sectors per cluster,

+                          number of reserved sectors,

+                          number of fats,

+                          number of dir sectors,

+                          first fat byte,

+                          number of fat sectors,

+                          heads,

+                          sectors per track,

+                          tracks,

+                          number of fat entrys,

+                     REAL size);

+

+LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row);

+

+INT CONST sector size :: 512;

+

+TEXT VAR bpb := 32 * " ";

+

+INITFLAG VAR bpb ds used := FALSE;

+

+DATASPACE VAR bpb ds;

+

+BLOCK VAR bpb block;

+

+DOSDISK VAR disk format;

+BOUND DOSDISK VAR format table;

+

+INT VAR eu sectors,

+        xbegin of data area;

+

+INT PROC eublock (INT CONST nr):

+(*COND FLOPPY

+  IF page format

+    THEN head * eu sectors per head + trac * eu sectors + sector

+    ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector

+  FI.

+

+page format:

+  eu heads < 0.

+

+sector:

+  nr MOD disk format.sectors per track.

+

+trac: 

+  (nr DIV disk format.sectors per track) DIV disk format.heads.

+

+head:

+  (nr DIV disk format.sectors per track) MOD disk format.heads.

+

+eu sectors per head:

+  eu sectors * eu tracks.

+

+ENDCOND*)

+(*COND HDU*)

+  nr

+

+(*ENDCOND*)

+

+END PROC eublock;

+

+INT PROC first block no of cluster (INT CONST cluster no):

+  IF cluster no < 2

+    THEN error stop ("interner Fehler")

+  FI;

+  begin of data area + (cluster no - 2) * sectors per cluster.

+

+END PROC first block no of cluster;

+

+INT PROC first fat byte:

+  disk format.first fat byte

+

+END PROC first fat byte;

+ 

+INT PROC number of fat copies:

+  disk format.number of fats

+

+END PROC number of fat copies;

+

+INT PROC number of fat sectors:

+  disk format.number of fat sectors 

+

+END PROC number of fat sectors;

+

+INT PROC number of fat entrys:

+  disk format.number of fat entrys

+

+END PROC number of fat entrys;

+

+INT PROC number of dir sectors:

+  disk format.number of dir sectors 

+

+END PROC number of dir sectors;

+

+INT PROC begin of fat (INT CONST no):

+  disk format.number of reserved sectors + no * disk format.number of fat sectors

+

+END PROC begin of fat;

+

+INT PROC begin of dir:

+  disk format.number of reserved sectors + 

+  disk format.number of fats * disk format.number of fat sectors

+ 

+END PROC begin of dir;

+

+INT PROC begin of data area:

+  xbegin of data area

+

+END PROC begin of data area;

+

+INT PROC sectors per cluster:

+  disk format.sectors per cluster 

+

+END PROC sectors per cluster;

+

+INT PROC cluster size:

+  disk format.sectors per cluster * 512

+

+END PROC cluster size;

+

+PROC set disk attributes (INT CONST first fat byte):

+  enable stop;

+(*COND FLOPPY

+  get bios parameter block; 

+  IF is valid bpb

+    THEN load disk data from bpb

+    ELSE load disk disk data from ds

+  FI;

+  eu sectors := eu last sector - eu first sector +1;

+ENDCOND*)

+  xbegin of data area := disk format.number of reserved sectors +

+        disk format.number of fats * disk format.number of fat sectors +

+        disk format.number of dir sectors; 

+(*COND FLOPPY

+  test compatibility 

+ 

+.is valid bpb:

+  first fat byte < 252 OR code (bpb SUB 22) = first fat byte.

+

+load disk disk data from ds:

+  IF exists (text (first fat byte))

+    THEN format table := old (text (first fat byte));

+         copy values

+    ELSE error stop ("DOS-Diskettenformat nicht implementiert")

+  FI.

+

+copy values:

+  disk format.sectors per cluster        := format table.sectors per cluster; 

+  disk format.number of reserved sectors := format table.number of reserved sectors; 

+  disk format.number of fats             := format table.number of fats;

+  disk format.size                       := format table.size;

+  disk format.number of dir sectors      := format table.number of dir sectors;

+  disk format.first fat byte             := format table.first fat byte;

+  disk format.number of fat sectors      := format table.number of fat sectors;

+  disk format.heads                      := format table.heads;

+  disk format.sectors per track          := format table.sectors per track;

+  disk format.tracks                     := format table.tracks;

+  disk format.number of fat entrys       := format table.number of fat entrys.

+

+test compatibility:

+  IF disk format.sectors per track > eu sectors

+    OR eu tracks <> disk format.tracks

+    OR abs (eu heads) < disk format.heads

+    OR disk format.number of reserved sectors <> 1

+    THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar")

+  FI; 

+ENDCOND*)

+ 

+END PROC set disk attributes;

+

+PROC reset disk attributes:

+(*COND FLOPPY

+  disk format.sectors per cluster        := 1;

+  disk format.number of reserved sectors := 1;

+  disk format.number of fats             := 1;

+  disk format.size                       := real (eu size);

+  disk format.number of dir sectors      := 4;

+  disk format.first fat byte             := 255;

+  disk format.number of fat sectors      := 1;

+  disk format.heads                      := eu heads;

+  disk format.sectors per track          := eu tracks;

+  disk format.tracks                     := eu sectors;

+  disk format.number of fat entrys       := 100.

+

+ENDCOND*)

+(*COND HDU*)

+  get bios parameter block; 

+  load disk data from bpb.

+

+(*ENDCOND*)

+

+END PROC reset disk attributes;

+

+PROC get bios parameter block:

+  init bpb ds;

+  read bpb;

+  copy bpb block to bpb text.

+

+init bpb ds:

+  IF NOT initialized (bpb ds used)

+    THEN bpb ds := nilspace;

+         bpb block := bpb ds

+  FI.

+

+read bpb:

+  INT VAR error;

+  read block (bpb ds, first non dummy ds page, 0, error);

+  IF error <> 0

+    THEN SELECT error OF 

+           CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit") 

+           CASE 2: errorstop ("Schreib-/Lesefehler") 

+           CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") 

+           OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) 

+         END SELECT

+  FI.

+

+copy bpb block to bpb text:

+  replace (bpb, 1, bpb block. block row [1]);

+  replace (bpb, 2, bpb block. block row [2]);

+  replace (bpb, 3, bpb block. block row [3]); 

+  replace (bpb, 4, bpb block. block row [4]).

+

+END PROC get bios parameter block;

+

+PROC load disk data from bpb:

+  disable stop;

+  enable load disk data from bpb;

+  IF is error

+    THEN clear error;

+         enable stop;

+         error stop ("Bios-Parameterblock ungültig")

+  FI.

+

+END PROC load disk data from bpb;

+

+PROC enable load disk data from bpb:

+  disk format.sectors per cluster        := code (bpb SUB 14);

+  disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15);

+  disk format.number of fats             := code (bpb SUB 17);

+  disk format.number of dir sectors      := dir entrys DIV dir entrys per block; 

+  disk format.size                       := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20));

+  disk format.first fat byte             := code (bpb SUB 22);

+  disk format.number of fat sectors      := code (bpb SUB 24) * 256 + code (bpb SUB 23); 

+  disk format.heads                      := dos heads;

+  disk format.sectors per track          := code (bpb SUB 26) * 256 + code (bpb SUB 25);

+  disk format.tracks                     :=

+        int(disk format.size / real(disk format.sectors per track * disk format.heads));

+  disk format.number of fat entrys       := fat entrys.

+ 

+dir entrys:

+  code (bpb SUB 19) * 256 + code (bpb SUB 18).

+

+dos heads:

+  code (bpb SUB 28) * 256 + code (bpb SUB 27).

+

+fat entrys:

+  data clusters + 2.

+

+data clusters:

+  int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)).

+

+no of table sectors:

+  disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors +

+  disk format.number of dir sectors. 

+

+END PROC enable load disk data from bpb;

+

+END PACKET dos disk;

diff --git a/system/dos/1986/src/disk manager b/system/dos/1986/src/disk manager
new file mode 100644
index 0000000..5711ee7
--- /dev/null
+++ b/system/dos/1986/src/disk manager
@@ -0,0 +1,245 @@
+PACKET disk manager DEFINES                 (* Copyright (C) 1986 *)

+                                            (* Frank Klapper      *)

+  disk fetch,                               (* 07.05.86           *)

+  disk check,

+  disk save first phase,

+  disk save second phase,

+  disk clear,

+  disk format,

+  disk erase,

+  disk exists,

+  disk list,

+  disk all,

+  disk reserve,

+  disk free:

+

+LET ascii        = 1,

+    ascii german = 2,

+    transparent  = 3,

+    ebcdic       = 4,

+    row text     = 5,

+    ds           = 6,

+    atari st     = 10;

+

+TEXT VAR file name;

+

+INT VAR mode := 0;

+TEXT VAR mode extension;

+

+REAL VAR last access time := 0.0;

+

+PROC disk fetch (TEXT CONST name, DATASPACE VAR file ds):

+  enable stop;

+  access disk;

+  file name  := adapted name (name, TRUE);

+  IF dir contains (file name)

+    THEN do fetch

+    ELSE errorstop ("die Datei """ + file name + """ gibt es nicht")

+  FI;

+  last access time := clock (1).

+

+do fetch:

+  SELECT mode OF 

+    CASE ascii, ascii german, atari st, ebcdic, transparent: fetch filemode (file ds, filename, mode)

+    CASE row text   : fetch row textmode (file ds, filename)

+    CASE ds         : fetch dsmode       (file ds, filename)

+    OTHERWISE error stop ("Unzul�ssige Betriebsart")

+  END SELECT.

+

+END PROC disk fetch;

+

+PROC disk check (TEXT CONST name):

+  enable stop;

+  access disk;

+  file name := adapted name (name, TRUE);

+  IF dir contains (file name)

+    THEN disable stop;

+         check file (file name);

+         IF is error

+           THEN clear error;

+                error stop ("Fehler beim Pr�flesen der Datei """ + file name + """")

+         FI;

+    ELSE error stop ("""" + file name + """ gibt es nicht")

+  FI;

+  last access time := clock (1).

+

+END PROC disk check;

+

+PROC disk save first phase (TEXT CONST name, BOOL VAR overwrite question):

+  enable stop;

+  overwrite question := FALSE;

+  access disk;

+  file name := adapted name (name, FALSE); 

+  IF dir contains (file name)

+     THEN overwrite question := TRUE

+  FI;

+  last access time := clock (1).

+

+END PROC disk save first phase;

+

+PROC disk save second phase (DATASPACE CONST file ds): 

+  enable stop;

+  access disk;

+  erase file if necessary;

+  do save;

+  last access time := clock (1).

+

+erase file if necessary:

+  IF dir contains (file name)

+    THEN erase table entrys (file name)

+  FI.

+

+do save:

+  SELECT mode OF 

+    CASE ascii, ascii german,atari st, ebcdic, transparent: save filemode (file ds, filename, mode)

+    CASE row text   : save row textmode (file ds, filename)

+    CASE ds         : save dsmode       (file ds, filename)

+    OTHERWISE error stop ("Unzul�ssige Betriebsart")

+  END SELECT.

+

+END PROC disk save second phase;

+

+(* DOS bekommt die Tabellenparameter von der Diskette

+   CPM bekommt die Tabellenparameter �ber 'reserve'   *)

+

+PROC disk clear:

+  enable stop;

+(*COND DOS*)

+  access disk;

+(*ENDCOND*)

+(*COND CPM

+  open eu disk;

+  open action;

+ENDCOND*)

+  format disk;

+  last access time := clock (1).

+

+END PROC disk clear;

+

+PROC disk erase (TEXT CONST name):

+  enable stop;

+  access disk;

+  file name := adapted name (name, TRUE); 

+  IF NOT dir contains (file name)

+    THEN errorstop ("die Datei """ + file name + """ gibt es nicht")

+    ELSE erase table entrys (file name);

+  FI;

+  last access time := clock (1).

+

+END PROC disk erase;

+ 

+BOOL PROC disk exists (TEXT CONST name):

+  enable stop;

+  access disk;

+  last access time := clock (1);

+  dir contains (adapted name (name, TRUE)).

+

+END PROC disk exists;

+

+PROC disk list (DATASPACE VAR list ds):

+  enable stop;

+  access disk;

+  dir list (list ds);

+  last access time := clock (1).

+

+END PROC disk list;

+

+THESAURUS PROC disk all:

+  enable stop;

+  access disk;

+  last access time := clock (1);

+  dir all.

+

+END PROC disk all;

+

+PROC disk format:

+

+(*COND DOS*)

+  error stop ("nicht implementiert")

+(*ENDCOND*)

+

+(*COND CPM

+  enable stop;

+  open eu disk;

+  open action;

+  format archive (eu disk format no);

+  format disk;

+  last access time := clock (1).

+ENDCOND*)

+

+END PROC disk format;

+

+PROC disk reserve (TEXT CONST reserve string):

+  enable stop;

+  close action;

+  last access time := clock (1);

+  get mode.

+ 

+get mode:

+  TEXT VAR mode text;

+  IF pos (reserve string, ":") = 0

+    THEN mode text := reserve string;

+         mode extension := ""

+    ELSE mode text := subtext (reserve string, 1, pos (reserve string, ":") - 1);

+         mode extension := subtext (reserve string, pos (reserve string, ":") + 1)

+  FI;

+  prepare modetext;

+  IF mode text = "FILEASCII"

+    THEN mode := ascii

+  ELIF mode text = "FILEASCIIGERMAN"

+    THEN mode := asciigerman

+  ELIF mode text = "FILEATARIST"

+    THEN mode := atari st

+  ELIF modetext = "FILEEBCDIC"

+    THEN mode := ebcdic

+  ELIF modetext = "FILETRANSPARENT"

+    THEN mode := transparent

+  ELIF mode text = "ROWTEXT"

+    THEN mode := row text

+  ELIF mode text = "DS"

+    THEN mode := ds

+   ELSE error stop ("Unzul�ssige Betriebsart")

+  FI.

+

+prepare modetext:

+  change all (mode text, " ", "");

+  INT VAR i;

+  FOR i FROM 1 UPTO LENGTH mode text REP

+    IF is lower case

+      THEN replace (mode text, i, upper case char)

+    FI

+  PER.

+

+is lower case:

+  code (mode text SUB i) > 96 AND code (mode text SUB i) < 123.

+

+upper case char:

+  code (code (mode text SUB i) - 32).

+

+END PROC disk reserve;

+

+PROC disk free:

+  disable stop;

+  close action;

+  close disk;

+  reduce cluster buffer.

+

+END PROC disk free;

+

+PROC access disk:

+  IF action closed COR (last access more than two seconds ago CAND disk changed)

+    THEN open disk archive

+  FI.

+

+open disk archive:

+  close action;

+  open eu disk;

+  open disk (mode extension);

+  open action.

+

+last access more than two seconds ago:

+  abs (clock (1) - last access time) > 2.0.

+

+END PROC access disk;

+

+END PACKET disk manager;

diff --git a/system/dos/1986/src/eu disk descriptor.fd b/system/dos/1986/src/eu disk descriptor.fd
new file mode 100644
index 0000000..cd00175
--- /dev/null
+++ b/system/dos/1986/src/eu disk descriptor.fd
@@ -0,0 +1,102 @@
+PACKET eu disk DEFINES                          (* Copyright (C) 1985 *)

+                                                (* Frank Klapper      *)

+                                                (* 25.03.86           *)

+  load shard interface table,

+  open eu disk,

+  eu size,

+  eu heads,

+  eu tracks,

+  eu first sector,

+  eu last sector:

+

+LET table length = 15,

+ 

+    size field         = 1,

+    head field         = 2,

+    track field        = 3,

+    first sector field = 4,

+    last  sector field = 5;

+

+ROW table length ROW 5 INT VAR format table;

+

+INT VAR table top,

+        table pointer;

+

+PROC open eu disk:

+  enable stop;

+  init check rerun;

+(*COND FLOPPY*)

+  INT VAR blocks := archive blocks;

+  search format table entry;

+(*ENDCOND*)

+.

+

+(*COND FLOPPY*)

+search format table entry:

+  table pointer := 1;

+  WHILE format table [table pointer][size field] <> blocks REP

+    table pointer INCR 1;

+    IF table pointer > table top

+      THEN error stop ("Diskettenformat nicht implementiert")

+    FI

+  PER.

+(*ENDCOND*)

+

+END PROC open eu disk;

+

+PROC load shard interface table:

+  FILE VAR f := sequential file (input, "shard interface");

+  TEXT VAR line;

+  table top := 0;

+  WHILE NOT eof (f) REP

+    get line (f, line);

+    IF (line SUB 1) <> ";"

+      THEN load line

+    FI

+  PER.

+

+load line:

+  table top INCR 1;

+  IF table top > table length

+    THEN error stop ("Shard Interface Tabelle zu groß")

+  FI;

+  INT VAR blank pos := 1;

+  format table [table top][size field]         := next int;

+  format table [table top][head field]         := next int;

+  format table [table top][track field]        := next int; 

+  format table [table top][first sector field] := next int;

+  format table [table top][last  sector field] := next int.

+

+next int:

+  line := compress (subtext (line, blank pos)) + " ";

+  blank pos := pos (line, " ");

+  int (subtext (line, 1, blank pos - 1)).

+

+END PROC load shard interface table;

+ 

+INT PROC eu size:

+  format table [table pointer][size field]

+

+END PROC eu size;

+

+INT PROC eu heads:

+  format table [table pointer][head field]

+

+END PROC eu heads;

+

+INT PROC eu tracks:

+  format table [table pointer][track field]

+

+END PROC eu tracks;

+

+INT PROC eu first sector:

+  format table [table pointer][first sector field]

+

+END PROC eu first sector;

+

+INT PROC eu last sector:

+  format table [table pointer][last sector field]

+

+END PROC eu last sector;

+

+END PACKET eu disk;

diff --git a/system/dos/1986/src/eu disk descriptor.hd b/system/dos/1986/src/eu disk descriptor.hd
new file mode 100644
index 0000000..caeef66
--- /dev/null
+++ b/system/dos/1986/src/eu disk descriptor.hd
@@ -0,0 +1,102 @@
+PACKET eu disk DEFINES                          (* Copyright (C) 1985 *)

+                                                (* Frank Klapper      *)

+                                                (* 25.03.86           *)

+  load shard interface table,

+  open eu disk,

+  eu size,

+  eu heads,

+  eu tracks,

+  eu first sector,

+  eu last sector:

+

+LET table length = 15,

+ 

+    size field         = 1,

+    head field         = 2,

+    track field        = 3,

+    first sector field = 4,

+    last  sector field = 5;

+

+ROW table length ROW 5 INT VAR format table;

+

+INT VAR table top,

+        table pointer;

+

+PROC open eu disk:

+  enable stop;

+  init check rerun;

+(*COND FLOPPY

+  INT VAR blocks := archive blocks;

+  search format table entry;

+ENDCOND*)

+.

+

+(*COND FLOPPY

+search format table entry:

+  table pointer := 1;

+  WHILE format table [table pointer][size field] <> blocks REP

+    table pointer INCR 1;

+    IF table pointer > table top

+      THEN error stop ("Diskettenformat nicht implementiert")

+    FI

+  PER.

+ENDCOND*)

+

+END PROC open eu disk;

+

+PROC load shard interface table:

+  FILE VAR f := sequential file (input, "shard interface");

+  TEXT VAR line;

+  table top := 0;

+  WHILE NOT eof (f) REP

+    get line (f, line);

+    IF (line SUB 1) <> ";"

+      THEN load line

+    FI

+  PER.

+

+load line:

+  table top INCR 1;

+  IF table top > table length

+    THEN error stop ("Shard Interface Tabelle zu groß")

+  FI;

+  INT VAR blank pos := 1;

+  format table [table top][size field]         := next int;

+  format table [table top][head field]         := next int;

+  format table [table top][track field]        := next int; 

+  format table [table top][first sector field] := next int;

+  format table [table top][last  sector field] := next int.

+

+next int:

+  line := compress (subtext (line, blank pos)) + " ";

+  blank pos := pos (line, " ");

+  int (subtext (line, 1, blank pos - 1)).

+

+END PROC load shard interface table;

+ 

+INT PROC eu size:

+  format table [table pointer][size field]

+

+END PROC eu size;

+

+INT PROC eu heads:

+  format table [table pointer][head field]

+

+END PROC eu heads;

+

+INT PROC eu tracks:

+  format table [table pointer][track field]

+

+END PROC eu tracks;

+

+INT PROC eu first sector:

+  format table [table pointer][first sector field]

+

+END PROC eu first sector;

+

+INT PROC eu last sector:

+  format table [table pointer][last sector field]

+

+END PROC eu last sector;

+

+END PACKET eu disk;

diff --git a/system/dos/1986/src/eumel-ebcdic + sub b/system/dos/1986/src/eumel-ebcdic + sub
new file mode 100644
index 0000000..5a571cb
--- /dev/null
+++ b/system/dos/1986/src/eumel-ebcdic + sub
@@ -0,0 +1,550 @@
+PACKET eumel ebcdic DEFINES                    (* Copyright (c) 1986 *)

+                                               (* Frank Klapper      *)

+                                               (* 19.02.86           *)

+  ebcdic to eumel with substitution,

+  eumel to ebcdic with substitution:

+

+TEXT VAR bild;

+

+PROC eumel to ebcdic with substitution (TEXT VAR string):

+  bild := "";

+  INT VAR pos;

+  FOR pos FROM 1 UPTO LENGTH string REP

+    bild CAT conversion

+  PER;

+  string := bild.

+

+conversion:

+  SELECT code (string SUB pos) OF

+    CASE   0: "{"240""240""240"{"

+    CASE   1: "{"240""240""241"{"

+    CASE   2: "{"240""240""242"{"

+    CASE   3: "{"240""240""243"{"

+    CASE   4: "{"240""240""244"{"

+    CASE   5: "{"240""240""245"{"

+    CASE   6: "{"240""240""246"{"

+    CASE   7: "{"240""240""247"{"

+    CASE   8: "{"240""240""248"{"

+    CASE   9: "{"240""240""249"{"

+    CASE  10: "%"

+    CASE  11: "{"240""241""241"{"

+    CASE  12: ""12""

+    CASE  13: ""13""

+    CASE  14: "{"240""241""244"{"

+    CASE  15: "{"240""241""245"{"

+    CASE  16: "{"240""241""246"{"

+    CASE  17: "{"240""241""247"{"

+    CASE  18: "{"240""241""248"{"

+    CASE  19: "{"240""241""249"{"

+    CASE  20: "{"240""242""240"{"

+    CASE  21: "{"240""242""241"{"

+    CASE  22: "{"240""242""242"{"

+    CASE  23: "{"240""242""243"{"

+    CASE  24: "{"240""242""244"{"

+    CASE  25: "{"240""242""245"{"

+    CASE  26: "{"240""242""246"{"

+    CASE  27: "{"240""242""247"{"

+    CASE  28: "{"240""242""248"{"

+    CASE  29: "{"240""242""249"{"

+    CASE  30: "{"240""243""240"{"

+    CASE  31: "{"240""243""241"{"

+    CASE  32: "@"

+    CASE  33: "O" 

+    CASE  34: ""

+    CASE  35: "{"

+    CASE  36: "{"240""243""246"{"

+    CASE  37: "l"

+    CASE  38: "P" 

+    CASE  39: "}"

+    CASE  40: "M" 

+    CASE  41: "]" 

+    CASE  42: "\" 

+    CASE  43: "N" 

+    CASE  44: "k"

+    CASE  45: "`" 

+    CASE  46: "K" 

+    CASE  47: "a" 

+    CASE  48: ""240""

+    CASE  49: ""241""

+    CASE  50: ""242""

+    CASE  51: ""243""

+    CASE  52: ""244""

+    CASE  53: ""245""

+    CASE  54: ""246""

+    CASE  55: ""247""

+    CASE  56: ""248""

+    CASE  57: ""249""

+    CASE  58: "z"

+    CASE  59: "^" 

+    CASE  60: "L" 

+    CASE  61: "~"

+    CASE  62: "n"

+    CASE  63: "o"

+    CASE  64: "|"

+    CASE  65: "�"

+    CASE  66: "�"

+    CASE  67: "�"

+    CASE  68: "�"

+    CASE  69: "�"

+    CASE  70: "�"

+    CASE  71: "�"

+    CASE  72: "�"

+    CASE  73: "�"

+    CASE  74: "�"

+    CASE  75: "�"

+    CASE  76: "�"

+    CASE  77: "�"

+    CASE  78: "�"

+    CASE  79: "�"

+    CASE  80: "�"

+    CASE  81: "�"

+    CASE  82: "�"

+    CASE  83: ""226""

+    CASE  84: ""227""

+    CASE  85: ""228""

+    CASE  86: ""229""

+    CASE  87: ""230""

+    CASE  88: ""231""

+    CASE  89: ""232""

+    CASE  90: ""233""

+    CASE  91: "J"

+    CASE  92: ""224""

+    CASE  93: "Z"

+    CASE  94: "{"240""249""244"{"

+    CASE  95: "m"

+    CASE  96: "y"

+    CASE  97: "�"

+    CASE  98: "�"

+    CASE  99: "�"

+    CASE 100: "�"

+    CASE 101: "�"

+    CASE 102: "�"

+    CASE 103: "�"

+    CASE 104: "�"

+    CASE 105: "�"

+    CASE 106: "�"

+    CASE 107: "�"

+    CASE 108: "�"

+    CASE 109: "�"

+    CASE 110: "�"

+    CASE 111: "�"

+    CASE 112: "�"

+    CASE 113: "�"

+    CASE 114: "�"

+    CASE 115: "�"

+    CASE 116: "�"

+    CASE 117: "�"

+    CASE 118: "�"

+    CASE 119: "�"

+    CASE 120: "�"

+    CASE 121: "�"

+    CASE 122: "�"

+    CASE 123: "�"

+    CASE 124: "{"241""242""244"{"

+    CASE 125: "�"

+    CASE 126: "�"

+    CASE 127: "{"241""242""247"{"

+    CASE 128: "{"241""242""248"{"

+    CASE 129: "{"241""242""249"{"

+    CASE 130: "{"241""243""240"{"

+    CASE 131: "{"241""243""241"{"

+    CASE 132: "{"241""243""242"{"

+    CASE 133: "{"241""243""243"{"

+    CASE 134: "{"241""243""244"{"

+    CASE 135: "{"241""243""245"{"

+    CASE 136: "{"241""243""246"{"

+    CASE 137: "{"241""243""247"{"

+    CASE 138: "{"241""243""248"{"

+    CASE 139: "{"241""243""249"{"

+    CASE 140: "{"241""244""240"{"

+    CASE 141: "{"241""244""241"{"

+    CASE 142: "{"241""244""242"{"

+    CASE 143: "{"241""244""243"{"

+    CASE 144: "{"241""244""244"{"

+    CASE 145: "{"241""244""245"{"

+    CASE 146: "{"241""244""246"{"

+    CASE 147: "{"241""244""247"{"

+    CASE 148: "{"241""244""248"{"

+    CASE 149: "{"241""244""249"{"

+    CASE 150: "{"241""245""240"{"

+    CASE 151: "{"241""245""241"{"

+    CASE 152: "{"241""245""242"{"

+    CASE 153: "{"241""245""243"{"

+    CASE 154: "{"241""245""244"{"

+    CASE 155: "{"241""245""245"{"

+    CASE 156: "{"241""245""246"{"

+    CASE 157: "{"241""245""247"{"

+    CASE 158: "{"241""245""248"{"

+    CASE 159: "{"241""245""249"{"

+    CASE 160: "{"241""246""240"{"

+    CASE 161: "{"241""246""241"{"

+    CASE 162: "{"241""246""242"{"

+    CASE 163: "{"241""246""243"{"

+    CASE 164: "{"241""246""244"{"

+    CASE 165: "{"241""246""245"{"

+    CASE 166: "{"241""246""246"{"

+    CASE 167: "{"241""246""247"{"

+    CASE 168: "{"241""246""248"{"

+    CASE 169: "{"241""246""249"{"

+    CASE 170: "{"241""247""240"{"

+    CASE 171: "{"241""247""241"{"

+    CASE 172: "{"241""247""242"{"

+    CASE 173: "{"241""247""243"{"

+    CASE 174: "{"241""247""244"{"

+    CASE 175: "{"241""247""245"{"

+    CASE 176: "{"241""247""246"{"

+    CASE 177: "{"241""247""247"{"

+    CASE 178: "{"241""247""248"{"

+    CASE 179: "{"241""247""249"{"

+    CASE 180: "{"241""248""240"{"

+    CASE 181: "{"241""248""241"{"

+    CASE 182: "{"241""248""242"{"

+    CASE 183: "{"241""248""243"{"

+    CASE 184: "{"241""248""244"{"

+    CASE 185: "{"241""248""245"{"

+    CASE 186: "{"241""248""246"{"

+    CASE 187: "{"241""248""247"{"

+    CASE 188: "{"241""248""248"{"

+    CASE 189: "{"241""248""249"{"

+    CASE 190: "{"241""249""240"{"

+    CASE 191: "{"241""249""241"{"

+    CASE 192: "{"241""249""242"{"

+    CASE 193: "{"241""249""243"{"

+    CASE 194: "{"241""249""244"{"

+    CASE 195: "{"241""249""245"{"

+    CASE 196: "{"241""249""246"{"

+    CASE 197: "{"241""249""247"{"

+    CASE 198: "{"241""249""248"{"

+    CASE 199: "{"241""249""249"{"

+    CASE 200: "{"242""240""240"{"

+    CASE 201: "{"242""240""241"{"

+    CASE 202: "{"242""240""242"{"

+    CASE 203: "{"242""240""243"{"

+    CASE 204: "{"242""240""244"{"

+    CASE 205: "{"242""240""245"{"

+    CASE 206: "{"242""240""246"{"

+    CASE 207: "{"242""240""247"{"

+    CASE 208: "{"242""240""248"{"

+    CASE 209: "{"242""240""249"{"

+    CASE 210: "{"242""241""240"{"

+    CASE 211: "{"242""241""241"{"

+    CASE 212: "{"242""241""242"{"

+    CASE 213: "{"242""241""243"{"

+    CASE 214: "{"242""241""244"{"

+    CASE 215: "{"242""241""245"{"

+    CASE 216: "{"242""241""246"{"

+    CASE 217: "{"242""241""247"{"

+    CASE 218: "{"242""241""248"{"

+    CASE 219: "{"242""241""249"{"

+    CASE 220: "�"

+    CASE 221: "`" 

+    CASE 222: "{"

+    CASE 223: "@"

+    CASE 224: "{"242""242""244"{"

+    CASE 225: "{"242""242""245"{"

+    CASE 226: "{"242""242""246"{"

+    CASE 227: "{"242""242""247"{"

+    CASE 228: "{"242""242""248"{"

+    CASE 229: "{"242""242""249"{"

+    CASE 230: "{"242""243""240"{"

+    CASE 231: "{"242""243""241"{"

+    CASE 232: "{"242""243""242"{"

+    CASE 233: "{"242""243""243"{"

+    CASE 234: "{"242""243""244"{"

+    CASE 235: "{"242""243""245"{"

+    CASE 236: "{"242""243""246"{"

+    CASE 237: "{"242""243""247"{"

+    CASE 238: "{"242""243""248"{"

+    CASE 239: "{"242""243""249"{"

+    CASE 240: "{"242""244""240"{"

+    CASE 241: "{"242""244""241"{"

+    CASE 242: "{"242""244""242"{"

+    CASE 243: "{"242""244""243"{"

+    CASE 244: "{"242""244""244"{"

+    CASE 245: "{"242""244""245"{"

+    CASE 246: "{"242""244""246"{"

+    CASE 247: "{"242""244""247"{"

+    CASE 248: "{"242""244""248"{"

+    CASE 249: "{"242""244""249"{"

+    CASE 250: "{"242""245""240"{"

+    CASE 251: "{"242""245""241"{"

+    CASE 252: "{"242""245""242"{"

+    CASE 253: "{"242""245""243"{"

+    CASE 254: "{"242""245""244"{"

+    CASE 255: "{"242""245""245"{"

+    OTHERWISE ""

+  END SELECT.

+

+END PROC eumel to ebcdic with substitution;

+

+PROC ebcdic to eumel with substitution (TEXT VAR string):

+  bild := "";

+  INT VAR pos;

+  FOR pos FROM 1 UPTO LENGTH string REP

+    bild CAT conversion

+  PER;

+  string := bild.

+

+conversion:

+  SELECT code (string SUB pos) OF

+    CASE   0: "#000#"

+    CASE   1: "#001#"

+    CASE   2: "#002#"

+    CASE   3: "#003#"

+    CASE   4: "#004#"

+    CASE   5: "#005#"

+    CASE   6: "#006#"

+    CASE   7: "#007#"

+    CASE   8: "#008#"

+    CASE   9: "#009#"

+    CASE  10: "#010#"

+    CASE  11: "#011#"

+    CASE  12: "#012#"

+    CASE  13: "#013#"

+    CASE  14: "#014#"

+    CASE  15: "#015#"

+    CASE  16: "#016#"

+    CASE  17: "#017#"

+    CASE  18: "#018#"

+    CASE  19: "#019#"

+    CASE  20: "#020#"

+    CASE  21: "#021#"

+    CASE  22: "#022#"

+    CASE  23: "#023#"

+    CASE  24: "#024#"

+    CASE  25: "#025#"

+    CASE  26: "#026#"

+    CASE  27: "#027#"

+    CASE  28: "#028#"

+    CASE  29: "#029#"

+    CASE  30: "#030#"

+    CASE  31: "#031#"

+    CASE  32: "#032#"

+    CASE  33: "#033#"

+    CASE  34: "#034#"

+    CASE  35: "#035#"

+    CASE  36: "#036#"

+    CASE  37: "#037#"

+    CASE  38: "#038#"

+    CASE  39: "#039#"

+    CASE  40: "#040#"

+    CASE  41: "#041#"

+    CASE  42: "#042#"

+    CASE  43: "#043#"

+    CASE  44: "#044#"

+    CASE  45: "#045#"

+    CASE  46: "#046#"

+    CASE  47: "#047#"

+    CASE  48: "#048#"

+    CASE  49: "#049#"

+    CASE  50: "#050#"

+    CASE  51: "#051#"

+    CASE  52: "#052#"

+    CASE  53: "#053#"

+    CASE  54: "#054#"

+    CASE  55: "#055#"

+    CASE  56: "#056#"

+    CASE  57: "#057#"

+    CASE  58: "#058#"

+    CASE  59: "#059#"

+    CASE  60: "#060#"

+    CASE  61: "#061#"

+    CASE  62: "#062#"

+    CASE  63: "#063#"

+    CASE  64: "#064#"

+    CASE  65: "#065#"

+    CASE  66: "#066#"

+    CASE  67: "#067#"

+    CASE  68: "#068#"

+    CASE  69: "#069#"

+    CASE  70: "#070#"

+    CASE  71: "#071#"

+    CASE  72: "#072#"

+    CASE  73: "#073#"

+    CASE  74: "["

+    CASE  75: "."

+    CASE  76: "<"

+    CASE  77: "("

+    CASE  78: "+"

+    CASE  79: "!"

+    CASE  80: "&"

+    CASE  81: "#081#"

+    CASE  82: "#082#"

+    CASE  83: "#083#"

+    CASE  84: "#084#"

+    CASE  85: "#085#"

+    CASE  86: "#086#"

+    CASE  87: "#087#"

+    CASE  88: "#088#"

+    CASE  89: "#089#"

+    CASE  90: "]"

+    CASE  91: "$"

+    CASE  92: "*"

+    CASE  93: ")"

+    CASE  94: ";"

+    CASE  95: "^"

+    CASE  96: "-"

+    CASE  97: "/"

+    CASE  98: "#098#"

+    CASE  99: "#099#"

+    CASE 100: "#100#"

+    CASE 101: "#101#"

+    CASE 102: "#102#"

+    CASE 103: "#103#"

+    CASE 104: "#104#"

+    CASE 105: "#105#"

+    CASE 106: "|"

+    CASE 107: ","

+    CASE 108: "%"

+    CASE 109: "_"

+    CASE 110: ">"

+    CASE 111: "?"

+    CASE 112: "#112#"

+    CASE 113: "#113#"

+    CASE 114: "#114#"

+    CASE 115: "#115#"

+    CASE 116: "#116#"

+    CASE 117: "#117#"

+    CASE 118: "#118#"

+    CASE 119: "#119#"

+    CASE 120: "#120#"

+    CASE 121: "`"

+    CASE 122: ":"

+    CASE 123: "#"

+    CASE 124: "@"

+    CASE 125: "'"

+    CASE 126: "="

+    CASE 127: """"

+    CASE 128: "#128#"

+    CASE 129: "a"

+    CASE 130: "b"

+    CASE 131: "c"

+    CASE 132: "d"

+    CASE 133: "e"

+    CASE 134: "f"

+    CASE 135: "g"

+    CASE 136: "h"

+    CASE 137: "i"

+    CASE 138: "#138#"

+    CASE 139: "#139#"

+    CASE 140: "#140#"

+    CASE 141: "#141#"

+    CASE 142: "#142#"

+    CASE 143: "#143#"

+    CASE 144: "#144#"

+    CASE 145: "j"

+    CASE 146: "k"

+    CASE 147: "l"

+    CASE 148: "m"

+    CASE 149: "n"

+    CASE 150: "o"

+    CASE 151: "p"

+    CASE 152: "q"

+    CASE 153: "r"

+    CASE 154: "#154#"

+    CASE 155: "#155#"

+    CASE 156: "#156#"

+    CASE 157: "#157#"

+    CASE 158: "#158#"

+    CASE 159: "#159#"

+    CASE 160: "#160#"

+    CASE 161: "~"

+    CASE 162: "s"

+    CASE 163: "t"

+    CASE 164: "u"

+    CASE 165: "v"

+    CASE 166: "w"

+    CASE 167: "x"

+    CASE 168: "y"

+    CASE 169: "z"

+    CASE 170: "#170#"

+    CASE 171: "#171#"

+    CASE 172: "#172#"

+    CASE 173: "#173#"

+    CASE 174: "#174#"

+    CASE 175: "#175#"

+    CASE 176: "#176#"

+    CASE 177: "#177#"

+    CASE 178: "#178#"

+    CASE 179: "#179#"

+    CASE 180: "#180#"

+    CASE 181: "#181#"

+    CASE 182: "#182#"

+    CASE 183: "#183#"

+    CASE 184: "#184#"

+    CASE 185: "#185#"

+    CASE 186: "#186#"

+    CASE 187: "#187#"

+    CASE 188: "#188#"

+    CASE 189: "#189#"

+    CASE 190: "#190#"

+    CASE 191: "#191#"

+    CASE 192: "{"

+    CASE 193: "A"

+    CASE 194: "B"

+    CASE 195: "C"

+    CASE 196: "D"

+    CASE 197: "E"

+    CASE 198: "F"

+    CASE 199: "G"

+    CASE 200: "H"

+    CASE 201: "I"

+    CASE 202: "#202#"

+    CASE 203: "#203#"

+    CASE 204: "#204#"

+    CASE 205: "#205#"

+    CASE 206: "#206#"

+    CASE 207: "#207#"

+    CASE 208: "}"

+    CASE 209: "J"

+    CASE 210: "K"

+    CASE 211: "L"

+    CASE 212: "M"

+    CASE 213: "N"

+    CASE 214: "O"

+    CASE 215: "P"

+    CASE 216: "Q"

+    CASE 217: "R"

+    CASE 218: "#218#"

+    CASE 219: "#219#"

+    CASE 220: "#220#"

+    CASE 221: "#221#"

+    CASE 222: "#222#"

+    CASE 223: "#223#"

+    CASE 224: "\"

+    CASE 225: "#225#"

+    CASE 226: "S"

+    CASE 227: "T"

+    CASE 228: "U"

+    CASE 229: "V"

+    CASE 230: "W"

+    CASE 231: "X"

+    CASE 232: "Y"

+    CASE 233: "Z"

+    CASE 234: "#234#"

+    CASE 235: "#235#"

+    CASE 236: "#236#"

+    CASE 237: "#237#"

+    CASE 238: "#238#"

+    CASE 239: "#239#"

+    CASE 240: "0"

+    CASE 241: "1"

+    CASE 242: "2"

+    CASE 243: "3"

+    CASE 244: "4"

+    CASE 245: "5"

+    CASE 246: "6"

+    CASE 247: "7"

+    CASE 248: "8"

+    CASE 249: "9"

+    CASE 250: "#250#"

+    CASE 251: "#251#"

+    CASE 252: "#252#"

+    CASE 253: "#253#"

+    CASE 254: "#254#"

+    CASE 255: "#255#"

+    OTHERWISE ""

+  END SELECT.

+END PROC ebcdic to eumel with substitution;

+

+END PACKET eumel ebcdic;

diff --git a/system/dos/1986/src/fat and dir.dos.fd b/system/dos/1986/src/fat and dir.dos.fd
new file mode 100644
index 0000000..35cf118
--- /dev/null
+++ b/system/dos/1986/src/fat and dir.dos.fd
@@ -0,0 +1,1190 @@
+PACKET dos fat and dir DEFINES               (* Copyright (C) 1985, 86 *)

+                                             (* Frank Klapper          *)

+  open disk,                                 (* 30.05.86               *)

+  close disk,

+  format disk,

+  disk changed,

+  open fetch,

+  next fetch cluster no,

+  open save,

+  next save cluster no,

+  close save,

+  erase table entrys,

+(*COND TEST

+  dump fat,

+ENDCOND*)

+  dir all,

+  dir list,

+  dir contains:

+

+LET fat row size            = 16384,     (* 32 KB *)

+    max fat blocks          = 25,

+    first fat entry no      = 2,

+    last entry of fat chain = 4088,

+    dir entrys per block    = 16, 

+    max dir entrys          = 1600,      (* 100 KB *)

+    archive byte            = " ";

+ 

+LET FAT   = BOUND STRUCT (ALIGN dummy,

+                          ROW 256 INT block row,

+                          ROW fat row size INT fat row); 

+

+LET LOCATION = STRUCT (INT msdos block no,

+                           block entry no),

+

+    FILEENTRY = STRUCT (TEXT date and time,

+                        REAL size,

+                        INT first cluster, 

+                        LOCATION location),

+

+    DIRENTRY = INT,

+

+    FILELIST = STRUCT (THESAURUS thes,

+                       ROW max dir entrys FILEENTRY entry,

+                       INT no of entrys),

+

+    DIRLIST = STRUCT (THESAURUS thes,

+                      ROW max dir entrys DIRENTRY entry,

+                      INT no of entrys),

+

+    FREELIST = STRUCT (ROW max dir entrys LOCATION stack,

+                       INT stacktop,

+                       LOCATION begin of free area,

+                                end of dir,

+                       INT dir chain root),

+ 

+    DIR = BOUND STRUCT (FILELIST filelist,

+                        DIRLIST dirlist, 

+                        FREELIST freelist,

+                        TEXT disklabel,

+                             path);

+ 

+INITFLAG VAR this packet := FALSE;

+

+DATASPACE VAR fat space,

+              dir ds, 

+              block ds; 

+ 

+BOOL VAR dataspaces open;

+ 

+FAT VAR fat struct;

+ROW max fat blocks BOOL VAR write access;

+INT VAR first possible available fat entry;

+

+DIR VAR dir;

+ 

+CLUSTER VAR block;

+

+INT VAR akt file cluster no,

+        first file cluster no;

+BOOL VAR no cluster saved;

+TEXT VAR save name;

+

+INT VAR count;

+

+TEXT VAR convert buffer := "  ",

+         name,

+         dir entry;

+

+.fat:

+  fat struct.fat row.

+

+PROC open disk (TEXT CONST subdir path):

+  disable stop;

+  enable open disk (subdir path);

+  IF is error

+    THEN close action

+  FI

+

+END PROC open disk;

+

+PROC enable open disk (TEXT CONST subdir path):

+  enable stop;

+  init dataspaces;

+  open fat;

+  open dir.

+ 

+open fat:

+  reset disk attributes;

+  read first fat block;

+  set disk attributes (fat byte (0));

+  read other fat blocks;

+  define write access table (FALSE);

+  first possible available fat entry := first fat entry no.

+

+read first fat block:

+  read fat block (0, FALSE).

+

+read other fat blocks:

+  INT VAR block no;

+  FOR block no FROM 1 UPTO number of fat sectors - 1 REP

+     read fat block (block no, FALSE)

+  PER.

+

+open dir:

+  init dir struct (subdir path, -1);

+  load main dir blocks;

+  load subdirs if necessary.

+

+load main dir blocks:

+  BOOL VAR last block;

+  store end of dir (loc (end of main dir, dir entrys per block - 1));

+  FOR block no FROM begin of dir UPTO end of main dir REP

+    load dir block (block no, last block);

+    UNTIL last block

+  PER. 

+

+end of main dir:

+  begin of dir + number of dir sectors - 1.

+

+load subdirs if necessary: 

+  TEXT VAR path := subdir path;

+  WHILE path <> "" REP

+    load next subdir if possible

+  PER.

+

+load next subdir if possible:

+  INT VAR cluster no;

+  get next subdir name;

+  get first cluster no of subdir table;

+  clear dir entrys (cluster no);

+  WHILE cluster no >= 0 REP

+    load subdir entrys of cluster;

+    cluster no := next fetch cluster no

+    UNTIL last block 

+  PER.

+

+get next subdir name:

+  TEXT VAR subdir name;

+  IF (path SUB 1) <> "\"

+    THEN error stop ("ungültige Pfadbezeichnung")

+  FI;

+  INT VAR backslash pos := pos (path, "\", "\", 2);

+  IF backslash pos = 0

+    THEN subdir name := subtext (path, 2);

+         path := ""

+    ELSE subdir name := subtext (path, 2, backslash pos - 1);

+         path := subtext (path, backslash pos)

+  FI;

+  subdir name := adapted name (subdir name, TRUE).

+

+get first cluster no of subdir table:

+  IF dir thes CONTAINS subdir name

+    THEN open fetch subdir (subdir name, cluster no);

+    ELSE error stop ("Subdirectory existiert nicht")

+  FI.

+

+load subdir entrys of cluster:

+  store end of dir (loc (last block no of cluster, dir entrys per block - 1));

+  FOR block no FROM 0 UPTO (sectors per cluster - 1) REP

+    load dir block (first block no of cluster (cluster no) + block no, last block)

+    UNTIL last block

+  PER.

+

+last block no of cluster:

+  first block no of cluster (cluster no) + sectors per cluster - 1.

+

+END PROC enable open disk;

+

+PROC init dataspaces:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF NOT dataspaces open

+   THEN disable stop;

+         dataspaces open := TRUE;

+         fat space  := nilspace;

+         dir   ds   := nilspace;

+         block ds   := nilspace;

+         fat struct := fat space;

+         dir        := dir ds; 

+         block      := block ds 

+  FI.

+

+END PROC init dataspaces;

+

+PROC init dir struct (TEXT CONST path string, INT CONST root):

+  clear dir entrys (root);

+  dir.path := path string;

+  dir.disk label := "". 

+

+END PROC init dir struct;

+

+PROC clear dir entrys (INT CONST root):

+  init file list;

+  init dir list;

+  init free list (root).

+

+init file list:

+  dir.file list.thes := empty thesaurus;

+  dir.file list.no of entrys := 0.

+

+init dir list:

+  dir.dir list.thes := empty thesaurus;

+  dir.dir list.no of entrys := 0. 

+

+END PROC clear dir entrys;

+

+PROC close disk:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF dataspaces open 

+    THEN forget (dir ds);

+         forget (block ds);

+         forget (fat space);

+         dataspaces open := FALSE

+  FI.

+

+END PROC close disk;

+

+(*COND FLOPPY*)

+PROC format disk:

+  enable stop;

+  init dataspaces;

+  format fat;

+  format dir.

+

+format fat:

+  write first four fat bytes;

+  write other fat bytes;

+  define write access table (TRUE);

+  copy fat to disk.

+

+write first four fat bytes:

+  fat [1] := word (first fat byte, 255);

+  fat [2] := word (255, 0).

+

+write other fat bytes:

+  FOR count FROM 3 UPTO fat length REP

+    fat [count] := 0

+  PER.

+

+fat length:

+  INT VAR len := number of fat entrys + number of fat entrys DIV 2

+                       + number of fat entrys MOD 2;

+  len DIV 2 + len MOD 2.

+ 

+format dir:

+  init dir struct ("", -1);

+  store begin of free area (loc (begin of dir, 0));

+  store end of dir (loc (end of dir, dir entrys per block - 1));

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM begin of dir UPTO end of dir REP

+    write disk block (block ds, count);

+  PER.

+

+end of dir:

+  begin of dir + number of dir sectors - 1. 

+

+END PROC format disk;

+(*ENDCOND*)

+

+(*COND HDU

+PROC disk clear:

+  error stop ("nicht implementiert")

+

+END PROC disk clear;

+

+PROC format disk:

+  error stop ("nicht implementiert")

+

+END PROC format disk;

+ENDCOND*)

+

+INT PROC word (INT CONST low byte, high byte):

+  convert buffer := code (low byte) + code (high byte);

+  convert buffer ISUB 1.

+

+END PROC word;

+ 

+BOOL PROC disk changed:

+(*COND FLOPPY*)

+  disable stop;

+  NOT first fat block ok COR is error     (* must be COR *)

+(*ENDCOND*)

+(*COND HDU

+  FALSE

+ENDCOND*)

+

+END PROC disk changed;

+

+BOOL PROC first fat block ok:

+  enable stop;

+  read fat block (0, TRUE);

+  FOR count FROM 1 UPTO 256 REP

+    compare word

+  PER; 

+  TRUE.

+

+compare word:

+  IF fat struct.fat row [count] <> fat struct.block row [count] 

+    THEN LEAVE first fat block ok WITH FALSE

+  FI. 

+

+END PROC first fat block ok;

+

+PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no):

+  enable stop;

+  first cluster no := dir.file list.entry [link index].first cluster;

+  size             := dir.file list.entry [link index].size;

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (file thes, name).

+

+END PROC open fetch;

+ 

+PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no):

+  first cluster no := dir.dir list.entry [link index];

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (dir thes, subdir name).

+

+END PROC open fetch subdir;

+

+INT PROC next fetch cluster no:

+  enable stop;

+  akt file cluster no := fat entry (akt file cluster no);

+  IF akt file cluster no < 4088  (*ff8h *)

+    THEN akt file cluster no

+    ELSE -1

+  FI.

+

+END PROC next fetch cluster no; 

+

+PROC open save (TEXT CONST file name):

+  enable stop;

+  save name := file name;

+  IF dir full

+    THEN error stop ("Directory voll")

+  FI;

+  IF dir thes CONTAINS file name

+    THEN error stop ("Subdirectory mit gleichem Namen existiert bereits")

+  FI;

+  IF file thes CONTAINS file name

+    THEN error stop ("Datei mit gleichem Namen existiert bereits")

+  FI;

+  no cluster saved := TRUE.

+

+END PROC open save;

+

+INT PROC next save cluster no:

+  enable stop;

+  IF no cluster saved

+    THEN akt file cluster no   := available fat entry;

+         first file cluster no := akt file cluster no;

+         no cluster saved := FALSE

+    ELSE INT VAR old cluster no := akt file cluster no;

+         akt file cluster no := available fat entry;

+         write fat entry (old cluster no, akt file cluster no)

+  FI;

+  write fat entry (akt file cluster no, last entry of fat chain);

+  akt file cluster no.

+

+END PROC next save cluster no;

+

+PROC close save (REAL CONST size):

+  enable stop;

+  IF no cluster saved

+    THEN insert dir entry (save name, 4088, 0.0)

+    ELSE copy fat to disk;

+         insert dir entry (save name, first file cluster no, size)

+  FI.

+

+END PROC close save;

+

+PROC erase table entrys (TEXT CONST name):

+  enable stop;

+  INT VAR first file cluster := first cluster;

+  delete dir entry (name);

+  erase fat chain (first file cluster);

+  copy fat to disk.

+

+first cluster:

+  dir.file list.entry [link index].first cluster.

+ 

+link index:

+  link (file thes, name).

+

+END PROC erase table entrys;

+

+INT PROC fat entry (INT CONST entry no):

+  fix bytes;

+  construct value.

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+construct value:

+  IF entry no MOD 2 = 0

+    THEN (right byte MOD 16) * 256 + left byte 

+    ELSE right byte * 16 + left byte DIV 16

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+

+END PROC fat entry;

+

+INT PROC available fat entry:

+  FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP

+    IF is available entry (count)

+      THEN first possible available fat entry := count;

+           LEAVE available fat entry WITH count

+    FI;

+  PER;

+  close action; error stop ("MS-DOS Datentraeger voll"); maxint.

+

+END PROC available fat entry;

+

+BOOL PROC is available entry (INT CONST entry no):

+  is zero entry.

+

+is zero entry:

+  IF entry no MOD 2 = 0

+    THEN (left byte = 0) CAND ((right byte MOD 16) = 0)

+    ELSE (right byte = 0) CAND ((left byte DIV 16) = 0)

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+ 

+first byte no:

+  entry no + entry no DIV 2.

+ 

+END PROC is available entry;

+

+PROC erase fat chain (INT CONST first entry):

+  INT VAR akt  entry no := first entry,

+          entry         := fat entry (akt entry no);

+  WHILE akt entry no not last chain entry no  REP

+    erase akt entry;

+    akt entry no := entry;

+    entry := fat entry (akt entry no)

+  PER;

+  erase akt entry.

+

+akt entry no not last chain entry no:

+  (entry < last entry of fat chain) AND (entry > 1).

+

+erase akt entry:

+  write fat entry (akt entry no, 0).

+

+END PROC erase fat chain; 

+

+PROC write fat entry (INT CONST entry no, value):

+  fix bytes;

+  remark write access (fat block of first  byte);

+  remark write access (fat block of second byte);

+  write value;

+  update first possible available entry. 

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+fat block of first byte:

+  first byte no DIV 512.

+

+fat block of second byte:

+  second byte no DIV 512.

+

+write value:

+  IF even entry no

+    THEN write fat byte (first  byte no, value MOD 256);

+         write fat byte (second byte no,

+                        (right byte DIV 16) * 16 + value DIV 256)

+    ELSE write fat byte (first byte no,

+                         (left byte MOD 16) + 16 * (value MOD 16));

+         write fat byte (second byte no, value DIV 16)

+  FI.

+

+even entry no:

+  entry no MOD 2 = 0.

+

+second byte no:

+  first byte no + 1.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (second byte no).

+

+update first possible available entry:

+  IF value = 0

+    THEN first possible available fat entry := 

+         min (first possible available fat entry, entry no)

+  FI.

+

+END PROC write fat entry; 

+

+INT PROC fat byte (INT CONST no): 

+  replace (convert buffer, 1, word); 

+  IF even byte no

+    THEN code (convert buffer SUB 1)

+    ELSE code (convert buffer SUB 2)

+  FI. 

+ 

+even byte no:

+  no MOD 2 = 0.

+

+word: 

+  fat [no DIV 2 + 1]. 

+

+END PROC fat byte; 

+ 

+PROC write fat byte (INT CONST byte no, new value):

+  read old word;

+  change byte;

+  write new word.

+

+read old word: 

+  replace (convert buffer, 1, word).

+

+write new word:

+  word := convert buffer ISUB 1.

+

+word:

+  fat [byte no DIV 2 + 1].

+

+change byte:

+  replace (convert buffer, byte pos, code (new value)).

+

+byte pos:

+  byte no MOD 2 + 1.

+

+END PROC write fat byte;

+

+PROC copy fat to disk:

+  INT VAR block no;

+  FOR block no FROM 0 UPTO number of fat sectors - 1 REP

+    IF was write access (block no)

+      THEN write fat block (block no)

+    FI

+  PER.

+

+END PROC copy fat to disk;

+

+PROC write fat block (INT CONST fat block no):

+  INT VAR fat copy no;

+  INT VAR return code;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies -1 REP

+    write disk block (fat space, ds page no, block no, return code);

+    IF return code > 0

+      THEN close action

+    FI

+  PER;

+  remark no write access (block no);

+  enable stop.

+

+ds page no:

+  first non dummy ds page + fat block no + 1.

+

+block no:

+  begin of fat (fat copy no) + fat block no.

+

+END PROC write fat block;

+

+PROC read fat block (INT CONST fat block, BOOL CONST test block):

+  INT VAR fat copy no;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP

+    clear error;

+    read disk block (fat space, ds page no, fat block no)

+    UNTIL NOT is error

+  PER;

+  IF is error

+    THEN close action

+  FI;

+  enable stop.

+

+ds page no:

+  IF test block

+    THEN first non dummy ds page

+    ELSE fat block + first non dummy ds page + 1

+  FI.

+

+fat block no:

+  begin of fat (fat copy no) + fat block.

+

+END PROC read fat block;

+

+PROC define write access table (BOOL CONST status):

+  FOR count FROM 1 UPTO number of fat sectors REP

+    write access [count] := status

+  PER.

+

+END PROC define write access table;

+

+PROC remark write access (INT CONST fat block no):

+  write access [fat block no + 1] := TRUE

+

+END PROC remark write access;

+

+PROC remark no write access (INT CONST fat block no):

+  write access [fat block no + 1] := FALSE

+

+END PROC remark no write access;

+

+BOOL PROC was write access (INT CONST fat block no):

+  write access [fat block no + 1]

+

+END PROC was write access;

+

+(*COND TEST

+PROC dump fat:                                                     

+  IF NOT exists ("fat dump")                                       

+    THEN open file                                                 

+  FI;                                                              

+  DATASPACE VAR ds := nilspace;                                    

+  FILE VAR in := sequential file (input, "fat dump"),              

+           out := sequential file (output, ds);                    

+  INT VAR i;                                                       

+  TEXT VAR line;                                                   

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    dump fat entry                                                 

+  PER;                                                             

+  forget ("fat dump", quiet);                                      

+  copy (ds, "fat dump");                                           

+  forget (ds).                                                     

+                                                                   

+open file:                                                         

+  in := sequential file (output, "fat dump");                      

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    putline (in, text (i, 4) + ": ")                               

+  PER.                                                             

+                                                                   

+dump fat entry:                                                    

+  cout (i);                                                        

+  getline (in, line);                                              

+  putline (out, line + "  " + text (fat entry (i), 4)).            

+                                                                   

+END PROC dump fat;                                                 

+ENDCOND*)

+

+PROC load dir block (INT CONST block no, BOOL VAR last block): 

+  last block := FALSE;

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  INT VAR entry no,

+          thes index;

+  FOR entry no FROM 0 UPTO dir entrys per block - 1 REP 

+    dir entry := text 32 (block, entry no);

+    process entry

+  PER.

+

+process entry:

+  SELECT pos (""0"."229"", dir entry SUB 1) OF

+    CASE 1: end of dir search

+    CASE 2: main dir entry

+    CASE 3: free entry

+    OTHERWISE file entry

+  END SELECT.

+

+end of dir search:

+  last block := TRUE;

+  store begin of free area (loc (block no, entry no));

+  LEAVE load dir block.

+

+main dir entry:

+  (* no operation *).

+

+free entry:

+  store in free list (loc (block no, entry no)).

+

+file entry:

+  SELECT code (dir entry SUB 12) OF

+    CASE  8: volume label

+    CASE 16: sub dir entry

+    OTHERWISE dos file entry

+  END SELECT.

+

+volume label:

+  dir.disk label := text (dir entry, 1, 11).

+

+sub dir entry:

+  dir.dir list.no of entrys INCR 1;

+  insert (dir thes, name, thes index);

+  dir list entry := first cluster no.

+

+dos file entry:

+  IF dir.file list.no of entrys >= max dir entrys

+    THEN error stop ("Directorytabelle voll")

+  FI;

+  dir.file list.no of entrys INCR 1;

+  insert (file thes, name, thes index);

+  file list entry.first cluster           := first cluster no;

+  file list entry.date and time           := dos date + "  " + dos time;

+  file list entry.size                    := dos storage;

+  file list entry.location.msdos block no := block no;

+  file list entry.location.block entry no := entry no.

+ 

+name:

+  IF name post <> ""

+    THEN name pre + "." + name post

+    ELSE name pre

+  FI.

+

+name pre:

+  compress (subtext (dir entry, 1, 8)).

+

+name post:

+  compress (subtext (dir entry, 9, 11)).

+

+file list entry:

+  dir.file list.entry [thes index].

+

+dir list entry:

+  dir.dir list.entry [thes index].

+

+first cluster no:

+  code (dir entry SUB 27) + 256 * code (dir entry SUB 28).

+

+dos storage:

+  real (code (dir entry SUB 29)) +

+  real (code (dir entry SUB 30)) * 256.0 +

+  real (code (dir entry SUB 31)) * 65536.0 +

+  real (code (dir entry SUB 32)) * 16777216.0.

+

+dos date:

+  day + "." + month + "." + year. 

+ 

+day: 

+  IF code (dir entry SUB 25) MOD 32 < 10 

+    THEN "0" + text (code (dir entry SUB 25) MOD 32) 

+    ELSE text (code (dir entry SUB 25) MOD 32)

+  FI. 

+ 

+month:

+  INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2);

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+year:

+  text (80 + code (dir entry SUB 26) DIV 2, 2).

+

+dos time:

+  hour + ":" + minute. 

+ 

+hour: 

+  dummy := code (dir entry SUB 24) DIV 8; 

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+minute: 

+  dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8); 

+  IF dummy < 10 

+    THEN "0" + text (dummy)

+    ELSE text (dummy) 

+  FI. 

+ 

+END PROC load dir block; 

+ 

+PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage):

+  (* name must be a dos name *)

+  LOCATION VAR ins pos := free location;

+  TEXT VAR akt date := date (clock (1)),

+           akt time := time of day (clock (1));

+  write disk entry;

+  write dir struct entry.

+

+write disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  prepare name;

+  dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time +

+               dos date + starting cluster + storage;

+  write text 32 (block, dir entry, ins pos.block entry no);

+  write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+prepare name:

+  TEXT VAR name pre, name post;

+  IF point pos > 0

+    THEN name pre  := subtext (name, 1, point pos - 1);

+         name post := subtext (name, point pos + 1);

+         name pre  CAT (8 - LENGTH name pre)  * " ";

+         name post CAT (3 - LENGTH name post) * " "

+    ELSE name pre  := name + (8 - LENGTH name) * " ";

+         name post := "   "

+  FI.

+ 

+point pos:

+  pos (name, "."). 

+ 

+dos time:

+  code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8).

+

+hour:

+  int (subtext (akt time, 1, 2)).

+

+minute:

+  int (subtext (akt time, 4, 5)).

+

+dos date:

+   code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8).

+

+day: 

+  int (subtext (akt date, 1, 2)).

+

+month:

+  int (subtext (akt date, 4, 5)).

+

+year:

+  int (subtext (akt date, 7, 8)).

+

+starting cluster:

+  code (start cluster MOD 256) + code (start cluster DIV 256).

+

+storage:

+  code (int (round (256.0 * frac (used storage / 256.0), 0))) +

+  code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) +

+  code (int (floor (used storage / 65536.0))) +

+  code (0).          (* maximal 16384 K *********************************)

+

+write dir struct entry:

+  INT VAR thes link;

+  insert (file thes, name, thes link);

+  file list entry.location      := ins pos; 

+  file list entry.first cluster := start cluster;

+  file list entry.date and time := akt date + "  " + akt time;

+  file list entry.size          := used storage.

+

+file list entry:

+  dir.filelist.entry [thes link].

+

+END PROC insert dir entry;

+

+PROC delete dir entry (TEXT CONST name):

+  LOCATION VAR del pos;

+  get del pos;

+  erase dir struct entry;

+  erase disk entry;

+  store in free list (del pos).

+

+get del pos:

+  del pos := dir.filelist.entry [link index].location.

+

+link index:

+  link (file thes, name).

+

+erase dir struct entry:

+  INT VAR i;

+  delete (file thes, name, i).

+

+erase disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  dir entry := text 32 (block, del pos.block entry no);

+  replace (dir entry, 1, ""229"");

+  write text 32 (block, dir entry, del pos.block entry no);

+  write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+END PROC delete dir entry;

+ 

+.

+file thes:

+  dir.filelist.thes.

+

+dir thes:

+  dir.dir list.thes.

+

+(*********************** dir information ******************************)

+

+THESAURUS PROC dir all: 

+  file thes.

+ 

+END PROC dir all; 

+ 

+BOOL PROC dir contains (TEXT CONST name): 

+  file thes CONTAINS name

+

+END PROC dir contains;

+ 

+PROC dir list (DATASPACE VAR ds):

+  enable stop;

+  open list file;

+  list files;

+  list dirs;

+  write list head.

+

+open list file:

+  forget (ds);

+  ds := nilspace;

+  FILE VAR list file := sequential file (output, ds);

+  putline (list file, "").

+ 

+list files: 

+  INT VAR number := 0;

+  get (file thes, name, number);

+  WHILE number > 0 REP

+    generate file list line;

+    get (file thes, name, number)

+  PER.

+

+generate file list line:

+  write (list file, centered name);

+  write (list file, "  ");

+  write (list file, text (act file entry.size, 11, 0));

+  write (list file, " Bytes belegt      ");

+  write (list file, act file entry.date and time); 

+(*COND TEST

+  write (list file, "  +++  "); 

+  write (list file, text (act file entry.first cluster)); 

+ENDCOND*)

+  line (list file).

+

+list dirs:

+  number := 0;

+  get (dir thes, name, number);

+  WHILE number > 0 REP

+    generate dir list line;

+    get (dir thes, name, number)

+  PER.

+

+generate dir list line:

+  write (list file, centered name);

+  write (list file, "   <DIR>");

+(*COND TEST

+  write (list file, "  +++  ");                                 

+  write (list file, text (dir.dir list.entry [number]));  

+ENDCOND*)

+  line (list file).

+

+centered name:

+  INT VAR point pos := pos (name, ".");

+  IF point pos > 0

+    THEN name pre + "." + name post

+    ELSE text (name, 12)

+  FI.

+

+name pre:

+  text (subtext (name, 1, point pos - 1), 8).

+

+name post:

+  text (subtext (name, point pos + 1, point pos + 4), 3).

+ 

+act file entry:

+  dir.file list.entry [number].

+

+write list head:

+  head line (list file, head).

+

+head:

+  "DOS" + disk label string + path string.

+

+disk label string:

+  IF dir.disk label <> ""

+    THEN ": " + dir.disk label

+    ELSE ""

+  FI.

+

+path string:

+  IF dir.path <> ""

+    THEN "     PATH: " + dir.path

+    ELSE ""

+  FI.

+

+END PROC dir list;

+ 

+(************ free list handling ******************************************)

+LOCATION PROC loc (INT CONST block, entry):

+  LOCATION : (block, entry) 

+

+END PROC loc;

+

+BOOL OP > (LOCATION CONST l, r):

+  l.msdos block no > r.msdos block no

+  OR ((l.msdos block no = r.msdos block no) AND 

+      (l.block entry no > r.block entry no)     )

+

+END OP >;

+

+OP INCR (LOCATION VAR l):

+  IF l.block entry no = dir entrys per block -1

+    THEN l.block entry no := 0;

+         l.msdos block no INCR 1

+    ELSE l.block entry no INCR 1

+  FI.

+

+END OP INCR;

+

+PROC init free list (INT CONST dir root):

+  dir.freelist.stacktop := 0;

+  dir.freelist.begin of free area.msdos block no := maxint;

+  dir.freelist.end of dir.msdos block no := -1;

+  dir.freelist.dir chain root := dir root.

+

+END PROC init free list;

+ 

+BOOL PROC dir full:

+  stack empty AND free area empty AND NOT expansion alloweded.

+

+stack empty:

+  dir.freelist.stacktop < 1.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC dir full;

+

+PROC store in free list (LOCATION CONST free):

+  dir.freelist.stacktop INCR 1;

+  dir.freelist.stack [top] := free.

+

+top:

+  dir.freelist.stacktop.

+

+END PROC store in free list;

+

+PROC store begin of free area (LOCATION CONST begin):

+  dir.freelist.begin of free area := begin

+

+END PROC store begin of free area;

+

+PROC store end of dir (LOCATION CONST end):

+  dir.freelist.end of dir := end

+

+END PROC store end of dir;

+

+LOCATION PROC free location:

+  LOCATION VAR result;

+  IF dir.freelist.stacktop > 0

+    THEN pop

+    ELIF NOT free area empty

+    THEN first of free area

+    ELIF expansion alloweded

+    THEN allocate new dir space;

+         result := free location

+    ELSE error stop ("Directorytabelle voll")

+  FI;

+  result.

+

+pop:

+  result := dir.freelist.stack [top];

+  top DECR 1.

+

+top:

+  dir.freelist.stack top.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+first of free area:

+  result := dir.freelist.begin of free area;

+  INCR dir.freelist.begin of free area.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC free location; 

+

+PROC allocate new dir space:

+  enable stop;

+  INT VAR new cluster no := available fat entry;

+  IF new cluster no < 0

+    THEN error stop ("MS-DOS Datentraeger voll")

+  FI;

+  INT VAR last entry no;

+  search last entry of fat chain;

+  write fat entry (new cluster no, 4095);

+  write fat entry (last entry no, new cluster no);

+  copy fat to disk;

+  store begin of free area (loc (first new block, 0));

+  store end of dir (loc (last new block, dir entrys per block - 1));

+  init new dir cluster.

+

+search last entry of fat chain:

+  last entry no := dir.freelist.dir chain root;

+  WHILE fat entry (last entry no) < last entry of fat chain REP

+    last entry no := fat entry (last entry no)

+  PER.

+

+init new dir cluster:

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM first new block UPTO last new block REP

+    write disk block (block ds, count);

+  PER.

+

+first new block:

+  firstblock no of cluster (new cluster no).

+

+last new block:

+  first block no of cluster (new cluster no) + sectors per cluster - 1.

+

+END PROC allocate new dir space; 

+

+(*COND TEST

+PROC dump freelist:

+  command dialogue (FALSE);

+  FILE VAR f := sequential file (output, "freelistdump");

+  INT VAR i;

+  putline (f, "STACKTOP: " + text (fl.stacktop));

+  putline (f, "STACK:");

+  FOR i FROM 1 UPTO 16 * number of dir sectors REP

+    putline (f, "   " + text (i, 4) + ":  " +

+                text (fl.stack [i].msdos block no) + ", " +

+                text (fl.stack [i].block entry no))

+  PER; 

+  line (f);

+  putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) + 

+            ", "  + text (fl.begin of free area.block entry no));

+  putline (f, "END   OF DIR:  " + text (fl.end of dir.msdos block no) + 

+            ", "  + text (fl.end of dir.block entry no)).

+

+fl:

+  dir.freelist.

+

+END PROC dump free list;

+ENDCOND*)

+

+END PACKET dos fat and dir;

diff --git a/system/dos/1986/src/fat and dir.dos.hd b/system/dos/1986/src/fat and dir.dos.hd
new file mode 100644
index 0000000..2612b25
--- /dev/null
+++ b/system/dos/1986/src/fat and dir.dos.hd
@@ -0,0 +1,1190 @@
+PACKET dos fat and dir DEFINES               (* Copyright (C) 1985, 86 *)

+                                             (* Frank Klapper          *)

+  open disk,                                 (* 30.05.86               *)

+  close disk,

+  format disk,

+  disk changed,

+  open fetch,

+  next fetch cluster no,

+  open save,

+  next save cluster no,

+  close save,

+  erase table entrys,

+(*COND TEST

+  dump fat,

+ENDCOND*)

+  dir all,

+  dir list,

+  dir contains:

+

+LET fat row size            = 16384,     (* 32 KB *)

+    max fat blocks          = 25,

+    first fat entry no      = 2,

+    last entry of fat chain = 4088,

+    dir entrys per block    = 16, 

+    max dir entrys          = 1600,      (* 100 KB *)

+    archive byte            = " ";

+ 

+LET FAT   = BOUND STRUCT (ALIGN dummy,

+                          ROW 256 INT block row,

+                          ROW fat row size INT fat row); 

+

+LET LOCATION = STRUCT (INT msdos block no,

+                           block entry no),

+

+    FILEENTRY = STRUCT (TEXT date and time,

+                        REAL size,

+                        INT first cluster, 

+                        LOCATION location),

+

+    DIRENTRY = INT,

+

+    FILELIST = STRUCT (THESAURUS thes,

+                       ROW max dir entrys FILEENTRY entry,

+                       INT no of entrys),

+

+    DIRLIST = STRUCT (THESAURUS thes,

+                      ROW max dir entrys DIRENTRY entry,

+                      INT no of entrys),

+

+    FREELIST = STRUCT (ROW max dir entrys LOCATION stack,

+                       INT stacktop,

+                       LOCATION begin of free area,

+                                end of dir,

+                       INT dir chain root),

+ 

+    DIR = BOUND STRUCT (FILELIST filelist,

+                        DIRLIST dirlist, 

+                        FREELIST freelist,

+                        TEXT disklabel,

+                             path);

+ 

+INITFLAG VAR this packet := FALSE;

+

+DATASPACE VAR fat space,

+              dir ds, 

+              block ds; 

+ 

+BOOL VAR dataspaces open;

+ 

+FAT VAR fat struct;

+ROW max fat blocks BOOL VAR write access;

+INT VAR first possible available fat entry;

+

+DIR VAR dir;

+ 

+CLUSTER VAR block;

+

+INT VAR akt file cluster no,

+        first file cluster no;

+BOOL VAR no cluster saved;

+TEXT VAR save name;

+

+INT VAR count;

+

+TEXT VAR convert buffer := "  ",

+         name,

+         dir entry;

+

+.fat:

+  fat struct.fat row.

+

+PROC open disk (TEXT CONST subdir path):

+  disable stop;

+  enable open disk (subdir path);

+  IF is error

+    THEN close action

+  FI

+

+END PROC open disk;

+

+PROC enable open disk (TEXT CONST subdir path):

+  enable stop;

+  init dataspaces;

+  open fat;

+  open dir.

+ 

+open fat:

+  reset disk attributes;

+  read first fat block;

+  set disk attributes (fat byte (0));

+  read other fat blocks;

+  define write access table (FALSE);

+  first possible available fat entry := first fat entry no.

+

+ read first fat block:

+  read fat block (0, FALSE).

+

+read other fat blocks:

+  INT VAR block no;

+  FOR block no FROM 1 UPTO number of fat sectors - 1 REP

+     read fat block (block no, FALSE)

+  PER.

+

+open dir:

+  init dir struct (subdir path, -1);

+  load main dir blocks;

+  load subdirs if necessary.

+

+load main dir blocks:

+  BOOL VAR last block;

+  store end of dir (loc (end of main dir, dir entrys per block - 1));

+  FOR block no FROM begin of dir UPTO end of main dir REP

+    load dir block (block no, last block);

+    UNTIL last block

+  PER. 

+

+end of main dir:

+  begin of dir + number of dir sectors - 1.

+

+load subdirs if necessary: 

+  TEXT VAR path := subdir path;

+  WHILE path <> "" REP

+    load next subdir if possible

+  PER.

+

+load next subdir if possible:

+  INT VAR cluster no;

+  get next subdir name;

+  get first cluster no of subdir table;

+  clear dir entrys (cluster no);

+  WHILE cluster no >= 0 REP

+    load subdir entrys of cluster;

+    cluster no := next fetch cluster no

+    UNTIL last block 

+  PER.

+

+get next subdir name:

+  TEXT VAR subdir name;

+  IF (path SUB 1) <> "\"

+    THEN error stop ("ungültige Pfadbezeichnung")

+  FI;

+  INT VAR backslash pos := pos (path, "\", "\", 2);

+  IF backslash pos = 0

+    THEN subdir name := subtext (path, 2);

+         path := ""

+    ELSE subdir name := subtext (path, 2, backslash pos - 1);

+         path := subtext (path, backslash pos)

+  FI;

+  subdir name := adapted name (subdir name, TRUE).

+

+get first cluster no of subdir table:

+  IF dir thes CONTAINS subdir name

+    THEN open fetch subdir (subdir name, cluster no);

+    ELSE error stop ("Subdirectory existiert nicht")

+  FI.

+

+load subdir entrys of cluster:

+  store end of dir (loc (last block no of cluster, dir entrys per block - 1));

+  FOR block no FROM 0 UPTO (sectors per cluster - 1) REP

+    load dir block (first block no of cluster (cluster no) + block no, last block)

+    UNTIL last block

+  PER.

+

+last block no of cluster:

+  first block no of cluster (cluster no) + sectors per cluster - 1.

+

+END PROC enable open disk;

+

+PROC init dataspaces:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF NOT dataspaces open

+   THEN disable stop;

+         dataspaces open := TRUE;

+         fat space  := nilspace;

+         dir   ds   := nilspace;

+         block ds   := nilspace;

+         fat struct := fat space;

+         dir        := dir ds; 

+         block      := block ds 

+  FI.

+

+END PROC init dataspaces;

+

+PROC init dir struct (TEXT CONST path string, INT CONST root):

+  clear dir entrys (root);

+  dir.path := path string;

+  dir.disk label := "". 

+

+END PROC init dir struct;

+

+PROC clear dir entrys (INT CONST root):

+  init file list;

+  init dir list;

+  init free list (root).

+

+init file list:

+  dir.file list.thes := empty thesaurus;

+  dir.file list.no of entrys := 0.

+

+init dir list:

+  dir.dir list.thes := empty thesaurus;

+  dir.dir list.no of entrys := 0. 

+

+END PROC clear dir entrys;

+

+PROC close disk:

+  enable stop;

+  IF NOT initialized (this packet)

+    THEN dataspaces open := FALSE

+  FI;

+  IF dataspaces open 

+    THEN forget (dir ds);

+         forget (block ds);

+         forget (fat space);

+         dataspaces open := FALSE

+  FI.

+

+END PROC close disk;

+

+(*COND FLOPPY

+PROC format disk:

+  enable stop;

+  init dataspaces;

+  format fat;

+  format dir.

+

+format fat:

+  write first four fat bytes;

+  write other fat bytes;

+  define write access table (TRUE);

+  copy fat to disk.

+

+write first four fat bytes:

+  fat [1] := word (first fat byte, 255);

+  fat [2] := word (255, 0).

+

+write other fat bytes:

+  FOR count FROM 3 UPTO fat length REP

+    fat [count] := 0

+  PER.

+

+fat length:

+  INT VAR len := number of fat entrys + number of fat entrys DIV 2

+                       + number of fat entrys MOD 2;

+  len DIV 2 + len MOD 2.

+ 

+format dir:

+  init dir struct ("", -1);

+  store begin of free area (loc (begin of dir, 0));

+  store end of dir (loc (end of dir, dir entrys per block - 1));

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM begin of dir UPTO end of dir REP

+    write disk block (block ds, count);

+  PER.

+

+end of dir:

+  begin of dir + number of dir sectors - 1. 

+

+END PROC format disk;

+ENDCOND*)

+

+(*COND HDU*)

+PROC disk clear:

+  error stop ("nicht implementiert")

+

+END PROC disk clear;

+

+PROC format disk:

+  error stop ("nicht implementiert")

+

+END PROC format disk;

+(*ENDCOND*)

+

+INT PROC word (INT CONST low byte, high byte):

+  convert buffer := code (low byte) + code (high byte);

+  convert buffer ISUB 1.

+

+END PROC word;

+ 

+BOOL PROC disk changed:

+(*COND FLOPPY

+  disable stop;

+  NOT first fat block ok COR is error     (* must be COR *)

+ENDCOND*)

+(*COND HDU*)

+  FALSE

+(*ENDCOND*)

+

+END PROC disk changed;

+

+BOOL PROC first fat block ok:

+  enable stop;

+  read fat block (0, TRUE);

+  FOR count FROM 1 UPTO 256 REP

+    compare word

+  PER; 

+  TRUE.

+

+compare word:

+  IF fat struct.fat row [count] <> fat struct.block row [count] 

+    THEN LEAVE first fat block ok WITH FALSE

+  FI. 

+

+END PROC first fat block ok;

+

+PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no):

+  enable stop;

+  first cluster no := dir.file list.entry [link index].first cluster;

+  size             := dir.file list.entry [link index].size;

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (file thes, name).

+

+END PROC open fetch;

+ 

+PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no):

+  first cluster no := dir.dir list.entry [link index];

+  IF first cluster no >= 4088

+    THEN first cluster no := -1

+  FI;

+  akt file cluster no := first cluster no.

+ 

+link index:

+  link (dir thes, subdir name).

+

+END PROC open fetch subdir;

+

+INT PROC next fetch cluster no:

+  enable stop;

+  akt file cluster no := fat entry (akt file cluster no);

+  IF akt file cluster no < 4088  (*ff8h *)

+    THEN akt file cluster no

+    ELSE -1

+  FI.

+

+END PROC next fetch cluster no; 

+

+PROC open save (TEXT CONST file name):

+  enable stop;

+  save name := file name;

+  IF dir full

+    THEN error stop ("Directory voll")

+  FI;

+  IF dir thes CONTAINS file name

+    THEN error stop ("Subdirectory mit gleichem Namen existiert bereits")

+  FI;

+  IF file thes CONTAINS file name

+    THEN error stop ("Datei mit gleichem Namen existiert bereits")

+  FI;

+  no cluster saved := TRUE.

+

+END PROC open save;

+

+INT PROC next save cluster no:

+  enable stop;

+  IF no cluster saved

+    THEN akt file cluster no   := available fat entry;

+         first file cluster no := akt file cluster no;

+         no cluster saved := FALSE

+    ELSE INT VAR old cluster no := akt file cluster no;

+         akt file cluster no := available fat entry;

+         write fat entry (old cluster no, akt file cluster no)

+  FI;

+  write fat entry (akt file cluster no, last entry of fat chain);

+  akt file cluster no.

+

+END PROC next save cluster no;

+

+PROC close save (REAL CONST size):

+  enable stop;

+  IF no cluster saved

+    THEN insert dir entry (save name, 4088, 0.0)

+    ELSE copy fat to disk;

+         insert dir entry (save name, first file cluster no, size)

+  FI.

+

+END PROC close save;

+

+PROC erase table entrys (TEXT CONST name):

+  enable stop;

+  INT VAR first file cluster := first cluster;

+  delete dir entry (name);

+  erase fat chain (first file cluster);

+  copy fat to disk.

+

+first cluster:

+  dir.file list.entry [link index].first cluster.

+ 

+link index:

+  link (file thes, name).

+

+END PROC erase table entrys;

+

+INT PROC fat entry (INT CONST entry no):

+  fix bytes;

+  construct value.

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+construct value:

+  IF entry no MOD 2 = 0

+    THEN (right byte MOD 16) * 256 + left byte 

+    ELSE right byte * 16 + left byte DIV 16

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+

+END PROC fat entry;

+

+INT PROC available fat entry:

+  FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP

+    IF is available entry (count)

+      THEN first possible available fat entry := count;

+           LEAVE available fat entry WITH count

+    FI;

+  PER;

+  close action; error stop ("MS-DOS Datentraeger voll"); maxint.

+

+END PROC available fat entry;

+

+BOOL PROC is available entry (INT CONST entry no):

+  is zero entry.

+

+is zero entry:

+  IF entry no MOD 2 = 0

+    THEN (left byte = 0) CAND ((right byte MOD 16) = 0)

+    ELSE (right byte = 0) CAND ((left byte DIV 16) = 0)

+  FI.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (first byte no + 1).

+ 

+first byte no:

+  entry no + entry no DIV 2.

+ 

+END PROC is available entry;

+

+PROC erase fat chain (INT CONST first entry):

+  INT VAR akt  entry no := first entry,

+          entry         := fat entry (akt entry no);

+  WHILE akt entry no not last chain entry no  REP

+    erase akt entry;

+    akt entry no := entry;

+    entry := fat entry (akt entry no)

+  PER;

+  erase akt entry.

+

+akt entry no not last chain entry no:

+  (entry < last entry of fat chain) AND (entry > 1).

+

+erase akt entry:

+  write fat entry (akt entry no, 0).

+

+END PROC erase fat chain; 

+

+PROC write fat entry (INT CONST entry no, value):

+  fix bytes;

+  remark write access (fat block of first  byte);

+  remark write access (fat block of second byte);

+  write value;

+  update first possible available entry. 

+

+fix bytes:

+  INT VAR first byte no := entry no + entry no DIV 2.

+

+fat block of first byte:

+  first byte no DIV 512.

+

+fat block of second byte:

+  second byte no DIV 512.

+

+write value:

+  IF even entry no

+    THEN write fat byte (first  byte no, value MOD 256);

+         write fat byte (second byte no,

+                        (right byte DIV 16) * 16 + value DIV 256)

+    ELSE write fat byte (first byte no,

+                         (left byte MOD 16) + 16 * (value MOD 16));

+         write fat byte (second byte no, value DIV 16)

+  FI.

+

+even entry no:

+  entry no MOD 2 = 0.

+

+second byte no:

+  first byte no + 1.

+

+left byte:

+  fat byte (first byte no).

+

+right byte:

+  fat byte (second byte no).

+

+update first possible available entry:

+  IF value = 0

+    THEN first possible available fat entry := 

+         min (first possible available fat entry, entry no)

+  FI.

+

+END PROC write fat entry; 

+

+INT PROC fat byte (INT CONST no): 

+  replace (convert buffer, 1, word); 

+  IF even byte no

+    THEN code (convert buffer SUB 1)

+    ELSE code (convert buffer SUB 2)

+  FI. 

+ 

+even byte no:

+  no MOD 2 = 0.

+

+word: 

+  fat [no DIV 2 + 1]. 

+

+END PROC fat byte; 

+ 

+PROC write fat byte (INT CONST byte no, new value):

+  read old word;

+  change byte;

+  write new word.

+

+read old word: 

+  replace (convert buffer, 1, word).

+

+write new word:

+  word := convert buffer ISUB 1.

+

+word:

+  fat [byte no DIV 2 + 1].

+

+change byte:

+  replace (convert buffer, byte pos, code (new value)).

+

+byte pos:

+  byte no MOD 2 + 1.

+

+END PROC write fat byte;

+

+PROC copy fat to disk:

+  INT VAR block no;

+  FOR block no FROM 0 UPTO number of fat sectors - 1 REP

+    IF was write access (block no)

+      THEN write fat block (block no)

+    FI

+  PER.

+

+END PROC copy fat to disk;

+

+PROC write fat block (INT CONST fat block no):

+  INT VAR fat copy no;

+  INT VAR return code;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies -1 REP

+    write disk block (fat space, ds page no, block no, return code);

+    IF return code > 0

+      THEN close action

+    FI

+  PER;

+  remark no write access (block no);

+  enable stop.

+

+ds page no:

+  first non dummy ds page + fat block no + 1.

+

+block no:

+  begin of fat (fat copy no) + fat block no.

+

+END PROC write fat block;

+

+PROC read fat block (INT CONST fat block, BOOL CONST test block):

+  INT VAR fat copy no;

+  disable stop;

+  FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP

+    clear error;

+    read disk block (fat space, ds page no, fat block no)

+    UNTIL NOT is error

+  PER;

+  IF is error

+    THEN close action

+  FI;

+  enable stop.

+

+ds page no:

+  IF test block

+    THEN first non dummy ds page

+    ELSE fat block + first non dummy ds page + 1

+  FI.

+

+fat block no:

+  begin of fat (fat copy no) + fat block.

+

+END PROC read fat block;

+

+PROC define write access table (BOOL CONST status):

+  FOR count FROM 1 UPTO number of fat sectors REP

+    write access [count] := status

+  PER.

+

+END PROC define write access table;

+

+PROC remark write access (INT CONST fat block no):

+  write access [fat block no + 1] := TRUE

+

+END PROC remark write access;

+

+PROC remark no write access (INT CONST fat block no):

+  write access [fat block no + 1] := FALSE

+

+END PROC remark no write access;

+

+BOOL PROC was write access (INT CONST fat block no):

+  write access [fat block no + 1]

+

+END PROC was write access;

+

+(*COND TEST

+PROC dump fat:                                                     

+  IF NOT exists ("fat dump")                                       

+    THEN open file                                                 

+  FI;                                                              

+  DATASPACE VAR ds := nilspace;                                    

+  FILE VAR in := sequential file (input, "fat dump"),              

+           out := sequential file (output, ds);                    

+  INT VAR i;                                                       

+  TEXT VAR line;                                                   

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    dump fat entry                                                 

+  PER;                                                             

+  forget ("fat dump", quiet);                                      

+  copy (ds, "fat dump");                                           

+  forget (ds).                                                     

+                                                                   

+open file:                                                         

+  in := sequential file (output, "fat dump");                      

+  FOR i FROM 0 UPTO number of fat entrys - 1 REP                   

+    putline (in, text (i, 4) + ": ")                               

+  PER.                                                             

+                                                                   

+dump fat entry:                                                    

+  cout (i);                                                        

+  getline (in, line);                                              

+  putline (out, line + "  " + text (fat entry (i), 4)).            

+                                                                   

+END PROC dump fat;                                                 

+ENDCOND*)

+

+PROC load dir block (INT CONST block no, BOOL VAR last block): 

+  last block := FALSE;

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  INT VAR entry no,

+          thes index;

+  FOR entry no FROM 0 UPTO dir entrys per block - 1 REP 

+    dir entry := text 32 (block, entry no);

+    process entry

+  PER.

+

+process entry:

+  SELECT pos (""0"."229"", dir entry SUB 1) OF

+    CASE 1: end of dir search

+    CASE 2: main dir entry

+    CASE 3: free entry

+    OTHERWISE file entry

+  END SELECT.

+

+end of dir search:

+  last block := TRUE;

+  store begin of free area (loc (block no, entry no));

+  LEAVE load dir block.

+

+main dir entry:

+  (* no operation *).

+

+free entry:

+  store in free list (loc (block no, entry no)).

+

+file entry:

+  SELECT code (dir entry SUB 12) OF

+    CASE  8: volume label

+    CASE 16: sub dir entry

+    OTHERWISE dos file entry

+  END SELECT.

+

+volume label:

+  dir.disk label := text (dir entry, 1, 11).

+

+sub dir entry:

+  dir.dir list.no of entrys INCR 1;

+  insert (dir thes, name, thes index);

+  dir list entry := first cluster no.

+

+dos file entry:

+  IF dir.file list.no of entrys >= max dir entrys

+    THEN error stop ("Directorytabelle voll")

+  FI;

+  dir.file list.no of entrys INCR 1;

+  insert (file thes, name, thes index);

+  file list entry.first cluster           := first cluster no;

+  file list entry.date and time           := dos date + "  " + dos time;

+  file list entry.size                    := dos storage;

+  file list entry.location.msdos block no := block no;

+  file list entry.location.block entry no := entry no.

+ 

+name:

+  IF name post <> ""

+    THEN name pre + "." + name post

+    ELSE name pre

+  FI.

+

+name pre:

+  compress (subtext (dir entry, 1, 8)).

+

+name post:

+  compress (subtext (dir entry, 9, 11)).

+

+file list entry:

+  dir.file list.entry [thes index].

+

+dir list entry:

+  dir.dir list.entry [thes index].

+

+first cluster no:

+  code (dir entry SUB 27) + 256 * code (dir entry SUB 28).

+

+dos storage:

+  real (code (dir entry SUB 29)) +

+  real (code (dir entry SUB 30)) * 256.0 +

+  real (code (dir entry SUB 31)) * 65536.0 +

+  real (code (dir entry SUB 32)) * 16777216.0.

+

+dos date:

+  day + "." + month + "." + year. 

+ 

+day: 

+  IF code (dir entry SUB 25) MOD 32 < 10 

+    THEN "0" + text (code (dir entry SUB 25) MOD 32) 

+    ELSE text (code (dir entry SUB 25) MOD 32)

+  FI. 

+ 

+month:

+  INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2);

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+year:

+  text (80 + code (dir entry SUB 26) DIV 2, 2).

+

+dos time:

+  hour + ":" + minute. 

+ 

+hour: 

+  dummy := code (dir entry SUB 24) DIV 8; 

+  IF dummy < 10 

+    THEN "0" + text (dummy) 

+    ELSE text (dummy) 

+  FI. 

+ 

+minute: 

+  dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8); 

+  IF dummy < 10 

+    THEN "0" + text (dummy)

+    ELSE text (dummy) 

+  FI. 

+ 

+END PROC load dir block; 

+ 

+PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage):

+  (* name must be a dos name *)

+  LOCATION VAR ins pos := free location;

+  TEXT VAR akt date := date (clock (1)),

+           akt time := time of day (clock (1));

+  write disk entry;

+  write dir struct entry.

+

+write disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  prepare name;

+  dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time +

+               dos date + starting cluster + storage;

+  write text 32 (block, dir entry, ins pos.block entry no);

+  write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+prepare name:

+  TEXT VAR name pre, name post;

+  IF point pos > 0

+    THEN name pre  := subtext (name, 1, point pos - 1);

+         name post := subtext (name, point pos + 1);

+         name pre  CAT (8 - LENGTH name pre)  * " ";

+         name post CAT (3 - LENGTH name post) * " "

+    ELSE name pre  := name + (8 - LENGTH name) * " ";

+         name post := "   "

+  FI.

+ 

+point pos:

+  pos (name, "."). 

+ 

+dos time:

+  code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8).

+

+hour:

+  int (subtext (akt time, 1, 2)).

+

+minute:

+  int (subtext (akt time, 4, 5)).

+

+dos date:

+   code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8).

+

+day: 

+  int (subtext (akt date, 1, 2)).

+

+month:

+  int (subtext (akt date, 4, 5)).

+

+year:

+  int (subtext (akt date, 7, 8)).

+

+starting cluster:

+  code (start cluster MOD 256) + code (start cluster DIV 256).

+

+storage:

+  code (int (round (256.0 * frac (used storage / 256.0), 0))) +

+  code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) +

+  code (int (floor (used storage / 65536.0))) +

+  code (0).          (* maximal 16384 K *********************************)

+

+write dir struct entry:

+  INT VAR thes link;

+  insert (file thes, name, thes link);

+  file list entry.location      := ins pos; 

+  file list entry.first cluster := start cluster;

+  file list entry.date and time := akt date + "  " + akt time;

+  file list entry.size          := used storage.

+

+file list entry:

+  dir.filelist.entry [thes link].

+

+END PROC insert dir entry;

+

+PROC delete dir entry (TEXT CONST name):

+  LOCATION VAR del pos;

+  get del pos;

+  erase dir struct entry;

+  erase disk entry;

+  store in free list (del pos).

+

+get del pos:

+  del pos := dir.filelist.entry [link index].location.

+

+link index:

+  link (file thes, name).

+

+erase dir struct entry:

+  INT VAR i;

+  delete (file thes, name, i).

+

+erase disk entry:

+  INT VAR return code;

+  read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI;

+  dir entry := text 32 (block, del pos.block entry no);

+  replace (dir entry, 1, ""229"");

+  write text 32 (block, dir entry, del pos.block entry no);

+  write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code);

+  IF return code > 0

+    THEN close action;

+         io error (return code)

+  FI.

+

+END PROC delete dir entry;

+ 

+.

+file thes:

+  dir.filelist.thes.

+

+dir thes:

+  dir.dir list.thes.

+

+(*********************** dir information ******************************)

+

+THESAURUS PROC dir all: 

+  file thes.

+ 

+END PROC dir all; 

+ 

+BOOL PROC dir contains (TEXT CONST name): 

+  file thes CONTAINS name

+

+END PROC dir contains;

+ 

+PROC dir list (DATASPACE VAR ds):

+  enable stop;

+  open list file;

+  list files;

+  list dirs;

+  write list head.

+

+open list file:

+  forget (ds);

+  ds := nilspace;

+  FILE VAR list file := sequential file (output, ds);

+  putline (list file, "").

+ 

+list files: 

+  INT VAR number := 0;

+  get (file thes, name, number);

+  WHILE number > 0 REP

+    generate file list line;

+    get (file thes, name, number)

+  PER.

+

+generate file list line:

+  write (list file, centered name);

+  write (list file, "  ");

+  write (list file, text (act file entry.size, 11, 0));

+  write (list file, " Bytes belegt      ");

+  write (list file, act file entry.date and time); 

+(*COND TEST

+  write (list file, "  +++  "); 

+  write (list file, text (act file entry.first cluster)); 

+ENDCOND*)

+  line (list file).

+

+list dirs:

+  number := 0;

+  get (dir thes, name, number);

+  WHILE number > 0 REP

+    generate dir list line;

+    get (dir thes, name, number)

+  PER.

+

+generate dir list line:

+  write (list file, centered name);

+  write (list file, "   <DIR>");

+(*COND TEST

+  write (list file, "  +++  ");                                 

+  write (list file, text (dir.dir list.entry [number]));  

+ENDCOND*)

+  line (list file).

+

+centered name:

+  INT VAR point pos := pos (name, ".");

+  IF point pos > 0

+    THEN name pre + "." + name post

+    ELSE text (name, 12)

+  FI.

+

+name pre:

+  text (subtext (name, 1, point pos - 1), 8).

+

+name post:

+  text (subtext (name, point pos + 1, point pos + 4), 3).

+ 

+act file entry:

+  dir.file list.entry [number].

+

+write list head:

+  head line (list file, head).

+

+head:

+  "DOS" + disk label string + path string.

+

+disk label string:

+  IF dir.disk label <> ""

+    THEN ": " + dir.disk label

+    ELSE ""

+  FI.

+

+path string:

+  IF dir.path <> ""

+    THEN "     PATH: " + dir.path

+    ELSE ""

+  FI.

+

+END PROC dir list;

+ 

+(************ free list handling ******************************************)

+LOCATION PROC loc (INT CONST block, entry):

+  LOCATION : (block, entry) 

+

+END PROC loc;

+

+BOOL OP > (LOCATION CONST l, r):

+  l.msdos block no > r.msdos block no

+  OR ((l.msdos block no = r.msdos block no) AND 

+      (l.block entry no > r.block entry no)     )

+

+END OP >;

+

+OP INCR (LOCATION VAR l):

+  IF l.block entry no = dir entrys per block -1

+    THEN l.block entry no := 0;

+         l.msdos block no INCR 1

+    ELSE l.block entry no INCR 1

+  FI.

+

+END OP INCR;

+

+PROC init free list (INT CONST dir root):

+  dir.freelist.stacktop := 0;

+  dir.freelist.begin of free area.msdos block no := maxint;

+  dir.freelist.end of dir.msdos block no := -1;

+  dir.freelist.dir chain root := dir root.

+

+END PROC init free list;

+ 

+BOOL PROC dir full:

+  stack empty AND free area empty AND NOT expansion alloweded.

+

+stack empty:

+  dir.freelist.stacktop < 1.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC dir full;

+

+PROC store in free list (LOCATION CONST free):

+  dir.freelist.stacktop INCR 1;

+  dir.freelist.stack [top] := free.

+

+top:

+  dir.freelist.stacktop.

+

+END PROC store in free list;

+

+PROC store begin of free area (LOCATION CONST begin):

+  dir.freelist.begin of free area := begin

+

+END PROC store begin of free area;

+

+PROC store end of dir (LOCATION CONST end):

+  dir.freelist.end of dir := end

+

+END PROC store end of dir;

+

+LOCATION PROC free location:

+  LOCATION VAR result;

+  IF dir.freelist.stacktop > 0

+    THEN pop

+    ELIF NOT free area empty

+    THEN first of free area

+    ELIF expansion alloweded

+    THEN allocate new dir space;

+         result := free location

+    ELSE error stop ("Directorytabelle voll")

+  FI;

+  result.

+

+pop:

+  result := dir.freelist.stack [top];

+  top DECR 1.

+

+top:

+  dir.freelist.stack top.

+

+free area empty:

+  dir.freelist.begin of free area > dir.freelist.end of dir.

+

+first of free area:

+  result := dir.freelist.begin of free area;

+  INCR dir.freelist.begin of free area.

+

+expansion alloweded:

+  dir.freelist.dir chain root >= 0.

+

+END PROC free location; 

+

+PROC allocate new dir space:

+  enable stop;

+  INT VAR new cluster no := available fat entry;

+  IF new cluster no < 0

+    THEN error stop ("MS-DOS Datentraeger voll")

+  FI;

+  INT VAR last entry no;

+  search last entry of fat chain;

+  write fat entry (new cluster no, 4095);

+  write fat entry (last entry no, new cluster no);

+  copy fat to disk;

+  store begin of free area (loc (first new block, 0));

+  store end of dir (loc (last new block, dir entrys per block - 1));

+  init new dir cluster.

+

+search last entry of fat chain:

+  last entry no := dir.freelist.dir chain root;

+  WHILE fat entry (last entry no) < last entry of fat chain REP

+    last entry no := fat entry (last entry no)

+  PER.

+

+init new dir cluster:

+  FOR count FROM 0 UPTO dir entrys per block - 1 REP

+    write text 32 (block, ""0"" + 31 * ""246"", count)

+  PER;

+  disable stop;

+  FOR count FROM first new block UPTO last new block REP

+    write disk block (block ds, count);

+  PER.

+

+first new block:

+  firstblock no of cluster (new cluster no).

+

+last new block:

+  first block no of cluster (new cluster no) + sectors per cluster - 1.

+

+END PROC allocate new dir space; 

+

+(*COND TEST

+PROC dump freelist:

+  command dialogue (FALSE);

+  FILE VAR f := sequential file (output, "freelistdump");

+  INT VAR i;

+  putline (f, "STACKTOP: " + text (fl.stacktop));

+  putline (f, "STACK:");

+  FOR i FROM 1 UPTO 16 * number of dir sectors REP

+    putline (f, "   " + text (i, 4) + ":  " +

+                text (fl.stack [i].msdos block no) + ", " +

+                text (fl.stack [i].block entry no))

+  PER; 

+  line (f);

+  putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) + 

+            ", "  + text (fl.begin of free area.block entry no));

+  putline (f, "END   OF DIR:  " + text (fl.end of dir.msdos block no) + 

+            ", "  + text (fl.end of dir.block entry no)).

+

+fl:

+  dir.freelist.

+

+END PROC dump free list;

+ENDCOND*)

+

+END PACKET dos fat and dir;

diff --git a/system/dos/1986/src/fetch b/system/dos/1986/src/fetch
new file mode 100644
index 0000000..ad00ab6
--- /dev/null
+++ b/system/dos/1986/src/fetch
@@ -0,0 +1,333 @@
+PACKET fetch DEFINES                   (* Copyright (C) 1985 *)

+                                       (* Frank Klapper      *)

+                                       (* 07.05.86           *) 

+  fetch filemode, 

+  fetch rowtextmode,

+  fetch dsmode, 

+  check file:

+

+LET       ascii        = 1,

+          ascii german = 2,

+          transparent  = 3,

+          ebcdic       = 4,

+          atari st     = 10;

+

+LET row text mode length = 4000,

+    row text type        = 1000,

+

+    ctrl z         = ""26"", 

+    tab            = ""9"",

+    page cmd       = "#page#";

+

+CLUSTER VAR cluster;

+

+DATASPACE VAR cluster space;

+

+BOUND STRUCT (INT size,

+              ROW row text mode length TEXT cluster row) VAR cluster struct;

+

+INT VAR next cluster no;

+REAL VAR file rest;

+

+FILE VAR file;

+

+PROC fetch filemode (DATASPACE VAR file space, 

+                     TEXT CONST name, INT CONST code type):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enabled fetch filemode (file space, name, code type);

+  forget (cluster space).

+ 

+END PROC fetch filemode; 

+ 

+PROC enabled fetch filemode (DATASPACE VAR file space, 

+                             TEXT CONST name,

+                             INT CONST code type):

+  enable stop;

+  initialize fetch filemode;

+  open fetch (name, file rest, next cluster no);

+  WHILE (next cluster no >= 0) AND (file rest > 0.0) REP

+    get text of act cluster;

+    write lines;

+(***************************************)

+    IF lines (file) > 3950

+      THEN putline (file, ">>> FREMDDATEI FUER EUMEL ZU LANG. ES K�NNEN DATEN FEHLEN <<<");

+           LEAVE enabled fetch filemode

+    FI;

+(***************************************)

+  PER;

+  write last line if necessary. 

+ 

+initialize fetch filemode:

+  REAL VAR real cluster size := real (cluster size);

+  TEXT VAR buffer := "";

+  forget (file space);

+  file space := nilspace;

+  file := sequential file (output, file space);

+  init cr lf ff const.

+ 

+init cr lf ff const:

+  TEXT VAR cr, lf, ff;

+  SELECT codetype OF 

+    CASE ascii, ascii german, atari st: cr := ""13""; lf := ""10""; ff := ""12""

+    CASE transparent: cr := ""13""; lf := ""10""; ff := ""12""

+    CASE ebcdic: cr := ""13""; lf := "%"; ff := ""12""

+  END SELECT;

+  TEXT CONST select buffer := cr + lf + ff;

+  TEXT CONST min line end char := code (min (code (cr), min (code (lf), code (ff)))),

+             max line end char := code (max (code (cr), max (code (lf), code (ff)))).

+

+get text of act cluster:

+  fetch next cluster (cluster space, first non dummy ds page);

+  buffer CAT text (cluster, 1, valid buffer length);

+  file rest DECR real cluster size;

+  IF seven bit code

+    THEN cancel bit 8

+  FI;

+  IF ctrl z end

+    THEN test ctrl z

+  FI;

+  INT CONST bufferlength := LENGTH buffer.

+

+ctrl z end:

+  (code type = ascii) OR (code type = ascii german).

+

+seven bit code:

+  code type = ascii OR code type = ascii german.

+

+valid buffer length:

+  int (min (file rest, real cluster size)).

+

+cancel bit 8:

+  INT VAR set pos := pos (buffer, "�", ""255"", 1);

+  WHILE set pos > 0 REP

+    replace (buffer, set pos, seven bit char);

+    set pos := pos (buffer, "�", ""255"", set pos + 1)

+  PER.

+

+seven bit char:

+  code (code (buffer SUB set pos) AND 127).

+

+test ctrl z:

+  IF pos (buffer, ctrl z) > 0

+    THEN file rest := 0.0;

+         buffer := subtext (buffer, 1, pos (buffer, ctrl z) - 1)

+  FI.

+

+write lines:

+  INT VAR begin pos := 1, end pos;

+  next cr lf ff pos;

+  WHILE end pos > 0 REP

+    execute char and get new pos pointer;

+    next cr lf ff pos

+  PER;

+  compress buffer.

+

+next cr lf ff pos:

+  end pos := pos (buffer, min line end char, max line end char, begin pos);

+  WHILE no line end char REP

+    end pos := pos (buffer, min line end char, max line end char, end pos + 1)

+  PER.

+

+no line end char:

+  (end pos > 0) AND (pos (select buffer, buffer SUB end pos) = 0).

+

+compress buffer:

+  buffer := subtext (buffer, begin pos).

+

+execute char and get new pos pointer:

+  SELECT pos (select buffer, buffer SUB end pos) OF

+    CASE 1: execute cr

+    CASE 2: execute lf

+    CASE 3: execute ff

+  END SELECT.

+

+execute cr: 

+  IF (end pos = bufferlength) AND (file rest > 0.0)

+    THEN compress buffer;

+         LEAVE write lines

+  FI;

+  write line (subtext (buffer, begin pos, end pos - 1), code type);

+  IF (buffer SUB (end pos + 1)) = lf 

+    THEN begin pos := end pos + 2

+    ELSE begin pos := end pos + 1

+  FI.

+ 

+execute ff:

+  write line (subtext (buffer, begin pos, end pos - 1), code type);

+  putline (file, page cmd);

+  begin pos := end pos + 1.

+

+execute lf: 

+  IF (end pos = bufferlength) AND (file rest > 0.0)

+    THEN compress buffer;

+         LEAVE write lines

+  FI;

+  write line (subtext (buffer, begin pos, end pos - 1), code type);

+  IF (buffer SUB (end pos + 1)) = cr 

+    THEN begin pos := end pos + 2

+    ELSE begin pos := end pos + 1

+  FI.

+ 

+write last line if necessary:

+  IF buffer <> ""

+    THEN end pos := LENGTH buffer + 1;

+         write line (subtext (buffer, begin pos, end pos - 1), code type)

+  FI.

+

+END PROC enabled fetch filemode;

+

+PROC write line (TEXT CONST line, INT CONST code type):

+  TEXT VAR result;

+  SELECT code type OF

+    CASE ascii: ascii conversion

+    CASE ascii german: ascii german conversion

+    CASE atari st: atari st conversion

+    CASE transparent: putline (file, line)

+    CASE ebcdic: ebcdic conversion

+  END SELECT.

+

+ascii conversion:

+  expand tabs;

+  replace steuerzeichen;

+  putline (file, result).

+

+ascii german conversion:

+  expand tabs;

+  replace steuerzeichen;

+  replace ascii german umlaute;

+  putline (file, result).

+

+atari st conversion:

+  expand tabs;

+  replace steuerzeichen;

+  replace atari st umlaute;

+  putline (file, result).

+

+replace ascii german umlaute:

+  change all (result, "[", "�");

+  change all (result, "\", "�");

+  change all (result, "]", "�");

+  change all (result, "{", "�");

+  change all (result, "|", "�");

+  change all (result, "}", "�");

+  change all (result, "~", "�").

+

+replace atari st umlaute:

+  change all (result, ""142"", "�");

+  change all (result, ""153"", "�");

+  change all (result, ""154"", "�");

+  change all (result, ""132"", "�");

+  change all (result, ""148"", "�");

+  change all (result, ""129"", "�");

+  change all (result, ""158"", "�").

+

+expand tabs:

+  result := line;

+  INT VAR tab pos := pos (result, tab);

+  WHILE tab pos > 0 REP

+    expand tab;

+    tab pos := pos (result, tab)

+  PER.

+

+expand tab:

+  result := subtext (result, 1, tab pos - 1) + (8 - ((tab pos - 1)) MOD 8) * " "

+          + subtext (result, tab pos + 1).

+

+replace steuerzeichen:

+  INT VAR position := pos (result, ""0"", ""31"", 1);

+  WHILE position > 0 REP

+    TEXT VAR char := result SUB position;

+    change all (result, char, "#" + int code + "#");

+    position := pos (result, ""0"", ""31"", position)

+  PER.

+

+ebcdic conversion:

+  result := line;

+  ebcdic to eumel with substitution (result);

+  putline (file, result).

+ 

+int code: 

+  (3 - LENGTH text (code (char))) * "0" + text (code (char)).

+

+END PROC write line;

+

+PROC fetch rowtextmode (DATASPACE VAR file space,

+                        TEXT CONST name):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enabled fetch rowtextmode (file space, name);

+  forget (cluster space).

+ 

+END PROC fetch rowtextmode;

+ 

+PROC enabled fetch rowtextmode (DATASPACE VAR file space,

+                               TEXT CONST name):

+  enable stop; 

+  open fetch (name, file rest, next cluster no);

+  initialize fetch rowtext mode;

+  WHILE next cluster no >= 0 REP

+    fetch next cluster (cluster space, first non dummy ds page);

+    cluster struct.size INCR 1;

+    IF file rest < real cluster size

+     THEN cluster struct.cluster row [cluster struct.size]

+                         := text (cluster, 1, int (file rest));

+          file rest := 0.0

+     ELSE cluster struct.cluster row [cluster struct.size] := text (cluster, 1, cluster size); 

+          file rest DECR real cluster size

+     FI

+  PER. 

+ 

+initialize fetch row text mode:

+  forget (file space);

+  file space := nilspace;

+  cluster struct := file space;

+  type (file space, row text type);

+  REAL VAR real cluster size := real (cluster size);

+  cluster struct.size := 0.

+

+END PROC enabled fetch rowtext mode;

+

+PROC fetch ds mode (DATASPACE VAR ds, TEXT CONST name):

+  enable stop;

+  open fetch (name, file rest, next cluster no);

+  init fetch dsmode;

+  WHILE next cluster no >= 0 REP

+    fetch next cluster (ds, ds block no);

+     ds block no INCR sectors per cluster;

+  PER. 

+ 

+init fetch dsmode:

+  forget (ds);

+  ds := nilspace;

+  INT VAR ds block no := 2.

+

+END PROC fetch ds mode;

+

+PROC check file (TEXT CONST name):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enabled check file (name);

+  forget (cluster space).

+ 

+END PROC check file;

+ 

+PROC enabled check file (TEXT CONST name):

+  enable stop;

+  open fetch (name, file rest, next cluster no);

+  WHILE next cluster no >= 0 REP

+    fetch next cluster (cluster space, first non dummy ds page)

+  PER. 

+ 

+END PROC enabled check file;

+

+PROC fetch next cluster (DATASPACE VAR fetch space, INT CONST first page):

+  read disk cluster (fetch space, first page, next cluster no);

+  next cluster no := next fetch cluster no.

+

+END PROC fetch next cluster;

+

+END PACKET fetch;

diff --git a/system/dos/1986/src/files.dos b/system/dos/1986/src/files.dos
new file mode 100644
index 0000000..0dd792f
--- /dev/null
+++ b/system/dos/1986/src/files.dos
@@ -0,0 +1,23 @@
+eumel-ebcdic + sub 

+open 

+block i/o 

+cluster 

+name conversion 

+eu disk descriptor.fd 

+disk descriptor.dos.fd 

+fat and dir.dos.fd 

+eu disk descriptor.hd 

+disk descriptor.dos.hd 

+fat and dir.dos.hd 

+fetch 

+save 

+disk manager 

+manager/M.dos.fd 

+manager/M.dos.hd

+table thes.dos 

+252 

+253 

+254 

+255 

+shard interface 

+

diff --git a/system/dos/1986/src/gen.dos b/system/dos/1986/src/gen.dos
new file mode 100644
index 0000000..5493272
--- /dev/null
+++ b/system/dos/1986/src/gen.dos
@@ -0,0 +1,99 @@
+(* 28.02.88, DOS Inserter HD/FD *) 

+TASK VAR fd, hd ; 

+IF NOT exists ("files.dos") THEN fetch ("files.dos", archive) FI ; 

+IF highest entry (ALL "files.dos" - all) > 0 

+   THEN fetch (ALL "files.dos" - all, archive) ; 

+FI ; 

+forget ("files.dos", quiet) ; 

+forget ("gen.dos", quiet) ; 

+release (archive) ; 

+ins ("eumel-ebcdic + sub") ; 

+ins ("open") ; 

+ins ("name conversion") ; 

+begin ("FD", PROC fd start, fd) ; 

+begin ("HD", PROC hd start, hd) ; 

+globalmanager ; 

+ 

+PROC ins (TEXT CONST name) : 

+ insert (name) ; 

+ forget (name, quiet) 

+ENDPROC ins ; 

+ 

+PROC hd start : 

+ command dialogue (FALSE) ; 

+ 

+ fetch ("eu disk descriptor.hd") ; 

+ erase ("eu disk descriptor.hd") ; 

+ fetch ("disk descriptor.dos.hd") ; 

+ erase ("disk descriptor.dos.hd") ; 

+ fetch ("cluster") ; 

+ fetch ("block i/o") ; 

+ fetch ("fat and dir.dos.hd") ; 

+ erase ("fat and dir.dos.hd") ; 

+ fetch ("fetch") ; 

+ fetch ("save") ; 

+ fetch ("disk manager") ; 

+ fetch ("manager/M.dos.hd") ; 

+ erase ("manager/M.dos.hd") ;  (* fetch beendet signalieren *) 

+ 

+ IF NOT exists ("manager/M.dos.fd", father) (* FD auch fertig ? *)

+    THEN erase ("block i/o") ; 

+         erase ("cluster") ; 

+         erase ("fetch") ; 

+         erase ("save") ; 

+         erase ("disk manager")

+ FI ; 

+ 

+ ins ("eu disk descriptor.hd") ; 

+ ins ("disk descriptor.dos.hd") ; 

+ ins ("cluster") ; 

+ ins ("block i/o") ; 

+ ins ("fat and dir.dos.hd") ; 

+ ins ("fetch") ; 

+ ins ("save") ; 

+ ins ("disk manager") ; 

+ ins ("manager/M.dos.hd") ; 

+ do ("dos manager") 

+ENDPROC hd start ; 

+ 

+PROC fd start : 

+ disablestop ;

+ command dialogue (FALSE) ; 

+ fetch ("table thes.dos") ; 

+ erase ("table thes.dos") ; 

+ fetch (ALL "table thes.dos") ; 

+ erase (ALL "table thes.dos") ; 

+ fetch ("eu disk descriptor.fd") ; 

+ erase ("eu disk descriptor.fd") ; 

+ fetch ("disk descriptor.dos.fd") ; 

+ erase ("disk descriptor.dos.fd") ; 

+ fetch ("cluster") ; 

+ fetch ("block i/o") ; 

+ fetch ("fat and dir.dos.fd") ; 

+ erase ("fat and dir.dos.fd") ; 

+ fetch ("fetch") ; 

+ fetch ("save") ; 

+ fetch ("disk manager") ; 

+ fetch ("manager/M.dos.fd") ; 

+ erase ("manager/M.dos.fd") ;  (* fetch beendet signalieren *) 

+ 

+ IF NOT exists ("manager/M.dos.hd", father) (* HD auch fertig ? *)

+    THEN erase ("block i/o") ;

+         erase ("cluster") ; 

+         erase ("fetch") ; 

+         erase ("save") ; 

+         erase ("disk manager")

+ FI ; 

+ 

+ ins ("eu disk descriptor.fd") ; 

+ ins ("disk descriptor.dos.fd") ; 

+ ins ("cluster") ; 

+ ins ("block i/o") ; 

+ ins ("fat and dir.dos.fd") ; 

+ ins ("fetch") ; 

+ ins ("save") ; 

+ ins ("disk manager") ; 

+ ins ("manager/M.dos.fd") ; 

+ do ("dos manager") 

+ENDPROC fd start ; 

+ 

diff --git a/system/dos/1986/src/manager-M.dos.fd b/system/dos/1986/src/manager-M.dos.fd
new file mode 100644
index 0000000..1c59e01
--- /dev/null
+++ b/system/dos/1986/src/manager-M.dos.fd
@@ -0,0 +1,198 @@
+PACKET dos manager multi DEFINES                     (* Copyright (C) 1985 *)

+                                                     (* Frank Klapper      *)

+  provide channel,                                   (* 25.03.86           *)

+  dos manager:

+ 

+LET std archive channel = 31,

+

+    ack              = 0,

+    second phase ack = 5,

+    false code       = 6,

+

+    fetch code       = 11,

+    save code        = 12,

+    exists code      = 13,

+    erase code       = 14,

+    list code        = 15,

+    all code         = 17,

+    clear code       = 18,

+    reserve code     = 19,

+    free code        = 20,

+    check read code  = 22,

+

+    quote            = """";

+

+BOUND STRUCT (TEXT name, pass) VAR msg;

+

+TASK VAR order task;

+

+INT VAR dos channel;

+

+REAL VAR last access time := 0.0;

+

+TASK VAR disk owner := niltask; 

+

+PROC provide channel (INT CONST channel):

+  dos channel := channel

+

+END PROC provide channel;

+

+(*COND FLOPPY*)

+provide channel (std archive channel);

+(*ENDCOND*)

+

+(*COND HDU

+provide channel (29) 

+ENDCOND*)

+

+PROC dos manager:

+  dos manager (dos channel)

+

+END PROC dos manager;

+

+PROC dos manager (INT CONST channel):

+(*COND FLOPPY*)

+  load shard interface table;

+(*ENDCOND*)

+  dos channel := channel;

+  task password ("-");

+  global manager

+        (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) 

+

+END PROC dos manager;

+

+PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,

+                  TASK CONST from task):

+  enable stop;

+  order task := from task;

+  msg := ds;

+  IF NOT (order task = disk owner) AND 

+     order code <> free code AND order code <> reserve code

+    THEN errorstop ("DOS nicht angemeldet")

+  FI;

+  SELECT order code OF 

+    CASE fetch code     : fetch file 

+    CASE save code      : save file

+    CASE erase code     : erase file

+    CASE clear code     : clear disk

+    CASE exists code    : exists file

+    CASE list code      : list disk

+    CASE all code       : deliver directory

+    CASE reserve code   : reserve

+    CASE free code      : free

+    CASE check read code: check

+    OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))

+  END SELECT.

+

+fetch file:

+  disk fetch (msg.name, ds);

+  manager ok (ds).

+

+check:

+  disk check (msg.name);

+  manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen"). 

+

+save file:

+  IF phase = 1

+    THEN save first phase

+    ELSE save second phase

+  FI.

+

+save first phase:

+  BOOL VAR overwrite question;

+  disk save first phase (msg.name, overwrite question);

+  IF overwrite question

+    THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben")

+    ELSE send (order task, second phase ack, ds)

+  FI.

+

+save second phase:

+  disable stop;

+  disk save second phase (ds);

+  forget (ds) ;

+  ds := nilspace ;

+  enable stop;

+  manager ok (ds).

+

+clear disk: 

+  IF NOT (from task = disk owner)

+    THEN error stop ("DOS nicht angemeldet")

+  FI;

+  IF phase = 1

+    THEN manager question ("Diskette loeschen")

+    ELSE disk clear;

+         manager ok (ds)

+  FI.

+

+erase file:

+  IF disk exists (msg.name)

+    THEN IF phase = 1

+           THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")

+           ELSE disk erase (msg.name);

+                manager ok (ds)

+         FI

+    ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")

+  FI.

+ 

+exists file:

+  IF disk exists (msg.name)

+    THEN manager ok (ds)

+    ELSE send (order task, false code, ds)

+  FI.

+

+list disk:

+  disk list (ds);

+  manager ok (ds).

+

+deliver directory:

+  forget (ds);

+  ds := nilspace;

+  BOUND THESAURUS VAR all names := ds;

+  all names := disk all;

+  manager ok (ds).

+

+reserve:

+  IF reserve or free permitted

+    THEN do continue channel;

+         disk owner := from task;

+         disk reserve (msg.name);

+         manager ok (ds)

+    ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")

+  FI.

+

+do continue channel:

+  IF channel <> dos channel

+    THEN continue channel (dos channel)

+  FI.

+

+reserve or free permitted :

+  from task = disk owner OR last access more than five minutes ago

+  OR disk owner = niltask OR NOT

+  (exists (disk owner) OR station(disk owner) <> station (myself)).

+

+last access more than five minutes ago :

+  abs (last access time - clock (1)) > 300.0.

+

+free: 

+  IF reserve or free permitted

+    THEN disk free;

+         disk owner := niltask;

+         break (quiet);

+         manager ok (ds)

+    ELSE manager message ("DOS nicht angemeldet")

+  FI.

+

+END PROC dos manager;

+

+PROC manager ok (DATASPACE VAR ds):

+  send (order task, ack, ds);

+  last access time := clock (1).

+

+END PROC manager ok;

+

+TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):

+  text (quote + adapted name (name, status) + quote, 14)

+

+END PROC expanded name;

+

+END PACKET dos manager multi;

diff --git a/system/dos/1986/src/manager-M.dos.hd b/system/dos/1986/src/manager-M.dos.hd
new file mode 100644
index 0000000..70d9d9a
--- /dev/null
+++ b/system/dos/1986/src/manager-M.dos.hd
@@ -0,0 +1,198 @@
+PACKET dos manager multi DEFINES                     (* Copyright (C) 1985 *)

+                                                     (* Frank Klapper      *)

+  provide channel,                                   (* 25.03.86           *)

+  dos manager:

+ 

+LET std archive channel = 31,

+

+    ack              = 0,

+    second phase ack = 5,

+    false code       = 6,

+

+    fetch code       = 11,

+    save code        = 12,

+    exists code      = 13,

+    erase code       = 14,

+    list code        = 15,

+    all code         = 17,

+    clear code       = 18,

+    reserve code     = 19,

+    free code        = 20,

+    check read code  = 22,

+

+    quote            = """";

+

+BOUND STRUCT (TEXT name, pass) VAR msg;

+

+TASK VAR order task;

+

+INT VAR dos channel;

+

+REAL VAR last access time := 0.0;

+

+TASK VAR disk owner := niltask; 

+

+PROC provide channel (INT CONST channel):

+  dos channel := channel

+

+END PROC provide channel;

+

+(*COND FLOPPY

+provide channel (std archive channel);

+ENDCOND*)

+

+(*COND HDU*)

+provide channel (29) 

+(*ENDCOND*)

+

+PROC dos manager:

+  dos manager (dos channel)

+

+END PROC dos manager;

+

+PROC dos manager (INT CONST channel):

+(*COND FLOPPY

+  load shard interface table;

+ENDCOND*)

+  dos channel := channel;

+  task password ("-");

+  global manager

+        (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) 

+

+END PROC dos manager;

+

+PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase,

+                  TASK CONST from task):

+  enable stop;

+  order task := from task;

+  msg := ds;

+  IF NOT (order task = disk owner) AND 

+     order code <> free code AND order code <> reserve code

+    THEN errorstop ("DOS nicht angemeldet")

+  FI;

+  SELECT order code OF 

+    CASE fetch code     : fetch file 

+    CASE save code      : save file

+    CASE erase code     : erase file

+    CASE clear code     : clear disk

+    CASE exists code    : exists file

+    CASE list code      : list disk

+    CASE all code       : deliver directory

+    CASE reserve code   : reserve

+    CASE free code      : free

+    CASE check read code: check

+    OTHERWISE errorstop ("unbekannter Auftrag für Task: " + name (myself))

+  END SELECT.

+

+fetch file:

+  disk fetch (msg.name, ds);

+  manager ok (ds).

+

+check:

+  disk check (msg.name);

+  manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen"). 

+

+save file:

+  IF phase = 1

+    THEN save first phase

+    ELSE save second phase

+  FI.

+

+save first phase:

+  BOOL VAR overwrite question;

+  disk save first phase (msg.name, overwrite question);

+  IF overwrite question

+    THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben")

+    ELSE send (order task, second phase ack, ds)

+  FI.

+

+save second phase:

+  disable stop;

+  disk save second phase (ds);

+  forget (ds) ;

+  ds := nilspace ;

+  enable stop;

+  manager ok (ds).

+

+clear disk: 

+  IF NOT (from task = disk owner)

+    THEN error stop ("DOS nicht angemeldet")

+  FI;

+  IF phase = 1

+    THEN manager question ("Diskette loeschen")

+    ELSE disk clear;

+         manager ok (ds)

+  FI.

+

+erase file:

+  IF disk exists (msg.name)

+    THEN IF phase = 1

+           THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen")

+           ELSE disk erase (msg.name);

+                manager ok (ds)

+         FI

+    ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk")

+  FI.

+ 

+exists file:

+  IF disk exists (msg.name)

+    THEN manager ok (ds)

+    ELSE send (order task, false code, ds)

+  FI.

+

+list disk:

+  disk list (ds);

+  manager ok (ds).

+

+deliver directory:

+  forget (ds);

+  ds := nilspace;

+  BOUND THESAURUS VAR all names := ds;

+  all names := disk all;

+  manager ok (ds).

+

+reserve:

+  IF reserve or free permitted

+    THEN do continue channel;

+         disk owner := from task;

+         disk reserve (msg.name);

+         manager ok (ds)

+    ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt")

+  FI.

+

+do continue channel:

+  IF channel <> dos channel

+    THEN continue channel (dos channel)

+  FI.

+

+reserve or free permitted :

+  from task = disk owner OR last access more than five minutes ago

+  OR disk owner = niltask OR NOT

+  (exists (disk owner) OR station(disk owner) <> station (myself)).

+

+last access more than five minutes ago :

+  abs (last access time - clock (1)) > 300.0.

+

+free: 

+  IF reserve or free permitted

+    THEN disk free;

+         disk owner := niltask;

+         break (quiet);

+         manager ok (ds)

+    ELSE manager message ("DOS nicht angemeldet")

+  FI.

+

+END PROC dos manager;

+

+PROC manager ok (DATASPACE VAR ds):

+  send (order task, ack, ds);

+  last access time := clock (1).

+

+END PROC manager ok;

+

+TEXT PROC expanded name (TEXT CONST name, BOOL CONST status):

+  text (quote + adapted name (name, status) + quote, 14)

+

+END PROC expanded name;

+

+END PACKET dos manager multi;

diff --git a/system/dos/1986/src/name conversion b/system/dos/1986/src/name conversion
new file mode 100644
index 0000000..3cdc202
--- /dev/null
+++ b/system/dos/1986/src/name conversion
@@ -0,0 +1,77 @@
+PACKET name conversion DEFINES                  (* Copyright (C) 1985 *)

+                                                (* Frank Klapper      *)

+  adapted name:                                 (* 20.02.86           *)

+

+LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&@!(){}",

+    lower case chars = "abcdefghijklmnopqrstuvwxyz";

+

+TEXT VAR name pre,

+         name post,

+         new, 

+         char;

+

+INT VAR point pos,

+        count;

+

+TEXT PROC adapted name (TEXT CONST eu name, BOOL CONST read modus):

+  enable stop;

+  point pos := pos (eu name, ".");

+  IF name extension exists

+    THEN changed name with extension

+    ELSE changed name without extension

+  FI.

+

+name extension exists:

+  point pos > 0.

+

+changed name with extension:

+  name pre  := compress (subtext (eu name, 1, point pos - 1));

+  name post := compress (subtext (eu name, point pos + 1));

+  IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3

+    THEN error

+  FI;

+  IF LENGTH name post = 0

+    THEN new name (name pre, read modus)

+    ELSE new name (name pre, read modus) + "."

+       + new name (name post, read modus)

+  FI.

+

+changed name without extension:

+  IF LENGTH eu name > 8 OR LENGTH euname < 1

+    THEN error

+  FI;

+  new name (eu name, read modus).

+

+error:

+  errorstop ("Unzulässiger Name").

+

+END PROC adapted name;

+

+TEXT PROC new name (TEXT CONST old name, BOOL CONST read modus):

+  new := "";

+  FOR count FROM 1 UPTO LENGTH old name REP

+    convert char

+  PER;

+  new.

+

+convert char:

+  char := old name SUB count;

+  IF is lower case char

+    THEN new CAT (upper case chars SUB string pos)

+  ELIF is upper case char OR read modus

+    THEN new CAT char

+  ELSE error stop ("Unzulässiger Name")

+  FI.

+

+is lower case char:

+  pos (lower case chars, char) > 0.

+

+is upper case char:

+  pos (upper case chars, char) > 0. 

+

+string pos:

+  pos (lower case chars, char).

+

+END PROC new name; 

+ 

+END PACKET name conversion;

diff --git a/system/dos/1986/src/open b/system/dos/1986/src/open
new file mode 100644
index 0000000..92e81e9
--- /dev/null
+++ b/system/dos/1986/src/open
@@ -0,0 +1,51 @@
+PACKET open DEFINES                             (* Copyright (C) 1986 *)

+                                                (* Frank Klapper      *)

+  open  action,                                 (* 20.03.86           *)

+  close action,

+  action opened,

+  action closed,

+  init check rerun,

+  check rerun:

+

+BOOL VAR open;

+INT VAR old session;

+

+INITFLAG VAR packet := FALSE;

+

+PROC open action:

+  open := TRUE

+

+END PROC open action;

+

+PROC close action:

+  open := FALSE

+

+END PROC close action;

+

+BOOL PROC action opened:

+  IF NOT initialized (packet)

+    THEN close action

+  FI;

+  open

+

+END PROC action opened;

+

+BOOL PROC action closed:

+  NOT action opened

+

+END PROC action closed;

+

+PROC init check rerun:

+  old session := session

+

+END PROC init check rerun;

+

+PROC check rerun:

+  IF session <> old session

+    THEN close action;

+         error stop ("Diskettenzugriff im RERUN")

+  FI.

+

+END PROC check rerun;

+

+END PACKET open;

diff --git a/system/dos/1986/src/save b/system/dos/1986/src/save
new file mode 100644
index 0000000..903cfaa
--- /dev/null
+++ b/system/dos/1986/src/save
@@ -0,0 +1,273 @@
+PACKET save DEFINES                   (* Copyright (C) 1985 *)

+                                      (* Frank Klapper      *)

+                                      (* 07.05.86           *)

+  save filemode, 

+  save rowtextmode,

+  save dsmode: 

+

+LET       ascii        = 1,

+          ascii german = 2,

+          transparent  = 3,

+          ebcdic       = 4,

+          atari st     = 10;

+

+LET ascii ctrl z = ""26"";

+

+LET row text mode length = 4000;

+

+CLUSTER VAR cluster;

+

+DATASPACE VAR cluster space;

+

+BOUND STRUCT (INT size,

+              ROW row text mode length TEXT cluster row) VAR cluster struct;

+

+REAL VAR storage;

+TEXT VAR cr lf, ff;

+TEXT VAR buffer;

+

+PROC save filemode (DATASPACE CONST file space, 

+                    TEXT CONST name,

+                    INT CONST code type):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enable save filemode (file space, name, code type);

+  buffer := "";

+  forget (cluster space).

+

+END PROC save filemode;

+ 

+PROC enable save filemode (DATASPACE CONST file space, 

+                           TEXT CONST name,

+                           INT CONST code type):

+  enable stop;

+  open save (name);

+  init save filemode;

+  INT VAR line no;

+  FOR line no FROM 1 UPTO lines (file) REP

+    to line (file, line no);

+    buffer cat file line;

+    WHILE LENGTH buffer >= cluster size REP

+      copy buffer to cluster;

+      write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+      remember rest

+    PER

+  PER;

+  cat ctrl z if necessary;

+  write rest;

+  close save (storage).

+

+init save filemode:

+  storage := 0.0;

+  FILE VAR file := sequential file (modify, file space);

+  SELECT code type OF

+    CASE ascii, ascii german, atari st, transparent: cr lf := ""13""10""; ff := ""12""

+    CASE ebcdic: cr lf := ""13"%"; ff := ""12""

+  END SELECT;

+  buffer := "".

+

+buffer cat file line:

+  exec (PROC (TEXT CONST, INT CONST) cat adapted line, file, code type).

+ 

+copy buffer to cluster:

+  write text (cluster, buffer);

+  storage INCR real (min (cluster size, LENGTH buffer)).

+

+remember rest:

+  buffer := subtext (buffer, cluster size + 1).

+

+write rest:

+  WHILE buffer <> ""

+    REP copy buffer to cluster; 

+        write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+        remember rest

+  PER.

+ 

+cat ctrl z if necessary:

+  IF code type <> ebcdic

+    THEN buffer CAT ascii ctrl z

+  FI.

+

+END PROC enable save filemode; 

+ 

+PROC cat adapted line (TEXT VAR line, INT CONST code type):

+  IF subtext (line, 1, 6) = "#page#" 

+      THEN buffer CAT ff;

+           LEAVE cat adapted line

+  FI;

+  SELECT code type OF

+    CASE transparent: (* no operation *)

+    CASE ascii:        change eumel print chars; ascii change

+    CASE ascii german: change eumel print chars; ascii german change

+    CASE atari st:     change eumel print chars; atari st change

+    CASE ebcdic:       change eumel print chars; eumel to ebcdic with substitution (line)

+  END SELECT;

+  buffer CAT line;

+  buffer CAT cr lf.

+

+change eumel print chars:

+  INT VAR char pos := pos (line, ""220"", ""223"", 1);

+  WHILE char pos > 0 REP

+    replace (line, char pos, std char);

+    char pos := pos (line, ""220"", ""223"", char pos + 1)

+  PER.

+

+std char:

+  SELECT code (line SUB char pos) OF

+    CASE 220: "k"

+    CASE 221: "-"

+    CASE 222: "#"

+    CASE 223: " "

+    OTHERWISE ""

+  END SELECT.

+

+ascii change: 

+  change all (line, ""251"", "#251#");

+  char pos := pos (line, "Ä", "ü", 1);

+  WHILE char pos > 0 REP

+    line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);

+    char pos := pos (line, "Ä", "ü", char pos + 1)

+  PER.

+

+ascii german change: 

+  char pos := pos (line, "[", "]", 1);

+  WHILE char pos > 0 REP

+    line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);

+    char pos := pos (line, "[", "]", char pos + 1)

+  PER;

+  char pos := pos (line, "{", "}", 1);

+  WHILE char pos > 0 REP

+    line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1);

+    char pos := pos (line, "{", "}", char pos + 1)

+  PER;

+  change all (line, ""251"", "~");

+  char pos := pos (line, "Ä", "ü", 1);

+  WHILE char pos > 0 REP

+    replace (line, char pos, umlaut in ascii german);

+    char pos := pos (line, "Ä", "ü", char pos + 1)

+  PER.

+

+atari st change: 

+  change all (line, "ß", ""158"");

+  char pos := pos (line, "Ä", "ü", 1);

+  WHILE char pos > 0 REP

+    replace (line, char pos, umlaut in atari st);

+    char pos := pos (line, "Ä", "ü", char pos + 1)

+  PER.

+

+ersatzdarstellung:

+  TEXT VAR char code := text (code  (line SUB char pos));

+  "#" + (3 - LENGTH char code) * "0" + char code + "#".

+

+umlaut in ascii german:

+  SELECT code (line SUB char pos) OF 

+    CASE 214: "["

+    CASE 215: "\"

+    CASE 216: "]"

+    CASE 217: "{"

+    CASE 218: "|"

+    CASE 219: "}"

+    OTHERWISE ""

+  END SELECT.

+

+umlaut in atari st:

+  SELECT code (line SUB char pos) OF 

+    CASE 214: ""142""

+    CASE 215: ""153""

+    CASE 216: ""154""

+    CASE 217: ""132""

+    CASE 218: ""148""

+    CASE 219: ""129""

+    OTHERWISE ""

+  END SELECT.

+

+END PROC cat adapted line;

+

+PROC save rowtextmode (DATASPACE CONST space,

+                       TEXT CONST name):

+  disable stop;

+  cluster space := nilspace;

+  cluster := cluster space;

+  enable save rowtext mode (space, name);

+  forget (cluster space).

+

+END PROC save rowtextmode;

+

+PROC enable save rowtextmode (DATASPACE CONST space,

+                              TEXT CONST name):

+  enable stop;

+  open save (name);

+  init save row textmode;

+  WHILE line no < cluster struct.size REP

+    fill buffer;

+    copy buffer to cluster;

+    write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+    remember rest

+  PER;

+  write rest;

+  close save (storage).

+

+init save rowtextmode:

+  storage := 0.0;

+  cluster struct  := space;

+  INT VAR line no := 0;

+  TEXT VAR buffer := "".

+

+fill buffer:

+  WHILE line no < cluster struct.size AND NOT buffer full REP

+    line no INCR 1;

+    buffer CAT cluster struct.cluster row [line no]

+  PER.

+

+buffer full:

+  LENGTH buffer >= cluster size.

+

+copy buffer to cluster:

+  write text (cluster, buffer);

+  storage INCR real (min (cluster size, LENGTH buffer)).

+

+remember rest:

+  buffer := subtext (buffer, cluster size + 1).

+

+write rest:

+  WHILE buffer <> ""

+    REP copy buffer to cluster; 

+        write disk cluster (cluster space, first non dummy ds page, next save cluster no);

+        remember rest

+  PER.

+

+END PROC enable save rowtextmode;

+ 

+PROC save ds mode (DATASPACE CONST ds,

+                   TEXT CONST name):

+  disable stop;

+  enable save ds mode (ds, name).

+

+END PROC save ds mode;

+

+PROC enable save ds mode (DATASPACE CONST ds,

+                          TEXT CONST name):

+  enable stop;

+  open save (name);

+  INT VAR page no := first non dummy ds page;

+  get last allocated ds page; 

+  WHILE page no <= last allocated ds page REP

+    write disk cluster (ds, page no, next save cluster no);

+    page no INCR sectors per cluster

+  PER;

+  close save (size).

+

+get last allocated ds page:

+  INT VAR last allocated ds page := -1, 

+          i;

+  FOR i FROM 1 UPTO ds pages (ds) REP

+    last allocated ds page := next ds page (ds, last allocated ds page) 

+  PER.

+

+size:

+  real (last allocated ds page - first non dummy ds page + 1) * 512.0.

+

+END PROC enable save ds mode;

+

+END PACKET save;

diff --git a/system/dos/1986/src/shard interface b/system/dos/1986/src/shard interface
new file mode 100644
index 0000000..c7fdac5
--- /dev/null
+++ b/system/dos/1986/src/shard interface
@@ -0,0 +1,19 @@
+; ';' in Spalte 1 kennzeichnet eine Kommentarzeile

+; alle Werte müssen durch Blanks getrennt werden

+;

+;heads: Anzahl der Köpfe, positiv für cylinderorientiertes Lesen

+;                         negativ für seitenorientiertes Lesen

+;

+;size     heads   tracks    first sectors  last sector

+;=====================================================

+320        1       40         1              8

+360        1       40         1              9

+640       -2       40         1              8

+720       -2       40         1              9

+800        2       40         1             10

+1440      -2       80         1              9

+1600       2       80         1             10

+2400      -2       80         1             15

+1232       1       77         0             15

+2464      -2       77         0             15

+; END OF FILE

diff --git a/system/dos/1986/src/table thes.dos b/system/dos/1986/src/table thes.dos
new file mode 100644
index 0000000..8b254cf
--- /dev/null
+++ b/system/dos/1986/src/table thes.dos
@@ -0,0 +1,5 @@
+shard interface

+252

+253

+254

+255

diff --git a/system/eumel-coder/1.8.0/src/eumel coder 1.8.0 b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0
new file mode 100644
index 0000000..d9f489f
--- /dev/null
+++ b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0
@@ -0,0 +1,2594 @@
+PACKET eumel coder                                 (* Autor: U. Bartling *) 

+       DEFINES coder on, coder off,

+               declare, define, apply, identify,

+               :=, =,

+               dump,

+ 

+               LABEL,

+               gosub, goret,

+               complement condition code,

+

+               ADDRESS ,

+               GLOB, LOC, REF, DEREF,

+               ref length,

+               +, 

+               adjust,

+               is global, is local, is ref,

+ 

+               DTYPE, 

+               type class, type name,

+               void type, int type, real type, text type, bool type, 

+               dataspace type, undefined type, 

+               row type, struct type, proc type, end type,

+ 

+               OPN, 

+               set length of local storage, 

+               begin module, end module, 

+               is proc, is eumel 0 instruction,

+               address, operation,

+               nop, 

+               init op codes,

+               mnemonic, 

+

+               parameter,

+               next param,

+               NEXTPARAM, 

+               access , 

+               dtype , 

+               param address,

+               same type ,

+ 

+               reserve storage, 

+               allocate denoter , 

+               allocate variable, 

+               data allocation by coder ,

+               data allocation by user,

+ 

+               run, run again, 

+               insert,

+               prot, prot off,

+               check, check on, check off,

+

+               help, bulletin, packets :

+

+(**************************************************************************)

+(*                                                                        *) 

+(*                         E U M E L  -  C O D E R                        *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(*   Zur Beschreibung des Coders siehe                                    *) 

+(*         U.Bartling, J. Liedtke: EUMEL-Coder-Interface                  *) 

+(*                                                                        *) 

+(*   Stand der Dokumentation  : 13.02.1986                                *) 

+(*   Stand der Implementation : 21.03.1986                                *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+                   (***** Globale Variable *****) 

+

+TEXT VAR object name;

+ 

+FILE VAR bulletin file; 

+ 

+INT VAR memory management mode, global address offset, hash table pointer,

+        nt link, permanent pointer, param link, index, mode, field pointer,

+        word, number of errors := 0 ;

+ 

+BOOL VAR found, end of params;

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  1. Interface zum ELAN-Compiler            12.03.1986  *) 

+(*                              1.7.5.4                                   *)

+(*                                                                        *) 

+(*   Beschreibung der      Tabellen (-groessen),                          *) 

+(*                         internen Vercodung von Typen                   *) 

+(*                    und  Kennungen .                                    *) 

+(*   Initialisieren und Beenden des Compilers,                            *) 

+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+LET  begin of hash table         =     0 ,

+     end of hash table           =  1023 ,

+ 

+     begin of permanent table    = 22784 ,

+       before first pt entry     = 22784 ,

+       first permanent entry     = 22785 ,

+     end of permanent table      = 32767 , 

+

+     wordlength                  =     1 ,  (* compile  u n d  run time *)

+     two word length             =     2 ,

+     three word length           =     3 ,

+     four word length            =     4 ,

+ 

+     permanent param const             = 10000 ,

+     permanent param var               = 20000 ,

+     permanent proc op                 = 30000 ,

+     permanent type                    = 30000 ,

+     permanent row                     =    10 ,

+     permanent struct                  =    11 ,

+     permanent param proc              =    12 ,

+(*   permanent param proc end marker   =     0 , *)

+     permanent type field              =     0 ,

+

+     ptt limit                         = 10000 ,

+     begin of pt minus ptt limit       = 12784 ,

+     offset to row size                = 12785 ,

+ 

+     void                              =     0 ,

+     int                               =     1 ,

+     real                              =     2 ,

+     string                            =     3 ,

+     bool                              =     5 ,

+     bool result                       =     6 ,

+     dataspace                         =     7 ,

+     undefined                         =     9 ,

+     row                               =    10 ,

+     struct                            =    11 ,

+     end                               =     0 ,

+

+     const                             =     1 , 

+     var                               =     2 ,

+(*   proc                              =     3 , *)

+(*   denoter                           =     5 , *)

+     bold                              =     2 ,

+ 

+     ins                               = TRUE ,

+     no ins                            = FALSE ,

+     no lst                            = FALSE ,

+     sermon                            = TRUE  ,

+     no sermon                         = FALSE ,

+ 

+     run again mode                    =     0 ,

+     compile file mode                 =     1 ,

+     prep coder mode                   =     5 , 

+

+     warning message                   =     2 , 

+     error message                     =     4 ,

+ 

+     point line                        = "..............." ;

+ 

+INT CONST permanent packet            :=     -2 ,

+          permanent end               :=     -3 ;

+

+BOOL VAR coder active                 := FALSE ; 

+

+INT  VAR run again mod nr             :=     0 ;

+ 

+ 

+                     (***** Start/Ende *****)

+ 

+LET invalid coder off = "CODER not active" ;

+

+PROC coder on (INT CONST data allocation mode) : 

+    mark coder on ; 

+    init memory management ; 

+    init opn section ; 

+    init compiler .

+ 

+mark coder on :

+    coder active := TRUE .

+

+init memory management :

+    memory management mode := data allocation mode ;

+    prep pbase (global address offset) .

+ 

+init compiler :

+    no do again ;

+    elan (prep coder mode, bulletin file, "", run again mod nr,

+          no ins, no lst, check option, no sermon)

+

+ENDPROC coder on;

+ 

+PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) :

+    IF coder active 

+       THEN mark coder off ; 

+            end coder (insert, sermon, start mod nr if no insert)

+       ELSE errorstop (invalid coder off)

+    FI .

+ 

+start mod nr if no insert :

+    IF insert THEN run again mod nr := 0

+              ELSE run again mod nr := start proc.mod nr

+    FI ;

+    run again mod nr .

+

+mark coder off :

+    reset memory management mode ;

+    init opn section ;

+    coder active := FALSE

+ENDPROC coder off ; 

+ 

+PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) :

+    EXTERNAL 10021

+ENDPROC end coder ; 

+

+PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, 

+           INT VAR start module number, BOOL CONST ins, lst, rtc, ser) :

+  EXTERNAL 256

+ENDPROC elan ;

+ 

+                   (***** Hash/Namenstabelle *****) 

+.

+next hash entry :

+     hash table pointer INCR wordlength .

+

+end of hash table reached :

+     hash table pointer > end of hash table .

+

+yet another nt entry :

+     nt link := cdb int (nt link) ;

+     nt link <> 0 . ;

+ 

+PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : 

+    EXTERNAL 10031

+ENDPROC declare object ; 

+ 

+PROC to object (TEXT CONST searched object) : 

+     hash ;

+     search nt entry .

+

+hash :

+     hash code := 0 ;

+     FOR index FROM 1 UPTO LENGTH searched object REP

+         addmult cyclic

+     ENDREP .

+

+addmult cyclic :

+     hash code INCR hash code ;

+     IF hash code > end of hash table THEN wrap around FI ;

+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .

+

+wrap around :

+     hash code DECR end of hash table .

+

+hash code : nt link .

+

+search nt entry :

+     found := FALSE ;

+     WHILE yet another nt entry REP

+          read current entry ;

+          IF object name = searched object 

+             THEN found := TRUE ;

+                  LEAVE to object

+          FI

+     PER .

+

+read current entry :

+     permanent pointer := cdb int (nt link + wordlength) ;

+     object name := cdb text (nt link + two word length)

+ENDPROC to object ;

+

+

+                 (***** Permanent Tabelle *****) 

+.

+next procedure :

+     permanent pointer := cdb int (permanent pointer) . ;

+

+PROC next pt param :

+     mode := cdb int (param link) MOD ptt limit ;

+     param link INCR wordlength ;

+     IF   mode = permanent row    THEN skip over permanent row 

+     ELIF mode = permanent struct THEN skip over permanent struct

+     FI ;

+     set end marker if end of list .

+

+skip over permanent row :

+     param link INCR wordlength ;

+     next pt param .

+

+skip over permanent struct :

+     REP

+         next pt param ;

+         mode := cdb int (param link)

+     UNTIL mode = permanent type field PER ;

+     param link INCR wordlength

+ENDPROC next pt param ;

+

+PROC set end marker if end of list :

+     mode := cdb int (param link) ;

+     end of params := mode >= permanent proc op OR mode <= 0 

+ENDPROC set end marker if end of list ;

+

+PROC get type and mode (INT VAR type) : 

+     mode := cdb int (param link) ;

+     IF mode = permanent param proc THEN type of param proc

+                                    ELSE type of object

+     FI .

+

+type of param proc : 

+     param link INCR wordlength ;

+     get type and mode (type) ;

+     mode := permanent param proc .

+

+type of object :

+     IF mode < 0 THEN type := 2769 + (32767 + mode) ;

+                      mode := 0

+                 ELSE type := mode MOD ptt limit ;

+                      mode DECR type ;

+                      translate type if necessary ;

+                      translate mode if necessary 

+     FI .

+

+translate type if necessary :

+     IF permanent row or struct THEN translate type FI .

+

+translate type :

+     type := param link - begin of pt minus ptt limit .

+

+translate mode if necessary : 

+    IF   mode = permanent param const THEN mode := const

+    ELIF mode = permanent param var   THEN mode := var

+    FI .

+

+permanent row or struct :

+     type = permanent row OR type = permanent struct

+ENDPROC get type and mode ;

+ 

+

+                 (***** Allgemeine Zugriffsprozeduren *****) 

+

+INT PROC cdb int (INT CONST index) :

+   EXTERNAL 116

+ENDPROC cdb int ;

+

+TEXT PROC cdb text (INT CONST index) :

+   EXTERNAL 117

+ENDPROC cdb text ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  2. Spruenge und Marken                    07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps LABEL                                       *) 

+(*                                                                        *) 

+(*   Deklaration, Definition und Applikation von Marken                   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE LABEL = INT ; 

+

+BOOL VAR invers :: FALSE ; 

+ 

+PROC declare (LABEL VAR label) : 

+    CONCR (label) := 0

+ENDPROC declare ; 

+ 

+PROC define (LABEL VAR label) : 

+    EXTERNAL 10084

+ENDPROC define ; 

+ 

+PROC complement condition code : 

+    invers := TRUE

+ENDPROC complement condition code ; 

+ 

+PROC apply (LABEL VAR label) : 

+    EXTERNAL 10149 

+ENDPROC apply ; 

+ 

+PROC apply (LABEL VAR label, BOOL CONST condition) : 

+    IF condition xor invers THEN branch true (label) 

+                            ELSE branch false (label)

+    FI ;

+    invers := FALSE .

+

+condition xor invers : 

+    IF condition THEN NOT invers

+                 ELSE invers

+    FI

+ENDPROC apply ; 

+ 

+OP := (LABEL VAR global label, local label) : (* EQUATE ! *)

+    EXTERNAL 10014 

+ENDOP := ; 

+ 

+TEXT PROC dump (LABEL CONST label) : 

+    "LAB " + text (CONCR (label)) 

+ENDPROC dump ; 

+ 

+PROC gosub (LABEL VAR label) : 

+    EXTERNAL 10015 

+ENDPROC gosub ; 

+ 

+PROC goret : 

+    s0 (q goret code) 

+ENDPROC goret ; 

+ 

+PROC branch true (LABEL VAR label) : 

+    EXTERNAL 10028

+ENDPROC branch true ; 

+ 

+PROC branch false (LABEL VAR label) : 

+    EXTERNAL 10029

+ENDPROC branch false ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  3. Datenaddressen                         21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps ADDRESS                                     *) 

+(*                                                                        *) 

+(*   Aufbau von Datenaddressen (Vercodung)                                *) 

+(*   Fortschalten und Ausrichten von Adressen                             *) 

+(*   Bereitstellen der Fehlermeldung "address overflow" (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+TYPE ADDRESS = STRUCT (INT kind, value) ; 

+ 

+LET global                 = 0 , 

+    local                  = 1 , 

+    ref mask               = 2 , 

+    global ref             = 2 , 

+    local ref              = 3 , 

+    module nr              = 4 ,

+    immediate value        = 5 ,

+ 

+    eumel0 stack offset    = 4 ,

+    local address limit    = 16 384 ,

+ 

+    illegal ref operation  = "REF not allowed" , 

+    deref on non ref       = "DEREF on non-ref address" ,

+    global ref not allowed = "GLOBAL REF not allowed" , 

+    unknown kind           = "Unknown address kind" , 

+    address overflow       = "Address Overflow" , 

+    illegal plus operation = "+ not allowed" ;

+ 

+ADDRESS VAR result addr;

+ 

+INT CONST ref length :: 2 ;

+

+OP := (ADDRESS VAR l, ADDRESS CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+ADDRESS OP GLOB (INT CONST address level) : 

+    result addr.kind  := global ; 

+    result addr.value := address level ; 

+    IF memory management mode = data allocation by user

+       THEN result addr.value INCR global address offset

+    FI ;

+    result addr

+ENDOP GLOB ;

+

+ADDRESS OP LOC (INT CONST address level) : 

+    result addr.kind  := local ;

+    result addr.value := address level + eumel0 stack offset ; 

+    result addr

+ENDOP LOC ; 

+ 

+ADDRESS OP REF (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    IF   result addr.kind = local  THEN result addr.kind INCR ref mask

+    ELIF result addr.kind = global THEN errorstop (global ref not allowed)

+                                   ELSE errorstop (illegal ref operation)

+    FI ;

+    result addr 

+ENDOP REF ; 

+ 

+ADDRESS OP DEREF (ADDRESS CONST ref address) : 

+    CONCR (result addr) := CONCR (ref address) ;

+    IF is not local ref THEN errorstop (deref on non ref) FI ; 

+    result addr.kind DECR ref mask ; 

+    result addr .

+ 

+is not local ref :

+    result addr.kind <> local ref

+ENDOP DEREF ;

+ 

+INT OP REPR (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    SELECT result addr.kind OF 

+        CASE global     :

+        CASE local      : set bit (result addr.value, 15) 

+        CASE global ref : errorstop (global ref not allowed)

+        CASE local ref  : prep local ref 

+        OTHERWISE errorstop (unknown kind)

+    ENDSELECT ; 

+    result addr.value .

+ 

+prep local ref : 

+    IF address limit exceeded THEN errorstop (address overflow) FI ;

+    set bit (result addr.value, 14) ; 

+    set bit (result addr.value, 15) .

+

+address limit exceeded :

+    result addr.value < eumel0 stack offset OR

+    result addr.value > local address limit

+ENDOP REPR ; 

+ 

+BOOL PROC is ref (ADDRESS CONST addr) : 

+    addr.kind = local ref

+ENDPROC is ref ; 

+ 

+BOOL PROC is global (ADDRESS CONST addr) : 

+    addr.kind = global 

+ENDPROC is global ; 

+ 

+BOOL PROC is local (ADDRESS CONST addr) : 

+    addr.kind = local 

+ENDPROC is local ; 

+ 

+ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : 

+    CONCR (result addr) := CONCR (addr) ; 

+    SELECT result addr.kind OF 

+        CASE global : inc global

+        CASE local  : inc local

+        OTHERWISE     errorstop (illegal plus operation) 

+    ENDSELECT ; 

+    result addr .

+ 

+inc global : 

+    result addr.value INCR offset ; 

+    IF result addr.value < 0 THEN errorstop (address overflow) FI .

+ 

+inc local : 

+    result addr.value INCR offset ; 

+    IF result addr.value < eumel 0 stack offset OR

+       result addr.value > local address limit

+       THEN errorstop (address overflow)

+    FI

+ENDOP + ; 

+ 

+PROC adjust (ADDRESS VAR addr, INT CONST adjust length) :

+    IF is local or global THEN adjust to length FI . 

+ 

+is local or global :

+    addr.kind <= local .

+

+adjust to length :

+    mode := addr.value MOD adjust length ;

+    IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI

+ENDPROC adjust ;

+

+TEXT PROC dump (ADDRESS CONST addr) : 

+    kind + text (addr.value) . 

+ 

+kind : 

+    SELECT addr.kind OF 

+        CASE global          : "GLOBAL " 

+        CASE local           : "LOCAL " 

+        CASE immediate value : "IMMEDIATE "

+        CASE module nr       : "PARAM PROC "

+        CASE global ref      : "GLOBAL REF " 

+        CASE local ref       : "LOCAL REF " 

+        OTHERWISE "undef. Addr:" 

+    ENDSELECT 

+ENDPROC dump; 

+

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  4. Datentypen   Teil I                    03.12.1985  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps DTYPE                                       *) 

+(*                                                                        *) 

+(*   Interne Repraesentation der primitiven Datentypen                    *) 

+(*   Identifikation von DTYPEs                                            *)

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+TYPE DTYPE = INT ; 

+ 

+OP := (DTYPE VAR l, DTYPE CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+BOOL OP = (DTYPE CONST l, r) : 

+    CONCR (l) = CONCR (r)

+ENDOP = ; 

+ 

+DTYPE PROC void type :      DTYPE :(void)      ENDPROC  void type ; 

+ 

+DTYPE PROC int  type :      DTYPE :(int )      ENDPROC  int type ; 

+ 

+DTYPE PROC real type :      DTYPE :(real)      ENDPROC  real type ; 

+ 

+DTYPE PROC text type :      DTYPE :(string)    ENDPROC  text type ; 

+ 

+DTYPE PROC bool type :      DTYPE :(bool)      ENDPROC  bool type ; 

+ 

+DTYPE PROC dataspace type : DTYPE :(dataspace) ENDPROC dataspace type ; 

+ 

+DTYPE PROC undefined type : DTYPE :(undefined) ENDPROC undefined type ; 

+ 

+DTYPE PROC row type  :      DTYPE :(row)       ENDPROC row type ; 

+ 

+DTYPE PROC struct type :    DTYPE :(struct)    ENDPROC struct type ; 

+ 

+DTYPE PROC proc type :   DTYPE :(permanent param proc) ENDPROC proc type ; 

+ 

+DTYPE PROC end type  :      DTYPE :(end)       ENDPROC end type ; 

+ 

+INT PROC type class (DTYPE CONST type) : 

+    SELECT type id OF 

+        CASE int, real, bool, string, dataspace, undefined : 1 

+        CASE void   : 0 

+        CASE row    : 3 

+        CASE struct : 4 

+        CASE permanent param  proc : 5 

+        OTHERWISE     pt type 

+    ENDSELECT . 

+

+pt type :

+    IF type id > ptt limit THEN permanent row or struct

+                           ELSE abstract type

+    FI .

+

+abstract type : 2 .

+

+permanent row or struct :

+    mode := cdbint (type link into pt) MOD ptt limit ; 

+    IF   mode = struct THEN 4

+    ELIF mode = row    THEN 3

+                       ELSE 2

+    FI .

+ 

+type link into pt :

+    type id + begin of pt minus ptt limit .

+

+type id : CONCR (type)

+ENDPROC type class ; 

+ 

+PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : 

+    SELECT type pos OF 

+          CASE 1   : size := 0; align := 0; type id := void 

+          CASE 6   : size := 1; align := 1; type id := int 

+          CASE 10  : size := 4; align := 4; type id := real 

+          CASE 15  : size := 8; align := 4; type id := string

+          CASE 20  : size := 1; align := 1; type id := bool 

+          CASE 25  : size := 1; align := 1; type id := dataspace

+          OTHERWISE  search for type in permanent table 

+    ENDSELECT . 

+ 

+type pos : 

+    enclose in delimiters ;

+    pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . 

+ 

+enclose in delimiters :

+    object name := "." ;

+    object name CAT name ;

+    object name CAT "." .

+

+search for type in permanent table : 

+    to object (name) ;

+    IF NOT found THEN size := 0; align := 0; type id := undefined 

+                 ELSE size := cdbint (permanent pointer + two wordlength) ;

+                      type id := permanent pointer - begin of permanent table ;

+                      IF   size < two wordlength  THEN align := 1

+                      ELIF size < four wordlength THEN align := 2

+                                                  ELSE align := 4

+                      FI

+    FI . 

+ 

+type id : CONCR (type)

+ENDPROC identify ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  5. Operationen  Teil I                    21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps OPN                                         *) 

+(*   Primitive Operationen (:=  etc.)                                     *) 

+(*   Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ;

+ 

+LET proc op    = 0 ,

+    param proc = 1 ,

+    eumel 0    = 2 , 

+    nil        = 3 , 

+ 

+    param proc at non ref = "PARAM PROC at non-ref address" ,

+    proc op expected      = "PROC expected" ;

+ 

+OPN VAR eumel0 opn;

+eumel0 opn.kind := eumel0 ;

+eumel0 opn.top of stack := 0 ;

+

+eumel0 opn.mod nr := q pp ;

+OPN CONST pp       :: eumel0 opn ,

+          nop code :: OPN :(nil, 0, 0) ;

+

+THESAURUS VAR eumel 0 opcodes :: empty thesaurus ; 

+ 

+PROC init op codes (FILE VAR eumelcodes) : 

+    eumel 0 opcodes := empty thesaurus ;

+    WHILE NOT eof (eumelcodes) REP

+       getline (eumelcodes, object name) ;

+       delete trailing blanks ;

+       IF object name <> "" CAND NOT (eumel 0 opcodes CONTAINS object name)

+          THEN insert (eumel 0 opcodes, object name)

+       FI

+    PER .

+

+delete trailing blanks :

+    WHILE (object name SUB LENGTH object name) = " " REP

+       object name := subtext (object name, 1, LENGTH object name - 1)

+    PER

+ENDPROC init op codes ; 

+

+ADDRESS PROC address (OPN CONST opn) :

+    IF opn.kind <> proc op THEN errorstop (proc op expected) FI ;

+    result addr.kind  := module nr ; 

+    result addr.value := opn.mod nr ;

+    result addr

+ENDPROC address ;

+ 

+OPN PROC operation (ADDRESS CONST addr) : 

+    IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; 

+    OPN VAR opn ;

+    opn.kind := param proc ; 

+    opn.mod nr :=addr.value ; 

+    opn.top of stack := 0 ; 

+    opn 

+ENDPROC operation ; 

+ 

+TEXT PROC mnemonic (OPN CONST op code) : 

+    name (eumel 0 opcodes, op code.mod nr)

+ENDPROC mnemonic ;

+ 

+OPN PROC nop : 

+    nop code

+ENDPROC nop ; 

+ 

+OP := (OPN VAR r, OPN CONST l) : 

+    CONCR (r) := CONCR (l) 

+ENDOP := ; 

+ 

+BOOL PROC is proc (OPN CONST operation) : 

+    operation.kind = proc op

+ENDPROC is proc ; 

+ 

+BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : 

+    link (eumel 0 opcodes, op code name) <> 0

+ENDPROC is eumel 0 instruction ; 

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  6. Parameterfeld                          10.01.1986  *) 

+(*                                                                        *) 

+(*   Bereitstellen des Parameterfeldes                                    *) 

+(*   Schreiben und Lesen von Eintraegen im Parameterfeld                  *) 

+(*   Fortschalten von Zeigern in das Parameterfeld                        *) 

+(*   Bereitstellen der Konstanten 'size of param field' (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+LET PARAMDESCRIPTOR = STRUCT (DTYPE type,   INT access, 

+                              ADDRESS addr, OPN push opn) , 

+ 

+    size of param field   = 100 ,

+    param field exceeded  = "Param Field Overflow",

+    param nr out of range = "Illegal Param Number" ;

+ 

+ROW size of param field PARAMDESCRIPTOR VAR param field ;

+ 

+ 

+                      (***** Schreiben *****) 

+ 

+PROC test param pos (INT CONST param nr) : 

+    IF param nr < 1 OR param nr > size of param field

+       THEN errorstop (param nr out of range)

+    FI 

+ENDPROC test param pos ; 

+ 

+PROC declare (INT CONST param nr, DTYPE CONST type) : 

+    test param pos (param nr) ; 

+    enter type . 

+ 

+enter type :

+    CONCR (param field [param nr].type) := CONCR (type) 

+ENDPROC declare ; 

+ 

+PROC declare (INT CONST param nr, access) : 

+    test param pos (param nr) ; 

+    enter access . 

+

+enter access :

+    param field [param nr].access := access 

+ENDPROC declare ; 

+ 

+PROC define (INT CONST param nr, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter address . 

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) 

+ENDPROC define ; 

+ 

+PROC define (INT CONST param nr, value) : 

+    result addr.kind  := immediate value ;

+    result addr.value := value ;

+    define (param nr, result addr) 

+ENDPROC define ; 

+ 

+PROC apply (INT CONST param nr, OPN CONST opn) : 

+    test param pos (param nr) ; 

+    enter push opn . 

+ 

+enter push opn : 

+    CONCR (param field [param nr].push opn) := CONCR (opn) 

+ENDPROC apply ; 

+ 

+PROC parameter (INT CONST param nr, DTYPE CONST type, 

+                INT CONST access, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter type ; 

+    enter access ; 

+    enter address ; 

+    enter pp as default . 

+ 

+enter type : 

+    CONCR (param field [param nr].type) := CONCR (type) .

+

+enter access :

+    param field [param nr].access := access .

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) .

+

+enter pp as default :

+    CONCR (param field [param nr].push opn) := CONCR (pp) 

+ENDPROC parameter ; 

+ 

+ 

+                       (***** Lesen *****) 

+ 

+ADDRESS PROC param address (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].addr 

+ENDPROC param address ; 

+ 

+DTYPE PROC dtype (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].type 

+ENDPROC dtype ; 

+ 

+INT PROC access (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].access 

+ENDPROC access ; 

+ 

+ 

+                      (***** Fortschalten *****) 

+ 

+OP NEXTPARAM (INT VAR param nr) : 

+   test param pos (param nr) ; 

+   IF long entry THEN read until end FI ; 

+   param nr INCR 1 .

+ 

+long entry : 

+    type class (param field [param nr].type) > 2 . 

+ 

+read until end : 

+    REP 

+        param nr INCR 1 ; 

+        NEXTPARAM param nr 

+    UNTIL end marker read or end of field PER . 

+ 

+end marker read or end of field :

+    param nr > size of param field OR

+    CONCR (param field [param nr].type) = end 

+ENDOP NEXTPARAM ; 

+ 

+INT PROC next param (INT CONST p) : 

+    index := p ; 

+    NEXTPARAM index ; 

+    index

+ENDPROC next param ; 

+ 

+TEXT PROC dump (INT CONST p) : 

+   IF p > 0 AND p <= 100 THEN dump entry (param field (p)) 

+                         ELSE param nr out of range 

+    FI 

+ENDPROC dump ; 

+ 

+TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : 

+    object name := dump (id.type) ; 

+    object name CAT text (id.access) ; 

+    object name CAT dump (id.addr) ; 

+    object name CAT dump (id.push opn) ;

+    object name

+ENDPROC dump entry ; 

+

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  7. Datentypen   Teil II                   20.01.1986  *) 

+(*                                                                        *) 

+(*   Deklaration neuer Datentypen                                         *) 

+(*   Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+DTYPE VAR pt type ;

+

+PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : 

+    entry into name table ; 

+    put next permanent (permanent type) ; 

+    put next permanent (size) ; 

+    put next permanent (nt link) ;

+    mark no offsets of text elements . 

+ 

+entry into name table : 

+    declare object (name, nt link, CONCR (type)) . 

+ 

+mark no offsets of text elements : 

+    put next permanent (0) 

+ENDPROC declare ; 

+ 

+BOOL PROC same type (INT CONST param 1, param 2) : 

+    INT CONST left type :: CONCR (param field [param 1].type) ;

+    IF left type = right type

+       THEN same fine structure if there is one

+       ELSE left type = undefined OR right type = undefined

+    FI .

+ 

+right type : CONCR (param field [param 2].type) . 

+ 

+same fine structure if there is one : 

+    IF   left type = row    THEN compare row 

+    ELIF left type = struct THEN compare struct 

+                            ELSE TRUE 

+    FI . 

+ 

+compare row : 

+    equal sizes AND same type (param1 + 1, param2 + 1) . 

+ 

+equal sizes : 

+    param field [param1+1].access = param field [param2+1].access .

+ 

+compare struct : 

+    INT VAR p1 :: param1+1, p2 :: param2+1 ; 

+    REP 

+       IF   NOT same type (p1, p2) THEN LEAVE same type WITH FALSE 

+       ELIF end type found         THEN LEAVE same type WITH TRUE

+       FI ;

+       NEXTPARAM p1 ;

+       NEXTPARAM p2

+    UNTIL end of field PER ;

+    FALSE .

+

+end type found :

+    CONCR (param field [p1].type) = end .

+

+end of field : 

+    p1 > size of param field OR p2 > size of param field 

+ENDPROC same type ;

+ 

+BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : 

+    field pointer := param nr ;

+    CONCR (pt type) := CONCR (type) ;

+    equal types 

+ENDPROC same type ;

+

+BOOL PROC equal types : 

+    identical types OR one type is undefined .

+

+one type is undefined :

+    type of actual field = undefined OR CONCR(pt type) = undefined .

+

+identical types :

+    SELECT type class (pt type) OF 

+        CASE 0, 1, 2 : type of actual field = CONCR (pt type)

+        CASE 3       : perhaps equal rows

+        CASE 4       : perhaps equal structs

+        OTHERWISE      FALSE

+    ENDSELECT .

+

+perhaps equal rows :

+    is row AND equal row sizes AND equal row types . 

+ 

+is row :

+    type of actual field = row .

+

+perhaps equal structs : 

+    is struct AND same type fields . 

+ 

+is struct :

+    type of actual field = struct .

+

+equal row sizes :

+    pt row size = row size within param field . 

+

+equal row types :

+    same type (field pointer + 1, pt row type) .

+

+pt row size :

+    cdb int (CONCR(pt type) + offset to row size) .

+

+pt row type :

+    CONCR (pt type) INCR 2 ;

+    pt type .

+

+row size within param field :

+    param field [field pointer].access .

+ 

+same type fields :

+    field pointer INCR 1 ;

+    CONCR (pt type) INCR 1 ;

+    REP

+        IF NOT equal types THEN LEAVE same type fields WITH FALSE FI ;

+        IF type of actual field = end 

+             THEN LEAVE same type fields WITH TRUE 

+        FI ; 

+        NEXTPARAM field pointer

+    UNTIL end of field PER ;

+    FALSE .

+

+end of field :

+    field pointer > size of param field .

+

+type of actual field :

+    CONCR (param field [field pointer].type) .

+ENDPROC equal types ;

+

+BOOL PROC is not void bool or undefined (DTYPE CONST dtype) :

+    type <> void AND type <> bool AND type <> undefined .

+

+type : CONCR (dtype)

+ENDPROC is not void bool or undefined ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  8. Operationen  Teil II                   07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition der Opcodes                                               *) 

+(*   Deklaration, Definition, Identifikation und Applikation              *) 

+(*   Eroeffnen und Schliessen eines Moduls                                *)

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+LET module not opened  = "Module not opened" , 

+    define missing     = "DEFINE missing" ,

+    wrong nr of params = "Wrong Nr. of Params:" , 

+    illegal kind       = "Opcode expected" ,

+    nested module      = "Nested Modules" ,

+    no mod nr          = "Param Proc expected" ,

+    no immediate value = "Value expected" ,

+    type error         = "Type Error" ,

+ 

+    q ln              =  1 ,

+    q move            =  2 ,    q move code             =  2 048 ,

+    q inc1            =  3 ,    q inc1 code             =  3 072 ,

+    q dec1            =  4 ,    q dec1 code             =  4 096 ,

+    q inc             =  5 ,    q inc code              =  5 120 ,

+    q dec             =  6 ,    q dec code              =  6 144 ,

+    q add             =  7 ,    q add code              =  7 168 ,

+    q sub             =  8 ,    q sub code              =  8 192 ,

+    q clear           =  9 ,    q clear code            =  9 216 ,

+    q test            = 10 , 

+    q equ             = 11 ,    q equ code              = 11 264 , 

+    q lsequ           = 12 ,    q lsequ code            = 12 288 , 

+    q fmove           = 13 ,    q fmove code            = 13 312 , 

+    q fadd            = 14 ,    q fadd code             = 14 336 , 

+    q fsub            = 15 ,    q fsub code             = 15 360 , 

+    q fmult           = 16 ,    q fmult code            = 16 384 , 

+    q fdiv            = 17 ,    q fdiv code             = 17 408 ,

+    q flsequ          = 18 ,    q flsequ code           = 18 432 ,

+    q tmove           = 19 ,    q tmove code            = 19 456 ,

+    q tequ            = 20 ,    q tequ code             = 20 480 , 

+    q accds           = 21 ,    q access ds code        = 22 528 , 

+    q ref             = 22 ,    q ref code              = 23 552 ,

+    q subscript       = 23 ,    q subscript code        = 24 576 , 

+    q select          = 24 ,    q select code           = 25 600 ,

+    q ppv             = 25 , 

+    q pp              = 26 , 

+    q make false      = 27 , (* q make false code       = 65 513 *)

+    q movex           = 28 ,

+(*  q longa subs                q longa subs code       = 65 376 *) 

+    q return          = 29 ,    q return code           = 32 512 ,

+    q true return     = 30 ,    q true return code      = 32 513 ,

+    q false return    = 31 ,    q false return code     = 32 514 ,

+                                q goret code            = 32 519 ,

+    q esc mult        = 32 ,    q esc mult code         = 32 553 ,

+    q esc div         = 33 ,    q esc div code          = 32 554 , 

+    q esc mod         = 34 ,    q esc mod code          = 32 555 , 

+    q pproc           = 35 , 

+    q compl int       = 36 ,    q compl int code        = 32 551 ,

+    q compl real      = 37 ,    q compl real code       = 32 550 ,

+(*  q alias ds        = 38 , *) 

+    q movim           = 39 ,    q esc movim code        = 32 547 ,

+    q fequ            = 40 ,    q fequ code             = 32 548 ,

+    q tlsequ          = 41 ,    q tlsequ code           = 32 549 ,

+(*  q case            = 42 , *)

+    q plus            = 43 ,

+    q minus           = 44 ,

+    q mult            = 45 ,

+    q int div         = 46 ,

+    q real div        = 47 ,

+    q equal           = 48 ,

+    q lessequal       = 49 ;

+ 

+INT CONST q make false code :: - 1 022 , 

+          q longa subs code :: -   159 ;

+ 

+

+                   (***** Deklaration *****) 

+ 

+PROC declare (OPN VAR operation) : 

+    operation.kind := proc op ;

+    get module nr (operation.mod nr) ; 

+    operation.top of stack := 0 

+ENDPROC declare ; 

+ 

+PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : 

+    declare (operation) ;

+    entry into name and pt table if necessary ; 

+    enter params ; 

+    enter result ; 

+    enter module number . 

+ 

+entry into name and pt table if necessary : 

+    declare object (name, nt link, permanent pointer) . 

+ 

+enter params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO params REP

+       enter param (param field [field pointer]) ;

+       NEXTPARAM field pointer 

+    PER .

+ 

+enter result : 

+    enter param (param field[field pointer].type, permanent proc op) .

+ 

+enter module number : 

+    put next permanent (operation.mod nr)

+ENDPROC declare ; 

+ 

+PROC enter param (PARAMDESCRIPTOR CONST param) :

+    IF   param.access = const 

+         THEN enter param (param.type, permanent param const)

+    ELIF param.access = var 

+         THEN enter param (param.type, permanent param var)

+    ELSE errorstop ("Unknown Access")

+    FI

+ENDPROC enter param ;

+

+PROC enter param (DTYPE CONST type, INT CONST permanent mode) :

+    SELECT type class (type) OF

+        CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode)

+        OTHERWISE      errorstop ("Illegal Type")

+    ENDSELECT

+ENDPROC enter param ;

+

+

+                    (***** Definition *****) 

+ 

+PROC define (OPN VAR opn) : 

+    IF NOT module open THEN errorstop (module not opened)

+                       ELSE proc head (opn.mod nr, opn.top of stack)

+    FI 

+ENDPROC define ; 

+ 

+PROC set length of local storage (OPN VAR opn, INT CONST size) :

+    IF   size < 0 OR size > local address limit

+         THEN errorstop (address overflow)

+    ELIF opn.top of stack = 0

+         THEN errorstop (define missing)

+    ELIF opn.kind <> proc op

+         THEN errorstop (proc op expected)

+    FI ;

+    set length (opn.top of stack, size + eumel0 stack offset)

+ENDPROC set length of local storage ; 

+ 

+PROC define (OPN VAR operation, INT CONST size) : 

+    define (operation) ; 

+    set length of local storage (operation, size)

+ENDPROC define ; 

+ 

+ 

+                 (***** Identifikation *****) 

+ 

+INT VAR counter, result index, result type repr;

+ 

+PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation,

+               BOOL VAR object exists) :

+    find result entry ; 

+    to object (name) ;

+    IF found  THEN first fit and leave if found FI ; 

+    IF eumel0 THEN identify eumel0 instruction 

+              ELSE yield undefined operation 

+    FI .

+ 

+find result entry : 

+    result index := first; 

+    counter := 0 ;

+    WHILE counter < params REP 

+        NEXTPARAM result index ; 

+        counter INCR 1

+    PER ;

+    check on param field exceeded .

+

+check on param field exceeded :

+    IF result index > size of param field

+       THEN errorstop (param field exceeded) 

+    FI .

+ 

+yield undefined operation :

+    declare (result index, undefined type) ;

+    apply (result index, nop) ;

+    object exists := FALSE .

+ 

+first fit and leave if found :

+    WHILE yet another procedure exists REP 

+        check one procedure and leave if match ; 

+        next procedure 

+    PER . 

+ 

+yet another procedure exists : 

+    permanent pointer <> 0 . 

+ 

+check one procedure and leave if match: 

+    param link := permanent pointer + wordlength ; 

+    set end marker if end of list ;

+    counter := params ; 

+    field pointer := 1 ;

+    REP

+       IF   end of params AND counter = 0 

+            THEN procedure found

+       ELIF end of params OR  counter = 0 

+            THEN LEAVE check one procedure and leave if match 

+            ELSE check next param 

+       FI 

+   PER . 

+ 

+check next param : 

+    get type and mode (CONCR(pt type)) ;

+    IF same types THEN set param mode ; 

+                       counter DECR 1 ; 

+                       field pointer INCR 1 ;

+                       next pt param

+                  ELSE LEAVE check one procedure and leave if match 

+    FI . 

+ 

+same types : (* inline version ! *)

+    equal types .

+ 

+set param mode : 

+    param field [field pointer].access := mode . 

+ 

+procedure found : 

+    get result ; 

+    operation.kind   := proc op ; 

+    operation.mod nr := module number ; 

+    operation.top of stack := 0 ;

+    object exists := TRUE ;

+    LEAVE identify . 

+ 

+get result : 

+    get type and mode (result type) ; 

+    declare (result index, mode) .

+ 

+module number :

+    cdbint (param link + 1) . 

+

+result type :

+    CONCR (param field [result index].type) .

+ 

+eumel0 : 

+    eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; 

+    eumel0 opn.mod nr <> 0 .

+ 

+identify eumel 0 instruction : 

+    init result type with void ; 

+    CONCR (operation) := CONCR (eumel0 opn) ;

+    object exists := check params and set result ;

+    declare (result index, DTYPE:(result type repr)) ;

+    declare (result index, const) .

+

+init result type with void :

+    result type repr := void . 

+ 

+check params and set result :

+    SELECT operation.mod nr OF

+       CASE q return, q false return, q true return : no params 

+       CASE q inc1, q dec1          : one int param yielding void 

+       CASE q pproc, q pp, q ln     : one param yielding void

+       CASE q test                  : one param yielding bool

+       CASE q clear, q ppv          : one int or bool param yielding void 

+       CASE q make false            : one bool param yielding void 

+       CASE q move                  : two int or bool params yielding void 

+       CASE q compl int, q inc, q dec : two int params yielding void

+       CASE q compl real, q fmove   : two real params yielding void 

+       CASE q equ, q lsequ          : two int params yielding bool 

+       CASE q fequ, q flsequ        : two real params yielding bool 

+       CASE q tequ, q tlsequ        : two text params yielding bool

+       CASE q tmove                 : two text params yielding void

+       CASE q accds, q ref          : two params yielding void

+       CASE q add, q sub, q esc mult,

+            q esc div, q esc mod    : three int params yielding void

+       CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void

+       CASE q select, q movex       : three params 

+       CASE q subscript             : five params 

+       CASE q plus, q minus, q mult : two intreals yielding intreal

+       CASE q int div               : two int params yielding int 

+       CASE q real div              : two real params yielding real

+       CASE q equal, q lessequal    : two intrealtexts yielding bool

+       OTHERWISE                      FALSE

+    ENDSELECT .

+ 

+no params : 

+    params = 0 . 

+

+one int param yielding void : 

+    p1 void (int type, first, params) .

+

+one param yielding void :

+    params = 1 . 

+

+one param yielding bool :

+    IF params = 1 THEN result type repr := bool ; 

+                       TRUE 

+                  ELSE FALSE

+    FI .

+ 

+one int or bool param yielding void :

+    p1 void (int type, first, params) OR p1 void (bool type, first, params) . 

+

+one bool param yielding void :

+    p1 void (bool type, first, params) . 

+ 

+two int or bool params yielding void : 

+    p2 (int  type, first, params, void) OR

+    p2 (bool type, first, params, void) .

+

+two int params yielding void :

+    p2 (int type, first, params, void) .

+

+two real params yielding void :

+    p2 (real type, first, params, void) .

+

+two text params yielding void :

+    p2 (text type, first, params, void) .

+

+two int params yielding bool :

+    p2 (int type, first, params, bool) .

+

+two real params yielding bool :

+    p2 (real type, first, params, bool) .

+

+two text params yielding bool :

+    p2 (text type, first, params, bool) .

+

+two params yielding void :

+    params = 2 . 

+

+three int params yielding void :

+    p3 void (int type, first, params) .

+

+three real params yielding void :

+    p3 void (real type, first, params) .

+

+three params :

+    params = 3 .

+

+five params : 

+    params = 5 . 

+

+two intreals yielding intreal :

+    two int params yielding int OR two real params yielding real .

+

+two intrealtexts yielding bool :

+    two int params yielding bool OR two real params yielding bool OR

+    two text params yielding bool .

+

+two int params yielding int :

+    p2 (int type, first, params, int) .

+

+two real params yielding real :

+    p2 (real type, first, params, real)

+ENDPROC identify ; 

+ 

+BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 1 AND param type is requested plain type . 

+ 

+param type is requested plain type :

+    CONCR (param field [first].type) = CONCR (requested type) 

+ 

+ENDPROC p1 void ;

+ 

+BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr,

+              INT CONST result type) :

+    IF param nr = 2 AND param types equal requested plain type

+       THEN result type repr := result type ;

+            TRUE

+       ELSE FALSE

+    FI .

+ 

+param types equal requested plain type :

+    CONCR (param field [first]  .type) = CONCR (requested type) AND 

+    CONCR (param field [first+1].type) = CONCR (requested type)

+

+ENDPROC p2 ;

+ 

+BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 3 AND param types ok .

+ 

+param types ok :

+    FOR index FROM first UPTO first+2 REP

+       IF different param types THEN LEAVE p3 void WITH FALSE FI 

+    PER ;

+    TRUE .

+ 

+different param types :

+    CONCR (param field [index].type) <> CONCR (requested type)

+ENDPROC p3 void; 

+

+

+                   (***** Applikation *****) 

+ 

+INT VAR address representation, left repr, right repr, result repr;

+

+PROC apply (INT CONST first, nr of params, OPN CONST opn) : 

+    IF NOT module open THEN errorstop (module not opened) FI ;

+    SELECT opn.kind OF 

+        CASE eumel 0    : generate eumel0 instruction 

+        CASE proc op    : call operation 

+        CASE param proc : call param proc

+        CASE nil        :

+        OTHERWISE         errorstop (illegal kind) 

+    ENDSELECT .

+ 

+call operation :

+    push params if necessary (first, nr of params, opn.mod nr) ; 

+    call (opn.mod nr) .

+ 

+call param proc : 

+    result addr.kind := local ref ;

+    result addr.value := opn.mod nr ;

+    address representation := REPR result addr ;

+    push params if necessary (first, nr of params, address representation) ;

+    call param (address representation) .

+

+generate eumel0 instruction : 

+    SELECT real nr of params OF 

+        CASE 0 : p0 instruction 

+        CASE 1 : apply p1 (opn, first addr) 

+        CASE 2 : apply p2 (opn, first addr, second addr)

+        CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) 

+        CASE 5 : subscript operation

+        OTHERWISE errorstop (wrong nr of params + text (nr of params)) 

+    ENDSELECT . 

+ 

+real nr of params :

+    IF operator denotation THEN nr of params + 1

+                           ELSE nr of params

+    FI .

+

+operator denotation :

+    opn.mod nr >= q plus .

+

+p0 instruction :

+    IF   opn.mod nr = q return       THEN s0 (q return code) 

+    ELIF opn.mod nr = q true return  THEN s0 (q true return code)

+    ELIF opn.mod nr = q false return THEN s0 (q false return code)

+                                     ELSE errorstop (wrong nr of params +

+                                                     mnemonic (opn)) 

+    FI .

+ 

+subscript operation :

+    IF opn.mod nr = q subscript 

+       THEN subscription

+       ELSE errorstop (wrong nr of params + text (nr of params))

+    FI .

+

+subscription :

+    ADDRESS CONST element length :: param field [first+2].addr ,

+                  limit          :: param field [first+3].addr ;

+    check on immediates ;

+    IF element length.value < 1024

+       THEN s0 (q subscript code + element length.value)

+       ELSE s0 (q longa subs code) ;

+            s0 (element length.value)

+    FI ;

+    s3 (limit.value - 1, subs index, base addr, subs result) .

+

+check on immediates :

+    IF element length.kind <> immediate value OR

+       limit.kind <> immediate value

+       THEN errorstop (no immediate value)

+    FI .

+

+subs index  : REPR param field [first+1].addr .

+

+base addr   : REPR param field [first].addr .

+

+subs result : REPR param field [first+4].addr .

+

+first addr : 

+    param field [first].addr .

+ 

+left type :

+    param field [first].type .

+

+second addr : 

+    param field [nextparam (first)].addr .

+ 

+third addr : 

+    param field [nextparam(nextparam(first))].addr

+ENDPROC apply ;

+ 

+PROC push params if necessary (INT CONST first, nr of params, mod nr) : 

+    init param push (mod nr) ;

+    IF nr of params > 0 THEN push params ;

+                             push result if there is one 

+    FI . 

+ 

+push params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO nr of params REP 

+        apply p1 (push code, param addr) ; 

+        NEXTPARAM field pointer

+    PER . 

+ 

+push code : 

+    param field [field pointer].push opn . 

+ 

+param addr :

+    param field [field pointer].addr . 

+ 

+push result if there is one : 

+    IF push result necessary 

+       THEN push result address (REPR param field [field pointer].addr)

+    FI . 

+

+push result necessary :

+    param field [field pointer].push opn.kind <> nil AND 

+    is not void bool or undefined (param field [field pointer].type) 

+ENDPROC push params if necessary ;

+

+PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : 

+    IF   opn.mod nr = q ln    THEN generate line number 

+    ELIF opn.mod nr = q pproc THEN push module nr

+                              ELSE gen p1 instruction

+    FI .

+

+gen p1 instruction : 

+    address representation := REPR addr ;

+    SELECT opn.mod nr OF 

+        CASE q inc1  : t1 (q inc1 code, address representation)

+        CASE q dec1  : t1 (q dec1 code, address representation)

+        CASE q clear : t1 (q clear code,address representation)

+        CASE q test  : test bool object (address representation)

+        CASE q pp    : push param (address representation)

+        CASE q make false : s1 (q make false code, address representation)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+

+generate line number :

+    IF addr.kind = immediate value THEN mark line (addr.value)

+                                   ELSE errorstop (no immediate value)

+    FI .

+

+push module nr : 

+    IF addr.kind = module nr THEN push param proc (addr.value)

+                             ELSE errorstop (no mod nr)

+    FI

+ENDPROC apply p1; 

+ 

+PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): 

+    left repr := REPR left addr ;

+    IF opn.mod nr = q movim THEN move immediate

+                            ELSE gen p2 instruction 

+    FI . 

+ 

+gen p2 instruction : 

+    right repr := REPR right addr ;

+    SELECT opn.mod nr OF 

+        CASE q move       : t2 (q move code, right repr, left repr)

+        CASE q inc        : t2 (q inc code, right repr, left repr) 

+        CASE q dec        : t2 (q dec code, right repr, left repr) 

+        CASE q equ        : compare (q equ code, left repr, right repr) 

+        CASE q lsequ      : compare (q lsequ code, left repr, right repr) 

+        CASE q fmove      : t2 (q fmove code, right repr, left repr)

+        CASE q flsequ     : compare (q flsequ code, left repr, right repr) 

+        CASE q tmove      : t2 (q tmove code, right repr, left repr)

+        CASE q tequ       : compare (q tequ code, left repr, right repr) 

+        CASE q compl int  : s2 (q compl int code, left repr, right repr)

+        CASE q compl real : s2 (q compl real code, left repr, right repr)

+        CASE q fequ       : compare (q fequ code, left repr, right repr) 

+        CASE q tlsequ     : compare (q tlsequ code, left repr, right repr) 

+        CASE q accds      : t2 (q access ds code, left repr, right repr)

+        CASE q ref        : t2 (q ref code, left repr, right repr) 

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+ 

+move immediate :

+    IF right addr.kind = immediate value 

+       THEN s0 (q esc movim code) ;

+            s1 (left repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI

+ENDPROC apply p2; 

+ 

+PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, 

+               ADDRESS CONST left addr, right addr, result addr ):

+    left repr   := REPR left addr ; 

+    result repr := REPR result addr ;

+    IF   opn.mod nr = q select THEN gen select instruction

+    ELIF opn.mod nr = q movex  THEN gen long move

+                               ELSE gen p3 instruction

+    FI .

+

+gen p3 instruction :

+    right repr  := REPR right addr ; 

+    SELECT opn.mod nr OF 

+        CASE q add                : int add

+        CASE q sub                : int sub

+        CASE q fadd               : real add 

+        CASE q fsub               : real sub 

+        CASE q fmult              : real mult 

+        CASE q fdiv, q real div   : real div 

+        CASE q esc mult           : int mult 

+        CASE q esc div, q int div : int div 

+        CASE q esc mod            : int mod 

+        CASE q plus               : int real add

+        CASE q minus              : int real sub

+        CASE q mult               : int real mult

+        CASE q equal, q lessequal : compare (comp code, left repr, right repr)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT . 

+ 

+gen select instruction :

+    IF right addr.kind = immediate value 

+       THEN t1 (q select code, left repr) ;

+            s1 (right addr.value, result repr)

+       ELSE errorstop (no immediate value)

+    FI .

+

+gen long move :

+    IF right addr.kind = immediate value

+       THEN long move (left repr, result repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI .

+

+int add   : compute (q add code, left repr, right repr, result repr) . 

+ 

+int sub   : compute (q sub code, left repr, right repr, result repr) . 

+ 

+real add  : compute (q fadd code, left repr, right repr, result repr) . 

+ 

+real sub  : compute (q fsub code, left repr, right repr, result repr) . 

+ 

+real mult : compute (q fmult code, left repr, right repr, result repr) . 

+ 

+real div  : compute (q fdiv code, left repr, right repr, result repr) . 

+ 

+int mult  : s3 (q esc mult code, left repr, right repr, result repr) . 

+ 

+int div   : s3 (q esc div code, left repr, right repr, result repr) . 

+ 

+int mod   : s3 (q esc mod code, left repr, right repr, result repr) .

+ 

+int real add : 

+    IF left type = int THEN int add

+                       ELSE real add

+    FI . 

+ 

+int real sub :

+    IF left type = int THEN int sub 

+                       ELSE real sub

+    FI .

+

+int real mult :

+    IF left type = int THEN int mult

+                       ELSE real mult

+    FI . 

+

+comp code : 

+    SELECT left type OF

+        CASE int    : IF opn.mod nr = q equal THEN q equ  ELSE q lsequ  FI 

+        CASE real   : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI

+        CASE string : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI

+        OTHERWISE errorstop (type error); q equ

+    ENDSELECT .

+

+left type : CONCR (left dtype)

+

+ENDPROC apply p3; 

+ 

+

+                      (***** Modul *****) 

+ 

+BOOL VAR module open ;

+

+.init opn section : 

+    module open := FALSE .;

+

+PROC begin module : 

+    IF module open THEN errorstop (nested module) 

+                   ELSE begin modul ; 

+                        module open := TRUE 

+    FI 

+ENDPROC begin module ; 

+ 

+PROC end module : 

+    IF NOT module open

+       THEN errorstop (module not opened) 

+       ELSE end modul ;

+            module open := FALSE

+    FI

+ENDPROC end module ; 

+

+TEXT PROC dump (OPN CONST operation) : 

+    IF   operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) 

+    ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation)

+                                  ELSE " undef. Opn" 

+    FI 

+ENDPROC dump ; 

+ 

+PROC begin modul :

+    EXTERNAL 10072

+ENDPROC begin modul ; 

+ 

+PROC end modul :

+    EXTERNAL 10011

+ENDPROC end modul ; 

+ 

+PROC proc head (INT VAR mod nr, top of stack) :

+    EXTERNAL 10012

+ENDPROC proc head ; 

+ 

+PROC set length (INT CONST top of stack, size) : 

+    EXTERNAL 10013

+ENDPROC set length ; 

+ 

+PROC get module nr (INT VAR module nr) : 

+    EXTERNAL 10016

+ENDPROC get module nr ; 

+ 

+PROC compute (INT CONST op code, l addr, r addr, result address) :

+    EXTERNAL 10017

+ENDPROC compute ; 

+ 

+PROC compare (INT CONST op code, l addr, r addr) :

+    EXTERNAL 10018

+ENDPROC compare ; 

+ 

+PROC long move (INT CONST to, from, length) :

+    EXTERNAL 10019

+ENDPROC long move ;

+

+PROC put next permanent (INT CONST permanent value) : 

+    EXTERNAL 10020

+ENDPROC put next permanent ; 

+ 

+PROC call (INT CONST mod nr) : 

+    EXTERNAL 10022

+ENDPROC call ; 

+ 

+PROC call param (INT CONST mod nr) : 

+    EXTERNAL 10023

+ENDPROC call param ; 

+ 

+PROC push param (INT CONST addr) : 

+    EXTERNAL 10024

+ENDPROC push param ; 

+ 

+PROC push param proc (INT CONST mod nr) : 

+    EXTERNAL 10025

+ENDPROC push param proc ; 

+ 

+PROC init param push (INT CONST mod nr) : 

+    EXTERNAL 10026

+ENDPROC init param push ; 

+ 

+PROC push result address (INT CONST addr) : 

+    EXTERNAL 10027

+ENDPROC push result address ; 

+ 

+PROC test bool object (INT CONST addr) : 

+    EXTERNAL 10187

+ENDPROC test bool object ; 

+ 

+PROC mark line (INT CONST line number) : 

+    EXTERNAL 10030

+ENDPROC mark line ; 

+ 

+PROC s0 (INT CONST op code) : 

+    EXTERNAL 10038

+ENDPROC s0 ; 

+ 

+PROC s1 (INT CONST op code, addr) : 

+    EXTERNAL 10039

+ENDPROC s1 ; 

+ 

+PROC s2 (INT CONST op code , addr1, addr2) : 

+    EXTERNAL 10040

+ENDPROC s2 ; 

+ 

+PROC s3 (INT CONST op code, addr1, addr2, addr3) : 

+    EXTERNAL 10041

+ENDPROC s3 ; 

+ 

+PROC t1 (INT CONST op code, addr) : 

+    EXTERNAL 10042

+ENDPROC t1 ; 

+ 

+PROC t2 (INT CONST op code, addr1, addr2) : 

+    EXTERNAL 10043

+ENDPROC t2 ; 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  9. Speicherverwaltung                     21.03.1986  *) 

+(*                                                                        *) 

+(*   Ablage der Paketdaten                                                *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+INT VAR address value;

+ 

+INT CONST data allocation by coder  := 1 , 

+          data allocation by user   := 2 ; 

+

+LET not initialized      = 0 ,

+    wrong mm mode        = "Wrong MM Mode" ,

+    define on non global = "Define for GLOB only" ,

+    text too long        = "TEXT too long" ;

+ 

+TEXT VAR const buffer :: point line ;

+

+.reset memory management mode :

+     memory management mode := not initialized . ;

+ 

+PROC reserve storage (INT CONST size) : 

+    IF memory management mode <> data allocation by user 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (address value, size) ; 

+    memory management mode := not initialized

+ENDPROC reserve storage ; 

+ 

+PROC allocate variable (ADDRESS VAR addr, INT CONST size) : 

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (addr.value, size) ;

+    addr.kind := global

+ENDPROC allocate variable ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, INT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate int denoter (addr.value) ;

+    put data word (value, addr.value) ;

+    addr.kind := global

+ENDPROC allocate denoter ; 

+

+PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate real denoter (addr.value) ;

+    addr.kind := global ;

+    define (addr, value)

+ENDPROC allocate denoter ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; 

+    addr.kind := global ;

+    skip heaplink; 

+    define (addr, value) ; 

+    reset heaplink .

+ 

+skip heaplink : 

+    addr.value INCR 1 .

+

+reset heaplink :

+    addr.value DECR 1

+ENDPROC allocate denoter ; 

+ 

+PROC define (ADDRESS CONST addr, INT CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    put data word (value, addr.value) 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, REAL CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    replace (const buffer, 1, value) ; 

+    address value := addr.value ;

+    FOR index FROM 1 UPTO 4 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, TEXT CONST value) : 

+    IF   addr.kind <> global THEN errorstop (define on non global) 

+    ELIF LENGTH value > 255  THEN errorstop (text too long)

+    FI ; 

+    address value := addr.value ;

+    const buffer := code (LENGTH value) ; 

+    const buffer CAT value ; 

+    const buffer CAT " " ;

+    FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER ; 

+    const buffer := point line

+ENDPROC define ; 

+ 

+PROC prep pbase (INT VAR offset) : 

+    EXTERNAL 10032 

+ENDPROC prep pbase; 

+ 

+PROC allocate var (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10033

+ENDPROC allocate var ; 

+ 

+PROC allocate int denoter (INT VAR addr) : 

+    EXTERNAL 10034

+ENDPROC allocate int denoter ;

+ 

+PROC allocate real denoter (INT VAR addr) : 

+    EXTERNAL 10035 

+ENDPROC allocate real denoter ;

+

+PROC allocate text denoter (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10036 

+ENDPROC allocate text denoter ;

+ 

+PROC put data word (INT CONST value, INT CONST addr) :

+    EXTERNAL 10037

+ENDPROC put data word ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                 10. Inspector                              08.01.1986  *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+INT VAR line number, pattern length, packet link,

+        begin of packet, last packet entry, indentation;

+

+TEXT VAR bulletin name, type and mode, pattern, buffer;

+ 

+DATASPACE VAR bulletin ds :: nilspace ;

+

+.packet name :

+     cdb text (cdb int(packet link + wordlength) + two word length) .

+

+.within editor :

+    aktueller editor > 0 .  ;

+

+TEXT PROC type name (DTYPE CONST type) : 

+    type and mode := "" ; 

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC type name ; 

+ 

+TEXT PROC dump (DTYPE CONST type) :

+    type and mode := "TYPE " ;

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC dump ;

+

+PROC name of type (INT CONST type) :

+            SELECT type OF

+     CASE void              :

+     CASE int               : type and mode CAT "INT"

+     CASE real              : type and mode CAT "REAL"

+     CASE string            : type and mode CAT "TEXT"

+     CASE bool, bool result : type and mode CAT "BOOL"

+     CASE dataspace         : type and mode CAT "DATASPACE"

+     OTHERWISE              : complex type

+            ENDSELECT .

+

+complex type :

+     IF type > ptt limit THEN perhaps permanent struct or row

+                         ELSE get complex type

+     FI .

+

+perhaps permanent struct or row :

+     index := type + begin of pt minus ptt limit ;

+     mode := cdb int (index) MOD ptt limit ;

+     IF   mode = permanent row    THEN get permanent row 

+     ELIF mode = permanent struct THEN get permanent struct

+                                  ELSE type and mode CAT "-"

+     FI .

+

+get complex type :

+     index := type + begin of permanent table ;

+     IF is complex type THEN get name

+                        ELSE type and mode CAT "-"

+     FI .

+

+is complex type :

+     permanent type definition mode = permanent type .

+

+get name :

+     type and mode CAT cdb text (link to type name + two word length) .

+

+link to type name :

+     cdb int (index + three word length) .

+

+permanent type definition mode :

+     cdb int (index + wordlength) .

+

+get permanent row :

+     INT VAR t; 

+     type and mode CAT "ROW " ;

+     type and mode CAT text (cdb int (index + wordlength)) ;

+     type and mode CAT " " ;

+     param link := index + two wordlength ;

+     get type and mode (t) ;

+     name of type (t) .

+ 

+get permanent struct :

+     type and mode CAT "STRUCT ( ... )" 

+ENDPROC name of type ;

+

+PROC help (TEXT CONST proc name) :

+     prep bulletin ;

+     prep help ;

+     scan (object name) ;

+     next symbol (pattern) ;

+     packet link := end of permanent table ;

+     IF function = 0 THEN standard help

+                     ELSE asterisk help

+     FI .

+

+prep help :

+     object name := compress (proc name) ;

+     INT VAR function :: 0 ;

+     INT CONST l :: LENGTH object name ;

+     IF l > 1 AND object name <> "**"

+        THEN IF (object name SUB l) = "*"

+               THEN function INCR 2 ;

+                    delete char (object name, l)

+             FI ;

+             IF (object name SUB 1) = "*"

+               THEN function INCR 1 ;

+                    delete char (object name, 1)

+             FI ;

+             IF another asterisk THEN wrong function FI

+     FI.

+

+another asterisk :

+     pos (object name, "*") <> 0 .

+

+wrong function :

+     errorstop ("unzulaessige Sternfunktion") .

+

+standard help :

+     to object (pattern) ;

+     IF found THEN display

+              ELSE error stop ("unbekannt: " + proc name)

+     FI .

+

+display :

+     WHILE permanent pointer <> 0 REP

+         put name of packet if necessary ;

+         put specifications (pattern) ;

+         next procedure

+     ENDREP ;

+     show bulletin file .

+ 

+put name of packet if necessary :

+     IF new packet THEN packet link := permanent pointer ;

+                        find begin of packet ;

+                        writeline (2) ;

+                        write packet name

+     FI .

+

+find begin of packet :

+     REP 

+         packet link DECR wordlength

+     UNTIL begin of packet found PER .

+

+begin of packet found :

+     cdb int (packet link) = permanent packet .

+

+new packet :

+     permanent pointer < packet link .

+

+asterisk help :

+     hash table pointer := begin of hash table ;

+     pattern length := LENGTH pattern - 1 ;

+     REP

+        list all objects in current hash table chain ;

+        next hash entry

+     UNTIL end of hash table reached ENDREP ;

+     show bulletin file .

+

+list all objects in current hash table chain :

+     nt link := hash table pointer ;

+     WHILE yet another nt entry REP

+        permanent pointer := cdb int (nt link + wordlength) ;

+        object name := cdb text (nt link + two word length) ;

+        IF matching THEN into bulletin FI

+     PER .

+

+matching :

+     INT CONST p :: pos (object name, pattern) ;

+     SELECT function OF

+         CASE 1 :   p <> 0 AND p = LENGTH object name - pattern length

+         CASE 2 :   p = 1

+         CASE 3 :   p <> 0

+         OTHERWISE  FALSE

+     ENDSELECT .

+

+into bulletin :

+     object names into bulletin (BOOL PROC not end of chain)

+ENDPROC help ;

+ 

+BOOL PROC not end of chain :

+     permanent pointer <> 0 

+ENDPROC not end of chain ;

+

+PROC write packet name :

+     indentation := 0 ;

+     write line ;

+     write bulletin line ("PACKET ") ;

+     indentation := 7 ;

+     object name := packet name ;

+     write bulletin line (object name) ;

+     write bulletin line (":") ;

+     writeline (2)

+ENDPROC write packet name ;

+

+PROC put specifications (TEXT CONST proc name) :

+     put obj name (proc name) ;

+     to first param ;

+     IF NOT end of params THEN put param list FI ;

+     put result ;

+     writeline .

+ 

+to first param :

+     param link := permanent pointer + word length ;

+     set end marker if end of list .

+

+put result :

+     INT VAR type;

+     get type and mode (type) ;

+     IF type <> void THEN type and mode := "  --> " ;

+                          name of type (type) ;

+                          write bulletin line (type and mode)

+     FI

+ENDPROC put specifications ;

+

+PROC put param list : 

+     write bulletin line (" (") ;

+     REP

+         INT VAR type;

+         get type and mode (type) ;

+         put type and mode ;

+         maybe param proc ;

+         next pt param ;

+         IF end of params THEN write bulletin line (")") ;

+                               LEAVE put param list 

+         FI ;

+         write bulletin line (", ") ;

+     PER .

+

+put type and mode :

+     type and mode := "" ;

+     name of type (type) ;

+     type and mode CAT name of mode ;

+     write bulletin line (type and mode) .

+

+name of mode :

+     IF   mode = const THEN " CONST"

+     ELIF mode = var   THEN " VAR"

+                       ELSE " PROC"

+     FI .

+

+maybe param proc :

+     IF mode = permanent param proc THEN put virtual params FI .

+

+put virtual params :

+     skip over result type if complex type ;

+     IF NOT end of virtual params THEN put param list FI.

+

+skip over result type if complex type :

+     next pt param .

+

+end of virtual params :

+    end of params

+ENDPROC put param list ;

+

+PROC next packet :

+     REP

+         packet link INCR wordlength ;

+         word := cdb int (packet link) ;

+         IF   word = permanent packet THEN true return

+         ELIF end of permanents       THEN false return

+         FI ;

+     ENDREP .

+

+true return :

+     found := TRUE ;

+     LEAVE next packet .

+

+false return :

+     found := FALSE ;

+     LEAVE next packet .

+

+end of permanents :

+     word = permanent end OR packet link > end of permanent table 

+ENDPROC next packet ;

+

+PROC prep bulletin :

+     forget (bulletin ds) ;

+     bulletin ds := nilspace ;

+     bulletin file := sequential file (output, bulletin ds) ;

+     line number := 0 ;

+     buffer := ""

+ENDPROC prep bulletin ;

+

+PROC show bulletin file :

+     IF within editor THEN ueberschrift neu FI ;

+     DATASPACE VAR local ds :: bulletin ds ;

+     FILE VAR local file :: sequential file (modify, local ds) ;

+     edit (local file) ;

+     forget (local ds)

+ENDPROC show bulletin file ;

+

+PROC write bulletin line (TEXT CONST line) :

+     IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ;

+     buffer CAT line

+ENDPROC write bulletin line ;

+

+PROC writeline  :

+     write (bulletin file, buffer) ;

+     line (bulletin file) ;

+     line number INCR 1 ;

+     cout (line number) ;

+     buffer := indentation * " "

+ENDPROC writeline ;

+

+PROC writeline (INT CONST times) :

+     IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ;

+                                          writeline

+                                     ELSE index := times

+     FI ;

+     line (bulletin file, index) ;

+     line number INCR index;

+     indentation := 0 ;

+     cout (line number)

+ENDPROC writeline ;

+ 

+PROC bulletin (TEXT CONST packet name) :

+     prep bulletin ;

+     scan (packet name) ;

+     next symbol (pattern) ;

+     to packet ; 

+     IF found THEN list packet ;

+                   show bulletin file

+              ELSE error stop (packet name + " ist kein Paketname")

+     FI . 

+ 

+to packet :

+     last packet entry := 0 ;

+     get nametab link of packet name ;

+     packet link := before first pt entry ;

+     REP

+         packet link INCR wordlength ;

+         word := cdb int (packet link) ;

+         IF word < 0 THEN IF   word = permanent packet THEN packet found

+                          ELIF word = permanent end    THEN return

+                          FI

+         FI

+     ENDREP .

+

+get nametab link of packet name :

+     to object (pattern) ;

+     IF NOT found THEN error stop ("unbekanntes Paket :" + packet name) ;

+                       LEAVE to packet

+     FI .

+

+packet found :

+     IF cdb int (packet link + wordlength) = nt link

+        THEN last packet entry := packet link FI .

+

+return : 

+     IF last packet entry <> 0 THEN found := TRUE ;

+                                    packet link := last packet entry

+                               ELSE found := FALSE

+     FI ;

+     LEAVE to packet

+ENDPROC bulletin ;

+ 

+PROC list packet :

+     begin of packet := packet link + word length ;

+     write packet name ; 

+     find end of packet ;

+     run through nametab and list all packet objects .

+ 

+find end of packet :

+     last packet entry := begin of packet ;

+     REP

+         last packet entry INCR wordlength ;

+         word := cdb int (last packet entry) ;

+     UNTIL end of packet entries PER .

+

+end of packet entries :

+     word = permanent packet OR word = permanent end .

+

+run through nametab and list all packet objects :

+     hashtable pointer := begin of hashtable ;

+     REP

+         nt link := hashtable pointer ;

+         list objects of current packet in this chain ;

+         next hash entry

+     UNTIL end of hashtable reached ENDREP .

+

+list objects of current packet in this chain :

+     WHILE yet another nt entry REP 

+         permanent pointer := cdb int (nt link + wordlength) ;

+         put objects of this name

+     PER .

+

+put objects of this name :

+     IF there is at least one object of this name in the current packet

+       THEN into bulletin FI .

+

+there is at least one object of this name in the current packet :

+     REP

+        IF permanent pointer >= begin of packet AND

+           permanent pointer < last packet entry

+           THEN LEAVE there is at least one object of this name

+                      in the current packet WITH TRUE FI ;

+        next procedure

+     UNTIL permanent pointer = 0 PER ;

+     FALSE .

+

+into bulletin :

+     object name := cdb text (nt link + two word length) ;

+     object names into bulletin (BOOL PROC within packet)

+ENDPROC list packet ;

+

+BOOL PROC within packet :

+     permanent pointer >= begin of packet AND 

+     permanent pointer < last packet entry

+ENDPROC within packet ;

+

+PROC object names into bulletin (BOOL PROC link ok) :

+     scan (object name) ;

+     next symbol (object name, mode) ;

+     IF type definition THEN put type definition

+                        ELSE put object definitions

+     FI .

+

+type definition :

+     mode = bold AND no params .

+

+no params :

+     cdb int (permanent pointer + word length) >= permanent type .

+

+put type definition :

+     put obj name (object name) ;

+     write bulletin line ("TYPE ") ;

+     writeline (1) .

+

+put object definitions :

+     WHILE link ok REP

+         put specifications (object name) ;

+         next procedure

+     ENDREP 

+ENDPROC object names into bulletin ;

+ 

+PROC bulletin :

+     prep bulletin ;

+     packet link := first permanent entry ;

+     REP

+         list packet ;

+         write line (4) ;

+         next packet

+     UNTIL NOT found PER ;

+     show bulletin file

+ENDPROC bulletin ;

+

+PROC put obj name (TEXT CONST name) :

+     buffer := "      " ;

+     bulletin name := point line ;

+     change (bulletin name, 1, end of line or name, name) ;

+     buffer CAT bulletin name ;

+     indentation := LENGTH buffer + 1 .

+

+end of line or name :

+     min (LENGTH name, LENGTH bulletin name)

+ENDPROC put obj name ;

+

+PROC packets :

+     prep bulletin ;

+     packet link := first permanent entry ;

+     REP

+         object name := packet name ;

+         put obj name (object name) ;

+         write line ;

+         next packet 

+     UNTIL NOT found PER ;

+     show bulletin file

+ENDPROC packets ;

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                 11. ELAN Run-Interface                     09.01.1986  *) 

+(*                                                                        *) 

+(*   Uebersetzen von ELAN-Programmen                                      *) 

+(*   Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler           *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+BOOL VAR list option     := FALSE ,

+         check option    :=  TRUE ,

+         listing enabled := FALSE ;

+

+FILE VAR listing file ;

+

+TEXT VAR listing file name := "" ;

+ 

+ 

+PROC run (TEXT CONST file name) : 

+  enable stop ;

+  IF NOT exists (file name)

+    THEN errorstop ("""" + file name + """ gibt es nicht")

+  FI ;

+  last param (file name) ;

+  run elan (file name, no ins)

+END PROC run;

+ 

+PROC run :

+  run (last param)

+ENDPROC run ;

+ 

+PROC run again :

+  IF run again mod nr <> 0

+    THEN elan (run again mode, bulletin file, "", run again mod nr, 

+               no ins, no lst, check option, no sermon)

+    ELSE errorstop ("'run again' nicht moeglich")

+  FI

+ENDPROC run again ;

+ 

+PROC insert (TEXT CONST file name) : 

+  enable stop ;

+  IF NOT exists (file name)

+    THEN errorstop ("""" + file name + """ gibt es nicht")

+  FI ;

+  last param (file name) ;

+  run elan (file name, ins)

+ENDPROC insert ;

+ 

+PROC insert :

+  insert (last param)

+ENDPROC insert ;

+ 

+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :

+  FILE VAR source := sequential file (modify, file name) ;

+  IF listing enabled

+    THEN open listing file

+  FI ;

+

+  disable stop ;

+  no do again ;

+  elan (compile file mode, source, "" , run again mod nr,

+        insert option, list option, check option, sermon) ;

+ 

+  IF anything noted AND command dialogue

+    THEN ignore halt during compiling ;

+         note edit (source) ;

+         errorstop ("")

+  FI .

+

+ignore halt during compiling :

+  IF is error

+    THEN put error ;

+         clear error ;

+         pause (5)

+  FI .

+

+open listing file :

+  listing file := sequential file (output, listing file name) ;

+  max line length (listing file, 130)

+

+ENDPROC run elan ;

+(*

+PROC out text (TEXT CONST text, INT CONST out type) :

+  INTERNAL 257 ; 

+  IF online

+    THEN out (text)

+  FI ;

+  IF out type = error message 

+    THEN note (text) ; 

+         number of errors INCR 1 

+    ELIF out type = warning message 

+        THEN note (text) 

+  FI ;

+  IF listing enabled

+    THEN write (listing file, text)

+  FI

+ENDPROC out text ;

+ 

+PROC out line (INT CONST out type) :

+  INTERNAL 258 ; 

+  IF online

+    THEN out (""13""10"")

+  FI ;

+  IF out type = error message OR out type = warning message

+    THEN note line

+  ELIF listing enabled

+    THEN line (listing file)

+  FI

+ENDPROC out line ;

+*)

+PROC prot (TEXT CONST file name) :

+  list option := TRUE ;

+  listing file name := file name ;

+  listing enabled := TRUE

+ENDPROC prot ;

+ 

+PROC prot off :

+  list option := FALSE ;

+  listing enabled := FALSE

+ENDPROC prot off ;

+

+BOOL PROC prot :

+  list option

+ENDPROC prot ;

+ 

+PROC check on :

+  check option := TRUE

+ENDPROC check on ;

+ 

+PROC check off :

+  check option := FALSE

+ENDPROC check off ;

+ 

+BOOL PROC check :

+  check option

+ENDPROC check ;

+

+ENDPACKET eumel coder ; 

diff --git a/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod
new file mode 100644
index 0000000..6914548
--- /dev/null
+++ b/system/eumel-coder/1.8.0/src/eumel coder 1.8.0_mod
@@ -0,0 +1,2043 @@
+PACKET eumel coder                                 (* Autor: U. Bartling *) 

+       DEFINES coder on, coder off,                (* 1.8.0-Korr. M.St. *) 

+               declare, define, apply, identify,   (* 21.11.86 *)

+               :=, =,                              (* EXTERNAL 10...Nummern*)

+               dump,                               (* und coderon-flags *)

+                                                   (* inspector/coder1 weg *)

+               LABEL,

+               gosub, goret,

+               complement condition code,

+

+               ADDRESS ,

+               GLOB, LOC, REF, DEREF,

+               ref length,

+               +, 

+               adjust,

+               is global, is local, is ref,

+ 

+               DTYPE, 

+               type class, type name,

+               void type, int type, real type, text type, bool type, 

+               dataspace type, undefined type, 

+               row type, struct type, proc type, end type,

+ 

+               OPN, 

+               set length of local storage, 

+               begin module, end module, 

+               is proc, is eumel 0 instruction,

+               address, operation,

+               nop, 

+               init op codes,

+               mnemonic, 

+

+               parameter,

+               next param,

+               NEXTPARAM, 

+               access , 

+               dtype , 

+               param address,

+               same type ,

+ 

+               reserve storage, 

+               allocate denoter , 

+               allocate variable, 

+               data allocation by coder ,

+               data allocation by user :

+

+(**************************************************************************)

+(*                                                                        *) 

+(*                         E U M E L  -  C O D E R                        *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(*   Zur Beschreibung des Coders siehe                                    *) 

+(*         U.Bartling, J. Liedtke: EUMEL-Coder-Interface                  *) 

+(*                                                                        *) 

+(*   Stand der Dokumentation  : 13.02.1986                                *) 

+(*   Stand der Implementation : 21.03.1986                                *) 

+(*                                                                        *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+                   (***** Globale Variable *****) 

+

+TEXT VAR object name;

+ 

+FILE VAR bulletin file; 

+ 

+INT VAR memory management mode, global address offset,

+        nt link, permanent pointer, param link, index, mode, field pointer;

+ 

+BOOL VAR found, end of params;

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  1. Interface zum ELAN-Compiler            12.03.1986  *) 

+(*                              1.7.5.4                                   *)

+(*                                                                        *) 

+(*   Beschreibung der      Tabellen (-groessen),                          *) 

+(*                         internen Vercodung von Typen                   *) 

+(*                    und  Kennungen .                                    *) 

+(*   Initialisieren und Beenden des Compilers,                            *) 

+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+LET  begin of hash table         =     0 ,

+     end of hash table           =  1023 ,

+ 

+     begin of permanent table    = 22784 ,

+(*     before first pt entry     = 22784 , *)

+(*     first permanent entry     = 22785 , *)

+(*   end of permanent table      = 32767 , *)

+

+     wordlength                  =     1 ,  (* compile  u n d  run time *)

+     two word length             =     2 ,

+     three word length           =     3 ,

+     four word length            =     4 ,

+ 

+     permanent param const             = 10000 ,

+     permanent param var               = 20000 ,

+     permanent proc op                 = 30000 ,

+     permanent type                    = 30000 ,

+     permanent row                     =    10 ,

+     permanent struct                  =    11 ,

+     permanent param proc              =    12 ,

+(*   permanent param proc end marker   =     0 , *)

+     permanent type field              =     0 ,

+

+     ptt limit                         = 10000 ,

+     begin of pt minus ptt limit       = 12784 ,

+     offset to row size                = 12785 ,

+ 

+     void                              =     0 ,

+     int                               =     1 ,

+     real                              =     2 ,

+     string                            =     3 ,

+     bool                              =     5 ,

+     bool result                       =     6 ,

+     dataspace                         =     7 ,

+     undefined                         =     9 ,

+     row                               =    10 ,

+     struct                            =    11 ,

+     end                               =     0 ,

+

+     const                             =     1 , 

+     var                               =     2 ,

+(*   proc                              =     3 , *)

+(*   denoter                           =     5 , *)

+(*   bold                              =     2 , *)

+ 

+     ins                               = TRUE ,

+     no ins                            = FALSE ,

+     no lst                            = FALSE ,

+     sermon                            = TRUE  ,

+     no sermon                         = FALSE ,

+

+(*   run again mode                    =     0 , *)

+(*   compile file mode                 =     1 , *)

+     prep coder mode                   =     5 , 

+ 

+(*   warning message                   =     2 , *) 

+(*   error message                     =     4 , *) 

+

+     point line                        = "..............." ;

+(* 

+INT CONST permanent packet            :=     -2 ,

+          permanent end               :=     -3 ;

+*)

+BOOL VAR coder active                 := FALSE ; 

+

+INT  VAR run again mod nr             :=     0 ;

+ 

+ 

+                     (***** Start/Ende *****)

+ 

+LET invalid coder off = "CODER not active" ;

+

+PROC coder on (INT CONST data allocation mode) : 

+    mark coder on ; 

+    init memory management ; 

+    init opn section ; 

+    init compiler .

+ 

+mark coder on :

+    coder active := TRUE .

+

+init memory management :

+    memory management mode := data allocation mode ;

+    prep pbase (global address offset) .

+ 

+init compiler :

+    no do again ;

+    elan (prep coder mode, bulletin file, "", run again mod nr,

+          no ins, prot, check, no sermon) (* prot, check f.test, M.St. *)

+

+ENDPROC coder on;

+ 

+PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) :

+    IF coder active 

+       THEN mark coder off ; 

+            end coder (insert, sermon, start mod nr if no insert)

+       ELSE errorstop (invalid coder off)

+    FI .

+ 

+start mod nr if no insert :

+    IF insert THEN run again mod nr := 0

+              ELSE run again mod nr := start proc.mod nr

+    FI ;

+    run again mod nr .

+

+mark coder off :

+    reset memory management mode ;

+    init opn section ;

+    coder active := FALSE

+ENDPROC coder off ; 

+ 

+PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) :

+    EXTERNAL 10021

+ENDPROC end coder ; 

+

+PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, 

+           INT VAR start module number, BOOL CONST ins, lst, rtc, ser) :

+  EXTERNAL 256

+ENDPROC elan ;

+ 

+                   (***** Hash/Namenstabelle *****) 

+

+. yet another nt entry :

+     nt link := cdb int (nt link) ;

+     nt link <> 0 . ;

+ 

+PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : 

+    EXTERNAL 10031

+ENDPROC declare object ; 

+ 

+PROC to object (TEXT CONST searched object) : 

+     hash ;

+     search nt entry .

+

+hash :

+     hash code := 0 ;

+     FOR index FROM 1 UPTO LENGTH searched object REP

+         addmult cyclic

+     ENDREP .

+

+addmult cyclic :

+     hash code INCR hash code ;

+     IF hash code > end of hash table THEN wrap around FI ;

+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .

+

+wrap around :

+     hash code DECR end of hash table .

+

+hash code : nt link .

+

+search nt entry :

+     found := FALSE ;

+     WHILE yet another nt entry REP

+          read current entry ;

+          IF object name = searched object 

+             THEN found := TRUE ;

+                  LEAVE to object

+          FI

+     PER .

+

+read current entry :

+     permanent pointer := cdb int (nt link + wordlength) ;

+     object name := cdb text (nt link + two word length)

+ENDPROC to object ;

+

+

+                 (***** Permanent Tabelle *****) 

+.

+next procedure :

+     permanent pointer := cdb int (permanent pointer) . ;

+

+PROC next pt param :

+     mode := cdb int (param link) MOD ptt limit ;

+     param link INCR wordlength ;

+     IF   mode = permanent row    THEN skip over permanent row 

+     ELIF mode = permanent struct THEN skip over permanent struct

+     FI ;

+     set end marker if end of list .

+

+skip over permanent row :

+     param link INCR wordlength ;

+     next pt param .

+

+skip over permanent struct :

+     REP

+         next pt param ;

+         mode := cdb int (param link)

+     UNTIL mode = permanent type field PER ;

+     param link INCR wordlength

+ENDPROC next pt param ;

+

+PROC set end marker if end of list :

+     mode := cdb int (param link) ;

+     end of params := mode >= permanent proc op OR mode <= 0 

+ENDPROC set end marker if end of list ;

+

+PROC get type and mode (INT VAR type) : 

+     mode := cdb int (param link) ;

+     IF mode = permanent param proc THEN type of param proc

+                                    ELSE type of object

+     FI .

+

+type of param proc : 

+     param link INCR wordlength ;

+     get type and mode (type) ;

+     mode := permanent param proc .

+

+type of object :

+     IF mode < 0 THEN type := 2769 + (32767 + mode) ;

+                      mode := 0

+                 ELSE type := mode MOD ptt limit ;

+                      mode DECR type ;

+                      translate type if necessary ;

+                      translate mode if necessary 

+     FI .

+

+translate type if necessary :

+     IF permanent row or struct THEN translate type FI .

+

+translate type :

+     type := param link - begin of pt minus ptt limit .

+

+translate mode if necessary : 

+    IF   mode = permanent param const THEN mode := const

+    ELIF mode = permanent param var   THEN mode := var

+    FI .

+

+permanent row or struct :

+     type = permanent row OR type = permanent struct

+ENDPROC get type and mode ;

+ 

+

+                 (***** Allgemeine Zugriffsprozeduren *****) 

+

+INT PROC cdb int (INT CONST index) :

+   EXTERNAL 116

+ENDPROC cdb int ;

+

+TEXT PROC cdb text (INT CONST index) :

+   EXTERNAL 117

+ENDPROC cdb text ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  2. Spruenge und Marken                    07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps LABEL                                       *) 

+(*                                                                        *) 

+(*   Deklaration, Definition und Applikation von Marken                   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE LABEL = INT ; 

+

+BOOL VAR invers :: FALSE ; 

+ 

+PROC declare (LABEL VAR label) : 

+    CONCR (label) := 0

+ENDPROC declare ; 

+ 

+PROC define (LABEL VAR label) : 

+    EXTERNAL 10083

+ENDPROC define ; 

+ 

+PROC complement condition code : 

+    invers := TRUE

+ENDPROC complement condition code ; 

+ 

+PROC apply (LABEL VAR label) : 

+    EXTERNAL 10148 

+ENDPROC apply ; 

+ 

+PROC apply (LABEL VAR label, BOOL CONST condition) : 

+    IF condition xor invers THEN branch true (label) 

+                            ELSE branch false (label)

+    FI ;

+    invers := FALSE .

+

+condition xor invers : 

+    IF condition THEN NOT invers

+                 ELSE invers

+    FI

+ENDPROC apply ; 

+ 

+OP := (LABEL VAR global label, local label) : (* EQUATE ! *)

+    EXTERNAL 10014 

+ENDOP := ; 

+ 

+TEXT PROC dump (LABEL CONST label) : 

+    "LAB " + text (CONCR (label)) 

+ENDPROC dump ; 

+ 

+PROC gosub (LABEL VAR label) : 

+    EXTERNAL 10015 

+ENDPROC gosub ; 

+ 

+PROC goret : 

+    s0 (q goret code) 

+ENDPROC goret ; 

+ 

+PROC branch true (LABEL VAR label) : 

+    EXTERNAL 10028

+ENDPROC branch true ; 

+ 

+PROC branch false (LABEL VAR label) : 

+    EXTERNAL 10029

+ENDPROC branch false ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  3. Datenaddressen                         21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps ADDRESS                                     *) 

+(*                                                                        *) 

+(*   Aufbau von Datenaddressen (Vercodung)                                *) 

+(*   Fortschalten und Ausrichten von Adressen                             *) 

+(*   Bereitstellen der Fehlermeldung "address overflow" (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+TYPE ADDRESS = STRUCT (INT kind, value) ; 

+ 

+LET global                 = 0 , 

+    local                  = 1 , 

+    ref mask               = 2 , 

+    global ref             = 2 , 

+    local ref              = 3 , 

+    module nr              = 4 ,

+    immediate value        = 5 ,

+ 

+    eumel0 stack offset    = 4 ,

+    local address limit    = 16 384 ,

+ 

+    illegal ref operation  = "REF not allowed" , 

+    deref on non ref       = "DEREF on non-ref address" ,

+    global ref not allowed = "GLOBAL REF not allowed" , 

+    unknown kind           = "Unknown address kind" , 

+    address overflow       = "Address Overflow" , 

+    illegal plus operation = "+ not allowed" ;

+ 

+ADDRESS VAR result addr;

+ 

+INT CONST ref length :: 2 ;

+

+OP := (ADDRESS VAR l, ADDRESS CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+ADDRESS OP GLOB (INT CONST address level) : 

+    result addr.kind  := global ; 

+    result addr.value := address level ; 

+    IF memory management mode = data allocation by user

+       THEN result addr.value INCR global address offset

+    FI ;

+    result addr

+ENDOP GLOB ;

+

+ADDRESS OP LOC (INT CONST address level) : 

+    result addr.kind  := local ;

+    result addr.value := address level + eumel0 stack offset ; 

+    result addr

+ENDOP LOC ; 

+ 

+ADDRESS OP REF (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    IF   result addr.kind = local  THEN result addr.kind INCR ref mask

+    ELIF result addr.kind = global THEN errorstop (global ref not allowed)

+                                   ELSE errorstop (illegal ref operation)

+    FI ;

+    result addr 

+ENDOP REF ; 

+ 

+ADDRESS OP DEREF (ADDRESS CONST ref address) : 

+    CONCR (result addr) := CONCR (ref address) ;

+    IF is not local ref THEN errorstop (deref on non ref) FI ; 

+    result addr.kind DECR ref mask ; 

+    result addr .

+ 

+is not local ref :

+    result addr.kind <> local ref

+ENDOP DEREF ;

+ 

+INT OP REPR (ADDRESS CONST addr) : 

+    CONCR (result addr) := CONCR (addr) ;

+    SELECT result addr.kind OF 

+        CASE global     :

+        CASE local      : set bit (result addr.value, 15) 

+        CASE global ref : errorstop (global ref not allowed)

+        CASE local ref  : prep local ref 

+        OTHERWISE errorstop (unknown kind)

+    ENDSELECT ; 

+    result addr.value .

+ 

+prep local ref : 

+    IF address limit exceeded THEN errorstop (address overflow) FI ;

+    set bit (result addr.value, 14) ; 

+    set bit (result addr.value, 15) .

+

+address limit exceeded :

+    result addr.value < eumel0 stack offset OR

+    result addr.value > local address limit

+ENDOP REPR ; 

+ 

+BOOL PROC is ref (ADDRESS CONST addr) : 

+    addr.kind = local ref

+ENDPROC is ref ; 

+ 

+BOOL PROC is global (ADDRESS CONST addr) : 

+    addr.kind = global 

+ENDPROC is global ; 

+ 

+BOOL PROC is local (ADDRESS CONST addr) : 

+    addr.kind = local 

+ENDPROC is local ; 

+ 

+ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : 

+    CONCR (result addr) := CONCR (addr) ; 

+    SELECT result addr.kind OF 

+        CASE global : inc global

+        CASE local  : inc local

+        OTHERWISE     errorstop (illegal plus operation) 

+    ENDSELECT ; 

+    result addr .

+ 

+inc global : 

+    result addr.value INCR offset ; 

+    IF result addr.value < 0 THEN errorstop (address overflow) FI .

+ 

+inc local : 

+    result addr.value INCR offset ; 

+    IF result addr.value < eumel 0 stack offset OR

+       result addr.value > local address limit

+       THEN errorstop (address overflow)

+    FI

+ENDOP + ; 

+ 

+PROC adjust (ADDRESS VAR addr, INT CONST adjust length) :

+    IF is local or global THEN adjust to length FI . 

+ 

+is local or global :

+    addr.kind <= local .

+

+adjust to length :

+    mode := addr.value MOD adjust length ;

+    IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI

+ENDPROC adjust ;

+

+TEXT PROC dump (ADDRESS CONST addr) : 

+    kind + text (addr.value) . 

+ 

+kind : 

+    SELECT addr.kind OF 

+        CASE global          : "GLOBAL " 

+        CASE local           : "LOCAL " 

+        CASE immediate value : "IMMEDIATE "

+        CASE module nr       : "PARAM PROC "

+        CASE global ref      : "GLOBAL REF " 

+        CASE local ref       : "LOCAL REF " 

+        OTHERWISE "undef. Addr:" 

+    ENDSELECT 

+ENDPROC dump; 

+

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  4. Datentypen   Teil I                    03.12.1985  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps DTYPE                                       *) 

+(*                                                                        *) 

+(*   Interne Repraesentation der primitiven Datentypen                    *) 

+(*   Identifikation von DTYPEs                                            *)

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+TYPE DTYPE = INT ; 

+ 

+OP := (DTYPE VAR l, DTYPE CONST r) : 

+    CONCR (l) := CONCR (r) 

+ENDOP := ; 

+ 

+BOOL OP = (DTYPE CONST l, r) : 

+    CONCR (l) = CONCR (r)

+ENDOP = ; 

+ 

+DTYPE PROC void type :      DTYPE :(void)      ENDPROC  void type ; 

+ 

+DTYPE PROC int  type :      DTYPE :(int )      ENDPROC  int type ; 

+ 

+DTYPE PROC real type :      DTYPE :(real)      ENDPROC  real type ; 

+ 

+DTYPE PROC text type :      DTYPE :(string)    ENDPROC  text type ; 

+ 

+DTYPE PROC bool type :      DTYPE :(bool)      ENDPROC  bool type ; 

+ 

+DTYPE PROC dataspace type : DTYPE :(dataspace) ENDPROC dataspace type ; 

+ 

+DTYPE PROC undefined type : DTYPE :(undefined) ENDPROC undefined type ; 

+ 

+DTYPE PROC row type  :      DTYPE :(row)       ENDPROC row type ; 

+ 

+DTYPE PROC struct type :    DTYPE :(struct)    ENDPROC struct type ; 

+ 

+DTYPE PROC proc type :   DTYPE :(permanent param proc) ENDPROC proc type ; 

+ 

+DTYPE PROC end type  :      DTYPE :(end)       ENDPROC end type ; 

+ 

+INT PROC type class (DTYPE CONST type) : 

+    SELECT type id OF 

+        CASE int, real, bool, string, dataspace, undefined : 1 

+        CASE void   : 0 

+        CASE row    : 3 

+        CASE struct : 4 

+        CASE permanent param  proc : 5 

+        OTHERWISE     pt type 

+    ENDSELECT . 

+

+pt type :

+    IF type id > ptt limit THEN permanent row or struct

+                           ELSE abstract type

+    FI .

+

+abstract type : 2 .

+

+permanent row or struct :

+    mode := cdbint (type link into pt) MOD ptt limit ; 

+    IF   mode = struct THEN 4

+    ELIF mode = row    THEN 3

+                       ELSE 2

+    FI .

+ 

+type link into pt :

+    type id + begin of pt minus ptt limit .

+

+type id : CONCR (type)

+ENDPROC type class ; 

+ 

+PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : 

+    SELECT type pos OF 

+          CASE 1   : size := 0; align := 0; type id := void 

+          CASE 6   : size := 1; align := 1; type id := int 

+          CASE 10  : size := 4; align := 4; type id := real 

+          CASE 15  : size := 8; align := 4; type id := string

+          CASE 20  : size := 1; align := 1; type id := bool 

+          CASE 25  : size := 1; align := 1; type id := dataspace

+          OTHERWISE  search for type in permanent table 

+    ENDSELECT . 

+ 

+type pos : 

+    enclose in delimiters ;

+    pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . 

+ 

+enclose in delimiters :

+    object name := "." ;

+    object name CAT name ;

+    object name CAT "." .

+

+search for type in permanent table : 

+    to object (name) ;

+    IF NOT found THEN size := 0; align := 0; type id := undefined 

+                 ELSE size := cdbint (permanent pointer + two wordlength) ;

+                      type id := permanent pointer - begin of permanent table ;

+                      IF   size < two wordlength  THEN align := 1

+                      ELIF size < four wordlength THEN align := 2

+                                                  ELSE align := 4

+                      FI

+    FI . 

+ 

+type id : CONCR (type)

+ENDPROC identify ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  5. Operationen  Teil I                    21.03.1986  *) 

+(*                                                                        *) 

+(*   Definition des Datentyps OPN                                         *) 

+(*   Primitive Operationen (:=  etc.)                                     *) 

+(*   Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ;

+ 

+LET proc op    = 0 ,

+    param proc = 1 ,

+    eumel 0    = 2 , 

+    nil        = 3 , 

+ 

+    param proc at non ref = "PARAM PROC at non-ref address" ,

+    proc op expected      = "PROC expected" ;

+ 

+OPN VAR eumel0 opn;

+eumel0 opn.kind := eumel0 ;

+eumel0 opn.top of stack := 0 ;

+

+eumel0 opn.mod nr := q pp ;

+OPN CONST pp       :: eumel0 opn ,

+          nop code :: OPN :(nil, 0, 0) ;

+

+THESAURUS VAR eumel 0 opcodes :: empty thesaurus ; 

+ 

+PROC init op codes (FILE VAR eumelcodes) : 

+    eumel 0 opcodes := empty thesaurus ;

+    WHILE NOT eof (eumelcodes) REP

+       getline (eumelcodes, object name) ;

+       delete trailing blanks ;

+       IF object name <> "" CAND NOT (eumel 0 opcodes CONTAINS object name)

+          THEN insert (eumel 0 opcodes, object name)

+       FI

+    PER .

+

+delete trailing blanks :

+    WHILE (object name SUB LENGTH object name) = " " REP

+       object name := subtext (object name, 1, LENGTH object name - 1)

+    PER

+ENDPROC init op codes ; 

+

+ADDRESS PROC address (OPN CONST opn) :

+    IF opn.kind <> proc op THEN errorstop (proc op expected) FI ;

+    result addr.kind  := module nr ; 

+    result addr.value := opn.mod nr ;

+    result addr

+ENDPROC address ;

+ 

+OPN PROC operation (ADDRESS CONST addr) : 

+    IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; 

+    OPN VAR opn ;

+    opn.kind := param proc ; 

+    opn.mod nr :=addr.value ; 

+    opn.top of stack := 0 ; 

+    opn 

+ENDPROC operation ; 

+ 

+TEXT PROC mnemonic (OPN CONST op code) : 

+    name (eumel 0 opcodes, op code.mod nr)

+ENDPROC mnemonic ;

+ 

+OPN PROC nop : 

+    nop code

+ENDPROC nop ; 

+ 

+OP := (OPN VAR r, OPN CONST l) : 

+    CONCR (r) := CONCR (l) 

+ENDOP := ; 

+ 

+BOOL PROC is proc (OPN CONST operation) : 

+    operation.kind = proc op

+ENDPROC is proc ; 

+ 

+BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : 

+    link (eumel 0 opcodes, op code name) <> 0

+ENDPROC is eumel 0 instruction ; 

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  6. Parameterfeld                          10.01.1986  *) 

+(*                                                                        *) 

+(*   Bereitstellen des Parameterfeldes                                    *) 

+(*   Schreiben und Lesen von Eintraegen im Parameterfeld                  *) 

+(*   Fortschalten von Zeigern in das Parameterfeld                        *) 

+(*   Bereitstellen der Konstanten 'size of param field' (Coder-intern)    *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+LET PARAMDESCRIPTOR = STRUCT (DTYPE type,   INT access, 

+                              ADDRESS addr, OPN push opn) , 

+ 

+    size of param field   = 100 ,

+    param field exceeded  = "Param Field Overflow",

+    param nr out of range = "Illegal Param Number" ;

+ 

+ROW size of param field PARAMDESCRIPTOR VAR param field ;

+ 

+ 

+                      (***** Schreiben *****) 

+ 

+PROC test param pos (INT CONST param nr) : 

+    IF param nr < 1 OR param nr > size of param field

+       THEN errorstop (param nr out of range)

+    FI 

+ENDPROC test param pos ; 

+ 

+PROC declare (INT CONST param nr, DTYPE CONST type) : 

+    test param pos (param nr) ; 

+    enter type . 

+ 

+enter type :

+    CONCR (param field [param nr].type) := CONCR (type) 

+ENDPROC declare ; 

+ 

+PROC declare (INT CONST param nr, access) : 

+    test param pos (param nr) ; 

+    enter access . 

+

+enter access :

+    param field [param nr].access := access 

+ENDPROC declare ; 

+ 

+PROC define (INT CONST param nr, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter address . 

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) 

+ENDPROC define ; 

+ 

+PROC define (INT CONST param nr, value) : 

+    result addr.kind  := immediate value ;

+    result addr.value := value ;

+    define (param nr, result addr) 

+ENDPROC define ; 

+ 

+PROC apply (INT CONST param nr, OPN CONST opn) : 

+    test param pos (param nr) ; 

+    enter push opn . 

+ 

+enter push opn : 

+    CONCR (param field [param nr].push opn) := CONCR (opn) 

+ENDPROC apply ; 

+ 

+PROC parameter (INT CONST param nr, DTYPE CONST type, 

+                INT CONST access, ADDRESS CONST addr) : 

+    test param pos (param nr) ; 

+    enter type ; 

+    enter access ; 

+    enter address ; 

+    enter pp as default . 

+ 

+enter type : 

+    CONCR (param field [param nr].type) := CONCR (type) .

+

+enter access :

+    param field [param nr].access := access .

+

+enter address :

+    CONCR (param field [param nr].addr) := CONCR (addr) .

+

+enter pp as default :

+    CONCR (param field [param nr].push opn) := CONCR (pp) 

+ENDPROC parameter ; 

+ 

+ 

+                       (***** Lesen *****) 

+ 

+ADDRESS PROC param address (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].addr 

+ENDPROC param address ; 

+ 

+DTYPE PROC dtype (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].type 

+ENDPROC dtype ; 

+ 

+INT PROC access (INT CONST param nr) : 

+    test param pos (param nr) ; 

+    param field [param nr].access 

+ENDPROC access ; 

+ 

+ 

+                      (***** Fortschalten *****) 

+ 

+OP NEXTPARAM (INT VAR param nr) : 

+   test param pos (param nr) ; 

+   IF long entry THEN read until end FI ; 

+   param nr INCR 1 .

+ 

+long entry : 

+    type class (param field [param nr].type) > 2 . 

+ 

+read until end : 

+    REP 

+        param nr INCR 1 ; 

+        NEXTPARAM param nr 

+    UNTIL end marker read or end of field PER . 

+ 

+end marker read or end of field :

+    param nr > size of param field OR

+    CONCR (param field [param nr].type) = end 

+ENDOP NEXTPARAM ; 

+ 

+INT PROC next param (INT CONST p) : 

+    index := p ; 

+    NEXTPARAM index ; 

+    index

+ENDPROC next param ; 

+ 

+TEXT PROC dump (INT CONST p) : 

+   IF p > 0 AND p <= 100 THEN dump entry (param field (p)) 

+                         ELSE param nr out of range 

+    FI 

+ENDPROC dump ; 

+ 

+TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : 

+    object name := dump (id.type) ; 

+    object name CAT text (id.access) ; 

+    object name CAT dump (id.addr) ; 

+    object name CAT dump (id.push opn) ;

+    object name

+ENDPROC dump entry ; 

+

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  7. Datentypen   Teil II                   20.01.1986  *) 

+(*                                                                        *) 

+(*   Deklaration neuer Datentypen                                         *) 

+(*   Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle   *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+DTYPE VAR pt type ;

+

+PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : 

+    entry into name table ; 

+    put next permanent (permanent type) ; 

+    put next permanent (size) ; 

+    put next permanent (nt link) ;

+    mark no offsets of text elements . 

+ 

+entry into name table : 

+    declare object (name, nt link, CONCR (type)) . 

+ 

+mark no offsets of text elements : 

+    put next permanent (0) 

+ENDPROC declare ; 

+ 

+BOOL PROC same type (INT CONST param 1, param 2) : 

+    INT CONST left type :: CONCR (param field [param 1].type) ;

+    IF left type = right type

+       THEN same fine structure if there is one

+       ELSE left type = undefined OR right type = undefined

+    FI .

+ 

+right type : CONCR (param field [param 2].type) . 

+ 

+same fine structure if there is one : 

+    IF   left type = row    THEN compare row 

+    ELIF left type = struct THEN compare struct 

+                            ELSE TRUE 

+    FI . 

+ 

+compare row : 

+    equal sizes AND same type (param1 + 1, param2 + 1) . 

+ 

+equal sizes : 

+    param field [param1+1].access = param field [param2+1].access .

+ 

+compare struct : 

+    INT VAR p1 :: param1+1, p2 :: param2+1 ; 

+    REP 

+       IF   NOT same type (p1, p2) THEN LEAVE same type WITH FALSE 

+       ELIF end type found         THEN LEAVE same type WITH TRUE

+       FI ;

+       NEXTPARAM p1 ;

+       NEXTPARAM p2

+    UNTIL end of field PER ;

+    FALSE .

+

+end type found :

+    CONCR (param field [p1].type) = end .

+

+end of field : 

+    p1 > size of param field OR p2 > size of param field 

+ENDPROC same type ;

+ 

+BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : 

+    field pointer := param nr ;

+    CONCR (pt type) := CONCR (type) ;

+    equal types 

+ENDPROC same type ;

+

+BOOL PROC equal types : 

+    identical types OR one type is undefined .

+

+one type is undefined :

+    type of actual field = undefined OR CONCR(pt type) = undefined .

+

+identical types :

+    SELECT type class (pt type) OF 

+        CASE 0, 1, 2 : type of actual field = CONCR (pt type)

+        CASE 3       : perhaps equal rows

+        CASE 4       : perhaps equal structs

+        OTHERWISE      FALSE

+    ENDSELECT .

+

+perhaps equal rows :

+    is row AND equal row sizes AND equal row types . 

+ 

+is row :

+    type of actual field = row .

+

+perhaps equal structs : 

+    is struct AND same type fields . 

+ 

+is struct :

+    type of actual field = struct .

+

+equal row sizes :

+    pt row size = row size within param field . 

+

+equal row types :

+    same type (field pointer + 1, pt row type) .

+

+pt row size :

+    cdb int (CONCR(pt type) + offset to row size) .

+

+pt row type :

+    CONCR (pt type) INCR 2 ;

+    pt type .

+

+row size within param field :

+    param field [field pointer].access .

+ 

+same type fields :

+    field pointer INCR 1 ;

+    CONCR (pt type) INCR 1 ;

+    REP

+        IF NOT equal types THEN LEAVE same type fields WITH FALSE FI ;

+        IF type of actual field = end 

+             THEN LEAVE same type fields WITH TRUE 

+        FI ; 

+        NEXTPARAM field pointer

+    UNTIL end of field PER ;

+    FALSE .

+

+end of field :

+    field pointer > size of param field .

+

+type of actual field :

+    CONCR (param field [field pointer].type) .

+ENDPROC equal types ;

+

+BOOL PROC is not void bool or undefined (DTYPE CONST dtype) :

+    type <> void AND type <> bool AND type <> undefined .

+

+type : CONCR (dtype)

+ENDPROC is not void bool or undefined ;

+ 

+

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  8. Operationen  Teil II                   07.03.1986  *) 

+(*                                                                        *) 

+(*   Definition der Opcodes                                               *) 

+(*   Deklaration, Definition, Identifikation und Applikation              *) 

+(*   Eroeffnen und Schliessen eines Moduls                                *)

+(*                                                                        *) 

+(**************************************************************************) 

+ 

+ 

+ 

+LET module not opened  = "Module not opened" , 

+    define missing     = "DEFINE missing" ,

+    wrong nr of params = "Wrong Nr. of Params:" , 

+    illegal kind       = "Opcode expected" ,

+    nested module      = "Nested Modules" ,

+    no mod nr          = "Param Proc expected" ,

+    no immediate value = "Value expected" ,

+    type error         = "Type Error" ,

+ 

+    q ln              =  1 ,

+    q move            =  2 ,    q move code             =  2 048 ,

+    q inc1            =  3 ,    q inc1 code             =  3 072 ,

+    q dec1            =  4 ,    q dec1 code             =  4 096 ,

+    q inc             =  5 ,    q inc code              =  5 120 ,

+    q dec             =  6 ,    q dec code              =  6 144 ,

+    q add             =  7 ,    q add code              =  7 168 ,

+    q sub             =  8 ,    q sub code              =  8 192 ,

+    q clear           =  9 ,    q clear code            =  9 216 ,

+    q test            = 10 , 

+    q equ             = 11 ,    q equ code              = 11 264 , 

+    q lsequ           = 12 ,    q lsequ code            = 12 288 , 

+    q fmove           = 13 ,    q fmove code            = 13 312 , 

+    q fadd            = 14 ,    q fadd code             = 14 336 , 

+    q fsub            = 15 ,    q fsub code             = 15 360 , 

+    q fmult           = 16 ,    q fmult code            = 16 384 , 

+    q fdiv            = 17 ,    q fdiv code             = 17 408 ,

+    q flsequ          = 18 ,    q flsequ code           = 18 432 ,

+    q tmove           = 19 ,    q tmove code            = 19 456 ,

+    q tequ            = 20 ,    q tequ code             = 20 480 , 

+    q accds           = 21 ,    q access ds code        = 22 528 , 

+    q ref             = 22 ,    q ref code              = 23 552 ,

+    q subscript       = 23 ,    q subscript code        = 24 576 , 

+    q select          = 24 ,    q select code           = 25 600 ,

+    q ppv             = 25 , 

+    q pp              = 26 , 

+    q make false      = 27 , (* q make false code       = 65 513 *)

+    q movex           = 28 ,

+(*  q longa subs                q longa subs code       = 65 376 *) 

+    q return          = 29 ,    q return code           = 32 512 ,

+    q true return     = 30 ,    q true return code      = 32 513 ,

+    q false return    = 31 ,    q false return code     = 32 514 ,

+                                q goret code            = 32 519 ,

+    q esc mult        = 32 ,    q esc mult code         = 32 553 ,

+    q esc div         = 33 ,    q esc div code          = 32 554 , 

+    q esc mod         = 34 ,    q esc mod code          = 32 555 , 

+    q pproc           = 35 , 

+    q compl int       = 36 ,    q compl int code        = 32 551 ,

+    q compl real      = 37 ,    q compl real code       = 32 550 ,

+(*  q alias ds        = 38 , *) 

+    q movim           = 39 ,    q esc movim code        = 32 547 ,

+    q fequ            = 40 ,    q fequ code             = 32 548 ,

+    q tlsequ          = 41 ,    q tlsequ code           = 32 549 ,

+(*  q case            = 42 , *)

+    q plus            = 43 ,

+    q minus           = 44 ,

+    q mult            = 45 ,

+    q int div         = 46 ,

+    q real div        = 47 ,

+    q equal           = 48 ,

+    q lessequal       = 49 ;

+ 

+INT CONST q make false code :: - 1 022 , 

+          q longa subs code :: -   159 ;

+ 

+

+                   (***** Deklaration *****) 

+ 

+PROC declare (OPN VAR operation) : 

+    operation.kind := proc op ;

+    get module nr (operation.mod nr) ; 

+    operation.top of stack := 0 

+ENDPROC declare ; 

+ 

+PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : 

+    declare (operation) ;

+    entry into name and pt table if necessary ; 

+    enter params ; 

+    enter result ; 

+    enter module number . 

+ 

+entry into name and pt table if necessary : 

+    declare object (name, nt link, permanent pointer) . 

+ 

+enter params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO params REP

+       enter param (param field [field pointer]) ;

+       NEXTPARAM field pointer 

+    PER .

+ 

+enter result : 

+    enter param (param field[field pointer].type, permanent proc op) .

+ 

+enter module number : 

+    put next permanent (operation.mod nr)

+ENDPROC declare ; 

+ 

+PROC enter param (PARAMDESCRIPTOR CONST param) :

+    IF   param.access = const 

+         THEN enter param (param.type, permanent param const)

+    ELIF param.access = var 

+         THEN enter param (param.type, permanent param var)

+    ELSE errorstop ("Unknown Access")

+    FI

+ENDPROC enter param ;

+

+PROC enter param (DTYPE CONST type, INT CONST permanent mode) :

+    SELECT type class (type) OF

+        CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode)

+        OTHERWISE      errorstop ("Illegal Type")

+    ENDSELECT

+ENDPROC enter param ;

+

+

+                    (***** Definition *****) 

+ 

+PROC define (OPN VAR opn) : 

+    IF NOT module open THEN errorstop (module not opened)

+                       ELSE proc head (opn.mod nr, opn.top of stack)

+    FI 

+ENDPROC define ; 

+ 

+PROC set length of local storage (OPN VAR opn, INT CONST size) :

+    IF   size < 0 OR size > local address limit

+         THEN errorstop (address overflow)

+    ELIF opn.top of stack = 0

+         THEN errorstop (define missing)

+    ELIF opn.kind <> proc op

+         THEN errorstop (proc op expected)

+    FI ;

+    set length (opn.top of stack, size + eumel0 stack offset)

+ENDPROC set length of local storage ; 

+ 

+PROC define (OPN VAR operation, INT CONST size) : 

+    define (operation) ; 

+    set length of local storage (operation, size)

+ENDPROC define ; 

+ 

+ 

+                 (***** Identifikation *****) 

+ 

+INT VAR counter, result index, result type repr;

+ 

+PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation,

+               BOOL VAR object exists) :

+    find result entry ; 

+    to object (name) ;

+    IF found  THEN first fit and leave if found FI ; 

+    IF eumel0 THEN identify eumel0 instruction 

+              ELSE yield undefined operation 

+    FI .

+ 

+find result entry : 

+    result index := first; 

+    counter := 0 ;

+    WHILE counter < params REP 

+        NEXTPARAM result index ; 

+        counter INCR 1

+    PER ;

+    check on param field exceeded .

+

+check on param field exceeded :

+    IF result index > size of param field

+       THEN errorstop (param field exceeded) 

+    FI .

+ 

+yield undefined operation :

+    declare (result index, undefined type) ;

+    apply (result index, nop) ;

+    object exists := FALSE .

+ 

+first fit and leave if found :

+    WHILE yet another procedure exists REP 

+        check one procedure and leave if match ; 

+        next procedure 

+    PER . 

+ 

+yet another procedure exists : 

+    permanent pointer <> 0 . 

+ 

+check one procedure and leave if match: 

+    param link := permanent pointer + wordlength ; 

+    set end marker if end of list ;

+    counter := params ; 

+    field pointer := 1 ;

+    REP

+       IF   end of params AND counter = 0 

+            THEN procedure found

+       ELIF end of params OR  counter = 0 

+            THEN LEAVE check one procedure and leave if match 

+            ELSE check next param 

+       FI 

+   PER . 

+ 

+check next param : 

+    get type and mode (CONCR(pt type)) ;

+    IF same types THEN set param mode ; 

+                       counter DECR 1 ; 

+                       field pointer INCR 1 ;

+                       next pt param

+                  ELSE LEAVE check one procedure and leave if match 

+    FI . 

+ 

+same types : (* inline version ! *)

+    equal types .

+ 

+set param mode : 

+    param field [field pointer].access := mode . 

+ 

+procedure found : 

+    get result ; 

+    operation.kind   := proc op ; 

+    operation.mod nr := module number ; 

+    operation.top of stack := 0 ;

+    object exists := TRUE ;

+    LEAVE identify . 

+ 

+get result : 

+    get type and mode (result type) ; 

+    declare (result index, mode) .

+ 

+module number :

+    cdbint (param link + 1) . 

+

+result type :

+    CONCR (param field [result index].type) .

+ 

+eumel0 : 

+    eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; 

+    eumel0 opn.mod nr <> 0 .

+ 

+identify eumel 0 instruction : 

+    init result type with void ; 

+    CONCR (operation) := CONCR (eumel0 opn) ;

+    object exists := check params and set result ;

+    declare (result index, DTYPE:(result type repr)) ;

+    declare (result index, const) .

+

+init result type with void :

+    result type repr := void . 

+ 

+check params and set result :

+    SELECT operation.mod nr OF

+       CASE q return, q false return, q true return : no params 

+       CASE q inc1, q dec1          : one int param yielding void 

+       CASE q pproc, q pp, q ln     : one param yielding void

+       CASE q test                  : one param yielding bool

+       CASE q clear, q ppv          : one int or bool param yielding void 

+       CASE q make false            : one bool param yielding void 

+       CASE q move                  : two int or bool params yielding void 

+       CASE q compl int, q inc, q dec : two int params yielding void

+       CASE q compl real, q fmove   : two real params yielding void 

+       CASE q equ, q lsequ          : two int params yielding bool 

+       CASE q fequ, q flsequ        : two real params yielding bool 

+       CASE q tequ, q tlsequ        : two text params yielding bool

+       CASE q tmove                 : two text params yielding void

+       CASE q accds, q ref          : two params yielding void

+       CASE q add, q sub, q esc mult,

+            q esc div, q esc mod    : three int params yielding void

+       CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void

+       CASE q select, q movex       : three params 

+       CASE q subscript             : five params 

+       CASE q plus, q minus, q mult : two intreals yielding intreal

+       CASE q int div               : two int params yielding int 

+       CASE q real div              : two real params yielding real

+       CASE q equal, q lessequal    : two intrealtexts yielding bool

+       OTHERWISE                      FALSE

+    ENDSELECT .

+ 

+no params : 

+    params = 0 . 

+

+one int param yielding void : 

+    p1 void (int type, first, params) .

+

+one param yielding void :

+    params = 1 . 

+

+one param yielding bool :

+    IF params = 1 THEN result type repr := bool ; 

+                       TRUE 

+                  ELSE FALSE

+    FI .

+ 

+one int or bool param yielding void :

+    p1 void (int type, first, params) OR p1 void (bool type, first, params) . 

+

+one bool param yielding void :

+    p1 void (bool type, first, params) . 

+ 

+two int or bool params yielding void : 

+    p2 (int  type, first, params, void) OR

+    p2 (bool type, first, params, void) .

+

+two int params yielding void :

+    p2 (int type, first, params, void) .

+

+two real params yielding void :

+    p2 (real type, first, params, void) .

+

+two text params yielding void :

+    p2 (text type, first, params, void) .

+

+two int params yielding bool :

+    p2 (int type, first, params, bool) .

+

+two real params yielding bool :

+    p2 (real type, first, params, bool) .

+

+two text params yielding bool :

+    p2 (text type, first, params, bool) .

+

+two params yielding void :

+    params = 2 . 

+

+three int params yielding void :

+    p3 void (int type, first, params) .

+

+three real params yielding void :

+    p3 void (real type, first, params) .

+

+three params :

+    params = 3 .

+

+five params : 

+    params = 5 . 

+

+two intreals yielding intreal :

+    two int params yielding int OR two real params yielding real .

+

+two intrealtexts yielding bool :

+    two int params yielding bool OR two real params yielding bool OR

+    two text params yielding bool .

+

+two int params yielding int :

+    p2 (int type, first, params, int) .

+

+two real params yielding real :

+    p2 (real type, first, params, real)

+ENDPROC identify ; 

+ 

+BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 1 AND param type is requested plain type . 

+ 

+param type is requested plain type :

+    CONCR (param field [first].type) = CONCR (requested type) 

+ 

+ENDPROC p1 void ;

+ 

+BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr,

+              INT CONST result type) :

+    IF param nr = 2 AND param types equal requested plain type

+       THEN result type repr := result type ;

+            TRUE

+       ELSE FALSE

+    FI .

+ 

+param types equal requested plain type :

+    CONCR (param field [first]  .type) = CONCR (requested type) AND 

+    CONCR (param field [first+1].type) = CONCR (requested type)

+

+ENDPROC p2 ;

+ 

+BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) :

+    param nr = 3 AND param types ok .

+ 

+param types ok :

+    FOR index FROM first UPTO first+2 REP

+       IF different param types THEN LEAVE p3 void WITH FALSE FI 

+    PER ;

+    TRUE .

+ 

+different param types :

+    CONCR (param field [index].type) <> CONCR (requested type)

+ENDPROC p3 void; 

+

+

+                   (***** Applikation *****) 

+ 

+INT VAR address representation, left repr, right repr, result repr;

+

+PROC apply (INT CONST first, nr of params, OPN CONST opn) : 

+    IF NOT module open THEN errorstop (module not opened) FI ;

+    SELECT opn.kind OF 

+        CASE eumel 0    : generate eumel0 instruction 

+        CASE proc op    : call operation 

+        CASE param proc : call param proc

+        CASE nil        :

+        OTHERWISE         errorstop (illegal kind) 

+    ENDSELECT .

+ 

+call operation :

+    push params if necessary (first, nr of params, opn.mod nr) ; 

+    call (opn.mod nr) .

+ 

+call param proc : 

+    result addr.kind := local ref ;

+    result addr.value := opn.mod nr ;

+    address representation := REPR result addr ;

+    push params if necessary (first, nr of params, address representation) ;

+    call param (address representation) .

+

+generate eumel0 instruction : 

+    SELECT real nr of params OF 

+        CASE 0 : p0 instruction 

+        CASE 1 : apply p1 (opn, first addr) 

+        CASE 2 : apply p2 (opn, first addr, second addr)

+        CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) 

+        CASE 5 : subscript operation

+        OTHERWISE errorstop (wrong nr of params + text (nr of params)) 

+    ENDSELECT . 

+ 

+real nr of params :

+    IF operator denotation THEN nr of params + 1

+                           ELSE nr of params

+    FI .

+

+operator denotation :

+    opn.mod nr >= q plus .

+

+p0 instruction :

+    IF   opn.mod nr = q return       THEN s0 (q return code) 

+    ELIF opn.mod nr = q true return  THEN s0 (q true return code)

+    ELIF opn.mod nr = q false return THEN s0 (q false return code)

+                                     ELSE errorstop (wrong nr of params +

+                                                     mnemonic (opn)) 

+    FI .

+ 

+subscript operation :

+    IF opn.mod nr = q subscript 

+       THEN subscription

+       ELSE errorstop (wrong nr of params + text (nr of params))

+    FI .

+

+subscription :

+    ADDRESS CONST element length :: param field [first+2].addr ,

+                  limit          :: param field [first+3].addr ;

+    check on immediates ;

+    IF element length.value < 1024

+       THEN s0 (q subscript code + element length.value)

+       ELSE s0 (q longa subs code) ;

+            s0 (element length.value)

+    FI ;

+    s3 (limit.value - 1, subs index, base addr, subs result) .

+

+check on immediates :

+    IF element length.kind <> immediate value OR

+       limit.kind <> immediate value

+       THEN errorstop (no immediate value)

+    FI .

+

+subs index  : REPR param field [first+1].addr .

+

+base addr   : REPR param field [first].addr .

+

+subs result : REPR param field [first+4].addr .

+

+first addr : 

+    param field [first].addr .

+ 

+left type :

+    param field [first].type .

+

+second addr : 

+    param field [nextparam (first)].addr .

+ 

+third addr : 

+    param field [nextparam(nextparam(first))].addr

+ENDPROC apply ;

+ 

+PROC push params if necessary (INT CONST first, nr of params, mod nr) : 

+    init param push (mod nr) ;

+    IF nr of params > 0 THEN push params ;

+                             push result if there is one 

+    FI . 

+ 

+push params : 

+    field pointer := first ;

+    FOR index FROM 1 UPTO nr of params REP 

+        apply p1 (push code, param addr) ; 

+        NEXTPARAM field pointer

+    PER . 

+ 

+push code : 

+    param field [field pointer].push opn . 

+ 

+param addr :

+    param field [field pointer].addr . 

+ 

+push result if there is one : 

+    IF push result necessary 

+       THEN push result address (REPR param field [field pointer].addr)

+    FI . 

+

+push result necessary :

+    param field [field pointer].push opn.kind <> nil AND 

+    is not void bool or undefined (param field [field pointer].type) 

+ENDPROC push params if necessary ;

+

+PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : 

+    IF   opn.mod nr = q ln    THEN generate line number 

+    ELIF opn.mod nr = q pproc THEN push module nr

+                              ELSE gen p1 instruction

+    FI .

+

+gen p1 instruction : 

+    address representation := REPR addr ;

+    SELECT opn.mod nr OF 

+        CASE q inc1  : t1 (q inc1 code, address representation)

+        CASE q dec1  : t1 (q dec1 code, address representation)

+        CASE q clear : t1 (q clear code,address representation)

+        CASE q test  : test bool object (address representation)

+        CASE q pp    : push param (address representation)

+        CASE q make false : s1 (q make false code, address representation)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+

+generate line number :

+    IF addr.kind = immediate value THEN mark line (addr.value)

+                                   ELSE errorstop (no immediate value)

+    FI .

+

+push module nr : 

+    IF addr.kind = module nr THEN push param proc (addr.value)

+                             ELSE errorstop (no mod nr)

+    FI

+ENDPROC apply p1; 

+ 

+PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): 

+    left repr := REPR left addr ;

+    IF opn.mod nr = q movim THEN move immediate

+                            ELSE gen p2 instruction 

+    FI . 

+ 

+gen p2 instruction : 

+    right repr := REPR right addr ;

+    SELECT opn.mod nr OF 

+        CASE q move       : t2 (q move code, right repr, left repr)

+        CASE q inc        : t2 (q inc code, right repr, left repr) 

+        CASE q dec        : t2 (q dec code, right repr, left repr) 

+        CASE q equ        : compare (q equ code, left repr, right repr) 

+        CASE q lsequ      : compare (q lsequ code, left repr, right repr) 

+        CASE q fmove      : t2 (q fmove code, right repr, left repr)

+        CASE q flsequ     : compare (q flsequ code, left repr, right repr) 

+        CASE q tmove      : t2 (q tmove code, right repr, left repr)

+        CASE q tequ       : compare (q tequ code, left repr, right repr) 

+        CASE q compl int  : s2 (q compl int code, left repr, right repr)

+        CASE q compl real : s2 (q compl real code, left repr, right repr)

+        CASE q fequ       : compare (q fequ code, left repr, right repr) 

+        CASE q tlsequ     : compare (q tlsequ code, left repr, right repr) 

+        CASE q accds      : t2 (q access ds code, left repr, right repr)

+        CASE q ref        : t2 (q ref code, left repr, right repr) 

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT .

+ 

+move immediate :

+    IF right addr.kind = immediate value 

+       THEN s0 (q esc movim code) ;

+            s1 (left repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI

+ENDPROC apply p2; 

+ 

+PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, 

+               ADDRESS CONST left addr, right addr, result addr ):

+    left repr   := REPR left addr ; 

+    result repr := REPR result addr ;

+    IF   opn.mod nr = q select THEN gen select instruction

+    ELIF opn.mod nr = q movex  THEN gen long move

+                               ELSE gen p3 instruction

+    FI .

+

+gen p3 instruction :

+    right repr  := REPR right addr ; 

+    SELECT opn.mod nr OF 

+        CASE q add                : int add

+        CASE q sub                : int sub

+        CASE q fadd               : real add 

+        CASE q fsub               : real sub 

+        CASE q fmult              : real mult 

+        CASE q fdiv, q real div   : real div 

+        CASE q esc mult           : int mult 

+        CASE q esc div, q int div : int div 

+        CASE q esc mod            : int mod 

+        CASE q plus               : int real add

+        CASE q minus              : int real sub

+        CASE q mult               : int real mult

+        CASE q equal, q lessequal : compare (comp code, left repr, right repr)

+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))

+    ENDSELECT . 

+ 

+gen select instruction :

+    IF right addr.kind = immediate value 

+       THEN t1 (q select code, left repr) ;

+            s1 (right addr.value, result repr)

+       ELSE errorstop (no immediate value)

+    FI .

+

+gen long move :

+    IF right addr.kind = immediate value

+       THEN long move (left repr, result repr, right addr.value)

+       ELSE errorstop (no immediate value)

+    FI .

+

+int add   : compute (q add code, left repr, right repr, result repr) . 

+ 

+int sub   : compute (q sub code, left repr, right repr, result repr) . 

+ 

+real add  : compute (q fadd code, left repr, right repr, result repr) . 

+ 

+real sub  : compute (q fsub code, left repr, right repr, result repr) . 

+ 

+real mult : compute (q fmult code, left repr, right repr, result repr) . 

+ 

+real div  : compute (q fdiv code, left repr, right repr, result repr) . 

+ 

+int mult  : s3 (q esc mult code, left repr, right repr, result repr) . 

+ 

+int div   : s3 (q esc div code, left repr, right repr, result repr) . 

+ 

+int mod   : s3 (q esc mod code, left repr, right repr, result repr) .

+ 

+int real add : 

+    IF left type = int THEN int add

+                       ELSE real add

+    FI . 

+ 

+int real sub :

+    IF left type = int THEN int sub 

+                       ELSE real sub

+    FI .

+

+int real mult :

+    IF left type = int THEN int mult

+                       ELSE real mult

+    FI . 

+

+comp code : 

+    SELECT left type OF

+        CASE int    : IF opn.mod nr = q equal THEN q equ  ELSE q lsequ  FI 

+        CASE real   : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI

+        CASE string : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI

+        OTHERWISE errorstop (type error); q equ

+    ENDSELECT .

+

+left type : CONCR (left dtype)

+

+ENDPROC apply p3; 

+ 

+

+                      (***** Modul *****) 

+ 

+BOOL VAR module open ;

+

+.init opn section : 

+    module open := FALSE .;

+

+PROC begin module : 

+    IF module open THEN errorstop (nested module) 

+                   ELSE begin modul ; 

+                        module open := TRUE 

+    FI 

+ENDPROC begin module ; 

+ 

+PROC end module : 

+    IF NOT module open

+       THEN errorstop (module not opened) 

+       ELSE end modul ;

+            module open := FALSE

+    FI

+ENDPROC end module ; 

+

+TEXT PROC dump (OPN CONST operation) : 

+    IF   operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) 

+    ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation)

+                                  ELSE " undef. Opn" 

+    FI 

+ENDPROC dump ; 

+ 

+PROC begin modul :

+    EXTERNAL 10071

+ENDPROC begin modul ; 

+ 

+PROC end modul :

+    EXTERNAL 10011

+ENDPROC end modul ; 

+ 

+PROC proc head (INT VAR mod nr, top of stack) :

+    EXTERNAL 10012

+ENDPROC proc head ; 

+ 

+PROC set length (INT CONST top of stack, size) : 

+    EXTERNAL 10013

+ENDPROC set length ; 

+ 

+PROC get module nr (INT VAR module nr) : 

+    EXTERNAL 10016

+ENDPROC get module nr ; 

+ 

+PROC compute (INT CONST op code, l addr, r addr, result address) :

+    EXTERNAL 10017

+ENDPROC compute ; 

+ 

+PROC compare (INT CONST op code, l addr, r addr) :

+    EXTERNAL 10018

+ENDPROC compare ; 

+ 

+PROC long move (INT CONST to, from, length) :

+    EXTERNAL 10019

+ENDPROC long move ;

+

+PROC put next permanent (INT CONST permanent value) : 

+    EXTERNAL 10020

+ENDPROC put next permanent ; 

+ 

+PROC call (INT CONST mod nr) : 

+    EXTERNAL 10022

+ENDPROC call ; 

+ 

+PROC call param (INT CONST mod nr) : 

+    EXTERNAL 10023

+ENDPROC call param ; 

+ 

+PROC push param (INT CONST addr) : 

+    EXTERNAL 10024

+ENDPROC push param ; 

+ 

+PROC push param proc (INT CONST mod nr) : 

+    EXTERNAL 10025

+ENDPROC push param proc ; 

+ 

+PROC init param push (INT CONST mod nr) : 

+    EXTERNAL 10026

+ENDPROC init param push ; 

+ 

+PROC push result address (INT CONST addr) : 

+    EXTERNAL 10027

+ENDPROC push result address ; 

+ 

+PROC test bool object (INT CONST addr) : 

+    EXTERNAL 10186

+ENDPROC test bool object ; 

+ 

+PROC mark line (INT CONST line number) : 

+    EXTERNAL 10030

+ENDPROC mark line ; 

+ 

+PROC s0 (INT CONST op code) : 

+    EXTERNAL 10038

+ENDPROC s0 ; 

+ 

+PROC s1 (INT CONST op code, addr) : 

+    EXTERNAL 10039

+ENDPROC s1 ; 

+ 

+PROC s2 (INT CONST op code , addr1, addr2) : 

+    EXTERNAL 10040

+ENDPROC s2 ; 

+ 

+PROC s3 (INT CONST op code, addr1, addr2, addr3) : 

+    EXTERNAL 10041

+ENDPROC s3 ; 

+ 

+PROC t1 (INT CONST op code, addr) : 

+    EXTERNAL 10042

+ENDPROC t1 ; 

+ 

+PROC t2 (INT CONST op code, addr1, addr2) : 

+    EXTERNAL 10043

+ENDPROC t2 ; 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                  9. Speicherverwaltung                     21.03.1986  *) 

+(*                                                                        *) 

+(*   Ablage der Paketdaten                                                *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+

+

+INT VAR address value;

+ 

+INT CONST data allocation by coder  := 1 , 

+          data allocation by user   := 2 ; 

+

+LET not initialized      = 0 ,

+    wrong mm mode        = "Wrong MM Mode" ,

+    define on non global = "Define for GLOB only" ,

+    text too long        = "TEXT too long" ;

+ 

+TEXT VAR const buffer :: point line ;

+

+.reset memory management mode :

+     memory management mode := not initialized . ;

+ 

+PROC reserve storage (INT CONST size) : 

+    IF memory management mode <> data allocation by user 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (address value, size) ; 

+    memory management mode := not initialized

+ENDPROC reserve storage ; 

+ 

+PROC allocate variable (ADDRESS VAR addr, INT CONST size) : 

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate var (addr.value, size) ;

+    addr.kind := global

+ENDPROC allocate variable ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, INT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate int denoter (addr.value) ;

+    put data word (value, addr.value) ;

+    addr.kind := global

+ENDPROC allocate denoter ; 

+

+PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate real denoter (addr.value) ;

+    addr.kind := global ;

+    define (addr, value)

+ENDPROC allocate denoter ; 

+ 

+PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) :

+    IF memory management mode <> data allocation by coder 

+       THEN errorstop (wrong mm mode) 

+    FI ; 

+    allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; 

+    addr.kind := global ;

+    skip heaplink; 

+    define (addr, value) ; 

+    reset heaplink .

+ 

+skip heaplink : 

+    addr.value INCR 1 .

+

+reset heaplink :

+    addr.value DECR 1

+ENDPROC allocate denoter ; 

+ 

+PROC define (ADDRESS CONST addr, INT CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    put data word (value, addr.value) 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, REAL CONST value) : 

+    IF addr.kind <> global 

+       THEN errorstop (define on non global) 

+    FI ; 

+    replace (const buffer, 1, value) ; 

+    address value := addr.value ;

+    FOR index FROM 1 UPTO 4 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER 

+ENDPROC define ; 

+ 

+PROC define (ADDRESS CONST addr, TEXT CONST value) : 

+    IF   addr.kind <> global THEN errorstop (define on non global) 

+    ELIF LENGTH value > 255  THEN errorstop (text too long)

+    FI ; 

+    address value := addr.value ;

+    const buffer := code (LENGTH value) ; 

+    const buffer CAT value ; 

+    const buffer CAT " " ;

+    FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP 

+        put data word (const buffer ISUB index, address value) ;

+        address value INCR 1

+    PER ; 

+    const buffer := point line

+ENDPROC define ; 

+ 

+PROC prep pbase (INT VAR offset) : 

+    EXTERNAL 10032 

+ENDPROC prep pbase; 

+ 

+PROC allocate var (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10033

+ENDPROC allocate var ; 

+ 

+PROC allocate int denoter (INT VAR addr) : 

+    EXTERNAL 10034

+ENDPROC allocate int denoter ;

+ 

+PROC allocate real denoter (INT VAR addr) : 

+    EXTERNAL 10035 

+ENDPROC allocate real denoter ;

+

+PROC allocate text denoter (INT VAR addr, INT CONST length) : 

+    EXTERNAL 10036 

+ENDPROC allocate text denoter ;

+ 

+PROC put data word (INT CONST value, INT CONST addr) :

+    EXTERNAL 10037

+ENDPROC put data word ; 

+ 

+ 

+#page#

+(**************************************************************************) 

+(*                                                                        *) 

+(*                 10. Inspector                              08.01.1986  *) 

+(*                                                                        *) 

+(**************************************************************************) 

+

+TEXT VAR type and mode ;

+ 

+TEXT PROC type name (DTYPE CONST type) : 

+    type and mode := "" ; 

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC type name ; 

+ 

+TEXT PROC dump (DTYPE CONST type) :

+    type and mode := "TYPE " ;

+    name of type (CONCR (type)) ; 

+    type and mode

+ENDPROC dump ;

+

+PROC name of type (INT CONST type) :

+            SELECT type OF

+     CASE void              :

+     CASE int               : type and mode CAT "INT"

+     CASE real              : type and mode CAT "REAL"

+     CASE string            : type and mode CAT "TEXT"

+     CASE bool, bool result : type and mode CAT "BOOL"

+     CASE dataspace         : type and mode CAT "DATASPACE"

+     OTHERWISE              : complex type

+            ENDSELECT .

+

+complex type :

+     IF type > ptt limit THEN perhaps permanent struct or row

+                         ELSE get complex type

+     FI .

+

+perhaps permanent struct or row :

+     index := type + begin of pt minus ptt limit ;

+     mode := cdb int (index) MOD ptt limit ;

+     IF   mode = permanent row    THEN get permanent row 

+     ELIF mode = permanent struct THEN get permanent struct

+                                  ELSE type and mode CAT "-"

+     FI .

+

+get complex type :

+     index := type + begin of permanent table ;

+     IF is complex type THEN get name

+                        ELSE type and mode CAT "-"

+     FI .

+

+is complex type :

+     permanent type definition mode = permanent type .

+

+get name :

+     type and mode CAT cdb text (link to type name + two word length) .

+

+link to type name :

+     cdb int (index + three word length) .

+

+permanent type definition mode :

+     cdb int (index + wordlength) .

+

+get permanent row :

+     INT VAR t; 

+     type and mode CAT "ROW " ;

+     type and mode CAT text (cdb int (index + wordlength)) ;

+     type and mode CAT " " ;

+     param link := index + two wordlength ;

+     get type and mode (t) ;

+     name of type (t) .

+ 

+get permanent struct :

+     type and mode CAT "STRUCT ( ... )" 

+ENDPROC name of type ;

+

+ENDPACKET eumel coder ; 

diff --git a/system/eumel-coder/1.8.0/src/eumel0 codes b/system/eumel-coder/1.8.0/src/eumel0 codes
new file mode 100644
index 0000000..428f71e
--- /dev/null
+++ b/system/eumel-coder/1.8.0/src/eumel0 codes
@@ -0,0 +1,50 @@
+LN 

+MOVE 

+INC1 

+DEC1 

+INC 

+DEC 

+ADD 

+SUB 

+CLEAR 

+TEST 

+EQU 

+LSEQU 

+FMOVE 

+FADD 

+FSUB 

+FMULT 

+FDIV 

+FLSEQU 

+TMOVE 

+TEQU 

+ACCDS 

+REF 

+SUBSCRIPT 

+SELECT 

+PPV 

+PP 

+MAKE_FALSE 

+MOVEX 

+RETURN 

+TRUE_RETURN 

+FALSE_RETURN 

+ESC_MULT 

+ESC_DIV 

+ESC_MOD 

+PPROC 

+COMPL_INT 

+COMPL_REAL 

+ALIAS_DS 

+MOVIM 

+FEQU 

+TLSEQU 

+CASE 

++ 

+- 

+* 

+DIV 

+/ 

+= 

+<= 

+

diff --git a/system/eumel-coder/1.8.1/source-disk b/system/eumel-coder/1.8.1/source-disk
new file mode 100644
index 0000000..972580b
--- /dev/null
+++ b/system/eumel-coder/1.8.1/source-disk
@@ -0,0 +1 @@
+debug/eumel-coder-1.8.1.img
diff --git a/system/eumel-coder/1.8.1/src/eumel coder 1.8.1 b/system/eumel-coder/1.8.1/src/eumel coder 1.8.1
new file mode 100644
index 0000000..0047067
--- /dev/null
+++ b/system/eumel-coder/1.8.1/src/eumel coder 1.8.1
@@ -0,0 +1,3086 @@
+PACKET eumel coder                                 (* Autor: U. Bartling *) 
+       DEFINES coder on, coder off,
+               declare, define, apply, identify,
+               :=, =,
+               dump,
+ 
+               LIB,
+
+               LABEL,
+               gosub, goret,
+               computed branch,
+               complement condition code,
+
+               ADDRESS ,
+               GLOB, LOC, REF, DEREF,
+               ref length,
+               +, 
+               adjust,
+               get base,
+               is global, is local, is ref,
+ 
+               DTYPE, 
+               type class, type name,
+               void type, int type, real type, text type, bool type, 
+               bool result type, dataspace type, undefined type, 
+               row type, struct type, proc type, end type,
+ 
+               OPN, 
+               set length of local storage, 
+               begin module, end module, 
+               is proc, is eumel 0 instruction,
+               address, operation,
+               nop, 
+               mnemonic, 
+
+               parameter,
+               next param,
+               NEXTPARAM, 
+               access , 
+               dtype , 
+               param address,
+               same type ,
+ 
+               reserve storage, 
+               allocate denoter , 
+               allocate variable, 
+               data allocation by coder ,
+               data allocation by user,
+ 
+               run, run again, 
+               insert,
+               prot, prot off,
+               check, check on, check off,
+
+               help, bulletin, packets,
+
+(**************************************************************************)
+(*                                                                        *) 
+(*                         E U M E L  -  C O D E R                        *) 
+(*                                                                        *) 
+(*                                                                        *) 
+(*   Zur Beschreibung des Coders siehe                                    *) 
+(*         U.Bartling, J. Liedtke: EUMEL-Coder-Interface                  *) 
+(*                                                                        *) 
+(*   Stand der Dokumentation  : 29.10.1986                                *) 
+(*   Stand der Implementation : 03.09.1986                                *) 
+(*                                                                        *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  0. Datentyp DINT                          03.09.1987  *) 
+(*                                                                        *) 
+(*   Definition    des Datentyps                                          *) 
+(*                 arithmetischer Operationen                             *) 
+(*            und  Konvertierungsprozeduren                               *) 
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+               DINT,
+               -, *, DIV, MOD, <, <=,
+               AND, OR, XOR,
+               dput, dget, dmov,
+               ddec1, dinc1, dinc, ddec,
+               dadd, dsub,
+               dequ, dlseq,
+               INCR, DECR,
+               put, get, cout,
+               text, real, int, dint,
+               replace, DSUB :
+ 
+ 
+TYPE DINT = STRUCT (INT low, high) ; 
+
+
+REAL VAR   real value ;           (* auch fuer Ausrichtung ! *)
+TEXT VAR convertion buffer ;
+
+DINT CONST dint0 :: dint(0) ;
+DINT VAR result  :: dint 0 ;
+  
+ 
+DINT PROC dint (INT CONST number) : 
+    EXTERNAL 144
+ENDPROC dint ; 
+
+INT PROC int (DINT CONST i) : 
+    EXTERNAL 143
+ENDPROC int;
+
+REAL PROC real (DINT CONST number) : 
+    real value := 65536.0 * real (number.high) ; 
+
+    IF   number.low >= 0 
+    THEN real value INCR real (number.low) 
+    ELSE real value INCR (real (number.low AND maxint) + 32768.0) 
+    FI ; 
+    real value
+ENDPROC real ; 
+
+DINT PROC dint (REAL CONST number) : 
+    real value := abs (number) ;
+    REAL CONST low := real value MOD 65536.0 ; 
+   
+    result.high := int(real value / 65536.0) ; 
+    IF   low < 32768.0 
+    THEN result.low := int (low)
+    ELSE result.low := int (low-32768.0) OR minint
+    FI ;
+    IF number < 0.0 THEN dsub (dint0, result, result) FI ;
+    result
+ENDPROC dint ; 
+
+TEXT PROC text (DINT CONST number) :
+    IF number.high = 0 THEN convert low part only
+                       ELSE convert number 
+    FI ; 
+    convertion buffer .
+ 
+convert low part only : 
+    IF number.low >= 0 THEN convertion buffer := text (number.low) 
+                       ELSE convertion buffer := text (real of low) ;
+                            erase decimal point
+    FI . 
+
+real of low : 
+    real (number.low AND maxint) + 32768.0 .
+
+convert number : 
+    convertion buffer := text (real(number)) ;
+    erase decimal point .
+
+erase decimal point :
+    convertion buffer := subtext (convertion buffer, 1, LENGTH convertion buffer-2)
+ENDPROC text;
+
+DINT PROC dint (TEXT CONST dint txt) :
+    convertion buffer := dint txt ;
+    INT CONST dot pos :: pos (convertion buffer, ".") ; 
+    IF dot pos = 0 THEN convertion buffer CAT ".0" FI ;
+    dint (real(convertion buffer))
+ENDPROC dint ;
+
+PROC get (DINT VAR dest) : 
+    REAL VAR number ;
+    get (number) ;
+    dest := dint (number)
+ENDPROC get ; 
+
+PROC put (DINT CONST number) : 
+    put (text (number));
+ENDPROC put ; 
+
+PROC cout (DINT CONST number) : 
+    EXTERNAL 61
+ENDPROC cout;
+
+OP := (DINT VAR a, DINT CONST b) : 
+#   INLINE ;   #
+    dmov (b, a); 
+ENDOP :=;
+
+OP INCR (DINT VAR a, DINT CONST b) : 
+#   INLINE ;   #
+    dinc (b, a); 
+ENDOP INCR;
+ 
+OP DECR (DINT VAR a, DINT CONST b) : 
+#   INLINE ;   #
+    ddec (b, a); 
+ENDOP DECR;
+
+BOOL OP = (DINT CONST a, b) : 
+    EXTERNAL 137 
+ENDOP =;
+
+BOOL OP <= (DINT CONST a, b) : 
+    EXTERNAL 138 
+ENDOP <=;
+
+BOOL OP < (DINT CONST a, b) :
+#   INLINE ;   #
+    NOT (b <= a)
+ENDOP <;
+
+BOOL PROC dequ (DINT CONST a, b) : 
+    EXTERNAL 137 
+ENDPROC dequ ;
+
+BOOL PROC dlseq (DINT CONST a, b) : 
+    EXTERNAL 138 
+ENDPROC dlseq ;
+
+PROC replace (TEXT VAR text, INT CONST index of dint, DINT CONST value) :
+    INT VAR subscript := index of dint * 2 ;
+    replace (text, subscript - 1,value.low); 
+    replace (text, subscript, value.high); 
+ENDPROC replace;
+
+DINT OP DSUB (TEXT CONST text, INT CONST index of dint) : 
+    INT  VAR subscript := index of dint * 2 ;
+    result.low  := text ISUB subscript - 1; 
+    result.high := text ISUB subscript;
+    result
+ENDOP DSUB;
+
+DINT OP + (DINT CONST a, b) :
+    EXTERNAL 135 
+ENDOP + ;
+ 
+DINT OP - (DINT CONST a, b) :
+    EXTERNAL 136 
+ENDOP - ;
+
+PROC dadd (DINT CONST a, b, DINT VAR res) :
+    EXTERNAL 135 
+ENDPROC dadd ;
+ 
+PROC dsub (DINT CONST a, b, DINT VAR res) :
+    EXTERNAL 136
+ENDPROC dsub ;
+
+PROC dinc (DINT CONST source, DINT VAR dest) : 
+    EXTERNAL 133 
+ENDPROC dinc ; 
+ 
+PROC ddec (DINT CONST source, DINT VAR dest) : 
+    EXTERNAL 134 
+ENDPROC ddec ; 
+ 
+PROC dmov (DINT CONST source, DINT VAR dest) : 
+    EXTERNAL 130 
+ENDPROC dmov; 
+
+DINT OP DIV (DINT CONST a,b) :
+    EXTERNAL 152
+ENDOP DIV ;
+
+DINT OP MOD (DINT CONST a,b) :
+    EXTERNAL 153
+ENDOP MOD ;
+
+DINT OP AND (DINT CONST a,b) :
+    result.low  := a.low  AND b.low ;
+    result.high := a.high AND b.high ;
+    result
+ENDOP AND ;
+
+DINT OP OR (DINT CONST a,b) :
+    result.low  := a.low  OR b.low ;
+    result.high := a.high OR b.high ;
+    result
+ENDOP OR ;
+
+DINT OP XOR (DINT CONST a,b) :
+    result.low  := a.low  XOR b.low ;
+    result.high := a.high XOR b.high ;
+    result
+ENDOP XOR ;
+
+PROC dput (ROW 32000 DINT VAR array, DINT CONST index, value) : 
+    EXTERNAL 139 
+ENDPROC dput ; 
+ 
+PROC dget (ROW 32000 DINT VAR array, DINT CONST index, DINT VAR dest) : 
+    EXTERNAL 140 
+ENDPROC dget ; 
+
+PROC dinc1 (DINT VAR dest) : 
+    EXTERNAL 131 
+ENDPROC dinc1 ; 
+ 
+PROC ddec1 (DINT VAR dest) :
+    EXTERNAL 132 
+ENDPROC ddec1 ; 
+
+DINT OP * (DINT CONST a,b) :
+    EXTERNAL 151
+ENDOP * ; 
+
+#page#
+                   (***** Globale Variable *****) 
+
+TEXT VAR object name;
+ 
+FILE VAR bulletin file; 
+ 
+INT VAR memory management mode, global address offset, packet base,
+        hash table pointer, nt link, permanent pointer, param link,
+        packet link, index, mode, field pointer, word,
+        number of errors := 0 ;
+ 
+BOOL VAR found, end of params;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  1. Interface zum ELAN-Compiler            13.11.1986  *) 
+(*                              1.8.1                                     *) 
+(*                                                                        *) 
+(*   Beschreibung der      Tabellen (-groessen),                          *) 
+(*                         internen Vercodung von Typen                   *) 
+(*                    und  Kennungen .                                    *) 
+(*   Initialisieren und Beenden des Compilers,                            *) 
+(*   Lesen aus und Schreiben in Namens- bzw. Permanent-Tabelle            *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+
+TYPE LIB = STRUCT (TEXT name, INT nt link, pt link, ADDRESS base) ;
+
+LET  begin of hash table         =     0 ,
+     end of hash table           =  1023 ,
+ 
+     begin of permanent table    = 22784 ,
+       before first pt entry     = 22784 ,
+       first permanent entry     = 22785 ,
+     end of permanent table      = 32767 , 
+
+     wordlength                  =     1 ,  (* compile  u n d  run time *)
+     two word length             =     2 ,
+     three word length           =     3 ,
+     four word length            =     4 ,
+ 
+     permanent param const             = 10000 ,
+     permanent param var               = 20000 ,
+     permanent proc op                 = 30000 ,
+     permanent type                    = 30000 ,
+     permanent row                     =    10 ,
+     permanent struct                  =    11 ,
+     permanent param proc              =    12 ,
+     permanent param proc end marker   =     0 ,
+     permanent type field              =     0 ,
+
+     ptt limit                         = 10000 ,
+     begin of pt minus ptt limit       = 12784 ,
+     begin of pt minus ptt limit 1     = 12785 , (* plus wordlength *)
+ 
+     void id                           =     0 ,
+     int id                            =     1 ,
+     real id                           =     2 ,
+     string id                         =     3 ,
+     bool id                           =     5 ,
+     bool result id                    =     6 ,
+     dataspace id                      =     7 ,
+     undefined id                      =     9 ,
+     row id                            =    10 ,
+     struct id                         =    11 ,
+     end id                            =     0 ,
+
+     const                             =     1 , 
+     var                               =     2 ,
+     proc id                           =     3 ,
+(*   denoter                           =     5 , *)
+     bold                              =     2 ,
+ 
+     ins                               = TRUE ,
+     no ins                            = FALSE ,
+     no lst                            = FALSE ,
+     sermon                            = TRUE  ,
+     no sermon                         = FALSE ,
+ 
+     run again mode                    =     0 ,
+     compile file mode                 =     1 ,
+     prep coder mode                   =     5 , 
+
+     warning message                   =     2 , 
+     error message                     =     4 ,
+ 
+     point line                        = "..............." ;
+ 
+INT CONST permanent packet            :=     -2 ,
+          permanent end               :=     -3 ;
+
+BOOL VAR coder active                 := FALSE ; 
+
+INT  VAR run again mod nr             :=     0 ;
+ 
+ 
+                     (***** Start/Ende *****)
+ 
+LET coder not active      = "CODER not active" ,
+    illegal define packet = "illegal define packet" ;
+
+PROC coder on (INT CONST data allocation mode) : 
+    mark coder on ; 
+    init opn section ; 
+    init compiler ;
+    init memory management .
+ 
+mark coder on :
+    coder active := TRUE .
+
+init memory management :
+    memory management mode := data allocation mode .
+ 
+init compiler :
+    no do again ;
+    elan (prep coder mode, bulletin file, "", run again mod nr,
+          no ins, no lst, check option, no sermon)
+
+ENDPROC coder on;
+ 
+PROC coder off (BOOL CONST insert, sermon, OPN CONST start proc) :
+    IF coder active 
+       THEN mark coder off ; 
+            end coder (insert, sermon, start mod nr if no insert)
+       ELSE errorstop (coder not active)
+    FI .
+ 
+start mod nr if no insert :
+    IF insert THEN run again mod nr := 0
+              ELSE run again mod nr := start proc.mod nr
+    FI ;
+    run again mod nr .
+
+mark coder off :
+    reset memory management mode ;
+    init opn section ;
+    coder active := FALSE
+ENDPROC coder off ; 
+ 
+PROC end coder (BOOL CONST insert wanted, sermon wanted, INT CONST mod) :
+    EXTERNAL 10021
+ENDPROC end coder ; 
+
+PROC elan (INT CONST mode, FILE VAR source, TEXT CONST line, 
+           INT VAR start module number, BOOL CONST ins, lst, rtc, ser) :
+  EXTERNAL 256
+ENDPROC elan ;
+
+PROC unsigned arithmetic : 
+    EXTERNAL 92 
+ENDPROC unsigned arithmetic ;
+ 
+
+                   (*****    Paket-Rahmen    *****)
+
+PROC declare (TEXT CONST name, LIB VAR packet) :
+    packet.name := name
+ENDPROC declare ;
+
+PROC define (LIB VAR packet) :
+    check if definition possible ;
+    declare object (packet.name, packet.nt link, packet.pt link) ;
+    open packet (packet.nt link, global address offset, packet base) ;
+    set to actual base (packet) .
+
+check if definition possible :
+    IF NOT coder active THEN errorstop (coder not active) FI ;
+    IF module open      THEN errorstop (illegal define packet) FI
+ENDPROC define ;
+
+PROC open packet (INT CONST nt link of packet name, INT VAR offset, base) :
+    EXTERNAL 10032 
+ENDPROC open packet ;
+
+PROC identify (TEXT CONST name, LIB VAR packet, BOOL VAR packet exists) :
+     to packet (name) ;
+     packet exists := found ;
+     IF found THEN packet.name    := name ;
+                   packet.nt link := nt link ;
+                   packet.pt link := packet link ;
+                   get pbas (packet.base)
+     FI
+ENDPROC identify ;
+
+ 
+                   (***** Hash/Namenstabelle *****) 
+.
+next hash entry :
+     hash table pointer INCR wordlength .
+
+end of hash table reached :
+     hash table pointer > end of hash table .
+
+yet another nt entry :
+     nt link := cdb int (nt link) ;
+     nt link <> 0 . ;
+ 
+PROC declare object (TEXT CONST name, INT VAR nt link, pt pointer) : 
+    EXTERNAL 10031
+ENDPROC declare object ; 
+ 
+PROC to object (TEXT CONST searched object) : 
+     hash ;
+     search nt entry .
+
+hash :
+     hash code := 0 ;
+     FOR index FROM 1 UPTO LENGTH searched object REP
+         addmult cyclic
+     ENDREP .
+
+addmult cyclic :
+     hash code INCR hash code ;
+     IF hash code > end of hash table THEN wrap around FI ;
+     hash code := (hash code + code (searched object SUB index)) MOD 1024 .
+
+wrap around :
+     hash code DECR end of hash table .
+
+hash code : nt link .
+
+search nt entry :
+     found := FALSE ;
+     WHILE yet another nt entry REP
+          read current entry ;
+          IF object name = searched object 
+             THEN found := TRUE ;
+                  LEAVE to object
+          FI
+     PER .
+
+read current entry :
+     permanent pointer := cdb int (nt link + wordlength) ;
+     object name := cdb text (nt link + two word length)
+ENDPROC to object ;
+
+
+                 (***** Permanent Tabelle *****) 
+.
+next procedure :
+     permanent pointer := cdb int (permanent pointer) . ;
+
+PROC next pt param :
+     mode := cdb int (param link) MOD ptt limit ;
+     param link INCR wordlength ;
+     IF   mode = permanent row    THEN skip over permanent row 
+     ELIF mode = permanent struct THEN skip over permanent struct
+     FI ;
+     set end marker if end of list .
+
+skip over permanent row :
+     param link INCR wordlength ;
+     next pt param .
+
+skip over permanent struct :
+     REP
+         mode := cdb int (param link) ;
+         IF mode = permanent type field
+            THEN param link INCR wordlength ;
+                 LEAVE skip over permanent struct
+         FI ;
+         next pt param
+     PER
+ENDPROC next pt param ;
+
+PROC set end marker if end of list :
+     mode := cdb int (param link) ;
+     end of params := mode >= permanent proc op OR mode <= 0 
+ENDPROC set end marker if end of list ;
+
+PROC get type and mode (INT VAR type) : 
+     mode := cdb int (param link) ;
+     IF   mode < 0                    THEN type := 2769 + (32767 + mode) ;
+                                           mode := 0
+     ELIF mode = permanent param proc THEN translate type
+                                      ELSE type := mode MOD ptt limit ;
+                                           mode DECR type ;
+                                           translate type if necessary ;
+                                           translate mode if necessary 
+     FI .
+
+translate type if necessary :
+     IF permanent row or struct THEN translate type FI .
+
+translate type :
+     type := param link - begin of pt minus ptt limit .
+
+translate mode if necessary : 
+    IF   mode = permanent param const THEN mode := const
+    ELIF mode = permanent param var   THEN mode := var
+    FI .
+
+permanent row or struct :
+     type = permanent row OR type = permanent struct
+ENDPROC get type and mode ;
+
+PROC put next permanent (INT CONST permanent value) : 
+    EXTERNAL 10020
+ENDPROC put next permanent ; 
+ 
+
+                 (***** Allgemeine Zugriffsprozeduren *****) 
+
+INT PROC cdb int (INT CONST index) :
+   EXTERNAL 116
+ENDPROC cdb int ;
+
+TEXT PROC cdb text (INT CONST index) :
+   EXTERNAL 117
+ENDPROC cdb text ;
+ 
+
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  2. Spruenge und Marken                    07.10.1986  *) 
+(*                                                                        *) 
+(*   Definition des Datentyps LABEL                                       *) 
+(*                                                                        *) 
+(*   Deklaration, Definition und Applikation von Marken                   *) 
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+TYPE LABEL = INT ; 
+
+BOOL VAR invers :: FALSE ; 
+ 
+PROC declare (LABEL VAR label) : 
+    CONCR (label) := 0
+ENDPROC declare ; 
+ 
+PROC define (LABEL VAR label) : 
+    EXTERNAL 10085
+ENDPROC define ; 
+ 
+PROC complement condition code : 
+    invers := NOT invers
+ENDPROC complement condition code ; 
+ 
+PROC apply (LABEL VAR label) : 
+    EXTERNAL 10151
+ENDPROC apply ; 
+ 
+PROC apply (LABEL VAR label, BOOL CONST condition) : 
+    IF condition xor invers THEN branch true (label) 
+                            ELSE branch false (label)
+    FI ;
+    invers := FALSE .
+
+condition xor invers : 
+    IF condition THEN NOT invers
+                 ELSE invers
+    FI
+ENDPROC apply ; 
+ 
+OP := (LABEL VAR global label, local label) : (* EQUATE ! *)
+    EXTERNAL 10014 
+ENDOP := ; 
+ 
+TEXT PROC dump (LABEL CONST label) : 
+    "LAB " + text (CONCR (label)) 
+ENDPROC dump ; 
+ 
+PROC gosub (LABEL VAR label) : 
+    EXTERNAL 10015 
+ENDPROC gosub ; 
+ 
+PROC goret : 
+    s0 (q goret code) 
+ENDPROC goret ; 
+ 
+PROC branch true (LABEL VAR label) : 
+    EXTERNAL 10028
+ENDPROC branch true ; 
+ 
+PROC branch false (LABEL VAR label) : 
+    EXTERNAL 10029
+ENDPROC branch false ; 
+
+PROC computed branch (ADDRESS CONST switch, INT CONST limit, LABEL VAR out) :
+    s1 (q esc case, REPR switch) ;
+    s0 (limit) ; 
+    branch false (out)
+ENDPROC computed branch ;
+ 
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  3. Datenaddressen                         13.11.1986  *) 
+(*                                                                        *) 
+(*   Definition des Datentyps ADDRESS                                     *) 
+(*                                                                        *) 
+(*   Aufbau von Datenaddressen (Vercodung)                                *) 
+(*   Fortschalten und Ausrichten von Adressen                             *) 
+(*   Behandlung von Paketbasis-Adressen                                   *) 
+(*   Bereitstellen der Fehlermeldung "address overflow" (Coder-intern)    *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+ 
+TYPE ADDRESS = STRUCT (INT kind, value) ; 
+ 
+LET global                 = 0 , 
+    local                  = 1 , 
+    ref mask               = 2 , 
+    global ref             = 2 , 
+    local ref              = 3 , 
+    module nr              = 4 ,
+    immediate value        = 5 ,
+    p base                 = 6 ,
+ 
+    eumel0 stack offset    = 4 ,
+    local address limit    = 16 384 ,
+    global address zero    = 0 ,
+ 
+    illegal ref operation  = "REF not allowed" , 
+    deref on non ref       = "DEREF on non-ref address" ,
+    global ref not allowed = "GLOBAL REF not allowed" , 
+    unknown kind           = "Unknown address kind" , 
+    address overflow       = "Address Overflow" , 
+    illegal plus operation = "+ not allowed" ;
+ 
+ADDRESS VAR result addr;
+ 
+INT CONST ref length :: 2 ;
+
+OP := (ADDRESS VAR l, ADDRESS CONST r) : 
+    CONCR (l) := CONCR (r) 
+ENDOP := ; 
+ 
+ADDRESS OP GLOB (INT CONST address level) : 
+    result addr.kind  := global ; 
+    result addr.value := address level ; 
+    IF memory management mode = data allocation by user
+       THEN result addr.value INCR global address offset
+    FI ;
+    result addr
+ENDOP GLOB ;
+
+ADDRESS OP LOC (INT CONST address level) : 
+    result addr.kind  := local ;
+    result addr.value := address level + eumel0 stack offset ; 
+    result addr
+ENDOP LOC ; 
+ 
+ADDRESS OP REF (ADDRESS CONST addr) : 
+    CONCR (result addr) := CONCR (addr) ;
+    IF   result addr.kind = local  THEN result addr.kind INCR ref mask
+    ELIF result addr.kind = global THEN errorstop (global ref not allowed)
+                                   ELSE errorstop (illegal ref operation)
+    FI ;
+    result addr 
+ENDOP REF ; 
+ 
+ADDRESS OP DEREF (ADDRESS CONST ref address) : 
+    CONCR (result addr) := CONCR (ref address) ;
+    IF is not local ref THEN errorstop (deref on non ref) FI ; 
+    result addr.kind DECR ref mask ; 
+    result addr .
+ 
+is not local ref :
+    result addr.kind <> local ref
+ENDOP DEREF ;
+ 
+INT OP REPR (ADDRESS CONST addr) : 
+    CONCR (result addr) := CONCR (addr) ;
+    SELECT result addr.kind OF 
+        CASE global     :
+        CASE local      : set bit (result addr.value, 15) 
+        CASE global ref : errorstop (global ref not allowed)
+        CASE local ref  : prep local ref 
+        OTHERWISE errorstop (unknown kind)
+    ENDSELECT ; 
+    result addr.value .
+ 
+prep local ref : 
+    IF address limit exceeded THEN errorstop (address overflow) FI ;
+    set bit (result addr.value, 14) ; 
+    set bit (result addr.value, 15) .
+
+address limit exceeded :
+    result addr.value < eumel0 stack offset OR
+    result addr.value > local address limit
+ENDOP REPR ; 
+ 
+PROC get base (LIB CONST packet, ADDRESS VAR base) :
+    CONCR (base) := CONCR (packet.base)
+ENDPROC get base ;
+
+PROC set to actual base (LIB VAR packet) :
+    packet.base.kind  := p base ;
+    packet.base.value := packet base
+ENDPROC set to actual base ;
+
+PROC get pbas (ADDRESS VAR base) :
+    base.kind  := p base ;
+    base.value := cdbint (packet link + 2)
+ENDPROC get pbas ;
+
+BOOL OP = (ADDRESS CONST l,r) :
+    l.kind = r.kind AND l.value = r.value
+ENDOP = ;
+
+BOOL PROC is ref (ADDRESS CONST addr) : 
+    addr.kind = local ref
+ENDPROC is ref ; 
+ 
+BOOL PROC is global (ADDRESS CONST addr) : 
+    addr.kind = global 
+ENDPROC is global ; 
+ 
+BOOL PROC is local (ADDRESS CONST addr) : 
+    addr.kind = local 
+ENDPROC is local ; 
+ 
+ADDRESS OP + (ADDRESS CONST addr, INT CONST offset) : 
+    CONCR (result addr) := CONCR (addr) ; 
+    SELECT result addr.kind OF 
+        CASE global : inc global
+        CASE local  : inc local
+        OTHERWISE     errorstop (illegal plus operation) 
+    ENDSELECT ; 
+    result addr .
+
+inc global : 
+    result addr.value INCR offset ; 
+    IF result addr.value < 0 THEN errorstop (address overflow) FI .
+ 
+inc local : 
+    result addr.value INCR offset ; 
+    IF result addr.value < eumel 0 stack offset OR
+       result addr.value > local address limit
+       THEN errorstop (address overflow)
+    FI
+ENDOP + ; 
+ 
+PROC adjust (ADDRESS VAR addr, INT CONST adjust length) :
+    IF is local or global THEN adjust to length FI . 
+ 
+is local or global :
+    addr.kind <= local .
+
+adjust to length :
+    mode := addr.value MOD adjust length ;
+    IF mode <> 0 THEN addr.value INCR (adjust length-mode) FI
+ENDPROC adjust ;
+
+TEXT PROC dump (ADDRESS CONST addr) : 
+    kind + text (addr.value) . 
+ 
+kind : 
+    SELECT addr.kind OF 
+        CASE global          : "GLOBAL " 
+        CASE local           : "LOCAL " 
+        CASE immediate value : "IMMEDIATE "
+        CASE module nr       : "PARAM PROC "
+        CASE global ref      : "GLOBAL REF " 
+        CASE local ref       : "LOCAL REF " 
+        CASE p base          : "PBAS "
+        OTHERWISE              "undef. Addr: " 
+    ENDSELECT 
+ENDPROC dump; 
+
+
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  4. Datentypen   Teil I                    08.09.1986  *) 
+(*                                                                        *) 
+(*   Definition des Datentyps DTYPE                                       *) 
+(*                                                                        *) 
+(*   Interne Repraesentation der primitiven Datentypen                    *) 
+(*   Identifikation von DTYPEs                                            *)
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+TYPE DTYPE = INT ; 
+ 
+OP := (DTYPE VAR l, DTYPE CONST r) : 
+    CONCR (l) := CONCR (r) 
+ENDOP := ; 
+ 
+BOOL OP = (DTYPE CONST l, r) : 
+    CONCR (l) = CONCR (r)
+ENDOP = ; 
+ 
+DTYPE PROC void type :      DTYPE :(void id)   ENDPROC  void type ; 
+ 
+DTYPE PROC int  type :      DTYPE :(int id)    ENDPROC  int type ; 
+ 
+DTYPE PROC real type :      DTYPE :(real id)   ENDPROC  real type ; 
+ 
+DTYPE PROC text type :      DTYPE :(string id) ENDPROC  text type ; 
+ 
+DTYPE PROC bool type :      DTYPE :(bool id)   ENDPROC  bool type ; 
+ 
+DTYPE PROC bool result type : DTYPE :(bool result id) ENDPROC  bool result type; 
+ 
+DTYPE PROC dataspace type : DTYPE :(dataspace id) ENDPROC dataspace type ; 
+ 
+DTYPE PROC undefined type : DTYPE :(undefined id) ENDPROC undefined type ; 
+ 
+DTYPE PROC row type  :      DTYPE :(row id)    ENDPROC row type ; 
+ 
+DTYPE PROC struct type :    DTYPE :(struct id) ENDPROC struct type ; 
+ 
+DTYPE PROC proc type :   DTYPE :(permanent param proc) ENDPROC proc type ; 
+ 
+DTYPE PROC end type  :      DTYPE :(end id)    ENDPROC end type ; 
+ 
+INT PROC type class (DTYPE CONST type) : 
+    SELECT type id OF 
+        CASE int id, real id, bool id, bool result id, string id,
+             dataspace id, undefined id : 1 
+        CASE void id   : 0 
+        CASE row id    : 3 
+        CASE struct id : 4 
+        CASE permanent param  proc : 5 
+        OTHERWISE     pt type 
+    ENDSELECT . 
+
+pt type :
+    IF type id > ptt limit THEN permanent row or struct
+                           ELSE abstract type
+    FI .
+
+abstract type : 2 .
+
+permanent row or struct :
+    unsigned arithmetic ;
+    mode := cdbint (type link into pt) MOD ptt limit ; 
+    IF   mode = struct id            THEN 4
+    ELIF mode = row id               THEN 3
+    ELIF mode = permanent param proc THEN 5
+                                     ELSE 2
+    FI .
+ 
+type link into pt :
+    type id + begin of pt minus ptt limit .
+
+type id : CONCR (type)
+ENDPROC type class ; 
+ 
+PROC identify (TEXT CONST name,INT VAR size, align, DTYPE VAR type) : 
+    SELECT type pos OF 
+          CASE 1   : size := 0; align := 0; type id := void id
+          CASE 6   : size := 1; align := 1; type id := int id
+          CASE 10  : size := 4; align := 4; type id := real id
+          CASE 15  : size := 8; align := 4; type id := string id
+          CASE 20  : size := 1; align := 1; type id := bool id
+          CASE 25  : size := 1; align := 1; type id := dataspace id
+          OTHERWISE  search for type in permanent table 
+    ENDSELECT . 
+ 
+type pos : 
+    enclose in delimiters ;
+    pos (".VOID.INT.REAL.TEXT.BOOL.DATASPACE.", object name) . 
+ 
+enclose in delimiters :
+    object name := "." ;
+    object name CAT name ;
+    object name CAT "." .
+
+search for type in permanent table : 
+    to object (name) ;
+    IF not found THEN size := 0; align := 0; type id := undefined id
+                 ELSE size := cdbint (permanent pointer + two wordlength) ;
+                      type id := permanent pointer - begin of permanent table ;
+                      IF   size < two wordlength  THEN align := 1
+                      ELIF size < four wordlength THEN align := 2
+                                                  ELSE align := 4
+                      FI
+    FI . 
+ 
+not found :
+    NOT found OR invalid entry .
+
+invalid entry :
+    permanent pointer = 0 OR
+    cdb int (permanent pointer + wordlength) <> permanent type .
+
+type id : CONCR (type)
+ENDPROC identify ; 
+ 
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  5. Operationen  Teil I                    30.09.1986  *) 
+(*                                                                        *) 
+(*   Definition des Datentyps OPN                                         *) 
+(*   Primitive Operationen (:=  etc.)                                     *) 
+(*   Initialisieren mit den externen Namen der EUMEL-0-Codes              *) 
+(*   Bereitstellen dee Fehlermeldung 'proc op expected' (coder-intern)    *) 
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+TYPE OPN = STRUCT (INT kind, mod nr, top of stack) ;
+ 
+LET proc op    = 0 ,
+    param proc = 1 ,
+    eumel 0    = 2 , 
+    nil        = 3 , 
+ 
+    param proc at non ref = "PARAM PROC at non-ref address" ,
+    proc op expected      = "PROC expected" ;
+ 
+OPN VAR eumel0 opn;
+eumel0 opn.kind := eumel0 ;
+eumel0 opn.top of stack := 0 ;
+
+eumel0 opn.mod nr := q pp ;
+OPN CONST pp       :: eumel0 opn ,
+          nop code :: OPN :(nil, 0, 0) ;
+
+IF NOT exists ("eumel0 codes")
+    THEN IF yes ("Archive 'eumel coder' eingelegt")
+             THEN archive ("eumel coder") ;
+                  fetch ("eumel0 codes", archive) ;
+                  release (archive)
+             ELSE errorstop ("""eumel0 codes"" gibt es nicht")
+         FI
+FI ;
+BOUND THESAURUS VAR initial opcodes :: old ("eumel0 codes") ;
+THESAURUS VAR eumel 0 opcodes :: initial opcodes ; 
+forget ("eumel0 codes") ;
+ 
+ADDRESS PROC address (OPN CONST opn) :
+    IF opn.kind <> proc op THEN errorstop (proc op expected) FI ;
+    result addr.kind  := module nr ; 
+    result addr.value := opn.mod nr ;
+    result addr
+ENDPROC address ;
+ 
+OPN PROC operation (ADDRESS CONST addr) : 
+    IF addr.kind <> local ref THEN errorstop (param proc at non ref) FI ; 
+    OPN VAR opn ;
+    opn.kind := param proc ; 
+    opn.mod nr :=addr.value ; 
+    opn.top of stack := 0 ; 
+    opn 
+ENDPROC operation ; 
+ 
+TEXT PROC mnemonic (OPN CONST op code) : 
+    name (eumel 0 opcodes, op code.mod nr)
+ENDPROC mnemonic ;
+ 
+OPN PROC nop : 
+    nop code
+ENDPROC nop ; 
+ 
+OP := (OPN VAR r, OPN CONST l) : 
+    CONCR (r) := CONCR (l) 
+ENDOP := ; 
+ 
+BOOL PROC is proc (OPN CONST operation) : 
+    operation.kind = proc op
+ENDPROC is proc ; 
+ 
+BOOL PROC is eumel 0 instruction (TEXT CONST op code name) : 
+    link (eumel 0 opcodes, op code name) <> 0
+ENDPROC is eumel 0 instruction ; 
+
+BOOL PROC is eumel 0 instruction (OPN CONST operation) : 
+    operation.kind = eumel0
+ENDPROC is eumel 0 instruction ; 
+ 
+
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  6. Parameterfeld                          10.04.1986  *) 
+(*                                                                        *) 
+(*   Bereitstellen des Parameterfeldes                                    *) 
+(*   Schreiben und Lesen von Eintraegen im Parameterfeld                  *) 
+(*   Fortschalten von Zeigern in das Parameterfeld                        *) 
+(*   Bereitstellen der Konstanten 'size of param field' (Coder-intern)    *) 
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+LET PARAMDESCRIPTOR = STRUCT (DTYPE type,   INT access, 
+                              ADDRESS addr, OPN push opn) , 
+ 
+    size of param field   = 100 ,
+    param field exceeded  = "Param Field Overflow",
+    param nr out of range = "Illegal Param Number" ;
+ 
+ROW size of param field PARAMDESCRIPTOR VAR param field ;
+ 
+ 
+                      (***** Schreiben *****) 
+ 
+PROC test param pos (INT CONST param nr) : 
+    IF param nr < 1 OR param nr > size of param field
+       THEN errorstop (param nr out of range)
+    FI 
+ENDPROC test param pos ; 
+ 
+PROC declare (INT CONST param nr, DTYPE CONST type) : 
+    test param pos (param nr) ; 
+    enter type . 
+ 
+enter type :
+    CONCR (param field [param nr].type) := CONCR (type) 
+ENDPROC declare ; 
+ 
+PROC declare (INT CONST param nr, access) : 
+    test param pos (param nr) ; 
+    enter access . 
+
+enter access :
+    param field [param nr].access := access 
+ENDPROC declare ; 
+ 
+PROC define (INT CONST param nr, ADDRESS CONST addr) : 
+    test param pos (param nr) ; 
+    enter address . 
+
+enter address :
+    CONCR (param field [param nr].addr) := CONCR (addr) 
+ENDPROC define ; 
+ 
+PROC define (INT CONST param nr, value) : 
+    result addr.kind  := immediate value ;
+    result addr.value := value ;
+    define (param nr, result addr) 
+ENDPROC define ; 
+ 
+PROC apply (INT CONST param nr, OPN CONST opn) : 
+    test param pos (param nr) ; 
+    enter push opn . 
+ 
+enter push opn : 
+    CONCR (param field [param nr].push opn) := CONCR (opn) 
+ENDPROC apply ; 
+ 
+PROC parameter (INT CONST param nr, DTYPE CONST type, 
+                INT CONST access, ADDRESS CONST addr) : 
+    test param pos (param nr) ; 
+    enter type ; 
+    enter access ; 
+    enter address ; 
+    enter pp as default . 
+ 
+enter type : 
+    CONCR (param field [param nr].type) := CONCR (type) .
+
+enter access :
+    param field [param nr].access := access .
+
+enter address :
+    CONCR (param field [param nr].addr) := CONCR (addr) .
+
+enter pp as default :
+    CONCR (param field [param nr].push opn) := CONCR (pp) 
+ENDPROC parameter ; 
+ 
+ 
+                       (***** Lesen *****) 
+ 
+ADDRESS PROC param address (INT CONST param nr) : 
+    test param pos (param nr) ; 
+    param field [param nr].addr 
+ENDPROC param address ; 
+ 
+DTYPE PROC dtype (INT CONST param nr) : 
+    test param pos (param nr) ; 
+    param field [param nr].type 
+ENDPROC dtype ; 
+ 
+INT PROC access (INT CONST param nr) : 
+    test param pos (param nr) ; 
+    param field [param nr].access 
+ENDPROC access ; 
+ 
+ 
+                      (***** Fortschalten *****) 
+ 
+OP NEXTPARAM (INT VAR param nr) : 
+   test param pos (param nr) ; 
+   INT CONST class :: type class (param field [param nr].type) ;
+   param nr INCR 1 ;
+   SELECT class OF
+       CASE 3    : NEXTPARAM param nr
+       CASE 4,5  : read until end 
+    ENDSELECT .
+
+read until end : 
+    WHILE NOT end marker read or end of field REP
+        NEXTPARAM param nr 
+    PER ;
+    param nr INCR 1 .
+ 
+end marker read or end of field :
+    param nr > size of param field OR
+    CONCR (param field [param nr].type) = end id
+ENDOP NEXTPARAM ; 
+ 
+INT PROC next param (INT CONST p) : 
+    INT VAR index := p ; 
+    NEXTPARAM index ; 
+    index
+ENDPROC next param ; 
+ 
+TEXT PROC dump (INT CONST p) : 
+   IF p > 0 AND p <= 100 THEN dump entry (param field (p)) 
+                         ELSE param nr out of range 
+    FI 
+ENDPROC dump ; 
+ 
+TEXT PROC dump entry (PARAMDESCRIPTOR CONST id) : 
+(*  object name :=  dump (id.type) ; *)
+    object name :=  "TYPE " ;           (*  siehe                         *)
+    object name CAT dump (id.type) ;    (*    TEXT PROC dump (DTYPE d)    *)
+    object name CAT text (id.access) ; 
+    object name CAT dump (id.addr) ; 
+    object name CAT dump (id.push opn) ;
+    object name
+ENDPROC dump entry ; 
+
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  7. Datentypen   Teil II                   08.09.1986  *) 
+(*                                                                        *) 
+(*   Deklaration neuer Datentypen                                         *) 
+(*   Vergleich von DTYPEs im Parameterfeld und in der Permanent-Tabelle   *) 
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+DTYPE VAR pt type ;
+
+PROC declare (TEXT CONST name, INT CONST size, align, DTYPE VAR type) : 
+    entry into name table ; 
+    put next permanent (permanent type) ; 
+    put next permanent (size) ; 
+    put next permanent (nt link) ;
+    mark no offsets of text elements . 
+ 
+entry into name table : 
+    declare object (name, nt link, CONCR (type)) ;
+    CONCR (type) DECR begin of permanent table .
+ 
+mark no offsets of text elements : 
+    put next permanent (0) 
+ENDPROC declare ; 
+ 
+BOOL PROC same type (INT CONST param 1, param 2) : 
+    INT CONST left type :: CONCR (param field [param 1].type) ;
+    IF left type = right type
+       THEN same fine structure if there is one
+       ELSE left type = undefined id OR right type = undefined id
+    FI .
+ 
+right type : CONCR (param field [param 2].type) . 
+ 
+same fine structure if there is one : 
+    IF   left type = row id     THEN compare row 
+    ELIF left is struct or proc THEN compare struct 
+                                ELSE TRUE 
+    FI . 
+ 
+left is struct or proc :
+    left type = struct id OR left type = proc id .
+
+compare row : 
+    equal sizes AND same type (param1 + 1, param2 + 1) . 
+ 
+equal sizes : 
+    param field [param1+1].access = param field [param2+1].access .
+ 
+compare struct : 
+    INT VAR p1 :: param1+1, p2 :: param2+1 ; 
+    WHILE same type (p1, p2) AND NOT end type found REP
+       NEXTPARAM p1 ;
+       NEXTPARAM p2
+    UNTIL end of field PER ;
+    FALSE .
+
+end type found :
+    CONCR (param field [p1].type) = end id .
+
+end of field : 
+    p1 > size of param field OR p2 > size of param field 
+ENDPROC same type ;
+ 
+BOOL PROC same type (INT CONST param nr, DTYPE CONST type) : 
+    field pointer := param nr ;
+    CONCR (pt type) := CONCR (type) ;
+    equal types 
+ENDPROC same type ;
+
+BOOL PROC equal types :
+    identical types OR one type is undefined .
+
+one type is undefined :
+    type of actual field = undefined id OR CONCR(pt type) = undefined id .
+
+identical types :
+    SELECT type class (pt type) OF 
+        CASE 0, 1, 2 : type of actual field = CONCR (pt type)
+        CASE 3       : perhaps equal rows
+        CASE 4       : perhaps equal structs
+        CASE 5       : perhaps equal param procs
+        OTHERWISE      FALSE
+    ENDSELECT .
+
+perhaps equal rows :
+    param link := CONCR (pt type) + begin of pt minus ptt limit ;
+    is row AND equal row sizes AND equal row types . 
+ 
+is row :
+    type of actual field = row id .
+
+perhaps equal structs : 
+    param link := CONCR (pt type) + begin of pt minus ptt limit ;
+    is struct AND same type fields . 
+ 
+is struct :
+    type of actual field = struct id .
+
+equal row sizes :
+    pt row size = row size within param field . 
+
+equal row types :
+    field pointer INCR 1 ;
+    param link INCR 2 ;
+    get type and mode (CONCR(pt type)) ;
+    equal types .
+
+pt row size :
+    cdb int (param link + 1) .
+
+row size within param field :
+    param field [field pointer + 1].access .
+ 
+same type fields :
+    REP
+        field pointer INCR 1 ;
+        param link INCR 1 ;
+        IF type of actual field = end id
+             THEN LEAVE same type fields WITH pt struct end reached
+        FI ; 
+        get type and mode (CONCR(pt type)) ;
+        IF NOT equal types THEN LEAVE same type fields WITH FALSE FI
+    UNTIL end of field PER ;
+    FALSE .
+
+pt struct end reached : 
+    cdbint (param link) = permanent type field . 
+ 
+end of field :
+    field pointer > size of param field .
+
+type of actual field :
+    CONCR (param field [field pointer].type) .
+
+perhaps equal param procs :
+    param link := CONCR (pt type) + begin of pt minus ptt limit ;
+    is proc AND same param list . 
+
+is proc : cdbint (param link) = permanent param proc .
+
+same param list :
+    param link INCR wordlength ;
+    DTYPE VAR proc result type ;
+    get type and mode (CONCR (proc result type)) ;
+    compare param list ;
+    check results .
+
+compare param list :
+    INT VAR last param := field pointer + 1 ;
+    REP
+        field pointer INCR 1 ;
+        param link INCR wordlength ;
+        IF pt param list exhausted THEN LEAVE compare param list FI ; 
+        IF type of actual field = end id 
+           THEN LEAVE equal types WITH FALSE
+        FI ; 
+        get type and mode (CONCR(pt type)) ;
+        last param := field pointer ;
+    UNTIL NOT equal types OR end of field PER .
+
+check results : 
+    pt param list exhausted AND equal result types .
+
+equal result types :
+    save param link ;
+    IF same type (last param, proc result type)
+       THEN restore ;
+            TRUE
+       ELSE FALSE
+    FI .
+
+pt param list exhausted :
+    cdbint (param link) = permanent param proc end marker .
+
+save param link :
+    INT CONST p :: param link .
+
+restore :
+    field pointer INCR 1 ;
+    param link := p
+
+ENDPROC equal types ;
+
+BOOL PROC is not void bool or undefined (DTYPE CONST dtype) :
+    type <> void id AND type <> bool result id AND type <> undefined id .
+
+type : CONCR (dtype)
+ENDPROC is not void bool or undefined ;
+ 
+
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  8. Operationen  Teil II                   08.09.1986  *) 
+(*                                                                        *) 
+(*   Definition der Opcodes                                               *) 
+(*   Deklaration, Definition, Identifikation und Applikation              *) 
+(*   Eroeffnen und Schliessen eines Moduls                                *)
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+ 
+LET module not opened  = "Module not opened" , 
+    define missing     = "DEFINE missing" ,
+    wrong nr of params = "Wrong Nr. of Params:" , 
+    illegal kind       = "Opcode expected" ,
+    nested module      = "Nested Modules" ,
+    no mod nr          = "Param Proc expected" ,
+    no immediate value = "Value expected" ,
+    type error         = "Type Error" ,
+ 
+    q ln              =  1 ,
+    q move            =  2 ,    q move code             =  2 048 ,
+    q inc1            =  3 ,    q inc1 code             =  3 072 ,
+    q dec1            =  4 ,    q dec1 code             =  4 096 ,
+    q inc             =  5 ,    q inc code              =  5 120 ,
+    q dec             =  6 ,    q dec code              =  6 144 ,
+    q add             =  7 ,    q add code              =  7 168 ,
+    q sub             =  8 ,    q sub code              =  8 192 ,
+    q clear           =  9 ,    q clear code            =  9 216 ,
+    q test            = 10 , 
+    q equ             = 11 ,    q equ code              = 11 264 , 
+    q lsequ           = 12 ,    q lsequ code            = 12 288 , 
+    q fmove           = 13 ,    q fmove code            = 13 312 , 
+    q fadd            = 14 ,    q fadd code             = 14 336 , 
+    q fsub            = 15 ,    q fsub code             = 15 360 , 
+    q fmult           = 16 ,    q fmult code            = 16 384 , 
+    q fdiv            = 17 ,    q fdiv code             = 17 408 ,
+    q flsequ          = 18 ,    q flsequ code           = 18 432 ,
+    q tmove           = 19 ,    q tmove code            = 19 456 ,
+    q tequ            = 20 ,    q tequ code             = 20 480 , 
+    q accds           = 21 ,    q access ds code        = 22 528 , 
+    q ref             = 22 ,    q ref code              = 23 552 ,
+    q subscript       = 23 ,    q subscript code        = 24 576 , 
+    q select          = 24 ,    q select code           = 25 600 ,
+    q ppv             = 25 ,    q ppv code              = 26 624 ,
+    q pp              = 26 , 
+    q make false      = 27 , (* q make false code       = 65 513 *)
+    q movex           = 28 ,
+(*  q longa subs                q longa subs code       = 65 376 *) 
+    q return          = 29 ,    q return code           = 32 512 ,
+    q true return     = 30 ,    q true return code      = 32 513 ,
+    q false return    = 31 ,    q false return code     = 32 514 ,
+                                q goret code            = 32 519 ,
+    q esc mult        = 32 ,    q esc mult code         = 32 553 ,
+    q esc div         = 33 ,    q esc div code          = 32 554 , 
+    q esc mod         = 34 ,    q esc mod code          = 32 555 , 
+    q pproc           = 35 , 
+    q compl int       = 36 ,    q compl int code        = 32 551 ,
+    q compl real      = 37 ,    q compl real code       = 32 550 ,
+    q alias ds        = 38 ,    q alias ds code         = 32 546 ,
+    q movim           = 39 ,    q esc movim code        = 32 547 ,
+    q fequ            = 40 ,    q fequ code             = 32 548 ,
+    q tlsequ          = 41 ,    q tlsequ code           = 32 549 ,
+(*  q case            = 42 , *) q esc case              = 32 544 ,
+    q plus            = 43 ,
+    q minus           = 44 ,
+    q mult            = 45 ,
+    q int div         = 46 ,
+    q real div        = 47 ,
+    q equal           = 48 ,
+    q lessequal       = 49 ,
+    q ulseq           = 50 ,    q ulseq code            = 21 504 ,
+    q pdadd           = 51 ,    q pdadd code            = 32 653 ,
+    q ppsub           = 52 ,    q ppsub code            = 32 654 ,
+    q dimov           = 53 ,    q dimov code            = 32 655 ,
+    q idmov           = 54 ,    q idmov code            = 32 656 ;
+
+INT CONST q make false code :: - 1 022 , 
+          q longa subs code :: -   159 ,
+          q penter code     :: -   511 ;
+ 
+
+                   (***** Deklaration *****) 
+ 
+PROC declare (OPN VAR operation) : 
+    operation.kind := proc op ;
+    get module nr (operation.mod nr) ; 
+    operation.top of stack := 0 
+ENDPROC declare ; 
+ 
+PROC declare (TEXT CONST name, INT CONST first, params, OPN VAR operation) : 
+    declare (operation) ;
+    entry into name and pt table if necessary ; 
+    enter params ; 
+    enter result ; 
+    enter module number . 
+ 
+entry into name and pt table if necessary : 
+    declare object (name, nt link, permanent pointer) . 
+ 
+enter params : 
+    field pointer := first ;
+    FOR index FROM 1 UPTO params REP
+       enter param (param field [field pointer]) ;
+       NEXTPARAM field pointer 
+    PER .
+ 
+enter result : 
+    enter param (param field[field pointer].type, permanent proc op) .
+ 
+enter module number : 
+    put next permanent (operation.mod nr)
+ENDPROC declare ; 
+ 
+PROC enter param (PARAMDESCRIPTOR CONST param) :
+    IF   param.access = const 
+         THEN enter param (param.type, permanent param const)
+    ELIF param.access = var 
+         THEN enter param (param.type, permanent param var)
+    ELSE errorstop ("Unknown Access")
+    FI
+ENDPROC enter param ;
+
+PROC enter param (DTYPE CONST type, INT CONST permanent mode) :
+    unsigned arithmetic ;
+    SELECT type class (type) OF
+        CASE 0, 1, 2 : put next permanent (CONCR(type) + permanent mode)
+        OTHERWISE      errorstop ("Illegal Type")
+    ENDSELECT
+ENDPROC enter param ;
+
+
+                    (***** Definition *****) 
+ 
+PROC define (OPN VAR opn) : 
+    IF NOT module open THEN errorstop (module not opened)
+                       ELSE proc head (opn.mod nr, opn.top of stack)
+    FI 
+ENDPROC define ; 
+ 
+PROC set length of local storage (OPN VAR opn, INT CONST size) :
+    IF   size < 0 OR size > local address limit
+         THEN errorstop (address overflow)
+    ELIF opn.top of stack = 0
+         THEN errorstop (define missing)
+    ELIF opn.kind <> proc op
+         THEN errorstop (proc op expected)
+    FI ;
+    set length (opn.top of stack, size + eumel0 stack offset)
+ENDPROC set length of local storage ; 
+ 
+PROC define (OPN VAR operation, INT CONST size) : 
+    define (operation) ; 
+    set length of local storage (operation, size)
+ENDPROC define ; 
+ 
+ 
+                 (***** Identifikation *****) 
+ 
+INT VAR counter, result index, result type repr;
+ 
+PROC identify (TEXT CONST name, INT CONST first, params, OPN VAR operation,
+               BOOL VAR object exists) :
+    find result entry ; 
+    to object (name) ;
+    IF found  THEN first fit and leave if found FI ; 
+    IF eumel0 THEN identify eumel0 instruction 
+              ELSE yield undefined operation 
+    FI .
+ 
+find result entry : 
+    result index := first; 
+    counter := 0 ;
+    WHILE counter < params REP 
+        NEXTPARAM result index ; 
+        counter INCR 1
+    PER ;
+    check on param field exceeded .
+
+check on param field exceeded :
+    IF result index > size of param field
+       THEN errorstop (param field exceeded) 
+    FI .
+ 
+yield undefined operation :
+    declare (result index, undefined type) ;
+    apply (result index, nop) ;
+    object exists := FALSE .
+ 
+first fit and leave if found :
+    WHILE yet another procedure exists REP 
+        check one procedure and leave if match ; 
+        next procedure 
+    PER . 
+ 
+yet another procedure exists : 
+    permanent pointer <> 0 . 
+ 
+check one procedure and leave if match: 
+    param link := permanent pointer + wordlength ; 
+    set end marker if end of list ;
+    counter := params ; 
+    field pointer := first ;
+    REP
+       IF   end of params AND counter = 0 
+            THEN procedure found
+       ELIF end of params OR  counter = 0 
+            THEN LEAVE check one procedure and leave if match 
+            ELSE check next param 
+       FI 
+   PER . 
+ 
+check next param : 
+    get type and mode (CONCR(pt type)) ;
+    IF same types THEN set param mode ; 
+                       field pointer INCR 1 ;
+                       param link INCR 1 ;
+                       set end marker if end of list ;
+                       counter DECR 1 ; 
+                  ELSE LEAVE check one procedure and leave if match 
+    FI . 
+ 
+same types : (* inline version ! *)
+    equal types .
+ 
+set param mode : 
+    param field [field pointer].access := mode . 
+ 
+procedure found : 
+    get result ; 
+    operation.kind   := proc op ; 
+    operation.mod nr := module number ; 
+    operation.top of stack := 0 ;
+    object exists := TRUE ;
+    LEAVE identify . 
+ 
+get result : 
+    get type and mode (result type) ; 
+    declare (result index, mode) .
+ 
+module number :
+    cdbint (param link + 1) . 
+
+result type :
+    CONCR (param field [result index].type) .
+ 
+eumel0 : 
+    eumel0 opn.mod nr := link (eumel 0 opcodes, name) ; 
+    eumel0 opn.mod nr <> 0 .
+ 
+identify eumel 0 instruction : 
+    init result type with void ; 
+    CONCR (operation) := CONCR (eumel0 opn) ;
+    object exists := check params and set result ;
+    declare (result index, DTYPE:(result type repr)) ;
+    declare (result index, const) .
+
+init result type with void :
+    result type repr := void id . 
+ 
+check params and set result :
+    SELECT operation.mod nr OF
+       CASE q return, q false return, q true return : no params 
+       CASE q inc1, q dec1          : one int param yielding void 
+       CASE q pproc, q pp, q ln     : one param yielding void
+       CASE q test                  : one param yielding bool
+       CASE q clear, q ppv          : one int or bool param yielding void 
+       CASE q make false            : one bool param yielding void 
+       CASE q move                  : two int or bool params yielding void 
+       CASE q compl int, q inc, q dec : two int params yielding void
+       CASE q compl real, q fmove   : two real params yielding void 
+       CASE q equ, q lsequ, q ulseq : two int params yielding bool 
+       CASE q fequ, q flsequ        : two real params yielding bool 
+       CASE q tequ, q tlsequ        : two text params yielding bool
+       CASE q tmove                 : two text params yielding void
+       CASE q accds, q ref, q movim,
+            q dimov, q idmov        : two params yielding void
+       CASE q add, q sub, q esc mult,
+            q esc div, q esc mod    : three int params yielding void
+       CASE q fadd, q fsub, q fmult, q fdiv : three real params yielding void
+       CASE q select, q movex, q alias ds,
+            q pdadd, q ppsub        : three params 
+       CASE q subscript             : five params 
+       CASE q plus, q mult          : two intreals yielding intreal
+       CASE q minus                 : monadic or dyadic minus
+       CASE q int div               : two int params yielding int 
+       CASE q real div              : two real params yielding real
+       CASE q equal, q lessequal    : two intrealtexts yielding bool
+       OTHERWISE                      FALSE
+    ENDSELECT .
+ 
+no params : 
+    params = 0 . 
+
+one int param yielding void : 
+    p1 void (int type, first, params) .
+
+one param yielding void :
+    params = 1 . 
+
+one param yielding bool :
+    IF params = 1 THEN result type repr := bool id ; 
+                       TRUE 
+                  ELSE FALSE
+    FI .
+ 
+one int or bool param yielding void :
+    p1 void (int type, first, params) OR p1 void (bool type, first, params) . 
+
+one bool param yielding void :
+    p1 void (bool type, first, params) . 
+ 
+two int or bool params yielding void : 
+    p2 (int  type, first, params, void id) OR
+    p2 (bool type, first, params, void id) .
+
+two int params yielding void :
+    p2 (int type, first, params, void id) .
+
+two real params yielding void :
+    p2 (real type, first, params, void id) .
+
+two text params yielding void :
+    p2 (text type, first, params, void id) .
+
+two int params yielding bool :
+    p2 (int type, first, params, bool id) .
+
+two real params yielding bool :
+    p2 (real type, first, params, bool id) .
+
+two text params yielding bool :
+    p2 (text type, first, params, bool id) .
+
+two params yielding void :
+    params = 2 . 
+
+three int params yielding void :
+    p3 void (int type, first, params) .
+
+three real params yielding void :
+    p3 void (real type, first, params) .
+
+three params :
+    params = 3 .
+
+five params : 
+    params = 5 . 
+
+two intreals yielding intreal :
+    two int params yielding int OR two real params yielding real .
+
+monadic or dyadic minus :
+    IF   params = 2 THEN two intreals yielding intreal
+    ELIF params = 1 THEN monadic minus
+                    ELSE FALSE
+    FI .
+
+monadic minus :
+    result type repr := CONCR (param field[first].type) ;
+    result type repr = int id OR result type repr = real id .
+
+two intrealtexts yielding bool :
+    two int params yielding bool OR two real params yielding bool OR
+    two text params yielding bool .
+
+two int params yielding int :
+    p2 (int type, first, params, int id) .
+
+two real params yielding real :
+    p2 (real type, first, params, real id)
+ENDPROC identify ; 
+ 
+BOOL PROC p1 void (DTYPE CONST requested type, INT CONST first, param nr) :
+    param nr = 1 AND param type is requested plain type . 
+ 
+param type is requested plain type :
+    CONCR (param field [first].type) = CONCR (requested type) 
+ 
+ENDPROC p1 void ;
+ 
+BOOL PROC p2 (DTYPE CONST requested type, INT CONST first, param nr,
+              INT CONST result type) :
+    IF param nr = 2 AND param types equal requested plain type
+       THEN result type repr := result type ;
+            TRUE
+       ELSE FALSE
+    FI .
+ 
+param types equal requested plain type :
+    CONCR (param field [first]  .type) = CONCR (requested type) AND 
+    CONCR (param field [first+1].type) = CONCR (requested type)
+
+ENDPROC p2 ;
+ 
+BOOL PROC p3 void (DTYPE CONST requested type, INT CONST first, param nr) :
+    param nr = 3 AND param types ok .
+ 
+param types ok :
+    FOR index FROM first UPTO first+2 REP
+       IF different param types THEN LEAVE p3 void WITH FALSE FI 
+    PER ;
+    TRUE .
+ 
+different param types :
+    CONCR (param field [index].type) <> CONCR (requested type)
+ENDPROC p3 void; 
+
+
+                   (***** Applikation *****) 
+ 
+INT VAR address representation, left repr, right repr, result repr;
+
+PROC apply (INT CONST first, nr of params, OPN CONST opn) : 
+    IF NOT module open THEN errorstop (module not opened) FI ;
+    SELECT opn.kind OF 
+        CASE eumel 0    : generate eumel0 instruction 
+        CASE proc op    : call operation 
+        CASE param proc : call param proc
+        CASE nil        :
+        OTHERWISE         errorstop (illegal kind) 
+    ENDSELECT .
+ 
+call operation :
+    push params if necessary (first, nr of params, opn.mod nr) ; 
+    call (opn.mod nr) .
+ 
+call param proc : 
+    result addr.kind := local ref ;
+    result addr.value := opn.mod nr ;
+    INT CONST module nr := REPR result addr ;
+    push params if necessary (first, nr of params, module nr) ;
+    call param (module nr) .
+
+generate eumel0 instruction : 
+    SELECT real nr of params OF 
+        CASE 0 : p0 instruction 
+        CASE 1 : apply p1 (opn, first addr) 
+        CASE 2 : apply p2 (opn, first addr, second addr)
+        CASE 3 : apply p3 (opn, left type, first addr, second addr, third addr) 
+        CASE 5 : subscript operation
+        OTHERWISE errorstop (wrong nr of params + text (nr of params)) 
+    ENDSELECT . 
+ 
+real nr of params :
+    IF operator denotation THEN nr of params + 1
+                           ELSE nr of params
+    FI .
+
+operator denotation :
+    opn.mod nr >= q plus AND opn.mod nr < q ulseq .
+
+p0 instruction :
+    IF   opn.mod nr = q return       THEN s0 (q return code) 
+    ELIF opn.mod nr = q true return  THEN s0 (q true return code)
+    ELIF opn.mod nr = q false return THEN s0 (q false return code)
+                                     ELSE errorstop (wrong nr of params +
+                                                     mnemonic (opn)) 
+    FI .
+ 
+subscript operation :
+    IF opn.mod nr = q subscript 
+       THEN subscription
+       ELSE errorstop (wrong nr of params + text (nr of params))
+    FI .
+
+subscription :
+    ADDRESS CONST element length :: param field [first+2].addr ,
+                  limit          :: param field [first+3].addr ;
+    check on immediates ;
+    IF element length.value < 1024
+       THEN s0 (q subscript code + element length.value)
+       ELSE s0 (q longa subs code) ;
+            s0 (element length.value)
+    FI ;
+    s3 (limit.value - 1, subs index, base addr, subs result) .
+
+check on immediates :
+    IF element length.kind <> immediate value OR
+       limit.kind <> immediate value
+       THEN errorstop (no immediate value)
+    FI .
+
+subs index  : REPR param field [first+1].addr .
+
+base addr   : REPR param field [first].addr .
+
+subs result : REPR param field [first+4].addr .
+
+first addr : 
+    param field [first].addr .
+ 
+left type :
+    param field [first].type .
+
+second addr : 
+    param field [nextparam (first)].addr .
+ 
+third addr : 
+    param field [nextparam(nextparam(first))].addr
+ENDPROC apply ;
+ 
+PROC push params if necessary (INT CONST first, nr of params, mod nr) : 
+    init param push (mod nr) ;
+    field pointer := first ;
+    IF nr of params > 0 THEN push params FI ;
+    push result if there is one .
+ 
+push params : 
+    FOR index FROM 1 UPTO nr of params REP 
+        apply p1 (push code, param addr) ; 
+        NEXTPARAM field pointer
+    PER . 
+ 
+push code : 
+    param field [field pointer].push opn . 
+ 
+param addr :
+    param field [field pointer].addr . 
+ 
+push result if there is one : 
+    IF push result necessary 
+       THEN push result address (REPR param field [field pointer].addr)
+    FI . 
+
+push result necessary :
+    param field [field pointer].push opn.kind <> nil AND 
+    is not void bool or undefined (param field [field pointer].type) 
+ENDPROC push params if necessary ;
+
+PROC apply p1 (OPN CONST opn, ADDRESS CONST addr) : 
+    IF   opn.mod nr = q ln    THEN generate line number 
+    ELIF opn.mod nr = q pproc THEN push module nr
+                              ELSE gen p1 instruction
+    FI .
+
+gen p1 instruction : 
+    address representation := REPR addr ;
+    SELECT opn.mod nr OF 
+        CASE q inc1  : t1 (q inc1 code, address representation)
+        CASE q dec1  : t1 (q dec1 code, address representation)
+        CASE q clear : t1 (q clear code,address representation)
+        CASE q test  : test bool object (address representation)
+        CASE q pp    : push param (address representation)
+        CASE q ppv   : s1 (q ppv code, address representation)
+        CASE q make false : s1 (q make false code, address representation)
+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))
+    ENDSELECT .
+
+generate line number :
+    IF addr.kind = immediate value THEN mark line (addr.value)
+                                   ELSE errorstop (no immediate value)
+    FI .
+
+push module nr : 
+    IF addr.kind = module nr THEN push param proc (addr.value)
+                             ELSE errorstop (no mod nr)
+    FI
+ENDPROC apply p1; 
+ 
+PROC apply p2 (OPN CONST opn, ADDRESS CONST left addr, right addr): 
+    left repr := REPR left addr ;
+    IF opn.mod nr = q movim THEN move immediate
+                            ELSE gen p2 instruction 
+    FI . 
+ 
+gen p2 instruction : 
+    right repr := REPR right addr ;
+    SELECT opn.mod nr OF 
+        CASE q move       : t2 (q move code, right repr, left repr)
+        CASE q inc        : t2 (q inc code, right repr, left repr) 
+        CASE q dec        : t2 (q dec code, right repr, left repr) 
+        CASE q equ        : compare (q equ code, left repr, right repr) 
+        CASE q lsequ      : compare (q lsequ code, left repr, right repr) 
+        CASE q ulseq      : compare (q ulseq code, left repr, right repr)
+        CASE q fmove      : t2 (q fmove code, right repr, left repr)
+        CASE q flsequ     : compare (q flsequ code, left repr, right repr) 
+        CASE q tmove      : t2 (q tmove code, right repr, left repr)
+        CASE q tequ       : compare (q tequ code, left repr, right repr) 
+        CASE q compl int  : s2 (q compl int code, left repr, right repr)
+        CASE q compl real : s2 (q compl real code, left repr, right repr)
+        CASE q fequ       : compare (q fequ code, left repr, right repr) 
+        CASE q tlsequ     : compare (q tlsequ code, left repr, right repr) 
+        CASE q accds      : t2 (q access ds code, left repr, right repr)
+        CASE q ref        : t2 (q ref code, left repr, right repr) 
+        CASE q dimov      : s2 (q dimov code, left repr, right repr)
+        CASE q idmov      : s2 (q idmov code, left repr, right repr)
+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))
+    ENDSELECT .
+ 
+move immediate :
+    IF right addr.kind = immediate value 
+       THEN s0 (q esc movim code) ;
+            s1 (right addr.value, left repr)
+       ELSE errorstop (no immediate value)
+    FI
+ENDPROC apply p2; 
+ 
+PROC apply p3 (OPN CONST opn, DTYPE CONST left dtype, 
+               ADDRESS CONST left addr, right addr, result addr ):
+    result repr := REPR result addr ;
+    IF   opn.mod nr = q pdadd  THEN select with dint; LEAVE apply p3
+    ELIF opn.mod nr = q select THEN gen select instruction; LEAVE apply p3 FI ;
+    left repr   := REPR left addr ; 
+    IF   opn.mod nr = q movex    THEN gen long move
+    ELIF opn.mod nr = q alias ds THEN alias dataspace
+                                 ELSE gen p3 instruction
+    FI .
+
+gen long move :
+    IF right addr.kind = immediate value
+       THEN long move (left repr, result repr, right addr.value)
+       ELSE errorstop (no immediate value)
+    FI .
+
+alias dataspace :
+    IF right addr.value = immediate value
+       THEN s0 (q alias ds code) ;
+            s2 (right addr.value, result repr, left repr)
+       ELSE errorstop (no immediate value)
+    FI .
+
+gen select instruction :
+    IF right addr.kind = immediate value 
+       THEN IF different bases
+               THEN access external (left addr.value, right addr.value)
+               ELSE t1 (q select code, REPR left addr) ;
+                    s1 (right addr.value, result repr)
+            FI
+       ELSE errorstop (no immediate value)
+    FI .
+
+select with dint :
+    right repr := REPR right addr ;
+    IF different bases THEN access external packet
+                       ELSE simple access
+    FI .
+
+different bases :
+    left addr.kind = p base AND left addr.value <> packet base .
+
+simple access :
+    s3 (q pdadd code, REPR left addr, right repr, result repr) .
+
+access external packet :
+    access external (left addr.value, global address zero) ;
+    s3 (q pdadd code, REPR REF result addr, right repr, result repr) .
+
+gen p3 instruction :
+    right repr  := REPR right addr ; 
+    SELECT opn.mod nr OF 
+        CASE q add                : int add
+        CASE q sub                : int sub
+        CASE q fadd               : real add 
+        CASE q fsub               : real sub 
+        CASE q fmult              : real mult 
+        CASE q fdiv, q real div   : real div 
+        CASE q esc mult           : int mult 
+        CASE q esc div, q int div : int div 
+        CASE q esc mod            : int mod 
+        CASE q plus               : int real add
+        CASE q minus              : int real sub
+        CASE q mult               : int real mult
+        CASE q equal, q lessequal : compare (comp code, left repr, right repr)
+        CASE q ppsub              : distance between two objects
+        OTHERWISE errorstop (wrong nr of params + mnemonic (opn))
+    ENDSELECT . 
+ 
+int add   : compute (q add code, left repr, right repr, result repr) . 
+ 
+int sub   : compute (q sub code, left repr, right repr, result repr) . 
+ 
+real add  : compute (q fadd code, left repr, right repr, result repr) . 
+ 
+real sub  : compute (q fsub code, left repr, right repr, result repr) . 
+ 
+real mult : compute (q fmult code, left repr, right repr, result repr) . 
+ 
+real div  : compute (q fdiv code, left repr, right repr, result repr) . 
+ 
+int mult  : s3 (q esc mult code, left repr, right repr, result repr) . 
+ 
+int div   : s3 (q esc div code, left repr, right repr, result repr) . 
+ 
+int mod   : s3 (q esc mod code, left repr, right repr, result repr) .
+ 
+int real add : 
+    IF left type = int id THEN int add
+                          ELSE real add
+    FI . 
+ 
+int real sub :
+    IF left type = int id THEN int sub 
+                           ELSE real sub
+    FI .
+
+int real mult :
+    IF left type = int id THEN int mult
+                          ELSE real mult
+    FI . 
+
+comp code : 
+    SELECT left type OF
+        CASE int id    : IF opn.mod nr = q equal THEN q equ  ELSE q lsequ FI 
+        CASE real id   : IF opn.mod nr = q equal THEN q fequ ELSE q flsequ FI
+        CASE string id : IF opn.mod nr = q equal THEN q tequ ELSE q tlsequ FI
+        OTHERWISE errorstop (type error); q equ
+    ENDSELECT .
+
+left type : CONCR (left dtype) .
+
+distance between two objects :
+    s3 (q ppsub code, left repr, right repr, result repr)
+
+ENDPROC apply p3; 
+ 
+PROC access external (INT CONST old base, offset) :
+    s0 (q penter code + old base) ;
+    t2 (q ref code, offset, result repr) ;
+    s0 (q penter code + packet base)
+ENDPROC access external ;
+
+
+                      (***** Modul *****) 
+ 
+BOOL VAR module open ;
+
+.init opn section : 
+    module open := FALSE .;
+
+PROC begin module : 
+    IF module open THEN errorstop (nested module) 
+                   ELSE begin modul ; 
+                        module open := TRUE 
+    FI 
+ENDPROC begin module ; 
+ 
+PROC end module : 
+    IF NOT module open
+       THEN errorstop (module not opened) 
+       ELSE end modul ;
+            module open := FALSE
+    FI
+ENDPROC end module ; 
+
+TEXT PROC dump (OPN CONST operation) : 
+    IF   operation.kind = proc op THEN " PROC" + text (operation.mod nr, 5) 
+    ELIF operation.kind = eumel 0 THEN " EUMEL0: " + mnemonic (operation)
+                                  ELSE " undef. Opn" 
+    FI 
+ENDPROC dump ; 
+ 
+PROC begin modul :
+    EXTERNAL 10073
+ENDPROC begin modul ; 
+ 
+PROC end modul :
+    EXTERNAL 10011
+ENDPROC end modul ; 
+ 
+PROC proc head (INT VAR mod nr, top of stack) :
+    EXTERNAL 10012
+ENDPROC proc head ; 
+ 
+PROC set length (INT CONST top of stack, size) : 
+    EXTERNAL 10013
+ENDPROC set length ; 
+ 
+PROC get module nr (INT VAR module nr) : 
+    EXTERNAL 10016
+ENDPROC get module nr ; 
+ 
+PROC compute (INT CONST op code, l addr, r addr, result address) :
+    EXTERNAL 10017
+ENDPROC compute ; 
+ 
+PROC compare (INT CONST op code, l addr, r addr) :
+    EXTERNAL 10018
+ENDPROC compare ; 
+ 
+PROC long move (INT CONST to, from, length) :
+    EXTERNAL 10019
+ENDPROC long move ;
+
+PROC call (INT CONST mod nr) : 
+    EXTERNAL 10022
+ENDPROC call ; 
+ 
+PROC call param (INT CONST mod nr) : 
+    EXTERNAL 10023
+ENDPROC call param ; 
+ 
+PROC push param (INT CONST addr) : 
+    EXTERNAL 10024
+ENDPROC push param ; 
+ 
+PROC push param proc (INT CONST mod nr) : 
+    EXTERNAL 10025
+ENDPROC push param proc ; 
+ 
+PROC init param push (INT CONST mod nr) : 
+    EXTERNAL 10026
+ENDPROC init param push ; 
+ 
+PROC push result address (INT CONST addr) : 
+    EXTERNAL 10027
+ENDPROC push result address ; 
+ 
+PROC test bool object (INT CONST addr) : 
+    EXTERNAL 10192
+ENDPROC test bool object ; 
+ 
+PROC mark line (INT CONST line number) : 
+    EXTERNAL 10030
+ENDPROC mark line ; 
+ 
+PROC s0 (INT CONST op code) : 
+    EXTERNAL 10038
+ENDPROC s0 ; 
+ 
+PROC s1 (INT CONST op code, addr) : 
+    EXTERNAL 10039
+ENDPROC s1 ; 
+ 
+PROC s2 (INT CONST op code , addr1, addr2) : 
+    EXTERNAL 10040
+ENDPROC s2 ; 
+ 
+PROC s3 (INT CONST op code, addr1, addr2, addr3) : 
+    EXTERNAL 10041
+ENDPROC s3 ; 
+ 
+PROC t1 (INT CONST op code, addr) : 
+    EXTERNAL 10042
+ENDPROC t1 ; 
+ 
+PROC t2 (INT CONST op code, addr1, addr2) : 
+    EXTERNAL 10043
+ENDPROC t2 ; 
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                  9. Speicherverwaltung                     03.06.1986  *) 
+(*                                                                        *) 
+(*   Ablage der Paketdaten                                                *) 
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+INT VAR address value;
+ 
+INT CONST data allocation by coder  := 1 , 
+          data allocation by user   := 2 ; 
+
+LET not initialized      = 0 ,
+    wrong mm mode        = "Wrong MM Mode" ,
+    define on non global = "Define for GLOB only" ,
+    text too long        = "TEXT too long" ;
+ 
+TEXT VAR const buffer :: point line ;
+
+.reset memory management mode :
+     memory management mode := not initialized . ;
+ 
+PROC reserve storage (INT CONST size) : 
+    IF memory management mode <> data allocation by user 
+       THEN errorstop (wrong mm mode) 
+    FI ; 
+    allocate var (address value, size) ; 
+    memory management mode := not initialized
+ENDPROC reserve storage ; 
+ 
+PROC allocate variable (ADDRESS VAR addr, INT CONST size) : 
+    IF memory management mode <> data allocation by coder 
+       THEN errorstop (wrong mm mode) 
+    FI ; 
+    allocate var (addr.value, size) ;
+    addr.kind := global
+ENDPROC allocate variable ; 
+ 
+PROC allocate denoter (ADDRESS VAR addr, INT CONST value) :
+    IF memory management mode <> data allocation by coder 
+       THEN errorstop (wrong mm mode) 
+    FI ; 
+    allocate int denoter (addr.value) ;
+    put data word (value, addr.value) ;
+    addr.kind := global
+ENDPROC allocate denoter ; 
+
+PROC allocate denoter (ADDRESS VAR addr, REAL CONST value) :
+    IF memory management mode <> data allocation by coder 
+       THEN errorstop (wrong mm mode) 
+    FI ; 
+    allocate real denoter (addr.value) ;
+    addr.kind := global ;
+    define (addr, value)
+ENDPROC allocate denoter ; 
+ 
+PROC allocate denoter (ADDRESS VAR addr, TEXT CONST value) :
+    IF memory management mode <> data allocation by coder 
+       THEN errorstop (wrong mm mode) 
+    FI ; 
+    allocate text denoter (addr.value, (LENGTH value+1) DIV 2 + 2) ; 
+    addr.kind := global ;
+    skip heaplink; 
+    define (addr, value) ; 
+    reset heaplink .
+ 
+skip heaplink : 
+    addr.value INCR 1 .
+
+reset heaplink :
+    addr.value DECR 1
+ENDPROC allocate denoter ; 
+ 
+PROC allocate denoter (ADDRESS VAR addr, DINT CONST value) :
+    IF memory management mode <> data allocation by coder 
+       THEN errorstop (wrong mm mode) 
+    FI ; 
+    allocate dint denoter (addr.value, value) ;
+    addr.kind := global
+ENDPROC allocate denoter ;
+
+PROC allocate dint denoter (INT VAR addr offset, DINT CONST value) :
+    adjust to an even address if necessary ;
+    put data word (value.low, addr offset) ;
+    allocate int denoter (address value) ;
+    put data word (value.high, address value) .
+
+adjust to an even address if necessary :
+    allocate int denoter (addr offset) ;
+    IF (addr offset AND 1) <> 0 THEN allocate int denoter (addr offset) FI
+ENDPROC allocate dint denoter ; 
+
+PROC define (ADDRESS CONST addr, INT CONST value) : 
+    IF addr.kind <> global 
+       THEN errorstop (define on non global) 
+    FI ; 
+    put data word (value, addr.value) 
+ENDPROC define ; 
+ 
+PROC define (ADDRESS CONST addr, DINT CONST value) : 
+    IF addr.kind <> global
+       THEN errorstop (define on non global) 
+    FI ; 
+    put data word (value.low , addr.value);
+    put data word (value.high, addr.value + 1)
+ENDPROC define ;
+
+PROC define (ADDRESS CONST addr, REAL CONST value) : 
+    IF addr.kind <> global 
+       THEN errorstop (define on non global) 
+    FI ; 
+    replace (const buffer, 1, value) ; 
+    address value := addr.value ;
+    FOR index FROM 1 UPTO 4 REP 
+        put data word (const buffer ISUB index, address value) ;
+        address value INCR 1
+    PER 
+ENDPROC define ; 
+ 
+PROC define (ADDRESS CONST addr, TEXT CONST value) : 
+    IF   addr.kind <> global THEN errorstop (define on non global) 
+    ELIF LENGTH value > 255  THEN errorstop (text too long)
+    FI ; 
+    address value := addr.value ;
+    const buffer := code (LENGTH value) ; 
+    const buffer CAT value ; 
+    const buffer CAT ""0"" ;
+    FOR index FROM 1 UPTO LENGTH const buffer DIV 2 REP 
+        put data word (const buffer ISUB index, address value) ;
+        address value INCR 1
+    PER ; 
+    const buffer := point line
+ENDPROC define ; 
+ 
+PROC allocate var (INT VAR addr, INT CONST length) : 
+    EXTERNAL 10033
+ENDPROC allocate var ; 
+ 
+PROC allocate int denoter (INT VAR addr) : 
+    EXTERNAL 10034
+ENDPROC allocate int denoter ;
+ 
+PROC allocate real denoter (INT VAR addr) : 
+    EXTERNAL 10035 
+ENDPROC allocate real denoter ;
+
+PROC allocate text denoter (INT VAR addr, INT CONST length) : 
+    EXTERNAL 10036 
+ENDPROC allocate text denoter ;
+ 
+PROC put data word (INT CONST value, INT CONST addr) :
+    EXTERNAL 10037
+ENDPROC put data word ; 
+ 
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                 10. Inspector                              28.10.1987  *) 
+(*                                                                        *) 
+(**************************************************************************) 
+
+
+
+INT VAR line number, pattern length, begin of packet,
+        last packet entry, indentation;
+
+TEXT VAR bulletin name, type and mode, pattern, buffer, dummy name;
+ 
+DATASPACE VAR bulletin ds :: nilspace ;
+
+.packet name :
+     cdb text (cdb int(packet link + wordlength) + two word length) .
+
+.packet entry :
+     permanent pointer = 0 OR
+     cdbint (permanent pointer) = permanent packet OR
+     cdbint (permanent pointer + wordlength) = permanent packet .
+
+.within editor :
+    aktueller editor > 0 .  ;
+
+TEXT PROC type name (DTYPE CONST type) : 
+    type and mode := "" ; 
+    IF CONCR (type) = void id THEN type and mode CAT "VOID"
+                              ELSE name of type (CONCR (type)) 
+    FI ;
+    type and mode
+ENDPROC type name ; 
+ 
+TEXT PROC dump (DTYPE CONST type) :
+(*  type and mode := "TYPE " ;
+    name of type (CONCR (type)) ; 
+    type and mode
+*)
+    type name (type)    (* aus Kompatibilitätsgründen zum 1.9.2 Coder / rr *)
+ENDPROC dump ;
+
+PROC name of type (INT CONST type) :
+            SELECT type OF
+     CASE void id                 :
+     CASE int id                  : type and mode CAT "INT"
+     CASE real id                 : type and mode CAT "REAL"
+     CASE string id               : type and mode CAT "TEXT"
+     CASE bool id, bool result id : type and mode CAT "BOOL"
+     CASE dataspace id            : type and mode CAT "DATASPACE"
+     CASE row id                  : type and mode CAT "ROW "
+     CASE struct id               : type and mode CAT "STRUCT"
+     OTHERWISE                    : complex type
+            ENDSELECT .
+
+complex type :
+     unsigned arithmetic ;
+     IF type > ptt limit THEN perhaps permanent struct or row
+                         ELSE get complex type
+     FI .
+
+perhaps permanent struct or row :
+     index := type + begin of pt minus ptt limit ;
+     mode := cdb int (index) MOD ptt limit ;
+     IF   mode = permanent row    THEN get permanent row 
+     ELIF mode = permanent struct THEN get permanent struct
+                                  ELSE type and mode CAT "-"
+     FI .
+
+get complex type :
+     index := type + begin of permanent table ;
+     IF is complex type THEN get name
+                        ELSE type and mode CAT "-"
+     FI .
+
+is complex type :
+     permanent type definition mode = permanent type .
+
+get name :
+     type and mode CAT cdb text (link to type name + two word length) .
+
+link to type name :
+     cdb int (index + three word length) .
+
+permanent type definition mode :
+     cdb int (index + wordlength) .
+
+get permanent row :
+     INT VAR t; 
+     type and mode CAT "ROW " ;
+     type and mode CAT text (cdb int (index + wordlength)) ;
+     type and mode CAT " " ;
+     param link := index + two wordlength ;
+     get type and mode (t) ;
+     name of type (t) .
+ 
+get permanent struct :
+     type and mode CAT "STRUCT ( ... )" 
+ENDPROC name of type ;
+
+PROC help (TEXT CONST proc name) :
+     prep bulletin ;
+     prep help ;
+     scan (object name) ;
+     next symbol (pattern) ;
+     packet link := end of permanent table ;
+     IF function = 0 THEN standard help
+                     ELSE asterisk help
+     FI .
+
+prep help :
+     object name := compress (proc name) ;
+     INT VAR function :: 0 ;
+     INT CONST l :: LENGTH object name ;
+     IF l > 1 AND object name <> "**"
+        THEN IF (object name SUB l) = "*"
+               THEN function INCR 2 ;
+                    delete char (object name, l)
+             FI ;
+             IF (object name SUB 1) = "*"
+               THEN function INCR 1 ;
+                    delete char (object name, 1)
+             FI ;
+             IF another asterisk THEN wrong function FI
+     FI.
+
+another asterisk :
+     pos (object name, "*") <> 0 .
+
+wrong function :
+     errorstop ("unzulaessige Sternfunktion") .
+
+standard help :
+     to object (pattern) ;
+     IF found THEN display
+              ELSE error stop ("unbekannt: " + proc name)
+     FI .
+
+display :
+     IF NOT packet entry
+        THEN WHILE permanent pointer <> 0 REP
+                 put name of packet if necessary ;
+                 put specifications (pattern) ;
+                 next procedure
+             ENDREP ;
+             show bulletin file
+        FI .
+ 
+put name of packet if necessary :
+     IF new packet THEN packet link := permanent pointer ;
+                        find begin of packet ;
+                        writeline (2) ;
+                        write packet name
+     FI .
+
+find begin of packet :
+     REP 
+         packet link DECR wordlength
+     UNTIL begin of packet found PER .
+
+begin of packet found :
+     cdb int (packet link) = permanent packet .
+
+new packet :
+     permanent pointer < packet link .
+
+asterisk help :
+     hash table pointer := begin of hash table ;
+     pattern length := LENGTH pattern - 1 ;
+     REP
+        list all objects in current hash table chain ;
+        next hash entry
+     UNTIL end of hash table reached ENDREP ;
+     show bulletin file .
+
+list all objects in current hash table chain :
+     nt link := hash table pointer ;
+     WHILE yet another nt entry REP
+        permanent pointer := cdb int (nt link + wordlength) ;
+        object name := cdb text (nt link + two word length) ;
+        IF matching THEN into bulletin FI
+     PER .
+
+matching :
+     INT CONST p :: pos (object name, pattern) ;
+     SELECT function OF
+         CASE 1 :   p <> 0 AND p = LENGTH object name - pattern length
+         CASE 2 :   p = 1
+         CASE 3 :   p <> 0
+         OTHERWISE  FALSE
+     ENDSELECT .
+
+into bulletin :
+     object names into bulletin (BOOL PROC not end of chain)
+ENDPROC help ;
+ 
+BOOL PROC not end of chain :
+     permanent pointer <> 0 
+ENDPROC not end of chain ;
+
+PROC write packet name :
+     indentation := 0 ;
+     write line ;
+     write bulletin line ("PACKET ") ;
+     indentation := 7 ;
+     object name := packet name ;
+     write bulletin line (object name) ;
+     write bulletin line (":") ;
+     writeline (2)
+ENDPROC write packet name ;
+
+PROC put specifications (TEXT CONST proc name) :
+     put obj name (proc name) ;
+     to first param ;
+     IF NOT end of params THEN put param list FI ;
+     put result ;
+     writeline .
+  
+to first param :
+     param link := permanent pointer + word length ;
+     set end marker if end of list .
+
+put result :
+     INT VAR type;
+     get type and mode (type) ;
+     IF type <> void id THEN type and mode := "  --> " ;
+                             name of type (type) ;
+                             write bulletin line (type and mode)
+     FI
+ENDPROC put specifications ;
+
+PROC put param list : 
+     write bulletin line (" (") ;
+     REP
+         INT VAR type, param mode;
+         get type and mode (type) ;
+         param mode := mode ;
+         put type and mode ;
+         maybe param proc ;
+         next pt param ;
+         IF end of params THEN write bulletin line (")") ;
+                               LEAVE put param list 
+         FI ;
+         write bulletin line (", ") ;
+     PER .
+
+put type and mode :
+     type and mode := "" ;
+     name of type (type) ;
+     type and mode CAT name of mode ;
+     write bulletin line (type and mode) .
+
+name of mode :
+     IF   param mode = const THEN " CONST"
+     ELIF param mode = var   THEN " VAR"
+                             ELSE " PROC"
+     FI .
+
+maybe param proc :
+     IF mode = permanent param proc THEN put virtual params FI .
+
+put virtual params :
+     skip over result type if complex type ;
+     IF NOT end of virtual params THEN put param list FI.
+
+skip over result type if complex type :
+     next pt param .
+
+end of virtual params :
+    end of params
+ENDPROC put param list ;
+
+PROC to packet (TEXT CONST packet name) :
+     to object ( packet name) ;
+     IF found THEN find start of packet objects FI .
+
+find start of packet objects :
+     last packet entry := 0 ;
+     packet link := before first pt entry ;
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF word < 0 THEN IF   word = permanent packet THEN packet found
+                          ELIF word = permanent end    THEN return
+                          FI
+         FI
+     ENDREP .
+
+packet found :
+     IF cdb int (packet link + wordlength) = nt link
+        THEN last packet entry := packet link FI .
+
+return : 
+     IF last packet entry <> 0 THEN found := TRUE ;
+                                    packet link := last packet entry
+                               ELSE found := FALSE
+     FI ;
+     LEAVE to packet
+ENDPROC to packet ;
+
+PROC next packet :
+     REP
+         packet link INCR wordlength ;
+         word := cdb int (packet link) ;
+         IF   word = permanent packet THEN true return
+         ELIF end of permanents       THEN false return
+         FI ;
+     ENDREP .
+
+true return :
+     found := TRUE ;
+     LEAVE next packet .
+
+false return :
+     found := FALSE ;
+     LEAVE next packet .
+
+end of permanents :
+     word = permanent end OR packet link > end of permanent table 
+ENDPROC next packet ;
+
+PROC prep bulletin :
+     forget (bulletin ds) ;
+     bulletin ds := nilspace ;
+     bulletin file := sequential file (output, bulletin ds) ;
+     line number := 0 ;
+     buffer := ""
+ENDPROC prep bulletin ;
+
+PROC show bulletin file :
+     IF within editor THEN ueberschrift neu FI ;
+     DATASPACE VAR local ds :: bulletin ds ;
+     FILE VAR local file :: sequential file (modify, local ds) ;
+     show (local file) ;
+     forget (local ds)
+ENDPROC show bulletin file ;
+
+PROC write bulletin line (TEXT CONST line) :
+     IF LENGTH buffer + LENGTH line > 75 THEN writeline FI ;
+     buffer CAT line
+ENDPROC write bulletin line ;
+
+PROC writeline  :
+     write (bulletin file, buffer) ;
+     line (bulletin file) ;
+     line number INCR 1 ;
+     cout (line number) ;
+     buffer := indentation * " "
+ENDPROC writeline ;
+
+PROC writeline (INT CONST times) :
+     IF LENGTH compress(buffer) <> 0 THEN index := times - 1 ;
+                                          writeline
+                                     ELSE index := times
+     FI ;
+     line (bulletin file, index) ;
+     line number INCR index;
+     indentation := 0 ;
+     cout (line number)
+ENDPROC writeline ;
+ 
+PROC bulletin (TEXT CONST packet name) :
+     prep bulletin ;
+     scan (packet name) ;
+     next symbol (pattern) ;
+     to packet (pattern) ;
+     IF found THEN list packet ;
+                   show bulletin file
+              ELSE error stop (packet name + " ist kein Paketname")
+     FI . 
+ 
+ENDPROC bulletin ;
+ 
+PROC list packet :
+     begin of packet := packet link + word length ;
+     write packet name ; 
+     find end of packet ;
+     run through nametab and list all packet objects .
+ 
+find end of packet :
+     last packet entry := begin of packet ;
+     REP
+         last packet entry INCR wordlength ;
+         word := cdb int (last packet entry) ;
+     UNTIL end of packet entries PER .
+
+end of packet entries :
+     word = permanent packet OR word = permanent end .
+
+run through nametab and list all packet objects :
+     hashtable pointer := begin of hashtable ;
+     REP
+         nt link := hashtable pointer ;
+         list objects of current packet in this chain ;
+         next hash entry
+     UNTIL end of hashtable reached ENDREP .
+
+list objects of current packet in this chain :
+     WHILE yet another nt entry REP 
+         permanent pointer := cdb int (nt link + wordlength) ;
+         put objects of this name
+     PER .
+
+put objects of this name :
+    IF there is an entry THEN into bulletin FI .
+
+there is an entry :
+    NOT packet entry AND
+    there is at least one object of this name in the current packet .
+
+there is at least one object of this name in the current packet :
+     REP
+        IF permanent pointer >= begin of packet AND
+           permanent pointer < last packet entry
+           THEN LEAVE there is at least one object of this name
+                      in the current packet WITH TRUE FI ;
+        next procedure
+     UNTIL permanent pointer = 0 PER ;
+     FALSE .
+
+into bulletin :
+     object name := cdb text (nt link + two word length) ;
+     object names into bulletin (BOOL PROC within packet)
+ENDPROC list packet ;
+
+BOOL PROC within packet :
+     permanent pointer >= begin of packet AND 
+     permanent pointer < last packet entry
+ENDPROC within packet ;
+
+PROC object names into bulletin (BOOL PROC link ok) :
+     scan (object name) ;
+     next symbol (dummy name, mode) ;
+     IF type definition THEN put type definition
+                        ELSE put object definitions
+     FI .
+
+type definition :
+     mode = bold AND no params .
+
+no params :
+     cdb int (permanent pointer + word length) >= permanent type .
+
+put type definition :
+     put obj name (object name) ;
+     write bulletin line ("TYPE ") ;
+     writeline (1) .
+
+put object definitions :
+     WHILE link ok REP
+         put specifications (object name) ;
+         next procedure
+     ENDREP 
+ENDPROC object names into bulletin ;
+ 
+PROC bulletin :
+     prep bulletin ;
+     packet link := first permanent entry ;
+     REP
+         list packet ;
+         write line (4) ;
+         next packet
+     UNTIL NOT found PER ;
+     show bulletin file
+ENDPROC bulletin ;
+
+PROC put obj name (TEXT CONST name) :
+     buffer := "      " ;
+     bulletin name := point line ;
+     change (bulletin name, 1, end of line or name, name) ;
+     buffer CAT bulletin name ;
+     indentation := LENGTH buffer + 1 .
+
+end of line or name :
+     min (LENGTH name, LENGTH bulletin name)
+ENDPROC put obj name ;
+
+PROC packets :
+     prep bulletin ;
+     packet link := first permanent entry ;
+     REP
+         object name := packet name ;
+         put obj name (object name) ;
+         write line ;
+         next packet 
+     UNTIL NOT found PER ;
+     show bulletin file
+ENDPROC packets ;
+ 
+#page#
+(**************************************************************************) 
+(*                                                                        *) 
+(*                 11. ELAN Run-Interface                     04.08.1986  *) 
+(*                                                                        *) 
+(*   Uebersetzen von ELAN-Programmen                                      *) 
+(*   Bereitstellen der Ausgabeprozeduren fuer den ELAN-Compiler           *) 
+(*                                                                        *) 
+(**************************************************************************) 
+ 
+ 
+ 
+BOOL VAR list option     := FALSE ,
+         check option    :=  TRUE ,
+         warning option  := FALSE , 
+         listing enabled := FALSE ;
+
+FILE VAR listing file ;
+
+TEXT VAR listing file name := "" ;
+ 
+ 
+PROC run (TEXT CONST file name) : 
+  enable stop ;
+  IF NOT exists (file name)
+    THEN errorstop ("""" + file name + """ gibt es nicht")
+  FI ;
+  last param (file name) ;
+  run elan (file name, no ins)
+END PROC run;
+ 
+PROC run :
+  run (last param)
+ENDPROC run ;
+ 
+PROC run again :
+  IF run again mod nr <> 0
+    THEN elan (run again mode, bulletin file, "", run again mod nr, 
+               no ins, no lst, check option, no sermon)
+    ELSE errorstop ("'run again' nicht moeglich")
+  FI
+ENDPROC run again ;
+ 
+PROC insert (TEXT CONST file name) : 
+  enable stop ;
+  IF NOT exists (file name)
+    THEN errorstop ("""" + file name + """ gibt es nicht")
+  FI ;
+  last param (file name) ;
+  run elan (file name, ins)
+ENDPROC insert ;
+ 
+PROC insert :
+  insert (last param)
+ENDPROC insert ;
+ 
+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :
+  FILE VAR source := sequential file (modify, file name) ;
+  IF listing enabled
+    THEN open listing file
+  FI ;
+
+  disable stop ;
+  no do again ;
+  elan (compile file mode, source, "" , run again mod nr,
+        insert option, list option, check option, sermon) ;
+ 
+  IF anything noted AND command dialogue
+    THEN ignore halt during compiling ;
+         note edit (source) ;
+         last param (file name) ; 
+         errorstop ("")
+  FI .
+
+ignore halt during compiling :
+  IF is error
+    THEN put error ;
+         clear error ;
+         pause (5)
+  FI .
+
+open listing file :
+  listing file := sequential file (output, listing file name) ;
+  max line length (listing file, 130)
+
+ENDPROC run elan ;
+(*
+PROC out text (TEXT CONST text, INT CONST out type) :
+  INTERNAL 257 ; 
+  IF online
+    THEN out (text)
+  FI ;
+  IF out type = error message OR (warning option AND out type = warning message) 
+    THEN note (text) ; 
+  FI ;
+  IF listing enabled
+    THEN write (listing file, text)
+  FI
+ENDPROC out text ;
+
+PROC out line (INT CONST out type) :
+  INTERNAL 258 ; 
+  IF online
+    THEN out (""13""10"")
+  FI ;
+  IF out type = error message
+       OR (warning option AND out type = warning message)
+    THEN note line
+  ELIF listing enabled
+    THEN line (listing file)
+  FI
+ENDPROC out line ;
+*)
+PROC prot (TEXT CONST file name) :
+  list option := TRUE ;
+  listing file name := file name ;
+  listing enabled := TRUE
+ENDPROC prot ;
+ 
+PROC prot off :
+  list option := FALSE ;
+  listing enabled := FALSE
+ENDPROC prot off ;
+
+BOOL PROC prot :
+  list option
+ENDPROC prot ;
+ 
+PROC check on :
+  check option := TRUE
+ENDPROC check on ;
+ 
+PROC check off :
+  check option := FALSE
+ENDPROC check off ;
+ 
+BOOL PROC check :
+  check option
+ENDPROC check ;
+
+PROC warnings on :                    
+  warning option := TRUE    
+ENDPROC warnings on ;    
+ 
+PROC warnings off : 
+  warning option := FALSE 
+ENDPROC warnings off ; 
+ 
+BOOL PROC warnings : 
+  warning option 
+ENDPROC warnings ; 
+
+ENDPACKET eumel coder ;  
+
+PACKET dint2 DEFINES dint type :
+ 
+INT VAR dummy ;
+DTYPE VAR d ;
+identify ("DINT", dummy, dummy, d) ; 
+ 
+DTYPE CONST dint type := d
+
+ENDPACKET dint2 ;
+
diff --git a/system/eumel0-z80/data/EUMEL0.DS b/system/eumel0-z80/data/EUMEL0.DS
new file mode 100644
index 0000000..8b53d98
--- /dev/null
+++ b/system/eumel0-z80/data/EUMEL0.DS
diff --git a/system/eumel0-z80/src/DISEUMEL.ELA b/system/eumel0-z80/src/DISEUMEL.ELA
new file mode 100644
index 0000000..b1039dc
--- /dev/null
+++ b/system/eumel0-z80/src/DISEUMEL.ELA
@@ -0,0 +1,607 @@
+PROC arith 16 : 

+ 

+ EXTERNAL 92

+ 

+ENDPROC arith 16 ; 

+ 

+BOOL OP ULSEQ (INT CONST left, right) : 

+ 

+ (left MINUS right) <= 0

+ 

+ENDOP ULSEQ ; 

+ 

+LET max words minus 1 = 32767 ; (* = max : 64K *) 

+ 

+TEXT VAR source name , instr, parameter , t ; 

+INT VAR addr , start addr, end addr , file nr , laenge, i , offset ;

+FILE VAR source file ; 

+

+BOUND STRUCT (ALIGN align, ROW max words minus 1 INT word) VAR space ; 

+

+TEXT VAR a, b, c;

+BOOL VAR screen mode := yes ("Bildschirmausgabe zusaetzlich") ; 

+put ("Startaddr:") ; 

+getline (a) ; 

+put ("Endaddr  :") ; 

+getline (b) ; 

+put ("Offset   :") ; 

+getline (c) ;

+resource ("eumel0", "eumel0.prt", a, b, c) ;

+edit ("eumel0.prt") ; 

+ 

+ 

+PROC resource (TEXT CONST code space name, source file name, 

+               TEXT CONST from, to, offs) : 

+ 

+ space := old (code space name) ; 

+ start addr := integer (from) ;

+ end addr   := integer (to) ; 

+ offset     := integer (offs) ; 

+ source name := source file name ; 

+ file nr := 1 ; 

+ forget (source name, quiet) ; 

+ source file := sequential file (output, source name) ; 

+ 

+ source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER  COMMENT") ; 

+ put tabs (source file, 40 * ""2"" + "^") ; 

+ addr := start addr ; 

+ line ; 

+ WHILE addr ULSEQ end addr REP 

+  IF online THEN out (hex16 (addr)) ; 

+                 out (""13"") ; 

+  FI ; 

+  source put (hex16 (addr)) ; 

+  disass ; 

+  FOR i FROM 1 UPTO laenge REP 

+   source put (hex8 (zugriff (addr PLUS (i-1)))) 

+  PER ; 

+  FOR i FROM laenge UPTO 3 REP

+   source put ("  ") 

+  PER ; 

+  t := "" ; 

+  FOR i FROM 1 UPTO laenge REP 

+   t CAT ascii (zugriff (addr PLUS (i-1))) 

+  PER ; 

+  source put (t, 5) ; 

+  source put (instr, 5) ; 

+  source put (parameter, 10) ; 

+  source line ; 

+  addr := addr PLUS laenge ; 

+ PER ; 

+ENDPROC resource ; 

+ 

+INT OP PLUS (INT CONST left, right) : 

+ arith16 ;

+ left + right  

+ENDOP PLUS ; 

+ 

+INT OP MINUS (INT CONST left, right) : 

+ arith16 ; 

+ left - right 

+ENDOP MINUS ; 

+ 

+PROC source line : 

+ check file overflow ; 

+ line (source file) ; 

+ IF screen mode AND online THEN line FI 

+ENDPROC source line ; 

+ 

+PROC source put (TEXT CONST text) : 

+ put (source file, text) ; 

+ IF screen mode AND online THEN put (text) FI

+ENDPROC source put ; 

+ 

+PROC source out (TEXT CONST text) : 

+ write (source file, text) ; 

+ IF screen mode AND online THEN write (text) FI

+ENDPROC source out ; 

+ 

+PROC source putline (TEXT CONST text) : 

+ check file overflow ;

+ putline (source file, text) ; 

+ IF screen mode AND online THEN putline (text) FI

+ENDPROC source putline ; 

+ 

+PROC source put (TEXT CONST text, INT CONST laenge) : 

+ source put (text + (laenge - length (text)) * " ") ; 

+ENDPROC source put ; 

+ 

+PROC check file overflow : 

+ TEXT VAR new name ; 

+ IF lines (source file) > 4000 THEN 

+    file nr INCR 1 ; 

+    new name := source name + "." + text (file nr) ; 

+    line (source file) ; 

+    putline (source file," - Fortsetzung in Datei """ + new name + """ -"); 

+    IF screen mode AND online THEN putline ("New FILE:" + new name) FI ; 

+    modify (source file) ; 

+    to first record (source file) ; 

+    forget (new name, quiet) ; 

+    source file := sequentialfile (output, new name) ; 

+    source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT") ; 

+    put tabs (source file, 40 * ""2"" + "^") 

+ FI 

+ENDPROC check file overflow ; 

+ 

+TEXT PROC hex16 (INT CONST nr) : 

+ INT VAR i, var := nr ;

+ TEXT VAR result := "" ;

+ FOR i FROM 1 UPTO 4 REP

+  rotate (var, 4) ; 

+  result CAT hex4 (var AND 15) 

+ PER ; 

+ result 

+ENDPROC hex16 ; 

+ 

+TEXT PROC hex8 (INT CONST nr) : 

+ hex4 (nr DIV 16) + hex4 (nr AND 15) 

+ENDPROC hex8 ; 

+ 

+TEXT PROC hex4 (INT CONST nr) : 

+ "0123456789ABCDEF" SUB (nr+1)

+ENDPROC hex4 ; 

+ 

+TEXT PROC ascii (INT CONST nr) : 

+ IF nr < 32 OR nr > 126 THEN "." 

+ ELSE code (nr) 

+ FI 

+ENDPROC ascii ; 

+ 

+INT PROC zugriff (INT CONST adr) : 

+ TEXT VAR t := "  " ; 

+ INT VAR index := offset PLUS adr MINUS startaddr ;

+ rotate (index, -1) ; (* Signed DIV 2 *)

+ index := index AND maxint ;

+ BOOL CONST low byte :: ((adr MINUS start addr) AND 1) = 0 ; 

+ replace (t, 1, space.word (index PLUS 1)) ;

+ IF low byte THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC zugriff ; 

+ 

+INT PROC integer (TEXT CONST hex addr) : 

+ INT VAR i, summe := 0 ; 

+ FOR i FROM 1 UPTO length (hex addr) REP 

+  rotate (summe, 4) ; 

+  summe INCR digit

+ PER ; 

+ summe . 

+ 

+digit : 

+ TEXT CONST char := hex addr SUB i ; 

+ IF char >= "a" THEN code (char) - 87 

+ ELIF char >= "A" THEN code (char) - 55 

+ ELSE code (char) - 48 

+ FI 

+ENDPROC integer ; 

+ 

+INT VAR byte, 

+        div 8, 

+        and 7, 

+        and f, 

+        div 10, 

+        int addr ; 

+ 

+TEXT VAR index, c byte ; 

+ 

+TEXT PROC arith log :

+    SELECT div 8 OF 

+       CASE 0 : "ADD" 

+       CASE 1 : "ADC" 

+       CASE 2 : "SUB" 

+       CASE 3 : "SBC" 

+       CASE 4 : "AND" 

+       CASE 5 : "XOR" 

+       CASE 6 : "OR" 

+       CASE 7 : "CP"

+    OTHERWISE "???" 

+  ENDSELECT 

+ 

+ENDPROC arith log; 

+ 

+TEXT PROC reg1 : 

+    SELECT div8 OF 

+      CASE 0 : "B" 

+      CASE 1 : "C" 

+      CASE 2 : "D" 

+      CASE 3 : "E" 

+      CASE 4 : "H" 

+      CASE 5 : "L" 

+      CASE 6 : "(HL)" 

+      CASE 7 : "A" 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC reg1; 

+ 

+TEXT PROC reg2 : 

+    SELECT and7 OF 

+      CASE 0 : "B" 

+      CASE 1 : "C" 

+      CASE 2 : "D" 

+      CASE 3 : "E" 

+      CASE 4 : "H" 

+      CASE 5 : "L" 

+      CASE 6 : "(HL)" 

+      CASE 7 : "A" 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC reg2; 

+ 

+TEXT PROC rp: 

+    SELECT div10 AND 3 OF 

+      CASE 0 : "BC" 

+      CASE 1 : "DE" 

+      CASE 2 : "HL" 

+      CASE 3 : IF byte > 127 THEN "AF" 

+               ELSE "SP" FI 

+      OTHERWISE "???" 

+    ENDSELECT 

+ 

+ENDPROC rp; 

+ 

+ 

+PROC bitmanipulation : 

+   parameter := text (div8) + "," + reg2 ; 

+   laenge := 2 ; 

+   SELECT byte DIV 64 OF 

+     CASE 1 : instr := "BIT" 

+     CASE 2 : instr := "RES"

+     CASE 3 : instr := "SET" 

+     OTHERWISE laenge := 1 ; 

+               parameter := "" 

+   ENDSELECT 

+ 

+ENDPROC bitmanipulation;

+ 

+ 

+PROC disass : 

+    laenge := 1 ; 

+    instr := "" ; 

+    parameter := "" ; 

+    int addr := addr ; 

+    byte := zugriff (int addr) ; 

+    c byte := code (byte) ; 

+    and 7 := byte AND 7 ; 

+    and f := byte AND 15 ; 

+    div 10:= byte DIV 16 ; 

+    div 8 := (byte DIV 8) AND 7 ; 

+    IF is special instruction 

+       THEN disass special instruction 

+    ELIF div 10 < 4 

+       THEN lower case instruction 

+    ELIF byte < 128 

+       THEN ld instruction 

+    ELIF byte < 192 

+       THEN arith log instruction 

+    ELSE higher case instruction 

+    FI. 

+ 

+is special instruction : 

+ pos (special instruction codes, c byte) > 0 . 

+ 

+special instruction codes : 

+  ""0""2""7""8""10""15""16""18""23""24""26""31""32""34""39""40""42""47""48""50

+  ""55""56""58""63""118""195""198""201""203""205""206""211""214""217""219

+  ""221""222""227""230""233""235""237""238""243""246""249""251""253""254"". 

+ 

+arith log instruction : 

+    instr := arith log ; 

+    parameter := reg 2 . 

+ 

+ld instruction : 

+  instr := "LD" ; 

+  parameter := reg 1 + "," + reg 2 . 

+ 

+condition code : 

+    SELECT div8 OF 

+      CASE 0 : "NZ" 

+      CASE 1 : "Z" 

+      CASE 2 : "NC" 

+      CASE 3 : "C" 

+      CASE 4 : "PO" 

+      CASE 5 : "PE" 

+      CASE 6 : "P" 

+      CASE 7 : "M" 

+      OTHERWISE "??" 

+    ENDSELECT. 

+ 

+lower case instruction : 

+   IF and f = 1 THEN instr := "LD" ; 

+                     parameter := rp + "," + next word ; 

+                     laenge := 3 

+ ELIF and f = 3 THEN instr := "INC" ; 

+                     parameter := rp ; 

+ ELIF and 7 = 4 THEN instr := "INC" ; 

+                     parameter := reg1

+ ELIF and 7 = 5 THEN instr := "DEC" ; 

+                     parameter := reg1 

+ ELIF and 7 = 6 THEN instr := "LD" ; 

+                     parameter := reg1 + "," + next byte ; 

+                     laenge := 2 

+ ELIF and f = 9 THEN instr := "ADD" ; 

+                     parameter := "HL," + rp ; 

+ ELIF and f =11 THEN instr := "DEC" ; 

+                     parameter := rp 

+ FI. 

+ 

+higher case instruction : 

+   SELECT and 7 OF 

+      CASE 0 : instr := "RET" ; 

+               parameter := condition code 

+      CASE 1 : instr := "POP" ; 

+               parameter := rp 

+      CASE 2 : instr := "JP" ; 

+               parameter := condition code + "," + next word ; 

+               laenge := 3 

+      CASE 4 : instr := "CALL" ; 

+               parameter := condition code + "," + next word ; 

+               laenge := 3 

+      CASE 5 : instr := "PUSH" ; 

+               parameter := rp 

+      CASE 7 : instr := "RST" ; 

+               parameter := hex8 (8 * div 8) 

+   ENDSELECT. 

+ 

+ 

+branchaddress : 

+     hex16 (addr PLUS displacement) . 

+ 

+displacement : 

+     IF zugriff (int addr PLUS 1) < 128 

+        THEN zugriff (int addr PLUS 1) + 2

+        ELSE zugriff (int addr PLUS 1) - 254 

+     FI. 

+ 

+cb instructions : 

+   byte := zugriff (addr PLUS 1) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   laenge := 2 ; 

+   parameter := reg 2 ; 

+   IF byte < 64 THEN 

+      SELECT div 8 OF 

+        CASE 0 : instr := "RLC" 

+        CASE 1 : instr := "RRC" 

+        CASE 2 : instr := "RL" 

+        CASE 3 : instr := "RR" 

+        CASE 4 : instr := "SLA" 

+        CASE 5 : instr := "SRA" 

+        CASE 6 : instr := "" ; parameter := "" ; laenge := 1 

+        CASE 7 : instr := "SLR" 

+        OTHERWISE laenge := 1 ; parameter := "" 

+      ENDSELECT 

+   ELSE 

+      bitmanipulation 

+   FI . 

+ 

+ 

+disass special instruction : 

+   SELECT byte OF 

+     CASE 0  : instr := "NOP" 

+     CASE 2  : instr := "LD" ; parameter := "(BC),A" 

+     CASE 7  : instr := "RLCA" 

+     CASE 8  : instr := "EX" ; parameter := "AF,AF'" 

+     CASE 10 : instr := "LD" ; parameter := "A,(BC)" 

+     CASE 15 : instr := "RRCA" 

+     CASE 16 : instr := "DJNZ" ; parameter := branchaddress ;     laenge:=2 

+     CASE 18 : instr := "LD" ; parameter := "(DE),A" 

+     CASE 23 : instr := "RLA" 

+     CASE 24 : instr := "JR" ; parameter := branchaddress ;       laenge:=2 

+     CASE 26 : instr := "LD" ; parameter := "A,(DE)" 

+     CASE 31 : instr := "RRA" 

+     CASE 32 : instr := "JR" ; parameter := "NZ," + branchaddress;laenge:=2 

+     CASE 34 : instr := "LD" ; parameter := "("+nextword+"),HL";  laenge:=3 

+     CASE 39 : instr := "DAA" 

+     CASE 40 : instr := "JR" ; parameter := "Z," + branchaddress; laenge:=2 

+     CASE 42 : instr := "LD" ; parameter := "HL,("+nextword+")";  laenge:=3 

+     CASE 47 : instr := "CPL" 

+     CASE 48 : instr := "JR" ; parameter := "NC," + branchaddress;laenge:=2 

+     CASE 50 : instr := "LD" ; parameter := "("+nextword+"),A";   laenge:=3 

+     CASE 55 : instr := "SCF" 

+     CASE 56 : instr := "JR" ; parameter := "C," + branchaddress; laenge:=2 

+     CASE 58 : instr := "LD" ; parameter := "A,("+nextword+")";   laenge:=3 

+     CASE 63 : instr := "CCF" 

+     CASE 118: instr := "HALT" 

+     CASE 195: instr := "JP" ; parameter := next word ;           laenge:=3 

+     CASE 198: instr := "ADD" ; parameter := "A,"+next byte;      laenge:=2 

+     CASE 201: instr := "RET" 

+     CASE 203: cb instructions 

+     CASE 205: instr := "CALL" ; parameter := next word; laenge := 3 

+     CASE 206: instr := "ADC" ; parameter := "A," + next byte ; laenge := 2 

+     CASE 211: instr := "OUT" ; parameter := "("+next byte+"),A";laenge:=2 

+     CASE 214: instr := "SUB" ; parameter := "A,"+next byte;laenge := 2 

+     CASE 217: instr := "EXX" 

+     CASE 219: instr := "IN" ; parameter := "A,(" + next byte+")";laenge := 2

+     CASE 221: index := "IX"; dd and fd instructions 

+     CASE 222: instr := "SBC" ; parameter := "A," + next byte ;laenge := 2 

+     CASE 227: instr := "EX"; parameter := "(SP),HL" 

+     CASE 230: instr := "AND" ; parameter := next byte; laenge := 2 

+     CASE 233: instr := "JP" ; parameter := "(HL)" 

+     CASE 235: instr := "EX" ; parameter := "DE,HL" 

+     CASE 237: ed instructions 

+     CASE 238: instr := "XOR" ; parameter := next byte ; laenge := 2 

+     CASE 243: instr := "DI" 

+     CASE 246: instr := "OR" ; parameter := next byte ; laenge := 2 

+     CASE 249: instr := "LD" ; parameter := "SP,HL" 

+     CASE 251: instr := "EI" 

+     CASE 253: index := "IY"; dd and fd instructions 

+     CASE 254: instr := "CP" ; parameter := next byte ; laenge := 2 

+   ENDSELECT. 

+ 

+ENDPROC disass ; 

+ 

+PROC dd and fd instructions : 

+   laenge := 2 ; 

+   int addr := addr PLUS 1 ; 

+   byte := zugriff (int addr) ; 

+   c byte := code (byte) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   SELECT byte OF 

+     CASE 33 : instr := "LD" ; parameter := index+","+next word;laenge:=4 

+     CASE 34 : instr := "LD" ; parameter:="("+next word+"),"+index;laenge:=4 

+     CASE 35 : instr := "INC" ; parameter := index 

+     CASE 42 : instr := "LD" ; parameter:=index+",("+next word+")";laenge:=4 

+     CASE 43 : instr := "DEC" ; parameter := index 

+     CASE 52 : instr := "INC";parameter:="("+index+"+"+nextbyte+")";laenge:=3

+     CASE 53 : instr := "DEC";parameter:="("+index+"+"+nextbyte+")";laenge:=3;

+     CASE 54 : instr := "LD" ; parameter :="("+index+"+"+next byte+"),"+ 

+                               hex8(zugriff (addr PLUS 3));laenge := 4 

+     CASE 203: dd and fd cb instructions

+     CASE 225: instr := "POP" ; parameter := index 

+     CASE 227: instr := "EX" ; parameter := "(SP)," + index 

+     CASE 229: instr := "PUSH" ; parameter := index 

+     CASE 233: instr := "JP" ; parameter := "(" + index + ")" 

+     CASE 249: instr := "LD" ; parameter := "SP," + index 

+   OTHERWISE calculated dd and fd instructions 

+   ENDSELECT. 

+ 

+calculated dd and fd instructions : 

+   parameter := "(" + index + "+" + next byte + ")" ; 

+   laenge := 3 ; 

+     IF andf = 9 THEN instr := "ADD" ; parameter := index+","+rp;laenge:=2 

+   ELIF and7 = 6 AND div 10 > 3 AND div 10 < 8

+      THEN instr := "LD" ; parameter := reg1 + "," + parameter 

+   ELIF div 10 = 7 AND byte <> 118 

+      THEN instr := "LD" ; parameter CAT "," + reg2 

+   ELIF and7 = 6 AND div 10 > 7 AND div 10 < 12 

+      THEN instr := arith log 

+   ELSE laenge := 1 ; 

+        parameter := ""

+   FI. 

+ 

+dd and fd cb instructions : 

+   int addr := addr PLUS 3 ; 

+   byte := zugriff (int addr) ; 

+   c byte := code (byte) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   IF byte < 64 AND and7 = 6 THEN 

+        laenge := 4 ; 

+        parameter := "("+index + "+" + hex8 (zugriff (addr PLUS 2)) + ")" ; 

+        SELECT div 8 OF 

+          CASE 0 : instr := "RLC"

+          CASE 1 : instr := "RRC"

+          CASE 2 : instr := "RL" 

+          CASE 3 : instr := "RR"

+          CASE 4 : instr := "SLA"

+          CASE 5 : instr := "SRA"

+          CASE 7 : instr := "SRL"

+        OTHERWISE instr := "" ; parameter := "" ;laenge := 1

+        ENDSELECT 

+   ELIF and7 = 6 THEN laenge := 4 ; parameter := "(" + index + "+" 

+                                    + hex8 (zugriff (addr PLUS 2)) + ")" ; 

+                      dd and fd bitmanipulation

+   ELSE laenge := 1 ; 

+        parameter := ""

+   FI. 

+ 

+dd and fd bitmanipulation : 

+   parameter := text (div8) + "," + parameter ;

+   SELECT byte DIV 64 OF 

+     CASE 1 : instr := "BIT"

+     CASE 2 : instr := "RES" 

+     CASE 3 : instr := "SET" 

+     OTHERWISE laenge := 1 ; 

+               parameter := "" 

+   ENDSELECT. 

+ 

+ENDPROC dd and fd instructions ; 

+ 

+PROC ed instructions : 

+   int addr := addr PLUS 1 ; 

+   byte := zugriff (int addr) ; 

+   c byte := code (byte) ; 

+   and 7 := byte AND 7 ; 

+   and f := byte AND 15 ; 

+   div 10:= byte DIV 16 ; 

+   div 8 := (byte DIV 8) AND 7 ; 

+   laenge := 2 ; 

+   SELECT byte OF 

+     CASE 52 : instr := "TST" ; parameter := "(HL)" 

+     CASE 68 : instr := "NEG" 

+     CASE 69 : instr := "RETN" 

+     CASE 70 : instr := "IM" ; parameter := "0" 

+     CASE 71 : instr := "LD" ; parameter := "I,A" 

+     CASE 77 : instr := "RETI" 

+     CASE 79 : instr := "LD" ; parameter := "R,A" 

+     CASE 86 : instr := "IM" ; parameter := "1" 

+     CASE 87 : instr := "LD" ; parameter := "A,I" 

+     CASE 94 : instr := "IM" ; parameter := "2"

+     CASE 95 : instr := "LD" ; parameter := "A,R" 

+     CASE 100: instr := "TST" ; parameter := next byte ; laenge := 3

+     CASE 103: instr := "RRD" 

+     CASE 111: instr := "RLD" 

+     CASE 116: instr := "TSTIO" ; parameter := next byte ; laenge := 3 

+     CASE 118: instr := "SLP" 

+     CASE 131: instr := "OTIM" 

+     CASE 139: instr := "OTDM" 

+     CASE 147: instr := "OTIMR" 

+     CASE 155: instr := "OTDMR" 

+     CASE 171: instr := "OUTD" 

+     CASE 163: instr := "OUTI" 

+     CASE 179: instr := "OTIR" 

+     CASE 187: instr := "OTDR" 

+   OTHERWISE calculate ed instruction 

+   ENDSELECT. 

+ 

+calculate ed instruction : 

+  IF is 40 to 7f THEN 

+        IF and7 = 0 THEN instr := "IN" ; parameter := reg1 + ",(C)" 

+      ELIF and7 = 1 THEN instr := "OUT" ; parameter := "(C)," + reg1 

+      ELIF andf = 2 THEN instr := "SBC" ; parameter := "HL," + rp 

+      ELIF andf = 3 THEN instr := "LD" ; parameter := "("+nextword+"),"+rp; 

+                         laenge := 4 

+      ELIF andf =11 THEN instr := "LD" ; parameter := rp+",("+nextword+")"; 

+                         laenge := 4

+      ELIF andf =10 THEN instr := "ADC" ; parameter := "HL," + rp 

+      ELIF andf =12 THEN instr := "MLT" ; parameter := rp 

+      ELSE laenge := 1

+      FI 

+  ELIF byte < 64 THEN 

+        IF and7 = 0 THEN instr := "IN0" ; parameter := reg1 + ",(" + next

+                         byte + ")" ; laenge := 3 

+      ELIF and7 = 1 THEN instr := "OUT0" ; parameter := "(" + next word +

+                         ")," + reg1 ; laenge := 3 

+      ELIF and7 = 4 THEN instr := "TST" ; parameter := reg1 

+      ELSE laenge := 1 

+      FI 

+  ELIF div10 = 10 OR div10 = 11 THEN 

+          IF and7 = 0 THEN instr := "LD" + modification 

+        ELIF and7 = 1 THEN instr := "CP" + modification

+        ELIF and7 = 2 THEN instr := "IN" + modification 

+        ELSE laenge := 1

+        FI 

+   ELSE laenge := 1

+   FI. 

+ 

+is 40 to 7f : 

+   div 10 < 8 AND div 10 > 3. 

+ 

+modification : 

+   SELECT div8 - 4 OF

+     CASE 0 : "I" 

+     CASE 1 : "D" 

+     CASE 2 : "IR" 

+     CASE 3 : "DR" 

+   OTHERWISE "???" 

+   ENDSELECT. 

+ 

+ENDPROC ed instructions ; 

+

+TEXT PROC next word : 

+ hex8 (zugriff (int addr PLUS 2)) + hex8 (zugriff (int addr PLUS 1))

+ENDPROC next word ;

+ 

+TEXT PROC next byte : 

+ hex8 (zugriff (int addr PLUS 1))

+ENDPROC next byte

+

diff --git a/system/eumel0-z80/src/eumel0.prt.1 b/system/eumel0-z80/src/eumel0.prt.1
new file mode 100644
index 0000000..244dcbe
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.1
@@ -0,0 +1,3948 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER  COMMENT

+

+1400 45          E     LD    B,L        ; "EUMEL           " (16 chars) 

+1401 55          U     LD    D,L        

+1402 4D          M     LD    C,L        

+1403 45          E     LD    B,L        

+1404 4C          L     LD    C,H        

+1405 20 20             JR    NZ,1427    

+1407 20 20             JR    NZ,1429    

+1409 20 20             JR    NZ,142B    

+140B 20 20             JR    NZ,142D    

+140D 20 20             JR    NZ,142F    

+140F 20 

+1410 3A 00                              ; eumel0blocks (58) 

+1412 D6 06       ..    SUB   A,06       ; mind. hgversion (1750) ID(0)

+1414 01 00                              ; cputype: z80 (1)       ID(1) 

+                                        ; 3=8086, 4=68000, 5=80286

+1416 65 00       ..e   LD    BC,6500    ; urladerversion (101)   ID(2)

+1418 00 00                              ; reserviert (0)         ID(3)

+141A 05 00                              ; mind shard version (5)

+141C 08 00       .     NOP              ; max shard version (8)

+                                        ; ----------- 175 Leiste ---------

+141E C3 D4 28    ..(   JP    28D4       ; Systemstart 175

+1421 C3 71 1F    .q.   JP    1F71       ; inputinterrupt

+1424 C3 35 6E    .5n   JP    6E35       ; timerinterrupt

+1427 C3 E2 6D    ..m   JP    6DE2       ; EUMEL0 Warte aufruefen

+142A C3 5B 5E    .[^   JP    5E5B       ; grab Blocks

+142D C3 21 60    .!`   JP    6021       ; free Blocks

+1430 C3 1C 29    ..)   JP    291C       ; Shutup ausfuehren

+1433 C3 09 29    ..)   JP    2909       ; Info " shard" Ansprungaddresse

+1436 00          .     NOP              ; 1500 00 7F FF

+1437 15          .     DEC   D          ; etc. wie 1.7.3

+1438 FF          .     RST   38         

+1439 7F          .     LD    A,A        

+143A 00          .     NOP              

+143B 80          .     ADD   B          

+143C 15          .     DEC   D          

+143D 02          .     LD    (BC),A     

+143E 7F          .     LD    A,A        

+143F 00          .     NOP              

+1440 00          .     NOP              

+1441 16 FD       ..    LD    D,FD       

+1443 7F          .     LD    A,A        

+1444 00          .     NOP              

+1445 80          .     ADD   B          

+1446 16 FF       ..    LD    D,FF       

+1448 7F          .     LD    A,A        

+1449 00          .     NOP              

+144A 00          .     NOP              

+144B 17          .     RLA              

+144C 00          .     NOP              

+144D 7F          .     LD    A,A        

+144E 01 80 18    ...   LD    BC,1880    

+1451 FF          .     RST   38         

+1452 7F          .     LD    A,A        

+1453 00          .     NOP              

+1454 00          .     NOP              

+1455 19          .     ADD   HL,DE      

+1456 00          .     NOP              

+1457 FF          .     RST   38         

+1458 04          .     INC   B          

+1459 00          .     NOP              

+145A 00          .     NOP              

+145B 31 37 35    175   LD    SP,3537    ; "175 hwtest   7 (!)"

+145E 20 68        h    JR    NZ,14C8    

+1460 77          w     LD    (HL),A     

+1461 74          t     LD    (HL),H     

+1462 65          e     LD    H,L        

+1463 73          s     LD    (HL),E     

+1464 74          t     LD    (HL),H     

+1465 20 20             JR    NZ,1487    

+1467 20 37        7    JR    NZ,14A0    

+1469 20 28        (    JR    NZ,1493    

+146B 21 29       !).   LD    HL,CD29    

+146D CD EB 6D          CALL  6DEB       ;---- EUMEL0-Ram Tabellen init ---

+1470 2A 36 14    *6.   LD    HL,(1436)  

+1473 E5          .     PUSH  HL         

+1474 21 36 14    !6.   LD    HL,1436    

+1477 97          .     SUB   A          

+1478 5E          ^     LD    E,(HL)     

+1479 23          #     INC   HL         

+147A 56          V     LD    D,(HL)     

+147B 14          .     INC   D          

+147C 15          .     DEC   D          

+147D 28 09       (.    JR    Z,1488     

+147F 23          #     INC   HL         

+1480 01 03 00    ...   LD    BC,0003    

+1483 ED B0       ..    LDIR             

+1485 3C          <     INC   A          

+1486 18 F0       ..    JR    1478       

+1488 D1          .     POP   DE         

+1489 62          b     LD    H,D        

+148A 6B          k     LD    L,E        

+148B 23          #     INC   HL         

+148C 4E          N     LD    C,(HL)     

+148D 23          #     INC   HL         

+148E 46          F     LD    B,(HL)     

+148F 2B          +     DEC   HL         

+1490 EB          .     EX    DE,HL      

+1491 ED B0       ..    LDIR             

+1493 3D          =     DEC   A          

+1494 20 F3        .    JR    NZ,1489    ; Miniprozess endlosschleife

+1496 C3 A0 6D    ..m   JP    6DA0       ; ====== Allgemeiner Systemstart ===

+1499 31 00 A1    1..   LD    SP,A100    ; Stackpointer vorlaefig setzen

+149C CD A0 28    ..(   CALL  28A0       ; Limit holen

+149F ED 53 3D 1D .S=.  LD    (1D3D),DE  

+14A3 ED 7B 3D 1D .{=.  LD    SP,(1D3D)  

+14A7 CD FE 6D    ..m   CALL  6DFE       

+14AA FB          .     EI               

+14AB 3A 6E 28    :n(   LD    A,(286E)   ; Vortest durchfuehren ?

+14AE CB 4F       .O    BIT   1,A        

+14B0 C2 BF 15    ...   JP    NZ,15BF    

+14B3 21 AF 82    !..   LD    HL,82AF    ; "EUMEL-Vortest"

+14B6 CD CA 6E    ..n   CALL  6ECA       ; Text ausgeben

+14B9 3E 02       >.    LD    A,02       ; Terminalkanaele anzeigen

+14BB F5          .     PUSH  AF         

+14BC CD 71 1E    .q.   CALL  1E71       ; Typ erfragen

+14BF 38 16       8.    JR    C,14D7     

+14C1 F1          .     POP   AF         

+14C2 F5          .     PUSH  AF         

+14C3 16 00       ..    LD    D,00       

+14C5 5F          _     LD    E,A        

+14C6 21 1B 1D    !..   LD    HL,1D1B    

+14C9 FE 0A       ..    CP    0A         

+14CB 30 01       0.    JR    NC,14CE    

+14CD 23          #     INC   HL         

+14CE CD 00 4E    ..N   CALL  4E00       

+14D1 21 19 1D    !..   LD    HL,1D19    

+14D4 CD CA 6E    ..n   CALL  6ECA       

+14D7 F1          .     POP   AF         

+14D8 3C          <     INC   A          

+14D9 FE 21       .!    CP    21         ; 31 Kanaele

+14DB 38 DE       8.    JR    C,14BB     

+14DD CD E0 1C    ...   CALL  1CE0       

+14E0 CD 8A 28    ..(   CALL  288A       

+14E3 22 11 1D    "..   LD    (1D11),HL  

+14E6 ED 43 0F 1D .C..  LD    (1D0F),BC  

+14EA CB B8       ..    RES   7,B        

+14EC CB 70       .p    BIT   6,B        

+14EE 50          P     LD    D,B        

+14EF 59          Y     LD    E,C        

+14F0 28 03       (.    JR    Z,14F5     

+14F2 01 00 00    ...   LD    BC,0000    

+14F5 CB 21       .!    SLA   C          

+14F7 CB 10       ..    RL    B          

+14F9 ED 43 0D 1D .C..  LD    (1D0D),BC  

+14FD CB B2       ..    RES   6,D        

+14FF 21 40 00    !@.   LD    HL,0040    

+1502 19          .     ADD   HL,DE      

+1503 EB          .     EX    DE,HL      

+1504 21 00 85    !..   LD    HL,8500    

+1507 CD 00 4E    ..N   CALL  4E00       

+150A 21 E8 84    !..   LD    HL,84E8    

+150D CD CA 6E    ..n   CALL  6ECA       

+1510 CD A0 28    ..(   CALL  28A0       

+1513 21 97 82    !..   LD    HL,8297    

+1516 EB          .     EX    DE,HL      

+1517 B7          .     OR    A          

+1518 ED 52       .R    SBC   HL,DE      

+151A CB 3C       .<    SLR   H          

+151C CB 3C       .<    SLR   H          

+151E 5C          \     LD    E,H        

+151F 16 00       ..    LD    D,00       

+1521 21 70 85    !p.   LD    HL,8570    

+1524 CD 00 4E    ..N   CALL  4E00       

+1527 21 57 85    !W.   LD    HL,8557    

+152A CD CA 6E    ..n   CALL  6ECA       

+152D 97          .     SUB   A          

+152E 01 05 00    ...   LD    BC,0005    

+1531 11 00 00    ...   LD    DE,0000    

+1534 CD A8 28    ..(   CALL  28A8       

+1537 CB 28       .(    SRA   B          

+1539 CB 19       ..    RR    C          

+153B 59          Y     LD    E,C        

+153C 50          P     LD    D,B        

+153D 21 1F 85    !..   LD    HL,851F    

+1540 3E E7       >.    LD    A,E7       

+1542 93          .     SUB   E          

+1543 3E 03       >.    LD    A,03       

+1545 9A          .     SBC   D          

+1546 38 01       8.    JR    C,1549     

+1548 23          #     INC   HL         

+1549 CD 00 4E    ..N   CALL  4E00       

+154C 21 08 85    !..   LD    HL,8508    

+154F CD CA 6E    ..n   CALL  6ECA       

+1552 3A 6E 28    :n(   LD    A,(286E)   

+1555 CB 47       .G    BIT   0,A        

+1557 20 0C        .    JR    NZ,1565    

+1559 21 DD 82    !..   LD    HL,82DD    

+155C CD CA 6E    ..n   CALL  6ECA       

+155F CD F0 17    ...   CALL  17F0       

+1562 CD E0 1C    ...   CALL  1CE0       

+1565 01 00 00    ...   LD    BC,0000    

+1568 ED A1       ..    CPI              

+156A EA 68 15    .h.   JP    PE,1568    

+156D 3E 01       >.    LD    A,01       

+156F CD 06 1F    ...   CALL  1F06       

+1572 38 4B       8K    JR    C,15BF     

+1574 ED 7B 3D 1D .{=.  LD    SP,(1D3D)  ; ----- Menue ausgeben --------

+1578 97          .     SUB   A          

+1579 32 30 1D    20.   LD    (1D30),A   

+157C 21 EE 82    !..   LD    HL,82EE    ; Menuetext

+157F CD CA 6E    ..n   CALL  6ECA       ; Ausgeben

+1582 CD 9B 1C    ...   CALL  1C9B       ; AUf Taste warten

+1585 FE 31       .1    CP    31         ; "1" Systemstart

+1587 28 36       (6    JR    Z,15BF     

+1589 FE 32       .2    CP    32         ; "2" Neuen HG laden

+158B CA 16 16    ...   JP    Z,1616     

+158E FE 33       .3    CP    33         ; "3" Hardwaretest

+1590 CA 9D 16    ...   JP    Z,169D     

+1593 FE 34       .4    CP    34         ; "4" neuen Urlader vom Archiv

+1595 28 35       (5    JR    Z,15CC     

+1597 FE 53       .S    CP    53         ; "S" Systemstart ohne Block 0

+1599 CA 6D 14    .m.   JP    Z,146D     ; Zur Miniprozess Schleife

+159C FE 49       .I    CP    49         ; "I" Info aufrufen

+159E 20 D4        .    JR    NZ,1574    

+15A0 DD 21 31 1D .!1.  LD    IX,1D31    

+15A4 CD C0 1A    ...   CALL  1AC0       

+15A7 21 46 A0    !F.   LD    HL,A046    

+15AA 11 19 7D    ..}   LD    DE,7D19    

+15AD 01 0A 00    ...   LD    BC,000A    

+15B0 ED B0       ..    LDIR             

+15B2 CD 1F 70    ..p   CALL  701F       ; Info aufrufen 

+15B5 18 06       ..    JR    15BD       ; " start"

+15B7 20 73        s    JR    NZ,162C    

+15B9 74          t     LD    (HL),H     

+15BA 61          a     LD    H,C        

+15BB 72          r     LD    (HL),D     

+15BC 74          t     LD    (HL),H     

+15BD 18 B5       ..    JR    1574       ; ------- Vortest Ende -----------

+15BF DD 21 31 1D .!1.  LD    IX,1D31    ; Systemstart

+15C3 CD C0 1A    ...   CALL  1AC0       ; Block 0 laden

+15C6 CD 66 1C    .f.   CALL  1C66       ; Etikett testen

+15C9 C3 6D 14    .m.   JP    146D       ; Zur Miniprozess Schleife

+15CC DD 21 36 1D .!6.  LD    IX,1D36    ;-- Neuen Urlader laden ------

+15D0 CD 9F 1A    ...   CALL  1A9F       

+15D3 21 0A 00    !..   LD    HL,000A    

+15D6 22 32 1D    "2.   LD    (1D32),HL  

+15D9 22 37 1D    "7.   LD    (1D37),HL  

+15DC CD 03 16    ...   CALL  1603       

+15DF DD 21 31 1D .!1.  LD    IX,1D31    

+15E3 CD 03 16    ...   CALL  1603       

+15E6 ED 4B 10 A0 .K..  LD    BC,(A010)  

+15EA 21 3A 00    !:.   LD    HL,003A    

+15ED 37          7     SCF              

+15EE ED 42       .B    SBC   HL,BC      

+15F0 30 08       0.    JR    NC,15FA    

+15F2 21 44 00    !D.   LD    HL,0044    

+15F5 22 3B 1D    ";.   LD    (1D3B),HL  

+15F8 18 4E       .N    JR    1648       

+15FA 21 D4 85    !..   LD    HL,85D4    

+15FD CD CA 6E    ..n   CALL  6ECA       

+1600 C3 74 15    .t.   JP    1574       ; Zum Vortest Menue

+1603 CD F2 1A    ...   CALL  1AF2       

+1606 21 00 A0    !..   LD    HL,A000    

+1609 11 2A 1D    .*.   LD    DE,1D2A    

+160C 01 05 00    ...   LD    BC,0005    

+160F CD 92 1C    ...   CALL  1C92       

+1612 C2 74 15    .t.   JP    NZ,1574    ; Zum Vortest Menue

+1615 C9          .     RET              ;-------- Neuen HG vom ARchiv ----

+1616 21 C9 84    !..   LD    HL,84C9    ; "ALten HG ueberschreiben (j/n) ?"

+1619 CD CA 6E    ..n   CALL  6ECA       

+161C CD 9B 1C    ...   CALL  1C9B       

+161F FE 79       .y    CP    79         ; "y" oder

+1621 28 05       (.    JR    Z,1628     

+1623 FE 6A       .j    CP    6A         ; "j" erlaubt

+1625 C2 74 15    .t.   JP    NZ,1574    

+1628 DD 21 31 1D .!1.  LD    IX,1D31    ; Ueberschreiben

+162C CD 9F 1A    ...   CALL  1A9F       

+162F CD C0 1A    ...   CALL  1AC0       

+1632 DD 21 36 1D .!6.  LD    IX,1D36    

+1636 CD 9F 1A    ...   CALL  1A9F       

+1639 CD C0 1A    ...   CALL  1AC0       

+163C CD 66 1C    .f.   CALL  1C66       

+163F 2A 24 A0    *$.   LD    HL,(A024)  

+1642 29          )     ADD   HL,HL      

+1643 29          )     ADD   HL,HL      

+1644 29          )     ADD   HL,HL      

+1645 22 3B 1D    ";.   LD    (1D3B),HL  

+1648 CD B6 1C    ...   CALL  1CB6       

+164B DD 21 31 1D .!1.  LD    IX,1D31    

+164F CD D1 1B    ...   CALL  1BD1       

+1652 DD 21 36 1D .!6.  LD    IX,1D36    

+1656 CD F2 1A    ...   CALL  1AF2       

+1659 DD 21 31 1D .!1.  LD    IX,1D31    

+165D CD 08 1C    ...   CALL  1C08       

+1660 CD BA 1B    ...   CALL  1BBA       

+1663 2A 3B 1D    *;.   LD    HL,(1D3B)  

+1666 ED 5B 32 1D .[2.  LD    DE,(1D32)  

+166A B7          .     OR    A          

+166B ED 52       .R    SBC   HL,DE      

+166D CA 8F 16    ...   JP    Z,168F     

+1670 DD 21 36 1D .!6.  LD    IX,1D36    

+1674 CD BA 1B    ...   CALL  1BBA       

+1677 20 CF        .    JR    NZ,1648    

+1679 21 43 84    !C.   LD    HL,8443    

+167C CD CA 6E    ..n   CALL  6ECA       

+167F CD 9B 1C    ...   CALL  1C9B       

+1682 FE 79       .y    CP    79         ; "y" oder

+1684 28 04       (.    JR    Z,168A     

+1686 FE 6A       .j    CP    6A         ; "j" erlaubt

+1688 20 EF        .    JR    NZ,1679    

+168A CD 9F 1A    ...   CALL  1A9F       

+168D 18 B9       ..    JR    1648       

+168F CD E0 1C    ...   CALL  1CE0       

+1692 CD E0 1C    ...   CALL  1CE0       

+1695 21 B5 84    !..   LD    HL,84B5    

+1698 CD CA 6E    ..n   CALL  6ECA       

+169B 18 FE       ..    JR    169B       

+169D 3E 01       >.    LD    A,01       ; ------ Hardwaretest

+169F 32 30 1D    20.   LD    (1D30),A   

+16A2 21 6C 83    !l.   LD    HL,836C    

+16A5 CD CA 6E    ..n   CALL  6ECA       ; Hardwaretest Menue

+16A8 21 00 00    !..   LD    HL,0000    

+16AB 22 F3 1C    "..   LD    (1CF3),HL  

+16AE CD 9B 1C    ...   CALL  1C9B       

+16B1 FE 31       .1    CP    31         ; "1" Speichertest

+16B3 CA C6 16    ...   JP    Z,16C6     

+16B6 FE 32       .2    CP    32         ; "2" Kanaltest

+16B8 CA 7C 17    .|.   JP    Z,177C     

+16BB FE 33       .3    CP    33         

+16BD 28 12       (.    JR    Z,16D1     ; "3" HG Test

+16BF FE 34       .4    CP    34         ; "4" Archivtest

+16C1 28 14       (.    JR    Z,16D7     

+16C3 C3 74 15    .t.   JP    1574       

+16C6 CD C2 1C    ...   CALL  1CC2       ; ----Speichertest

+16C9 CD F0 17    ...   CALL  17F0       

+16CC CD B6 1C    ...   CALL  1CB6       

+16CF 18 F5       ..    JR    16C6       ; Wiederholen

+16D1 DD 21 31 1D .!1.  LD    IX,1D31    ; ------- HG Test

+16D5 18 04       ..    JR    16DB       

+16D7 DD 21 36 1D .!6.  LD    IX,1D36    ; -------- Archivtest

+16DB 21 C1 83    !..   LD    HL,83C1    

+16DE CD CA 6E    ..n   CALL  6ECA       

+16E1 CD 9B 1C    ...   CALL  1C9B       

+16E4 FE 31       .1    CP    31         ; "1" Lesetest

+16E6 28 0C       (.    JR    Z,16F4     

+16E8 FE 32       .2    CP    32         ; "2" Schreiblesetest

+16EA 28 21       (!    JR    Z,170D     

+16EC FE 33       .3    CP    33         ; "3" Positioniertest

+16EE CA 60 17    .`.   JP    Z,1760     

+16F1 C3 74 15    .t.   JP    1574       ; Zum Vortest Menue

+16F4 CD C2 1C    ...   CALL  1CC2       

+16F7 CD E0 1C    ...   CALL  1CE0       

+16FA CD 9F 1A    ...   CALL  1A9F       

+16FD CD B6 1C    ...   CALL  1CB6       

+1700 CD D1 1B    ...   CALL  1BD1       

+1703 CD F2 1A    ...   CALL  1AF2       

+1706 CD BA 1B    ...   CALL  1BBA       

+1709 20 F2        .    JR    NZ,16FD    

+170B 18 E7       ..    JR    16F4       

+170D CD C2 1C    ...   CALL  1CC2       

+1710 CD E0 1C    ...   CALL  1CE0       

+1713 CD 9F 1A    ...   CALL  1A9F       

+1716 CD B6 1C    ...   CALL  1CB6       

+1719 CD D1 1B    ...   CALL  1BD1       

+171C CD F2 1A    ...   CALL  1AF2       

+171F 21 00 A0    !..   LD    HL,A000    

+1722 11 00 A2    ...   LD    DE,A200    

+1725 01 00 02    ...   LD    BC,0200    

+1728 ED B0       ..    LDIR             

+172A 3E 55       >U    LD    A,55       

+172C CD 31 1C    .1.   CALL  1C31       

+172F 3E AA       >.    LD    A,AA       

+1731 CD 31 1C    .1.   CALL  1C31       

+1734 21 00 A2    !..   LD    HL,A200    

+1737 11 00 A0    ...   LD    DE,A000    

+173A 01 00 02    ...   LD    BC,0200    

+173D ED B0       ..    LDIR             

+173F CD 08 1C    ...   CALL  1C08       

+1742 3E 55       >U    LD    A,55       

+1744 CD 59 1C    .Y.   CALL  1C59       

+1747 CD ED 1B    ...   CALL  1BED       

+174A 21 00 A0    !..   LD    HL,A000    

+174D 11 00 A2    ...   LD    DE,A200    

+1750 01 00 02    ...   LD    BC,0200    

+1753 CD 92 1C    ...   CALL  1C92       

+1756 C4 27 1C    .'.   CALL  NZ,1C27    

+1759 CD BA 1B    ...   CALL  1BBA       

+175C 20 B8        .    JR    NZ,1716    

+175E 18 AD       ..    JR    170D       

+1760 CD C2 1C    ...   CALL  1CC2       

+1763 CD E0 1C    ...   CALL  1CE0       

+1766 CD 9F 1A    ...   CALL  1A9F       

+1769 CD B6 1C    ...   CALL  1CB6       

+176C CD C0 1A    ...   CALL  1AC0       

+176F CD D1 1B    ...   CALL  1BD1       

+1772 CD F2 1A    ...   CALL  1AF2       

+1775 CD BA 1B    ...   CALL  1BBA       

+1778 20 EF        .    JR    NZ,1769    

+177A 18 E4       ..    JR    1760       

+177C CD C2 1C    ...   CALL  1CC2       

+177F CD E0 1C    ...   CALL  1CE0       

+1782 CD B6 1C    ...   CALL  1CB6       

+1785 3E 20       >     LD    A,20       

+1787 32 30 85    20.   LD    (8530),A   

+178A 3E 02       >.    LD    A,02       

+178C F5          .     PUSH  AF         

+178D 5F          _     LD    E,A        

+178E CD 71 1E    .q.   CALL  1E71       

+1791 38 53       8S    JR    C,17E6     

+1793 F1          .     POP   AF         

+1794 F5          .     PUSH  AF         

+1795 CD 59 1E    .Y.   CALL  1E59       

+1798 FE 1E       ..    CP    1E         

+179A 38 20       8     JR    C,17BC     

+179C 16 00       ..    LD    D,00       

+179E 21 31 85    !1.   LD    HL,8531    

+17A1 36 20       6     LD    (HL),20    

+17A3 2B          +     DEC   HL         

+17A4 CD 00 4E    ..N   CALL  4E00       

+17A7 21 28 85    !(.   LD    HL,8528    

+17AA 4E          N     LD    C,(HL)     

+17AB 23          #     INC   HL         

+17AC 06 00       ..    LD    B,00       

+17AE F1          .     POP   AF         

+17AF F5          .     PUSH  AF         

+17B0 59          Y     LD    E,C        

+17B1 CD 88 21    ..!   CALL  2188       

+17B4 38 06       8.    JR    C,17BC     

+17B6 09          .     ADD   HL,BC      

+17B7 7B          {     LD    A,E        

+17B8 91          .     SUB   C          

+17B9 4F          O     LD    C,A        

+17BA 18 F2       ..    JR    17AE       

+17BC F1          .     POP   AF         

+17BD F5          .     PUSH  AF         

+17BE CD 06 1F    ...   CALL  1F06       

+17C1 38 23       8#    JR    C,17E6     

+17C3 5F          _     LD    E,A        

+17C4 16 00       ..    LD    D,00       

+17C6 21 20 20    !     LD    HL,2020    

+17C9 22 55 85    "U.   LD    (8555),HL  

+17CC 21 54 85    !T.   LD    HL,8554    

+17CF CD 00 4E    ..N   CALL  4E00       

+17D2 F1          .     POP   AF         

+17D3 F5          .     PUSH  AF         

+17D4 5F          _     LD    E,A        

+17D5 16 00       ..    LD    D,00       

+17D7 21 42 85    !B.   LD    HL,8542    

+17DA 36 20       6     LD    (HL),20    

+17DC 2B          +     DEC   HL         

+17DD CD 00 4E    ..N   CALL  4E00       

+17E0 21 34 85    !4.   LD    HL,8534    

+17E3 CD CA 6E    ..n   CALL  6ECA       

+17E6 F1          .     POP   AF         

+17E7 3C          <     INC   A          

+17E8 FE 20       .     CP    20         

+17EA DA 8C 17    ...   JP    C,178C     

+17ED C3 7C 17    .|.   JP    177C       

+17F0 CD A0 28    ..(   CALL  28A0       

+17F3 15          .     DEC   D          

+17F4 21 DE 85    !..   LD    HL,85DE    

+17F7 22 E7 1C    "..   LD    (1CE7),HL  

+17FA EB          .     EX    DE,HL      

+17FB B7          .     OR    A          

+17FC ED 52       .R    SBC   HL,DE      

+17FE 22 E9 1C    "..   LD    (1CE9),HL  

+1801 EB          .     EX    DE,HL      

+1802 CB 3A       .:    SLR   D          

+1804 CB 1B       ..    RR    E          

+1806 21 03 00    !..   LD    HL,0003    

+1809 CD 3D 4D    .=M   CALL  4D3D       

+180C CB 23       .#    SLA   E          

+180E CB 12       ..    RL    D          

+1810 ED 53 EB 1C .S..  LD    (1CEB),DE  

+1814 21 DE 85    !..   LD    HL,85DE    

+1817 11 3F 1D    .?.   LD    DE,1D3F    

+181A B7          .     OR    A          

+181B ED 52       .R    SBC   HL,DE      

+181D 22 ED 1C    "..   LD    (1CED),HL  

+1820 EB          .     EX    DE,HL      

+1821 21 03 00    !..   LD    HL,0003    

+1824 CD 3D 4D    .=M   CALL  4D3D       

+1827 ED 53 EF 1C .S..  LD    (1CEF),DE  

+182B 21 FF FF    !..   LD    HL,FFFF    

+182E 22 F1 1C    "..   LD    (1CF1),HL  

+1831 2A E7 1C    *..   LD    HL,(1CE7)  

+1834 CD 12 19    ...   CALL  1912       

+1837 21 00 00    !..   LD    HL,0000    

+183A 5C          \     LD    E,H        

+183B E5          .     PUSH  HL         

+183C CD C9 19    ...   CALL  19C9       

+183F 30 0D       0.    JR    NC,184E    

+1841 CD 12 19    ...   CALL  1912       

+1844 E1          .     POP   HL         

+1845 7C          |     LD    A,H        

+1846 C6 40       .@    ADD   A,40       

+1848 67          g     LD    H,A        

+1849 30 01       0.    JR    NC,184C    

+184B 1C          .     INC   E          

+184C 18 ED       ..    JR    183B       

+184E E1          .     POP   HL         ; Testmuster fuer Speichertest

+184F 11 01 55    ..U   LD    DE,5501    

+1852 CD 22 19    .".   CALL  1922       

+1855 11 02 55    ..U   LD    DE,5502    

+1858 CD 22 19    .".   CALL  1922       

+185B 11 00 AA    ...   LD    DE,AA00    

+185E CD 22 19    .".   CALL  1922       

+1861 11 01 55    ..U   LD    DE,5501    

+1864 CD 7A 19    .z.   CALL  197A       

+1867 11 01 AA    ...   LD    DE,AA01    

+186A CD 22 19    .".   CALL  1922       

+186D 11 02 55    ..U   LD    DE,5502    

+1870 CD 7A 19    .z.   CALL  197A       

+1873 11 00 AA    ...   LD    DE,AA00    

+1876 CD 7A 19    .z.   CALL  197A       

+1879 11 01 AA    ...   LD    DE,AA01    

+187C CD 7A 19    .z.   CALL  197A       

+187F 11 00 55    ..U   LD    DE,5500    

+1882 CD 22 19    .".   CALL  1922       

+1885 11 00 55    ..U   LD    DE,5500    

+1888 CD 7A 19    .z.   CALL  197A       

+188B 11 02 AA    ...   LD    DE,AA02    

+188E CD 22 19    .".   CALL  1922       

+1891 11 02 AA    ...   LD    DE,AA02    

+1894 CD 7A 19    .z.   CALL  197A       

+1897 2A E9 1C    *..   LD    HL,(1CE9)  

+189A ED 5B ED 1C .[..  LD    DE,(1CED)  

+189E B7          .     OR    A          

+189F ED 52       .R    SBC   HL,DE      

+18A1 38 5D       8]    JR    C,1900     

+18A3 F3          .     DI               

+18A4 21 3F 1D    !?.   LD    HL,1D3F    

+18A7 ED 5B E7 1C .[..  LD    DE,(1CE7)  

+18AB CD 1B 1A    ...   CALL  1A1B       

+18AE 11 01 55    ..U   LD    DE,5501    

+18B1 CD 07 1A    ...   CALL  1A07       

+18B4 11 02 55    ..U   LD    DE,5502    

+18B7 CD 07 1A    ...   CALL  1A07       

+18BA 11 00 AA    ...   LD    DE,AA00    

+18BD CD 07 1A    ...   CALL  1A07       

+18C0 11 01 55    ..U   LD    DE,5501    

+18C3 CD 11 1A    ...   CALL  1A11       

+18C6 11 01 AA    ...   LD    DE,AA01    

+18C9 CD 07 1A    ...   CALL  1A07       

+18CC 11 02 55    ..U   LD    DE,5502    

+18CF CD 11 1A    ...   CALL  1A11       

+18D2 11 00 AA    ...   LD    DE,AA00    

+18D5 CD 11 1A    ...   CALL  1A11       

+18D8 11 01 AA    ...   LD    DE,AA01    

+18DB CD 11 1A    ...   CALL  1A11       

+18DE 11 00 55    ..U   LD    DE,5500    

+18E1 CD 07 1A    ...   CALL  1A07       

+18E4 11 00 55    ..U   LD    DE,5500    

+18E7 CD 11 1A    ...   CALL  1A11       

+18EA 11 02 AA    ...   LD    DE,AA02    

+18ED CD 07 1A    ...   CALL  1A07       

+18F0 11 02 AA    ...   LD    DE,AA02    

+18F3 CD 11 1A    ...   CALL  1A11       

+18F6 2A E7 1C    *..   LD    HL,(1CE7)  

+18F9 11 3F 1D    .?.   LD    DE,1D3F    

+18FC CD 1B 1A    ...   CALL  1A1B       

+18FF FB          .     EI               

+1900 CD E0 1C    ...   CALL  1CE0       

+1903 3A E6 1C    :..   LD    A,(1CE6)   

+1906 B7          .     OR    A          

+1907 C8          .     RET   Z          

+1908 ED 7B 3D 1D .{=.  LD    SP,(1D3D)  

+190C CD E0 1C    ...   CALL  1CE0       

+190F C3 2B 18    .+.   JP    182B       

+1912 06 05       ..    LD    B,05       

+1914 97          .     SUB   A          

+1915 57          W     LD    D,A        

+1916 77          w     LD    (HL),A     

+1917 7E          ~     LD    A,(HL)     

+1918 BA          .     CP    D          

+1919 C4 31 1A    .1.   CALL  NZ,1A31    

+191C 3C          <     INC   A          

+191D 20 F6        .    JR    NZ,1915    

+191F 10 F3       ..    DJNZ  1914       

+1921 C9          .     RET              

+1922 2A E7 1C    *..   LD    HL,(1CE7)  

+1925 ED 4B EB 1C .K..  LD    BC,(1CEB)  

+1929 CD 51 19    .Q.   CALL  1951       

+192C 26 00       &.    LD    H,00       

+192E 6B          k     LD    L,E        

+192F 1E 00       ..    LD    E,00       

+1931 E5          .     PUSH  HL         

+1932 CD C9 19    ...   CALL  19C9       

+1935 30 0F       0.    JR    NC,1946    

+1937 7D          }     LD    A,L        

+1938 72          r     LD    (HL),D     

+1939 C6 03       ..    ADD   A,03       

+193B 6F          o     LD    L,A        

+193C 30 FA       0.    JR    NC,1938    

+193E E1          .     POP   HL         

+193F 6F          o     LD    L,A        

+1940 24          $     INC   H          

+1941 20 EE        .    JR    NZ,1931    

+1943 1C          .     INC   E          

+1944 18 EB       ..    JR    1931       

+1946 CD 6D 19    .m.   CALL  196D       

+1949 21 0B 1D    !..   LD    HL,1D0B    

+194C CD CA 6E    ..n   CALL  6ECA       

+194F E1          .     POP   HL         

+1950 C9          .     RET              

+1951 D5          .     PUSH  DE         

+1952 79          y     LD    A,C        

+1953 B7          .     OR    A          

+1954 28 01       (.    JR    Z,1957     

+1956 04          .     INC   B          

+1957 79          y     LD    A,C        

+1958 48          H     LD    C,B        

+1959 47          G     LD    B,A        

+195A 7A          z     LD    A,D        

+195B 16 00       ..    LD    D,00       

+195D 19          .     ADD   HL,DE      

+195E 11 03 00    ...   LD    DE,0003    

+1961 77          w     LD    (HL),A     

+1962 19          .     ADD   HL,DE      

+1963 10 FC       ..    DJNZ  1961       

+1965 0D          .     DEC   C          

+1966 20 F9        .    JR    NZ,1961    

+1968 D1          .     POP   DE         

+1969 CD 6D 19    .m.   CALL  196D       

+196C C9          .     RET              

+196D F5          .     PUSH  AF         

+196E C5          .     PUSH  BC         

+196F 3E 00       >.    LD    A,00       

+1971 06 64       .d    LD    B,64       

+1973 ED 4F       .O    LD    R,A        

+1975 10 FC       ..    DJNZ  1973       

+1977 C1          .     POP   BC         

+1978 F1          .     POP   AF         

+1979 C9          .     RET              

+197A 2A E7 1C    *..   LD    HL,(1CE7)  

+197D ED 4B EB 1C .K..  LD    BC,(1CEB)  

+1981 CD A1 19    ...   CALL  19A1       

+1984 26 00       &.    LD    H,00       

+1986 6B          k     LD    L,E        

+1987 5C          \     LD    E,H        

+1988 E5          .     PUSH  HL         

+1989 CD C9 19    ...   CALL  19C9       

+198C 30 B8       0.    JR    NC,1946    

+198E 7E          ~     LD    A,(HL)     

+198F BA          .     CP    D          

+1990 C4 31 1A    .1.   CALL  NZ,1A31    

+1993 7D          }     LD    A,L        

+1994 C6 03       ..    ADD   A,03       

+1996 6F          o     LD    L,A        

+1997 30 F5       0.    JR    NC,198E    

+1999 E1          .     POP   HL         

+199A 6F          o     LD    L,A        

+199B 24          $     INC   H          

+199C 20 EA        .    JR    NZ,1988    

+199E 1C          .     INC   E          

+199F 18 E7       ..    JR    1988       

+19A1 D5          .     PUSH  DE         

+19A2 79          y     LD    A,C        

+19A3 B7          .     OR    A          

+19A4 28 01       (.    JR    Z,19A7     

+19A6 04          .     INC   B          

+19A7 79          y     LD    A,C        

+19A8 48          H     LD    C,B        

+19A9 47          G     LD    B,A        

+19AA 7A          z     LD    A,D        

+19AB 16 00       ..    LD    D,00       

+19AD 19          .     ADD   HL,DE      

+19AE 11 FF FF    ...   LD    DE,FFFF    

+19B1 ED 53 F1 1C .S..  LD    (1CF1),DE  

+19B5 57          W     LD    D,A        

+19B6 7E          ~     LD    A,(HL)     

+19B7 BA          .     CP    D          

+19B8 C4 31 1A    .1.   CALL  NZ,1A31    

+19BB 7D          }     LD    A,L        

+19BC C6 03       ..    ADD   A,03       

+19BE 6F          o     LD    L,A        

+19BF 30 01       0.    JR    NC,19C2    

+19C1 24          $     INC   H          

+19C2 10 F2       ..    DJNZ  19B6       

+19C4 0D          .     DEC   C          

+19C5 20 EF        .    JR    NZ,19B6    

+19C7 D1          .     POP   DE         

+19C8 C9          .     RET              

+19C9 E5          .     PUSH  HL         

+19CA 6C          l     LD    L,H        

+19CB 63          c     LD    H,E        

+19CC 24          $     INC   H          

+19CD 22 F1 1C    "..   LD    (1CF1),HL  

+19D0 25          %     DEC   H          

+19D1 D5          .     PUSH  DE         

+19D2 55          U     LD    D,L        

+19D3 CB 3C       .<    SLR   H          

+19D5 CB 1D       ..    RR    L          

+19D7 E5          .     PUSH  HL         

+19D8 ED 4B 0D 1D .K..  LD    BC,(1D0D)  

+19DC B7          .     OR    A          

+19DD ED 42       .B    SBC   HL,BC      

+19DF E1          .     POP   HL         

+19E0 30 08       0.    JR    NC,19EA    

+19E2 CD EE 19    ...   CALL  19EE       

+19E5 7A          z     LD    A,D        

+19E6 E6 01       ..    AND   01         

+19E8 B4          .     OR    H          

+19E9 37          7     SCF              

+19EA D1          .     POP   DE         

+19EB E1          .     POP   HL         

+19EC 67          g     LD    H,A        

+19ED C9          .     RET              

+19EE 3A 10 1D    :..   LD    A,(1D10)   

+19F1 CB 7F       ..    BIT   7,A        

+19F3 C2 8D 28    ..(   JP    NZ,288D    

+19F6 CB 3C       .<    SLR   H          

+19F8 CB 1D       ..    RR    L          

+19FA 7D          }     LD    A,L        

+19FB 2A 11 1D    *..   LD    HL,(1D11)  

+19FE 30 02       0.    JR    NC,1A02    

+1A00 CB CC       ..    SET   1,H        

+1A02 2E 00       ..    LD    L,00       

+1A04 C3 8D 28    ..(   JP    288D       

+1A07 21 3F 1D    !?.   LD    HL,1D3F    

+1A0A ED 4B EF 1C .K..  LD    BC,(1CEF)  

+1A0E C3 51 19    .Q.   JP    1951       

+1A11 21 3F 1D    !?.   LD    HL,1D3F    

+1A14 ED 4B EF 1C .K..  LD    BC,(1CEF)  

+1A18 C3 A1 19    ...   JP    19A1       

+1A1B ED 4B ED 1C .K..  LD    BC,(1CED)  

+1A1F ED B0       ..    LDIR             

+1A21 2B          +     DEC   HL         

+1A22 1B          .     DEC   DE         

+1A23 ED 4B ED 1C .K..  LD    BC,(1CED)  

+1A27 1A          .     LD    A,(DE)     

+1A28 ED A9       ..    CPD              

+1A2A 20 FE        .    JR    NZ,1A2A    

+1A2C 1B          .     DEC   DE         

+1A2D EA 27 1A    .'.   JP    PE,1A27    

+1A30 C9          .     RET              

+1A31 F5          .     PUSH  AF         

+1A32 C5          .     PUSH  BC         

+1A33 D5          .     PUSH  DE         

+1A34 E5          .     PUSH  HL         

+1A35 42          B     LD    B,D        

+1A36 4F          O     LD    C,A        

+1A37 ED 5B F1 1C .[..  LD    DE,(1CF1)  

+1A3B CB 7A       .z    BIT   7,D        

+1A3D 28 25       (%    JR    Z,1A64     

+1A3F E5          .     PUSH  HL         

+1A40 EB          .     EX    DE,HL      

+1A41 2A E7 1C    *..   LD    HL,(1CE7)  

+1A44 B7          .     OR    A          

+1A45 ED 52       .R    SBC   HL,DE      

+1A47 E1          .     POP   HL         

+1A48 38 16       8.    JR    C,1A60     

+1A4A E5          .     PUSH  HL         

+1A4B C5          .     PUSH  BC         

+1A4C 11 3F 1D    .?.   LD    DE,1D3F    

+1A4F 2A E7 1C    *..   LD    HL,(1CE7)  

+1A52 CD 1B 1A    ...   CALL  1A1B       

+1A55 C1          .     POP   BC         

+1A56 E1          .     POP   HL         

+1A57 FB          .     EI               

+1A58 3E 00       >.    LD    A,00       

+1A5A CD 66 1A    .f.   CALL  1A66       

+1A5D C3 08 19    ...   JP    1908       

+1A60 3E 00       >.    LD    A,00       

+1A62 18 02       ..    JR    1A66       

+1A64 7A          z     LD    A,D        

+1A65 63          c     LD    H,E        

+1A66 F5          .     PUSH  AF         

+1A67 3E 01       >.    LD    A,01       

+1A69 32 E6 1C    2..   LD    (1CE6),A   

+1A6C 11 D2 85    ...   LD    DE,85D2    

+1A6F 79          y     LD    A,C        

+1A70 CD F5 1C    ...   CALL  1CF5       

+1A73 11 CA 85    ...   LD    DE,85CA    

+1A76 78          x     LD    A,B        

+1A77 CD F5 1C    ...   CALL  1CF5       

+1A7A F1          .     POP   AF         

+1A7B 11 BE 85    ...   LD    DE,85BE    

+1A7E CD F5 1C    ...   CALL  1CF5       

+1A81 7C          |     LD    A,H        

+1A82 CD F5 1C    ...   CALL  1CF5       

+1A85 7D          }     LD    A,L        

+1A86 CD F5 1C    ...   CALL  1CF5       

+1A89 21 B0 85    !..   LD    HL,85B0    

+1A8C CD CA 6E    ..n   CALL  6ECA       

+1A8F 3E 01       >.    LD    A,01       

+1A91 CD 06 1F    ...   CALL  1F06       

+1A94 38 F9       8.    JR    C,1A8F     

+1A96 FE 0D       ..    CP    0D         

+1A98 20 F5        .    JR    NZ,1A8F    

+1A9A E1          .     POP   HL         

+1A9B D1          .     POP   DE         

+1A9C C1          .     POP   BC         

+1A9D F1          .     POP   AF         

+1A9E C9          .     RET              

+1A9F DD 7E 00    .~.   LD    A,(IX+00)  

+1AA2 01 05 00    ...   LD    BC,0005    

+1AA5 DD E5       ..    PUSH  IX         

+1AA7 D5          .     PUSH  DE         

+1AA8 11 00 00    ...   LD    DE,0000    

+1AAB CD A8 28    ..(   CALL  28A8       

+1AAE D1          .     POP   DE         

+1AAF DD E1       ..    POP   IX         

+1AB1 DD 71 03    .q.   LD    (IX+03),C  

+1AB4 DD 70 04    .p.   LD    (IX+04),B  

+1AB7 DD 36 01 00 .6..  LD    (IX+01),00 

+1ABB DD 36 02 00 .6..  LD    (IX+02),00 

+1ABF C9          .     RET              

+1AC0 21 00 A0    !..   LD    HL,A000    

+1AC3 11 00 00    ...   LD    DE,0000    

+1AC6 01 00 00    ...   LD    BC,0000    

+1AC9 DD 7E 00    .~.   LD    A,(IX+00)  

+1ACC DD E5       ..    PUSH  IX         

+1ACE CD 7E 28    .~(   CALL  287E       

+1AD1 DD E1       ..    POP   IX         

+1AD3 0C          .     INC   C          

+1AD4 0D          .     DEC   C          

+1AD5 C8          .     RET   Z          

+1AD6 21 00 A0    !..   LD    HL,A000    

+1AD9 DD 7E 00    .~.   LD    A,(IX+00)  

+1ADC 01 00 00    ...   LD    BC,0000    

+1ADF DD E5       ..    PUSH  IX         

+1AE1 CD 7E 28    .~(   CALL  287E       

+1AE4 DD E1       ..    POP   IX         

+1AE6 0C          .     INC   C          

+1AE7 0D          .     DEC   C          

+1AE8 C8          .     RET   Z          

+1AE9 21 A4 84    !..   LD    HL,84A4    

+1AEC CD CA 6E    ..n   CALL  6ECA       

+1AEF C3 74 15    .t.   JP    1574       

+1AF2 21 00 A0    !..   LD    HL,A000    

+1AF5 06 40       .@    LD    B,40       

+1AF7 3E 1E       >.    LD    A,1E       

+1AF9 77          w     LD    (HL),A     

+1AFA 23          #     INC   HL         

+1AFB 10 FC       ..    DJNZ  1AF9       

+1AFD DD 5E 01    .^.   LD    E,(IX+01)  

+1B00 DD 56 02    .V.   LD    D,(IX+02)  

+1B03 3E 14       >.    LD    A,14       

+1B05 F5          .     PUSH  AF         

+1B06 21 00 A0    !..   LD    HL,A000    

+1B09 01 00 00    ...   LD    BC,0000    

+1B0C DD 7E 00    .~.   LD    A,(IX+00)  

+1B0F DD E5       ..    PUSH  IX         

+1B11 CD 7E 28    .~(   CALL  287E       

+1B14 21 00 A0    !..   LD    HL,A000    

+1B17 06 40       .@    LD    B,40       

+1B19 3E 1E       >.    LD    A,1E       

+1B1B BE          .     CP    (HL)       

+1B1C 20 05        .    JR    NZ,1B23    

+1B1E 23          #     INC   HL         

+1B1F 10 FA       ..    DJNZ  1B1B       

+1B21 0E 1E       ..    LD    C,1E       

+1B23 DD E1       ..    POP   IX         

+1B25 F1          .     POP   AF         

+1B26 0D          .     DEC   C          

+1B27 F2 32 1B    .2.   JP    P,1B32     

+1B2A FE 14       ..    CP    14         

+1B2C C8          .     RET   Z          

+1B2D 21 27 84    !'.   LD    HL,8427    

+1B30 18 4C       .L    JR    1B7E       

+1B32 FE 0A       ..    CP    0A         

+1B34 20 14        .    JR    NZ,1B4A    

+1B36 D5          .     PUSH  DE         

+1B37 F5          .     PUSH  AF         

+1B38 21 00 A0    !..   LD    HL,A000    

+1B3B DD 7E 00    .~.   LD    A,(IX+00)  

+1B3E 11 00 00    ...   LD    DE,0000    

+1B41 DD E5       ..    PUSH  IX         

+1B43 CD 7E 28    .~(   CALL  287E       

+1B46 DD E1       ..    POP   IX         

+1B48 F1          .     POP   AF         

+1B49 D1          .     POP   DE         

+1B4A 3D          =     DEC   A          

+1B4B 20 B8        .    JR    NZ,1B05    

+1B4D 21 FD FF    !..   LD    HL,FFFD    ; -3 ist Markierung f. defekten Bl.

+1B50 22 00 A0    "..   LD    (A000),HL  

+1B53 21 00 A0    !..   LD    HL,A000    

+1B56 11 02 A0    ...   LD    DE,A002    

+1B59 01 FE 01    ...   LD    BC,01FE    

+1B5C ED B0       ..    LDIR             

+1B5E 21 31 84    !1.   LD    HL,8431    

+1B61 3A 30 1D    :0.   LD    A,(1D30)   

+1B64 B7          .     OR    A          

+1B65 20 17        .    JR    NZ,1B7E    

+1B67 CD CA 6E    ..n   CALL  6ECA       

+1B6A 21 77 85    !w.   LD    HL,8577    

+1B6D CD CA 6E    ..n   CALL  6ECA       

+1B70 CD 9B 1C    ...   CALL  1C9B       

+1B73 FE 6E       .n    CP    6E         

+1B75 CA 74 15    .t.   JP    Z,1574     

+1B78 CD E0 1C    ...   CALL  1CE0       

+1B7B C3 F2 1A    ...   JP    1AF2       

+1B7E 3A 30 1D    :0.   LD    A,(1D30)   

+1B81 B7          .     OR    A          

+1B82 28 1B       (.    JR    Z,1B9F     

+1B84 CD A6 1B    ...   CALL  1BA6       

+1B87 21 68 84    !h.   LD    HL,8468    

+1B8A CD CA 6E    ..n   CALL  6ECA       

+1B8D CD 9B 1C    ...   CALL  1C9B       

+1B90 F5          .     PUSH  AF         

+1B91 CD E0 1C    ...   CALL  1CE0       

+1B94 F1          .     POP   AF         

+1B95 FE 79       .y    CP    79         

+1B97 28 02       (.    JR    Z,1B9B     

+1B99 FE 6A       .j    CP    6A         

+1B9B CC 08 1C    ...   CALL  Z,1C08     

+1B9E C9          .     RET              

+1B9F CD A6 1B    ...   CALL  1BA6       

+1BA2 CD E0 1C    ...   CALL  1CE0       

+1BA5 C9          .     RET              

+1BA6 E5          .     PUSH  HL         

+1BA7 21 91 85    !..   LD    HL,8591    

+1BAA DD 7E 00    .~.   LD    A,(IX+00)  

+1BAD B7          .     OR    A          

+1BAE 28 03       (.    JR    Z,1BB3     

+1BB0 21 95 85    !..   LD    HL,8595    

+1BB3 CD CA 6E    ..n   CALL  6ECA       

+1BB6 E1          .     POP   HL         

+1BB7 C3 CA 6E    ..n   JP    6ECA       

+1BBA DD 5E 01    .^.   LD    E,(IX+01)  

+1BBD DD 56 02    .V.   LD    D,(IX+02)  

+1BC0 DD 6E 03    .n.   LD    L,(IX+03)  

+1BC3 DD 66 04    .f.   LD    H,(IX+04)  

+1BC6 13          .     INC   DE         

+1BC7 DD 73 01    .s.   LD    (IX+01),E  

+1BCA DD 72 02    .r.   LD    (IX+02),D  

+1BCD B7          .     OR    A          

+1BCE ED 52       .R    SBC   HL,DE      

+1BD0 C9          .     RET              

+1BD1 DD 5E 01    .^.   LD    E,(IX+01)  

+1BD4 DD 56 02    .V.   LD    D,(IX+02)  

+1BD7 21 20 20    !     LD    HL,2020    

+1BDA 22 26 1D    "&.   LD    (1D26),HL  

+1BDD 22 28 1D    "(.   LD    (1D28),HL  

+1BE0 21 25 1D    !%.   LD    HL,1D25    

+1BE3 CD 00 4E    ..N   CALL  4E00       

+1BE6 21 22 1D    !".   LD    HL,1D22    

+1BE9 CD CA 6E    ..n   CALL  6ECA       

+1BEC C9          .     RET              

+1BED DD 5E 01    .^.   LD    E,(IX+01)  

+1BF0 DD 56 02    .V.   LD    D,(IX+02)  

+1BF3 21 00 A0    !..   LD    HL,A000    

+1BF6 01 00 00    ...   LD    BC,0000    

+1BF9 DD 7E 00    .~.   LD    A,(IX+00)  

+1BFC DD E5       ..    PUSH  IX         

+1BFE CD 7E 28    .~(   CALL  287E       

+1C01 DD E1       ..    POP   IX         

+1C03 78          x     LD    A,B        

+1C04 B1          .     OR    C          

+1C05 20 20             JR    NZ,1C27    

+1C07 C9          .     RET              

+1C08 06 05       ..    LD    B,05       

+1C0A C5          .     PUSH  BC         

+1C0B 21 00 A0    !..   LD    HL,A000    

+1C0E DD 5E 01    .^.   LD    E,(IX+01)  

+1C11 DD 56 02    .V.   LD    D,(IX+02)  

+1C14 01 00 00    ...   LD    BC,0000    

+1C17 DD 7E 00    .~.   LD    A,(IX+00)  

+1C1A DD E5       ..    PUSH  IX         

+1C1C CD 81 28    ..(   CALL  2881       

+1C1F DD E1       ..    POP   IX         

+1C21 79          y     LD    A,C        

+1C22 B0          .     OR    B          

+1C23 C1          .     POP   BC         

+1C24 C8          .     RET   Z          

+1C25 10 E3       ..    DJNZ  1C0A       

+1C27 21 08 84    !..   LD    HL,8408    

+1C2A CD A6 1B    ...   CALL  1BA6       

+1C2D CD E0 1C    ...   CALL  1CE0       

+1C30 C9          .     RET              

+1C31 F5          .     PUSH  AF         

+1C32 CD 59 1C    .Y.   CALL  1C59       

+1C35 CD 08 1C    ...   CALL  1C08       

+1C38 3E 0F       >.    LD    A,0F       

+1C3A CD 59 1C    .Y.   CALL  1C59       

+1C3D CD ED 1B    ...   CALL  1BED       

+1C40 F1          .     POP   AF         

+1C41 21 00 A0    !..   LD    HL,A000    

+1C44 01 00 02    ...   LD    BC,0200    

+1C47 ED A1       ..    CPI              

+1C49 20 04        .    JR    NZ,1C4F    

+1C4B EA 92 1C    ...   JP    PE,1C92    

+1C4E C9          .     RET              

+1C4F 21 16 84    !..   LD    HL,8416    

+1C52 CD CA 6E    ..n   CALL  6ECA       

+1C55 CD E0 1C    ...   CALL  1CE0       

+1C58 C9          .     RET              

+1C59 21 00 A0    !..   LD    HL,A000    

+1C5C 11 01 A0    ...   LD    DE,A001    

+1C5F 01 FF 01    ...   LD    BC,01FF    

+1C62 77          w     LD    (HL),A     

+1C63 ED B0       ..    LDIR             

+1C65 C9          .     RET              ; ---- Korrekten Block 0 testen

+1C66 21 00 A0    !..   LD    HL,A000    

+1C69 11 2A 1D    .*.   LD    DE,1D2A    ; "EUMEL-"

+1C6C 01 06 00    ...   LD    BC,0006    

+1C6F CD 92 1C    ...   CALL  1C92       

+1C72 20 12        .    JR    NZ,1C86    ; "HG-ungueltig"

+1C74 21 09 A0    !..   LD    HL,A009    

+1C77 11 86 82    ...   LD    DE,8286    ; 

+1C7A 01 02 00    ...   LD    BC,0002    

+1C7D CD 92 1C    ...   CALL  1C92       ; Versionsnummer

+1C80 C8          .     RET   Z          

+1C81 21 93 84    !..   LD    HL,8493    ; "Falsche Version"

+1C84 18 03       ..    JR    1C89       

+1C86 21 85 84    !..   LD    HL,8485    

+1C89 CD CA 6E    ..n   CALL  6ECA       

+1C8C CD 9B 1C    ...   CALL  1C9B       

+1C8F C3 74 15    .t.   JP    1574       ; Zum Vortest Menue

+1C92 1A          .     LD    A,(DE)     ; Zeichenkette vergleichen

+1C93 13          .     INC   DE         

+1C94 ED A1       ..    CPI              

+1C96 C0          .     RET   NZ         

+1C97 EA 92 1C    ...   JP    PE,1C92    

+1C9A C9          .     RET              ;----------- Auf Taste warten > A --

+1C9B 3E 01       >.    LD    A,01       ; Kanal 1

+1C9D CD 06 1F    ...   CALL  1F06       ; Auf Taste warten

+1CA0 38 F9       8.    JR    C,1C9B     ; Warten!

+1CA2 FE 1B       ..    CP    1B         ; ESC

+1CA4 CA 74 15    .t.   JP    Z,1574     ; Zum Vortest Menue

+1CA7 FE 20       .     CP    20         ; 

+1CA9 D8          .     RET   C          ; < Blank zurueck

+1CAA 32 1E 1D    2..   LD    (1D1E),A   

+1CAD F5          .     PUSH  AF         

+1CAE 21 1D 1D    !..   LD    HL,1D1D    ; CRLF

+1CB1 CD CA 6E    ..n   CALL  6ECA       ; ausgeben

+1CB4 F1          .     POP   AF         

+1CB5 C9          .     RET              ;----- incharety an Kanal 1

+1CB6 3E 01       >.    LD    A,01       

+1CB8 CD 06 1F    ...   CALL  1F06       ; 

+1CBB D8          .     RET   C          ; Wenn nichts da ist

+1CBC FE 1B       ..    CP    1B         

+1CBE CA 74 15    .t.   JP    Z,1574     ; ESC --> Zum Vortest Menue

+1CC1 C9          .     RET              ; -------- Zaehlpuffer loeschen

+1CC2 21 20 20    !     LD    HL,2020    

+1CC5 22 AA 85    "..   LD    (85AA),HL  

+1CC8 22 AC 85    "..   LD    (85AC),HL  

+1CCB ED 5B F3 1C .[..  LD    DE,(1CF3)  

+1CCF 13          .     INC   DE         

+1CD0 ED 53 F3 1C .S..  LD    (1CF3),DE  

+1CD4 21 A9 85    !..   LD    HL,85A9    

+1CD7 CD 00 4E    ..N   CALL  4E00       ; Dezimal -- ASCII Konvertiereung

+1CDA 21 9D 85    !..   LD    HL,859D    ; Puffer ausgeben

+1CDD C3 CA 6E    ..n   JP    6ECA       

+1CE0 21 16 1D    !..   LD    HL,1D16    ; CRLF ausgeben

+1CE3 C3 CA 6E    ..n   JP    6ECA

+1CE6 00          .     NOP              

+1CE7 00          .     NOP              

+1CE8 00          .     NOP              

+1CE9 00          .     NOP              

+1CEA 00          .     NOP              

+1CEB 00          .     NOP              

+1CEC 00          .     NOP              

+1CED 00          .     NOP              

+1CEE 00          .     NOP              

+1CEF 00          .     NOP              

+1CF0 00          .     NOP              

+1CF1 00          .     NOP              

+1CF2 00          .     NOP              

+1CF3 00          .     NOP              

+1CF4 00          .     NOP              

+1CF5 F5          .     PUSH  AF         ;- Byte in A Hex --> (DE),(DE+1)

+1CF6 0F          .     RRCA             

+1CF7 0F          .     RRCA             

+1CF8 0F          .     RRCA             

+1CF9 0F          .     RRCA             

+1CFA CD FE 1C    ...   CALL  1CFE       

+1CFD F1          .     POP   AF         

+1CFE E6 0F       ..    AND   0F         

+1D00 C6 30       .0    ADD   A,30       

+1D02 FE 3A       .:    CP    3A         

+1D04 38 02       8.    JR    C,1D08     

+1D06 C6 07       ..    ADD   A,07       

+1D08 12          .     LD    (DE),A     

+1D09 13          .     INC   DE         

+1D0A C9          .     RET              ; ------ Zeichentexte ------

+1D0B 01 2A 00    .*.   LD    BC,002A    ; "*" Laenge 1

+1D0E 00          .     NOP              

+1D0F 00          .     NOP              

+1D10 00          .     NOP              

+1D11 00          .     NOP              

+1D12 00          .     NOP              

+1D13 00          .     NOP              

+1D14 01 20 02    . .   LD    BC,0220    ; Blank

+1D17 0A          .     LD    A,(BC)     ; CRLF

+1D18 0D          .     DEC   C          

+1D19 03          .     INC   BC         ; ", 1"

+1D1A 2C          ,     INC   L          

+1D1B 20 31        1    JR    NZ,1D4E    

+1D1D 04          .     INC   B          ; Blank, CR, LF,LF

+1D1E 20 0D        .    JR    NZ,1D2D    

+1D20 0A          .     LD    A,(BC)     

+1D21 0A          .     LD    A,(BC)     

+1D22 07          .     RLCA             ; CR, "#     "

+1D23 0D          .     DEC   C          

+1D24 23          #     INC   HL         

+1D25 20 20             JR    NZ,1D47    

+1D27 20 20             JR    NZ,1D49    

+1D29 20 45        E    JR    NZ,1D70    ; "EUMEL-" HG Kennzeichen

+1D2B 55          U     LD    D,L        

+1D2C 4D          M     LD    C,L        

+1D2D 45          E     LD    B,L        

+1D2E 4C          L     LD    C,H        

+1D2F 2D          -     DEC   L          

+1D30 00          .     NOP              

+1D31 00          .     NOP              ; Harddisk Descriptor

+1D32 00          .     NOP              

+1D33 00          .     NOP              

+1D34 00          .     NOP              

+1D35 00          .     NOP              

+1D36 1F          .     RRA              ; Floppy Descriptor

+1D37 00          .     NOP              

+1D38 00          .     NOP              

+1D39 00          .     NOP              

+1D3A 00          .     NOP              

+1D3B 00          .     NOP              

+1D3C 00          .     NOP              

+1D3D 00          .     NOP              

+1D3E 00          .     NOP              

+1D3F FF          .     RST   38         ; ====== Ende des nichtresidenten

+1D40 FF          .     RST   38         ; EUMEL0 Teils ==================

+1D41 FF          .     RST   38         

+1D42 FF          .     RST   38         

+1D43 FF          .     RST   38         

+1D44 FF          .     RST   38         

+1D45 FF          .     RST   38         

+1D46 FF          .     RST   38         

+1D47 FF          .     RST   38         

+1D48 FF          .     RST   38         

+1D49 FF          .     RST   38         

+1D4A FF          .     RST   38         

+1D4B FF          .     RST   38         

+1D4C FF          .     RST   38         

+1D4D FF          .     RST   38         

+1D4E FF          .     RST   38         

+1D4F FF          .     RST   38         

+1D50 FF          .     RST   38         

+1D51 FF          .     RST   38         

+1D52 FF          .     RST   38         

+1D53 FF          .     RST   38         

+1D54 FF          .     RST   38         

+1D55 FF          .     RST   38         

+1D56 FF          .     RST   38         

+1D57 FF          .     RST   38         

+1D58 FF          .     RST   38         

+1D59 FF          .     RST   38         

+1D5A FF          .     RST   38         

+1D5B FF          .     RST   38         

+1D5C FF          .     RST   38         

+1D5D FF          .     RST   38         

+1D5E FF          .     RST   38         

+1D5F FF          .     RST   38         

+1D60 FF          .     RST   38         

+1D61 FF          .     RST   38         

+1D62 FF          .     RST   38         

+1D63 FF          .     RST   38         

+1D64 FF          .     RST   38         

+1D65 FF          .     RST   38         

+1D66 FF          .     RST   38         

+1D67 FF          .     RST   38         

+1D68 FF          .     RST   38         

+1D69 FF          .     RST   38         

+1D6A FF          .     RST   38         

+1D6B FF          .     RST   38         

+1D6C FF          .     RST   38         

+1D6D FF          .     RST   38         

+1D6E FF          .     RST   38         

+1D6F FF          .     RST   38         

+1D70 FF          .     RST   38         

+1D71 FF          .     RST   38         

+1D72 FF          .     RST   38         

+1D73 FF          .     RST   38         

+1D74 FF          .     RST   38         

+1D75 FF          .     RST   38         

+1D76 FF          .     RST   38         

+1D77 FF          .     RST   38         

+1D78 FF          .     RST   38         

+1D79 FF          .     RST   38         

+1D7A FF          .     RST   38         

+1D7B FF          .     RST   38         

+1D7C FF          .     RST   38         

+1D7D FF          .     RST   38         

+1D7E FF          .     RST   38         

+1D7F FF          .     RST   38         

+1D80 FF          .     RST   38         

+1D81 FF          .     RST   38         

+1D82 FF          .     RST   38         

+1D83 FF          .     RST   38         

+1D84 FF          .     RST   38         

+1D85 FF          .     RST   38         

+1D86 FF          .     RST   38         

+1D87 FF          .     RST   38         

+1D88 FF          .     RST   38         

+1D89 FF          .     RST   38         

+1D8A FF          .     RST   38         

+1D8B FF          .     RST   38         

+1D8C FF          .     RST   38         

+1D8D FF          .     RST   38         

+1D8E FF          .     RST   38         

+1D8F FF          .     RST   38         

+1D90 FF          .     RST   38         

+1D91 FF          .     RST   38         

+1D92 FF          .     RST   38         

+1D93 FF          .     RST   38         

+1D94 FF          .     RST   38         

+1D95 FF          .     RST   38         

+1D96 FF          .     RST   38         

+1D97 FF          .     RST   38         

+1D98 FF          .     RST   38         

+1D99 FF          .     RST   38         

+1D9A FF          .     RST   38         

+1D9B FF          .     RST   38         

+1D9C FF          .     RST   38         

+1D9D FF          .     RST   38         

+1D9E FF          .     RST   38         

+1D9F FF          .     RST   38         

+1DA0 FF          .     RST   38         

+1DA1 FF          .     RST   38         

+1DA2 FF          .     RST   38         

+1DA3 FF          .     RST   38         

+1DA4 FF          .     RST   38         

+1DA5 FF          .     RST   38         

+1DA6 FF          .     RST   38         

+1DA7 FF          .     RST   38         

+1DA8 FF          .     RST   38         

+1DA9 FF          .     RST   38         

+1DAA FF          .     RST   38         

+1DAB FF          .     RST   38         

+1DAC FF          .     RST   38         

+1DAD FF          .     RST   38         

+1DAE FF          .     RST   38         

+1DAF FF          .     RST   38         

+1DB0 FF          .     RST   38         

+1DB1 FF          .     RST   38         

+1DB2 FF          .     RST   38         

+1DB3 FF          .     RST   38         

+1DB4 FF          .     RST   38         

+1DB5 FF          .     RST   38         

+1DB6 FF          .     RST   38         

+1DB7 FF          .     RST   38         

+1DB8 FF          .     RST   38         

+1DB9 FF          .     RST   38         

+1DBA FF          .     RST   38         

+1DBB FF          .     RST   38         

+1DBC FF          .     RST   38         

+1DBD FF          .     RST   38         

+1DBE FF          .     RST   38         

+1DBF FF          .     RST   38         

+1DC0 FF          .     RST   38         

+1DC1 FF          .     RST   38         

+1DC2 FF          .     RST   38         

+1DC3 FF          .     RST   38         

+1DC4 FF          .     RST   38         

+1DC5 FF          .     RST   38         

+1DC6 FF          .     RST   38         

+1DC7 FF          .     RST   38         

+1DC8 FF          .     RST   38         

+1DC9 FF          .     RST   38         

+1DCA FF          .     RST   38         

+1DCB FF          .     RST   38         

+1DCC FF          .     RST   38         

+1DCD FF          .     RST   38         

+1DCE FF          .     RST   38         

+1DCF FF          .     RST   38         

+1DD0 FF          .     RST   38         

+1DD1 FF          .     RST   38         

+1DD2 FF          .     RST   38         

+1DD3 FF          .     RST   38         

+1DD4 FF          .     RST   38         

+1DD5 FF          .     RST   38         

+1DD6 FF          .     RST   38         

+1DD7 FF          .     RST   38         

+1DD8 FF          .     RST   38         

+1DD9 FF          .     RST   38         

+1DDA FF          .     RST   38         

+1DDB FF          .     RST   38         

+1DDC FF          .     RST   38         

+1DDD FF          .     RST   38         

+1DDE FF          .     RST   38         

+1DDF FF          .     RST   38         

+1DE0 FF          .     RST   38         

+1DE1 FF          .     RST   38         

+1DE2 FF          .     RST   38         

+1DE3 FF          .     RST   38         

+1DE4 FF          .     RST   38         

+1DE5 FF          .     RST   38         

+1DE6 FF          .     RST   38         

+1DE7 FF          .     RST   38         

+1DE8 FF          .     RST   38         

+1DE9 FF          .     RST   38         

+1DEA FF          .     RST   38         

+1DEB FF          .     RST   38         

+1DEC FF          .     RST   38         

+1DED FF          .     RST   38         

+1DEE FF          .     RST   38         

+1DEF FF          .     RST   38         

+1DF0 FF          .     RST   38         

+1DF1 FF          .     RST   38         

+1DF2 FF          .     RST   38         

+1DF3 FF          .     RST   38         

+1DF4 FF          .     RST   38         

+1DF5 FF          .     RST   38         

+1DF6 FF          .     RST   38         

+1DF7 FF          .     RST   38         

+1DF8 FF          .     RST   38         

+1DF9 FF          .     RST   38         

+1DFA FF          .     RST   38         

+1DFB FF          .     RST   38         

+1DFC FF          .     RST   38         

+1DFD FF          .     RST   38         

+1DFE FF          .     RST   38         

+1DFF FF          .     RST   38         

+1E00 FF          .     RST   38         ; ======= Residenter EUMEL0 =======

+1E01 FF          .     RST   38         ; DR EIntrag des DRDR

+1E02 FF          .     RST   38         

+1E03 FF          .     RST   38         

+1E04 FF          .     RST   38         

+1E05 FF          .     RST   38         

+1E06 FF          .     RST   38         

+1E07 FF          .     RST   38         

+1E08 FF          .     RST   38         

+1E09 FF          .     RST   38         

+1E0A FF          .     RST   38         

+1E0B FF          .     RST   38         

+1E0C FF          .     RST   38         

+1E0D FF          .     RST   38         

+1E0E FF          .     RST   38         

+1E0F FF          .     RST   38         ; ---------- 173 Leiste ---------

+1E10 C3 DF 28    ..(   JP    28DF       ; systemstart 173

+1E13 C3 71 1F    .q.   JP    1F71       ; inputinterrupt

+1E16 C3 35 6E    .5n   JP    6E35       ; timerinterrupt

+1E19 C3 E2 6D    ..m   JP    6DE2       ; warte

+1E1C C3 22 1E    .".   JP    1E22       ; frei eumel0 (nur 173)

+1E1F C3 1F 70    ..p   JP    701F       ; info (Text uebergeben)

+1E22 3A 6D 28    :m(   LD    A,(286D)   ;----------- frei eumel0 ---------

+1E25 CB C7       ..    SET   0,A        ; MODE Bit 0 setzen

+1E27 32 6D 28    2m(   LD    (286D),A   

+1E2A C9          .     RET              ;--------------------------------

+1E2B FF          .     RST   38         

+1E2C FF          .     RST   38         

+1E2D FF          .     RST   38         

+1E2E FF          .     RST   38         

+1E2F FF          .     RST   38         

+1E30 FF          .     RST   38         

+1E31 FF          .     RST   38         

+1E32 FF          .     RST   38         

+1E33 FF          .     RST   38         

+1E34 FF          .     RST   38         

+1E35 FF          .     RST   38         

+1E36 FF          .     RST   38         

+1E37 FF          .     RST   38         

+1E38 FF          .     RST   38         

+1E39 FF          .     RST   38         

+1E3A FF          .     RST   38         

+1E3B FF          .     RST   38         

+1E3C FF          .     RST   38         

+1E3D FF          .     RST   38         

+1E3E FF          .     RST   38         

+1E3F FF          .     RST   38         

+1E40 FF          .     RST   38         

+1E41 FF          .     RST   38         

+1E42 FF          .     RST   38         

+1E43 FF          .     RST   38         

+1E44 FF          .     RST   38         

+1E45 FF          .     RST   38         

+1E46 FF          .     RST   38         

+1E47 FF          .     RST   38         

+1E48 FF          .     RST   38         

+1E49 FF          .     RST   38         

+1E4A FF          .     RST   38         

+1E4B 74          t     LD    (HL),H     ; "trmnet  10 (!)"

+1E4C 72          r     LD    (HL),D     

+1E4D 6D          m     LD    L,L        

+1E4E 6E          n     LD    L,(HL)     

+1E4F 65          e     LD    H,L        

+1E50 74          t     LD    (HL),H     

+1E51 20 20             JR    NZ,1E73    

+1E53 31 30 20    10    LD    SP,2030    

+1E56 28 21       (!    JR    Z,1E79     

+1E58 29          )     ADD   HL,HL      ;---------- intern frout ---------

+1E59 FE 11       ..    CP    11

+1E5B D0          .     RET   NC         

+1E5C E5          .     PUSH  HL         

+1E5D CD EB 23    ..#   CALL  23EB       

+1E60 CB 5E       .^    BIT   3,(HL)     

+1E62 E1          .     POP   HL         

+1E63 28 02       (.    JR    Z,1E67     

+1E65 97          .     SUB   A          ; Ist Stop-Taste gedrueckt

+1E66 C9          .     RET              

+1E67 C5          .     PUSH  BC         ; Weiter gedrueckt

+1E68 01 02 00    ...   LD    BC,0002    ; IOCONTROL frout

+1E6B CD A8 28    ..(   CALL  28A8       

+1E6E 79          y     LD    A,C        

+1E6F C1          .     POP   BC         

+1E70 C9          .     RET              ;-------- intern typ --------------

+1E71 32 B8 26    2.&   LD    (26B8),A   

+1E74 C5          .     PUSH  BC         

+1E75 01 01 00    ...   LD    BC,0001    ; IOCONTROL typ

+1E78 CD A8 28    ..(   CALL  28A8       

+1E7B 79          y     LD    A,C        

+1E7C E6 03       ..    AND   03         

+1E7E FE 03       ..    CP    03         

+1E80 C1          .     POP   BC         

+1E81 3A B8 26    :.&   LD    A,(26B8)   

+1E84 C9          .     RET              ; ---------- cursorpos --> BC ---

+1E85 FE 11       ..    CP    11         

+1E87 D0          .     RET   NC         

+1E88 E5          .     PUSH  HL         

+1E89 CD EB 23    ..#   CALL  23EB       ; Kanaltabellenaddresse

+1E8C 01 02 00    ...   LD    BC,0002    

+1E8F 09          .     ADD   HL,BC      

+1E90 4E          N     LD    C,(HL)     

+1E91 23          #     INC   HL         

+1E92 46          F     LD    B,(HL)     

+1E93 E1          .     POP   HL         

+1E94 B7          .     OR    A          

+1E95 C9          .     RET              ;----------------------------------

+1E96 DD 7E 04    .~.   LD    A,(IX+04)  ; Grosser Puffer leer ?

+1E99 D6 01       ..    SUB   A,01       

+1E9B 30 0B       0.    JR    NC,1EA8    

+1E9D DD 7E 0B    .~.   LD    A,(IX+0B)  

+1EA0 D6 01       ..    SUB   A,01       

+1EA2 30 04       0.    JR    NC,1EA8    

+1EA4 CD E4 1E    ...   CALL  1EE4       ; IOCONTROL weiter

+1EA7 37          7     SCF              

+1EA8 C1          .     POP   BC         

+1EA9 DD E1       ..    POP   IX         

+1EAB E1          .     POP   HL         

+1EAC C9          .     RET              ;---------------------------------

+1EAD FE 11       ..    CP    11         

+1EAF 3F          ?     CCF              

+1EB0 D8          .     RET   C          

+1EB1 E5          .     PUSH  HL         

+1EB2 DD E5       ..    PUSH  IX         

+1EB4 C5          .     PUSH  BC         

+1EB5 32 AC 26    2.&   LD    (26AC),A   

+1EB8 CD FA 23    ..#   CALL  23FA       

+1EBB 3A A9 26    :.&   LD    A,(26A9)   

+1EBE B7          .     OR    A          

+1EBF 28 11       (.    JR    Z,1ED2     

+1EC1 F5          .     PUSH  AF         

+1EC2 97          .     SUB   A          

+1EC3 32 A9 26    2.&   LD    (26A9),A   

+1EC6 F1          .     POP   AF         

+1EC7 28 09       (.    JR    Z,1ED2     

+1EC9 CD 1F 70    ..p   CALL  701F       

+1ECC 18 04       ..    JR    1ED2       

+1ECE 20 69        i    JR    NZ,1F39    ; Info aufrufen

+1ED0 6E          n     LD    L,(HL)     ; " int"

+1ED1 74          t     LD    (HL),H     

+1ED2 DD 2A AD 26 .*.&  LD    IX,(26AD)  

+1ED6 CB 6E       .n    BIT   5,(HL)     

+1ED8 20 BC        .    JR    NZ,1E96    ; Grosser Puffer

+1EDA DD 7E 04    .~.   LD    A,(IX+04)  ; Kleiner Puffer leer ?

+1EDD FE 07       ..    CP    07         

+1EDF 28 15       (.    JR    Z,1EF6     

+1EE1 B7          .     OR    A          

+1EE2 18 51       .Q    JR    1F35       

+1EE4 3A AC 26    :.&   LD    A,(26AC)   ;---------- intern weiter --------

+1EE7 01 04 00    ...   LD    BC,0004    ; IOCONTROL weiter

+1EEA C3 A8 28    ..(   JP    28A8       

+1EED C5          .     PUSH  BC         ;---------- intern stop -----------

+1EEE 01 03 00    ...   LD    BC,0003    

+1EF1 CD A8 28    ..(   CALL  28A8       ; IOCONTORL stop

+1EF4 C1          .     POP   BC         

+1EF5 C9          .     RET              ;----------------------------------

+1EF6 CD E4 1E    ...   CALL  1EE4       ; CALL weiter

+1EF9 DD 7E 04    .~.   LD    A,(IX+04)  ;

+1EFC FE 07       ..    CP    07         

+1EFE 28 03       (.    JR    Z,1F03     ; Puffer leer ?

+1F00 B7          .     OR    A          

+1F01 18 32       .2    JR    1F35       ; Routine mit CLC verlassen 

+1F03 37          7     SCF              

+1F04 18 2F       ./    JR    1F35       ; ROutine mit SEC verlassen

+1F06 CD AD 1E    ...   CALL  1EAD       ;---------------------------------

+1F09 D8          .     RET   C          

+1F0A E5          .     PUSH  HL         

+1F0B DD E5       ..    PUSH  IX         

+1F0D C5          .     PUSH  BC         

+1F0E DD 2A AD 26 .*.&  LD    IX,(26AD)  

+1F12 DD 7E 07    .~.   LD    A,(IX+07)  

+1F15 DD CB 00 6E ...n  BIT   5,(IX+00)  

+1F19 20 1F        .    JR    NZ,1F3A    

+1F1B 2A AD 26    *.&   LD    HL,(26AD)  

+1F1E 01 07 00    ...   LD    BC,0007    

+1F21 09          .     ADD   HL,BC      

+1F22 D5          .     PUSH  DE         

+1F23 54          T     LD    D,H        

+1F24 5D          ]     LD    E,L        

+1F25 23          #     INC   HL         

+1F26 01 0F 00    ...   LD    BC,000F    

+1F29 F3          .     DI               

+1F2A ED B0       ..    LDIR             

+1F2C DD 35       .5    DEC   (IX+04)    

+1F2E 04          .     INC   B          

+1F2F DD 35       .5    DEC   (IX+05)    

+1F31 05          .     DEC   B          

+1F32 FB          .     EI               

+1F33 D1          .     POP   DE         

+1F34 B7          .     OR    A          

+1F35 C1          .     POP   BC         

+1F36 DD E1       ..    POP   IX         

+1F38 E1          .     POP   HL         

+1F39 C9          .     RET              

+1F3A 67          g     LD    H,A        ; Pufferaddresse

+1F3B DD 6E 0C    .n.   LD    L,(IX+0C)  ; Pufferaddresse 

+1F3E CD 81 5A    ..Z   CALL  5A81       

+1F41 DD 7E 05    .~.   LD    A,(IX+05)  ; Lowbyte Schreibzeiger

+1F44 3C          <     INC   A          

+1F45 DD 77 05    .w.   LD    (IX+05),A

+1F48 20 03        .    JR    NZ,1F4D    

+1F4A DD 34       .4    INC   (IX+0A)    ; Highbyte Schreibzeiger

+1F4C 0A          .     LD    A,(BC)     

+1F4D 6F          o     LD    L,A        

+1F4E DD 7E 0A    .~.   LD    A,(IX+0A)  

+1F51 E6 01       ..    AND   01         

+1F53 84          .     ADD   H          

+1F54 67          g     LD    H,A        

+1F55 7E          ~     LD    A,(HL)     

+1F56 F5          .     PUSH  AF         

+1F57 CD 8C 5A    ..Z   CALL  5A8C       

+1F5A F3          .     DI               

+1F5B DD 6E 04    .n.   LD    L,(IX+04)  ; Jetzt darf kein Inputinter. komm.

+1F5E DD 66 0B    .f.   LD    H,(IX+0B)  

+1F61 2B          +     DEC   HL         

+1F62 DD 74 0B    .t.   LD    (IX+0B),H  

+1F65 DD 75 04    .u.   LD    (IX+04),L  

+1F68 FB          .     EI               

+1F69 7D          }     LD    A,L        

+1F6A B7          .     OR    A          

+1F6B CC E4 1E    ...   CALL  Z,1EE4     ; CALL weiter

+1F6E F1          .     POP   AF         

+1F6F 18 C3       ..    JR    1F34       ;=========== inputinterrupt =======

+1F71 FE 11       ..    CP    11         ; B=Eingabezeichen

+1F73 D0          .     RET   NC         ; C=Errorbits

+1F74 DD E5       ..    PUSH  IX         

+1F76 E5          .     PUSH  HL         

+1F77 F5          .     PUSH  AF         

+1F78 CD EB 23    ..#   CALL  23EB       ; Kanaltabelleaddresse

+1F7B E5          .     PUSH  HL         

+1F7C DD E1       ..    POP   IX         

+1F7E CB B9       ..    RES   7,C        ; 

+1F80 CB A9       ..    RES   5,C        ; Pufferoverflowbit

+1F82 DD 7E 01    .~.   LD    A,(IX+01)  

+1F85 B1          .     OR    C          ; Mit Bits vom Shard verodern 

+1F86 DD 77 01    .w.   LD    (IX+01),A  

+1F89 CB 7F       ..    BIT   7,A        

+1F8B 28 0A       (.    JR    Z,1F97     

+1F8D E5          .     PUSH  HL         

+1F8E DD CB 01 F6 ....  SET   6,(IX+01)  

+1F92 21 A9 26    !.&   LD    HL,26A9    

+1F95 34          4     INC   (HL)       

+1F96 E1          .     POP   HL         

+1F97 DD CB 01 FE ....  SET   7,(IX+01)  

+1F9B CB 6E       .n    BIT   5,(HL)     ; Grosser Puffer ?

+1F9D 28 6F       (o    JR    Z,200E     

+1F9F DD 7E 0B    .~.   LD    A,(IX+0B)  ; ja

+1FA2 FE 01       ..    CP    01         

+1FA4 38 0E       8.    JR    C,1FB4     ; < 1 (=0) : Nicht voll

+1FA6 20 3A        :    JR    NZ,1FE2    ; > 1 (=2) : Voll

+1FA8 DD 7E 04    .~.   LD    A,(IX+04)  ; = 180 ,

+1FAB FE 80       ..    CP    80         ; Puffer 3/4b voll Hysterese Stop

+1FAD 20 05        .    JR    NZ,1FB4    

+1FAF F1          .     POP   AF         

+1FB0 F5          .     PUSH  AF         

+1FB1 CD ED 1E    ...   CALL  1EED       ; CALL stop

+1FB4 DD 34       .4    INC   (IX+04)    

+1FB6 04          .     INC   B          

+1FB7 20 03        .    JR    NZ,1FBC    

+1FB9 DD 34       .4    INC   (IX+0B)    

+1FBB 0B          .     DEC   BC         

+1FBC DD 66 07    .f.   LD    H,(IX+07)  

+1FBF DD 6E 0C    .n.   LD    L,(IX+0C)  

+1FC2 78          x     LD    A,B        

+1FC3 C5          .     PUSH  BC         

+1FC4 F5          .     PUSH  AF         

+1FC5 CD 81 5A    ..Z   CALL  5A81       

+1FC8 DD 7E 08    .~.   LD    A,(IX+08)  

+1FCB 3C          <     INC   A          

+1FCC DD 77 08    .w.   LD    (IX+08),A  

+1FCF 6F          o     LD    L,A        

+1FD0 20 03        .    JR    NZ,1FD5    

+1FD2 DD 34       .4    INC   (IX+09)    

+1FD4 09          .     ADD   HL,BC      

+1FD5 DD 7E 09    .~.   LD    A,(IX+09)  

+1FD8 E6 01       ..    AND   01         

+1FDA 84          .     ADD   H          

+1FDB 67          g     LD    H,A        

+1FDC F1          .     POP   AF         

+1FDD 77          w     LD    (HL),A     

+1FDE CD 8C 5A    ..Z   CALL  5A8C       

+1FE1 C1          .     POP   BC         

+1FE2 DD CB 01 EE ....  SET   5,(IX+01)  ; Pufferoverflow setzen

+1FE6 F1          .     POP   AF         

+1FE7 21 AB 26    !.&   LD    HL,26AB    

+1FEA CB B6       ..    RES   6,(HL)     

+1FEC DD CB 01 BE ....  RES   7,(IX+01)  

+1FF0 FB          .     EI               

+1FF1 DD CB 00 6E ...n  BIT   5,(IX+00)  ; Gro�er Puffer ?

+1FF5 20 09        .    JR    NZ,2000    

+1FF7 3E 17       >.    LD    A,17       ; Pufferende-Lesezeiger

+1FF9 DD 96 04    ...   SUB   (IX+04)    ; Platz im Puffer

+1FFC E1          .     POP   HL         

+1FFD DD E1       ..    POP   IX         

+1FFF C9          .     RET              ;----------- Ende von inputinterr.

+2000 DD 7E 0B    .~.   LD    A,(IX+0B)  

+2003 B7          .     OR    A          

+2004 3E FF       >.    LD    A,FF       

+2006 28 F4       (.    JR    Z,1FFC     

+2008 97          .     SUB   A          

+2009 DD 96 04    ...   SUB   (IX+04)    

+200C 18 EE       ..    JR    1FFC       

+200E F1          .     POP   AF         ;------ kleiner Puffer ------------

+200F F5          .     PUSH  AF         

+2010 CD 95 26    ..&   CALL  2695       ; Typtabellennummer

+2013 FE 7E       .~    CP    7E         ; psi ?

+2015 20 29        )    JR    NZ,2040    

+2017 78          x     LD    A,B        ; info-Taste

+2018 FE 04       ..    CP    04         

+201A 28 18       (.    JR    Z,2034       

+201C FE 07       ..    CP    07         ; SV-Call

+201E 28 1A       (.    JR    Z,203A     

+2020 FE 11       ..    CP    11         ; Stop

+2022 28 0A       (.    JR    Z,202E     

+2024 FE 17       ..    CP    17         ; Weiter

+2026 20 18        .    JR    NZ,2040    

+2028 DD CB 00 9E ....  RES   3,(IX+00)  ; Weiter gedrueckt

+202C 18 B8       ..    JR    1FE6       

+202E DD CB 00 DE ....  SET   3,(IX+00)  ; Stop gedrueckt

+2032 18 B2       ..    JR    1FE6       

+2034 F1          .     POP   AF         ; info-taste gedrueckt 

+2035 CD 33 6F    .3o   CALL  6F33       

+2038 18 AD       ..    JR    1FE7       

+203A F1          .     POP   AF         ; SV-Call gedrueckt

+203B CD 93 4C    ..L   CALL  4C93       ; SV-Call zustellen

+203E 18 A7       ..    JR    1FE7       

+2040 C5          .     PUSH  BC         ; nicht psi als tabelle

+2041 DD 7E 05    .~.   LD    A,(IX+05)  ; Schreibzeiger >= 16H ? 

+2044 FE 16       ..    CP    16         

+2046 D2 F2 20    ..    JP    NC,20F2    ; Pufferoverflow setzen

+2049 21 AB 26    !.&   LD    HL,26AB    

+204C CB F6       ..    SET   6,(HL)     

+204E 4F          O     LD    C,A        

+204F 06 00       ..    LD    B,00       

+2051 DD E5       ..    PUSH  IX         

+2053 E1          .     POP   HL         

+2054 09          .     ADD   HL,BC      

+2055 C1          .     POP   BC         

+2056 70          p     LD    (HL),B     

+2057 23          #     INC   HL         

+2058 36 FF       6.    LD    (HL),FF    

+205A DD 34       .4    INC   (IX+05)    ; Schreibzeiger

+205C 05          .     DEC   B          

+205D FE 0E       ..    CP    0E         

+205F 20 0E        .    JR    NZ,206F    

+2061 F1          .     POP   AF         

+2062 F5          .     PUSH  AF         

+2063 CD 95 26    ..&   CALL  2695       

+2066 CB 7E       .~    BIT   7,(HL)     

+2068 28 05       (.    JR    Z,206F     

+206A F1          .     POP   AF         

+206B F5          .     PUSH  AF         

+206C CD ED 1E    ...   CALL  1EED       

+206F F1          .     POP   AF         

+2070 F5          .     PUSH  AF         

+2071 CD 95 26    ..&   CALL  2695       

+2074 FE 7E       .~    CP    7E         

+2076 D2 EB 20    ..    JP    NC,20EB    

+2079 CD 1F 24    ..$   CALL  241F       

+207C D5          .     PUSH  DE         

+207D C5          .     PUSH  BC         

+207E 01 80 01    ...   LD    BC,0180    

+2081 09          .     ADD   HL,BC      

+2082 E5          .     PUSH  HL         

+2083 EB          .     EX    DE,HL      

+2084 DD E5       ..    PUSH  IX         

+2086 E1          .     POP   HL         

+2087 DD 4E 04    .N.   LD    C,(IX+04)  

+208A 06 00       ..    LD    B,00       

+208C 09          .     ADD   HL,BC      

+208D 1A          .     LD    A,(DE)     ; Zeichen an Lesezeigerposition holen

+208E 13          .     INC   DE         

+208F 3C          <     INC   A          

+2090 F5          .     PUSH  AF         

+2091 20 04        .    JR    NZ,2097    

+2093 1A          .     LD    A,(DE)     ; Zeichen = FF ?

+2094 3C          <     INC   A          

+2095 28 38       (8    JR    Z,20CF     

+2097 E5          .     PUSH  HL         

+2098 EB          .     EX    DE,HL      

+2099 1A          .     LD    A,(DE)     

+209A ED A1       ..    CPI              

+209C 20 24        $    JR    NZ,20C2    

+209E 13          .     INC   DE         

+209F 3C          <     INC   A          

+20A0 20 F7        .    JR    NZ,2099    

+20A2 E1          .     POP   HL         

+20A3 F1          .     POP   AF         

+20A4 3D          =     DEC   A          

+20A5 FE 11       ..    CP    11         ; Weiter

+20A7 CA 1C 21    ..!   JP    Z,211C     

+20AA FE 04       ..    CP    04         ; Info

+20AC 28 56       (V    JR    Z,2104     

+20AE FE 07       ..    CP    07         ; SV-Call

+20B0 28 5E       (^    JR    Z,2110     

+20B2 FE 17       ..    CP    17         ; Stop

+20B4 CA 22 21    ."!   JP    Z,2122     

+20B7 77          w     LD    (HL),A     ; Anderer Eingabecode

+20B8 DD 34       .4    INC   (IX+04)    ; Lese-Zeiger weitersetzen

+20BA 04          .     INC   B          

+20BB 23          #     INC   HL         

+20BC CD 2F 21    ./!   CALL  212F       

+20BF E1          .     POP   HL         

+20C0 18 1B       ..    JR    20DD       

+20C2 3C          <     INC   A          

+20C3 28 1C       (.    JR    Z,20E1     

+20C5 7E          ~     LD    A,(HL)     

+20C6 23          #     INC   HL         

+20C7 3C          <     INC   A          

+20C8 20 FB        .    JR    NZ,20C5    

+20CA EB          .     EX    DE,HL      

+20CB E1          .     POP   HL         

+20CC F1          .     POP   AF         

+20CD 18 BE       ..    JR    208D       

+20CF F1          .     POP   AF         

+20D0 E1          .     POP   HL         

+20D1 DD 34       .4    INC   (IX+04)    

+20D3 04          .     INC   B          

+20D4 DD 7E 04    .~.   LD    A,(IX+04)  ; Lesezeiger = Schreibzeiger ?

+20D7 DD BE 05    ...   CP    (IX+05)    

+20DA C2 82 20    ..    JP    NZ,2082    

+20DD C1          .     POP   BC         

+20DE D1          .     POP   DE         

+20DF 18 0D       ..    JR    20EE       

+20E1 3E 02       >.    LD    A,02       

+20E3 32 AB 26    2.&   LD    (26AB),A   

+20E6 E1          .     POP   HL         

+20E7 F1          .     POP   AF         

+20E8 E1          .     POP   HL         

+20E9 18 F2       ..    JR    20DD       

+20EB DD 34       .4    INC   (IX+04)    ; Zeiger weitersetzen

+20ED 04          .     INC   B          

+20EE F1          .     POP   AF         

+20EF C3 E7 1F    ...   JP    1FE7       

+20F2 DD CB 01 EE ....  SET   5,(IX+01)  ; Bit 5 : Puffer overflow

+20F6 DD 7E 04    .~.   LD    A,(IX+04)  ; Schreibzeiger := Lesezeiger

+20F9 DD 77 05    .w.   LD    (IX+05),A  

+20FC 3E 03       >.    LD    A,03       

+20FE 32 AB 26    2.&   LD    (26AB),A   

+2101 C1          .     POP   BC         

+2102 18 EA       ..    JR    20EE       ;-------------- Info-Taste --------

+2104 CD 2F 21    ./!   CALL  212F       

+2107 E1          .     POP   HL         

+2108 C1          .     POP   BC         

+2109 D1          .     POP   DE         

+210A F1          .     POP   AF         

+210B CD 33 6F    .3o   CALL  6F33       

+210E 18 DF       ..    JR    20EF       ;--------------- SV-Call ---------

+2110 CD 2F 21    ./!   CALL  212F       

+2113 E1          .     POP   HL         

+2114 C1          .     POP   BC         

+2115 D1          .     POP   DE         

+2116 F1          .     POP   AF         

+2117 CD 93 4C    ..L   CALL  4C93       

+211A 18 D3       ..    JR    20EF       ;-------------- Weiter-Taste ------

+211C DD CB 00 DE ....  SET   3,(IX+00)  ; Weiterbit setzen 

+2120 18 04       ..    JR    2126       ;-------------- Stop-Taste --------

+2122 DD CB 00 9E ....  RES   3,(IX+00)  ; 

+2126 CD 2F 21    ./!   CALL  212F       

+2129 E1          .     POP   HL         

+212A C1          .     POP   BC         

+212B D1          .     POP   DE         

+212C F1          .     POP   AF         

+212D 18 C0       ..    JR    20EF       

+212F DD 7E 04    .~.   LD    A,(IX+04)  ; Schreibzeiger := Lesezeiger

+2132 DD 77 05    .w.   LD    (IX+05),A  

+2135 3E FF       >.    LD    A,FF       ; Puffer bis zum Ende mit FF fuellen

+2137 77          w     LD    (HL),A     

+2138 23          #     INC   HL         

+2139 7B          {     LD    A,E        

+213A BD          .     CP    L          

+213B 20 F8        .    JR    NZ,2135    

+213D C9          .     RET              ; ------ Test ob Puffer overflow

+213E F5          .     PUSH  AF         

+213F E5          .     PUSH  HL         

+2140 21 B2 26    !.&   LD    HL,26B2    

+2143 CB 7E       .~    BIT   7,(HL)     

+2145 28 02       (.    JR    Z,2149     

+2147 86          .     ADD   (HL)       

+2148 77          w     LD    (HL),A     

+2149 3A AB 26    :.&   LD    A,(26AB)   

+214C 3D          =     DEC   A          

+214D FA 85 21    ..!   JP    M,2185     

+2150 32 AB 26    2.&   LD    (26AB),A   

+2153 20 30        0    JR    NZ,2185    

+2155 DD E5       ..    PUSH  IX         

+2157 D5          .     PUSH  DE         

+2158 C5          .     PUSH  BC         

+2159 11 18 00    ...   LD    DE,0018    

+215C 3E 01       >.    LD    A,01       ; Beginne mit Kanal 1

+215E CD EB 23    ..#   CALL  23EB       ; Zeiger auf Kanaltabelle --> HL

+2161 06 10       ..    LD    B,10       ; Fuer 16 Kanaele

+2163 E5          .     PUSH  HL         

+2164 DD E1       ..    POP   IX         

+2166 DD CB 00 6E ...n  BIT   5,(IX+00)  ; Gro�er Puffer

+216A 20 11        .    JR    NZ,217D    ; kein overflow

+216C F3          .     DI               

+216D DD 7E 05    .~.   LD    A,(IX+05)  ; Schreibzeiger >= 16H ? 

+2170 FE 16       ..    CP    16         

+2172 38 05       8.    JR    C,2179     

+2174 3E 13       >.    LD    A,13       ; zuruecksetzen auf 13

+2176 DD 77 05    .w.   LD    (IX+05),A  

+2179 DD 77 04    .w.   LD    (IX+04),A  

+217C FB          .     EI               

+217D DD 19       ..    ADD   IX,DE      ; Next entry

+217F 10 E5       ..    DJNZ  2166       

+2181 C1          .     POP   BC         

+2182 D1          .     POP   DE         

+2183 DD E1       ..    POP   IX         

+2185 E1          .     POP   HL         

+2186 F1          .     POP   AF         

+2187 C9          .     RET              ;----------- OUTPUT ------------

+2188 FE 11       ..    CP    11         

+218A D2 7B 28    .{(   JP    NC,287B    

+218D F5          .     PUSH  AF         

+218E DD E5       ..    PUSH  IX         

+2190 32 AC 26    2.&   LD    (26AC),A   

+2193 E5          .     PUSH  HL         

+2194 CD 95 26    ..&   CALL  2695       

+2197 D2 3A 22    .:"   JP    NC,223A    

+219A 32 B1 26    2.&   LD    (26B1),A   

+219D 3A AC 26    :.&   LD    A,(26AC)   

+21A0 CD FA 23    ..#   CALL  23FA       

+21A3 DD 2A AD 26 .*.&  LD    IX,(26AD)  

+21A7 7E          ~     LD    A,(HL)     

+21A8 E6 0B       ..    AND   0B         

+21AA 28 24       ($    JR    Z,21D0     

+21AC CB 5F       ._    BIT   3,A        

+21AE 20 0C        .    JR    NZ,21BC    

+21B0 CB 47       .G    BIT   0,A        

+21B2 28 13       (.    JR    Z,21C7     

+21B4 3A AC 26    :.&   LD    A,(26AC)   

+21B7 CD 59 1E    .Y.   CALL  1E59       

+21BA 38 09       8.    JR    C,21C5     

+21BC E1          .     POP   HL         

+21BD DD E1       ..    POP   IX         

+21BF F1          .     POP   AF         

+21C0 01 00 00    ...   LD    BC,0000    

+21C3 B7          .     OR    A          

+21C4 C9          .     RET              

+21C5 CB 86       ..    RES   0,(HL)     

+21C7 3A B2 26    :.&   LD    A,(26B2)   

+21CA CB 7F       ..    BIT   7,A        

+21CC 20 EE        .    JR    NZ,21BC    

+21CE CB 8E       ..    RES   1,(HL)     

+21D0 E1          .     POP   HL         

+21D1 D5          .     PUSH  DE         

+21D2 E5          .     PUSH  HL         

+21D3 3A B1 26    :.&   LD    A,(26B1)   

+21D6 CD 1F 24    ..$   CALL  241F       

+21D9 54          T     LD    D,H        

+21DA 5D          ]     LD    E,L        

+21DB E1          .     POP   HL         

+21DC E5          .     PUSH  HL         

+21DD C5          .     PUSH  BC         

+21DE 78          x     LD    A,B        

+21DF B1          .     OR    C          

+21E0 20 08        .    JR    NZ,21EA    

+21E2 C1          .     POP   BC         

+21E3 E1          .     POP   HL         

+21E4 D1          .     POP   DE         

+21E5 DD E1       ..    POP   IX         

+21E7 F1          .     POP   AF         

+21E8 37          7     SCF              

+21E9 C9          .     RET              

+21EA E5          .     PUSH  HL         

+21EB 7E          ~     LD    A,(HL)     

+21EC 2A AD 26    *.&   LD    HL,(26AD)  

+21EF CB 56       .V    BIT   2,(HL)     

+21F1 28 0F       (.    JR    Z,2202     

+21F3 CB 66       .f    BIT   4,(HL)     

+21F5 CA 07 23    ..#   JP    Z,2307     

+21F8 CB A6       ..    RES   4,(HL)     

+21FA 23          #     INC   HL         

+21FB 23          #     INC   HL         

+21FC 77          w     LD    (HL),A     

+21FD E1          .     POP   HL         

+21FE 23          #     INC   HL         

+21FF 0B          .     DEC   BC         

+2200 18 DC       ..    JR    21DE       

+2202 E1          .     POP   HL         

+2203 E5          .     PUSH  HL         

+2204 C5          .     PUSH  BC         

+2205 3A B1 26    :.&   LD    A,(26B1)   

+2208 FE 7E       .~    CP    7E         

+220A 28 35       (5    JR    Z,2241     

+220C E5          .     PUSH  HL         

+220D 6E          n     LD    L,(HL)     

+220E 26 00       &.    LD    H,00       

+2210 19          .     ADD   HL,DE      

+2211 7E          ~     LD    A,(HL)     

+2212 3C          <     INC   A          

+2213 20 38        8    JR    NZ,224D    

+2215 E1          .     POP   HL         

+2216 ED A1       ..    CPI              

+2218 EA 0C 22    .."   JP    PE,220C    

+221B C1          .     POP   BC         

+221C E1          .     POP   HL         

+221D C5          .     PUSH  BC         

+221E 3A AC 26    :.&   LD    A,(26AC)   

+2221 CD 7B 28    .{(   CALL  287B       

+2224 F5          .     PUSH  AF         

+2225 DD 7E 03    .~.   LD    A,(IX+03)  ; xpos INCR C

+2228 81          .     ADD   C          

+2229 DD 77 03    .w.   LD    (IX+03),A  

+222C F1          .     POP   AF         

+222D D2 CE 23    ..#   JP    NC,23CE    

+2230 09          .     ADD   HL,BC      

+2231 E3          .     EX    (SP),HL    

+2232 B7          .     OR    A          

+2233 ED 42       .B    SBC   HL,BC      

+2235 44          D     LD    B,H        

+2236 4D          M     LD    C,L        

+2237 E1          .     POP   HL         

+2238 18 A4       ..    JR    21DE       

+223A E1          .     POP   HL         

+223B DD E1       ..    POP   IX         

+223D F1          .     POP   AF         

+223E C3 7B 28    .{(   JP    287B       

+2241 3E 0D       >.    LD    A,0D       

+2243 BE          .     CP    (HL)       

+2244 30 08       0.    JR    NC,224E    

+2246 ED A1       ..    CPI              

+2248 EA 43 22    .C"   JP    PE,2243    

+224B 18 CE       ..    JR    221B       

+224D E1          .     POP   HL         

+224E 7E          ~     LD    A,(HL)     

+224F E1          .     POP   HL         

+2250 E5          .     PUSH  HL         

+2251 B7          .     OR    A          

+2252 ED 42       .B    SBC   HL,BC      

+2254 28 06       (.    JR    Z,225C     

+2256 44          D     LD    B,H        

+2257 4D          M     LD    C,L        

+2258 E1          .     POP   HL         

+2259 E3          .     EX    (SP),HL    

+225A 18 C2       ..    JR    221E       

+225C F5          .     PUSH  AF         

+225D 3A AC 26    :.&   LD    A,(26AC)   

+2260 C5          .     PUSH  BC         

+2261 01 02 00    ...   LD    BC,0002    ; IOCONTROL frout

+2264 CD A8 28    ..(   CALL  28A8       

+2267 79          y     LD    A,C        

+2268 C1          .     POP   BC         

+2269 FE 10       ..    CP    10         

+226B DA E6 23    ..#   JP    C,23E6     

+226E F1          .     POP   AF         

+226F CD 79 22    .y"   CALL  2279       

+2272 C1          .     POP   BC         

+2273 E1          .     POP   HL         

+2274 0B          .     DEC   BC         

+2275 23          #     INC   HL         

+2276 C3 DE 21    ..!   JP    21DE       ;-------- cursor mitfuehren ------

+2279 FE 06       ..    CP    06         

+227B CA FF 22    .."   JP    Z,22FF     

+227E 38 54       8T    JR    C,22D4     

+2280 FE 08       ..    CP    08         ; Left

+2282 28 15       (.    JR    Z,2299     

+2284 FE 07       ..    CP    07         ; Bell: Keine Veraenderung

+2286 28 5B       ([    JR    Z,22E3     

+2288 FE 0A       ..    CP    0A         ; LF

+228A 28 12       (.    JR    Z,229E     

+228C DD 34       .4    INC   (IX+03)    ; Alles andere wie right 

+228E 03          .     INC   BC         

+228F FE 0D       ..    CP    0D         ; CR

+2291 20 50        P    JR    NZ,22E3    

+2293 DD 36 03 00 .6..  LD    (IX+03),00 

+2297 18 4A       .J    JR    22E3       

+2299 DD 35       .5    DEC   (IX+03)    

+229B 03          .     INC   BC         

+229C 18 45       .E    JR    22E3       

+229E F5          .     PUSH  AF         

+229F DD 7E 02    .~.   LD    A,(IX+02)  ; ypos des cursors

+22A2 DD BE 06    ...   CP    (IX+06)    ; max. ypos (wird mit ysize ges.) 

+22A5 28 03       (.    JR    Z,22AA     

+22A7 DD 34       .4    INC   (IX+02)    ; ypos +1

+22A9 02          .     LD    (BC),A     

+22AA F1          .     POP   AF         

+22AB 18 36       .6    JR    22E3       

+22AD E5          .     PUSH  HL         

+22AE 23          #     INC   HL         

+22AF CD 5F 23    ._#   CALL  235F       

+22B2 E1          .     POP   HL         

+22B3 7E          ~     LD    A,(HL)     

+22B4 B7          .     OR    A          

+22B5 C8          .     RET   Z          

+22B6 2A AD 26    *.&   LD    HL,(26AD)  

+22B9 CB C6       ..    SET   0,(HL)     

+22BB CB CE       ..    SET   1,(HL)     

+22BD 3E 81       >.    LD    A,81       

+22BF 32 B2 26    2.&   LD    (26B2),A   

+22C2 C3 E0 23    ..#   JP    23E0       

+22C5 DD 36 02 00 .6..  LD    (IX+02),00 

+22C9 DD 36 03 00 .6..  LD    (IX+03),00 

+22CD 18 14       ..    JR    22E3       

+22CF DD 34       .4    INC   (IX+03)    

+22D1 03          .     INC   BC         

+22D2 18 0F       ..    JR    22E3       

+22D4 FE 01       ..    CP    01         ; Home ?

+22D6 28 ED       (.    JR    Z,22C5     

+22D8 FE 02       ..    CP    02         ; Right ?

+22DA 28 F3       (.    JR    Z,22CF     

+22DC FE 03       ..    CP    03         ; Up

+22DE 20 03        .    JR    NZ,22E3    

+22E0 DD 35       .5    DEC   (IX+02)    ; ypos-1 

+22E2 02          .     LD    (BC),A     

+22E3 6F          o     LD    L,A        

+22E4 3A B1 26    :.&   LD    A,(26B1)   

+22E7 FE 7E       .~    CP    7E         

+22E9 20 04        .    JR    NZ,22EF    

+22EB 7D          }     LD    A,L        

+22EC C3 B8 23    ..#   JP    23B8       

+22EF 26 00       &.    LD    H,00       

+22F1 19          .     ADD   HL,DE      

+22F2 7E          ~     LD    A,(HL)     

+22F3 FE 80       ..    CP    80         

+22F5 DA B8 23    ..#   JP    C,23B8     

+22F8 D6 80       ..    SUB   A,80       

+22FA 62          b     LD    H,D        

+22FB 6F          o     LD    L,A        

+22FC 24          $     INC   H          

+22FD 18 AE       ..    JR    22AD       ;---------- cursor (x,y) ----------

+22FF 2A AD 26    *.&   LD    HL,(26AD)  

+2302 CB D6       ..    SET   2,(HL)     

+2304 CB E6       ..    SET   4,(HL)     

+2306 C9          .     RET              ;---------------------------------

+2307 23          #     INC   HL         

+2308 23          #     INC   HL         

+2309 23          #     INC   HL         

+230A 77          w     LD    (HL),A     

+230B 3A B1 26    :.&   LD    A,(26B1)   

+230E FE 7E       .~    CP    7E         ; psi ?

+2310 20 11        .    JR    NZ,2323    

+2312 3E 06       >.    LD    A,06       ; Code 6

+2314 CD B8 23    ..#   CALL  23B8       

+2317 2B          +     DEC   HL         

+2318 7E          ~     LD    A,(HL)     ; y pos 

+2319 CD B8 23    ..#   CALL  23B8       

+231C 23          #     INC   HL         

+231D 7E          ~     LD    A,(HL)     ; x pos  

+231E CD B8 23    ..#   CALL  23B8       

+2321 18 31       .1    JR    2354       

+2323 14          .     INC   D          

+2324 1A          .     LD    A,(DE)     

+2325 15          .     DEC   D          

+2326 3C          <     INC   A          

+2327 20 0E        .    JR    NZ,2337    

+2329 DD 7E 03    .~.   LD    A,(IX+03)  ; alte xpos

+232C D6 50       .P    SUB   A,50       ; 80 Spalten Umbruch

+232E 38 07       8.    JR    C,2337     

+2330 DD CB 02 F6 ....  SET   6,(IX+02)  

+2334 DD 77 03    .w.   LD    (IX+03),A  

+2337 C5          .     PUSH  BC         

+2338 21 06 00    !..   LD    HL,0006    ; Cursorstringcode = 6

+233B 19          .     ADD   HL,DE      

+233C 7E          ~     LD    A,(HL)     ; Ist immer ein outstring

+233D CB BF       ..    RES   7,A        

+233F 24          $     INC   H          ; Outstringpage

+2340 6F          o     LD    L,A        

+2341 2C          ,     INC   L          ; keine wartezeit

+2342 CD 5F 23    ._#   CALL  235F       ; prestring ausgeben

+2345 23          #     INC   HL         

+2346 CD 6C 23    .l#   CALL  236C       ; x/y pos ausgeben

+2349 CD 5F 23    ._#   CALL  235F       ; midstring ausgeben

+234C 23          #     INC   HL         

+234D CD 6C 23    .l#   CALL  236C       ; x/y pos ausgeben

+2350 CD 5F 23    ._#   CALL  235F       ; poststring ausgeben

+2353 C1          .     POP   BC         ; naechstes zeichen interpretieren

+2354 2A AD 26    *.&   LD    HL,(26AD)  

+2357 CB 96       ..    RES   2,(HL)     

+2359 E1          .     POP   HL         

+235A 23          #     INC   HL         

+235B 0B          .     DEC   BC         

+235C C3 DE 21    ..!   JP    21DE       ; string ausgeben (mit 0 am ende)

+235F 06 46       .F    LD    B,46       ; max 70 zeichen

+2361 7E          ~     LD    A,(HL)     

+2362 B7          .     OR    A          

+2363 28 06       (.    JR    Z,236B     

+2365 CD B8 23    ..#   CALL  23B8       ; char out

+2368 23          #     INC   HL         

+2369 10 F6       ..    DJNZ  2361       

+236B C9          .     RET              ;----------- x/y pos out --------- 

+236C 7E          ~     LD    A,(HL)     ; zeichen "x" oder "y" 

+236D E5          .     PUSH  HL         

+236E 2A AD 26    *.&   LD    HL,(26AD)  ; zeiger auf x pos (26ad)+2

+2371 23          #     INC   HL         

+2372 23          #     INC   HL         

+2373 FE 79       .y    CP    79         ; "y" Kennzeichen

+2375 28 01       (.    JR    Z,2378     

+2377 23          #     INC   HL         ; ypos 

+2378 46          F     LD    B,(HL)     ; neue position --> B

+2379 FD E5       ..    PUSH  IY         

+237B 14          .     INC   D          ; 

+237C D5          .     PUSH  DE         

+237D FD E1       ..    POP   IY         

+237F 15          .     DEC   D          

+2380 FE 79       .y    CP    79         ; "y" Kennzeichen

+2382 28 02       (.    JR    Z,2386     

+2384 FD 23       .#    INC   IY         

+2386 FD 7E 02    .~.   LD    A,(IY+02)  ; Offset + pos

+2389 80          .     ADD   B          

+238A FD CB 00 56 ...V  BIT   2,(IY+00)  ; Keine Konvertierung

+238E 20 0C        .    JR    NZ,239C     

+2390 FD CB 00 46 ...F  BIT   0,(IY+00)  ; Dezimale ASCII-Ausgabe

+2394 20 0E        .    JR    NZ,23A4    

+2396 FE 0C       ..    CP    0C         ; Elbit Cursor

+2398 38 02       8.    JR    C,239C     

+239A C6 04       ..    ADD   A,04       ; ywert

+239C CD B8 23    ..#   CALL  23B8       ; Byte ausgeben

+239F FD E1       ..    POP   IY         

+23A1 E1          .     POP   HL         

+23A2 23          #     INC   HL         

+23A3 C9          .     RET              ;--------- Dezimal ausgeben -------

+23A4 D5          .     PUSH  DE         

+23A5 5F          _     LD    E,A        

+23A6 16 00       ..    LD    D,00       

+23A8 21 A4 26    !.&   LD    HL,26A4    ; Zwischenspeicheraddresse

+23AB CD 00 4E    ..N   CALL  4E00       ; String uebertragen

+23AE 41          A     LD    B,C        ; Laengebyte

+23AF 21 A4 26    !.&   LD    HL,26A4    ; Startaddresse des Strings

+23B2 CD 61 23    .a#   CALL  2361       ; String ausgeben

+23B5 D1          .     POP   DE         

+23B6 18 E7       ..    JR    239F       ; Return

+23B8 E5          .     PUSH  HL         

+23B9 C5          .     PUSH  BC         

+23BA 21 AA 26    !.&   LD    HL,26AA    

+23BD 77          w     LD    (HL),A     

+23BE 01 01 00    ...   LD    BC,0001    

+23C1 3A AC 26    :.&   LD    A,(26AC)   

+23C4 CD 7B 28    .{(   CALL  287B       

+23C7 78          x     LD    A,B        

+23C8 B1          .     OR    C          

+23C9 28 F3       (.    JR    Z,23BE     

+23CB C1          .     POP   BC         

+23CC E1          .     POP   HL         

+23CD C9          .     RET              

+23CE E1          .     POP   HL         

+23CF B7          .     OR    A          

+23D0 ED 42       .B    SBC   HL,BC      

+23D2 E3          .     EX    (SP),HL    

+23D3 C1          .     POP   BC         

+23D4 B7          .     OR    A          

+23D5 ED 42       .B    SBC   HL,BC      

+23D7 44          D     LD    B,H        

+23D8 4D          M     LD    C,L        

+23D9 E1          .     POP   HL         

+23DA D1          .     POP   DE         

+23DB DD E1       ..    POP   IX         

+23DD F1          .     POP   AF         

+23DE B7          .     OR    A          

+23DF C9          .     RET              

+23E0 C1          .     POP   BC         

+23E1 E1          .     POP   HL         

+23E2 2B          +     DEC   HL         

+23E3 C1          .     POP   BC         

+23E4 18 EC       ..    JR    23D2       

+23E6 E1          .     POP   HL         

+23E7 E1          .     POP   HL         

+23E8 C1          .     POP   BC         

+23E9 18 E7       ..    JR    23D2       ;----- Zeiger auf Kanaltabelle

+23EB D5          .     PUSH  DE         

+23EC C5          .     PUSH  BC         

+23ED 21 B1 26    !.&   LD    HL,26B1    

+23F0 47          G     LD    B,A        

+23F1 11 18 00    ...   LD    DE,0018    ; 24 Bytes lang ein entry

+23F4 19          .     ADD   HL,DE      

+23F5 10 FD       ..    DJNZ  23F4       

+23F7 C1          .     POP   BC         

+23F8 D1          .     POP   DE         

+23F9 C9          .     RET              

+23FA CD EB 23    ..#   CALL  23EB       

+23FD 22 AD 26    ".&   LD    (26AD),HL  

+2400 C9          .     RET              ;--------- Typtabellennummeraddr->HL

+2401 FE 7E       .~    CP    7E         ; psi

+2403 C8          .     RET   Z          

+2404 FE 05       ..    CP    05         ; Tabellennummer >= 5 ?

+2406 38 0E       8.    JR    C,2416     

+2408 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+240B 18 09       ..    JR    2416       ; " lst ovfl"

+240D 20 6C        l    JR    NZ,247B    

+240F 73          s     LD    (HL),E     

+2410 74          t     LD    (HL),H     

+2411 20 6F        o    JR    NZ,2482    

+2413 76          v     HALT             

+2414 66          f     LD    H,(HL)     

+2415 6C          l     LD    L,H        

+2416 21 B3 26    !.&   LD    HL,26B3

+2419 85          .     ADD   L          

+241A 6F          o     LD    L,A        

+241B 30 01       0.    JR    NC,241E    

+241D 24          $     INC   H          

+241E C9          .     RET              ;------ Addresse der Typtabelle --

+241F CD 01 24    ..$   CALL  2401       

+2422 66          f     LD    H,(HL)     

+2423 2E 00       ..    LD    L,00       

+2425 C9          .     RET              ;--Typt.Block reservieren -------

+2426 E5          .     PUSH  HL         

+2427 D5          .     PUSH  DE         

+2428 CD 42 5E    .B^   CALL  5E42       ; Block freimachen

+242B 7D          }     LD    A,L        

+242C 87          .     ADD   A          ; * 2

+242D D1          .     POP   DE         

+242E E1          .     POP   HL         

+242F 77          w     LD    (HL),A     ; Pufferaddresse (Block)eintragen

+2430 C9          .     RET              

+2431 F1          .     POP   AF         

+2432 01 FF FF    ...   LD    BC,FFFF    ; Returncode -1

+2435 C9          .     RET              ; ---- 173/175 Shard-IOCONTROL ----- 

+2436 F5          .     PUSH  AF         

+2437 3A 6B 28    :k(   LD    A,(286B)   ; Shardversion 

+243A FE 06       ..    CP    06         ; 173 Shard

+243C 38 F3       8.    JR    C,2431     ; < 6 : control geht nicht

+243E FE 08       ..    CP    08         

+2440 30 0A       0.    JR    NC,244C    ; >= 8 : keine Registerverlagerung

+2442 F1          .     POP   AF         ; 173: Register umdrehen

+2443 61          a     LD    H,C        ; H = Schl�ssel (>=8: HL=Schl�ssel)

+2444 42          B     LD    B,D        ; BC = Funktionsnummer

+2445 4B          K     LD    C,E        ; L war schon addressierter Kanal

+2446 11 00 00    ...   LD    DE,0000    ; DE = Funktionscode 1 (nicht in <8)

+2449 C3 A8 28    ..(   JP    28A8       ; IOCONTROL an Shard geben

+244C F1          .     POP   AF         ; --- 175 Shard-IOCONTROL ---------- 

+244D C5          .     PUSH  BC         

+244E 42          B     LD    B,D        ; Funktionsnummer nach BC

+244F 4B          K     LD    C,E        

+2450 54          T     LD    D,H        ; Code 1 nach DE

+2451 5D          ]     LD    E,L        

+2452 E1          .     POP   HL         ; Code 2 nach HL

+2453 C3 A8 28    ..(   JP    28A8       ; ---- CONTROL (DE,HL,BC,res BC) ----

+2456 CB 7A       .z    BIT   7,D        

+2458 20 F3        .    JR    NZ,244D    

+245A F5          .     PUSH  AF         

+245B 7B          {     LD    A,E        ; Control 6: flow (kanal.

+245C FE 06       ..    CP    06         

+245E CA 24 25    .$%   JP    Z,2524     

+2461 FE 08       ..    CP    08         ; Control 8: baud (kanal,schlssl,res)

+2463 28 D2       (.    JR    Z,2437     

+2465 FE 09       ..    CP    09         ; Control 9: bits (kanal,schlssl,res)

+2467 28 CE       (.    JR    Z,2437     

+2469 FE 0A       ..    CP    0A         ; Control 10: calendar (field,0,bcd)

+246B 28 1B       (.    JR    Z,2488     

+246D FE 0C       ..    CP    0C         ; Control 12: xmiterror (0,0,err)

+246F 20 1E        .    JR    NZ,248F    ;--------- IOCONTROL 12 ----------

+2471 0E 3F       .?    LD    C,3F

+2473 3A 6B 28    :k(   LD    A,(286B)   

+2476 FE 08       ..    CP    08         ; Shard Version >= 8 ?

+2478 30 02       0.    JR    NC,247C    

+247A 0E 20       .     LD    C,20       ; Nur Puffer uebergelaufen

+247C F1          .     POP   AF         

+247D CD EB 23    ..#   CALL  23EB       ; Zeiger auf Kanaltabelle 

+2480 23          #     INC   HL         

+2481 7E          ~     LD    A,(HL)     

+2482 A1          .     AND   C          

+2483 4F          O     LD    C,A        

+2484 06 00       ..    LD    B,00       

+2486 70          p     LD    (HL),B     

+2487 C9          .     RET              ; ----- IOCONTROL calendar ---------

+2488 3A 6B 28    :k(   LD    A,(286B)   

+248B FE 08       ..    CP    08         ; Shard Vers >= 8 ? 

+248D 38 A2       8.    JR    C,2431     ; nein, Return -1

+248F F1          .     POP   AF         ; ------ 

+2490 FE 20       .     CP    20         ; Parameterkanal ?

+2492 28 0E       (.    JR    Z,24A2     

+2494 F5          .     PUSH  AF         ; Kein Parameterkanal

+2495 7B          {     LD    A,E        

+2496 FE 05       ..    CP    05         ; Funktion 5: size

+2498 28 04       (.    JR    Z,249E     

+249A FE 07       ..    CP    07         ; Funktion 7: format

+249C 20 AE        .    JR    NZ,244C    

+249E F1          .     POP   AF         

+249F C3 2A 64    .*d   JP    642A       ; �bergeben an PROZ ARCH

+24A2 7B          {     LD    A,E        ; Am Parameterkanal

+24A3 FE 01       ..    CP    01         ; Funktion 1: typtab(kanal,typnr,res)

+24A5 28 65       (e    JR    Z,250C     

+24A7 FE 02       ..    CP    02         ; Funktion 2: inbuffsize(kanal,size,res)

+24A9 28 06       (.    JR    Z,24B1     

+24AB FE 0B       ..    CP    0B         ; Funktion 11: ysize(kanal,ysize,res)

+24AD CA 3C 25    .<%   JP    Z,253C     

+24B0 C9          .     RET              ;--- CONTROL inputbuffersize ------

+24B1 7D          }     LD    A,L        ; Funktion 2 :

+24B2 FE 11       ..    CP    11         

+24B4 D0          .     RET   NC         ; Kanal < 17 ?

+24B5 CD EB 23    ..#   CALL  23EB       ; Zeiger auf Kanaltabelle berechnen 

+24B8 78          x     LD    A,B        ; > 255 ?

+24B9 FE 01       ..    CP    01         

+24BB 30 22       0"    JR    NC,24DF    

+24BD CB 6E       .n    BIT   5,(HL)     ; inputbuffersize < 256

+24BF C8          .     RET   Z          ; schon eingestellt

+24C0 DD E5       ..    PUSH  IX         

+24C2 E5          .     PUSH  HL         

+24C3 DD E1       ..    POP   IX         

+24C5 DD 66 07    .f.   LD    H,(IX+07)  ; 7 = Blockaddresse

+24C8 DD 6E 0C    .n.   LD    L,(IX+0C)  

+24CB CD 0B 5E    ..^   CALL  5E0B       ; Alten Pufferblock freigeben

+24CE F3          .     DI               

+24CF DD 36 00 00 .6..  LD    (IX+00),00 ; Jetzt kleiner Puffer ohne Flussk.

+24D3 DD 36 04 07 .6..  LD    (IX+04),07 ; Zeiger auf Pufferanfang

+24D7 FB          .     EI               

+24D8 DD 36 05 07 .6..  LD    (IX+05),07 

+24DC DD E1       ..    POP   IX         

+24DE C9          .     RET              ;---- Grosser Puffer --------------

+24DF CB 6E       .n    BIT   5,(HL)     

+24E1 C0          .     RET   NZ         ; war schon > 255 eingestellt

+24E2 DD E5       ..    PUSH  IX         

+24E4 E5          .     PUSH  HL         

+24E5 CD 18 5E    ..^   CALL  5E18       ; Block freimachen fuer Puffer

+24E8 DD E1       ..    POP   IX         

+24EA F3          .     DI               

+24EB DD CB 00 EE ....  SET   5,(IX+00)  ; Grosser Puffer

+24EF DD 74 07    .t.   LD    (IX+07),H  ; Pufferaddresse setzen

+24F2 DD 75 0C    .u.   LD    (IX+0C),L  

+24F5 97          .     SUB   A          ; Puffer leeren

+24F6 DD 77 04    .w.   LD    (IX+04),A  ; Lese- und Schreibzeiger jetzt 16Bit

+24F9 DD 77 08    .w.   LD    (IX+08),A  ; Auf Blockanfang

+24FC DD 77 05    .w.   LD    (IX+05),A  

+24FF DD 77 0B    .w.   LD    (IX+0B),A  

+2502 DD 77 09    .w.   LD    (IX+09),A  

+2505 DD 77 0A    .w.   LD    (IX+0A),A  

+2508 FB          .     EI               

+2509 DD E1       ..    POP   IX         

+250B C9          .     RET              ;------ CONTROL typtabelle -------

+250C 79          y     LD    A,C        ; Typtabelle einstellen

+250D FE FE       ..    CP    FE         ; >= 254: psi o. transparent

+250F 30 05       0.    JR    NC,2516    ; 

+2511 FE 05       ..    CP    05         

+2513 D2 3F 26    .?&   JP    NC,263F    ; >= 5: falsche Nummer

+2516 7D          }     LD    A,L        

+2517 FE 11       ..    CP    11         

+2519 D2 5A 26    .Z&   JP    NC,265A    

+251C CD 95 26    ..&   CALL  2695       ; Kanaltyptabellenaddresse holen 

+251F 71          q     LD    (HL),C     ; Nummer eintragen

+2520 01 00 00    ...   LD    BC,0000    ; ok

+2523 C9          .     RET              ;------ IOCONTROL flow ----------

+2524 F1          .     POP   AF         ; Eigener Kanal

+2525 C5          .     PUSH  BC         

+2526 E5          .     PUSH  HL         

+2527 CD 36 24    .6$   CALL  2436       ; Shard IOCONTROL flow

+252A E1          .     POP   HL         

+252B D1          .     POP   DE         

+252C 7D          }     LD    A,L        ; Addressierter Kanal

+252D FE 11       ..    CP    11         ; > 16: fertig

+252F D0          .     RET   NC         

+2530 CD 95 26    ..&   CALL  2695       ; Tytabellennummer holen --> A

+2533 CB BE       ..    RES   7,(HL)     ; Erstmal keine Flu�kontrolle setzen

+2535 7B          {     LD    A,E        

+2536 B7          .     OR    A          

+2537 28 02       (.    JR    Z,253B     ; Wenn Flu�kontrolle, dann in Typ-

+2539 CB FE       ..    SET   7,(HL)     ; tabellennummer vermerken

+253B C9          .     RET              ;------- IOCONTROL ysize ----------- 

+253C 7D          }     LD    A,L        ; Addressierter Kanal

+253D FE 11       ..    CP    11         ; > 16: fertig

+253F D0          .     RET   NC         

+2540 CD EB 23    ..#   CALL  23EB       ; Addresse der Kanaltabelle holen 

+2543 DD E5       ..    PUSH  IX         

+2545 E5          .     PUSH  HL         

+2546 DD E1       ..    POP   IX         

+2548 0D          .     DEC   C          ; ysize-1 (=ymax f. y=0..ymax)

+2549 DD 46 06    .F.   LD    B,(IX+06)  ; Return = alte ysize

+254C 04          .     INC   B          ; ymax + 1 = ysize

+254D DD 71 06    .q.   LD    (IX+06),C  

+2550 DD E1       ..    POP   IX         

+2552 48          H     LD    C,B        ; Nur Werte 0..255

+2553 06 00       ..    LD    B,00       

+2555 C9          .     RET              ;----------------------------------

+2556 CB 7C       .|    BIT   7,H        

+2558 C2 DE 63    ..c   JP    NZ,63DE    

+255B 32 AC 26    2.&   LD    (26AC),A   

+255E 7C          |     LD    A,H        

+255F B5          .     OR    L          

+2560 20 06        .    JR    NZ,2568    

+2562 3A AC 26    :.&   LD    A,(26AC)   

+2565 C3 DE 63    ..c   JP    63DE        

+2568 7C          |     LD    A,H        

+2569 E6 FE       ..    AND   FE         

+256B FE 02       ..    CP    02         

+256D 28 08       (.    JR    Z,2577     

+256F C3 5E 26    .^&   JP    265E       

+2572 01 01 02    ...   LD    BC,0201    

+2575 E1          .     POP   HL         

+2576 C9          .     RET              

+2577 78          x     LD    A,B        

+2578 B1          .     OR    C          

+2579 C8          .     RET   Z          

+257A 25          %     DEC   H          

+257B 25          %     DEC   H          

+257C E5          .     PUSH  HL         

+257D 09          .     ADD   HL,BC      

+257E 7C          |     LD    A,H        

+257F D6 02       ..    SUB   A,02       

+2581 38 05       8.    JR    C,2588     

+2583 20 ED        .    JR    NZ,2572    

+2585 B5          .     OR    L          

+2586 20 EA        .    JR    NZ,2572    

+2588 3A AC 26    :.&   LD    A,(26AC)   

+258B CD FA 23    ..#   CALL  23FA       

+258E E1          .     POP   HL         

+258F 19          .     ADD   HL,DE      

+2590 DD E5       ..    PUSH  IX         

+2592 DD 2A AD 26 .*.&  LD    IX,(26AD)  

+2596 DD CB 00 6E ...n  BIT   5,(IX+00)  

+259A 28 5E       (^    JR    Z,25FA     

+259C C5          .     PUSH  BC         

+259D E5          .     PUSH  HL         

+259E DD 66 0B    .f.   LD    H,(IX+0B)  

+25A1 DD 6E 04    .n.   LD    L,(IX+04)  

+25A4 B7          .     OR    A          

+25A5 ED 42       .B    SBC   HL,BC      

+25A7 DA 13 26    ..&   JP    C,2613     

+25AA DD 66 07    .f.   LD    H,(IX+07)  

+25AD DD 6E 0C    .n.   LD    L,(IX+0C)  

+25B0 CD 81 5A    ..Z   CALL  5A81       

+25B3 ED 43 AF 26 .C.&  LD    (26AF),BC  

+25B7 DD 6E 05    .n.   LD    L,(IX+05)  

+25BA DD 7E 0A    .~.   LD    A,(IX+0A)  

+25BD E6 01       ..    AND   01         

+25BF 84          .     ADD   H          

+25C0 67          g     LD    H,A        

+25C1 D1          .     POP   DE         

+25C2 C1          .     POP   BC         

+25C3 C5          .     PUSH  BC         

+25C4 23          #     INC   HL         

+25C5 7D          }     LD    A,L        

+25C6 B7          .     OR    A          

+25C7 20 06        .    JR    NZ,25CF    

+25C9 CB 44       .D    BIT   0,H        

+25CB 20 02        .    JR    NZ,25CF    

+25CD 25          %     DEC   H          

+25CE 25          %     DEC   H          

+25CF ED A0       ..    LDI              

+25D1 EA C5 25    ..%   JP    PE,25C5    

+25D4 2B          +     DEC   HL         

+25D5 DD 75 05    .u.   LD    (IX+05),L  

+25D8 DD 74 0A    .t.   LD    (IX+0A),H  

+25DB ED 4B AF 26 .K.&  LD    BC,(26AF)  

+25DF CD 8C 5A    ..Z   CALL  5A8C       

+25E2 C1          .     POP   BC         

+25E3 F3          .     DI               

+25E4 DD 66 0B    .f.   LD    H,(IX+0B)  

+25E7 DD 6E 04    .n.   LD    L,(IX+04)  

+25EA B7          .     OR    A          

+25EB ED 42       .B    SBC   HL,BC      

+25ED DD 74 0B    .t.   LD    (IX+0B),H  

+25F0 DD 75 04    .u.   LD    (IX+04),L  

+25F3 FB          .     EI               

+25F4 01 00 00    ...   LD    BC,0000    

+25F7 DD E1       ..    POP   IX         

+25F9 C9          .     RET              ;----------------------------------

+25FA 3A AC 26    :.&   LD    A,(26AC)   

+25FD CD AD 1E    ...   CALL  1EAD       

+2600 DC 1A 26    ..&   CALL  C,261A     

+2603 DD E1       ..    POP   IX         

+2605 3A AC 26    :.&   LD    A,(26AC)   

+2608 CD 06 1F    ...   CALL  1F06       

+260B D8          .     RET   C          

+260C 77          w     LD    (HL),A     

+260D ED A1       ..    CPI              

+260F EA 05 26    ..&   JP    PE,2605    

+2612 C9          .     RET              

+2613 CD 1A 26    ..&   CALL  261A       

+2616 E1          .     POP   HL         

+2617 C1          .     POP   BC         

+2618 18 E9       ..    JR    2603       

+261A 2A AD 26    *.&   LD    HL,(26AD)  

+261D 7E          ~     LD    A,(HL)     

+261E EE 40       .@    XOR   40         

+2620 77          w     LD    (HL),A     

+2621 CB 77       .w    BIT   6,A        

+2623 C8          .     RET   Z          

+2624 21 00 00    !..   LD    HL,0000    

+2627 C3 1A 6C    ..l   JP    6C1A

+262A CB 7C       .|    BIT   7,H        

+262C C2 25 64    .%d   JP    NZ,6425    

+262F 32 AC 26    2.&   LD    (26AC),A   

+2632 F5          .     PUSH  AF         

+2633 7C          |     LD    A,H        

+2634 B5          .     OR    L          

+2635 20 2B        +    JR    NZ,2662    

+2637 F1          .     POP   AF         

+2638 FE 20       .     CP    20         

+263A C2 25 64    .%d   JP    NZ,6425    

+263D 18 04       ..    JR    2643       

+263F 01 02 00    ...   LD    BC,0002    ; Nummer der Typtabelle falsch

+2642 C9          .     RET              

+2643 79          y     LD    A,C        

+2644 FE 05       ..    CP    05         

+2646 30 F7       0.    JR    NC,263F    

+2648 CD 01 24    ..$   CALL  2401       

+264B 7E          ~     LD    A,(HL)     

+264C B7          .     OR    A          

+264D CC 26 24    .&$   CALL  Z,2426     

+2650 67          g     LD    H,A        

+2651 2E 00       ..    LD    L,00       

+2653 EB          .     EX    DE,HL      

+2654 01 00 02    ...   LD    BC,0200    ; Typtabelle in Bereich uebertragen

+2657 ED B0       ..    LDIR             

+2659 C9          .     RET              

+265A 01 03 00    ...   LD    BC,0003    

+265D C9          .     RET              

+265E 01 01 00    ...   LD    BC,0001    

+2661 C9          .     RET              

+2662 F1          .     POP   AF         

+2663 7C          |     LD    A,H        

+2664 E6 FE       ..    AND   FE         

+2666 FE 02       ..    CP    02         

+2668 28 02       (.    JR    Z,266C     

+266A 18 F2       ..    JR    265E       

+266C 78          x     LD    A,B        

+266D B1          .     OR    C          

+266E C8          .     RET   Z          

+266F C5          .     PUSH  BC         

+2670 E5          .     PUSH  HL         

+2671 01 02 00    ...   LD    BC,0002    

+2674 3A AC 26    :.&   LD    A,(26AC)   

+2677 CD A8 28    ..(   CALL  28A8       ; IOCONTROL frout

+267A 21 1C 00    !..   LD    HL,001C    ; 28 Zeichen

+267D ED 42       .B    SBC   HL,BC      ; Anzahl uebernommener Zeichen

+267F D4 1A 26    ..&   CALL  NC,261A    

+2682 E1          .     POP   HL         

+2683 C1          .     POP   BC         

+2684 25          %     DEC   H          

+2685 25          %     DEC   H          

+2686 19          .     ADD   HL,DE      

+2687 C5          .     PUSH  BC         

+2688 3A AC 26    :.&   LD    A,(26AC)   

+268B CD 88 21    ..!   CALL  2188       

+268E E1          .     POP   HL         

+268F B7          .     OR    A          

+2690 ED 42       .B    SBC   HL,BC      

+2692 44          D     LD    B,H        

+2693 4D          M     LD    C,L        

+2694 C9          .     RET              

+2695 21 B8 26    !.&   LD    HL,26B8    

+2698 C5          .     PUSH  BC         

+2699 4F          O     LD    C,A        

+269A 06 00       ..    LD    B,00       

+269C 09          .     ADD   HL,BC      

+269D C1          .     POP   BC         

+269E 7E          ~     LD    A,(HL)     

+269F CB BF       ..    RES   7,A        

+26A1 FE 7F       ..    CP    7F         

+26A3 C9          .     RET              

+26A4 FF          .     RST   38         

+26A5 FF          .     RST   38         

+26A6 FF          .     RST   38         

+26A7 FF          .     RST   38         

+26A8 FF          .     RST   38         

+26A9 00          .     NOP              

+26AA 00          .     NOP              

+26AB 00          .     NOP              

+26AC 00          .     NOP              

+26AD 00          .     NOP              

+26AE 00          .     NOP              

+26AF 00          .     NOP              

+26B0 00          .     NOP              

+26B1 00          .     NOP              

+26B2 00          .     NOP              

+26B3 00          .     NOP              

+26B4 00          .     NOP              

+26B5 00          .     NOP              

+26B6 00          .     NOP              

+26B7 00          .     NOP              

+26B8 00          .     NOP              ; typtabellen nummern & Flusskontr.

+26B9 7E          ~     LD    A,(HL)     ; Kanal 1 : psi ohne flow

+26BA FF          .     RST   38         ; kanal 2 : transparent mit flow

+26BB FF          .     RST   38         ; (Bit 7 = 1: Mit Flu�kontrolle)

+26BC FF          .     RST   38         

+26BD FF          .     RST   38         

+26BE FF          .     RST   38         

+26BF FF          .     RST   38         

+26C0 FF          .     RST   38         

+26C1 FF          .     RST   38         

+26C2 FF          .     RST   38         

+26C3 FF          .     RST   38         

+26C4 FF          .     RST   38         

+26C5 FF          .     RST   38         

+26C6 FF          .     RST   38         

+26C7 FF          .     RST   38         

+26C8 FF          .     RST   38         ; kanal 16 

+                                        ; kanaltabelle fuer kanal 1

+26C9 00          .     NOP            0 ; Bit 0 :

+                                        ; Bit 3 : 1=Stoptaste gedrueckt

+                                        ; Bit 5 : 1=Grosser Puffer (>255Byte) 

+26CA 00          .     NOP            1 ; Bits 0..5 : Errorbits

+26CB FF          .     RST   38       2 ; Cursorpos y

+26CC FF          .     RST   38       3 ; Cursorpos x

+26CD 07          .     RLCA           4 ; Pufferzeiger schreiben

+26CE 07          .     RLCA           5 ; Pufferzeiger lesen

+26CF 17          .     RLA            6 ; ysize = 23

+26D0 FF          .     RST   38       7 ; Ab hier Eingabezeichen ...

+26D1 FF          .     RST   38       8 ;

+26D2 FF          .     RST   38       9 ;

+26D3 FF          .     RST   38      10 ;

+26D4 FF          .     RST   38      11 ;

+26D5 FF          .     RST   38      12 ;

+26D6 FF          .     RST   38

+26D7 FF          .     RST   38         

+26D8 FF          .     RST   38         

+26D9 FF          .     RST   38         

+26DA FF          .     RST   38         

+26DB FF          .     RST   38         

+26DC FF          .     RST   38         ; I.d.R bis hier

+26DD FF          .     RST   38         

+26DE FF          .     RST   38         

+26DF FF          .     RST   38         

+26E0 FF          .     RST   38         

+26E1 00          .     NOP              ; kanal 2

+26E2 00          .     NOP              

+26E3 FF          .     RST   38         

+26E4 FF          .     RST   38         

+26E5 07          .     RLCA             

+26E6 07          .     RLCA             

+26E7 17          .     RLA              

+26E8 FF          .     RST   38         

+26E9 FF          .     RST   38         

+26EA FF          .     RST   38         

+26EB FF          .     RST   38         

+26EC FF          .     RST   38         

+26ED FF          .     RST   38         

+26EE FF          .     RST   38         

+26EF FF          .     RST   38         

+26F0 FF          .     RST   38         

+26F1 FF          .     RST   38         

+26F2 FF          .     RST   38         

+26F3 FF          .     RST   38         

+26F4 FF          .     RST   38         

+26F5 FF          .     RST   38         

+26F6 FF          .     RST   38         

+26F7 FF          .     RST   38         

+26F8 FF          .     RST   38         

+26F9 00          .     NOP              ; kanal 3

+26FA 00          .     NOP              

+26FB FF          .     RST   38         

+26FC FF          .     RST   38         

+26FD 07          .     RLCA             

+26FE 07          .     RLCA             

+26FF 17          .     RLA              

+2700 FF          .     RST   38         

+2701 FF          .     RST   38         

+2702 FF          .     RST   38         

+2703 FF          .     RST   38         

+2704 FF          .     RST   38         

+2705 FF          .     RST   38         

+2706 FF          .     RST   38         

+2707 FF          .     RST   38         

+2708 FF          .     RST   38         

+2709 FF          .     RST   38         

+270A FF          .     RST   38         

+270B FF          .     RST   38         

+270C FF          .     RST   38         

+270D FF          .     RST   38         

+270E FF          .     RST   38         

+270F FF          .     RST   38         

+2710 FF          .     RST   38         

+2711 00          .     NOP              ; kanal 4

+2712 00          .     NOP              

+2713 FF          .     RST   38         

+2714 FF          .     RST   38         

+2715 07          .     RLCA             

+2716 07          .     RLCA             

+2717 17          .     RLA              

+2718 FF          .     RST   38         

+2719 FF          .     RST   38         

+271A FF          .     RST   38         

+271B FF          .     RST   38         

+271C FF          .     RST   38         

+271D FF          .     RST   38         

+271E FF          .     RST   38         

+271F FF          .     RST   38         

+2720 FF          .     RST   38         

+2721 FF          .     RST   38         

+2722 FF          .     RST   38         

+2723 FF          .     RST   38         

+2724 FF          .     RST   38         

+2725 FF          .     RST   38         

+2726 FF          .     RST   38         

+2727 FF          .     RST   38         

+2728 FF          .     RST   38         

+2729 00          .     NOP              ; kanal 5

+272A 00          .     NOP              

+272B FF          .     RST   38         

+272C FF          .     RST   38         

+272D 07          .     RLCA             

+272E 07          .     RLCA             

+272F 17          .     RLA              

+2730 FF          .     RST   38         

+2731 FF          .     RST   38         

+2732 FF          .     RST   38         

+2733 FF          .     RST   38         

+2734 FF          .     RST   38         

+2735 FF          .     RST   38         

+2736 FF          .     RST   38         

+2737 FF          .     RST   38         

+2738 FF          .     RST   38         

+2739 FF          .     RST   38         

+273A FF          .     RST   38         

+273B FF          .     RST   38         

+273C FF          .     RST   38         

+273D FF          .     RST   38         

+273E FF          .     RST   38         

+273F FF          .     RST   38         

+2740 FF          .     RST   38         

+2741 00          .     NOP              ; kanal 6

+2742 00          .     NOP              

+2743 FF          .     RST   38         

+2744 FF          .     RST   38         

+2745 07          .     RLCA             

+2746 07          .     RLCA             

+2747 17          .     RLA              

+2748 FF          .     RST   38         

+2749 FF          .     RST   38         

+274A FF          .     RST   38         

+274B FF          .     RST   38         

+274C FF          .     RST   38         

+274D FF          .     RST   38         

+274E FF          .     RST   38         

+274F FF          .     RST   38         

+2750 FF          .     RST   38         

+2751 FF          .     RST   38         

+2752 FF          .     RST   38         

+2753 FF          .     RST   38         

+2754 FF          .     RST   38         

+2755 FF          .     RST   38         

+2756 FF          .     RST   38         

+2757 FF          .     RST   38         

+2758 FF          .     RST   38         

+2759 00          .     NOP              ; kanal 7

+275A 00          .     NOP              

+275B FF          .     RST   38         

+275C FF          .     RST   38         

+275D 07          .     RLCA             

+275E 07          .     RLCA             

+275F 17          .     RLA              

+2760 FF          .     RST   38         

+2761 FF          .     RST   38         

+2762 FF          .     RST   38         

+2763 FF          .     RST   38         

+2764 FF          .     RST   38         

+2765 FF          .     RST   38         

+2766 FF          .     RST   38         

+2767 FF          .     RST   38         

+2768 FF          .     RST   38         

+2769 FF          .     RST   38         

+276A FF          .     RST   38         

+276B FF          .     RST   38         

+276C FF          .     RST   38         

+276D FF          .     RST   38         

+276E FF          .     RST   38         

+276F FF          .     RST   38         

+2770 FF          .     RST   38         

+2771 00          .     NOP              ; kanal 8

+2772 00          .     NOP              

+2773 FF          .     RST   38         

+2774 FF          .     RST   38         

+2775 07          .     RLCA             

+2776 07          .     RLCA             

+2777 17          .     RLA              

+2778 FF          .     RST   38         

+2779 FF          .     RST   38         

+277A FF          .     RST   38         

+277B FF          .     RST   38         

+277C FF          .     RST   38         

+277D FF          .     RST   38         

+277E FF          .     RST   38         

+277F FF          .     RST   38         

+2780 FF          .     RST   38         

+2781 FF          .     RST   38         

+2782 FF          .     RST   38         

+2783 FF          .     RST   38         

+2784 FF          .     RST   38         

+2785 FF          .     RST   38         

+2786 FF          .     RST   38         

+2787 FF          .     RST   38         

+2788 FF          .     RST   38         

+2789 00          .     NOP              ; kanal 9

+278A 00          .     NOP              

+278B FF          .     RST   38         

+278C FF          .     RST   38         

+278D 07          .     RLCA             

+278E 07          .     RLCA             

+278F 17          .     RLA              

+2790 FF          .     RST   38         

+2791 FF          .     RST   38         

+2792 FF          .     RST   38         

+2793 FF          .     RST   38         

+2794 FF          .     RST   38         

+2795 FF          .     RST   38         

+2796 FF          .     RST   38         

+2797 FF          .     RST   38         

+2798 FF          .     RST   38         

+2799 FF          .     RST   38         

+279A FF          .     RST   38         

+279B FF          .     RST   38         

+279C FF          .     RST   38         

+279D FF          .     RST   38         

+279E FF          .     RST   38         

+279F FF          .     RST   38         

+27A0 FF          .     RST   38         

+27A1 00          .     NOP              ; kanal 10

+27A2 00          .     NOP              

+27A3 FF          .     RST   38         

+27A4 FF          .     RST   38         

+27A5 07          .     RLCA             

+27A6 07          .     RLCA             

+27A7 17          .     RLA              

+27A8 FF          .     RST   38         

+27A9 FF          .     RST   38         

+27AA FF          .     RST   38         

+27AB FF          .     RST   38         

+27AC FF          .     RST   38         

+27AD FF          .     RST   38         

+27AE FF          .     RST   38         

+27AF FF          .     RST   38         

+27B0 FF          .     RST   38         

+27B1 FF          .     RST   38         

+27B2 FF          .     RST   38         

+27B3 FF          .     RST   38         

+27B4 FF          .     RST   38         

+27B5 FF          .     RST   38         

+27B6 FF          .     RST   38         

+27B7 FF          .     RST   38         

+27B8 FF          .     RST   38         

+27B9 00          .     NOP              ; kanal 11

+27BA 00          .     NOP              

+27BB FF          .     RST   38         

+27BC FF          .     RST   38         

+27BD 07          .     RLCA             

+27BE 07          .     RLCA             

+27BF 17          .     RLA              

+27C0 FF          .     RST   38         

+27C1 FF          .     RST   38         

+27C2 FF          .     RST   38         

+27C3 FF          .     RST   38         

+27C4 FF          .     RST   38         

+27C5 FF          .     RST   38         

+27C6 FF          .     RST   38         

+27C7 FF          .     RST   38         

+27C8 FF          .     RST   38         

+27C9 FF          .     RST   38         

+27CA FF          .     RST   38         

+27CB FF          .     RST   38         

+27CC FF          .     RST   38         

+27CD FF          .     RST   38         

+27CE FF          .     RST   38         

+27CF FF          .     RST   38         

+27D0 FF          .     RST   38         

+27D1 00          .     NOP              ; kanal 12

+27D2 00          .     NOP              

+27D3 FF          .     RST   38         

+27D4 FF          .     RST   38         

+27D5 07          .     RLCA             

+27D6 07          .     RLCA             

+27D7 17          .     RLA              

+27D8 FF          .     RST   38         

+27D9 FF          .     RST   38         

+27DA FF          .     RST   38         

+27DB FF          .     RST   38         

+27DC FF          .     RST   38         

+27DD FF          .     RST   38         

+27DE FF          .     RST   38         

+27DF FF          .     RST   38         

+27E0 FF          .     RST   38         

+27E1 FF          .     RST   38         

+27E2 FF          .     RST   38         

+27E3 FF          .     RST   38         

+27E4 FF          .     RST   38         

+27E5 FF          .     RST   38         

+27E6 FF          .     RST   38         

+27E7 FF          .     RST   38         

+27E8 FF          .     RST   38         

+27E9 00          .     NOP              ; kanal 13

+27EA 00          .     NOP              

+27EB FF          .     RST   38         

+27EC FF          .     RST   38         

+27ED 07          .     RLCA             

+27EE 07          .     RLCA             

+27EF 17          .     RLA              

+27F0 FF          .     RST   38         

+27F1 FF          .     RST   38         

+27F2 FF          .     RST   38         

+27F3 FF          .     RST   38         

+27F4 FF          .     RST   38         

+27F5 FF          .     RST   38         

+27F6 FF          .     RST   38         

+27F7 FF          .     RST   38         

+27F8 FF          .     RST   38         

+27F9 FF          .     RST   38         

+27FA FF          .     RST   38         

+27FB FF          .     RST   38         

+27FC FF          .     RST   38         

+27FD FF          .     RST   38         

+27FE FF          .     RST   38         

+27FF FF          .     RST   38         

+2800 FF          .     RST   38         

+2801 00          .     NOP              ; kanal 14

+2802 00          .     NOP              

+2803 FF          .     RST   38         

+2804 FF          .     RST   38         

+2805 07          .     RLCA             

+2806 07          .     RLCA             

+2807 17          .     RLA              

+2808 FF          .     RST   38         

+2809 FF          .     RST   38         

+280A FF          .     RST   38         

+280B FF          .     RST   38         

+280C FF          .     RST   38         

+280D FF          .     RST   38         

+280E FF          .     RST   38         

+280F FF          .     RST   38         

+2810 FF          .     RST   38         

+2811 FF          .     RST   38         

+2812 FF          .     RST   38         

+2813 FF          .     RST   38         

+2814 FF          .     RST   38         

+2815 FF          .     RST   38         

+2816 FF          .     RST   38         

+2817 FF          .     RST   38         

+2818 FF          .     RST   38         

+2819 00          .     NOP              ; kanal 15

+281A 00          .     NOP              

+281B FF          .     RST   38         

+281C FF          .     RST   38         

+281D 07          .     RLCA             

+281E 07          .     RLCA             

+281F 17          .     RLA              

+2820 FF          .     RST   38         

+2821 FF          .     RST   38         

+2822 FF          .     RST   38         

+2823 FF          .     RST   38         

+2824 FF          .     RST   38         

+2825 FF          .     RST   38         

+2826 FF          .     RST   38         

+2827 FF          .     RST   38         

+2828 FF          .     RST   38         

+2829 FF          .     RST   38         

+282A FF          .     RST   38         

+282B FF          .     RST   38         

+282C FF          .     RST   38         

+282D FF          .     RST   38         

+282E FF          .     RST   38         

+282F FF          .     RST   38         

+2830 FF          .     RST   38         

+2831 00          .     NOP              ; kanal 16

+2832 00          .     NOP              

+2833 FF          .     RST   38         

+2834 FF          .     RST   38         

+2835 07          .     RLCA             

+2836 07          .     RLCA             

+2837 17          .     RLA              

+2838 FF          .     RST   38         

+2839 FF          .     RST   38         

+283A FF          .     RST   38         

+283B FF          .     RST   38         

+283C FF          .     RST   38         

+283D FF          .     RST   38         

+283E FF          .     RST   38         

+283F FF          .     RST   38         

+2840 FF          .     RST   38         

+2841 FF          .     RST   38         

+2842 FF          .     RST   38         

+2843 FF          .     RST   38         

+2844 FF          .     RST   38         

+2845 FF          .     RST   38         

+2846 FF          .     RST   38         

+2847 FF          .     RST   38         

+2848 FF          .     RST   38         

+2849 73          s     LD    (HL),E     ; "shdifc.z80 001 (!)"

+284A 68          h     LD    L,B        

+284B 64          d     LD    H,H        

+284C 69          i     LD    L,C        

+284D 66          f     LD    H,(HL)     

+284E 63          c     LD    H,E        

+284F 2E 7A       .z    LD    L,7A       

+2851 38 30       80    JR    C,2883     

+2853 20 30        0    JR    NZ,2885    

+2855 30 31       01    JR    NC,2888    

+2857 20 28        (    JR    NZ,2881    

+2859 21 29 

+285B FF                                 ;------ 69 Bytes von hier -------

+285C FF          .     RST   38         ; "SHARD           "

+285D FF          .     RST   38         

+285E FF          .     RST   38         

+285F FF          .     RST   38         

+2860 FF          .     RST   38         

+2861 FF          .     RST   38         

+2862 FF          .     RST   38         

+2863 FF          .     RST   38         

+2864 FF          .     RST   38         

+2865 FF          .     RST   38         

+2866 FF          .     RST   38         

+2867 FF          .     RST   38         

+2868 FF          .     RST   38         

+2869 FF          .     RST   38         

+286A FF          .     RST   38         ; Shard Interface

+286B 06                                 ; SHard versionnummer(wird veraendert

+286C 00                                 ; "

+286D 00          .     NOP              ; mode :BIT 0: 1=frei eumel0

+286E 00          .     NOP              ; bit 8:0=speichetest,9:0=vortest

+286F 00          .     NOP              ; id4

+2870 00          .     NOP              

+2871 00          .     NOP              ; id5

+2872 00          .     NOP              

+2873 00          .     NOP              ; id6

+2874 00          .     NOP              

+2875 00          .     NOP              ; id7

+2876 00          .     NOP              

+2877 00          .     NOP              ; leer

+2878 00          .     NOP              

+2879 00          .     NOP              ; leer

+287A 00          .     NOP              

+287B C3 06 01    ...   JP    0106       ; OUTPUT

+287E C3 09 01    ...   JP    0109       ; BLOCKIN

+2881 C3 0C 01    ...   JP    010C       ; BLOCKOUT

+2884 C3 0F 01    ...   JP    010F       ; IOCONTROL

+2887 C3 12 01    ...   JP    0112       ; SYSEND

+288A C3 15 01    ...   JP    0115       ; SCHINF

+288D C3 18 01    ...   JP    0118       ; SCHACC

+2890 00          .     NOP              ; leer

+2891 00          .     NOP              

+2892 00          .     NOP              ; RAM-Limit low

+2893 00          .     NOP              ;    " high

+2894 00          .     NOP              

+2895 00          .     NOP              

+2896 00          .     NOP              

+2897 00          .     NOP              

+2898 00          .     NOP              

+2899 00          .     NOP              

+289A 00          .     NOP              

+289B 00          .     NOP              

+289C 00          .     NOP              

+289D 00          .     NOP              

+289E 00          .     NOP              

+289F 00          .     NOP              ;----------- bis hier ---------

+28A0 ED 5B 92 28 .[.(  LD    DE,(2892)  ; RAM-Limit laden

+28A4 C9          .     RET              ;-------------------------------

+28A5 ED B0       ..    LDIR             ; Longmove = LDIR (immer)

+28A7 C9          .     RET              

+28A8 B7          .     OR    A          ; Intern IOCONTROL

+28A9 20 D9        .    JR    NZ,2884    ; Fuer alle Kanale > 0: IOCONTROL

+28AB 79          y     LD    A,C        

+28AC FE 05       ..    CP    05         ; HG-Kanal Fkt. 5 : Size

+28AE 28 03       (.    JR    Z,28B3     

+28B0 97          .     SUB   A          ; Alle anderen HG-Controls weiter

+28B1 18 D1       ..    JR    2884       ; IOCONTROL

+28B3 97          .     SUB   A          

+28B4 CD 84 28    ..(   CALL  2884       ; Anz. Bloecke DIV 65536 in A

+28B7 E5          .     PUSH  HL         

+28B8 67          g     LD    H,A        ; A retten

+28B9 3A 6B 28    :k(   LD    A,(286B)   ; Shard Version

+28BC FE 07       ..    CP    07         

+28BE 30 02       0.    JR    NC,28C2    ; 

+28C0 26 00       &.    LD    H,00       ; Shard Version 6 : Hoechstens 65536

+28C2 7C          |     LD    A,H        ; Shard Version > 6 : Auch mehr als^

+28C3 B7          .     OR    A          

+28C4 20 08        .    JR    NZ,28CE    

+28C6 21 80 7E    !.~   LD    HL,7E80    ; 

+28C9 B7          .     OR    A          ; CLC

+28CA ED 42       .B    SBC   HL,BC      

+28CC E1          .     POP   HL         

+28CD D0          .     RET   NC         

+28CE E1          .     POP   HL         

+28CF 97          .     SUB   A          ; Maximum an Bloecken: 32384

+28D0 01 80 7E    ..~   LD    BC,7E80    ; 15MB + 832 KB

+28D3 C9          .     RET              ;========== 175 Systemstart =======

+28D4 11 5B 28    .[(   LD    DE,285B    ; 69 Bytes uebertragen

+28D7 01 45 00    .E.   LD    BC,0045    ; Von Shard Leiste --> EUMEL0

+28DA ED B0       ..    LDIR             ; 175 Systemstart

+28DC C3 99 14    ...   JP    1499       ;========= 173 Systemstart ========

+28DF 3A 1E 01    :..   LD    A,(011E)   ; Shardversion

+28E2 32 6B 28    2k(   LD    (286B),A   

+28E5 FE 07       ..    CP    07         ; >= 7 : falsche Leiste !

+28E7 30 0A       0.    JR    NC,28F3    

+28E9 CD 03 01    ...   CALL  0103       ; LIMIT erfragen

+28EC ED 53 92 28 .S.(  LD    (2892),DE  ; Eintragen

+28F0 C3 99 14    ...   JP    1499       ; Zum neuen Systemstart (175)

+28F3 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+28F6 18 0F       ..    JR    2907       

+28F8 20 66        f    JR    NZ,2960    ; " falsche Leiste"

+28FA 61          a     LD    H,C        

+28FB 6C          l     LD    L,H        

+28FC 73          s     LD    (HL),E     

+28FD 63          c     LD    H,E        

+28FE 68          h     LD    L,B        

+28FF 65          e     LD    H,L        

+2900 20 4C        L    JR    NZ,294E    

+2902 65          e     LD    H,L        

+2903 69          i     LD    L,C        

+2904 73          s     LD    (HL),E     

+2905 74          t     LD    (HL),H     

+2906 65          e     LD    H,L        

+2907 18 EA       ..    JR    28F3       ; Endlos

+2909 F5          .     PUSH  AF         ; Info Aufruf vom Shard

+290A 3E F2       >.    LD    A,F2       

+290C 32 19 7D    2.}   LD    (7D19),A   

+290F F1          .     POP   AF         

+2910 CD 1F 70    ..p   CALL  701F       

+2913 18 06       ..    JR    291B       ; Info aufrufen

+2915 20 73        s    JR    NZ,298A    ; " shard"

+2917 68          h     LD    L,B        

+2918 61          a     LD    H,C        

+2919 72          r     LD    (HL),D     

+291A 64          d     LD    H,H        

+291B C9          .     RET              ;---------------------------------

+291C 3E 04       >.    LD    A,04       ; shutup anfordern

+291E C3 BB 81    ...   JP    81BB       

+2921 3A 00                              ; Task geht in Wartezustand--------

+2923 DD 77 06          LD    (IX+6),A   ; status pcb-Feld setzen

+2926 DD CB 07 7E       BIT   7,(IX+7)

+292A C4 02 2A    ..*   CALL  NZ,2A02    ; Speicherfelder --> pcb-felder

+292D 31 13 6D    1.m   LD    SP,6D13    ; Schleifenanfang fuer offenen Warte

+2930 CD 41 6B    .Ak   CALL  6B41       ; zustand

+2933 3A 1A 6E    :.n   LD    A,(6E1A)   

+2936 3D          =     DEC   A          

+2937 CC 38 4C    .8L   CALL  Z,4C38     ; Supervisor

+293A DD 7E 06    .~.   LD    A,(IX+06)  

+293D CB 47       .G    BIT   0,A        ; geblockt, keine Aktion bis entblockt

+293F 20 3D        =    JR    NZ,297E    

+2941 E6 3C       .<    AND   3C         ; Statusbist ausblenden

+2943 FE 2C       .,    CP    2C         

+2945 D2 D8 29    ..)   JP    NC,29D8    

+2948 32 51 29    2Q)   LD    (2951),A   

+294B FE 18       ..    CP    18         ; 18 : Leitblockfelder --> Speicher

+294D D4 46 2A    .F*   CALL  NC,2A46    

+2950 18 FE       ..    JR    2950       ; Sprung in Tabelle

+2952 C3 CC 29    ..)   JP    29CC       ; 00 : Test, ob haltprocess

+2955 FF          .     RST   38         

+2956 C3 BE 29    ..)   JP    29BE       ; 04 : auf kanalankoppeln warten

+2959 FF          .     RST   38         

+295A C3 AA 29    ..)   JP    29AA       ; 08 : warten auf tastendruck

+295D FF          .     RST   38         

+295E C3 95 29    ..)   JP    2995       ; 0C : pause (in mod)

+2961 FF          .     RST   38         

+2962 C3 7C 2E    .|.   JP    2E7C       ; 10 : Busy, RET TRUE, test halt

+2965 FF          .     RST   38         

+2966 C3 81 2E    ...   JP    2E81       ; 14 : Busy, RET FALSE, test halt

+2969 FF          .     RST   38         

+296A C3 B5 2F    ../   JP    2FB5       ; 18 : CALL PROC

+296D FF          .     RST   38         

+296E C3 38 3D    .8=   JP    3D38       ; 1C : EXTERNAL TERM

+2971 FF          .     RST   38         

+2972 C3 3D 4A    .=J   JP    4A3D       ; 20 : anford. garbagecollect.

+2975 FF          .     RST   38         

+2976 C3 5D 4A    .]J   JP    4A5D       ; 24 : garbage collect. 1. Teil 

+2979 FF          .     RST   38         

+297A C3 09 4B    ..K   JP    4B09       ; 28 : garbage collect. 2 teil

+297D FF          .     RST   38         

+297E 3A 1A 6E    :.n   LD    A,(6E1A)   ; Supervisor  

+2981 FE 01       ..    CP    01         

+2983 20 0A        .    JR    NZ,298F    

+2985 F3          .     DI               

+2986 3A F9 4C    :.L   LD    A,(4CF9)   

+2989 B7          .     OR    A          

+298A 3A 1A 6E    :.n   LD    A,(6E1A)   

+298D 20 03        .    JR    NZ,2992    ; SV-Call angefordert ?

+298F CD 74 6D    .tm   CALL  6D74       ; block SV

+2992 FB          .     EI               

+2993 18 98       ..    JR    292D       

+2995 2A F1 4C    *.L   LD    HL,(4CF1)  ; Pausenende abwarten

+2998 DD 7E 0C    .~.   LD    A,(IX+0C)  

+299B 95          .     SUB   L          

+299C DD 7E 0D    .~.   LD    A,(IX+0D)  

+299F 9C          .     SBC   H          

+29A0 FA CC 29    ..)   JP    M,29CC     

+29A3 DD 7E 26    .~&   LD    A,(IX+26)  

+29A6 B7          .     OR    A          

+29A7 CA 2D 29    .-)   JP    Z,292D     

+29AA DD CB 05 46 ...F  BIT   0,(IX+05)  

+29AE 20 1C        .    JR    NZ,29CC    

+29B0 DD 7E 26    .~&   LD    A,(IX+26)  

+29B3 B7          .     OR    A          

+29B4 28 C8       (.    JR    Z,297E     

+29B6 CD AD 1E    ...   CALL  1EAD       ; taste gedrueckt ?

+29B9 DA 2D 29    .-)   JP    C,292D     

+29BC 18 0E       ..    JR    29CC       

+29BE DD 7E 26    .~&   LD    A,(IX+26)  

+29C1 B7          .     OR    A          

+29C2 28 BA       (.    JR    Z,297E     

+29C4 CD 59 1E    .Y.   CALL  1E59       

+29C7 FE 1E       ..    CP    1E         ; Mindestens 30 Zeichen uebernehmen 

+29C9 DA 2D 29    .-)   JP    C,292D     

+29CC DD 35       .5    DEC   (IX+08)

+29CE 08          .     EX    AF,AF'     

+29CF F2 2D 29    .-)   JP    P,292D     

+29D2 CD 7E 2A    .~*   CALL  2A7E       ; Test, ob halt process

+29D5 C3 A7 2A    ..*   JP    2AA7       ; zur interpreter schleife

+29D8 DD CB 05 46 ...F  BIT   0,(IX+05)  

+29DC 20 EE        .    JR    NZ,29CC    

+29DE DD 7E 34    .~4   LD    A,(IX+34)  

+29E1 B7          .     OR    A          

+29E2 20 9A        .    JR    NZ,297E    

+29E4 DD 7E 26    .~&   LD    A,(IX+26)  

+29E7 B7          .     OR    A          

+29E8 28 94       (.    JR    Z,297E     

+29EA CD AD 1E    ...   CALL  1EAD       ; taste gedrueckt ?

+29ED DA 2D 29    .-)   JP    C,292D     

+29F0 DD 36 2C FC .6,.  LD    (IX+2C),FC ; msgcod := -4

+29F4 DD 36 2D FF .6-.  LD    (IX+2D),FF 

+29F8 DD 36 2E 01 .6..  LD    (IX+2E),01 

+29FC DD CB 07 DE ....  SET   3,(IX+07)  

+2A00 18 CA       ..    JR    29CC       ;---------------------------------

+2A02 CD F6 4B    ..K   CALL  4BF6       

+2A05 DD CB 07 BE ....  RES   7,(IX+07)  ; Felder wurden uebertragen

+2A09 ED 5B 1C 6E .[.n  LD    DE,(6E1C)  

+2A0D 1E 10       ..    LD    E,10       ; 10..17

+2A0F 21 C4 41    !.A   LD    HL,41C4    ; pcb Felder von Hauptspeicher

+2A12 ED A0       ..    LDI              ; in Leitblock  uebertragen

+2A14 ED A0       ..    LDI              ; lbas

+2A16 ED A0       ..    LDI              ; ltop

+2A18 ED A0       ..    LDI

+2A1A ED A0       ..    LDI              ; ls_top

+2A1C ED A0       ..    LDI              

+2A1E ED A0       ..    LDI              ; hptop

+2A20 ED A0       ..    LDI              

+2A22 DD CB 07 6E ...n  BIT   5,(IX+07)  

+2A26 C4 4D 45    .ME   CALL  NZ,454D    

+2A29 D9          .     EXX              ; pbas

+2A2A DD 71 0E    .q.   LD    (IX+0E),C  

+2A2D DD 7E 2A    .~*   LD    A,(IX+2A)  ; prio --> pricnt

+2A30 DD 77 08    .w.   LD    (IX+08),A  

+2A33 08          .     EX    AF,AF'     

+2A34 DD CB 09 16 ....  RL    (IX+09)    

+2A38 1F          .     RRA              

+2A39 30 07       0.    JR    NC,2A42    

+2A3B D6 80       ..    SUB   A,80       

+2A3D 30 03       0.    JR    NC,2A42    

+2A3F DD 35       .5    DEC   (IX+0A)    

+2A41 0A          .     LD    A,(BC)     

+2A42 DD 77 09    .w.   LD    (IX+09),A  

+2A45 C9          .     RET              ;--------------------------------

+2A46 CD 16 42    ..B   CALL  4216       

+2A49 DD 4E 0E    .N.   LD    C,(IX+0E)  ; pbas

+2A4C 16 19       ..    LD    D,19       

+2A4E D9          .     EXX              

+2A4F 2A 1C 6E    *.n   LD    HL,(6E1C)  ; Leitblock Felder in Hauptspeicher

+2A52 2E 10       ..    LD    L,10       ; uebertragen

+2A54 11 C4 41    ..A   LD    DE,41C4    

+2A57 ED A0       ..    LDI              

+2A59 ED A0       ..    LDI              

+2A5B ED A0       ..    LDI              

+2A5D ED A0       ..    LDI              

+2A5F ED A0       ..    LDI              

+2A61 ED A0       ..    LDI              

+2A63 ED A0       ..    LDI              

+2A65 ED A0       ..    LDI              

+2A67 CD AB 42    ..B   CALL  42AB       

+2A6A DD 4E 09    .N.   LD    C,(IX+09)  

+2A6D CB 21       .!    SLA   C          

+2A6F 17          .     RLA              

+2A70 47          G     LD    B,A        

+2A71 DD CB 07 FE ....  SET   7,(IX+07)  ; Felder wurden uebertragen

+2A75 79          y     LD    A,C        

+2A76 08          .     EX    AF,AF'     

+2A77 CD DB 4B    ..K   CALL  4BDB       ; millis verringern

+2A7A CD 93 2A    ..*   CALL  2A93       

+2A7D C9          .     RET              ;--------------------------------

+2A7E CD 46 2A    .F*   CALL  2A46       

+2A81 DD 36 06 00 .6..  LD    (IX+06),00 

+2A85 DD CB 05 46 ...F  BIT   0,(IX+05)  ; halt process angefordert ?

+2A89 C8          .     RET   Z          

+2A8A DD CB 05 86 ....  RES   0,(IX+05)  

+2A8E 3E 01       >.    LD    A,01       

+2A90 C3 0D 3D    ..=   JP    3D0D       ; errorstop "halt from terminal"

+2A93 21 E6 7C    !.|   LD    HL,7CE6    ; AND 7C--------------------------

+2A96 22 AE 2A    ".*   LD    (2AAE),HL  

+2A99 C9          .     RET              

+2A9A 21 18 F1    !..   LD    HL,F118    ; JR 2AA1

+2A9D 22 AE 2A    ".*   LD    (2AAE),HL  

+2AA0 C9          .     RET              

+2AA1 CD 93 2A    ..*   CALL  2A93       ; AND 7C Maske setzen

+2AA4 C3 26 29    .&)   JP    2926       ; Je nach Status reagieren 

+2AA7 79          y     LD    A,C        ;----------------------------------

+2AA8 08          .     EX    AF,AF'

+2AA9 0A          .     LD    A,(BC)     

+2AAA 6F          o     LD    L,A        

+2AAB 0C          .     INC   C          

+2AAC 0A          .     LD    A,(BC)     

+2AAD 67          g     LD    H,A        ; HL := Codeword

+2AAE E6 7C       .|    AND   7C         ; Opcodebits ausmaskieren

+2AB0 32 B6 2A    2.*   LD    (2AB6),A   ; Opcode setzen

+2AB3 AC          .     XOR   H          ; Datenbits in A

+2AB4 0C          .     INC   C          ; BC zeigt auf naechsten Opcode

+2AB5 20 FE        .    JR    NZ,2AB5    ; Wird 

+2AB7 C3 8C 2C    ..,   JP    2C8C       ; Neue Seite, ggf neuen Block laden

+2ABA FF          .     RST   38         ; und Restart (EUMEL0-Restart)

+2ABB C3 F1 2C    ..,   JP    2CF1       ; 0 LN (nr)

+2ABE FF          .     RST   38         ; 1 LONGLN (nr-1024)

+2ABF C3 FD 2C    ..,   JP    2CFD       ; 2 MOV1 (source, dest)

+2AC2 FF          .     RST   38         

+2AC3 C3 11 2D    ..-   JP    2D11       ; 3 INC1 (dest) 

+2AC6 FF          .     RST   38         

+2AC7 C3 1F 2D    ..-   JP    2D1F       ; 4 DEC1 (dest)

+2ACA FF          .     RST   38         

+2ACB C3 30 2D    .0-   JP    2D30       ; 5 INC (source, dest)

+2ACE FF          .     RST   38         

+2ACF C3 50 2D    .P-   JP    2D50       ; 6 DEC (source, dest)

+2AD2 FF          .     RST   38         

+2AD3 C3 65 2D    .e-   JP    2D65       ; 7 ADD (a, b, c)

+2AD6 FF          .     RST   38         

+2AD7 C3 82 2D    ..-   JP    2D82       ; 8 SUB (a, b, c)

+2ADA FF          .     RST   38         

+2ADB C3 D2 2D    ..-   JP    2DD2       ; 9 CLEAR (dest)

+2ADE FF          .     RST   38         

+2ADF C3 2B 2E    .+.   JP    2E2B       ; 10 TEST (source) --> BOOL

+2AE2 FF          .     RST   38         

+2AE3 C3 60 2E    .`.   JP    2E60       ; 11 EQU (a, b) --> BOOL

+2AE6 FF          .     RST   38         

+2AE7 C3 35 2E    .5.   JP    2E35       ; 12 LSEQ (a, b) --> BOOL

+2AEA FF          .     RST   38         

+2AEB C3 04 35    ..5   JP    3504       ; 13 MOV8 (source, dest)

+2AEE FF          .     RST   38         

+2AEF C3 20 35    . 5   JP    3520       ; 14 FADD (a, b, c)

+2AF2 FF          .     RST   38         

+2AF3 C3 3B 35    .;5   JP    353B       ; 15 FSUB (a, b, c)

+2AF6 FF          .     RST   38         

+2AF7 C3 41 35    .A5   JP    3541       ; 16 FMULT (a, b, c) 

+2AFA FF          .     RST   38         

+2AFB C3 47 35    .G5   JP    3547       ; 17 FDIV (a, b, c)

+2AFE FF          .     RST   38         

+2AFF C3 5D 35    .]5   JP    355D       ; 18 FLSEQ (a, b) --> BOOL

+2B02 FF          .     RST   38         

+2B03 C3 CD 30    ..0   JP    30CD       ; 19 TMOV (source, dest)

+2B06 FF          .     RST   38         

+2B07 C3 0F 31    ..1   JP    310F       ; 20 TEQU (a, b) --> BOOL

+2B0A FF          .     RST   38         

+2B0B C3 4E 2E    .N.   JP    2E4E       ; 21 ULSEQU (a, b) --> BOOL

+2B0E FF          .     RST   38         

+2B0F C3 03 36    ..6   JP    3603       ; 22 ACCDS (dsid, refadr)

+2B12 FF          .     RST   38         

+2B13 C3 21 36    .!6   JP    3621       ; 23 REF (source, refadr)

+2B16 FF          .     RST   38         

+2B17 C3 43 36    .C6   JP    3643       ; 24 SUBS (limit-1, index, refadr)

+2B1A FF          .     RST   38         

+2B1B C3 27 36    .'6   JP    3627       ; 25 SEL (base, offset, refadr)

+2B1E FF          .     RST   38         

+2B1F C3 02 2F    ../   JP    2F02       ; 26 PPV (source)

+2B22 FF          .     RST   38         

+2B23 C3 07 2F    ../   JP    2F07       ; 27 PP (source)

+2B26 FF          .     RST   38         

+2B27 C3 8E 2E    ...   JP    2E8E       ; 28 BR (lowadr)

+2B2A FF          .     RST   38         

+2B2B C3 A3 2E    ...   JP    2EA3       ; 29 LONGBR (lowadr-1024)

+2B2E FF          .     RST   38         

+2B2F C3 40 2F    .@/   JP    2F40       ; 30 CALL (modnr)

+2B32 FF          .     RST   38         

+2B33 07          .     RLCA             ; 31 ...

+2B34 07          .     RLCA             

+2B35 07          .     RLCA             

+2B36 32 3A 2B    2:+   LD    (2B3A),A   

+2B39 18 FE       ..    JR    2B39       ; Sprung auf SPezial

+2B3B C3 6E 36    .n6   JP    366E       ; 0 : ISXCHAR (char) --> BOOL

+2B3E FF          .     RST   38         

+2B3F C3 80 36    ..6   JP    3680       ; 1 : STIM (byteval, dest) 

+2B42 FF          .     RST   38         

+2B43 C3 8C 36    ..6   JP    368C       ; 2 : MOVX (bytelen, source, dest)

+2B46 FF          .     RST   38         

+2B47 C3 D2 36    ..6   JP    36D2       ; 3 : PW (ds+segment, offs, value) 

+2B4A FF          .     RST   38         

+2B4B C3 C9 36    ..6   JP    36C9       ; 4 : GW (ds+segment, offs, result) 

+2B4E FF          .     RST   38         

+2B4F C3 DE 2F    ../   JP    2FDE       ; 5 : PENTER (highbyte)

+2B52 FF          .     RST   38         

+2B53 C3 76 2B    .v+   JP    2B76       ; 6 : ESC (functionbyte)

+2B56 FF          .     RST   38         

+2B57 7D          }     LD    A,L        ; 7 : LONGA (opcodebyte)

+2B58 32 B6 2A    2.*   LD    (2AB6),A   

+2B5B E6 83       ..    AND   83         

+2B5D 20 08        .    JR    NZ,2B67    

+2B5F 0A          .     LD    A,(BC)     

+2B60 6F          o     LD    L,A        

+2B61 0C          .     INC   C          ; Zur Interpreterschleife mit Opcode 

+2B62 0A          .     LD    A,(BC)     

+2B63 0C          .     INC   C          

+2B64 C3 B5 2A    ..*   JP    2AB5       ; --------

+2B67 3E FD       >.    LD    A,FD       ; -3 = Block unlesbar

+2B69 BD          .     CP    L          

+2B6A C2 F4 3C    ..<   JP    NZ,3CF4    

+2B6D DD CB 0B B6 ....  RES   6,(IX+0B)  ; enablestop

+2B71 3E 10       >.    LD    A,10       ; Errorstop Block unlesbar 

+2B73 C3 12 3D    ..=   JP    3D12       ;------------ ESC ---------------

+2B76 7D          }     LD    A,L        

+2B77 FE 82       ..    CP    82         ; 129 ist Maximum ESC 

+2B79 D2 F4 3C    ..<   JP    NC,3CF4    

+2B7C 26 00       &.    LD    H,00       

+2B7E 29          )     ADD   HL,HL      ; * 2 fuer Zugriff

+2B7F 11 88 2B    ..+   LD    DE,2B88    ; Tabellen anfang

+2B82 19          .     ADD   HL,DE      

+2B83 5E          ^     LD    E,(HL)     

+2B84 23          #     INC   HL         

+2B85 56          V     LD    D,(HL)     ; Sprung addresse --> DE

+2B86 EB          .     EX    DE,HL      

+2B87 E9          .     JP    (HL)       ; EXTERNAL aufrufen-------------

+2B88 F3 2F       0 : RTN 

+2B8A F9 2F       1 : RTN FALSE --> BOOL

+2B8C 0A 30       2 : RTN TRUE  --> BOOL

+2B8E F4 3C       3 : --------

+2B90 38 3D       4 : TERM

+2B92 7F 30       5 : GOSUB (adr) 

+2B94 0E 37       6 : KE 

+2B96 AF 30       7 : GORET (adr) 

+2B98 CE 3A       8 : CRD (var, var)

+2B9A DA 3A       9 : BCRD (var, var)

+2B9C B3 3A      10 : CWR (var, char, int)

+2B9E 79 3A      11 : ECWR (var, var, char) 

+2BA0 1B 3B      12 : CTT (int, refadr) 

+2BA2 26 3B      13 : GETC (text, posvar) 

+2BA4 54 3B      14 : FNONBL (charvar, text, posvar) --> BOOL

+2BA6 A7 3B      15 : DREM256 (var, var) 

+2BA8 BC 3B      16 : AMUL256 (var, int)

+2BAA F4 3C      17 : ---------

+2BAC DF 3B      18 : ISDIG (char) --> BOOL 

+2BAE CC 3B      19 : ISLD (char) --> BOOL 

+2BB0 F1 3B      20 : ISLCAS (char) --> BOOL 

+2BB2 F6 3B      21 : ISUCAS (chasr) --> BOOL 

+2BB4 FB 3B      22 : GADDR (a, b, c) 

+2BB6 17 3C      23 : GCADDR (a, b, c) --> BOOL 

+2BB8 36 3C      24 : ISSHA (int) --> BOOL 

+2BBA 14 37      25 : SYSGEN 

+2BBC 42 3C      26 : GETTAB 

+2BBE 58 3C      27 : PUTTAB 

+2BC0 62 3C      28 : ERATAB 

+2BC2 3A 2F      29 : EXEC (modnr)

+2BC4 E8 2E      30 : PPROC (modnr) 

+2BC6 33 2F      31 : PCALL (adr) 

+2BC8 CC 2E      32 : CASE (switch, limit)

+2BCA 86 36      33 : MOVEXX (len, from, to) 

+2BCC 9A 38      34 : ALIAS (...,...) 

+2BCE 0C 2D      35 : MOVIM (...,...) 

+2BD0 4D 35      36 : FEQU (a, b) --> BOOL 

+2BD2 44 31      37 : TLSEQ (a, b) --> BOOL 

+2BD4 6E 35      38 : FCOMPL (source, dest)

+2BD6 DC 2D      39 : COMPL (source, dest) 

+2BD8 C1 2D      40 : IMULT (a, b, c) 

+2BDA A0 2D      41 : MULT (a, b, c) 

+2BDC AC 2D      42 : DIV (a, b, c) 

+2BDE B8 2D      43 : MOD (a, b, c) 

+2BE0 9F 34      44 : ISUB (text, pos, result) 

+2BE2 8D 34      45 : replace (text, pos, int) 

+2BE4 A8 31      46 : CODE (text, result)

+2BE6 B9 31      47 : ENCODE (int, text) 

+2BE8 C2 31      48 : SUB (text, pos, result) 

+2BEA CE 31      49 : subtext (source, from, to, result) 

+2BEC C8 31      50 : subtext (source, from, result)

+2BEE 2F 32      51 : replace (text, pos, text) 

+2BF0 D4 31      52 : CAT (text, text) 

+2BF2 97 31      53 : LENGTH (text, result) 

+2BF4 81 32      54 : pos (source, pattern, result) 

+2BF6 89 32      55 : pos (source, pattern, from, result)

+2BF8 92 32      56 : pos (source, pattern, from, to, result) 

+2BFA 93 33      57 : stranalyze (row256int, intv,int,text,intv,int,intv)

+2BFC 42 33      58 : pos (source, low, high, from, result) 

+2BFE F4 3C      59 : ------------

+2C00 67 37      60 : out (text) 

+2C02 1A 37      61 : cout (int) 

+2C04 5D 37      62 : outsubtext (text, from) 

+2C06 62 37      63 : outsubtext (text, from, to) 

+2C08 9E 37      64 : inchar (result) 

+2C0A BD 37      65 : incharety (result) 

+2C0C D4 37      66 : pause (time) 

+2C0E F5 37      67 : getcursor (x, y)

+2C10 10 38      68 : catinput (textv, escchar) 

+2C12 E5 38      69 : nilspace (result) 

+2C14 EB 38      70 : dscopy (dest, source)

+2C16 19 39      71 : forget (ds) 

+2C18 47 39      72 : settype (ds, type) 

+2C1A 68 39      73 : gettype (ds, type) 

+2C1C 79 39      74 : heapsize (ds, size) 

+2C1E 4E 3D      75 : enablestop 

+2C20 5B 3D      76 : disablestop 

+2C22 62 3D      77 : seterrorstop (nr) 

+2C24 76 3D      78 : iserror --> BOOL 

+2C26 80 3D      79 : clearerror 

+2C28 9F 3D      80 : readpcb (field, result) 

+2C2A 87 41      81 : infopassword (alt, neu, ok)

+2C2C E4 35      82 : setclock (task, value) 

+2C2E 0E 2E      83 : rotate (int, anzahl) 

+2C30 09 3A      84 : control (fkt, code1, code2, result) 

+2C32 B3 39      85 : blockout (ds, page, code1, code2, result) 

+2C34 E5 39      86 : blockin (ds, page, code1, code2, result) 

+2C36 3B 3A      87 : nextdspage (ds, page, result) 

+2C38 97 39      88 : pages (ds, task, result)

+2C3A 7A 3C      89 : storage (size, used) ?

+2C3C 8D 3C      90 : sysop (nr) 

+2C3E E5 2F      91 : arith15 

+2C40 EC 2F      92 : arith16 

+2C42 7A 34      93 : heapsize (result) 

+2C44 88 34      94 : collectheapgarbage 

+2C46 9D 3E      95 : ? (neues begin)

+2C48 7C 35      96 : shiftleftdigits (in, real, out) 

+2C4A 98 35      97 : decimalexponent (real, result) 

+2C4C A1 35      98 : setexp (exp, real) 

+2C4E AE 35      99 : floor (source, dest) 

+2C50 A3 34     100 : RSUB (text, pos, result) 

+2C52 91 34     101 : replace (text, pos, real) 

+2C54 BC 35     102 : clock (nr, result) 

+2C56 F2 35     103 : setclock (value) 

+2C58 EB 3D     104 : readpcb (task, field, result) 

+2C5A F1 3D     105 : writepcb (task, field, value) 

+2C5C DC 35     106 : readclock (task, result) 

+2C5E 1E 3E     107 : status (task, result) 

+2C60 2E 3E     108 : unblock (task) 

+2C62 41 3E     109 : block (task) 

+2C64 63 3E     110 : halt process (task) 

+2C66 6C 3E     111 : create process (... 

+2C68 52 3F     112 : erase process (task) 

+2C6A B7 40     113 : send (...

+2C6C BD 40     114 : wait (... 

+2C6E 06 41     115 : call (... 

+2C70 F7 3A     116 : cdb int (adr, result) 

+2C72 0E 3B     117 : cdb text (adr, result) 

+2C74 4F 3E     118 : nextactive (taskandresult) 

+2C76 EF 36     119 : putword (seg, adr, value) 

+2C78 E5 36     120 : getword (seg, adr, result) 

+2C7A 02 2E     121 : XOR (a, b, c) 

+2C7C 2B 41     122 : pingpong (... 

+2C7E 5B 3F     123 : exists (task) --> BOOL

+2C80 EA 2D     124 : AND (a, b, c) 

+2C82 F6 2D     125 : OR (a, b, c) 

+2C84 67 41     126 : session (result) 

+2C86 96 40     127 : sendfromto (...

+2C88 51 41     128 : define collector (task) 

+2C8A 6E 41     129 : id (field, result)

+

+2C8C C2 F3 2C    ..,   JP    NZ,2CF3    ; C <> 0: LN Befehl, kein Page

+2C8F F5          .     PUSH  AF         ; Neuen Block

+2C90 3A B6 2A    :.*   LD    A,(2AB6)   ; Opcode BF oder LN

+2C93 FE 70       .p    CP    70         

+2C95 28 02       (.    JR    Z,2C99     

+2C97 FE 74       .t    CP    74         

+2C99 C4 87 42    ..B   CALL  NZ,4287    ; Neue Seite laden

+2C9C F1          .     POP   AF         

+2C9D 04          .     INC   B           

+2C9E 05          .     DEC   B          ; Flag B = 0 setzen

+2C9F C3 B5 2A    ..*   JP    2AB5       ; Befehl nochmal aufsetzen

+2CA2 CD 13 43    ..C   CALL  4313       ;--------------------------------

+2CA5 5E          ^     LD    E,(HL)     ; DE := 1. Codewort

+2CA6 2C          ,     INC   L          

+2CA7 56          V     LD    D,(HL)     

+2CA8 CD 13 43    ..C   CALL  4313       ; HL := 2. Codewort

+2CAB 7E          ~     LD    A,(HL)     

+2CAC 2C          ,     INC   L          

+2CAD 66          f     LD    H,(HL)     

+2CAE 6F          o     LD    L,A        

+2CAF C9          .     RET              ;----------- Bytemove ------------

+2CB0 04          .     INC   B          

+2CB1 05          .     DEC   B          

+2CB2 20 12        .    JR    NZ,2CC6    ; Weniger als 256 Bytes ?

+2CB4 79          y     LD    A,C        ; 256 Bytes in einem Schub per LDIR

+2CB5 B7          .     OR    A          

+2CB6 C8          .     RET   Z          ; Nichts moven

+2CB7 85          .     ADD   L          

+2CB8 38 07       8.    JR    C,2CC1     

+2CBA 79          y     LD    A,C         

+2CBB 83          .     ADD   E          

+2CBC 38 03       8.    JR    C,2CC1     

+2CBE ED B0       ..    LDIR             

+2CC0 C9          .     RET              

+2CC1 3E 0D       >.    LD    A,0D       

+2CC3 B9          .     CP    C          

+2CC4 30 0C       0.    JR    NC,2CD2    

+2CC6 CD 78 45    .xE   CALL  4578       ; Move in mehreren Teilen

+2CC9 C8          .     RET   Z          

+2CCA ED B0       ..    LDIR             

+2CCC D0          .     RET   NC         

+2CCD CD C1 45    ..E   CALL  45C1       

+2CD0 18 F4       ..    JR    2CC6       

+2CD2 7E          ~     LD    A,(HL)     

+2CD3 0D          .     DEC   C          

+2CD4 28 19       (.    JR    Z,2CEF     

+2CD6 F5          .     PUSH  AF         

+2CD7 D5          .     PUSH  DE         

+2CD8 FD 21 85 46 .!.F  LD    IY,4685    

+2CDC 2C          ,     INC   L          

+2CDD CC 1B 45    ..E   CALL  Z,451B     

+2CE0 EB          .     EX    DE,HL      

+2CE1 FD 21 89 46 .!.F  LD    IY,4689    

+2CE5 2C          ,     INC   L          

+2CE6 CC 1B 45    ..E   CALL  Z,451B     

+2CE9 EB          .     EX    DE,HL      

+2CEA CD D2 2C    ..,   CALL  2CD2       ; Teilmove

+2CED D1          .     POP   DE         

+2CEE F1          .     POP   AF         

+2CEF 12          .     LD    (DE),A     

+2CF0 C9          .     RET              ;------------- LONGLN ------------

+2CF1 C6 04       ..    ADD   A,04       ; 

+2CF3 07          .     RLCA             ;------------- LN ----------------

+2CF4 DD 75 20    .u    LD    (IX+20),L  

+2CF7 DD 77 21    .w!   LD    (IX+21),A  

+2CFA C3 A7 2A    ..*   JP    2AA7       ;--------- MOV1  -----------------

+2CFD CD 1B 43    ..C   CALL  431B       ; fromaddresse --> HL

+2D00 5E          ^     LD    E,(HL)     

+2D01 2C          ,     INC   L          

+2D02 56          V     LD    D,(HL)     

+2D03 CD 64 43    .dC   CALL  4364       ; toaddresse --> HL

+2D06 73          s     LD    (HL),E     

+2D07 2C          ,     INC   L          

+2D08 72          r     LD    (HL),D     

+2D09 C3 A7 2A    ..*   JP    2AA7       ;----------- MOVIM --------------

+2D0C CD 43 44    .CD   CALL  4443       

+2D0F 18 F2       ..    JR    2D03       

+2D11 CD 6C 43    .lC   CALL  436C       ;---------- INC1 ----------------

+2D14 34          4     INC   (HL)       

+2D15 C2 A7 2A    ..*   JP    NZ,2AA7    

+2D18 2C          ,     INC   L          

+2D19 34          4     INC   (HL)       

+2D1A E2 A7 2A    ..*   JP    PO,2AA7    

+2D1D 18 2B       .+    JR    2D4A       ;-------------- DEC1 -------------

+2D1F CD 6C 43    .lC   CALL  436C       

+2D22 7E          ~     LD    A,(HL)     

+2D23 D6 01       ..    SUB   A,01       

+2D25 77          w     LD    (HL),A     

+2D26 D2 A7 2A    ..*   JP    NC,2AA7    

+2D29 2C          ,     INC   L          

+2D2A 35          5     DEC   (HL)       

+2D2B E2 A7 2A    ..*   JP    PO,2AA7    

+2D2E 18 1A       ..    JR    2D4A       ;------------- INC ---------------

+2D30 CD 1B 43    ..C   CALL  431B       

+2D33 5E          ^     LD    E,(HL)     

+2D34 2C          ,     INC   L          

+2D35 56          V     LD    D,(HL)     

+2D36 CD 64 43    .dC   CALL  4364       

+2D39 7E          ~     LD    A,(HL)     

+2D3A 83          .     ADD   E          

+2D3B 77          w     LD    (HL),A     

+2D3C 2C          ,     INC   L          

+2D3D 7E          ~     LD    A,(HL)     

+2D3E 8A          .     ADC   D          

+2D3F 77          w     LD    (HL),A     

+2D40 E2 A7 2A    ..*   JP    PO,2AA7    

+2D43 30 05       0.    JR    NC,2D4A    

+2D45 3E FF       >.    LD    A,FF       

+2D47 77          w     LD    (HL),A     

+2D48 2D          -     DEC   L          

+2D49 77          w     LD    (HL),A     

+2D4A CD FC 3C    ..<   CALL  3CFC       

+2D4D C3 A7 2A    ..*   JP    2AA7       ;------------- DEC ----------------

+2D50 CD 1B 43    ..C   CALL  431B       

+2D53 5E          ^     LD    E,(HL)     

+2D54 2C          ,     INC   L          

+2D55 56          V     LD    D,(HL)     

+2D56 CD 64 43    .dC   CALL  4364       

+2D59 7E          ~     LD    A,(HL)     

+2D5A 93          .     SUB   E          

+2D5B 77          w     LD    (HL),A     

+2D5C 2C          ,     INC   L          

+2D5D 7E          ~     LD    A,(HL)     

+2D5E 9A          .     SBC   D          

+2D5F 77          w     LD    (HL),A     

+2D60 E2 A7 2A    ..*   JP    PO,2AA7    

+2D63 18 DE       ..    JR    2D43       ;------------- ADD ---------------

+2D65 CD 1B 43    ..C   CALL  431B       

+2D68 5E          ^     LD    E,(HL)     

+2D69 2C          ,     INC   L          

+2D6A 56          V     LD    D,(HL)     

+2D6B CD 13 43    ..C   CALL  4313       

+2D6E 7E          ~     LD    A,(HL)     

+2D6F 2C          ,     INC   L          

+2D70 66          f     LD    H,(HL)     

+2D71 6F          o     LD    L,A        

+2D72 B7          .     OR    A          

+2D73 ED 5A       .Z    ADC   HL,DE      

+2D75 EC FC 3C    ..<   CALL  PE,3CFC    

+2D78 EB          .     EX    DE,HL      

+2D79 CD 64 43    .dC   CALL  4364       

+2D7C 73          s     LD    (HL),E     

+2D7D 2C          ,     INC   L          

+2D7E 72          r     LD    (HL),D     

+2D7F C3 A7 2A    ..*   JP    2AA7       ;------------ SUB ----------------

+2D82 CD 1B 43    ..C   CALL  431B       

+2D85 5E          ^     LD    E,(HL)     

+2D86 2C          ,     INC   L          

+2D87 56          V     LD    D,(HL)     

+2D88 CD 13 43    ..C   CALL  4313       

+2D8B 7E          ~     LD    A,(HL)     

+2D8C 2C          ,     INC   L          

+2D8D 66          f     LD    H,(HL)     

+2D8E 6F          o     LD    L,A        

+2D8F EB          .     EX    DE,HL      

+2D90 B7          .     OR    A          

+2D91 ED 52       .R    SBC   HL,DE      

+2D93 EC FC 3C    ..<   CALL  PE,3CFC    

+2D96 EB          .     EX    DE,HL      

+2D97 CD 64 43    .dC   CALL  4364       

+2D9A 73          s     LD    (HL),E     

+2D9B 2C          ,     INC   L          

+2D9C 72          r     LD    (HL),D     

+2D9D C3 A7 2A    ..*   JP    2AA7       ;-------------- MULT ------------

+2DA0 CD A2 2C    ..,   CALL  2CA2       ; Zwei Addressen holen --> HL, DE

+2DA3 CD 0D 4D    ..M   CALL  4D0D       ; MULT

+2DA6 DC FC 3C    ..<   CALL  C,3CFC     ; Overflow, ggf

+2DA9 C3 03 2D    ..-   JP    2D03       ;--------------- DIV ------------

+2DAC CD A2 2C    ..,   CALL  2CA2       

+2DAF CD 3D 4D    .=M   CALL  4D3D       ; DIV

+2DB2 DC CD 3C    ..<   CALL  C,3CCD     

+2DB5 C3 03 2D    ..-   JP    2D03       ;--------------- MOD -------------

+2DB8 CD A2 2C    ..,   CALL  2CA2       

+2DBB CD 3D 4D    .=M   CALL  4D3D       ; DIV

+2DBE EB          .     EX    DE,HL      ; Rest davon

+2DBF 18 F1       ..    JR    2DB2       ;------------- IMULT -------------

+2DC1 CD A2 2C    ..,   CALL  2CA2       

+2DC4 CD 6D 4D    .mM   CALL  4D6D       

+2DC7 EB          .     EX    DE,HL      

+2DC8 CE 00       ..    ADC   A,00       

+2DCA 28 03       (.    JR    Z,2DCF     

+2DCC 11 FF FF    ...   LD    DE,FFFF    ; Overflow = -1

+2DCF C3 03 2D    ..-   JP    2D03       ;------------- CLEAR -------------

+2DD2 CD 6C 43    .lC   CALL  436C       

+2DD5 97          .     SUB   A          

+2DD6 77          w     LD    (HL),A     

+2DD7 2C          ,     INC   L          

+2DD8 77          w     LD    (HL),A     

+2DD9 C3 A7 2A    ..*   JP    2AA7       ;------------- COMPL --------------

+2DDC CD A8 2C    ..,   CALL  2CA8       

+2DDF EB          .     EX    DE,HL      

+2DE0 21 00 00    !..   LD    HL,0000    

+2DE3 B7          .     OR    A          

+2DE4 ED 52       .R    SBC   HL,DE      

+2DE6 EB          .     EX    DE,HL      

+2DE7 C3 03 2D    ..-   JP    2D03       ;--------------- AND -------------

+2DEA CD A2 2C    ..,   CALL  2CA2       

+2DED 7B          {     LD    A,E        

+2DEE A5          .     AND   L          

+2DEF 5F          _     LD    E,A        

+2DF0 7A          z     LD    A,D        

+2DF1 A4          .     AND   H          

+2DF2 57          W     LD    D,A        

+2DF3 C3 03 2D    ..-   JP    2D03       ;-------------- OR --------------

+2DF6 CD A2 2C    ..,   CALL  2CA2       

+2DF9 7B          {     LD    A,E        

+2DFA B5          .     OR    L          

+2DFB 5F          _     LD    E,A        

+2DFC 7A          z     LD    A,D        

+2DFD B4          .     OR    H          

+2DFE 57          W     LD    D,A        

+2DFF C3 03 2D    ..-   JP    2D03       ;---------------- XOR ------------

+2E02 CD A2 2C    ..,   CALL  2CA2       

+2E05 7B          {     LD    A,E        

+2E06 AD          .     XOR   L          

+2E07 5F          _     LD    E,A        

+2E08 7A          z     LD    A,D        

+2E09 AC          .     XOR   H          

+2E0A 57          W     LD    D,A        

+2E0B C3 03 2D    ..-   JP    2D03       ;-------------- rotate ------------

+2E0E CD 64 43    .dC   CALL  4364       

+2E11 E5          .     PUSH  HL         

+2E12 5E          ^     LD    E,(HL)     

+2E13 2C          ,     INC   L          

+2E14 56          V     LD    D,(HL)     

+2E15 CD 13 43    ..C   CALL  4313       

+2E18 7E          ~     LD    A,(HL)     

+2E19 E6 0F       ..    AND   0F         ; keine links/rechts Optimierung

+2E1B 28 0A       (.    JR    Z,2E27     

+2E1D CB 23       .#    SLA   E          

+2E1F CB 12       ..    RL    D          

+2E21 30 01       0.    JR    NC,2E24    

+2E23 1C          .     INC   E          

+2E24 3D          =     DEC   A          

+2E25 20 F6        .    JR    NZ,2E1D    

+2E27 E1          .     POP   HL         

+2E28 C3 06 2D    ..-   JP    2D06       ;------------- TEST ---------------

+2E2B CD 1B 43    ..C   CALL  431B       

+2E2E 7E          ~     LD    A,(HL)     

+2E2F 2C          ,     INC   L          

+2E30 B6          .     OR    (HL)       

+2E31 28 3E       (>    JR    Z,2E71     ; Beide 0 ?

+2E33 18 4F       .O    JR    2E84       ;------------- LSEQ --------------

+2E35 CD 1B 43    ..C   CALL  431B       

+2E38 EB          .     EX    DE,HL      

+2E39 CD 13 43    ..C   CALL  4313       

+2E3C EB          .     EX    DE,HL      

+2E3D 1A          .     LD    A,(DE)     

+2E3E 96          .     SUB   (HL)       

+2E3F 1C          .     INC   E          

+2E40 2C          ,     INC   L          

+2E41 1A          .     LD    A,(DE)     

+2E42 9E          .     SBC   (HL)       

+2E43 E2 48 2E    .H.   JP    PO,2E48    

+2E46 EE 80       ..    XOR   80         

+2E48 F2 71 2E    .q.   JP    P,2E71     

+2E4B C3 84 2E    ...   JP    2E84       ;------------ ULSEQU --------------

+2E4E CD 1B 43    ..C   CALL  431B       

+2E51 EB          .     EX    DE,HL      

+2E52 CD 13 43    ..C   CALL  4313       

+2E55 EB          .     EX    DE,HL      

+2E56 1A          .     LD    A,(DE)     

+2E57 96          .     SUB   (HL)       

+2E58 1C          .     INC   E          

+2E59 2C          ,     INC   L          

+2E5A 1A          .     LD    A,(DE)     

+2E5B 9E          .     SBC   (HL)       

+2E5C 30 13       0.    JR    NC,2E71    

+2E5E 18 24       .$    JR    2E84       ;----------- EQU -----------------

+2E60 CD 1B 43    ..C   CALL  431B       

+2E63 EB          .     EX    DE,HL      

+2E64 CD 13 43    ..C   CALL  4313       

+2E67 1A          .     LD    A,(DE)     

+2E68 BE          .     CP    (HL)       

+2E69 20 19        .    JR    NZ,2E84    

+2E6B 1C          .     INC   E          

+2E6C 2C          ,     INC   L          

+2E6D 1A          .     LD    A,(DE)     

+2E6E BE          .     CP    (HL)       

+2E6F 20 13        .    JR    NZ,2E84    

+2E71 0A          .     LD    A,(BC)     ; TRUE liefern

+2E72 6F          o     LD    L,A        

+2E73 0C          .     INC   C          

+2E74 0A          .     LD    A,(BC)     

+2E75 CB 77       .w    BIT   6,A        

+2E77 20 4C        L    JR    NZ,2EC5    

+2E79 C3 8E 2E    ...   JP    2E8E       ; zum Branch

+2E7C CD 7E 2A    .~*   CALL  2A7E       

+2E7F 18 F0       ..    JR    2E71       

+2E81 CD 7E 2A    .~*   CALL  2A7E       

+2E84 0A          .     LD    A,(BC)     ; FALSE liefern

+2E85 6F          o     LD    L,A        

+2E86 0C          .     INC   C          

+2E87 0A          .     LD    A,(BC)     

+2E88 CB 77       .w    BIT   6,A        

+2E8A 28 39       (9    JR    Z,2EC5     ; Opcode veraendern

+2E8C E6 87       ..    AND   87         ; folgt immer Branch

+2E8E B7          .     OR    A          ;------------- BR -----------------

+2E8F 20 14        .    JR    NZ,2EA5    

+2E91 78          x     LD    A,B        

+2E92 0F          .     RRCA             

+2E93 4D          M     LD    C,L        

+2E94 CB 21       .!    SLA   C          

+2E96 8F          .     ADC   A          

+2E97 90          .     SUB   B          

+2E98 CA A7 2A    ..*   JP    Z,2AA7     

+2E9B 80          .     ADD   B          

+2E9C 47          G     LD    B,A        

+2E9D DD 75 09    .u.   LD    (IX+09),L  

+2EA0 C3 A7 2A    ..*   JP    2AA7       ;------------ LONGBR --------------

+2EA3 C6 04       ..    ADD   A,04       

+2EA5 07          .     RLCA             

+2EA6 DD 86 0A    ...   ADD   (IX+0A)    

+2EA9 DD BE 0F    ...   CP    (IX+0F)    

+2EAC FA B1 2E    ...   JP    M,2EB1     

+2EAF D6 10       ..    SUB   A,10       

+2EB1 DD 77 0A    .w.   LD    (IX+0A),A  

+2EB4 7D          }     LD    A,L        

+2EB5 DD 77 09    .w.   LD    (IX+09),A  

+2EB8 4F          O     LD    C,A        

+2EB9 87          .     ADD   A          

+2EBA 08          .     EX    AF,AF'     

+2EBB CD AB 42    ..B   CALL  42AB       

+2EBE CB 21       .!    SLA   C          

+2EC0 17          .     RLA              

+2EC1 47          G     LD    B,A        

+2EC2 C3 A7 2A    ..*   JP    2AA7       

+2EC5 0C          .     INC   C          

+2EC6 CC A8 42    ..B   CALL  Z,42A8     

+2EC9 C3 A7 2A    ..*   JP    2AA7       ;------------ CASE ----------------

+2ECC CD A8 2C    ..,   CALL  2CA8       

+2ECF CD 43 44    .CD   CALL  4443       

+2ED2 CB 7C       .|    BIT   7,H        

+2ED4 20 AE        .    JR    NZ,2E84    

+2ED6 7D          }     LD    A,L        

+2ED7 93          .     SUB   E          

+2ED8 7C          |     LD    A,H        

+2ED9 9A          .     SBC   D          

+2EDA 30 A8       0.    JR    NC,2E84    

+2EDC CB 38       .8    SLR   B          

+2EDE CB 19       ..    RR    C          

+2EE0 DD 46 0A    .F.   LD    B,(IX+0A)  

+2EE3 09          .     ADD   HL,BC      

+2EE4 23          #     INC   HL         

+2EE5 7C          |     LD    A,H        

+2EE6 18 C9       ..    JR    2EB1       ;-------------- PPROC -------------

+2EE8 CD 43 44    .CD   CALL  4443       

+2EEB EB          .     EX    DE,HL      

+2EEC 11 02 00    ...   LD    DE,0002    ; D=0

+2EEF 7C          |     LD    A,H        

+2EF0 FE 05       ..    CP    05         ; Modnr < 1280 : Segment 2

+2EF2 38 01       8.    JR    C,2EF5     

+2EF4 1C          .     INC   E          

+2EF5 D5          .     PUSH  DE         ; Segment in E auf Stack

+2EF6 24          $     INC   H          ; +0200 = Moduletable

+2EF7 24          $     INC   H          

+2EF8 97          .     SUB   A          

+2EF9 CD 4D 44    .MD   CALL  444D       

+2EFC 5E          ^     LD    E,(HL)     ; Addresse 

+2EFD 2C          ,     INC   L          

+2EFE 56          V     LD    D,(HL)     

+2EFF D5          .     PUSH  DE         ; REF-Addr auf Stack 

+2F00 18 0A       ..    JR    2F0C       ;--------------- PPV -------------

+2F02 CD A8 2C    ..,   CALL  2CA8       

+2F05 18 03       ..    JR    2F0A       ;--------------- PP -------------

+2F07 CD C0 43    ..C   CALL  43C0       

+2F0A D5          .     PUSH  DE         

+2F0B E5          .     PUSH  HL         

+2F0C 2A C6 41    *.A   LD    HL,(41C6)  ; REF-Addr auf Stack---------------

+2F0F 23          #     INC   HL         

+2F10 23          #     INC   HL         

+2F11 CB 7C       .|    BIT   7,H        

+2F13 C2 D1 3C    ..<   JP    NZ,3CD1    

+2F16 5C          \     LD    E,H        

+2F17 16 1A       ..    LD    D,1A       

+2F19 1A          .     LD    A,(DE)     

+2F1A 67          g     LD    H,A        

+2F1B 29          )     ADD   HL,HL      

+2F1C D4 F9 42    ..B   CALL  NC,42F9    

+2F1F D1          .     POP   DE         

+2F20 73          s     LD    (HL),E     ; Low Word

+2F21 2C          ,     INC   L          

+2F22 72          r     LD    (HL),D     

+2F23 2C          ,     INC   L          

+2F24 D1          .     POP   DE         ; High Word

+2F25 73          s     LD    (HL),E     

+2F26 2C          ,     INC   L          

+2F27 72          r     LD    (HL),D     

+2F28 2A C6 41    *.A   LD    HL,(41C6)  ; Stackpointer

+2F2B 23          #     INC   HL         

+2F2C 23          #     INC   HL         

+2F2D 22 C6 41    ".A   LD    (41C6),HL  

+2F30 C3 A7 2A    ..*   JP    2AA7       ;------------- PCALL --------------

+2F33 CD B8 43    ..C   CALL  43B8       ; REF-Addr vom Stack

+2F36 7B          {     LD    A,E        ; Segment

+2F37 EB          .     EX    DE,HL      

+2F38 18 27       .'    JR    2F61       ;------------- EXEC ---------------

+2F3A CD A8 2C    ..,   CALL  2CA8       

+2F3D 7C          |     LD    A,H        

+2F3E 18 08       ..    JR    2F48       ;-------------- CALL -------------

+2F40 CB 7F       ..    BIT   7,A        

+2F42 CB BF       ..    RES   7,A        

+2F44 28 02       (.    JR    Z,2F48     

+2F46 CB D7       ..    SET   2,A        

+2F48 F5          .     PUSH  AF         

+2F49 C6 02       ..    ADD   A,02       ; Addresse aus Module Addr Tabelle

+2F4B 67          g     LD    H,A        

+2F4C 5F          _     LD    E,A        

+2F4D 16 19       ..    LD    D,19       

+2F4F 1A          .     LD    A,(DE)     

+2F50 67          g     LD    H,A        

+2F51 29          )     ADD   HL,HL      

+2F52 B7          .     OR    A          

+2F53 CC E1 42    ..B   CALL  Z,42E1     

+2F56 5E          ^     LD    E,(HL)     

+2F57 2C          ,     INC   L          

+2F58 56          V     LD    D,(HL)     

+2F59 F1          .     POP   AF         

+2F5A FE 05       ..    CP    05         

+2F5C 3E 02       >.    LD    A,02       

+2F5E 38 01       8.    JR    C,2F61     

+2F60 3C          <     INC   A          ; Call PROC

+2F61 47          G     LD    B,A        ;---- Segment in A, Addr in HL

+2F62 D5          .     PUSH  DE         ; call...

+ - Fortsetzung in Datei "eumel0.prt.2" -

diff --git a/system/eumel0-z80/src/eumel0.prt.2 b/system/eumel0-z80/src/eumel0.prt.2
new file mode 100644
index 0000000..5dbb9b9
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.2
@@ -0,0 +1,3957 @@
+#type ("17.klein")#

+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT

+

+2F63 2A C8 41    *.A   LD    HL,(41C8)

+2F66 5C          \     LD    E,H

+2F67 16 1A       ..    LD    D,1A       

+2F69 1A          .     LD    A,(DE)     

+2F6A 67          g     LD    H,A        

+2F6B 29          )     ADD   HL,HL      

+2F6C D4 F9 42    ..B   CALL  NC,42F9    

+2F6F ED 5B C4 41 .[.A  LD    DE,(41C4)  ; Stacktop auf Stack

+2F73 73          s     LD    (HL),E     

+2F74 2C          ,     INC   L          

+2F75 72          r     LD    (HL),D     

+2F76 2C          ,     INC   L          

+2F77 DD CB 09 26 ...&  SLA   (IX+09)    ; icount Felder auf Stack

+2F7B CB 19       ..    RR    C          

+2F7D 71          q     LD    (HL),C     

+2F7E 2C          ,     INC   L          

+2F7F DD 7E 0A    .~.   LD    A,(IX+0A)  

+2F82 77          w     LD    (HL),A     

+2F83 2C          ,     INC   L          

+2F84 DD 7E 0B    .~.   LD    A,(IX+0B)  

+2F87 77          w     LD    (HL),A     

+2F88 2C          ,     INC   L          

+2F89 E6 FC       ..    AND   FC         ; Fehlerzustand vererbt sich

+2F8B B0          .     OR    B          

+2F8C 47          G     LD    B,A        

+2F8D D9          .     EXX              

+2F8E 79          y     LD    A,C        

+2F8F D9          .     EXX              

+2F90 77          w     LD    (HL),A     

+2F91 2C          ,     INC   L          

+2F92 DD 7E 0F    .~.   LD    A,(IX+0F)  

+2F95 77          w     LD    (HL),A     

+2F96 D1          .     POP   DE         

+2F97 7A          z     LD    A,D        

+2F98 C6 10       ..    ADD   A,10       

+2F9A DD 77 0F    .w.   LD    (IX+0F),A  

+2F9D DD 36 06 18 .6..  LD    (IX+06),18 

+2FA1 DD 73 09    .s.   LD    (IX+09),E  ; icount neu setzen

+2FA4 DD 72 0A    .r.   LD    (IX+0A),D  

+2FA7 DD 70 0B    .p.   LD    (IX+0B),B  

+2FAA 4B          K     LD    C,E        

+2FAB 7B          {     LD    A,E        

+2FAC 87          .     ADD   A          

+2FAD 08          .     EX    AF,AF'     

+2FAE CD AB 42    ..B   CALL  42AB       

+2FB1 CB 21       .!    SLA   C          

+2FB3 17          .     RLA              

+2FB4 47          G     LD    B,A        

+2FB5 0A          .     LD    A,(BC)     

+2FB6 5F          _     LD    E,A        

+2FB7 0C          .     INC   C          

+2FB8 0A          .     LD    A,(BC)     

+2FB9 57          W     LD    D,A        

+2FBA 0C          .     INC   C          

+2FBB CC 87 42    ..B   CALL  Z,4287     

+2FBE DD 36 06 00 .6..  LD    (IX+06),00 

+2FC2 2A C8 41    *.A   LD    HL,(41C8)  

+2FC5 22 C4 41    ".A   LD    (41C4),HL  ; Stacktop neu setzen

+2FC8 B7          .     OR    A          

+2FC9 ED 5A       .Z    ADC   HL,DE      

+2FCB EA D1 3C    ..<   JP    PE,3CD1    

+2FCE 22 C8 41    ".A   LD    (41C8),HL  

+2FD1 23          #     INC   HL         

+2FD2 23          #     INC   HL         

+2FD3 22 C6 41    ".A   LD    (41C6),HL  ; Stackpointer neu setzen

+2FD6 CB 7C       .|    BIT   7,H        

+2FD8 CA A7 2A    ..*   JP    Z,2AA7     ; Stackoverflow bei CALL

+2FDB C3 D1 3C    ..<   JP    3CD1       ;------------ PENTER -------------

+2FDE 7D          }     LD    A,L        

+2FDF D9          .     EXX              

+2FE0 4F          O     LD    C,A        ; C' = Packetbase

+2FE1 D9          .     EXX              

+2FE2 C3 A7 2A    ..*   JP    2AA7       ;------------- arith15 ------------ 

+2FE5 DD CB 0B A6 ....  RES   4,(IX+0B)  

+2FE9 C3 A7 2A    ..*   JP    2AA7       ;------------- arith16 ------------

+2FEC DD CB 0B E6 ....  SET   4,(IX+0B)  

+2FF0 C3 A7 2A    ..*   JP    2AA7       ;------------- RTN ----------------

+2FF3 CD 35 30    .50   CALL  3035       ; LEAVE PROC

+2FF6 C3 A7 2A    ..*   JP    2AA7       ;------------- RTN FALSE ----------

+2FF9 CD 1B 30    ..0   CALL  301B       

+2FFC DD 36 06 10 .6..  LD    (IX+06),10 ; Status LEAVE PROC FALSE

+3000 CD 38 30    .80   CALL  3038       

+3003 DD 36 06 00 .6..  LD    (IX+06),00 ; Status wieder busy, BR FALSEmodif.

+3007 C3 71 2E    .q.   JP    2E71       ;-------------- RTN TRUE ----------

+300A CD 1B 30    ..0   CALL  301B       

+300D DD 36 06 14 .6..  LD    (IX+06),14 ; Status LEAVE PROC TRUE

+3011 CD 38 30    .80   CALL  3038       

+3014 DD 36 06 00 .6..  LD    (IX+06),00 ; Wieder Busy

+3018 C3 84 2E    ...   JP    2E84       ; BR TRUE modif.

+301B 2A C4 41    *.A   LD    HL,(41C4)  ;-------- LEAVE PROC -------------

+301E 44          D     LD    B,H        

+301F 4D          M     LD    C,L        ; ALten Stacktop wiederherstellen

+3020 22 C8 41    ".A   LD    (41C8),HL  

+3023 23          #     INC   HL         

+3024 23          #     INC   HL         

+3025 22 C6 41    ".A   LD    (41C6),HL  ; +2 = Neuer Stacktop

+3028 2B          +     DEC   HL         

+3029 2B          +     DEC   HL         

+302A 5C          \     LD    E,H        

+302B 16 1A       ..    LD    D,1A       

+302D 1A          .     LD    A,(DE)     

+302E 67          g     LD    H,A        

+302F 29          )     ADD   HL,HL      

+3030 B7          .     OR    A          

+3031 C0          .     RET   NZ         

+3032 C3 E1 42    ..B   JP    42E1       ;--------------------------------

+3035 CD 1B 30    ..0   CALL  301B       ; LEAVE PROC

+3038 5E          ^     LD    E,(HL)     

+3039 2C          ,     INC   L          

+303A 56          V     LD    D,(HL)     

+303B 7B          {     LD    A,E        

+303C 91          .     SUB   C          

+303D 7A          z     LD    A,D        

+303E 98          .     SBC   B          

+303F 30 37       07    JR    NC,3078    ; Stack underflow, Harakiri

+3041 2C          ,     INC   L          

+3042 ED 53 C4 41 .S.A  LD    (41C4),DE  ; Stacktop

+3046 4E          N     LD    C,(HL)     

+3047 2C          ,     INC   L          

+3048 DD 71 09    .q.   LD    (IX+09),C  ; icount wiederherstellen

+304B 7E          ~     LD    A,(HL)     

+304C 2C          ,     INC   L          

+304D DD 77 0A    .w.   LD    (IX+0A),A  

+3050 DD 7E 0B    .~.   LD    A,(IX+0B)  

+3053 E6 80       ..    AND   80         

+3055 5E          ^     LD    E,(HL)     

+3056 CB BB       ..    RES   7,E        

+3058 B3          .     OR    E          

+3059 DD 77 0B    .w.   LD    (IX+0B),A  ; iserror uebernehmen

+305C 2C          ,     INC   L          

+305D E6 C0       ..    AND   C0         

+305F FE 80       ..    CP    80         

+3061 CA 2E 3D    ..=   JP    Z,3D2E     ; errorstop

+3064 7E          ~     LD    A,(HL)     

+3065 2C          ,     INC   L          

+3066 D9          .     EXX              

+3067 4F          O     LD    C,A        

+3068 D9          .     EXX              

+3069 7E          ~     LD    A,(HL)     

+306A DD 77 0F    .w.   LD    (IX+0F),A  

+306D 79          y     LD    A,C        

+306E 87          .     ADD   A          

+306F 08          .     EX    AF,AF'     

+3070 CD AB 42    ..B   CALL  42AB       

+3073 CB 21       .!    SLA   C          

+3075 17          .     RLA              

+3076 47          G     LD    B,A        

+3077 C9          .     RET              

+3078 DD 36 06 FF .6..  LD    (IX+06),FF ; dead setzen. "Harakiri"

+307C C3 26 29    .&)   JP    2926       ;-------------- GOSUB -------------

+307F CD 43 44    .CD   CALL  4443       ; Branchaddresse holen

+3082 D5          .     PUSH  DE         

+3083 2A C8 41    *.A   LD    HL,(41C8)  

+3086 5C          \     LD    E,H        

+3087 16 1A       ..    LD    D,1A       

+3089 1A          .     LD    A,(DE)     

+308A 67          g     LD    H,A        

+308B 29          )     ADD   HL,HL      

+308C D4 F9 42    ..B   CALL  NC,42F9    

+308F DD 7E 09    .~.   LD    A,(IX+09)  ; icount auf Stack (Seg.bleibt)!

+3092 87          .     ADD   A          

+3093 CB 19       ..    RR    C          

+3095 71          q     LD    (HL),C     

+3096 2C          ,     INC   L          

+3097 DD 7E 0A    .~.   LD    A,(IX+0A)  

+309A 77          w     LD    (HL),A     

+309B 2A C8 41    *.A   LD    HL,(41C8)  ; Stackpointer INCR 4

+309E 23          #     INC   HL         

+309F 23          #     INC   HL         

+30A0 23          #     INC   HL         

+30A1 23          #     INC   HL         

+30A2 22 C8 41    ".A   LD    (41C8),HL  

+30A5 23          #     INC   HL         

+30A6 23          #     INC   HL         

+30A7 22 C6 41    ".A   LD    (41C6),HL  ; stacktop

+30AA E1          .     POP   HL         

+30AB 7C          |     LD    A,H        ; BRANCH

+30AC C3 8E 2E    ...   JP    2E8E       ;------------- GORET -------------

+30AF 2A C8 41    *.A   LD    HL,(41C8)  ; Stackpointer vom Stack

+30B2 2B          +     DEC   HL         

+30B3 2B          +     DEC   HL         

+30B4 22 C6 41    ".A   LD    (41C6),HL  

+30B7 2B          +     DEC   HL         

+30B8 2B          +     DEC   HL         

+30B9 22 C8 41    ".A   LD    (41C8),HL  

+30BC 5C          \     LD    E,H        

+30BD 16 1A       ..    LD    D,1A       

+30BF 1A          .     LD    A,(DE)     

+30C0 67          g     LD    H,A        

+30C1 29          )     ADD   HL,HL      

+30C2 B7          .     OR    A          

+30C3 CC E1 42    ..B   CALL  Z,42E1     

+30C6 2C          ,     INC   L          

+30C7 7E          ~     LD    A,(HL)     

+30C8 2D          -     DEC   L          

+30C9 6E          n     LD    L,(HL)     ; BRANCH

+30CA C3 B1 2E    ...   JP    2EB1       ;------------- TMOV --------------

+30CD CD 92 46    ..F   CALL  4692       

+30D0 FE 02       ..    CP    02         

+30D2 30 0F       0.    JR    NC,30E3    

+30D4 B7          .     OR    A          

+30D5 28 01       (.    JR    Z,30D8     

+30D7 56          V     LD    D,(HL)     

+30D8 CD 64 43    .dC   CALL  4364       

+30DB 2C          ,     INC   L          

+30DC 2C          ,     INC   L          

+30DD 73          s     LD    (HL),E     

+30DE 2C          ,     INC   L          

+30DF 72          r     LD    (HL),D     

+30E0 C3 A7 2A    ..*   JP    2AA7       

+30E3 DD CB 07 DE ....  SET   3,(IX+07)  

+30E7 E5          .     PUSH  HL         

+30E8 D5          .     PUSH  DE         

+30E9 CD AA 47    ..G   CALL  47AA       

+30EC D1          .     POP   DE         

+30ED CD 68 48    .hH   CALL  4868       

+30F0 42          B     LD    B,D        

+30F1 4B          K     LD    C,E        

+30F2 EB          .     EX    DE,HL      

+30F3 E3          .     EX    (SP),HL    

+30F4 7B          {     LD    A,E        

+30F5 95          .     SUB   L          

+30F6 7A          z     LD    A,D        

+30F7 20 01        .    JR    NZ,30FA    

+30F9 94          .     SUB   H          

+30FA C4 B0 2C    ..,   CALL  NZ,2CB0    

+30FD CD E8 45    ..E   CALL  45E8       

+3100 D1          .     POP   DE         

+3101 CD 92 48    ..H   CALL  4892       

+3104 DD CB 07 9E ....  RES   3,(IX+07)  

+3108 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+310C C3 A7 2A    ..*   JP    2AA7       ;------------ TEQU ----------------

+310F CD 92 46    ..F   CALL  4692       

+3112 FE 02       ..    CP    02         

+3114 30 09       0.    JR    NC,311F    

+3116 2D          -     DEC   L          

+3117 E5          .     PUSH  HL         

+3118 CD 07 44    ..D   CALL  4407       

+311B D1          .     POP   DE         

+311C C3 67 2E    .g.   JP    2E67       

+311F E5          .     PUSH  HL         

+3120 D5          .     PUSH  DE         

+3121 CD DD 46    ..F   CALL  46DD       

+3124 E3          .     EX    (SP),HL    

+3125 B7          .     OR    A          

+3126 ED 52       .R    SBC   HL,DE      

+3128 20 15        .    JR    NZ,313F    

+312A ED 43 D0 41 .C.A  LD    (41D0),BC  

+312E 4B          K     LD    C,E        

+312F 42          B     LD    B,D        

+3130 D1          .     POP   DE         

+3131 E1          .     POP   HL         

+3132 CD 7A 31    .z1   CALL  317A       

+3135 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3139 C2 84 2E    ...   JP    NZ,2E84    

+313C C3 71 2E    .q.   JP    2E71       

+313F D1          .     POP   DE         

+3140 E1          .     POP   HL         

+3141 C3 84 2E    ...   JP    2E84       ;------------- TLSEQU ------------

+3144 CD 8D 46    ..F   CALL  468D       

+3147 E5          .     PUSH  HL         

+3148 D5          .     PUSH  DE         

+3149 CD DD 46    ..F   CALL  46DD       

+314C E3          .     EX    (SP),HL    

+314D 7B          {     LD    A,E        

+314E 95          .     SUB   L          

+314F 7A          z     LD    A,D        

+3150 9C          .     SBC   H          

+3151 32 D3 41    2.A   LD    (41D3),A   

+3154 30 01       0.    JR    NC,3157    

+3156 EB          .     EX    DE,HL      

+3157 ED 43 D0 41 .C.A  LD    (41D0),BC  

+315B 44          D     LD    B,H        

+315C 4D          M     LD    C,L        

+315D D1          .     POP   DE         

+315E E1          .     POP   HL         

+315F 78          x     LD    A,B        

+3160 B1          .     OR    C          

+3161 C4 7A 31    .z1   CALL  NZ,317A    

+3164 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3168 28 06       (.    JR    Z,3170     

+316A D2 71 2E    .q.   JP    NC,2E71    

+316D C3 84 2E    ...   JP    2E84       

+3170 3A D3 41    :.A   LD    A,(41D3)   

+3173 B7          .     OR    A          

+3174 F2 71 2E    .q.   JP    P,2E71     

+3177 C3 84 2E    ...   JP    2E84       

+317A CD 78 45    .xE   CALL  4578       

+317D 30 0B       0.    JR    NC,318A    

+317F CD 8A 31    ..1   CALL  318A       

+3182 C2 EC 45    ..E   JP    NZ,45EC    

+3185 CD C1 45    ..E   CALL  45C1       

+3188 18 F0       ..    JR    317A       

+318A C8          .     RET   Z          

+318B 1A          .     LD    A,(DE)     

+318C BE          .     CP    (HL)       

+318D C0          .     RET   NZ         

+318E 2C          ,     INC   L          

+318F 1C          .     INC   E          

+3190 0D          .     DEC   C          

+3191 C2 8B 31    ..1   JP    NZ,318B    

+3194 97          .     SUB   A          

+3195 47          G     LD    B,A        

+3196 C9          .     RET              ;------------- LENGTH ------------

+3197 CD 13 43    ..C   CALL  4313       

+319A 23          #     INC   HL         

+319B 23          #     INC   HL         

+319C 5E          ^     LD    E,(HL)     

+319D 16 00       ..    LD    D,00       

+319F 7B          {     LD    A,E        

+31A0 3C          <     INC   A          

+31A1 C2 03 2D    ..-   JP    NZ,2D03    

+31A4 2C          ,     INC   L          

+31A5 C3 00 2D    ..-   JP    2D00       ;--------------- CODE ------------

+31A8 CD 8D 46    ..F   CALL  468D       

+31AB 11 FF FF    ...   LD    DE,FFFF    ; Wenn Laenge <> 1 ==> -1

+31AE FE 01       ..    CP    01         

+31B0 C2 03 2D    ..-   JP    NZ,2D03    

+31B3 5E          ^     LD    E,(HL)     ; sonst erstes Zeichen

+31B4 16 00       ..    LD    D,00       

+31B6 C3 03 2D    ..-   JP    2D03       ;-------------- ENCODE -----------

+31B9 CD 13 43    ..C   CALL  4313       

+31BC 1E 01       ..    LD    E,01       ; Laenge 1

+31BE 56          V     LD    D,(HL)     

+31BF C3 D8 30    ..0   JP    30D8       ;-------------- TSUB -------------

+31C2 CD 2C 47    .,G   CALL  472C       

+31C5 C3 D4 30    ..0   JP    30D4       ;------------- subtext 1 ---------

+31C8 CD 89 47    ..G   CALL  4789       

+31CB C3 D0 30    ..0   JP    30D0       ;------------- subtext 2 ---------

+31CE CD 95 47    ..G   CALL  4795       

+31D1 C3 D0 30    ..0   JP    30D0       ;------------- CAT ---------------

+31D4 CD B8 43    ..C   CALL  43B8       

+31D7 ED 53 CE 41 .S.A  LD    (41CE),DE  

+31DB E5          .     PUSH  HL         

+31DC CD 8D 46    ..F   CALL  468D       

+31DF 2D          -     DEC   L          

+31E0 7E          ~     LD    A,(HL)     

+31E1 32 D2 41    2.A   LD    (41D2),A   

+31E4 E3          .     EX    (SP),HL    

+31E5 D5          .     PUSH  DE         

+31E6 ED 5B CE 41 .[.A  LD    DE,(41CE)  

+31EA CD AD 47    ..G   CALL  47AD       

+31ED ED 53 40 4B .S@K  LD    (4B40),DE  

+31F1 E3          .     EX    (SP),HL    

+31F2 EB          .     EX    DE,HL      

+31F3 B7          .     OR    A          

+31F4 ED 5A       .Z    ADC   HL,DE      

+31F6 FA 26 32    .&2   JP    M,3226     

+31F9 22 CC 41    ".A   LD    (41CC),HL  

+31FC EB          .     EX    DE,HL      

+31FD E3          .     EX    (SP),HL    

+31FE CD AD 48    ..H   CALL  48AD       

+3201 38 28       8(    JR    C,322B     

+3203 ED 5B 40 4B .[@K  LD    DE,(4B40)  

+3207 CD 0D 45    ..E   CALL  450D       

+320A EB          .     EX    DE,HL      

+320B C1          .     POP   BC         

+320C E1          .     POP   HL         

+320D 3A D2 41    :.A   LD    A,(41D2)   

+3210 BE          .     CP    (HL)       

+3211 C2 26 29    .&)   JP    NZ,2926    

+3214 2C          ,     INC   L          

+3215 CD B0 2C    ..,   CALL  2CB0       

+3218 ED 5B CC 41 .[.A  LD    DE,(41CC)  

+321C CD 92 48    ..H   CALL  4892       

+321F ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3223 C3 A7 2A    ..*   JP    2AA7       

+3226 3E 07       >.    LD    A,07       

+3228 CD 0D 3D    ..=   CALL  3D0D       

+322B C1          .     POP   BC         

+322C E1          .     POP   HL         

+322D 18 F0       ..    JR    321F       ;------------ replace text -------

+322F CD AA 47    ..G   CALL  47AA       

+3232 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3236 E5          .     PUSH  HL         

+3237 CD A8 2C    ..,   CALL  2CA8       

+323A EB          .     EX    DE,HL      

+323B 1B          .     DEC   DE         

+323C B7          .     OR    A          

+323D ED 52       .R    SBC   HL,DE      

+323F 38 21       8!    JR    C,3262     

+3241 E3          .     EX    (SP),HL    

+3242 CD 0D 45    ..E   CALL  450D       

+3245 E3          .     EX    (SP),HL    

+3246 E5          .     PUSH  HL         

+3247 CD 8D 46    ..F   CALL  468D       

+324A ED 43 D0 41 .C.A  LD    (41D0),BC  

+324E C1          .     POP   BC         

+324F 79          y     LD    A,C        

+3250 93          .     SUB   E          

+3251 78          x     LD    A,B        

+3252 9A          .     SBC   D          

+3253 38 02       8.    JR    C,3257     

+3255 4B          K     LD    C,E        

+3256 42          B     LD    B,D        

+3257 D1          .     POP   DE         

+3258 CD B0 2C    ..,   CALL  2CB0       

+325B ED 4B D0 41 .K.A  LD    BC,(41D0)  

+#25F C3 A7 2A    ..*   JP    2AA7       

+3262 E1          .     POP   HL         

+3263 18 FA       ..    JR    325F       

+3265 CD 8D 46    ..F   CALL  468D       

+3268 E3          .     EX    (SP),HL    

+3269 D5          .     PUSH  DE         

+326A E5          .     PUSH  HL         

+326B CD DD 46    ..F   CALL  46DD       

+326E 7E          ~     LD    A,(HL)     

+326F 32 D4 41    2.A   LD    (41D4),A   

+3272 22 D8 41    ".A   LD    (41D8),HL  

+3275 3A 8A 46    :.F   LD    A,(468A)   

+3278 32 DA 41    2.A   LD    (41DA),A   

+327B 1B          .     DEC   DE         

+327C ED 53 D6 41 .S.A  LD    (41D6),DE  

+3280 C9          .     RET              ;------------ pos 1 --------------

+3281 CD 65 32    .e2   CALL  3265       

+3284 11 01 00    ...   LD    DE,0001    

+3287 18 1E       ..    JR    32A7       ;----------- pos 2 --------------- 

+3289 CD 65 32    .e2   CALL  3265       

+328C CD A8 2C    ..,   CALL  2CA8       

+328F EB          .     EX    DE,HL      

+3290 18 15       ..    JR    32A7       ;------------- pos 3 -------------

+3292 CD 65 32    .e2   CALL  3265       

+3295 CD A8 2C    ..,   CALL  2CA8       

+3298 EB          .     EX    DE,HL      

+3299 CD A8 2C    ..,   CALL  2CA8       

+329C EB          .     EX    DE,HL      

+329D E3          .     EX    (SP),HL    

+329E 7B          {     LD    A,E        

+329F 95          .     SUB   L          

+32A0 7A          z     LD    A,D        

+32A1 9C          .     SBC   H          

+32A2 30 01       0.    JR    NC,32A5    

+32A4 EB          .     EX    DE,HL      

+32A5 E3          .     EX    (SP),HL    

+32A6 EB          .     EX    DE,HL      

+32A7 CD 64 43    .dC   CALL  4364       

+32AA 22 CC 41    ".A   LD    (41CC),HL  

+32AD ED 43 D0 41 .C.A  LD    (41D0),BC  

+32B1 C1          .     POP   BC         

+32B2 2A D6 41    *.A   LD    HL,(41D6)  

+32B5 24          $     INC   H          

+32B6 25          %     DEC   H          

+32B7 20 3B        ;    JR    NZ,32F4    

+32B9 79          y     LD    A,C        

+32BA 95          .     SUB   L          

+32BB 4F          O     LD    C,A        

+32BC 78          x     LD    A,B        

+32BD 9C          .     SBC   H          

+32BE 47          G     LD    B,A        

+32BF E1          .     POP   HL         

+32C0 38 33       83    JR    C,32F5     

+32C2 CD 1D 46    ..F   CALL  461D       

+32C5 38 2E       8.    JR    C,32F5     

+32C7 CD 44 45    .DE   CALL  4544       

+32CA 28 29       ()    JR    Z,32F5     

+32CC F5          .     PUSH  AF         

+32CD 3A D4 41    :.A   LD    A,(41D4)   

+32D0 ED B1       ..    CPIR             

+32D2 CC FA 32    ..2   CALL  Z,32FA     

+32D5 28 0C       (.    JR    Z,32E3     

+32D7 78          x     LD    A,B        

+32D8 B1          .     OR    C          

+32D9 20 F2        .    JR    NZ,32CD    

+32DB F1          .     POP   AF         

+32DC 30 17       0.    JR    NC,32F5    

+32DE CD C1 45    ..E   CALL  45C1       

+32E1 18 E4       ..    JR    32C7       

+32E3 F1          .     POP   AF         

+32E4 CD 33 46    .3F   CALL  4633       

+32E7 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+32EB 2A CC 41    *.A   LD    HL,(41CC)  

+32EE 73          s     LD    (HL),E     

+32EF 2C          ,     INC   L          

+32F0 72          r     LD    (HL),D     

+32F1 C3 A7 2A    ..*   JP    2AA7       

+32F4 E1          .     POP   HL         

+32F5 11 00 00    ...   LD    DE,0000    

+32F8 18 ED       ..    JR    32E7       

+32FA 3A D6 41    :.A   LD    A,(41D6)   

+32FD B7          .     OR    A          

+32FE C8          .     RET   Z          

+32FF C5          .     PUSH  BC         

+3300 03          .     INC   BC         

+3301 CD F1 45    ..E   CALL  45F1       

+3304 ED 5B 85 46 .[.F  LD    DE,(4685)  

+3308 D5          .     PUSH  DE         

+3309 E5          .     PUSH  HL         

+330A 3A D6 41    :.A   LD    A,(41D6)   

+330D 47          G     LD    B,A        

+330E 2B          +     DEC   HL         

+330F ED 5B D8 41 .[.A  LD    DE,(41D8)  

+3313 3A DA 41    :.A   LD    A,(41DA)   

+3316 32 8A 46    2.F   LD    (468A),A   

+3319 2C          ,     INC   L          

+331A 20 07        .    JR    NZ,3323    

+331C FD 21 85 46 .!.F  LD    IY,4685    

+3320 CD 1B 45    ..E   CALL  451B       

+3323 1C          .     INC   E          

+3324 20 09        .    JR    NZ,332F    

+3326 FD 21 89 46 .!.F  LD    IY,4689    

+332A EB          .     EX    DE,HL      

+332B CD 1B 45    ..E   CALL  451B       

+332E EB          .     EX    DE,HL      

+332F 1A          .     LD    A,(DE)     

+3330 BE          .     CP    (HL)       

+3331 20 02        .    JR    NZ,3335    

+3333 10 E4       ..    DJNZ  3319       

+3335 F5          .     PUSH  AF         

+3336 CD 12 46    ..F   CALL  4612       

+3339 F1          .     POP   AF         

+333A E1          .     POP   HL         

+333B D1          .     POP   DE         

+333C C1          .     POP   BC         

+333D ED 53 85 46 .S.F  LD    (4685),DE  

+3341 C9          .     RET              ;------------ pos high low -------

+3342 CD 8D 46    ..F   CALL  468D       

+3345 D5          .     PUSH  DE         

+3346 E5          .     PUSH  HL         

+3347 CD 13 43    ..C   CALL  4313       

+334A 23          #     INC   HL         

+334B 23          #     INC   HL         

+334C 23          #     INC   HL         

+334D 5E          ^     LD    E,(HL)     

+334E CD 13 43    ..C   CALL  4313       

+3351 23          #     INC   HL         

+3352 23          #     INC   HL         

+3353 23          #     INC   HL         

+3354 56          V     LD    D,(HL)     

+3355 ED 53 D4 41 .S.A  LD    (41D4),DE  

+3359 CD A8 2C    ..,   CALL  2CA8       

+335C E5          .     PUSH  HL         

+335D CD 64 43    .dC   CALL  4364       

+3360 22 CC 41    ".A   LD    (41CC),HL  

+3363 ED 43 D0 41 .C.A  LD    (41D0),BC  

+3367 D1          .     POP   DE         

+3368 E1          .     POP   HL         

+3369 C1          .     POP   BC         

+336A CD 1D 46    ..F   CALL  461D       

+336D DA F5 32    ..2   JP    C,32F5     

+3370 CD 44 45    .DE   CALL  4544       

+3373 CA F5 32    ..2   JP    Z,32F5     

+3376 F5          .     PUSH  AF         

+3377 ED 5B D4 41 .[.A  LD    DE,(41D4)  

+337B 0B          .     DEC   BC         

+337C 7A          z     LD    A,D        

+337D BE          .     CP    (HL)       

+337E 38 05       8.    JR    C,3385     

+3380 7E          ~     LD    A,(HL)     

+3381 BB          .     CP    E          

+3382 D2 E3 32    ..2   JP    NC,32E3    

+3385 23          #     INC   HL         

+3386 78          x     LD    A,B        

+3387 B1          .     OR    C          

+3388 20 F1        .    JR    NZ,337B    

+338A F1          .     POP   AF         

+338B D2 F5 32    ..2   JP    NC,32F5    

+338E CD C1 45    ..E   CALL  45C1       

+3391 18 DD       ..    JR    3370       ;------------- stranalyze ---------

+3393 CD B8 43    ..C   CALL  43B8       ; REF-Addr vom Stack (HL,DE)

+3396 FD 21 89 46 .!.F  LD    IY,4689    

+339A FD 72 03    .r.   LD    (IY+03),D  ; Dataspace

+339D 7B          {     LD    A,E        ; Segment

+339E CD CA 44    ..D   CALL  44CA       ; Block holen HL = Speicheraddr

+33A1 CB 3C       .<    SLR   H          ; --> Wordaddr konvertieren

+33A3 CB 1D       ..    RR    L          

+33A5 22 DB 41    ".A   LD    (41DB),HL  ; Block 1 Wortaddr

+33A8 29          )     ADD   HL,HL      ; --> Byteaddr konv.

+33A9 11 FE 01    ...   LD    DE,01FE    ; Ende des Blocks auch lesen 

+33AC CD 0D 45    ..E   CALL  450D       ; (schlimmstenfalls also 2 Bloecke) 

+33AF CB 3C       .<    SLR   H          ; 2. Block Wortaddr

+33B1 CB 1D       ..    RR    L          

+33B3 22 DD 41    ".A   LD    (41DD),HL  ; Block 2 Wortaddr

+33B6 CD 64 43    .dC   CALL  4364       ; Addresse d.INT VAR summe holen 

+33B9 22 DF 41    ".A   LD    (41DF),HL  

+33BC CD A8 2C    ..,   CALL  2CA8       ; INT CONST maxbreite holen

+33BF 22 E1 41    ".A   LD    (41E1),HL  

+33C2 CD 8D 46    ..F   CALL  468D       ; TEXT CONST zeile holen

+33C5 E5          .     PUSH  HL         

+33C6 CD 64 43    .dC   CALL  4364       ; INT VAR pos holen

+33C9 E5          .     PUSH  HL         

+33CA CD A8 2C    ..,   CALL  2CA8       ; INT CONST to-pos holen

+33CD 7B          {     LD    A,E        

+33CE 95          .     SUB   L          

+33CF 7A          z     LD    A,D        ; falls to < from beide vertauschen

+33D0 9C          .     SBC   H          

+33D1 38 01       8.    JR    C,33D4     

+33D3 EB          .     EX    DE,HL      

+33D4 CD 64 43    .dC   CALL  4364       ; INT VAR exit addr holen 

+33D7 22 E3 41    ".A   LD    (41E3),HL  ; exit addresse

+33DA ED 43 D0 41 .C.A  LD    (41D0),BC  ; BC retten

+33DE 42          B     LD    B,D        ; BC := to pos

+33DF 4B          K     LD    C,E        

+33E0 E1          .     POP   HL         ; pos addresse

+33E1 22 CC 41    ".A   LD    (41CC),HL  

+33E4 5E          ^     LD    E,(HL)     ; poswert holen --> DE

+33E5 2C          ,     INC   L          

+33E6 56          V     LD    D,(HL)     

+33E7 E1          .     POP   HL         ; TEXT zeile

+33E8 CD 1D 46    ..F   CALL  461D       ; TEXT Zugriff

+33EB DA 56 34    .V4   JP    C,3456     ; Fehlerausgang

+33EE CD 44 45    .DE   CALL  4544       ; Zeichenaddr (Text SUB pos)--> HL

+33F1 CA 56 34    .V4   JP    Z,3456     ; Fehlerausgang, wenn > TEXT-Laenge

+33F4 F5          .     PUSH  AF         ; Flag (C) merken

+33F5 DD CB 07 5E ...^  BIT   3,(IX+07)  ; Extension-Bit (Skip next char) 

+33F9 20 4D        M    JR    NZ,3448    ; Res BIT 3 und �bernaechstes zeichen

+33FB 7E          ~     LD    A,(HL)     ; A = ROW-Offset (Code)

+33FC E5          .     PUSH  HL         

+33FD 2A DB 41    *.A   LD    HL,(41DB)  ; Block 1 Wortaddr

+3400 85          .     ADD   L          

+3401 30 03       0.    JR    NC,3406    

+3403 2A DD 41    *.A   LD    HL,(41DD)  ; Block 2 Wortaddr

+3406 6F          o     LD    L,A        

+3407 29          )     ADD   HL,HL      

+3408 5E          ^     LD    E,(HL)     ; DE := tabelle(A)

+3409 2C          ,     INC   L          

+340A 56          V     LD    D,(HL)     

+340B ED 53 CE 41 .S.A  LD    (41CE),DE  ; fuer exit merken

+340F CB 7A       .z    BIT   7,D        

+3411 28 06       (.    JR    Z,3419     ; < 0 : Extensionchar (Skip next)

+3413 CB BA       ..    RES   7,D        ; F�r Summierung positiv machen

+3415 DD CB 07 DE ....  SET   3,(IX+07)  ; merken, dass DE negativ war

+3419 2A DF 41    *.A   LD    HL,(41DF)  ; Addresse von 'summe'

+341C 7E          ~     LD    A,(HL)     ; DE INCR summe

+341D 83          .     ADD   E          

+3477 C3 06 2D    ..-   JP    2D06       ;---------- task heapsize ---------

+347A 3A CB 41    :.A   LD    A,(41CB)   ; heaptop DIV 4 +1

+347D CB 3F       .?    SLR   A          

+347F CB 3F       .?    SLR   A          

+3481 3C          <     INC   A          

+3482 5F          _     LD    E,A        

+3483 16 00       ..    LD    D,00       

+3485 C3 03 2D    ..-   JP    2D03       ;----------- collect heap garbage -

+3488 79          y     LD    A,C        ; pbase ?

+3489 08          .     EX    AF,AF'     

+348A C3 33 4A    .3J   JP    4A33       ;----------- replace int ---------

+348D 3E 01       >.    LD    A,01       ; 1 Wort

+348F 18 02       ..    JR    3493       ;----------- replace real -------

+3491 3E 07       >.    LD    A,07       ; 7 Woerter

+3493 32 D2 41    2.A   LD    (41D2),A   

+3496 CD AA 47    ..G   CALL  47AA       

+3499 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+349D 18 0C       ..    JR    34AB       ;-------------- ISUB -------------

+349F 3E 01       >.    LD    A,01       

+34A1 18 02       ..    JR    34A5       ;------------- RSUB --------------

+34A3 3E 07       >.    LD    A,07       

+34A5 32 D2 41    2.A   LD    (41D2),A   

+34A8 CD 8D 46    ..F   CALL  468D       

+34AB E5          .     PUSH  HL         

+34AC CD A8 2C    ..,   CALL  2CA8       

+34AF 2B          +     DEC   HL         

+34B0 CB 7C       .|    BIT   7,H        

+34B2 C4 D9 3C    ..<   CALL  NZ,3CD9    

+34B5 29          )     ADD   HL,HL      

+34B6 3A D2 41    :.A   LD    A,(41D2)   

+34B9 FE 01       ..    CP    01         

+34BB 28 02       (.    JR    Z,34BF     

+34BD 29          )     ADD   HL,HL      

+34BE 29          )     ADD   HL,HL      

+34BF B5          .     OR    L          

+34C0 93          .     SUB   E          

+34C1 7C          |     LD    A,H        

+34C2 9A          .     SBC   D          

+34C3 D4 D9 3C    ..<   CALL  NC,3CD9    

+34C6 EB          .     EX    DE,HL      

+34C7 E1          .     POP   HL         

+34C8 CD 0D 45    ..E   CALL  450D       

+34CB EB          .     EX    DE,HL      

+34CC FD CB 00 46 ...F  BIT   0,(IY+00)  

+34D0 28 06       (.    JR    Z,34D8     

+34D2 CD 64 43    .dC   CALL  4364       

+34D5 EB          .     EX    DE,HL      

+34D6 18 03       ..    JR    34DB       

+34D8 CD 13 43    ..C   CALL  4313       

+34DB C5          .     PUSH  BC         

+34DC 3A D2 41    :.A   LD    A,(41D2)   

+34DF 47          G     LD    B,A        

+34E0 4F          O     LD    C,A        

+34E1 D5          .     PUSH  DE         

+34E2 11 F3 41    ..A   LD    DE,41F3    

+34E5 7E          ~     LD    A,(HL)     

+34E6 12          .     LD    (DE),A     

+34E7 2C          ,     INC   L          

+34E8 CC 1B 45    ..E   CALL  Z,451B     

+34EB 13          .     INC   DE         

+34EC 10 F7       ..    DJNZ  34E5       

+34EE 7E          ~     LD    A,(HL)     

+34EF 12          .     LD    (DE),A     

+34F0 E1          .     POP   HL         

+34F1 11 F3 41    ..A   LD    DE,41F3    

+34F4 41          A     LD    B,C        

+34F5 1A          .     LD    A,(DE)     

+34F6 77          w     LD    (HL),A     

+34F7 2C          ,     INC   L          

+34F8 CC 1B 45    ..E   CALL  Z,451B     

+34FB 13          .     INC   DE         

+34FC 10 F7       ..    DJNZ  34F5       

+34FE 1A          .     LD    A,(DE)     

+34FF 77          w     LD    (HL),A     

+3500 C1          .     POP   BC         

+3501 C3 A7 2A    ..*   JP    2AA7       ;----------- FMOV MOV8 ------------

+3504 CD 1B 43    ..C   CALL  431B       

+3507 7D          }     LD    A,L        

+3508 E6 F8       ..    AND   F8         

+350A 5F          _     LD    E,A        

+350B 54          T     LD    D,H        

+350C CD 64 43    .dC   CALL  4364       

+350F 7D          }     LD    A,L        

+3510 E6 F8       ..    AND   F8         

+3512 6F          o     LD    L,A        

+3513 EB          .     EX    DE,HL      

+3514 C5          .     PUSH  BC         

+3515 01 08 00    ...   LD    BC,0008    

+3518 F3          .     DI               

+3519 ED B0       ..    LDIR             

+351B FB          .     EI               

+351C C1          .     POP   BC         

+351D C3 A7 2A    ..*   JP    2AA7       ;-------------- FADD --------------

+3520 FD 21 2C 4F .!,O  LD    IY,4F2C    

+3524 CD AF 44    ..D   CALL  44AF       

+3527 EB          .     EX    DE,HL      

+3528 CD A7 44    ..D   CALL  44A7       

+352B CD 60 4E    .`N   CALL  4E60       

+352E 30 DC       0.    JR    NC,350C    

+3530 3E 06       >.    LD    A,06       

+3532 CD 0D 3D    ..=   CALL  3D0D       

+3535 CD 43 44    .CD   CALL  4443       

+3538 C3 A7 2A    ..*   JP    2AA7       ;------------- FSUB ---------------

+353B FD 21 20 4F .! O  LD    IY,4F20    

+353F 18 E3       ..    JR    3524       ;------------- FMULT --------------

+3541 FD 21 E1 4F .!.O  LD    IY,4FE1    

+3545 18 DD       ..    JR    3524       ;------------ FDIV ----------------

+3547 FD 21 59 50 .!YP  LD    IY,5059    

+354B 18 D7       ..    JR    3524       ;------------ FEQU --------------

+354D CD A7 44    ..D   CALL  44A7       

+3550 EB          .     EX    DE,HL      

+3551 CD A7 44    ..D   CALL  44A7       

+3554 CD 83 4E    ..N   CALL  4E83       

+3557 C2 84 2E    ...   JP    NZ,2E84    

+355A C3 71 2E    .q.   JP    2E71       ;----------- FLSEQ ----------------

+355D CD AF 44    ..D   CALL  44AF       

+3560 EB          .     EX    DE,HL      

+3561 CD A7 44    ..D   CALL  44A7       

+3564 EB          .     EX    DE,HL      

+3565 CD 83 4E    ..N   CALL  4E83       

+3568 DA 84 2E    ...   JP    C,2E84     

+356B C3 71 2E    .q.   JP    2E71       ;------------ FCOMPL -------------

+356E CD A7 44    ..D   CALL  44A7       

+3571 EB          .     EX    DE,HL      

+3572 CD B7 44    ..D   CALL  44B7       

+3575 EB          .     EX    DE,HL      

+3576 CD D2 4E    ..N   CALL  4ED2       

+3579 C3 A7 2A    ..*   JP    2AA7       ;--------------- SLD --------------

+357C CD 13 43    ..C   CALL  4313       

+357F 56          V     LD    D,(HL)     

+3580 CD B7 44    ..D   CALL  44B7       

+3583 E5          .     PUSH  HL         

+3584 CD 64 43    .dC   CALL  4364       

+3587 E3          .     EX    (SP),HL    

+3588 97          .     SUB   A          

+3589 ED 67       .g    RRD              

+358B 5F          _     LD    E,A        

+358C 7A          z     LD    A,D        

+358D CD 1B 52    ..R   CALL  521B       

+3590 E1          .     POP   HL         

+3591 73          s     LD    (HL),E     

+3592 2C          ,     INC   L          

+3593 36 00       6.    LD    (HL),00    

+3595 C3 A7 2A    ..*   JP    2AA7       ;------------ decimalexponent ------

+3598 CD A7 44    ..D   CALL  44A7       

+359B CD E9 4E    ..N   CALL  4EE9       

+359E C3 03 2D    ..-   JP    2D03       ;------------ setexp --------------

+35A1 CD 13 43    ..C   CALL  4313       

+35A4 5E          ^     LD    E,(HL)     

+35A5 CD B7 44    ..D   CALL  44B7       

+35A8 CD E0 4E    ..N   CALL  4EE0       

+35AB C3 A7 2A    ..*   JP    2AA7       ;------------- floor --------------

+35AE CD A7 44    ..D   CALL  44A7       

+35B1 EB          .     EX    DE,HL      

+35B2 CD B7 44    ..D   CALL  44B7       

+35B5 EB          .     EX    DE,HL      

+35B6 CD F6 4E    ..N   CALL  4EF6       

+35B9 C3 A7 2A    ..*   JP    2AA7       ;------------ clock (nr) ----------

+35BC CD 13 43    ..C   CALL  4313       

+35BF 7E          ~     LD    A,(HL)     

+35C0 E6 07       ..    AND   07         

+35C2 28 0F       (.    JR    Z,35D3     ; clock(0) = Taskclock

+35C4 3D          =     DEC   A          ; -1

+35C5 87          .     ADD   A          ; *8 (REAL)

+35C6 87          .     ADD   A          

+35C7 87          .     ADD   A          

+35C8 6F          o     LD    L,A        

+35C9 26 00       &.    LD    H,00       

+35CB 11 B9 4C    ..L   LD    DE,4CB9    ; 4CB9 = clock (1)

+35CE 19          .     ADD   HL,DE      

+35CF EB          .     EX    DE,HL      

+35D0 C3 0C 35    ..5   JP    350C       ; Move Real

+35D3 ED 5B 1C 6E .[.n  LD    DE,(6E1C)  ; Steht im Leitblock ab 38..3f

+35D7 1E 38       .8    LD    E,38       ; Move real

+35D9 C3 0C 35    ..5   JP    350C       ;------------ clock (task) --------

+35DC CD C2 3D    ..=   CALL  3DC2       ; Fremden Leitblock laden

+35DF FD E5       ..    PUSH  IY         ; Leitblock addr in IY

+35E1 D1          .     POP   DE         

+35E2 18 F3       ..    JR    35D7       ;----------- setclock task -------

+35E4 CD BA 3D    ..=   CALL  3DBA       

+35E7 CD 13 43    ..C   CALL  4313       

+35EA FD E5       ..    PUSH  IY         

+35EC D1          .     POP   DE         

+35ED 1E 38       .8    LD    E,38       ; Move Real

+35EF C3 14 35    ..5   JP    3514       ;---------- setclock -------------

+35F2 DD 7E 1D    .~.   LD    A,(IX+1D)  ; priv >= 1

+35F5 FE 01       ..    CP    01         

+35F7 DA E6 3C    ..<   JP    C,3CE6     ; privilegierungsfehler

+35FA CD A7 44    ..D   CALL  44A7       ; 

+35FD 11 B9 4C    ..L   LD    DE,4CB9    

+3600 C3 14 35    ..5   JP    3514       ;------------ ACCDS ---------------

+3603 CD 1B 43    ..C   CALL  431B       

+3606 CD 11 36    ..6   CALL  3611       ; Test ob DSID > 4

+3609 1E 00       ..    LD    E,00       ; REF-Addr D=DSID, E=0

+360B D5          .     PUSH  DE         

+360C 21 04 01    !..   LD    HL,0104    ; Wortaddresse 4 in Seite 1 i. Start

+360F 18 23       .#    JR    3634       ;------------ DSID > 4 ? ----------

+3611 56          V     LD    D,(HL)     

+3612 3E 04       >.    LD    A,04       

+3614 BA          .     CP    D          

+3615 D2 82 38    ..8   JP    NC,3882    ; falscher DATASPACE Zugriff

+3618 2C          ,     INC   L          

+3619 7E          ~     LD    A,(HL)     

+361A DD BE 30    ..0   CP    (IX+30)    

+361D C2 82 38    ..8   JP    NZ,3882    

+3620 C9          .     RET              ;-------------- REF ---------------

+3621 CD C0 43    ..C   CALL  43C0       ; Wortaddr holen

+3624 D5          .     PUSH  DE         ; Zweiwortaddr auf Stack

+3625 18 0D       ..    JR    3634       ;-------------- SEL ---------------

+3627 CD C0 43    ..C   CALL  43C0       

+362A D5          .     PUSH  DE         

+362B CD 43 44    .CD   CALL  4443       ; Offset holen

+362E 19          .     ADD   HL,DE      ; REF:=Base+Offset

+362F 30 03       0.    JR    NC,3634    

+3631 D1          .     POP   DE         

+3632 1C          .     INC   E          

+3633 D5          .     PUSH  DE         

+3634 EB          .     EX    DE,HL      ;---------- REF-Adr auf Stack -----

+3635 CD 64 43    .dC   CALL  4364       

+3638 73          s     LD    (HL),E     ; 4 Bytes auf Stack

+3639 2C          ,     INC   L          

+363A 72          r     LD    (HL),D     

+363B 2C          ,     INC   L          

+363C D1          .     POP   DE         

+363D 73          s     LD    (HL),E     

+363E 2C          ,     INC   L          

+363F 72          r     LD    (HL),D     

+3640 C3 A7 2A    ..*   JP    2AA7       ;------------- SUBS ---------------

+3643 67          g     LD    H,A        

+3644 E5          .     PUSH  HL         

+3645 CD 43 44    .CD   CALL  4443

+3648 CD 13 43    ..C   CALL  4313       

+364B 7E          ~     LD    A,(HL)     

+364C 2C          ,     INC   L          

+364D 66          f     LD    H,(HL)     

+364E 6F          o     LD    L,A        

+364F 2B          +     DEC   HL         

+3650 7B          {     LD    A,E        

+3651 95          .     SUB   L          

+3652 7A          z     LD    A,D        

+3653 9C          .     SBC   H          

+3654 DC D9 3C    ..<   CALL  C,3CD9     

+3657 EB          .     EX    DE,HL      

+3658 E1          .     POP   HL         

+3659 CD 6D 4D    .mM   CALL  4D6D       

+365C DC D9 3C    ..<   CALL  C,3CD9     

+365F E5          .     PUSH  HL         

+3660 F5          .     PUSH  AF         

+3661 CD B8 43    ..C   CALL  43B8       

+3664 F1          .     POP   AF         

+3665 83          .     ADD   E          

+3666 5F          _     LD    E,A        

+3667 EB          .     EX    DE,HL      

+3668 E3          .     EX    (SP),HL    

+3669 19          .     ADD   HL,DE      

+366A 30 C8       0.    JR    NC,3634    ; REF-Adr auf Stack

+366C 18 C3       ..    JR    3631       ;------------ EQUIM --------------

+366E EB          .     EX    DE,HL      

+366F CD 13 43    ..C   CALL  4313       

+3672 7E          ~     LD    A,(HL)     

+3673 BB          .     CP    E          

+3674 C2 84 2E    ...   JP    NZ,2E84    ; Lowbyte vergleichen

+3677 2C          ,     INC   L          

+3678 7E          ~     LD    A,(HL)     ; Highbyte muss 0 sein

+3679 B7          .     OR    A          

+367A C2 84 2E    ...   JP    NZ,2E84    

+367D C3 71 2E    .q.   JP    2E71       ;-------------- STIM -------------

+3680 EB          .     EX    DE,HL      

+3681 16 00       ..    LD    D,00       ; Lowbyte uebernehmen, Highbyte 0

+3683 C3 03 2D    ..-   JP    2D03       ;-------------- MOVEXX -----------

+3686 CD 43 44    .CD   CALL  4443       ; langer move

+3689 D5          .     PUSH  DE         

+368A 18 03       ..    JR    368F       ;-------------- MOVX -------------

+368C 26 00       &.    LD    H,00       ; Highbyte 0

+368E E5          .     PUSH  HL         

+368F CD B8 43    ..C   CALL  43B8       ; laenge holen

+3692 FD 21 85 46 .!.F  LD    IY,4685    

+3696 FD 36 00 01 .6..  LD    (IY+00),01 

+369A FD 72 03    .r.   LD    (IY+03),D  

+369D 7B          {     LD    A,E        

+369E CD CA 44    ..D   CALL  44CA       ; from addr holen

+36A1 E5          .     PUSH  HL         

+36A2 CD B8 43    ..C   CALL  43B8       

+36A5 FD 21 89 46 .!.F  LD    IY,4689    

+36A9 FD 36 00 00 .6..  LD    (IY+00),00 

+36AD FD 72 03    .r.   LD    (IY+03),D  

+36B0 7B          {     LD    A,E        

+36B1 CD CA 44    ..D   CALL  44CA       

+36B4 EB          .     EX    DE,HL      

+36B5 E1          .     POP   HL         

+36B6 ED 43 D0 41 .C.A  LD    (41D0),BC  

+36BA C1          .     POP   BC         

+36BB CB 21       .!    SLA   C          ; Laenge * 2 in Bytes

+36BD CB 10       ..    RL    B          

+36BF CD B0 2C    ..,   CALL  2CB0       

+36C2 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+36C6 C3 A7 2A    ..*   JP    2AA7       ;--------------- GW --------------

+36C9 CD F9 36    ..6   CALL  36F9       ; segment und oofset

+36CC CD 4D 44    .MD   CALL  444D       ; Wert auf Stack

+36CF C3 00 2D    ..-   JP    2D00       ;-------------- PW ---------------

+36D2 CD F9 36    ..6   CALL  36F9       ; segment und offset

+36D5 CD 7D 44    .}D   CALL  447D       

+36D8 EB          .     EX    DE,HL      

+36D9 CD 13 43    ..C   CALL  4313       

+36DC 7E          ~     LD    A,(HL)     

+36DD 12          .     LD    (DE),A     ; segment veraendern

+36DE 2C          ,     INC   L          

+36DF 1C          .     INC   E          

+36E0 7E          ~     LD    A,(HL)     

+36E1 12          .     LD    (DE),A     

+36E2 C3 A7 2A    ..*   JP    2AA7       ;----------- getword ------------- 

+36E5 CD 13 43    ..C   CALL  4313       ; segment (Nur ein Byte)

+36E8 5E          ^     LD    E,(HL)     

+36E9 CD A8 2C    ..,   CALL  2CA8       ; wortaddr --> HL

+36EC 7B          {     LD    A,E        ; Seg in A, addr in HL, Wert a.Stack

+36ED 18 DD       ..    JR    36CC       ;------------ putword ------------

+36EF CD 13 43    ..C   CALL  4313       

+36F2 5E          ^     LD    E,(HL)     ; segment (nur ein byte)

+36F3 CD A8 2C    ..,   CALL  2CA8       

+36F6 7B          {     LD    A,E        ; Segment 

+36F7 18 DC       ..    JR    36D5       ;--------------------------------

+36F9 5D          ]     LD    E,L        ; L ist Opcode Byte m. Seg und Offse

+36FA CD 13 43    ..C   CALL  4313       

+36FD 7B          {     LD    A,E        

+36FE 5E          ^     LD    E,(HL)     ; Wortaddr holen

+36FF 2C          ,     INC   L          

+3700 56          V     LD    D,(HL)     

+3701 67          g     LD    H,A        

+3702 E6 0F       ..    AND   0F         ; Low digit = Offset zu Wortaddr

+3704 6F          o     LD    L,A        

+3705 AC          .     XOR   H          ; Low DIgit in A = 0

+3706 26 00       &.    LD    H,00       

+3708 19          .     ADD   HL,DE      

+3709 0F          .     RRCA             ; A 0 Segment

+370A 0F          .     RRCA             

+370B 0F          .     RRCA             

+370C 0F          .     RRCA             

+370D C9          .     RET              ;------------- KE ----------------

+370E CD 2A 6F    .*o   CALL  6F2A       ; Info " KE"

+3711 C3 A7 2A    ..*   JP    2AA7       ;-------------- SYSGEN ------------

+3714 CD 05 53    ..S   CALL  5305       ; RET, Keine Aktion

+3717 C3 A7 2A    ..*   JP    2AA7       ;--------------- cout ------------

+371A CD 13 43    ..C   CALL  4313       ; INT holen

+371D 5E          ^     LD    E,(HL)     

+371E 2C          ,     INC   L          

+371F 56          V     LD    D,(HL)     

+3720 C5          .     PUSH  BC         

+3721 CB 7A       .z    BIT   7,D        

+3723 20 34        4    JR    NZ,3759    

+3725 DD 7E 26    .~&   LD    A,(IX+26)  ; Am Kanal ?

+3728 B7          .     OR    A          

+3729 28 2E       (.    JR    Z,3759     ; Nur fuer positive Zahlen

+372B CD 59 1E    .Y.   CALL  1E59       

+372E FE 1E       ..    CP    1E         ; Kanal genuegend frei

+3730 38 27       8'    JR    C,3759     

+3732 21 20 20    !     LD    HL,2020    

+3735 22 E9 41    ".A   LD    (41E9),HL  

+3738 22 EB 41    ".A   LD    (41EB),HL  ; Puffer loeschen

+373B 21 E8 41    !.A   LD    HL,41E8    

+373E CD 00 4E    ..N   CALL  4E00       ; Konvertieren

+3741 21 E7 41    !.A   LD    HL,41E7    

+3744 01 0C 00    ...   LD    BC,000C    ; Stringlaenge 12

+3747 59          Y     LD    E,C        

+3748 DD 7E 26    .~&   LD    A,(IX+26)  ; immer noch frei ?

+374B B7          .     OR    A          

+374C 28 0B       (.    JR    Z,3759     

+374E CD 88 21    ..!   CALL  2188       ; OUTPUT

+3751 38 06       8.    JR    C,3759     

+3753 09          .     ADD   HL,BC      

+3754 7B          {     LD    A,E        

+3755 91          .     SUB   C          

+3756 4F          O     LD    C,A        

+3757 18 EE       ..    JR    3747       

+3759 C1          .     POP   BC         

+375A C3 A7 2A    ..*   JP    2AA7       ;------------ outsubtext 1 --------

+375D CD 89 47    ..G   CALL  4789       

+3760 18 08       ..    JR    376A       ;------------ outsubtext 2 --------

+3762 CD 95 47    ..G   CALL  4795       

+3765 18 03       ..    JR    376A       ;--------------- out --------------

+3767 CD 8D 46    ..F   CALL  468D       

+376A C5          .     PUSH  BC         

+376B 42          B     LD    B,D        

+376C 4B          K     LD    C,E        

+376D CD 44 45    .DE   CALL  4544       

+3770 28 16       (.    JR    Z,3788     

+3772 F5          .     PUSH  AF         

+3773 50          P     LD    D,B        

+3774 59          Y     LD    E,C        

+3775 DD 7E 26    .~&   LD    A,(IX+26)  

+3778 B7          .     OR    A          

+3779 28 11       (.    JR    Z,378C     

+377B CD 88 21    ..!   CALL  2188       ; OUTPUT

+377E 30 0F       0.    JR    NC,378F    

+3780 F1          .     POP   AF         

+3781 30 05       0.    JR    NC,3788    

+3783 CD C1 45    ..E   CALL  45C1       

+3786 18 E5       ..    JR    376D       

+3788 C1          .     POP   BC         

+3789 C3 A7 2A    ..*   JP    2AA7       

+378C 01 00 00    ...   LD    BC,0000    

+378F F1          .     POP   AF         

+3790 7B          {     LD    A,E        

+3791 91          .     SUB   C          

+3792 4F          O     LD    C,A        

+3793 7A          z     LD    A,D        

+3794 98          .     SBC   B          

+3795 47          G     LD    B,A        

+3796 CD F1 45    ..E   CALL  45F1       

+3799 3E 44       >D    LD    A,44       

+379B C3 23 29    .#)   JP    2923       ;-------------- inchar ------------

+379E CD 64 43    .dC   CALL  4364       

+37A1 2C          ,     INC   L          

+37A2 2C          ,     INC   L          

+37A3 DD 7E 26    .~&   LD    A,(IX+26)  ; AM Kanal ?

+37A6 B7          .     OR    A          

+37A7 28 05       (.    JR    Z,37AE     

+37A9 CD 06 1F    ...   CALL  1F06       ; incharety 

+37AC 30 05       0.    JR    NC,37B3    

+37AE 3E 48       >H    LD    A,48       ; Status: Auf Taste warten

+37B0 C3 23 29    .#)   JP    2923       

+37B3 36 01       6.    LD    (HL),01    ; Text der laenge 1

+37B5 2C          ,     INC   L          

+37B6 77          w     LD    (HL),A     

+37B7 CD 29 4C    .)L   CALL  4C29       

+37BA C3 A7 2A    ..*   JP    2AA7       ;------------- incharety ---------

+37BD CD 64 43    .dC   CALL  4364       

+37C0 2C          ,     INC   L          

+37C1 2C          ,     INC   L          

+37C2 DD 7E 26    .~&   LD    A,(IX+26)  

+37C5 B7          .     OR    A          

+37C6 28 05       (.    JR    Z,37CD     

+37C8 CD 06 1F    ...   CALL  1F06       

+37CB 30 E6       0.    JR    NC,37B3    ; Text der laenge 1

+37CD 97          .     SUB   A          ; Niltext

+37CE 77          w     LD    (HL),A     

+37CF 2C          ,     INC   L          

+37D0 77          w     LD    (HL),A     

+37D1 C3 A7 2A    ..*   JP    2AA7       ;-------------- pause ------------

+37D4 CD A8 2C    ..,   CALL  2CA8       

+37D7 DD 7E 26    .~&   LD    A,(IX+26)  

+37DA B7          .     OR    A          

+37DB 28 06       (.    JR    Z,37E3     

+37DD CD AD 1E    ...   CALL  1EAD       ; Taste gedrueckt ?

+37E0 D2 A7 2A    ..*   JP    NC,2AA7    

+37E3 ED 5B F1 4C .[.L  LD    DE,(4CF1)  

+37E7 19          .     ADD   HL,DE      

+37E8 DD 75 0C    .u.   LD    (IX+0C),L  ; modi := time

+37EB DD 74 0D    .t.   LD    (IX+0D),H  

+37EE 79          y     LD    A,C        

+37EF 08          .     EX    AF,AF'     

+37F0 3E 4C       >L    LD    A,4C       ; Status: pause

+37F2 C3 23 29    .#)   JP    2923       ;------------ getcursor -----------

+37F5 C5          .     PUSH  BC         

+37F6 DD 7E 26    .~&   LD    A,(IX+26)  

+37F9 B7          .     OR    A          

+37FA C4 85 1E    ...   CALL  NZ,1E85    ; getcursor --> BC

+37FD 59          Y     LD    E,C        

+37FE 50          P     LD    D,B        

+37FF C1          .     POP   BC         ; icount

+3800 DA 26 29    .&)   JP    C,2926     

+3803 1C          .     INC   E          ; x+1 , y+1

+3804 14          .     INC   D          

+3805 CD 64 43    .dC   CALL  4364       ; Zwei Werte (wie REF-Adr) auf Stack

+3808 72          r     LD    (HL),D     ; Beide Highbytes 0

+3809 16 00       ..    LD    D,00       

+380B 2C          ,     INC   L          

+380C 72          r     LD    (HL),D     

+380D C3 03 2D    ..-   JP    2D03       ;------------ catinput ------------

+3810 CD B8 43    ..C   CALL  43B8       

+3813 E5          .     PUSH  HL         

+3814 D5          .     PUSH  DE         

+3815 CD 64 43    .dC   CALL  4364       

+3818 2C          ,     INC   L          

+3819 2C          ,     INC   L          

+381A 22 CC 41    ".A   LD    (41CC),HL  

+381D 97          .     SUB   A          

+381E 77          w     LD    (HL),A     

+381F 2C          ,     INC   L          

+3820 77          w     LD    (HL),A     

+3821 DD 7E 26    .~&   LD    A,(IX+26)  

+3824 B7          .     OR    A          

+3825 28 44       (D    JR    Z,386B     

+3827 D1          .     POP   DE         

+3828 E1          .     POP   HL         

+3829 E5          .     PUSH  HL         

+382A D5          .     PUSH  DE         

+382B CD AD 47    ..G   CALL  47AD       

+382E ED 53 40 4B .S@K  LD    (4B40),DE  

+3832 D5          .     PUSH  DE         

+3833 13          .     INC   DE         

+3834 CD AD 48    ..H   CALL  48AD       

+3837 D1          .     POP   DE         

+3838 38 2A       8*    JR    C,3864     

+383A CD 1D 4A    ..J   CALL  4A1D       

+383D CD 0D 45    ..E   CALL  450D       

+3840 DD 7E 26    .~&   LD    A,(IX+26)  

+3843 CD 06 1F    ...   CALL  1F06       ; incharety

+3846 38 1C       8.    JR    C,3864     

+3848 FE 20       .     CP    20         

+384A 38 11       8.    JR    C,385D     ; < Blank ?

+384C 77          w     LD    (HL),A     

+384D 13          .     INC   DE         

+384E 2C          ,     INC   L          

+384F 7D          }     LD    A,L        ; alle 8 Zeichen unterbrechen

+3850 E6 07       ..    AND   07         

+3852 20 EC        .    JR    NZ,3840    

+3854 CD 92 48    ..H   CALL  4892       

+3857 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+385B 18 CA       ..    JR    3827       ; nochmal von vorne

+385D 2A CC 41    *.A   LD    HL,(41CC)  

+3860 36 01       6.    LD    (HL),01    ; Text der Laenge 1 = escchar

+3862 2C          ,     INC   L          

+3863 77          w     LD    (HL),A     

+3864 CD 92 48    ..H   CALL  4892       ; Kein Zeichen mehr: CAT...

+3867 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+386B D1          .     POP   DE         

+386C E1          .     POP   HL         

+386D C3 A7 2A    ..*   JP    2AA7       ;------ korrekte DSID in HL ?-----

+3870 DD 7E 30    .~0   LD    A,(IX+30)  ; eigener Taskindex

+3873 BC          .     CP    H          

+3874 20 0C        .    JR    NZ,3882    

+3876 7D          }     LD    A,L        ; DSnr > 4

+3877 FE 05       ..    CP    05         

+3879 38 07       8.    JR    C,3882     

+387B C5          .     PUSH  BC         

+387C 4D          M     LD    C,L        ; exists (ds) ?

+387D CD 77 69    .wi   CALL  6977       

+3880 C1          .     POP   BC         

+3881 D0          .     RET   NC         

+3882 3E 0B       >.    LD    A,0B       ; alias error

+3884 CD 0D 3D    ..=   CALL  3D0D       

+3887 21 05 00    !..   LD    HL,0005    ; Errorspace mit eienem Index

+388A 55          U     LD    D,L        

+388B 37          7     SCF              

+388C C9          .     RET              ;---------------------------------

+388D 55          U     LD    D,L        

+388E 1E 00       ..    LD    E,00       

+3890 21 02 01    !..   LD    HL,0102    

+3893 CD 5C 65    .\e   CALL  655C       

+3896 0F          .     RRCA             

+3897 67          g     LD    H,A        

+3898 29          )     ADD   HL,HL      

+3899 C9          .     RET              ;------------ ALIAS --------------

+389A CD 43 44    .CD   CALL  4443       ; DSID holen

+389D 21 0B 01    !..   LD    HL,010B    

+38A0 19          .     ADD   HL,DE      

+38A1 38 0A       8.    JR    C,38AD     

+38A3 7D          }     LD    A,L        

+38A4 E6 F8       ..    AND   F8         

+38A6 6F          o     LD    L,A        

+38A7 29          )     ADD   HL,HL      

+38A8 30 01       0.    JR    NC,38AB    

+38AA 2C          ,     INC   L          

+38AB 18 03       ..    JR    38B0       

+38AD 21 04 00    !..   LD    HL,0004    

+38B0 22 CC 41    ".A   LD    (41CC),HL  

+38B3 CD A8 2C    ..,   CALL  2CA8       

+38B6 CD 70 38    .p8   CALL  3870       

+38B9 E5          .     PUSH  HL         

+38BA CD 8D 38    ..8   CALL  388D       

+38BD 2D          -     DEC   L          

+38BE 2D          -     DEC   L          

+38BF 7E          ~     LD    A,(HL)     

+38C0 3C          <     INC   A          

+38C1 20 1E        .    JR    NZ,38E1    

+38C3 21 00 01    !..   LD    HL,0100    

+38C6 CD 2C 66    .,f   CALL  662C       

+38C9 0F          .     RRCA             

+38CA 67          g     LD    H,A        

+38CB 29          )     ADD   HL,HL      

+38CC ED 5B CC 41 .[.A  LD    DE,(41CC)  ; Liefert REF-Addr

+38D0 73          s     LD    (HL),E     

+38D1 2C          ,     INC   L          

+38D2 72          r     LD    (HL),D     

+38D3 2C          ,     INC   L          

+38D4 73          s     LD    (HL),E     

+38D5 2C          ,     INC   L          

+38D6 72          r     LD    (HL),D     

+38D7 2C          ,     INC   L          

+38D8 CB 7E       .~    BIT   7,(HL)     

+38DA 28 05       (.    JR    Z,38E1     

+38DC 36 00       6.    LD    (HL),00    

+38DE 2C          ,     INC   L          

+38DF 36 00       6.    LD    (HL),00    

+38E1 D1          .     POP   DE         

+38E2 C3 03 2D    ..-   JP    2D03       ;---------- nilspace -------------

+38E5 11 00 00    ...   LD    DE,0000    

+38E8 C3 03 2D    ..-   JP    2D03       ;----------- dscopy := -----------

+38EB CD 64 43    .dC   CALL  4364       ; dest adr holen

+38EE E5          .     PUSH  HL         

+38EF CD A8 2C    ..,   CALL  2CA8       

+38F2 7C          |     LD    A,H        

+38F3 B5          .     OR    L          

+38F4 C4 70 38    .p8   CALL  NZ,3870    ; source <> nilspace

+38F7 EB          .     EX    DE,HL      

+38F8 38 0F       8.    JR    C,3909     

+38FA C5          .     PUSH  BC         

+38FB DD 46 30    .F0   LD    B,(IX+30)  ; eigener taskindex

+38FE 4B          K     LD    C,E        

+38FF 50          P     LD    D,B        

+3900 CD E8 68    ..h   CALL  68E8       ; 

+3903 C1          .     POP   BC         

+3904 1C          .     INC   E          ; Anzahl Dataspaces

+3905 1D          .     DEC   E          

+3906 CC 10 39    ..9   CALL  Z,3910     ; errorstop durhfuehren als SBRT.

+3909 E1          .     POP   HL         

+390A 73          s     LD    (HL),E     

+390B 2C          ,     INC   L          

+390C 72          r     LD    (HL),D     

+390D C3 A7 2A    ..*   JP    2AA7       

+3910 3E 08       >.    LD    A,08       ; errorstop zuviele DS

+3912 CD 0D 3D    ..=   CALL  3D0D       

+3915 11 05 00    ...   LD    DE,0005    ; result ist errorspace

+3918 C9          .     RET              ;------------- forget ------------

+3919 CD 64 43    .dC   CALL  4364       

+391C C5          .     PUSH  BC         

+391D 5E          ^     LD    E,(HL)     

+391E 2C          ,     INC   L          

+391F 56          V     LD    D,(HL)     

+3920 EB          .     EX    DE,HL      

+3921 3E 05       >.    LD    A,05       ; Nur ds > 4 loeschen

+3923 BD          .     CP    L          

+3924 30 17       0.    JR    NC,393D    

+3926 CB 7C       .|    BIT   7,H        

+3928 28 06       (.    JR    Z,3930     

+392A 7D          }     LD    A,L        

+392B 84          .     ADD   H          

+392C 20 0F        .    JR    NZ,393D    

+392E 18 06       ..    JR    3936       

+3930 DD 7E 30    .~0   LD    A,(IX+30)  

+3933 BC          .     CP    H          

+3934 20 07        .    JR    NZ,393D    

+3936 4D          M     LD    C,L        

+3937 CD 77 69    .wi   CALL  6977       

+393A D4 97 69    ..i   CALL  NC,6997    

+393D EB          .     EX    DE,HL      

+393E 36 00       6.    LD    (HL),00    ; ergebnis 01 DS

+3940 2D          -     DEC   L          

+3941 36 01       6.    LD    (HL),01    

+3943 C1          .     POP   BC         

+3944 C3 A7 2A    ..*   JP    2AA7       ;------------- settype -----------

+3947 CD A8 2C    ..,   CALL  2CA8       

+394A EB          .     EX    DE,HL      

+394B CD A8 2C    ..,   CALL  2CA8       

+394E EB          .     EX    DE,HL      

+394F CD 70 38    .p8   CALL  3870       

+3952 38 11       8.    JR    C,3965     

+3954 D5          .     PUSH  DE         

+3955 55          U     LD    D,L        

+3956 1E 00       ..    LD    E,00       

+3958 21 02 01    !..   LD    HL,0102    

+395B CD 2C 66    .,f   CALL  662C       

+395E 0F          .     RRCA             

+395F 67          g     LD    H,A        

+3960 29          )     ADD   HL,HL      

+3961 D1          .     POP   DE         

+3962 73          s     LD    (HL),E     ; type im ds ersetzen

+3963 2C          ,     INC   L          

+3964 72          r     LD    (HL),D     

+3965 C3 A7 2A    ..*   JP    2AA7       ;------------- gettype ------------

+3968 CD A8 2C    ..,   CALL  2CA8       

+396B CD 70 38    .p8   CALL  3870       

+396E 38 06       8.    JR    C,3976     

+3970 CD 8D 38    ..8   CALL  388D       

+3973 5E          ^     LD    E,(HL)     

+3974 2C          ,     INC   L          

+3975 56          V     LD    D,(HL)     

+3976 C3 03 2D    ..-   JP    2D03       ;------------ heapsize ------------

+3979 CD A8 2C    ..,   CALL  2CA8       

+397C CD 70 38    .p8   CALL  3870       

+397F 38 F5       8.    JR    C,3976     

+3981 CD 8D 38    ..8   CALL  388D       

+3984 2E 00       ..    LD    L,00       

+3986 7E          ~     LD    A,(HL)     

+3987 E6 0F       ..    AND   0F         

+3989 2C          ,     INC   L          

+398A 5E          ^     LD    E,(HL)     

+398B 0F          .     RRCA             

+398C CB 1B       ..    RR    E          

+398E 0F          .     RRCA             

+398F CB 1B       ..    RR    E          

+3991 E6 03       ..    AND   03         

+3993 57          W     LD    D,A        

+3994 C3 03 2D    ..-   JP    2D03       ;------------ pages task ----------

+3997 CD 13 43    ..C   CALL  4313       

+399A 5E          ^     LD    E,(HL)     

+399B CD 13 43    ..C   CALL  4313       

+399E 56          V     LD    D,(HL)     

+399F CD 7D 6A    .}j   CALL  6A7D       

+39A2 C3 03 2D    ..-   JP    2D03       ;---- Parameter fuer blockin/out---

+39A5 CD 13 43    ..C   CALL  4313       ; DSnr

+39A8 CD 11 36    ..6   CALL  3611

+39AB CD A8 2C    ..,   CALL  2CA8       ; page --> HL

+39AE 5C          \     LD    E,H        

+39AF 65          e     LD    H,L        

+39B0 2E 00       ..    LD    L,00       

+39B2 C9          .     RET              ;----------------- blockout -------

+39B3 CD A5 39    ..9   CALL  39A5       

+39B6 CD 5C 65    .\e   CALL  655C       

+39B9 67          g     LD    H,A        

+39BA EB          .     EX    DE,HL      

+39BB CD A8 2C    ..,   CALL  2CA8       ; code1 --> HL

+39BE E5          .     PUSH  HL         

+39BF CD A8 2C    ..,   CALL  2CA8       ; code2 --> HL

+39C2 E5          .     PUSH  HL

+39C3 CD 64 43    .dC   CALL  4364       ; result addr

+39C6 ED 43 D0 41 .C.A  LD    (41D0),BC  

+39CA C1          .     POP   BC         

+39CB E3          .     EX    (SP),HL    

+39CC DD 7E 26    .~&   LD    A,(IX+26)  

+39CF B7          .     OR    A          

+39D0 28 05       (.    JR    Z,39D7     ; Kanal > 0 sein

+39D2 CD 2A 26    .*&   CALL  262A       

+39D5 18 03       ..    JR    39DA       

+39D7 01 FF FF    ...   LD    BC,FFFF    ; Nicht fuer HG

+39DA E1          .     POP   HL         ; result liefern

+39DB 71          q     LD    (HL),C     

+39DC 2C          ,     INC   L          

+39DD 70          p     LD    (HL),B     

+39DE ED 4B D0 41 .K.A  LD    BC,(41D0)  

+39E2 C3 A7 2A    ..*   JP    2AA7       ;------------ blockin -------------

+39E5 CD A5 39    ..9   CALL  39A5       

+39E8 CD 2C 66    .,f   CALL  662C       

+39EB 67          g     LD    H,A        

+39EC EB          .     EX    DE,HL      

+39ED CD A8 2C    ..,   CALL  2CA8       

+39F0 E5          .     PUSH  HL         

+39F1 CD A8 2C    ..,   CALL  2CA8       

+39F4 E5          .     PUSH  HL         

+39F5 CD 64 43    .dC   CALL  4364       

+39F8 ED 43 D0 41 .C.A  LD    (41D0),BC  

+39FC C1          .     POP   BC         

+39FD E3          .     EX    (SP),HL    

+39FE DD 7E 26    .~&   LD    A,(IX+26)  

+3A01 B7          .     OR    A          

+3A02 28 D3       (.    JR    Z,39D7     

+3A04 CD 56 25    .V%   CALL  2556       

+3A07 18 D1       ..    JR    39DA       ;------------ control -------------

+3A09 CD A8 2C    ..,   CALL  2CA8       ; funktion

+3A0C EB          .     EX    DE,HL      

+3A0D CD A8 2C    ..,   CALL  2CA8       ; code1

+3A10 E5          .     PUSH  HL         

+3A11 CD A8 2C    ..,   CALL  2CA8       ; code2

+3A14 E5          .     PUSH  HL         

+3A15 CD 64 43    .dC   CALL  4364       ; result

+3A18 ED 43 D0 41 .C.A  LD    (41D0),BC  ; DE = Funktion

+3A1C C1          .     POP   BC         ; BC = Code 2

+3A1D E3          .     EX    (SP),HL    ; HL = Code 1

+3A1E 7B          {     LD    A,E        ; funktion=10 (calendar)

+3A1F D6 0A       ..    SUB   A,0A       

+3A21 B2          .     OR    D          

+3A22 28 0B       (.    JR    Z,3A2F     

+3A24 DD 7E 26    .~&   LD    A,(IX+26)  

+3A27 B7          .     OR    A          

+3A28 28 AD       (.    JR    Z,39D7     

+3A2A CD 56 24    .V$   CALL  2456       ; IOCONTROL

+3A2D 18 AB       ..    JR    39DA       ; result in BC uebertragen

+3A2F 3A 6B 28    :k(   LD    A,(286B)   ; control (10,..)

+3A32 FE 08       ..    CP    08         ; shard >= 8?

+3A34 30 F4       0.    JR    NC,3A2A    ; nein: 

+3A36 01 FF FF    ...   LD    BC,FFFF    ; result -1

+3A39 18 9F       ..    JR    39DA       ;-------------- nextdspage --------

+3A3B CD 13 43    ..C   CALL  4313       ; dsnr holen

+3A3E CD 11 36    ..6   CALL  3611       ; test, gueltigen ds

+3A41 CD A8 2C    ..,   CALL  2CA8       ; page holen

+3A44 CD 5B 6A    .[j   CALL  6A5B       ; nextdspage

+3A47 EB          .     EX    DE,HL      

+3A48 C3 03 2D    ..-   JP    2D03       ; nextpage auf stack

+3A4B CB 7E       .~    BIT   7,(HL)     

+3A4D 28 04       (.    JR    Z,3A53     

+3A4F CB BE       ..    RES   7,(HL)     

+3A51 B7          .     OR    A          

+3A52 C9          .     RET              

+3A53 1C          .     INC   E          

+3A54 2D          -     DEC   L          

+3A55 34          4     INC   (HL)       

+3A56 20 03        .    JR    NZ,3A5B    

+3A58 2C          ,     INC   L          

+3A59 34          4     INC   (HL)       

+3A5A 2D          -     DEC   L          

+3A5B 2C          ,     INC   L          

+3A5C CB FE       ..    SET   7,(HL)     

+3A5E 37          7     SCF              

+3A5F C9          .     RET              

+3A60 CB BC       ..    RES   7,H        

+3A62 5C          \     LD    E,H        

+3A63 16 1D       ..    LD    D,1D       

+3A65 1A          .     LD    A,(DE)     

+3A66 67          g     LD    H,A        

+3A67 29          )     ADD   HL,HL      

+3A68 D8          .     RET   C          

+3A69 C3 F9 42    ..B   JP    42F9       

+3A6C CB BC       ..    RES   7,H        

+3A6E 5C          \     LD    E,H        

+3A6F 16 1D       ..    LD    D,1D       

+3A71 1A          .     LD    A,(DE)     

+3A72 67          g     LD    H,A        

+3A73 29          )     ADD   HL,HL      

+3A74 B7          .     OR    A          

+3A75 C0          .     RET   NZ         

+3A76 C3 E1 42    ..B   JP    42E1       ;---------------- ECWR ------------

+3A79 CD 64 43    .dC   CALL  4364       

+3A7C E5          .     PUSH  HL         

+3A7D CD 64 43    .dC   CALL  4364       

+3A80 5E          ^     LD    E,(HL)     

+3A81 2C          ,     INC   L          

+3A82 56          V     LD    D,(HL)     

+3A83 E5          .     PUSH  HL         

+3A84 EB          .     EX    DE,HL      

+3A85 CD 60 3A    .`:   CALL  3A60       

+3A88 EB          .     EX    DE,HL      

+3A89 CD 13 43    ..C   CALL  4313       

+3A8C 7E          ~     LD    A,(HL)     

+3A8D E1          .     POP   HL         

+3A8E CD 4B 3A    .K:   CALL  3A4B       

+3A91 12          .     LD    (DE),A     

+3A92 38 04       8.    JR    C,3A98     

+3A94 EB          .     EX    DE,HL      

+3A95 2C          ,     INC   L          

+3A96 36 00       6.    LD    (HL),00    

+3A98 E1          .     POP   HL         

+3A99 5E          ^     LD    E,(HL)     

+3A9A 2C          ,     INC   L          

+3A9B 56          V     LD    D,(HL)     

+3A9C EB          .     EX    DE,HL      

+3A9D 29          )     ADD   HL,HL      

+3A9E CB 54       .T    BIT   2,H        

+3AA0 CB 94       ..    RES   2,H        

+3AA2 28 01       (.    JR    Z,3AA5     

+3AA4 2C          ,     INC   L          

+3AA5 85          .     ADD   L          

+3AA6 6F          o     LD    L,A        

+3AA7 30 01       0.    JR    NC,3AAA    

+3AA9 24          $     INC   H          

+3AAA CB 94       ..    RES   2,H        

+3AAC EB          .     EX    DE,HL      

+3AAD 72          r     LD    (HL),D     

+3AAE 2D          -     DEC   L          

+3AAF 73          s     LD    (HL),E     

+3AB0 C3 A7 2A    ..*   JP    2AA7       ;--------------- CWR -------------

+3AB3 CD 64 43    .dC   CALL  4364       

+3AB6 E5          .     PUSH  HL         

+3AB7 CD 13 43    ..C   CALL  4313       

+3ABA 5E          ^     LD    E,(HL)     

+3ABB D5          .     PUSH  DE         

+3ABC CD A8 2C    ..,   CALL  2CA8       

+3ABF CD 60 3A    .`:   CALL  3A60       

+3AC2 D1          .     POP   DE         

+3AC3 73          s     LD    (HL),E     

+3AC4 E1          .     POP   HL         

+3AC5 2C          ,     INC   L          

+3AC6 CD 4B 3A    .K:   CALL  3A4B       

+3AC9 CB BE       ..    RES   7,(HL)     

+3ACB C3 A7 2A    ..*   JP    2AA7       ;----------- CRD ------------------

+3ACE CD A8 2C    ..,   CALL  2CA8       

+3AD1 CD 6C 3A    .l:   CALL  3A6C       

+3AD4 5E          ^     LD    E,(HL)     

+3AD5 16 00       ..    LD    D,00       

+3AD7 C3 03 2D    ..-   JP    2D03       ;------------- BCRD ---------------

+3ADA CD 64 43    .dC   CALL  4364       

+3ADD E5          .     PUSH  HL         

+3ADE CD 64 43    .dC   CALL  4364       

+3AE1 5E          ^     LD    E,(HL)     

+3AE2 2C          ,     INC   L          

+3AE3 56          V     LD    D,(HL)     

+3AE4 E5          .     PUSH  HL         

+3AE5 EB          .     EX    DE,HL      

+3AE6 CD 6C 3A    .l:   CALL  3A6C       

+3AE9 EB          .     EX    DE,HL      

+3AEA E1          .     POP   HL         

+3AEB CD 4B 3A    .K:   CALL  3A4B       

+3AEE E1          .     POP   HL         

+3AEF 1A          .     LD    A,(DE)     

+3AF0 77          w     LD    (HL),A     

+3AF1 2C          ,     INC   L          

+3AF2 36 00       6.    LD    (HL),00    

+3AF4 C3 A7 2A    ..*   JP    2AA7       ;-------------- cdbint -----------

+3AF7 CD A8 2C    ..,   CALL  2CA8       ; address holen

+3AFA 3E 05       >.    LD    A,05       ; Segment 5

+3AFC FD 21 85 46 .!.F  LD    IY,4685    

+3B00 FD 36 00 01 .6..  LD    (IY+00),01 ; 1 Wort

+3B04 FD 36 03 04 .6..  LD    (IY+03),04 ; DS 4

+3B08 CD CA 44    ..D   CALL  44CA       

+3B0B C3 00 2D    ..-   JP    2D00       ;-------------- cdbtext -----------

+3B0E CD A8 2C    ..,   CALL  2CA8       ; Textaddress holen

+3B11 2B          +     DEC   HL         

+3B12 11 05 04    ...   LD    DE,0405    ; DS 4, Segment 5

+3B15 CD 95 46    ..F   CALL  4695       

+3B18 C3 D0 30    ..0   JP    30D0       ;--------------- CTT --------------

+3B1B CD A8 2C    ..,   CALL  2CA8       ; Textaddr holen

+3B1E 2B          +     DEC   HL         

+3B1F 11 04 00    ...   LD    DE,0004    ; REF-Adr : DS 4, HL

+3B22 D5          .     PUSH  DE         

+3B23 C3 34 36    .46   JP    3634       ;-------------- GETC --------------

+3B26 CD 8D 46    ..F   CALL  468D       

+3B29 E5          .     PUSH  HL         

+3B2A CD 64 43    .dC   CALL  4364       

+3B2D 7B          {     LD    A,E        

+3B2E 5E          ^     LD    E,(HL)     

+3B2F 93          .     SUB   E          

+3B30 2C          ,     INC   L          

+3B31 7A          z     LD    A,D        

+3B32 56          V     LD    D,(HL)     

+3B33 9A          .     SBC   D          

+3B34 38 18       8.    JR    C,3B4E     

+3B36 E3          .     EX    (SP),HL    

+3B37 1B          .     DEC   DE         

+3B38 CD 0D 45    ..E   CALL  450D       

+3B3B 5E          ^     LD    E,(HL)     

+3B3C CD 64 43    .dC   CALL  4364       

+3B3F 73          s     LD    (HL),E     

+3B40 2C          ,     INC   L          

+3B41 36 00       6.    LD    (HL),00    

+3B43 E1          .     POP   HL         

+3B44 2D          -     DEC   L          

+3B45 34          4     INC   (HL)       

+3B46 C2 71 2E    .q.   JP    NZ,2E71    

+3B49 2C          ,     INC   L          

+3B4A 34          4     INC   (HL)       

+3B4B C3 71 2E    .q.   JP    2E71       

+3B4E CD 43 44    .CD   CALL  4443       

+3B51 C3 84 2E    ...   JP    2E84       ;------------ FNONBL --------------

+3B54 CD 64 43    .dC   CALL  4364       

+3B57 E5          .     PUSH  HL         

+3B58 CD 8D 46    ..F   CALL  468D       

+3B5B E5          .     PUSH  HL         

+3B5C D5          .     PUSH  DE         

+3B5D CD 64 43    .dC   CALL  4364       

+3B60 22 CC 41    ".A   LD    (41CC),HL  

+3B63 ED 43 D0 41 .C.A  LD    (41D0),BC  

+3B67 C1          .     POP   BC         

+3B68 5E          ^     LD    E,(HL)     

+3B69 2C          ,     INC   L          

+3B6A 56          V     LD    D,(HL)     

+3B6B E1          .     POP   HL         

+3B6C CD 1D 46    ..F   CALL  461D       

+3B6F CD 44 45    .DE   CALL  4544       

+3B72 28 2B       (+    JR    Z,3B9F     

+3B74 F5          .     PUSH  AF         

+3B75 3E 20       >     LD    A,20       

+3B77 ED A1       ..    CPI              

+3B79 20 0B        .    JR    NZ,3B86    

+3B7B EA 77 3B    .w;   JP    PE,3B77    

+3B7E F1          .     POP   AF         

+3B7F 30 1E       0.    JR    NC,3B9F    

+3B81 CD C1 45    ..E   CALL  45C1       

+3B84 18 E9       ..    JR    3B6F       

+3B86 F1          .     POP   AF         

+3B87 2B          +     DEC   HL         

+3B88 7E          ~     LD    A,(HL)     

+3B89 CD 33 46    .3F   CALL  4633       

+3B8C 13          .     INC   DE         

+3B8D 2A CC 41    *.A   LD    HL,(41CC)  

+3B90 73          s     LD    (HL),E     

+3B91 2C          ,     INC   L          

+3B92 72          r     LD    (HL),D     

+3B93 E1          .     POP   HL         

+3B94 77          w     LD    (HL),A     

+3B95 2C          ,     INC   L          

+3B96 36 00       6.    LD    (HL),00    

+3B98 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3B9C C3 71 2E    .q.   JP    2E71       

+3B9F E1          .     POP   HL         

+3BA0 ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3BA4 C3 84 2E    ...   JP    2E84       ;-------------- DREM256 ----------- 

+3BA7 CD 64 43    .dC   CALL  4364       

+3BAA EB          .     EX    DE,HL      

+3BAB CD 64 43    .dC   CALL  4364       

+3BAE 1A          .     LD    A,(DE)     

+3BAF 77          w     LD    (HL),A     

+3BB0 97          .     SUB   A          

+3BB1 2C          ,     INC   L          

+3BB2 77          w     LD    (HL),A     

+3BB3 EB          .     EX    DE,HL      

+3BB4 2C          ,     INC   L          

+3BB5 5E          ^     LD    E,(HL)     

+3BB6 77          w     LD    (HL),A     

+3BB7 2D          -     DEC   L          

+3BB8 73          s     LD    (HL),E     

+3BB9 C3 A7 2A    ..*   JP    2AA7       ;------------- AMUL256 ------------

+3BBC CD 64 43    .dC   CALL  4364       

+3BBF EB          .     EX    DE,HL      

+3BC0 CD 13 43    ..C   CALL  4313       

+3BC3 7E          ~     LD    A,(HL)     

+3BC4 EB          .     EX    DE,HL      

+3BC5 5E          ^     LD    E,(HL)     

+3BC6 77          w     LD    (HL),A     

+3BC7 2C          ,     INC   L          

+3BC8 73          s     LD    (HL),E     

+3BC9 C3 A7 2A    ..*   JP    2AA7       ;------------ ISLD ----------------

+3BCC CD 13 43    ..C   CALL  4313       

+3BCF 7E          ~     LD    A,(HL)     

+3BD0 FE 7B       .{    CP    7B         

+3BD2 D2 84 2E    ...   JP    NC,2E84    

+3BD5 FE 61       .a    CP    61         

+3BD7 D2 71 2E    .q.   JP    NC,2E71    

+3BDA 11 3A 30    .:0   LD    DE,303A    

+3BDD 18 07       ..    JR    3BE6       ;------------- ISDIG ---------------

+3BDF 11 3A 30    .:0   LD    DE,303A    

+3BE2 CD 13 43    ..C   CALL  4313       

+3BE5 7E          ~     LD    A,(HL)     

+3BE6 BB          .     CP    E          

+3BE7 D2 84 2E    ...   JP    NC,2E84    

+3BEA BA          .     CP    D          

+3BEB D2 71 2E    .q.   JP    NC,2E71    

+3BEE C3 84 2E    ...   JP    2E84       ;-------------- ISLCAS ------------

+3BF4 18 EC       ..    JR    3BE2       ;-------------- ISUCAS ----------- 

+3BF6 11 5B 41    .[A   LD    DE,415B    

+3BF9 18 E7       ..    JR    3BE2       ;--------------- GADDR ------------

+3BFB CD A8 2C    ..,   CALL  2CA8       

+3BFE EB          .     EX    DE,HL      

+3BFF CD A8 2C    ..,   CALL  2CA8       

+3C02 CB 7C       .|    BIT   7,H        

+3C04 28 0A       (.    JR    Z,3C10     

+3C06 29          )     ADD   HL,HL      

+3C07 CB 7C       .|    BIT   7,H        

+3C09 28 01       (.    JR    Z,3C0C     

+3C0B 2C          ,     INC   L          

+3C0C CB FC       ..    SET   7,H        

+3C0E 18 03       ..    JR    3C13       

+3C10 B7          .     OR    A          

+3C11 ED 52       .R    SBC   HL,DE      

+3C13 EB          .     EX    DE,HL      

+3C14 C3 03 2D    ..-   JP    2D03       ;------------- GCADDR -------------

+3C17 CD A8 2C    ..,   CALL  2CA8       

+3C1A EB          .     EX    DE,HL      

+3C1B CD 13 43    ..C   CALL  4313       

+3C1E 2C          ,     INC   L          

+3C1F 7A          z     LD    A,D        

+3C20 96          .     SUB   (HL)       

+3C21 30 02       0.    JR    NC,3C25    

+3C23 C6 10       ..    ADD   A,10       

+3C25 0F          .     RRCA             

+3C26 57          W     LD    D,A        

+3C27 CD 64 43    .dC   CALL  4364       

+3C2A 73          s     LD    (HL),E     

+3C2B 2C          ,     INC   L          

+3C2C 72          r     LD    (HL),D     

+3C2D 7A          z     LD    A,D        

+3C2E E6 78       .x    AND   78         

+3C30 CA 71 2E    .q.   JP    Z,2E71     

+3C33 C3 84 2E    ...   JP    2E84       ;------------ ISSHA ---------------

+3C36 CD A8 2C    ..,   CALL  2CA8       

+3C39 7C          |     LD    A,H        

+3C3A E6 7C       .|    AND   7C         

+3C3C CA 71 2E    .q.   JP    Z,2E71     

+3C3F C3 84 2E    ...   JP    2E84       ;-------------- GETTAB ------------

+3C42 11 00 04    ...   LD    DE,0400    

+3C45 21 00 05    !..   LD    HL,0500    ; von Segment 5 nach segment 4 

+3C48 3E 80       >.    LD    A,80       

+3C4A C5          .     PUSH  BC         

+3C4B 47          G     LD    B,A        

+3C4C 0E 04       ..    LD    C,04       

+3C4E CD B6 69    ..i   CALL  69B6       

+3C51 CD 16 42    ..B   CALL  4216       

+3C54 C1          .     POP   BC         

+3C55 C3 A7 2A    ..*   JP    2AA7       ;-------------- PUTTAB ------------

+3C58 11 00 05    ...   LD    DE,0500    ; von segment 4 nach segment 5

+3C5B 21 00 04    !..   LD    HL,0400    

+3C5E 3E 80       >.    LD    A,80       

+3C60 18 E8       ..    JR    3C4A       ;------------- ERATAB -------------

+3C62 11 00 04    ...   LD    DE,0400    ; Segment 4 loeschen (6 ist leer)

+3C65 21 00 06    !..   LD    HL,0600    

+3C68 E5          .     PUSH  HL         

+3C69 C5          .     PUSH  BC         

+3C6A 06 FE       ..    LD    B,FE       

+3C6C 0E 04       ..    LD    C,04       

+3C6E CD B6 69    ..i   CALL  69B6       

+3C71 C1          .     POP   BC         

+3C72 E1          .     POP   HL         

+3C73 11 00 07    ...   LD    DE,0700    ; neuerdings auch Segment 7

+3C76 3E FE       >.    LD    A,FE       ; loeschen

+3C78 18 D0       ..    JR    3C4A       ;------------ storage ------------

+3C7A C5          .     PUSH  BC         

+3C7B CD CC 56    ..V   CALL  56CC       ; storage berechnen

+3C7E 59          Y     LD    E,C        

+3C7F 50          P     LD    D,B        

+3C80 C1          .     POP   BC         

+3C81 EB          .     EX    DE,HL      

+3C82 E5          .     PUSH  HL         

+3C83 CD 64 43    .dC   CALL  4364       ; size-addresse holen

+3C86 73          s     LD    (HL),E     

+3C87 2C          ,     INC   L          

+3C88 72          r     LD    (HL),D     

+3C89 D1          .     POP   DE         ; used-auf stack

+3C8A C3 03 2D    ..-   JP    2D03       ;------------- sysop -------------

+3C8D DD 7E 1D    .~.   LD    A,(IX+1D)  ; privilegierte operation

+3C90 FE 01       ..    CP    01         

+3C92 DA E6 3C    ..<   JP    C,3CE6     

+3C95 CD A8 2C    ..,   CALL  2CA8       ; nr holen

+3C98 3E 0C       >.    LD    A,0C       

+3C9A BD          .     CP    L          

+3C9B 20 01        .    JR    NZ,3C9E    ; savesystem ?

+3C9D 2D          -     DEC   L          ; aus 12 wird 11

+3C9E 3A 17 82    :..   LD    A,(8217)   ; Musta

+3CA1 B7          .     OR    A          

+3CA2 C2 26 29    .&)   JP    NZ,2926    ; Warten, bis Musta frei

+3CA5 DD CB 07 5E ...^  BIT   3,(IX+07)  ; restart

+3CA9 20 1B        .    JR    NZ,3CC6    

+3CAB DD CB 07 DE ....  SET   3,(IX+07)  

+3CAF 7D          }     LD    A,L        

+3CB0 32 17 82    2..   LD    (8217),A   

+3CB3 21 60 EA    !`.   LD    HL,EA60    ; 6000.0 s = 100 Minuten

+3CB6 22 B6 4C    ".L   LD    (4CB6),HL  

+3CB9 FE 04       ..    CP    04         ; < shutup ?

+3CBB DA 26 29    .&)   JP    C,2926     

+3CBE CD 02 2A    ..*   CALL  2A02       

+3CC1 CD E2 6D    ..m   CALL  6DE2       ; Endlos warte

+3CC4 18 FB       ..    JR    3CC1       

+3CC6 DD CB 07 9E ....  RES   3,(IX+07)  

+3CCA C3 A7 2A    ..*   JP    2AA7       ;-------------- DIV by 0 ---------

+3CCD 3E 05       >.    LD    A,05       

+3CCF 18 37       .7    JR    3D08       ;---------- Stackoverflow ---------

+3CD1 DD CB 0B B6 ....  RES   6,(IX+0B)  ; enablestop

+3CD5 3E 02       >.    LD    A,02       ; errorstop

+3CD7 18 39       .9    JR    3D12       ;

+3CD9 3E 09       >.    LD    A,09       ;---------- Subscript overflow ----

+3CDB CB 7C       .|    BIT   7,H        

+3CDD 28 02       (.    JR    Z,3CE1     

+3CDF 3E 0A       >.    LD    A,0A       ;---------- Subscript underflow ----

+3CE1 21 00 00    !..   LD    HL,0000    

+3CE4 18 27       .'    JR    3D0D       ;----- error: privilegierte op --

+3CE6 DD 7E 30    .~0   LD    A,(IX+30)  ; Taskindex = Supervisor ?

+3CE9 FE 01       ..    CP    01         

+3CEB 20 07        .    JR    NZ,3CF4    

+3CED DD 36 1D 02 .6..  LD    (IX+1D),02 ; privileged 2, offener wartezustand

+3CF1 C3 26 29    .&)   JP    2926       ;--------- Codefehler --------------

+3CF4 DD CB 0B B6 ....  RES   6,(IX+0B)  ; enablestop 

+3CF8 3E 11       >.    LD    A,11       

+3CFA 18 16       ..    JR    3D12       ; errorstop ("Codefehler")

+3CFC 30 03       0.    JR    NC,3D01    ; ------ INT overflow, wenn arith15

+3CFE 21 FF FF    !..   LD    HL,FFFF    

+3D01 DD CB 0B 66 ...f  BIT   4,(IX+0B)  

+3D05 C0          .     RET   NZ         

+3D06 3E 04       >.    LD    A,04       

+3D08 11 01 00    ...   LD    DE,0001    

+3D0B 62          b     LD    H,D        

+3D0C 6A          j     LD    L,D        

+3D0D DD CB 0B 7E ...~  BIT   7,(IX+0B)  ; nur wenn nicht schon iserror

+3D11 C0          .     RET   NZ         

+3D12 DD 36 25 00 .6%.  LD    (IX+25),00 ;--------- errorstop

+3D16 DD 77 24    .w$   LD    (IX+24),A  ; errorno

+3D19 DD 7E 20    .~    LD    A,(IX+20)  ; errline := lineno

+3D1C DD 77 22    .w"   LD    (IX+22),A  

+3D1F DD 7E 21    .~!   LD    A,(IX+21)  

+3D22 DD 77 23    .w#   LD    (IX+23),A  

+3D25 DD CB 0B FE ....  SET   7,(IX+0B)  ; iserror

+3D29 DD CB 0B 76 ...v  BIT   6,(IX+0B)  

+3D2D C0          .     RET   NZ         

+3D2E CD E8 45    ..E   CALL  45E8       ; Return, wenn enablestop

+3D31 DD CB 07 9E ....  RES   3,(IX+07)  

+3D35 31 13 6D    1.m   LD    SP,6D13    

+3D38 DD CB 0B 76 ...v  BIT   6,(IX+0B)  ;-------------- TERM --------------

+3D3C 20 09        .    JR    NZ,3D47    ; bis zum disablestop PROC zurueck

+3D3E DD 36 06 1C .6..  LD    (IX+06),1C ; Status LEAVE PROC

+3D42 CD 35 30    .50   CALL  3035       ; EXEC LEAVE

+3D45 18 F1       ..    JR    3D38       ; Weiter LEAVEn

+3D47 DD 36 06 00 .6..  LD    (IX+06),00 ; Status Busy

+3D4B C3 A7 2A    ..*   JP    2AA7       ;----------- enablestop ---------

+3D4E DD CB 0B B6 ....  RES   6,(IX+0B)  

+3D52 DD CB 0B 7E ...~  BIT   7,(IX+0B)  

+3D56 20 E0        .    JR    NZ,3D38    ; LEAVE PROC, if enablesto and iserr

+3D58 C3 A7 2A    ..*   JP    2AA7       ;------------ disablestop --------

+3D5B DD CB 0B F6 ....  SET   6,(IX+0B)  

+3D5F C3 A7 2A    ..*   JP    2AA7       ;----------- seterrorstop ---------

+3D62 CD A8 2C    ..,   CALL  2CA8       

+3D65 DD CB 0B 7E ...~  BIT   7,(IX+0B)  

+3D69 C2 A7 2A    ..*   JP    NZ,2AA7    

+3D6C DD 74 25    .t%   LD    (IX+25),H  ; errorcode high

+3D6F 7D          }     LD    A,L        

+3D70 CD 16 3D    ..=   CALL  3D16       ; errorstop

+3D73 C3 A7 2A    ..*   JP    2AA7       ;------------- iserror ------------

+3D76 DD CB 0B 7E ...~  BIT   7,(IX+0B)  

+3D7A CA 84 2E    ...   JP    Z,2E84     

+3D7D C3 71 2E    .q.   JP    2E71       ;------------ clearerror ----------

+3D80 DD CB 0B 76 ...v  BIT   6,(IX+0B)  

+3D84 CA A7 2A    ..*   JP    Z,2AA7     ; war kein Fehler

+3D87 C5          .     PUSH  BC         

+3D88 0E 05       ..    LD    C,05       

+3D8A CD 97 69    ..i   CALL  6997       

+3D8D 3A 1A 6E    :.n   LD    A,(6E1A)   ; Aktueller Taskindex

+3D90 47          G     LD    B,A        

+3D91 0E 00       ..    LD    C,00       

+3D93 57          W     LD    D,A        

+3D94 CD E8 68    ..h   CALL  68E8       

+3D97 C1          .     POP   BC         

+3D98 DD CB 0B BE ....  RES   7,(IX+0B)  

+3D9C C3 A7 2A    ..*   JP    2AA7       ;-------- readpcb myself ----------

+3D9F CD A5 3D    ..=   CALL  3DA5       ; 

+3DA2 C3 00 2D    ..-   JP    2D00       ; Wert auf Stack

+3DA5 CD 13 43    ..C   CALL  4313       ; Zwei Addressen holen

+3DA8 7E          ~     LD    A,(HL)     

+3DA9 2A 1C 6E    *.n   LD    HL,(6E1C)  ; Leitblock aktueller

+3DAC 87          .     ADD   A          

+3DAD C6 1E       ..    ADD   A,1E       ; pcb--> pcf konvertieren

+3DAF E6 3F       .?    AND   3F         

+3DB1 6F          o     LD    L,A        

+3DB2 C9          .     RET              ;----- test ob, supervisorson ----

+3DB3 DD 7E 1D    .~.   LD    A,(IX+1D)  ; priv Feld

+3DB6 FE 01       ..    CP    01         ; >= 1 : darf

+3DB8 30 08       0.    JR    NC,3DC2    

+3DBA DD 7E 1D    .~.   LD    A,(IX+1D)  ;------ test, ob supervisor -------

+3DBD FE 02       ..    CP    02         

+3DBF DA E6 3C    ..<   JP    C,3CE6     ; < 2 : darf nicht

+3DC2 CD 07 44    ..D   CALL  4407       ; leitblock einer task laden-------

+3DC5 FD 2A 1C 6E .*.n  LD    IY,(6E1C)  

+3DC9 1A          .     LD    A,(DE)     

+3DCA 3D          =     DEC   A          

+3DCB FE 7F       ..    CP    7F         ; Taskindex >= 128 ?

+3DCD D0          .     RET   NC         

+3DCE 1C          .     INC   E          

+3DCF 1A          .     LD    A,(DE)     

+3DD0 1D          .     DEC   E          

+3DD1 DD BE 31    ..1   CP    (IX+31)    ; Stationsnummer (myself)

+3DD4 20 07        .    JR    NZ,3DDD    

+3DD6 1A          .     LD    A,(DE)     

+3DD7 CD 4D 6D    .Mm   CALL  6D4D       

+3DDA 1A          .     LD    A,(DE)     

+3DDB 37          7     SCF              

+3DDC C9          .     RET              

+3DDD B7          .     OR    A          

+3DDE C9          .     RET              ;------------ pcb-feld lesen -----

+3DDF CD C2 3D    ..=   CALL  3DC2       ; 

+3DE2 CD 13 43    ..C   CALL  4313       

+3DE5 7E          ~     LD    A,(HL)     ; pcb-nummer

+3DE6 FD E5       ..    PUSH  IY         

+3DE8 E1          .     POP   HL         

+3DE9 18 C1       ..    JR    3DAC       ;------------- readpcb task -------

+3DEB CD DF 3D    ..=   CALL  3DDF       ; Readpcb und Wert auf Stack

+3DEE C3 00 2D    ..-   JP    2D00       ;------------- writepcb task ------

+3DF1 CD DF 3D    ..=   CALL  3DDF       ; Readpcb 

+3DF4 FD 7E 30    .~0   LD    A,(IY+30)  ; Eigener Taskindex = pcb-Taskindex

+3DF7 DD BE 30    ..0   CP    (IX+30)    

+3DFA 20 05        .    JR    NZ,3E01    ; Nein, kann nur Supervisor

+3DFC 7D          }     LD    A,L        ; linenumber field

+3DFD FE 20       .     CP    20         ; pcf=32 kann beschrieben werden

+3DFF 28 12       (.    JR    Z,3E13     ; von jeder task

+3E01 DD 7E 1D    .~.   LD    A,(IX+1D)  

+3E04 FE 02       ..    CP    02         

+3E06 30 0B       0.    JR    NC,3E13    ; priv >= 2 darf alle beschreiben

+3E08 FE 01       ..    CP    01         

+3E0A DA E6 3C    ..<   JP    C,3CE6     ; priv < 1 darf nur linenumber

+3E0D 7D          }     LD    A,L        

+3E0E FE 2A       .*    CP    2A         ; priv = 1 darf nur prio beschreiben

+3E10 C2 E6 3C    ..<   JP    NZ,3CE6    

+3E13 EB          .     EX    DE,HL      ; writepcb durchfuehren

+3E14 CD A8 2C    ..,   CALL  2CA8       ; value holen

+3E17 EB          .     EX    DE,HL      

+3E18 73          s     LD    (HL),E     ; leitblock veraendern

+3E19 2C          ,     INC   L          

+3E1A 72          r     LD    (HL),D     

+3E1B C3 A7 2A    ..*   JP    2AA7       ;-------------- status ------------

+3E1E CD C2 3D    ..=   CALL  3DC2       ; leitblock von task holen

+3E21 FD 7E 06    .~.   LD    A,(IY+06)  ; status feld

+3E24 07          .     RLCA             

+3E25 07          .     RLCA             

+3E26 E6 0F       ..    AND   0F         

+3E28 5F          _     LD    E,A        

+3E29 16 00       ..    LD    D,00       

+3E2B C3 03 2D    ..-   JP    2D03       ;--------------- unblock ----------

+3E2E CD B3 3D    ..=   CALL  3DB3       ; nur von supervisorsoehnen

+3E31 DC 68 6D    .hm   CALL  C,6D68     

+3E34 FD CB 06 4E ...N  BIT   1,(IY+06)

+3E38 20 04        .    JR    NZ,3E3E    

+3E3A FD CB 06 86 ....  RES   0,(IY+06)  

+3E3E C3 A7 2A    ..*   JP    2AA7       ;--------------- block ------------

+3E41 CD B3 3D    ..=   CALL  3DB3       ; nur von supervisorsoehnen

+3E44 30 F8       0.    JR    NC,3E3E    

+3E46 FD CB 06 C6 ....  SET   0,(IY+06)  

+3E4A CD 74 6D    .tm   CALL  6D74       

+3E4D 18 EF       ..    JR    3E3E       ;----------- nextactive ----------

+3E4F CD 64 43    .dC   CALL  4364       ; task holen

+3E52 7E          ~     LD    A,(HL)     

+3E53 CD 7E 6D    .~m   CALL  6D7E       

+3E56 F5          .     PUSH  AF         

+3E57 CD 4D 6D    .Mm   CALL  6D4D       

+3E5A F1          .     POP   AF         

+3E5B 77          w     LD    (HL),A     

+3E5C 2C          ,     INC   L          

+3E5D FD 7E 31    .~1   LD    A,(IY+31)  ; taskindex holen

+3E60 77          w     LD    (HL),A     

+3E61 18 DB       ..    JR    3E3E       ;------------ halt process --------

+3E63 CD BA 3D    ..=   CALL  3DBA       ; nur vom supervisor

+3E66 FD CB 05 C6 ....  SET   0,(IY+05)  

+3E6A 18 D2       ..    JR    3E3E       ;------------- create process -----

+3E6C DD 7E 30    .~0   LD    A,(IX+30)  ; myself index

+3E6F 32 13 42    2.B   LD    (4213),A   

+3E72 2A CA 41    *.A   LD    HL,(41CA)  ; heaptop

+3E75 22 14 42    ".B   LD    (4214),HL  

+3E78 CD BA 3D    ..=   CALL  3DBA       ; supervisor ?

+3E7B D2 4C 3F    .L?   JP    NC,3F4C    ; nicht moeglich

+3E7E E5          .     PUSH  HL         ; unprivilegiertes createprocess

+3E7F D5          .     PUSH  DE         

+3E80 FD 36 00 00 .6..  LD    (IY+00),00 ; wstate 

+3E84 FD 36 1D FF .6..  LD    (IY+1D),FF ; priv

+3E88 CD B8 43    ..C   CALL  43B8       ; procadresse holen

+3E8B FD 75 09    .u.   LD    (IY+09),L  ; icount uebertragen

+3E8E FD 74 0A    .t.   LD    (IY+0A),H  

+3E91 FD 73 0B    .s.   LD    (IY+0B),E  

+3E94 7C          |     LD    A,H        

+3E95 C6 10       ..    ADD   A,10       

+3E97 FD 77 0F    .w.   LD    (IY+0F),A  ; c8k, und allgemeiner create proc.

+3E9A C3 D9 3E    ..>   JP    3ED9       ;------- create privileged process-

+3E9D CD 13 43    ..C   CALL  4313       

+3EA0 7E          ~     LD    A,(HL)     

+3EA1 E6 7F       ..    AND   7F         

+3EA3 32 13 42    2.B   LD    (4213),A   

+3EA6 CD 4D 6D    .Mm   CALL  6D4D       

+3EA9 FD 6E 16    .n.   LD    L,(IY+16)  ; hptop

+3EAC FD 66 17    .f.   LD    H,(IY+17)  

+3EAF 22 14 42    ".B   LD    (4214),HL  

+3EB2 CD BA 3D    ..=   CALL  3DBA       ; supervisor ?

+3EB5 D2 49 3F    .I?   JP    NC,3F49    ; nicht moeglich

+3EB8 E5          .     PUSH  HL         

+3EB9 D5          .     PUSH  DE         

+3EBA FD 36 01 00 .6..  LD    (IY+01),00 ; wstate

+3EBE CD A8 2C    ..,   CALL  2CA8       ; priv parameter

+3EC1 FD 75 1D    .u.   LD    (IY+1D),L  

+3EC4 CD 07 44    ..D   CALL  4407       ; PROCAddresse holen --> DE, HL

+3EC7 1A          .     LD    A,(DE)     

+3EC8 FD 77 09    .w.   LD    (IY+09),A  ; icount

+3ECB 1C          .     INC   E          

+3ECC 1A          .     LD    A,(DE)     

+3ECD FD 77 0A    .w.   LD    (IY+0A),A  

+3ED0 C6 10       ..    ADD   A,10       

+3ED2 FD 77 0F    .w.   LD    (IY+0F),A  ; c8k

+3ED5 7E          ~     LD    A,(HL)     ; segment

+3ED6 FD 77 0B    .w.   LD    (IY+0B),A  

+3ED9 ED 43 D0 41 .C.A  LD    (41D0),BC  ;-allgemeimer Teil von createproc.

+3EDD FD E5       ..    PUSH  IY         ; IY = Leitblockaddresse des 

+3EDF D1          .     POP   DE         ; neuen Prozesses

+3EE0 1E 30       .0    LD    E,30       ; 

+3EE2 E1          .     POP   HL         ; taskindex setzen

+3EE3 ED A0       ..    LDI              

+3EE5 ED A0       ..    LDI              

+3EE7 E1          .     POP   HL         ; version

+3EE8 ED A0       ..    LDI              

+3EEA ED A0       ..    LDI              

+3EEC 1E 38       .8    LD    E,38       ; clock

+3EEE 06 08       ..    LD    B,08       

+3EF0 97          .     SUB   A          ; auf 0.0 setzen

+3EF1 12          .     LD    (DE),A     

+3EF2 1C          .     INC   E          

+3EF3 10 FC       ..    DJNZ  3EF1       

+3EF5 FD 77 2A    .w*   LD    (IY+2A),A  ; prio auf 0

+3EF8 FD 77 2B    .w+   LD    (IY+2B),A  

+3EFB 3A 13 42    :.B   LD    A,(4213)   

+3EFE 47          G     LD    B,A        

+3EFF 0E 04       ..    LD    C,04       

+3F01 FD 56 30    .V0   LD    D,(IY+30)  ; myself index

+3F04 DD CB 07 5E ...^  BIT   3,(IX+07)  ; war restart ?

+3F08 CC E8 68    ..h   CALL  Z,68E8     ; 

+3F0B DD CB 07 DE ....  SET   3,(IX+07)  ; kein restart mehr

+3F0F 0E 00       ..    LD    C,00       

+3F11 CD E8 68    ..h   CALL  68E8       

+3F14 DD CB 07 9E ....  RES   3,(IX+07) ; restart

+3F18 2A 14 42    *.B   LD    HL,(4214) ; heaptop uebertragen

+3F1B FD 75 16    .u.   LD    (IY+16),L  

+3F1E FD 74 17    .t.   LD    (IY+17),H  

+3F21 97          .     SUB   A          

+3F22 FD 77 26    .w&   LD    (IY+26),A  ; channel 0 (break)

+3F25 FD 77 27    .w'   LD    (IY+27),A  

+3F28 FD 77 04    .w.   LD    (IY+04),A  ; millis, comflg

+3F2B FD 77 05    .w.   LD    (IY+05),A  

+3F2E FD 77 07    .w.   LD    (IY+07),A  ; restart war

+3F31 FD 77 14    .w.   LD    (IY+14),A  ls_top

+3F34 FD 77 15    .w.   LD    (IY+15),A  

+3F37 FD 36 06 18 .6..  LD    (IY+06),18

+3F3B 7A          z     LD    A,D        

+3F3C CD 68 6D    .hm   CALL  6D68       

+3F3F ED 4B D0 41 .K.A  LD    BC,(41D0)  

+3F43 CD 16 42    ..B   CALL  4216       

+3F46 C3 A7 2A    ..*   JP    2AA7       

+3F49 CD 13 43    ..C   CALL  4313       ;---------- kein createprocess ---

+3F4C CD 13 43    ..C   CALL  4313       

+3F4F C3 A7 2A    ..*   JP    2AA7       ;--------- erase process ----------

+3F52 CD BA 3D    ..=   CALL  3DBA       

+3F55 DC 8B 68    ..h   CALL  C,688B     

+3F58 C3 A7 2A    ..*   JP    2AA7       ;------------ existstask ----------

+3F5B CD C2 3D    ..=   CALL  3DC2       ; leitblock holen

+3F5E D2 84 2E    ...   JP    NC,2E84    ; NC = FALSE

+3F61 FD E5       ..    PUSH  IY         

+3F63 D1          .     POP   DE         

+3F64 1E 32       .2    LD    E,32       ; version vergleichen

+3F66 C3 67 2E    .g.   JP    2E67       ;------------ send ----------------

+3F69 11 0B 42    ..B   LD    DE,420B    

+3F6C DD E5       ..    PUSH  IX         

+3F6E E1          .     POP   HL         

+3F6F 2E 30       .0    LD    L,30       ; myself index

+3F71 CD 72 40    .r@   CALL  4072       

+3F74 97          .     SUB   A          ; msgds := nilspace

+3F75 DD 77 2E    .w.   LD    (IX+2E),A  

+3F78 DD 77 2F    .w/   LD    (IX+2F),A  

+3F7B CD C2 3D    ..=   CALL  3DC2       ; Leitblock der anderen task holen

+3F7E F5          .     PUSH  AF         

+3F7F C5          .     PUSH  BC         

+3F80 D5          .     PUSH  DE         

+3F81 E5          .     PUSH  HL         

+3F82 01 0F 42    ..B   LD    BC,420F    

+3F85 CD 7A 40    .z@   CALL  407A       

+3F88 E1          .     POP   HL         

+3F89 D1          .     POP   DE         

+3F8A C1          .     POP   BC         

+3F8B F1          .     POP   AF         

+3F8C 38 1E       8.    JR    C,3FAC     

+3F8E 1A          .     LD    A,(DE)     

+3F8F FE 02       ..    CP    02         

+3F91 DA 3D 40    .=@   JP    C,403D     

+3F94 1C          .     INC   E          

+3F95 1A          .     LD    A,(DE)     

+3F96 DD BE 31    ..1   CP    (IX+31)    ; station

+3F99 CA 3D 40    .=@   JP    Z,403D     ; gleiche 

+3F9C 3A 07 42    :.B   LD    A,(4207)   

+3F9F 3D          =     DEC   A          

+3FA0 FE 7E       .~    CP    7E         

+3FA2 D2 3D 40    .=@   JP    NC,403D    

+3FA5 3C          <     INC   A          

+3FA6 CD 4D 6D    .Mm   CALL  6D4D       

+3FA9 21 09 42    !.B   LD    HL,4209    

+3FAC FD E5       ..    PUSH  IY         

+3FAE D1          .     POP   DE         

+3FAF 1E 32       .2    LD    E,32       

+3FB1 CD 6A 40    .j@   CALL  406A       

+3FB4 C2 3D 40    .=@   JP    NZ,403D    

+3FB7 FD 7E 06    .~.   LD    A,(IY+06)

+3FBA CB 87       ..    RES   0,A        

+3FBC FE BC       ..    CP    BC         

+3FBE C2 41 40    .A@   JP    NZ,4041    

+3FC1 1E 34       .4    LD    E,34       ; fromid

+3FC3 1A          .     LD    A,(DE)     

+3FC4 B7          .     OR    A          

+3FC5 28 09       (.    JR    Z,3FD0     

+3FC7 21 0B 42    !.B   LD    HL,420B    

+3FCA CD 66 40    .f@   CALL  4066       

+3FCD C2 41 40    .A@   JP    NZ,4041    

+3FD0 CD A8 2C    ..,   CALL  2CA8       

+3FD3 E5          .     PUSH  HL         

+3FD4 CD 64 43    .dC   CALL  4364       

+3FD7 5E          ^     LD    E,(HL)     

+3FD8 2C          ,     INC   L          

+3FD9 56          V     LD    D,(HL)     

+3FDA EB          .     EX    DE,HL      

+3FDB CD 70 38    .p8   CALL  3870       

+3FDE DA 61 40    .a@   JP    C,4061     

+3FE1 E5          .     PUSH  HL         

+3FE2 CD 64 43    .dC   CALL  4364       

+3FE5 97          .     SUB   A          

+3FE6 77          w     LD    (HL),A     

+3FE7 2C          ,     INC   L          

+3FE8 77          w     LD    (HL),A     

+3FE9 E1          .     POP   HL         

+3FEA EB          .     EX    DE,HL      

+3FEB C5          .     PUSH  BC         

+3FEC DD 46 30    .F0   LD    B,(IX+30)  

+3FEF 4B          K     LD    C,E        

+3FF0 FD 56 30    .V0   LD    D,(IY+30)  

+3FF3 CD E5 68    ..h   CALL  68E5       

+3FF6 C1          .     POP   BC         

+3FF7 36 FF       6.    LD    (HL),FF    

+3FF9 FD 73 2E    .s.   LD    (IY+2E),E  

+3FFC FD 7E 30    .~0   LD    A,(IY+30)  

+3FFF FD 77 2F    .w/   LD    (IY+2F),A  

+4002 21 0F 42    !.B   LD    HL,420F    

+4005 DD E5       ..    PUSH  IX         

+4007 D1          .     POP   DE         

+4008 1E 34       .4    LD    E,34       

+400A CD 72 40    .r@   CALL  4072       

+400D 21 0B 42    !.B   LD    HL,420B    

+4010 FD E5       ..    PUSH  IY         

+4012 D1          .     POP   DE         

+4013 1E 34       .4    LD    E,34       

+4015 CD 72 40    .r@   CALL  4072       

+4018 FD CB 0B 7E ...~  BIT   7,(IY+0B)  

+401C 20 08        .    JR    NZ,4026    

+401E 21 0F 42    !.B   LD    HL,420F    

+4021 1E 22       ."    LD    E,22       

+4023 CD 72 40    .r@   CALL  4072       

+4026 EB          .     EX    DE,HL      

+4027 D1          .     POP   DE         

+4028 2E 2C       .,    LD    L,2C       

+402A 73          s     LD    (HL),E     

+402B 2C          ,     INC   L          

+402C 72          r     LD    (HL),D     

+402D 2E 06       ..    LD    L,06       

+402F 36 00       6.    LD    (HL),00    

+4031 2E 07       ..    LD    L,07       

+4033 CB DE       ..    SET   3,(HL)     ; kein restart

+4035 2E 30       .0    LD    L,30       

+4037 7E          ~     LD    A,(HL)     

+4038 CD 68 6D    .hm   CALL  6D68       

+403B 97          .     SUB   A          

+403C C9          .     RET              

+403D 1E FF       ..    LD    E,FF       

+403F 18 11       ..    JR    4052       

+4041 3A 10 42    :.B   LD    A,(4210)   

+4044 DD BE 31    ..1   CP    (IX+31)    

+4047 28 07       (.    JR    Z,4050     

+4049 3A 07 42    :.B   LD    A,(4207)   

+404C B7          .     OR    A          

+404D C2 26 29    .&)   JP    NZ,2926    

+4050 1E FE       ..    LD    E,FE       

+4052 CD 13 43    ..C   CALL  4313       

+4055 CD 13 43    ..C   CALL  4313       

+4058 CD 64 43    .dC   CALL  4364       

+405B 7B          {     LD    A,E        

+405C 77          w     LD    (HL),A     

+405D 2C          ,     INC   L          

+405E 36 FF       6.    LD    (HL),FF    

+4060 C9          .     RET              

+4061 E1          .     POP   HL         

+4062 1E FD       ..    LD    E,FD       

+4064 18 F2       ..    JR    4058       

+4066 CD 6A 40    .j@   CALL  406A       

+4069 C0          .     RET   NZ         

+406A 1A          .     LD    A,(DE)     

+406B BE          .     CP    (HL)       

+406C C0          .     RET   NZ         

+406D 23          #     INC   HL         

+406E 13          .     INC   DE         

+406F 1A          .     LD    A,(DE)     

+4070 BE          .     CP    (HL)       

+4071 C9          .     RET              

+4072 C5          .     PUSH  BC         

+4073 01 04 00    ...   LD    BC,0004    

+4076 ED B0       ..    LDIR             

+4078 C1          .     POP   BC         

+4079 C9          .     RET              

+407A 1A          .     LD    A,(DE)     

+407B 02          .     LD    (BC),A     

+407C 1C          .     INC   E          

+407D 03          .     INC   BC         

+407E 1A          .     LD    A,(DE)     

+407F 02          .     LD    (BC),A     

+4080 03          .     INC   BC         

+4081 7E          ~     LD    A,(HL)     

+4082 02          .     LD    (BC),A     

+4083 2C          ,     INC   L          

+4084 03          .     INC   BC         

+4085 7E          ~     LD    A,(HL)     

+4086 02          .     LD    (BC),A     

+4087 C9          .     RET              

+4088 CD 64 43    .dC   CALL  4364       

+408B 3A 1D 6E    :.n   LD    A,(6E1D)   

+408E 57          W     LD    D,A        

+408F 1A          .     LD    A,(DE)     

+4090 77          w     LD    (HL),A     

+4091 2C          ,     INC   L          

+4092 1C          .     INC   E          

+4093 1A          .     LD    A,(DE)     

+4094 77          w     LD    (HL),A     

+4095 C9          .     RET              ;----------- sendfromto -----------

+4096 DD 7E 1D    .~.   LD    A,(IX+1D)  

+4099 FE 01       ..    CP    01         

+409B DA E6 3C    ..<   JP    C,3CE6     ; nur supervisorsoehne

+409E CD 07 44    ..D   CALL  4407       

+40A1 1C          .     INC   E          

+40A2 1A          .     LD    A,(DE)     

+40A3 1D          .     DEC   E          

+40A4 DD BE 31    ..1   CP    (IX+31)    

+40A7 28 0E       (.    JR    Z,40B7     

+40A9 C5          .     PUSH  BC         

+40AA 01 0B 42    ..B   LD    BC,420B    ; andere station

+40AD CD 7A 40    .z@   CALL  407A       

+40B0 C1          .     POP   BC         

+40B1 CD 74 3F    .t?   CALL  3F74       

+40B4 C3 A7 2A    ..*   JP    2AA7       ;------------- send ---------------

+40B7 CD 69 3F    .i?   CALL  3F69       

+40BA C3 A7 2A    ..*   JP    2AA7       ;------------ wait ----------------

+40BD DD CB 07 5E ...^  BIT   3,(IX+07)  

+40C1 20 1E        .    JR    NZ,40E1    

+40C3 CD 29 4C    .)L   CALL  4C29       

+40C6 97          .     SUB   A          

+40C7 DD 77 34    .w4   LD    (IX+34),A  

+40CA DD 77 35    .w5   LD    (IX+35),A  

+40CD DD 77 36    .w6   LD    (IX+36),A  

+40D0 DD 77 37    .w7   LD    (IX+37),A  

+40D3 DD 36 06 BC .6..  LD    (IX+06),BC ; wait zustand

+40D7 3A 1A 6E    :.n   LD    A,(6E1A)   

+40DA 3D          =     DEC   A          

+40DB CC 38 4C    .8L   CALL  Z,4C38     

+40DE C3 26 29    .&)   JP    2926       

+40E1 1E 2E       ..    LD    E,2E       

+40E3 CD 88 40    ..@   CALL  4088       

+40E6 1E 2C       .,    LD    E,2C       ; 4 Bytes auf Stack

+40E8 CD 88 40    ..@   CALL  4088       

+40EB 1E 34       .4    LD    E,34       ; 4 Bytes auf stack

+40ED D5          .     PUSH  DE         

+40EE CD 39 44    .9D   CALL  4439       

+40F1 E3          .     EX    (SP),HL    

+40F2 C5          .     PUSH  BC         

+40F3 ED A0       ..    LDI              

+40F5 ED A0       ..    LDI              

+40F7 C1          .     POP   BC         

+40F8 D1          .     POP   DE         

+40F9 C5          .     PUSH  BC         

+40FA ED A0       ..    LDI              

+40FC ED A0       ..    LDI              

+40FE C1          .     POP   BC         

+40FF DD CB 07 9E ....  RES   3,(IX+07)  ; restart

+4103 C3 A7 2A    ..*   JP    2AA7       ;--------------- call -------------

+4106 DD CB 07 5E ...^  BIT   3,(IX+07)  

+410A 20 2E        .    JR    NZ,413A    

+410C CD 69 3F    .i?   CALL  3F69       

+410F B7          .     OR    A          

+4110 28 14       (.    JR    Z,4126      

+4112 FE FE       ..    CP    FE         

+4114 C2 A7 2A    ..*   JP    NZ,2AA7    

+4117 FD E5       ..    PUSH  IY         

+4119 E1          .     POP   HL         

+411A DD E5       ..    PUSH  IX         

+411C D1          .     POP   DE         

+411D B7          .     OR    A          

+411E ED 52       .R    SBC   HL,DE      

+4120 CA A7 2A    ..*   JP    Z,2AA7     

+4123 C3 26 29    .&)   JP    2926       

+4126 3E BC       >.    LD    A,BC       ; wait

+4128 C3 23 29    .#)   JP    2923       ;-------------- pingpong ----------

+412B DD CB 07 5E ...^  BIT   3,(IX+07)  

+412F 20 09        .    JR    NZ,413A    

+4131 CD 69 3F    .i?   CALL  3F69       

+4134 B7          .     OR    A          

+4135 28 EF       (.    JR    Z,4126     

+4137 C3 A7 2A    ..*   JP    2AA7       

+413A CD 43 44    .CD   CALL  4443       

+413D CD 43 44    .CD   CALL  4443       

+4140 1E 2E       ..    LD    E,2E       

+4142 CD 88 40    ..@   CALL  4088       

+4145 1E 2C       .,    LD    E,2C       

+4147 CD 88 40    ..@   CALL  4088       

+414A DD CB 07 9E ....  RES   3,(IX+07)  

+414E C3 A7 2A    ..*   JP    2AA7       ;--------- define collector -------

+4151 DD 7E 1D    .~.   LD    A,(IX+1D)  ; nur von supervisorsoehnen

+4154 FE 01       ..    CP    01         

+4156 DA E6 3C    ..<   JP    C,3CE6     

+4159 CD 07 44    ..D   CALL  4407       

+415C C5          .     PUSH  BC         

+415D 01 07 42    ..B   LD    BC,4207    

+4160 CD 7A 40    .z@   CALL  407A       

+4163 C1          .     POP   BC         

+4164 C3 A7 2A    ..*   JP    2AA7       ;------------- session ------------

+4167 ED 5B 17 6B .[.k  LD    DE,(6B17)  

+416B C3 03 2D    ..-   JP    2D03       ;----------------- id -------------

+416E CD 13 43    ..C   CALL  4313       

+4171 7E          ~     LD    A,(HL)     

+4172 E6 07       ..    AND   07         

+4174 21 8F 82    !..   LD    HL,828F    

+4177 5F          _     LD    E,A        

+4178 D6 04       ..    SUB   A,04       

+417A 38 04       8.    JR    C,4180     

+417C 21 6F 28    !o(   LD    HL,286F    

+417F 5F          _     LD    E,A        

+4180 16 00       ..    LD    D,00       

+4182 19          .     ADD   HL,DE      

+4183 19          .     ADD   HL,DE      

+4184 C3 00 2D    ..-   JP    2D00       ;- infopassword ("alt","neu",ok)

+4187 11 F3 41    ..A   LD    DE,41F3

+418A CD A9 41    ..A   CALL  41A9       ; Wort --> 41F3 holen

+418D 11 FD 41    ..A   LD    DE,41FD    

+4190 CD A9 41    ..A   CALL  41A9       ; Wort --> 41FD holen

+4193 CD 64 43    .dC   CALL  4364       ; REF-addr holen

+4196 C5          .     PUSH  BC         

+4197 E5          .     PUSH  HL         

+4198 21 F3 41    !.A   LD    HL,41F3    

+419B 11 FD 41    ..A   LD    DE,41FD    

+419E CD 10 6F    ..o   CALL  6F10       ; 10 bytes invertieren und kopieren

+41A1 E1          .     POP   HL         

+41A2 71          q     LD    (HL),C     ; enthaelt 0, wenn ok

+41A3 2C          ,     INC   L          

+41A4 70          p     LD    (HL),B     

+41A5 C1          .     POP   BC         

+41A6 C3 A7 2A    ..*   JP    2AA7       

+41A9 D5          .     PUSH  DE         

+41AA CD 8D 46    ..F   CALL  468D       ; Word --> HL holen

+41AD D1          .     POP   DE         

+41AE C5          .     PUSH  BC         

+41AF 06 0A       ..    LD    B,0A       ; 10 mal

+41B1 7E          ~     LD    A,(HL)     

+41B2 12          .     LD    (DE),A     

+41B3 13          .     INC   DE         

+41B4 D5          .     PUSH  DE         

+41B5 11 01 00    ...   LD    DE,0001    

+41B8 CD 0D 45    ..E   CALL  450D       ; HL INCR 1

+41BB D1          .     POP   DE         

+41BC 10 F3       ..    DJNZ  41B1       

+41BE C1          .     POP   BC         

+41BF C9          .     RET              ;========= EXTERNALS ENDE ========

+41C0 20 52        R    JR    NZ,4214    ; " REG"

+41C2 45          E     LD    B,L        

+41C3 47          G     LD    B,A        

+41C4 00          .     NOP              

+41C5 00          .     NOP              

+41C6 00          .     NOP              

+41C7 00          .     NOP              

+41C8 00          .     NOP              

+41C9 00          .     NOP              

+41CA 00          .     NOP              

+41CB 00          .     NOP              

+41CC 00          .     NOP              

+41CD 00          .     NOP              

+41CE 00          .     NOP              

+41CF 00          .     NOP              

+41D0 00          .     NOP              

+41D1 00          .     NOP              

+41D2 00          .     NOP              

+41D3 00          .     NOP              

+41D4 00          .     NOP              

+41D5 00          .     NOP              

+41D6 00          .     NOP              

+41D7 00          .     NOP              

+41D8 00          .     NOP              

+41D9 00          .     NOP              

+41DA 00          .     NOP              

+41DB 00          .     NOP              

+41DC 00          .     NOP              

+41DD 01 00 00    ...   LD    BC,0000    

+41E0 00          .     NOP              

+41E1 00          .     NOP              

+41E2 00          .     NOP              

+41E3 00          .     NOP              

+41E4 00          .     NOP              

+41E5 00          .     NOP              

+41E6 00          .     NOP              

+41E7 02          .     LD    (BC),A     

+41E8 20 20             JR    NZ,420A    

+41EA 20 20             JR    NZ,420C    

+41EC 20 08        .    JR    NZ,41F6    

+41EE 08          .     EX    AF,AF'     

+41EF 08          .     EX    AF,AF'     

+41F0 08          .     EX    AF,AF'     

+41F1 08          .     EX    AF,AF'     

+41F2 08          .     EX    AF,AF'     

+41F3 00          .     NOP              

+41F4 00          .     NOP              

+41F5 00          .     NOP              

+41F6 00          .     NOP              

+41F7 00          .     NOP              

+41F8 00          .     NOP              

+41F9 00          .     NOP              

+41FA 00          .     NOP              

+41FB 00          .     NOP              

+41FC 00          .     NOP              

+41FD 00          .     NOP              

+41FE 00          .     NOP              

+41FF 00          .     NOP              

+4200 00          .     NOP              

+4201 00          .     NOP              

+4202 00          .     NOP              

+4203 00          .     NOP              

+4204 00          .     NOP              

+4205 00          .     NOP              

+4206 00          .     NOP              

+4207 00          .     NOP              

+4208 00          .     NOP              

+4209 00          .     NOP              

+420A 00          .     NOP              

+420B 00          .     NOP              

+420C 00          .     NOP              

+420D 00          .     NOP              

+420E 00          .     NOP              

+420F 00          .     NOP              

+4210 00          .     NOP              

+4211 00          .     NOP              

+4212 00          .     NOP              

+4213 00          .     NOP              

+4214 00          .     NOP              

+4215 00          .     NOP              

+4216 97          .     SUB   A          

+4217 32 00 19    2..   LD    (1900),A   

+421A 32 00 19    2..   LD    (1900),A   

+421D 32 00 19    2..   LD    (1900),A   

+4220 32 00 19    2..   LD    (1900),A   

+4223 32 00 19    2..   LD    (1900),A   

+4226 32 00 19    2..   LD    (1900),A   

+4229 32 00 19    2..   LD    (1900),A   

+422C 32 00 19    2..   LD    (1900),A   

+422F 32 00 19    2..   LD    (1900),A   

+4232 32 00 19    2..   LD    (1900),A   

+4235 32 00 19    2..   LD    (1900),A   

+4238 32 00 19    2..   LD    (1900),A   

+423B 32 00 19    2..   LD    (1900),A   

+423E 32 00 19    2..   LD    (1900),A   

+4241 32 00 19    2..   LD    (1900),A   

+4244 32 00 19    2..   LD    (1900),A   

+4247 32 00 19    2..   LD    (1900),A   

+424A 32 00 19    2..   LD    (1900),A   

+424D 32 00 19    2..   LD    (1900),A   

+4250 32 00 19    2..   LD    (1900),A   

+4253 32 00 19    2..   LD    (1900),A   

+4256 32 00 19    2..   LD    (1900),A   

+4259 32 00 19    2..   LD    (1900),A   

+425C 32 00 19    2..   LD    (1900),A   

+425F 32 00 19    2..   LD    (1900),A   

+4262 B7          .     OR    A          

+4263 21 00 00    !..   LD    HL,0000    

+4266 22 75 46    "uF   LD    (4675),HL  

+4269 21 18 42    !.B   LD    HL,4218    

+426C 22 72 42    "rB   LD    (4272),HL  

+426F C9          .     RET              

+4270 EB          .     EX    DE,HL      

+4271 22 18 42    ".B   LD    (4218),HL  

+4274 2A 72 42    *rB   LD    HL,(4272)  

+4277 23          #     INC   HL         

+4278 23          #     INC   HL         

+4279 CB 7E       .~    BIT   7,(HL)     

+427B 23          #     INC   HL         

+427C 22 72 42    "rB   LD    (4272),HL  

+427F EB          .     EX    DE,HL      

+4280 C8          .     RET   Z          

+4281 CD 16 42    ..B   CALL  4216       

+4284 C3 26 29    .&)   JP    2926       

+4287 08          .     EX    AF,AF'     

+4288 F6 01       ..    OR    01         

+428A 08          .     EX    AF,AF'     

+428B CB 40       .@    BIT   0,B        

+428D 20 06        .    JR    NZ,4295    

+428F 04          .     INC   B          

+4290 DD CB 09 FE ....  SET   7,(IX+09)  

+4294 C9          .     RET              

+4295 F5          .     PUSH  AF         

+4296 D5          .     PUSH  DE         

+4297 E5          .     PUSH  HL         

+4298 DD CB 09 BE ....  RES   7,(IX+09)  

+429C DD 34       .4    INC   (IX+0A)    

+429E 0A          .     LD    A,(BC)     

+429F CD AB 42    ..B   CALL  42AB       

+42A2 87          .     ADD   A          

+42A3 47          G     LD    B,A        

+42A4 E1          .     POP   HL         

+42A5 D1          .     POP   DE         

+42A6 F1          .     POP   AF         

+42A7 C9          .     RET              

+42A8 97          .     SUB   A          

+42A9 18 DF       ..    JR    428A       

+42AB DD 66 0A    .f.   LD    H,(IX+0A)  

+42AE DD 7E 0B    .~.   LD    A,(IX+0B)  

+42B1 E6 03       ..    AND   03         

+42B3 5F          _     LD    E,A        

+42B4 FE 02       ..    CP    02         

+42B6 20 07        .    JR    NZ,42BF    

+42B8 CD 48 5F    .H_   CALL  5F48        ; Segment 2 ist Ausnahme

+42BB C0          .     RET   NZ         

+42BC DD 66 0A    .f.   LD    H,(IX+0A)  

+42BF 7B          {     LD    A,E        

+42C0 C6 19       ..    ADD   A,19       

+42C2 57          W     LD    D,A        

+42C3 5C          \     LD    E,H        

+42C4 1A          .     LD    A,(DE)     

+42C5 B7          .     OR    A          

+42C6 C0          .     RET   NZ         

+42C7 D5          .     PUSH  DE         

+42C8 7A          z     LD    A,D        

+42C9 CD 70 42    .pB   CALL  4270       

+42CC D6 19       ..    SUB   A,19       

+42CE 5F          _     LD    E,A        

+42CF 16 04       ..    LD    D,04       

+42D1 FE 02       ..    CP    02         

+42D3 20 05        .    JR    NZ,42DA    

+42D5 CD 55 65    .Ue   CALL  6555       

+42D8 18 03       ..    JR    42DD       

+42DA CD 5C 65    .\e   CALL  655C       

+42DD 0F          .     RRCA             

+42DE E1          .     POP   HL         

+42DF 77          w     LD    (HL),A     

+42E0 C9          .     RET              

+42E1 CB 1C       ..    RR    H          

+42E3 CB 1D       ..    RR    L          

+42E5 D5          .     PUSH  DE         

+42E6 63          c     LD    H,E        

+42E7 7A          z     LD    A,D        

+42E8 CD 70 42    .pB   CALL  4270       

+42EB D6 19       ..    SUB   A,19       

+42ED 5F          _     LD    E,A        

+42EE 16 04       ..    LD    D,04       

+42F0 CD 5C 65    .\e   CALL  655C       

+42F3 D1          .     POP   DE         

+42F4 0F          .     RRCA             

+42F5 12          .     LD    (DE),A     

+42F6 67          g     LD    H,A        

+42F7 29          )     ADD   HL,HL      

+42F8 C9          .     RET              

+42F9 CB 1C       ..    RR    H          

+42FB CB 1D       ..    RR    L          

+42FD D5          .     PUSH  DE         

+42FE 63          c     LD    H,E        

+42FF 7A          z     LD    A,D        

+4300 CD 70 42    .pB   CALL  4270       

+4303 D6 19       ..    SUB   A,19       

+4305 5F          _     LD    E,A        

+4306 16 04       ..    LD    D,04       

+4308 CD 2C 66    .,f   CALL  662C       

+430B D1          .     POP   DE         

+430C 0F          .     RRCA             

+430D 67          g     LD    H,A        

+430E F6 80       ..    OR    80         

+4310 12          .     LD    (DE),A     

+4311 29          )     ADD   HL,HL      

+4312 C9          .     RET              ;---------------------------------

+4313 0A          .     LD    A,(BC)     ; Naechstes Codewort holen --> HL

+4314 6F          o     LD    L,A        

+4315 0C          .     INC   C          

+4316 0A          .     LD    A,(BC)     

+4317 0C          .     INC   C          

+4318 CC 87 42    ..B   CALL  Z,4287     

+431B B7          .     OR    A          

+431C FA 32 43    .2C   JP    M,4332     

+431F D9          .     EXX              

+4320 81          .     ADD   C          

+4321 5F          _     LD    E,A        

+4322 1A          .     LD    A,(DE)     

+4323 D9          .     EXX              

+4324 67          g     LD    H,A        

+4325 29          )     ADD   HL,HL      

+4326 B7          .     OR    A          

+4327 C0          .     RET   NZ         

+4328 D5          .     PUSH  DE         

+4329 D9          .     EXX              

+432A D5          .     PUSH  DE         

+432B D9          .     EXX              

+432C D1          .     POP   DE         

+432D CD E1 42    ..B   CALL  42E1       

+4330 D1          .     POP   DE         

+4331 C9          .     RET              

+4332 D5          .     PUSH  DE         

+4333 ED 5B C4 41 .[.A  LD    DE,(41C4)  

+4337 E6 7F       ..    AND   7F         

+4339 1F          .     RRA              

+433A CB 1D       ..    RR    L          

+433C 67          g     LD    H,A        

+433D 38 0C       8.    JR    C,434B     

+433F 19          .     ADD   HL,DE      

+4340 5C          \     LD    E,H        

+4341 16 1A       ..    LD    D,1A       

+4343 1A          .     LD    A,(DE)     

+4344 67          g     LD    H,A        

+4345 29          )     ADD   HL,HL      

+4346 B7          .     OR    A          

+4347 28 E4       (.    JR    Z,432D     

+4349 D1          .     POP   DE         

+434A C9          .     RET              

+434B CD DE 43    ..C   CALL  43DE       

+434E 20 0C        .    JR    NZ,435C    

+4350 C6 19       ..    ADD   A,19       

+4352 57          W     LD    D,A        

+4353 5C          \     LD    E,H        

+4354 1A          .     LD    A,(DE)     

+4355 67          g     LD    H,A        

+4356 29          )     ADD   HL,HL      

+4357 B7          .     OR    A          

+4358 28 D3       (.    JR    Z,432D     

+435A D1          .     POP   DE         

+435B C9          .     RET              

+435C CD 5C 65    .\e   CALL  655C       

+435F 0F          .     RRCA             

+4360 67          g     LD    H,A        

+4361 29          )     ADD   HL,HL      

+4362 D1          .     POP   DE         

+4363 C9          .     RET              

+4364 0A          .     LD    A,(BC)     

+4365 6F          o     LD    L,A        

+4366 0C          .     INC   C          

+4367 0A          .     LD    A,(BC)     

+4368 0C          .     INC   C          

+4369 CC 87 42    ..B   CALL  Z,4287     

+436C B7          .     OR    A          

+436D FA 82 43    ..C   JP    M,4382     

+4370 D9          .     EXX              

+4371 81          .     ADD   C          

+4372 5F          _     LD    E,A        

+4373 1A          .     LD    A,(DE)     

+4374 D9          .     EXX              

+4375 67          g     LD    H,A        

+4376 29          )     ADD   HL,HL      

+4377 D8          .     RET   C          

+4378 D5          .     PUSH  DE         

+4379 D9          .     EXX              

+437A D5          .     PUSH  DE         

+437B D9          .     EXX              

+437C D1          .     POP   DE         

+437D CD F9 42    ..B   CALL  42F9       

+4380 D1          .     POP   DE         

+4381 C9          .     RET              

+4382 D5          .     PUSH  DE         

+4383 ED 5B C4 41 .[.A  LD    DE,(41C4)  

+4387 E6 7F       ..    AND   7F         

+4389 1F          .     RRA              

+438A CB 1D       ..    RR    L          

+438C 67          g     LD    H,A        

+438D 38 10       8.    JR    C,439F     

+438F 19          .     ADD   HL,DE      

+4390 5C          \     LD    E,H        

+4391 16 1A       ..    LD    D,1A       

+4393 1A          .     LD    A,(DE)     

+4394 67          g     LD    H,A        

+4395 29          )     ADD   HL,HL      

+4396 7B          {     LD    A,E        

+4397 D1          .     POP   DE         

+4398 D8          .     RET   C          

+4399 D5          .     PUSH  DE         

+439A 5F          _     LD    E,A        

+439B 16 1A       ..    LD    D,1A       

+439D 18 DE       ..    JR    437D       

+439F CD DE 43    ..C   CALL  43DE       

+43A2 20 0C        .    JR    NZ,43B0    

+43A4 C6 19       ..    ADD   A,19       

+43A6 57          W     LD    D,A        

+43A7 5C          \     LD    E,H        

+43A8 1A          .     LD    A,(DE)     

+43A9 67          g     LD    H,A        

+43AA 29          )     ADD   HL,HL      

+43AB D4 F9 42    ..B   CALL  NC,42F9    

+43AE D1          .     POP   DE         

+43AF C9          .     RET              

+43B0 CD 2C 66    .,f   CALL  662C       

+43B3 0F          .     RRCA             

+43B4 67          g     LD    H,A        

+43B5 29          )     ADD   HL,HL      

+43B6 D1          .     POP   DE         

+43B7 C9          .     RET              ;------------ REF-Addr vom Stack

+43B8 0A          .     LD    A,(BC)     ; --> HL, DE

+43B9 6F          o     LD    L,A        

+43BA 0C          .     INC   C          

+43BB 0A          .     LD    A,(BC)     

+43BC 0C          .     INC   C          

+43BD CC 87 42    ..B   CALL  Z,4287     

+43C0 B7          .     OR    A          

+43C1 FA CC 43    ..C   JP    M,43CC     

+43C4 D9          .     EXX              

+43C5 81          .     ADD   C          

+43C6 D9          .     EXX              

+43C7 67          g     LD    H,A        

+43C8 97          .     SUB   A          

+43C9 5F          _     LD    E,A        

+43CA 57          W     LD    D,A        

+43CB C9          .     RET              ;----------------------------------

+43CC ED 5B C4 41 .[.A  LD    DE,(41C4)  

+43D0 E6 7F       ..    AND   7F         

+43D2 1F          .     RRA              

+43D3 CB 1D       ..    RR    L          

+43D5 67          g     LD    H,A        

+43D6 38 06       8.    JR    C,43DE     

+43D8 19          .     ADD   HL,DE      

+43D9 97          .     SUB   A          

+43DA 11 01 00    ...   LD    DE,0001    

+43DD C9          .     RET              

+43DE 19          .     ADD   HL,DE      

+43DF 16 1A       ..    LD    D,1A       

+43E1 5C          \     LD    E,H        

+43E2 1A          .     LD    A,(DE)     

+43E3 67          g     LD    H,A        

+43E4 29          )     ADD   HL,HL      

+43E5 B7          .     OR    A          

+43E6 CC E1 42    ..B   CALL  Z,42E1     

+43E9 5E          ^     LD    E,(HL)     

+43EA 2C          ,     INC   L          

+43EB 56          V     LD    D,(HL)     

+43EC 2C          ,     INC   L          

+43ED 7E          ~     LD    A,(HL)     

+43EE 2C          ,     INC   L          

+43EF 66          f     LD    H,(HL)     

+43F0 EB          .     EX    DE,HL      

+43F1 14          .     INC   D          

+43F2 15          .     DEC   D          

+43F3 20 07        .    JR    NZ,43FC    

+43F5 FE 06       ..    CP    06         

+43F7 30 03       0.    JR    NC,43FC    

+43F9 5F          _     LD    E,A        

+43FA BF          .     CP    A          

+43FB C9          .     RET              

+43FC E6 07       ..    AND   07         

+43FE 5F          _     LD    E,A        

+43FF 7A          z     LD    A,D        

+4400 FE 04       ..    CP    04         

+4402 7B          {     LD    A,E        

+4403 D0          .     RET   NC         

+4404 16 05       ..    LD    D,05       

+4406 C9          .     RET              ;----------------------------------

+4407 0A          .     LD    A,(BC)     

+4408 6F          o     LD    L,A        

+4409 0C          .     INC   C          

+440A 0A          .     LD    A,(BC)     

+440B CD 1B 43    ..C   CALL  431B       

+440E 54          T     LD    D,H        

+440F 5D          ]     LD    E,L        

+4410 2C          ,     INC   L          

+4411 2C          ,     INC   L          

+4412 28 05       (.    JR    Z,4419     

+4414 0C          .     INC   C          

+4415 C0          .     RET   NZ         

+4416 C3 87 42    ..B   JP    4287       

+4419 0D          .     DEC   C          

+441A FD 21 85 46 .!.F  LD    IY,4685    

+441E FD CB 00 C6 ....  SET   0,(IY+00)  

+4422 CD B8 43    ..C   CALL  43B8       

+4425 7D          }     LD    A,L        

+4426 32 86 46    2.F   LD    (4686),A   

+4429 ED 53 87 46 .S.F  LD    (4687),DE  

+442D 7B          {     LD    A,E        

+442E CD CA 44    ..D   CALL  44CA       

+4431 54          T     LD    D,H        

+4432 5D          ]     LD    E,L        

+4433 2C          ,     INC   L          

+4434 2C          ,     INC   L          

+4435 CC 1B 45    ..E   CALL  Z,451B     

+4438 C9          .     RET              

+4439 FD 21 85 46 .!.F  LD    IY,4685    

+443D FD CB 00 86 ....  RES   0,(IY+00)  

+4441 18 DF       ..    JR    4422       ;-------- Branchaddresse holen -----

+4443 0A          .     LD    A,(BC)     

+4444 5F          _     LD    E,A        

+4445 0C          .     INC   C          

+4446 0A          .     LD    A,(BC)     

+4447 57          W     LD    D,A        

+4448 0C          .     INC   C          

+4449 C0          .     RET   NZ         

+444A C3 87 42    ..B   JP    4287       

+444D FE 06       ..    CP    06         

+444F 30 0C       0.    JR    NC,445D    

+4451 C6 19       ..    ADD   A,19       

+4453 57          W     LD    D,A        

+4454 5C          \     LD    E,H        

+4455 1A          .     LD    A,(DE)     

+4456 67          g     LD    H,A        

+4457 29          )     ADD   HL,HL      

+4458 B7          .     OR    A          

+4459 C0          .     RET   NZ         

+445A C3 E1 42    ..B   JP    42E1       

+445D ED 5B 75 46 .[uF  LD    DE,(4675)  

+4461 7C          |     LD    A,H        

+4462 BA          .     CP    D          

+4463 20 07        .    JR    NZ,446C    

+4465 7B          {     LD    A,E        

+4466 B7          .     OR    A          

+4467 28 03       (.    JR    Z,446C     

+4469 63          c     LD    H,E        

+446A 29          )     ADD   HL,HL      

+446B C9          .     RET              

+446C 16 04       ..    LD    D,04       

+446E 1E 07       ..    LD    E,07       

+4470 CD 5C 65    .\e   CALL  655C       

+4473 0F          .     RRCA             

+4474 5F          _     LD    E,A        

+4475 54          T     LD    D,H        

+4476 ED 53 75 46 .SuF  LD    (4675),DE  

+447A 63          c     LD    H,E        

+447B 29          )     ADD   HL,HL      

+447C C9          .     RET              

+447D FE 06       ..    CP    06         

+447F 30 0B       0.    JR    NC,448C    

+4481 C6 19       ..    ADD   A,19       

+4483 57          W     LD    D,A        

+4484 5C          \     LD    E,H        

+4485 1A          .     LD    A,(DE)     

+4486 67          g     LD    H,A        

+4487 29          )     ADD   HL,HL      

+4488 D8          .     RET   C          

+4489 C3 F9 42    ..B   JP    42F9       

+448C ED 5B 75 46 .[uF  LD    DE,(4675)  

+4490 7C          |     LD    A,H        

+4491 BA          .     CP    D          

+4492 20 07        .    JR    NZ,449B    

+4494 7B          {     LD    A,E        

+4495 87          .     ADD   A          

+4496 30 03       0.    JR    NC,449B    

+4498 63          c     LD    H,E        

+4499 29          )     ADD   HL,HL      

+449A C9          .     RET              

+449B 16 04       ..    LD    D,04       

+449D 1E 07       ..    LD    E,07       

+449F CD 2C 66    .,f   CALL  662C       

+44A2 0F          .     RRCA             

+44A3 F6 80       ..    OR    80         

+44A5 18 CD       ..    JR    4474       

+44A7 CD 13 43    ..C   CALL  4313       

+44AA 7D          }     LD    A,L        

+44AB E6 F8       ..    AND   F8         

+44AD 6F          o     LD    L,A        

+44AE C9          .     RET              

+44AF CD 1B 43    ..C   CALL  431B       

+44B2 7D          }     LD    A,L        

+44B3 E6 F8       ..    AND   F8         

+44B5 6F          o     LD    L,A        

+44B6 C9          .     RET              

+44B7 CD 64 43    .dC   CALL  4364       

+44BA 7D          }     LD    A,L        

+44BB E6 F8       ..    AND   F8         

+44BD 6F          o     LD    L,A        

+44BE C9          .     RET              

+44BF 5D          ]     LD    E,L        

+44C0 7D          }     LD    A,L        

+44C1 E6 F0       ..    AND   F0         

+44C3 6F          o     LD    L,A        

+44C4 AB          .     XOR   E          

+44C5 1F          .     RRA              

+44C6 CB 1C       ..    RR    H          

+44C8 CB 1D       ..    RR    L          

+44CA FD 74 01    .t.   LD    (IY+01),H  

+44CD FD 77 02    .w.   LD    (IY+02),A  

+44D0 5F          _     LD    E,A        

+44D1 FD 7E 03    .~.   LD    A,(IY+03)  

+44D4 B7          .     OR    A          

+44D5 20 15        .    JR    NZ,44EC    ; Fremdatenraum

+44D7 7B          {     LD    A,E        ; DS4 = 0

+44D8 C6 19       ..    ADD   A,19       

+44DA 57          W     LD    D,A        

+44DB 5C          \     LD    E,H

+44DC 1A          .     LD    A,(DE)     ; DE=1900+256*segment+AddrDIV256

+44DD 67          g     LD    H,A        

+44DE 29          )     ADD   HL,HL      ; In Byteaddresse wandeln

+44DF D8          .     RET   C          

+44E0 FD CB 00 46 ...F  BIT   0,(IY+00)  

+44E4 CA F9 42    ..B   JP    Z,42F9     

+44E7 B7          .     OR    A          

+44E8 C0          .     RET   NZ         

+44E9 C3 E1 42    ..B   JP    42E1       

+44EC 57          W     LD    D,A        

+44ED FD CB 00 46 ...F  BIT   0,(IY+00)  

+44F1 20 05        .    JR    NZ,44F8    

+44F3 CD 2C 66    .,f   CALL  662C       

+44F6 18 03       ..    JR    44FB       

+44F8 CD 5C 65    .\e   CALL  655C       

+44FB 0F          .     RRCA             

+44FC 67          g     LD    H,A        

+44FD 29          )     ADD   HL,HL      

+44FE C9          .     RET              

+44FF CB 3F       .?    SLR   A          

+4501 CB 1C       ..    RR    H          

+4503 CB 1D       ..    RR    L          

+4505 F5          .     PUSH  AF         

+4506 CD CA 44    ..D   CALL  44CA       

+4509 F1          .     POP   AF         

+450A D0          .     RET   NC         

+450B 2C          ,     INC   L          

+450C C9          .     RET              ;---------------------------------

+450D 7D          }     LD    A,L        

+450E 83          .     ADD   E          

+450F 3E 00       >.    LD    A,00       

+4511 8A          .     ADC   D          

+4512 20 02        .    JR    NZ,4516    

+4514 19          .     ADD   HL,DE      

+4515 C9          .     RET              

+4516 3D          =     DEC   A          

+4517 20 0D        .    JR    NZ,4526    

+4519 19          .     ADD   HL,DE      

+451A 25          %     DEC   H          

+451B 24          $     INC   H          

+451C CB 44       .D    BIT   0,H        

+451E C0          .     RET   NZ         

+451F 25          %     DEC   H          

+4520 D5          .     PUSH  DE         

+4521 11 00 01    ...   LD    DE,0100    

+4524 18 01       ..    JR    4527       

+4526 D5          .     PUSH  DE         

+4527 97          .     SUB   A          

+4528 CB 1C       ..    RR    H          

+452A FD 66 01    .f.   LD    H,(IY+01)  

+452D CB 14       ..    RL    H          

+452F 17          .     RLA              

+4530 19          .     ADD   HL,DE      

+4531 CE 00       ..    ADC   A,00       

+4533 1F          .     RRA              

+4534 CB 1C       ..    RR    H          

+4536 CB 1D       ..    RR    L          

+4538 F5          .     PUSH  AF         

+4539 FD 86 02    ...   ADD   (IY+02)    

+453C CD CA 44    ..D   CALL  44CA       

+453F F1          .     POP   AF         

+4540 D1          .     POP   DE         

+4541 D0          .     RET   NC         

+4542 2C          ,     INC   L          

+4543 C9          .     RET              

+4544 D5          .     PUSH  DE         

+4545 11 00 00    ...   LD    DE,0000    

+4548 CD 78 45    .xE   CALL  4578       

+454B D1          .     POP   DE         

+454C C9          .     RET              

+454D 2A 79 46    *yF   LD    HL,(4679)  

+4550 DD 75 0C    .u.   LD    (IX+0C),L  

+4553 DD 74 0D    .t.   LD    (IX+0D),H  

+4556 DD CB 07 AE ....  RES   5,(IX+07)  

+455A DD CB 07 F6 ....  SET   6,(IX+07)  

+455E C9          .     RET              

+455F 69          i     LD    L,C        

+4560 60          `     LD    H,B        

+4561 DD 4E 0C    .N.   LD    C,(IX+0C)  

+4564 DD 46 0D    .F.   LD    B,(IX+0D)  

+4567 B7          .     OR    A          

+4568 ED 42       .B    SBC   HL,BC      

+456A 22 7B 46    "{F   LD    (467B),HL  

+456D ED 43 79 46 .CyF  LD    (4679),BC  

+4571 CD C1 45    ..E   CALL  45C1       

+4574 DD CB 07 B6 ....  RES   6,(IX+07)  

+4578 22 7D 46    "}F   LD    (467D),HL  

+457B ED 53 7F 46 .S.F  LD    (467F),DE  

+457F DD CB 07 76 ...v  BIT   6,(IX+07)  

+4583 20 DA        .    JR    NZ,455F    

+4585 7B          {     LD    A,E        

+4586 BD          .     CP    L          

+4587 30 01       0.    JR    NC,458A    

+4589 7D          }     LD    A,L        

+458A ED 44       .D    NEG              

+458C 28 0F       (.    JR    Z,459D     

+458E 04          .     INC   B          

+458F 05          .     DEC   B          

+4590 20 12        .    JR    NZ,45A4    

+4592 B9          .     CP    C          

+4593 38 0F       8.    JR    C,45A4     

+4595 78          x     LD    A,B        

+4596 B1          .     OR    C          

+4597 C9          .     RET              

+4598 2A 7D 46    *}F   LD    HL,(467D)  

+459B 18 F8       ..    JR    4595       

+459D 04          .     INC   B          

+459E 05          .     DEC   B          

+459F 28 F4       (.    JR    Z,4595     

+45A1 37          7     SCF              

+45A2 18 01       ..    JR    45A5       

+45A4 B7          .     OR    A          

+45A5 69          i     LD    L,C        

+45A6 60          `     LD    H,B        

+45A7 4F          O     LD    C,A        

+45A8 3E 00       >.    LD    A,00       

+45AA 8F          .     ADC   A          

+45AB 47          G     LD    B,A        

+45AC B7          .     OR    A          

+45AD ED 42       .B    SBC   HL,BC      

+45AF 28 E7       (.    JR    Z,4598     

+45B1 DD CB 07 EE ....  SET   5,(IX+07)  

+45B5 ED 43 7B 46 .C{F  LD    (467B),BC  

+45B9 22 79 46    "yF   LD    (4679),HL  

+45BC 2A 7D 46    *}F   LD    HL,(467D)  

+45BF 37          7     SCF              

+45C0 C9          .     RET              

+45C1 2A 7F 46    *.F   LD    HL,(467F)  

+45C4 7C          |     LD    A,H        

+45C5 B5          .     OR    L          

+45C6 28 0C       (.    JR    Z,45D4     

+45C8 FD 21 89 46 .!.F  LD    IY,4689    

+45CC ED 5B 7B 46 .[{F  LD    DE,(467B)  

+45D0 CD 0D 45    ..E   CALL  450D       

+45D3 EB          .     EX    DE,HL      

+45D4 D5          .     PUSH  DE         

+45D5 2A 7D 46    *}F   LD    HL,(467D)  

+45D8 FD 21 85 46 .!.F  LD    IY,4685    

+45DC ED 5B 7B 46 .[{F  LD    DE,(467B)  

+45E0 CD 0D 45    ..E   CALL  450D       

+45E3 D1          .     POP   DE         

+45E4 ED 4B 79 46 .KyF  LD    BC,(4679)  

+45E8 DD CB 07 B6 ....  RES   6,(IX+07)  

+45EC DD CB 07 AE ....  RES   5,(IX+07)  

+45F0 C9          .     RET              

+45F1 DD CB 07 6E ...n  BIT   5,(IX+07)  

+45F5 28 0D       (.    JR    Z,4604     

+45F7 E5          .     PUSH  HL         

+45F8 2A 79 46    *yF   LD    HL,(4679)  

+45FB 22 77 46    "wF   LD    (4677),HL  

+45FE 09          .     ADD   HL,BC      

+45FF 22 79 46    "yF   LD    (4679),HL  

+4602 E1          .     POP   HL         

+4603 C9          .     RET              

+4604 3E FF       >.    LD    A,FF       

+4606 32 78 46    2xF   LD    (4678),A   

+4609 DD CB 07 EE ....  SET   5,(IX+07)  

+460D ED 43 79 46 .CyF  LD    (4679),BC  

+4611 C9          .     RET              

+4612 2A 77 46    *wF   LD    HL,(4677)  

+4615 CB 7C       .|    BIT   7,H        

+4617 20 D3        .    JR    NZ,45EC    

+4619 22 79 46    "yF   LD    (4679),HL  

+461C C9          .     RET              

+461D ED 43 81 46 .C.F  LD    (4681),BC  

+4621 1B          .     DEC   DE         

+4622 7B          {     LD    A,E        

+4623 B2          .     OR    D          

+4624 C8          .     RET   Z          

+4625 FD 21 85 46 .!.F  LD    IY,4685    

+4629 CD 0D 45    ..E   CALL  450D       

+462C 79          y     LD    A,C        

+462D 93          .     SUB   E          ; BC DECR DE

+462E 4F          O     LD    C,A        

+462F 78          x     LD    A,B        

+4630 9A          .     SBC   D          

+4631 47          G     LD    B,A        

+4632 C9          .     RET              ;-----------------------------------

+4633 2A 81 46    *.F   LD    HL,(4681)  

+4636 B7          .     OR    A          

+4637 ED 42       .B    SBC   HL,BC      

+4639 DD CB 07 6E ...n  BIT   5,(IX+07)  

+463D 28 07       (.    JR    Z,4646     

+463F ED 4B 79 46 .KyF  LD    BC,(4679)  

+4643 B7          .     OR    A          

+4644 ED 42       .B    SBC   HL,BC      

+4646 EB          .     EX    DE,HL      

+4647 18 A3       ..    JR    45EC       ; REST  Bit 5 (IX+7)

+4649 F5          .     PUSH  AF         

+464A E5          .     PUSH  HL         

+464B 3E 01       >.    LD    A,01       

+464D CD 7D 44    .}D   CALL  447D       

+4650 36 FF       6.    LD    (HL),FF    

+4652 54          T     LD    D,H        

+4653 5D          ]     LD    E,L        

+4654 13          .     INC   DE         

+4655 97          .     SUB   A          

+4656 93          .     SUB   E          

+4657 4F          O     LD    C,A        

+4658 06 00       ..    LD    B,00       

+465A CB 44       .D    BIT   0,H        

+465C 20 01        .    JR    NZ,465F    

+465E 04          .     INC   B          

+465F 78          x     LD    A,B        

+4660 B1          .     OR    C          

+4661 28 02       (.    JR    Z,4665     

+4663 ED B0       ..    LDIR             

+4665 D1          .     POP   DE         

+4666 F1          .     POP   AF         

+4667 92          .     SUB   D          

+4668 47          G     LD    B,A        

+4669 0E 04       ..    LD    C,04       

+466B 5A          Z     LD    E,D        

+466C 16 01       ..    LD    D,01       

+466E 13          .     INC   DE         

+466F 21 00 06    !..   LD    HL,0600    

+4672 C3 B6 69    ..i   JP    69B6       

+4675 00          .     NOP              

+4676 00          .     NOP              

+4677 00          .     NOP              

+4678 00          .     NOP              

+4679 00          .     NOP              

+467A 00          .     NOP              

+467B 00          .     NOP              

+467C 00          .     NOP              

+467D 00          .     NOP              

+467E 00          .     NOP              

+467F 00          .     NOP              

+4680 00          .     NOP              

+4681 00          .     NOP              

+4682 00          .     NOP              

+4683 56          V     LD    D,(HL)     ; "VR" - 8 Byte-Register

+4684 52          R     LD    D,D        

+4685 00          .     NOP              

+4686 00          .     NOP              

+4687 00          .     NOP              

+4688 00          .     NOP              

+4689 00          .     NOP              

+468A 00          .     NOP              

+468B 00          .     NOP              

+468C 00          .     NOP              

+468D CD B8 43    ..C   CALL  43B8       

+4690 18 03       ..    JR    4695       

+4692 CD C0 43    ..C   CALL  43C0       

+4695 FD 21 85 46 .!.F  LD    IY,4685    

+4699 22 85 46    ".F   LD    (4685),HL  

+469C ED 53 87 46 .S.F  LD    (4687),DE  

+46A0 FD CB 00 C6 ....  SET   0,(IY+00)  

+46A4 20 4B        K    JR    NZ,46F1    

+46A6 23          #     INC   HL         

+46A7 7B          {     LD    A,E        

+46A8 5C          \     LD    E,H        

+46A9 C6 19       ..    ADD   A,19       

+46AB 57          W     LD    D,A        

+46AC 1A          .     LD    A,(DE)     

+46AD 67          g     LD    H,A        

+46AE 29          )     ADD   HL,HL      

+46AF B7          .     OR    A          

+46B0 CC E1 42    ..B   CALL  Z,42E1     

+46B3 7E          ~     LD    A,(HL)     

+46B4 FE FF       ..    CP    FF         

+46B6 28 05       (.    JR    Z,46BD     

+46B8 2C          ,     INC   L          

+46B9 5F          _     LD    E,A        

+46BA 16 00       ..    LD    D,00       

+46BC C9          .     RET              

+46BD 2C          ,     INC   L          

+46BE 5E          ^     LD    E,(HL)     

+46BF 2C          ,     INC   L          

+46C0 56          V     LD    D,(HL)     

+46C1 CB 7A       .z    BIT   7,D        

+46C3 C2 13 4A    ..J   JP    NZ,4A13    

+46C6 CB 95       ..    RES   2,L        

+46C8 7E          ~     LD    A,(HL)     

+46C9 2C          ,     INC   L          

+46CA 66          f     LD    H,(HL)     

+46CB 6F          o     LD    L,A        

+46CC D5          .     PUSH  DE         

+46CD CD BF 44    ..D   CALL  44BF       

+46D0 D1          .     POP   DE         

+46D1 7E          ~     LD    A,(HL)     

+46D2 3C          <     INC   A          

+46D3 C2 13 4A    ..J   JP    NZ,4A13    

+46D6 7D          }     LD    A,L        

+46D7 C6 06       ..    ADD   A,06       

+46D9 6F          o     LD    L,A        

+46DA 3E FF       >.    LD    A,FF       

+46DC C9          .     RET              

+46DD CD B8 43    ..C   CALL  43B8       

+46E0 FD 21 89 46 .!.F  LD    IY,4689    

+46E4 22 89 46    ".F   LD    (4689),HL  

+46E7 ED 53 8B 46 .S.F  LD    (468B),DE  

+46EB FD CB 00 C6 ....  SET   0,(IY+00)  

+46EF 28 B5       (.    JR    Z,46A6     

+46F1 23          #     INC   HL         

+46F2 CD ED 44    ..D   CALL  44ED       

+46F5 7E          ~     LD    A,(HL)     

+46F6 FE FF       ..    CP    FF         

+46F8 20 1A        .    JR    NZ,4714    

+46FA 23          #     INC   HL         

+46FB 23          #     INC   HL         

+46FC BE          .     CP    (HL)       

+46FD 2B          +     DEC   HL         

+46FE 2B          +     DEC   HL         

+46FF 28 13       (.    JR    Z,4714     

+4701 2C          ,     INC   L          

+4702 5E          ^     LD    E,(HL)     

+4703 2C          ,     INC   L          

+4704 56          V     LD    D,(HL)     

+4705 CB 95       ..    RES   2,L        

+4707 7E          ~     LD    A,(HL)     

+4708 2C          ,     INC   L          

+4709 66          f     LD    H,(HL)     

+470A 6F          o     LD    L,A        

+470B D5          .     PUSH  DE         

+470C CD BF 44    ..D   CALL  44BF       

+470F D1          .     POP   DE         

+4710 2C          ,     INC   L          

+4711 2C          ,     INC   L          

+4712 18 C6       ..    JR    46DA       

+4714 B7          .     OR    A          

+4715 F2 B8 46    ..F   JP    P,46B8     

+4718 2D          -     DEC   L          

+4719 56          V     LD    D,(HL)     

+471A 2D          -     DEC   L          

+471B 5E          ^     LD    E,(HL)     

+471C 7B          {     LD    A,E        

+471D E6 07       ..    AND   07         

+471F C2 13 4A    ..J   JP    NZ,4A13    

+4722 EB          .     EX    DE,HL      

+4723 97          .     SUB   A          

+4724 CD FF 44    ..D   CALL  44FF       

+4727 CB D5       ..    SET   2,L        

+4729 7E          ~     LD    A,(HL)     

+472A 18 8C       ..    JR    46B8       

+472C CD 8D 46    ..F   CALL  468D       

+472F E5          .     PUSH  HL         

+4730 CD A8 2C    ..,   CALL  2CA8       

+4733 C5          .     PUSH  BC         

+4734 4D          M     LD    C,L        

+4735 44          D     LD    B,H        

+4736 18 20       .     JR    4758       

+4738 DD CB 07 5E ...^  BIT   3,(IX+07)  

+473C 20 0E        .    JR    NZ,474C    

+473E DD 75 18    .u.   LD    (IX+18),L  ; hpv1

+4741 DD 74 19    .t.   LD    (IX+19),H  

+4744 DD 71 1A    .q.   LD    (IX+1A),C  ; hpv2

+4747 DD 70 1B    .p.   LD    (IX+1B),B  

+474A 18 0C       ..    JR    4758       

+474C DD 6E 18    .n.   LD    L,(IX+18)  

+474F DD 66 19    .f.   LD    H,(IX+19)  

+4752 DD 4E 1A    .N.   LD    C,(IX+1A)  

+4755 DD 46 1B    .F.   LD    B,(IX+1B)  

+4758 2B          +     DEC   HL         

+4759 CB 7C       .|    BIT   7,H        

+475B 28 03       (.    JR    Z,4760     

+475D 21 00 00    !..   LD    HL,0000    

+4760 CB 78       .x    BIT   7,B        

+4762 20 1F        .    JR    NZ,4783    

+4764 7B          {     LD    A,E        

+4765 91          .     SUB   C          

+4766 7A          z     LD    A,D        

+4767 98          .     SBC   B          

+4768 30 02       0.    JR    NC,476C    

+476A 42          B     LD    B,D        

+476B 4B          K     LD    C,E        

+476C EB          .     EX    DE,HL      

+476D 69          i     LD    L,C        

+476E 60          `     LD    H,B        

+476F B7          .     OR    A          

+4770 ED 52       .R    SBC   HL,DE      

+4772 28 0F       (.    JR    Z,4783     

+4774 38 0D       8.    JR    C,4783     

+4776 C1          .     POP   BC         

+4777 E3          .     EX    (SP),HL    

+4778 CD 0D 45    ..E   CALL  450D       

+477B D1          .     POP   DE         

+477C 7B          {     LD    A,E        

+477D 14          .     INC   D          

+477E 15          .     DEC   D          

+477F C8          .     RET   Z          

+4780 3E FF       >.    LD    A,FF       

+4782 C9          .     RET              

+4783 C1          .     POP   BC         

+4784 E1          .     POP   HL         

+4785 97          .     SUB   A          

+4786 57          W     LD    D,A        

+4787 5F          _     LD    E,A        

+4788 C9          .     RET              

+4789 CD 8D 46    ..F   CALL  468D       

+478C E5          .     PUSH  HL         

+478D CD A8 2C    ..,   CALL  2CA8       

+4790 C5          .     PUSH  BC         

+4791 42          B     LD    B,D        

+4792 4B          K     LD    C,E        

+4793 18 A3       ..    JR    4738       

+4795 CD 8D 46    ..F   CALL  468D       

+4798 E5          .     PUSH  HL         

+4799 CD A8 2C    ..,   CALL  2CA8       

+479C 22 4A 4B    "JK   LD    (4B4A),HL  

+479F CD A8 2C    ..,   CALL  2CA8       

+47A2 C5          .     PUSH  BC         

+47A3 44          D     LD    B,H        

+47A4 4D          M     LD    C,L        

+47A5 2A 4A 4B    *JK   LD    HL,(4B4A)  

+47A8 18 8E       ..    JR    4738       

+47AA CD B8 43    ..C   CALL  43B8       

+47AD FD 21 89 46 .!.F  LD    IY,4689    

+47B1 22 89 46    ".F   LD    (4689),HL  

+47B4 ED 53 8B 46 .S.F  LD    (468B),DE  

+47B8 ED 43 D0 41 .C.A  LD    (41D0),BC  

+47BC 3E 02       >.    LD    A,02       

+47BE 32 89 46    2.F   LD    (4689),A   

+47C1 7B          {     LD    A,E        

+47C2 32 3B 4B    2;K   LD    (4B3B),A   

+47C5 B5          .     OR    L          

+47C6 32 3C 4B    2<K   LD    (4B3C),A   

+47C9 7C          |     LD    A,H        

+47CA 32 3D 4B    2=K   LD    (4B3D),A   

+47CD 32 3A 4B    2:K   LD    (4B3A),A   

+47D0 2C          ,     INC   L          

+47D1 7B          {     LD    A,E        

+47D2 CD CA 44    ..D   CALL  44CA       

+47D5 22 38 4B    "8K   LD    (4B38),HL  

+47D8 5E          ^     LD    E,(HL)     

+47D9 1C          .     INC   E          

+47DA 28 28       ((    JR    Z,4804     

+47DC 1D          .     DEC   E          

+47DD 3E 0D       >.    LD    A,0D       

+47DF BB          .     CP    E          

+47E0 30 1C       0.    JR    NC,47FE    

+47E2 FD CB 00 8E ....  RES   1,(IY+00)  

+47E6 2A 38 4B    *8K   LD    HL,(4B38)  

+47E9 36 00       6.    LD    (HL),00    

+47EB 21 00 00    !..   LD    HL,0000    

+47EE 22 3E 4B    ">K   LD    (4B3E),HL  

+47F1 2A 3A 4B    *:K   LD    HL,(4B3A)  

+47F4 22 8A 46    ".F   LD    (468A),HL  

+47F7 2A 38 4B    *8K   LD    HL,(4B38)  

+47FA 1E 00       ..    LD    E,00       

+47FC 3E 0D       >.    LD    A,0D       

+47FE 2C          ,     INC   L          

+47FF 16 00       ..    LD    D,00       

+4801 42          B     LD    B,D        

+4802 4F          O     LD    C,A        

+4803 C9          .     RET              

+4804 FD CB 00 8E ....  RES   1,(IY+00)  

+4808 2D          -     DEC   L          

+4809 56          V     LD    D,(HL)     

+480A 2D          -     DEC   L          

+480B 5E          ^     LD    E,(HL)     

+480C ED 53 3E 4B .S>K  LD    (4B3E),DE  

+4810 3A 8C 46    :.F   LD    A,(468C)   

+4813 B7          .     OR    A          

+4814 20 35        5    JR    NZ,484B    

+4816 7B          {     LD    A,E        

+4817 E6 0F       ..    AND   0F         

+4819 FE 03       ..    CP    03         

+481B 20 CE        .    JR    NZ,47EB    

+481D EB          .     EX    DE,HL      

+481E CD BF 44    ..D   CALL  44BF       

+4821 7E          ~     LD    A,(HL)     

+4822 2C          ,     INC   L          

+4823 A6          .     AND   (HL)       

+4824 3C          <     INC   A          

+4825 20 C4        .    JR    NZ,47EB    

+4827 2C          ,     INC   L          

+4828 3A 3C 4B    :<K   LD    A,(4B3C)   

+482B BE          .     CP    (HL)       

+482C 20 BD        .    JR    NZ,47EB    

+482E 2C          ,     INC   L          

+482F 3A 3D 4B    :=K   LD    A,(4B3D)   

+4832 BE          .     CP    (HL)       

+4833 20 B6        .    JR    NZ,47EB    

+4835 2C          ,     INC   L          

+4836 22 42 4B    "BK   LD    (4B42),HL  

+4839 4E          N     LD    C,(HL)     

+483A 2C          ,     INC   L          

+483B 46          F     LD    B,(HL)     

+483C 2C          ,     INC   L          

+483D E5          .     PUSH  HL         

+483E 2A 38 4B    *8K   LD    HL,(4B38)  

+4841 2C          ,     INC   L          

+4842 5E          ^     LD    E,(HL)     

+4843 2C          ,     INC   L          

+4844 56          V     LD    D,(HL)     

+4845 E1          .     POP   HL         

+4846 FD CB 00 D6 ....  SET   2,(IY+00)  

+484A C9          .     RET              

+484B 7B          {     LD    A,E        

+484C A2          .     AND   D          

+484D 3C          <     INC   A          

+484E CA EB 47    ..G   JP    Z,47EB     

+4851 EB          .     EX    DE,HL      

+4852 CD BF 44    ..D   CALL  44BF       

+4855 18 DF       ..    JR    4836       

+4857 D5          .     PUSH  DE         

+4858 2A 38 4B    *8K   LD    HL,(4B38)  

+485B E5          .     PUSH  HL         

+485C CD 08 48    ..H   CALL  4808       

+485F D1          .     POP   DE         

+4860 3E FF       >.    LD    A,FF       

+4862 12          .     LD    (DE),A     

+4863 FD CB 00 8E ....  RES   1,(IY+00)  

+4867 D1          .     POP   DE         

+4868 7B          {     LD    A,E        

+4869 FE 0E       ..    CP    0E         

+486B 30 0F       0.    JR    NC,487C    

+486D 14          .     INC   D          

+486E 15          .     DEC   D          

+486F 20 0B        .    JR    NZ,487C    

+4871 2A 3A 4B    *:K   LD    HL,(4B3A)  

+4874 22 8A 46    ".F   LD    (468A),HL  

+4877 2A 38 4B    *8K   LD    HL,(4B38)  

+487A 2C          ,     INC   L          

+487B C9          .     RET              

+487C 79          y     LD    A,C        

+487D 93          .     SUB   E          

+487E 78          x     LD    A,B        

+487F 9A          .     SBC   D          

+4880 D0          .     RET   NC         

+4881 FD CB 00 4E ...N  BIT   1,(IY+00)  

+4885 20 D0        .    JR    NZ,4857    

+4887 CD 3F 49    .?I   CALL  493F       

+488A FD CB 00 5E ...^  BIT   3,(IY+00)  

+488E C4 ED 49    ..I   CALL  NZ,49ED    

+4891 C9          .     RET              

+4892 14          .     INC   D          

+4893 15          .     DEC   D          

+4894 20 0B        .    JR    NZ,48A1    

+4896 3E 0D       >.    LD    A,0D       

+4898 BB          .     CP    E          

+4899 38 06       8.    JR    C,48A1     

+489B 2A 38 4B    *8K   LD    HL,(4B38)  

+489E 73          s     LD    (HL),E     

+489F 2C          ,     INC   L          

+48A0 C9          .     RET              

+48A1 E5          .     PUSH  HL         

+48A2 2A 38 4B    *8K   LD    HL,(4B38)  

+48A5 36 FF       6.    LD    (HL),FF    

+48A7 2C          ,     INC   L          

+48A8 73          s     LD    (HL),E     

+48A9 2C          ,     INC   L          

+48AA 72          r     LD    (HL),D     

+48AB E1          .     POP   HL         

+48AC C9          .     RET              

+48AD 3A 89 46    :.F   LD    A,(4689)   

+48B0 B7          .     OR    A          

+48B1 CA 13 4A    ..J   JP    Z,4A13     

+48B4 79          y     LD    A,C        

+48B5 93          .     SUB   E          

+48B6 78          x     LD    A,B        

+48B7 9A          .     SBC   D          

+48B8 D0          .     RET   NC         

+48B9 D5          .     PUSH  DE         

+48BA 2A 85 46    *.F   LD    HL,(4685)  

+48BD E5          .     PUSH  HL         

+48BE 2A 87 46    *.F   LD    HL,(4687)  

+48C1 E5          .     PUSH  HL         

+48C2 2A 89 46    *.F   LD    HL,(4689)  

+48C5 2E 01       ..    LD    L,01       

+48C7 22 85 46    ".F   LD    (4685),HL  

+48CA 2A 8B 46    *.F   LD    HL,(468B)  

+48CD 22 87 46    ".F   LD    (4687),HL  

+48D0 FD CB 00 4E ...N  BIT   1,(IY+00)  

+48D4 20 3A        :    JR    NZ,4910    

+48D6 CD 3F 49    .?I   CALL  493F       

+48D9 22 4A 4B    "JK   LD    (4B4A),HL  

+48DC FD CB 00 5E ...^  BIT   3,(IY+00)  

+48E0 28 20       (     JR    Z,4902     

+48E2 ED 4B 40 4B .K@K  LD    BC,(4B40)  

+48E6 EB          .     EX    DE,HL      

+48E7 2A 8A 46    *.F   LD    HL,(468A)  

+48EA E5          .     PUSH  HL         

+48EB 2A 42 4B    *BK   LD    HL,(4B42)  

+48EE 2C          ,     INC   L          

+48EF 2C          ,     INC   L          

+48F0 CD B0 2C    ..,   CALL  2CB0       

+48F3 E1          .     POP   HL         

+48F4 22 8A 46    ".F   LD    (468A),HL  

+48F7 FD 21 89 46 .!.F  LD    IY,4689    

+48FB FD CB 00 5E ...^  BIT   3,(IY+00)  

+48FF C4 ED 49    ..I   CALL  NZ,49ED    

+4902 E1          .     POP   HL         

+4903 22 87 46    ".F   LD    (4687),HL  

+4906 E1          .     POP   HL         

+4907 22 85 46    ".F   LD    (4685),HL  

+490A 2A 4A 4B    *JK   LD    HL,(4B4A)  

+490D D1          .     POP   DE         

+490E B7          .     OR    A          

+490F C9          .     RET              

+4910 D5          .     PUSH  DE         

+4911 2A 38 4B    *8K   LD    HL,(4B38)  

+4914 CD 08 48    ..H   CALL  4808       

+4917 D1          .     POP   DE         

+4918 79          y     LD    A,C        

+4919 93          .     SUB   E          

+491A 78          x     LD    A,B        

+491B 9A          .     SBC   D          

+491C DC 3F 49    .?I   CALL  C,493F     

+491F 22 4A 4B    "JK   LD    (4B4A),HL  

+4922 ED 4B 40 4B .K@K  LD    BC,(4B40)  

+4926 EB          .     EX    DE,HL      

+4927 2A 8A 46    *.F   LD    HL,(468A)  

+492A E5          .     PUSH  HL         

+492B 2A 38 4B    *8K   LD    HL,(4B38)  

+492E 2C          ,     INC   L          

+492F CD B0 2C    ..,   CALL  2CB0       

+4932 2A 38 4B    *8K   LD    HL,(4B38)  

+4935 7E          ~     LD    A,(HL)     

+4936 36 FF       6.    LD    (HL),FF    

+4938 2C          ,     INC   L          

+4939 77          w     LD    (HL),A     

+493A 2C          ,     INC   L          

+493B 36 00       6.    LD    (HL),00    

+493D 18 B4       ..    JR    48F3       

+493F D5          .     PUSH  DE         

+4940 21 CA 41    !.A   LD    HL,41CA    

+4943 3A 8C 46    :.F   LD    A,(468C)   

+4946 B7          .     OR    A          

+4947 28 11       (.    JR    Z,495A     

+4949 D5          .     PUSH  DE         

+494A 57          W     LD    D,A        

+494B 21 00 01    !..   LD    HL,0100    

+494E 5D          ]     LD    E,L        

+494F CD 2C 66    .,f   CALL  662C       

+4952 0F          .     RRCA             

+4953 67          g     LD    H,A        

+4954 29          )     ADD   HL,HL      

+4955 D1          .     POP   DE         

+4956 3E 02       >.    LD    A,02       

+4958 18 02       ..    JR    495C       

+495A 3E 06       >.    LD    A,06       

+495C E5          .     PUSH  HL         

+495D 32 48 4B    2HK   LD    (4B48),A   

+4960 C6 0F       ..    ADD   A,0F       

+4962 83          .     ADD   E          

+4963 30 01       0.    JR    NC,4966    

+4965 14          .     INC   D          

+4966 E6 F0       ..    AND   F0         

+4968 5F          _     LD    E,A        

+4969 2A 3E 4B    *>K   LD    HL,(4B3E)  

+496C 09          .     ADD   HL,BC      

+496D ED 4B 48 4B .KHK  LD    BC,(4B48)  

+4971 09          .     ADD   HL,BC      

+4972 C1          .     POP   BC         

+4973 0A          .     LD    A,(BC)     

+4974 BD          .     CP    L          

+4975 20 23        #    JR    NZ,499A    

+4977 03          .     INC   BC         

+4978 0A          .     LD    A,(BC)     

+4979 0B          .     DEC   BC         

+497A BC          .     CP    H          

+497B 20 1D        .    JR    NZ,499A    

+497D 2A 3E 4B    *>K   LD    HL,(4B3E)  

+4980 19          .     ADD   HL,DE      

+4981 DC D8 49    ..I   CALL  C,49D8     

+4984 7D          }     LD    A,L        

+4985 02          .     LD    (BC),A     

+4986 03          .     INC   BC         

+4987 7C          |     LD    A,H        

+4988 02          .     LD    (BC),A     

+4989 2A 48 4B    *HK   LD    HL,(4B48)  

+498C EB          .     EX    DE,HL      

+498D B7          .     OR    A          

+498E ED 52       .R    SBC   HL,DE      

+4990 EB          .     EX    DE,HL      

+4991 2A 42 4B    *BK   LD    HL,(4B42)  

+4994 73          s     LD    (HL),E     

+4995 2C          ,     INC   L          

+4996 72          r     LD    (HL),D     

+4997 2C          ,     INC   L          

+4998 D1          .     POP   DE         

+4999 C9          .     RET              

+499A ED 43 44 4B .CDK  LD    (4B44),BC  

+499E 0A          .     LD    A,(BC)     

+499F 6F          o     LD    L,A        

+49A0 03          .     INC   BC         

+49A1 0A          .     LD    A,(BC)     

+49A2 67          g     LD    H,A        

+49A3 E5          .     PUSH  HL         

+49A4 19          .     ADD   HL,DE      

+49A5 DC D8 49    ..I   CALL  C,49D8     

+49A8 22 46 4B    "FK   LD    (4B46),HL  

+49AB 2A 48 4B    *HK   LD    HL,(4B48)  

+49AE EB          .     EX    DE,HL      

+49AF B7          .     OR    A          

+49B0 ED 52       .R    SBC   HL,DE      

+49B2 E3          .     EX    (SP),HL    

+49B3 22 3E 4B    ">K   LD    (4B3E),HL  

+49B6 CD BF 44    ..D   CALL  44BF       

+49B9 D1          .     POP   DE         

+49BA 3A 8C 46    :.F   LD    A,(468C)   

+49BD B7          .     OR    A          

+49BE 20 0E        .    JR    NZ,49CE    

+49C0 36 FF       6.    LD    (HL),FF    

+49C2 2C          ,     INC   L          

+49C3 36 FF       6.    LD    (HL),FF    

+49C5 2C          ,     INC   L          

+49C6 ED 4B 3C 4B .K<K  LD    BC,(4B3C)  

+49CA 71          q     LD    (HL),C     

+49CB 2C          ,     INC   L          

+49CC 70          p     LD    (HL),B     

+49CD 2C          ,     INC   L          

+49CE 73          s     LD    (HL),E     

+49CF 2C          ,     INC   L          

+49D0 72          r     LD    (HL),D     

+49D1 2C          ,     INC   L          

+49D2 D1          .     POP   DE         

+49D3 FD CB 00 DE ....  SET   3,(IY+00)  

+49D7 C9          .     RET              

+49D8 3A 8C 46    :.F   LD    A,(468C)   

+49DB B7          .     OR    A          

+49DC CA 39 4A    .9J   JP    Z,4A39     

+49DF 2C          ,     INC   L          

+49E0 7D          }     LD    A,L        

+49E1 E6 0F       ..    AND   0F         

+49E3 C0          .     RET   NZ         

+49E4 3E 03       >.    LD    A,03       

+49E6 DD CB 0B B6 ....  RES   6,(IX+0B)  

+49EA C3 0D 3D    ..=   JP    3D0D       

+49ED E5          .     PUSH  HL         

+49EE D5          .     PUSH  DE         

+49EF 2A 44 4B    *DK   LD    HL,(4B44)  

+49F2 ED 5B 46 4B .[FK  LD    DE,(4B46)  

+49F6 73          s     LD    (HL),E     

+49F7 23          #     INC   HL         

+49F8 72          r     LD    (HL),D     

+49F9 2A 38 4B    *8K   LD    HL,(4B38)  

+49FC 2D          -     DEC   L          

+49FD 2D          -     DEC   L          

+49FE ED 5B 3E 4B .[>K  LD    DE,(4B3E)  

+4A02 73          s     LD    (HL),E     

+4A03 2C          ,     INC   L          

+4A04 72          r     LD    (HL),D     

+4A05 2C          ,     INC   L          

+4A06 36 FF       6.    LD    (HL),FF    

+4A08 2C          ,     INC   L          

+4A09 ED 5B 40 4B .[@K  LD    DE,(4B40)  

+4A0D 73          s     LD    (HL),E     

+4A0E 2C          ,     INC   L          

+4A0F 72          r     LD    (HL),D     

+4A10 D1          .     POP   DE         

+4A11 E1          .     POP   HL         

+4A12 C9          .     RET              

+4A13 3E 0E       >.    LD    A,0E       

+4A15 CD 0D 3D    ..=   CALL  3D0D       

+4A18 97          .     SUB   A          

+4A19 57          W     LD    D,A        

+4A1A 5F          _     LD    E,A        

+4A1B 37          7     SCF              

+4A1C C9          .     RET              

+4A1D 7A          z     LD    A,D        

+4A1E B7          .     OR    A          

+4A1F C0          .     RET   NZ         

+4A20 7B          {     LD    A,E        

+4A21 FE 0D       ..    CP    0D         

+4A23 C0          .     RET   NZ         

+4A24 4E          N     LD    C,(HL)     

+4A25 2C          ,     INC   L          

+4A26 46          F     LD    B,(HL)     

+4A27 2D          -     DEC   L          

+4A28 E5          .     PUSH  HL         

+4A29 2A 38 4B    *8K   LD    HL,(4B38)  

+4A2C 77          w     LD    (HL),A     

+4A2D 2C          ,     INC   L          

+4A2E 71          q     LD    (HL),C     

+4A2F 2C          ,     INC   L          

+4A30 70          p     LD    (HL),B     

+4A31 E1          .     POP   HL         

+4A32 C9          .     RET              

+4A33 DD CB 07 C6 ....  SET   0,(IX+07)  

+4A37 18 04       ..    JR    4A3D       

+4A39 DD CB 07 86 ....  RES   0,(IX+07)  

+4A3D DD 36 06 20 .6.   LD    (IX+06),20 

+4A41 2A C8 41    *.A   LD    HL,(41C8)  

+4A44 3E 7F       >.    LD    A,7F       

+4A46 CD 49 46    .IF   CALL  4649       

+4A49 21 03 00    !..   LD    HL,0003    

+4A4C 22 CA 41    ".A   LD    (41CA),HL  

+4A4F DD 75 18    .u.   LD    (IX+18),L  

+4A52 DD 74 19    .t.   LD    (IX+19),H  

+4A55 DD 36 06 24 .6.$  LD    (IX+06),24 

+4A59 DD CB 07 A6 ....  RES   4,(IX+07)  

+4A5D DD 6E 18    .n.   LD    L,(IX+18)  

+4A60 DD 66 19    .f.   LD    H,(IX+19)  

+4A63 FD 21 85 46 .!.F  LD    IY,4685    

+4A67 FD CB 00 C6 ....  SET   0,(IY+00)  

+4A6B FD 36 03 00 .6..  LD    (IY+03),00 

+4A6F CD BF 44    ..D   CALL  44BF       

+4A72 22 4A 4B    "JK   LD    (4B4A),HL  

+4A75 DD CB 07 66 ...f  BIT   4,(IX+07)  

+4A79 20 40        @    JR    NZ,4ABB    

+4A7B 2C          ,     INC   L          

+4A7C 2C          ,     INC   L          

+4A7D 5E          ^     LD    E,(HL)     

+4A7E 2C          ,     INC   L          

+4A7F 56          V     LD    D,(HL)     

+4A80 7B          {     LD    A,E        

+4A81 A2          .     AND   D          

+4A82 3C          <     INC   A          

+4A83 CA 09 4B    ..K   JP    Z,4B09     

+4A86 ED 53 C6 41 .S.A  LD    (41C6),DE  

+4A8A 2C          ,     INC   L          

+4A8B 7E          ~     LD    A,(HL)     

+4A8C DD 77 1A    .w.   LD    (IX+1A),A  

+4A8F 2C          ,     INC   L          

+4A90 7E          ~     LD    A,(HL)     

+4A91 DD 77 1B    .w.   LD    (IX+1B),A  

+4A94 7B          {     LD    A,E        

+4A95 E6 01       ..    AND   01         

+4A97 CB 83       ..    RES   0,E        

+4A99 EB          .     EX    DE,HL      

+4A9A CD 4D 44    .MD   CALL  444D       

+4A9D DD 7E 18    .~.   LD    A,(IX+18)  

+4AA0 BE          .     CP    (HL)       

+4AA1 20 47        G    JR    NZ,4AEA    

+4AA3 2C          ,     INC   L          

+4AA4 DD 7E 19    .~.   LD    A,(IX+19)  

+4AA7 BE          .     CP    (HL)       

+4AA8 20 40        @    JR    NZ,4AEA    

+4AAA 2C          ,     INC   L          

+4AAB 7E          ~     LD    A,(HL)     

+4AAC 3C          <     INC   A          

+4AAD 20 3B        ;    JR    NZ,4AEA    

+4AAF 2C          ,     INC   L          

+4AB0 DD 7E 1A    .~.   LD    A,(IX+1A)  

+4AB3 96          .     SUB   (HL)       

+4AB4 23          #     INC   HL         

+4AB5 DD 7E 1B    .~.   LD    A,(IX+1B)  

+4AB8 9E          .     SBC   (HL)       

+4AB9 38 2F       8/    JR    C,4AEA     

+4ABB DD CB 07 E6 ....  SET   4,(IX+07)  

+4ABF 2A C6 41    *.A   LD    HL,(41C6)  

+4AC2 16 00       ..    LD    D,00       

+4AC4 7D          }     LD    A,L        

+4AC5 E6 01       ..    AND   01         

+4AC7 5F          _     LD    E,A        

+4AC8 CB 85       ..    RES   0,L        

+4ACA CD AD 47    ..G   CALL  47AD       

+4ACD ED 53 40 4B .S@K  LD    (4B40),DE  

+4AD1 CD 3F 49    .?I   CALL  493F       

+4AD4 FD CB 00 5E ...^  BIT   3,(IY+00)  

+4AD8 C4 ED 49    ..I   CALL  NZ,49ED    

+4ADB 42          B     LD    B,D        

+4ADC 4B          K     LD    C,E        

+4ADD EB          .     EX    DE,HL      

+4ADE 2A 4A 4B    *JK   LD    HL,(4B4A)  

+4AE1 7D          }     LD    A,L        

+4AE2 C6 06       ..    ADD   A,06       

+4AE4 6F          o     LD    L,A        

+4AE5 CD B0 2C    ..,   CALL  2CB0       

+4AE8 18 04       ..    JR    4AEE       

+4AEA DD CB 07 C6 ....  SET   0,(IX+07)  

+4AEE DD CB 07 A6 ....  RES   4,(IX+07)  

+4AF2 DD 7E 18    .~.   LD    A,(IX+18)  

+4AF5 C6 06       ..    ADD   A,06       

+4AF7 DD 86 1A    ...   ADD   (IX+1A)    

+4AFA DD 77 18    .w.   LD    (IX+18),A  

+4AFD DD 7E 19    .~.   LD    A,(IX+19)  

+4B00 DD 8E 1B    ...   ADC   (IX+1B)    

+4B03 DD 77 19    .w.   LD    (IX+19),A  

+4B06 D2 5D 4A    .]J   JP    NC,4A5D    

+4B09 DD 36 06 28 .6.(  LD    (IX+06),28 

+4B0D 2A C8 41    *.A   LD    HL,(41C8)  

+4B10 23          #     INC   HL         

+4B11 23          #     INC   HL         

+4B12 22 C6 41    ".A   LD    (41C6),HL  

+4B15 2A CA 41    *.A   LD    HL,(41CA)  

+4B18 37          7     SCF              

+4B19 CB 1C       ..    RR    H          

+4B1B CB 1D       ..    RR    L          

+4B1D CB 85       ..    RES   0,L        

+4B1F 3E FF       >.    LD    A,FF       

+4B21 CD 49 46    .IF   CALL  4649       

+4B24 DD 36 06 00 .6..  LD    (IX+06),00 

+4B28 DD CB 07 9E ....  RES   3,(IX+07)  

+4B2C DD CB 07 46 ...F  BIT   0,(IX+07)  

+4B30 C2 26 29    .&)   JP    NZ,2926    

+4B33 C3 E4 49    ..I   JP    49E4       

+4B36 54          T     LD    D,H        ; "TR"

+4B37 52          R     LD    D,D        

+4B38 00          .     NOP              

+4B39 00          .     NOP              

+4B3A 00          .     NOP              

+4B3B 00          .     NOP              

+4B3C 00          .     NOP              

+4B3D 00          .     NOP              

+4B3E 00          .     NOP              

+4B3F 00          .     NOP              

+4B40 00          .     NOP              

+4B41 00          .     NOP              

+4B42 00          .     NOP              

+4B43 00          .     NOP              

+4B44 00          .     NOP              

+4B45 00          .     NOP              

+4B46 00          .     NOP              

+4B47 00          .     NOP              

+4B48 00          .     NOP              

+4B49 00          .     NOP              

+4B4A 00          .     NOP              

+4B4B 00          .     NOP              

+4B4C F5          .     PUSH  AF         

+4B4D C5          .     PUSH  BC         

+4B4E D5          .     PUSH  DE         

+4B4F E5          .     PUSH  HL         

+4B50 FD E5       ..    PUSH  IY         

+4B52 2A B6 4C    *.L   LD    HL,(4CB6)  

+4B55 2B          +     DEC   HL         

+4B56 7C          |     LD    A,H        

+4B57 B5          .     OR    L          

+4B58 20 1D        .    JR    NZ,4B77    

+4B5A 21 17 82    !..   LD    HL,8217    

+4B5D 3A B8 4C    :.L   LD    A,(4CB8)   

+4B60 FE 02       ..    CP    02         

+4B62 28 09       (.    JR    Z,4B6D     

+4B64 CB CE       ..    SET   1,(HL)     

+4B66 3E 02       >.    LD    A,02       

+4B68 21 B8 0B    !..   LD    HL,0BB8    

+4B6B 18 07       ..    JR    4B74       

+4B6D CB C6       ..    SET   0,(HL)     

+4B6F 3E 01       >.    LD    A,01       

+4B71 21 70 17    !p.   LD    HL,1770    

+4B74 32 B8 4C    2.L   LD    (4CB8),A   

+4B77 22 B6 4C    ".L   LD    (4CB6),HL  

+4B7A 2A F1 4C    *.L   LD    HL,(4CF1)  

+4B7D 23          #     INC   HL         

+4B7E 22 F1 4C    ".L   LD    (4CF1),HL  

+4B81 21 B9 4C    !.L   LD    HL,4CB9    

+4B84 CD 99 4E    ..N   CALL  4E99       

+4B87 3A B5 4C    :.L   LD    A,(4CB5)   

+4B8A B7          .     OR    A          

+4B8B 28 08       (.    JR    Z,4B95     

+4B8D 2A B3 4C    *.L   LD    HL,(4CB3)  

+4B90 65          e     LD    H,L        

+4B91 6F          o     LD    L,A        

+4B92 22 B3 4C    ".L   LD    (4CB3),HL  

+4B95 FD E1       ..    POP   IY         

+4B97 E1          .     POP   HL         

+4B98 D1          .     POP   DE         

+4B99 C1          .     POP   BC         

+4B9A F1          .     POP   AF         

+4B9B C9          .     RET              

+4B9C F3          .     DI               

+4B9D 2A B3 4C    *.L   LD    HL,(4CB3)  

+4BA0 7D          }     LD    A,L        

+4BA1 B7          .     OR    A          

+4BA2 28 35       (5    JR    Z,4BD9     

+4BA4 6C          l     LD    L,H        

+4BA5 26 00       &.    LD    H,00       

+4BA7 22 B3 4C    ".L   LD    (4CB3),HL  

+4BAA FB          .     EI               

+4BAB FE 80       ..    CP    80         

+4BAD 28 24       ($    JR    Z,4BD3     

+4BAF CB 7F       ..    BIT   7,A        

+4BB1 C4 CA 4B    ..K   CALL  NZ,4BCA    

+4BB4 21 D1 4C    !.L   LD    HL,4CD1    

+4BB7 06 03       ..    LD    B,03       

+4BB9 0F          .     RRCA             

+4BBA F5          .     PUSH  AF         

+4BBB C5          .     PUSH  BC         

+4BBC E5          .     PUSH  HL         

+4BBD DC 99 4E    ..N   CALL  C,4E99     

+4BC0 E1          .     POP   HL         

+4BC1 C1          .     POP   BC         

+4BC2 F1          .     POP   AF         

+4BC3 11 08 00    ...   LD    DE,0008    

+4BC6 19          .     ADD   HL,DE      

+4BC7 10 F0       ..    DJNZ  4BB9       

+4BC9 C9          .     RET              

+4BCA F5          .     PUSH  AF         

+4BCB 21 C9 4C    !.L   LD    HL,4CC9    

+4BCE CD 99 4E    ..N   CALL  4E99       

+4BD1 F1          .     POP   AF         

+4BD2 C9          .     RET              

+4BD3 21 C1 4C    !.L   LD    HL,4CC1    

+4BD6 C3 99 4E    ..N   JP    4E99       

+4BD9 FB          .     EI               

+4BDA C9          .     RET              

+4BDB 3A F4 6E    :.n   LD    A,(6EF4)   

+4BDE DD 96 04    ...   SUB   (IX+04)    

+4BE1 ED 44       .D    NEG              

+4BE3 DD 77 04    .w.   LD    (IX+04),A  

+4BE6 21 B5 4C    !.L   LD    HL,4CB5    

+4BE9 DD 7E 2A    .~*   LD    A,(IX+2A)  

+4BEC FE 05       ..    CP    05         

+4BEE 30 03       0.    JR    NC,4BF3    

+4BF0 CB C6       ..    SET   0,(HL)     

+4BF2 C9          .     RET              

+4BF3 CB CE       ..    SET   1,(HL)     

+4BF5 C9          .     RET              

+4BF6 3A F4 6E    :.n   LD    A,(6EF4)   

+4BF9 DD 86 04    ...   ADD   (IX+04)    

+4BFC FE 64       .d    CP    64         

+4BFE 38 1E       8.    JR    C,4C1E     

+4C00 D6 64       .d    SUB   A,64       

+4C02 F5          .     PUSH  AF         

+4C03 DD 35       .5    DEC   (IX+1C)    

+4C05 1C          .     INC   E          

+4C06 20 0B        .    JR    NZ,4C13    

+4C08 DD 7E 2A    .~*   LD    A,(IX+2A)  

+4C0B 3C          <     INC   A          

+4C0C FE 03       ..    CP    03         

+4C0E 30 03       0.    JR    NC,4C13    

+4C10 DD 77 2A    .w*   LD    (IX+2A),A  

+4C13 2A 1C 6E    *.n   LD    HL,(6E1C)  

+4C16 2E 38       .8    LD    L,38       

+4C18 CD 99 4E    ..N   CALL  4E99       

+4C1B F1          .     POP   AF         

+4C1C 18 DE       ..    JR    4BFC       

+4C1E DD 77 04    .w.   LD    (IX+04),A  

+4C21 21 B5 4C    !.L   LD    HL,4CB5    

+4C24 CB 86       ..    RES   0,(HL)     

+4C26 CB 8E       ..    RES   1,(HL)     

+4C28 C9          .     RET              

+4C29 DD 7E 2A    .~*   LD    A,(IX+2A)  

+4C2C FE 03       ..    CP    03         

+4C2E D0          .     RET   NC         

+4C2F DD 36 2A 00 .6*.  LD    (IX+2A),00 

+4C33 DD 36 1C 3C .6.<  LD    (IX+1C),3C 

+4C37 C9          .     RET              

+4C38 3A F9 4C    :.L   LD    A,(4CF9)   

+4C3B B7          .     OR    A          

+4C3C C8          .     RET   Z          

+4C3D 3E 01       >.    LD    A,01       

+4C3F 32 F9 4C    2.L   LD    (4CF9),A   

+4C42 2A FA 4C    *.L   LD    HL,(4CFA)  

+4C45 06 11       ..    LD    B,11       

+4C47 23          #     INC   HL         

+4C48 7E          ~     LD    A,(HL)     

+4C49 FE 01       ..    CP    01         

+4C4B 28 0D       (.    JR    Z,4C5A     

+4C4D 38 03       8.    JR    C,4C52     

+4C4F 21 FB 4C    !.L   LD    HL,4CFB    

+4C52 10 F3       ..    DJNZ  4C47       

+4C54 21 F9 4C    !.L   LD    HL,4CF9    

+4C57 CB 86       ..    RES   0,(HL)     

+4C59 C9          .     RET              

+4C5A DD 7E 26    .~&   LD    A,(IX+26)  

+4C5D B7          .     OR    A          

+4C5E 20 28        (    JR    NZ,4C88    

+4C60 22 FA 4C    ".L   LD    (4CFA),HL  

+4C63 11 FC 4C    ..L   LD    DE,4CFC    

+4C66 B7          .     OR    A          

+4C67 ED 52       .R    SBC   HL,DE      

+4C69 DD 7E 06    .~.   LD    A,(IX+06)  

+4C6C FE BC       ..    CP    BC         

+4C6E C0          .     RET   NZ         

+4C6F DD 7E 34    .~4   LD    A,(IX+34)  

+4C72 B7          .     OR    A          

+4C73 C0          .     RET   NZ         

+4C74 DD 36 06 00 .6..  LD    (IX+06),00 

+4C78 DD CB 07 DE ....  SET   3,(IX+07)  

+4C7C DD 75 2C    .u,   LD    (IX+2C),L  

+4C7F DD 74 2D    .t-   LD    (IX+2D),H  

+4C82 2A FA 4C    *.L   LD    HL,(4CFA)  

+4C85 36 00       6.    LD    (HL),00    

+4C87 C9          .     RET              

+4C88 DD CB 05 C6 ....  SET   0,(IX+05)  

+4C8C 97          .     SUB   A          

+4C8D 32 F9 4C    2.L   LD    (4CF9),A   

+4C90 C9          .     RET              

+4C91 F1          .     POP   AF         

+4C92 C9          .     RET              ;---------- SV-Call zustellen -----

+4C93 F5          .     PUSH  AF         ; Kanalnummer

+4C94 3A FC 6E    :.n   LD    A,(6EFC)   

+4C97 B7          .     OR    A          

+4C98 20 F7        .    JR    NZ,4C91    

+4C9A F1          .     POP   AF         

+4C9B F5          .     PUSH  AF         

+4C9C E5          .     PUSH  HL         

+4C9D 21 F9 4C    !.L   LD    HL,4CF9    

+4CA0 CB CE       ..    SET   1,(HL)     ; irgendein Kanal hat SV-Call

+4CA2 21 FC 4C    !.L   LD    HL,4CFC    ; 4CFC+Kanalnummer

+4CA5 85          .     ADD   L          

+4CA6 6F          o     LD    L,A        

+4CA7 30 01       0.    JR    NC,4CAA    

+4CA9 24          $     INC   H          

+4CAA 3E 01       >.    LD    A,01       

+4CAC 77          w     LD    (HL),A     ; 1: SV-Call angefordert

+4CAD CD 68 6D    .hm   CALL  6D68       ; unblock (supervisor)

+4CB0 E1          .     POP   HL         

+4CB1 F1          .     POP   AF         

+4CB2 C9          .     RET              ;--------------------------------

+4CB3 00          .     NOP              

+4CB4 00          .     NOP              

+4CB5 00          .     NOP              

+4CB6 70          p     LD    (HL),B     

+4CB7 17          .     RLA              

+4CB8 01 

+4CB9 00 00                              ; clock (1)

+4CBB 00          .     NOP              

+4CBC 00          .     NOP              

+4CBD 00          .     NOP              

+4CBE 00          .     NOP              

+4CBF 00          .     NOP              

+4CC0 00          .     NOP

+4CC1 00          .     NOP              ; clock (2)

+4CC2 00          .     NOP              

+4CC3 00          .     NOP              

+4CC4 00          .     NOP              

+4CC5 00          .     NOP              

+4CC6 00          .     NOP              

+4CC7 00          .     NOP

+4CC8 00          .     NOP              

+4CC9 00          .     NOP              ; clock (3)

+4CCA 00          .     NOP              

+4CCB 00          .     NOP              

+4CCC 00          .     NOP              

+4CCD 00          .     NOP              

+4CCE 00          .     NOP

+4CCF 00          .     NOP              

+4CD0 00          .     NOP              

+4CD1 00          .     NOP              ; clock (4)

+4CD2 00          .     NOP              

+4CD3 00          .     NOP              

+4CD4 00          .     NOP              

+4CD5 00          .     NOP              

+4CD6 00          .     NOP              

+4CD7 00          .     NOP              

+4CD8 00          .     NOP              

+4CD9 00          .     NOP              ; clock (5)

+4CDA 00          .     NOP              

+4CDB 00          .     NOP              

+ - Fortsetzung in Datei "eumel0.prt.3" -

diff --git a/system/eumel0-z80/src/eumel0.prt.3 b/system/eumel0-z80/src/eumel0.prt.3
new file mode 100644
index 0000000..2ae7eab
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.3
@@ -0,0 +1,4004 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT

+

+4CDC 00          .     NOP              

+4CDD 00          .     NOP              

+4CDE 00          .     NOP              

+4CDF 00          .     NOP              

+4CE0 00          .     NOP              

+4CE1 00          .     NOP              ; clock (6)

+4CE2 00          .     NOP              

+4CE3 00          .     NOP              

+4CE4 00          .     NOP              

+4CE5 00          .     NOP              

+4CE6 00          .     NOP              

+4CE7 00          .     NOP              

+4CE8 00          .     NOP              

+4CE9 00          .     NOP              ; clock (7)

+4CEA 00          .     NOP              

+4CEB 00          .     NOP              

+4CEC 00          .     NOP              

+4CED 00          .     NOP              

+4CEE 00          .     NOP              

+4CEF 00          .     NOP              

+4CF0 00          .     NOP              

+4CF1 00          .     NOP              ; ---

+4CF2 00          .     NOP              ; 4CF1/4CF2 = pausenzaehler akt.Task

+4CF3 00          .     NOP              

+4CF4 00          .     NOP              

+4CF5 00          .     NOP              

+4CF6 00          .     NOP              

+4CF7 00          .     NOP              

+4CF8 00          .     NOP              

+4CF9 00          .     NOP              ;--

+4CFA FC 4C 

+4CFC 00                                 ; Tabelle der SV-Call anforderungen

+4CFD 00          .     NOP              ; Kanal 1

+4CFE 00          .     NOP              ; Kanal 2 ...

+4CFF 00          .     NOP              

+4D00 00          .     NOP              

+4D01 00          .     NOP              

+4D02 00          .     NOP              

+4D03 00          .     NOP              

+4D04 00          .     NOP              

+4D05 00          .     NOP              

+4D06 00          .     NOP              

+4D07 00          .     NOP              

+4D08 00          .     NOP              

+4D09 00          .     NOP              

+4D0A 00          .     NOP              

+4D0B 00          .     NOP              ; Kanal 16

+4D0C FF          .     RST   38         ; Tabellenende

+4D0D CD 21 4D    .!M   CALL  4D21       

+4D10 CD 6D 4D    .mM   CALL  4D6D       

+4D13 EB          .     EX    DE,HL      

+4D14 D8          .     RET   C          

+4D15 1F          .     RRA              

+4D16 D8          .     RET   C          

+4D17 7A          z     LD    A,D        

+4D18 17          .     RLA              

+4D19 D8          .     RET   C          

+4D1A 3A 5A 4E    :ZN   LD    A,(4E5A)   

+4D1D B7          .     OR    A          

+4D1E F0          .     RET   P          

+4D1F 18 13       ..    JR    4D34       

+4D21 7A          z     LD    A,D        

+4D22 AC          .     XOR   H          

+4D23 32 5A 4E    2ZN   LD    (4E5A),A   

+4D26 CB 7C       .|    BIT   7,H        

+4D28 28 07       (.    JR    Z,4D31     

+4D2A 97          .     SUB   A          

+4D2B 95          .     SUB   L          

+4D2C 6F          o     LD    L,A        

+4D2D 3E 00       >.    LD    A,00       

+4D2F 9C          .     SBC   H          

+4D30 67          g     LD    H,A        

+4D31 CB 7A       .z    BIT   7,D        

+4D33 C8          .     RET   Z          

+4D34 97          .     SUB   A          

+4D35 93          .     SUB   E          

+4D36 5F          _     LD    E,A        

+4D37 3E 00       >.    LD    A,00       

+4D39 9A          .     SBC   D          

+4D3A 57          W     LD    D,A        

+4D3B B7          .     OR    A          

+4D3C C9          .     RET              

+4D3D CB 7A       .z    BIT   7,D        

+4D3F 20 0E        .    JR    NZ,4D4F    

+4D41 CD 21 4D    .!M   CALL  4D21       

+4D44 CD AD 4D    ..M   CALL  4DAD       

+4D47 30 D1       0.    JR    NC,4D1A    

+4D49 C9          .     RET              

+4D4A CD AD 4D    ..M   CALL  4DAD       

+4D4D B7          .     OR    A          

+4D4E C9          .     RET              

+4D4F DD CB 0B 66 ...f  BIT   4,(IX+0B)  

+4D53 20 F5        .    JR    NZ,4D4A    

+4D55 CD 21 4D    .!M   CALL  4D21       

+4D58 E5          .     PUSH  HL         

+4D59 CD AD 4D    ..M   CALL  4DAD       

+4D5C 38 0B       8.    JR    C,4D69     

+4D5E 7C          |     LD    A,H        

+4D5F B5          .     OR    L          

+4D60 28 07       (.    JR    Z,4D69     

+4D62 EB          .     EX    DE,HL      

+4D63 E3          .     EX    (SP),HL    

+4D64 ED 52       .R    SBC   HL,DE      

+4D66 D1          .     POP   DE         

+4D67 18 B1       ..    JR    4D1A       

+4D69 33          3     INC   SP         

+4D6A 33          3     INC   SP         

+4D6B 18 AD       ..    JR    4D1A       

+4D6D 7A          z     LD    A,D        ; -------- 16 * 16 --> 24 Bit MULT ---

+4D6E BC          .     CP    H          

+4D6F 30 01       0.    JR    NC,4D72    

+4D71 EB          .     EX    DE,HL      

+4D72 C5          .     PUSH  BC         

+4D73 44          D     LD    B,H        

+4D74 4D          M     LD    C,L        

+4D75 97          .     SUB   A          

+4D76 67          g     LD    H,A        

+4D77 6F          o     LD    L,A        

+4D78 CB 38       .8    SLR   B          

+4D7A CB 19       ..    RR    C          

+4D7C 30 01       0.    JR    NC,4D7F    

+4D7E 19          .     ADD   HL,DE      

+4D7F 18 1B       ..    JR    4D9C       

+4D81 CB 23       .#    SLA   E          

+4D83 CB 12       ..    RL    D          

+4D85 CE 00       ..    ADC   A,00       

+4D87 19          .     ADD   HL,DE      

+4D88 CE 00       ..    ADC   A,00       

+4D8A CB 38       .8    SLR   B          

+4D8C CB 19       ..    RR    C          

+4D8E 38 F1       8.    JR    C,4D81     

+4D90 20 04        .    JR    NZ,4D96    

+4D92 04          .     INC   B          

+4D93 05          .     DEC   B          

+4D94 28 12       (.    JR    Z,4DA8     

+4D96 CB 23       .#    SLA   E          

+4D98 CB 12       ..    RL    D          

+4D9A 38 0F       8.    JR    C,4DAB     

+4D9C CB 38       .8    SLR   B          

+4D9E CB 19       ..    RR    C          

+4DA0 38 DF       8.    JR    C,4D81     

+4DA2 20 F2        .    JR    NZ,4D96    

+4DA4 04          .     INC   B          

+4DA5 05          .     DEC   B          

+4DA6 20 EE        .    JR    NZ,4D96    

+4DA8 FE 02       ..    CP    02         

+4DAA 3F          ?     CCF              

+4DAB C1          .     POP   BC         

+4DAC C9          .     RET              

+4DAD 7C          |     LD    A,H        

+4DAE B5          .     OR    L          

+4DAF 20 02        .    JR    NZ,4DB3    

+4DB1 37          7     SCF              

+4DB2 C9          .     RET              

+4DB3 7C          |     LD    A,H        

+4DB4 B2          .     OR    D          

+4DB5 28 2B       (+    JR    Z,4DE2     

+4DB7 C5          .     PUSH  BC         

+4DB8 97          .     SUB   A          

+4DB9 3C          <     INC   A          

+4DBA ED 6A       .j    ADC   HL,HL      

+4DBC F2 B9 4D    ..M   JP    P,4DB9     

+                                                                                                                                                                                           

+4DC0 4D          M     LD    C,L        

+4DC1 EB          .     EX    DE,HL      

+4DC2 11 00 00    ...   LD    DE,0000    

+4DC5 CB 23       .#    SLA   E          

+4DC7 CB 12       ..    RL    D          

+4DC9 22 5B 4E    "[N   LD    (4E5B),HL  

+4DCC B7          .     OR    A          

+4DCD ED 42       .B    SBC   HL,BC      

+4DCF 30 03       0.    JR    NC,4DD4    

+4DD1 2A 5B 4E    *[N   LD    HL,(4E5B)  

+4DD4 38 01       8.    JR    C,4DD7     

+4DD6 13          .     INC   DE         

+4DD7 CB 38       .8    SLR   B          

+4DD9 CB 19       ..    RR    C          

+4DDB 3D          =     DEC   A          

+4DDC F2 C5 4D    ..M   JP    P,4DC5     

+4DDF C1          .     POP   BC         

+4DE0 B7          .     OR    A          

+4DE1 C9          .     RET              

+4DE2 CB 7D       .}    BIT   7,L        

+4DE4 20 06        .    JR    NZ,4DEC    

+4DE6 24          $     INC   H          

+4DE7 CB 25       .%    SLA   L          

+4DE9 F2 E6 4D    ..M   JP    P,4DE6     

+4DEC 7B          {     LD    A,E        

+4DED 1E 00       ..    LD    E,00       

+4DEF CB 23       .#    SLA   E          

+4DF1 BD          .     CP    L          

+4DF2 38 02       8.    JR    C,4DF6     

+4DF4 95          .     SUB   L          

+4DF5 1C          .     INC   E          

+4DF6 CB 3D       .=    SLR   L          

+4DF8 25          %     DEC   H          

+4DF9 F2 EF 4D    ..M   JP    P,4DEF     

+4DFC 6F          o     LD    L,A        

+4DFD 97          .     SUB   A          

+4DFE 67          g     LD    H,A        

+4DFF C9          .     RET              

+4E00 E5          .     PUSH  HL         

+4E01 EB          .     EX    DE,HL      

+4E02 06 10       ..    LD    B,10       

+4E04 11 00 00    ...   LD    DE,0000    

+4E07 4A          J     LD    C,D        

+4E08 29          )     ADD   HL,HL      

+4E09 38 11       8.    JR    C,4E1C     

+4E0B 10 FB       ..    DJNZ  4E08       

+4E0D 18 1C       ..    JR    4E2B       

+4E0F 7A          z     LD    A,D        

+4E10 87          .     ADD   A          

+4E11 27          '     DAA              

+4E12 57          W     LD    D,A        

+4E13 7B          {     LD    A,E        

+4E14 8F          .     ADC   A          

+4E15 27          '     DAA              

+4E16 5F          _     LD    E,A        

+4E17 CB 11       ..    RL    C          

+4E19 29          )     ADD   HL,HL      

+4E1A 30 0D       0.    JR    NC,4E29    

+4E1C 7A          z     LD    A,D        

+4E1D C6 01       ..    ADD   A,01       

+4E1F 27          '     DAA              

+4E20 57          W     LD    D,A        

+4E21 7B          {     LD    A,E        

+4E22 CE 00       ..    ADC   A,00       

+4E24 27          '     DAA              

+4E25 5F          _     LD    E,A        

+4E26 30 01       0.    JR    NC,4E29    

+4E28 0C          .     INC   C          

+4E29 10 E4       ..    DJNZ  4E0F       

+4E2B 21 5D 4E    !]N   LD    HL,4E5D    

+4E2E 71          q     LD    (HL),C     

+4E2F ED 53 5E 4E .S^N  LD    (4E5E),DE  

+4E33 D1          .     POP   DE         

+4E34 06 06       ..    LD    B,06       

+4E36 D5          .     PUSH  DE         

+4E37 0E 00       ..    LD    C,00       

+4E39 3E 30       >0    LD    A,30       

+4E3B CD 53 4E    .SN   CALL  4E53       

+4E3E FE 30       .0    CP    30         

+4E40 20 08        .    JR    NZ,4E4A    

+4E42 10 F7       ..    DJNZ  4E3B       

+4E44 04          .     INC   B          

+4E45 18 03       ..    JR    4E4A       

+4E47 CD 53 4E    .SN   CALL  4E53       

+4E4A 12          .     LD    (DE),A     

+4E4B 13          .     INC   DE         

+4E4C 0C          .     INC   C          

+4E4D 10 F8       ..    DJNZ  4E47       

+4E4F 06 00       ..    LD    B,00       

+4E51 D1          .     POP   DE         

+4E52 C9          .     RET              

+4E53 ED 6F       .o    RLD              

+4E55 CB 40       .@    BIT   0,B        

+4E57 C8          .     RET   Z          

+4E58 23          #     INC   HL         

+4E59 C9          .     RET              

+4E5A 00          .     NOP              

+4E5B 00          .     NOP              

+4E5C 00          .     NOP              

+4E5D 20 20             JR    NZ,4E7F    

+4E5F 20 08        .    JR    NZ,4E69    

+4E61 F5          .     PUSH  AF         

+4E62 C5          .     PUSH  BC         

+4E63 CD 72 4E    .rN   CALL  4E72       

+4E66 DD 2A 1C 6E .*.n  LD    IX,(6E1C)  

+4E6A 11 91 4E    ..N   LD    DE,4E91    

+4E6D C1          .     POP   BC         

+4E6E 08          .     EX    AF,AF'     

+4E6F F1          .     POP   AF         

+4E70 08          .     EX    AF,AF'     

+4E71 C9          .     RET              

+4E72 E5          .     PUSH  HL         

+4E73 EB          .     EX    DE,HL      

+4E74 11 91 4E    ..N   LD    DE,4E91    

+4E77 01 08 00    ...   LD    BC,0008    

+4E7A ED B0       ..    LDIR             

+4E7C DD 21 91 4E .!.N  LD    IX,4E91    

+4E80 FD E3       ..    EX    (SP),IY    

+4E82 C9          .     RET              

+4E83 C5          .     PUSH  BC         

+4E84 D5          .     PUSH  DE         

+4E85 DD E3       ..    EX    (SP),IX    

+4E87 E5          .     PUSH  HL         

+4E88 FD E1       ..    POP   IY         

+4E8A CD B3 51    ..Q   CALL  51B3       

+4E8D DD E1       ..    POP   IX         

+4E8F C1          .     POP   BC         

+4E90 C9          .     RET              

+4E91 00          .     NOP              

+4E92 00          .     NOP              

+4E93 00          .     NOP              

+4E94 00          .     NOP              

+4E95 00          .     NOP              

+4E96 00          .     NOP              

+4E97 00          .     NOP              

+4E98 00          .     NOP              

+4E99 0E 01       ..    LD    C,01       

+4E9B E5          .     PUSH  HL         

+4E9C FD E1       ..    POP   IY         

+4E9E FD 7E 07    .~.   LD    A,(IY+07)  

+4EA1 FE 8D       ..    CP    8D         

+4EA3 D0          .     RET   NC         

+4EA4 B7          .     OR    A          

+4EA5 FA AD 4E    ..N   JP    M,4EAD     

+4EA8 3E 80       >.    LD    A,80       

+4EAA FD 77 07    .w.   LD    (IY+07),A  

+4EAD D6 7F       ..    SUB   A,7F       

+4EAF CB 3F       .?    SLR   A          

+4EB1 47          G     LD    B,A        

+4EB2 5F          _     LD    E,A        

+4EB3 16 00       ..    LD    D,00       

+4EB5 79          y     LD    A,C        

+4EB6 38 04       8.    JR    C,4EBC     

+4EB8 87          .     ADD   A          

+4EB9 87          .     ADD   A          

+4EBA 81          .     ADD   C          

+4EBB 87          .     ADD   A          

+4EBC 19          .     ADD   HL,DE      

+4EBD 04          .     INC   B          

+4EBE B7          .     OR    A          

+4EBF 8E          .     ADC   (HL)       

+4EC0 27          '     DAA              

+4EC1 77          w     LD    (HL),A     

+4EC2 2B          +     DEC   HL         

+4EC3 3E 00       >.    LD    A,00       

+4EC5 10 F8       ..    DJNZ  4EBF       

+4EC7 23          #     INC   HL         

+4EC8 7E          ~     LD    A,(HL)     

+4EC9 FE 10       ..    CP    10         

+4ECB D8          .     RET   C          

+4ECC 97          .     SUB   A          

+4ECD CD 3A 52    .:R   CALL  523A       

+4ED0 34          4     INC   (HL)       

+4ED1 C9          .     RET              

+4ED2 C5          .     PUSH  BC         

+4ED3 D5          .     PUSH  DE         

+4ED4 CD 73 52    .sR   CALL  5273       

+4ED7 D1          .     POP   DE         

+4ED8 C1          .     POP   BC         

+4ED9 1A          .     LD    A,(DE)     

+4EDA B7          .     OR    A          

+4EDB C8          .     RET   Z          

+4EDC EE 80       ..    XOR   80         

+4EDE 12          .     LD    (DE),A     

+4EDF C9          .     RET              

+4EE0 7B          {     LD    A,E        

+4EE1 11 07 00    ...   LD    DE,0007    

+4EE4 19          .     ADD   HL,DE      

+4EE5 C6 81       ..    ADD   A,81       

+4EE7 77          w     LD    (HL),A     

+4EE8 C9          .     RET              

+4EE9 11 07 00    ...   LD    DE,0007    

+4EEC 19          .     ADD   HL,DE      

+4EED 7E          ~     LD    A,(HL)     

+4EEE D6 81       ..    SUB   A,81       

+4EF0 5F          _     LD    E,A        

+4EF1 16 00       ..    LD    D,00       

+4EF3 D0          .     RET   NC         

+4EF4 15          .     DEC   D          

+4EF5 C9          .     RET              

+4EF6 C5          .     PUSH  BC         

+4EF7 D5          .     PUSH  DE         

+4EF8 CD 73 52    .sR   CALL  5273       

+4EFB EB          .     EX    DE,HL      

+4EFC D1          .     POP   DE         

+4EFD C1          .     POP   BC         

+4EFE 2B          +     DEC   HL         

+4EFF 3E 8D       >.    LD    A,8D       

+4F01 96          .     SUB   (HL)       

+4F02 D8          .     RET   C          

+4F03 FE 0D       ..    CP    0D         

+4F05 30 0F       0.    JR    NC,4F16    

+4F07 2B          +     DEC   HL         

+4F08 3D          =     DEC   A          

+4F09 F8          .     RET   M          

+4F0A 28 05       (.    JR    Z,4F11     

+4F0C 36 00       6.    LD    (HL),00    

+4F0E 3D          =     DEC   A          

+4F0F 18 F6       ..    JR    4F07       

+4F11 7E          ~     LD    A,(HL)     

+4F12 E6 F0       ..    AND   F0         

+4F14 77          w     LD    (HL),A     

+4F15 C9          .     RET              

+4F16 EB          .     EX    DE,HL      

+4F17 3E 08       >.    LD    A,08       

+4F19 36 00       6.    LD    (HL),00    

+4F1B 23          #     INC   HL         

+4F1C 3D          =     DEC   A          

+4F1D 20 FA        .    JR    NZ,4F19    

+4F1F C9          .     RET              

+4F20 FD 7E 00    .~.   LD    A,(IY+00)  

+4F23 EE 80       ..    XOR   80         

+4F25 5F          _     LD    E,A        

+4F26 DD 56 00    .V.   LD    D,(IX+00)  

+4F29 C3 32 4F    .2O   JP    4F32       

+4F2C DD 56 00    .V.   LD    D,(IX+00)  

+4F2F FD 5E 00    .^.   LD    E,(IY+00)  

+4F32 AF          .     XOR   A          

+4F33 DD BE 07    ...   CP    (IX+07)    

+4F36 C2 49 4F    .IO   JP    NZ,4F49    

+4F39 FD BE 07    ...   CP    (IY+07)    

+4F3C C8          .     RET   Z          

+4F3D 7B          {     LD    A,E        

+4F3E FD E5       ..    PUSH  IY         

+4F40 E1          .     POP   HL         

+4F41 CD 79 52    .yR   CALL  5279       

+4F44 DD 77 00    .w.   LD    (IX+00),A  

+4F47 B7          .     OR    A          

+4F48 C9          .     RET              

+4F49 DD 72 00    .r.   LD    (IX+00),D  

+4F4C FD BE 07    ...   CP    (IY+07)    

+4F4F C8          .     RET   Z          

+4F50 D5          .     PUSH  DE         

+4F51 CB BA       ..    RES   7,D        

+4F53 CB BB       ..    RES   7,E        

+4F55 CD B9 51    ..Q   CALL  51B9       

+4F58 38 0D       8.    JR    C,4F67     

+4F5A CD 7E 52    .~R   CALL  527E       

+4F5D CD 96 52    ..R   CALL  5296       

+4F60 C1          .     POP   BC         

+4F61 78          x     LD    A,B        

+4F62 A9          .     XOR   C          

+4F63 78          x     LD    A,B        

+4F64 C3 71 4F    .qO   JP    4F71       

+4F67 CD 86 52    ..R   CALL  5286       

+4F6A CD 82 52    ..R   CALL  5282       

+4F6D C1          .     POP   BC         

+4F6E 79          y     LD    A,C        

+4F6F A8          .     XOR   B          

+4F70 79          y     LD    A,C        

+4F71 08          .     EX    AF,AF'     

+4F72 3A BD 52    :.R   LD    A,(52BD)   

+4F75 21 C5 52    !.R   LD    HL,52C5    

+4F78 96          .     SUB   (HL)       

+4F79 28 0F       (.    JR    Z,4F8A     

+4F7B FE 0D       ..    CP    0D         

+4F7D D2 D8 4F    ..O   JP    NC,4FD8    

+4F80 47          G     LD    B,A        

+4F81 AF          .     XOR   A          

+4F82 21 BE 52    !.R   LD    HL,52BE    

+4F85 CD 3A 52    .:R   CALL  523A       

+4F88 10 F7       ..    DJNZ  4F81       

+4F8A 06 07       ..    LD    B,07       

+4F8C 21 C4 52    !.R   LD    HL,52C4    

+4F8F 11 BC 52    ..R   LD    DE,52BC    

+4F92 A7          .     AND   A          

+4F93 08          .     EX    AF,AF'     

+4F94 FA B8 4F    ..O   JP    M,4FB8     

+4F97 08          .     EX    AF,AF'     

+4F98 1A          .     LD    A,(DE)     

+4F99 8E          .     ADC   (HL)       

+4F9A 27          '     DAA              

+4F9B 12          .     LD    (DE),A     

+4F9C 1B          .     DEC   DE         

+4F9D 2B          +     DEC   HL         

+4F9E 10 F8       ..    DJNZ  4F98       

+4FA0 3A B6 52    :.R   LD    A,(52B6)   

+4FA3 E6 F0       ..    AND   F0         

+4FA5 CA D8 4F    ..O   JP    Z,4FD8     

+4FA8 21 BD 52    !.R   LD    HL,52BD    

+4FAB 34          4     INC   (HL)       

+4FAC CA B2 52    ..R   JP    Z,52B2     

+4FAF 21 B6 52    !.R   LD    HL,52B6    

+4FB2 CD 3A 52    .:R   CALL  523A       

+4FB5 C3 D8 4F    ..O   JP    4FD8       

+4FB8 08          .     EX    AF,AF'     

+4FB9 1A          .     LD    A,(DE)     

+4FBA 9E          .     SBC   (HL)       

+4FBB 27          '     DAA              

+4FBC 12          .     LD    (DE),A     

+4FBD 1B          .     DEC   DE         

+4FBE 2B          +     DEC   HL         

+4FBF 10 F8       ..    DJNZ  4FB9       

+4FC1 3A BD 52    :.R   LD    A,(52BD)   

+4FC4 4F          O     LD    C,A        

+4FC5 21 B6 52    !.R   LD    HL,52B6    

+4FC8 CD F6 51    ..Q   CALL  51F6       

+4FCB CA A6 52    ..R   JP    Z,52A6     

+4FCE DA A6 52    ..R   JP    C,52A6     

+4FD1 79          y     LD    A,C        

+4FD2 32 BD 52    2.R   LD    (52BD),A   

+4FD5 C3 D8 4F    ..O   JP    4FD8       

+4FD8 21 B6 52    !.R   LD    HL,52B6    

+4FDB CD 79 52    .yR   CALL  5279       

+4FDE C3 0B 51    ..Q   JP    510B       

+4FE1 AF          .     XOR   A          

+4FE2 DD BE 07    ...   CP    (IX+07)    

+4FE5 CA A6 52    ..R   JP    Z,52A6     

+4FE8 FD BE 07    ...   CP    (IY+07)    

+4FEB CA A6 52    ..R   JP    Z,52A6     

+4FEE DD 7E 00    .~.   LD    A,(IX+00)  

+4FF1 FD AE 00    ...   XOR   (IY+00)    

+4FF4 08          .     EX    AF,AF'     

+4FF5 DD E5       ..    PUSH  IX         

+4FF7 D1          .     POP   DE         

+4FF8 21 06 00    !..   LD    HL,0006    

+4FFB 19          .     ADD   HL,DE      

+4FFC 22 B4 52    ".R   LD    (52B4),HL  

+4FFF EB          .     EX    DE,HL      

+5000 CD 93 51    ..Q   CALL  5193       

+5003 CD 86 52    ..R   CALL  5286       

+5006 FD 21 B6 52 .!.R  LD    IY,52B6    

+500A CD A6 52    ..R   CALL  52A6       

+500D 06 07       ..    LD    B,07       

+500F C3 1D 50    ..P   JP    501D       

+5012 AF          .     XOR   A          

+5013 CD 37 52    .7R   CALL  5237       

+5016 CD BD 50    ..P   CALL  50BD       

+5019 AF          .     XOR   A          

+501A CD 37 52    .7R   CALL  5237       

+501D FD 4E 06    .N.   LD    C,(IY+06)  

+5020 FD 2B       .+    DEC   IY         

+5022 CD BD 50    ..P   CALL  50BD       

+5025 10 EB       ..    DJNZ  5012       

+5027 05          .     DEC   B          

+5028 DD 7E 00    .~.   LD    A,(IX+00)  

+502B E6 F0       ..    AND   F0         

+502D 28 05       (.    JR    Z,5034     

+502F 04          .     INC   B          

+5030 AF          .     XOR   A          

+5031 CD 37 52    .7R   CALL  5237       

+5034 3A CD 52    :.R   LD    A,(52CD)   

+5037 D6 80       ..    SUB   A,80       

+5039 4F          O     LD    C,A        

+503A FD 7E 0E    .~.   LD    A,(IY+0E)  

+503D D6 80       ..    SUB   A,80       

+503F 81          .     ADD   C          

+5040 E2 4A 50    .JP   JP    PO,504A    

+5043 80          .     ADD   B          

+5044 E2 AD 51    ..Q   JP    PO,51AD    

+5047 C3 4E 50    .NP   JP    504E       

+504A 80          .     ADD   B          

+504B EA AD 51    ..Q   JP    PE,51AD    

+504E C6 80       ..    ADD   A,80       

+5050 CA A6 52    ..R   JP    Z,52A6     

+5053 DD 77 07    .w.   LD    (IX+07),A  

+5056 C3 0B 51    ..Q   JP    510B       

+5059 AF          .     XOR   A          

+505A FD BE 07    ...   CP    (IY+07)    

+505D CA B2 52    ..R   JP    Z,52B2     

+5060 DD BE 07    ...   CP    (IX+07)    

+5063 CA A6 52    ..R   JP    Z,52A6     

+5066 DD 7E 00    .~.   LD    A,(IX+00)  

+5069 FD AE 00    ...   XOR   (IY+00)    

+506C 08          .     EX    AF,AF'     

+506D FD E5       ..    PUSH  IY         

+506F E1          .     POP   HL         

+5070 CD 93 51    ..Q   CALL  5193       

+5073 DD E5       ..    PUSH  IX         

+5075 CD 7E 52    .~R   CALL  527E       

+5078 01 01 07    ...   LD    BC,0701    

+507B C5          .     PUSH  BC         

+507C 0E 0F       ..    LD    C,0F       

+507E 21 C6 52    !.R   LD    HL,52C6    

+5081 CD 5A 51    .ZQ   CALL  515A       

+5084 30 18       0.    JR    NC,509E    

+5086 C1          .     POP   BC         

+5087 0D          .     DEC   C          

+5088 C5          .     PUSH  BC         

+5089 C3 97 50    ..P   JP    5097       

+508C C5          .     PUSH  BC         

+508D 21 B6 52    !.R   LD    HL,52B6    

+5090 AF          .     XOR   A          

+5091 CD 1B 52    ..R   CALL  521B       

+5094 CD 19 51    ..Q   CALL  5119       

+5097 21 B6 52    !.R   LD    HL,52B6    

+509A AF          .     XOR   A          

+509B CD 1B 52    ..R   CALL  521B       

+509E CD 19 51    ..Q   CALL  5119       

+50A1 79          y     LD    A,C        

+50A2 2F          /     CPL              

+50A3 DD 77 00    .w.   LD    (IX+00),A  

+50A6 DD 23       .#    INC   IX         

+50A8 C1          .     POP   BC         

+50A9 10 E1       ..    DJNZ  508C       

+50AB 41          A     LD    B,C        

+50AC 3A CD 52    :.R   LD    A,(52CD)   

+50AF D6 80       ..    SUB   A,80       

+50B1 4F          O     LD    C,A        

+50B2 3A BD 52    :.R   LD    A,(52BD)   

+50B5 D6 80       ..    SUB   A,80       

+50B7 91          .     SUB   C          

+50B8 DD E1       ..    POP   IX         

+50BA C3 40 50    .@P   JP    5040       

+50BD 21 CC 52    !.R   LD    HL,52CC    

+50C0 CB 19       ..    RR    C          

+50C2 DC DE 50    ..P   CALL  C,50DE     

+50C5 21 D4 52    !.R   LD    HL,52D4    

+50C8 CB 19       ..    RR    C          

+50CA DC DE 50    ..P   CALL  C,50DE     

+50CD 21 DC 52    !.R   LD    HL,52DC    

+50D0 CB 19       ..    RR    C          

+50D2 DC DE 50    ..P   CALL  C,50DE     

+50D5 21 E4 52    !.R   LD    HL,52E4    

+50D8 CB 19       ..    RR    C          

+50DA DC DE 50    ..P   CALL  C,50DE     

+50DD C9          .     RET              

+50DE ED 5B B4 52 .[.R  LD    DE,(52B4)  

+50E2 1A          .     LD    A,(DE)     

+50E3 86          .     ADD   (HL)       

+50E4 27          '     DAA              

+50E5 12          .     LD    (DE),A     

+50E6 1B          .     DEC   DE         

+50E7 2B          +     DEC   HL         

+50E8 1A          .     LD    A,(DE)     

+50E9 8E          .     ADC   (HL)       

+50EA 27          '     DAA              

+50EB 12          .     LD    (DE),A     

+50EC 1B          .     DEC   DE         

+50ED 2B          +     DEC   HL         

+50EE 1A          .     LD    A,(DE)     

+50EF 8E          .     ADC   (HL)       

+50F0 27          '     DAA              

+50F1 12          .     LD    (DE),A     

+50F2 1B          .     DEC   DE         

+50F3 2B          +     DEC   HL         

+50F4 1A          .     LD    A,(DE)     

+50F5 8E          .     ADC   (HL)       

+50F6 27          '     DAA              

+50F7 12          .     LD    (DE),A     

+50F8 1B          .     DEC   DE         

+50F9 2B          +     DEC   HL         

+50FA 1A          .     LD    A,(DE)     

+50FB 8E          .     ADC   (HL)       

+50FC 27          '     DAA              

+50FD 12          .     LD    (DE),A     

+50FE 1B          .     DEC   DE         

+50FF 2B          +     DEC   HL         

+5100 1A          .     LD    A,(DE)     

+5101 8E          .     ADC   (HL)       

+5102 27          '     DAA              

+5103 12          .     LD    (DE),A     

+5104 1B          .     DEC   DE         

+5105 2B          +     DEC   HL         

+5106 1A          .     LD    A,(DE)     

+5107 8E          .     ADC   (HL)       

+5108 27          '     DAA              

+5109 12          .     LD    (DE),A     

+510A C9          .     RET              

+510B DD 7E 00    .~.   LD    A,(IX+00)  

+510E E6 0F       ..    AND   0F         

+5110 47          G     LD    B,A        

+5111 08          .     EX    AF,AF'     

+5112 E6 80       ..    AND   80         

+5114 B0          .     OR    B          

+5115 DD 77 00    .w.   LD    (IX+00),A  

+5118 C9          .     RET              

+5119 21 DE 52    !.R   LD    HL,52DE    

+511C CD 5A 51    .ZQ   CALL  515A       

+511F 38 06       8.    JR    C,5127     

+5121 21 E4 52    !.R   LD    HL,52E4    

+5124 CD 67 51    .gQ   CALL  5167       

+5127 CB 11       ..    RL    C          

+5129 21 D6 52    !.R   LD    HL,52D6    

+512C CD 5A 51    .ZQ   CALL  515A       

+512F 38 06       8.    JR    C,5137     

+5131 21 DC 52    !.R   LD    HL,52DC    

+5134 CD 67 51    .gQ   CALL  5167       

+5137 CB 11       ..    RL    C          

+5139 21 CE 52    !.R   LD    HL,52CE    

+513C CD 5A 51    .ZQ   CALL  515A       

+513F 38 06       8.    JR    C,5147     

+5141 21 D4 52    !.R   LD    HL,52D4    

+5144 CD 67 51    .gQ   CALL  5167       

+5147 CB 11       ..    RL    C          

+5149 21 C6 52    !.R   LD    HL,52C6    

+514C CD 5A 51    .ZQ   CALL  515A       

+514F 38 06       8.    JR    C,5157     

+5151 21 CC 52    !.R   LD    HL,52CC    

+5154 CD 67 51    .gQ   CALL  5167       

+5157 CB 11       ..    RL    C          

+5159 C9          .     RET              

+515A 11 B6 52    ..R   LD    DE,52B6    

+515D 06 07       ..    LD    B,07       

+515F 1A          .     LD    A,(DE)     

+5160 BE          .     CP    (HL)       

+5161 C0          .     RET   NZ         

+5162 23          #     INC   HL         

+5163 13          .     INC   DE         

+5164 10 F9       ..    DJNZ  515F       

+5166 C9          .     RET              

+5167 11 BC 52    ..R   LD    DE,52BC    

+516A 1A          .     LD    A,(DE)     

+516B 96          .     SUB   (HL)       

+516C 27          '     DAA              

+516D 12          .     LD    (DE),A     

+516E 1B          .     DEC   DE         

+516F 2B          +     DEC   HL         

+5170 1A          .     LD    A,(DE)     

+5171 9E          .     SBC   (HL)       

+5172 27          '     DAA              

+5173 12          .     LD    (DE),A     

+5174 1B          .     DEC   DE         

+5175 2B          +     DEC   HL         

+5176 1A          .     LD    A,(DE)     

+5177 9E          .     SBC   (HL)       

+5178 27          '     DAA              

+5179 12          .     LD    (DE),A     

+517A 1B          .     DEC   DE         

+517B 2B          +     DEC   HL         

+517C 1A          .     LD    A,(DE)     

+517D 9E          .     SBC   (HL)       

+517E 27          '     DAA              

+517F 12          .     LD    (DE),A     

+5180 1B          .     DEC   DE         

+5181 2B          +     DEC   HL         

+5182 1A          .     LD    A,(DE)     

+5183 9E          .     SBC   (HL)       

+5184 27          '     DAA              

+5185 12          .     LD    (DE),A     

+5186 1B          .     DEC   DE         

+5187 2B          +     DEC   HL         

+5188 1A          .     LD    A,(DE)     

+5189 9E          .     SBC   (HL)       

+518A 27          '     DAA              

+518B 12          .     LD    (DE),A     

+518C 1B          .     DEC   DE         

+518D 2B          +     DEC   HL         

+518E 1A          .     LD    A,(DE)     

+518F 9E          .     SBC   (HL)       

+5190 27          '     DAA              

+5191 12          .     LD    (DE),A     

+5192 C9          .     RET              

+5193 11 C6 52    ..R   LD    DE,52C6    

+5196 CD 73 52    .sR   CALL  5273       

+5199 21 C6 52    !.R   LD    HL,52C6    

+519C CB BE       ..    RES   7,(HL)     

+519E 06 03       ..    LD    B,03       

+51A0 78          x     LD    A,B        

+51A1 CD 73 52    .sR   CALL  5273       

+51A4 47          G     LD    B,A        

+51A5 A7          .     AND   A          

+51A6 CD 53 52    .SR   CALL  5253       

+51A9 23          #     INC   HL         

+51AA 10 F4       ..    DJNZ  51A0       

+51AC C9          .     RET              

+51AD F2 A6 52    ..R   JP    P,52A6     

+51B0 C3 B2 52    ..R   JP    52B2       

+51B3 DD 56 00    .V.   LD    D,(IX+00)  

+51B6 FD 5E 00    .^.   LD    E,(IY+00)  

+51B9 7A          z     LD    A,D        

+51BA E6 80       ..    AND   80         

+51BC 20 13        .    JR    NZ,51D1    

+51BE CB 7B       .{    BIT   7,E        

+51C0 C0          .     RET   NZ         

+51C1 DD 7E 07    .~.   LD    A,(IX+07)  

+51C4 FD BE 07    ...   CP    (IY+07)    

+51C7 C0          .     RET   NZ         

+51C8 7A          z     LD    A,D        

+51C9 BB          .     CP    E          

+51CA C0          .     RET   NZ         

+51CB DD E5       ..    PUSH  IX         

+51CD FD E5       ..    PUSH  IY         

+51CF 18 11       ..    JR    51E2       

+51D1 AB          .     XOR   E          

+51D2 17          .     RLA              

+51D3 D8          .     RET   C          

+51D4 FD 7E 07    .~.   LD    A,(IY+07)  

+51D7 DD BE 07    ...   CP    (IX+07)    

+51DA C0          .     RET   NZ         

+51DB 7B          {     LD    A,E        

+51DC BA          .     CP    D          

+51DD C0          .     RET   NZ         

+51DE FD E5       ..    PUSH  IY         

+51E0 DD E5       ..    PUSH  IX         

+51E2 E1          .     POP   HL         

+51E3 D1          .     POP   DE         

+51E4 23          #     INC   HL         

+51E5 13          .     INC   DE         

+51E6 06 06       ..    LD    B,06       

+51E8 1A          .     LD    A,(DE)     

+51E9 BE          .     CP    (HL)       

+51EA C0          .     RET   NZ         

+51EB 23          #     INC   HL         

+51EC 13          .     INC   DE         

+51ED 10 F9       ..    DJNZ  51E8       

+51EF C9          .     RET              

+51F0 DD 4E 07    .N.   LD    C,(IX+07)  

+51F3 DD E5       ..    PUSH  IX         

+51F5 E1          .     POP   HL         

+51F6 7E          ~     LD    A,(HL)     

+51F7 A7          .     AND   A          

+51F8 20 10        .    JR    NZ,520A    

+51FA 06 0C       ..    LD    B,0C       

+51FC AF          .     XOR   A          

+51FD 0D          .     DEC   C          

+51FE 28 0E       (.    JR    Z,520E     

+5200 CD 1B 52    ..R   CALL  521B       

+5203 23          #     INC   HL         

+5204 7E          ~     LD    A,(HL)     

+5205 A7          .     AND   A          

+5206 20 02        .    JR    NZ,520A    

+5208 10 F3       ..    DJNZ  51FD       

+520A DD 71 07    .q.   LD    (IX+07),C  

+520D C9          .     RET              

+520E 04          .     INC   B          

+520F CB 38       .8    SLR   B          

+5211 23          #     INC   HL         

+5212 B6          .     OR    (HL)       

+5213 10 FC       ..    DJNZ  5211       

+5215 C8          .     RET   Z          

+5216 37          7     SCF              

+5217 C9          .     RET              

+5218 DD E5       ..    PUSH  IX         

+521A E1          .     POP   HL         

+521B C5          .     PUSH  BC         

+521C 01 06 00    ...   LD    BC,0006    

+521F 09          .     ADD   HL,BC      

+5220 ED 6F       .o    RLD              

+5222 2B          +     DEC   HL         

+5223 ED 6F       .o    RLD              

+5225 2B          +     DEC   HL         

+5226 ED 6F       .o    RLD              

+5228 2B          +     DEC   HL         

+5229 ED 6F       .o    RLD              

+522B 2B          +     DEC   HL         

+522C ED 6F       .o    RLD              

+522E 2B          +     DEC   HL         

+522F ED 6F       .o    RLD              

+5231 2B          +     DEC   HL         

+5232 ED 6F       .o    RLD              

+5234 2B          +     DEC   HL         

+5235 C1          .     POP   BC         

+5236 C9          .     RET              

+5237 DD E5       ..    PUSH  IX         

+5239 E1          .     POP   HL         

+523A ED 67       .g    RRD              

+523C 23          #     INC   HL         

+523D ED 67       .g    RRD              

+523F 23          #     INC   HL         

+5240 ED 67       .g    RRD              

+5242 23          #     INC   HL         

+5243 ED 67       .g    RRD              

+5245 23          #     INC   HL         

+5246 ED 67       .g    RRD              

+5248 23          #     INC   HL         

+5249 ED 67       .g    RRD              

+524B 23          #     INC   HL         

+524C ED 67       .g    RRD              

+524E 23          #     INC   HL         

+524F C9          .     RET              

+5250 DD E5       ..    PUSH  IX         

+5252 E1          .     POP   HL         

+5253 C5          .     PUSH  BC         

+5254 01 06 00    ...   LD    BC,0006    

+5257 09          .     ADD   HL,BC      

+5258 06 07       ..    LD    B,07       

+525A 7E          ~     LD    A,(HL)     

+525B 8F          .     ADC   A          

+525C 27          '     DAA              

+525D 77          w     LD    (HL),A     

+525E 2B          +     DEC   HL         

+525F 10 F9       ..    DJNZ  525A       

+5261 C1          .     POP   BC         

+5262 C9          .     RET              

+5263 11 E6 52    ..R   LD    DE,52E6    

+5266 18 08       ..    JR    5270       

+5268 11 EE 52    ..R   LD    DE,52EE    

+526B 18 03       ..    JR    5270       

+526D 11 F6 52    ..R   LD    DE,52F6    

+5270 DD E5       ..    PUSH  IX         

+5272 E1          .     POP   HL         

+5273 01 08 00    ...   LD    BC,0008    

+5276 ED B0       ..    LDIR             

+5278 C9          .     RET              

+5279 DD E5       ..    PUSH  IX         

+527B D1          .     POP   DE         

+527C 18 F5       ..    JR    5273       

+527E DD E5       ..    PUSH  IX         

+5280 18 06       ..    JR    5288       

+5282 DD E5       ..    PUSH  IX         

+5284 18 12       ..    JR    5298       

+5286 FD E5       ..    PUSH  IY         

+5288 E1          .     POP   HL         

+5289 11 B6 52    ..R   LD    DE,52B6    

+528C CD 73 52    .sR   CALL  5273       

+528F 21 B6 52    !.R   LD    HL,52B6    

+5292 56          V     LD    D,(HL)     

+5293 CB BE       ..    RES   7,(HL)     

+5295 C9          .     RET              

+5296 FD E5       ..    PUSH  IY         

+5298 E1          .     POP   HL         

+5299 11 BE 52    ..R   LD    DE,52BE    

+529C CD 73 52    .sR   CALL  5273       

+529F 21 BE 52    !.R   LD    HL,52BE    

+52A2 5E          ^     LD    E,(HL)     

+52A3 CB BE       ..    RES   7,(HL)     

+52A5 C9          .     RET              

+52A6 06 08       ..    LD    B,08       

+52A8 DD E5       ..    PUSH  IX         

+52AA E1          .     POP   HL         

+52AB 36 00       6.    LD    (HL),00    

+52AD 23          #     INC   HL         

+52AE 10 FB       ..    DJNZ  52AB       

+52B0 B7          .     OR    A          

+52B1 C9          .     RET              

+52B2 37          7     SCF              

+52B3 C9          .     RET              

+52B4 FF          .     RST   38         

+52B5 FF          .     RST   38         

+52B6 FF          .     RST   38         

+52B7 FF          .     RST   38         

+52B8 FF          .     RST   38         

+52B9 FF          .     RST   38         

+52BA FF          .     RST   38         

+52BB FF          .     RST   38         

+52BC FF          .     RST   38         

+52BD FF          .     RST   38         

+52BE FF          .     RST   38         

+52BF FF          .     RST   38         

+52C0 FF          .     RST   38         

+52C1 FF          .     RST   38         

+52C2 FF          .     RST   38         

+52C3 FF          .     RST   38         

+52C4 FF          .     RST   38         

+52C5 FF          .     RST   38         

+52C6 FF          .     RST   38         

+52C7 FF          .     RST   38         

+52C8 FF          .     RST   38         

+52C9 FF          .     RST   38         

+52CA FF          .     RST   38         

+52CB FF          .     RST   38         

+52CC FF          .     RST   38         

+52CD FF          .     RST   38         

+52CE FF          .     RST   38         

+52CF FF          .     RST   38         

+52D0 FF          .     RST   38         

+52D1 FF          .     RST   38         

+52D2 FF          .     RST   38         

+52D3 FF          .     RST   38         

+52D4 FF          .     RST   38         

+52D5 FF          .     RST   38         

+52D6 FF          .     RST   38         

+52D7 FF          .     RST   38         

+52D8 FF          .     RST   38         

+52D9 FF          .     RST   38         

+52DA FF          .     RST   38         

+52DB FF          .     RST   38         

+52DC FF          .     RST   38         

+52DD FF          .     RST   38         

+52DE FF          .     RST   38         

+52DF FF          .     RST   38         

+52E0 FF          .     RST   38         

+52E1 FF          .     RST   38         

+52E2 FF          .     RST   38         

+52E3 FF          .     RST   38         

+52E4 FF          .     RST   38         

+52E5 FF          .     RST   38         

+52E6 FF          .     RST   38         

+52E7 FF          .     RST   38         

+52E8 FF          .     RST   38         

+52E9 FF          .     RST   38         

+52EA FF          .     RST   38         

+52EB FF          .     RST   38         

+52EC FF          .     RST   38         

+52ED FF          .     RST   38         

+52EE FF          .     RST   38         

+52EF FF          .     RST   38         

+52F0 FF          .     RST   38         

+52F1 FF          .     RST   38         

+52F2 FF          .     RST   38         

+52F3 FF          .     RST   38         

+52F4 FF          .     RST   38         

+52F5 FF          .     RST   38         

+52F6 FF          .     RST   38         

+52F7 FF          .     RST   38         

+52F8 FF          .     RST   38         

+52F9 FF          .     RST   38         

+52FA FF          .     RST   38         

+52FB FF          .     RST   38         

+52FC FF          .     RST   38         

+52FD FF          .     RST   38         

+52FE 97          .     SUB   A          

+52FF CD 93 4C    ..L   CALL  4C93       

+5302 C3 26 29    .&)   JP    2926       

+5305 C9          .     RET              

+5306 31 37 35    175   LD    SP,3537    ; "175 bitmap   2 (!)"

+5309 20 62        b    JR    NZ,536D    

+530B 69          i     LD    L,C        

+530C 74          t     LD    (HL),H     

+530D 6D          m     LD    L,L        

+530E 61          a     LD    H,C        

+530F 70          p     LD    (HL),B     

+5310 20 20             JR    NZ,5332    

+5312 20 32        2    JR    NZ,5346    

+5314 20 28        (    JR    NZ,533E    

+5316 21 29 CD    !).   LD    HL,CD29    

+5319 9D          .     SBC   L          

+531A 53          S     LD    D,E        

+531B ED 5B 46 53 .[FS  LD    DE,(5346)  

+531F 7B          {     LD    A,E        

+5320 FE 14       ..    CP    14         

+5322 D0          .     RET   NC         

+5323 CD 41 5D    .A]   CALL  5D41       

+5326 CB FD       ..    SET   7,L        

+5328 CB 8E       ..    RES   1,(HL)     

+532A CB BD       ..    RES   7,L        

+532C D5          .     PUSH  DE         

+532D 65          e     LD    H,L        

+532E CB 24       .$    SLA   H          

+5330 2E 00       ..    LD    L,00       

+5332 54          T     LD    D,H        

+5333 5D          ]     LD    E,L        

+5334 13          .     INC   DE         

+5335 01 FF 01    ...   LD    BC,01FF    

+5338 36 FF       6.    LD    (HL),FF    

+533A ED B0       ..    LDIR             

+533C D1          .     POP   DE         

+533D 1C          .     INC   E          

+533E 1C          .     INC   E          

+533F ED 53 46 53 .SFS  LD    (5346),DE  

+5343 C3 1F 53    ..S   JP    531F       

+5346 04          .     INC   B          

+5347 00          .     NOP              

+5348 C5          .     PUSH  BC         

+5349 E5          .     PUSH  HL         

+534A 42          B     LD    B,D        

+534B 4B          K     LD    C,E        

+534C CB 38       .8    SLR   B          

+534E CB 19       ..    RR    C          

+5350 CB 38       .8    SLR   B          

+5352 CB 19       ..    RR    C          

+5354 CB 38       .8    SLR   B          

+5356 CB 19       ..    RR    C          

+5358 CB 38       .8    SLR   B          

+535A CB 19       ..    RR    C          

+535C FD 21 00 00 .!..  LD    IY,0000    

+5360 2A FD 56    *.V   LD    HL,(56FD)  

+5363 D5          .     PUSH  DE         

+5364 11 08 00    ...   LD    DE,0008    

+5367 7E          ~     LD    A,(HL)     

+5368 B7          .     OR    A          

+5369 28 13       (.    JR    Z,537E     

+536B FE FF       ..    CP    FF         

+536D 28 0D       (.    JR    Z,537C     

+536F C5          .     PUSH  BC         

+5370 06 08       ..    LD    B,08       

+5372 1F          .     RRA              

+5373 30 02       0.    JR    NC,5377    

+5375 FD 23       .#    INC   IY         

+5377 10 F9       ..    DJNZ  5372       

+5379 C1          .     POP   BC         

+537A 18 02       ..    JR    537E       

+537C FD 19       ..    ADD   IY,DE      

+537E ED A1       ..    CPI              

+5380 EA 67 53    .gS   JP    PE,5367    

+5383 D1          .     POP   DE         

+5384 7B          {     LD    A,E        

+5385 1F          .     RRA              

+5386 E6 07       ..    AND   07         

+5388 28 09       (.    JR    Z,5393     

+538A 47          G     LD    B,A        

+538B 7E          ~     LD    A,(HL)     

+538C 1F          .     RRA              

+538D 30 02       0.    JR    NC,5391    

+538F FD 23       .#    INC   IY         

+5391 10 F9       ..    DJNZ  538C       

+5393 FD 29       .)    ADD   IY,HL      

+5395 FD 23       .#    INC   IY         

+5397 E1          .     POP   HL         

+5398 C1          .     POP   BC         

+5399 FD E5       ..    PUSH  IY         

+539B D1          .     POP   DE         

+539C C9          .     RET              

+539D 97          .     SUB   A          

+539E 01 05 00    ...   LD    BC,0005    

+53A1 11 00 00    ...   LD    DE,0000    

+53A4 CD A8 28    ..(   CALL  28A8       

+53A7 ED 43 0A 57 .C.W  LD    (570A),BC  

+53AB E5          .     PUSH  HL         

+53AC 60          `     LD    H,B        

+53AD 69          i     LD    L,C        

+53AE 06 06       ..    LD    B,06       

+53B0 CB 3C       .<    SLR   H          

+53B2 CB 1D       ..    RR    L          

+53B4 10 FA       ..    DJNZ  53B0       

+53B6 7D          }     LD    A,L        

+53B7 C6 28       .(    ADD   A,28       

+53B9 6F          o     LD    L,A        

+53BA 30 01       0.    JR    NC,53BD    

+53BC 24          $     INC   H          

+53BD 22 10 57    ".W   LD    (5710),HL  

+53C0 E1          .     POP   HL         

+53C1 ED 4B 0A 57 .K.W  LD    BC,(570A)  

+53C5 CB 28       .(    SRA   B          

+53C7 CB 19       ..    RR    C          

+53C9 CB 28       .(    SRA   B          

+53CB CB 19       ..    RR    C          

+53CD CB 28       .(    SRA   B          

+53CF CB 19       ..    RR    C          

+53D1 ED 43 FB 56 .C.V  LD    (56FB),BC  

+53D5 C9          .     RET              

+53D6 E5          .     PUSH  HL         

+53D7 2A FD 56    *.V   LD    HL,(56FD)  

+53DA CD DF 53    ..S   CALL  53DF       

+53DD E1          .     POP   HL         

+53DE C9          .     RET              

+53DF C5          .     PUSH  BC         

+53E0 E5          .     PUSH  HL         

+53E1 2A F9 56    *.V   LD    HL,(56F9)  

+53E4 B7          .     OR    A          

+53E5 ED 52       .R    SBC   HL,DE      

+53E7 20 10        .    JR    NZ,53F9    

+53E9 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+53EC 18 0B       ..    JR    53F9       ; " bnr gleich"

+53EE 20 62        b    JR    NZ,5452    

+53F0 6E          n     LD    L,(HL)     

+53F1 72          r     LD    (HL),D     

+53F2 20 67        g    JR    NZ,545B    

+53F4 6C          l     LD    L,H        

+53F5 65          e     LD    H,L        

+53F6 69          i     LD    L,C        

+53F7 63          c     LD    H,E        

+53F8 68          h     LD    L,B        

+53F9 E1          .     POP   HL         

+53FA ED 4B FB 56 .K.V  LD    BC,(56FB)  

+53FE F5          .     PUSH  AF         

+53FF D5          .     PUSH  DE         

+5400 CD 66 56    .fV   CALL  5666       

+5403 30 04       0.    JR    NC,5409    

+5405 19          .     ADD   HL,DE      

+5406 2F          /     CPL              

+5407 A6          .     AND   (HL)       

+5408 77          w     LD    (HL),A     

+5409 D1          .     POP   DE         

+540A F1          .     POP   AF         

+540B C1          .     POP   BC         

+540C C9          .     RET              

+540D E5          .     PUSH  HL         

+540E 2A FF 56    *.V   LD    HL,(56FF)  

+5411 CD DF 53    ..S   CALL  53DF       

+5414 E1          .     POP   HL         

+5415 C9          .     RET              

+5416 E5          .     PUSH  HL         

+5417 D5          .     PUSH  DE         

+5418 C5          .     PUSH  BC         

+5419 CD 9D 53    ..S   CALL  539D       

+541C 78          x     LD    A,B        

+541D 3C          <     INC   A          

+541E 3C          <     INC   A          

+541F CD B1 5F    .._   CALL  5FB1       

+5422 22 FD 56    ".V   LD    (56FD),HL  

+5425 CD 3A 54    .:T   CALL  543A       

+5428 22 FF 56    ".V   LD    (56FF),HL  

+542B 54          T     LD    D,H        

+542C 5D          ]     LD    E,L        

+542D 13          .     INC   DE         

+542E 36 FF       6.    LD    (HL),FF    

+5430 ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5434 ED B0       ..    LDIR             

+5436 C1          .     POP   BC         

+5437 D1          .     POP   DE         

+5438 E1          .     POP   HL         

+5439 C9          .     RET              

+543A 11 04 00    ...   LD    DE,0004    

+543D ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5441 C5          .     PUSH  BC         

+5442 D5          .     PUSH  DE         

+5443 E5          .     PUSH  HL         

+5444 CD 46 81    .F.   CALL  8146       

+5447 67          g     LD    H,A        

+5448 2E 00       ..    LD    L,00       

+544A D1          .     POP   DE         

+544B 01 00 02    ...   LD    BC,0200    

+544E ED B0       ..    LDIR             

+5450 62          b     LD    H,D        

+5451 6B          k     LD    L,E        

+5452 D1          .     POP   DE         

+5453 1C          .     INC   E          

+5454 1C          .     INC   E          

+5455 C1          .     POP   BC         

+5456 05          .     DEC   B          

+5457 05          .     DEC   B          

+5458 F2 41 54    .AT   JP    P,5441     

+545B C9          .     RET              

+545C E5          .     PUSH  HL         

+545D D5          .     PUSH  DE         

+545E C5          .     PUSH  BC         

+545F F5          .     PUSH  AF         

+5460 3A 13 57    :.W   LD    A,(5713)   

+5463 B7          .     OR    A          

+5464 C2 12 55    ..U   JP    NZ,5512    

+5467 2A 08 57    *.W   LD    HL,(5708)  

+546A 22 0C 57    ".W   LD    (570C),HL  

+546D 21 04 00    !..   LD    HL,0004    

+5470 ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5474 ED 5B FD 56 .[.V  LD    DE,(56FD)  

+5478 FD 21 00 00 .!..  LD    IY,0000    

+547C 3E 01       >.    LD    A,01       

+547E 32 12 57    2.W   LD    (5712),A   

+5481 E5          .     PUSH  HL         

+5482 C5          .     PUSH  BC         

+5483 D5          .     PUSH  DE         

+5484 EB          .     EX    DE,HL      

+5485 FD E5       ..    PUSH  IY         

+5487 CD 46 81    .F.   CALL  8146       

+548A FD E1       ..    POP   IY         

+548C 67          g     LD    H,A        

+548D 2E 00       ..    LD    L,00       

+548F D1          .     POP   DE         

+5490 01 00 02    ...   LD    BC,0200    

+5493 1A          .     LD    A,(DE)     

+5494 AE          .     XOR   (HL)       

+5495 77          w     LD    (HL),A     

+5496 87          .     ADD   A          

+5497 30 02       0.    JR    NC,549B    

+5499 FD 23       .#    INC   IY         

+549B 20 F9        .    JR    NZ,5496    

+549D 13          .     INC   DE         

+549E ED A1       ..    CPI              

+54A0 EA 93 54    ..T   JP    PE,5493    

+54A3 C1          .     POP   BC         

+54A4 E1          .     POP   HL         

+54A5 2C          ,     INC   L          

+54A6 2C          ,     INC   L          

+54A7 05          .     DEC   B          

+54A8 05          .     DEC   B          

+54A9 F2 81 54    ..T   JP    P,5481     

+54AC 2A 0C 57    *.W   LD    HL,(570C)  

+54AF ED 4B 08 57 .K.W  LD    BC,(5708)  

+54B3 B7          .     OR    A          

+54B4 ED 42       .B    SBC   HL,BC      

+54B6 FD E5       ..    PUSH  IY         

+54B8 C1          .     POP   BC         

+54B9 09          .     ADD   HL,BC      

+54BA 44          D     LD    B,H        

+54BB 4D          M     LD    C,L        

+54BC 2A 0A 57    *.W   LD    HL,(570A)  

+54BF B7          .     OR    A          

+54C0 ED 42       .B    SBC   HL,BC      

+54C2 30 0C       0.    JR    NC,54D0    

+54C4 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+54C7 18 07       ..    JR    54D0       ; " HGVOLL"

+54C9 20 48        H    JR    NZ,5513    

+54CB 47          G     LD    B,A        

+54CC 56          V     LD    D,(HL)     

+54CD 4F          O     LD    C,A        

+54CE 4C          L     LD    C,H        

+54CF 4C          L     LD    C,H        

+54D0 ED 4B 10 57 .K.W  LD    BC,(5710)  

+54D4 ED 42       .B    SBC   HL,BC      

+54D6 22 08 57    ".W   LD    (5708),HL  

+54D9 B7          .     OR    A          

+54DA 01 14 00    ...   LD    BC,0014    

+54DD ED 42       .B    SBC   HL,BC      

+54DF 3E 00       >.    LD    A,00       

+54E1 DC FA 54    ..T   CALL  C,54FA     

+54E4 32 13 57    2.W   LD    (5713),A   

+54E7 CD CD 5F    .._   CALL  5FCD       

+54EA 11 04 00    ...   LD    DE,0004    

+54ED ED 53 0E 57 .S.W  LD    (570E),DE  

+54F1 97          .     SUB   A          

+54F2 32 12 57    2.W   LD    (5712),A   

+54F5 F1          .     POP   AF         

+54F6 C1          .     POP   BC         

+54F7 D1          .     POP   DE         

+54F8 E1          .     POP   HL         

+54F9 C9          .     RET              

+54FA 2A 08 57    *.W   LD    HL,(5708)  

+54FD ED 4B 10 57 .K.W  LD    BC,(5710)  

+5501 09          .     ADD   HL,BC      

+5502 22 08 57    ".W   LD    (5708),HL  

+5505 21 81 18    !..   LD    HL,1881    

+5508 06 7D       .}    LD    B,7D       

+550A CB CE       ..    SET   1,(HL)     

+550C 23          #     INC   HL         

+550D 10 FB       ..    DJNZ  550A       

+550F 3E 01       >.    LD    A,01       

+5511 C9          .     RET              

+5512 2A FD 56    *.V   LD    HL,(56FD)  

+5515 ED 4B FB 56 .K.V  LD    BC,(56FB)  

+5519 11 00 00    ...   LD    DE,0000    

+551C 7E          ~     LD    A,(HL)     

+551D 87          .     ADD   A          

+551E 30 01       0.    JR    NC,5521    

+5520 13          .     INC   DE         

+5521 20 FA        .    JR    NZ,551D    

+5523 ED A1       ..    CPI              

+5525 EA 1C 55    ..U   JP    PE,551C    

+5528 62          b     LD    H,D        

+5529 6B          k     LD    L,E        

+552A B7          .     OR    A          

+552B ED 5B 10 57 .[.W  LD    DE,(5710)  

+552F ED 52       .R    SBC   HL,DE      

+5531 3E 00       >.    LD    A,00       

+5533 CE 00       ..    ADC   A,00       

+5535 32 13 57    2.W   LD    (5713),A   

+5538 20 0F        .    JR    NZ,5549    

+553A 21 17 82    !..   LD    HL,8217    

+553D 36 03       6.    LD    (HL),03    

+553F 06 7D       .}    LD    B,7D       

+5541 21 81 18    !..   LD    HL,1881    

+5544 CB 8E       ..    RES   1,(HL)     

+5546 23          #     INC   HL         

+5547 10 FB       ..    DJNZ  5544       

+5549 CD CD 5F    .._   CALL  5FCD       

+554C 18 A3       ..    JR    54F1       

+554E 21 12 57    !.W   LD    HL,5712    

+5551 7E          ~     LD    A,(HL)     

+5552 B7          .     OR    A          

+5553 C2 1A 6C    ..l   JP    NZ,6C1A    

+5556 D5          .     PUSH  DE         

+5557 C5          .     PUSH  BC         

+5558 2A 08 57    *.W   LD    HL,(5708)  

+555B 2B          +     DEC   HL         

+555C CB 7C       .|    BIT   7,H        

+555E 28 07       (.    JR    Z,5567     

+5560 CD 0E 6E    ..n   CALL  6E0E       

+5563 FE 4D       .M    CP    4D         

+5565 20 63        c    JR    NZ,55CA    

+5567 22 08 57    ".W   LD    (5708),HL  

+556A ED 5B 0E 57 .[.W  LD    DE,(570E)  

+556E CD 41 5D    .A]   CALL  5D41       

+5571 CB FD       ..    SET   7,L        

+5573 CB 8E       ..    RES   1,(HL)     

+5575 65          e     LD    H,L        

+5576 2E 00       ..    LD    L,00       

+5578 CB 24       .$    SLA   H          

+557A 01 00 02    ...   LD    BC,0200    

+557D CD F7 55    ..U   CALL  55F7       

+5580 30 22       0"    JR    NC,55A4    

+5582 ED 5B 0E 57 .[.W  LD    DE,(570E)  

+5586 7B          {     LD    A,E        

+5587 D6 04       ..    SUB   A,04       

+5589 87          .     ADD   A          

+558A 87          .     ADD   A          

+558B 87          .     ADD   A          

+558C 87          .     ADD   A          

+558D 1E 00       ..    LD    E,00       

+558F 57          W     LD    D,A        

+5590 19          .     ADD   HL,DE      

+5591 ED 5B 0A 57 .[.W  LD    DE,(570A)  

+5595 CB 23       .#    SLA   E          

+5597 CB 12       ..    RL    D          

+5599 B7          .     OR    A          

+559A E5          .     PUSH  HL         

+559B ED 52       .R    SBC   HL,DE      

+559D E1          .     POP   HL         

+559E 30 10       0.    JR    NC,55B0    

+55A0 C1          .     POP   BC         

+55A1 D1          .     POP   DE         

+55A2 B7          .     OR    A          

+55A3 C9          .     RET              

+55A4 ED 5B 0E 57 .[.W  LD    DE,(570E)  

+55A8 1C          .     INC   E          

+55A9 1C          .     INC   E          

+55AA ED 53 0E 57 .S.W  LD    (570E),DE  

+55AE 18 BA       ..    JR    556A       

+55B0 CD 0E 6E    ..n   CALL  6E0E       

+55B3 FE 4D       .M    CP    4D         ; Muell-Prozess ?

+55B5 20 04        .    JR    NZ,55BB    

+55B7 C1          .     POP   BC         

+55B8 D1          .     POP   DE         

+55B9 37          7     SCF              

+55BA C9          .     RET              

+55BB CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+55BE 18 08       ..    JR    55C8       ; " HG voll"

+55C0 20 48        H    JR    NZ,560A    

+55C2 47          G     LD    B,A        

+55C3 20 76        v    JR    NZ,563B    

+55C5 6F          o     LD    L,A        

+55C6 6C          l     LD    L,H        

+55C7 6C          l     LD    L,H        

+55C8 18 F1       ..    JR    55BB       

+55CA 21 17 82    !..   LD    HL,8217    

+55CD 7E          ~     LD    A,(HL)     

+55CE B7          .     OR    A          

+55CF CB C6       ..    SET   0,(HL)     

+55D1 20 03        .    JR    NZ,55D6    

+55D3 3E 03       >.    LD    A,03       

+55D5 77          w     LD    (HL),A     

+55D6 C3 1A 6C    ..l   JP    6C1A       

+55D9 D5          .     PUSH  DE         

+55DA E5          .     PUSH  HL         

+55DB EB          .     EX    DE,HL      

+55DC 01 00 01    ...   LD    BC,0100    

+55DF CD F7 55    ..U   CALL  55F7       

+55E2 44          D     LD    B,H        

+55E3 4D          M     LD    C,L        

+55E4 E1          .     POP   HL         

+55E5 D1          .     POP   DE         

+55E6 C9          .     RET              

+55E7 D5          .     PUSH  DE         

+55E8 C5          .     PUSH  BC         

+55E9 2A FF 56    *.V   LD    HL,(56FF)  

+55EC ED 4B FB 56 .K.V  LD    BC,(56FB)  

+55F0 03          .     INC   BC         

+55F1 CD F7 55    ..U   CALL  55F7       

+55F4 C1          .     POP   BC         

+55F5 D1          .     POP   DE         

+55F6 C9          .     RET              

+55F7 E5          .     PUSH  HL         

+55F8 3E FF       >.    LD    A,FF       

+55FA 03          .     INC   BC         

+55FB ED A1       ..    CPI              

+55FD E2 2B 56    .+V   JP    PO,562B    

+5600 28 F9       (.    JR    Z,55FB     

+5602 2B          +     DEC   HL         

+5603 06 08       ..    LD    B,08       

+5605 CB 1E       ..    RR    (HL)       

+5607 30 02       0.    JR    NC,560B    

+5609 10 FA       ..    DJNZ  5605       

+560B 3E 08       >.    LD    A,08       

+560D 90          .     SUB   B          

+560E 37          7     SCF              

+560F CB 1E       ..    RR    (HL)       

+5611 10 FC       ..    DJNZ  560F       

+5613 C1          .     POP   BC         

+5614 B7          .     OR    A          

+5615 ED 42       .B    SBC   HL,BC      

+5617 CB 25       .%    SLA   L          

+5619 CB 14       ..    RL    H          

+561B CB 25       .%    SLA   L          

+561D CB 14       ..    RL    H          

+561F CB 25       .%    SLA   L          

+5621 CB 14       ..    RL    H          

+5623 B5          .     OR    L          

+5624 6F          o     LD    L,A        

+5625 CB 25       .%    SLA   L          

+5627 CB 14       ..    RL    H          

+5629 37          7     SCF              

+562A C9          .     RET              

+562B E1          .     POP   HL         

+562C B7          .     OR    A          

+562D C9          .     RET              

+562E E5          .     PUSH  HL         

+562F 2A 08 57    *.W   LD    HL,(5708)  

+5632 CB 3C       .<    SLR   H          

+5634 CB 1D       ..    RR    L          

+5636 B7          .     OR    A          

+5637 ED 42       .B    SBC   HL,BC      

+5639 E1          .     POP   HL         

+563A D0          .     RET   NC         

+563B CD 20 6E    . n   CALL  6E20       

+563E C5          .     PUSH  BC         

+563F 3A 17 82    :..   LD    A,(8217)   

+5642 BA          .     CP    D          

+5643 28 09       (.    JR    Z,564E     

+5645 D5          .     PUSH  DE         

+5646 CD C1 81    ...   CALL  81C1       

+5649 D1          .     POP   DE         

+564A 7A          z     LD    A,D        

+564B 32 17 82    2..   LD    (8217),A   

+564E CD C1 81    ...   CALL  81C1       

+5651 CD CC 56    ..V   CALL  56CC       

+5654 B7          .     OR    A          

+5655 ED 42       .B    SBC   HL,BC      

+5657 C1          .     POP   BC         

+5658 ED 42       .B    SBC   HL,BC      

+565A 38 05       8.    JR    C,5661     

+565C CD 2A 6E    .*n   CALL  6E2A       

+565F B7          .     OR    A          

+5660 C9          .     RET              

+5661 CD 2A 6E    .*n   CALL  6E2A       

+5664 37          7     SCF              

+5665 C9          .     RET              

+5666 CB 3A       .:    SLR   D          

+5668 CB 1B       ..    RR    E          

+566A 7B          {     LD    A,E        

+566B E6 07       ..    AND   07         

+566D CB 3A       .:    SLR   D          

+566F CB 1B       ..    RR    E          

+5671 CB 3A       .:    SLR   D          

+5673 CB 1B       ..    RR    E          

+5675 CB 3A       .:    SLR   D          

+5677 CB 1B       ..    RR    E          

+5679 E5          .     PUSH  HL         

+567A 21 14 57    !.W   LD    HL,5714    

+567D 85          .     ADD   L          

+567E 6F          o     LD    L,A        

+567F 30 01       0.    JR    NC,5682    

+5681 24          $     INC   H          

+5682 7E          ~     LD    A,(HL)     

+5683 60          `     LD    H,B        

+5684 69          i     LD    L,C        

+5685 B7          .     OR    A          

+5686 ED 52       .R    SBC   HL,DE      

+5688 30 1B       0.    JR    NC,56A5    

+568A CD 1F 70    ..p   CALL  701F       

+568D 18 10       ..    JR    569F       

+568F 20 66        f    JR    NZ,56F7    ; Info aufrufen 

+5691 61          a     LD    H,C        ; " falsches setbit"

+5692 6C          l     LD    L,H        

+5693 73          s     LD    (HL),E     

+5694 63          c     LD    H,E        

+5695 68          h     LD    L,B        

+5696 65          e     LD    H,L        

+5697 73          s     LD    (HL),E     

+5698 20 73        s    JR    NZ,570D    

+569A 65          e     LD    H,L        

+569B 74          t     LD    (HL),H     

+569C 62          b     LD    H,D        

+569D 69          i     LD    L,C        

+569E 74          t     LD    (HL),H     

+569F E1          .     POP   HL         

+56A0 11 00 00    ...   LD    DE,0000    

+56A3 AF          .     XOR   A          

+56A4 C9          .     RET              

+56A5 E1          .     POP   HL         

+56A6 37          7     SCF              

+56A7 C9          .     RET              

+56A8 E5          .     PUSH  HL         

+56A9 D5          .     PUSH  DE         

+56AA C5          .     PUSH  BC         

+56AB ED 4B FB 56 .K.V  LD    BC,(56FB)  

+56AF CD 66 56    .fV   CALL  5666       

+56B2 F5          .     PUSH  AF         

+56B3 D5          .     PUSH  DE         

+56B4 7A          z     LD    A,D        

+56B5 C6 04       ..    ADD   A,04       

+56B7 5F          _     LD    E,A        

+56B8 16 00       ..    LD    D,00       

+56BA CD 46 81    .F.   CALL  8146       

+56BD 67          g     LD    H,A        

+56BE 2E 00       ..    LD    L,00       

+56C0 D1          .     POP   DE         

+56C1 7A          z     LD    A,D        

+56C2 E6 01       ..    AND   01         

+56C4 57          W     LD    D,A        

+56C5 F1          .     POP   AF         

+56C6 19          .     ADD   HL,DE      

+56C7 A6          .     AND   (HL)       

+56C8 C1          .     POP   BC         

+56C9 D1          .     POP   DE         

+56CA E1          .     POP   HL         

+56CB C9          .     RET              

+56CC 2A 0A 57    *.W   LD    HL,(570A)  

+56CF ED 4B 10 57 .K.W  LD    BC,(5710)  

+56D3 B7          .     OR    A          

+56D4 ED 42       .B    SBC   HL,BC      

+56D6 ED 4B 08 57 .K.W  LD    BC,(5708)  

+56DA E5          .     PUSH  HL         

+56DB ED 42       .B    SBC   HL,BC      

+56DD 3A 13 57    :.W   LD    A,(5713)   

+56E0 B7          .     OR    A          

+56E1 28 05       (.    JR    Z,56E8     

+56E3 ED 4B 10 57 .K.W  LD    BC,(5710)  

+56E7 09          .     ADD   HL,BC      

+56E8 44          D     LD    B,H        

+56E9 4D          M     LD    C,L        

+56EA E1          .     POP   HL         

+56EB CB 3C       .<    SLR   H          

+56ED CB 1D       ..    RR    L          

+56EF CB 38       .8    SLR   B          

+56F1 CB 19       ..    RR    C          

+56F3 C9          .     RET              

+56F4 76          v     HALT             ; "vergl"

+56F5 65          e     LD    H,L        

+56F6 72          r     LD    (HL),D     

+56F7 67          g     LD    H,A        

+56F8 6C          l     LD    L,H        

+56F9 FF          .     RST   38         

+56FA FF          .     RST   38         

+56FB 00          .     NOP              

+56FC 00          .     NOP              

+56FD 00          .     NOP              

+56FE 00          .     NOP              

+56FF 00          .     NOP              

+5700 00          .     NOP              

+5701 68          h     LD    L,B        ; "hgfrei"

+5702 67          g     LD    H,A        

+5703 66          f     LD    H,(HL)     

+5704 72          r     LD    (HL),D     

+5705 65          e     LD    H,L        

+5706 69          i     LD    L,C        

+5707 20 00        .    JR    NZ,5709    

+5709 00          .     NOP              

+570A E8          .     RET   PE         

+570B 03          .     INC   BC         

+570C 00          .     NOP              

+570D 00          .     NOP              

+570E 04          .     INC   B          

+570F 00          .     NOP              

+5710 2E 00       ..    LD    L,00       

+5712 00          .     NOP              

+5713 00          .     NOP              

+5714 01 02 04    ...   LD    BC,0402    

+5717 08          .     EX    AF,AF'     

+5718 10 20       .     DJNZ  573A       

+571A 40          @     LD    B,B        

+571B 80          .     ADD   B          

+571C 31 37 35    175   LD    SP,3537    ; "175 lader   2 (!)"

+571F 20 6C        l    JR    NZ,578D    

+5721 61          a     LD    H,C        

+5722 64          d     LD    H,H        

+5723 65          e     LD    H,L        

+5724 72          r     LD    (HL),D     

+5725 20 20             JR    NZ,5747    

+5727 20 32        2    JR    NZ,575B    

+5729 20 28        (    JR    NZ,5753    

+572B 21 29 3E    !)>   LD    HL,3E29    

+572E FE 32       .2    CP    32         

+5730 27          '     DAA              

+5731 16 CD       ..    LD    D,CD       

+5733 A0          .     AND   B          

+5734 28 CD       (.    JR    Z,5703     

+5736 78          x     LD    A,B        

+5737 82          .     ADD   D          

+5738 2B          +     DEC   HL         

+5739 6C          l     LD    L,H        

+573A 37          7     SCF              

+573B CB 1D       ..    RR    L          

+573D 2C          ,     INC   L          

+573E 26 15       &.    LD    H,15       

+5740 22 9F 60    ".`   LD    (609F),HL  

+5743 13          .     INC   DE         

+5744 7A          z     LD    A,D        

+5745 37          7     SCF              

+5746 CB 1F       ..    RR    A          

+5748 32 A1 60    2.`   LD    (60A1),A   

+574B 21 CF 15    !..   LD    HL,15CF    

+574E CB C6       ..    SET   0,(HL)     

+5750 21 00 14    !..   LD    HL,1400    

+5753 11 01 14    ...   LD    DE,1401    

+5756 01 FF 00    ...   LD    BC,00FF    

+5759 36 80       6.    LD    (HL),80    

+575B ED B0       ..    LDIR             

+575D 21 7D 82    !}.   LD    HL,827D    

+5760 CD CA 6E    ..n   CALL  6ECA       

+5763 CD 8B 59    ..Y   CALL  598B       

+5766 CD 85 64    ..d   CALL  6485       

+5769 C9          .     RET              

+576A 50          P     LD    D,B        ; "PROZ LADER"

+576B 52          R     LD    D,D        

+576C 4F          O     LD    C,A        

+576D 5A          Z     LD    E,D        

+576E 20 4C        L    JR    NZ,57BC    

+5770 41          A     LD    B,C        

+5771 44          D     LD    B,H        

+5772 45          E     LD    B,L        

+5773 52          R     LD    D,D        

+5774 42          B     LD    B,D        

+5775 58          X     LD    E,B        

+5776 C3 A5 5F    .._   JP    5FA5       

+5779 4C          L     LD    C,H        

+577A FF          .     RST   38         

+577B FF          .     RST   38         

+577C FF          .     RST   38         

+577D FF          .     RST   38         

+577E FF          .     RST   38         

+577F FF          .     RST   38         

+5780 FF          .     RST   38         

+5781 FF          .     RST   38         

+5782 FF          .     RST   38         

+5783 FF          .     RST   38         

+5784 FF          .     RST   38         

+5785 FF          .     RST   38         

+5786 FF          .     RST   38         

+5787 FF          .     RST   38         

+5788 FF          .     RST   38         

+5789 FF          .     RST   38         

+578A FF          .     RST   38         

+578B FF          .     RST   38         

+578C FF          .     RST   38         

+578D FF          .     RST   38         

+578E FF          .     RST   38         

+578F FF          .     RST   38         

+5790 FF          .     RST   38         

+5791 FF          .     RST   38         

+5792 FF          .     RST   38         

+5793 FF          .     RST   38         

+5794 FF          .     RST   38         

+5795 FF          .     RST   38         

+5796 FF          .     RST   38         

+5797 FF          .     RST   38         

+5798 FF          .     RST   38         

+5799 FF          .     RST   38         

+579A FF          .     RST   38         

+579B FF          .     RST   38         

+579C FF          .     RST   38         

+579D FF          .     RST   38         

+579E FF          .     RST   38         

+579F FF          .     RST   38         

+57A0 FF          .     RST   38         

+57A1 FF          .     RST   38         

+57A2 FF          .     RST   38         

+57A3 FF          .     RST   38         

+57A4 FF          .     RST   38         

+57A5 FF          .     RST   38         

+57A6 FF          .     RST   38         

+57A7 FF          .     RST   38         

+57A8 FF          .     RST   38         

+57A9 FF          .     RST   38         

+57AA FF          .     RST   38         

+57AB FF          .     RST   38         

+57AC FF          .     RST   38         

+57AD FF          .     RST   38         

+57AE FF          .     RST   38         

+57AF FF          .     RST   38         

+57B0 FF          .     RST   38         

+57B1 FF          .     RST   38         

+57B2 FF          .     RST   38         

+57B3 FF          .     RST   38         

+57B4 FF          .     RST   38         

+57B5 FF          .     RST   38         

+57B6 FF          .     RST   38         

+57B7 FF          .     RST   38         

+57B8 FF          .     RST   38         

+57B9 FF          .     RST   38         

+57BA FF          .     RST   38         

+57BB FF          .     RST   38         

+57BC FF          .     RST   38         

+57BD FF          .     RST   38         

+57BE FF          .     RST   38         

+57BF FF          .     RST   38         

+57C0 FF          .     RST   38         

+57C1 FF          .     RST   38         

+57C2 FF          .     RST   38         

+57C3 FF          .     RST   38         

+57C4 FF          .     RST   38         

+57C5 FF          .     RST   38         

+57C6 FF          .     RST   38         

+57C7 FF          .     RST   38         

+57C8 FF          .     RST   38         

+57C9 FF          .     RST   38         

+57CA FF          .     RST   38         

+57CB FF          .     RST   38         

+57CC FF          .     RST   38         

+57CD FF          .     RST   38         

+57CE FF          .     RST   38         

+57CF FF          .     RST   38         

+57D0 FF          .     RST   38         

+57D1 FF          .     RST   38         

+57D2 FF          .     RST   38         

+57D3 FF          .     RST   38         

+57D4 FF          .     RST   38         

+57D5 FF          .     RST   38         

+57D6 FF          .     RST   38         

+57D7 FF          .     RST   38         

+57D8 FF          .     RST   38         

+57D9 FF          .     RST   38         

+57DA FF          .     RST   38         

+57DB FF          .     RST   38         

+57DC FF          .     RST   38         

+57DD FF          .     RST   38         

+57DE FF          .     RST   38         

+57DF FF          .     RST   38         

+57E0 FF          .     RST   38         

+57E1 FF          .     RST   38         

+57E2 FF          .     RST   38         

+57E3 FF          .     RST   38         

+57E4 FF          .     RST   38         

+57E5 FF          .     RST   38         

+57E6 FF          .     RST   38         

+57E7 FF          .     RST   38         

+57E8 FF          .     RST   38         

+57E9 FF          .     RST   38         

+57EA FF          .     RST   38         

+57EB FF          .     RST   38         

+57EC FF          .     RST   38         

+57ED FF          .     RST   38         

+57EE FF          .     RST   38         

+57EF FF          .     RST   38         

+57F0 FF          .     RST   38         

+57F1 FF          .     RST   38         

+57F2 FF          .     RST   38         

+57F3 FF          .     RST   38         

+57F4 FF          .     RST   38         

+57F5 FF          .     RST   38         

+57F6 FF          .     RST   38         

+57F7 FF          .     RST   38         

+57F8 FF          .     RST   38         

+57F9 FF          .     RST   38         

+57FA FF          .     RST   38         

+57FB FF          .     RST   38         

+57FC FF          .     RST   38         

+57FD FF          .     RST   38         

+57FE FF          .     RST   38         

+57FF FF          .     RST   38         

+5800 FF          .     RST   38         

+5801 FF          .     RST   38         

+5802 FF          .     RST   38         

+5803 FF          .     RST   38         

+5804 FF          .     RST   38         

+5805 FF          .     RST   38         

+5806 FF          .     RST   38         

+5807 FF          .     RST   38         

+5808 FF          .     RST   38         

+5809 FF          .     RST   38         

+580A FF          .     RST   38         

+580B FF          .     RST   38         

+580C FF          .     RST   38         

+580D FF          .     RST   38         

+580E FF          .     RST   38         

+580F FF          .     RST   38         

+5810 FF          .     RST   38         

+5811 FF          .     RST   38         

+5812 FF          .     RST   38         

+5813 FF          .     RST   38         

+5814 FF          .     RST   38         

+5815 FF          .     RST   38         

+5816 FF          .     RST   38         

+5817 FF          .     RST   38         

+5818 FF          .     RST   38         

+5819 FF          .     RST   38         

+581A FF          .     RST   38         

+581B FF          .     RST   38         

+581C FF          .     RST   38         

+581D FF          .     RST   38         

+581E FF          .     RST   38         

+581F FF          .     RST   38         

+5820 FF          .     RST   38         

+5821 FF          .     RST   38         

+5822 FF          .     RST   38         

+5823 FF          .     RST   38         

+5824 FF          .     RST   38         

+5825 FF          .     RST   38         

+5826 FF          .     RST   38         

+5827 FF          .     RST   38         

+5828 FF          .     RST   38         

+5829 FF          .     RST   38         

+582A FF          .     RST   38         

+582B FF          .     RST   38         

+582C FF          .     RST   38         

+582D FF          .     RST   38         

+582E FF          .     RST   38         

+582F FF          .     RST   38         

+5830 FF          .     RST   38         

+5831 FF          .     RST   38         

+5832 FF          .     RST   38         

+5833 FF          .     RST   38         

+5834 FF          .     RST   38         

+5835 FF          .     RST   38         

+5836 FF          .     RST   38         

+5837 FF          .     RST   38         

+5838 FF          .     RST   38         

+5839 FF          .     RST   38         

+583A FF          .     RST   38         

+583B FF          .     RST   38         

+583C FF          .     RST   38         

+583D FF          .     RST   38         

+583E FF          .     RST   38         

+583F FF          .     RST   38         

+5840 FF          .     RST   38         

+5841 FF          .     RST   38         

+5842 44          D     LD    B,H        

+5843 58          X     LD    E,B        

+5844 21 B5 4C    !.L   LD    HL,4CB5    

+5847 CB 96       ..    RES   2,(HL)     

+5849 CD E2 6D    ..m   CALL  6DE2       

+584C 3A 96 60    :.`   LD    A,(6096)   

+584F B7          .     OR    A          

+5850 28 15       (.    JR    Z,5867     

+5852 FE 02       ..    CP    02         

+5854 28 2C       (,    JR    Z,5882     

+5856 2A 97 60    *.`   LD    HL,(6097)  

+5859 CB 46       .F    BIT   0,(HL)     

+585B 20 0A        .    JR    NZ,5867    

+585D CD 1C 59    ..Y   CALL  591C       

+5860 2A 97 60    *.`   LD    HL,(6097)  

+5863 CB CE       ..    SET   1,(HL)     

+5865 18 2A       .*    JR    5891       

+5867 3A 99 60    :.`   LD    A,(6099)   

+586A B7          .     OR    A          

+586B 28 28       ((    JR    Z,5895     

+586D 2A 9A 60    *.`   LD    HL,(609A)  

+5870 CB 46       .F    BIT   0,(HL)     

+5872 20 21        !    JR    NZ,5895    

+5874 CD 1C 59    ..Y   CALL  591C       

+5877 2A 9A 60    *.`   LD    HL,(609A)  

+587A CB CE       ..    SET   1,(HL)     

+587C 97          .     SUB   A          

+587D 32 99 60    2.`   LD    (6099),A   

+5880 18 13       ..    JR    5895       

+5882 3A 5B 60    :[`   LD    A,(605B)   

+5885 B7          .     OR    A          

+5886 28 09       (.    JR    Z,5891     

+5888 CD 96 5C    ..\   CALL  5C96       

+588B 20 08        .    JR    NZ,5895    

+588D 97          .     SUB   A          

+588E 32 B3 60    2.`   LD    (60B3),A   

+5891 97          .     SUB   A          

+5892 32 96 60    2.`   LD    (6096),A   

+5895 3A 1F 16    :..   LD    A,(161F)   

+5898 FE FD       ..    CP    FD         

+589A 28 14       (.    JR    Z,58B0     

+589C 21 CE 15    !..   LD    HL,15CE    

+589F CB 46       .F    BIT   0,(HL)     

+58A1 20 0D        .    JR    NZ,58B0    

+58A3 57          W     LD    D,A        

+58A4 3A 1F 15    :..   LD    A,(151F)   

+58A7 5F          _     LD    E,A        

+58A8 CD 45 59    .EY   CALL  5945       

+58AB 3E FD       >.    LD    A,FD       

+58AD 32 1F 16    2..   LD    (161F),A   

+58B0 3A A4 60    :.`   LD    A,(60A4)   

+58B3 B7          .     OR    A          

+58B4 28 2E       (.    JR    Z,58E4     

+58B6 3A 63 60    :c`   LD    A,(6063)   

+58B9 B7          .     OR    A          

+58BA CA 44 58    .DX   JP    Z,5844     

+58BD CD F7 58    ..X   CALL  58F7       

+58C0 22 9D 60    ".`   LD    (609D),HL  

+58C3 21 B5 4C    !.L   LD    HL,4CB5    

+58C6 CB D6       ..    SET   2,(HL)     

+58C8 2A B1 60    *.`   LD    HL,(60B1)  

+58CB 56          V     LD    D,(HL)     

+58CC 25          %     DEC   H          

+58CD 5E          ^     LD    E,(HL)     

+58CE ED 53 A7 60 .S.`  LD    (60A7),DE  

+58D2 2A 9D 60    *.`   LD    HL,(609D)  

+58D5 CD 45 59    .EY   CALL  5945       

+58D8 2A B1 60    *.`   LD    HL,(60B1)  

+58DB 36 FD       6.    LD    (HL),FD    

+58DD 21 63 60    !c`   LD    HL,6063    

+58E0 35          5     DEC   (HL)       

+58E1 C3 95 58    ..X   JP    5895       

+58E4 CD F4 5B    ..[   CALL  5BF4       

+58E7 20 03        .    JR    NZ,58EC    

+58E9 11 00 00    ...   LD    DE,0000    

+58EC ED 53 A5 60 .S.`  LD    (60A5),DE  

+58F0 3E 02       >.    LD    A,02       

+58F2 32 A4 60    2.`   LD    (60A4),A   

+58F5 18 B9       ..    JR    58B0       

+58F7 06 08       ..    LD    B,08       

+58F9 2A 9D 60    *.`   LD    HL,(609D)  

+58FC CD 3C 5F    .<_   CALL  5F3C       

+58FF CB 46       .F    BIT   0,(HL)     

+5901 20 F9        .    JR    NZ,58FC    

+5903 CB 5E       .^    BIT   3,(HL)     

+5905 28 02       (.    JR    Z,5909     

+5907 10 F0       ..    DJNZ  58F9       

+5909 E5          .     PUSH  HL         

+590A 06 02       ..    LD    B,02       

+590C CD 3C 5F    .<_   CALL  5F3C       

+590F 10 FB       ..    DJNZ  590C       

+5911 06 08       ..    LD    B,08       

+5913 CB 9E       ..    RES   3,(HL)     

+5915 CD 3C 5F    .<_   CALL  5F3C       

+5918 10 F9       ..    DJNZ  5913       

+591A E1          .     POP   HL         

+591B C9          .     RET              

+591C CB C6       ..    SET   0,(HL)     

+591E CB 96       ..    RES   2,(HL)     

+5920 CB 4E       .N    BIT   1,(HL)     

+5922 20 09        .    JR    NZ,592D    

+5924 C3 10 5B    ..[   JP    5B10       

+5927 3E 02       >.    LD    A,02       

+5929 CB 4E       .N    BIT   1,(HL)     

+592B 28 02       (.    JR    Z,592F     

+592D 3E 03       >.    LD    A,03       

+592F CB BD       ..    RES   7,L        

+5931 5E          ^     LD    E,(HL)     

+5932 24          $     INC   H          

+5933 56          V     LD    D,(HL)     

+5934 65          e     LD    H,L        

+5935 CB 24       .$    SLA   H          

+5937 2E 00       ..    LD    L,00       

+5939 FE 03       ..    CP    03         

+593B C8          .     RET   Z          

+593C 7A          z     LD    A,D        

+593D FE FD       ..    CP    FD         

+593F D0          .     RET   NC         

+5940 3E 02       >.    LD    A,02       

+5942 C3 82 5E    ..^   JP    5E82       

+5945 E5          .     PUSH  HL         

+5946 CB 96       ..    RES   2,(HL)     

+5948 D5          .     PUSH  DE         

+5949 CD 1C 59    ..Y   CALL  591C       

+594C D1          .     POP   DE         

+594D E3          .     EX    (SP),HL    

+594E 24          $     INC   H          

+594F 36 FF       6.    LD    (HL),FF    

+5951 25          %     DEC   H          

+5952 E3          .     EX    (SP),HL    

+5953 7A          z     LD    A,D        

+5954 FE FF       ..    CP    FF         

+5956 20 16        .    JR    NZ,596E    

+5958 D5          .     PUSH  DE         

+5959 36 FF       6.    LD    (HL),FF    

+595B 54          T     LD    D,H        

+595C 5D          ]     LD    E,L        

+595D 13          .     INC   DE         

+595E 01 FF 01    ...   LD    BC,01FF    

+5961 CD A5 28    ..(   CALL  28A5       

+5964 D1          .     POP   DE         

+5965 E1          .     POP   HL         

+5966 36 02       6.    LD    (HL),02    

+5968 CB BD       ..    RES   7,L        

+596A 73          s     LD    (HL),E     

+596B 24          $     INC   H          

+596C 72          r     LD    (HL),D     

+596D C9          .     RET              

+596E CD E9 5A    ..Z   CALL  5AE9       

+5971 28 F2       (.    JR    Z,5965     

+5973 3E 01       >.    LD    A,01       

+5975 CD 82 5E    ..^   CALL  5E82       

+5978 7C          |     LD    A,H        

+5979 FE 9C       ..    CP    9C         

+597B 28 E8       (.    JR    Z,5965     

+597D E1          .     POP   HL         

+597E E5          .     PUSH  HL         

+597F CD 68 59    .hY   CALL  5968       

+5982 E1          .     POP   HL         

+5983 E5          .     PUSH  HL         

+5984 CD 10 5B    ..[   CALL  5B10       

+5987 E1          .     POP   HL         

+5988 36 02       6.    LD    (HL),02    

+598A C9          .     RET              

+598B CD 8A 28    ..(   CALL  288A       

+598E 22 AB 60    ".`   LD    (60AB),HL  

+5991 CB 78       .x    BIT   7,B        

+5993 28 0D       (.    JR    Z,59A2     

+5995 3E C3       >.    LD    A,C3       ; JP ... 

+5997 32 95 5A    2.Z   LD    (5A95),A   

+599A 21 8D 28    !.(   LD    HL,288D    ; SCHACC

+599D 22 96 5A    ".Z   LD    (5A96),HL  

+59A0 CB B8       ..    RES   7,B        

+59A2 CB 70       .p    BIT   6,B        

+59A4 28 22       ("    JR    Z,59C8     

+59A6 21 FF FF    !..   LD    HL,FFFF    

+59A9 22 5C 60    "\`   LD    (605C),HL  

+59AC 3E C9       >.    LD    A,C9       ; RET

+59AE 32 95 5A    2.Z   LD    (5A95),A   

+59B1 3E C3       >.    LD    A,C3       ; JP ...

+59B3 32 A8 5A    2.Z   LD    (5AA8),A   

+59B6 21 8D 28    !.(   LD    HL,288D    ; SCHACC

+59B9 3A 6B 28    :k(   LD    A,(286B)   

+59BC FE 06       ..    CP    06         

+59BE 38 03       8.    JR    C,59C3     

+59C0 21 BD 5A    !.Z   LD    HL,5ABD    

+59C3 22 A9 5A    ".Z   LD    (5AA9),HL  

+59C6 CB B0       ..    RES   6,B        

+59C8 CB 21       .!    SLA   C          

+59CA CB 10       ..    RL    B          

+59CC 20 05        .    JR    NZ,59D3    

+59CE 3E 50       >P    LD    A,50       

+59D0 32 B4 60    2.`   LD    (60B4),A   

+59D3 ED 43 AE 60 .C.`  LD    (60AE),BC  

+59D7 78          x     LD    A,B        

+59D8 B1          .     OR    C          

+59D9 32 5B 60    2[`   LD    (605B),A   

+59DC 28 34       (4    JR    Z,5A12     

+59DE C5          .     PUSH  BC         

+59DF 3E 00       >.    LD    A,00       ; HG

+59E1 01 05 00    ...   LD    BC,0005    ; Size

+59E4 11 00 00    ...   LD    DE,0000    ; Schluessel 0

+59E7 CD A8 28    ..(   CALL  28A8       

+59EA E1          .     POP   HL         

+59EB B7          .     OR    A          

+59EC ED 42       .B    SBC   HL,BC      

+59EE 38 0F       8.    JR    C,59FF     

+59F0 3E 01       >.    LD    A,01       

+59F2 CD 1D 5A    ..Z   CALL  5A1D       

+59F5 97          .     SUB   A          

+59F6 32 5B 60    2[`   LD    (605B),A   

+59F9 3C          <     INC   A          

+59FA 32 AD 60    2.`   LD    (60AD),A   

+59FD 18 18       ..    JR    5A17       

+59FF 1E 00       ..    LD    E,00       

+5A01 D5          .     PUSH  DE         

+5A02 CD A6 5A    ..Z   CALL  5AA6       

+5A05 54          T     LD    D,H        

+5A06 5D          ]     LD    E,L        

+5A07 13          .     INC   DE         

+5A08 36 FE       6.    LD    (HL),FE    

+5A0A ED B0       ..    LDIR             

+5A0C D1          .     POP   DE         

+5A0D 1C          .     INC   E          

+5A0E 1C          .     INC   E          

+5A0F 20 F0        .    JR    NZ,5A01    

+5A11 C9          .     RET              

+5A12 3E C9       >.    LD    A,C9       ; RET

+5A14 32 95 5A    2.Z   LD    (5A95),A   

+5A17 21 CF 15    !..   LD    HL,15CF    

+5A1A CB 86       ..    RES   0,(HL)     

+5A1C C9          .     RET              

+5A1D 21 00 00    !..   LD    HL,0000    

+5A20 C5          .     PUSH  BC         

+5A21 F5          .     PUSH  AF         

+5A22 E5          .     PUSH  HL         

+5A23 CD 92 5A    ..Z   CALL  5A92       

+5A26 D1          .     POP   DE         

+5A27 CB 23       .#    SLA   E          

+5A29 CB 12       ..    RL    D          

+5A2B F1          .     POP   AF         

+5A2C CD B0 5E    ..^   CALL  5EB0       

+5A2F CB 3A       .:    SLR   D          

+5A31 CB 1B       ..    RR    E          

+5A33 EB          .     EX    DE,HL      

+5A34 C1          .     POP   BC         

+5A35 ED A1       ..    CPI              

+5A37 EA 20 5A    . Z   JP    PE,5A20    

+5A3A C9          .     RET              

+5A3B 3A AD 60    :.`   LD    A,(60AD)   

+5A3E B7          .     OR    A          

+5A3F C8          .     RET   Z          

+5A40 3E 00       >.    LD    A,00       

+5A42 32 AD 60    2.`   LD    (60AD),A   

+5A45 01 05 00    ...   LD    BC,0005    

+5A48 11 00 00    ...   LD    DE,0000    

+5A4B CD A8 28    ..(   CALL  28A8       

+5A4E C5          .     PUSH  BC         

+5A4F 3E 02       >.    LD    A,02       

+5A51 CD 1D 5A    ..Z   CALL  5A1D       

+5A54 C1          .     POP   BC         

+5A55 11 00 00    ...   LD    DE,0000    

+5A58 C5          .     PUSH  BC         

+5A59 21 00 9E    !..   LD    HL,9E00    

+5A5C 3E 00       >.    LD    A,00       

+5A5E 01 00 00    ...   LD    BC,0000    

+5A61 CD 7E 28    .~(   CALL  287E       

+5A64 78          x     LD    A,B        

+5A65 B1          .     OR    C          

+5A66 20 08        .    JR    NZ,5A70    

+5A68 C1          .     POP   BC         

+5A69 ED A1       ..    CPI              

+5A6B 13          .     INC   DE         

+5A6C EA 58 5A    .XZ   JP    PE,5A58    

+5A6F C9          .     RET              

+5A70 CD CA 6E    ..n   CALL  6ECA       

+5A73 62          b     LD    H,D        

+5A74 6B          k     LD    L,E        

+5A75 CD 92 5A    ..Z   CALL  5A92       

+5A78 01 00 00    ...   LD    BC,0000    

+5A7B 97          .     SUB   A          

+5A7C CD 81 28    ..(   CALL  2881       

+5A7F 18 D8       ..    JR    5A59       

+5A81 7C          |     LD    A,H        

+5A82 47          G     LD    B,A        

+5A83 FE 10       ..    CP    10         

+5A85 D0          .     RET   NC         

+5A86 ED 4B A2 60 .K.`  LD    BC,(60A2)  

+5A8A 18 06       ..    JR    5A92       

+5A8C 78          x     LD    A,B        

+5A8D FE 10       ..    CP    10         

+5A8F D0          .     RET   NC         

+5A90 60          `     LD    H,B        

+5A91 69          i     LD    L,C        

+5A92 22 A2 60    ".`   LD    (60A2),HL  

+5A95 CB 3C       .<    SLR   H          

+5A97 CB 1D       ..    RR    L          

+5A99 7D          }     LD    A,L        

+5A9A 2A AB 60    *.`   LD    HL,(60AB)  

+5A9D 30 02       0.    JR    NC,5AA1    

+5A9F 24          $     INC   H          

+5AA0 24          $     INC   H          

+5AA1 2E 00       ..    LD    L,00       

+5AA3 C3 8D 28    ..(   JP    288D       

+5AA6 3E 03       >.    LD    A,03       

+5AA8 FE 03       ..    CP    03         

+5AAA 28 1A       (.    JR    Z,5AC6     

+5AAC F5          .     PUSH  AF         

+5AAD EB          .     EX    DE,HL      

+5AAE CD 92 5A    ..Z   CALL  5A92       

+5AB1 F1          .     POP   AF         

+5AB2 01 00 02    ...   LD    BC,0200    

+5AB5 3D          =     DEC   A          

+5AB6 CA A5 28    ..(   JP    Z,28A5     

+5AB9 EB          .     EX    DE,HL      

+5ABA C3 A5 28    ..(   JP    28A5       

+5ABD FE 03       ..    CP    03         

+5ABF 30 02       0.    JR    NC,5AC3    

+5AC1 EE 03       ..    XOR   03         

+5AC3 C3 8D 28    ..(   JP    288D       

+5AC6 7B          {     LD    A,E        

+5AC7 26 00       &.    LD    H,00       

+5AC9 07          .     RLCA             

+5ACA 07          .     RLCA             

+5ACB 07          .     RLCA             

+5ACC 07          .     RLCA             

+5ACD F5          .     PUSH  AF         

+5ACE E6 0F       ..    AND   0F         

+5AD0 6F          o     LD    L,A        

+5AD1 CD 92 5A    ..Z   CALL  5A92       

+5AD4 F1          .     POP   AF         

+5AD5 17          .     RLA              

+5AD6 30 01       0.    JR    NC,5AD9    

+5AD8 24          $     INC   H          

+5AD9 E6 C0       ..    AND   C0         

+5ADB 6F          o     LD    L,A        

+5ADC 01 14 00    ...   LD    BC,0014    

+5ADF C9          .     RET              

+5AE0 3A 5B 60    :[`   LD    A,(605B)   

+5AE3 B7          .     OR    A          

+5AE4 C0          .     RET   NZ         

+5AE5 F1          .     POP   AF         

+5AE6 F6 01       ..    OR    01         

+5AE8 C9          .     RET              

+5AE9 CD E0 5A    ..Z   CALL  5AE0       

+5AEC C5          .     PUSH  BC         

+5AED D5          .     PUSH  DE         

+5AEE E5          .     PUSH  HL         

+5AEF CD A6 5A    ..Z   CALL  5AA6       

+5AF2 C5          .     PUSH  BC         

+5AF3 7A          z     LD    A,D        

+5AF4 ED B1       ..    CPIR             

+5AF6 C1          .     POP   BC         

+5AF7 20 13        .    JR    NZ,5B0C    

+5AF9 09          .     ADD   HL,BC      

+5AFA 2B          +     DEC   HL         

+5AFB 7E          ~     LD    A,(HL)     

+5AFC CB EE       ..    SET   5,(HL)     

+5AFE 09          .     ADD   HL,BC      

+5AFF 6E          n     LD    L,(HL)     

+5B00 E6 1F       ..    AND   1F         

+5B02 67          g     LD    H,A        

+5B03 D1          .     POP   DE         

+5B04 D5          .     PUSH  DE         

+5B05 EB          .     EX    DE,HL      

+5B06 3E 01       >.    LD    A,01       

+5B08 CD A8 5A    ..Z   CALL  5AA8       

+5B0B 97          .     SUB   A          

+5B0C E1          .     POP   HL         

+5B0D D1          .     POP   DE         

+5B0E C1          .     POP   BC         

+5B0F C9          .     RET              

+5B10 3A 5B 60    :[`   LD    A,(605B)   

+5B13 B7          .     OR    A          

+5B14 CA 27 59    .'Y   JP    Z,5927     

+5B17 7E          ~     LD    A,(HL)     

+5B18 32 60 60    2``   LD    (6060),A   

+5B1B CB BD       ..    RES   7,L        

+5B1D 5E          ^     LD    E,(HL)     

+5B1E 24          $     INC   H          

+5B1F 56          V     LD    D,(HL)     

+5B20 65          e     LD    H,L        

+5B21 CB 24       .$    SLA   H          

+5B23 2E 00       ..    LD    L,00       

+5B25 7A          z     LD    A,D        

+5B26 FE FD       ..    CP    FD         

+5B28 D0          .     RET   NC         

+5B29 B7          .     OR    A          

+5B2A 20 06        .    JR    NZ,5B32    

+5B2C 7B          {     LD    A,E        

+5B2D FE 04       ..    CP    04         

+5B2F DA 87 5B    ..[   JP    C,5B87     

+5B32 E5          .     PUSH  HL         

+5B33 CD A6 5A    ..Z   CALL  5AA6       

+5B36 C5          .     PUSH  BC         

+5B37 7A          z     LD    A,D        

+5B38 ED B1       ..    CPIR             

+5B3A C1          .     POP   BC         

+5B3B 20 14        .    JR    NZ,5B51    

+5B3D 09          .     ADD   HL,BC      

+5B3E 2B          +     DEC   HL         

+5B3F CB B6       ..    RES   6,(HL)     

+5B41 7E          ~     LD    A,(HL)     

+5B42 09          .     ADD   HL,BC      

+5B43 6E          n     LD    L,(HL)     

+5B44 E6 1F       ..    AND   1F         

+5B46 67          g     LD    H,A        

+5B47 EB          .     EX    DE,HL      

+5B48 E1          .     POP   HL         

+5B49 E5          .     PUSH  HL         

+5B4A 3E 02       >.    LD    A,02       

+5B4C CD A8 5A    ..Z   CALL  5AA8       

+5B4F E1          .     POP   HL         

+5B50 C9          .     RET              

+5B51 3A 60 60    :``   LD    A,(6060)   

+5B54 F5          .     PUSH  AF         

+5B55 B7          .     OR    A          

+5B56 ED 42       .B    SBC   HL,BC      

+5B58 3E FE       >.    LD    A,FE       

+5B5A ED B1       ..    CPIR             

+5B5C 20 24        $    JR    NZ,5B82    

+5B5E D5          .     PUSH  DE         

+5B5F CD F4 5B    ..[   CALL  5BF4       

+5B62 EB          .     EX    DE,HL      

+5B63 D1          .     POP   DE         

+5B64 28 1C       (.    JR    Z,5B82     

+5B66 E5          .     PUSH  HL         

+5B67 CD A6 5A    ..Z   CALL  5AA6       

+5B6A C5          .     PUSH  BC         

+5B6B 3E FE       >.    LD    A,FE       

+5B6D ED B1       ..    CPIR             

+5B6F C1          .     POP   BC         

+5B70 2B          +     DEC   HL         

+5B71 72          r     LD    (HL),D     

+5B72 09          .     ADD   HL,BC      

+5B73 D1          .     POP   DE         

+5B74 72          r     LD    (HL),D     

+5B75 F1          .     POP   AF         

+5B76 CB 4F       .O    BIT   1,A        

+5B78 28 02       (.    JR    Z,5B7C     

+5B7A CB F6       ..    SET   6,(HL)     

+5B7C CB EE       ..    SET   5,(HL)     

+5B7E 09          .     ADD   HL,BC      

+5B7F 73          s     LD    (HL),E     

+5B80 18 C6       ..    JR    5B48       

+5B82 F1          .     POP   AF         

+5B83 E1          .     POP   HL         

+5B84 CB 4F       .O    BIT   1,A        

+5B86 C0          .     RET   NZ         

+5B87 3E 02       >.    LD    A,02       

+5B89 C3 82 5E    ..^   JP    5E82       

+5B8C 32 66 60    2f`   LD    (6066),A   

+5B8F 3A A8 5A    :.Z   LD    A,(5AA8)   

+5B92 FE C3       ..    CP    C3         

+5B94 CA CB 5B    ..[   JP    Z,5BCB     

+5B97 3A 5B 60    :[`   LD    A,(605B)   

+5B9A B7          .     OR    A          

+5B9B CA CB 5B    ..[   JP    Z,5BCB     

+5B9E C5          .     PUSH  BC         

+5B9F CD A6 5A    ..Z   CALL  5AA6       

+5BA2 C5          .     PUSH  BC         

+5BA3 7A          z     LD    A,D        

+5BA4 ED B1       ..    CPIR             

+5BA6 C1          .     POP   BC         

+5BA7 C2 CA 5B    ..[   JP    NZ,5BCA    

+5BAA 09          .     ADD   HL,BC      

+5BAB 2B          +     DEC   HL         

+5BAC CB 6E       .n    BIT   5,(HL)     

+5BAE 20 20             JR    NZ,5BD0    

+5BB0 3A 66 60    :f`   LD    A,(6066)   

+5BB3 CB 4F       .O    BIT   1,A        

+5BB5 20 02        .    JR    NZ,5BB9    

+5BB7 CB B6       ..    RES   6,(HL)     

+5BB9 7E          ~     LD    A,(HL)     

+5BBA 09          .     ADD   HL,BC      

+5BBB 6E          n     LD    L,(HL)     

+5BBC E6 1F       ..    AND   1F         

+5BBE 67          g     LD    H,A        

+5BBF CD 92 5A    ..Z   CALL  5A92       

+5BC2 C1          .     POP   BC         

+5BC3 6C          l     LD    L,H        

+5BC4 CB 3D       .=    SLR   L          

+5BC6 26 15       &.    LD    H,15       

+5BC8 37          7     SCF              

+5BC9 C9          .     RET              

+5BCA C1          .     POP   BC         

+5BCB CD 41 5D    .A]   CALL  5D41       

+5BCE 18 09       ..    JR    5BD9       

+5BD0 22 B5 60    ".`   LD    (60B5),HL  

+5BD3 CD B6 5D    ..]   CALL  5DB6       

+5BD6 38 15       8.    JR    C,5BED     

+5BD8 C1          .     POP   BC         

+5BD9 F5          .     PUSH  AF         

+5BDA CB FD       ..    SET   7,L        

+5BDC 3A 66 60    :f`   LD    A,(6066)   

+5BDF A6          .     AND   (HL)       

+5BE0 77          w     LD    (HL),A     

+5BE1 3A 5B 60    :[`   LD    A,(605B)   

+5BE4 B7          .     OR    A          

+5BE5 28 02       (.    JR    Z,5BE9     

+5BE7 CB 9E       ..    RES   3,(HL)     

+5BE9 CB BD       ..    RES   7,L        

+5BEB F1          .     POP   AF         

+5BEC C9          .     RET              

+5BED 2A B5 60    *.`   LD    HL,(60B5)  

+5BF0 CB AE       ..    RES   5,(HL)     

+5BF2 18 BC       ..    JR    5BB0       

+5BF4 3A B0 60    :.`   LD    A,(60B0)   

+5BF7 B7          .     OR    A          

+5BF8 20 1F        .    JR    NZ,5C19    

+5BFA 2A 5C 60    *\`   LD    HL,(605C)  

+5BFD 23          #     INC   HL         

+5BFE 22 5C 60    "\`   LD    (605C),HL  

+5C01 ED 4B AE 60 .K.`  LD    BC,(60AE)  

+5C05 B7          .     OR    A          

+5C06 ED 42       .B    SBC   HL,BC      

+5C08 30 06       0.    JR    NC,5C10    

+5C0A 09          .     ADD   HL,BC      

+5C0B 54          T     LD    D,H        

+5C0C 5D          ]     LD    E,L        

+5C0D F6 01       ..    OR    01         

+5C0F C9          .     RET              

+5C10 3E 01       >.    LD    A,01       

+5C12 32 B0 60    2.`   LD    (60B0),A   

+5C15 97          .     SUB   A          

+5C16 32 5C 60    2\`   LD    (605C),A   

+5C19 ED 5B 5C 60 .[\`  LD    DE,(605C)  

+5C1D 1C          .     INC   E          

+5C1E 1C          .     INC   E          

+5C1F ED 53 5C 60 .S\`  LD    (605C),DE  

+5C23 CD A6 5A    ..Z   CALL  5AA6       

+5C26 56          V     LD    D,(HL)     

+5C27 3E FE       >.    LD    A,FE       

+5C29 BA          .     CP    D          

+5C2A C8          .     RET   Z          

+5C2B 77          w     LD    (HL),A     

+5C2C 09          .     ADD   HL,BC      

+5C2D CB 7E       .~    BIT   7,(HL)     

+5C2F 28 0C       (.    JR    Z,5C3D     

+5C31 B7          .     OR    A          

+5C32 ED 42       .B    SBC   HL,BC      

+5C34 E5          .     PUSH  HL         

+5C35 C5          .     PUSH  BC         

+5C36 CD 50 5C    .P\   CALL  5C50       

+5C39 C1          .     POP   BC         

+5C3A E1          .     POP   HL         

+5C3B 18 E9       ..    JR    5C26       

+5C3D CD 66 5C    .f\   CALL  5C66       

+5C40 ED 5B 5C 60 .[\`  LD    DE,(605C)  

+5C44 CD A6 5A    ..Z   CALL  5AA6       

+5C47 E5          .     PUSH  HL         

+5C48 09          .     ADD   HL,BC      

+5C49 7E          ~     LD    A,(HL)     

+5C4A E6 1F       ..    AND   1F         

+5C4C 57          W     LD    D,A        

+5C4D 09          .     ADD   HL,BC      

+5C4E 5E          ^     LD    E,(HL)     

+5C4F E1          .     POP   HL         

+5C50 D5          .     PUSH  DE         

+5C51 54          T     LD    D,H        

+5C52 5D          ]     LD    E,L        

+5C53 23          #     INC   HL         

+5C54 C5          .     PUSH  BC         

+5C55 ED B0       ..    LDIR             

+5C57 1B          .     DEC   DE         

+5C58 3E FE       >.    LD    A,FE       

+5C5A 12          .     LD    (DE),A     

+5C5B 13          .     INC   DE         

+5C5C C1          .     POP   BC         

+5C5D CB 21       .!    SLA   C          

+5C5F CB 10       ..    RL    B          

+5C61 ED B0       ..    LDIR             

+5C63 D1          .     POP   DE         

+5C64 B7          .     OR    A          

+5C65 C9          .     RET              

+5C66 CB 76       .v    BIT   6,(HL)     

+5C68 C0          .     RET   NZ         

+5C69 CB F6       ..    SET   6,(HL)     

+5C6B E5          .     PUSH  HL         

+5C6C 3A B3 60    :.`   LD    A,(60B3)   

+5C6F B7          .     OR    A          

+5C70 20 0B        .    JR    NZ,5C7D    

+5C72 CD AE 5D    ..]   CALL  5DAE       

+5C75 38 06       8.    JR    C,5C7D     

+5C77 CB FD       ..    SET   7,L        

+5C79 CB 8E       ..    RES   1,(HL)     

+5C7B E1          .     POP   HL         

+5C7C C9          .     RET              

+5C7D E1          .     POP   HL         

+5C7E D5          .     PUSH  DE         

+5C7F 7E          ~     LD    A,(HL)     

+5C80 E6 1F       ..    AND   1F         

+5C82 57          W     LD    D,A        

+5C83 09          .     ADD   HL,BC      

+5C84 5E          ^     LD    E,(HL)     

+5C85 21 00 9E    !..   LD    HL,9E00    

+5C88 3E 01       >.    LD    A,01       

+5C8A CD A8 5A    ..Z   CALL  5AA8       

+5C8D 21 00 9E    !..   LD    HL,9E00    

+5C90 D1          .     POP   DE         

+5C91 3E 02       >.    LD    A,02       

+5C93 C3 82 5E    ..^   JP    5E82       

+5C96 ED 5B 5E 60 .[^`  LD    DE,(605E)  

+5C9A CD A6 5A    ..Z   CALL  5AA6       

+5C9D 7D          }     LD    A,L        

+5C9E 82          .     ADD   D          

+5C9F 6F          o     LD    L,A        

+5CA0 30 01       0.    JR    NC,5CA3    

+5CA2 24          $     INC   H          

+5CA3 56          V     LD    D,(HL)     

+5CA4 7A          z     LD    A,D        

+5CA5 FE FE       ..    CP    FE         

+5CA7 28 06       (.    JR    Z,5CAF     

+5CA9 09          .     ADD   HL,BC      

+5CAA C5          .     PUSH  BC         

+5CAB CD 66 5C    .f\   CALL  5C66       

+5CAE C1          .     POP   BC         

+5CAF ED 5B 5E 60 .[^`  LD    DE,(605E)  

+5CB3 14          .     INC   D          

+5CB4 7A          z     LD    A,D        

+5CB5 B9          .     CP    C          

+5CB6 20 04        .    JR    NZ,5CBC    

+5CB8 16 00       ..    LD    D,00       

+5CBA 1C          .     INC   E          

+5CBB 1C          .     INC   E          

+5CBC ED 53 5E 60 .S^`  LD    (605E),DE  

+5CC0 C9          .     RET              

+5CC1 E5          .     PUSH  HL         

+5CC2 2A 61 60    *a`   LD    HL,(6061)  

+5CC5 CD 92 5A    ..Z   CALL  5A92       

+5CC8 E1          .     POP   HL         

+5CC9 C9          .     RET              

+5CCA CD 20 6E    . n   CALL  6E20       

+5CCD CD D4 5C    ..\   CALL  5CD4       

+5CD0 CD 2A 6E    .*n   CALL  6E2A       

+5CD3 C9          .     RET              

+5CD4 32 9C 60    2.`   LD    (609C),A   

+5CD7 3A B4 60    :.`   LD    A,(60B4)   

+5CDA 3D          =     DEC   A          

+5CDB C8          .     RET   Z          

+5CDC 32 B4 60    2.`   LD    (60B4),A   

+5CDF 3A A8 5A    :.Z   LD    A,(5AA8)   

+5CE2 FE C3       ..    CP    C3         

+5CE4 C8          .     RET   Z          

+5CE5 3A AD 60    :.`   LD    A,(60AD)   

+5CE8 B7          .     OR    A          

+5CE9 CC E0 5A    ..Z   CALL  Z,5AE0     

+5CEC 3A 9C 60    :.`   LD    A,(609C)   

+5CEF 26 15       &.    LD    H,15       

+5CF1 6F          o     LD    L,A        

+5CF2 CB 3D       .=    SLR   L          

+5CF4 E5          .     PUSH  HL         

+5CF5 5E          ^     LD    E,(HL)     

+5CF6 24          $     INC   H          

+5CF7 56          V     LD    D,(HL)     

+5CF8 3A AD 60    :.`   LD    A,(60AD)   

+5CFB B7          .     OR    A          

+5CFC 20 32        2    JR    NZ,5D30    

+5CFE CD A6 5A    ..Z   CALL  5AA6       

+5D01 C5          .     PUSH  BC         

+5D02 7A          z     LD    A,D        

+5D03 ED B1       ..    CPIR             

+5D05 C1          .     POP   BC         

+5D06 20 30        0    JR    NZ,5D38    

+5D08 09          .     ADD   HL,BC      

+5D09 2B          +     DEC   HL         

+5D0A 7E          ~     LD    A,(HL)     

+5D0B E6 1F       ..    AND   1F         

+5D0D CB FE       ..    SET   7,(HL)     

+5D0F 09          .     ADD   HL,BC      

+5D10 47          G     LD    B,A        

+5D11 4E          N     LD    C,(HL)     

+5D12 E1          .     POP   HL         

+5D13 36 01       6.    LD    (HL),01    

+5D15 24          $     INC   H          

+5D16 CB FD       ..    SET   7,L        

+5D18 36 FF       6.    LD    (HL),FF    

+5D1A CB BD       ..    RES   7,L        

+5D1C 24          $     INC   H          

+5D1D 24          $     INC   H          

+5D1E 7E          ~     LD    A,(HL)     

+5D1F 87          .     ADD   A          

+5D20 21 B7 60    !.`   LD    HL,60B7    

+5D23 30 01       0.    JR    NC,5D26    

+5D25 24          $     INC   H          

+5D26 85          .     ADD   L          

+5D27 6F          o     LD    L,A        

+5D28 30 01       0.    JR    NC,5D2B    

+5D2A 24          $     INC   H          

+5D2B 0D          .     DEC   C          

+5D2C 71          q     LD    (HL),C     

+5D2D 23          #     INC   HL         

+5D2E 70          p     LD    (HL),B     

+5D2F C9          .     RET              

+5D30 42          B     LD    B,D        

+5D31 4B          K     LD    C,E        

+5D32 CB 28       .(    SRA   B          

+5D34 CB 19       ..    RR    C          

+5D36 18 DA       ..    JR    5D12       

+5D38 21 B4 60    !.`   LD    HL,60B4    

+5D3B 34          4     INC   (HL)       

+5D3C E1          .     POP   HL         

+5D3D C9          .     RET              

+5D3E C3 8C 5B    ..[   JP    5B8C       

+5D41 21 B5 4C    !.L   LD    HL,4CB5    

+5D44 CB D6       ..    SET   2,(HL)     

+5D46 CD B6 5D    ..]   CALL  5DB6       

+5D49 D2 A6 5D    ..]   JP    NC,5DA6    

+5D4C 3A 5B 60    :[`   LD    A,(605B)   

+5D4F B7          .     OR    A          

+5D50 28 33       (3    JR    Z,5D85     

+5D52 CD A6 5A    ..Z   CALL  5AA6       

+5D55 7A          z     LD    A,D        

+5D56 ED B1       ..    CPIR             

+5D58 20 2B        +    JR    NZ,5D85    

+5D5A CD F7 58    ..X   CALL  58F7       

+5D5D CB 4E       .N    BIT   1,(HL)     

+5D5F 20 16        .    JR    NZ,5D77    

+5D61 D5          .     PUSH  DE         

+5D62 E5          .     PUSH  HL         

+5D63 CB BD       ..    RES   7,L        

+5D65 5E          ^     LD    E,(HL)     

+5D66 24          $     INC   H          

+5D67 56          V     LD    D,(HL)     

+5D68 24          $     INC   H          

+5D69 7E          ~     LD    A,(HL)     

+5D6A B7          .     OR    A          

+5D6B 28 16       (.    JR    Z,5D83     

+5D6D CD A6 5A    ..Z   CALL  5AA6       

+5D70 7A          z     LD    A,D        

+5D71 ED B1       ..    CPIR             

+5D73 E1          .     POP   HL         

+5D74 D1          .     POP   DE         

+5D75 20 0E        .    JR    NZ,5D85    

+5D77 22 9D 60    ".`   LD    (609D),HL  

+5D7A CD 45 59    .EY   CALL  5945       

+5D7D 21 00 00    !..   LD    HL,0000    

+5D80 C3 9C 5D    ..]   JP    5D9C       

+5D83 E1          .     POP   HL         

+5D84 D1          .     POP   DE         

+5D85 21 20 16    ! .   LD    HL,1620    

+5D88 3E FD       >.    LD    A,FD       

+5D8A ED A1       ..    CPI              

+5D8C 20 0B        .    JR    NZ,5D99    

+5D8E 2B          +     DEC   HL         

+5D8F 72          r     LD    (HL),D     

+5D90 25          %     DEC   H          

+5D91 73          s     LD    (HL),E     

+5D92 E5          .     PUSH  HL         

+5D93 21 63 60    !c`   LD    HL,6063    

+5D96 34          4     INC   (HL)       

+5D97 18 04       ..    JR    5D9D       

+5D99 21 63 60    !c`   LD    HL,6063    

+5D9C E5          .     PUSH  HL         

+5D9D 21 B5 4C    !.L   LD    HL,4CB5    

+5DA0 CB 96       ..    RES   2,(HL)     

+5DA2 E1          .     POP   HL         

+5DA3 C3 1A 6C    ..l   JP    6C1A       

+5DA6 E5          .     PUSH  HL         

+5DA7 21 B5 4C    !.L   LD    HL,4CB5    

+5DAA CB 96       ..    RES   2,(HL)     

+5DAC E1          .     POP   HL         

+5DAD C9          .     RET              

+5DAE CD CD 5D    ..]   CALL  5DCD       

+5DB1 D8          .     RET   C          

+5DB2 7D          }     LD    A,L        

+5DB3 FE 28       .(    CP    28         

+5DB5 C9          .     RET              

+5DB6 CD CD 5D    ..]   CALL  5DCD       

+5DB9 D8          .     RET   C          

+5DBA 7D          }     LD    A,L        

+5DBB FE 28       .(    CP    28         

+5DBD DA 1A 6C    ..l   JP    C,6C1A     

+5DC0 CB FD       ..    SET   7,L        

+5DC2 CB 46       .F    BIT   0,(HL)     

+5DC4 C2 1A 6C    ..l   JP    NZ,6C1A    

+5DC7 CB DE       ..    SET   3,(HL)     

+5DC9 CB BD       ..    RES   7,L        

+5DCB B7          .     OR    A          

+5DCC C9          .     RET              

+5DCD CB 83       ..    RES   0,E        

+5DCF C5          .     PUSH  BC         

+5DD0 7B          {     LD    A,E        

+5DD1 AA          .     XOR   D          

+5DD2 6F          o     LD    L,A        

+5DD3 26 14       &.    LD    H,14       

+5DD5 6E          n     LD    L,(HL)     

+5DD6 26 15       &.    LD    H,15       

+5DD8 7B          {     LD    A,E        

+5DD9 BE          .     CP    (HL)       

+5DDA 20 09        .    JR    NZ,5DE5    

+5DDC 24          $     INC   H          

+5DDD 7A          z     LD    A,D        

+5DDE BE          .     CP    (HL)       

+5DDF 20 04        .    JR    NZ,5DE5    

+5DE1 25          %     DEC   H          

+5DE2 B7          .     OR    A          

+5DE3 C1          .     POP   BC         

+5DE4 C9          .     RET              

+5DE5 21 1F 15    !..   LD    HL,151F    

+5DE8 01 62 00    .b.   LD    BC,0062    

+5DEB 7B          {     LD    A,E        

+5DEC ED B1       ..    CPIR             

+5DEE E2 08 5E    ..^   JP    PO,5E08    

+5DF1 7A          z     LD    A,D        

+5DF2 24          $     INC   H          

+5DF3 2D          -     DEC   L          

+5DF4 BE          .     CP    (HL)       

+5DF5 28 04       (.    JR    Z,5DFB     

+5DF7 2C          ,     INC   L          

+5DF8 25          %     DEC   H          

+5DF9 18 F0       ..    JR    5DEB       

+5DFB 25          %     DEC   H          

+5DFC E5          .     PUSH  HL         

+5DFD 45          E     LD    B,L        

+5DFE 7B          {     LD    A,E        

+5DFF AA          .     XOR   D          

+5E00 6F          o     LD    L,A        

+5E01 26 14       &.    LD    H,14       

+5E03 70          p     LD    (HL),B     

+5E04 E1          .     POP   HL         

+5E05 C1          .     POP   BC         

+5E06 B7          .     OR    A          

+5E07 C9          .     RET              

+5E08 C1          .     POP   BC         

+5E09 37          7     SCF              

+5E0A C9          .     RET              

+5E0B 7C          |     LD    A,H        

+5E0C FE 10       ..    CP    10         

+5E0E D8          .     RET   C          

+5E0F 37          7     SCF              

+5E10 CB 1C       ..    RR    H          

+5E12 6C          l     LD    L,H        

+5E13 26 15       &.    LD    H,15       

+5E15 CB 86       ..    RES   0,(HL)     

+5E17 C9          .     RET              

+5E18 CD 8A 28    ..(   CALL  288A       

+5E1B CB 70       .p    BIT   6,B        

+5E1D 20 1A        .    JR    NZ,5E39    

+5E1F 3A 5B 60    :[`   LD    A,(605B)   

+5E22 B7          .     OR    A          

+5E23 28 14       (.    JR    Z,5E39     

+5E25 21 A4 60    !.`   LD    HL,60A4    

+5E28 CB 4E       .N    BIT   1,(HL)     

+5E2A 20 05        .    JR    NZ,5E31    

+5E2C 36 00       6.    LD    (HL),00    

+5E2E C3 1A 6C    ..l   JP    6C1A       

+5E31 36 01       6.    LD    (HL),01    

+5E33 2A A5 60    *.`   LD    HL,(60A5)  

+5E36 7C          |     LD    A,H        

+5E37 B5          .     OR    L          

+5E38 C0          .     RET   NZ         

+5E39 CD 42 5E    .B^   CALL  5E42       

+5E3C 65          e     LD    H,L        

+5E3D CB 24       .$    SLA   H          

+5E3F 2E 00       ..    LD    L,00       

+5E41 C9          .     RET              

+5E42 2A 9F 60    *.`   LD    HL,(609F)  

+5E45 22 9D 60    ".`   LD    (609D),HL  

+5E48 11 18 FF    ...   LD    DE,FF18    

+5E4B CD 41 5D    .A]   CALL  5D41       

+5E4E CB C6       ..    SET   0,(HL)     

+5E50 CB FD       ..    SET   7,L        

+5E52 CB C6       ..    SET   0,(HL)     

+5E54 CB BD       ..    RES   7,L        

+5E56 C9          .     RET              

+5E57 01 01 00    ...   LD    BC,0001    

+5E5A C9          .     RET              ;--------------------------------

+5E5B 7C          |     LD    A,H        

+5E5C FE A0       ..    CP    A0         

+5E5E 38 F7       8.    JR    C,5E57     

+5E60 37          7     SCF              

+5E61 1F          .     RRA              

+5E62 41          A     LD    B,C        

+5E63 80          .     ADD   B          

+5E64 38 F1       8.    JR    C,5E57     

+5E66 E5          .     PUSH  HL         

+5E67 21 A1 60    !.`   LD    HL,60A1    

+5E6A 3D          =     DEC   A          

+5E6B BE          .     CP    (HL)       

+5E6C E1          .     POP   HL         

+5E6D 30 E8       0.    JR    NC,5E57    

+5E6F CD 20 6E    . n   CALL  6E20       

+5E72 6C          l     LD    L,H        

+5E73 37          7     SCF              

+5E74 CB 1D       ..    RR    L          

+5E76 26 15       &.    LD    H,15       

+5E78 CD B9 5F    .._   CALL  5FB9       

+5E7B CD 2A 6E    .*n   CALL  6E2A       

+5E7E 01 00 00    ...   LD    BC,0000    

+5E81 C9          .     RET              

+5E82 E5          .     PUSH  HL         

+5E83 21 B5 4C    !.L   LD    HL,4CB5    

+5E86 CB FE       ..    SET   7,(HL)     

+5E88 CB 96       ..    RES   2,(HL)     

+5E8A E1          .     POP   HL         

+5E8B 47          G     LD    B,A        

+5E8C 3A AD 60    :.`   LD    A,(60AD)   

+5E8F B7          .     OR    A          

+5E90 78          x     LD    A,B        

+5E91 20 0D        .    JR    NZ,5EA0    

+5E93 CD B0 5E    ..^   CALL  5EB0       

+5E96 E5          .     PUSH  HL         

+5E97 21 B5 4C    !.L   LD    HL,4CB5    

+5E9A CB BE       ..    RES   7,(HL)     

+5E9C CB D6       ..    SET   2,(HL)     

+5E9E E1          .     POP   HL         

+5E9F C9          .     RET              

+5EA0 E5          .     PUSH  HL         

+5EA1 D5          .     PUSH  DE         

+5EA2 CB 2A       .*    SRA   D          

+5EA4 CB 1B       ..    RR    E          

+5EA6 CD A8 5A    ..Z   CALL  5AA8       

+5EA9 D1          .     POP   DE         

+5EAA E1          .     POP   HL         

+5EAB 18 E9       ..    JR    5E96       

+5EAD CD 2A 6E    .*n   CALL  6E2A       

+5EB0 06 32       .2    LD    B,32       

+5EB2 F5          .     PUSH  AF         

+5EB3 C5          .     PUSH  BC         

+5EB4 E5          .     PUSH  HL         

+5EB5 01 00 00    ...   LD    BC,0000    

+5EB8 CB 3A       .:    SLR   D          

+5EBA CB 1B       ..    RR    E          

+5EBC FE 02       ..    CP    02         

+5EBE 3E 00       >.    LD    A,00       

+5EC0 28 05       (.    JR    Z,5EC7     

+5EC2 CD 7E 28    .~(   CALL  287E       

+5EC5 18 03       ..    JR    5ECA       

+5EC7 CD 81 28    ..(   CALL  2881       

+5ECA CB 23       .#    SLA   E          

+5ECC CB 12       ..    RL    D          

+5ECE 79          y     LD    A,C        

+5ECF B0          .     OR    B          

+5ED0 28 66       (f    JR    Z,5F38     

+5ED2 22 A9 60    ".`   LD    (60A9),HL  

+5ED5 E1          .     POP   HL         

+5ED6 C1          .     POP   BC         

+5ED7 F1          .     POP   AF         

+5ED8 10 D8       ..    DJNZ  5EB2       

+5EDA CD 20 6E    . n   CALL  6E20       

+5EDD 21 67 60    !g`   LD    HL,6067    

+5EE0 CD CA 6E    ..n   CALL  6ECA       

+5EE3 2A A9 60    *.`   LD    HL,(60A9)  

+5EE6 CD CA 6E    ..n   CALL  6ECA       

+5EE9 21 6B 60    !k`   LD    HL,606B    

+5EEC CD CA 6E    ..n   CALL  6ECA       ; noch ein Versuch (j)

+5EEF CD 9E 6E    ..n   CALL  6E9E       

+5EF2 FE 64       .d    CP    64         ; "d" Diskerror

+5EF4 28 2D       (-    JR    Z,5F23     

+5EF6 FE 6A       .j    CP    6A         ; "j" nochmal

+5EF8 28 B3       (.    JR    Z,5EAD     

+5EFA FE 59       .Y    CP    59         ; "Y" Mark

+5EFC 20 DF        .    JR    NZ,5EDD    

+5EFE 21 84 60    !.`   LD    HL,6084    

+5F01 CD CA 6E    ..n   CALL  6ECA       

+5F04 CD 9E 6E    ..n   CALL  6E9E       

+5F07 FE 10       ..    CP    10         

+5F09 20 D2        .    JR    NZ,5EDD    

+5F0B CD 2A 6E    .*n   CALL  6E2A       

+5F0E CD 20 6E    . n   CALL  6E20       

+5F11 01 FE 01    ...   LD    BC,01FE    

+5F14 23          #     INC   HL         

+5F15 54          T     LD    D,H        

+5F16 5D          ]     LD    E,L        

+5F17 13          .     INC   DE         

+5F18 36 FF       6.    LD    (HL),FF    

+5F1A 2B          +     DEC   HL         

+5F1B 36 FD       6.    LD    (HL),FD    

+5F1D ED B0       ..    LDIR             

+5F1F CD 2A 6E    .*n   CALL  6E2A       

+5F22 C9          .     RET              

+5F23 CD 2A 6E    .*n   CALL  6E2A       

+5F26 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+5F29 18 0B       ..    JR    5F36       

+5F2B 20 44        D    JR    NZ,5F71    ; " DISK ERROR"

+5F2D 49          I     LD    C,C        

+5F2E 53          S     LD    D,E        

+5F2F 4B          K     LD    C,E        

+5F30 20 45        E    JR    NZ,5F77    

+5F32 52          R     LD    D,D        

+5F33 52          R     LD    D,D        

+5F34 4F          O     LD    C,A        

+5F35 52          R     LD    D,D        

+5F36 18 A2       ..    JR    5EDA       

+5F38 E1          .     POP   HL         

+5F39 C1          .     POP   BC         

+5F3A F1          .     POP   AF         

+5F3B C9          .     RET              

+5F3C 2C          ,     INC   L          

+5F3D CB FD       ..    SET   7,L        

+5F3F 3A A1 60    :.`   LD    A,(60A1)   

+5F42 BD          .     CP    L          

+5F43 C0          .     RET   NZ         

+5F44 2A 9F 60    *.`   LD    HL,(609F)  

+5F47 C9          .     RET              

+5F48 7C          |     LD    A,H        

+5F49 21 B7 60    !.`   LD    HL,60B7    

+5F4C 87          .     ADD   A          

+5F4D 30 01       0.    JR    NC,5F50    

+5F4F 24          $     INC   H          

+5F50 85          .     ADD   L          

+5F51 6F          o     LD    L,A        

+5F52 30 01       0.    JR    NC,5F55    

+5F54 24          $     INC   H          

+5F55 7E          ~     LD    A,(HL)     

+5F56 3C          <     INC   A          

+5F57 C8          .     RET   Z          

+5F58 23          #     INC   HL         

+5F59 66          f     LD    H,(HL)     

+5F5A 6F          o     LD    L,A        

+5F5B 22 61 60    "a`   LD    (6061),HL  

+5F5E CD 92 5A    ..Z   CALL  5A92       

+5F61 7C          |     LD    A,H        

+5F62 CB 3F       .?    SLR   A          

+5F64 C9          .     RET              

+5F65 CD 6B 5F    .k_   CALL  5F6B       

+5F68 CB 86       ..    RES   0,(HL)     

+5F6A C9          .     RET              

+5F6B 3E 01       >.    LD    A,01       

+5F6D C5          .     PUSH  BC         

+5F6E E5          .     PUSH  HL         

+5F6F 47          G     LD    B,A        

+5F70 CD 0E 6E    ..n   CALL  6E0E       

+5F73 FE 41       .A    CP    41         

+5F75 78          x     LD    A,B        

+5F76 28 09       (.    JR    Z,5F81     

+5F78 22 97 60    ".`   LD    (6097),HL  

+5F7B 21 96 60    !.`   LD    HL,6096    

+5F7E 77          w     LD    (HL),A     

+5F7F 18 07       ..    JR    5F88       

+5F81 22 9A 60    ".`   LD    (609A),HL  

+5F84 21 99 60    !.`   LD    HL,6099    

+5F87 77          w     LD    (HL),A     

+5F88 E5          .     PUSH  HL         

+5F89 21 B5 4C    !.L   LD    HL,4CB5    

+5F8C CB 96       ..    RES   2,(HL)     

+5F8E CD E2 6D    ..m   CALL  6DE2       

+5F91 E1          .     POP   HL         

+5F92 7E          ~     LD    A,(HL)     

+5F93 B7          .     OR    A          

+5F94 20 F2        .    JR    NZ,5F88    

+5F96 E1          .     POP   HL         

+5F97 C1          .     POP   BC         

+5F98 C9          .     RET              

+5F99 E5          .     PUSH  HL         

+5F9A 21 00 00    !..   LD    HL,0000    

+5F9D 22 5E 60    "^`   LD    (605E),HL  

+5FA0 E1          .     POP   HL         

+5FA1 3E 02       >.    LD    A,02       

+5FA3 18 C8       ..    JR    5F6D       

+5FA5 CD 1F 70    ..p   CALL  701F       

+5FA8 18 04       ..    JR    5FAE       

+5FAA 20 52        R    JR    NZ,5FFE    

+5FAC 45          E     LD    B,L        

+5FAD 53          S     LD    D,E        

+5FAE C3 44 58    .DX   JP    5844       

+5FB1 21 D0 15    !..   LD    HL,15D0    

+5FB4 47          G     LD    B,A        

+5FB5 ED 43 64 60 .Cd`  LD    (6064),BC  

+5FB9 CD 6B 5F    .k_   CALL  5F6B       

+5FBC 24          $     INC   H          

+5FBD 36 FF       6.    LD    (HL),FF    

+5FBF 25          %     DEC   H          

+5FC0 CB BD       ..    RES   7,L        

+5FC2 CB C6       ..    SET   0,(HL)     

+5FC4 CB FD       ..    SET   7,L        

+5FC6 2C          ,     INC   L          

+5FC7 10 F0       ..    DJNZ  5FB9       

+5FC9 21 00 A0    !..   LD    HL,A000    

+5FCC C9          .     RET              

+5FCD 3A 17 82    :..   LD    A,(8217)   ; musta

+5FD0 CB 67       .g    BIT   4,A        

+5FD2 20 27        '    JR    NZ,5FFB    ; Bit 4 = System-Aufbau

+5FD4 21 28 16    !(.   LD    HL,1628    

+5FD7 7E          ~     LD    A,(HL)     

+5FD8 57          W     LD    D,A        

+5FD9 FE FD       ..    CP    FD         

+5FDB 30 1A       0.    JR    NC,5FF7    

+5FDD 25          %     DEC   H          

+5FDE 5E          ^     LD    E,(HL)     

+5FDF CD A8 56    ..V   CALL  56A8       

+5FE2 20 12        .    JR    NZ,5FF6    

+5FE4 7B          {     LD    A,E        

+5FE5 BE          .     CP    (HL)       

+5FE6 20 0E        .    JR    NZ,5FF6    

+5FE8 24          $     INC   H          

+5FE9 7A          z     LD    A,D        

+5FEA BE          .     CP    (HL)       

+5FEB 20 0A        .    JR    NZ,5FF7    

+5FED 25          %     DEC   H          

+5FEE CB C6       ..    SET   0,(HL)     

+5FF0 CB FD       ..    SET   7,L        

+5FF2 36 02       6.    LD    (HL),02    

+5FF4 CB BD       ..    RES   7,L        

+5FF6 24          $     INC   H          

+5FF7 2C          ,     INC   L          

+5FF8 F2 D7 5F    .._   JP    P,5FD7     

+5FFB 3A 5B 60    :[`   LD    A,(605B)   

+5FFE B7          .     OR    A          

+5FFF 28 12       (.    JR    Z,6013     

+6001 1E 00       ..    LD    E,00       

+6003 D5          .     PUSH  DE         

+6004 CD A6 5A    ..Z   CALL  5AA6       

+6007 09          .     ADD   HL,BC      

+6008 41          A     LD    B,C        

+6009 CB EE       ..    SET   5,(HL)     

+600B 23          #     INC   HL         

+600C 10 FB       ..    DJNZ  6009       

+600E D1          .     POP   DE         

+600F 1C          .     INC   E          

+6010 1C          .     INC   E          

+6011 20 F0        .    JR    NZ,6003    

+6013 ED 4B 64 60 .Kd`  LD    BC,(6064)  

+6017 21 D0 15    !..   LD    HL,15D0    

+601A CB 86       ..    RES   0,(HL)     

+601C 2C          ,     INC   L          

+601D C8          .     RET   Z          

+601E 10 FA       ..    DJNZ  601A       

+6020 C9          .     RET              ;-------------------------------

+6021 E5          .     PUSH  HL         

+6022 41          A     LD    B,C        

+6023 6C          l     LD    L,H        

+6024 37          7     SCF              

+6025 CB 1D       ..    RR    L          

+6027 26 15       &.    LD    H,15       

+6029 CD 1A 60    ..`   CALL  601A       

+602C E1          .     POP   HL         

+602D C9          .     RET              

+602E CD B6 5D    ..]   CALL  5DB6       

+6031 30 18       0.    JR    NC,604B    

+6033 7A          z     LD    A,D        

+6034 32 1F 16    2..   LD    (161F),A   

+6037 7B          {     LD    A,E        

+6038 32 1F 15    2..   LD    (151F),A   

+603B C5          .     PUSH  BC         

+603C D5          .     PUSH  DE         

+603D CD E2 6D    ..m   CALL  6DE2       

+6040 3A 1F 16    :..   LD    A,(161F)   

+6043 FE FD       ..    CP    FD         

+6045 20 F6        .    JR    NZ,603D    

+6047 D1          .     POP   DE         

+6048 C1          .     POP   BC         

+6049 18 E3       ..    JR    602E       

+604B 65          e     LD    H,L        

+604C CB 24       .$    SLA   H          

+604E 2E 00       ..    LD    L,00       

+6050 C9          .     RET              

+6051 3E 01       >.    LD    A,01       

+6053 32 B3 60    2.`   LD    (60B3),A   

+6056 C9          .     RET              

+6057 21 A8 15    !..   LD    HL,15A8    

+605A C9          .     RET              

+605B 00          .     NOP              

+605C 0F          .     RRCA             

+605D 00          .     NOP              

+605E 00          .     NOP              

+605F 00          .     NOP              

+6060 00          .     NOP              

+6061 00          .     NOP              

+6062 00          .     NOP              

+6063 00          .     NOP              

+6064 01 01 FF    ...   LD    BC,FF01    

+6067 03          .     INC   BC         

+6068 06 17       ..    LD    B,17       

+606A 00          .     NOP              

+606B 18 20       .     JR    608D       

+606D 6E          n     LD    L,(HL)     ; "noch ein Versuch"

+606E 6F          o     LD    L,A        

+606F 63          c     LD    H,E        

+6070 68          h     LD    L,B        

+6071 20 65        e    JR    NZ,60D8    

+6073 69          i     LD    L,C        

+6074 6E          n     LD    L,(HL)     

+6075 20 56        V    JR    NZ,60CD    

+6077 65          e     LD    H,L        

+6078 72          r     LD    (HL),D     

+6079 73          s     LD    (HL),E     

+607A 75          u     LD    (HL),L     

+607B 63          c     LD    H,E        

+607C 68          h     LD    L,B        

+607D 20 28        (    JR    NZ,60A7    

+607F 6A          j     LD    L,D        

+6080 29          )     ADD   HL,HL      

+6081 20 3F        ?    JR    NZ,60C2    

+6083 20 11        .    JR    NZ,6096    

+6085 20 69        i    JR    NZ,60F0    ; "ignore (MARK) ?"

+6087 67          g     LD    H,A        

+6088 6E          n     LD    L,(HL)     

+6089 6F          o     LD    L,A        

+608A 72          r     LD    (HL),D     

+608B 65          e     LD    H,L        

+608C 20 28        (    JR    NZ,60B6    

+608E 4D          M     LD    C,L        

+608F 41          A     LD    B,C        

+6090 52          R     LD    D,D        

+6091 4B          K     LD    C,E        

+6092 29          )     ADD   HL,HL      

+6093 20 3F        ?    JR    NZ,60D4    

+6095 20 00        .    JR    NZ,6097    

+6097 FF          .     RST   38         

+6098 FF          .     RST   38         

+6099 00          .     NOP              

+609A FF          .     RST   38         

+609B FF          .     RST   38         

+609C 00          .     NOP              

+609D DA 15 00    ...   JP    C,0015     

+60A0 00          .     NOP              

+60A1 00          .     NOP              

+60A2 00          .     NOP              

+60A3 00          .     NOP              

+60A4 01 00 00    ...   LD    BC,0000    

+60A7 00          .     NOP              

+60A8 00          .     NOP              

+60A9 00          .     NOP              

+60AA 00          .     NOP              

+60AB 00          .     NOP              

+60AC 00          .     NOP              

+60AD 00          .     NOP              

+60AE 00          .     NOP              

+60AF 00          .     NOP              

+60B0 00          .     NOP              

+60B1 20 16        .    JR    NZ,60C9    

+60B3 00          .     NOP              

+60B4 FF          .     RST   38         

+60B5 00          .     NOP              

+60B6 00          .     NOP              

+60B7 FF          .     RST   38         

+60B8 FF          .     RST   38         

+60B9 FF          .     RST   38         

+60BA FF          .     RST   38         

+60BB FF          .     RST   38         

+60BC FF          .     RST   38         

+60BD FF          .     RST   38         

+60BE FF          .     RST   38         

+60BF FF          .     RST   38         

+60C0 FF          .     RST   38         

+60C1 FF          .     RST   38         

+60C2 FF          .     RST   38         

+60C3 FF          .     RST   38         

+60C4 FF          .     RST   38         

+60C5 FF          .     RST   38         

+60C6 FF          .     RST   38         

+60C7 FF          .     RST   38         

+60C8 FF          .     RST   38         

+60C9 FF          .     RST   38         

+60CA FF          .     RST   38         

+60CB FF          .     RST   38         

+60CC FF          .     RST   38         

+60CD FF          .     RST   38         

+60CE FF          .     RST   38         

+60CF FF          .     RST   38         

+60D0 FF          .     RST   38         

+60D1 FF          .     RST   38         

+60D2 FF          .     RST   38         

+60D3 FF          .     RST   38         

+60D4 FF          .     RST   38         

+60D5 FF          .     RST   38         

+60D6 FF          .     RST   38         

+60D7 FF          .     RST   38         

+60D8 FF          .     RST   38         

+60D9 FF          .     RST   38         

+60DA FF          .     RST   38         

+60DB FF          .     RST   38         

+60DC FF          .     RST   38         

+60DD FF          .     RST   38         

+60DE FF          .     RST   38         

+60DF FF          .     RST   38         

+60E0 FF          .     RST   38         

+60E1 FF          .     RST   38         

+60E2 FF          .     RST   38         

+60E3 FF          .     RST   38         

+60E4 FF          .     RST   38         

+60E5 FF          .     RST   38         

+60E6 FF          .     RST   38         

+60E7 FF          .     RST   38         

+60E8 FF          .     RST   38         

+60E9 FF          .     RST   38         

+60EA FF          .     RST   38         

+60EB FF          .     RST   38         

+60EC FF          .     RST   38         

+60ED FF          .     RST   38         

+60EE FF          .     RST   38         

+60EF FF          .     RST   38         

+60F0 FF          .     RST   38         

+60F1 FF          .     RST   38         

+60F2 FF          .     RST   38         

+60F3 FF          .     RST   38         

+60F4 FF          .     RST   38         

+60F5 FF          .     RST   38         

+60F6 FF          .     RST   38         

+60F7 FF          .     RST   38         

+60F8 FF          .     RST   38         

+60F9 FF          .     RST   38         

+60FA FF          .     RST   38         

+60FB FF          .     RST   38         

+60FC FF          .     RST   38         

+60FD FF          .     RST   38         

+60FE FF          .     RST   38         

+60FF FF          .     RST   38         

+6100 FF          .     RST   38         

+6101 FF          .     RST   38         

+6102 FF          .     RST   38         

+6103 FF          .     RST   38         

+6104 FF          .     RST   38         

+6105 FF          .     RST   38         

+6106 FF          .     RST   38         

+6107 FF          .     RST   38         

+6108 FF          .     RST   38         

+6109 FF          .     RST   38         

+610A FF          .     RST   38         

+610B FF          .     RST   38         

+610C FF          .     RST   38         

+610D FF          .     RST   38         

+610E FF          .     RST   38         

+610F FF          .     RST   38         

+6110 FF          .     RST   38         

+6111 FF          .     RST   38         

+6112 FF          .     RST   38         

+6113 FF          .     RST   38         

+6114 FF          .     RST   38         

+6115 FF          .     RST   38         

+6116 FF          .     RST   38         

+6117 FF          .     RST   38         

+6118 FF          .     RST   38         

+6119 FF          .     RST   38         

+611A FF          .     RST   38         

+611B FF          .     RST   38         

+611C FF          .     RST   38         

+611D FF          .     RST   38         

+611E FF          .     RST   38         

+611F FF          .     RST   38         

+6120 FF          .     RST   38         

+6121 FF          .     RST   38         

+6122 FF          .     RST   38         

+6123 FF          .     RST   38         

+6124 FF          .     RST   38         

+6125 FF          .     RST   38         

+6126 FF          .     RST   38         

+6127 FF          .     RST   38         

+6128 FF          .     RST   38         

+6129 FF          .     RST   38         

+612A FF          .     RST   38         

+612B FF          .     RST   38         

+612C FF          .     RST   38         

+612D FF          .     RST   38         

+612E FF          .     RST   38         

+612F FF          .     RST   38         

+6130 FF          .     RST   38         

+6131 FF          .     RST   38         

+6132 FF          .     RST   38         

+6133 FF          .     RST   38         

+6134 FF          .     RST   38         

+6135 FF          .     RST   38         

+6136 FF          .     RST   38         

+6137 FF          .     RST   38         

+6138 FF          .     RST   38         

+6139 FF          .     RST   38         

+613A FF          .     RST   38         

+613B FF          .     RST   38         

+613C FF          .     RST   38         

+613D FF          .     RST   38         

+613E FF          .     RST   38         

+613F FF          .     RST   38         

+6140 FF          .     RST   38         

+6141 FF          .     RST   38         

+6142 FF          .     RST   38         

+6143 FF          .     RST   38         

+6144 FF          .     RST   38         

+6145 FF          .     RST   38         

+6146 FF          .     RST   38         

+6147 FF          .     RST   38         

+6148 FF          .     RST   38         

+6149 FF          .     RST   38         

+614A FF          .     RST   38         

+614B FF          .     RST   38         

+614C FF          .     RST   38         

+614D FF          .     RST   38         

+614E FF          .     RST   38         

+614F FF          .     RST   38         

+6150 FF          .     RST   38         

+6151 FF          .     RST   38         

+6152 FF          .     RST   38         

+6153 FF          .     RST   38         

+6154 FF          .     RST   38         

+6155 FF          .     RST   38         

+6156 FF          .     RST   38         

+6157 FF          .     RST   38         

+6158 FF          .     RST   38         

+6159 FF          .     RST   38         

+615A FF          .     RST   38         

+615B FF          .     RST   38         

+615C FF          .     RST   38         

+615D FF          .     RST   38         

+615E FF          .     RST   38         

+615F FF          .     RST   38         

+6160 FF          .     RST   38         

+6161 FF          .     RST   38         

+6162 FF          .     RST   38         

+6163 FF          .     RST   38         

+6164 FF          .     RST   38         

+6165 FF          .     RST   38         

+6166 FF          .     RST   38         

+6167 FF          .     RST   38         

+6168 FF          .     RST   38         

+6169 FF          .     RST   38         

+616A FF          .     RST   38         

+616B FF          .     RST   38         

+616C FF          .     RST   38         

+616D FF          .     RST   38         

+616E FF          .     RST   38         

+616F FF          .     RST   38         

+6170 FF          .     RST   38         

+6171 FF          .     RST   38         

+6172 FF          .     RST   38         

+6173 FF          .     RST   38         

+6174 FF          .     RST   38         

+6175 FF          .     RST   38         

+6176 FF          .     RST   38         

+6177 FF          .     RST   38         

+6178 FF          .     RST   38         

+6179 FF          .     RST   38         

+617A FF          .     RST   38         

+617B FF          .     RST   38         

+617C FF          .     RST   38         

+617D FF          .     RST   38         

+617E FF          .     RST   38         

+617F FF          .     RST   38         

+6180 FF          .     RST   38         

+6181 FF          .     RST   38         

+6182 FF          .     RST   38         

+6183 FF          .     RST   38         

+6184 FF          .     RST   38         

+6185 FF          .     RST   38         

+6186 FF          .     RST   38         

+6187 FF          .     RST   38         

+6188 FF          .     RST   38         

+6189 FF          .     RST   38         

+618A FF          .     RST   38         

+618B FF          .     RST   38         

+618C FF          .     RST   38         

+618D FF          .     RST   38         

+618E FF          .     RST   38         

+618F FF          .     RST   38         

+6190 FF          .     RST   38         

+6191 FF          .     RST   38         

+6192 FF          .     RST   38         

+6193 FF          .     RST   38         

+6194 FF          .     RST   38         

+6195 FF          .     RST   38         

+6196 FF          .     RST   38         

+6197 FF          .     RST   38         

+6198 FF          .     RST   38         

+6199 FF          .     RST   38         

+619A FF          .     RST   38         

+619B FF          .     RST   38         

+619C FF          .     RST   38         

+619D FF          .     RST   38         

+619E FF          .     RST   38         

+619F FF          .     RST   38         

+61A0 FF          .     RST   38         

+61A1 FF          .     RST   38         

+61A2 FF          .     RST   38         

+61A3 FF          .     RST   38         

+61A4 FF          .     RST   38         

+61A5 FF          .     RST   38         

+61A6 FF          .     RST   38         

+61A7 FF          .     RST   38         

+61A8 FF          .     RST   38         

+61A9 FF          .     RST   38         

+61AA FF          .     RST   38         

+61AB FF          .     RST   38         

+61AC FF          .     RST   38         

+61AD FF          .     RST   38         

+61AE FF          .     RST   38         

+61AF FF          .     RST   38         

+61B0 FF          .     RST   38         

+61B1 FF          .     RST   38         

+61B2 FF          .     RST   38         

+61B3 FF          .     RST   38         

+61B4 FF          .     RST   38         

+61B5 FF          .     RST   38         

+61B6 FF          .     RST   38         

+61B7 FF          .     RST   38         

+61B8 FF          .     RST   38         

+61B9 FF          .     RST   38         

+61BA FF          .     RST   38         

+61BB FF          .     RST   38         

+61BC FF          .     RST   38         

+61BD FF          .     RST   38         

+61BE FF          .     RST   38         

+61BF FF          .     RST   38         

+61C0 FF          .     RST   38         

+61C1 FF          .     RST   38         

+61C2 FF          .     RST   38         

+61C3 FF          .     RST   38         

+61C4 FF          .     RST   38         

+61C5 FF          .     RST   38         

+61C6 FF          .     RST   38         

+61C7 FF          .     RST   38         

+61C8 FF          .     RST   38         

+61C9 FF          .     RST   38         

+61CA FF          .     RST   38         

+61CB FF          .     RST   38         

+61CC FF          .     RST   38         

+61CD FF          .     RST   38         

+61CE FF          .     RST   38         

+61CF FF          .     RST   38         

+61D0 FF          .     RST   38         

+61D1 FF          .     RST   38         

+61D2 FF          .     RST   38         

+61D3 FF          .     RST   38         

+61D4 FF          .     RST   38         

+61D5 FF          .     RST   38         

+61D6 FF          .     RST   38         

+61D7 FF          .     RST   38         

+61D8 FF          .     RST   38         

+61D9 FF          .     RST   38         

+61DA FF          .     RST   38         

+61DB FF          .     RST   38         

+61DC FF          .     RST   38         

+61DD FF          .     RST   38         

+61DE FF          .     RST   38         

+61DF FF          .     RST   38         

+61E0 FF          .     RST   38         

+61E1 FF          .     RST   38         

+61E2 FF          .     RST   38         

+61E3 FF          .     RST   38         

+61E4 FF          .     RST   38         

+61E5 FF          .     RST   38         

+61E6 FF          .     RST   38         

+61E7 FF          .     RST   38         

+61E8 FF          .     RST   38         

+61E9 FF          .     RST   38         

+61EA FF          .     RST   38         

+61EB FF          .     RST   38         

+61EC FF          .     RST   38         

+61ED FF          .     RST   38         

+61EE FF          .     RST   38         

+61EF FF          .     RST   38         

+61F0 FF          .     RST   38         

+61F1 FF          .     RST   38         

+61F2 FF          .     RST   38         

+61F3 FF          .     RST   38         

+61F4 FF          .     RST   38         

+61F5 FF          .     RST   38         

+61F6 FF          .     RST   38         

+61F7 FF          .     RST   38         

+61F8 FF          .     RST   38         

+61F9 FF          .     RST   38         

+61FA FF          .     RST   38         

+61FB FF          .     RST   38         

+61FC FF          .     RST   38         

+61FD FF          .     RST   38         

+61FE FF          .     RST   38         

+61FF FF          .     RST   38         

+6200 FF          .     RST   38         

+6201 FF          .     RST   38         

+6202 FF          .     RST   38         

+6203 FF          .     RST   38         

+6204 FF          .     RST   38         

+6205 FF          .     RST   38         

+6206 FF          .     RST   38         

+6207 FF          .     RST   38         

+6208 FF          .     RST   38         

+6209 FF          .     RST   38         

+620A FF          .     RST   38         

+620B FF          .     RST   38         

+620C FF          .     RST   38         

+620D FF          .     RST   38         

+620E FF          .     RST   38         

+620F FF          .     RST   38         

+6210 FF          .     RST   38         

+6211 FF          .     RST   38         

+6212 FF          .     RST   38         

+6213 FF          .     RST   38         

+6214 FF          .     RST   38         

+6215 FF          .     RST   38         

+6216 FF          .     RST   38         

+6217 FF          .     RST   38         

+6218 FF          .     RST   38         

+6219 FF          .     RST   38         

+621A FF          .     RST   38         

+621B FF          .     RST   38         

+621C FF          .     RST   38         

+621D FF          .     RST   38         

+621E FF          .     RST   38         

+621F FF          .     RST   38         

+6220 FF          .     RST   38         

+6221 FF          .     RST   38         

+6222 FF          .     RST   38         

+6223 FF          .     RST   38         

+6224 FF          .     RST   38         

+6225 FF          .     RST   38         

+6226 FF          .     RST   38         

+6227 FF          .     RST   38         

+6228 FF          .     RST   38         

+6229 FF          .     RST   38         

+622A FF          .     RST   38         

+622B FF          .     RST   38         

+622C FF          .     RST   38         

+622D FF          .     RST   38         

+622E FF          .     RST   38         

+622F FF          .     RST   38         

+6230 FF          .     RST   38         

+6231 FF          .     RST   38         

+6232 FF          .     RST   38         

+6233 FF          .     RST   38         

+6234 FF          .     RST   38         

+6235 FF          .     RST   38         

+6236 FF          .     RST   38         

+6237 FF          .     RST   38         

+6238 FF          .     RST   38         

+6239 FF          .     RST   38         

+623A FF          .     RST   38         

+623B FF          .     RST   38         

+623C FF          .     RST   38         

+623D FF          .     RST   38         

+623E FF          .     RST   38         

+623F FF          .     RST   38         

+6240 FF          .     RST   38         

+6241 FF          .     RST   38         

+6242 FF          .     RST   38         

+6243 FF          .     RST   38         

+6244 FF          .     RST   38         

+6245 FF          .     RST   38         

+6246 FF          .     RST   38         

+6247 FF          .     RST   38         

+6248 FF          .     RST   38         

+6249 FF          .     RST   38         

+624A FF          .     RST   38         

+624B FF          .     RST   38         

+624C FF          .     RST   38         

+624D FF          .     RST   38         

+624E FF          .     RST   38         

+624F FF          .     RST   38         

+6250 FF          .     RST   38         

+6251 FF          .     RST   38         

+6252 FF          .     RST   38         

+6253 FF          .     RST   38         

+6254 FF          .     RST   38         

+6255 FF          .     RST   38         

+6256 FF          .     RST   38         

+6257 FF          .     RST   38         

+6258 FF          .     RST   38         

+6259 FF          .     RST   38         

+625A FF          .     RST   38         

+625B FF          .     RST   38         

+625C FF          .     RST   38         

+625D FF          .     RST   38         

+625E FF          .     RST   38         

+625F FF          .     RST   38         

+6260 FF          .     RST   38         

+6261 FF          .     RST   38         

+6262 FF          .     RST   38         

+6263 FF          .     RST   38         

+6264 FF          .     RST   38         

+6265 FF          .     RST   38         

+6266 FF          .     RST   38         

+6267 FF          .     RST   38         

+6268 FF          .     RST   38         

+6269 FF          .     RST   38         

+626A FF          .     RST   38         

+626B FF          .     RST   38         

+626C FF          .     RST   38         

+626D FF          .     RST   38         

+626E FF          .     RST   38         

+626F FF          .     RST   38         

+6270 FF          .     RST   38         

+6271 FF          .     RST   38         

+6272 FF          .     RST   38         

+6273 FF          .     RST   38         

+6274 FF          .     RST   38         

+6275 FF          .     RST   38         

+6276 FF          .     RST   38         

+6277 FF          .     RST   38         

+6278 FF          .     RST   38         

+6279 FF          .     RST   38         

+627A FF          .     RST   38         

+627B FF          .     RST   38         

+627C FF          .     RST   38         

+627D FF          .     RST   38         

+627E FF          .     RST   38         

+627F FF          .     RST   38         

+6280 FF          .     RST   38         

+6281 FF          .     RST   38         

+6282 FF          .     RST   38         

+6283 FF          .     RST   38         

+6284 FF          .     RST   38         

+6285 FF          .     RST   38         

+6286 FF          .     RST   38         

+6287 FF          .     RST   38         

+6288 FF          .     RST   38         

+6289 FF          .     RST   38         

+628A FF          .     RST   38         

+628B FF          .     RST   38         

+628C FF          .     RST   38         

+628D FF          .     RST   38         

+628E FF          .     RST   38         

+628F FF          .     RST   38         

+6290 FF          .     RST   38         

+6291 FF          .     RST   38         

+6292 FF          .     RST   38         

+6293 FF          .     RST   38         

+6294 FF          .     RST   38         

+6295 FF          .     RST   38         

+6296 FF          .     RST   38         

+6297 FF          .     RST   38         

+6298 FF          .     RST   38         

+6299 FF          .     RST   38         

+629A FF          .     RST   38         

+629B FF          .     RST   38         

+629C FF          .     RST   38         

+629D FF          .     RST   38         

+629E FF          .     RST   38         

+629F FF          .     RST   38         

+62A0 FF          .     RST   38         

+62A1 FF          .     RST   38         

+62A2 FF          .     RST   38         

+62A3 FF          .     RST   38         

+62A4 FF          .     RST   38         

+62A5 FF          .     RST   38         

+62A6 FF          .     RST   38         

+62A7 FF          .     RST   38         

+62A8 FF          .     RST   38         

+62A9 FF          .     RST   38         

+62AA FF          .     RST   38         

+62AB FF          .     RST   38         

+62AC FF          .     RST   38         

+62AD FF          .     RST   38         

+62AE FF          .     RST   38         

+62AF FF          .     RST   38         

+62B0 FF          .     RST   38         

+62B1 FF          .     RST   38         

+62B2 FF          .     RST   38         

+62B3 FF          .     RST   38         

+62B4 FF          .     RST   38         

+62B5 FF          .     RST   38         

+62B6 FF          .     RST   38         

+62B7 61          a     LD    H,C        ; "archiv   3 (!)"

+62B8 72          r     LD    (HL),D     

+62B9 63          c     LD    H,E        

+62BA 68          h     LD    L,B        

+62BB 69          i     LD    L,C        

+62BC 76          v     HALT             

+62BD 20 20             JR    NZ,62DF    

+62BF 20 33        3    JR    NZ,62F4    

+62C1 20 28        (    JR    NZ,62EB    

+62C3 21 29 50    !)P   LD    HL,5029    ; "PROZ ARCH"

+62C6 52          R     LD    D,D        

+62C7 4F          O     LD    C,A        

+62C8 5A          Z     LD    E,D        

+62C9 20 41        A    JR    NZ,630C    

+62CB 52          R     LD    D,D        

+62CC 43          C     LD    B,E        

+62CD 48          H     LD    C,B        

+62CE 54          T     LD    D,H        

+62CF 63          c     LD    H,E        

+62D0 C3 DE 63    ..c   JP    63DE       

+62D3 41          A     LD    B,C        

+62D4 FF          .     RST   38         

+62D5 FF          .     RST   38         

+62D6 FF          .     RST   38         

+62D7 FF          .     RST   38         

+62D8 FF          .     RST   38         

+62D9 FF          .     RST   38         

+62DA FF          .     RST   38         

+62DB FF          .     RST   38         

+62DC FF          .     RST   38         

+62DD FF          .     RST   38         

+62DE FF          .     RST   38         

+62DF FF          .     RST   38         

+62E0 FF          .     RST   38         

+62E1 FF          .     RST   38         

+62E2 FF          .     RST   38         

+62E3 FF          .     RST   38         

+62E4 FF          .     RST   38         

+62E5 FF          .     RST   38         

+62E6 FF          .     RST   38         

+62E7 FF          .     RST   38         

+62E8 FF          .     RST   38         

+62E9 FF          .     RST   38         

+62EA FF          .     RST   38         

+62EB FF          .     RST   38         

+62EC FF          .     RST   38         

+62ED FF          .     RST   38         

+62EE FF          .     RST   38         

+62EF FF          .     RST   38         

+62F0 FF          .     RST   38         

+62F1 FF          .     RST   38         

+62F2 FF          .     RST   38         

+62F3 FF          .     RST   38         

+62F4 FF          .     RST   38         

+62F5 FF          .     RST   38         

+62F6 FF          .     RST   38         

+62F7 FF          .     RST   38         

+62F8 FF          .     RST   38         

+62F9 FF          .     RST   38         

+62FA FF          .     RST   38         

+62FB FF          .     RST   38         

+62FC FF          .     RST   38         

+62FD FF          .     RST   38         

+62FE FF          .     RST   38         

+62FF FF          .     RST   38         

+6300 FF          .     RST   38         

+6301 FF          .     RST   38         

+6302 FF          .     RST   38         

+6303 FF          .     RST   38         

+6304 FF          .     RST   38         

+6305 FF          .     RST   38         

+6306 FF          .     RST   38         

+6307 FF          .     RST   38         

+6308 FF          .     RST   38         

+6309 FF          .     RST   38         

+630A FF          .     RST   38         

+630B FF          .     RST   38         

+630C FF          .     RST   38         

+630D FF          .     RST   38         

+630E FF          .     RST   38         

+630F FF          .     RST   38         

+6310 FF          .     RST   38         

+6311 FF          .     RST   38         

+6312 FF          .     RST   38         

+6313 FF          .     RST   38         

+6314 FF          .     RST   38         

+6315 FF          .     RST   38         

+6316 FF          .     RST   38         

+6317 FF          .     RST   38         

+6318 FF          .     RST   38         

+6319 FF          .     RST   38         

+631A FF          .     RST   38         

+631B FF          .     RST   38         

+631C FF          .     RST   38         

+631D FF          .     RST   38         

+631E FF          .     RST   38         

+631F FF          .     RST   38         

+6320 FF          .     RST   38         

+6321 FF          .     RST   38         

+6322 FF          .     RST   38         

+6323 FF          .     RST   38         

+6324 FF          .     RST   38         

+6325 FF          .     RST   38         

+6326 FF          .     RST   38         

+6327 FF          .     RST   38         

+6328 FF          .     RST   38         

+6329 FF          .     RST   38         

+632A FF          .     RST   38         

+632B FF          .     RST   38         

+632C FF          .     RST   38         

+632D FF          .     RST   38         

+632E FF          .     RST   38         

+632F FF          .     RST   38         

+6330 FF          .     RST   38         

+6331 FF          .     RST   38         

+6332 FF          .     RST   38         

+6333 FF          .     RST   38         

+6334 FF          .     RST   38         

+6335 FF          .     RST   38         

+6336 FF          .     RST   38         

+6337 FF          .     RST   38         

+6338 FF          .     RST   38         

+6339 FF          .     RST   38         

+633A FF          .     RST   38         

+633B FF          .     RST   38         

+633C FF          .     RST   38         

+633D FF          .     RST   38         

+633E FF          .     RST   38         

+633F FF          .     RST   38         

+6340 FF          .     RST   38         

+6341 FF          .     RST   38         

+6342 FF          .     RST   38         

+6343 FF          .     RST   38         

+6344 FF          .     RST   38         

+6345 FF          .     RST   38         

+6346 FF          .     RST   38         

+6347 FF          .     RST   38         

+6348 FF          .     RST   38         

+6349 FF          .     RST   38         

+634A FF          .     RST   38         

+634B FF          .     RST   38         

+634C FF          .     RST   38         

+634D FF          .     RST   38         

+634E FF          .     RST   38         

+634F FF          .     RST   38         

+6350 FF          .     RST   38         

+6351 FF          .     RST   38         

+6352 FF          .     RST   38         

+6353 FF          .     RST   38         

+6354 56          V     LD    D,(HL)     

+6355 63          c     LD    H,E        

+6356 21 B5 4C    !.L   LD    HL,4CB5    

+6359 CB 96       ..    RES   2,(HL)     

+635B CD E2 6D    ..m   CALL  6DE2       

+635E 3A 51 64    :Qd   LD    A,(6451)   

+6361 B7          .     OR    A          

+6362 28 F7       (.    JR    Z,635B     

+6364 FA 5B 63    .[c   JP    M,635B     

+6367 21 B5 4C    !.L   LD    HL,4CB5    

+636A CB D6       ..    SET   2,(HL)     

+636C FE 0C       ..    CP    0C         

+636E DA 81 63    ..c   JP    C,6381     

+6371 CD 1F 70    ..p   CALL  701F       

+6374 18 04       ..    JR    637A       

+6376 20 3F        ?    JR    NZ,63B7    

+6378 3F          ?     CCF              

+6379 3F          ?     CCF              

+637A 3E 00       >.    LD    A,00       

+637C 32 51 64    2Qd   LD    (6451),A   

+637F 18 D5       ..    JR    6356       

+6381 2A 49 64    *Id   LD    HL,(6449)  

+6384 ED 5B 4D 64 .[Md  LD    DE,(644D)  

+6388 ED 4B 4B 64 .KKd  LD    BC,(644B)  

+638C FE 0A       ..    CP    0A         

+638E 28 1F       (.    JR    Z,63AF     

+6390 FE 0B       ..    CP    0B         

+6392 3A 4F 64    :Od   LD    A,(644F)   

+6395 28 05       (.    JR    Z,639C     

+6397 CD 7E 28    .~(   CALL  287E       

+639A 18 19       ..    JR    63B5       

+639C EB          .     EX    DE,HL      

+639D ED 5B 4B 64 .[Kd  LD    DE,(644B)  

+63A1 ED 4B 49 64 .KId  LD    BC,(6449)  

+63A5 CD A8 28    ..(   CALL  28A8       

+63A8 ED 43 53 64 .CSd  LD    (6453),BC  

+63AC C3 7A 63    .zc   JP    637A       

+63AF 3A 4F 64    :Od   LD    A,(644F)   

+63B2 CD 81 28    ..(   CALL  2881       

+63B5 ED 43 53 64 .CSd  LD    (6453),BC  

+63B9 2A 49 64    *Id   LD    HL,(6449)  

+63BC CD CC 63    ..c   CALL  63CC       

+63BF C3 7A 63    .zc   JP    637A       

+63C2 01 01 00    ...   LD    BC,0001    

+63C5 ED 43 53 64 .CSd  LD    (6453),BC  

+63C9 C3 7A 63    .zc   JP    637A       

+63CC 6C          l     LD    L,H        

+63CD 37          7     SCF              

+63CE CB 1D       ..    RR    L          

+63D0 26 15       &.    LD    H,15       

+63D2 CB 86       ..    RES   0,(HL)     

+63D4 C9          .     RET              

+63D5 6C          l     LD    L,H        

+63D6 37          7     SCF              

+63D7 CB 1D       ..    RR    L          

+63D9 26 15       &.    LD    H,15       

+63DB CB C6       ..    SET   0,(HL)     

+63DD C9          .     RET              

+63DE F5          .     PUSH  AF         

+63DF 3E 09       >.    LD    A,09       

+63E1 F5          .     PUSH  AF         

+63E2 E5          .     PUSH  HL         

+63E3 21 51 64    !Qd   LD    HL,6451    

+63E6 7E          ~     LD    A,(HL)     

+63E7 B7          .     OR    A          

+63E8 C2 1A 6C    ..l   JP    NZ,6C1A    

+63EB 23          #     INC   HL         

+63EC 7E          ~     LD    A,(HL)     

+63ED B7          .     OR    A          

+63EE 28 11       (.    JR    Z,6401     

+63F0 3A 1A 6E    :.n   LD    A,(6E1A)   

+63F3 BE          .     CP    (HL)       

+63F4 C2 1A 6C    ..l   JP    NZ,6C1A    

+63F7 36 00       6.    LD    (HL),00    

+63F9 ED 4B 53 64 .KSd  LD    BC,(6453)  

+63FD E1          .     POP   HL         

+63FE F1          .     POP   AF         

+63FF F1          .     POP   AF         

+6400 C9          .     RET              

+6401 3A 1A 6E    :.n   LD    A,(6E1A)   

+6404 77          w     LD    (HL),A     

+6405 E1          .     POP   HL         

+6406 ED 53 49 64 .SId  LD    (6449),DE  

+640A 22 4B 64    "Kd   LD    (644B),HL  

+640D ED 43 4D 64 .CMd  LD    (644D),BC  

+6411 F1          .     POP   AF         

+6412 EB          .     EX    DE,HL      

+6413 32 51 64    2Qd   LD    (6451),A   

+6416 FE 0B       ..    CP    0B         

+6418 C4 D5 63    ..c   CALL  NZ,63D5    

+641B F1          .     POP   AF         

+641C 32 4F 64    2Od   LD    (644F),A   

+641F 21 51 64    !Qd   LD    HL,6451    

+6422 C3 1A 6C    ..l   JP    6C1A       

+6425 F5          .     PUSH  AF         

+6426 3E 0A       >.    LD    A,0A       

+6428 18 B7       ..    JR    63E1       

+642A F5          .     PUSH  AF         

+642B 3E 0B       >.    LD    A,0B       

+642D 18 B2       ..    JR    63E1       

+642F E5          .     PUSH  HL         

+6430 21 52 64    !Rd   LD    HL,6452    

+6433 BE          .     CP    (HL)       

+6434 20 02        .    JR    NZ,6438    

+6436 36 00       6.    LD    (HL),00    

+6438 E1          .     POP   HL         

+6439 C9          .     RET              

+643A ED 4B 45 64 .KEd  LD    BC,(6445)  

+643E 21 00 00    !..   LD    HL,0000    

+6441 22 45 64    "Ed   LD    (6445),HL  

+6444 C9          .     RET              

+6445 00          .     NOP              

+6446 00          .     NOP              

+6447 00          .     NOP              

+6448 00          .     NOP              

+6449 FF          .     RST   38         

+644A FF          .     RST   38         

+644B FF          .     RST   38         

+644C FF          .     RST   38         

+644D FF          .     RST   38         

+644E FF          .     RST   38         

+644F FF          .     RST   38         

+6450 00          .     NOP              

+6451 00          .     NOP              

+6452 00          .     NOP              

+6453 05          .     DEC   B          

+6454 00          .     NOP              

+6455 00          .     NOP              

+6456 00          .     NOP              

+6457 00          .     NOP              

+6458 00          .     NOP              

+6459 00          .     NOP              

+645A 00          .     NOP              

+645B 00          .     NOP              

+645C 00          .     NOP              

+645D 00          .     NOP              

+645E 00          .     NOP              

+645F 00          .     NOP              

+6460 00          .     NOP              

+6461 00          .     NOP              

+6462 00          .     NOP              

+6463 00          .     NOP              

+6464 00          .     NOP              

+6465 00          .     NOP              

+6466 00          .     NOP              

+6467 00          .     NOP              

+6468 00          .     NOP              

+6469 00          .     NOP              

+646A 00          .     NOP              

+646B 31 37 35    175   LD    SP,3537    ; "175---spver quelle   3 (!)"

+646E 2D          -     DEC   L          

+646F 2D          -     DEC   L          

+6470 2D          -     DEC   L          

+6471 73          s     LD    (HL),E     

+6472 70          p     LD    (HL),B     

+6473 76          v     HALT             

+6474 65          e     LD    H,L        

+6475 72          r     LD    (HL),D     

+6476 2E 71       .q    LD    L,71       

+6478 75          u     LD    (HL),L     

+6479 65          e     LD    H,L        

+647A 6C          l     LD    L,H        

+647B 6C          l     LD    L,H        

+647C 65          e     LD    H,L        

+647D 20 20             JR    NZ,649F    

+647F 20 33        3    JR    NZ,64B4    

+6481 20 28        (    JR    NZ,64AB    

+6483 21 29 01    !).   LD    HL,0129    

+6486 38 00       8.    JR    C,6488     

+6488 CD D8 81    ...   CALL  81D8       

+648B FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+648F FD 46 04    .F.   LD    B,(IY+04)  

+6492 FD 4E 03    .N.   LD    C,(IY+03)  

+6495 C5          .     PUSH  BC         

+6496 ED 73 51 65 .sQe  LD    (6551),SP  

+649A 01 3B 65    .;e   LD    BC,653B    

+649D FD 70 04    .p.   LD    (IY+04),B  

+64A0 FD 71 03    .q.   LD    (IY+03),C  

+64A3 CD 48 65    .He   CALL  6548       

+64A6 11 00 00    ...   LD    DE,0000    ; Block 0

+64A9 CD 4E 6A    .Nj   CALL  6A4E       ; In RAM holen (Adresse in HL)

+64AC 67          g     LD    H,A        ; Ettikettadresse (Highbyte in H)

+64AD 97          .     SUB   A          ; HG-Kanal

+64AE 01 05 00    ...   LD    BC,0005    ; IOCONTROL 'size'

+64B1 CD A8 28    ..(   CALL  28A8       

+64B4 2E 24       .$    LD    L,24       ; 'aus historischen Gr�nden...' 

+64B6 CB 28       .(    SRA   B          ; = HG-Blocks DIV 8

+64B8 CB 19       ..    RR    C          

+64BA CB 28       .(    SRA   B          

+64BC CB 19       ..    RR    C          

+64BE CB 28       .(    SRA   B          

+64C0 CB 19       ..    RR    C          

+64C2 71          q     LD    (HL),C     ; eintragen

+64C3 23          #     INC   HL         

+64C4 70          p     LD    (HL),B     

+64C5 2E 0E       ..    LD    L,0E       ; session INCR 1

+64C7 5E          ^     LD    E,(HL)     

+64C8 2C          ,     INC   L          

+64C9 56          V     LD    D,(HL)     

+64CA 13          .     INC   DE         

+64CB 72          r     LD    (HL),D     

+64CC 2D          -     DEC   L          

+64CD 73          s     LD    (HL),E     

+64CE ED 53 17 6B .S.k  LD    (6B17),DE  ; Ausserdem in 6B17 ablegen

+64D2 2E 46       .F    LD    L,46       ; Infopassword

+64D4 11 19 7D    ..}   LD    DE,7D19    ; Lesen --> 7D19 

+64D7 01 0A 00    ...   LD    BC,000A    ; 10 Bytes 

+64DA ED B0       ..    LDIR             

+64DC 2E 50       .P    LD    L,50       ;

+64DE 7E          ~     LD    A,(HL)     

+64DF FE 01       ..    CP    01         ; 1 = frisches System 

+64E1 20 17        .    JR    NZ,64FA    

+64E3 36 00       6.    LD    (HL),00    ; jetzt nicht frisch 

+64E5 3E 11       >.    LD    A,11       ; Funktion 17 

+64E7 CD BB 81    ...   CALL  81BB       

+64EA CD 26 65    .&e   CALL  6526       

+64ED 3E 12       >.    LD    A,12       ; Funktion 18 'System aufbauen'

+64EF CD BB 81    ...   CALL  81BB       

+64F2 21 1A 6B    !.k   LD    HL,6B1A    

+64F5 CD CA 6E    ..n   CALL  6ECA       

+64F8 18 20       .     JR    651A       ; das wars

+64FA 2E 0D       ..    LD    L,0D       ; 0 = shutup-Zustand

+64FC CB 4E       .N    BIT   1,(HL)     

+64FE 28 08       (.    JR    Z,6508     

+6500 21 00 6B    !.k   LD    HL,6B00    ; Alte Werte benuzten 6B00.. 

+6503 CD CA 6E    ..n   CALL  6ECA       

+6506 18 02       ..    JR    650A       

+6508 36 FF       6.    LD    (HL),FF    ; FF = kein Shutup

+650A CD 48 65    .He   CALL  6548       

+650D CD 18 53    ..S   CALL  5318       

+6510 3E 01       >.    LD    A,01       ; Funktion 1

+6512 CD BB 81    ...   CALL  81BB       

+6515 CD 26 65    .&e   CALL  6526       

+6518 18 00       ..    JR    651A       

+651A C1          .     POP   BC         ; 

+651B FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+651F FD 70 04    .p.   LD    (IY+04),B  

+6522 FD 71 03    .q.   LD    (IY+03),C  

+6525 C9          .     RET              

+6526 CD 48 65    .He   CALL  6548       ; N�chsten MINI

+6529 11 02 00    ...   LD    DE,0002    ; Block "2" ist Systemanker

+652C CD 36 6A    .6j   CALL  6A36       ; A ist Adresse (Highbyte)

+652F 67          g     LD    H,A        

+6530 2E 00       ..    LD    L,00       

+6532 11 2B 1E    .+.   LD    DE,1E2B    

+6535 01 10 00    ...   LD    BC,0010    ; 16 Bytes (DR_DR) �bertragen

+6538 ED B0       ..    LDIR             

+653A C9          .     RET              

+653B ED 7B 51 65 .{Qe  LD    SP,(6551)  

+653F CD E2 6D    ..m   CALL  6DE2       

+6542 FD 2A 53 65 .*Se  LD    IY,(6553)  

+6546 FD E9       ..    JP    (IY)       

+6548 E1          .     POP   HL         

+6549 ED 73 51 65 .sQe  LD    (6551),SP  

+654D 22 53 65    "Se   LD    (6553),HL  

+6550 E9          .     JP    (HL)       

+6551 00          .     NOP              ; MINI-Savestackpointer 

+6552 00          .     NOP              

+6553 00          .     NOP              ; MINI IY Zeigt auf MINI-Descriptor

+6554 00          .     NOP              

+6555 CD 5C 65    .\e   CALL  655C       

+6558 CD CA 5C    ..\   CALL  5CCA       

+655B C9          .     RET              

+655C 7A          z     LD    A,D        

+655D FE 04       ..    CP    04         

+655F 30 02       0.    JR    NC,6563    ; Korrekte DSnr in D ? 

+6561 16 05       ..    LD    D,05       ; Nein 'errorspace' 5 

+6563 C5          .     PUSH  BC         

+6564 E5          .     PUSH  HL         

+6565 3A 1A 6E    :.n   LD    A,(6E1A)   

+6568 6F          o     LD    L,A        

+6569 7D          }     LD    A,L        

+656A 87          .     ADD   A          

+656B 8B          .     ADC   E          

+ - Fortsetzung in Datei "eumel0.prt.4" -

+

diff --git a/system/eumel0-z80/src/eumel0.prt.4 b/system/eumel0-z80/src/eumel0.prt.4
new file mode 100644
index 0000000..3eb9b03
--- /dev/null
+++ b/system/eumel0-z80/src/eumel0.prt.4
@@ -0,0 +1,4001 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT

+

+656C 8A          .     ADC   D          

+656D 8C          .     ADC   H          

+656E 4F          O     LD    C,A        

+656F 06 14       ..    LD    B,14       

+6571 0A          .     LD    A,(BC)     

+6572 4F          O     LD    C,A        

+6573 06 18       ..    LD    B,18       

+6575 0A          .     LD    A,(BC)     

+6576 BC          .     CP    H          

+6577 20 15        .    JR    NZ,658E    

+6579 05          .     DEC   B          

+657A 0A          .     LD    A,(BC)     

+657B BA          .     CP    D          

+657C 20 10        .    JR    NZ,658E    

+657E CB F9       ..    SET   7,C        

+6580 0A          .     LD    A,(BC)     

+6581 BB          .     CP    E          

+6582 20 0A        .    JR    NZ,658E    

+6584 05          .     DEC   B          

+6585 0A          .     LD    A,(BC)     

+6586 BD          .     CP    L          

+6587 20 05        .    JR    NZ,658E    

+6589 79          y     LD    A,C        

+658A 87          .     ADD   A          

+658B E1          .     POP   HL         

+658C C1          .     POP   BC         

+658D C9          .     RET              

+658E DD E5       ..    PUSH  IX         

+6590 FD E5       ..    PUSH  IY         

+6592 D5          .     PUSH  DE         

+6593 7D          }     LD    A,L        

+6594 6C          l     LD    L,H        

+6595 63          c     LD    H,E        

+6596 5A          Z     LD    E,D        

+6597 57          W     LD    D,A        

+6598 E5          .     PUSH  HL         

+6599 7B          {     LD    A,E        

+659A FE 20       .     CP    20         

+659C 38 36       86    JR    C,65D4     

+659E CD DA 66    ..f   CALL  66DA       

+65A1 D1          .     POP   DE         

+65A2 CD E1 65    ..e   CALL  65E1       

+65A5 D1          .     POP   DE         

+65A6 FD E1       ..    POP   IY         

+65A8 DD E1       ..    POP   IX         

+65AA E1          .     POP   HL         

+65AB C1          .     POP   BC         

+65AC E5          .     PUSH  HL         

+65AD C5          .     PUSH  BC         

+65AE F5          .     PUSH  AF         

+65AF 3A 1A 6E    :.n   LD    A,(6E1A)   

+65B2 6F          o     LD    L,A        

+65B3 7D          }     LD    A,L        

+65B4 87          .     ADD   A          

+65B5 8B          .     ADC   E          

+65B6 8A          .     ADC   D          

+65B7 8C          .     ADC   H          

+65B8 4F          O     LD    C,A        

+65B9 06 14       ..    LD    B,14       

+65BB F1          .     POP   AF         

+65BC F5          .     PUSH  AF         

+65BD 0F          .     RRCA             

+65BE 02          .     LD    (BC),A     

+65BF 4F          O     LD    C,A        

+65C0 06 18       ..    LD    B,18       

+65C2 7C          |     LD    A,H        

+65C3 02          .     LD    (BC),A     

+65C4 05          .     DEC   B          

+65C5 7A          z     LD    A,D        

+65C6 02          .     LD    (BC),A     

+65C7 CB F9       ..    SET   7,C        

+65C9 7B          {     LD    A,E        

+65CA 02          .     LD    (BC),A     

+65CB 05          .     DEC   B          

+65CC 7D          }     LD    A,L        

+65CD 02          .     LD    (BC),A     

+65CE F1          .     POP   AF         

+65CF C1          .     POP   BC         

+65D0 E1          .     POP   HL         

+65D1 C9          .     RET              

+65D2 F1          .     POP   AF         

+65D3 C9          .     RET              

+65D4 87          .     ADD   A          

+65D5 87          .     ADD   A          

+65D6 87          .     ADD   A          

+65D7 87          .     ADD   A          

+65D8 2A 1C 6E    *.n   LD    HL,(6E1C)  

+65DB 6F          o     LD    L,A        

+65DC 30 C3       0.    JR    NC,65A1    

+65DE 24          $     INC   H          

+65DF 18 C0       ..    JR    65A1       

+65E1 23          #     INC   HL         

+65E2 7E          ~     LD    A,(HL)     

+65E3 2B          +     DEC   HL         

+65E4 3C          <     INC   A          

+65E5 20 27        '    JR    NZ,660E    

+65E7 7A          z     LD    A,D        

+65E8 B7          .     OR    A          

+65E9 20 0C        .    JR    NZ,65F7    

+65EB 7B          {     LD    A,E        

+65EC FE 03       ..    CP    03         

+65EE 38 0E       8.    JR    C,65FE     

+65F0 96          .     SUB   (HL)       

+65F1 38 04       8.    JR    C,65F7     

+65F3 FE 05       ..    CP    05         

+65F5 38 11       8.    JR    C,6608     

+65F7 11 FF FF    ...   LD    DE,FFFF    

+65FA CD 36 6A    .6j   CALL  6A36       

+65FD C9          .     RET              

+65FE 87          .     ADD   A          

+65FF 28 F6       (.    JR    Z,65F7     

+6601 85          .     ADD   L          

+6602 6F          o     LD    L,A        

+6603 5E          ^     LD    E,(HL)     

+6604 23          #     INC   HL         

+6605 56          V     LD    D,(HL)     

+6606 18 F2       ..    JR    65FA       

+6608 87          .     ADD   A          

+6609 C6 06       ..    ADD   A,06       

+660B C3 01 66    ..f   JP    6601       

+660E 7A          z     LD    A,D        

+660F E6 07       ..    AND   07         

+6611 87          .     ADD   A          

+6612 85          .     ADD   L          

+6613 6F          o     LD    L,A        

+6614 D5          .     PUSH  DE         

+6615 5E          ^     LD    E,(HL)     

+6616 23          #     INC   HL         

+6617 56          V     LD    D,(HL)     

+6618 3E FF       >.    LD    A,FF       

+661A CD 3F 6A    .?j   CALL  6A3F       

+661D E1          .     POP   HL         

+661E CB 25       .%    SLA   L          

+6620 CE 00       ..    ADC   A,00       

+6622 67          g     LD    H,A        

+6623 5E          ^     LD    E,(HL)     

+6624 2C          ,     INC   L          

+6625 56          V     LD    D,(HL)     

+6626 CD C1 5C    ..\   CALL  5CC1       

+6629 C3 FA 65    ..e   JP    65FA       

+662C 7A          z     LD    A,D        

+662D FE 04       ..    CP    04         ; drid < 4

+662F 30 13       0.    JR    NC,6644    

+6631 CD 1F 70    ..p   CALL  701F       ; Info aufrufen 

+6634 18 0C       ..    JR    6642       

+6636 20 75        u    JR    NZ,66AD    ; " unzul. drid"

+6638 6E          n     LD    L,(HL)     

+6639 7A          z     LD    A,D        

+663A 75          u     LD    (HL),L     

+663B 6C          l     LD    L,H        

+663C 2E 20       .     LD    L,20       

+663E 64          d     LD    H,H        

+663F 72          r     LD    (HL),D     

+6640 69          i     LD    L,C        

+6641 64          d     LD    H,H        

+6642 16 05       ..    LD    D,05       

+6644 C5          .     PUSH  BC         

+6645 E5          .     PUSH  HL         

+6646 3A 1A 6E    :.n   LD    A,(6E1A)   

+6649 6F          o     LD    L,A        

+664A 7D          }     LD    A,L        

+664B 87          .     ADD   A          

+664C 8B          .     ADC   E          

+664D 8A          .     ADC   D          

+664E 8C          .     ADC   H          

+664F 4F          O     LD    C,A        

+6650 06 14       ..    LD    B,14       

+6652 0A          .     LD    A,(BC)     

+6653 4F          O     LD    C,A        

+6654 06 18       ..    LD    B,18       

+6656 0A          .     LD    A,(BC)     

+6657 BC          .     CP    H          

+6658 20 1B        .    JR    NZ,6675    

+665A 05          .     DEC   B          

+665B 0A          .     LD    A,(BC)     

+665C BA          .     CP    D          

+665D 20 16        .    JR    NZ,6675    

+665F CB F9       ..    SET   7,C        

+6661 0A          .     LD    A,(BC)     

+6662 BB          .     CP    E          

+6663 20 10        .    JR    NZ,6675    

+6665 05          .     DEC   B          

+6666 0A          .     LD    A,(BC)     

+6667 BD          .     CP    L          

+6668 20 0B        .    JR    NZ,6675    

+666A 05          .     DEC   B          

+666B 0A          .     LD    A,(BC)     

+666C CB 57       .W    BIT   2,A        

+666E 28 05       (.    JR    Z,6675     

+6670 79          y     LD    A,C        

+6671 81          .     ADD   C          

+6672 E1          .     POP   HL         

+6673 C1          .     POP   BC         

+6674 C9          .     RET              

+6675 DD E5       ..    PUSH  IX         

+6677 FD E5       ..    PUSH  IY         

+6679 D5          .     PUSH  DE         

+667A 7D          }     LD    A,L        

+667B 6C          l     LD    L,H        

+667C 63          c     LD    H,E        

+667D 5A          Z     LD    E,D        

+667E 57          W     LD    D,A        

+667F E5          .     PUSH  HL         

+6680 7B          {     LD    A,E        

+6681 FE 20       .     CP    20         

+6683 38 43       8C    JR    C,66C8     

+6685 CD DE 66    ..f   CALL  66DE       

+6688 D1          .     POP   DE         

+6689 CD 93 67    ..g   CALL  6793       

+668C 20 47        G    JR    NZ,66D5    

+668E CD 48 6A    .Hj   CALL  6A48       

+6691 F5          .     PUSH  AF         

+6692 CD C1 5C    ..\   CALL  5CC1       

+6695 F1          .     POP   AF         

+6696 D1          .     POP   DE         

+6697 FD E1       ..    POP   IY         

+6699 DD E1       ..    POP   IX         

+669B E1          .     POP   HL         

+669C C1          .     POP   BC         

+669D E5          .     PUSH  HL         

+669E C5          .     PUSH  BC         

+669F F5          .     PUSH  AF         

+66A0 3A 1A 6E    :.n   LD    A,(6E1A)   

+66A3 6F          o     LD    L,A        

+66A4 7D          }     LD    A,L        

+66A5 87          .     ADD   A          

+66A6 8B          .     ADC   E          

+66A7 8A          .     ADC   D          

+66A8 8C          .     ADC   H          

+66A9 4F          O     LD    C,A        

+66AA 06 14       ..    LD    B,14       

+66AC F1          .     POP   AF         

+66AD F5          .     PUSH  AF         

+66AE 0F          .     RRCA             

+66AF 02          .     LD    (BC),A     

+66B0 4F          O     LD    C,A        

+66B1 06 18       ..    LD    B,18       

+66B3 7C          |     LD    A,H        

+66B4 02          .     LD    (BC),A     

+66B5 05          .     DEC   B          

+66B6 7A          z     LD    A,D        

+66B7 02          .     LD    (BC),A     

+66B8 CB F9       ..    SET   7,C        

+66BA 7B          {     LD    A,E        

+66BB 02          .     LD    (BC),A     

+66BC 05          .     DEC   B          

+66BD 7D          }     LD    A,L        

+66BE 02          .     LD    (BC),A     

+66BF 05          .     DEC   B          

+66C0 0A          .     LD    A,(BC)     

+66C1 F6 0C       ..    OR    0C         

+66C3 02          .     LD    (BC),A     

+66C4 F1          .     POP   AF         

+66C5 C1          .     POP   BC         

+66C6 E1          .     POP   HL         

+66C7 C9          .     RET              

+66C8 87          .     ADD   A          

+66C9 87          .     ADD   A          

+66CA 87          .     ADD   A          

+66CB 87          .     ADD   A          

+66CC 2A 1C 6E    *.n   LD    HL,(6E1C)  

+66CF 6F          o     LD    L,A        

+66D0 30 B3       0.    JR    NC,6685    

+66D2 24          $     INC   H          

+66D3 18 B0       ..    JR    6685       

+66D5 CD 35 68    .5h   CALL  6835       

+66D8 18 6A       .j    JR    6744       

+66DA 3E 00       >.    LD    A,00       

+66DC 18 02       ..    JR    66E0       

+66DE 3E 01       >.    LD    A,01       

+66E0 32 12 6B    2.k   LD    (6B12),A   

+66E3 7B          {     LD    A,E        

+66E4 FE 20       .     CP    20         

+66E6 30 1D       0.    JR    NC,6705    

+66E8 6A          j     LD    L,D        

+66E9 26 14       &.    LD    H,14       

+66EB 6E          n     LD    L,(HL)     

+66EC 26 17       &.    LD    H,17       

+66EE 7E          ~     LD    A,(HL)     

+66EF B7          .     OR    A          

+66F0 20 13        .    JR    NZ,6705    

+66F2 25          %     DEC   H          

+66F3 CB FD       ..    SET   7,L        

+66F5 7E          ~     LD    A,(HL)     

+66F6 BA          .     CP    D          

+66F7 20 0C        .    JR    NZ,6705    

+66F9 25          %     DEC   H          

+66FA CB 56       .V    BIT   2,(HL)     

+66FC 28 07       (.    JR    Z,6705     

+66FE CB DE       ..    SET   3,(HL)     

+6700 7D          }     LD    A,L        

+6701 87          .     ADD   A          

+6702 6B          k     LD    L,E        

+6703 18 6C       .l    JR    6771       

+6705 21 2B 1E    !+.   LD    HL,1E2B    

+6708 D5          .     PUSH  DE         

+6709 CB 3A       .:    SLR   D          

+670B CB 1B       ..    RR    E          

+670D CB 3A       .:    SLR   D          

+670F CB 1B       ..    RR    E          

+6711 CB 3A       .:    SLR   D          

+6713 CB 1B       ..    RR    E          

+6715 CB 3A       .:    SLR   D          

+6717 CB 1B       ..    RR    E          

+6719 CB 3A       .:    SLR   D          

+671B CB 1B       ..    RR    E          

+671D 3A 12 6B    :.k   LD    A,(6B12)   

+6720 B7          .     OR    A          

+6721 28 27       ('    JR    Z,674A     

+6723 CD 93 67    ..g   CALL  6793       

+6726 28 27       ('    JR    Z,674F     

+6728 CD 35 68    .5h   CALL  6835       

+672B D1          .     POP   DE         

+672C 7A          z     LD    A,D        

+672D B7          .     OR    A          

+672E 28 14       (.    JR    Z,6744     

+6730 2E 00       ..    LD    L,00       

+6732 06 20       .     LD    B,20       

+6734 7B          {     LD    A,E        

+6735 FE 20       .     CP    20         

+6737 30 04       0.    JR    NC,673D    

+6739 2E 40       .@    LD    L,40       

+673B 06 1C       ..    LD    B,1C       

+673D C5          .     PUSH  BC         

+673E CD 80 67    ..g   CALL  6780       

+6741 C1          .     POP   BC         

+6742 10 F9       ..    DJNZ  673D       

+6744 21 00 00    !..   LD    HL,0000    

+6747 C3 1A 6C    ..l   JP    6C1A       

+674A CD E1 65    ..e   CALL  65E1       

+674D 18 03       ..    JR    6752       

+674F CD 48 6A    .Hj   CALL  6A48       

+6752 E1          .     POP   HL         

+6753 F5          .     PUSH  AF         

+6754 7D          }     LD    A,L        

+6755 FE 20       .     CP    20         

+6757 30 17       0.    JR    NC,6770    

+6759 F1          .     POP   AF         

+675A F5          .     PUSH  AF         

+675B E5          .     PUSH  HL         

+675C CB 3F       .?    SLR   A          

+675E 6F          o     LD    L,A        

+675F 54          T     LD    D,H        

+6760 26 17       &.    LD    H,17       

+6762 36 00       6.    LD    (HL),00    

+6764 25          %     DEC   H          

+6765 CB FD       ..    SET   7,L        

+6767 72          r     LD    (HL),D     

+6768 25          %     DEC   H          

+6769 CB D6       ..    SET   2,(HL)     

+676B 26 14       &.    LD    H,14       

+676D 6A          j     LD    L,D        

+676E 77          w     LD    (HL),A     

+676F E1          .     POP   HL         

+6770 F1          .     POP   AF         

+6771 CB 25       .%    SLA   L          

+6773 CB 25       .%    SLA   L          

+6775 CB 25       .%    SLA   L          

+6777 CB 25       .%    SLA   L          

+6779 CE 00       ..    ADC   A,00       

+677B 67          g     LD    H,A        

+677C CD C1 5C    ..\   CALL  5CC1       

+677F C9          .     RET              

+6780 06 08       ..    LD    B,08       

+6782 23          #     INC   HL         

+6783 7E          ~     LD    A,(HL)     

+6784 2B          +     DEC   HL         

+6785 FE FF       ..    CP    FF         

+6787 20 03        .    JR    NZ,678C    

+6789 23          #     INC   HL         

+678A 23          #     INC   HL         

+678B 05          .     DEC   B          

+678C CB C6       ..    SET   0,(HL)     

+678E 23          #     INC   HL         

+678F 23          #     INC   HL         

+6790 10 FA       ..    DJNZ  678C       

+6792 C9          .     RET              

+6793 23          #     INC   HL         

+6794 7E          ~     LD    A,(HL)     

+6795 2B          +     DEC   HL         

+6796 3C          <     INC   A          

+6797 C2 0A 68    ..h   JP    NZ,680A    

+679A 7A          z     LD    A,D        

+679B B7          .     OR    A          

+679C 20 1B        .    JR    NZ,67B9    

+679E 7B          {     LD    A,E        

+679F FE 03       ..    CP    03         

+67A1 DA 01 68    ..h   JP    C,6801     

+67A4 7E          ~     LD    A,(HL)     

+67A5 3C          <     INC   A          

+67A6 20 08        .    JR    NZ,67B0    

+67A8 7B          {     LD    A,E        

+67A9 FE FB       ..    CP    FB         

+67AB 38 02       8.    JR    C,67AF     

+67AD 3E FB       >.    LD    A,FB       

+67AF 77          w     LD    (HL),A     

+67B0 7B          {     LD    A,E        

+67B1 96          .     SUB   (HL)       

+67B2 38 05       8.    JR    C,67B9     

+67B4 FE 05       ..    CP    05         

+67B6 DA FC 67    ..g   JP    C,67FC     

+67B9 E5          .     PUSH  HL         

+67BA 21 13 6B    !.k   LD    HL,6B13    

+67BD CD 35 68    .5h   CALL  6835       

+67C0 7C          |     LD    A,H        

+67C1 ED 5B 13 6B .[.k  LD    DE,(6B13)  

+67C5 21 FF FF    !..   LD    HL,FFFF    

+67C8 22 13 6B    ".k   LD    (6B13),HL  

+67CB E1          .     POP   HL         

+67CC 46          F     LD    B,(HL)     

+67CD 73          s     LD    (HL),E     

+67CE 23          #     INC   HL         

+67CF 72          r     LD    (HL),D     

+67D0 57          W     LD    D,A        

+67D1 1E 02       ..    LD    E,02       

+67D3 23          #     INC   HL         

+67D4 78          x     LD    A,B        

+67D5 01 04 00    ...   LD    BC,0004    

+67D8 ED B0       ..    LDIR             

+67DA 01 0A 00    ...   LD    BC,000A    

+67DD 5F          _     LD    E,A        

+67DE 3C          <     INC   A          

+67DF 20 03        .    JR    NZ,67E4    

+67E1 09          .     ADD   HL,BC      

+67E2 18 08       ..    JR    67EC       

+67E4 7A          z     LD    A,D        

+67E5 CB 23       .#    SLA   E          

+67E7 CE 00       ..    ADC   A,00       

+67E9 57          W     LD    D,A        

+67EA ED B0       ..    LDIR             

+67EC 2B          +     DEC   HL         

+67ED 01 0D 00    ...   LD    BC,000D    

+67F0 54          T     LD    D,H        

+67F1 5D          ]     LD    E,L        

+67F2 1B          .     DEC   DE         

+67F3 36 FF       6.    LD    (HL),FF    

+67F5 ED B8       ..    LDDR             

+67F7 36 01       6.    LD    (HL),01    

+67F9 C3 44 67    .Dg   JP    6744       

+67FC 87          .     ADD   A          

+67FD C6 06       ..    ADD   A,06       

+67FF 18 04       ..    JR    6805       

+6801 87          .     ADD   A          

+6802 CA B9 67    ..g   JP    Z,67B9     

+6805 85          .     ADD   L          

+6806 6F          o     LD    L,A        

+6807 CB 46       .F    BIT   0,(HL)     

+6809 C9          .     RET              

+680A D5          .     PUSH  DE         

+680B 7A          z     LD    A,D        

+680C E6 07       ..    AND   07         

+680E CB 27       .'    SLA   A          

+6810 85          .     ADD   L          

+6811 6F          o     LD    L,A        

+6812 CB 46       .F    BIT   0,(HL)     

+6814 20 11        .    JR    NZ,6827    

+6816 5E          ^     LD    E,(HL)     

+6817 2C          ,     INC   L          

+6818 56          V     LD    D,(HL)     

+6819 3E FD       >.    LD    A,FD       

+681B CD 3F 6A    .?j   CALL  6A3F       

+681E E1          .     POP   HL         

+681F CB 25       .%    SLA   L          

+6821 CE 00       ..    ADC   A,00       

+6823 67          g     LD    H,A        

+6824 CB 46       .F    BIT   0,(HL)     

+6826 C9          .     RET              

+6827 CD 35 68    .5h   CALL  6835       

+682A 06 00       ..    LD    B,00       

+682C CB C6       ..    SET   0,(HL)     

+682E 23          #     INC   HL         

+682F 23          #     INC   HL         

+6830 10 FA       ..    DJNZ  682C       

+6832 C3 44 67    .Dg   JP    6744       

+6835 5E          ^     LD    E,(HL)     

+6836 23          #     INC   HL         

+6837 56          V     LD    D,(HL)     

+6838 2B          +     DEC   HL         

+6839 E5          .     PUSH  HL         

+683A CD 41 5D    .A]   CALL  5D41       

+683D E5          .     PUSH  HL         

+683E CB FD       ..    SET   7,L        

+6840 CB 96       ..    RES   2,(HL)     

+6842 CB 4E       .N    BIT   1,(HL)     

+6844 28 28       ((    JR    Z,686E     

+6846 24          $     INC   H          

+6847 36 FF       6.    LD    (HL),FF    

+6849 CD 4E 55    .NU   CALL  554E       

+684C C1          .     POP   BC         

+684D D1          .     POP   DE         

+684E EB          .     EX    DE,HL      

+684F CB 83       ..    RES   0,E        

+6851 73          s     LD    (HL),E     

+6852 23          #     INC   HL         

+6853 72          r     LD    (HL),D     

+6854 2B          +     DEC   HL         

+6855 6C          l     LD    L,H        

+6856 26 15       &.    LD    H,15       

+6858 37          7     SCF              

+6859 CB 1D       ..    RR    L          

+685B CB 8E       ..    RES   1,(HL)     

+685D 60          `     LD    H,B        

+685E 69          i     LD    L,C        

+685F 73          s     LD    (HL),E     

+6860 CB FD       ..    SET   7,L        

+6862 CB 8E       ..    RES   1,(HL)     

+6864 24          $     INC   H          

+6865 CB BD       ..    RES   7,L        

+6867 72          r     LD    (HL),D     

+6868 65          e     LD    H,L        

+6869 CB 24       .$    SLA   H          

+686B 2E 00       ..    LD    L,00       

+686D C9          .     RET              

+686E 24          $     INC   H          

+686F 36 FF       6.    LD    (HL),FF    

+6871 11 F0 FF    ...   LD    DE,FFF0    

+6874 CD 41 5D    .A]   CALL  5D41       

+6877 C1          .     POP   BC         

+6878 E5          .     PUSH  HL         

+6879 55          U     LD    D,L        

+687A 1E 00       ..    LD    E,00       

+687C 61          a     LD    H,C        

+687D 2E 00       ..    LD    L,00       

+687F 01 00 02    ...   LD    BC,0200    

+6882 CB 24       .$    SLA   H          

+6884 CB 22       ."    SLA   D          

+6886 CD A5 28    ..(   CALL  28A5       

+6889 18 BE       ..    JR    6849       

+688B B7          .     OR    A          

+688C C8          .     RET   Z          

+688D CD 2F 64    ./d   CALL  642F       

+6890 CD 20 6E    . n   CALL  6E20       

+6893 CD 74 6D    .tm   CALL  6D74       

+6896 F5          .     PUSH  AF         

+6897 1F          .     RRA              

+6898 1F          .     RRA              

+6899 1F          .     RRA              

+689A 1F          .     RRA              

+689B E6 06       ..    AND   06         

+689D 21 2B 1E    !+.   LD    HL,1E2B    

+68A0 85          .     ADD   L          

+68A1 6F          o     LD    L,A        

+68A2 5E          ^     LD    E,(HL)     

+68A3 23          #     INC   HL         

+68A4 56          V     LD    D,(HL)     

+68A5 CD 4E 6A    .Nj   CALL  6A4E       

+68A8 67          g     LD    H,A        

+68A9 F1          .     POP   AF         

+68AA E5          .     PUSH  HL         

+68AB 21 80 16    !..   LD    HL,1680    

+68AE 01 81 00    ...   LD    BC,0081    

+68B1 ED B1       ..    CPIR             

+68B3 E2 BC 68    ..h   JP    PO,68BC    

+68B6 2B          +     DEC   HL         

+68B7 36 FF       6.    LD    (HL),FF    

+68B9 23          #     INC   HL         

+68BA 18 F5       ..    JR    68B1       

+68BC E1          .     POP   HL         

+68BD CB 27       .'    SLA   A          

+68BF CB 27       .'    SLA   A          

+68C1 CB 27       .'    SLA   A          

+68C3 CB 27       .'    SLA   A          

+68C5 6F          o     LD    L,A        

+68C6 30 01       0.    JR    NC,68C9    

+68C8 24          $     INC   H          

+68C9 36 FF       6.    LD    (HL),FF    

+68CB 54          T     LD    D,H        

+68CC 5D          ]     LD    E,L        

+68CD 13          .     INC   DE         

+68CE 01 0F 00    ...   LD    BC,000F    

+68D1 ED B0       ..    LDIR             

+68D3 CD DA 68    ..h   CALL  68DA       

+68D6 CD 2A 6E    .*n   CALL  6E2A       

+68D9 C9          .     RET              

+68DA 3A 13 57    :.W   LD    A,(5713)   

+68DD B7          .     OR    A          

+68DE C8          .     RET   Z          

+68DF 21 17 82    !..   LD    HL,8217    

+68E2 CB C6       ..    SET   0,(HL)     

+68E4 C9          .     RET              

+68E5 7A          z     LD    A,D        

+68E6 18 02       ..    JR    68EA       

+68E8 3E FF       >.    LD    A,FF       

+68EA 32 16 6B    2.k   LD    (6B16),A   

+68ED E5          .     PUSH  HL         

+68EE C5          .     PUSH  BC         

+68EF 1E 04       ..    LD    E,04       

+68F1 D5          .     PUSH  DE         

+68F2 CD DA 66    ..f   CALL  66DA       

+68F5 D1          .     POP   DE         

+68F6 23          #     INC   HL         

+68F7 7E          ~     LD    A,(HL)     

+68F8 23          #     INC   HL         

+68F9 A6          .     AND   (HL)       

+68FA 23          #     INC   HL         

+68FB A6          .     AND   (HL)       

+68FC 3C          <     INC   A          

+68FD 28 06       (.    JR    Z,6905     

+68FF 1C          .     INC   E          

+6900 20 EF        .    JR    NZ,68F1    

+6902 C1          .     POP   BC         

+6903 E1          .     POP   HL         

+6904 C9          .     RET              

+6905 D5          .     PUSH  DE         

+6906 CD DE 66    ..f   CALL  66DE       

+6909 E5          .     PUSH  HL         

+690A 50          P     LD    D,B        

+690B 59          Y     LD    E,C        

+690C 7B          {     LD    A,E        

+690D B7          .     OR    A          

+690E 28 0A       (.    JR    Z,691A     

+6910 CD DE 66    ..f   CALL  66DE       

+6913 E5          .     PUSH  HL         

+6914 CD 30 80    .0.   CALL  8030       

+6917 E1          .     POP   HL         

+6918 18 03       ..    JR    691D       

+691A 21 26 6A    !&j   LD    HL,6A26    

+691D 3A 16 6B    :.k   LD    A,(6B16)   

+6920 3C          <     INC   A          

+6921 20 05        .    JR    NZ,6928    

+6923 E5          .     PUSH  HL         

+6924 CD 80 67    ..g   CALL  6780       

+6927 E1          .     POP   HL         

+6928 D1          .     POP   DE         

+6929 01 10 00    ...   LD    BC,0010    

+692C ED B0       ..    LDIR             

+692E 3A 16 6B    :.k   LD    A,(6B16)   

+6931 3C          <     INC   A          

+6932 28 0B       (.    JR    Z,693F     

+6934 01 0F 00    ...   LD    BC,000F    

+6937 2B          +     DEC   HL         

+6938 36 FF       6.    LD    (HL),FF    

+693A 54          T     LD    D,H        

+693B 5D          ]     LD    E,L        

+693C 1B          .     DEC   DE         

+693D ED B8       ..    LDDR             

+693F D1          .     POP   DE         

+6940 3E FF       >.    LD    A,FF       

+6942 CD 53 69    .Si   CALL  6953       

+6945 C1          .     POP   BC         

+6946 D5          .     PUSH  DE         

+6947 59          Y     LD    E,C        

+6948 50          P     LD    D,B        

+6949 3E FF       >.    LD    A,FF       

+694B CD 53 69    .Si   CALL  6953       

+694E 42          B     LD    B,D        

+694F 4B          K     LD    C,E        

+6950 D1          .     POP   DE         

+6951 E1          .     POP   HL         

+6952 C9          .     RET              

+6953 21 00 17    !..   LD    HL,1700    

+6956 01 81 00    ...   LD    BC,0081    

+6959 F5          .     PUSH  AF         

+695A 7B          {     LD    A,E        

+695B ED B1       ..    CPIR             

+695D E2 75 69    .ui   JP    PO,6975    

+6960 2B          +     DEC   HL         

+6961 25          %     DEC   H          

+6962 CB FD       ..    SET   7,L        

+6964 7A          z     LD    A,D        

+6965 BE          .     CP    (HL)       

+6966 20 07        .    JR    NZ,696F    

+6968 F1          .     POP   AF         

+6969 77          w     LD    (HL),A     

+696A F5          .     PUSH  AF         

+696B 25          %     DEC   H          

+696C CB 96       ..    RES   2,(HL)     

+696E 24          $     INC   H          

+696F CB BD       ..    RES   7,L        

+6971 24          $     INC   H          

+6972 23          #     INC   HL         

+6973 18 E5       ..    JR    695A       

+6975 F1          .     POP   AF         

+6976 C9          .     RET              

+6977 79          y     LD    A,C        

+6978 FE 04       ..    CP    04         

+697A D8          .     RET   C          

+697B D5          .     PUSH  DE         

+697C E5          .     PUSH  HL         

+697D C5          .     PUSH  BC         

+697E 59          Y     LD    E,C        

+697F 3A 1A 6E    :.n   LD    A,(6E1A)   

+6982 57          W     LD    D,A        

+6983 CD DA 66    ..f   CALL  66DA       

+6986 23          #     INC   HL         

+6987 7E          ~     LD    A,(HL)     

+6988 23          #     INC   HL         

+6989 A6          .     AND   (HL)       

+698A 23          #     INC   HL         

+698B A6          .     AND   (HL)       

+698C 3C          <     INC   A          

+698D 28 05       (.    JR    Z,6994     

+698F B7          .     OR    A          

+6990 C1          .     POP   BC         

+6991 E1          .     POP   HL         

+6992 D1          .     POP   DE         

+6993 C9          .     RET              

+6994 37          7     SCF              

+6995 18 F9       ..    JR    6990       

+6997 D5          .     PUSH  DE         

+6998 E5          .     PUSH  HL         

+6999 C5          .     PUSH  BC         

+699A 79          y     LD    A,C        

+699B FE 04       ..    CP    04         

+699D 38 F1       8.    JR    C,6990     

+699F 3A 1A 6E    :.n   LD    A,(6E1A)   

+69A2 57          W     LD    D,A        

+69A3 59          Y     LD    E,C        

+69A4 CD DE 66    ..f   CALL  66DE       

+69A7 54          T     LD    D,H        

+69A8 5D          ]     LD    E,L        

+69A9 13          .     INC   DE         

+69AA 01 0F 00    ...   LD    BC,000F    

+69AD 36 FF       6.    LD    (HL),FF    

+69AF ED B0       ..    LDIR             

+69B1 CD DA 68    ..h   CALL  68DA       

+69B4 18 DA       ..    JR    6990       

+69B6 78          x     LD    A,B        

+69B7 B7          .     OR    A          

+69B8 C8          .     RET   Z          

+69B9 85          .     ADD   L          

+69BA DC 0B 6A    ..j   CALL  C,6A0B     

+69BD 78          x     LD    A,B        

+69BE 83          .     ADD   E          

+69BF DC 0B 6A    ..j   CALL  C,6A0B     

+69C2 CD 20 6E    . n   CALL  6E20       

+69C5 C5          .     PUSH  BC         

+69C6 E5          .     PUSH  HL         

+69C7 D5          .     PUSH  DE         

+69C8 3A 1A 6E    :.n   LD    A,(6E1A)   

+69CB 57          W     LD    D,A        

+69CC 59          Y     LD    E,C        

+69CD 3E FF       >.    LD    A,FF       

+69CF CD 53 69    .Si   CALL  6953       

+69D2 CD DE 66    ..f   CALL  66DE       

+69D5 2C          ,     INC   L          

+69D6 7E          ~     LD    A,(HL)     

+69D7 2D          -     DEC   L          

+69D8 3C          <     INC   A          

+69D9 28 31       (1    JR    Z,6A0C     

+69DB D1          .     POP   DE         

+69DC E5          .     PUSH  HL         

+69DD CD 93 67    ..g   CALL  6793       

+69E0 CD 1A 6A    ..j   CALL  6A1A       

+69E3 D1          .     POP   DE         

+69E4 E3          .     EX    (SP),HL    

+69E5 EB          .     EX    DE,HL      

+69E6 CD 93 67    ..g   CALL  6793       

+69E9 CD 1A 6A    ..j   CALL  6A1A       

+69EC D1          .     POP   DE         

+69ED C1          .     POP   BC         

+69EE C5          .     PUSH  BC         

+69EF E5          .     PUSH  HL         

+69F0 CB C6       ..    SET   0,(HL)     

+69F2 2C          ,     INC   L          

+69F3 2C          ,     INC   L          

+69F4 10 FA       ..    DJNZ  69F0       

+69F6 E1          .     POP   HL         

+69F7 C1          .     POP   BC         

+69F8 48          H     LD    C,B        

+69F9 CB 21       .!    SLA   C          

+69FB 06 00       ..    LD    B,00       

+69FD CB 10       ..    RL    B          

+69FF CD 14 80    ...   CALL  8014       

+6A02 ED B0       ..    LDIR             

+6A04 CD C1 5C    ..\   CALL  5CC1       

+6A07 CD 2A 6E    .*n   CALL  6E2A       

+6A0A C9          .     RET              

+6A0B C8          .     RET   Z          

+6A0C CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6A0F 18 07       ..    JR    6A18       

+6A11 20 73        s    JR    NZ,6A86    ; " spmove"

+6A13 70          p     LD    (HL),B     

+6A14 6D          m     LD    L,L        

+6A15 6F          o     LD    L,A        

+6A16 76          v     HALT             

+6A17 65          e     LD    H,L        

+6A18 18 F2       ..    JR    6A0C       

+6A1A 1F          .     RRA              

+6A1B CB 1D       ..    RR    L          

+6A1D CD 4E 6A    .Nj   CALL  6A4E       

+6A20 CB 25       .%    SLA   L          

+6A22 CE 00       ..    ADC   A,00       

+6A24 67          g     LD    H,A        

+6A25 C9          .     RET              

+6A26 FF          .     RST   38         ; nilspace-Eintrag

+6A27 FF          .     RST   38         

+6A28 01 FF FF    ...   LD    BC,FFFF    

+6A2B FF          .     RST   38         

+6A2C FF          .     RST   38         

+6A2D FF          .     RST   38         

+6A2E FF          .     RST   38         

+6A2F FF          .     RST   38         

+6A30 FF          .     RST   38         

+6A31 FF          .     RST   38         

+6A32 FF          .     RST   38         

+6A33 FF          .     RST   38         

+6A34 FF          .     RST   38         

+6A35 FF          .     RST   38         

+6A36 E5          .     PUSH  HL         

+6A37 CD 41 5D    .A]   CALL  5D41       

+6A3A 7D          }     LD    A,L        

+6A3B CB 27       .'    SLA   A          

+6A3D E1          .     POP   HL         

+6A3E C9          .     RET              

+6A3F E5          .     PUSH  HL         

+6A40 CD 3E 5D    .>]   CALL  5D3E       

+6A43 CB 25       .%    SLA   L          

+6A45 7D          }     LD    A,L        

+6A46 E1          .     POP   HL         

+6A47 C9          .     RET              

+6A48 E5          .     PUSH  HL         

+6A49 5E          ^     LD    E,(HL)     

+6A4A 23          #     INC   HL         

+6A4B 56          V     LD    D,(HL)     

+6A4C 18 01       ..    JR    6A4F       

+6A4E E5          .     PUSH  HL         

+6A4F CD 41 5D    .A]   CALL  5D41       

+6A52 CB FD       ..    SET   7,L        

+6A54 CB 8E       ..    RES   1,(HL)     

+6A56 7D          }     LD    A,L        

+6A57 CB 27       .'    SLA   A          

+6A59 E1          .     POP   HL         

+6A5A C9          .     RET              

+6A5B 7A          z     LD    A,D        

+6A5C FE 04       ..    CP    04         

+6A5E 38 19       8.    JR    C,6A79     

+6A60 23          #     INC   HL         

+6A61 7C          |     LD    A,H        

+6A62 FE 08       ..    CP    08         

+6A64 30 13       0.    JR    NC,6A79    

+6A66 E5          .     PUSH  HL         

+6A67 D5          .     PUSH  DE         

+6A68 5C          \     LD    E,H        

+6A69 65          e     LD    H,L        

+6A6A CD 5C 65    .\e   CALL  655C       

+6A6D CB 3F       .?    SLR   A          

+6A6F 6F          o     LD    L,A        

+6A70 26 16       &.    LD    H,16       

+6A72 7E          ~     LD    A,(HL)     

+6A73 3C          <     INC   A          

+6A74 D1          .     POP   DE         

+6A75 E1          .     POP   HL         

+6A76 28 E8       (.    JR    Z,6A60     

+6A78 C9          .     RET              

+6A79 21 FF FF    !..   LD    HL,FFFF    

+6A7C C9          .     RET              

+6A7D 7B          {     LD    A,E        

+6A7E FE 04       ..    CP    04         

+6A80 38 26       8&    JR    C,6AA8     

+6A82 E5          .     PUSH  HL         

+6A83 C5          .     PUSH  BC         

+6A84 D5          .     PUSH  DE         

+6A85 CD DA 66    ..f   CALL  66DA       

+6A88 D1          .     POP   DE         

+6A89 23          #     INC   HL         

+6A8A 23          #     INC   HL         

+6A8B 7E          ~     LD    A,(HL)     

+6A8C 23          #     INC   HL         

+6A8D A6          .     AND   (HL)       

+6A8E 3C          <     INC   A          

+6A8F 28 1B       (.    JR    Z,6AAC     

+6A91 2B          +     DEC   HL         

+6A92 2B          +     DEC   HL         

+6A93 7E          ~     LD    A,(HL)     

+6A94 3C          <     INC   A          

+6A95 20 1A        .    JR    NZ,6AB1    

+6A97 06 07       ..    LD    B,07       

+6A99 11 00 00    ...   LD    DE,0000    

+6A9C 2C          ,     INC   L          

+6A9D 2C          ,     INC   L          

+6A9E 7E          ~     LD    A,(HL)     

+6A9F 3C          <     INC   A          

+6AA0 28 01       (.    JR    Z,6AA3     

+6AA2 1C          .     INC   E          

+6AA3 10 F7       ..    DJNZ  6A9C       

+6AA5 C1          .     POP   BC         

+6AA6 E1          .     POP   HL         

+6AA7 C9          .     RET              

+6AA8 11 FF FF    ...   LD    DE,FFFF    

+6AAB C9          .     RET              

+6AAC 11 FF FF    ...   LD    DE,FFFF    

+6AAF 18 F4       ..    JR    6AA5       

+6AB1 06 08       ..    LD    B,08       

+6AB3 FD E5       ..    PUSH  IY         

+6AB5 FD 21 00 00 .!..  LD    IY,0000    

+6AB9 C5          .     PUSH  BC         

+6ABA D5          .     PUSH  DE         

+6ABB CD DA 66    ..f   CALL  66DA       

+6ABE 78          x     LD    A,B        

+6ABF 3D          =     DEC   A          

+6AC0 87          .     ADD   A          

+6AC1 B5          .     OR    L          

+6AC2 6F          o     LD    L,A        

+6AC3 5E          ^     LD    E,(HL)     

+6AC4 2C          ,     INC   L          

+6AC5 56          V     LD    D,(HL)     

+6AC6 14          .     INC   D          

+6AC7 28 23       (#    JR    Z,6AEC     

+6AC9 15          .     DEC   D          

+6ACA 3E FF       >.    LD    A,FF       

+6ACC CD 3F 6A    .?j   CALL  6A3F       

+6ACF 67          g     LD    H,A        

+6AD0 2E 00       ..    LD    L,00       

+6AD2 06 00       ..    LD    B,00       

+6AD4 23          #     INC   HL         

+6AD5 7E          ~     LD    A,(HL)     

+6AD6 23          #     INC   HL         

+6AD7 3C          <     INC   A          

+6AD8 28 02       (.    JR    Z,6ADC     

+6ADA FD 23       .#    INC   IY         

+6ADC 10 F6       ..    DJNZ  6AD4       

+6ADE CD C1 5C    ..\   CALL  5CC1       

+6AE1 D1          .     POP   DE         

+6AE2 C1          .     POP   BC         

+6AE3 10 D4       ..    DJNZ  6AB9       

+6AE5 FD E5       ..    PUSH  IY         

+6AE7 D1          .     POP   DE         

+6AE8 FD E1       ..    POP   IY         

+6AEA 18 B9       ..    JR    6AA5       

+6AEC D1          .     POP   DE         

+6AED C1          .     POP   BC         

+6AEE 2D          -     DEC   L          

+6AEF 2D          -     DEC   L          

+6AF0 7E          ~     LD    A,(HL)     

+6AF1 3C          <     INC   A          

+6AF2 20 EF        .    JR    NZ,6AE3    

+6AF4 05          .     DEC   B          

+6AF5 18 F7       ..    JR    6AEE       

+6AF7 45          E     LD    B,L        ; "EUMEL-000"

+6AF8 55          U     LD    D,L        

+6AF9 4D          M     LD    C,L        

+6AFA 45          E     LD    B,L        

+6AFB 4C          L     LD    C,H        

+6AFC 2D          -     DEC   L          

+6AFD 30 30       00    JR    NC,6B2F    

+6AFF 30 11       0.    JR    NC,6B12    

+6B01 20 20             JR    NZ,6B23    ; "  *** RERUN ***CRLF"

+6B03 2A 2A 2A    ***   LD    HL,(2A2A)  

+6B06 20 52        R    JR    NZ,6B5A    

+6B08 45          E     LD    B,L        

+6B09 52          R     LD    D,D        

+6B0A 55          U     LD    D,L        

+6B0B 4E          N     LD    C,(HL)     

+6B0C 20 2A        *    JR    NZ,6B38    

+6B0E 2A 2A 0A    **.   LD    HL,(0A2A)  

+6B11 0D          .     DEC   C          

+6B12 01 FF FF    ...   LD    BC,FFFF    

+6B15 01 FF 

+6B17 FF FF                              ; session

+6B19 78          x     LD    A,B        

+6B1A 13          .     INC   DE         

+6B1B 20 53        S    JR    NZ,6B70    ; " System aufgebaut."

+6B1D 79          y     LD    A,C        

+6B1E 73          s     LD    (HL),E     

+6B1F 74          t     LD    (HL),H     

+6B20 65          e     LD    H,L        

+6B21 6D          m     LD    L,L        

+6B22 20 61        a    JR    NZ,6B85    

+6B24 75          u     LD    (HL),L     

+6B25 66          f     LD    H,(HL)     

+6B26 67          g     LD    H,A        

+6B27 65          e     LD    H,L        

+6B28 62          b     LD    H,D        

+6B29 61          a     LD    H,C        

+6B2A 75          u     LD    (HL),L     

+6B2B 74          t     LD    (HL),H     

+6B2C 2E 20       .     LD    L,20       

+6B2E 31 37 35    175   LD    SP,3537    ; "175 restart   2 (!)"

+6B31 20 72        r    JR    NZ,6BA5    

+6B33 65          e     LD    H,L        

+6B34 73          s     LD    (HL),E     

+6B35 74          t     LD    (HL),H     

+6B36 61          a     LD    H,C        

+6B37 72          r     LD    (HL),D     

+6B38 74          t     LD    (HL),H     

+6B39 20 20             JR    NZ,6B5B    

+6B3B 20 32        2    JR    NZ,6B6F    

+6B3D 20 28        (    JR    NZ,6B67    

+6B3F 21 29 

+6B41 ED 5B 46 6C       LD    DE,(6C46)

+6B45 ED 53 F7 6E .S.n  LD    (6EF7),DE  

+6B49 11 13 6C    ..l   LD    DE,6C13    

+6B4C ED 53 46 6C .SFl  LD    (6C46),DE  

+6B50 ED 73 F2 6E .s.n  LD    (6EF2),SP  

+6B54 3A F0 6E    :.n   LD    A,(6EF0)   

+6B57 B7          .     OR    A          

+6B58 28 21       (!    JR    Z,6B7B     

+6B5A 06 00       ..    LD    B,00       

+6B5C 97          .     SUB   A          

+6B5D 32 F0 6E    2.n   LD    (6EF0),A   

+6B60 CD 98 6E    ..n   CALL  6E98       

+6B63 FE 69       .i    CP    69         ; "i" und Info-Taste

+6B65 28 09       (.    JR    Z,6B70     

+6B67 C5          .     PUSH  BC         

+6B68 CD E2 6D    ..m   CALL  6DE2       

+6B6B C1          .     POP   BC         

+6B6C 10 EE       ..    DJNZ  6B5C       

+6B6E 18 0B       ..    JR    6B7B       ; Info aufrufen

+6B70 CD 1F 70    ..p   CALL  701F       ; "-break"

+6B73 18 06       ..    JR    6B7B       

+6B75 2D          -     DEC   L          

+6B76 62          b     LD    H,D        

+6B77 72          r     LD    (HL),D     

+6B78 65          e     LD    H,L        

+6B79 61          a     LD    H,C        

+6B7A 6B          k     LD    L,E        

+6B7B CD 9C 4B    ..K   CALL  4B9C       

+6B7E 97          .     SUB   A          

+6B7F 32 F6 6E    2.n   LD    (6EF6),A   

+6B82 2A 1A 6E    *.n   LD    HL,(6E1A)  ; Aktuelle Task

+6B85 CB FD       ..    SET   7,L        

+6B87 2C          ,     INC   L          ; N�echste Task

+6B88 01 FF FF    ...   LD    BC,FFFF    ; unendlich

+6B8B 3E 01       >.    LD    A,01       ; aktive Task suchen

+6B8D ED B1       ..    CPIR             

+6B8F CB 7D       .}    BIT   7,L

+6B91 20 0E        .    JR    NZ,6BA1    ; 01 gefunden

+6B93 21 81 18    !..   LD    HL,1881    ; Auf Anfang

+6B96 ED B1       ..    CPIR             ; naechste suchen

+6B98 CB 7D       .}    BIT   7,L        

+6B9A 20 05        .    JR    NZ,6BA1    

+6B9C CD E2 6D    ..m   CALL  6DE2       ; keine aktivierte Task gefunden  

+6B9F 18 B3       ..    JR    6B54       ; Auf Info-Taste warten

+6BA1 2D          -     DEC   L           

+6BA2 CB BD       ..    RES   7,L        

+6BA4 22 1A 6E    ".n   LD    (6E1A),HL  ; Taskindex Merken 

+6BA7 CD E2 6D    ..m   CALL  6DE2       ; Prozess wechseln

+6BAA 3A 1A 6E    :.n   LD    A,(6E1A)   

+6BAD 57          W     LD    D,A        ; DE= PCB (DS 0)

+6BAE 1E 00       ..    LD    E,00       

+6BB0 CD DE 66    ..f   CALL  66DE       

+6BB3 22 1C 6E    ".n   LD    (6E1C),HL  

+6BB6 2A F7 6E    *.n   LD    HL,(6EF7)  

+6BB9 22 46 6C    "Fl   LD    (6C46),HL  

+6BBC DD 2A 1C 6E .*.n  LD    IX,(6E1C)  

+6BC0 3A 1A 6E    :.n   LD    A,(6E1A)   ; Taskindex (Leitblock) <> Maxiproz

+6BC3 DD BE 30    ..0   CP    (IX+30)    

+6BC6 28 14       (.    JR    Z,6BDC     

+6BC8 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6BCB 18 0F       ..    JR    6BDC       

+6BCD 20 6B        k    JR    NZ,6C3A    ; " kein Leitblock"

+6BCF 65          e     LD    H,L        

+6BD0 69          i     LD    L,C        

+6BD1 6E          n     LD    L,(HL)     

+6BD2 20 4C        L    JR    NZ,6C20    

+6BD4 65          e     LD    H,L        

+6BD5 69          i     LD    L,C        

+6BD6 74          t     LD    (HL),H     

+6BD7 62          b     LD    H,D        

+6BD8 6C          l     LD    L,H        

+6BD9 6F          o     LD    L,A        

+6BDA 63          c     LD    H,E        

+6BDB 6B          k     LD    L,E        

+6BDC DD 7E 01    .~.   LD    A,(IX+01)  

+6BDF B7          .     OR    A          ; wstate = 00, Task nicht aktiv

+6BE0 C8          .     RET   Z          

+6BE1 FE FE       ..    CP    FE         ; wstate = FE: Info-Stop

+6BE3 20 17        .    JR    NZ,6BFC    

+6BE5 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6BE8 18 10       ..    JR    6BFA       ; " stop durch info"

+6BEA 20 73        s    JR    NZ,6C5F    

+6BEC 74          t     LD    (HL),H     

+6BED 6F          o     LD    L,A        

+6BEE 70          p     LD    (HL),B     

+6BEF 20 64        d    JR    NZ,6C55    

+6BF1 75          u     LD    (HL),L     

+6BF2 72          r     LD    (HL),D     

+6BF3 63          c     LD    H,E        

+6BF4 68          h     LD    L,B        

+6BF5 20 69        i    JR    NZ,6C60    

+6BF7 6E          n     LD    L,(HL)     

+6BF8 66          f     LD    H,(HL)     

+6BF9 6F          o     LD    L,A        

+6BFA 18 12       ..    JR    6C0E       ; wstate loword: addresse im Hauptsp.

+6BFC 67          g     LD    H,A        ; IX+1

+6BFD DD 6E 00    .n.   LD    L,(IX+00)  ; wstate low

+6C00 DD 7E 02    .~.   LD    A,(IX+02)  ; wstate highword: (wstate lowword)

+6C03 BE          .     CP    (HL)       

+6C04 20 08        .    JR    NZ,6C0E    ; highbyte wstate

+6C06 24          $     INC   H          

+6C07 DD 7E 03    .~.   LD    A,(IX+03)  

+6C0A BE          .     CP    (HL)       

+6C0B CA 41 6B    .Ak   JP    Z,6B41     ; wstate/wstate+256 = (wstate)

+6C0E DD 36 01 00 .6..  LD    (IX+01),00 ; Inhalt nicht gleich

+6C12 C9          .     RET              

+6C13 ED 7B F2 6E .{.n  LD    SP,(6EF2)  

+6C17 C3 54 6B    .Tk   JP    6B54       

+6C1A FD 2A FA 6E .*.n  LD    IY,(6EFA)  ; Prozess start

+6C1E FD 23       .#    INC   IY         

+6C20 FD 23       .#    INC   IY         

+6C22 FD E9       ..    JP    (IY)       

+6C24 DD 2A 1C 6E .*.n  LD    IX,(6E1C)  

+6C28 DD 75 00    .u.   LD    (IX+00),L  ; wstate neu setzen addresse

+6C2B DD 74 01    .t.   LD    (IX+01),H  

+6C2E 7E          ~     LD    A,(HL)     

+6C2F DD 77 02    .w.   LD    (IX+02),A  ; inhalt von wstate

+6C32 24          $     INC   H          

+6C33 7E          ~     LD    A,(HL)     

+6C34 DD 77 03    .w.   LD    (IX+03),A  

+6C37 C3 26 29    .&)   JP    2926       ; wartezustand

+6C3A 50          P     LD    D,B        ; "PROZ ELAN"

+6C3B 52          R     LD    D,D        

+6C3C 4F          O     LD    C,A        

+6C3D 5A          Z     LD    E,D        

+6C3E 20 45        E    JR    NZ,6C85    

+6C40 4C          L     LD    C,H        

+6C41 41          A     LD    B,C        

+6C42 4E          N     LD    C,(HL)     

+6C43 11 6D C3    .m.   LD    DE,C36D    

+6C46 45          E     LD    B,L        

+6C47 6D          m     LD    L,L        

+6C48 45          E     LD    B,L        

+6C49 FF          .     RST   38         

+6C4A FF          .     RST   38         

+6C4B FF          .     RST   38         

+6C4C FF          .     RST   38         

+6C4D FF          .     RST   38         

+6C4E FF          .     RST   38         

+6C4F FF          .     RST   38         

+6C50 FF          .     RST   38         

+6C51 FF          .     RST   38         

+6C52 FF          .     RST   38         

+6C53 FF          .     RST   38         

+6C54 FF          .     RST   38         

+6C55 FF          .     RST   38         

+6C56 FF          .     RST   38         

+6C57 FF          .     RST   38         

+6C58 FF          .     RST   38         

+6C59 FF          .     RST   38         

+6C5A FF          .     RST   38         

+6C5B FF          .     RST   38         

+6C5C FF          .     RST   38         

+6C5D FF          .     RST   38         

+6C5E FF          .     RST   38         

+6C5F FF          .     RST   38         

+6C60 FF          .     RST   38         

+6C61 FF          .     RST   38         

+6C62 FF          .     RST   38         

+6C63 FF          .     RST   38         

+6C64 FF          .     RST   38         

+6C65 FF          .     RST   38         

+6C66 FF          .     RST   38         

+6C67 FF          .     RST   38         

+6C68 FF          .     RST   38         

+6C69 FF          .     RST   38         

+6C6A FF          .     RST   38         

+6C6B FF          .     RST   38         

+6C6C FF          .     RST   38         

+6C6D FF          .     RST   38         

+6C6E FF          .     RST   38         

+6C6F FF          .     RST   38         

+6C70 FF          .     RST   38         

+6C71 FF          .     RST   38         

+6C72 FF          .     RST   38         

+6C73 FF          .     RST   38         

+6C74 FF          .     RST   38         

+6C75 FF          .     RST   38         

+6C76 FF          .     RST   38         

+6C77 FF          .     RST   38         

+6C78 FF          .     RST   38         

+6C79 FF          .     RST   38         

+6C7A FF          .     RST   38         

+6C7B FF          .     RST   38         

+6C7C FF          .     RST   38         

+6C7D FF          .     RST   38         

+6C7E FF          .     RST   38         

+6C7F FF          .     RST   38         

+6C80 FF          .     RST   38         

+6C81 FF          .     RST   38         

+6C82 FF          .     RST   38         

+6C83 FF          .     RST   38         

+6C84 FF          .     RST   38         

+6C85 FF          .     RST   38         

+6C86 FF          .     RST   38         

+6C87 FF          .     RST   38         

+6C88 FF          .     RST   38         

+6C89 FF          .     RST   38         

+6C8A FF          .     RST   38         

+6C8B FF          .     RST   38         

+6C8C FF          .     RST   38         

+6C8D FF          .     RST   38         

+6C8E FF          .     RST   38         

+6C8F FF          .     RST   38         

+6C90 FF          .     RST   38         

+6C91 FF          .     RST   38         

+6C92 FF          .     RST   38         

+6C93 FF          .     RST   38         

+6C94 FF          .     RST   38         

+6C95 FF          .     RST   38         

+6C96 FF          .     RST   38         

+6C97 FF          .     RST   38         

+6C98 FF          .     RST   38         

+6C99 FF          .     RST   38         

+6C9A FF          .     RST   38         

+6C9B FF          .     RST   38         

+6C9C FF          .     RST   38         

+6C9D FF          .     RST   38         

+6C9E FF          .     RST   38         

+6C9F FF          .     RST   38         

+6CA0 FF          .     RST   38         

+6CA1 FF          .     RST   38         

+6CA2 FF          .     RST   38         

+6CA3 FF          .     RST   38         

+6CA4 FF          .     RST   38         

+6CA5 FF          .     RST   38         

+6CA6 FF          .     RST   38         

+6CA7 FF          .     RST   38         

+6CA8 FF          .     RST   38         

+6CA9 FF          .     RST   38         

+6CAA FF          .     RST   38         

+6CAB FF          .     RST   38         

+6CAC FF          .     RST   38         

+6CAD FF          .     RST   38         

+6CAE FF          .     RST   38         

+6CAF FF          .     RST   38         

+6CB0 FF          .     RST   38         

+6CB1 FF          .     RST   38         

+6CB2 FF          .     RST   38         

+6CB3 FF          .     RST   38         

+6CB4 FF          .     RST   38         

+6CB5 FF          .     RST   38         

+6CB6 FF          .     RST   38         

+6CB7 FF          .     RST   38         

+6CB8 FF          .     RST   38         

+6CB9 FF          .     RST   38         

+6CBA FF          .     RST   38         

+6CBB FF          .     RST   38         

+6CBC FF          .     RST   38         

+6CBD FF          .     RST   38         

+6CBE FF          .     RST   38         

+6CBF FF          .     RST   38         

+6CC0 FF          .     RST   38         

+6CC1 FF          .     RST   38         

+6CC2 FF          .     RST   38         

+6CC3 FF          .     RST   38         

+6CC4 FF          .     RST   38         

+6CC5 FF          .     RST   38         

+6CC6 FF          .     RST   38         

+6CC7 FF          .     RST   38         

+6CC8 FF          .     RST   38         

+6CC9 FF          .     RST   38         

+6CCA FF          .     RST   38         

+6CCB FF          .     RST   38         

+6CCC FF          .     RST   38         

+6CCD FF          .     RST   38         

+6CCE FF          .     RST   38         

+6CCF FF          .     RST   38         

+6CD0 FF          .     RST   38         

+6CD1 FF          .     RST   38         

+6CD2 FF          .     RST   38         

+6CD3 FF          .     RST   38         

+6CD4 FF          .     RST   38         

+6CD5 FF          .     RST   38         

+6CD6 FF          .     RST   38         

+6CD7 FF          .     RST   38         

+6CD8 FF          .     RST   38         

+6CD9 FF          .     RST   38         

+6CDA FF          .     RST   38         

+6CDB FF          .     RST   38         

+6CDC FF          .     RST   38         

+6CDD FF          .     RST   38         

+6CDE FF          .     RST   38         

+6CDF FF          .     RST   38         

+6CE0 FF          .     RST   38         

+6CE1 FF          .     RST   38         

+6CE2 FF          .     RST   38         

+6CE3 FF          .     RST   38         

+6CE4 FF          .     RST   38         

+6CE5 FF          .     RST   38         

+6CE6 FF          .     RST   38         

+6CE7 FF          .     RST   38         

+6CE8 FF          .     RST   38         

+6CE9 FF          .     RST   38         

+6CEA FF          .     RST   38         

+6CEB FF          .     RST   38         

+6CEC FF          .     RST   38         

+6CED FF          .     RST   38         

+6CEE FF          .     RST   38         

+6CEF FF          .     RST   38         

+6CF0 FF          .     RST   38         

+6CF1 FF          .     RST   38         

+6CF2 FF          .     RST   38         

+6CF3 FF          .     RST   38         

+6CF4 FF          .     RST   38         

+6CF5 FF          .     RST   38         

+6CF6 FF          .     RST   38         

+6CF7 FF          .     RST   38         

+6CF8 FF          .     RST   38         

+6CF9 FF          .     RST   38         

+6CFA FF          .     RST   38         

+6CFB FF          .     RST   38         

+6CFC FF          .     RST   38         

+6CFD FF          .     RST   38         

+6CFE FF          .     RST   38         

+6CFF FF          .     RST   38         

+6D00 FF          .     RST   38         

+6D01 FF          .     RST   38         

+6D02 FF          .     RST   38         

+6D03 FF          .     RST   38         

+6D04 FF          .     RST   38         

+6D05 FF          .     RST   38         

+6D06 FF          .     RST   38         

+6D07 FF          .     RST   38         

+6D08 FF          .     RST   38         

+6D09 FF          .     RST   38         

+6D0A FF          .     RST   38         

+6D0B FF          .     RST   38         

+6D0C FF          .     RST   38         

+6D0D FF          .     RST   38         

+6D0E FF          .     RST   38         

+6D0F FF          .     RST   38         

+6D10 FF          .     RST   38         

+6D11 13          .     INC   DE         

+6D12 6D          m     LD    L,L        

+6D13 CD 2D 57    .-W   CALL  572D       

+6D16 11 00 00    ...   LD    DE,0000    ; Task 0, DS 0 laden (Aktiv.Tab.) 

+6D19 CD DA 66    ..f   CALL  66DA       

+6D1C 11 80 18    ...   LD    DE,1880    ; 128 Bytes Akt.Tabelle 

+6D1F 01 80 00    ...   LD    BC,0080    

+6D22 ED B0       ..    LDIR             

+6D24 3A FF 18    :..   LD    A,(18FF)   ; 18FF = FF: SV und 18FF := 01

+6D27 3C          <     INC   A          ; sonst alten SV-Zustand lassen 

+6D28 20 07        .    JR    NZ,6D31    

+6D2A 3C          <     INC   A          

+6D2B 32 81 18    2..   LD    (1881),A   ; supervisor aktivieren

+6D2E 32 FF 18    2..   LD    (18FF),A   

+6D31 11 B9 4C    ..L   LD    DE,4CB9    ; Systemclocks (7)

+6D34 01 40 00    .@.   LD    BC,0040    

+6D37 ED B0       ..    LDIR             

+6D39 CD 41 6B    .Ak   CALL  6B41       

+6D3C 21 24 6C    !$l   LD    HL,6C24    

+6D3F 22 46 6C    "Fl   LD    (6C46),HL  

+6D42 C3 FE 52    ..R   JP    52FE       

+6D45 31 13 6D    1.m   LD    SP,6D13    

+6D48 CD E2 6D    ..m   CALL  6DE2       ; Prozess wechseln

+6D4B 18 C9       ..    JR    6D16       ; Aktivierungstabelle/Clocks laden

+6D4D B7          .     OR    A          

+6D4E 20 0A        .    JR    NZ,6D5A    

+6D50 CD 1F 70    ..p   CALL  701F       ; Info aufrufen " plac"

+6D53 18 05       ..    JR    6D5A       

+6D55 20 70        p    JR    NZ,6DC7    

+6D57 6C          l     LD    L,H        

+6D58 61          a     LD    H,C        

+6D59 63          c     LD    H,E        

+6D5A D5          .     PUSH  DE         

+6D5B E5          .     PUSH  HL         

+6D5C 57          W     LD    D,A        

+6D5D 1E 00       ..    LD    E,00       ; Leitblock der Task laden

+6D5F CD DE 66    ..f   CALL  66DE       

+6D62 E5          .     PUSH  HL         

+6D63 FD E1       ..    POP   IY         ; Adresse --> IY

+6D65 E1          .     POP   HL         

+6D66 D1          .     POP   DE         

+6D67 C9          .     RET              ; -------- unblock (A) ------------

+6D68 B7          .     OR    A          

+6D69 C8          .     RET   Z          

+6D6A E5          .     PUSH  HL         

+6D6B 26 18       &.    LD    H,18       ; Aktivierungstabelle 1880 ....

+6D6D 6F          o     LD    L,A        

+6D6E CB FD       ..    SET   7,L        

+6D70 36 01       6.    LD    (HL),01    ; Task aktivieren

+6D72 E1          .     POP   HL         

+6D73 C9          .     RET              ;------------- block (A) ---------

+6D74 E5          .     PUSH  HL         

+6D75 26 18       &.    LD    H,18       

+6D77 6F          o     LD    L,A        

+6D78 CB FD       ..    SET   7,L        ; AKtivierungstabelle

+6D7A 36 FF       6.    LD    (HL),FF    ; Task deaktivieren

+6D7C E1          .     POP   HL         

+6D7D C9          .     RET              ;----------------------------------

+6D7E C5          .     PUSH  BC         

+6D7F E5          .     PUSH  HL         

+6D80 01 FF FF    ...   LD    BC,FFFF    

+6D83 26 18       &.    LD    H,18       

+6D85 C6 81       ..    ADD   A,81       

+6D87 6F          o     LD    L,A        

+6D88 3E 01       >.    LD    A,01       

+6D8A ED B1       ..    CPIR             

+6D8C CB 7D       .}    BIT   7,L        

+6D8E 20 09        .    JR    NZ,6D99    

+6D90 21 81 18    !..   LD    HL,1881    

+6D93 ED B1       ..    CPIR             

+6D95 CB 7D       .}    BIT   7,L        

+6D97 28 03       (.    JR    Z,6D9C     

+6D99 2D          -     DEC   L          

+6D9A CB BD       ..    RES   7,L        

+6D9C 7D          }     LD    A,L        

+6D9D E1          .     POP   HL         

+6D9E C1          .     POP   BC         

+6D9F C9          .     RET              ; ====== Miniprozess-Schleife ======

+6DA0 21 43 6C    !Cl   LD    HL,6C43    ; PROZ ELAN

+6DA3 ED 7B 43 6C .{Cl  LD    SP,(6C43)  

+6DA7 CD DA 6D    ..m   CALL  6DDA       ; 

+6DAA ED 73 43 6C .sCl  LD    (6C43),SP   

+6DAE 21 74 57    !tW   LD    HL,5774    ; PROZ LADER

+6DB1 ED 7B 74 57 .{tW  LD    SP,(5774)  

+6DB5 CD DA 6D    ..m   CALL  6DDA       

+6DB8 ED 73 74 57 .stW  LD    (5774),SP  

+6DBC 21 5E 7D    !^}   LD    HL,7D5E    ; PROZ MUELL

+6DBF ED 7B 5E 7D .{^}  LD    SP,(7D5E)  

+6DC3 CD DA 6D    ..m   CALL  6DDA       

+6DC6 ED 73 5E 7D .s^}  LD    (7D5E),SP  

+6DCA 21 CE 62    !.b   LD    HL,62CE    ; PROZ ARCH

+6DCD ED 7B CE 62 .{.b  LD    SP,(62CE)  

+6DD1 CD DA 6D    ..m   CALL  6DDA       

+6DD4 ED 73 CE 62 .s.b  LD    (62CE),SP  

+6DD8 18 C6       ..    JR    6DA0       ; zum Schleifenanfang

+6DDA 22 FA 6E    ".n   LD    (6EFA),HL  ;------- Prozess wechseln ---------

+6DDD E1          .     POP   HL         

+6DDE 22 1E 6E    ".n   LD    (6E1E),HL  

+6DE1 C9          .     RET              

+6DE2 3A FC 6E    :.n   LD    A,(6EFC)   

+6DE5 B7          .     OR    A          

+6DE6 C0          .     RET   NZ         

+6DE7 2A 1E 6E    *.n   LD    HL,(6E1E)  

+6DEA E9          .     JP    (HL)       

+6DEB F5          .     PUSH  AF         

+6DEC 3A 0D 6E    :.n   LD    A,(6E0D)   

+6DEF 3D          =     DEC   A          

+6DF0 FA FC 6D    ..m   JP    M,6DFC     

+6DF3 32 0D 6E    2.n   LD    (6E0D),A   

+6DF6 20 04        .    JR    NZ,6DFC    

+6DF8 97          .     SUB   A          

+6DF9 32 FC 6E    2.n   LD    (6EFC),A   

+6DFC F1          .     POP   AF         

+6DFD C9          .     RET              

+6DFE F5          .     PUSH  AF         

+6DFF 3A 0D 6E    :.n   LD    A,(6E0D)   

+6E02 3C          <     INC   A          

+6E03 32 0D 6E    2.n   LD    (6E0D),A   

+6E06 3E 01       >.    LD    A,01       

+6E08 32 FC 6E    2.n   LD    (6EFC),A   

+6E0B F1          .     POP   AF         

+6E0C C9          .     RET              

+6E0D 00          .     NOP              

+6E0E FD E5       ..    PUSH  IY         

+6E10 FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+6E14 FD 7E 05    .~.   LD    A,(IY+05)  

+6E17 FD E1       ..    POP   IY         

+6E19 C9          .     RET              

+6E1A 80          .     ADD   B          

+6E1B 18 00       ..    JR    6E1D       

+6E1D 00          .     NOP              

+6E1E 00          .     NOP              ; Miniprozess addresse

+6E1F 00          .     NOP              

+6E20 DD E3       ..    EX    (SP),IX    

+6E22 FD E5       ..    PUSH  IY         ; warte

+6E24 D5          .     PUSH  DE         

+6E25 C5          .     PUSH  BC         

+6E26 E5          .     PUSH  HL         

+6E27 F5          .     PUSH  AF         

+6E28 DD E9       ..    JP    (IX)       

+6E2A DD E1       ..    POP   IX         

+6E2C F1          .     POP   AF         

+6E2D E1          .     POP   HL         

+6E2E C1          .     POP   BC         

+6E2F D1          .     POP   DE         

+6E30 FD E1       ..    POP   IY         

+6E32 DD E3       ..    EX    (SP),IX    

+6E34 C9          .     RET              ;========= timerinterrupt =======

+6E35 F5          .     PUSH  AF         

+6E36 3A FC 6E    :.n   LD    A,(6EFC)   

+6E39 B7          .     OR    A          

+6E3A 20 2C        ,    JR    NZ,6E68    

+6E3C F1          .     POP   AF         

+6E3D FB          .     EI               

+6E3E CD 3E 21    .>!   CALL  213E       

+6E41 F5          .     PUSH  AF         

+6E42 E5          .     PUSH  HL         

+6E43 2A F9 6E    *.n   LD    HL,(6EF9)  

+6E46 2D          -     DEC   L          

+6E47 28 1E       (.    JR    Z,6E67     

+6E49 F5          .     PUSH  AF         

+6E4A 21 F4 6E    !.n   LD    HL,6EF4    

+6E4D 86          .     ADD   (HL)       

+6E4E 77          w     LD    (HL),A     

+6E4F F1          .     POP   AF         

+6E50 F5          .     PUSH  AF         

+6E51 23          #     INC   HL         

+6E52 86          .     ADD   (HL)       

+6E53 77          w     LD    (HL),A     

+6E54 D6 64       .d    SUB   A,64       ; MOD 100

+6E56 38 04       8.    JR    C,6E5C     

+6E58 77          w     LD    (HL),A     

+6E59 CD 4C 4B    .LK   CALL  4B4C       

+6E5C F1          .     POP   AF         

+6E5D 21 F6 6E    !.n   LD    HL,6EF6    

+6E60 86          .     ADD   (HL)       

+6E61 77          w     LD    (HL),A     

+6E62 FE 64       .d    CP    64         

+6E64 D4 9A 2A    ..*   CALL  NC,2A9A    

+6E67 E1          .     POP   HL         

+6E68 F1          .     POP   AF         

+6E69 C9          .     RET              ;------------ Info Taste ----------

+6E6A 32 F1 6E    2.n   LD    (6EF1),A   ; Taste zweimal druecken

+6E6D 3A F0 6E    :.n   LD    A,(6EF0)   

+6E70 B7          .     OR    A          

+6E71 28 1F       (.    JR    Z,6E92     

+6E73 CD 8F 6E    ..n   CALL  6E8F       

+6E76 CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6E79 18 0F       ..    JR    6E8A       ; " Info erzwungen" 

+6E7B 20 49        I    JR    NZ,6EC6    

+6E7D 6E          n     LD    L,(HL)     

+6E7E 66          f     LD    H,(HL)     

+6E7F 6F          o     LD    L,A        

+6E80 20 65        e    JR    NZ,6EE7    

+6E82 72          r     LD    (HL),D     

+6E83 7A          z     LD    A,D        

+6E84 77          w     LD    (HL),A     

+6E85 75          u     LD    (HL),L     

+6E86 6E          n     LD    L,(HL)     

+6E87 67          g     LD    H,A        

+6E88 65          e     LD    H,L        

+6E89 6E          n     LD    L,(HL)     

+6E8A 97          .     SUB   A          

+6E8B 32 F0 6E    2.n   LD    (6EF0),A   

+6E8E C9          .     RET              ;----------------------------------

+6E8F FB          .     EI               

+6E90 ED 4D       .M    RETI             

+6E92 3C          <     INC   A          

+6E93 32 F0 6E    2.n   LD    (6EF0),A   ; info tasten anzahl

+6E96 97          .     SUB   A          

+6E97 C9          .     RET              

+6E98 3A F1 6E    :.n   LD    A,(6EF1)   ; info kanal 

+6E9B C3 06 1F    ...   JP    1F06       ; auf taste warten

+6E9E CD 98 6E    ..n   CALL  6E98       

+6EA1 D0          .     RET   NC         

+6EA2 CD 20 6E    . n   CALL  6E20       

+6EA5 CD E2 6D    ..m   CALL  6DE2       

+6EA8 CD 2A 6E    .*n   CALL  6E2A       

+6EAB 18 F1       ..    JR    6E9E       

+6EAD CD CA 6E    ..n   CALL  6ECA       

+6EB0 CD 9E 6E    ..n   CALL  6E9E       

+6EB3 CD B9 6E    ..n   CALL  6EB9       

+6EB6 FE 6A       .j    CP    6A         ; j

+6EB8 C9          .     RET              

+6EB9 32 C9 6E    2.n   LD    (6EC9),A   

+6EBC E5          .     PUSH  HL         

+6EBD 21 C8 6E    !.n   LD    HL,6EC8    

+6EC0 CD CA 6E    ..n   CALL  6ECA       

+6EC3 E1          .     POP   HL         

+6EC4 3A C9 6E    :.n   LD    A,(6EC9)   

+6EC7 C9          .     RET              

+6EC8 01 00 E5    ...   LD    BC,E500    

+6ECB C5          .     PUSH  BC         

+6ECC 4E          N     LD    C,(HL)    ; Laenge am Stringanafng 

+6ECD 23          #     INC   HL         

+6ECE 06 00       ..    LD    B,00       

+6ED0 3A F1 6E    :.n   LD    A,(6EF1)   

+6ED3 C5          .     PUSH  BC         

+6ED4 CD 88 21    ..!   CALL  2188       ; OUTPUT

+6ED7 38 13       8.    JR    C,6EEC     

+6ED9 CD 20 6E    . n   CALL  6E20       

+6EDC CD E2 6D    ..m   CALL  6DE2       

+6EDF CD 2A 6E    .*n   CALL  6E2A       

+6EE2 09          .     ADD   HL,BC      

+6EE3 E3          .     EX    (SP),HL    

+6EE4 B7          .     OR    A          

+6EE5 ED 42       .B    SBC   HL,BC      

+6EE7 44          D     LD    B,H        

+6EE8 4D          M     LD    C,L        

+6EE9 E1          .     POP   HL         

+6EEA 18 E4       ..    JR    6ED0       

+6EEC C1          .     POP   BC         

+6EED C1          .     POP   BC         

+6EEE E1          .     POP   HL         

+6EEF C9          .     RET              

+6EF0 00          .     NOP              

+6EF1 01 00 00    ...   LD    BC,0000    

+6EF4 00          .     NOP              

+6EF5 00          .     NOP              

+6EF6 00          .     NOP              

+6EF7 00          .     NOP              

+6EF8 00          .     NOP              

+6EF9 00          .     NOP              

+6EFA 43          C     LD    B,E        

+6EFB 6C          l     LD    L,H        

+6EFC 01 69 6E    .in   LD    BC,6E69    ; "info quelle   3 (!)"

+6EFF 66          f     LD    H,(HL)     

+6F00 6F          o     LD    L,A        

+6F01 2E 71       .q    LD    L,71       

+6F03 75          u     LD    (HL),L     

+6F04 65          e     LD    H,L        

+6F05 6C          l     LD    L,H        

+6F06 6C          l     LD    L,H        

+6F07 65          e     LD    H,L        

+6F08 20 20             JR    NZ,6F2A    

+6F0A 20 33        3    JR    NZ,6F3F    

+6F0C 20 28        (    JR    NZ,6F36    

+6F0E 21 29 

+6F10 D5                PUSH  DE         ;------------------------------

+6F11 CD B1 7A    ..z   CALL  7AB1       ; Altes Password korrekt ?

+6F14 D1          .     POP   DE         

+6F15 01 01 00    ...   LD    BC,0001    

+6F18 C0          .     RET   NZ         

+6F19 21 19 7D    !.}   LD    HL,7D19    

+6F1C 06 0A       ..    LD    B,0A       ; 10 Bytes invertieren und uebetr.

+6F1E 1A          .     LD    A,(DE)     ; Neues Password eintragen 

+6F1F 2F          /     CPL              

+6F20 77          w     LD    (HL),A     

+6F21 23          #     INC   HL         

+6F22 13          .     INC   DE         

+6F23 10 F9       ..    DJNZ  6F1E       

+6F25 01 00 00    ...   LD    BC,0000    

+6F28 C9          .     RET              

+6F29 C9          .     RET              ;----------------------------------

+6F2A CD 1F 70    ..p   CALL  701F       ; Info aufrufen

+6F2D 18 03       ..    JR    6F32       

+6F2F 20 4B        K    JR    NZ,6F7C    ; " KE"

+6F31 45          E     LD    B,L        

+6F32 C9          .     RET              ;---------- info-taste gedrueckt ---

+6F33 C3 6A 6E    .jn   JP    6E6A       ; Info aufrufen

+6F36 C3 CA 6E    ..n   JP    6ECA       

+6F39 7A          z     LD    A,D        

+6F3A B7          .     OR    A          

+6F3B 28 14       (.    JR    Z,6F51     

+6F3D FE FF       ..    CP    FF         

+6F3F 20 04        .    JR    NZ,6F45    

+6F41 7C          |     LD    A,H        

+6F42 CB 27       .'    SLA   A          

+6F44 C9          .     RET              

+6F45 CD 72 6F    .ro   CALL  6F72       

+6F48 CD 5C 65    .\e   CALL  655C       

+6F4B DD E1       ..    POP   IX         

+6F4D CD 10 70    ..p   CALL  7010       

+6F50 C9          .     RET              

+6F51 E5          .     PUSH  HL         

+6F52 6C          l     LD    L,H        

+6F53 63          c     LD    H,E        

+6F54 C5          .     PUSH  BC         

+6F55 ED 4B 9B 7C .K.|  LD    BC,(7C9B)  

+6F59 B7          .     OR    A          

+6F5A ED 42       .B    SBC   HL,BC      

+6F5C 30 68       0h    JR    NC,6FC6    

+6F5E 09          .     ADD   HL,BC      

+6F5F C1          .     POP   BC         

+6F60 CD 92 5A    ..Z   CALL  5A92       

+6F63 7C          |     LD    A,H        

+6F64 E1          .     POP   HL         

+6F65 C9          .     RET              

+6F66 CD 72 6F    .ro   CALL  6F72       

+6F69 CD 36 6A    .6j   CALL  6A36       

+6F6C DD E1       ..    POP   IX         

+6F6E CD 10 70    ..p   CALL  7010       

+6F71 C9          .     RET              

+6F72 DD E1       ..    POP   IX         

+6F74 DD 22 8C 6F .".o  LD    (6F8C),IX  

+6F78 CD 20 6E    . n   CALL  6E20       

+6F7B DD 2A 8C 6F .*.o  LD    IX,(6F8C)  

+6F7F DD E5       ..    PUSH  IX         

+6F81 ED 73 90 6F .s.o  LD    (6F90),SP  

+6F85 DD E9       ..    JP    (IX)       

+6F87 69          i     LD    L,C        ; "ixsav"

+6F88 78          x     LD    A,B        

+6F89 73          s     LD    (HL),E     

+6F8A 61          a     LD    H,C        

+6F8B 76          v     HALT             

+6F8C 00          .     NOP              

+6F8D 00          .     NOP              

+6F8E 00          .     NOP              

+6F8F 00          .     NOP              

+6F90 00          .     NOP              

+6F91 00          .     NOP              

+6F92 00          .     NOP              

+6F93 00          .     NOP              

+6F94 3A 4B 7B    :K{   LD    A,(7B4B)   

+6F97 B7          .     OR    A          

+6F98 28 31       (1    JR    Z,6FCB     

+6F9A ED 7B 90 6F .{.o  LD    SP,(6F90)  

+6F9E CD E2 6D    ..m   CALL  6DE2       ; Prozess wechseln

+6FA1 DD E1       ..    POP   IX         

+6FA3 DD 22 8C 6F .".o  LD    (6F8C),IX  

+6FA7 DD E5       ..    PUSH  IX         

+6FA9 3A 1A 6E    :.n   LD    A,(6E1A)   ; Taskindex aktueller Prozess

+6FAC E6 7F       ..    AND   7F         

+6FAE 28 0F       (.    JR    Z,6FBF     ; Task 0 ?

+6FB0 57          W     LD    D,A        ; PCB laden

+6FB1 1E 00       ..    LD    E,00       

+6FB3 CD DE 66    ..f   CALL  66DE       

+6FB6 22 1C 6E    ".n   LD    (6E1C),HL  

+6FB9 21 FF FF    !..   LD    HL,FFFF    

+6FBC 22 23 7D    "#}   LD    (7D23),HL  

+6FBF DD E1       ..    POP   IX         

+6FC1 CD 2A 6E    .*n   CALL  6E2A       

+6FC4 18 B2       ..    JR    6F78       

+6FC6 21 BC 7C    !.|   LD    HL,7CBC    

+6FC9 18 03       ..    JR    6FCE       

+6FCB 21 A6 7C    !.|   LD    HL,7CA6    

+6FCE ED 7B 8E 6F .{.o  LD    SP,(6F8E)  

+6FD2 CD CA 6E    ..n   CALL  6ECA       

+6FD5 C3 D4 70    ..p   JP    70D4       

+6FD8 ED 7B 8E 6F .{.o  LD    SP,(6F8E)  

+6FDC C3 8A 71    ..q   JP    718A       

+6FDF 7A          z     LD    A,D        

+6FE0 B7          .     OR    A          

+6FE1 CA 51 6F    .Qo   JP    Z,6F51     

+6FE4 FE FF       ..    CP    FF         

+6FE6 20 04        .    JR    NZ,6FEC    

+6FE8 7C          |     LD    A,H        

+6FE9 CB 27       .'    SLA   A          

+6FEB C9          .     RET              

+6FEC CD 72 6F    .ro   CALL  6F72       

+6FEF CD 2C 66    .,f   CALL  662C       

+6FF2 DD E1       ..    POP   IX         

+6FF4 CD 10 70    ..p   CALL  7010       

+6FF7 C9          .     RET              

+6FF8 CD 72 6F    .ro   CALL  6F72       

+6FFB CD DA 66    ..f   CALL  66DA       

+6FFE DD E1       ..    POP   IX         

+7000 CD 10 70    ..p   CALL  7010       

+7003 C9          .     RET              

+7004 CD 72 6F    .ro   CALL  6F72       

+7007 CD DE 66    ..f   CALL  66DE       

+700A DD E1       ..    POP   IX         

+700C CD 10 70    ..p   CALL  7010       

+700F C9          .     RET              

+7010 DD E1       ..    POP   IX         

+7012 FD 21 08 00 .!..  LD    IY,0008    

+7016 FD 39       .9    ADD   IY,SP      

+7018 FD F9       ..    LD    SP,IY      

+701A FD E1       ..    POP   IY         

+701C DD E3       ..    EX    (SP),IX    

+701E C9          .     RET              ; =============== Info ===========

+701F E3          .     EX    (SP),HL    

+7020 F5          .     PUSH  AF         

+7021 23          #     INC   HL         

+7022 23          #     INC   HL         

+7023 7E          ~     LD    A,(HL)     

+7024 2B          +     DEC   HL         

+7025 2B          +     DEC   HL         

+7026 B7          .     OR    A          

+7027 20 03        .    JR    NZ,702C    

+7029 F1          .     POP   AF         

+702A E3          .     EX    (SP),HL    

+702B C9          .     RET              

+702C E5          .     PUSH  HL         

+702D 3A 60 78    :`x   LD    A,(7860)   

+7030 B7          .     OR    A          

+7031 28 13       (.    JR    Z,7046     

+7033 23          #     INC   HL         

+7034 CD 98 75    ..u   CALL  7598       

+7037 CD 0E 6E    ..n   CALL  6E0E       

+703A 21 D2 77    !.w   LD    HL,77D2    

+703D BE          .     CP    (HL)       

+703E CA 29 71    .)q   JP    Z,7129     

+7041 CD E2 6D    ..m   CALL  6DE2       

+7044 18 FB       ..    JR    7041       

+7046 E1          .     POP   HL         

+7047 F1          .     POP   AF         

+7048 E3          .     EX    (SP),HL    

+7049 FD E5       ..    PUSH  IY         

+704B F5          .     PUSH  AF         

+704C 3A 17 82    :..   LD    A,(8217)   

+704F 3D          =     DEC   A          

+7050 F2 56 70    .Vp   JP    P,7056     

+7053 32 17 82    2..   LD    (8217),A   

+7056 FD 21 04 00 .!..  LD    IY,0004    

+705A FD 39       .9    ADD   IY,SP      

+705C F1          .     POP   AF         

+705D FD E5       ..    PUSH  IY         

+705F DD E5       ..    PUSH  IX         

+7061 D9          .     EXX              

+7062 E5          .     PUSH  HL         

+7063 D5          .     PUSH  DE         

+7064 C5          .     PUSH  BC         

+7065 D9          .     EXX              

+7066 08          .     EX    AF,AF'     

+7067 F5          .     PUSH  AF         

+7068 08          .     EX    AF,AF'     

+7069 E5          .     PUSH  HL         

+706A D5          .     PUSH  DE         

+706B C5          .     PUSH  BC         

+706C F5          .     PUSH  AF         

+706D CD 8A 28    ..(   CALL  288A       

+7070 CB 70       .p    BIT   6,B        

+7072 20 08        .    JR    NZ,707C    

+7074 CB 21       .!    SLA   C          

+7076 CB 10       ..    RL    B          

+7078 ED 43 9B 7C .C.|  LD    (7C9B),BC  

+707C FD 21 00 00 .!..  LD    IY,0000    

+7080 FD 39       .9    ADD   IY,SP      

+7082 FD E5       ..    PUSH  IY         

+7084 21 60 78    !`x   LD    HL,7860    

+7087 CD 65 82    .e.   CALL  8265       

+708A CD FE 6D    ..m   CALL  6DFE       

+708D 3E 01       >.    LD    A,01       

+708F 32 F9 6E    2.n   LD    (6EF9),A   

+7092 FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+7096 FD 4E 03    .N.   LD    C,(IY+03)  

+7099 FD 46 04    .F.   LD    B,(IY+04)  

+709C ED 43 50 7B .CP{  LD    (7B50),BC  

+70A0 01 94 6F    ..o   LD    BC,6F94    

+70A3 FD 70 04    .p.   LD    (IY+04),B  

+70A6 FD 71 03    .q.   LD    (IY+03),C  

+70A9 97          .     SUB   A          

+70AA 32 4B 7B    2K{   LD    (7B4B),A   

+70AD FD E1       ..    POP   IY         

+70AF 21 39 7B    !9{   LD    HL,7B39    

+70B2 36 00       6.    LD    (HL),00    

+70B4 21 26 7B    !&{   LD    HL,7B26    

+70B7 22 5C 7B    "\{   LD    (7B5C),HL  

+70BA FD 22 92 6F .".o  LD    (6F92),IY  

+70BE 11 D1 77    ..w   LD    DE,77D1    

+70C1 CD B2 74    ..t   CALL  74B2       

+70C4 3E FF       >.    LD    A,FF       

+70C6 32 54 7B    2T{   LD    (7B54),A   

+70C9 97          .     SUB   A          

+70CA 32 18 7D    2.}   LD    (7D18),A   

+70CD ED 73 8E 6F .s.o  LD    (6F8E),SP  

+70D1 CD F2 74    ..t   CALL  74F2       

+70D4 CD B2 75    ..u   CALL  75B2       

+70D7 FE 67       .g    CP    67         ; "g" Weiter

+70D9 CA 41 71    .Aq   JP    Z,7141     

+70DC FE 50       .P    CP    50         ; "P" Password

+70DE CA 8D 7A    ..z   JP    Z,7A8D     

+70E1 F5          .     PUSH  AF         

+70E2 3A 18 7D    :.}   LD    A,(7D18)   

+70E5 B7          .     OR    A          

+70E6 28 41       (A    JR    Z,7129     

+70E8 F1          .     POP   AF         

+70E9 FE 0D       ..    CP    0D         ; CR Dump

+70EB CA 5A 72    .Zr   JP    Z,725A     

+70EE FE 77       .w    CP    77         ; w  Wordaddress setzen

+70F0 CA 3E 72    .>r   JP    Z,723E     

+70F3 FE 7A       .z    CP    7A         ; z  Leitblock zeigen

+70F5 CA BB 71    ..q   JP    Z,71BB     

+70F8 FE 73       .s    CP    73         ; s  Dataspace waehlen

+70FA CA 26 72    .&r   JP    Z,7226     

+70FD FE 70       .p    CP    70         ; p Byteaddresse setzen

+70FF CA 2D 72    .-r   JP    Z,722D     

+7102 FE 6C       .l    CP    6C         ; l Dumplaenge setzen

+7104 CA 54 72    .Tr   JP    Z,7254     

+7107 FE 6B       .k    CP    6B         ; k Block vom HG laden

+7109 CA A9 73    ..s   JP    Z,73A9     

+710C FE 78       .x    CP    78         ; x Bytekette suchen

+710E CA C0 73    ..s   JP    Z,73C0     

+7111 FE 6F       .o    CP    6F         ; o Naechste Seite dumpen

+7113 CA 51 73    .Qs   JP    Z,7351     

+7116 FE 72       .r    CP    72         ; r Miniprozesse freigeben

+7118 28 1A       (.    JR    Z,7134     

+711A FE 79       .y    CP    79         ; y Spezielle Kommando

+711C CA B3 78    ..x   JP    Z,78B3     

+711F FE 71       .q    CP    71         ; q Zur anderen Tas wechseln

+7121 CA A4 71    ..q   JP    Z,71A4     

+7124 FE 74       .t    CP    74         ; t Register anzeigen

+7126 CC 07 7B    ..{   CALL  Z,7B07     

+7129 3E 07       >.    LD    A,07       ; Unbekannt beep

+712B CD A4 75    ..u   CALL  75A4       

+712E ED 7B 8E 6F .{.o  LD    SP,(6F8E)  

+7132 18 A0       ..    JR    70D4       

+7134 22 4C 7B    "L{   LD    (7B4C),HL  

+7137 CD EB 6D    ..m   CALL  6DEB       

+713A 3E 01       >.    LD    A,01       

+713C 32 4B 7B    2K{   LD    (7B4B),A   

+713F 18 93       ..    JR    70D4       

+7141 97          .     SUB   A          

+7142 32 F9 6E    2.n   LD    (6EF9),A   

+7145 21 60 78    !`x   LD    HL,7860    

+7148 CD 62 82    .b.   CALL  8262       

+714B 3A 17 82    :..   LD    A,(8217)   

+714E B7          .     OR    A          

+714F F2 56 71    .Vq   JP    P,7156     

+7152 3C          <     INC   A          

+7153 32 17 82    2..   LD    (8217),A   

+7156 CD EB 6D    ..m   CALL  6DEB       

+7159 ED 4B 50 7B .KP{  LD    BC,(7B50)  

+715D FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+7161 FD 71 03    .q.   LD    (IY+03),C  

+7164 FD 70 04    .p.   LD    (IY+04),B  

+7167 3A 4B 7B    :K{   LD    A,(7B4B)   

+716A B7          .     OR    A          

+716B 28 0A       (.    JR    Z,7177     

+716D 21 00 00    !..   LD    HL,0000    

+7170 3A 4C 7B    :L{   LD    A,(7B4C)   

+7173 B7          .     OR    A          

+7174 CA 1A 6C    ..l   JP    Z,6C1A     

+7177 F1          .     POP   AF         

+7178 C1          .     POP   BC         

+7179 D1          .     POP   DE         

+717A E1          .     POP   HL         

+717B 08          .     EX    AF,AF'     

+717C F1          .     POP   AF         

+717D 08          .     EX    AF,AF'     

+717E D9          .     EXX              

+717F C1          .     POP   BC         

+7180 D1          .     POP   DE         

+7181 E1          .     POP   HL         

+7182 D9          .     EXX              

+7183 DD E1       ..    POP   IX         

+7185 FD E1       ..    POP   IY         

+7187 FD E1       ..    POP   IY         

+7189 C9          .     RET              

+718A 21 60 78    !`x   LD    HL,7860    

+718D CD 62 82    .b.   CALL  8262       

+7190 ED 4B 50 7B .KP{  LD    BC,(7B50)  

+7194 FD 2A FA 6E .*.n  LD    IY,(6EFA)  

+7198 FD 71 03    .q.   LD    (IY+03),C  

+719B FD 70 04    .p.   LD    (IY+04),B  

+719E CD E2 6D    ..m   CALL  6DE2       

+71A1 C3 7C 70    .|p   JP    707C       

+71A4 7D          }     LD    A,L        

+71A5 B7          .     OR    A          

+71A6 CA D4 70    ..p   JP    Z,70D4     

+71A9 55          U     LD    D,L        

+71AA 1E 00       ..    LD    E,00       

+71AC F5          .     PUSH  AF         

+71AD CD 04 70    ..p   CALL  7004       

+71B0 2E 01       ..    LD    L,01       

+71B2 36 FE       6.    LD    (HL),FE    

+71B4 F1          .     POP   AF         

+71B5 CD 68 6D    .hm   CALL  6D68       

+71B8 C3 D4 70    ..p   JP    70D4       

+71BB 7C          |     LD    A,H        

+71BC B5          .     OR    L          

+71BD 28 08       (.    JR    Z,71C7     

+71BF 55          U     LD    D,L        

+71C0 1E 00       ..    LD    E,00       

+71C2 CD F8 6F    ..o   CALL  6FF8       

+71C5 18 03       ..    JR    71CA       

+71C7 2A 1C 6E    *.n   LD    HL,(6E1C)  

+71CA FD E5       ..    PUSH  IY         

+71CC FD 21 72 7B .!r{  LD    IY,7B72    

+71D0 3E 00       >.    LD    A,00       

+71D2 32 71 7B    2q{   LD    (7B71),A   

+71D5 E5          .     PUSH  HL         

+71D6 21 39 7B    !9{   LD    HL,7B39    

+71D9 CB 86       ..    RES   0,(HL)     

+71DB 21 6B 7C    !k|   LD    HL,7C6B    

+71DE CD CA 6E    ..n   CALL  6ECA       

+71E1 CD 1C 7B    ..{   CALL  7B1C       

+71E4 E1          .     POP   HL         

+71E5 FD 7E 02    .~.   LD    A,(IY+02)  

+71E8 B7          .     OR    A          

+71E9 CA 21 72    .!r   JP    Z,7221     

+71EC FD 5E 00    .^.   LD    E,(IY+00)  

+71EF 16 00       ..    LD    D,00       

+71F1 E5          .     PUSH  HL         

+71F2 19          .     ADD   HL,DE      

+71F3 FD 46 01    .F.   LD    B,(IY+01)  

+71F6 CD 2D 75    .-u   CALL  752D       

+71F9 FD E5       ..    PUSH  IY         

+71FB E1          .     POP   HL         

+71FC 23          #     INC   HL         

+71FD 23          #     INC   HL         

+71FE CD CA 6E    ..n   CALL  6ECA       

+7201 3A 71 7B    :q{   LD    A,(7B71)   

+7204 C6 14       ..    ADD   A,14       

+7206 FE 50       .P    CP    50         

+7208 38 04       8.    JR    C,720E     

+720A CD 1C 7B    ..{   CALL  7B1C       

+720D 97          .     SUB   A          

+720E 32 71 7B    2q{   LD    (7B71),A   

+7211 CD 84 75    ..u   CALL  7584       

+7214 16 00       ..    LD    D,00       

+7216 FD 5E 02    .^.   LD    E,(IY+02)  

+7219 13          .     INC   DE         

+721A 13          .     INC   DE         

+721B 13          .     INC   DE         

+721C FD 19       ..    ADD   IY,DE      

+721E E1          .     POP   HL         

+721F 18 C4       ..    JR    71E5       

+7221 FD E1       ..    POP   IY         

+7223 C3 CD 70    ..p   JP    70CD       

+7226 7D          }     LD    A,L        

+7227 32 54 7B    2T{   LD    (7B54),A   

+722A C3 D4 70    ..p   JP    70D4       

+722D 22 5C 7B    "\{   LD    (7B5C),HL  

+7230 3A 71 78    :qx   LD    A,(7871)   

+7233 32 5E 7B    2^{   LD    (7B5E),A   

+7236 3E 01       >.    LD    A,01       

+7238 32 CD 77    2.w   LD    (77CD),A   

+723B C3 D4 70    ..p   JP    70D4       

+723E CB 25       .%    SLA   L          

+7240 CB 14       ..    RL    H          

+7242 22 5C 7B    "\{   LD    (7B5C),HL  

+7245 3A 71 78    :qx   LD    A,(7871)   

+7248 CB 17       ..    RL    A          

+724A 32 5E 7B    2^{   LD    (7B5E),A   

+724D 97          .     SUB   A          

+724E 32 CD 77    2.w   LD    (77CD),A   

+7251 C3 D4 70    ..p   JP    70D4       

+7254 22 65 7B    "e{   LD    (7B65),HL  

+7257 C3 D4 70    ..p   JP    70D4       

+725A 2A 99 7C    *.|   LD    HL,(7C99)  

+725D 7C          |     LD    A,H        

+725E B5          .     OR    L          

+725F C2 D4 70    ..p   JP    NZ,70D4    

+7262 CD 1C 7B    ..{   CALL  7B1C       

+7265 21 61 78    !ax   LD    HL,7861    

+7268 CD CA 6E    ..n   CALL  6ECA       

+726B 21 54 7B    !T{   LD    HL,7B54    

+726E CD 3A 7A    .:z   CALL  7A3A       

+7271 21 5C 7B    !\{   LD    HL,7B5C    

+7274 CD 3A 7A    .:z   CALL  7A3A       

+7277 21 65 7B    !e{   LD    HL,7B65    

+727A CD 3A 7A    .:z   CALL  7A3A       

+727D 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7280 ED 4B 65 7B .Ke{  LD    BC,(7B65)  

+7284 CD 8A 72    ..r   CALL  728A       

+7287 C3 CD 70    ..p   JP    70CD       

+728A 3E 00       >.    LD    A,00       

+728C 32 3E 7B    2>{   LD    (7B3E),A   

+728F 7D          }     LD    A,L        

+7290 32 6C 78    2lx   LD    (786C),A   

+7293 E6 F0       ..    AND   F0         

+7295 6F          o     LD    L,A        

+7296 3A 5E 7B    :^{   LD    A,(7B5E)   

+7299 5F          _     LD    E,A        

+729A 78          x     LD    A,B        

+729B B7          .     OR    A          

+729C FA B3 72    ..r   JP    M,72B3     

+729F CD B9 72    ..r   CALL  72B9       

+72A2 CD 20 6E    . n   CALL  6E20       

+72A5 CD 98 6E    ..n   CALL  6E98       

+72A8 38 04       8.    JR    C,72AE     

+72AA CD 2A 6E    .*n   CALL  6E2A       

+72AD C9          .     RET              

+72AE CD 2A 6E    .*n   CALL  6E2A       

+72B1 18 E7       ..    JR    729A       

+72B3 21 39 7B    !9{   LD    HL,7B39    

+72B6 CB C6       ..    SET   0,(HL)     

+72B8 C9          .     RET              

+72B9 C5          .     PUSH  BC         

+72BA E5          .     PUSH  HL         

+72BB 22 73 78    "sx   LD    (7873),HL  

+72BE ED 53 75 78 .Sux  LD    (7875),DE  

+72C2 22 77 78    "wx   LD    (7877),HL  

+72C5 ED 53 79 78 .Syx  LD    (7879),DE  

+72C9 E5          .     PUSH  HL         

+72CA CD 88 78    ..x   CALL  7888       

+72CD CD 39 6F    .9o   CALL  6F39       

+72D0 E1          .     POP   HL         

+72D1 CB 3C       .<    SLR   H          

+72D3 CE 00       ..    ADC   A,00       

+72D5 67          g     LD    H,A        

+72D6 E5          .     PUSH  HL         

+72D7 CD 1C 7B    ..{   CALL  7B1C       

+72DA 21 3E 7B    !>{   LD    HL,7B3E    

+72DD 34          4     INC   (HL)       

+72DE 3A CD 77    :.w   LD    A,(77CD)   

+72E1 B7          .     OR    A          

+72E2 20 0B        .    JR    NZ,72EF    

+72E4 21 79 78    !yx   LD    HL,7879    

+72E7 CB 3E       .>    SLR   (HL)       

+72E9 2B          +     DEC   HL         

+72EA CB 1E       ..    RR    (HL)       

+72EC 2B          +     DEC   HL         

+72ED CB 1E       ..    RR    (HL)       

+72EF 21 79 78    !yx   LD    HL,7879    

+72F2 CD 56 75    .Vu   CALL  7556       

+72F5 2B          +     DEC   HL         

+72F6 CD 56 75    .Vu   CALL  7556       

+72F9 2B          +     DEC   HL         

+72FA CD 56 75    .Vu   CALL  7556       

+72FD E1          .     POP   HL         

+72FE 22 73 78    "sx   LD    (7873),HL  

+7301 3E 3A       >:    LD    A,3A       

+7303 CD A4 75    ..u   CALL  75A4       

+7306 3E 20       >     LD    A,20       

+7308 CD A4 75    ..u   CALL  75A4       

+730B 06 08       ..    LD    B,08       

+730D CD 2D 75    .-u   CALL  752D       

+7310 3E 20       >     LD    A,20       

+7312 CD A4 75    ..u   CALL  75A4       

+7315 06 08       ..    LD    B,08       

+7317 CD 2D 75    .-u   CALL  752D       

+731A 3E 20       >     LD    A,20       

+731C CD A4 75    ..u   CALL  75A4       

+731F 2A 73 78    *sx   LD    HL,(7873)  

+7322 01 10 00    ...   LD    BC,0010    

+7325 7E          ~     LD    A,(HL)     

+7326 FE 20       .     CP    20         

+7328 30 02       0.    JR    NC,732C    

+732A 3E 2E       >.    LD    A,2E       

+732C FE 7E       .~    CP    7E         

+732E 38 02       8.    JR    C,7332     

+7330 3E 2E       >.    LD    A,2E       

+7332 CD A4 75    ..u   CALL  75A4       

+7335 ED A1       ..    CPI              

+7337 EA 25 73    .%s   JP    PE,7325    

+733A E1          .     POP   HL         

+733B ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+733F ED 5B 75 78 .[ux  LD    DE,(7875)  

+7343 B7          .     OR    A          

+7344 ED 4A       .J    ADC   HL,BC      

+7346 30 01       0.    JR    NC,7349    

+7348 1C          .     INC   E          

+7349 C1          .     POP   BC         

+734A 79          y     LD    A,C        

+734B D6 10       ..    SUB   A,10       

+734D 4F          O     LD    C,A        

+734E D0          .     RET   NC         

+734F 05          .     DEC   B          

+7350 C9          .     RET              

+7351 7C          |     LD    A,H        

+7352 B5          .     OR    L          

+7353 28 04       (.    JR    Z,7359     

+7355 54          T     LD    D,H        

+7356 5D          ]     LD    E,L        

+7357 18 04       ..    JR    735D       

+7359 ED 5B 65 7B .[e{  LD    DE,(7B65)  

+735D 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7360 B7          .     OR    A          

+7361 ED 5A       .Z    ADC   HL,DE      

+7363 22 5C 7B    "\{   LD    (7B5C),HL  

+7366 30 04       0.    JR    NC,736C    

+7368 21 5E 7B    !^{   LD    HL,7B5E    

+736B 34          4     INC   (HL)       

+736C C3 5A 72    .Zr   JP    725A       

+736F 7C          |     LD    A,H        

+7370 B5          .     OR    L          

+7371 20 0C        .    JR    NZ,737F    

+7373 EB          .     EX    DE,HL      

+7374 01 05 00    ...   LD    BC,0005    

+7377 3E 1F       >.    LD    A,1F       

+7379 CD A8 28    ..(   CALL  28A8       

+737C 21 00 00    !..   LD    HL,0000    

+737F 22 25 7D    "%}   LD    (7D25),HL  

+7382 E5          .     PUSH  HL         

+7383 11 12 FF    ...   LD    DE,FF12    

+7386 CD 66 6F    .fo   CALL  6F66       

+7389 D1          .     POP   DE         

+738A 67          g     LD    H,A        

+738B 2E 00       ..    LD    L,00       

+738D 22 23 7D    "#}   LD    (7D23),HL  

+7390 E5          .     PUSH  HL         

+7391 01 00 00    ...   LD    BC,0000    

+7394 3E 1F       >.    LD    A,1F       

+7396 CD 7E 28    .~(   CALL  287E       

+7399 E1          .     POP   HL         

+739A 79          y     LD    A,C        

+739B B7          .     OR    A          

+739C 20 02        .    JR    NZ,73A0    

+739E 18 10       ..    JR    73B0       

+73A0 3E 30       >0    LD    A,30       

+73A2 81          .     ADD   C          

+73A3 CD A4 75    ..u   CALL  75A4       

+73A6 C3 D4 70    ..p   JP    70D4       

+73A9 EB          .     EX    DE,HL      

+73AA CD 66 6F    .fo   CALL  6F66       

+73AD 67          g     LD    H,A        

+73AE 2E 00       ..    LD    L,00       

+73B0 22 5C 7B    "\{   LD    (7B5C),HL  

+73B3 21 5E 7B    !^{   LD    HL,7B5E    

+73B6 36 00       6.    LD    (HL),00    

+73B8 3E FF       >.    LD    A,FF       

+73BA 32 54 7B    2T{   LD    (7B54),A   

+73BD C3 5A 72    .Zr   JP    725A       

+73C0 22 6F 7B    "o{   LD    (7B6F),HL  

+73C3 CD F1 79    ..y   CALL  79F1       

+73C6 FE 68       .h    CP    68         

+73C8 28 0C       (.    JR    Z,73D6     

+73CA FE 63       .c    CP    63         

+73CC 28 2D       (-    JR    Z,73FB     

+73CE FE 0D       ..    CP    0D         

+73D0 CA 98 74    ..t   JP    Z,7498     

+73D3 C3 29 71    .)q   JP    7129       

+73D6 CD A4 75    ..u   CALL  75A4       

+73D9 3E 20       >     LD    A,20       

+73DB CD A4 75    ..u   CALL  75A4       

+73DE 11 FA 7C    ..|   LD    DE,7CFA    

+73E1 06 00       ..    LD    B,00       

+73E3 C5          .     PUSH  BC         

+73E4 D5          .     PUSH  DE         

+73E5 CD B2 75    ..u   CALL  75B2       

+73E8 D1          .     POP   DE         

+73E9 C1          .     POP   BC         

+73EA F5          .     PUSH  AF         

+73EB 7D          }     LD    A,L        

+73EC 12          .     LD    (DE),A     

+73ED 13          .     INC   DE         

+73EE 04          .     INC   B          

+73EF F1          .     POP   AF         

+73F0 FE 0D       ..    CP    0D         

+73F2 20 EF        .    JR    NZ,73E3    

+73F4 ED 43 F8 7C .C.|  LD    (7CF8),BC  

+73F8 C3 98 74    ..t   JP    7498       

+73FB CD A4 75    ..u   CALL  75A4       

+73FE 3E 20       >     LD    A,20       

+7400 CD A4 75    ..u   CALL  75A4       

+7403 11 FA 7C    ..|   LD    DE,7CFA    

+7406 06 00       ..    LD    B,00       

+7408 CD F1 79    ..y   CALL  79F1       

+740B CD A4 75    ..u   CALL  75A4       

+740E FE 0D       ..    CP    0D         

+7410 CA F4 73    ..s   JP    Z,73F4     

+7413 12          .     LD    (DE),A     

+7414 13          .     INC   DE         

+7415 04          .     INC   B          

+7416 18 F0       ..    JR    7408       

+7418 2A 5C 7B    *\{   LD    HL,(7B5C)  

+741B 24          $     INC   H          

+741C 2E 00       ..    LD    L,00       

+741E 22 5C 7B    "\{   LD    (7B5C),HL  

+7421 20 04        .    JR    NZ,7427    

+7423 21 5E 7B    !^{   LD    HL,7B5E    

+7426 34          4     INC   (HL)       

+7427 2A 6F 7B    *o{   LD    HL,(7B6F)  

+742A 2B          +     DEC   HL         

+742B 7C          |     LD    A,H        

+742C B5          .     OR    L          

+742D CA 29 71    .)q   JP    Z,7129     

+7430 CD 20 6E    . n   CALL  6E20       

+7433 CD 98 6E    ..n   CALL  6E98       

+7436 38 06       8.    JR    C,743E     

+7438 CD 2A 6E    .*n   CALL  6E2A       

+743B C3 29 71    .)q   JP    7129       

+743E CD 2A 6E    .*n   CALL  6E2A       

+7441 22 6F 7B    "o{   LD    (7B6F),HL  

+7444 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7447 ED 5B 5E 7B .[^{  LD    DE,(7B5E)  

+744B CD 88 78    ..x   CALL  7888       

+744E CD 39 6F    .9o   CALL  6F39       

+7451 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7454 CB 3C       .<    SLR   H          

+7456 CE 00       ..    ADC   A,00       

+7458 67          g     LD    H,A        

+7459 06 00       ..    LD    B,00       

+745B 3E 00       >.    LD    A,00       

+745D 95          .     SUB   L          

+745E 20 02        .    JR    NZ,7462    

+7460 06 01       ..    LD    B,01       

+7462 4F          O     LD    C,A        

+7463 3A FA 7C    :.|   LD    A,(7CFA)   

+7466 ED B1       ..    CPIR             

+7468 C2 18 74    ..t   JP    NZ,7418    

+746B 7D          }     LD    A,L        

+746C 3D          =     DEC   A          

+746D 32 5C 7B    2\{   LD    (7B5C),A   

+7470 ED 4B F8 7C .K.|  LD    BC,(7CF8)  

+7474 05          .     DEC   B          

+7475 28 0E       (.    JR    Z,7485     

+7477 11 FB 7C    ..|   LD    DE,7CFB    

+747A 1A          .     LD    A,(DE)     

+747B BE          .     CP    (HL)       

+747C 20 1A        .    JR    NZ,7498    

+747E 13          .     INC   DE         

+747F 2C          ,     INC   L          

+7480 CC A2 74    ..t   CALL  Z,74A2     

+7483 10 F5       ..    DJNZ  747A       

+7485 3A 54 7B    :T{   LD    A,(7B54)   

+7488 3C          <     INC   A          

+7489 C2 5A 72    .Zr   JP    NZ,725A    

+748C 2A 5C 7B    *\{   LD    HL,(7B5C)  

+748F 01 FA 7C    ..|   LD    BC,7CFA    

+7492 B7          .     OR    A          

+7493 ED 42       .B    SBC   HL,BC      

+7495 C2 5A 72    .Zr   JP    NZ,725A    

+7498 2A 5C 7B    *\{   LD    HL,(7B5C)  

+749B 23          #     INC   HL         

+749C 22 5C 7B    "\{   LD    (7B5C),HL  

+749F C3 44 74    .Dt   JP    7444       

+74A2 D5          .     PUSH  DE         

+74A3 2A 5C 7B    *\{   LD    HL,(7B5C)  

+74A6 24          $     INC   H          

+74A7 CD 88 78    ..x   CALL  7888       

+74AA CD 39 6F    .9o   CALL  6F39       

+74AD 67          g     LD    H,A        

+74AE 2E 00       ..    LD    L,00       

+74B0 D1          .     POP   DE         

+74B1 C9          .     RET              

+74B2 FD 6E 16    .n.   LD    L,(IY+16)  

+74B5 FD 66 17    .f.   LD    H,(IY+17)  

+74B8 23          #     INC   HL         

+74B9 7E          ~     LD    A,(HL)     

+74BA FE 3C       .<    CP    3C         

+74BC 38 02       8.    JR    C,74C0     

+74BE 3E 3C       ><    LD    A,3C       

+74C0 4F          O     LD    C,A        

+74C1 C6 04       ..    ADD   A,04       

+74C3 12          .     LD    (DE),A     

+74C4 13          .     INC   DE         

+74C5 CD 0E 6E    ..n   CALL  6E0E       

+74C8 12          .     LD    (DE),A     

+74C9 13          .     INC   DE         

+74CA 3A 1A 6E    :.n   LD    A,(6E1A)   

+74CD E5          .     PUSH  HL         

+74CE 21 7F 78    !.x   LD    HL,787F    

+74D1 77          w     LD    (HL),A     

+74D2 3E 30       >0    LD    A,30       

+74D4 ED 6F       .o    RLD              

+74D6 FE 3A       .:    CP    3A         

+74D8 38 02       8.    JR    C,74DC     

+74DA C6 07       ..    ADD   A,07       

+74DC 12          .     LD    (DE),A     

+74DD 3E 30       >0    LD    A,30       

+74DF 13          .     INC   DE         

+74E0 ED 6F       .o    RLD              

+74E2 FE 3A       .:    CP    3A         

+74E4 38 02       8.    JR    C,74E8     

+74E6 C6 07       ..    ADD   A,07       

+74E8 12          .     LD    (DE),A     

+74E9 13          .     INC   DE         

+74EA 13          .     INC   DE         

+74EB E1          .     POP   HL         

+74EC 23          #     INC   HL         

+74ED 06 00       ..    LD    B,00       

+74EF ED B0       ..    LDIR             

+74F1 C9          .     RET              

+74F2 21 7B 78    !{x   LD    HL,787B    

+74F5 CD CA 6E    ..n   CALL  6ECA       

+74F8 21 D1 77    !.w   LD    HL,77D1    

+74FB CD CA 6E    ..n   CALL  6ECA       

+74FE 21 6B 7C    !k|   LD    HL,7C6B    

+7501 CD CA 6E    ..n   CALL  6ECA       

+7504 21 1C 6E    !.n   LD    HL,6E1C    

+7507 06 02       ..    LD    B,02       

+7509 CD 2D 75    .-u   CALL  752D       

+750C CD 82 75    ..u   CALL  7582       

+750F 21 14 78    !.x   LD    HL,7814    

+7512 CD CA 6E    ..n   CALL  6ECA       

+7515 2A 92 6F    *.o   LD    HL,(6F92)  

+7518 06 18       ..    LD    B,18       

+751A CD 2D 75    .-u   CALL  752D       

+751D CD 1C 7B    ..{   CALL  7B1C       

+7520 CD BE 79    ..y   CALL  79BE       

+7523 CD 82 75    ..u   CALL  7582       

+7526 21 61 78    !ax   LD    HL,7861    

+7529 CD CA 6E    ..n   CALL  6ECA       

+752C C9          .     RET              

+752D 04          .     INC   B          

+752E 05          .     DEC   B          

+752F C8          .     RET   Z          

+7530 3A 6C 78    :lx   LD    A,(786C)   

+7533 BD          .     CP    L          

+7534 20 0A        .    JR    NZ,7540    

+7536 3E 08       >.    LD    A,08       

+7538 CD A4 75    ..u   CALL  75A4       

+753B 3E 2D       >-    LD    A,2D       

+753D CD A4 75    ..u   CALL  75A4       

+7540 CD 56 75    .Vu   CALL  7556       

+7543 3A 6C 78    :lx   LD    A,(786C)   

+7546 BD          .     CP    L          

+7547 20 04        .    JR    NZ,754D    

+7549 3E 2D       >-    LD    A,2D       

+754B 18 02       ..    JR    754F       

+754D 3E 20       >     LD    A,20       

+754F CD A4 75    ..u   CALL  75A4       

+7552 23          #     INC   HL         

+7553 10 DB       ..    DJNZ  7530       

+7555 C9          .     RET              

+7556 E5          .     PUSH  HL         

+7557 4E          N     LD    C,(HL)     

+7558 21 7F 78    !.x   LD    HL,787F    

+755B 71          q     LD    (HL),C     

+755C D5          .     PUSH  DE         

+755D 3E 30       >0    LD    A,30       

+755F ED 6F       .o    RLD              

+7561 5F          _     LD    E,A        

+7562 FE 3A       .:    CP    3A         

+7564 38 05       8.    JR    C,756B     

+7566 C6 07       ..    ADD   A,07       

+7568 5F          _     LD    E,A        

+7569 3E 30       >0    LD    A,30       

+756B ED 6F       .o    RLD              

+756D 57          W     LD    D,A        

+756E FE 3A       .:    CP    3A         

+7570 38 03       8.    JR    C,7575     

+7572 C6 07       ..    ADD   A,07       

+7574 57          W     LD    D,A        

+7575 ED 53 CF 77 .S.w  LD    (77CF),DE  

+7579 21 CE 77    !.w   LD    HL,77CE    

+757C CD CA 6E    ..n   CALL  6ECA       

+757F D1          .     POP   DE         

+7580 E1          .     POP   HL         

+7581 C9          .     RET              

+7582 3E 4F       >O    LD    A,4F       

+7584 F5          .     PUSH  AF         

+7585 3A F1 6E    :.n   LD    A,(6EF1)   

+7588 CD 85 1E    ...   CALL  1E85       

+758B F1          .     POP   AF         

+758C 90          .     SUB   B          

+758D C8          .     RET   Z          

+758E D8          .     RET   C          

+758F 47          G     LD    B,A        

+7590 3E 20       >     LD    A,20       

+7592 CD A4 75    ..u   CALL  75A4       

+7595 10 F9       ..    DJNZ  7590       

+7597 C9          .     RET              

+7598 46          F     LD    B,(HL)     

+7599 05          .     DEC   B          

+759A 04          .     INC   B          

+759B C8          .     RET   Z          

+759C 23          #     INC   HL         

+759D 7E          ~     LD    A,(HL)     

+759E CD A4 75    ..u   CALL  75A4       

+75A1 10 F9       ..    DJNZ  759C       

+75A3 C9          .     RET              ;---------------------------- 

+75A4 F5          .     PUSH  AF         ; Zeichen in A ausgeben

+75A5 32 6E 78    2nx   LD    (786E),A   

+75A8 E5          .     PUSH  HL         

+75A9 21 6D 78    !mx   LD    HL,786D    

+75AC CD CA 6E    ..n   CALL  6ECA       

+75AF E1          .     POP   HL         

+75B0 F1          .     POP   AF         

+75B1 C9          .     RET              

+75B2 21 00 00    !..   LD    HL,0000    

+75B5 22 6F 78    "ox   LD    (786F),HL  

+75B8 22 71 78    "qx   LD    (7871),HL  

+75BB CD F1 79    ..y   CALL  79F1       

+75BE FE 03       ..    CP    03         

+75C0 CA 28 76    .(v   JP    Z,7628     

+75C3 18 03       ..    JR    75C8       

+75C5 CD F1 79    ..y   CALL  79F1       

+75C8 CD A4 75    ..u   CALL  75A4       ; Zeichen in A ausgeben

+75CB 21 6F 78    !ox   LD    HL,786F    

+75CE FE 3C       .<    CP    3C         

+75D0 28 24       ($    JR    Z,75F6     

+75D2 FE 3E       .>    CP    3E         

+75D4 28 2A       (*    JR    Z,7600     

+75D6 FE 69       .i    CP    69         

+75D8 28 32       (2    JR    Z,760C     

+75DA FE 30       .0    CP    30         

+75DC 38 44       8D    JR    C,7622     

+75DE FE 3A       .:    CP    3A         

+75E0 38 0A       8.    JR    C,75EC     

+75E2 FE 61       .a    CP    61         

+75E4 38 3C       8<    JR    C,7622     

+75E6 FE 67       .g    CP    67         

+75E8 30 38       08    JR    NC,7622    

+75EA C6 D9       ..    ADD   A,D9       

+75EC ED 6F       .o    RLD              

+75EE 23          #     INC   HL         

+75EF ED 6F       .o    RLD              

+75F1 23          #     INC   HL         

+75F2 ED 6F       .o    RLD              

+75F4 18 CF       ..    JR    75C5       

+75F6 CB 26       .&    SLA   (HL)       

+75F8 23          #     INC   HL         

+75F9 CB 16       ..    RL    (HL)       

+75FB 23          #     INC   HL         

+75FC CB 16       ..    RL    (HL)       

+75FE 18 C5       ..    JR    75C5       

+7600 23          #     INC   HL         

+7601 23          #     INC   HL         

+7602 CB 3E       .>    SLR   (HL)       

+7604 2B          +     DEC   HL         

+7605 CB 1E       ..    RR    (HL)       

+7607 2B          +     DEC   HL         

+7608 CB 1E       ..    RR    (HL)       

+760A 18 B9       ..    JR    75C5       

+760C 7E          ~     LD    A,(HL)     

+760D 32 71 78    2qx   LD    (7871),A   

+7610 2A 5C 7B    *\{   LD    HL,(7B5C)  

+7613 CD 8E 76    ..v   CALL  768E       

+7616 22 6F 78    "ox   LD    (786F),HL  

+7619 18 AA       ..    JR    75C5       

+761B 3E 07       >.    LD    A,07       

+761D CD A4 75    ..u   CALL  75A4       

+7620 18 90       ..    JR    75B2       

+7622 CB 81       ..    RES   0,C        

+7624 2A 6F 78    *ox   LD    HL,(786F)  

+7627 C9          .     RET              

+7628 3A 39 7B    :9{   LD    A,(7B39)   

+762B CB 47       .G    BIT   0,A        

+762D 28 EC       (.    JR    Z,761B     

+762F FD E5       ..    PUSH  IY         

+7631 21 78 7C    !x|   LD    HL,7C78    

+7634 CD CA 6E    ..n   CALL  6ECA       

+7637 FD 21 52 7B .!R{  LD    IY,7B52    

+763B 3A 3E 7B    :>{   LD    A,(7B3E)   

+763E 47          G     LD    B,A        

+763F FD 70 00    .p.   LD    (IY+00),B  

+7642 3E 03       >.    LD    A,03       

+7644 CD 93 78    ..x   CALL  7893       

+7647 2A 5C 7B    *\{   LD    HL,(7B5C)  

+764A CD 99 78    ..x   CALL  7899       

+764D ED 5B 5E 7B .[^{  LD    DE,(7B5E)  

+7651 CD F1 79    ..y   CALL  79F1       

+7654 FE 03       ..    CP    03         

+7656 CA A2 76    ..v   JP    Z,76A2     

+7659 FE 0A       ..    CP    0A         

+765B CA C0 76    ..v   JP    Z,76C0     

+765E FE 02       ..    CP    02         

+7660 CA E7 76    ..v   JP    Z,76E7     

+7663 FE 20       .     CP    20         

+7665 CA E7 76    ..v   JP    Z,76E7     

+7668 FE 08       ..    CP    08         

+766A CA 3E 77    .>w   JP    Z,773E     

+766D FE 01       ..    CP    01         

+766F 28 C0       (.    JR    Z,7631     

+7671 FE 30       .0    CP    30         

+7673 38 0E       8.    JR    C,7683     

+7675 FE 3A       .:    CP    3A         

+7677 DA 8F 77    ..w   JP    C,778F     

+767A FE 61       .a    CP    61         

+767C 38 05       8.    JR    C,7683     

+767E FE 67       .g    CP    67         

+7680 DA 8D 77    ..w   JP    C,778D     

+7683 FD E1       ..    POP   IY         

+7685 22 4E 7B    "N{   LD    (7B4E),HL  

+7688 CD 8E 76    ..v   CALL  768E       

+768B CB C1       ..    SET   0,C        

+768D C9          .     RET              

+768E F5          .     PUSH  AF         

+768F E5          .     PUSH  HL         

+7690 CD 88 78    ..x   CALL  7888       

+7693 CD 39 6F    .9o   CALL  6F39       

+7696 E1          .     POP   HL         

+7697 CB 3C       .<    SLR   H          

+7699 CE 00       ..    ADC   A,00       

+769B 67          g     LD    H,A        

+769C 7E          ~     LD    A,(HL)     

+769D 23          #     INC   HL         

+769E 66          f     LD    H,(HL)     

+769F 6F          o     LD    L,A        

+76A0 F1          .     POP   AF         

+76A1 C9          .     RET              

+76A2 3A 3E 7B    :>{   LD    A,(7B3E)   

+76A5 FD BE 00    ...   CP    (IY+00)    

+76A8 28 34       (4    JR    Z,76DE     

+76AA FD 34       .4    INC   (IY+00)    

+76AC 00          .     NOP              

+76AD 3E 03       >.    LD    A,03       

+76AF CD A4 75    ..u   CALL  75A4       

+76B2 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+76B6 B7          .     OR    A          

+76B7 ED 42       .B    SBC   HL,BC      

+76B9 D2 51 76    .Qv   JP    NC,7651    

+76BC 1D          .     DEC   E          

+76BD C3 51 76    .Qv   JP    7651       

+76C0 3E 01       >.    LD    A,01       

+76C2 FD BE 00    ...   CP    (IY+00)    

+76C5 CA DE 76    ..v   JP    Z,76DE     

+76C8 FD 35       .5    DEC   (IY+00)    

+76CA 00          .     NOP              

+76CB 3E 0A       >.    LD    A,0A       

+76CD CD A4 75    ..u   CALL  75A4       

+76D0 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+76D4 B7          .     OR    A          

+76D5 ED 4A       .J    ADC   HL,BC      

+76D7 D2 51 76    .Qv   JP    NC,7651    

+76DA 1C          .     INC   E          

+76DB C3 51 76    .Qv   JP    7651       

+76DE 3E 07       >.    LD    A,07       

+76E0 CD A4 75    ..u   CALL  75A4       

+76E3 3E 0D       >.    LD    A,0D       

+76E5 18 9C       ..    JR    7683       

+76E7 E5          .     PUSH  HL         

+76E8 E5          .     PUSH  HL         

+76E9 D5          .     PUSH  DE         

+76EA CD 88 78    ..x   CALL  7888       

+76ED CD 39 6F    .9o   CALL  6F39       

+76F0 D1          .     POP   DE         

+76F1 E1          .     POP   HL         

+76F2 CB 3C       .<    SLR   H          

+76F4 CE 00       ..    ADC   A,00       

+76F6 67          g     LD    H,A        

+76F7 CD 56 75    .Vu   CALL  7556       

+76FA 3E 20       >     LD    A,20       

+76FC CD A4 75    ..u   CALL  75A4       

+76FF E1          .     POP   HL         

+7700 7D          }     LD    A,L        

+7701 E6 0F       ..    AND   0F         

+7703 FE 0F       ..    CP    0F         

+7705 28 0D       (.    JR    Z,7714     

+7707 23          #     INC   HL         

+7708 FE 07       ..    CP    07         

+770A 20 05        .    JR    NZ,7711    

+770C 3E 20       >     LD    A,20       

+770E CD A4 75    ..u   CALL  75A4       

+7711 C3 51 76    .Qv   JP    7651       

+7714 3E 01       >.    LD    A,01       

+7716 FD BE 00    ...   CP    (IY+00)    

+7719 28 C3       (.    JR    Z,76DE     

+771B FD 35       .5    DEC   (IY+00)    

+771D 00          .     NOP              

+771E E5          .     PUSH  HL         

+771F 21 40 7B    !@{   LD    HL,7B40    

+7722 CD CA 6E    ..n   CALL  6ECA       

+7725 E1          .     POP   HL         

+7726 C5          .     PUSH  BC         

+7727 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+772B 03          .     INC   BC         

+772C 09          .     ADD   HL,BC      

+772D D2 31 77    .1w   JP    NC,7731    

+7730 1C          .     INC   E          

+7731 01 10 00    ...   LD    BC,0010    

+7734 B7          .     OR    A          

+7735 ED 42       .B    SBC   HL,BC      

+7737 30 01       0.    JR    NC,773A    

+7739 1D          .     DEC   E          

+773A C1          .     POP   BC         

+773B C3 51 76    .Qv   JP    7651       

+773E 7D          }     LD    A,L        

+773F E6 0F       ..    AND   0F         

+7741 FE 00       ..    CP    00         

+7743 28 1A       (.    JR    Z,775F     

+7745 2B          +     DEC   HL         

+7746 FE 08       ..    CP    08         

+7748 28 0E       (.    JR    Z,7758     

+774A 3E 08       >.    LD    A,08       

+774C CD A4 75    ..u   CALL  75A4       

+774F CD A4 75    ..u   CALL  75A4       

+7752 CD A4 75    ..u   CALL  75A4       

+7755 C3 51 76    .Qv   JP    7651       

+7758 3E 08       >.    LD    A,08       

+775A CD A4 75    ..u   CALL  75A4       

+775D 18 EB       ..    JR    774A       

+775F 3A 3E 7B    :>{   LD    A,(7B3E)   

+7762 FD BE 00    ...   CP    (IY+00)    

+7765 CA DE 76    ..v   JP    Z,76DE     

+7768 FD 34       .4    INC   (IY+00)    

+776A 00          .     NOP              

+776B E5          .     PUSH  HL         

+776C 3E 03       >.    LD    A,03       

+776E CD A4 75    ..u   CALL  75A4       

+7771 06 2E       ..    LD    B,2E       

+7773 CD 91 78    ..x   CALL  7891       

+7776 E1          .     POP   HL         

+7777 C5          .     PUSH  BC         

+7778 ED 4B 3A 7B .K:{  LD    BC,(7B3A)  

+777C B7          .     OR    A          

+777D ED 42       .B    SBC   HL,BC      

+777F 30 01       0.    JR    NC,7782    

+7781 1D          .     DEC   E          

+7782 01 0F 00    ...   LD    BC,000F    

+7785 09          .     ADD   HL,BC      

+7786 30 01       0.    JR    NC,7789    

+7788 1C          .     INC   E          

+7789 C1          .     POP   BC         

+778A C3 51 76    .Qv   JP    7651       

+778D C6 D9       ..    ADD   A,D9       

+778F C5          .     PUSH  BC         

+7790 E6 0F       ..    AND   0F         

+7792 87          .     ADD   A          

+7793 87          .     ADD   A          

+7794 87          .     ADD   A          

+7795 87          .     ADD   A          

+7796 47          G     LD    B,A        

+7797 CD F1 79    ..y   CALL  79F1       

+779A FE 3A       .:    CP    3A         

+779C 38 0A       8.    JR    C,77A8     

+779E FE 61       .a    CP    61         

+77A0 38 E7       8.    JR    C,7789     

+77A2 FE 67       .g    CP    67         

+77A4 30 E3       0.    JR    NC,7789    

+77A6 C6 D9       ..    ADD   A,D9       

+77A8 E6 0F       ..    AND   0F         

+77AA B0          .     OR    B          

+77AB C1          .     POP   BC         

+77AC E5          .     PUSH  HL         

+77AD F5          .     PUSH  AF         

+77AE E5          .     PUSH  HL         

+77AF D5          .     PUSH  DE         

+77B0 CD 88 78    ..x   CALL  7888       

+77B3 CD DF 6F    ..o   CALL  6FDF       

+77B6 D1          .     POP   DE         

+77B7 E1          .     POP   HL         

+77B8 CB 3C       .<    SLR   H          

+77BA CE 00       ..    ADC   A,00       

+77BC 67          g     LD    H,A        

+77BD F1          .     POP   AF         

+77BE 77          w     LD    (HL),A     

+77BF CD 56 75    .Vu   CALL  7556       

+77C2 06 02       ..    LD    B,02       

+77C4 3E 08       >.    LD    A,08       

+77C6 CD 93 78    ..x   CALL  7893       

+77C9 E1          .     POP   HL         

+77CA C3 51 76    .Qv   JP    7651       

+77CD 01 02 00    ...   LD    BC,0002    

+77D0 00          .     NOP              

+77D1 00          .     NOP              

+77D2 00          .     NOP              

+77D3 20 20             JR    NZ,77F5    

+77D5 20 20             JR    NZ,77F7    

+77D7 20 FF        .    JR    NZ,77D8    

+77D9 FF          .     RST   38         

+77DA FF          .     RST   38         

+77DB FF          .     RST   38         

+77DC FF          .     RST   38         

+77DD FF          .     RST   38         

+77DE FF          .     RST   38         

+77DF FF          .     RST   38         

+77E0 FF          .     RST   38         

+77E1 FF          .     RST   38         

+77E2 FF          .     RST   38         

+77E3 FF          .     RST   38         

+77E4 FF          .     RST   38         

+77E5 FF          .     RST   38         

+77E6 FF          .     RST   38         

+77E7 FF          .     RST   38         

+77E8 FF          .     RST   38         

+77E9 FF          .     RST   38         

+77EA FF          .     RST   38         

+77EB FF          .     RST   38         

+77EC FF          .     RST   38         

+77ED FF          .     RST   38         

+77EE FF          .     RST   38         

+77EF FF          .     RST   38         

+77F0 FF          .     RST   38         

+77F1 FF          .     RST   38         

+77F2 FF          .     RST   38         

+77F3 FF          .     RST   38         

+77F4 FF          .     RST   38         

+77F5 FF          .     RST   38         

+77F6 FF          .     RST   38         

+77F7 FF          .     RST   38         

+77F8 FF          .     RST   38         

+77F9 FF          .     RST   38         

+77FA FF          .     RST   38         

+77FB FF          .     RST   38         

+77FC FF          .     RST   38         

+77FD FF          .     RST   38         

+77FE FF          .     RST   38         

+77FF FF          .     RST   38         

+7800 FF          .     RST   38         

+7801 FF          .     RST   38         

+7802 FF          .     RST   38         

+7803 FF          .     RST   38         

+7804 FF          .     RST   38         

+7805 FF          .     RST   38         

+7806 FF          .     RST   38         

+7807 FF          .     RST   38         

+7808 FF          .     RST   38         

+7809 FF          .     RST   38         

+780A FF          .     RST   38         

+780B FF          .     RST   38         

+780C FF          .     RST   38         

+780D FF          .     RST   38         

+780E FF          .     RST   38         

+780F FF          .     RST   38         

+7810 FF          .     RST   38         

+7811 FF          .     RST   38         

+7812 FF          .     RST   38         

+7813 FF          .     RST   38         

+7814 4B          K     LD    C,E        

+7815 01 0D 0A    ...   LD    BC,0A0D    

+7818 20 46        F    JR    NZ,7860    

+781A 20 20             JR    NZ,783C    

+781C 41          A     LD    B,C        

+781D 20 20             JR    NZ,783F    

+781F 43          C     LD    B,E        

+7820 20 20             JR    NZ,7842    

+7822 42          B     LD    B,D        

+7823 20 20             JR    NZ,7845    

+7825 45          E     LD    B,L        

+7826 20 20             JR    NZ,7848    

+7828 44          D     LD    B,H        

+7829 20 20             JR    NZ,784B    

+782B 4C          L     LD    C,H        

+782C 20 20             JR    NZ,784E    

+782E 48          H     LD    C,B        

+782F 20 20             JR    NZ,7851    

+7831 46          F     LD    B,(HL)     

+7832 20 20             JR    NZ,7854    

+7834 41          A     LD    B,C        

+7835 20 20             JR    NZ,7857    

+7837 43          C     LD    B,E        

+7838 20 20             JR    NZ,785A    

+783A 42          B     LD    B,D        

+783B 20 20             JR    NZ,785D    

+783D 45          E     LD    B,L        

+783E 20 20             JR    NZ,7860    

+7840 44          D     LD    B,H        

+7841 20 20             JR    NZ,7863    

+7843 4C          L     LD    C,H        

+7844 20 20             JR    NZ,7866    

+7846 48          H     LD    C,B        

+7847 20 20             JR    NZ,7869    

+7849 49          I     LD    C,C        

+784A 58          X     LD    E,B        

+784B 20 20             JR    NZ,786D    

+784D 20 20             JR    NZ,786F    

+784F 53          S     LD    D,E        

+7850 50          P     LD    D,B        

+7851 20 20             JR    NZ,7873    

+7853 20 20             JR    NZ,7875    

+7855 49          I     LD    C,C        

+7856 59          Y     LD    E,C        

+7857 20 20             JR    NZ,7879    

+7859 20 20             JR    NZ,787B    

+785B 50          P     LD    D,B        

+785C 43          C     LD    B,E        

+785D 0D          .     DEC   C          

+785E 0A          .     LD    A,(BC)     

+785F 20 00        .    JR    NZ,7861    

+7861 0A          .     LD    A,(BC)     

+7862 06 16       ..    LD    B,16       

+7864 00          .     NOP              

+7865 0D          .     DEC   C          

+7866 0A          .     LD    A,(BC)     

+7867 69          i     LD    L,C        

+7868 6E          n     LD    L,(HL)     

+7869 66          f     LD    H,(HL)     

+786A 6F          o     LD    L,A        

+786B 3A 00 01    :..   LD    A,(0100)   

+786E 00          .     NOP              

+786F 00          .     NOP              

+7870 00          .     NOP              

+7871 00          .     NOP              

+7872 00          .     NOP              

+7873 00          .     NOP              

+7874 00          .     NOP              

+7875 00          .     NOP              

+7876 00          .     NOP              

+7877 00          .     NOP              

+7878 00          .     NOP              

+7879 00          .     NOP              

+787A 00          .     NOP              

+787B 03          .     INC   BC         

+787C 0A          .     LD    A,(BC)     

+787D 01 0D 00    ...   LD    BC,000D    

+7880 03          .     INC   BC         

+7881 06 16       ..    LD    B,16       

+7883 07          .     RLCA             

+7884 2A 00 00    *..   LD    HL,(0000)  

+7887 C9          .     RET              

+7888 CB 3B       .;    SLR   E          

+788A CB 1C       ..    RR    H          

+788C 3A 54 7B    :T{   LD    A,(7B54)   

+788F 57          W     LD    D,A        

+7890 C9          .     RET              

+7891 3E 02       >.    LD    A,02       

+7893 CD A4 75    ..u   CALL  75A4       

+7896 10 FB       ..    DJNZ  7893       

+7898 C9          .     RET              

+7899 7D          }     LD    A,L        

+789A E6 0F       ..    AND   0F         

+789C C5          .     PUSH  BC         

+789D 47          G     LD    B,A        

+789E CB 17       ..    RL    A          

+78A0 80          .     ADD   B          

+78A1 C6 08       ..    ADD   A,08       

+78A3 FE 20       .     CP    20         

+78A5 38 01       8.    JR    C,78A8     

+78A7 3C          <     INC   A          

+78A8 47          G     LD    B,A        

+78A9 3E 0D       >.    LD    A,0D       

+78AB CD A4 75    ..u   CALL  75A4       

+78AE CD 91 78    ..x   CALL  7891       

+78B1 C1          .     POP   BC         

+78B2 C9          .     RET              ;----- y - Infokommandos

+78B3 E5          .     PUSH  HL         

+78B4 3E 20       >     LD    A,20       

+78B6 CD A4 75    ..u   CALL  75A4       

+78B9 CD F1 79    ..y   CALL  79F1       

+78BC E1          .     POP   HL         

+78BD FE 0D       ..    CP    0D         ; CR zum lernen

+78BF CA 62 72    .br   JP    Z,7262     

+78C2 FE 50       .P    CP    50         ; P neues Passwort

+78C4 CA DC 7A    ..z   JP    Z,7ADC     

+78C7 FE 6C       .l    CP    6C         ; l Lernmodus an

+78C9 CA 86 79    ..y   JP    Z,7986     

+78CC FE 65       .e    CP    65         ; Lernmodus aus

+78CE CA 8F 79    ..y   JP    Z,798F     

+78D1 FE 61       .a    CP    61         ; Ausfuehren (gelerntes)

+78D3 CA B5 79    ..y   JP    Z,79B5     

+78D6 FE 69       .i    CP    69         ; yi = increment beim dump setzen

+78D8 CA 17 79    ..y   JP    Z,7917     

+78DB FE 74       .t    CP    74         ; t Block vom Archiv lesen

+78DD CA 6F 73    .os   JP    Z,736F     

+78E0 FE 66       .f    CP    66         ; yf lernmodus (zuruecksetzen?)

+78E2 CA A4 79    ..y   JP    Z,79A4     

+78E5 FE 62       .b    CP    62         ; b Breakpoint 1

+78E7 CA 1D 79    ..y   JP    Z,791D     

+78EA FE 63       .c    CP    63         ; c Breakpoint 2

+78EC CA 52 79    .Ry   JP    Z,7952     

+78EF FE 77       .w    CP    77         ; w Zum anderen Miniprozess

+78F1 28 03       (.    JR    Z,78F6     

+78F3 C3 29 71    .)q   JP    7129       ; beep

+78F6 7C          |     LD    A,H        

+78F7 B5          .     OR    L          

+78F8 28 03       (.    JR    Z,78FD     

+78FA 22 25 7D    "%}   LD    (7D25),HL  

+78FD ED 5B 25 7D .[%}  LD    DE,(7D25)  

+7901 2A 23 7D    *#}   LD    HL,(7D23)  

+7904 7C          |     LD    A,H        

+7905 3C          <     INC   A          

+7906 CA 29 71    .)q   JP    Z,7129     

+7909 3E 1F       >.    LD    A,1F       

+790B 01 00 00    ...   LD    BC,0000    

+790E CD 81 28    ..(   CALL  2881       

+7911 2A 23 7D    *#}   LD    HL,(7D23)  

+7914 C3 B0 73    ..s   JP    73B0       

+7917 22 3A 7B    ":{   LD    (7B3A),HL  

+791A C3 D4 70    ..p   JP    70D4       

+791D CB 41       .A    BIT   0,C        

+791F CA 25 79    .%y   JP    Z,7925     

+7922 2A 4E 7B    *N{   LD    HL,(7B4E)  

+7925 E5          .     PUSH  HL         

+7926 21 53 7A    !Sz   LD    HL,7A53    

+7929 7E          ~     LD    A,(HL)     

+792A B7          .     OR    A          

+792B CA 37 79    .7y   JP    Z,7937     

+792E ED 5B 56 7A .[Vz  LD    DE,(7A56)  

+7932 01 03 00    ...   LD    BC,0003    

+7935 ED B0       ..    LDIR             

+7937 E1          .     POP   HL         

+7938 22 56 7A    "Vz   LD    (7A56),HL  

+793B 11 53 7A    .Sz   LD    DE,7A53    

+793E 01 03 00    ...   LD    BC,0003    

+7941 ED B0       ..    LDIR             

+7943 ED 5B 56 7A .[Vz  LD    DE,(7A56)  

+7947 21 50 7A    !Pz   LD    HL,7A50    

+794A 01 03 00    ...   LD    BC,0003    

+794D ED B0       ..    LDIR             

+794F C3 D4 70    ..p   JP    70D4       

+7952 CB 41       .A    BIT   0,C        

+7954 CA 5A 79    .Zy   JP    Z,795A     

+7957 2A 4E 7B    *N{   LD    HL,(7B4E)  

+795A E5          .     PUSH  HL         

+795B ED 5B F1 7A .[.z  LD    DE,(7AF1)  

+795F 21 01 7B    !.{   LD    HL,7B01    

+7962 01 03 00    ...   LD    BC,0003    

+7965 ED B0       ..    LDIR             

+7967 E1          .     POP   HL         

+7968 11 01 7B    ..{   LD    DE,7B01    

+796B 22 F1 7A    ".z   LD    (7AF1),HL  

+796E 01 03 00    ...   LD    BC,0003    

+7971 ED B0       ..    LDIR             

+7973 ED 5B F1 7A .[.z  LD    DE,(7AF1)  

+7977 21 F3 7A    !.z   LD    HL,7AF3    

+797A 01 03 00    ...   LD    BC,0003    

+797D ED B0       ..    LDIR             

+797F ED 53 05 7B .S.{  LD    (7B05),DE  

+7983 C3 D4 70    ..p   JP    70D4       

+7986 21 CE 7C    !.|   LD    HL,7CCE    

+7989 22 97 7C    ".|   LD    (7C97),HL  

+798C C3 D4 70    ..p   JP    70D4       

+798F 2A 97 7C    *.|   LD    HL,(7C97)  

+7992 7C          |     LD    A,H        

+7993 B5          .     OR    L          

+7994 CA 29 71    .)q   JP    Z,7129     

+7997 2B          +     DEC   HL         

+7998 2B          +     DEC   HL         

+7999 36 FF       6.    LD    (HL),FF    

+799B 21 00 00    !..   LD    HL,0000    

+799E 22 97 7C    ".|   LD    (7C97),HL  

+79A1 C3 D4 70    ..p   JP    70D4       

+79A4 2A 99 7C    *.|   LD    HL,(7C99)  

+79A7 7C          |     LD    A,H        

+79A8 B5          .     OR    L          

+79A9 C2 29 71    .)q   JP    NZ,7129    

+79AC 2A 9D 7C    *.|   LD    HL,(7C9D)  

+79AF 22 99 7C    ".|   LD    (7C99),HL  

+79B2 C3 D4 70    ..p   JP    70D4       

+79B5 21 CE 7C    !.|   LD    HL,7CCE    

+79B8 22 99 7C    ".|   LD    (7C99),HL  

+79BB C3 D4 70    ..p   JP    70D4       

+79BE 21 CE 7C    !.|   LD    HL,7CCE    

+79C1 7E          ~     LD    A,(HL)     

+79C2 FE FF       ..    CP    FF         

+79C4 C8          .     RET   Z          

+79C5 E5          .     PUSH  HL         

+79C6 ED 4B 99 7C .K.|  LD    BC,(7C99)  

+79CA 78          x     LD    A,B        

+79CB B1          .     OR    C          

+79CC 20 04        .    JR    NZ,79D2    

+79CE ED 4B 9D 7C .K.|  LD    BC,(7C9D)  

+79D2 B7          .     OR    A          

+79D3 ED 42       .B    SBC   HL,BC      

+79D5 20 06        .    JR    NZ,79DD    

+79D7 21 9F 7C    !.|   LD    HL,7C9F    

+79DA CD CA 6E    ..n   CALL  6ECA       

+79DD E1          .     POP   HL         

+79DE 7E          ~     LD    A,(HL)     

+79DF FE 20       .     CP    20         

+79E1 30 08       0.    JR    NC,79EB    

+79E3 3E 25       >%    LD    A,25       

+79E5 CD A4 75    ..u   CALL  75A4       

+79E8 7E          ~     LD    A,(HL)     

+79E9 C6 40       .@    ADD   A,40       

+79EB CD A4 75    ..u   CALL  75A4       

+79EE 23          #     INC   HL         

+79EF 18 D0       ..    JR    79C1       

+79F1 E5          .     PUSH  HL         

+79F2 2A 99 7C    *.|   LD    HL,(7C99)  

+79F5 7C          |     LD    A,H        

+79F6 B5          .     OR    L          

+79F7 28 16       (.    JR    Z,7A0F     

+79F9 7E          ~     LD    A,(HL)     

+79FA FE FF       ..    CP    FF         

+79FC 20 0B        .    JR    NZ,7A09    

+79FE 21 00 00    !..   LD    HL,0000    

+7A01 22 99 7C    ".|   LD    (7C99),HL  

+7A04 22 9D 7C    ".|   LD    (7C9D),HL  

+7A07 18 06       ..    JR    7A0F       

+7A09 23          #     INC   HL         

+7A0A 22 99 7C    ".|   LD    (7C99),HL  

+7A0D E1          .     POP   HL         

+7A0E C9          .     RET              

+7A0F CD 9E 6E    ..n   CALL  6E9E       

+7A12 F5          .     PUSH  AF         

+7A13 2A 97 7C    *.|   LD    HL,(7C97)  

+7A16 7C          |     LD    A,H        

+7A17 B5          .     OR    L          

+7A18 28 1D       (.    JR    Z,7A37     

+7A1A B7          .     OR    A          

+7A1B 01 F7 7C    ..|   LD    BC,7CF7    

+7A1E ED 42       .B    SBC   HL,BC      

+7A20 38 0C       8.    JR    C,7A2E     

+7A22 21 7C 7C    !||   LD    HL,7C7C    

+7A25 CD CA 6E    ..n   CALL  6ECA       

+7A28 21 00 00    !..   LD    HL,0000    

+7A2B F1          .     POP   AF         

+7A2C 18 04       ..    JR    7A32       

+7A2E F1          .     POP   AF         

+7A2F 09          .     ADD   HL,BC      

+7A30 77          w     LD    (HL),A     

+7A31 23          #     INC   HL         

+7A32 22 97 7C    ".|   LD    (7C97),HL  

+7A35 E1          .     POP   HL         

+7A36 C9          .     RET              

+7A37 F1          .     POP   AF         

+7A38 E1          .     POP   HL         

+7A39 C9          .     RET              

+7A3A E5          .     PUSH  HL         

+7A3B 2B          +     DEC   HL         

+7A3C 4E          N     LD    C,(HL)     

+7A3D 23          #     INC   HL         

+7A3E 06 00       ..    LD    B,00       

+7A40 09          .     ADD   HL,BC      

+7A41 C5          .     PUSH  BC         

+7A42 CD CA 6E    ..n   CALL  6ECA       

+7A45 C1          .     POP   BC         

+7A46 E1          .     POP   HL         

+7A47 41          A     LD    B,C        

+7A48 CD 2D 75    .-u   CALL  752D       

+7A4B 3E 20       >     LD    A,20       

+7A4D C3 A4 75    ..u   JP    75A4       

+7A50 CD 58 7A    .Xz   CALL  7A58       

+7A53 00          .     NOP              

+7A54 00          .     NOP              

+7A55 00          .     NOP              

+7A56 00          .     NOP              

+7A57 00          .     NOP              

+7A58 CD 1F 70    ..p   CALL  701F       

+7A5B 18 04       ..    JR    7A61       

+7A5D 74          t     LD    (HL),H     ; "test"

+7A5E 65          e     LD    H,L        

+7A5F 73          s     LD    (HL),E     

+7A60 74          t     LD    (HL),H     

+7A61 FD E5       ..    PUSH  IY         

+7A63 F5          .     PUSH  AF         

+7A64 FD 21 00 00 .!..  LD    IY,0000    

+7A68 FD 39       .9    ADD   IY,SP      

+7A6A E5          .     PUSH  HL         

+7A6B D5          .     PUSH  DE         

+7A6C C5          .     PUSH  BC         

+7A6D FD 7E 04    .~.   LD    A,(IY+04)  

+7A70 D6 03       ..    SUB   A,03       

+7A72 FD 77 04    .w.   LD    (IY+04),A  

+7A75 30 03       0.    JR    NC,7A7A    

+7A77 FD 35       .5    DEC   (IY+05)    

+7A79 05          .     DEC   B          

+7A7A ED 5B 56 7A .[Vz  LD    DE,(7A56)  

+7A7E 21 53 7A    !Sz   LD    HL,7A53    

+7A81 01 03 00    ...   LD    BC,0003    

+7A84 ED B0       ..    LDIR             

+7A86 C1          .     POP   BC         

+7A87 D1          .     POP   DE         

+7A88 E1          .     POP   HL         

+7A89 F1          .     POP   AF         

+7A8A FD E1       ..    POP   IY         

+7A8C C9          .     RET              

+7A8D 21 FA 7C    !.|   LD    HL,7CFA    

+7A90 06 0A       ..    LD    B,0A       

+7A92 CD F1 79    ..y   CALL  79F1       

+7A95 77          w     LD    (HL),A     

+7A96 23          #     INC   HL         

+7A97 FE 0D       ..    CP    0D         

+7A99 28 05       (.    JR    Z,7AA0     

+7A9B 10 F5       ..    DJNZ  7A92       

+7A9D C3 29 71    .)q   JP    7129       

+7AA0 21 FA 7C    !.|   LD    HL,7CFA    

+7AA3 CD B1 7A    ..z   CALL  7AB1       

+7AA6 C2 29 71    .)q   JP    NZ,7129    

+7AA9 3E 01       >.    LD    A,01       

+7AAB 32 18 7D    2.}   LD    (7D18),A   

+7AAE C3 D4 70    ..p   JP    70D4       

+7AB1 E5          .     PUSH  HL         

+7AB2 21 19 7D    !.}   LD    HL,7D19    

+7AB5 11 1A 7D    ..}   LD    DE,7D1A    

+7AB8 01 09 00    ...   LD    BC,0009    

+7ABB 1A          .     LD    A,(DE)     

+7ABC ED A1       ..    CPI              

+7ABE 13          .     INC   DE         

+7ABF 20 05        .    JR    NZ,7AC6    

+7AC1 EA BB 7A    ..z   JP    PE,7ABB    

+7AC4 18 14       ..    JR    7ADA       

+7AC6 D1          .     POP   DE         

+7AC7 21 19 7D    !.}   LD    HL,7D19    

+7ACA 1A          .     LD    A,(DE)     

+7ACB 13          .     INC   DE         

+7ACC FE 0D       ..    CP    0D         

+7ACE 28 06       (.    JR    Z,7AD6     

+7AD0 2F          /     CPL              

+7AD1 ED A1       ..    CPI              

+7AD3 28 F5       (.    JR    Z,7ACA     

+7AD5 C9          .     RET              

+7AD6 2F          /     CPL              

+7AD7 ED A1       ..    CPI              

+7AD9 C9          .     RET              

+7ADA E1          .     POP   HL         

+7ADB C9          .     RET              

+7ADC 21 19 7D    !.}   LD    HL,7D19    

+7ADF 06 0A       ..    LD    B,0A       

+7AE1 CD F1 79    ..y   CALL  79F1       

+7AE4 2F          /     CPL              

+7AE5 77          w     LD    (HL),A     

+7AE6 FE F2       ..    CP    F2         

+7AE8 CA D4 70    ..p   JP    Z,70D4     

+7AEB 23          #     INC   HL         

+7AEC 10 F3       ..    DJNZ  7AE1       

+7AEE C3 29 71    .)q   JP    7129       

+7AF1 01 7B C3    .{.   LD    BC,C37B    

+7AF4 F6 7A       .z    OR    7A         

+7AF6 CD 1F 70    ..p   CALL  701F       

+7AF9 18 06       ..    JR    7B01       

+7AFB 20 74        t    JR    NZ,7B71    ; " test2"

+7AFD 65          e     LD    H,L        

+7AFE 73          s     LD    (HL),E     

+7AFF 74          t     LD    (HL),H     

+7B00 32 21 00    2!.   LD    (0021),A   

+7B03 00          .     NOP              

+7B04 C3 F6 7A    ..z   JP    7AF6       

+7B07 CD 26 7B    .&{   CALL  7B26       

+7B0A E5          .     PUSH  HL         

+7B0B D5          .     PUSH  DE         

+7B0C C5          .     PUSH  BC         

+7B0D F5          .     PUSH  AF         

+7B0E 21 00 00    !..   LD    HL,0000    

+7B11 39          9     ADD   HL,SP      

+7B12 06 08       ..    LD    B,08       

+7B14 CD 2D 75    .-u   CALL  752D       

+7B17 F1          .     POP   AF         

+7B18 C1          .     POP   BC         

+7B19 D1          .     POP   DE         

+7B1A E1          .     POP   HL         

+7B1B C9          .     RET              

+7B1C 3E 0A       >.    LD    A,0A       

+7B1E CD A4 75    ..u   CALL  75A4       

+7B21 3E 0D       >.    LD    A,0D       

+7B23 C3 A4 75    ..u   JP    75A4       

+7B26 C9          .     RET              

+7B27 C9          .     RET              

+7B28 C9          .     RET              

+7B29 C9          .     RET              

+7B2A C9          .     RET              

+7B2B C9          .     RET              

+7B2C C9          .     RET              

+7B2D C9          .     RET              

+7B2E C9          .     RET              

+7B2F C9          .     RET              

+7B30 C9          .     RET              

+7B31 C9          .     RET              

+7B32 C9          .     RET              

+7B33 C9          .     RET              

+7B34 C9          .     RET              

+7B35 C9          .     RET              

+7B36 C9          .     RET              

+7B37 C9          .     RET              

+7B38 C9          .     RET              

+7B39 00          .     NOP              

+7B3A 10 00       ..    DJNZ  7B3C       

+7B3C 00          .     NOP              

+7B3D 00          .     NOP              

+7B3E 00          .     NOP              

+7B3F 00          .     NOP              

+7B40 0A          .     LD    A,(BC)     ; info Dumpueberschrift

+7B41 0A          .     LD    A,(BC)     

+7B42 0D          .     DEC   C          

+7B43 02          .     LD    (BC),A     

+7B44 02          .     LD    (BC),A     

+7B45 02          .     LD    (BC),A     

+7B46 02          .     LD    (BC),A     

+7B47 02          .     LD    (BC),A     

+7B48 02          .     LD    (BC),A     

+7B49 02          .     LD    (BC),A     

+7B4A 02          .     LD    (BC),A     

+7B4B 00          .     NOP              

+7B4C 00          .     NOP              

+7B4D 00          .     NOP              

+7B4E 00          .     NOP              

+7B4F 00          .     NOP              

+7B50 00          .     NOP              

+7B51 00          .     NOP              

+7B52 00          .     NOP              

+7B53 01 FF 05    ...   LD    BC,05FF    

+7B56 64          d     LD    H,H        

+7B57 73          s     LD    (HL),E     

+7B58 69          i     LD    L,C        

+7B59 64          d     LD    H,H        

+7B5A 3D          =     DEC   A          

+7B5B 03          .     INC   BC         

+7B5C 00          .     NOP              

+7B5D 00          .     NOP              

+7B5E 00          .     NOP              

+7B5F 04          .     INC   B          

+7B60 61          a     LD    H,C        

+7B61 64          d     LD    H,H        

+7B62 72          r     LD    (HL),D     

+7B63 3D          =     DEC   A          

+7B64 02          .     LD    (BC),A     

+7B65 00          .     NOP              

+7B66 00          .     NOP              

+7B67 07          .     RLCA             

+7B68 6C          l     LD    L,H        

+7B69 61          a     LD    H,C        

+7B6A 65          e     LD    H,L        

+7B6B 6E          n     LD    L,(HL)     

+7B6C 67          g     LD    H,A        

+7B6D 65          e     LD    H,L        

+7B6E 3D          =     DEC   A          

+7B6F 00          .     NOP              

+7B70 00          .     NOP              

+7B71 00          .     NOP              

+7B72 00          .     NOP              

+7B73 04          .     INC   B          ; Leitblock Ueberschrift

+7B74 06 77       .w    LD    B,77       

+7B76 73          s     LD    (HL),E     

+7B77 74          t     LD    (HL),H     

+7B78 61          a     LD    H,C        

+7B79 74          t     LD    (HL),H     

+7B7A 65          e     LD    H,L        

+7B7B 04          .     INC   B          

+7B7C 01 06 6D    ..m   LD    BC,6D06    

+7B7F 69          i     LD    L,C        

+7B80 6C          l     LD    L,H        

+7B81 6C          l     LD    L,H        

+7B82 69          i     LD    L,C        

+7B83 73          s     LD    (HL),E     

+7B84 05          .     DEC   B          

+7B85 01 06 63    ..c   LD    BC,6306    

+7B88 6F          o     LD    L,A        

+7B89 6D          m     LD    L,L        

+7B8A 66          f     LD    H,(HL)     

+7B8B 6C          l     LD    L,H        

+7B8C 67          g     LD    H,A        

+7B8D 06 01       ..    LD    B,01       

+7B8F 06 72       .r    LD    B,72       

+7B91 73          s     LD    (HL),E     

+7B92 74          t     LD    (HL),H     

+7B93 63          c     LD    H,E        

+7B94 6F          o     LD    L,A        

+7B95 64          d     LD    H,H        

+7B96 07          .     RLCA             

+7B97 01 06 72    ..r   LD    BC,7206    

+7B9A 73          s     LD    (HL),E     

+7B9B 74          t     LD    (HL),H     

+7B9C 66          f     LD    H,(HL)     

+7B9D 6C          l     LD    L,H        

+7B9E 67          g     LD    H,A        

+7B9F 08          .     EX    AF,AF'     

+7BA0 01 06 70    ..p   LD    BC,7006    

+7BA3 72          r     LD    (HL),D     

+7BA4 69          i     LD    L,C        

+7BA5 63          c     LD    H,E        

+7BA6 6E          n     LD    L,(HL)     

+7BA7 74          t     LD    (HL),H     

+7BA8 09          .     ADD   HL,BC      

+7BA9 03          .     INC   BC         

+7BAA 06 69       .i    LD    B,69       

+7BAC 63          c     LD    H,E        

+7BAD 6F          o     LD    L,A        

+7BAE 75          u     LD    (HL),L     

+7BAF 6E          n     LD    L,(HL)     

+7BB0 74          t     LD    (HL),H     

+7BB1 0C          .     INC   C          

+7BB2 02          .     LD    (BC),A     

+7BB3 04          .     INC   B          

+7BB4 6D          m     LD    L,L        

+7BB5 6F          o     LD    L,A        

+7BB6 64          d     LD    H,H        

+7BB7 69          i     LD    L,C        

+7BB8 0E 01       ..    LD    C,01       

+7BBA 04          .     INC   B          

+7BBB 70          p     LD    (HL),B     

+7BBC 62          b     LD    H,D        

+7BBD 61          a     LD    H,C        

+7BBE 73          s     LD    (HL),E     

+7BBF 0F          .     RRCA             

+7BC0 01 03 63    ..c   LD    BC,6303    

+7BC3 38 6B       8k    JR    C,7C30     

+7BC5 10 02       ..    DJNZ  7BC9       

+7BC7 04          .     INC   B          

+7BC8 6C          l     LD    L,H        

+7BC9 62          b     LD    H,D        

+7BCA 61          a     LD    H,C        

+7BCB 73          s     LD    (HL),E     

+7BCC 12          .     LD    (DE),A     

+7BCD 02          .     LD    (BC),A     

+7BCE 04          .     INC   B          

+7BCF 6C          l     LD    L,H        

+7BD0 74          t     LD    (HL),H     

+7BD1 6F          o     LD    L,A        

+7BD2 70          p     LD    (HL),B     

+7BD3 14          .     INC   D          

+7BD4 02          .     LD    (BC),A     

+7BD5 06 6C       .l    LD    B,6C       

+7BD7 73          s     LD    (HL),E     

+7BD8 5F          _     LD    E,A        

+7BD9 74          t     LD    (HL),H     

+7BDA 6F          o     LD    L,A        

+7BDB 70          p     LD    (HL),B     

+7BDC 16 02       ..    LD    D,02       

+7BDE 05          .     DEC   B          

+7BDF 68          h     LD    L,B        

+7BE0 70          p     LD    (HL),B     

+7BE1 74          t     LD    (HL),H     

+7BE2 6F          o     LD    L,A        

+7BE3 70          p     LD    (HL),B     

+7BE4 18 02       ..    JR    7BE8       

+7BE6 04          .     INC   B          

+7BE7 68          h     LD    L,B        

+7BE8 70          p     LD    (HL),B     

+7BE9 76          v     HALT             

+7BEA 31 1A 02    1..   LD    SP,021A    

+7BED 04          .     INC   B          

+7BEE 68          h     LD    L,B        

+7BEF 70          p     LD    (HL),B     

+7BF0 76          v     HALT             

+7BF1 32 1C 01    2..   LD    (011C),A   

+7BF4 06 70       .p    LD    B,70       

+7BF6 72          r     LD    (HL),D     

+7BF7 69          i     LD    L,C        

+7BF8 63          c     LD    H,E        

+7BF9 6C          l     LD    L,H        

+7BFA 6B          k     LD    L,E        

+7BFB 1D          .     DEC   E          

+7BFC 01 04 70    ..p   LD    BC,7004    

+7BFF 72          r     LD    (HL),D     

+7C00 69          i     LD    L,C        

+7C01 76          v     HALT             

+7C02 1E 02       ..    LD    E,02       

+7C04 04          .     INC   B          

+7C05 66          f     LD    H,(HL)     

+7C06 72          r     LD    (HL),D     

+7C07 65          e     LD    H,L        

+7C08 65          e     LD    H,L        

+7C09 20 02        .    JR    NZ,7C0D    

+7C0B 04          .     INC   B          

+7C0C 6C          l     LD    L,H        

+7C0D 69          i     LD    L,C        

+7C0E 6E          n     LD    L,(HL)     

+7C0F 65          e     LD    H,L        

+7C10 22 02 07    "..   LD    (0702),HL  

+7C13 65          e     LD    H,L        

+7C14 72          r     LD    (HL),D     

+7C15 72          r     LD    (HL),D     

+7C16 6C          l     LD    L,H        

+7C17 69          i     LD    L,C        

+7C18 6E          n     LD    L,(HL)     

+7C19 65          e     LD    H,L        

+7C1A 24          $     INC   H          

+7C1B 02          .     LD    (BC),A     

+7C1C 06 65       .e    LD    B,65       

+7C1E 72          r     LD    (HL),D     

+7C1F 72          r     LD    (HL),D     

+7C20 63          c     LD    H,E        

+7C21 6F          o     LD    L,A        

+7C22 64          d     LD    H,H        

+7C23 26 02       &.    LD    H,02       

+7C25 07          .     RLCA             

+7C26 63          c     LD    H,E        

+7C27 68          h     LD    L,B        

+7C28 61          a     LD    H,C        

+7C29 6E          n     LD    L,(HL)     

+7C2A 6E          n     LD    L,(HL)     

+7C2B 65          e     LD    H,L        

+7C2C 6C          l     LD    L,H        

+7C2D 28 02       (.    JR    Z,7C31     

+7C2F 06 63       .c    LD    B,63       

+7C31 68          h     LD    L,B        

+7C32 61          a     LD    H,C        

+7C33 6D          m     LD    L,L        

+7C34 61          a     LD    H,C        

+7C35 70          p     LD    (HL),B     

+7C36 2A 02 04    *..   LD    HL,(0402)  

+7C39 70          p     LD    (HL),B     

+7C3A 72          r     LD    (HL),D     

+7C3B 69          i     LD    L,C        

+7C3C 6F          o     LD    L,A        

+7C3D 2C          ,     INC   L          

+7C3E 02          .     LD    (BC),A     

+7C3F 06 6D       .m    LD    B,6D       

+7C41 73          s     LD    (HL),E     

+7C42 67          g     LD    H,A        

+7C43 63          c     LD    H,E        

+7C44 6F          o     LD    L,A        

+7C45 64          d     LD    H,H        

+7C46 2E 02       ..    LD    L,02       

+7C48 05          .     DEC   B          

+7C49 6D          m     LD    L,L        

+7C4A 73          s     LD    (HL),E     

+7C4B 67          g     LD    H,A        

+7C4C 64          d     LD    H,H        

+7C4D 73          s     LD    (HL),E     

+7C4E 30 04       0.    JR    NC,7C54    

+7C50 06 74       .t    LD    B,74       

+7C52 61          a     LD    H,C        

+7C53 73          s     LD    (HL),E     

+7C54 6B          k     LD    L,E        

+7C55 69          i     LD    L,C        

+7C56 64          d     LD    H,H        

+7C57 34          4     INC   (HL)       

+7C58 04          .     INC   B          

+7C59 06 66       .f    LD    B,66       

+7C5B 72          r     LD    (HL),D     

+7C5C 6F          o     LD    L,A        

+7C5D 6D          m     LD    L,L        

+7C5E 69          i     LD    L,C        

+7C5F 64          d     LD    H,H        

+7C60 38 08       8.    JR    C,7C6A     

+7C62 05          .     DEC   B          

+7C63 63          c     LD    H,E        

+7C64 6C          l     LD    L,H        

+7C65 6F          o     LD    L,A        

+7C66 63          c     LD    H,E        

+7C67 6B          k     LD    L,E        

+7C68 00          .     NOP              

+7C69 00          .     NOP              

+7C6A 00          .     NOP              

+7C6B 0C          .     INC   C          

+7C6C 20 4C        L    JR    NZ,7CBA    ; " LEITBLOCK"

+7C6E 45          E     LD    B,L        

+7C6F 49          I     LD    C,C        

+7C70 54          T     LD    D,H        

+7C71 42          B     LD    B,D        

+7C72 4C          L     LD    C,H        

+7C73 4F          O     LD    C,A        

+7C74 43          C     LD    B,E        

+7C75 4B          K     LD    C,E        

+7C76 20 20             JR    NZ,7C98    

+7C78 03          .     INC   BC         

+7C79 06 17       ..    LD    B,17       

+7C7B 46          F     LD    B,(HL)     

+7C7C 11 20 7A    . z   LD    DE,7A20    ; "zuviel gelernt!"

+7C7F 75          u     LD    (HL),L     

+7C80 76          v     HALT             

+7C81 69          i     LD    L,C        

+7C82 65          e     LD    H,L        

+7C83 6C          l     LD    L,H        

+7C84 20 67        g    JR    NZ,7CED    

+7C86 65          e     LD    H,L        

+7C87 6C          l     LD    L,H        

+7C88 65          e     LD    H,L        

+7C89 72          r     LD    (HL),D     

+7C8A 6E          n     LD    L,(HL)     

+7C8B 74          t     LD    (HL),H     

+7C8C 21 20 FF    ! .   LD    HL,FF20    

+7C8F FF          .     RST   38         

+7C90 FF          .     RST   38         

+7C91 FF          .     RST   38         

+7C92 FF          .     RST   38         

+7C93 FF          .     RST   38         

+7C94 FF          .     RST   38         

+7C95 00          .     NOP              

+7C96 00          .     NOP              

+7C97 00          .     NOP              

+7C98 00          .     NOP              

+7C99 00          .     NOP              

+7C9A 00          .     NOP              

+7C9B 00          .     NOP              

+7C9C 00          .     NOP              

+7C9D 00          .     NOP              

+7C9E 00          .     NOP              

+7C9F 06 20       .     LD    B,20       ; "<**>

+7CA1 3C          <     INC   A          

+7CA2 2A 2A 3E    **>   LD    HL,(3E2A)  

+7CA5 20 15        .    JR    NZ,7CBC    

+7CA7 20 50        P    JR    NZ,7CF9    ; "Paging erforderlich"

+7CA9 61          a     LD    H,C        

+7CAA 67          g     LD    H,A        

+7CAB 69          i     LD    L,C        

+7CAC 6E          n     LD    L,(HL)     

+7CAD 67          g     LD    H,A        

+7CAE 20 65        e    JR    NZ,7D15    

+7CB0 72          r     LD    (HL),D     

+7CB1 66          f     LD    H,(HL)     

+7CB2 6F          o     LD    L,A        

+7CB3 72          r     LD    (HL),D     

+7CB4 64          d     LD    H,H        

+7CB5 65          e     LD    H,L        

+7CB6 72          r     LD    (HL),D     

+7CB7 6C          l     LD    L,H        

+7CB8 69          i     LD    L,C        

+7CB9 63          c     LD    H,E        

+7CBA 68          h     LD    L,B        

+7CBB 20 11        .    JR    NZ,7CCE    

+7CBD 20 4E        N    JR    NZ,7D0D    ; "Nicht im Schatt"

+7CBF 69          i     LD    L,C        

+7CC0 63          c     LD    H,E        

+7CC1 68          h     LD    L,B        

+7CC2 74          t     LD    (HL),H     

+7CC3 20 69        i    JR    NZ,7D2E    

+7CC5 6D          m     LD    L,L        

+7CC6 20 53        S    JR    NZ,7D1B    

+7CC8 63          c     LD    H,E        

+7CC9 68          h     LD    L,B        

+7CCA 61          a     LD    H,C        

+7CCB 74          t     LD    (HL),H     

+7CCC 74          t     LD    (HL),H     

+7CCD 20 FF        .    JR    NZ,7CCE    

+7CCF FF          .     RST   38         

+7CD0 FF          .     RST   38         

+7CD1 FF          .     RST   38         

+7CD2 FF          .     RST   38         

+7CD3 FF          .     RST   38         

+7CD4 FF          .     RST   38         

+7CD5 FF          .     RST   38         

+7CD6 FF          .     RST   38         

+7CD7 FF          .     RST   38         

+7CD8 FF          .     RST   38         

+7CD9 FF          .     RST   38         

+7CDA FF          .     RST   38         

+7CDB FF          .     RST   38         

+7CDC FF          .     RST   38         

+7CDD FF          .     RST   38         

+7CDE FF          .     RST   38         

+7CDF FF          .     RST   38         

+7CE0 FF          .     RST   38         

+7CE1 FF          .     RST   38         

+7CE2 FF          .     RST   38         

+7CE3 FF          .     RST   38         

+7CE4 FF          .     RST   38         

+7CE5 FF          .     RST   38         

+7CE6 FF          .     RST   38         

+7CE7 FF          .     RST   38         

+7CE8 FF          .     RST   38         

+7CE9 FF          .     RST   38         

+7CEA FF          .     RST   38         

+7CEB FF          .     RST   38         

+7CEC FF          .     RST   38         

+7CED FF          .     RST   38         

+7CEE FF          .     RST   38         

+7CEF FF          .     RST   38         

+7CF0 FF          .     RST   38         

+7CF1 FF          .     RST   38         

+7CF2 FF          .     RST   38         

+7CF3 FF          .     RST   38         

+7CF4 FF          .     RST   38         

+7CF5 FF          .     RST   38         

+7CF6 FF          .     RST   38         

+7CF7 FF          .     RST   38         

+7CF8 00          .     NOP              

+7CF9 00          .     NOP              

+7CFA FF          .     RST   38         

+7CFB FF          .     RST   38         

+7CFC FF          .     RST   38         

+7CFD FF          .     RST   38         

+7CFE FF          .     RST   38         

+7CFF FF          .     RST   38         

+7D00 FF          .     RST   38         

+7D01 FF          .     RST   38         

+7D02 FF          .     RST   38         

+7D03 FF          .     RST   38         

+7D04 FF          .     RST   38         

+7D05 FF          .     RST   38         

+7D06 FF          .     RST   38         

+7D07 FF          .     RST   38         

+7D08 FF          .     RST   38         

+7D09 FF          .     RST   38         

+7D0A FF          .     RST   38         

+7D0B FF          .     RST   38         

+7D0C FF          .     RST   38         

+7D0D FF          .     RST   38         

+7D0E FF          .     RST   38         

+7D0F FF          .     RST   38         

+7D10 FF          .     RST   38         

+7D11 FF          .     RST   38         

+7D12 FF          .     RST   38         

+7D13 FF          .     RST   38         

+7D14 FF          .     RST   38         

+7D15 FF          .     RST   38         

+7D16 FF          .     RST   38         

+7D17 FF          .     RST   38         

+7D18 00          .     NOP              

+7D19 FF          .     RST   38         

+7D1A 00          .     NOP              

+7D1B FF          .     RST   38         

+7D1C FF          .     RST   38         

+7D1D FF          .     RST   38         

+7D1E FF          .     RST   38         

+7D1F FF          .     RST   38         

+7D20 FF          .     RST   38         

+7D21 FF          .     RST   38         

+7D22 FF          .     RST   38         

+7D23 FF          .     RST   38         

+7D24 FF          .     RST   38         

+7D25 FF          .     RST   38         

+7D26 FF          .     RST   38         

+7D27 6D          m     LD    L,L        ; "muell   2 (!)"

+7D28 75          u     LD    (HL),L     

+7D29 65          e     LD    H,L        

+7D2A 6C          l     LD    L,H        

+7D2B 6C          l     LD    L,H        

+7D2C 20 20             JR    NZ,7D4E    

+7D2E 20 32        2    JR    NZ,7D62    

+7D30 20 28        (    JR    NZ,7D5A    

+7D32 21 29 CD    !).   LD    HL,CD29    

+7D35 20 6E        n    JR    NZ,7DA5    

+7D37 21 80 18    !..   LD    HL,1880    

+7D3A 3E 01       >.    LD    A,01       

+7D3C 01 80 00    ...   LD    BC,0080    

+7D3F 57          W     LD    D,A        

+7D40 ED B1       ..    CPIR             

+7D42 E2 48 7D    .H}   JP    PO,7D48    

+7D45 14          .     INC   D          

+7D46 18 F8       ..    JR    7D40       

+7D48 42          B     LD    B,D        

+7D49 C5          .     PUSH  BC         

+7D4A CD E2 6D    ..m   CALL  6DE2       

+7D4D C1          .     POP   BC         

+7D4E 10 F9       ..    DJNZ  7D49       

+7D50 CD 2A 6E    .*n   CALL  6E2A       

+7D53 C9          .     RET              

+7D54 50          P     LD    D,B        ; "PROZ MUELL"

+7D55 52          R     LD    D,D        

+7D56 4F          O     LD    C,A        

+7D57 5A          Z     LD    E,D        

+7D58 20 4D        M    JR    NZ,7DA7    

+7D5A 55          U     LD    D,L        

+7D5B 45          E     LD    B,L        

+7D5C 4C          L     LD    C,H        

+7D5D 4C          L     LD    C,H        

+7D5E EE 7D       .}    XOR   7D         

+7D60 C3 5A 81    .Z.   JP    815A       

+7D63 4D          M     LD    C,L        

+7D64 FF          .     RST   38         

+7D65 FF          .     RST   38         

+7D66 FF          .     RST   38         

+7D67 FF          .     RST   38         

+7D68 FF          .     RST   38         

+7D69 FF          .     RST   38         

+7D6A FF          .     RST   38         

+7D6B FF          .     RST   38         

+7D6C FF          .     RST   38         

+7D6D FF          .     RST   38         

+7D6E FF          .     RST   38         

+7D6F FF          .     RST   38         

+7D70 FF          .     RST   38         

+7D71 FF          .     RST   38         

+7D72 FF          .     RST   38         

+7D73 FF          .     RST   38         

+7D74 FF          .     RST   38         

+7D75 FF          .     RST   38         

+7D76 FF          .     RST   38         

+7D77 FF          .     RST   38         

+7D78 FF          .     RST   38         

+7D79 FF          .     RST   38         

+7D7A FF          .     RST   38         

+7D7B FF          .     RST   38         

+7D7C FF          .     RST   38         

+7D7D FF          .     RST   38         

+7D7E FF          .     RST   38         

+7D7F FF          .     RST   38         

+7D80 FF          .     RST   38         

+7D81 FF          .     RST   38         

+7D82 FF          .     RST   38         

+7D83 FF          .     RST   38         

+7D84 FF          .     RST   38         

+7D85 FF          .     RST   38         

+7D86 FF          .     RST   38         

+7D87 FF          .     RST   38         

+7D88 FF          .     RST   38         

+7D89 FF          .     RST   38         

+7D8A FF          .     RST   38         

+7D8B FF          .     RST   38         

+7D8C FF          .     RST   38         

+7D8D FF          .     RST   38         

+7D8E FF          .     RST   38         

+7D8F FF          .     RST   38         

+7D90 FF          .     RST   38         

+7D91 FF          .     RST   38         

+7D92 FF          .     RST   38         

+7D93 FF          .     RST   38         

+7D94 FF          .     RST   38         

+7D95 FF          .     RST   38         

+7D96 FF          .     RST   38         

+7D97 FF          .     RST   38         

+7D98 FF          .     RST   38         

+7D99 FF          .     RST   38         

+7D9A FF          .     RST   38         

+7D9B FF          .     RST   38         

+7D9C FF          .     RST   38         

+7D9D FF          .     RST   38         

+7D9E FF          .     RST   38         

+7D9F FF          .     RST   38         

+7DA0 FF          .     RST   38         

+7DA1 FF          .     RST   38         

+7DA2 FF          .     RST   38         

+7DA3 FF          .     RST   38         

+7DA4 FF          .     RST   38         

+7DA5 FF          .     RST   38         

+7DA6 FF          .     RST   38         

+7DA7 FF          .     RST   38         

+7DA8 FF          .     RST   38         

+7DA9 FF          .     RST   38         

+7DAA FF          .     RST   38         

+7DAB FF          .     RST   38         

+7DAC FF          .     RST   38         

+7DAD FF          .     RST   38         

+7DAE FF          .     RST   38         

+7DAF FF          .     RST   38         

+7DB0 FF          .     RST   38         

+7DB1 FF          .     RST   38         

+7DB2 FF          .     RST   38         

+7DB3 FF          .     RST   38         

+7DB4 FF          .     RST   38         

+7DB5 FF          .     RST   38         

+7DB6 FF          .     RST   38         

+7DB7 FF          .     RST   38         

+7DB8 FF          .     RST   38         

+7DB9 FF          .     RST   38         

+7DBA FF          .     RST   38         

+7DBB FF          .     RST   38         

+7DBC FF          .     RST   38         

+7DBD FF          .     RST   38         

+7DBE FF          .     RST   38         

+7DBF FF          .     RST   38         

+7DC0 FF          .     RST   38         

+7DC1 FF          .     RST   38         

+7DC2 FF          .     RST   38         

+7DC3 FF          .     RST   38         

+7DC4 FF          .     RST   38         

+7DC5 FF          .     RST   38         

+7DC6 FF          .     RST   38         

+7DC7 FF          .     RST   38         

+7DC8 FF          .     RST   38         

+7DC9 FF          .     RST   38         

+7DCA FF          .     RST   38         

+7DCB FF          .     RST   38         

+7DCC FF          .     RST   38         

+7DCD FF          .     RST   38         

+7DCE FF          .     RST   38         

+7DCF FF          .     RST   38         

+7DD0 FF          .     RST   38         

+7DD1 FF          .     RST   38         

+7DD2 FF          .     RST   38         

+7DD3 FF          .     RST   38         

+7DD4 FF          .     RST   38         

+7DD5 FF          .     RST   38         

+7DD6 FF          .     RST   38         

+7DD7 FF          .     RST   38         

+7DD8 FF          .     RST   38         

+7DD9 FF          .     RST   38         

+7DDA FF          .     RST   38         

+7DDB FF          .     RST   38         

+7DDC FF          .     RST   38         

+7DDD FF          .     RST   38         

+7DDE FF          .     RST   38         

+7DDF FF          .     RST   38         

+7DE0 FF          .     RST   38         

+7DE1 FF          .     RST   38         

+7DE2 FF          .     RST   38         

+7DE3 FF          .     RST   38         

+7DE4 FF          .     RST   38         

+7DE5 FF          .     RST   38         

+7DE6 FF          .     RST   38         

+7DE7 FF          .     RST   38         

+7DE8 FF          .     RST   38         

+7DE9 FF          .     RST   38         

+7DEA FF          .     RST   38         

+7DEB FF          .     RST   38         

+7DEC FF          .     RST   38         

+7DED FF          .     RST   38         

+7DEE F0          .     RET   P          

+7DEF 7D          }     LD    A,L        

+7DF0 21 B5 4C    !.L   LD    HL,4CB5    

+7DF3 CB 96       ..    RES   2,(HL)     

+7DF5 CD E2 6D    ..m   CALL  6DE2       

+7DF8 3A 17 82    :..   LD    A,(8217)   ; "musta" Zelle

+7DFB 3D          =     DEC   A          

+7DFC FA F5 7D    ..}   JP    M,7DF5     

+7DFF 21 B5 4C    !.L   LD    HL,4CB5    

+7E02 CB D6       ..    SET   2,(HL)     

+7E04 3C          <     INC   A          

+7E05 CB 57       .W    BIT   2,A        ; shutup

+7E07 20 1E        .    JR    NZ,7E27    

+7E09 CB 4F       .O    BIT   1,A        ; fixpoint

+7E0B 20 1A        .    JR    NZ,7E27    

+7E0D CB 47       .G    BIT   0,A        ; collect garbage

+7E0F C2 FF 7E    ..~   JP    NZ,7EFF    

+7E12 CB 5F       ._    BIT   3,A        ; savesystem

+7E14 C2 7C 80    .|.   JP    NZ,807C    

+7E17 97          .     SUB   A          

+7E18 32 17 82    2..   LD    (8217),A   

+7E1B 18 D3       ..    JR    7DF0       ; Warte bis Anforderung da

+7E1D 3A 17 82    :..   LD    A,(8217)   ; Musta

+7E20 CB 47       .G    BIT   0,A        

+7E22 C2 FF 7E    ..~   JP    NZ,7EFF    

+7E25 18 C9       ..    JR    7DF0       

+7E27 3A 13 57    :.W   LD    A,(5713)   

+7E2A B7          .     OR    A          

+7E2B 20 F0        .    JR    NZ,7E1D    

+7E2D 21 17 82    !..   LD    HL,8217    

+7E30 CB 66       .f    BIT   4,(HL)     

+7E32 CB A6       ..    RES   4,(HL)      

+7E34 20 1E        .    JR    NZ,7E54    

+7E36 CD 88 81    ...   CALL  8188       

+7E39 11 00 00    ...   LD    DE,0000    

+7E3C CD DE 66    ..f   CALL  66DE       

+7E3F CD A4 81    ...   CALL  81A4       

+7E42 54          T     LD    D,H        

+7E43 5D          ]     LD    E,L        

+7E44 01 80 00    ...   LD    BC,0080    

+7E47 21 80 18    !..   LD    HL,1880    

+7E4A ED B0       ..    LDIR             

+7E4C 21 B9 4C    !.L   LD    HL,4CB9    

+7E4F 01 40 00    .@.   LD    BC,0040    

+7E52 ED B0       ..    LDIR             

+7E54 CD 57 60    .W`   CALL  6057       

+7E57 CB 96       ..    RES   2,(HL)     

+7E59 CB EE       ..    SET   5,(HL)     

+7E5B 2C          ,     INC   L          

+7E5C 20 F9        .    JR    NZ,7E57    

+7E5E 21 2B 1E    !+.   LD    HL,1E2B    

+7E61 CD 80 67    ..g   CALL  6780       

+7E64 21 2B 1E    !+.   LD    HL,1E2B    

+7E67 11 18 82    ...   LD    DE,8218    

+7E6A 01 10 00    ...   LD    BC,0010    

+7E6D ED B0       ..    LDIR             

+7E6F CD 51 60    .Q`   CALL  6051       

+7E72 06 64       .d    LD    B,64       

+7E74 CD 20 6E    . n   CALL  6E20       

+7E77 CD E2 6D    ..m   CALL  6DE2       

+7E7A CD 2A 6E    .*n   CALL  6E2A       

+7E7D 10 F5       ..    DJNZ  7E74       

+7E7F CD 57 60    .W`   CALL  6057       

+7E82 CB 6E       .n    BIT   5,(HL)     

+7E84 28 0C       (.    JR    Z,7E92     

+7E86 CB AE       ..    RES   5,(HL)     

+7E88 CB 4E       .N    BIT   1,(HL)     

+7E8A 20 06        .    JR    NZ,7E92    

+7E8C CD 65 5F    .e_   CALL  5F65       

+7E8F CD 34 7D    .4}   CALL  7D34       

+7E92 2C          ,     INC   L          

+7E93 20 ED        .    JR    NZ,7E82    

+7E95 CD 99 5F    .._   CALL  5F99       

+7E98 11 02 00    ...   LD    DE,0002    

+7E9B CD 46 81    .F.   CALL  8146       

+7E9E 57          W     LD    D,A        

+7E9F 1E EF       ..    LD    E,EF       

+7EA1 62          b     LD    H,D        

+7EA2 2E DF       ..    LD    L,DF       

+7EA4 01 E0 00    ...   LD    BC,00E0    

+7EA7 ED B8       ..    LDDR             

+7EA9 1E 00       ..    LD    E,00       

+7EAB 21 18 82    !..   LD    HL,8218    

+7EAE 01 10 00    ...   LD    BC,0010    

+7EB1 ED B0       ..    LDIR             

+7EB3 6A          j     LD    L,D        

+7EB4 CB 3D       .=    SLR   L          

+7EB6 CB FD       ..    SET   7,L        

+7EB8 26 15       &.    LD    H,15       

+7EBA CD 65 5F    .e_   CALL  5F65       

+7EBD 21 17 82    !..   LD    HL,8217    

+7EC0 CB 4E       .N    BIT   1,(HL)     

+7EC2 CB 8E       ..    RES   1,(HL)     

+7EC4 C2 F0 7D    ..}   JP    NZ,7DF0    

+7EC7 CD DF 7E    ..~   CALL  7EDF       

+7ECA 3A AD 60    :.`   LD    A,(60AD)   

+7ECD B7          .     OR    A          

+7ECE 20 06        .    JR    NZ,7ED6    

+7ED0 21 28 82    !(.   LD    HL,8228    

+7ED3 CD CA 6E    ..n   CALL  6ECA       

+7ED6 CD 3B 5A    .;Z   CALL  5A3B       

+7ED9 CD 87 28    ..(   CALL  2887       

+7EDC C3 DC 7E    ..~   JP    7EDC       

+7EDF 11 00 00    ...   LD    DE,0000    

+7EE2 CD 46 81    .F.   CALL  8146       

+7EE5 67          g     LD    H,A        

+7EE6 2E 0D       ..    LD    L,0D       

+7EE8 36 00       6.    LD    (HL),00    

+7EEA 2E 46       .F    LD    L,46       

+7EEC 11 19 7D    ..}   LD    DE,7D19    

+7EEF 01 0A 00    ...   LD    BC,000A    

+7EF2 EB          .     EX    DE,HL      

+7EF3 ED B0       ..    LDIR             

+7EF5 6F          o     LD    L,A        

+7EF6 CB 3D       .=    SLR   L          

+7EF8 CB FD       ..    SET   7,L        

+7EFA 26 15       &.    LD    H,15       

+7EFC C3 65 5F    .e_   JP    5F65       

+7EFF CD 16 54    ..T   CALL  5416       

+7F02 3A 17 82    :..   LD    A,(8217)   ; Musta

+7F05 CB 67       .g    BIT   4,A        

+7F07 20 2B        +    JR    NZ,7F34    

+7F09 ED 4B 10 82 .K..  LD    BC,(8210)  

+7F0D 11 00 00    ...   LD    DE,0000    

+7F10 78          x     LD    A,B        

+7F11 B1          .     OR    C          

+7F12 28 08       (.    JR    Z,7F1C     

+7F14 CD D6 53    ..S   CALL  53D6       

+7F17 13          .     INC   DE         

+7F18 13          .     INC   DE         

+7F19 0B          .     DEC   BC         

+7F1A 18 F4       ..    JR    7F10       

+7F1C 97          .     SUB   A          

+7F1D 32 0C 82    2..   LD    (820C),A   

+7F20 32 0D 82    2..   LD    (820D),A   

+7F23 21 2B 1E    !+.   LD    HL,1E2B    

+7F26 CD B3 7F    ...   CALL  7FB3       

+7F29 3E 01       >.    LD    A,01       

+7F2B 32 0C 82    2..   LD    (820C),A   

+7F2E 3A 13 57    :.W   LD    A,(5713)   

+7F31 B7          .     OR    A          

+7F32 20 17        .    JR    NZ,7F4B    

+7F34 11 02 00    ...   LD    DE,0002    

+7F37 CD 46 81    .F.   CALL  8146       

+7F3A 67          g     LD    H,A        

+7F3B 2E 00       ..    LD    L,00       

+7F3D 11 18 82    ...   LD    DE,8218    

+7F40 01 10 00    ...   LD    BC,0010    

+7F43 ED B0       ..    LDIR             

+7F45 21 18 82    !..   LD    HL,8218    

+7F48 CD B3 7F    ...   CALL  7FB3       

+7F4B CD 34 7D    .4}   CALL  7D34       

+7F4E CD E7 55    ..U   CALL  55E7       

+7F51 30 27       0'    JR    NC,7F7A    

+7F53 EB          .     EX    DE,HL      

+7F54 3A 17 82    :..   LD    A,(8217)   ; Musta

+7F57 CB 67       .g    BIT   4,A        

+7F59 28 50       (P    JR    Z,7FAB     

+7F5B CD B1 81    ...   CALL  81B1       

+7F5E E5          .     PUSH  HL         

+7F5F 6C          l     LD    L,H        

+7F60 26 15       &.    LD    H,15       

+7F62 CB 3D       .=    SLR   L          

+7F64 CB FD       ..    SET   7,L        

+7F66 CB 8E       ..    RES   1,(HL)     

+7F68 E1          .     POP   HL         

+7F69 06 00       ..    LD    B,00       

+7F6B 5E          ^     LD    E,(HL)     

+7F6C 23          #     INC   HL         

+7F6D 56          V     LD    D,(HL)     

+7F6E 14          .     INC   D          

+7F6F 28 04       (.    JR    Z,7F75     

+7F71 15          .     DEC   D          

+7F72 CD 5F 80    ._.   CALL  805F       

+7F75 23          #     INC   HL         

+7F76 10 F3       ..    DJNZ  7F6B       

+7F78 18 D1       ..    JR    7F4B       

+7F7A 3E 01       >.    LD    A,01       

+7F7C 32 0D 82    2..   LD    (820D),A   

+7F7F CD 5C 54    .\T   CALL  545C       

+7F82 21 17 82    !..   LD    HL,8217    

+7F85 CB 86       ..    RES   0,(HL)     

+7F87 CB 66       .f    BIT   4,(HL)     

+7F89 CA F0 7D    ..}   JP    Z,7DF0     

+7F8C 36 01       6.    LD    (HL),01    

+7F8E 11 02 00    ...   LD    DE,0002    

+7F91 CD 46 81    .F.   CALL  8146       

+7F94 57          W     LD    D,A        

+7F95 1E 00       ..    LD    E,00       

+7F97 21 18 82    !..   LD    HL,8218    

+7F9A 01 10 00    ...   LD    BC,0010    

+7F9D ED B0       ..    LDIR             

+7F9F CD 88 81    ...   CALL  8188       

+7FA2 CD 18 53    ..S   CALL  5318       

+7FA5 CD A4 81    ...   CALL  81A4       

+7FA8 C3 FF 7E    ..~   JP    7EFF       

+7FAB CD D6 53    ..S   CALL  53D6       

+7FAE CD B1 81    ...   CALL  81B1       

+7FB1 18 B6       ..    JR    7F69       

+7FB3 06 04       ..    LD    B,04       

+7FB5 0E 10       ..    LD    C,10       

+7FB7 E5          .     PUSH  HL         

+7FB8 C5          .     PUSH  BC         

+7FB9 5E          ^     LD    E,(HL)     

+7FBA 23          #     INC   HL         

+7FBB 56          V     LD    D,(HL)     

+7FBC CD 67 80    .g.   CALL  8067       

+7FBF 69          i     LD    L,C        

+7FC0 CD CC 7F    ...   CALL  7FCC       

+7FC3 C1          .     POP   BC         

+7FC4 0E 00       ..    LD    C,00       

+7FC6 E1          .     POP   HL         

+7FC7 23          #     INC   HL         

+7FC8 23          #     INC   HL         

+7FC9 10 EC       ..    DJNZ  7FB7       

+7FCB C9          .     RET              

+7FCC 14          .     INC   D          

+7FCD C8          .     RET   Z          

+7FCE 15          .     DEC   D          

+7FCF CD 0D 54    ..T   CALL  540D       

+7FD2 D5          .     PUSH  DE         

+7FD3 CD 46 81    .F.   CALL  8146       

+7FD6 67          g     LD    H,A        

+7FD7 CD EA 7F    ...   CALL  7FEA       

+7FDA D1          .     POP   DE         

+7FDB 20 F5        .    JR    NZ,7FD2    

+7FDD D5          .     PUSH  DE         

+7FDE CD 46 81    .F.   CALL  8146       

+7FE1 67          g     LD    H,A        

+7FE2 24          $     INC   H          

+7FE3 CD EA 7F    ...   CALL  7FEA       

+7FE6 D1          .     POP   DE         

+7FE7 20 F4        .    JR    NZ,7FDD    

+7FE9 C9          .     RET              

+7FEA 5E          ^     LD    E,(HL)     

+7FEB 2C          ,     INC   L          

+7FEC 56          V     LD    D,(HL)     

+7FED 14          .     INC   D          

+7FEE 28 22       ("    JR    Z,8012     

+ - Fortsetzung in Datei "eumel0.prt.5" -

diff --git a/system/multiuser/1.7.5/source-disk b/system/multiuser/1.7.5/source-disk
new file mode 100644
index 0000000..e24344a
--- /dev/null
+++ b/system/multiuser/1.7.5/source-disk
@@ -0,0 +1,2 @@
+175_src/source-code-1.7.5m_0.img
+175_src/source-code-1.7.5m_1.img
diff --git a/system/multiuser/1.7.5/src/archive b/system/multiuser/1.7.5/src/archive
new file mode 100644
index 0000000..8027b29
--- /dev/null
+++ b/system/multiuser/1.7.5/src/archive
@@ -0,0 +1,92 @@
+(* ------------------- VERSION 14     06.03.86 ------------------- *)
+PACKET archive DEFINES
+
+               archive ,
+               clear ,
+               release ,
+               format ,
+               check ,
+               reserve :
+
+
+LET clear code      = 18 ,
+    reserve code    = 19 ,
+    free code       = 20 ,
+    check read code = 22 ,
+    format code     = 23 ;
+
+
+TASK PROC archive :
+ 
+  task ("ARCHIVE")
+
+ENDPROC archive ;
+
+PROC archive (TEXT CONST archive name, TASK CONST task) :
+
+  call (reserve code, archive name, task)
+
+ENDPROC archive ;
+
+PROC reserve (TEXT CONST message, TASK CONST task) :
+
+  call (reserve code, message, task)
+
+END PROC reserve;
+
+PROC reserve (TASK CONST task) :
+
+  call(reserve code, "", task)
+
+END PROC reserve;
+
+PROC archive (TEXT CONST archive name, INT CONST station) :
+
+  call (reserve code, archive name, station/ "ARCHIVE")
+
+ENDPROC archive ;
+
+PROC archive (TEXT CONST archive name):
+
+  call (reserve code, archive name, archive)
+
+ENDPROC archive ;
+
+PROC release (TASK CONST task) :
+
+  call (free code, "", task)
+
+ENDPROC release ;
+
+PROC clear (TASK CONST task) :
+
+  call (clear code, "", task)
+
+ENDPROC clear ;
+
+PROC format (TASK CONST task) :
+
+  format (0, task)
+
+ENDPROC format ;
+
+PROC format (INT CONST code, TASK CONST task) :
+
+  call (format code , text (code), task)
+
+ENDPROC format ;
+
+PROC check (TEXT CONST file name, TASK CONST task) :
+
+  call (check read code, file name, task)
+
+ENDPROC check ;
+
+PROC check (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) check, nameset, task)
+
+ENDPROC check ;
+
+ENDPACKET archive ;
+
diff --git a/system/multiuser/1.7.5/src/archive manager b/system/multiuser/1.7.5/src/archive manager
new file mode 100644
index 0000000..c37d2e2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/archive manager
@@ -0,0 +1,670 @@
+(* ------------------- VERSION 10 vom 17.04.86 ------------------- *)
+PACKET archive manager DEFINES                 (* Autor: J.Liedtke*)
+ 
+      archive manager ,
+      provide channel :
+
+
+
+LET std archive channel  = 31 ,
+
+    ack              = 0 ,
+    nak              = 1 ,
+    error nak        = 2 ,
+    second phase ack = 5 ,
+    false code       = 6 ,
+ 
+    fetch code       = 11 ,
+    save code        = 12 ,
+    exists code      = 13 ,
+    erase code       = 14 ,
+    list code        = 15 ,
+    all code         = 17 ,
+    clear code       = 18 ,
+    reserve code     = 19 ,
+    free code        = 20 ,
+    check read code  = 22 ,
+    format code      = 23 ,
+
+    read error       = 92 ,
+ 
+    max files = 200 ,
+ 
+    start of volume = 1000 ,
+    end of volume = 1 ,
+    file header   = 3 , 
+
+    number of header blocks = 2 ,
+ 
+    quote         = """" ,
+    dummy name    = "-" ,
+    dummy date    = "        " ,
+
+ 
+    HEADER = STRUCT (TEXT name, date, INT type, TEXT password) ;
+
+
+BOUND STRUCT (TEXT name, pass) VAR msg ;
+
+INT VAR archive channel := std archive channel ;
+
+TASK VAR archive owner := niltask ,
+         order task ;
+TEXT VAR archive name := "" , write stamp ;
+
+REAL VAR last access time := 0.0 ;
+
+BOOL VAR was already write access ;
+
+
+DATASPACE VAR header space := nilspace ;
+BOUND HEADER VAR header ;
+
+TEXT VAR file name := "" ;
+
+LET invalid   = 0 ,
+    read only = 1 ,
+    valid     = 2 ;
+
+LET accept read errors = TRUE ,
+    ignore read errors = FALSE ;
+
+
+INT VAR directory state := invalid ;
+
+THESAURUS VAR directory ;
+INT VAR dir index ;
+
+INT VAR archive size ;
+
+INT VAR end of volume block ;
+ROW max files INT VAR header block ;
+ROW max files TEXT VAR header date ;
+
+
+ 
+PROC provide channel (INT CONST channel) :
+
+  archive channel := channel
+
+ENDPROC provide channel ;
+
+PROC archive manager :
+
+  archive manager (archive channel)
+
+ENDPROC archive manager ;
+
+PROC archive manager (INT CONST channel) :
+
+  archive channel := channel ;
+  task password ("-") ;
+  global manager 
+     (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) archive manager)
+
+ENDPROC archive manager ;
+
+PROC archive manager (DATASPACE VAR ds, INT CONST order, phase,
+                      TASK CONST task) :
+
+
+  enable stop ;
+  order task := task ;
+  msg := ds ;
+  SELECT order OF
+    CASE fetch code       : fetch file
+    CASE save code        : save file
+    CASE exists code      : exists file
+    CASE erase code       : erase file
+    CASE list code        : list (ds); manager ok (ds)
+    CASE all code         : deliver directory
+    CASE clear code,
+         format code      : clear or format
+    CASE reserve code     : reserve 
+    CASE free code        : free
+    CASE check read code  : check
+    OTHERWISE errorstop (name (myself) + ": unbekannter Auftrag")
+  ENDSELECT .
+
+deliver directory :
+  access archive ;
+  BOUND THESAURUS VAR all names := ds ;
+  all names := directory ;
+  WHILE all names CONTAINS dummy name REP
+    delete (all names, dummy name, dir index)
+  PER ;
+  manager ok (ds) .
+
+clear or format :
+  IF NOT (order task = archive owner)
+    THEN errorstop ("Archiv nicht angemeldet")
+  ELIF phase = 1
+    THEN ask for erase all
+  ELSE   directory state := invalid ;
+         IF order <> clear code
+           THEN format archive (specification) ;
+                archive size := archive blocks
+         FI ;
+         rewind ;
+         write header (archive name, text (clock(1),13,1), start of volume);
+         write end of volume ;
+         manager ok (ds)
+  FI .
+
+ask for erase all :
+  IF order = format code AND specification > 3
+    THEN errorstop ("ungueltiger Format-Code")
+  FI ;
+  look at volume header ;
+  IF header.name <> ""
+    THEN IF order = clear code
+           THEN manager question ("Archiv """+header.name+""" loeschen", order task) 
+           ELSE manager question ("Archiv """+header.name+""" formatieren", order task) 
+         FI 
+    ELSE IF order = clear code
+           THEN manager question ("Archiv initialisieren", order task) 
+           ELSE manager question ("Archiv formatieren", order task)
+         FI
+  FI .
+
+specification :
+  int (msg.name) .
+
+reserve :
+  IF reserve or free permitted
+     THEN continue archive channel;
+          disable stop ;
+          directory state := invalid ;
+          archive owner := order task ;
+          archive name := msg.name ;
+          manager ok (ds)
+     ELSE errorstop ("Archiv wird von Task """+name(archive owner)+""" benutzt")
+  FI .
+
+continue archive channel :
+  continue channel (archive channel) .
+
+free :
+  IF reserve or free permitted 
+    THEN archive owner := niltask ;
+         break (quiet) ;
+         manager ok (ds)
+    ELSE manager message ("Archiv nicht angemeldet", order task)
+  FI.
+
+reserve or free permitted :
+     order task = archive owner OR last access more than five minutes ago
+     OR archive owner = niltask OR NOT
+     (exists (archive owner) OR station (archive owner) <> station (myself)) .
+ 
+last access more than five minutes ago :
+     abs (last access time - clock (1)) > 300.0 .
+
+fetch file :
+  access archive ;
+  access file (msg.name) ;
+  IF no read error remarked
+    THEN disable stop ;
+         fetch (ds, accept read errors) ;
+         IF read error occurred
+           THEN remark read error
+         FI ;
+         enable stop
+    ELSE fetch (ds, ignore read errors)
+  FI ;
+  manager ok (ds) .
+
+no read error remarked :
+  pos (file name, " mit Lesefehler") = 0 .
+
+read error occurred :
+  is error AND error code = read error .
+
+remark read error :
+  dir index := link (directory, file name) ;
+  REP
+    file name CAT " mit Lesefehler" ;
+  UNTIL NOT (directory CONTAINS file name) PER ;
+  IF LENGTH file name < 100
+    THEN rename (directory, dir index, file name)
+  FI .
+
+save file :
+  IF phase = 1
+    THEN access archive ;
+         access file (msg.name) ;
+         IF file in directory
+           THEN manager question (""""+file name +""" ueberschreiben", order task)
+           ELSE send (order task, second phase ack, ds)
+         FI
+    ELSE access archive ;
+         access file (file name) ;
+         erase ;
+         save (ds) ;
+         forget (ds) ;
+         ds := nilspace ;
+         manager ok (ds)
+  FI .
+
+exists file :
+  access archive ;
+  access file (msg.name) ;
+  IF file in directory
+    THEN manager ok (ds)
+    ELSE send (order task, false code, ds)
+  FI .
+
+erase file :
+  access archive ;
+  access file (msg.name) ;
+  IF file in directory
+    THEN IF phase = 1
+           THEN manager question (""""+file name+""" loeschen", order task)
+           ELSE erase ; manager ok (ds)
+         FI
+    ELSE manager message ("gibt es nicht", order task)
+  FI .
+
+check :
+  access archive ;
+  access file (msg.name) ;
+  IF file in directory
+    THEN position to file ;
+         disable stop ;
+         check read ;
+         IF is error
+           THEN clear error; error ("fehlerhaft")
+           ELSE last access time := clock (1) ;
+                manager message ("""" + file name + """ ohne Fehler gelesen", order task)
+         FI
+    ELSE error ("gibt es nicht")
+  FI .
+
+file in directory :  dir index > 0 .
+
+position to file :
+  seek (header block (dir index) + number of header blocks) .
+
+ENDPROC archive manager ;
+
+PROC manager ok (DATASPACE VAR ds) :
+
+  send (order task, ack, ds) ;
+  last access time := clock (1) .
+
+ENDPROC manager ok ;
+
+PROC access archive :
+ 
+  IF NOT (order task = archive owner)
+    THEN errorstop ("Archiv nicht angemeldet")
+  ELIF directory state = invalid
+    THEN open archive
+  ELIF last access more than two seconds ago
+    THEN check volume name ;
+         new open if somebody changed medium
+  FI .
+
+last access more than two seconds ago :
+  abs (clock (1) - last access time) > 2.0 .
+
+new open if somebody changed medium :
+  IF header.date <> write stamp
+    THEN directory state := invalid ;
+         access archive
+  FI .
+
+open archive :
+  directory state := invalid ;
+  check volume name ;
+  write stamp := header.date ;
+  was already write access := FALSE ;
+  read directory ;
+  make directory valid if no read errors occurred .
+
+read directory :
+  directory := empty thesaurus ;
+  rewind ;
+  get next header ;
+  WHILE header.type = file header REP
+    IF directory CONTAINS header.name
+      THEN rename (directory, header.name, dummy name)
+    FI ;
+    insert (directory, header.name, dir index) ;
+    header block (dir index) := end of volume block ;
+    header date (dir index)  := header.date ;
+    get next header ;
+  PER .
+
+make directory valid if no read errors occurred :
+  IF directory state = invalid
+    THEN directory state := valid
+  FI .
+
+ENDPROC access archive ;
+
+PROC access file (TEXT CONST name) :
+
+  file name := name ;
+  dir index := link (directory, file name) .
+
+ENDPROC access file ;
+
+
+PROC check volume name :
+
+  disable stop ;
+  archive size := archive blocks ;
+  read volume header ;
+  IF header.type <> start of volume
+    THEN simulate header (start of volume, "?????")
+  ELIF header.name <> archive name
+    THEN errorstop ("Archiv heisst """ + header.name + """")
+  FI .
+
+read volume header :
+  rewind ;
+  read header ;
+  IF is error AND error code = read error
+    THEN clear error ;
+         simulate header (start of volume, "?????")
+  FI .
+
+ENDPROC check volume name ;
+
+PROC get next header :
+
+  disable stop ;
+  skip dataspace ;
+  IF NOT is error
+    THEN read header
+  FI ;
+  IF is error
+    THEN clear error ;
+         directory state := read only ;
+         search header
+  FI ;
+  end of volume block := block number - number of header blocks .
+
+search header :
+  INT VAR ds pages ;
+  search dataspace (ds pages) ;
+  IF ds pages < 0
+    THEN simulate header (end of volume, "")
+  ELIF NOT is header space
+    THEN simulate header (file header, "????? " + text (block number))
+  FI .
+
+is header space :
+  IF ds pages <> 1
+    THEN FALSE
+    ELSE remember position ;
+         read header ;
+         IF read error occurred
+           THEN clear error; back to old position; FALSE
+         ELIF header format looks ok
+           THEN TRUE
+           ELSE back to old position ; FALSE
+         FI
+  FI .
+
+read error occurred :
+  is error CAND error code = read error .
+
+header format looks ok :
+  header.type = file header OR header.type = end of volume .
+
+remember position :
+  INT CONST old block nr := block number .
+
+back to old position :
+  seek (old block nr) .
+
+ENDPROC get next header ;
+
+PROC fetch (DATASPACE VAR ds, BOOL CONST error accept):
+
+  enable stop ;
+  IF file name <> dummy name
+    THEN fetch from archive
+    ELSE error ("Name unzulaessig")
+  FI .
+
+fetch from archive :
+  IF file in directory
+    THEN position to file ;
+         read (ds, 30000, error accept)
+  ELIF directory state = read only
+    THEN error ("gibt es nicht (oder Lesefehler)")
+    ELSE error ("gibt es nicht")
+  FI .
+
+position to file :
+  seek (header block (dir index) + number of header blocks) .
+
+file in directory :  dir index > 0 .
+ 
+ENDPROC fetch ;
+
+PROC erase :
+
+  IF directory state = read only
+    THEN errorstop ("'save'/'erase' wegen Lesefehler verboten")
+    ELSE update write stamp if first write access ;
+         erase archive
+  FI .
+
+update write stamp if first write access :
+  IF NOT was already write access 
+    THEN rewind ;
+         write stamp := text (clock (1), 13, 1) ;
+         write header (archive name, write stamp, start of volume) ;
+         was already write access := TRUE
+  FI .
+
+erase archive :
+  IF file in directory
+    THEN IF is last file of archive
+           THEN cut off all erased files
+           ELSE rename to dummy
+         FI
+  FI .
+
+file in directory :         dir index > 0 .
+
+is last file of archive :   dir index = highest entry (directory) .
+
+cut off all erased files :
+  directory state := invalid ;
+  REP
+    delete (directory, dir index) ;
+    dir index DECR 1
+  UNTIL dir index = 0 COR name (directory, dir index) <> dummy name PER ;
+  behind last valid file ;
+  write end of volume ;
+  directory state := valid .
+
+behind last valid file :
+  seek (header block (dir index + 1)) ;
+  end of volume block := block number .
+
+rename to dummy :
+    directory state := invalid ;
+    to file header ;
+    read header ;
+    to file header ;
+    header.name := dummy name ;
+    header.date := dummy date ;
+    write (header space) ;
+    rename (directory, file name, dummy name) ;
+    header date (dir index) := dummy date ;
+    directory state := valid .
+
+to file header :
+  seek (header block (dir index)) .
+
+ENDPROC erase ;
+
+PROC save (DATASPACE VAR ds) :
+
+  IF file name <> dummy name
+    THEN save to archive
+    ELSE error ("Name unzulaessig")
+  FI .
+
+save to archive :
+  IF file too large OR highest entry (directory) >= max files
+    THEN error ( "kann nicht geschrieben werden (Archiv voll)")
+    ELSE write new file
+  FI .
+
+file too large :
+  end of volume block + ds pages (ds) + 5 > archive size .
+
+write new file :
+  seek (end of volume block) ;
+  disable stop ;
+  write file (ds) ;
+  IF is error
+    THEN seek (end of volume block)
+    ELSE insert (directory, file name, dir index) ;
+         remember begin of header block ;
+         remember date
+  FI ;
+  write end of volume .
+
+remember begin of header block :
+  header block (dir index) := end of volume block .
+
+remember date :
+  header date (dir index) := date .
+
+ENDPROC save ;
+
+PROC write file (DATASPACE CONST ds) :
+
+  enable stop ;
+  write header (file name, date, file header) ;
+  write (ds) 
+
+ENDPROC write file ;
+
+PROC write end of volume :
+
+  disable stop ;
+  end of volume block := block number ;
+  write header ("", "", end of volume)
+
+ENDPROC write end of volume ;
+
+PROC write header (TEXT CONST name, date, INT CONST header type) :
+
+  forget (header space) ;
+  header space := nilspace ;
+  header := header space ;
+
+  header.name := subtext (name,1,100) ;
+  header.date := date ;
+  header.type := header type ;
+
+  write (header space) 
+
+ENDPROC write header ;
+
+PROC read header :
+
+  IF archive size > 0
+    THEN forget (header space) ;
+         header space := nilspace ;
+         read (header space, 1, accept read errors) ;
+         header := header space
+    ELSE errorstop ("Lesen unmoeglich (Archiv)")
+  FI .
+
+ENDPROC read header ;
+
+PROC simulate header (INT CONST type, TEXT CONST name) :
+
+  forget (header space) ;
+  header space := nilspace ;
+  header := header space ;
+  header.name := name ;
+  header.date := "??.??.??" ;
+  header.type := type ;
+  header.password := ""
+
+ENDPROC simulate header ;
+
+PROC look at volume header :
+
+  rewind ;
+  archive size := archive blocks ;
+  forget (header space) ;
+  header space := nilspace ;
+  INT VAR return code ;
+  read block (header space, 1, 1, return code) ;
+  header := header space ;
+  disable stop ;
+  IF return code <> 0 OR
+     LENGTH header.name < 0 OR LENGTH header.name > 100 OR is error
+    THEN header.name := "" ;
+         clear error
+  FI
+
+ENDPROC look at volume header ;
+
+PROC list (DATASPACE VAR ds) :
+
+  access archive ;
+  open list file ;
+  INT VAR file number := 0 ;
+  get (directory, file name, file number) ;
+  WHILE file number > 0 REP
+    generate list line ;
+    get (directory, file name, file number)
+  PER ;
+  IF directory state = read only
+    THEN putline (list file, "Lesefehler: Evtl. fehlen Eintraege")
+  FI ;
+  write list head .
+
+open list file :
+  forget (ds) ;
+  ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) ;
+  putline (list file, "") .
+
+generate list line :
+  write (list file, header date (file number)) ;
+  write (list file, text (file blocks DIV 2, 5)) ;
+  write (list file, " K  ") ;
+  IF file name = dummy name
+    THEN write (list file, dummy name)
+    ELSE write (list file, quote) ;
+         write (list file, file name) ;
+         write (list file, quote)
+  FI ;
+  line (list file) .
+
+file blocks :
+  IF file number < highest entry (directory)
+    THEN header block (file number+1) - header block (file number)
+    ELSE end of volume block - header block (file number)
+  FI .
+
+write list head :                                      (* wk 22.08.85 *)
+  headline (list file, archive name +
+            " (" + used + " K belegt von " + text (archive size DIV 2) + " K)") .
+
+used :  text ((end of volume block + 3) DIV 2) .
+
+ENDPROC list ;
+
+PROC error (TEXT CONST error msg) :
+
+  errorstop ("""" + file name + """ " + error msg)
+ 
+ENDPROC error ;
+
+ENDPACKET archive manager ;
+
diff --git a/system/multiuser/1.7.5/src/basic archive b/system/multiuser/1.7.5/src/basic archive
new file mode 100644
index 0000000..8235607
--- /dev/null
+++ b/system/multiuser/1.7.5/src/basic archive
@@ -0,0 +1,401 @@
+(* ------------------- VERSION 11     06.03.86 ------------------- *)
+PACKET basic archive DEFINES 
+
+  archive blocks ,
+  block number ,
+  check read ,
+  format archive ,
+  read block ,
+  read ,
+  rewind ,
+  search dataspace ,
+  seek ,
+  size ,
+  skip dataspace ,
+  write block ,
+  write :
+
+INT VAR blocknr  := 0 ,
+        rerun    := 0 ,
+        page     := -1 ,
+        bit word := 1 ,
+        unreadable sequence length := 0 ;
+INT CONST all ones :=-1 ;
+
+
+DATASPACE VAR label ds ;
+
+LET write normal            = 0 ,
+    archive version         = 1 ,
+    first page stored       = 2 ,
+    dr size                 = 3 ,
+    first bit word          = 4 ,
+(*  write deleted data mark = 64 , *)
+    inconsistent            = 90 ,
+    read error              = 92 ,
+    label size              = 131 ;
+
+BOUND STRUCT (ALIGN dummy for page1,
+              (* Page 2 begins: *)
+              ROW label size INT lab) VAR label;
+
+
+INT PROC block number :
+  block nr
+ENDPROC block number ;
+
+PROC seek (INT CONST block) :
+  block nr := block
+ENDPROC seek ;
+
+PROC rewind :
+  forget (label ds);
+  label ds := nilspace;
+  label := label ds;
+  block nr := 0;
+  rerun := session 
+END PROC rewind; 
+ 
+PROC skip dataspace:
+  check rerun;
+  get label; 
+  IF is error
+    THEN
+  ELIF olivetti
+    THEN block nr INCR label.lab (dr size+1)
+    ELSE block nr INCR label.lab (dr size)
+  FI
+END PROC skip dataspace; 
+ 
+PROC read (DATASPACE VAR ds):
+  read (ds, 30000, FALSE)
+ENDPROC read ;
+
+PROC read (DATASPACE VAR ds, INT CONST max pages, BOOL CONST error accept) :
+  enable stop ;
+  check rerun;
+  get label; 
+  init next page;
+  INT VAR i ;
+  FOR i FROM 1 UPTO max pages REP
+    next page;
+    IF no further page THEN  LEAVE read FI;
+    check storage ;
+    check rerun ;
+    read block ;
+    block nr INCR 1;
+  PER .
+
+read block :
+  disable stop ;
+  get external block (ds, page, block nr) ;
+  ignore read error if no errors accepted ;
+  enable stop .
+
+ignore read error if no errors accepted :
+  IF is error CAND error code = read error CAND NOT error accept
+    THEN clear error
+  FI .
+
+check storage :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN forget (ds) ;
+         ds := nilspace ;
+         errorstop ("Speicherengpass") ;
+         LEAVE read
+  FI .
+
+check rerun :
+    IF rerun <> session
+      THEN errorstop ("RERUN beim Archiv-Zugriff") ;
+           LEAVE read
+    FI .
+
+END PROC read;
+
+PROC check read :
+
+  enable stop ;
+  get label ;
+  INT VAR pages, i;
+  IF olivetti
+    THEN pages := label.lab (dr size+1)
+    ELSE pages := label.lab (dr size)
+  FI ;
+  FOR i FROM 1 UPTO pages REP
+    get external block (label ds, 2, block nr) ;
+    block nr INCR 1
+  PER .
+
+ENDPROC check read ;
+
+PROC write (DATASPACE CONST ds):
+  enable stop ;
+  check rerun;
+  INT VAR label block nr := block nr;
+  block nr INCR 1;init label;
+  INT VAR page := -1,i;
+  FOR i FROM 1 UPTO ds pages (ds) REP
+    check rerun ;
+    page := next ds page(ds,page);
+    put external block (ds, page, block nr) ;
+    reset archive bit;
+    label.lab(dr size) INCR 1;
+    block nr INCR 1
+  PER;
+  put label.
+
+
+  init label:
+  label.lab(archive version) := 0 ;
+  label.lab(first page stored) := 0 ;
+  label.lab(dr size) := 0;
+  INT VAR j;
+  FOR j FROM first bit word UPTO label size REP
+    label.lab (j) := all ones
+  PER.
+
+  put label:
+  put external block (label ds, 2, label block nr).
+
+  reset archive bit:
+  reset bit (label.lab (page DIV 16+first bit word), page MOD 16).
+
+END PROC write;
+
+PROC get label:
+
+  enable stop ;
+  get external block (label ds, 2, block nr)  ;
+  block nr INCR 1;
+  check label.
+
+check label:
+  IF may be z80 format label OR may be old olivetti format label
+    THEN
+    ELSE errorstop (inconsistent, "Archiv inkonsistent")
+  FI.
+
+may be z80 format label :
+  z80 archive AND label.lab(dr size) > 0 .
+
+may be old olivetti format label :
+  olivetti AND label.lab(first page stored)=0 AND label.lab(dr size+1) > 0 .
+
+END PROC get label; 
+ 
+PROC next page:
+  IF z80 archive 
+  THEN 
+    WHILE labelbits = all ones REP
+      bitword INCR 1;
+      IF bitword >= label size THEN
+      no further page := true; LEAVE next page FI
+    PER;
+    INT VAR p := lowest reset (labelbits);
+    set bit (labelbits, p);
+    page := 16*(bitword-first bit word)+p 
+  ELSE
+    WHILE oli bits = 0 REP 
+      bitword INCR 1; 
+      IF bitword >= labelsize-64 THEN
+      no further page := true; LEAVE next page FI 
+    PER; 
+    p := lowest set (oli bits); 
+    reset bit (olibits, p); 
+    page := 16*(bitword-firstbitword)+p; 
+  FI. 
+ 
+  label bits : label.lab (bitword).
+  oli bits : label.lab (bitword+1). 
+ 
+END PROC next page;
+.
+olivetti : label.lab (archive version) = -1. 
+ 
+z80 archive : label.lab (archive version) = 0. 
+ 
+init next page:
+   BOOL VAR no further page := false;
+   bitword := first bit word.
+
+check rerun :
+    IF rerun <> session
+      THEN errorstop ("RERUN beim Archiv-Zugriff")
+    FI .
+
+PROC get external block (DATASPACE VAR ds, INT CONST page,
+                         INT CONST block nr): 
+
+  INT VAR error ;
+  read block (ds, page, block nr, error) ;
+  SELECT error OF
+    CASE 0: read succeeded
+    CASE 1: error stop ("Lesen unmoeglich (Archiv)")
+    CASE 2: read failed
+    CASE 3: error stop ("Archiv-Ueberlauf") 
+    OTHERWISE error stop ("??? (Archiv)")
+  END SELECT .
+
+read succeeded :
+  unreadable sequence length := 0 .
+
+read failed :
+  unreadable sequence length INCR 1 ;
+  IF unreadable sequence length >= 30
+    THEN errorstop ("30 unlesbare Bloecke hintereinander")
+    ELSE error stop (read error, "Lesefehler (Archiv)")
+  FI .
+
+END PROC get external block; 
+ 
+PROC put external block (DATASPACE CONST ds, INT CONST page, 
+                         INT CONST block nr):
+  INT VAR error;
+  write block (ds, page, write normal, block nr, error) ;
+  SELECT error OF
+    CASE 0: 
+    CASE 1: error stop ("Schreiben unmoeglich (Archiv)")
+    CASE 2: error stop ("Schreibfehler (Archiv)")
+    CASE 3: error stop ("Archiv-Ueberlauf") 
+    OTHERWISE error stop ("??? (Archiv)") 
+  END SELECT .
+
+END PROC put external block;
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code) :
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, 0, block no, return code). 
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 INT CONST mode,
+                 INT CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, mode * 256, block no, return code) .
+
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block;
+ 
+INT PROC size (INT CONST key) :
+
+  INT VAR return code ;
+  control (5, key, 0, return code) ;
+  return code .
+
+ENDPROC size ;
+
+INT PROC archive blocks :
+  size (0)
+ENDPROC archive blocks ;
+
+PROC search dataspace (INT VAR ds pages) :
+
+  disable stop ;
+  ds pages := -1 ;
+  INT CONST last block := archive blocks ;
+ 
+  WHILE block nr < last block REP
+    IF block is dataspace label
+      THEN ds pages := pages counted ;
+           LEAVE search dataspace
+    FI ;
+    block nr INCR 1
+  UNTIL is error PER .
+
+block is dataspace label :
+  look at label block ;
+  IF is error
+    THEN IF error code = read error OR error code = inconsistent
+           THEN clear error
+         FI ;
+         FALSE
+    ELSE count pages ;
+         pages counted = number of pages as label says
+  FI .
+
+look at label block :
+  INT CONST
+  old block nr := block nr ;
+  get label ;
+  block nr := old block nr.
+
+count pages :
+  INT VAR
+  pages counted := 0 ;
+  init next page ;
+  next page ;
+  WHILE NOT no further page REP
+    pages counted INCR 1 ;
+    next page
+  PER .
+
+number of pages as label says :   label.lab (dr size) .
+
+ENDPROC search dataspace ;
+
+PROC format archive (INT CONST format code) :
+
+  IF format is possible
+    THEN format
+    ELSE errorstop ("'format' ist hier nicht implementiert")
+  FI .
+
+format is possible :
+  INT VAR return code ;
+  control (1,0,0, return code) ;
+  bit (return code, 4) .
+
+format :
+  control (7, format code, 0, return code) ;
+  IF return code = 1
+    THEN errorstop ("Formatieren unmoeglich")
+  ELIF return code > 1
+    THEN errorstop ("Schreibfehler (Archiv)")
+  FI .
+
+ENDPROC format archive ;
+
+END PACKET basic archive;
+
diff --git a/system/multiuser/1.7.5/src/canal b/system/multiuser/1.7.5/src/canal
new file mode 100644
index 0000000..ad0baa8
--- /dev/null
+++ b/system/multiuser/1.7.5/src/canal
@@ -0,0 +1,227 @@
+(* ------------------- VERSION 6     20.05.86 ------------------- *)
+PACKET canal DEFINES                           (* Autor: J.Liedtke *)
+ 
+    analyze supervisor command :
+ 
+ 
+
+LET command list =
+ 
+"begin:1.12end:3.0break:4.0continue:5.01halt:7.0
+taskinfo:8.0storageinfo:9.0help:10.0 ",
+
+    supervisor command text =
+
+""6""20""1"ESC ?  -->     help
+"6""21""1"ESC b  -->     begin ("""")
+"6""22""1"ESC c  -->     continue ("""")
+"6""23""1"ESC q  -->     break
+"6""21""50"ESC h  -->     halt
+"6""22""50"ESC s  -->     storage info
+"6""23""50"ESC t  -->     task info
+"6""8""6"gib supervisor kommando :" ,
+
+     text type = 4 ,
+     ack                 = 0 ,
+     error nak           = 2 ,
+     begin code          = 4 ,
+     end code            = 5 ,
+     break code          = 6 ,
+     halt code           = 8 ,
+     password code       = 9 ,
+     continue code       = 100 ,
+
+     home      = ""1"" ;
+
+ 
+TASK VAR sv ;
+
+DATASPACE VAR ds ;
+
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg ;
+BOUND TEXT VAR error msg ;
+
+INT VAR command index , number of params , reply ;
+TEXT VAR param 1, param 2 , task password ;
+ 
+
+  lernsequenz auf taste legen ("b", ""1""8""1""12"begin ("""")"8""8""11"") ;
+  lernsequenz auf taste legen ("c", ""1""8""1""12"continue ("""")"8""8""11"") ;
+  lernsequenz auf taste legen ("q", ""1""8""1""12"break"13"") ;
+  lernsequenz auf taste legen ("h", ""1""8""1""12"halt"13"") ;
+  lernsequenz auf taste legen ("s", ""1""8""1""12"storage info"13"") ;
+  lernsequenz auf taste legen ("t", ""1""8""1""12"task info"13"") ;
+  lernsequenz auf taste legen ("?", ""1""8""1""12"help"13"") ;
+
+PROC analyze supervisor command :
+ 
+  disable stop ;
+  sv := supervisor ;
+  ds := nilspace ;
+  REP
+    command dialogue (TRUE) ;
+    command pre ;
+    cry if not enough storage ;
+    get command (supervisor command text) ;
+    analyze command (command list, text type,
+                     command index, number of params,
+                     param1, param2) ;
+    execute command ;
+  PER .
+
+command pre :
+  IF NOT is error
+    THEN wait for terminal; eumel must advertise
+    ELSE forget (ds) ; ds := nilspace
+  FI .
+
+wait for terminal :
+  out (home) .
+
+cry if not enough storage :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN out (""7"Speicher Engpass!"13""10"") ;
+  FI .
+
+ENDPROC analyze supervisor command ;
+
+PROC execute command :
+
+  enable stop ;
+  SELECT command index OF
+    CASE  1 : begin ("PUBLIC")
+    CASE  2 : begin (param2)
+    CASE  3 : end via canal
+    CASE  4 : break
+    CASE  5 : quiet
+    CASE  6 : continue (param1)
+    CASE  7 : halt
+    CASE  8 : task info (0); eumel must advertise; quiet
+    CASE  9 : storage info; quiet
+    CASE 10 : help; eumel must advertise; quiet
+    OTHERWISE analyze command error
+  ENDSELECT ;
+  IF reply = error nak
+    THEN error msg := ds ;
+         errorstop (CONCR (error msg))
+  FI .
+ 
+end via canal :
+  IF yes ("Task """ + name (task (channel (myself))) + """ loeschen")
+    THEN eumel must advertise ;
+         call (sv, end code, ds, reply)
+  FI .
+
+break :
+  eumel must advertise ;
+  call (sv, break code, ds, reply) .
+
+halt :
+  call (sv, halt code, ds, reply) .
+
+quiet :
+  call (sv, ack, ds, reply) .
+
+analyze command error :
+  command error ;
+  IF command index = 0
+    THEN errorstop ("kein supervisor kommando")
+  ELIF number of params = 0
+    THEN errorstop ("Taskname fehlt")
+    ELSE errorstop ("Parameter ueberfluessig")
+  FI .
+
+ENDPROC  execute command ;
+ 
+PROC begin (TEXT CONST father name) :
+
+  IF param1 = "-"
+    THEN errorstop ("Name ungueltig")
+  FI ;
+  sv msg := ds ;
+  CONCR (sv msg).tname := param1 ;
+  CONCR (sv msg).tpass := "" ;
+  call (task (father name), begin code, ds, reply) ;
+  IF reply = password code
+    THEN get password ;
+         sv msg := ds ;
+         CONCR (sv msg).tpass := task password ;
+         call (task (father name), begin code, ds, reply) 
+  FI ;
+  IF reply = ack
+    THEN continue (param1)
+  FI .
+
+get password :
+  put ("      Passwort:") ;
+  get secret line (task password) .
+ 
+ENDPROC begin ;
+
+PROC continue (TEXT CONST task name) :
+
+  sv msg := ds ;
+  CONCR (sv msg).tname := task name ;
+  CONCR (sv msg).tpass := "" ;
+  call (sv, continue code + channel, ds, reply) ;
+  IF reply = password code
+    THEN get password ;
+         sv msg := ds ;
+         CONCR (sv msg).tpass := task password ;
+         call (sv, continue code + channel, ds, reply)
+  FI .
+
+get password :
+  put ("      Passwort:") ;
+  get secret line (task password) .
+
+ENDPROC continue ;
+
+PROC help: 
+
+  LET page       = ""1""4"" 
+     ,bell       = ""7"" 
+     ,cr         = ""13""
+     ,end mark   = ""14""
+     ,begin mark = ""15""
+     ,esc        = ""27"" 
+     ;
+
+  REP
+    out (page) ;
+    show page ;
+  UNTIL is quit command PER .
+
+  show page : 
+    putline(begin mark + (31 * ".") + " supervisor help " + (31 * ".") + end mark) ;
+    putline("Hier finden Sie einige Kommandos, die Ihnen den Einstieg ins System er -") ;
+    putline("leichtern sollen:") ;
+    out(""6""05""07"1. Informations-Kommandos") ;
+    out(""6""07""11"storage info        physisch belegten Hintergrundplatz melden") ;
+    out(""6""08""11"task info           Taskbaum zeigen") ;
+    out(""6""14""07"2. Verbindung zum Supervisor") ;
+    out(""6""16""11"break               Task vom Terminal abkoppeln") ;
+    out(""6""17""11"begin(""task"")       neue Task `task` einrichten") ;
+    out(""6""18""11"continue(""task"")    Task `task` an ein Terminal ankoppeln") ;
+    out(""6""21""01"Näheres:     Benutzerhandbuch, Teil 2, Kap. 2") ;
+    out(""6""23""05"Wenn Sie den Hilfe-Modus beenden wollen, tippen Sie die Taste `q`.   ") ;
+    out(cr) .
+
+  is quit command :
+    TEXT VAR char ;
+    get char (char) ;
+    IF char = esc 
+      THEN get char (char)
+    FI;
+    IF char = "q" COR char = "Q"
+      THEN true 
+      ELSE out (bell); 
+           FALSE
+    FI.
+
+END PROC help ;
+
+ENDPACKET canal ;
+
diff --git a/system/multiuser/1.7.5/src/configuration manager b/system/multiuser/1.7.5/src/configuration manager
new file mode 100644
index 0000000..5eaea52
--- /dev/null
+++ b/system/multiuser/1.7.5/src/configuration manager
@@ -0,0 +1,553 @@
+(* ------------------- VERSION 11     02.06.86 ------------------- *)
+PACKET configuration manager DEFINES
+ 
+       configurate ,
+       exec configuration ,
+       setup ,
+       define collector ,
+       configuration manager :
+
+ 
+LET baudrates      = ""1"50"2"75"3"110"4"134.5"5"150"6"300"7"600
+"8"1200"9"1800"10"2400"11"3600"12"4800"13"7200
+"14"9600"15"19200"16"38400"17"",
+    parities       = ""0"no"1"odd"2"even"3"" ,
+    bits per char  = ""0"1"1"2"2"3"3"4"4"5"5"6"6"7"7"8"8"" ,
+    stopbits       = ""0"1"1"1.5"2"2"3"" ,
+    flow modes     = ""0"ohne Protokoll"1"XON/XOFF"2"RTS/CTS
+"3""4""5"XON/XOFF - ausgabeseitig"6"RTS/CTS - ausgabeseitig"7""8"
+"9"XON/XOFF - eingabeseitig"10"RTS/CTS - eingabeseitig"11"" ,
+
+    ok             = "j" ,
+    esc            = ""27"" ,
+    cr             = ""13"" ,
+    right          = ""2"" ,
+
+    psi            = "psi" ,
+    transparent    = "transparent" ,
+
+    std rate          = 14 ,
+    std bits          = 22 ,
+    std flow          = 0 ,
+    std inbuffer size = 16 ,
+
+    device table      = 32000 ,
+
+    max edit terminal      = 15 ,
+    configuration channel  = 32 ,
+
+    fetch code             = 11 ,
+    save  code             = 12 ,
+    erase code             = 14 ,
+    system start interrupt = 100 ,
+
+    CONF = STRUCT (TEXT dev type,
+                   INT baud, bits par stop, flow control, inbuffer size) ;
+ 
+ 
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
+
+BOUND ROW max edit terminal CONF VAR conf ;
+
+INT VAR channel no ;
+
+TEXT VAR prelude , last feature , answer , collector := "" ;
+
+
+ 
+BOOL PROC shard permits (INT CONST code, key) :
+
+  INT VAR reply ; 
+  IF key > -128
+    THEN control (code, channel no, key, reply)
+    ELSE control (code, channel no, -maxint-1, reply)
+  FI ;
+  reply = 0 . 
+
+ENDPROC shard permits ;
+
+PROC ask user (TEXT CONST feature, question) :
+
+  last feature := feature ;
+  put question ;
+  skip pretyped chars ;
+  get valid answer .
+
+put question :
+  clear line ;
+  out (prelude) ;
+  out (feature) ;
+  out (question) ;
+  out (" (j/n) ") .
+
+clear line :
+  out (cr) ;
+  79 TIMESOUT " " ;
+  out (cr) .
+
+skip pretyped chars :
+  REP UNTIL incharety = "" PER .
+
+get valid answer :
+  REP
+    inchar (answer)
+  UNTIL pos ("jJyYnN"27"", answer) > 0 PER ;
+  IF answer > ""31""
+    THEN out (answer)
+  FI ;
+  out (cr) ;
+  normalize answer .
+
+normalize answer :
+  IF pos ("jJyY", answer) > 0
+    THEN answer := ok
+  FI .
+
+ENDPROC ask user ;
+
+BOOL PROC yes (TEXT CONST question) :
+
+  ask user ("", question) ;
+  answer = ok
+
+ENDPROC yes ;
+
+PROC chose key (INT VAR old key, INT CONST max key, TEXT CONST key string,
+                key entity, BOOL PROC (INT CONST) shard permits):
+
+  IF shard permits at least one standard key
+    THEN try all keys
+  FI .
+
+shard permits at least one standard key :
+  INT VAR key ;
+  FOR key FROM 0 UPTO max key REP
+    IF shard permits (key)
+      THEN LEAVE shard permits at least one standard key WITH TRUE
+    FI
+  PER ;
+  FALSE .
+
+try all keys :
+  key := old key ;
+  REP
+    examine this key ;
+    next key
+  PER .
+
+examine this key :
+  IF shard permits (key) CAND key value <> ""
+    THEN ask user (key value, key entity) ;
+         IF answer = ok
+           THEN chose this key
+         ELIF answer = esc
+           THEN key := -129
+         FI
+  FI .
+
+key value : 
+  IF key >= 0
+    THEN subtext (key string, key pos + 1, next key pos - 1)
+    ELSE text (key)
+  FI .
+
+key pos       : pos (key string, code (key)) .
+next key pos  : pos (key string, code (key+1)) .
+
+chose this key :
+  remember calibration ;
+  old key := key ;
+  LEAVE chose key .
+
+next key :
+  IF key < max key
+    THEN key INCR 1
+    ELSE key := 0
+  FI .
+
+remember calibration :
+  prelude CAT last feature ;
+  prelude CAT ", " .
+
+ENDPROC chose key ;
+
+BOOL PROC rate ok (INT CONST key) :
+
+  shard permits (8, key)
+
+ENDPROC rate ok ;
+
+BOOL PROC bits ok (INT CONST key) :
+
+  IF key < 0
+    THEN shard permits (9, key)
+    ELSE some standard combination ok
+  FI .
+
+some standard combination ok :
+  INT VAR combined := key ;
+  REP
+    IF shard permits (9, combined)
+      THEN LEAVE bits ok WITH TRUE
+    FI ;
+    combined INCR 8
+  UNTIL combined > 127 PER ;
+  FALSE
+
+ENDPROC bits ok ;
+
+BOOL PROC parity ok (INT CONST key) :
+
+  INT VAR combined := 8 * key + data bits ;
+  key >= 0 AND (shard permits (9, combined)      OR
+                shard permits (9, combined + 32) OR
+                shard permits (9, combined + 64)    )
+
+ENDPROC parity ok ;
+
+BOOL PROC stopbits ok (INT CONST key) :
+
+  key >= 0 AND shard permits (9, 32 * key + 8 * parity + data bits)
+
+ENDPROC stopbits ok ;
+
+BOOL PROC flow mode ok (INT CONST key) :
+
+  shard permits (6, key)
+
+ENDPROC flow mode ok ;
+
+
+
+INT VAR data bits ,
+        parity ,
+        stop ;
+
+INT VAR old session := 0 ;
+
+
+TEXT VAR table name, dummy ;
+
+
+PROC configurate :
+
+  new configuration ;
+  access configuration table ;
+  show all device types ;
+  channel no := 1 ;
+  REP
+    IF channel hardware exists
+      THEN try this channel ;
+           setup this channel
+    FI ;
+    channel no INCR 1
+  UNTIL channel no > 15 PER ;
+  prelude := "" ;
+  IF yes ("Koennen unbenutzte Geraetetypen geloescht werden")
+    THEN forget unused device tables
+  FI .
+
+access configuration table :
+  IF exists ("configuration")
+    THEN conf := old ("configuration")
+    ELSE conf := new ("configuration") ;
+         initialize configuration
+  FI .
+
+initialize configuration :
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    conf (channel no) :=
+    CONF:(transparent, std rate, std bits, std flow, std inbuffer size)
+  PER ;
+  conf (1).dev type := psi .
+
+show all device types :
+  show prelude ;
+  begin list ;
+  get list entry (table name, dummy) ;
+  WHILE table name <> "" REP
+    IF dataspace is device table
+      THEN show table name
+    FI ;
+    get list entry (table name, dummy)
+  PER ;
+  line (2) .
+
+show prelude :
+  line (30) ;
+  outtext (psi, 1, 20) ;
+  outtext (transparent, 1, 20) .
+
+dataspace is device table :
+  type (old (table name)) = device table .
+
+show table name :
+  outtext (table name, 1, 20) .
+ 
+try this channel :
+  prelude := "Kanal " ;
+  ask user ("", text (channel no)) ;
+  IF answer = ok
+    THEN prelude CAT text (channel no) + ": " ;
+         get configuration from user (conf (channel no)) ;
+         line
+  FI .
+
+channel hardware exists :
+  INT VAR
+  operators channel := channel ;
+  INT VAR channel type ;
+  disable stop ;
+  continue (channel no) ;
+  IF is error
+    THEN IF error message = "kein Kanal"
+           THEN channel type := 0
+           ELSE channel type := inout mask
+         FI
+    ELSE get channel type from shard
+  FI ;
+  clear error ;
+  disable stop ;
+  continue operators channel ; 
+  (channel type AND inout mask) <> 0 .
+
+get channel type from shard :
+  control (1, 0, 0, channel type) .
+
+inout mask : 3 .
+
+forget unused device tables :
+  begin list ;
+  get list entry (table name, dummy) ;
+  WHILE table name <> "" REP
+    IF type (old (table name)) = device table
+      THEN forget if unused
+    FI ;
+    get list entry (table name, dummy)
+  PER .
+
+forget if unused :
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    IF conf (channel no).dev type = table name
+      THEN LEAVE forget if unused
+    FI
+  PER ;
+  forget (table name, quiet) .
+
+setup this channel :
+  operators channel := channel ;
+  disable stop ;
+  continue (configuration channel) ;
+  set up channel (channel no, conf (channel no)) ;
+  continue operators channel . 
+
+continue operators channel :
+  continue (operators channel) ;
+  IF is error
+    THEN clear error ;
+         break (quiet) ;
+         LEAVE configurate
+  FI ;
+  enable stop .
+
+ENDPROC configurate ;
+
+PROC get configuration from user (CONF VAR conf) :
+
+  get device type ;
+  get baud rate ;
+  get bits and parity and stopbits ;
+  get protocol ;
+  get buffer size .
+
+
+get device type :
+  begin list ;
+  table name := conf.dev type ;
+  IF NOT is valid device type
+    THEN next device type
+  FI ;
+  REP
+    IF NOT (table name = transparent AND channel no = 1)
+      THEN ask user ("", table name) ;
+           IF answer = ok COR was esc followed by type table name
+             THEN IF is valid device type 
+                    THEN remember device type ;
+                         LEAVE get device type
+                    ELSE out (""7" unbekannter Typ"); pause (20) 
+                  FI
+           FI
+    FI ;
+    next device type
+  PER .
+
+was esc followed by type table name :
+  IF answer = esc
+    THEN 9 TIMESOUT right ;
+         put ("Typ:") ;
+         editget (table name) ;
+         TRUE
+    ELSE FALSE
+  FI .
+
+is valid device type :
+  table name = psi OR table name = transparent OR
+  (exists (table name) CAND type (old (table name)) = device table) .
+
+remember device type :
+  prelude CAT table name ;
+  conf.dev type := table name ;
+  prelude CAT ", " .
+
+next device type :
+  IF table name = psi
+    THEN table name := transparent
+    ELSE IF table name = transparent
+           THEN begin list
+         FI ;
+         search next device type space
+  FI .
+
+search next device type space :
+  REP
+    get list entry (table name, dummy)
+  UNTIL table name = "" COR type (old (table name)) = device table PER;
+  IF table name = ""
+    THEN table name := psi
+  FI .
+
+get baud rate :
+  chose key (conf.baud, 16, baudrates, " Baud", PROC rate ok) .
+
+get bits and parity and stopbits :
+  data bits := conf.bits par stop MOD 8 ;
+  parity := (conf.bits par stop DIV 8) MOD 4 ;
+  stop := (conf.bits par stop DIV 32) MOD 4 ;
+  chose key (data bits, 7, bits per char, " Bits", PROC bits ok) ;
+  IF data bits >= 0
+    THEN chose key (parity, 2, parities, " parity", PROC parity ok) ;
+         chose key (stop, 2, stopbits, " Stopbits", PROC stopbits ok);
+         conf.bits par stop := data bits + 8 * parity + 32 * stop
+    ELSE conf.bits par stop := data bits
+  FI .
+
+get protocol :
+  chose key (conf.flow control, 10, flow modes,
+             "", PROC flow mode ok) .
+
+get buffer size :
+  IF dev type is transparent
+    THEN chose buffer size
+    ELSE conf.inbuffer size := std inbuffer size
+  FI .
+
+dev type is transparent :
+  conf.dev type = "transparent" .
+
+chose buffer size :
+  REP
+    IF conf.inbuffer size = 16 CAND yes ("normaler Puffer")
+      THEN LEAVE chose buffer size
+    FI ;
+    conf.inbuffer size := 512 ;
+    IF yes ("grosser Puffer")
+      THEN LEAVE chose buffer size
+    FI ;
+    conf.inbuffer size := 16
+  PER .
+
+ENDPROC get configuration from user ;
+
+PROC exec configuration :
+
+  setup
+
+ENDPROC exec configuration ;
+
+PROC setup :
+
+  conf := old ("configuration") ;
+  continue (configuration channel) ;
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    set up channel (channel no, conf (channel no))
+  PER ;
+  set up collector task ;
+  break but do not forget error message if any .
+
+set up collector task :
+  IF collector <> "" CAND collector <> "-" CAND exists task (collector)
+    THEN define collector (task (collector))
+  FI .
+
+break but do not forget error message if any :
+  IF is error
+    THEN dummy := error message ;
+         clear error ;
+         break (quiet) ;
+         errorstop (dummy)
+    ELSE break (quiet)
+  FI .
+
+ENDPROC set up ;
+
+PROC set up channel (INT CONST channel no, CONF CONST conf) :
+
+  link (channel no, conf.dev type) ;
+  baudrate (channel no, conf.baud) ;
+  bits (channel no, conf.bits par stop) ;
+  flow (channel no, conf.flow control) ;
+  input buffer size (channel no, conf.inbuffer size) .
+
+ENDPROC setup channel ;
+
+PROC configuration manager (DATASPACE VAR ds, INT CONST order, phase,
+                            TASK CONST order task) :
+
+  enable stop ;
+  IF order <> system start interrupt
+    THEN font manager
+  FI ;
+  IF session <> old session
+    THEN disable stop ;
+         set up ;
+         clear error ;
+         old session := session ;
+         set autonom
+  FI .
+
+  font manager :
+    IF (order <> save code AND order <> erase code ) OR order task < supervisor
+       THEN delete password if there is one;
+            free manager (ds, order, phase, order task)
+       ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """")
+    FI .
+ 
+  delete password if there is one :
+    IF order >= fetch code AND order <= erase code AND phase = 1
+       THEN msg := ds;
+            msg. write pass := "";
+            msg. read  pass := "";
+    FI .
+ 
+ENDPROC configuration manager ;
+
+PROC configuration manager :
+
+  configurate ;
+  break ;
+  global manager
+  (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST) configuration manager)
+
+ENDPROC configuration manager ;
+
+PROC define collector (TEXT CONST task table name) :
+
+  collector := task table name ;
+  IF exists task (collector)
+    THEN define collector (task (collector))
+  FI
+
+ENDPROC define collector ;
+
+ENDPACKET configuration manager ;
+
diff --git a/system/multiuser/1.7.5/src/eumel printer b/system/multiuser/1.7.5/src/eumel printer
new file mode 100644
index 0000000..94858b5
--- /dev/null
+++ b/system/multiuser/1.7.5/src/eumel printer
@@ -0,0 +1,3066 @@
+PACKET eumel printer                           (* Autor   : Rudolf Ruland *)
+                                               (* Version : 4             *)
+                                               (* Stand   : 05.05.86      *)
+       DEFINES print, 
+               with elan listings,
+               is elan source,
+               bottom label for elan listings,
+               x pos,
+               y pos,
+               y offset index,
+               line type,
+               material,
+               pages printed :
+ 
+
+LET std x wanted                   =  2.54,
+    std y wanted                   =  2.35,
+    std limit                      =  16.0,
+    std pagelength                 =  25.0,
+    std linefeed faktor            =  1.0,
+    std material                   =  "";
+
+LET blank                          =  " ",
+    blank code 1                   =  33,
+    geschuetztes blank             =  ""223"", 
+    keine blankanalyse             =  0,
+    einfach blank                  =  1,
+    doppel blank                   =  2,
+ 
+    anweisungszeichen              =  "#",
+    anweisungszeichen code 1       =  36,
+    geschuetztes anweisungszeichen =  ""222"",
+    druckerkommando zeichen        =  "/",
+    quote                          =  """",
+ 
+    erweiterungs ausgang           =  32767,
+    blank ausgang                  =  32766,
+    anweisungs ausgang             =  32765,
+    d code ausgang                 =  32764,
+    max breite                     =  32763,
+ 
+    punkt                          =  ".",
+ 
+    leer                           =   0,
+
+    kommando token                 =  0,
+    text token                     =  1,
+ 
+    underline linetype             =  1,
+    underline bit                  =  0,
+    bold bit                       =  1,
+    italics bit                    =  2,
+    modifikations liste            =  "ubir",
+    anzahl modifikationen          =  4, 
+ 
+    document                       =  1,
+    page                           =  2,
+ 
+    write text                     =  1,
+    write cmd                      =  2,
+    carriage return                =  3, 
+    move                           =  4,
+    draw                           =  5,
+    on                             =  6, 
+    off                            =  7,
+    type                           =  8,
+ 
+    tag type                       =  1,
+    bold type                      =  2,
+    number type                    =  3,
+    text type                      =  4,
+    delimiter type                 =  6,
+    eof type                       =  7;
+ 
+ 
+INT CONST null ausgang            := -32767-1;
+ 
+ROW anzahl modifikationen INT CONST modifikations werte :=
+                               ROW anzahl modifikationen INT : (1, 2, 4, 8);
+ 
+TEXT CONST anweisungsliste := 
+    "type:1.1on:2.1off:3.1center:4.0right:5.0u:6.0d:7.0e:8.0b:9.0" +
+    "fillchar:10.1mark:11.2markend:12.0" +
+    "ub:13.0ue:14.0fb:15.0fe:16.0" +
+    "block:20.0columns:21.2columnsend:22.0free:23.1limit:24.1linefeed:25.1" + 
+    "material:26.1page:27.01pagelength:29.1start:30.2" + 
+    "table:31.0tableend:32.0clearpos:33.01" + 
+    "lpos:35.1rpos:36.1cpos:37.1dpos:38.2bpos:39.2" +
+    "textbegin:40.02textend:42.0" +
+    "indentation:43.1ytab:44.1";
+ 
+LET a type             =   1,      a block            =  20,
+    a on               =   2,      a columns          =  21,
+    a off              =   3,      a columnsend       =  22,
+    a center           =   4,      a free             =  23,
+    a right            =   5,      a limit            =  24,
+    a up               =   6,      a linefeed         =  25,
+    a down             =   7,      a material         =  26,
+    a end up or down   =   8,      a page0            =  27,
+    a bsp              =   9,      a page1            =  28,
+    a fill char        =  10,      a pagelength       =  29,
+    a mark             =  11,      a start            =  30,
+    a markend          =  12,      a table            =  31,
+    a ub               =  13,      a tableend         =  32,
+    a ue               =  14,      a clearpos0        =  33,
+    a fb               =  15,      a clearpos1        =  34,
+    a fe               =  16,      a lpos             =  35,
+                                   a rpos             =  36,
+                                   a cpos             =  37,
+                                   a dpos             =  38,
+                                   a bpos             =  39,
+                                   a textbegin0       =  40,
+                                   a textbegin2       =  41,
+                                   a textend          =  42,
+                                   a indentation      =  43,
+                                   a y tab            =  44;
+ 
+INT VAR  a xpos, a breite, a font, a modifikationen,
+         a modifikationen fuer x move, a ypos, aktuelle ypos,
+         letzter font, letzte modifikationen,
+         d ypos, d xpos, d font, d modifikationen, 
+ 
+         zeilenpos, alte zeilenpos, zeilen laenge, anzahl zeichen, ausgang,
+         anzahl einrueck blanks, blankbreite,
+         einrueckbreite, aktuelle einrueckbreite, alte einrueckbreite,
+         font durchschuss, fonthoehe, font tiefe,
+         groesste fonthoehe, aktuelle zeilenhoehe, letzte zeilenhoehe,
+         blankmodus, alter blankmodus,
+         token zeiger, erstes token der zeile, 
+
+         erstes tab token, tab anfang, anzahl blanks, 
+         d code 1, d pitch, fuell zeichen breite, erstes fuell token, 
+         letztes fuell token, 
+ 
+         x size, y size, x wanted, y wanted, x start, y start,
+         pagelength, limit, indentation,
+         left margin, top margin, seitenlaenge,
+         papierlaenge, papierbreite,
+         luecke, anzahl spalten, aktuelle spalte,
+
+         verschiebung, rest, neue modifikationen, modifikations modus, pass,
+ 
+         int param, anweisungs index, anzahl params, index,
+ 
+         gedruckte seiten;
+ 
+BOOL VAR zeile ist absatzzeile, letzte zeile war absatzzeile,
+         zeile muss geblockt werden, rechts, a block token, offsets,
+         tabellen modus, block modus, center modus, right modus,
+         seite ist offen, vor erster seite;
+ 
+REAL VAR linefeed faktor, real param;
+ 
+TEXT VAR zeile, anweisung, par1, par2, material wert, replacements,
+         fuell zeichen, d string, font offsets;
+ 
+ROW 256 INT VAR zeichenbreiten, replacement tabelle, zeichen zaehler;
+ 
+INITFLAG VAR in dieser task := FALSE;
+ 
+. zeile ist zu ende               : zeilenpos > zeilen laenge
+ 
+. zeilen breite                   : a xpos - left margin
+ 
+. neue zeilenhoehe                : int (linefeed faktor * real (fonthoehe) + 0.5)
+ 
+. naechstes zeichen ist blank     : pos (zeile, blank, zeilenpos + 1, zeilenpos + 1) <> 0
+ 
+. naechstes nicht blankes zeichen : pos (zeile, ""33"", ""255"", zeilenpos)
+ 
+. in letzter spalte               : aktuelle spalte >= anzahl spalten
+ 
+. anfangs blankmodus :
+    INT VAR dummy;
+    IF   center modus OR right modus
+         THEN dummy
+    ELIF index zaehler = 0
+         THEN blankmodus
+         ELSE alter blankmodus
+    FI
+ 
+. initialisiere tab variablen : 
+    erstes tab token := token index f + 1;
+    tab anfang       := zeilen breite;
+    anzahl blanks    := 0;
+.;
+ 
+(******************************************************************)
+ 
+LET zeilen nr laenge  =  4,
+    teil einrueckung  =  5,
+ 
+    headline pre  = "Zeile    ****   E L A N    EUMEL 1.7.5  ****   ",
+    headline post = "   ****    ";
+ 
+INT  VAR zeilen nr, rest auf seite,
+         max zeichen zeile, max zeichen fuss, layout laenge, layout laenge name,
+         symbol type, naechster symbol type;
+ 
+BOOL VAR vor erstem packet, innerhalb der define liste;
+ 
+TEXT VAR bottom label, dateiname, layout blanks, refinement layout zeile;
+ 
+ 
+. symbol           : fuell zeichen
+. naechstes symbol : d string
+. elan text        : d token. text
+.; 
+ 
+(******************************************************************)
+(*** tokenspeicher                                              ***)
+
+LET max token  = 3000,
+    max ypos   = 1000,
+ 
+    TOKEN      = STRUCT (TEXT text,
+                         INT  xpos, breite, font, modifikationen,
+                              modifikationen fuer x move, 
+                              offset index, naechster token index, 
+                         BOOL block token ),
+
+    YPOS       = STRUCT (INT ypos, vorheriger ypos index, naechster ypos index,
+                             erster token index, letzter token index ), 
+ 
+    TOKENLISTE = STRUCT (ROW max token TOKEN token liste,
+                         ROW max ypos  YPOS  ypos  liste );
+ 
+DATASPACE VAR ds;
+ 
+BOUND TOKENLISTE VAR tokenspeicher;
+ 
+TOKEN VAR d token, offset token;
+ 
+INT VAR erster ypos index a, letzter ypos index a, 
+        erster ypos index d, letzter ypos index d, 
+        ypos  index, ypos  index f, ypos  index a, ypos  index d, 
+        token index, token index f;
+ 
+. t  : tokenspeicher. token liste (token index)
+. tf : tokenspeicher. token liste (token index f)
+ 
+. y  : tokenspeicher. ypos  liste (ypos  index) 
+. yf : tokenspeicher. ypos  liste (ypos  index f) 
+. ya : tokenspeicher. ypos  liste (ypos  index a)
+. yd : tokenspeicher. ypos  liste (ypos  index d)
+ 
+. loesche druckspeicher :
+    erster ypos index d := 0;
+           ypos index f := 0;
+          token index f := 0;
+ 
+. druckspeicher ist nicht leer :
+    erster ypos index d <> 0
+ 
+. loesche analysespeicher :
+    erster ypos index a := 0;
+ 
+. analysespeicher ist nicht leer :
+    erster ypos index a <> 0
+.; 
+ 
+(******************************************************************)
+(*** anweisungsspeicher                                         ***)
+ 
+INT  VAR anweisungszaehler;
+TEXT VAR anweisungs indizes, params1 zeiger, params2 zeiger;
+THESAURUS VAR params1, params2; 
+ 
+PROC loesche anweisungsspeicher :
+ 
+    anweisungs zaehler := 0;
+    anweisungs indizes := "";
+    params1 zeiger     := "";
+    params2 zeiger     := "";
+    params1            := empty thesaurus;
+    params2            := empty thesaurus;
+ 
+END PROC loesche anweisungsspeicher; 
+ 
+(******************************************************************)
+(*** indexspeicher                                              ***)
+ 
+INT  VAR index zaehler;
+TEXT VAR grosse fonts, verschiebungen;
+
+PROC loesche indexspeicher :
+ 
+    index zaehler  := 0;
+    grosse fonts   := "";
+    verschiebungen := "";
+ 
+END PROC loesche indexspeicher; 
+ 
+ 
+(******************************************************************)
+(*** tabellenspeicher                                           ***)
+ 
+LET max tabs          =  30,
+    TABELLENEINTRAG   =  STRUCT (INT tab typ, tab position, tab param);
+
+TEXT VAR tab liste, fill char;
+THESAURUS VAR d strings;
+ROW max tabs TABELLENEINTRAG VAR tabspeicher;
+ 
+INT VAR tab index;
+ 
+. tab typ       : tab speicher (tab liste ISUB tab index). tab typ
+. tab position  : tab speicher (tab liste ISUB tab index). tab position
+. tab param     : tab speicher (tab liste ISUB tab index). tab param 
+. anzahl tabs   : LENGTH tab liste DIV 2 
+.;
+ 
+PROC loesche tabellenspeicher :
+ 
+    fill char := " ";
+    tabliste  := "";
+    d strings := empty thesaurus;
+    FOR tab index FROM 1 UPTO max tabs
+        REP tab speicher (tab index). tab typ := leer PER;
+ 
+END PROC loesche tabellenspeicher;
+ 
+(******************************************************************)
+(*** markierungsspeicher                                        ***)
+ 
+INT VAR mark index l, mark index r, alter mark index l, alter mark index r;
+ 
+ROW 4 TOKEN VAR mark token;
+ 
+. markierung links  : mark index l > 0
+. markierung rechts : mark index r > 0
+.;
+ 
+PROC loesche markierung :
+ 
+     mark index l := 0;
+     mark index r := 0;
+
+END PROC loesche markierung;
+ 
+ 
+PROC loesche alte markierung :
+ 
+     alter mark index l := 0;
+     alter mark index r := 0;
+
+END PROC loesche alte markierung;
+ 
+
+PROC initialisiere markierung :
+ 
+     FOR mark index l FROM 1 UPTO 4
+     REP mark token (mark index l). modifikationen fuer x move := 0;
+         mark token (mark index l). offset index               := text token;
+         mark token (mark index l). block token                := FALSE;
+         mark token (mark index l). naechster token index      := 0;
+     PER;
+ 
+END PROC initialisiere markierung;
+ 
+(******************************************************************)
+(*** durchschuss                                                ***)
+ 
+INT VAR durchschuss 1, durchschuss 2, anzahl durchschuss 1, 
+        anzahl durchschuss, zeilen zaehler;
+ 
+BOOL VAR wechsel := TRUE;
+ 
+INT PROC durchschuss :
+ 
+     zeilen zaehler INCR 1;
+     IF   zeilen zaehler <= anzahl durchschuss 1
+          THEN durchschuss 1
+     ELIF zeilen zaehler <= anzahl durchschuss 
+          THEN durchschuss 2
+          ELSE 0
+     FI
+ 
+END PROC durchschuss;
+ 
+ 
+PROC neuer durchschuss (INT CONST anzahl, rest) :
+ 
+     zeilen zaehler     := 0;
+     anzahl durchschuss := anzahl;
+     IF anzahl > 0 
+        THEN IF wechsel
+                THEN durchschuss 1        := rest DIV anzahl durchschuss;
+                     durchschuss 2        := durchschuss 1 + sign (rest);
+                     anzahl durchschuss 1 := anzahl durchschuss -
+                                             abs (rest) MOD anzahl durchschuss;
+                     wechsel              := FALSE;
+                ELSE durchschuss 2        := rest DIV anzahl durchschuss; 
+                     durchschuss 1        := durchschuss 2 + sign (rest);
+                     anzahl durchschuss 1 := abs (rest) MOD anzahl durchschuss;
+                     wechsel              := TRUE;
+             FI;
+        ELSE loesche durchschuss
+     FI;
+ 
+END PROC neuer durchschuss;
+ 
+ 
+PROC loesche durchschuss :
+
+     durchschuss 1           := 0;
+     durchschuss 2           := 0;
+     anzahl durchschuss 1    := 0;
+     anzahl durchschuss      := 0;
+     zeilen zaehler          := 0;
+ 
+END PROC loesche durchschuss;
+ 
+(****************************************************************)
+ 
+PROC initialisierung :
+ 
+  forget (ds);
+  ds := nilspace; tokenspeicher := ds;
+  loesche druckspeicher;
+  loesche anweisungsspeicher;
+  loesche indexspeicher;
+  initialisiere markierung;
+  right  modus                 := FALSE;
+  center modus                 := FALSE;
+  seite ist offen              := FALSE;
+  pass                         := 0;
+  a breite                     := 0;
+  a block token                := FALSE;
+  a modifikationen fuer x move := 0;
+  d code 1                     := leer;
+  erstes fuell token           := leer;
+  IF two bytes
+     THEN FOR index FROM   1 UPTO 129 REP zeichen zaehler (index) := 1 PER; 
+          FOR index FROM 130 UPTO 160 REP zeichen zaehler (index) := - maxint PER;
+          FOR index FROM 161 UPTO 224 REP zeichen zaehler (index) := 1 PER;
+          FOR index FROM 225 UPTO 240 REP zeichen zaehler (index) := - maxint PER;
+          FOR index FROM 241 UPTO 256 REP zeichen zaehler (index) := 1 PER;
+     ELSE FOR index FROM   1 UPTO 256 REP zeichen zaehler (index) := 1 PER; 
+  FI;
+ 
+END PROC initialisierung;
+ 
+(****************************************************************)
+(*** print - Kommando                                         ***)
+
+BOOL VAR elan listings erlaubt;
+FILE VAR eingabe;
+ 
+with elan listings (TRUE);
+ 
+PROC with elan listings (BOOL CONST flag) :
+     elan listings erlaubt := flag;
+END PROC with elan listings;
+ 
+BOOL PROC with elan listings : elan listings erlaubt END PROC with elan listings;
+ 
+ 
+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ):
+ 
+  print (PROC (TEXT VAR) lese zeile, BOOL PROC eof,
+         PROC (INT CONST, INT VAR, INT VAR) open,
+         PROC (INT CONST, INT CONST) close,
+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 
+         FALSE, "");
+ 
+END PROC print;
+ 
+ 
+PROC print (FILE VAR file,
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+
+  eingabe := file;
+  input (eingabe);
+  print (PROC (TEXT VAR) lese zeile, BOOL PROC eof,
+         PROC (INT CONST, INT VAR, INT VAR) open,
+         PROC (INT CONST, INT CONST) close,
+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 
+         elan listings erlaubt CAND is elan source (eingabe), 
+         headline (eingabe) );
+ 
+END PROC print;
+ 
+PROC lese zeile (TEXT VAR zeile) : getline (eingabe, zeile) END PROC lese zeile;
+ 
+BOOL PROC eof : eof (eingabe) END PROC eof;
+ 
+BOOL PROC is elan source (FILE VAR eingabe) :
+ 
+hole erstes symbol;
+elan programm tag COR elan programm bold COR kommentar
+
+. elan programm tag :
+    symbol type = tag type CAND pos (zeile, ";") > 0 
+ 
+. elan programm bold :
+    symbol type = bold type CAND is elan bold
+
+    . is elan bold :
+        symbol = "PACKET" COR symbol = "LET"
+            COR proc oder op (symbol) COR deklaration
+ 
+    . deklaration :
+        next symbol (symbol);
+        symbol = "VAR" OR symbol = "CONST"
+
+. kommentar :
+    pos (zeile, "(*") > 0 OR pos (zeile, "{") > 0 
+
+. 
+  hole erstes symbol :
+    hole erstes nicht blankes symbol; 
+    scan (zeile);
+    next symbol (symbol, symbol type);
+ 
+    . hole erstes nicht blankes symbol :
+        IF eof (eingabe) THEN LEAVE is elan source WITH FALSE FI;
+        REP getline (eingabe, zeile);
+        UNTIL pos (zeile, ""33"",""254"", 1) > 0 OR eof (eingabe) PER;
+        reset (eingabe);
+ 
+END PROC is elan source;
+
+(****************************************************************)
+ 
+bottom label for elan listings ("");
+ 
+PROC bottom label for elan listings (TEXT CONST label) :
+     bottom label := label;
+END PROC bottom label for elan listings;
+ 
+TEXT PROC bottom label for elan listings : bottom label END PROC bottom label for elan listings;
+ 
+ 
+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,
+            BOOL CONST elan listing, TEXT CONST file name) :
+ 
+disable stop;
+gedruckte seiten := 0;
+drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,
+              PROC (INT CONST, INT VAR, INT VAR) open,
+              PROC (INT CONST, INT CONST) close,
+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,
+              elan listing, file name );
+IF is error THEN behandle fehlermeldung FI;
+ 
+. behandle fehlermeldung :
+    par1 := error message;
+    int param := error line;
+    clear error;
+    IF NOT vor erster seite
+       THEN IF seite ist offen
+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )
+            FI;
+            clear error;
+            close (document, 0);
+            clear error;
+    FI;
+    initialisierung;
+    errorstop (par1 (* + " -> " + text (int param) *) );
+ 
+END PROC print; 
+ 
+INT PROC x pos          : d xpos                END PROC x pos;
+INT PROC y pos          : d ypos                END PROC y pos;
+INT PROC y offset index : d token. offset index END PROC y offset index;
+INT PROC linetype       : underline linetype    END PROC linetype;
+TEXT PROC material      : material wert         END PROC material;
+INT PROC pages printed  : gedruckte seiten      END PROC pages printed;
+ 
+(****************************************************************)
+ 
+PROC drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,
+                   PROC (INT CONST, INT VAR, INT VAR) open,
+                   PROC (INT CONST, INT CONST) close,
+                   PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,
+                   BOOL CONST elan listing, TEXT CONST file name ) :
+ 
+ 
+enable stop;
+IF elan listing
+   THEN dateiname := file name;
+        drucke elan listing;
+   ELSE drucke text datei;
+FI;
+ 
+.
+  drucke text datei :
+    initialisiere druck; 
+    WHILE NOT eof
+    REP next line (zeile); 
+        analysiere zeile; 
+        drucke token soweit wie moeglich;
+        werte anweisungsspeicher aus;
+    PER;
+    schliesse druck ab; 
+ 
+. 
+  initialisiere druck :
+    IF NOT initialized (in dieser task)
+       THEN ds := nilspace;
+            initialisierung
+    FI;
+    vor erster seite               := TRUE;
+    tabellen modus                 := FALSE;
+    block modus                    := FALSE;
+    zeile ist absatzzeile          := TRUE;
+    x wanted                       := x step conversion (std x wanted);
+    y wanted                       := y step conversion (std y wanted);
+    limit                          := x step conversion (std limit);
+    pagelength                     := y step conversion (std pagelength);
+    linefeed faktor                := std linefeed faktor;
+    material wert                  := std material;
+    indentation                    := 0;
+    modifikations modus            := maxint; 
+    seitenlaenge                   := maxint;
+    papierlaenge                   := maxint;
+    left margin                    := 0;
+    top  margin                    := 0;
+    a ypos                         := top margin;
+    a font                         := -1;
+    a modifikationen               := 0;
+    aktuelle spalte                := 1;
+    anzahl spalten                 := 1;
+    stelle neuen font ein (1);
+    loesche tabellenspeicher;
+    loesche markierung;
+    loesche alte markierung;
+    loesche durchschuss;
+ 
+. 
+  schliesse druck ab :
+    IF NOT vor erster seite
+       THEN IF seite ist offen
+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )
+            FI;
+            close (document, 0);
+    FI;
+ 
+.
+  drucke token soweit wie moeglich :
+    IF analysespeicher ist nicht leer
+       THEN letztes token bei gleicher ypos; 
+            IF NOT seite ist offen
+               THEN eroeffne seite (x wanted, y wanted,
+                                  PROC (INT CONST, INT VAR, INT VAR) open);
+            FI;
+            gehe zur letzten neuen ypos;
+            IF seitenlaenge ueberschritten OR papierlaenge ueberschritten 
+               THEN neue seite oder spalte;
+                    analysiere zeile nochmal;
+               ELSE sortiere neue token ein;
+                    IF in letzter spalte
+                       THEN drucke tokenspeicher (a ypos,
+                            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                    FI;
+            FI;
+    FI;
+ 
+    . gehe zur letzten neuen ypos :
+        ypos index a := letzter ypos index a
+ 
+    . seitenlaenge ueberschritten :
+        ya. ypos > seitenlaenge 
+ 
+    . papierlaenge ueberschritten :
+        ya. ypos > papierlaenge 
+ 
+    . neue seite oder spalte :
+        IF in letzter spalte
+           THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                      PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                eroeffne seite (x wanted, aktuelles y wanted,
+                      PROC (INT CONST, INT VAR, INT VAR) open);
+           ELSE neue spalte;
+        FI;
+ 
+        . aktuelles y wanted :
+            IF seitenlaenge ueberschritten
+               THEN y wanted
+               ELSE 0
+            FI
+ 
+    . analysiere zeile nochmal :
+        setze auf alte werte zurueck;
+        loesche anweisungsspeicher;
+        analysiere zeile;
+        letztes token bei gleicher ypos;
+        sortiere neue token ein;
+ 
+        . setze auf alte werte zurueck :
+           zeile ist absatzzeile := letzte zeile war absatzzeile;
+           a modifikationen      := letzte modifikationen;
+           stelle neuen font ein (letzter font);
+ 
+.
+  werte anweisungsspeicher aus :
+    INT VAR index;
+    FOR index  FROM 1 UPTO anweisungszaehler
+    REP
+        SELECT anweisungs indizes ISUB index OF
+          CASE a block             : block anweisung
+          CASE a columns           : columns anweisung
+          CASE a columnsend        : columnsend anweisung
+          CASE a free              : free anweisung
+          CASE a limit             : limit anweisung
+          CASE a linefeed          : linefeed anweisung
+          CASE a material          : material anweisung
+          CASE a page0, a page1    : page anweisung
+          CASE a pagelength        : pagelength anweisung
+          CASE a start             : start anweisung
+          CASE a table             : table anweisung
+          CASE a tableend          : tableend anweisung 
+          CASE a clearpos0         : clearpos0 anweisung
+          CASE a clearpos1         : clearpos1 anweisung
+          CASE a lpos, a rpos, a cpos, a dpos
+                                   : lpos rpos cpos dpos anweisung
+          CASE a bpos              : bpos anweisung
+          CASE a fillchar          : fillchar anweisung
+          CASE a textbegin0        : textbegin0 anweisung
+          CASE a textbegin2        : textbegin2 anweisung
+          CASE a textend           : textend anweisung
+          CASE a indentation       : indentation anweisung
+          CASE a y tab             : y tab anweisung
+        END SELECT
+   PER; 
+   loesche anweisungsspeicher;
+ 
+   . block anweisung :
+       blockmodus := TRUE;
+ 
+   . columns anweisung :
+       IF anzahl spalten = 1 AND int  conversion ok (param1)
+                             AND real conversion ok (param2) 
+          THEN anzahl spalten := max (1, int param); 
+               luecke         := x step conversion (real param);
+       FI;
+ 
+   . columnsend anweisung :
+       anzahl spalten  := 1;
+       aktuelle spalte := 1; 
+       left margin     := x wanted - x start + indentation;
+ 
+   . free anweisung :
+       IF real conversion ok (param1) THEN a ypos INCR y step conversion (real param) FI;
+ 
+   . limit anweisung :
+       IF real conversion ok (param1) THEN limit := x step conversion (real param) FI;
+ 
+   . linefeed anweisung :
+       IF real conversion ok (param1)
+          THEN linefeed faktor    := real param;
+               letzte zeilenhoehe := neue zeilenhoehe;
+       FI;
+
+   . material anweisung :
+       material wert := param1;
+ 
+   . page anweisung :
+       IF seite ist offen
+          THEN IF NOT in letzter spalte
+                  THEN neue spalte
+                  ELSE schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                       papier laenge := maxint;
+               FI;
+          ELSE a ypos        := top margin;
+               papier laenge := maxint;
+       FI;
+ 
+   . pagelength anweisung :
+       IF real conversion ok (param1)
+          THEN pagelength   := y step conversion (real param);
+       FI;
+ 
+   . start anweisung :
+       IF real conversion ok (param1) THEN x wanted := x step conversion (real param) FI;
+       IF real conversion ok (param2) THEN y wanted := y step conversion (real param) FI;
+ 
+   . table anweisung :
+       tabellenmodus := TRUE;
+ 
+   . tableend anweisung :
+       tabellenmodus := FALSE;
+ 
+   . clearpos0 anweisung :
+       loesche tabellenspeicher;
+ 
+   . clearpos1 anweisung :
+       IF real conversion ok (param1) 
+          THEN int param := x step conversion (real param);
+               FOR tab index FROM 1 UPTO anzahl tabs
+               REP IF tab position = int param
+                      THEN tab typ := leer;
+                           delete int (tab liste, tab index);
+                           LEAVE clearpos1 anweisung;
+                   FI;
+               PER;
+       FI; 
+ 
+   . lpos rpos cpos dpos anweisung :
+       IF real conversion ok (param1)
+          THEN neuer tab eintrag (anweisungs indizes ISUB index, param2) FI; 
+ 
+   . bpos anweisung :
+       IF real conversion ok (param2) CAND real conversion ok (param1)
+            CAND real (param2) > real param
+          THEN neuer tab eintrag (a bpos, param2) FI;
+ 
+   . fillchar anweisung :
+        fill char := param1;
+ 
+   . textbegin0 anweisung :
+       aktuelle einrueckbreite := alte einrueckbreite;
+       mark index l            := alter mark index l;
+       mark index r            := alter mark index r;
+       loesche alte markierung;
+ 
+   . textbegin2 anweisung :
+       aktuelle einrueckbreite := alte einrueckbreite;
+       mark index l            := alter mark index l;
+       mark index r            := alter mark index r;
+       loesche alte markierung;
+       neuer durchschuss (int (param1), y step conversion (real (param 2)));
+ 
+   . textend anweisung :
+       alte einrueckbreite := aktuelle einrueckbreite;
+       alter mark index l  := mark index l;
+       alter mark index r  := mark index r;
+       loesche markierung;
+       loesche durchschuss;
+
+   . indentation anweisung :
+(*     IF real conversion ok (param1)
+          THEN int param   := x step conversion (real param);
+               left margin INCR (int param - indentation);
+               indentation :=    int param;
+       FI;
+  *)
+   . y tab anweisung :
+(*     IF real conversion ok (param1)
+          THEN int param := y step conversion (real param);
+               IF int param <= seitenlaenge THEN a ypos := int param FI;
+       FI;
+  *)
+       . param1 :
+           IF (params1 zeiger ISUB index) <> 0
+              THEN name (params1, params1 zeiger ISUB index)
+              ELSE ""
+           FI
+ 
+       . param2 :
+           IF (params2 zeiger ISUB index) <> 0
+              THEN name (params2, params2 zeiger ISUB index)
+              ELSE ""
+           FI
+ 
+
+.
+  drucke elan listing :
+    initialisiere elan listing;
+    WHILE NOT eof
+    REP next line (zeile);
+        zeilen nr INCR 1;
+        drucke elan zeile;
+    PER;
+    schliesse elan listing ab;
+ 
+.
+  initialisiere elan listing :
+    open document cmd;
+    hole elan list font;
+    initialisiere variablen;
+    elan fuss und kopf (1,
+               PROC (INT CONST, INT CONST) close,
+               PROC (INT CONST, INT VAR, INT VAR) open,
+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+    . open document cmd :
+        material wert         := "";
+        d token. offset index := 1;
+        erster ypos index d   := 0; 
+        vor erster seite      := FALSE;
+        seite ist offen       := FALSE;
+        open (document, x size, y size);
+        vor erster seite      := TRUE;
+ 
+    . hole elan list font :
+        d font := max (1, font ("elanlist"));
+        get replacements (d font, replacements, replacement tabelle);
+        einrueckbreite := indentation pitch (d font) ;
+        font hoehe     := font lead (d font) + font height (d font) + font depth (d font);
+ 
+    . initialisiere variablen :
+        innerhalb der define liste := FALSE;
+        vor erstem packet       := TRUE;
+        zeilen nr               := 0;
+        y wanted                := y size DIV 23;
+        pagelength              := y size - y wanted - y wanted; 
+        x wanted                := (min (x size DIV 10, x step conversion (2.54))
+                                        DIV einrueckbreite) * einrueckbreite; 
+        max zeichen zeile       := (x size - x wanted - (x wanted DIV 3)) DIV einrueckbreite;
+        max zeichen fuss        := fusszeilenbreite;
+        layout laenge           := min (38, max zeichen zeile DIV 3);
+        layout laenge name      :=  layout laenge - zeilen nr laenge - 8; 
+        layout blanks           := (layout laenge - zeilen nr laenge - 1) * " "; 
+        refinement layout zeile := (layout laenge - 1) * " " ;
+        refinement layout zeile CAT "|" ;
+        IF pagelength DIV fonthoehe - 6 < 35 OR max zeichen zeile < 65
+           THEN errorstop ("Schreibfeld fuer 'elan listing' zu klein") FI;
+ 
+        . fusszeilenbreite :
+            INT CONST dina 4 breite := x step conversion (21.0);
+            IF   x size <= dina 4 breite
+                 THEN (x size - 2 * x wanted) DIV einrueckbreite 
+            ELIF 120 * einrueckbreite <= dina 4 breite - 2 * x wanted
+                 THEN (dina 4 breite - 2 * x wanted) DIV einrueckbreite 
+                 ELSE min (120, (x size - 2 * x wanted) DIV einrueckbreite)
+            FI
+ 
+.
+  schliesse elan listing ab :
+    elan fuss und kopf (-1,
+               PROC (INT CONST, INT CONST) close,
+               PROC (INT CONST, INT VAR, INT VAR) open,
+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    close (document, 0);
+ 
+. 
+  drucke elan zeile :
+    IF pos (zeile, "#page#") = 1 
+       THEN IF nicht am seiten anfang THEN seiten wechsel FI;
+       ELSE bestimme elan layout;
+            bestimme elan zeile;
+            gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+            seitenwechsel wenn noetig;
+    FI;
+ 
+    . nicht am seitenanfang :
+        rest auf seite < pagelength - 3 * font hoehe
+ 
+    . seiten wechsel :
+        elan fuss und kopf (0,
+               PROC (INT CONST, INT CONST) close,
+               PROC (INT CONST, INT VAR, INT VAR) open,
+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+. 
+  bestimme elan layout :
+    IF pos (zeile, "P") = 0 AND pos (zeile, ":") = 0
+       THEN leeres layout 
+       ELSE analysiere elan zeile
+    FI;
+    elan text CAT "|";
+ 
+    . leeres layout :
+        elan text := text (zeilen nr, zeilen nr laenge);
+        elan text CAT layout blanks;
+ 
+    . analysiere elan zeile :
+        scan (zeile);
+        next symbol (symbol, symbol type);
+        next symbol (naechstes symbol, naechster symbol type) ;
+        IF   packet anfang              THEN packet     layout 
+        ELIF innerhalb der define liste THEN leeres     layout; pruefe ende der define liste 
+        ELIF proc op anfang             THEN proc op    layout
+        ELIF refinement anfang          THEN refinement layout
+                                        ELSE leeres     layout
+        FI;
+ 
+    . packet anfang :
+        symbol = "PACKET"
+ 
+    . proc op anfang :
+        IF   proc oder op (symbol)
+             THEN naechster symbol type <> delimiter type
+        ELIF (symbol <> "END") AND proc oder op (naechstes symbol)
+             THEN symbol := naechstes symbol;
+                  next symbol (naechstes symbol, naechster symbol type) ;
+                  naechster symbol type <> delimiter type
+             ELSE FALSE
+        FI
+ 
+    . refinement anfang :
+        symbol type = tag type AND naechstes symbol = ":" 
+                                  AND NOT innerhalb der define liste 
+ 
+    . packet layout :
+        IF nicht am seiten anfang AND
+             (NOT vor erstem packet OR gedruckte seiten > 0)
+           THEN seiten wechsel FI;
+        layout ("   ", naechstes symbol, "*") ;
+        vor erstem packet := FALSE ;
+        innerhalb der define liste := TRUE;
+        pruefe ende der define liste;
+
+       . pruefe ende der define liste :
+           IF pos (zeile, ":") <> 0
+              THEN scan (zeile);
+                   WHILE innerhalb der define liste
+                   REP next symbol (symbol);
+                       IF symbol = ":" THEN innerhalb der define liste := FALSE FI;
+                   UNTIL symbol = "" PER;
+           FI;
+
+    . proc op layout :
+        IF   keine vier zeilen mehr
+             THEN seiten wechsel
+        ELIF nicht am seitenanfang
+             THEN cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+        FI ; 
+        layout ("   ", naechstes symbol, ".");
+ 
+        . keine vier zeilen mehr :
+            rest auf seite <= 8 * font hoehe 
+ 
+    . refinement layout :
+        IF   keine drei zeilen mehr
+             THEN seiten wechsel
+        ELIF nicht am seitenanfang
+             THEN elan text := refinement layout zeile;
+                  gib elan text aus
+                       (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+        FI ; 
+        layout ("      ", symbol, " ");
+ 
+        . keine drei zeilen mehr :
+            rest auf seite <= 7 * font hoehe 
+ 
+. 
+  bestimme elan zeile : 
+    IF zeile ist nicht zu lang
+       THEN elan text CAT zeile;
+       ELSE drucke zeile in teilen 
+    FI;
+ 
+    . zeile ist nicht zu lang :
+        zeilen laenge := LENGTH zeile;
+        zeilen laenge <= rest auf zeile
+ 
+       . rest auf zeile :
+           max zeichen zeile - LENGTH elan text
+ 
+    . drucke zeile in teilen :
+        zeilen pos := 1;
+        bestimme einrueckung;
+        WHILE zeile noch nicht ganz gedruckt REP teil layout PER;
+ 
+    . bestimme einrueckung :
+        anzahl einrueck blanks := naechstes nicht blankes zeichen - 1;
+        IF anzahl einrueck blanks > rest auf zeile - 20
+           THEN anzahl einrueck blanks := 0 FI;
+ 
+    . zeile noch nicht ganz gedruckt :
+        bestimme zeilenteil;
+        NOT zeile ist zu ende
+ 
+        . bestimme zeilenteil :
+            bestimme laenge;
+            zeilen teil := subtext (zeile, zeilen pos, zeilen pos + laenge - 1);
+            elan text CAT zeilen teil;
+            zeilen pos INCR laenge;
+ 
+            . zeilen teil : par1
+
+            . bestimme laenge :
+               INT VAR laenge := zeilen laenge - zeilen pos + 1;
+               IF laenge > rest auf zeile
+                  THEN laenge := rest auf zeile;
+                       WHILE (zeile SUB (zeilen pos + laenge - 1)) <> " "
+                       REP laenge DECR 1 UNTIL laenge = 0 PER;
+                       IF laenge = 0 THEN laenge := rest auf zeile FI;
+               FI;
+ 
+    . teil layout :
+        gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+        elan text :=  (zeilen nr laenge - 1) * " "; 
+        elan text CAT "+";
+        elan text CAT layout blanks;
+        elan text CAT "|";
+        elan text cat blanks (anzahl einrueck blanks + teil einrueckung);
+ 
+. 
+  seiten wechsel wenn noetig :
+    IF keine zeilen mehr AND NOT eof THEN seiten wechsel FI; 
+ 
+    . keine zeilen mehr :
+        rest auf seite <= 4 * font hoehe 
+ 
+END PROC drucke datei;
+ 
+ 
+BOOL PROC real conversion ok (TEXT CONST param) :
+     real param := real (param);
+     last conversion ok AND real param >= 0.0
+END PROC real conversion ok;
+ 
+ 
+BOOL PROC int conversion ok (TEXT CONST param) :
+     int param := int (param);
+     last conversion ok AND int param >= 0 
+END PROC int conversion ok;
+ 
+ 
+PROC neuer tab eintrag (INT CONST typ, TEXT CONST param) :
+ 
+     suche neuen eintrag;
+     sortiere neue tab position ein;
+     tab typ      := typ;
+     tab position := neue tab position;
+     tab param    := eventueller parameter;
+ 
+     . suche neuen eintrag :
+         INT VAR index := 0;
+         REP index INCR 1;
+             IF tab speicher (index). tab typ = leer
+                THEN LEAVE suche neuen eintrag FI;
+         UNTIL index = max tabs PER;
+         LEAVE neuer tab eintrag;
+ 
+     . sortiere neue tab position ein :
+         INT VAR neue tab position := x step conversion (real param);
+         FOR tab index FROM 1 UPTO anzahl tabs
+         REP IF   tab position = neue tab position
+                THEN LEAVE neuer tab eintrag
+             ELIF tab position > neue tab position
+                THEN insert int (tab liste, tab index, index);
+                     LEAVE sortiere neue tab position ein;
+             FI;
+         PER;
+         tab liste CAT index;
+         tab index :=  anzahl tabs;
+ 
+     . eventueller parameter :
+         INT VAR link;
+         SELECT typ OF
+           CASE a dpos : insert (d strings, param, link); link
+           CASE a bpos : x step conversion (real(param))
+             OTHERWISE : 0
+         END SELECT
+ 
+END PROC neuer tab eintrag;
+ 
+ 
+PROC neue spalte :
+     a ypos           :=  top margin;
+     left margin     INCR (limit + luecke);
+     aktuelle spalte INCR 1;
+END PROC neue spalte ;
+ 
+ 
+BOOL PROC proc oder op (TEXT CONST symbol) :
+
+  symbol = "PROC" OR symbol = "PROCEDURE"
+    OR symbol = "OP" OR symbol = "OPERATOR" 
+
+ENDPROC proc oder op ;
+ 
+ 
+PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :
+
+name := subtext (name, 1, layout laenge name) ;
+elan text :=  text (zeilen nr, zeilen nr laenge);
+elan text CAT pre;
+elan text CAT name;
+elan text CAT " ";
+generiere strukturiertes layout;
+ 
+. generiere strukturiertes layout :
+    INT VAR index;
+    FOR index FROM 1 UPTO layout laenge - LENGTH elan text - 1
+        REP elan text CAT post PER;
+
+ENDPROC layout ;
+ 
+ 
+PROC elan text cat blanks (INT CONST anzahl) :
+ 
+  par2 := anzahl * " ";
+  elan text CAT par2;
+ 
+END PROC elan text cat blanks;
+ 
+ 
+(***********************************************************************)
+ 
+PROC analysiere zeile : 
+ 
+loesche analysespeicher;
+behandle fuehrende blanks;
+pruefe ob anweisungszeile;
+pruefe ob markierung links;
+ 
+IF   tabellen modus
+     THEN analysiere tabellenzeile
+ELIF letzte zeile war absatzzeile 
+     THEN analysiere zeile nach absatzzeile 
+     ELSE analysiere zeile nach blockzeile
+FI; 
+ 
+pruefe center und right modus;
+pruefe ob tabulation vorliegt;
+werte indexspeicher aus;
+berechne zeilenhoehe;
+pruefe ob markierung rechts;
+ 
+.
+  analysiere zeile nach absatzzeile :
+    test auf aufzaehlung;
+    IF zeile muss geblockt werden 
+       THEN analysiere blockzeile nach absatzzeile 
+       ELSE analysiere absatzzeile nach absatzzeile 
+    FI; 
+.
+  analysiere zeile nach blockzeile :
+    IF zeile muss geblockt werden 
+       THEN analysiere blockzeile nach blockzeile 
+       ELSE analysiere absatzzeile nach blockzeile
+    FI; 
+ 
+ 
+.
+  behandle fuehrende blanks :
+    zeilenpos := 1;
+    zeilenpos := naechstes nicht blankes zeichen; 
+    IF zeilenpos = 0
+       THEN behandle leerzeile;
+            LEAVE analysiere zeile;
+       ELSE letzte zeile war absatzzeile := zeile ist absatzzeile; 
+            IF letzte zeile war absatzzeile THEN neue einrueckung FI;
+            initialisiere analyse;
+    FI;
+ 
+    . behandle leerzeile :
+        a ypos INCR (letzte zeilenhoehe + durchschuss);
+        zeile ist absatzzeile := LENGTH zeile > 0;
+        pruefe ob markierung links;
+        pruefe ob markierung rechts;
+ 
+    . neue einrueckung :
+        aktuelle einrueckbreite := einrueckbreite;
+ 
+    . initialisiere analyse :
+        zeile ist absatzzeile        := (zeile SUB LENGTH zeile) = blank;
+        zeile muss geblockt werden   := block modus AND NOT zeile ist absatzzeile;
+        erstes token der zeile       := token index f + 1;
+        groesste fonthoehe           := fonthoehe;
+        aktuelle zeilenhoehe         := letzte zeilenhoehe;
+        zeilen laenge                := laenge der zeile;
+        anzahl einrueck blanks       := zeilen pos - 1; 
+        anzahl zeichen               := anzahl einrueck blanks;
+        a xpos                       := left margin + anzahl zeichen * aktuelle einrueckbreite; 
+        a modifikationen fuer x move := 0;
+        letzter font                 := a font;
+        letzte modifikationen        := a modifikationen;
+        IF zeile muss geblockt werden THEN initialisiere tab variablen FI;
+
+        . laenge der zeile :
+            IF zeile ist absatzzeile
+               THEN LENGTH zeile - 1
+               ELSE LENGTH zeile 
+            FI
+.
+  pruefe ob anweisungszeile :
+    IF erstes zeichen ist anweisungszeichen
+       THEN REP analysiere anweisung;
+                IF zeile ist zu ende THEN LEAVE analysiere zeile FI;
+            UNTIL zeichen ist kein anweisungs zeichen PER;
+    FI;
+ 
+    . erstes zeichen ist anweisungszeichen :
+        pos (zeile, anweisungszeichen, 1, 1) <> 0
+ 
+    . zeichen ist kein anweisungszeichen :
+        pos (zeile, anweisungszeichen, zeilen pos, zeilen pos) = 0
+ 
+.
+  pruefe ob markierung links :
+    IF markierung links
+       THEN mark token (mark index l). xpos := 
+                             left margin - mark token (mark index l). breite;
+            lege markierungs token an (mark index l);
+            erstes token der zeile := token index f + 1;
+            initialisiere tab variablen;
+    FI;
+ 
+. 
+  analysiere tabellenzeile : 
+    anfangs blankmodus := doppel blank;
+    alte zeilenpos     := zeilen pos;
+    FOR tab index FROM 1 UPTO anzahl tabs
+    REP lege fuell token an wenn noetig;
+        initialisiere tab variablen; 
+        SELECT tab typ OF
+          CASE a lpos  :  linksbuendige spalte
+          CASE a rpos  :  rechtsbuendige spalte
+          CASE a cpos  :  zentrierte spalte
+          CASE a dpos  :  dezimale spalte
+          CASE a bpos  :  geblockte spalte
+        END SELECT;
+        berechne fuell token wenn noetig;
+        tabulation;
+    PER;
+    analysiere rest der zeile;
+ 
+    . lege fuell token an wenn noetig :
+        IF fill char <> blank
+           THEN fuellzeichen                 := fill char;
+                fuellzeichen breite          := string breite (fuellzeichen);
+                token zeiger                 := zeilen pos;
+                erstes fuell token           := token index f + 1;
+                lege text token an;
+                letztes fuell token          := token index f;
+                a modifikationen fuer x move := a modifikationen
+        FI;
+ 
+    . berechne fuell token wenn noetig :
+        IF erstes fuell token <> leer
+           THEN IF letztes fuell token <> token index f 
+                   THEN berechne fuell token;
+                   ELSE loesche letzte token;
+                FI;
+                erstes fuell token := leer
+        FI;
+ 
+        . berechne fuell token :
+            INT VAR anzahl fuellzeichen, fuell breite;
+            token index         := erstes fuell token;
+            anzahl fuellzeichen := (tab anfang - t. xpos + left margin) 
+                                                 DIV fuellzeichen breite;
+            rest                := (tab anfang - t. xpos + left margin) 
+                                                 MOD fuellzeichen breite;
+            IF anzahl fuell zeichen > 0
+               THEN fuell text   := anzahl fuellzeichen * fuellzeichen; 
+                    fuell breite := anzahl fuellzeichen * fuellzeichen breite; 
+                    FOR token index FROM erstes fuell token UPTO letztes fuell token
+                    REP t. text   := fuell text;
+                        t. breite := fuell breite;
+                        IF erstes fuell token <> erstes token der zeile
+                           THEN t. xpos INCR rest DIV 2;
+                                t. modifikationen fuer x move := t. modifikationen;
+                        FI;
+                    PER;
+            FI;
+ 
+            . fuell text : par1
+ 
+        . loesche letzte token :
+            FOR token index FROM letztes fuell token DOWNTO erstes fuell token
+            REP loesche letztes token PER;
+ 
+    . tabulation :
+        alte zeilenpos := zeilenpos;
+        zeilenpos := naechstes nicht blankes zeichen; 
+        IF zeilenpos = 0
+           THEN zeilenpos := zeilenlaenge + 1; 
+                LEAVE analysiere tabellenzeile;
+        FI;
+        anzahl zeichen INCR zeilenpos - alte zeilenpos; 
+ 
+    . linksbuendige spalte : 
+        a xpos     := left margin + tab position;
+        tab anfang := tab position;
+        bestimme token bis terminator oder zeilenende;
+ 
+    . rechtsbuendige spalte :
+        bestimme token bis terminator oder zeilenende;
+        schreibe zeile rechtsbuendig (tab position);
+ 
+    . zentrierte spalte :
+        bestimme token bis terminator oder zeilenende;
+        zentriere zeile (tab position);
+ 
+    . dezimale spalte :
+        d string                  := name (d strings, tab param);
+        d code 1                  := code (d string SUB 1) + 1;
+        d pitch                   := zeichenbreiten (d code 1);
+        zeichenbreiten (d code 1) := d code ausgang;
+        bestimme token bis terminator oder zeilenende;
+        zeichenbreiten (d code 1) := d pitch;
+        d code 1                  := leer;
+        schreibe zeile rechtsbuendig (tab position);
+        IF zeichen ist dezimal zeichen
+           THEN IF tab position <> zeilen breite
+                   THEN a xpos     := left margin + tab position;
+                        tab anfang := tab position;
+                FI;
+                bestimme token bis terminator oder zeilenende
+        FI;
+ 
+        . zeichen ist dezimal zeichen :
+            pos (zeile, d string,  zeilen pos) = zeilen pos
+ 
+    . geblockte spalte :
+        blankmodus := einfach blank;
+        a xpos     := left margin + tab position;
+        tab anfang := tab position;
+        REP bestimme token bis terminator oder zeilenende; 
+            IF zeile ist zu ende OR naechstes zeichen ist blank
+               THEN blocke spalte wenn noetig;
+                    LEAVE geblockte spalte;
+               ELSE dehnbares blank gefunden;
+            FI;
+        PER;
+ 
+        . blocke spalte wenn noetig :
+            IF letztes zeichen ist kein geschuetztes blank
+               THEN blocke zeile (tab param) FI;
+            blank modus := doppel blank;
+ 
+        . letztes zeichen ist kein geschuetztes blank :
+            pos (zeile, geschuetztes blank,  zeilen pos - 1, zeilen pos - 1) = 0
+              AND NOT within kanji (zeile, zeilen pos - 2)
+
+    . analysiere rest der zeile :
+        blankmodus := keine blankanalyse;
+        zeilen pos := alte zeilenpos;
+        bestimme token bis terminator oder zeilenende;
+ 
+.
+  test auf aufzaehlung : 
+    anfangs blankmodus := einfach blank;
+    bestimme token bis terminator oder zeilenende;
+    IF zeile ist zu ende
+       THEN LEAVE analysiere zeile nach absatzzeile
+       ELSE aufzaehlung moeglich
+    FI;
+ 
+    . aufzaehlung moeglich :
+        bestimme letztes zeichen;
+        IF    (anzahl zeichen bei aufzaehlung < 2  AND letztes zeichen = "-")
+           OR (anzahl zeichen bei aufzaehlung < 20 AND letztes zeichen = ":")
+           OR (anzahl zeichen bei aufzaehlung < 7
+                                        AND pos (".)", letztes zeichen) <> 0)
+           OR naechstes zeichen ist blank
+          THEN tabulator position gefunden;
+        ELIF zeile muss geblockt werden
+          THEN dehnbares blank gefunden;
+        FI;
+ 
+        . bestimme letztes zeichen : 
+            token index := token index f;
+            WHILE token index >= erstes token der zeile
+            REP IF token ist text token 
+                   THEN letztes zeichen := t. text SUB LENGTH t. text;
+                        LEAVE bestimme letztes zeichen;
+                FI;
+                token index DECR 1;
+            PER;
+            letztes zeichen := "";
+ 
+        . letztes zeichen : par1
+ 
+        . anzahl zeichen bei aufzaehlung :
+            anzahl zeichen - anzahl einrueck blanks
+ 
+        . token ist text token :
+            t. offset index >= text token
+.
+  analysiere blockzeile nach absatzzeile :
+    REP bestimme token bis terminator oder zeilenende; 
+        IF zeile ist zu ende 
+           THEN blocke zeile (limit);
+                LEAVE analysiere blockzeile nach absatzzeile
+           ELSE analysiere blank in blockzeile nach absatzzeile 
+        FI;
+    PER;
+ 
+    . analysiere blank in blockzeile nach absatzzeile : 
+        IF naechstes zeichen ist blank
+           THEN tabulator position gefunden;
+           ELSE dehnbares blank gefunden;
+        FI;
+ 
+.
+  analysiere absatzzeile nach absatzzeile :
+    blankmodus := doppel blank;
+    REP bestimme token bis terminator oder zeilenende;
+        IF zeile ist zu ende 
+           THEN LEAVE analysiere absatzzeile nach absatzzeile
+           ELSE tabulator position gefunden
+        FI;
+    PER;
+ 
+.
+  analysiere blockzeile nach blockzeile :
+    anfangs blankmodus := einfach blank;
+    REP bestimme token bis terminator oder zeilenende;
+        IF zeile ist zu ende 
+           THEN blocke zeile (limit);
+                LEAVE analysiere blockzeile nach blockzeile
+           ELSE dehnbares blank gefunden 
+        FI;
+    PER;
+ 
+.
+  analysiere absatzzeile nach blockzeile :
+    anfangs blankmodus := keine blankanalyse;
+    bestimme token bis terminator oder zeilenende;
+
+.
+  dehnbares blank gefunden :
+    anzahl zeichen INCR 1;
+    zeilenpos      INCR 1;
+    a xpos         INCR blankbreite;
+    a modifikationen fuer x move := a modifikationen;
+    IF NOT a block token
+       THEN anzahl blanks  INCR 1;
+            a block token := TRUE; 
+    FI;
+.
+  tabulator position gefunden :
+    alte zeilenpos := zeilenpos; 
+    zeilenpos := naechstes nicht blankes zeichen;
+    IF zeilenpos = 0 
+       THEN zeilenpos := zeilen laenge + 1;
+       ELSE IF erstes token der zeile > token index f
+               THEN token zeiger := zeilen pos;
+                    lege text token an;
+            FI;
+            anzahl zeichen INCR (zeilenpos - alte zeilenpos);
+            a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; 
+            a modifikationen fuer x move := a modifikationen;
+            IF zeile muss geblockt werden THEN initialisiere tab variablen FI;
+    FI;
+ 
+.
+  pruefe center und right modus : 
+    IF center modus THEN zentriere zeile (limit DIV 2) FI;
+    IF right  modus THEN schreibe zeile rechtsbuendig (limit) FI;
+.
+  pruefe ob tabulation vorliegt:
+    IF analyse speicher ist nicht leer CAND a xpos > tf. xpos + tf. breite
+       THEN a modifikationen fuer x move := a modifikationen; 
+            token zeiger := zeilen pos;
+            lege text token an;
+    FI;
+.
+  werte indexspeicher aus :
+    INT VAR index;
+    IF index zaehler > 0
+       THEN FOR index FROM index zaehler DOWNTO 1
+                REP a ypos DECR (verschiebungen ISUB index) PER;
+            stelle neuen font ein (grosse fonts ISUB 1);
+            loesche index speicher;
+    FI;
+.
+  berechne zeilenhoehe :
+    verschiebung := aktuelle zeilenhoehe + durchschuss;
+    a ypos INCR verschiebung;
+    verschiebe token ypos (verschiebung);
+ 
+.
+  pruefe ob markierung rechts :
+    IF markierung rechts
+       THEN mark token (mark index r). xpos := left margin + limit;
+            lege markierungs token an (mark index r);
+    FI;
+ 
+END PROC analysiere zeile;
+ 
+ 
+PROC blocke zeile (INT CONST rechter rand) :
+ 
+rest := rechter rand - zeilen breite;
+IF rest > 0 AND anzahl blanks > 0
+   THEN INT CONST schmaler schritt       := rest DIV anzahl blanks,
+                  breiter schritt        := schmaler schritt + 1,
+                  anzahl breite schritte := rest MOD anzahl blanks;
+        IF rechts
+           THEN blocke token xpos (breiter schritt, schmaler schritt,
+                                                     anzahl breite schritte);
+                rechts := FALSE; 
+           ELSE blocke token xpos (schmaler schritt, breiter schritt,
+                                     anzahl blanks - anzahl breite schritte);
+                rechts := TRUE;
+       FI;
+       a xpos INCR ( breiter schritt * anzahl breite schritte +
+              schmaler schritt * (anzahl blanks - anzahl breite schritte) );
+FI;
+ 
+END PROC blocke zeile;
+ 
+ 
+PROC zentriere zeile (INT CONST zentrier pos) :
+ 
+IF erstes tab token <= token index f
+   THEN verschiebung := zentrier pos - tab anfang -
+                                   (zeilen breite - tab anfang) DIV 2; 
+        verschiebe token xpos (verschiebung);
+        a xpos     INCR verschiebung; 
+        tab anfang INCR verschiebung; 
+FI;
+center modus := FALSE;
+ 
+END PROC zentriere zeile;
+
+
+PROC schreibe zeile rechtsbuendig (INT CONST rechte pos) :
+ 
+IF erstes tab token <= token index f
+   THEN verschiebung := rechte pos - zeilen breite;
+        verschiebe token xpos (verschiebung);
+        a xpos     INCR verschiebung;
+        tab anfang INCR verschiebung; 
+FI;
+right modus := FALSE;
+ 
+ 
+END PROC schreibe zeile rechtsbuendig;
+
+ 
+PROC bestimme token bis terminator oder zeilenende :
+ 
+token zeiger := zeilen pos;
+REP stranalyze (zeichenbreiten, a breite, max breite, 
+                zeile, zeilen pos, zeilen laenge,
+                ausgang);
+    zeilen pos INCR 1;
+    IF   ausgang = blank ausgang
+         THEN analysiere blank
+    ELIF ausgang = anweisungs ausgang
+         THEN anweisung gefunden
+    ELIF ausgang = d code ausgang
+         THEN analysiere d string
+    ELIF ausgang = erweiterungs ausgang
+         THEN erweiterung gefunden
+         ELSE terminator oder zeilenende gefunden
+    FI;
+PER;
+ 
+. analysiere blank :
+    IF blankmodus = einfach blank OR
+       (blankmodus = doppel blank AND naechstes zeichen ist blank)
+       THEN terminator oder zeilenende gefunden 
+       ELSE a breite INCR blankbreite;
+            zeilenpos INCR 1;
+    FI;
+ 
+. analysiere d string :
+    IF pos (zeile, d string, zeilen pos) = zeilen pos 
+       THEN terminator oder zeilenende gefunden 
+       ELSE IF   d pitch = maxint
+                 THEN erweiterung gefunden
+            ELIF d pitch < 0
+                 THEN a breite INCR (d pitch XOR - maxint - 1); 
+                      zeilen pos INCR 2; 
+                 ELSE a breite INCR d pitch; 
+                      zeilenpos INCR 1;
+            FI;
+    FI;
+ 
+. erweiterung gefunden :
+    a breite INCR extended char pitch (a font, zeile SUB zeilen pos, 
+                                               zeile SUB zeilen pos + 1); 
+    zeilen pos INCR 2;
+ 
+. anweisung gefunden :
+    gegebenfalls neues token gefunden;
+    analysiere anweisung;
+    IF zeile ist zu ende
+       THEN LEAVE bestimme token bis terminator oder zeilenende FI;
+    token zeiger := zeilenpos;
+ 
+. terminator oder zeilenende gefunden :
+    IF ausgang = null ausgang THEN  zeilen laenge DECR 1 FI;
+    gegebenfalls neues token gefunden;
+    LEAVE bestimme token bis terminator oder zeilenende;
+ 
+    . gegebenfalls neues token gefunden :
+        IF token zeiger < zeilenpos THEN lege text token an FI;
+ 
+END PROC bestimme token bis terminator oder zeilen ende;
+
+ 
+PROC analysiere anweisung :
+ 
+   bestimme anweisung;
+   IF anweisung ist kommando
+      THEN lege kommando token an;
+      ELSE werte anweisung aus; 
+   FI;
+ 
+    . anweisungsanfang : token zeiger
+ 
+    . anweisungsende   : zeilen pos - 2
+ 
+    . erstes zeichen   : par1
+ 
+. bestimme anweisung :
+    anweisungsanfang := zeilenpos + 1;
+    zeilen pos := pos (zeile, anweisungszeichen, anweisungsanfang, zeilenlaenge);
+    IF zeilenpos = 0
+       THEN zeilenpos := anweisungsanfang - 1;
+            replace (zeile, zeilenpos, geschuetztes anweisungszeichen);
+            LEAVE analysiere anweisung;
+    FI;
+    zeilen pos INCR 1; 
+    anweisung      := subtext (zeile, anweisungsanfang, anweisungsende);
+    erstes zeichen := anweisung SUB 1;
+ 
+. anweisung ist kommando : 
+    IF   erstes zeichen = quote
+         THEN scan (anweisung);
+              next symbol (anweisung, symbol type);
+              next symbol (par2, naechster symbol type);
+              IF symbol type <> text type OR naechster symbol type <> eof type
+                 THEN LEAVE analysiere anweisung FI;
+              TRUE
+    ELIF erstes zeichen = druckerkommando zeichen
+         THEN delete char (anweisung, 1);
+              TRUE
+         ELSE FALSE
+    FI
+ 
+. 
+  werte anweisung aus :
+    analyze command (anweisungs liste, anweisung, number type,
+                     anweisungs index, anzahl params, par1, par2);
+    SELECT anweisungs index OF
+      CASE a type           : type anweisung
+      CASE a on             : on anweisung
+      CASE a off            : off anweisung
+      CASE a ub, a fb       : ub fb anweisung
+      CASE a ue, a fe       : ue fe anweisung
+      CASE a center         : center anweisung
+      CASE a right          : right anweisung
+      CASE a up, a down     : index anweisung
+      CASE a end up or down : end index anweisung
+      CASE a bsp            : bsp anweisung
+      CASE a fillchar       : fillchar anweisung
+      CASE a mark           : mark anweisung
+      CASE a markend        : markend anweisung
+      OTHERWISE : IF anweisungs index > 0 THEN speichere anweisung FI;
+    END SELECT;
+ 
+    . type anweisung :
+        change all (par1, " ", "");
+        stelle neuen font ein (font (par1));
+        groesste fonthoehe := max (groesste fonthoehe, fonthoehe);
+        a modifikationen   := 0;
+        IF nicht innerhalb eines indexes THEN berechne aktuelle zeilenhoehe FI;
+ 
+        . nicht innerhalb eines indexes :
+            index zaehler = 0
+ 
+        . berechne aktuelle zeilenhoehe :
+            IF linefeed faktor >= 1.0
+              THEN aktuelle zeilenhoehe := max (groesste   fonthoehe,
+                                                       letzte zeilenhoehe);
+              ELSE aktuelle zeilenhoehe := max (aktuelle zeilenhoehe,
+                                                       letzte zeilenhoehe);
+           FI;
+ 
+    . on anweisung :
+        par1 := par1 SUB 1;
+        IF pos (modifikations liste, par1) > 0
+           THEN set bit (a modifikationen, pos (modifikations liste, par1) - 1 );
+        FI;
+ 
+    . off anweisung :
+        par1 := par1 SUB 1;
+        IF pos (modifikations liste, par1) > 0
+           THEN reset bit (a modifikationen, pos (modifikations liste, par1) - 1 );
+        FI;
+
+    . ub fb anweisung :
+        IF anweisungs index = a ub
+           THEN par1 := "u"
+           ELSE par1 := "b"
+        FI;
+        on anweisung;
+
+    . ue fe anweisung :
+        IF anweisungs index = a ue
+           THEN par1 := "u"
+           ELSE par1 := "b"
+        FI;
+        off anweisung;
+
+    . center anweisung :
+        IF NOT zeile muss geblockt werden AND NOT tabellen modus
+               AND NOT right modus
+           THEN center modus := TRUE;
+                blankmodus   := keine blankanalyse;
+                initialisiere tab variablen; 
+        FI;
+ 
+    . right anweisung :
+        IF NOT zeile muss geblockt werden AND NOT tabellen modus
+           THEN IF center modus THEN zentriere zeile (limit DIV 2) FI;
+                right modus := TRUE;
+                blankmodus  := keine blankanalyse;
+                initialisiere tab variablen; 
+        FI;
+ 
+    . index anweisung :
+        INT CONST grosser font := a font, grosse fonthoehe := fonthoehe; 
+        INT VAR   kleiner font;
+        IF next smaller font exists (grosser font, kleiner font)
+           THEN stelle neuen font ein (kleiner font) FI;
+        IF font hoehe < grosse fonthoehe
+           THEN berechne verschiebung fuer kleinen font
+           ELSE berechne verschiebung fuer grossen font
+        FI;
+        a ypos INCR verschiebung;
+        merke grossen font und verschiebung;
+ 
+        . berechne verschiebung fuer kleinen font :
+            IF anweisungs index = a down
+               THEN verschiebung :=     15 PROZENT grosse fonthoehe;
+               ELSE verschiebung :=  - ( 9 PROZENT grosse fonthoehe )
+                                     - (grosse fonthoehe - fonthoehe);
+            FI;
+ 
+        . berechne verschiebung fuer grossen font :
+            IF anweisungs index = a down
+               THEN verschiebung :=    25 PROZENT fonthoehe;
+               ELSE verschiebung := - (50 PROZENT fonthoehe);
+            FI;
+ 
+        . merke grossen font und verschiebung :
+            index zaehler INCR 1;
+            grosse fonts   CAT grosser font;
+            verschiebungen CAT verschiebung;
+            IF index zaehler = 1
+               THEN alter blankmodus := blankmodus; 
+                          blankmodus := keine blankanalyse;
+            FI;
+ 
+    . end index anweisung :
+        IF index zaehler > 0
+           THEN schalte auf groesseren font zurueck;
+        FI;
+ 
+        . schalte auf groesseren font zurueck :
+            a ypos DECR (verschiebungen ISUB index zaehler);
+            stelle neuen font ein (grosse fonts ISUB index zaehler);
+            IF index zaehler = 1
+               THEN blankmodus := alter blankmodus;
+            FI;
+            index zaehler DECR 1;
+            verschiebungen := subtext (verschiebungen, 1, 2 * index zaehler);
+            grosse fonts   := subtext (grosse fonts,   1, 2 * index zaehler);
+ 
+    . bsp anweisung :
+        INT VAR breite davor, breite dahinter;
+        IF anweisungs anfang - 2 >= 1 AND anweisungs ende + 2 <= zeilen laenge
+           THEN IF is kanji esc (zeile SUB anweisungs anfang - 3)
+                   THEN zeichen davor := subtext (zeile, anweisungs anfang - 3,
+                                                         anweisungs anfang - 2);
+                   ELSE zeichen davor := zeile SUB anweisungs anfang - 2;
+                FI;
+                IF is kanji esc (zeile SUB anweisungs ende + 2)
+                   THEN zeichen dahinter := subtext (zeile, anweisungs ende + 2,
+                                                            anweisungs ende + 3 );
+                   ELSE zeichen dahinter := zeile SUB anweisungs ende + 2;
+                FI;
+                IF pos (" #", zeichen davor) = 0 AND pos (" #", zeichen dahinter) = 0 
+                   THEN breite davor    := char pitch (a font, zeichen davor);
+                        breite dahinter := char pitch (a font, zeichen dahinter);
+                        IF breite davor < breite dahinter THEN vertausche zeichen FI;
+                        lege token fuer zeichen dahinter an;
+                        a xpos INCR (breite davor - breite dahinter) DIV 2; 
+                FI;
+        FI;
+ 
+        . zeichen davor    : par1
+        . zeichen dahinter : par2
+ 
+        . vertausche zeichen :
+            change (zeile, anweisungs anfang - 2 - LENGTH zeichen davor + 1, 
+                           anweisungs anfang - 2, zeichen dahinter);
+            change (zeile, anweisungs ende + 2,
+                           anweisungs ende + 2 + LENGTH zeichen dahinter - 1, zeichen davor);
+            change (tf. text, LENGTH tf. text - LENGTH zeichen davor + 1,
+                              LENGTH tf. text, zeichen dahinter);
+            tf. breite INCR (breite dahinter - breite davor);
+            a xpos     INCR (breite dahinter - breite davor);
+            int param        := breite davor;
+            breite davor     := breite dahinter;
+            breite dahinter  := int param;
+ 
+        . lege token fuer zeichen dahinter an :
+            token zeiger := zeilen pos;
+            a breite     := breite dahinter;
+            zeilen pos INCR LENGTH zeichen dahinter;
+            a xpos     DECR (breite davor + breite dahinter) DIV 2; 
+            lege text token an;
+            anzahl zeichen DECR 1;
+ 
+    . fillchar anweisung :
+        IF par1 = "" THEN par1 := " " FI;
+        fill char := par1;
+        speichere anweisung;
+ 
+    . mark anweisung :
+        IF par1 <> "" 
+           THEN mark index l := (alter mark index l MOD 2) + 1;
+                neue markierung (par1, mark index l);
+           ELSE mark index l := 0;
+        FI;
+        IF par2 <> "" 
+           THEN mark index r := (alter mark index r MOD 2) + 3;
+                neue markierung (par2, mark index r);
+           ELSE mark index r := 0;
+        FI;
+ 
+    . markend anweisung :
+        loesche markierung;
+ 
+    . speichere anweisung :
+        anweisungs zaehler INCR 1;
+        anweisungs indizes CAT anweisungs index;
+        IF par1 <> ""
+           THEN insert (params1, par1); 
+                params1 zeiger CAT highest entry (params1);
+           ELSE params1 zeiger CAT 0;
+        FI;
+        IF par2 <> ""
+           THEN insert (params2, par2); 
+                params2 zeiger CAT highest entry (params2);
+           ELSE params2 zeiger CAT 0;
+        FI;
+ 
+END PROC analysiere anweisung;
+ 
+ 
+PROC stelle neuen font ein (INT CONST font nr ) :
+
+  IF font nr <> a font THEN neuer font FI;
+ 
+  . neuer font :
+      a font := max (1, font nr);
+      get font (a font, einrueckbreite, font durchschuss, font hoehe, font tiefe,
+                zeichenbreiten);
+      font hoehe INCR (font durchschuss + font tiefe);
+      letzte zeilenhoehe                         := neue zeilenhoehe;
+      blankbreite                                := zeichenbreiten (blank code 1);
+      zeichenbreiten (blank code 1)              := blank ausgang;
+      zeichenbreiten (anweisungs zeichen code 1) := anweisungs ausgang;
+      font offsets                               := y offsets (a font);
+      offsets                                    := LENGTH font offsets > 2;
+      IF d code 1 <> leer
+         THEN d pitch                            := zeichenbreiten (d code 1);
+              zeichenbreiten (d code 1)          := d code ausgang;
+     FI;
+ 
+END PROC stelle neuen font ein;
+ 
+ 
+INT OP PROZENT (INT CONST prozent, wert) :
+ 
+    (wert * prozent + 99) DIV 100
+ 
+END OP PROZENT; 
+ 
+ 
+PROC neue markierung (TEXT CONST text, INT CONST mark index) :
+ 
+      mark token (mark index). text           := text;
+      mark token (mark index). breite         := string breite (text);
+      mark token (mark index). font           := a font;
+      mark token (mark index). modifikationen := a modifikationen;
+ 
+END PROC neue markierung;
+ 
+ 
+INT PROC string breite (TEXT CONST string) :
+ 
+    INT VAR summe := 0, pos := 1;
+    REP stranalyze (zeichenbreiten, summe, max breite, string, pos, maxint, ausgang);
+        IF   ausgang = erweiterungs ausgang
+             THEN summe INCR extended char pitch (a font,
+                                       string SUB pos+1, string SUB pos+2);
+                  pos INCR 3;
+        ELIF ausgang = blank ausgang
+             THEN summe INCR blankbreite;
+                  pos INCR 2;
+        ELIF ausgang = anweisungs ausgang
+             THEN summe INCR char pitch (a font, anweisungszeichen);
+                  pos INCR 2;
+             ELSE LEAVE string breite WITH summe
+        FI;
+    PER;
+    0
+ 
+END PROC string breite;
+ 
+(*******************************************************************)
+ 
+PROC lege text token an :
+ 
+  aktuelle ypos := a ypos + (font offsets ISUB 1); 
+  neuer token index;
+  uebertrage text token (tf);
+  IF offsets THEN lege offsets an (font offsets) FI;
+  stranalyze (zeichen zaehler, anzahl zeichen, max int,
+              zeile, token zeiger, zeilen pos - 1, ausgang);
+  a xpos                       INCR a breite;
+  a breite                     := 0;
+  a modifikationen fuer x move := 0;
+  a block token                := FALSE;
+ 
+END PROC lege text token an;
+ 
+ 
+PROC uebertrage text token (TOKEN VAR tf) :
+ 
+  tf. text                       := subtext (zeile, token zeiger, zeilenpos - 1);
+  tf. xpos                       := a xpos;
+  tf. breite                     := a breite;
+  tf. font                       := a font;
+  tf. modifikationen             := a modifikationen;
+  tf. modifikationen fuer x move := a modifikationen fuer x move;
+  tf. offset index               := text token;
+  tf. block token                := a block token;
+
+END PROC uebertrage text token;
+ 
+ 
+PROC lege kommando token an :
+ 
+  aktuelle ypos := a ypos + (font offsets ISUB 1); 
+  neuer token index;
+  uebertrage kommando token (tf);
+  a modifikationen fuer x move := 0;
+  a block token                := FALSE;
+ 
+END PROC lege kommando token an;
+ 
+ 
+PROC uebertrage kommando token (TOKEN VAR tf) :
+ 
+  tf. text                       := anweisung;
+  tf. breite                     := 0;
+  tf. xpos                       := a xpos;
+  tf. font                       := a font;
+  tf. modifikationen             := a modifikationen;
+  tf. modifikationen fuer x move := a modifikationen fuer x move;
+  tf. offset index               := kommando token;
+  tf. block token                := a block token;
+ 
+END PROC uebertrage kommando token;
+ 
+ 
+PROC lege markierungs token an (INT CONST mark index) :
+ 
+  aktuelle ypos := a ypos + (mark font offsets ISUB 1); 
+  neuer token index;
+  tf := mark token (mark index);
+  IF mark offsets THEN lege offsets an (mark font offsets) FI;
+ 
+  . mark font offsets   : y offsets (mark token (mark index). font)
+ 
+  . mark offsets        : LENGTH mark font offsets > 2
+ 
+END PROC lege markierungs token an;
+ 
+ 
+PROC lege offsets an (TEXT CONST offsets) :
+ 
+  INT CONST anzahl offsets := LENGTH offsets DIV 2;
+  offset token := tf;
+  offset token. block token := FALSE;
+  reset bit (offset token. modifikationen, underline bit);
+  FOR index FROM 2 UPTO anzahl offsets
+  REP aktuelle ypos := a ypos + (offsets ISUB index); 
+      neuer token index;
+      tf               := offset token;
+      tf. offset index := index;
+  PER;
+ 
+END PROC lege offsets an;
+ 
+ 
+PROC neuer token index :
+ 
+IF   erster ypos index a = 0
+     THEN erste ypos
+ELIF ya. ypos = aktuelle ypos 
+     THEN neues token bei gleicher ypos
+     ELSE fuege neue ypos ein
+FI;
+ 
+  . erste ypos :
+      ypos  index f INCR 1;
+          erster     ypos index a := ypos index f;
+          letzter    ypos index a := ypos index f;
+      yf. vorheriger ypos index   := 0;
+      yf. naechster  ypos index   := 0;
+      erstes token bei neuer ypos;
+ 
+  . fuege neue ypos ein :
+      letztes token bei gleicher ypos;
+      IF ya. ypos > aktuelle ypos
+         THEN richtige ypos ist oberhalb
+         ELSE richtige ypos ist unterhalb
+      FI;
+ 
+      . richtige ypos ist oberhalb :
+          REP ypos index a := ya. vorheriger ypos index;
+              IF   ypos index a = 0
+                   THEN fuege ypos vor erstem ypos index ein;
+                        LEAVE richtige ypos ist oberhalb;
+              ELIF ya. ypos = aktuelle ypos
+                   THEN neues token bei neuer ypos;
+                        LEAVE richtige ypos ist oberhalb;
+              ELIF ya. ypos < aktuelle ypos
+                   THEN fuege ypos nach ypos index ein;
+                        LEAVE richtige ypos ist oberhalb;
+              FI;
+          PER;
+ 
+      . richtige ypos ist unterhalb :
+          REP ypos index a := ya. naechster ypos index;
+              IF   ypos index a = 0
+                   THEN fuege ypos nach letztem ypos index ein;
+                        LEAVE richtige ypos ist unterhalb;
+              ELIF ya. ypos = aktuelle ypos
+                   THEN neues token bei neuer ypos;
+                        LEAVE richtige ypos ist unterhalb;
+              ELIF ya. ypos > aktuelle ypos 
+                   THEN fuege ypos vor ypos index ein;
+                        LEAVE richtige ypos ist unterhalb;
+              FI;
+          PER;
+ 
+          . fuege ypos vor erstem ypos index ein :
+              ypos  index f INCR 1;
+              yf. vorheriger ypos index   := 0;
+              yf. naechster  ypos index   :=     erster    ypos index a;
+                  erster     ypos index a :=               ypos index f;
+                             ypos index a := yf. naechster ypos index;
+              ya. vorheriger ypos index   :=               ypos index f;
+              erstes token bei neuer ypos;
+ 
+          . fuege ypos nach ypos index ein :
+              ypos  index f INCR 1;
+              yf. vorheriger ypos index   :=               ypos index a;
+              yf. naechster  ypos index   := ya. naechster ypos index;
+              ya. naechster  ypos index   :=               ypos index f;
+                             ypos index a := yf. naechster ypos index;
+              ya. vorheriger ypos index   :=               ypos index f;
+              erstes token bei neuer ypos;
+ 
+          . fuege ypos vor ypos index ein :
+              ypos  index f INCR 1;
+              yf. naechster  ypos index   :=                ypos index a;
+              yf. vorheriger ypos index   := ya. vorheriger ypos index;
+              ya. vorheriger ypos index   :=                ypos index f;
+                             ypos index a := yf. vorheriger ypos index;
+              ya. naechster  ypos index   :=                ypos index f;
+              erstes token bei neuer ypos;
+ 
+          . fuege ypos nach letztem ypos index ein :
+              ypos  index f INCR 1;
+              yf. naechster  ypos index   := 0;
+              yf. vorheriger ypos index   :=     letzter    ypos index a;
+                  letzter    ypos index a :=                ypos index f;
+                             ypos index a := yf. vorheriger ypos index;
+              ya. naechster  ypos index   :=                ypos index f;
+              erstes token bei neuer ypos;
+ 
+END PROC neuer token index;
+ 
+
+PROC erstes token bei neuer ypos :
+     token index f INCR 1;
+                 ypos index a := ypos index f;
+     ya. erster token index   := token index f; 
+     ya. ypos                 := aktuelle ypos;
+END PROC erstes token bei neuer ypos;
+ 
+ 
+PROC neues token bei neuer ypos :
+     token index f INCR 1;
+     ya. ypos                 := aktuelle ypos;
+                  token index := ya. letzter token index;
+     t. naechster token index := token index f;
+END PROC neues token bei neuer ypos;
+ 
+ 
+PROC neues token bei gleicher ypos :
+     tf. naechster token index := token index f + 1;
+     token index f INCR 1;
+END PROC neues token bei gleicher ypos;
+ 
+ 
+PROC letztes token bei gleicher ypos : 
+     tf. naechster token index := 0;
+     ya. letzter   token index := token index f;
+END PROC letztes token bei gleicher ypos;
+ 
+ 
+PROC loesche letztes token :
+ 
+     IF token index f = ya. erster token index 
+        THEN loesche ypos
+        ELSE token index f DECR 1;
+     FI;
+ 
+     . loesche ypos :
+         kette vorgaenger um;
+         kette nachfolger um;
+         bestimme letzten ypos index;
+ 
+         . kette vorgaenger um :
+             ypos index := ya. vorheriger ypos index; 
+             IF ypos index = 0
+                THEN       erster ypos index a := ya. naechster ypos index;
+                ELSE y. naechster ypos index   := ya. naechster ypos index; 
+             FI;
+ 
+         . kette nachfolger um :
+             ypos index := ya. naechster ypos index;
+             IF ypos index = 0
+                THEN       letzter ypos index a := ya. vorheriger ypos index;
+                ELSE y. vorheriger ypos index   := ya. vorheriger ypos index; 
+             FI;
+ 
+         . bestimme letzten ypos index :
+             IF ypos index a = ypos index f THEN ypos index f DECR 1 FI;
+             token index f DECR 1;
+             ypos index a := letzter ypos index a; 
+             WHILE ypos index a <> 0
+                       CAND ya. letzter token index <> token index f
+             REP ypos index a := ya. vorheriger ypos index PER;
+ 
+END PROC loesche letztes token;
+ 
+ 
+PROC blocke token xpos (INT CONST dehnung 1, dehnung 2,
+                                  anzahl dehnungen fuer dehnung 1 ) :
+
+  INT VAR dehnung := 0, anzahl dehnungen := 0;
+  token index := erstes tab token;
+  WHILE token index <= token index f
+  REP erhoehe token xpos bei block token;
+      t. xpos INCR dehnung;
+      token index INCR 1; 
+  PER;
+ 
+  . erhoehe token xpos bei block token :
+      IF t. block token
+         THEN IF anzahl dehnungen < anzahl dehnungen fuer dehnung 1
+                 THEN anzahl dehnungen INCR 1;
+                      dehnung INCR dehnung 1;
+                 ELSE dehnung INCR dehnung 2;
+              FI;
+      FI;
+ 
+END PROC blocke token xpos;
+ 
+ 
+PROC verschiebe token xpos (INT CONST verschiebung) :
+ 
+  token index := erstes tab token;
+  WHILE token index <= token index f
+  REP t. xpos INCR verschiebung;
+      token index INCR 1; 
+  PER;
+ 
+END PROC verschiebe token xpos;
+ 
+ 
+PROC verschiebe token ypos (INT CONST verschiebung) :
+ 
+  ypos index := erster ypos index a;
+  WHILE ypos index <> 0
+  REP y. ypos INCR verschiebung; 
+      ypos index := y. naechster ypos index;
+  PER;
+ 
+END PROC verschiebe token ypos;
+ 
+ 
+PROC sortiere neue token ein :
+ 
+IF analysespeicher ist nicht leer
+   THEN IF druckspeicher ist nicht leer
+           THEN sortiere neue token in sortierte liste ein
+           ELSE sortierte liste ist leer
+        FI;
+FI;
+
+. sortierte liste ist leer :
+    IF erster ypos index a <> 0
+       THEN erster  ypos index d := erster  ypos index a;
+            letzter ypos index d := letzter ypos index a;
+                    ypos index d := letzter ypos index a;
+    FI;
+ 
+. sortiere neue token in sortierte liste ein :
+    gehe zum ersten neuen token;
+    bestimme erste einsortierposition;
+    WHILE es gibt noch neue token
+    REP IF   ypos index d = 0
+             THEN haenge neue token ans ende der sortierten liste 
+        ELIF ya. ypos > yd. ypos
+             THEN naechste ypos der sortierten liste
+        ELIF ya. ypos = yd. ypos
+             THEN neues token auf gleicher ypos
+             ELSE neue token vor ypos
+        FI; 
+    PER;
+ 
+    . gehe zum ersten neuen token :
+        ypos index a := erster ypos index a;
+ 
+    . bestimme erste einsortierposition :
+        WHILE ypos index d <> 0  CAND  ya. ypos < yd. ypos
+          REP ypos index d := yd. vorheriger ypos index PER;
+        IF ypos index d = 0 THEN erste neue token vor listen anfang FI;
+ 
+        . erste neue token vor listen anfang :
+                   ypos index d := erster ypos index d;
+            erster ypos index d := erster ypos index a;
+            REP ypos index a := ya. naechster ypos index;
+                IF   ypos index a = 0
+                     THEN verkette letztes ya mit yd;
+                          LEAVE sortiere neue token in sortierte liste ein
+                ELIF ya. ypos = yd. ypos
+                     THEN verkette ya mit yd;
+                          LEAVE erste neue token vor listen anfang
+                ELIF ya. ypos > yd. ypos
+                     THEN verkette vorheriges ya mit yd;
+                          ypos index d := yd. naechster ypos index;
+                          LEAVE erste neue token vor listen anfang
+                FI;
+            PER;
+ 
+    . es gibt noch neue token :
+        ypos index a <> 0
+ 
+    . haenge neue token ans ende der sortierten liste : 
+                       ypos index d := letzter ypos index d;
+        yd. naechster  ypos index   :=         ypos index a;
+        ya. vorheriger ypos index   :=         ypos index d;
+            letzter    ypos index d := letzter ypos index a;
+                       ypos index d := letzter ypos index a;
+                       ypos index a := 0;
+ 
+    . naechste ypos der sortierten liste :
+        ypos index d := yd. naechster ypos index;
+ 
+    . neues token auf gleicher ypos :
+                      token index   := yd. letzter   token index;
+        t . naechster token index   := ya. erster    token index;
+        yd. letzter   token index   := ya. letzter   token index;
+                      ypos  index a := ya. naechster ypos  index;
+                      ypos  index d := yd. naechster ypos  index;
+        IF ypos index d = 0 THEN ypos index d := letzter ypos index d FI;
+ 
+    . neue token vor ypos :
+        verkette ya mit vorherigem yd;
+        REP ypos index a := ya. naechster ypos index;
+            IF   ypos index a = 0
+                 THEN verkette letztes ya mit yd;
+                      LEAVE sortiere neue token in sortierte liste ein
+            ELIF ya. ypos = yd. ypos
+                 THEN verkette ya mit yd;
+                      LEAVE neue token vor ypos
+            ELIF ya. ypos > yd. ypos 
+                 THEN verkette vorheriges ya mit yd;
+                      ypos index d := yd. naechster ypos index;
+                      LEAVE neue token vor ypos
+            FI;
+        PER;
+
+ 
+. verkette ya mit vorherigem yd :
+                        index   := ypos index d;
+                   ypos index d := yd. vorheriger ypos index; 
+    yd. naechster  ypos index   :=                ypos index a;
+    ya. vorheriger ypos index   :=                ypos index d;
+                   ypos index d := index;
+ 
+. verkette letztes ya mit yd :
+                   ypos index a := letzter ypos index a;
+    yd. vorheriger ypos index   :=         ypos index a;
+    ya. naechster  ypos index   :=         ypos index d;
+                   ypos index a := 0;
+ 
+. verkette vorheriges ya mit yd :
+                        index   := ypos index a;
+                   ypos index a := ya. vorheriger ypos index; 
+    yd. vorheriger ypos index   :=         ypos index a;
+    ya. naechster  ypos index   :=         ypos index d;
+                   ypos index a := index;
+ 
+. verkette ya mit yd :
+    verkette vorheriges ya mit yd;
+    neues token auf gleicher ypos;
+ 
+END PROC sortiere neue token ein;
+ 
+(***************************************************************)
+ 
+PROC drucke tokenspeicher
+             (INT CONST max ypos,
+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+IF druckspeicher ist nicht leer
+   THEN gehe zur ersten ypos; 
+        WHILE yd. ypos <= max ypos 
+        REP drucke token bei ypos;
+            gehe zur naechsten ypos; 
+        PER;
+        loesche gedruckte token;
+FI;
+ 
+. gehe zur ersten ypos :
+    ypos index d := erster ypos index d;
+
+. drucke token bei ypos :
+    IF yd. ypos >= - y start
+       THEN druck durchgang;
+            IF bold      pass THEN fett         durchgang FI;
+            IF underline pass THEN unterstreich durchgang FI;
+    FI;
+ 
+    . bold      pass : bit (pass, bold bit)
+ 
+    . underline pass : bit (pass, underline bit)
+ 
+. gehe zur naechsten ypos : 
+    IF ypos index d = letzter ypos index d
+       THEN loesche druckspeicher;
+            LEAVE drucke tokenspeicher;
+    FI;
+    ypos index d := yd. naechster ypos index;
+ 
+. loesche gedruckte token :
+        erster     ypos index d := ypos index d;
+    yd. vorheriger ypos index   := 0;
+ 
+. 
+  druck durchgang :
+    verschiebung := yd. ypos - d ypos;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    gehe zum ersten token dieser ypos; 
+    REP drucke token UNTIL kein token mehr vorhanden PER;
+    gib cr aus;
+ 
+    . drucke token :
+        IF NOT token passt in zeile THEN berechne token teil FI;
+        font wechsel wenn noetig;
+        x move mit modifikations ueberpruefung; 
+        IF token ist text token
+           THEN gib text token aus
+                  (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+           ELSE gib kommando token aus
+        FI;
+ 
+    . gib kommando token aus :
+        execute (write cmd, d token. text, 1, LENGTH d token. text)
+ 
+        . berechne token teil :
+            INT CONST fuenf punkte := 5 * char pitch (d token. font, punkt);
+            INT VAR token pos, token breite, anzahl punkte, zeichen laenge, zeichen breite; 
+            IF   d token. xpos < - x start
+                   AND d token. xpos + d token. breite > - x start 
+                 THEN berechne token teil von links
+            ELIF d token. xpos < papierbreite
+                   AND d token. xpos + d token. breite > papierbreite
+                 THEN berechne token teil nach rechts
+                 ELSE LEAVE drucke token
+            FI;
+ 
+        . berechne token teil von links :
+            rest          := min (x size, d token. xpos + d token. breite + x start);
+            d token. xpos := - x start;
+            IF rest <= fuenf punkte 
+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);
+                    d token. text   := anzahl punkte * punkt;
+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);
+               ELSE token pos    := LENGTH d token. text + 1;
+                    token breite := fuenf punkte;
+                    berechne token teil breite von hinten;
+                    change (d token. text, 1, token pos - 1, 5 * punkt);
+                    d token. breite := token breite;
+            FI;
+ 
+            . berechne token teil breite von hinten :
+                WHILE naechstes zeichen passt noch davor
+                REP token breite INCR zeichen breite; 
+                    token pos    DECR zeichen laenge;
+                PER;
+ 
+            . naechstes zeichen passt noch davor :
+                IF within kanji (d token. text, token pos - 1) 
+                   THEN zeichen laenge := 2
+                   ELSE zeichen laenge := 1
+                FI;
+                zeichen breite := char pitch (d token. font,
+                    subtext (d token. text, token pos - zeichen laenge, token pos - 1));
+                token breite + zeichen breite < rest
+ 
+        . berechne token teil nach rechts :
+            rest := papier breite - d token. xpos;
+            IF rest <= fuenf punkte 
+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);
+                    d token. text   := anzahl punkte * punkt;
+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);
+               ELSE token pos    := 0;
+                    token breite := fuenf punkte;
+                    berechne token teil breite von vorne;
+                    change (d token. text, token pos + 1, LENGTH d token. text, 5 * punkt);
+                    d token. breite := token breite;
+            FI;
+ 
+            . berechne token teil breite von vorne :
+                WHILE naechstes zeichen passt noch dahinter
+                REP token breite INCR zeichen breite; 
+                    token pos    INCR zeichen laenge;
+                PER;
+ 
+            . naechstes zeichen passt noch dahinter :
+                IF is kanji esc (d token. text SUB token pos + 1) 
+                   THEN zeichen laenge := 2
+                   ELSE zeichen laenge := 1
+                FI;
+                zeichen breite := char pitch (d token. font,
+                    subtext (d token. text, token pos + 1, token pos + zeichen laenge));
+                token breite + zeichen breite < rest
+ 
+.
+  fett durchgang :
+    reset bit (pass, bold bit);
+    gehe zum ersten token dieser ypos;
+    REP gib token nochmal aus UNTIL kein token mehr vorhanden PER;
+    schalte modifikationen aus wenn noetig;
+    gib cr aus;
+ 
+    . gib token nochmal aus :
+        INT CONST min verschiebung := bold offset (d token. font); 
+        d token. xpos INCR min verschiebung;
+        IF bit (d token. modifikationen, bold bit) AND
+               token passt in zeile AND token ist text token 
+          THEN verschiebung := d token. xpos - d xpos;
+               font wechsel wenn noetig;
+               schalte italics ein wenn noetig;
+               x move wenn noetig;
+               gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+        FI;
+        d token. xpos DECR min verschiebung;
+ 
+        . schalte italics ein wenn noetig :
+            IF bit (d token. modifikationen, italics bit)
+               THEN neue modifikationen := modifikations werte (italics bit + 1);
+                    schalte modifikationen ein wenn noetig;
+               ELSE schalte modifikationen aus wenn noetig;
+            FI;
+ 
+. 
+  unterstreich durchgang :
+    INT VAR l xpos := 0;
+    reset bit (pass, underline bit);
+    schalte modifikationen aus wenn noetig;
+    gehe zum ersten token dieser ypos;
+    REP unterstreiche token UNTIL kein token mehr vorhanden PER;
+    gib cr aus;
+ 
+    . unterstreiche token :
+        IF token muss unterstrichen werden AND
+                token passt in zeile AND token ist text token 
+           THEN font wechsel wenn noetig;
+                berechne x move laenge; 
+                x move wenn noetig;
+                berechne unterstreich laenge;
+                unterstreiche;
+         FI;
+         l xpos := d token. xpos + d token. breite;
+ 
+         . token muss unterstrichen werden :
+             bit (d token. modifikationen, underline bit) OR
+                bit (d token. modifikationen fuer x move, underline bit)
+ 
+         . berechne x move laenge :
+             IF bit (d token. modifikationen fuer x move, underline bit) 
+                THEN verschiebung := l  xpos - d xpos
+                ELSE verschiebung := d token. xpos - d xpos
+             FI;
+
+         . berechne unterstreich laenge :
+             INT VAR unterstreich verschiebung;
+             IF bit (d token. modifikationen, underline bit) 
+                THEN unterstreich verschiebung := d token. xpos + 
+                                                d token. breite - d xpos
+                ELSE unterstreich verschiebung := d token. xpos - d xpos
+             FI;
+ 
+ 
+. gehe zum ersten token dieser ypos :
+    token index := yd. erster token index;
+    d token := t;
+ 
+. kein token mehr vorhanden :
+    token index := d token. naechster token  index;
+    IF token index = 0
+       THEN TRUE
+       ELSE d token := t;
+            FALSE
+    FI
+ 
+. token ist text token :
+    d token. offset index >= text token
+ 
+. token passt in zeile :
+    d token. xpos >= - x start AND
+         d token. xpos + d token. breite <= papier breite 
+ 
+. font wechsel wenn noetig :
+    IF d token. font <>  d font
+       THEN font wechsel (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;
+ 
+. schalte modifikationen ein wenn noetig :
+    IF d modifikationen <> neue modifikationen
+       THEN schalte modifikationen ein (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;
+ 
+. schalte modifikationen aus wenn noetig :
+    IF d modifikationen <> 0
+       THEN schalte modifikationen aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;
+
+. x move wenn noetig :
+    IF verschiebung <> 0
+       THEN x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; 
+ 
+. gib cr aus :
+    execute (carriage return, "", d xpos, 0);
+    d xpos := 0;
+ 
+. 
+  x move mit modifikations ueberpruefung :
+    verschiebung := d token. xpos - d xpos;
+    IF verschiebung <> 0
+       THEN neue modifikationen := d token. modifikationen fuer x move;
+            schalte modifikationen ein wenn noetig;
+            x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    FI;
+    neue modifikationen := d token. modifikationen;
+    schalte modifikationen ein wenn noetig;
+ 
+. 
+  unterstreiche :
+    IF unterstreich verschiebung > 0
+       THEN disable stop; 
+            d xpos INCR unterstreich verschiebung;
+            execute (draw, "", unterstreich verschiebung, 0);
+            IF is error
+               THEN unterstreiche nach cr;
+            FI;
+            enable stop;
+    FI;
+ 
+    . unterstreiche nach cr :
+        clear error;
+        d xpos DECR unterstreich verschiebung;
+        verschiebung := d xpos;
+        gib cr aus;
+        x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+        d xpos INCR unterstreich verschiebung;
+        execute (draw, "", unterstreich verschiebung, 0);
+        IF is error
+           THEN clear error; 
+                d xpos DECR unterstreich verschiebung;
+                gib cr aus;
+                LEAVE unterstreich durchgang;
+        FI;
+
+END PROC drucke tokenspeicher;
+ 
+PROC y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+    IF verschiebung <> 0
+       THEN disable stop; 
+            d ypos INCR verschiebung;
+            execute (move, "", 0, verschiebung);
+            IF is error
+               THEN clear error;
+                    d ypos DECR verschiebung;
+                    verschiebung := 0;
+            FI;
+            enable stop;
+    FI;
+ 
+END PROC y move;
+ 
+
+PROC x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+    disable stop;
+    d xpos INCR verschiebung; 
+    execute (move, "", verschiebung, 0);
+    IF is error
+       THEN fuehre x move nach cr aus
+    FI;
+ 
+    . fuehre x move nach cr aus :
+        clear error;
+        schalte modifikationen aus wenn noetig;
+        gib cr aus;
+        IF d xpos <> 0
+           THEN execute (move, "", d xpos, 0);
+                IF is error
+                   THEN clear error;
+                        d xpos := 0;
+                FI
+        FI;
+        schalte modifikationen ein wenn noetig;
+ 
+        . gib cr aus :
+            execute (carriage return,  "", d xpos - verschiebung, 0);
+ 
+        . schalte modifikationen aus wenn noetig :
+            neue modifikationen := d modifikationen;
+            IF d modifikationen <> 0
+               THEN schalte modifikationen aus
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+            FI;
+ 
+        . schalte modifikationen ein wenn noetig :
+            IF d modifikationen <> neue modifikationen
+               THEN schalte modifikationen ein
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+            FI;
+ 
+END PROC x move;
+ 
+ 
+PROC schalte modifikationen ein 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+     disable stop;
+     INT VAR index;
+     IF d modifikationen <> 0
+        THEN schalte modifikationen aus
+               (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+     FI;
+     d modifikationen := neue modifikationen;
+     FOR index FROM 1 UPTO anzahl modifikationen
+     REP IF bit (d modifikationen, modifikations bit)
+            THEN modifikation muss eingeschaltet werden
+         FI; 
+     PER;
+ 
+     . modifikations bit : index - 1
+ 
+     . modifikation muss eingeschaltet werden :
+         IF bit (modifikations modus, modifikations bit) 
+            THEN execute (on, "", modifikations werte (index), 0);
+                 IF is error
+                    THEN clear error;
+                         reset bit (modifikations modus, modifikations bit); 
+                         set bit   (pass,                modifikations bit);
+                 FI;
+            ELSE set bit (pass, modifikations bit); 
+         FI;
+ 
+END PROC schalte modifikationen ein;
+ 
+ 
+PROC schalte modifikationen aus 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+     disable stop;
+     INT VAR index;
+     FOR index FROM 1 UPTO anzahl modifikationen
+     REP IF bit (d modifikationen, modifikations bit)
+            THEN modifikation muss ausgeschaltet werden
+         FI; 
+     PER;
+     d modifikationen := 0;
+ 
+     . modifikations bit : index - 1
+ 
+     . modifikation muss ausgeschaltet werden :
+         IF bit (modifikations modus, modifikations bit) 
+            THEN execute (off, "", modifikations werte (index), 0);
+                 IF is error THEN clear error FI;
+         FI;
+ 
+END PROC schalte modifikationen aus;
+ 
+ 
+PROC font wechsel 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+     disable stop;
+     d font := d token. font;
+     get replacements (d font, replacements, replacement tabelle);
+     execute (type, "", d font, 0);
+     IF is error THEN font wechsel nach cr FI;
+     enable stop;
+ 
+     . font wechsel nach cr :
+         clear error;
+         verschiebung := d xpos;
+         gib cr aus;
+         execute (type, "", d font, 0);
+         IF NOT is error
+            THEN schalte modifikationen aus
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+                 x move
+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+         FI;
+ 
+        . gib cr aus :
+            execute (carriage return,  "", d xpos, 0);
+            d xpos := 0;
+ 
+END PROC font wechsel;
+ 
+ 
+PROC gib text token aus 
+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+  INT CONST token laenge := LENGTH d token. text;
+  INT VAR token pos := 1, alte token pos, summe := 0;
+  IF token laenge > 0
+     THEN REP alte token pos := token pos;
+              stranalyze (replacement tabelle, summe, 0,
+                          d token. text, token pos, token laenge,
+                          ausgang);
+              IF ausgang = 0 
+                 THEN gib token rest aus;
+                 ELSE gib token teil aus;
+                      gib ersatzdarstellung aus;
+              FI;
+          PER;
+  FI;
+ 
+  . gib token rest aus :
+      IF token laenge >= alte token pos
+         THEN execute (write text, d token. text, alte token pos, token laenge) FI;
+      d xpos INCR d token. breite;
+      LEAVE gib text token aus;
+
+  . gib token teil aus :
+      IF token pos >= alte token pos
+         THEN execute (write text, d token. text, alte token pos, token pos) FI;
+ 
+  . gib ersatzdarstellung aus :
+      IF ausgang = maxint
+         THEN ersatzdarstellung := extended replacement (d token. font,
+                d token. text SUB token pos + 1, d token. text SUB token pos + 2);
+              execute (write text, ersatzdarstellung, 1, LENGTH ersatzdarstellung);
+              tokenpos INCR 3;
+         ELSE IF ausgang < 0
+                 THEN ausgang := ausgang XOR (-32767-1);
+                      token pos INCR 1;
+              FI;
+              execute (write text, replacements, ausgang + 1, ausgang + code (replacements SUB ausgang));
+              token pos INCR 2;
+      FI;
+ 
+      . ersatzdarstellung : par1
+ 
+END PROC gib text token aus;
+ 
+ 
+PROC schliesse seite ab (PROC (INT CONST, INT CONST) close,
+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+
+enable stop;
+gebe restliche token aus;
+seiten ende kommando;
+
+. gebe restliche token aus :
+    IF erster ypos index d <> 0
+       THEN drucke tokenspeicher (maxint,
+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    FI;
+    rest := papier laenge - d ypos;
+
+. seiten ende kommando :
+    seite ist offen := FALSE;
+    a ypos          := top margin;
+    aktuelle spalte := 1;
+    close (page, rest);
+ 
+END PROC schliesse seite ab;
+ 
+ 
+PROC eroeffne seite (INT CONST x wanted, y wanted,
+                     PROC (INT CONST, INT VAR, INT VAR) open ) :
+ 
+IF vor erster seite THEN eroeffne druck FI;
+seiten anfang kommando;
+initialisiere neue seite;
+
+. eroeffne druck :
+    open (document, x size, y size);
+    vor erster seite := FALSE;
+    d font           := -1;
+    d modifikationen := 0;
+
+. seiten anfang kommando :
+    x start := x wanted;
+    y start := y wanted;
+    open (page, x start, y start);
+    gedruckte seiten INCR 1;
+    seite ist offen := TRUE;
+
+. initialisiere neue seite :
+    INT CONST dif left margin := x wanted - x start - left margin + indentation,
+              dif top  margin := y wanted - y start - top  margin; 
+    IF dif left margin <> 0
+       THEN erstes tab token := 1;
+            verschiebe token xpos (dif left margin);
+            a xpos      INCR dif left margin;
+            left margin INCR dif left margin;
+    FI;
+    IF dif top margin <> 0
+       THEN verschiebe token ypos (dif top margin);
+            a ypos      INCR dif top margin;
+            top margin  INCR dif top margin;
+    FI;
+    d xpos := 0;
+    d ypos := 0;
+    IF seitenlaenge <= papierlaenge
+       THEN seitenlaenge := top margin + pagelength; 
+       ELSE seitenlaenge DECR papierlaenge;
+    FI;
+    papierlaenge := y size - y start;
+    papierbreite := x size - x start;
+
+END PROC eroeffne seite;
+ 
+(****************************************************************)
+ 
+PROC elan fuss und kopf (INT CONST fuss oder kopf,
+                PROC (INT CONST, INT CONST) close,
+                PROC (INT CONST, INT VAR, INT VAR) open,
+                PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+IF fuss oder kopf <= 0 THEN elan fuss FI;
+IF fuss oder kopf >= 0 THEN elan kopf FI;
+ 
+.
+  elan fuss :
+    y move zur fusszeile;
+    drucke elan fuss;
+    close page cmd;
+ 
+. y move zur fusszeile :
+    execute (carriage return,  "", d xpos, 0);
+    d xpos := 0;
+    verschiebung := rest auf seite - font hoehe;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+. drucke elan fuss :
+    IF bottom label = ""
+       THEN seiten nr := ""
+       ELSE seiten nr := bottom label;
+            seiten nr CAT "/";
+    FI;
+    seiten nr CAT text (gedruckte seiten);
+    elan text := seiten nr;
+    elan text CAT "   ";
+    elan text cat blanks ((max zeichen fuss - LENGTH dateiname) DIV 2 - LENGTH elan text);
+    elan text CAT dateiname;
+    elan text cat blanks (max zeichen fuss - LENGTH seiten nr - LENGTH elan text - 3);
+    elan text CAT "   ";
+    elan text CAT seiten nr;
+    IF LENGTH elan text > max zeichen zeile
+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;
+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+ 
+    . seiten nr : par1
+ 
+. close page cmd :
+    close (page, papierlaenge - d ypos);
+    seite ist offen := FALSE;
+
+.
+  elan kopf :
+    open page cmd ;
+    y move zur kopfzeile;
+    drucke elan kopf;
+
+. open page cmd :
+    x start         := x wanted;
+    y start         := y wanted;
+    open (page, x start, y start);
+    IF fuss oder kopf = 1 THEN execute (type, "", d font, 0) FI;
+    gedruckte seiten INCR 1;
+    seite ist offen := TRUE;
+    top  margin     := y wanted - y start;
+    left margin     := x wanted - x start;
+    rest auf seite  := pagelength;
+    papierlaenge    := y size - y start;
+    d ypos          := 0; 
+    d xpos          := 0;
+ 
+. y move zur kopf zeile :
+    verschiebung := top margin;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+    IF verschiebung = 0 THEN rest auf seite INCR top margin FI;
+ 
+. drucke elan kopf :
+    elan text :=  headline pre;
+    elan text CAT date;
+    elan text CAT headline post;
+    elan text CAT datei name;
+    IF LENGTH elan text > max zeichen zeile
+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;
+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+    cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 
+ 
+ENDPROC elan fuss und kopf;
+ 
+ 
+PROC gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :
+ 
+cr plus lf (1, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+linker rand wenn noetig;
+d token. breite := LENGTH elan text * einrueckbreite;
+gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+. linker rand wenn noetig :
+    IF left margin > 0
+       THEN disable stop;
+            d xpos := left margin;
+            execute (move, "", left margin, 0);
+            IF is error 
+               THEN clear error;
+                    d xpos := 0;
+            FI;
+            enable stop;
+    FI;
+ 
+END PROC gib elan text aus;
+ 
+ 
+PROC cr plus lf (INT CONST anzahl,
+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : 
+ 
+gib cr aus;
+gib lf aus;
+rest auf seite DECR verschiebung;
+ 
+. gib cr aus :
+    execute (carriage return,  "", d xpos, 0);
+    d xpos := 0;
+ 
+. gib lf aus :
+    verschiebung := anzahl * font hoehe;
+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+END PROC cr plus lf ; 
+ 
+ 
+END PACKET eumel printer;
+
diff --git a/system/multiuser/1.7.5/src/font store b/system/multiuser/1.7.5/src/font store
new file mode 100644
index 0000000..ebb6a62
--- /dev/null
+++ b/system/multiuser/1.7.5/src/font store
@@ -0,0 +1,695 @@
+PACKET font store                                 (* Autor : Rudolf Ruland *) 
+                                                  (* Stand : 18.02.86      *) 
+        DEFINES font table, 
+                list font tables,
+                list fonts, 
+ 
+                x step conversion,
+                y step conversion,
+                on string,
+                off string,
+ 
+                font,
+                font exists, 
+                next larger font exists, 
+                next smaller font exists,
+                font lead,
+                font height,
+                font depth,
+                indentation pitch,
+                char pitch, 
+                extended char pitch,
+                replacement,
+                extended replacement,
+                font string,
+                y offsets,
+                bold offset,
+                get font, 
+                get replacements :
+ 
+ 
+LET font task       = "configurator";
+ 
+LET ack             =    0,
+    fetch code      =   11,
+    all code        =   17,
+ 
+    underline       =    1,
+    bold            =    2,
+    italics         =    4,
+    reverse         =    8,
+
+    first font      =    1,
+    max fonts       =   50,
+    max extensions  =  120, 
+    font table type = 3009,
+ 
+    FONTTABLE = STRUCT (
+ 
+        THESAURUS font names, 
+ 
+        TEXT replacements, font name links,
+             extension chars, extension indexes, 
+
+        ROW 4 TEXT on strings, off strings,
+ 
+        REAL x unit, y unit,
+ 
+        ROW 256 INT replacements table,
+ 
+        INT last font, last extension
+ 
+        ROW max fonts STRUCT (
+            TEXT font string, font name indexes, replacements,
+                 extension chars, extension indexes, y offsets,
+            ROW 256 INT pitch table, replacements table,
+            INT  indentation pitch, font lead, font height, font depth,
+                 next larger font, next smaller font, bold offset ) fonts ,
+ 
+        ROW max extensions STRUCT (
+            TEXT replacements,
+            ROW 256 INT pitch table, replacements table,
+            INT std pitch                                     ) extensions ,
+ 
+                        );
+ 
+INT VAR font nr, help, reply, list index, last font,
+        index, char code 1, link nr, font store replacements length; 
+ 
+TEXT VAR fo table := "", old font table, font name links, buffer;
+ 
+THESAURUS VAR font tables, font names;
+ 
+INITFLAG VAR in this task := FALSE, 
+             init font ds := FALSE,
+             init ds      := FALSE;
+ 
+BOUND FONTTABLE VAR font store;
+ 
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg;
+ 
+BOUND THESAURUS VAR all msg;
+ 
+BOUND TEXT VAR error msg;
+ 
+DATASPACE VAR font ds, ds;
+ 
+(*****************************************************************) 
+ 
+PROC font table (TEXT CONST new font table) :
+
+  disable stop;
+  get font table (new font table);
+  in this task := NOT (font table = "" OR type (font ds) <> font table type);
+ 
+END PROC font table;
+ 
+ 
+PROC get font table (TEXT CONST new font table) :
+ 
+  enable stop;
+  buffer := new font table;
+  change all (buffer, " ", "");
+  IF   exists (buffer) CAND type (old (buffer)) = font table type
+       THEN get font table from own task 
+  ELIF exists task (font task)
+       THEN get font table from font task 
+       ELSE errorstop ("Fonttabelle """ + buffer + """ gibt es nicht")
+  FI;
+ 
+  . get font table from own task :
+      IF NOT initialized (init ds) THEN ds := nilspace FI;
+      forget (ds); ds := old (buffer);
+      new font store;
+ 
+  . get font table from font task :
+      fetch font table (buffer);
+      IF type (ds) <> font table type 
+         THEN forget (ds);
+              errorstop ("Fonttabelle """ + buffer + """ gibt es nicht")
+      FI;
+      new font store;
+ 
+      . new font store :
+          disable stop;
+          IF NOT initialized (init font ds) THEN font ds := nilspace FI;
+          forget (font ds);
+          font ds := ds;
+          forget (ds);
+          font store      := font ds;
+          fo table        := buffer;
+          font names      := font store. font names;
+          font name links := font store. font name links;
+          last font       := font store. last font;
+          font store replacements length := LENGTH font store. replacements;
+
+END PROC get font table;
+ 
+ 
+TEXT PROC font table :
+ 
+  fo table
+ 
+END PROC  font table;
+ 
+ 
+PROC list font tables :
+ 
+  enable stop; 
+  font tables := empty thesaurus;
+  font tables in own task;
+  font tables in font task;
+  note font tables;
+  note edit;
+ 
+  . font tables in own task :
+      list index := 0;
+      REP get (all, buffer, list index);
+          IF buffer = "" THEN LEAVE font tables in own task FI;
+          IF type (old (buffer)) = font table type
+                  AND NOT (font tables CONTAINS buffer)
+            THEN insert (font tables, buffer) FI;
+      PER;
+ 
+  . font tables in font task :
+      all file names from font task;
+      THESAURUS CONST names := all msg;
+      list index := 0;
+      REP get (names, buffer, list index);
+          IF buffer = ""
+             THEN forget (ds);
+                  LEAVE font tables in font task
+          FI;
+          fetch font table (buffer);
+          IF type (ds) = font table type
+                  AND NOT (font tables CONTAINS buffer) 
+             THEN insert (font tables, buffer) FI;
+      PER;
+ 
+  . note font tables :
+      list index := 0;
+      REP get (font tables, buffer, list index);
+          IF buffer = ""
+             THEN LEAVE note font tables;
+             ELSE note (buffer); note line;
+          FI;
+      PER;
+ 
+END PROC list font tables;
+ 
+ 
+PROC list fonts (TEXT CONST name):
+ 
+  initialize if necessary;
+  disable stop;
+  old font table := font table;
+  font table (name);
+  list fonts;
+  font table (old font table);
+ 
+END PROC list fonts;
+ 
+ 
+PROC list fonts :
+ 
+  enable stop;
+  initialize if necessary;
+  note font table;
+  FOR font nr FROM first font UPTO last font REP note font PER;
+  note edit;
+
+. note font table :
+    note ("FONTTABELLE  :  """); note (font table);              note (""";"); noteline; 
+    note ("  x einheit  =  ");   note (text (font store. x unit)); note (";"); noteline; 
+    note ("  y einheit  =  ");   note (text (font store. y unit)); note (";"); noteline; 
+ 
+. note font :
+    cout (font nr);
+    noteline;
+    note ("  FONT  :  ");                note font names;                       note (";"); noteline; 
+    note ("    einrueckbreite   =  ");   note (text(font. indentation pitch));  note (";"); noteline;
+    note ("    durchschuss      =  ");   note (text(font. font lead));          note (";"); noteline;
+    note ("    fonthoehe        =  ");   note (text(font. font height));        note (";"); noteline; 
+    note ("    fonttiefe        =  ");   note (text(font. font depth));         note (";"); noteline; 
+    note ("    groesserer font  =  """); note (next larger);                  note (""";"); noteline;
+    note ("    kleinerer font   =  """); note (next smaller);                 note (""";"); noteline;
+ 
+    . font         : font store. fonts (font nr) 
+    . next larger  : name (font store. font names, font. next larger font)
+    . next smaller : name (font store. font names, font. next smaller font)
+ 
+    . note font names :
+        INT VAR index;
+        note ("""");
+        note (name (font names, font. font name indexes ISUB 1));
+        note ("""");
+        FOR index FROM 2 UPTO LENGTH font. font name indexes DIV 2
+        REP note (",  """);
+            note (name (font names, font. font name indexes ISUB index));
+            note ("""");
+        PER;
+ 
+END PROC list fonts;
+ 
+ 
+INT PROC x step conversion (REAL CONST cm) :
+ 
+  initialize if necessary;
+  IF cm >= 0.0
+     THEN int (cm * font store. x unit + 0.5 )
+     ELSE int (cm * font store. x unit - 0.5 )
+  FI
+ 
+END PROC x step conversion;
+ 
+ 
+REAL PROC x step conversion (INT CONST steps) :
+ 
+  initialize if necessary;
+  real (steps) / font store. x unit
+ 
+END PROC x step conversion;
+ 
+ 
+INT PROC y step conversion (REAL CONST cm) :
+ 
+  initialize if necessary;
+  IF cm >= 0.0
+     THEN int (cm * font store. y unit + 0.5 )
+     ELSE int (cm * font store. y unit - 0.5 )
+  FI
+ 
+END PROC y step conversion;
+ 
+ 
+REAL PROC y step conversion (INT CONST steps) :
+ 
+  initialize if necessary;
+  real (steps) / font store. y unit
+ 
+END PROC y step conversion;
+ 
+ 
+TEXT PROC on string (INT CONST modification) :
+ 
+  initialize if necessary;
+  SELECT modification OF
+    CASE underline : font store. on strings (1)
+    CASE bold      : font store. on strings (2)
+    CASE italics   : font store. on strings (3)
+    CASE reverse   : font store. on strings (4)
+         OTHERWISE : errorstop ("unzulaessige Modifikation"); ""
+  END SELECT
+ 
+END PROC on string;
+ 
+ 
+TEXT PROC  off string (INT CONST modification) :
+ 
+  initialize if necessary;
+  SELECT modification OF
+    CASE underline : font store.  off strings (1)
+    CASE bold      : font store.  off strings (2)
+    CASE italics   : font store.  off strings (3)
+    CASE reverse   : font store.  off strings (4)
+         OTHERWISE : errorstop ("unzulaessige Modifikation"); ""
+  END SELECT
+ 
+END PROC  off string;
+ 
+ 
+INT PROC font (TEXT CONST font name) :
+ 
+  initialize if necessary;
+  buffer := font name;
+  change all (buffer, " ", "");
+  INT CONST link nr := link (font names, buffer)
+  IF link nr <> 0
+     THEN font name links ISUB link nr
+     ELSE 0
+  FI
+ 
+END PROC font;
+ 
+ 
+TEXT PROC font (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN name (font names, fonts. font name indexes ISUB 1)
+     ELSE ""
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font;
+ 
+ 
+BOOL PROC font exists (TEXT CONST font name) :
+ 
+  font (font name) <> 0
+ 
+END PROC font exists;
+ 
+ 
+BOOL PROC next larger font exists(INT CONST font number,
+                                  INT VAR   next larger font) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN next larger font := fonts. next larger font;
+          IF next larger font <> 0
+             THEN next larger font := font name links ISUB next larger font;
+                  next larger font <> 0
+             ELSE FALSE
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht");
+          FALSE
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC next larger font exists;
+ 
+ 
+BOOL PROC next smaller font exists (INT CONST font number,
+                                    INT VAR   next smaller font) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN next smaller font := fonts. next smaller font;
+          IF next smaller font <> 0
+             THEN next smaller font := font name links ISUB next smaller font;
+                  next smaller font <> 0
+             ELSE FALSE
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht");
+          FALSE
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC next smaller font exists;
+ 
+ 
+INT PROC font lead (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font lead 
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font lead; 
+ 
+ 
+INT PROC font height (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font height
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font height;
+ 
+ 
+INT PROC font depth (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font depth
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font depth;
+ 
+ 
+INT PROC indentation pitch (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. indentation pitch
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC indentation pitch;
+ 
+ 
+INT PROC char pitch (INT  CONST font number,
+                     TEXT CONST char ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN INT CONST pitch := font. pitch table (code (char SUB 1) + 1);
+          IF   pitch = maxint
+               THEN extended char pitch (font number, char SUB 1, char SUB 2)
+          ELIF pitch < 0
+               THEN pitch XOR (-maxint-1) 
+               ELSE pitch
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . font :      font store. fonts (font number)
+ 
+END PROC char pitch;
+ 
+ 
+INT PROC extended char pitch (INT  CONST font number,
+                               TEXT CONST esc char, char) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN extension. pitch table (code (char) + 1) 
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . font      : font store. fonts (font number)
+ 
+  . extension : font store. extensions (extension number)
+ 
+  . extension number :
+      INT CONST index := pos (font. extension chars, esc char);
+      IF index = 0
+         THEN errorstop ("""" + esc char + char + """ hat keine Erweiterung") FI; 
+      font. extension indexes ISUB index
+ 
+END PROC extended char pitch;
+ 
+ 
+TEXT PROC replacement (INT  CONST font number,
+                       TEXT CONST char ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN link nr := font. replacements table (code (char SUB 1) + 1);
+          IF link nr = maxint
+             THEN extended replacement (font number, char SUB 1, char SUB 2)
+             ELSE process font replacement
+          FI
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . font      : font store. fonts (font number)
+ 
+  . process font replacement :
+      IF link nr < 0 THEN link nr := link nr XOR (-maxint-1) FI;
+      IF   link nr = 0
+           THEN char
+      ELIF link nr > font store replacements length
+           THEN link nr DECR font store replacements length;
+                replacement text (font. replacements)
+           ELSE replacement text (font store. replacements)
+      FI
+ 
+END PROC replacement;
+ 
+ 
+TEXT PROC extended replacement (INT  CONST font number,
+                                 TEXT CONST esc char, char ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN process extension replacement
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . process extension replacement :
+      determine extension link nr;
+      IF   link nr = 0
+           THEN char
+      ELIF link nr > font store extension replacements length 
+           THEN link nr DECR font store extension replacements length;
+                replacement text (font extension. replacements)
+           ELSE replacement text (font store extension. replacements)
+      FI
+ 
+      . determine extension link nr :
+          INT CONST index 1 := pos (font. extension chars, esc char); 
+          INT CONST index 2 := pos (font store. extension chars, esc char);
+          IF   index 1 <> 0
+               THEN link nr := font extension. replacements table (code (char) + 1); 
+          ELIF index 2 <> 0
+               THEN link nr := font store extension. replacements table (code (char) + 1); 
+               ELSE errorstop ("""" + esc char + char + """ hat keine Erweiterung") 
+          FI;
+ 
+      . font extension              : font store. extensions (font extension number)
+ 
+      . font extension number       : font. extension indexes ISUB index 1
+ 
+      . font                        : font store. fonts (font number)
+ 
+      . font store extension        : font store. extensions (font store extension number)
+ 
+      . font store extension number : font store. extension indexes ISUB index 2
+ 
+      . font store extension replacements length :
+          IF index 2 = 0
+             THEN 0
+             ELSE LENGTH font store extension. replacements
+          FI
+ 
+END PROC extended replacement;
+ 
+ 
+TEXT PROC replacement text (TEXT CONST replacements) :
+ 
+  buffer := subtext (replacements, link nr + 1,
+                                   link nr + code (replacements SUB link nr));
+  buffer
+ 
+END PROC replacement text;
+ 
+ 
+TEXT PROC font string (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. font string
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC font string;
+ 
+ 
+TEXT PROC y offsets (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. y offsets
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); ""
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC y offsets;
+ 
+ 
+INT PROC bold offset (INT CONST font number) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN fonts. bold offset
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 0
+  FI
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC bold offset;
+ 
+ 
+PROC get font (INT CONST font number,
+               INT VAR indentation pitch, font lead, font height, font depth,
+               ROW 256 INT VAR pitch table ) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN indentation pitch := fonts. indentation pitch;
+          pitch table       := fonts. pitch table;
+          font lead         := fonts. font lead; 
+          font height       := fonts. font height;
+          font depth        := fonts. font depth; 
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 
+  FI;
+ 
+  . fonts : font store. fonts (font number) 
+ 
+END PROC get font;
+ 
+ 
+PROC get replacements (INT CONST font number, 
+                       TEXT VAR replacements,
+                       ROW 256 INT VAR replacements table) :
+ 
+  initialize if necessary;
+  IF font number >= first font AND font number <= last font
+     THEN replacements       := font store. replacements;
+          replacements      CAT fonts. replacements;
+          replacements table := fonts. replacements table;
+     ELSE errorstop ("Font " + text (font number) + " gibt es nicht"); 
+  FI;
+ 
+  . fonts : font store. fonts (font number)
+ 
+END PROC get replacements;
+ 
+ 
+PROC initialize if necessary :
+
+  IF NOT initialized (in this task)
+     THEN IF font table = ""
+             THEN in this task := FALSE;
+                  errorstop ("Fonttabelle noch nicht eingestellt");
+             ELSE font table (font table);
+          FI;
+  FI;
+
+END PROC initialize if necessary; 
+ 
+ 
+PROC fetch font table (TEXT CONST font table name) :
+ 
+  enable stop;
+  IF NOT initialized (init ds) THEN ds := nilspace FI;
+  forget (ds); ds := nilspace;
+  msg             := ds;
+  msg. name       := font table name;
+  msg. write pass := "";
+  msg. read  pass := "";
+  call (task (font task), fetch code, ds, reply);
+  IF reply <> ack
+     THEN errorstop ("Fonttabelle """ + font table name + """ gibt es nicht")
+  FI;
+ 
+END PROC fetch font table;
+ 
+ 
+PROC all file names from font task :
+ 
+  enable stop;
+  IF NOT initialized (init ds) THEN ds := nilspace FI;
+  forget (ds); ds := nilspace;
+  call (task (font task), all code, ds, reply);
+  IF reply <> ack
+     THEN error msg := ds;
+          errorstop (error msg);
+     ELSE all msg := ds
+  FI;
+ 
+END PROC all file names from font task;
+ 
+ 
+END PACKET font store;
+
diff --git a/system/multiuser/1.7.5/src/global manager b/system/multiuser/1.7.5/src/global manager
new file mode 100644
index 0000000..b3d64cc
--- /dev/null
+++ b/system/multiuser/1.7.5/src/global manager
@@ -0,0 +1,683 @@
+(* ------------------- VERSION 19     16.05.86 ------------------- *)
+PACKET global manager DEFINES                  (* Autor: J.Liedtke *)
+ 
+  ALL ,
+  begin password ,
+  call ,
+  continue channel ,
+  erase ,
+  exists ,
+  fetch , 
+  free global manager ,
+  free manager ,
+  global manager ,
+  list ,
+  manager message ,
+  manager question ,
+  save , 
+  std manager :
+ 
+ 
+LET ack                  = 0 ,
+    nak                  = 1 ,
+    error nak            = 2 ,
+    message ack          = 3 ,
+    question ack         = 4 ,
+    second phase ack     = 5 ,
+    false code           = 6 , 
+
+    begin code           = 4 ,
+    password code        = 9 ,
+    fetch code           = 11 ,
+    save code            = 12 ,
+    exists code          = 13 ,
+    erase code           = 14 ,
+    list code            = 15 ,
+    all code             = 17 ,
+    free code            = 20 ,
+    continue code        = 100,
+ 
+
+    error pre            = ""7""13""10""5"FEHLER : " , 
+    cr lf                = ""13""10"" ;
+
+INT VAR reply , order , last order, phase number ;
+ 
+DATASPACE VAR ds := nilspace ;
+ 
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
+BOUND TEXT VAR reply msg ;
+BOUND THESAURUS VAR thesaurus msg ;
+ 
+TASK VAR order task, last order task ; 
+
+FILE VAR list file ;
+ 
+TEXT VAR error message buffer := "" 
+        ,record 
+        ,received name 
+        ,create son password := "" 
+        ,save file name 
+        ,save write password 
+        ,save read password 
+        ;
+ 
+ 
+PROC fetch (TEXT CONST file name) :
+
+  fetch (file name, father)
+ 
+ENDPROC fetch ;
+ 
+PROC fetch (TEXT CONST file name, TASK CONST manager) :
+ 
+  enable stop ;
+  last param (file name) ;
+  IF NOT exists (file name) 
+    THEN call (fetch code, file name, manager)
+  ELIF overwrite permitted
+    THEN call (fetch code, file name, manager) ;
+         forget (file name, quiet) 
+  ELSE LEAVE fetch
+  FI ;
+  IF reply = ack 
+    THEN disable stop ;
+         copy (ds, file name) ; 
+         forget (ds)
+    ELSE forget (ds) ; 
+         errorstop ("Task """ + name (manager) + """antwortet nicht mit ack")
+  FI . 
+ 
+overwrite permitted :
+  say ("eigene Datei """) ;
+  say (file name) ;
+  yes (""" ueberschreiben") .
+
+ENDPROC fetch ;
+
+PROC fetch (DATASPACE VAR dest, TEXT CONST file name, TASK CONST manager) :
+
+  disable stop ;
+  call (fetch code, file name, manager) ;
+  dest := ds ;
+  forget (ds)
+
+ENDPROC fetch ;
+
+
+PROC save :
+ 
+  save (last param)
+ 
+ENDPROC save ;
+ 
+PROC save (TEXT CONST file name) :
+ 
+  save (file name, father)
+ 
+ENDPROC save ;
+ 
+PROC save (TEXT CONST file name, TASK CONST manager) :
+ 
+  last param (file name) ;
+  call (save code, file name, old (file name), manager) ; 
+  forget (ds) 
+ 
+ENDPROC save ;
+
+PROC save (DATASPACE CONST source, TEXT CONST file name, TASK CONST manager):
+
+  call (save code, file name, source, manager) ; 
+  forget (ds) 
+
+ENDPROC save ;
+
+
+BOOL PROC exists (TEXT CONST file name, TASK CONST manager) :
+
+  call (exists code, file name, manager) ; 
+  forget (ds) ;
+  reply = ack .
+
+ENDPROC exists ;
+
+
+PROC erase :
+ 
+  erase (last param)
+ 
+ENDPROC erase ;
+ 
+PROC erase (TEXT CONST file name) :
+ 
+  erase (file name, father)
+ 
+ENDPROC erase ;
+ 
+PROC erase (TEXT CONST file name, TASK CONST manager) :
+ 
+  call (erase code, file name, manager) ; 
+  forget (ds)
+
+ENDPROC erase ;
+
+ 
+PROC list (TASK CONST manager) :
+ 
+  IF manager = myself
+    THEN list
+    ELSE list from manager
+  FI .
+
+list from manager :
+  call (list code, "", manager) ;
+  IF reply = ack
+    THEN DATASPACE VAR save ds := ds ; 
+         forget (ds) ; 
+         list file := sequential file (modify, save ds) ;
+         insert station and name of task in headline if possible ; 
+         show (list file) ;
+         forget (save ds)
+    ELSE forget (ds) 
+  FI . 
+ 
+insert station and name of task in headline if possible :
+  IF headline (list file) = "" 
+    THEN headline (list file, station number if there is one 
+                              + "  Task : " + name (manager))
+  FI . 
+ 
+station number if there is one : 
+  IF station (manager) > 0 
+    THEN "Station : " + text (station (manager)) 
+    ELSE "" 
+  FI . 
+ 
+ENDPROC list ;
+        
+PROC list (FILE VAR f, TASK CONST manager) :
+ 
+  IF manager = myself
+    THEN list (f)
+    ELSE list from manager
+  FI .
+
+list from manager :
+  call (list code, "", manager) ;
+  IF reply = ack
+    THEN DATASPACE VAR save ds := ds ; 
+         forget (ds) ; 
+         list file := sequential file (input, save ds) ;
+         copy attributes (list file, f) ;
+         insert station and name of task in headline if possible ;
+         REP
+           getline (list file, record) ;
+           putline (f, record)
+         UNTIL eof (list file) PER ; 
+         forget (save ds)
+    ELSE forget (ds) 
+  FI . 
+
+insert station and name of task in headline if possible :
+  IF headline (list file) = "" 
+    THEN headline (list file, station number if there is one 
+                              + "  Task : " + name (manager))
+  FI . 
+ 
+station number if there is one : 
+  IF station (manager) > 0 
+    THEN "Station : " + text (station (manager)) 
+    ELSE "" 
+  FI . 
+ 
+ENDPROC list ;
+
+THESAURUS OP ALL (TASK CONST manager) :
+
+  THESAURUS VAR result ;
+  IF manager = myself
+    THEN result := all
+    ELSE get all from manager
+  FI ;
+  result .
+
+get all from manager :
+  call (all code, "", manager) ;
+  IF reply = ack
+    THEN get result thesaurus
+    ELSE result := empty thesaurus
+  FI .
+
+get result thesaurus :
+  thesaurus msg := ds ;
+  result := CONCR (thesaurus msg) ;
+  forget (ds) .
+ 
+ENDOP ALL ; 
+ 
+ 
+PROC call (INT CONST op code, TEXT CONST file name, TASK CONST manager) :
+ 
+  DATASPACE VAR dummy space ;
+  call (op code, file name, dummy space, manager) 
+
+ENDPROC call ;
+
+PROC call (INT CONST op code, TEXT CONST file name,
+           DATASPACE CONST save space, TASK CONST manager) :
+ 
+  enable stop ;
+  send first order first time ;
+  send second order if required first time ;
+  WHILE order restart required REP
+    pause (10) ;
+    send first order (op code, file name, manager) ;
+    send second order if required
+  PER ;
+  error or message if required .
+
+send first order first time :
+  send first order (op code, file name, manager) ;
+  WHILE order restart required REP
+    pause (10) ;
+    send first order (op code, file name, manager)
+  PER .
+
+send second order if required first time :
+  IF reply = question ack
+    THEN reply msg := ds ;
+         IF NOT yes (reply msg)
+           THEN LEAVE call 
+           ELSE send second order (op code, file name, save space, manager)
+         FI
+  ELIF reply = second phase ack
+    THEN send second order (op code, file name, save space, manager)
+  FI .
+
+send second order if required :
+    IF reply = second phase ack OR reply = question ack
+      THEN send second order (op code, file name, save space, manager)
+    FI .
+
+error or message if required :
+  IF reply = message ack
+    THEN reply msg := ds ;
+         say (reply msg) ;
+         say (cr lf)
+  ELIF reply = error nak
+    THEN reply msg := ds ;
+         errorstop (reply msg)
+  FI .
+
+order restart required : reply = nak .
+
+ENDPROC call ;
+
+PROC send first order (INT CONST op code, TEXT CONST file name,
+                       TASK CONST manager) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  msg := ds ;
+  msg.name := file name ;
+  msg.write pass := write password ;
+  msg.read pass  := read password ;
+  call (manager, op code, ds, reply) ;
+  IF reply < 0
+    THEN errorstop ("Task nicht vorhanden")
+  FI .
+
+ENDPROC send first order ;
+
+PROC send second order (INT CONST op code, TEXT CONST file name,
+                        DATASPACE CONST save space, TASK CONST manager) :
+
+  IF op code = save code
+    THEN send save space
+    ELSE send first order (second phase ack, file name, manager)
+  FI .
+
+send save space :
+  forget (ds) ;
+  ds := save space ;
+  call (manager, second phase ack, ds, reply) .
+
+ENDPROC send second order ;
+ 
+ 
+PROC global manager :
+
+  global manager 
+  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager)
+
+ENDPROC global manager ;
+
+PROC free global manager :
+
+  global manager 
+  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) free manager)
+
+ENDPROC free global manager ;
+
+
+PROC global manager (PROC (DATASPACE VAR, 
+                     INT CONST, INT CONST, TASK CONST) manager) :
+ 
+  DATASPACE VAR local ds := nilspace ;
+  break ; 
+  set autonom ;
+  disable stop ;
+  command dialogue (FALSE) ;
+  remember heap size ;
+  last order task := niltask ;
+  REP
+    forget (local ds) ; 
+    wait (local ds, order, order task) ;
+    IF order <> second phase ack
+      THEN prepare first phase ;
+           manager (local ds, order, phase number, order task)
+    ELIF order task = last order task
+      THEN prepare second phase ;
+           manager (local ds, order, phase number, order task)
+    ELSE   send nak
+    FI ;
+    send error if necessary ;
+    collect heap garbage if necessary
+  PER .
+
+prepare first phase :
+  phase number := 1 ;
+  last order := order ;
+  last order task := order task .
+
+prepare second phase :
+  phase number INCR 1 ;
+  order := last order .
+
+send nak :
+  forget (local ds) ;
+  local ds := nilspace ;
+  send (order task, nak, local ds) .
+
+send error if necessary :
+  IF is error
+    THEN forget (local ds) ;
+         local ds := nilspace ;
+         reply msg := local ds ;
+         CONCR (reply msg) := error message ;
+         clear error ;
+         send (order task, error nak, local ds)
+  FI .
+ 
+remember heap size :
+  INT VAR old heap size := heap size .
+
+collect heap garbage if necessary :
+  IF heap size > old heap size + 8
+    THEN collect heap garbage ;
+         old heap size := heap size
+  FI .
+
+ENDPROC global manager ;
+
+PROC std manager (DATASPACE VAR ds, 
+                  INT CONST order, phase, TASK CONST order task) :
+
+  IF order task < myself OR order = begin code OR order task = supervisor
+    THEN free manager (ds, order, phase, order task)
+    ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """")
+  FI .
+
+ENDPROC std manager ;
+
+PROC free manager (DATASPACE VAR ds, 
+                   INT CONST order, phase, TASK CONST order task):
+
+  enable stop ;
+  IF   order > continue code   AND
+       order task = supervisor THEN y maintenance
+  ELIF order = begin code      THEN y begin
+  ELSE                              file manager order
+  FI .
+
+file manager order :
+  get message text if there is one ;
+  SELECT order OF
+    CASE fetch code       : y fetch
+    CASE save code        : y save
+    CASE exists code      : y exists
+    CASE erase code       : y erase
+    CASE list code        : y list
+    CASE all code         : y all
+    OTHERWISE errorstop ("falscher Auftrag fuer Task """+name(myself)+"""")
+  ENDSELECT .
+ 
+get message text if there is one :
+  IF order >= fetch code AND order <= erase code AND phase = 1
+    THEN msg := ds ;
+         received name := msg.name
+  FI .
+ 
+y begin :
+  BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg := ds ;
+  IF create son password = sv msg.tpass AND create son password <> "-"
+    THEN create son task
+  ELIF sv msg.tpass = ""
+    THEN ask for password
+  ELSE   errorstop ("Passwort falsch")
+  FI .
+
+create son task :
+  begin (ds, PROC std begin, reply) ;
+  send (order task, reply, ds) .
+
+ask for password :
+  send (order task, password code, ds) .
+
+
+y fetch :
+  IF read permission (received name, msg.read pass)
+    THEN forget (ds) ;
+         ds := old (received name) ;
+         send (order task, ack, ds)
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y erase :
+  msg := ds ;
+  received name := msg.name ;
+  IF NOT exists (received name)
+    THEN manager message ("""" + received name + """ existiert nicht", order task)
+  ELIF phase = 1
+    THEN manager question ("""" + received name + """ loeschen", order task)
+  ELIF write permission (received name, msg.write pass)
+    THEN forget (received name, quiet) ;
+         send (order task, ack, ds)
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y save :
+  IF phase = 1
+    THEN y save pre
+    ELSE y save post
+  FI .
+
+y save pre :
+  IF write permission (received name, msg.write pass)
+    THEN save file name := received name ;
+         save write password  := msg.write pass ;
+         save read password   := msg.read pass ;
+         IF exists (received name)
+           THEN manager question 
+                ("""" + received name + """ ueberschreiben", order task)
+           ELSE send (order task, second phase ack, ds) 
+         FI
+    ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y save post :
+  forget (save file name, quiet) ;
+  copy (ds, save file name) ;
+  enter password (save file name, save write password, save read password) ;
+  forget (ds) ;
+  ds := nilspace ;
+  send (order task, ack, ds) ;
+  cover tracks of save passwords .
+
+cover tracks of save passwords :
+  replace (save write password, 1, LENGTH save write password * " ") ;
+  replace (save read password, 1, LENGTH save read password * " ") .
+
+y exists :
+  IF exists (received name)
+    THEN send (order task, ack, ds)
+    ELSE send (order task, false code, ds)
+  FI .
+
+y list :
+  forget (ds) ;
+  ds := nilspace ;
+  list file := sequential file (output, ds) ;
+  list (list file) ;
+  send (order task, ack, ds) .
+ 
+y all :
+  BOUND THESAURUS VAR all names := ds ;
+  all names := all ;
+  send (order task, ack, ds) .
+ 
+y maintenance :
+  disable stop ;
+  call (supervisor, order, ds, reply) ;
+  forget (ds) ;
+  IF reply = ack
+    THEN put error message if there is one ; 
+         REP 
+           command dialogue (TRUE) ;
+           get command ("maintenance :") ;
+           reset editor ; 
+           do command
+         UNTIL NOT on line PER ;
+         command dialogue (FALSE) ;
+         break ;
+         set autonom ;
+         save error message if there is one 
+  FI ;
+  enable stop .
+
+put error message if there is one : 
+  IF error message buffer <> "" 
+    THEN  out (error pre) ; 
+          out (error message buffer) ; 
+          out (cr lf) ; 
+          error message buffer := ""
+  FI . 
+ 
+reset editor :
+  WHILE aktueller editor > 0 REP
+    quit
+  PER ;
+  clear error .
+
+save error message if there is one : 
+  IF is error 
+    THEN error message buffer := error message ; 
+         clear error 
+  FI . 
+ 
+ENDPROC free manager ;
+ 
+PROC manager message (TEXT CONST message) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := message ;
+  send (order task, message ack, ds)
+
+ENDPROC manager message ;
+
+PROC manager question (TEXT CONST question) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := question ;
+  send (order task, question ack, ds)
+
+ENDPROC manager question ;
+
+PROC manager message (TEXT CONST message, TASK CONST receiver) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := message ;
+  send (receiver, message ack, ds)
+
+ENDPROC manager message ;
+
+PROC manager question (TEXT CONST question, TASK CONST receiver) :
+
+  forget (ds) ;
+  ds := nilspace ;
+  reply msg := ds ;
+  reply msg := question ;
+  send (receiver, question ack, ds)
+
+ENDPROC manager question ;
+
+PROC std begin :
+
+  do ("monitor")
+
+ENDPROC std begin ;
+
+PROC begin password (TEXT CONST password) :
+
+  cover tracks of old create son password ;
+  create son password := password ;
+  say (""3""13""5"") ;
+  cover tracks .
+
+cover tracks of old create son password :
+  replace (create son password, 1, LENGTH create son password * " ") .
+
+ENDPROC begin password ;
+
+
+PROC continue channel (INT CONST channel number) : 
+
+  TASK CONST channel owner := task (channel number) ; 
+  IF i am not channel owner 
+    THEN IF NOT is niltask (channel owner)
+           THEN ask channel owner to release the channel ;
+                IF channel owner does not release channel
+                  THEN errorstop ("Task """ + name (channel owner)
+                                            + """ gibt Kanal " 
+                                            + text (channel number)
+                                            + " nicht frei") 
+                FI 
+         FI ; 
+         continue (channel number) 
+  FI .
+  
+i am not channel owner : 
+  channel <> channel number . 
+ 
+ask channel owner to release the channel :
+  forget (ds) ; 
+  ds := nilspace ; 
+  pingpong (channel owner, free code, ds, reply) . 
+
+channel owner does not release channel : 
+  (reply <> ack) AND task exists . 
+ 
+task exists : 
+  reply <> -1 . 
+ 
+ENDPROC continue channel ;
+
+
+END PACKET global manager ;
+
diff --git a/system/multiuser/1.7.5/src/indexer b/system/multiuser/1.7.5/src/indexer
new file mode 100644
index 0000000..e60110a
--- /dev/null
+++ b/system/multiuser/1.7.5/src/indexer
@@ -0,0 +1,1142 @@
+(* ------------------- VERSION 59 vom 21.02.86 -------------------- *)
+PACKET index program DEFINES outline,
+                             index,
+                             index merge:
+
+(* Programm zur Behandlung von Indizes aus Druckdateien
+   Autor: Rainer Hahn
+   Stand: 1.7.1 (Febr. 1984)
+          1.7.4 (Maerz 1985) 'outline'
+*)
+
+LET escape            = ""27"",
+    blank             = " ",
+    trenn k           = ""220"",
+    trennzeichen      = ""221"",
+    minuszeichen      = ""45"",
+    kommando zeichen  = "#",
+    trenner           = " ...",
+    ziffernanfang     = "...  ",
+    ziffern           = "1234567890",
+    ib0               = 1,
+    ib1               = 2,
+    ib2               = 3,
+    ie0               = 4,
+    ie1               = 5,
+    ie2               = 6,
+    max indizes       = 10, (* !!Anzahl möglichetr Indizes *)
+    punkt grenze      = 50,
+    leer              = 0,
+    fuellend          = 1,
+    nicht angekoppelt = 2;
+ 
+INT VAR  seiten nr,
+         zeilen nr,
+         erste fehler zeilennr,
+         zeilen seit index begin,
+         von,
+         komm anf,
+         komm ende,
+         kommando index,
+         index nr,
+         inhalt nr,
+         anz params,
+         anz zwischenspeicher,
+         y richtung; 
+ 
+BOOL VAR outline modus,
+         inhaltsverzeichnis offen;
+
+TEXT VAR dummy,
+         dummy2,
+         fehlerdummy,
+         einrueckung,
+         akt zeile,
+         zweite zeile,
+         akt index,
+         zweiter index,
+         zeile,
+         kommando,
+         datei name,
+         kommando liste :: "ib:1.012ie:4.012",
+         par1,
+         par2;
+ 
+FILE VAR eingabe file,
+         ausgabe file;
+
+ROW max indizes FILE VAR f;
+
+ROW max indizes TEXT VAR zwischenspeicher;
+
+LET SAMMLER = STRUCT (TEXT index text,
+                      TEXT seitennummer zusatz,
+                      INT  zustand);
+ 
+ROW max indizes SAMMLER VAR sammler;
+
+(******************************* outline-Routine **********************)
+
+PROC outline:
+  outline (last param)
+END PROC outline;
+
+PROC outline (TEXT CONST eingabe datei):
+  outline modus := TRUE;
+  disable stop;
+  do outline (eingabe datei);
+  IF is error
+    THEN put error;
+         clear error
+  FI;
+  enable stop;
+  IF anything noted
+    THEN to line (eingabe file, erste fehler zeilennr);
+         note edit (eingabe file)
+    ELSE to line (eingabe file, 1);
+         last param (eingabe datei + ".outline")
+  FI;
+  line
+END PROC outline;
+
+PROC do outline (TEXT CONST eingabe datei):
+  enable stop;
+  IF exists (eingabe datei)
+    THEN initialisiere bildschirm;
+         deaktiviere sammler;
+         anfrage auf inhaltsverzeichnis;
+         einrichten fuer zeilennummer ausgabe;
+         richte dateien ein;
+         verarbeite datei;
+    ELSE errorstop ("Datei nicht vorhanden")
+  FI;
+  cursor (1, y richtung + 1).
+
+initialisiere bildschirm:
+  eingabe file := sequential file (modify, eingabe datei);
+  page;
+  put ("OUTLINE"); put ("( für"); put (lines (eingabe file)); put ("Zeilen):");
+  put (eingabe datei);
+  put ("->"); out (eingabe datei); out (".outline");
+  cursor (1, 3).
+
+anfrage auf inhaltsverzeichnis:
+  put ("Bitte Index-Nr. für Inhaltsverzeichnis:");
+  dummy := "9";
+  REP
+    editget (dummy);
+    inhalt nr := int (dummy);
+    IF last conversion ok AND inhalt nr > 0 AND inhalt nr < 10
+      THEN LEAVE anfrage auf inhaltsverzeichnis
+      ELSE line; put ("Nr. zwischen 0 und 9, bitte nochmal:")
+    FI
+  END REP.
+
+einrichten fuer zeilennummer ausgabe:
+  line (2);
+  INT VAR x;
+  get cursor (x, y richtung).
+
+richte dateien ein:
+  inhaltsverzeichnis offen := FALSE;
+  anz zwischenspeicher := 0;
+  einrueckung := "";
+  erste fehler zeilennr := 0;
+  ggf ueberschreibe anfrage (eingabe datei + ".outline");
+  ausgabe file := sequential file (output, eingabe datei + ".outline");
+  to line (eingabe file, 1);
+  col (eingabe file, 1).
+
+verarbeite datei:
+  REP
+    suche naechste zeile mit kommandozeichen;
+    IF pattern found
+      THEN verarbeite ggf index kommandos
+    FI;
+    IF line no (eingabe file) = lines (eingabe file)
+      THEN LEAVE verarbeite datei
+      ELSE down (eingabe file);
+           col (eingabe file, 1)
+    FI
+  END REP.
+
+verarbeite ggf index kommandos:
+  komm anf := col (eingabe file);
+  von := komm anf;
+  REP
+    WHILE komm anf <> 0 REP
+      komplettiere alle fuellenden sammler (von, komm anf - 1);
+      entschluessele kommando;
+      von := komm ende + 1;
+      setze kommando um
+    END REP;
+    IF alle sammler leer
+      THEN LEAVE verarbeite ggf index kommandos
+      ELSE fuelle sammler mit restzeile und lese naechste zeile
+    FI
+ UNTIL line no (eingabe file) = lines (eingabe file) END REP.
+
+setze kommando um:
+  SELECT kommando index OF
+  CASE ib0, ib1, ib2:
+    zeilen seit index begin := 0;
+    IF anz params = 0
+      THEN index nr := 1
+      ELSE index nr := int (par1)
+    FI;
+    index anfang;
+  CASE ie0, ie1, ie2:
+    IF anz params = 0
+      THEN index nr := 1
+      ELSE index nr := int (par1)
+    FI;
+    index ende;
+  OTHERWISE
+  END SELECT.
+
+index anfang:
+  IF gueltiger index
+    THEN fange neuen index an
+    ELSE fehler (18, par1)
+  FI.
+
+fange neuen index an:
+  IF sammler fuellend (index nr)
+    THEN fehler (20, text (index nr))
+  ELIF index ist inhaltsverzeichnis
+    THEN stelle einrueckung fest;
+         sammler [index nr] . index text := einrueckung;
+         einrueckung CAT "   ";
+         inhaltsverzeichnis offen := TRUE
+  ELIF index ist hauptindex
+    THEN sammler [index nr] . index text := einrueckung;
+    ELSE sammler [index nr] . index text := einrueckung;
+         sammler [index nr] . index text CAT text (index nr);
+         sammler [index nr] . index text CAT " --> "
+  FI;
+  sammler [index nr] . zustand := fuellend.
+
+stelle einrueckung fest:
+  einrueckung := "";
+  INT VAR punkt pos :: pos (zeile, ".");
+  WHILE punkt pos <> 0 REP
+    einrueckung CAT "   ";
+    punkt pos := pos (zeile, ".", punkt pos + 1)
+  END REP.
+
+index ende:
+  IF gueltiger index
+    THEN IF sammler fuellend (index nr)
+           THEN IF kommando index = ie2
+                  THEN sammler [index nr] . index text CAT par2;
+                FI;
+                leere sammler in outline datei (index nr)
+           ELSE fehler (21, text (index nr))
+          FI
+    ELSE fehler (18, text (index nr))
+  FI;
+  sammler [index nr] . zustand := leer.
+
+index ist inhaltsverzeichnis:
+  index nr = inhalt nr.
+
+index ist hauptindex:
+  index nr = 1.
+END PROC do outline;
+
+PROC leere sammler in outline datei (INT CONST nr):
+  IF index ist inhaltsverzeichnis
+    THEN line (ausgabe file);
+         putline (ausgabe file, sammler [nr] . index text);
+         inhaltsverzeichnis offen := FALSE;
+         leere zwischenspeicher
+  ELIF inhaltsverzeichnis offen
+    THEN fuelle zwischenspeicher
+    ELSE putline (ausgabe file, sammler [nr] . index text)
+  FI;
+  sammler [nr] . zustand := leer.
+
+index ist inhaltsverzeichnis:
+  nr = inhalt nr.
+
+leere zwischenspeicher:
+  INT VAR i;
+  FOR i FROM 1 UPTO anz zwischenspeicher REP
+    putline (ausgabe file, zwischenspeicher [i])
+  END REP;
+  anz zwischenspeicher := 0.
+
+fuelle zwischenspeicher:
+  anz zwischenspeicher INCR 1;
+  IF anz zwischenspeicher <= max indizes
+    THEN zwischenspeicher [anz zwischenspeicher] := sammler [nr] . index text
+  FI.
+END PROC leere sammler in outline datei;
+
+(********************* Utility Routinen *****************************)
+
+PROC ggf ueberschreibe anfrage (TEXT CONST d):
+  yrichtung INCR 1;
+  cursor (1, yrichtung);
+  IF exists (d)
+    THEN IF yes (d + " überschreiben")
+           THEN forget (d, quiet)
+           ELSE put ("wird angefügt")
+         FI
+  FI;
+  IF outline modus
+    THEN line
+    ELSE cursor (7, 3)
+  FI
+END PROC ggf ueberschreibe anfrage;
+
+BOOL PROC gueltiger index:
+  last conversion ok AND index nr > 0 AND index nr <= max indizes
+END PROC gueltiger index;
+
+PROC suche naechste zeile mit kommandozeichen:
+  TEXT VAR steuerzeichen :: incharety;
+  IF steuerzeichen = escape
+    THEN errorstop ("Abbruch durch ESC")
+  FI;
+  downety (eingabe file, "#", lines (eingabe file));
+  read record (eingabe file, zeile);
+  zeilen nr := line no (eingabe file);
+  cout (zeilen nr);
+END PROC suche naechste zeile mit kommandozeichen;
+
+PROC entschluessele kommando:
+  komm ende := pos (zeile, kommando zeichen, komm anf + 1);
+  IF komm ende <> 0 
+    THEN hole kommando text; 
+         TEXT CONST kommando anfangs zeichen :: kommando SUB 1;
+         IF pos ("-/"":*", kommando anfangs zeichen) = 0
+           THEN analysiere kommando
+         FI;
+         komm anf := pos (zeile, kommando zeichen, komm ende + 1);
+    ELSE fehler (2, ""); 
+         komm anf := 0;
+         LEAVE entschluessele kommando
+  END IF. 
+ 
+hole kommando text: 
+  kommando := subtext (zeile, komm anf + 1, komm ende - 1). 
+ 
+analysiere kommando:
+  kommando index := 0;
+  analyze command (kommando liste, kommando, 3,
+                   kommando index, anz params, par1, par2);
+  disable stop; 
+  command error; 
+  IF is error 
+    THEN dummy := error message;
+         clear error;
+         dummy CAT " -> ";
+         dummy CAT kommando;
+         fehler (22, dummy);
+         enable stop; 
+         komm anf := 0;
+         kommando index := 0;
+         LEAVE entschluessele kommando
+  END IF; 
+  enable stop
+END PROC entschluessele kommando;
+
+PROC fuelle sammler mit restzeile und lese naechste zeile:
+  restzeile auffuellen;
+  naechste zeile und zaehlen;
+  zeilen seit index begin INCR 1;
+  von := pos (zeile, ""33"", ""255"", 1);
+  komm anf := pos (zeile, kommando zeichen, von);
+  IF zeilen seit index begin > 10 (* !!Anzahl Zeilen!! *)
+    THEN index aufnahme stoppen;
+         fehler (17, "");
+         LEAVE fuelle sammler mit restzeile und lese naechste zeile
+  ELIF seitenbegrenzung
+    THEN index aufnahme stoppen;
+         fehler (7, "");
+  END IF.
+
+restzeile auffuellen:
+  IF silbentrennung
+    THEN IF durch silbentrennung gewandeltes k
+           THEN replace (zeile, length (zeile) - 1, "c")
+         FI;
+        komplettiere alle fuellenden sammler (von, length (zeile) - 1)
+  ELIF bindestrich
+    THEN komplettiere alle fuellenden sammler (von, length (zeile));
+    ELSE komplettiere alle fuellenden sammler (von, length (zeile));
+         zeile := " ";
+         komplettiere alle fuellenden sammler (1, 1)
+  END IF.
+ 
+silbentrennung: 
+  (zeile SUB length (zeile)) = trennzeichen. 
+ 
+durch silbentrennung gewandeltes k:
+  (zeile SUB length (zeile) - 1) = trenn k.
+
+bindestrich:
+  (zeile SUB length (zeile)) = minuszeichen AND
+      (zeile SUB length (zeile) - 1) <> blank. 
+END PROC fuelle sammler mit restzeile und lese naechste zeile;
+
+(**************************** index routine *************************) 
+ 
+PROC index: 
+  index (last param) 
+END PROC index; 
+ 
+PROC index (TEXT CONST eingabe datei): 
+  outline modus := FALSE;
+  last param (eingabe datei);
+  disable stop;
+  suche indizes (eingabe datei); 
+    IF is error 
+      THEN put error; 
+           clear error;
+    FI;
+  enable stop;
+  nachbehandlung. 
+ 
+nachbehandlung:
+  IF anything noted
+    THEN to line (eingabe file, erste fehler zeilennr);
+         note edit (eingabe file)
+    ELSE to line (eingabe file, 1)
+  FI;
+  line.
+END PROC index;
+ 
+(************************** eigentliche index routine *****************) 
+ 
+PROC suche indizes (TEXT CONST eingabe datei):
+  enable stop;
+  IF exists (eingabe datei)
+    THEN IF pos (eingabe datei, ".p") = 0 
+           THEN errorstop ("Datei ist keine Druckdatei") 
+         FI;
+         eingabe file := sequential file (modify, eingabe datei); 
+         datei name := eingabe datei;
+         erste fehler zeilennr := 0;
+         initialisiere bildschirm; 
+         deaktiviere sammler;
+         verarbeite datei;
+         sortiere die index dateien;
+    ELSE errorstop ("Datei existiert nicht") 
+  END IF. 
+ 
+initialisiere bildschirm: 
+  page;
+  put ("INDEX"); put ("(für"); put (lines (eingabe file)); put ("Zeilen):");
+  put (eingabe datei); 
+  cursor (1, 3);
+  out ("Zeile:      "); 
+  out ("Seite:"); 
+  y richtung := 4;
+  cursor (7, 3).
+ 
+verarbeite datei:
+  lese bis erste seitenbegrenzung;
+  WHILE NOT eof (eingabe file) REP
+     lese bis naechste seitenbegrenzung;
+     setze seiten nr;
+     gehe auf erste textzeile zurueck;
+     verarbeite indizes dieser seite
+  END REP.
+ 
+lese bis erste seitenbegrenzung: 
+  to line (eingabe file, 1); 
+  col (eingabe file, 1);
+  read record (eingabe file, zeile);
+  zeilen nr := 1;
+  cout (1);
+  REP
+     IF eof (eingabe file)
+       THEN errorstop ("Datei ist keine Druckdatei")
+     ELIF seitenbegrenzung
+       THEN LEAVE lese bis erste seitenbegrenzung
+       ELSE naechste zeile und zaehlen
+     END IF
+  END REP.
+ 
+lese bis naechste seitenbegrenzung:
+  IF line no (eingabe file) >= lines (eingabe file)
+    THEN LEAVE verarbeite datei
+    ELSE down (eingabe file)
+  FI;
+  INT VAR erste textzeile := line no (eingabe file);
+  down (eingabe file, "#page##----", lines (eingabe file));
+  IF pattern found
+    THEN read record (eingabe file, zeile)
+    ELSE LEAVE verarbeite datei
+  FI.
+
+gehe auf erste textzeile zurueck: 
+  to line (eingabe file, erste textzeile); 
+  read record (eingabe file, zeile);
+  zeilennr := lineno (eingabe file);
+  cout (zeilennr). 
+ 
+verarbeite indizes dieser seite: 
+  REP
+    suche naechste zeile mit kommandozeichen;
+    IF seitenbegrenzung 
+      THEN LEAVE verarbeite indizes dieser seite 
+    FI;
+    verarbeite index kommandos der naechsten zeilen;
+    IF seitenbegrenzung
+      THEN LEAVE verarbeite indizes dieser seite
+    FI;
+    down (eingabe file);
+    col (eingabe file, 1)
+  END REP.
+ 
+verarbeite index kommandos der naechsten zeilen:
+  komm anf := col (eingabe file);
+  von      := komm anf;
+  REP
+    WHILE komm anf <> 0 REP
+      komplettiere alle fuellenden sammler (von, komm anf - 1);
+      entschluessele kommando;
+      von := komm ende + 1;
+      setze kommando um
+    END REP;
+    IF alle sammler leer
+      THEN LEAVE verarbeite index kommandos der naechsten zeilen
+      ELSE fuelle sammler mit restzeile und lese naechste zeile
+    END IF
+  UNTIL seitenbegrenzung ENDREP;
+  fehler (7, "").
+ 
+setze kommando um: 
+SELECT kommando index OF 
+CASE ib0, ib1, ib2: 
+  zeilen seit index begin := 0;
+  IF anz params = 0
+    THEN index nr := 1
+    ELSE index nr := int (par1)
+  FI;
+  index anfang;
+CASE ie0, ie1, ie2:
+  IF anz params = 0
+    THEN index nr := 1
+    ELSE index nr := int (par1)
+  FI;
+  index ende;
+OTHERWISE
+ENDSELECT. 
+
+index anfang: 
+  IF gueltiger index
+    THEN fange neuen index an
+    ELSE fehler (18, par1)
+  END IF.
+ 
+fange neuen index an: 
+  IF sammler fuellend (index nr) 
+    THEN fehler (20, text (index nr))
+    ELSE fuelle sammler mit (index nr, ""); 
+         IF anz params = 2 
+           THEN zusatz an seitennummer (index nr, par2) 
+           ELSE zusatz an seitennummer (index nr, "") 
+         END IF
+  END IF.
+ 
+index ende: 
+  IF gueltiger index
+    THEN schreibe fuellenden sammler
+    ELSE fehler (18, text (index nr))
+  END IF.
+ 
+schreibe fuellenden sammler: 
+  IF sammler fuellend (index nr) 
+    THEN IF anz params = 2 
+           THEN fuelle sammler mit (index nr, par2) 
+         ENDIF;
+         schreibe sammler (index nr); 
+    ELSE fehler (21, text (index nr))
+  END IF.
+END PROC suche indizes; 
+ 
+(********************* Service Routinen ************************) 
+ 
+BOOL PROC seitenbegrenzung: 
+ subtext (zeile, 2, 5) = "page" AND subtext (zeile, 8, 12) = "-----"
+END PROC seitenbegrenzung;
+ 
+PROC setze seiten nr:
+  seiten nr := int (subtext (zeile, ziffern anfang, ziffernende));
+  cursor (20, 3);
+  put (seiten nr);
+  cursor (7, 3).
+ 
+ziffern anfang:
+  pos (zeile, "0", "9", 10).
+ 
+ziffern ende:
+  pos (zeile, " ", ziffern anfang) - 1
+END PROC setze seiten nr;
+ 
+PROC naechste zeile und zaehlen:
+  zeilen nr INCR 1;
+  cout (zeilen nr);
+  naechste zeile
+END PROC naechste zeile und zaehlen;
+ 
+PROC naechste zeile:
+  down (eingabe file);
+  read record (eingabe file, zeile);
+  col (eingabe file, 1)
+END PROC naechste zeile; 
+ 
+(**************************** Fehler - Routine *********************) 
+ 
+PROC fehler (INT CONST nr, TEXT CONST addition):
+  IF erste fehler zeilennr = 0
+    THEN erste fehler zeilennr := zeilen nr
+  FI;
+  yrichtung INCR 1; 
+  IF yrichtung > 23
+    THEN yrichtung := 23;
+  FI;
+  cursor (1, yrichtung); 
+  fehler melden;
+  fehlermeldung auf terminal ausgeben;
+  IF outline modus
+    THEN line
+    ELSE cursor (7, 3)
+  FI.
+ 
+fehler melden:
+  report text processing error (nr, zeilen nr, fehlerdummy, addition).
+ 
+fehlermeldung auf terminal ausgeben: 
+  out (fehlerdummy); 
+END PROC fehler;
+ 
+PROC warnung (INT CONST nr, TEXT CONST addition):
+  IF erste fehler zeilennr = 0
+    THEN erste fehler zeilennr := zeilen nr
+  FI;
+  yrichtung INCR 1; 
+  IF yrichtung > 23 
+    THEN yrichtung := 23;
+  FI;
+  cursor (1, yrichtung); 
+  fehler melden;
+  meldung auf terminal ausgeben;
+  IF outline modus
+    THEN line
+    ELSE cursor (7, 3)
+  FI.
+ 
+fehler melden:
+  report text processing warning (nr, zeilen nr, fehlerdummy, addition).
+ 
+meldung auf terminal ausgeben: 
+  out (fehlerdummy); 
+END PROC warnung;
+ 
+(************************** Sammler-Dienste **************************)
+ 
+PROC index aufnahme stoppen:
+  zeile := "INDEX FEHLER";
+  komplettiere alle fuellenden sammler (1, length (zeile));
+  schreibe alle sammler;
+  read record (eingabe file, zeile)
+END PROC index aufnahme stoppen;
+ 
+PROC deaktiviere sammler:
+  INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    sammler [i] . zustand := nicht angekoppelt 
+  END REP 
+END PROC deaktiviere sammler; 
+ 
+BOOL PROC sammler fuellend (INT CONST nr): 
+  sammler [nr] . zustand = fuellend 
+END PROC sammler fuellend; 
+ 
+BOOL PROC sammler angekoppelt (INT CONST nr): 
+  NOT (sammler [nr] . zustand = nicht angekoppelt)
+END PROC sammler angekoppelt; 
+ 
+BOOL PROC alle sammler leer: 
+  INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    IF sammler [i] . zustand = fuellend
+      THEN LEAVE alle sammler leer WITH FALSE 
+    END IF 
+  END REP; 
+  TRUE 
+END PROC alle sammler leer; 
+ 
+PROC komplettiere alle fuellenden sammler (INT CONST von pos, bis pos): 
+  INT VAR i; 
+  IF von pos > bis pos
+    THEN LEAVE komplettiere alle fuellenden sammler
+  FI;
+  dummy := subtext (zeile, von pos, bis pos);
+  FOR i FROM 1 UPTO max indizes REP 
+    IF sammler [i] . zustand = fuellend
+      THEN sammler [i] . index text CAT dummy;
+    FI 
+  END REP;
+END PROC komplettiere alle fuellenden sammler; 
+ 
+PROC fuelle sammler mit (INT CONST nr, TEXT CONST dazu):
+  IF sammler [nr] . zustand = nicht angekoppelt
+    THEN ankoppeln;
+         sammler [nr] . index text := dazu
+  ELIF sammler [nr] . zustand = leer
+    THEN sammler [nr] . index text := dazu
+  ELIF sammler fuellend (nr)
+    THEN sammler [nr] . index text CAT dazu 
+  END IF;
+  sammler [nr] . zustand := fuellend.
+ 
+ankoppeln:
+  yrichtung INCR 1;
+  cursor (1, yrichtung);
+  put ("Indizes");
+  put (nr);
+  put ("gehen in Datei:");
+  dummy := datei name;
+  IF subtext (dummy, length (dummy) - 1) = ".p" 
+    THEN replace (dummy, length (dummy) - 1, ".i") 
+    ELSE dummy CAT ".i"; 
+  END IF;
+  dummy CAT text (nr); 
+  out (dummy);
+  ggf ueberschreibe anfrage (dummy);
+  f [nr] := sequential file (output, dummy);
+  copy attributes (eingabe file, f[nr]);
+  cursor (7, 3)
+END PROC fuelle sammler mit;
+ 
+PROC zusatz an seitennummer (INT CONST nr, TEXT CONST zus text): 
+  sammler [nr] . seitennummer zusatz := zus text 
+END PROC zusatz an seitennummer; 
+ 
+PROC schreibe sammler (INT CONST nr):
+  entferne leading blanks;
+  IF outline modus
+    THEN leere sammler in outline datei (nr)
+    ELSE fuege punkte an;
+         fuege seiten nr an;
+         fuege zusatz an seitennummer an;
+         fuege absatzzeichen an;
+         leere sammler
+  FI.
+
+entferne leading blanks: 
+  WHILE (aufgesammelter text SUB 1) = blank REP 
+    delete char (aufgesammelter text, 1) 
+  END REP. 
+ 
+fuege punkte an: 
+  aufgesammelter text CAT trenner;
+  IF length (aufgesammelter text) < punkt grenze 
+    THEN dummy := (punkt grenze - length (aufgesammelter text)) * ".";
+         aufgesammelter text CAT dummy
+  END IF; 
+  aufgesammelter text CAT "  ".
+ 
+fuege seiten nr an:
+  aufgesammelter text CAT text (seiten nr).
+ 
+fuege zusatz an seitennummer an: 
+  aufgesammelter text CAT sammler [nr]. seitennummer zusatz. 
+ 
+fuege absatzzeichen an: 
+  aufgesammelter text CAT blank.
+ 
+leere sammler: 
+  putline (f [nr], aufgesammelter text);
+  sammler [nr] . zustand := leer.
+ 
+aufgesammelter text: 
+  sammler [nr] . index text
+END PROC schreibe sammler; 
+ 
+PROC schreibe alle sammler: 
+  INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    IF sammler fuellend (i) 
+      THEN schreibe sammler (i) 
+    END IF 
+  END REP 
+END PROC schreibe alle sammler;
+ 
+(**************** Sortieren und Indizes zusammenfuehren ***************) 
+ 
+PROC sortiere die index dateien: 
+INT VAR i; 
+  FOR i FROM 1 UPTO max indizes REP 
+    IF index datei erstellt 
+      THEN sortiere diese datei
+    END IF 
+  END REP. 
+ 
+index datei erstellt: 
+  sammler angekoppelt (i). 
+ 
+sortiere diese datei:
+  y richtung INCR 1; 
+  cursor (1, yrichtung);
+  dummy := datei name; 
+  IF subtext (dummy, length (dummy) - 1) = ".p" 
+    THEN replace (dummy, length (dummy) - 1, ".i") 
+    ELSE dummy CAT ".i"; 
+  END IF;
+  dummy CAT text (i);
+  put (dummy);
+  IF yes ("sortieren") 
+    THEN lex sort (dummy);
+         eintraege zusammenziehen (dummy)
+  END IF;
+END PROC sortiere die index dateien; 
+ 
+PROC eintraege zusammenziehen (TEXT CONST fname):
+  FILE VAR sorted file :: sequential file (modify, fname);
+  INT VAR i :: 1;
+  to line (sorted file, 1);
+  read record (sorted file, akt zeile);
+  akt index := subtext (akt zeile, 1, pos (akt zeile, trenner) - 1);
+  down (sorted file);
+  WHILE NOT eof (sorted file) REP
+    read record (sorted file, zweite zeile);
+    zweiter index := subtext (zweitezeile, 1, pos (zweitezeile, trenner)-1);
+    i INCR 1;
+    cout (i);
+    IF akt index LEXEQUAL zweiter index
+      THEN fuege seitennummern von zweite in akt zeile ein
+      ELSE akt zeile := zweite zeile;
+           akt index := zweiter index
+    FI;
+    down (sorted file)
+  END REP;
+  to line (sorted file, 1).
+
+fuege seitennummern von zweite in akt zeile ein:
+  hole seitennummer der zweiten zeile;
+  fuege in akt zeile ein;
+  delete record (sorted file);
+  up (sorted file);
+  write record (sorted file, akt zeile).
+
+hole seitennummer der zweiten zeile:
+  INT VAR von := pos (zweite zeile, ziffernanfang) + length (ziffernanfang),
+          bis := von;
+  WHILE pos (ziffern, zweite zeile SUB bis) <> 0 REP
+    bis INCR 1
+  END REP;
+  bis DECR 1;
+  INT VAR zweite nummer := int( subtext (zweite zeile, von, bis));
+  TEXT VAR zweiter nummern text :=
+                    subtext (zweite zeile, von, length (zweite zeile) - 1).
+
+fuege in akt zeile ein:
+  suche einfuege position in akt zeile;
+  fuege ein.
+
+suche einfuege position in akt zeile:
+  INT VAR einfuege pos :=
+                    pos (akt zeile, ziffernanfang) + length (ziffernanfang);
+  von := einfuege pos;
+  REP
+    hole neue nummer;
+  UNTIL am ende der zeile END REP.
+
+am ende der zeile:
+  von >= length (akt zeile).
+
+hole neue nummer:
+  bis := von;
+  WHILE pos (ziffern, akt zeile SUB bis) <> 0 REP
+    bis INCR 1
+  END REP;
+  bis DECR 1;
+  IF bis < von
+    THEN bis := von
+  FI;
+  INT VAR neue nummer := int (subtext (akt zeile, von, bis));
+  IF zweite nummer = neue nummer
+    THEN fuege ggf zweiten nummern text mit textanhang ein
+  ELIF zweite nummer > neue nummer
+    THEN einfuege pos := von;
+         von := pos (akt zeile, ", ", bis) + 2;
+         IF von <= 2
+           THEN von := length (akt zeile)
+         FI
+    ELSE einfuege pos := von;
+         LEAVE suche einfuege position in akt zeile
+  FI.
+
+fuege ggf zweiten nummern text mit textanhang ein:
+  bis := pos (akt zeile, ", ", von);
+  IF bis <= 0
+    THEN bis := length (akt zeile);
+  FI;
+  IF die beiden nummern sind mit textanhang gleich
+    THEN LEAVE fuege in akt zeile ein
+    ELSE einfuege pos := von;
+         LEAVE suche einfuege position in akt zeile
+  FI.
+
+die beiden nummern sind mit textanhang gleich:
+  zweiter nummern text = subtext (akt zeile, von, bis - 1).
+
+fuege ein:
+  IF am ende der zeile
+    THEN change (akt zeile, length (akt zeile), length (akt zeile), ", ");
+         akt zeile CAT (zweiter nummern text + " ")
+    ELSE zweiter nummern text CAT ", ";
+         change
+          (akt zeile, einfuege pos, einfuege pos -1, zweiter nummern text);
+  FI.
+END PROC eintraege zusammenziehen;
+
+(*********************** merge routine *********************) 
+ 
+PROC index merge (TEXT CONST i1, i2):
+  disable stop;
+    indizes zusammenziehen (i1, i2);
+    IF is error
+      THEN put error; 
+           clear error;
+      ELSE last param (i2)
+    FI;
+  enable stop;
+  line.
+END PROC index merge; 
+ 
+PROC indizes zusammenziehen (TEXT CONST i1, i2): 
+  enable stop; 
+  ueberschrift schreiben;
+  dateien assoziieren; 
+  i1 vor i2 einfuegen;
+  sortieren; 
+  forget (i1).
+ 
+dateien assoziieren: 
+  IF exists (i1) 
+    THEN eingabe file := sequential file (modify, i1) 
+    ELSE errorstop (i1 + "existiert nicht")
+  END IF; 
+  IF exists (i2) 
+    THEN f[2] := sequential file (modify, i2) 
+    ELSE errorstop (i2 + "existiert nicht") 
+  END IF.
+
+ueberschrift schreiben: 
+  page; 
+  put ("INDEX MERGE:"); put (i1); put ("-->"); put (i2);
+  cursor (1, 3); 
+  yrichtung := 3.
+ 
+i1 vor i2 einfuegen:
+  to first record (eingabe file); 
+  to first record (f [2]);
+  zeilen nr := 0; 
+  WHILE NOT eof (eingabe file) REP
+    zeilennr INCR 1; 
+    cout (zeilennr);
+    read record (eingabe file, zeile);
+    insert record (f [2]);
+    write record (f[2], zeile);
+    down (f[2]);
+    down (eingabe file);
+  END REP.
+
+sortieren: 
+  y richtung INCR 1; 
+  cursor (1, yrichtung);
+  put (i2); 
+  IF yes ("sortieren") 
+    THEN lex sort (i2);
+         eintraege zusammenziehen (i2)
+  END IF
+END PROC indizes zusammenziehen;
+END PACKET index program;
+
+PACKET columns DEFINES col put, col get, col lineform, col autoform:
+ 
+INT VAR ende pos,
+        anfangs pos;
+ 
+FILE VAR file, spaltenfile; 
+ 
+TEXT VAR dummy, 
+         spalte, 
+         zeile; 
+ 
+LET geschuetztes blank = ""223"",
+    blank              = " ";
+
+BOOL VAR spalte loeschen;
+
+DATASPACE VAR local space := nilspace;
+
+PROC col lineform:
+  spalte loeschen := TRUE;
+  columns put;
+  file := sequential file (modify, local space);
+  lineform (spaltenfile);
+  col get
+END PROC col lineform;
+
+PROC col autoform:
+  spalte loeschen := TRUE;
+  columns put;
+  file := sequential file (modify, local space);
+  autoform (spaltenfile);
+  col get
+END PROC col autoform;
+
+PROC col put:
+  spalte loeschen := yes ("Spalte löschen");
+  columns put
+END PROC col put;
+
+PROC columns put:
+  IF aktueller editor > 0 AND mark 
+    THEN editor bereich bearbeiten 
+    ELSE errorstop ("col put arbeitet nur auf markierten Bereich im Editor") 
+  FI. 
+ 
+editor bereich bearbeiten: 
+    file := editfile; 
+    anfangs pos einholen;
+    ende pos einholen;
+    INT VAR letzte zeile := line no (file),
+            erste zeile  := mark line no (file);
+    to line (file, erste zeile);
+    col (file, 1);
+    spalten put;
+    to line (file, erste zeile);
+    col (file, anfangs pos);
+    mark (false);
+    ueberschrift neu.
+
+anfangs pos einholen:
+  anfangs pos := mark col (file).
+
+ende pos einholen:
+  ende pos := col (file) - 1;
+  IF ende pos < anfangs pos
+    THEN errorstop ("Markierungsende muß rechts vom -anfang sein")
+  FI.
+
+spalten put:
+  spaltendatei einrichten;
+  satznr neu;
+  WHILE line no (file) <= letzte zeile REP
+    satznr zeigen;
+    read record (file, zeile);
+    spalte herausholen;
+    spalte schreiben;
+    down (file)
+  END REP.
+
+spaltendatei einrichten:
+  forget (local space);
+  local space := nilspace;
+  spaltenfile := sequential file (output, local space).
+
+spalte herausholen:
+  spalte := subtext (zeile, anfangs pos, ende pos);
+  IF spalte loeschen
+    THEN change (zeile, anfangs pos, ende pos, "");
+         write record (file, zeile)
+  FI;
+  WHILE length (spalte) > 1 AND (spalte SUB length (spalte)) = blank REP
+    delete char (spalte, length (spalte))
+  END REP;
+  IF spaltenende ist geschuetztes blank
+    THEN delete char (spalte, length (spalte));
+         spalte CAT " "
+  FI.
+
+spalte schreiben:
+  putline (spaltenfile, spalte).
+
+spaltenende ist geschuetztes blank:
+  (spalte SUB length (spalte)) = geschuetztes blank.
+END PROC columns put;
+
+PROC col get:
+  IF aktueller editor > 0
+    THEN editor bereich bearbeiten
+    ELSE errorstop ("col put kann nur im Editor aufgerufen werden")
+  FI;
+  columns get;
+  alles neu.
+
+editor bereich bearbeiten:
+  file := editfile; 
+  spaltenfile := sequential file (input, local space).
+
+columns get:
+  anfangs pos := col (file) - 1;
+  spaltenbreite feststellen;
+  col (file, 1);
+  satznr neu;
+  WHILE NOT eof (spaltenfile) REP
+    satznr zeigen;
+    getline (spaltenfile, spalte);
+    read record (file, zeile);
+    spalte ggf verbreitern;
+    zeile ggf verbreitern;
+    spalte in zeile einfuegen;
+    zeile schreiben;
+    down (file);
+    IF eof (file)
+      THEN errorstop ("Spalte hat zu viele Zeilen für die Datei")
+    FI
+  END REP.
+
+zeile ggf verbreitern:
+  WHILE length (zeile) < anfangs pos REP
+    zeile CAT blank
+  END REP.
+
+spaltenbreite feststellen:
+  INT VAR anz spaltenzeichen :: 0;
+  WHILE NOT eof (spaltenfile) REP
+    getline (spaltenfile, spalte);
+    IF length (spalte) > anz spaltenzeichen
+      THEN anz spaltenzeichen := length (spalte)
+    FI
+  END REP;
+  spaltenfile := sequential file (input, local space).
+
+spalte ggf verbreitern:
+  IF (spalte SUB length (spalte)) = blank
+    THEN delete char (spalte, length (spalte));
+         spalte CAT geschuetztes blank
+  FI;
+  IF anzufuegende spalte soll nicht ans zeilenende
+    THEN spalte verbreitern
+  FI.
+
+anzufuegende spalte soll nicht ans zeilenende:
+  anfangs pos <= length (zeile).
+
+spalte verbreitern:
+  WHILE length (spalte) < anz spaltenzeichen REP
+    spalte CAT blank
+  END REP.
+
+spalte in zeile einfuegen:
+  dummy := subtext (zeile, 1, anfangs pos);
+  dummy CAT spalte;
+  dummy CAT subtext (zeile, anfangs pos + 1);
+  zeile := dummy.
+
+zeile schreiben:
+  write record (file, zeile).
+END PROC col get;
+END PACKET columns;
+
diff --git a/system/multiuser/1.7.5/src/konfigurieren b/system/multiuser/1.7.5/src/konfigurieren
new file mode 100644
index 0000000..016fef2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/konfigurieren
@@ -0,0 +1,254 @@
+(* ------------------- VERSION 4     22.04.86 ------------------- *)
+PACKET konfigurieren DEFINES                (* Autor: D.Heinrichs *)
+
+
+
+    ansi cursor,
+    baudrate ,
+    bits ,
+    cursor logic , 
+    elbit cursor , 
+    enter incode , 
+    enter outcode , 
+    flow , 
+    input buffer size , 
+    link ,
+    new configuration ,
+    new type , 
+    ysize :
+
+LET max dtype nr = 5,  (* maximum number of active device tables *)
+    device table = 32000,
+    ack = 0 ;
+
+ 
+INT VAR next outstring,
+        next instring; 
+ 
+BOUND STRUCT (ALIGN space,                       (* umsetzcodetabelle *)
+              ROW 128 INT outcodes,
+              ROW  64 INT outstrings,
+              ROW  64 INT instrings) VAR x;
+
+
+ROW max dtype nr DATASPACE VAR device code table;
+
+THESAURUS VAR dtypes ;
+
+ 
+PROC new configuration :
+
+  dtypes := empty thesaurus ;
+  INT VAR i ;
+  insert (dtypes, "psi", i) ;
+  insert (dtypes, "transparent", i) ;
+  FOR i FROM 1 UPTO max dtype nr REP
+    forget (device code table (i))
+  PER .
+
+ENDPROC new configuration ;
+
+ 
+PROC block out (DATASPACE CONST ds, INT CONST page, code): 
+  INT VAR err; 
+  block out (ds,page,0,code,err);
+  announce error (err)
+END PROC block out; 
+ 
+PROC announce error (INT CONST err):
+  SELECT err OF 
+  CASE 0:
+  CASE 1: errorstop ("unbekanntes Terminalkommando")
+  CASE 2: errorstop ("Nummer der Terminal-Typ-Tabelle falsch")
+  CASE 3: errorstop ("falsche Terminalnummer") 
+  OTHERWISE errorstop ("blockout: unzulaessiger Kanal")
+  ENDSELECT
+END PROC announce error;
+ 
+PROC flow (INT CONST nr, INT CONST dtype):
+  control (6, dtype, nr)
+END PROC flow;
+
+PROC ysize (INT CONST channel ,new size, INT VAR old size) :
+  control (11, channel, new size, old size)
+ENDPROC ysize ;
+
+PROC input buffer size (INT CONST nr,size):
+  INT VAR err;
+  control (2,nr,size,err)
+END PROC input buffer size;
+
+PROC baudrate (INT CONST nr, rate) :
+  control (8, rate, nr)
+ENDPROC baudrate ;
+
+PROC bits (INT CONST channel, number, parity) :
+  bits (channel, number-1 + 8*parity)
+ENDPROC bits ;
+
+PROC bits (INT CONST channel, key) :
+  control (9, key, channel)
+ENDPROC bits ;
+
+PROC control (INT CONST function, key, channel) :
+
+  INT VAR err ;
+  IF key > -128 AND key < 127
+    THEN control (function, channel, key, err)
+  ELIF key = -128
+    THEN control (function, channel, -maxint-1, err)
+  FI
+
+ENDPROC control ;
+
+
+PROC new type (TEXT CONST dtype):
+  x := new (dtype);
+  type (old (dtype), device table);
+  next outstring := 4;
+  next instring := 0;
+  INT VAR i;
+  (* Defaults, damit trmpret den cursor mitfuehrt: *)
+    FOR i FROM 1 UPTO 6 REP
+    enter outcode (i,i)
+    PER;
+    enter outcode (8,8); 
+    enter outcode (10,10);
+    enter outcode (13,13);
+    enter outcode (14,126); 
+    enter outcode (15,126);
+END PROC new type;
+
+INT PROC activate dtype (TEXT CONST dtype): 
+ 
+ INT VAR i := link (dtypes, dtype);
+ IF (exists (dtype) CAND type (old (dtype)) = device table) 
+    THEN IF i <= 0
+            THEN insert (dtypes, dtype, i);
+         FI;
+         forget(device code table (i-2));
+         device code table (i-2) := old (dtype)
+ FI;
+ IF i > max dtype nr +2  (* 5 neue Typen erlaubt *) 
+    THEN delete (dtypes,i);
+         error stop ("Anzahl Terminaltypen > "+text (i));0 
+    ELIF i <= 0
+         THEN error stop ("Unbekannter Terminaltyp" + dtype); 0
+    ELSE i
+ FI. 
+
+END PROC activate dtype; 
+
+PROC link (INT CONST nr, TEXT CONST dtype): 
+ 
+  INT VAR lst nr := activate dtype (dtype)-3;
+  IF lst nr < 0
+     THEN lst nr INCR 256  (* fuer std terminal und std device *)
+     ELSE blockout (device code table(lst nr+1), 2, lst nr); 
+  FI; 
+  INT VAR err := 0;
+  control (1,nr,lst nr,err) ;
+  announce error(err)
+
+END PROC link;
+ 
+
+PROC enter outcode (INT CONST eumel code, ziel code):
+
+  IF ziel code < 128
+    THEN simple entry (eumel code, ziel code)
+    ELSE enter outcode (eumel code, 0, code (ziel code))
+  FI .
+
+ENDPROC enter outcode ;
+
+PROC simple entry (INT CONST eumel code, ziel code) :
+
+  INT CONST position := eumel code DIV 2 +1, 
+            teil := eumel code - 2*position + 2;
+  TEXT VAR h :="     ";
+  replace (h,1,out word);
+  replace (h,1+teil,code (ziel code));
+  out word := (h ISUB 1).
+
+  out word: x.outcodes (position).
+
+END PROC simple entry ;
+
+PROC enter outcode (INT CONST eumel code, wartezeit,
+                    TEXT CONST sequenz):
+
+     INT VAR i;
+     simple entry (eumel code, next outstring + 128);
+     enter part (x.outstrings, next outstring, wartezeit); 
+     FOR i FROM 1 UPTO length (sequenz) REP
+       enter part (x.outstrings, next outstring + i, code (sequenzSUBi))
+     PER;
+     next outstring INCR length (sequenz)+2;
+     abschluss. 
+ 
+     abschluss:
+     enter part (x.outstrings, next outstring-1, 0)
+END PROC enter outcode;
+
+PROC enter outcode (INT CONST eumelcode, TEXT CONST wert):
+  enter outcode (eumelcode,code(wert))
+END PROC enter outcode;
+
+PROC enter part (ROW 64 INT VAR a,INT CONST index, wert):
+  INT CONST position := index DIV 2 +1, 
+            teil := index - 2*position + 2;
+  IF position > 64 THEN errorstop ("Ueberlauf der Terminaltyptabelle") FI;
+  TEXT VAR h :="     ";
+  replace (h,1,out word);
+  replace (h,1+teil,code (wert));
+  out word := (h ISUB 1).
+
+  out word: a (position).
+END PROC enter part;
+
+
+PROC enter incode (INT CONST elan code, TEXT CONST sequenz):
+     IF elan code > 254 OR elan code < 0 THEN errorstop ("kein Eingabecode")
+     ELSE
+     INT VAR i;
+     enter part (x.instrings, next instring, elan code); 
+     FOR i FROM 1 UPTO length (sequenz) REP
+       enter part (x.instrings, next instring + i, code (sequenzSUBi))
+     PER;
+     next instring INCR length (sequenz)+2;
+
+     FI
+
+END PROC enter incode;
+
+PROC cursor logic (INT CONST dist, TEXT CONST pre, mid, post):
+
+     cursor logic (dist,255,pre,mid,post)
+
+END PROC cursor logic;
+
+PROC ansi cursor (TEXT CONST pre, mid, post):
+ 
+     cursor logic (0, 1, pre, mid, post)
+
+END PROC ansi cursor;
+
+PROC cursor logic (INT CONST dist, modus, TEXT CONST pre, mid, post):
+
+     enter part (x.outstrings,2,dist);
+     enter part (x.outstrings,3,dist);
+     enter part (x.outstrings,0,modus);
+     enter part (x.outstrings,1,modus);
+     enter outcode (6,0,pre+""0"y"+mid+""0"x"+post+""0"")
+
+END PROC cursor logic;
+
+PROC elbit cursor: 
+     cursor logic (0,""27"","",""); 
+     enter part (x.outstrings,0,2);
+     enter part (x.outstrings,1,255);
+END PROC elbit cursor;
+
+ENDPACKET konfigurieren;
+
diff --git a/system/multiuser/1.7.5/src/liner b/system/multiuser/1.7.5/src/liner
new file mode 100644
index 0000000..bc1f41d
--- /dev/null
+++ b/system/multiuser/1.7.5/src/liner
@@ -0,0 +1,3079 @@
+(* ------------------- VERSION 406 vom 28.05.86 ----(1.7.5)------------- *)
+PACKET liner DEFINES line form,
+                     autoform,
+                     hyphenation width,
+                     additional commands:
+
+(* Programm zur Zeilenformatierung mit unterschiedlichen Schriftypen
+   Autor: Rainer Hahn
+   Stand: 1.7.1 Febr. 1984
+          1.7.3 Juli  1984
+          1.7.4 Juni  1985 
+          1.7.5 ab Okt. 1985 
+ *)
+
+(********************* form deklarationen ********************)
+
+TEXT VAR zeichen,
+         aufzaehlungszeichen,
+         par 1,
+         par 2,
+         kommando,
+         command store,
+         zielreferenzen,
+         herkunftsreferenzen,
+         aktuelle referenz,
+         alter schriftname, 
+         dummy,
+         fehlerdummy,
+         footdummy,
+         scan symbol,
+         font table name :: "",
+         trennwort,
+         trennwort ohne komm,
+         wort1,
+         wort1 ohne komm,
+         wort2,
+         font nr speicher,
+         modifikations speicher,
+         mod zeilennr speicher,
+         index speicher,
+         ind zeilennr speicher,
+         counter numbering store,
+         counter reference store,
+         trennsymbol,
+         puffer,
+         neue zeile,
+         zeile,
+         einrueckung zweite zeile,
+         aktuelle blanks,
+         alte blanks,
+         zusaetzliche commands :: "",
+         kommando liste;
+
+INT CONST rueckwaerts :: -1,
+          esc char ohne zweites byte ausgang :: - maxint - 1;
+
+INT VAR anz tabs,
+        mitzuzaehlende zeichen,
+        anz blanks freihalten,
+        kommando index,
+        scan type,
+        font nr :: 1,
+        blankbreite fuer diesen schrifttyp,
+        aktuelle     pitch zeilenlaenge,
+        eingestellte indentation pitch,
+        einrueckbreite,
+        zeilenbreite,
+        trennbreite in prozent :: 7,
+        trennbreite,
+        max trennlaenge,
+        max trenn laenge ohne komm,
+        zeichenwert ausgang,
+        formelbreite,
+        formelanfang,
+        zeilennr,
+        wortanfang,
+        wortende,
+        erste fehler zeilennr,
+        macro kommando ende,
+        von,
+        pufferlaenge,
+        zeichenpos,
+        zeichenpos bereits verarbeitet;
+
+BOOL VAR ask type and limit,
+         format file in situ,
+         lineform mode,
+         macro works,
+         kommandos speichern,
+         letzter puffer war absatz,
+         in d und e verarbeitung,
+         in tabelle,
+         in foot uebertrag,
+         in foot;
+
+LET hop          = ""1"",
+    rechts       = ""2"",
+    cl eol       = ""5"",
+    links        = ""8"",
+    return       = ""13"",
+    begin mark   = ""15"",
+    end mark     = ""14"",
+    escape       = ""27"",
+    trennzeichen = ""221"",
+    trenn k      = ""220"",
+    blank        = " ",
+    bindestrich  = "-",
+    buchstaben   =
+               "abcdefghijklmnopqrstuvwxyzüäößABCDEFGHIJKLMNOPQRSTUVWXYZÄÜö",
+    kommando zeichen = "#",
+    max tabs              = 30,
+    extended char ausgang = 32767,
+    blank      ausgang    = 32766,
+    kommando   ausgang    = 32765,
+    such       ausgang    = 32764,
+    zeilenende ausgang    = 0,
+    vorwaerts          = 1,
+    type1        = 1,
+    linefeed     = 3,
+    limit        = 4,
+    free         = 5,
+    page command0= 6,
+    page command1= 7,
+    on           = 8,
+    off          = 9,
+    page nr      = 10,
+    pagelength   = 11,
+    start        = 12,
+    foot         = 13,
+    end          = 14,
+    head         = 15,
+    headeven     = 16,
+    headodd      = 17,
+    bottom       = 18,
+    bottomeven   = 19,
+    bottomodd    = 20,
+    block        = 21,
+    material     = 22,
+    columns      = 23,
+    columnsend   = 24,
+    ib0          = 25,
+    ib1          = 26,
+    ib2          = 27,
+    ie0          = 28,
+    ie1          = 29,
+    ie2          = 30,
+    topage       = 31,
+    goalpage     = 32,
+    count0       = 33,
+    count1       = 34,
+    setcount     = 35,
+    value0       = 36,
+    value1       = 37,
+    table        = 38,
+    table end    = 39,
+    r pos        = 40,
+    l pos        = 41,
+    c pos        = 42,
+    d pos        = 43,
+    b pos        = 44,
+    clear pos0   = 45,
+    clear pos1   = 46,
+    right        = 47,
+    center       = 48,
+    skip         = 49,
+    skip end     = 50,
+    u command    = 51,
+    d command    = 52,
+    e command    = 53,
+    head on      = 54,
+    head off     = 55,
+    bottom on    = 56,
+    bottom off   = 57,
+    count per page=58,
+    fillchar     = 59,
+    mark command = 60,
+    mark end     = 61,
+    pageblock    = 62,
+    bsp          = 63,
+    counter1     = 64,
+    counter2     = 65,
+    setcounter   = 66,
+    putcounter0  = 67,
+    putcounter1  = 68,
+    storecounter = 69,
+    ub           = 70,
+    ue           = 71,
+    fb           = 72,
+    fe           = 73;
+
+REAL VAR limit in cm :: 16.0,
+         fehler wert :: -1.0;
+
+FILE VAR eingabe,
+         ausgabe,
+         file;
+
+FRANGE VAR alter bereich; 
+ 
+DATASPACE VAR ds;
+
+ROW 256 INT VAR pitch table;
+ROW max tabs TEXT VAR tab zeichen;
+ROW max tabs ROW 3 INT VAR tabs;
+(* 1. Eintrag: Position
+   2. Eintrag: Art
+   3. Eintrag: Bis-Position
+*)
+ 
+(************************** liner state-Routinen **********************)
+
+TYPE LINERSTATE =
+  STRUCT (INT position, from,
+          BOOL in macro,
+          TEXT buffer line, next line,
+               old blanks, actual blanks,
+               new line);
+
+LINERSTATE VAR before macro state,
+               before foot state;
+
+PROC get liner state (LINERSTATE VAR l):
+  l . position    := zeichenpos;
+  l . from        := von;
+  l . in macro    := macro works;
+  l . buffer line := puffer;
+  l . next line   := zeile;
+  l . old blanks  := alte blanks;
+  l . actualblanks:= aktuelle blanks;
+  l . new line    := neue zeile;
+END PROC get liner state;
+
+PROC put liner state (LINERSTATE CONST l):
+  zeichenpos          := l . position;
+  von                 := l . from;
+  macro works         := l . in macro;
+  puffer              := l . buffer line ;
+  zeile               := l . next line ;
+  alte blanks         := l . old blanks;
+  aktuelle blanks     := l . actual blanks;
+  neue zeile          := l . new line ;
+  pufferlaenge := length (puffer);
+END PROC put liner state;
+
+(*********************** Utility Routinen **************************)
+
+PROC delete int (TEXT VAR resultat, INT CONST delete pos) :
+    change  (resultat, delete pos * 2 - 1, delete pos * 2, "")
+END PROC delete int; 
+
+OP CAT (TEXT VAR resultat, INT CONST zahl) :
+    resultat CAT "  ";
+    replace (resultat, LENGTH resultat DIV 2, zahl);
+END OP CAT;
+
+PROC conversion (REAL VAR cm, INT VAR pitches):
+  disable stop;
+    INT VAR i :: x step conversion (cm);
+    IF is error
+      THEN dummy := error message;
+           clear error;
+           dummy CAT " -> ";
+           dummy CAT text (cm);
+           fehler (38, dummy);
+           cm := fehler wert
+    ELIF i < 0
+      THEN fehler (38, "negativ");
+           cm := fehler wert
+      ELSE pitches := i
+    FI;
+  enable stop
+END PROC conversion;
+
+(************************** Fehlermeldungen **********************)
+ 
+PROC fehler (INT CONST nr, TEXT CONST addition):
+  fehler melden;
+  meldung auf terminal ausgeben und ggf zeilennummer merken.
+ 
+fehler melden:
+  report text processing error (nr, zeilen nr, fehlerdummy, addition).
+END PROC fehler;
+ 
+PROC warnung (INT CONST nr, TEXT CONST addition):
+  warnung melden;
+  meldung auf terminal ausgeben und ggf zeilennummer merken.
+ 
+warnung melden:
+  report text processing warning (nr, zeilennr, fehlerdummy, addition).
+END PROC warnung;
+
+PROC meldung auf terminal ausgeben und ggf zeilennummer merken:
+  IF online
+    THEN line ;
+         out (fehlerdummy);
+         line ;
+  FI;
+  IF erste fehler zeilennr = 0
+    THEN erste fehler zeilennr := zeilennr
+  FI
+END PROC meldung auf terminal ausgeben und ggf zeilennummer merken;
+
+(*********************** Macro-Bearbeitung ***********************)
+
+PROC fuehre initialisierung fuer macro aus:
+  get liner state (before macro state);
+  get macro line (puffer);
+  pufferlaenge := length (puffer);
+  get macro line (zeile);
+  zeichenpos := 1;
+  von := 1;
+  macro works := TRUE.
+END PROC fuehre initialisierung fuer macro aus;
+
+PROC macro end command: 
+  kommando := subtext (kommando, 2);
+  scan (kommando);
+  next symbol (scan symbol, scan type); 
+  IF NOT macro works
+    THEN fehler (40, kommando);
+         LEAVE macro end command
+  ELIF scan symbol <> "macroend" 
+    THEN fehler (33, kommando) 
+    ELSE put liner state (before macro state);
+  FI
+END PROC macro end command; 
+ 
+(************************** Schrifttyp einstellen *********************)
+
+PROC stelle font ein:
+  IF alter schriftname = par1
+    THEN IF zeilen nr > 2
+           THEN warnung (8, par1)
+           ELSE LEAVE stelle font ein
+         FI
+  ELIF font exists (par1)
+    THEN font nr := font (par1);
+    ELSE fehler (1, par1);
+         par1 := font (1);
+         font nr := 1
+  FI;
+  alter schriftname := par1;
+  hole font und stelle trennbreite ein
+END PROC stelle font ein;
+ 
+PROC hole font:
+  INT VAR x; (* height Werte *)
+  get font (font nr, eingestellte indentation pitch, x, x, x, pitch table);
+  pitch table [code (kommandozeichen) + 1] := kommando ausgang;
+  blankbreite fuer diesen schrifttyp := pitch table [code (blank) + 1] 
+END PROC hole font;
+
+PROC hole font und stelle trennbreite ein:
+  hole font;
+  trennbreite setzen
+END PROC hole font und stelle trennbreite ein;
+
+PROC trennbreite setzen:
+  trennbreite := berechnete trennbreite.
+
+berechnete trennbreite:
+  INT VAR eingestellte trennbreite;
+  conversion (limit in cm, eingestellte trennbreite);
+  eingestellte trennbreite := eingestellte trennbreite
+                                            DIV 100 * trennbreite in prozent;
+  IF eingestellte trennbreite <= zweimal blankbreite
+    THEN zweimal blankbreite
+    ELSE eingestellte trennbreite
+  FI.
+
+zweimal blankbreite:
+  2 * eingestellte indentation pitch.
+END PROC trennbreite setzen; 
+ 
+PROC hyphenation width (INT CONST prozente): 
+  IF prozente < 4 OR prozente > 20 
+    THEN putline ("Fehler: Einstellbare Trennbreite zwischen 4 und 20%") 
+    ELSE trennbreite in prozent := prozente
+  FI 
+END PROC hyphenation width;
+
+(************************** kommando verarbeitung ****************)
+
+PROC additional commands (TEXT CONST k): 
+  zusaetzliche commands := k 
+END PROC additional commands; 
+ 
+TEXT PROC additional commands:
+  zusaetzliche commands
+END PROC additional commands;
+
+BOOL PROC hinter dem kommando steht nix (INT CONST komm ende):
+  komm ende = pufferlaenge OR absatz hinter dem kommando.
+
+absatz hinter dem kommando:
+  komm ende + 1 = pufferlaenge AND puffer hat absatz.
+END PROC hinter dem kommando steht nix;
+
+PROC verarbeite kommando und neue zeile auffuellen:
+  neue zeile auffuellen (von, zeichenpos - 1);
+  von := zeichenpos;
+  verarbeite kommando;
+  neue zeile auffuellen (von, zeichenpos - 1);
+  von := zeichenpos
+END PROC verarbeite kommando und neue zeile auffuellen;
+
+PROC speichere kommando:
+  command store CAT "#";
+  command store CAT kommando;
+  command store CAT "#"
+END PROC speichere kommando;
+
+PROC execute stored commands:
+  IF length (command store) <> 0
+    THEN kommandos speichern := FALSE;
+         dummy := puffer;
+         INT VAR zpos := zeichenpos;
+         zeichenpos := 1;
+         puffer := command store;
+         pufferlaenge := length (puffer);
+         execute commands;
+         puffer := dummy;
+         pufferlaenge := length (puffer);
+         zeichenpos := zpos;
+         command store := "";
+  FI;
+  kommandos speichern := TRUE.
+
+execute commands:
+  WHILE zeichenpos < pufferlaenge REP
+    verarbeite kommando
+  END REP.
+END PROC execute stored commands;
+
+PROC verarbeite kommando:
+INT VAR  anz params,
+         intparam,
+         kommando ende;
+REAL VAR realparam;
+   zeichenpos INCR 1;
+   kommando ende := pos (puffer, kommando zeichen, zeichenpos);
+   IF kommando ende <> 0
+     THEN kommando oder kommentar kommando verarbeiten;
+          zeichenpos := kommando ende + 1
+     ELSE fehler (2, "")
+  FI.
+
+kommando oder kommentar kommando verarbeiten:
+  kommando := subtext (puffer, zeichenpos, kommando ende - 1);
+  TEXT CONST erstes kommandozeichen :: (kommando SUB 1);
+  IF pos ("-/"":*", erstes kommandozeichen) = 0
+    THEN scanne kommando und fuehre es aus
+    ELSE restliche kommandos
+  FI.
+
+restliche kommandos:
+  IF erstes kommandozeichen = "-" OR erstes kommandozeichen = "/"
+    THEN
+  ELIF erstes kommandozeichen = """"
+    THEN scan (kommando);
+         next symbol (scan symbol, scan type);
+         INT VAR scan type2;
+         next symbol (scan symbol, scan type2);
+         IF scan type <> 4 OR scan type2 <> 7
+           THEN fehler (58, kommando)
+         FI
+  ELIF erstes kommandozeichen = "*"
+    THEN zeichenpos := kommando ende + 1;
+         macroend command;
+         LEAVE verarbeite kommando
+  ELIF erstes kommandozeichen = ":"
+    THEN disable stop;
+         delete char (kommando, 1);
+         INT CONST line no before do := line no (eingabe);
+         do (kommando);
+         to line (eingabe, line no before do);
+         IF is error
+           THEN dummy := error message;
+                clear error;
+                dummy CAT " -> ";
+                dummy CAT kommando;
+                fehler (9, dummy)
+         FI;
+         enable stop
+  FI.
+ 
+scanne kommando und fuehre es aus:
+   analyze command (kommando liste, kommando, 3,
+                    kommando index, anz params, par1, par2);
+   disable stop ; 
+   command error ;
+   IF is error
+     THEN dummy := error message;
+          clear error;
+          dummy CAT " -> ";
+          dummy CAT kommando;
+          fehler (22, dummy); 
+          enable stop;
+          LEAVE scanne kommando und fuehre es aus
+   FI;
+   enable stop;
+   setze kommando um.
+
+setze kommando um:
+   SELECT kommando index OF
+ 
+CASE type1:
+     stelle font ein;
+     modifikations speicher := "";
+     mod zeilennr speicher  := ""
+ 
+CASE limit:
+     realparam := real (par1); 
+     IF kommandos speichern
+       THEN speichere kommando
+     ELIF last conversion ok AND pos (par1, ".") <> 0
+       THEN IF realparam = 0.0
+              THEN fehler (37, "")
+              ELSE conversion (realparam, aktuelle pitch zeilenlaenge);
+                   IF realparam <> fehlerwert
+                     THEN limit in cm := realparam;
+                          trennbreite setzen
+                   FI
+            FI
+       ELSE fehler (4, par1);
+     FI
+ 
+CASE on, ub, fb:
+     TEXT VAR mod zeichen;
+     IF kommando index = ub
+       THEN mod zeichen := "u"
+     ELIF kommando index = fb
+       THEN mod zeichen := "b"
+       ELSE mod zeichen := (par1 SUB 1);
+     FI;
+     INT VAR position :: pos (modifikations speicher, mod zeichen);
+     IF position <> 0
+       THEN dummy := mod zeichen + " in Zeile ";
+            dummy CAT text (mod zeilennr speicher ISUB position);
+            fehler (54, dummy);
+            replace (mod zeilennr speicher, position, zeilennr);
+       ELSE modifikations speicher CAT mod zeichen;
+            mod zeilennr speicher CAT zeilennr
+     FI
+ 
+CASE off, fe, ue:
+     IF kommando index = ue
+       THEN mod zeichen := "u"
+     ELIF kommando index = fe
+       THEN mod zeichen := "b"
+       ELSE mod zeichen := (par1 SUB 1);
+     FI;
+     position := pos (modifikations speicher, mod zeichen);
+     IF position  = 0
+       THEN fehler (55, mod zeichen)
+       ELSE delete char (modifikations speicher, position);
+            delete int (mod zeilennr speicher, position)
+     FI
+ 
+CASE pagenr, pagelength, start, block, material, setcount, right, center,
+     linefeed:
+ 
+CASE head, headodd, headeven, bottom, bottomodd, bottomeven, end, free,
+          page command0, page command1, columns, columnsend:
+     IF NOT hinter dem kommando steht nix (kommando ende)
+       THEN fehler (19, kommando)
+     ELIF kommando ende = pufferlaenge
+       THEN IF (neue zeile SUB length (neue zeile)) = blank
+              THEN delete char (neue zeile, length (neue zeile))
+            FI;
+            puffer CAT blank;
+            pufferlaenge := length (puffer)
+     FI;
+     in foot := FALSE
+ 
+CASE foot:
+     IF in foot uebertrag
+       THEN zeilenbreite := aktuelle pitch zeilenlaenge + 1
+     ELIF in foot
+       THEN fehler (3, "")
+       ELSE fuelle ggf zeile vor foot auf (kommando ende)
+     FI
+ 
+CASE ib0, ib1, ib2:
+     TEXT VAR ind zeichen;
+     IF kommando index = ib0
+       THEN ind zeichen:= "1"
+       ELSE ind zeichen := par1
+     FI;
+     position := pos (index speicher, ind zeichen);
+     IF position <> 0
+       THEN dummy := ind zeichen + " in Zeile ";
+            dummy CAT text (ind zeilennr speicher ISUB position);
+            fehler (56, dummy);
+            replace (ind zeilennr speicher, position, zeilennr)
+       ELSE index speicher CAT ind zeichen;
+            ind zeilennr speicher CAT zeilennr
+     FI
+
+CASE ie0, ie1, ie2:
+     IF kommando index = ie0
+       THEN ind zeichen := "1"
+       ELSE ind zeichen := par1
+     FI;
+     position := pos (index speicher, ind zeichen);
+     IF position = 0
+       THEN fehler (57, ind zeichen)
+       ELSE delete char (index speicher, position);
+            delete int (ind zeilennr speicher, position)
+     FI
+
+CASE topage, count1: 
+     herkunftsreferenzen speichern;
+     zeilenbreite um blankbreite erhoehen (3)
+ 
+CASE count0: 
+     zeilenbreite um blankbreite erhoehen (3)
+ 
+CASE value0, value1: 
+     IF anz params <> 0
+       THEN zielreferenzen speichern ohne warnung
+     FI;
+     zeilenbreite um blankbreite erhoehen (3)
+
+CASE goalpage: 
+     zielreferenzen speichern
+
+CASE table:
+     IF in tabelle
+       THEN fehler (41, "")
+       ELSE IF hinter dem kommando steht nix (kommando ende)
+              THEN zeichenpos := pufferlaenge;
+                   neue zeile auffuellen und ausgabe bei zeilenende
+              ELSE neue zeile auffuellen (von, kommando ende);
+                   puffer := subtext (puffer, kommandoende + 1);
+                   schreibe und initialisiere neue zeile
+            FI;
+            verarbeite tabelle;
+            LEAVE verarbeite kommando
+     FI
+
+CASE table end:
+     IF NOT in tabelle
+       THEN fehler (59, "")
+     FI
+
+CASE r pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (r pos)
+     FI
+
+CASE l pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (l pos)
+     FI
+
+CASE c pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (c pos)
+     FI
+
+CASE d pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (d pos)
+     FI
+
+CASE b pos:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition eintragen (b pos)
+     FI
+
+CASE clear pos0:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE anz tabs := 0;
+     FI
+
+CASE clear pos1:
+     IF kommandos speichern
+       THEN speichere kommando
+       ELSE tabulatorposition loeschen
+     FI
+
+CASE skip:
+     IF hinter dem kommando steht nix (kommando ende)
+       THEN neue zeile auffuellen und ausgabe bei zeilenende
+       ELSE neue zeile auffuellen (von, kommandoende);
+            puffer := subtext (puffer, kommandoende + 1);
+            schreibe und initialisiere neue zeile
+     FI;
+     skip zeilen verarbeiten;
+     kommando ende := zeichenpos;
+
+CASE skip end:
+
+CASE u command, d command:
+     INT VAR next smaller font;
+     speichere font nr;
+     IF next smaller font exists (font nr, next smaller font)
+       THEN font nr := next smaller font
+     FI;
+     hole font und stelle trennbreite ein;
+     IF NOT in d und e verarbeitung
+       THEN verarbeite index und exponenten;
+            LEAVE verarbeite kommando
+     FI
+
+CASE e command:
+     entspeichere font nr
+
+CASE head on, head off, bottom on, bottom off, count per page, fillchar,
+     mark command, markend, pageblock:
+
+CASE bsp:
+     zeichenpos DECR 2;
+     IF kommandoende = length (puffer) OR
+        (puffer SUB kommandoende + 1) = kommandozeichen OR
+        zeichenpos < 1 OR
+        (puffer SUB zeichenpos) = kommandozeichen
+       THEN fehler (28, "");
+            LEAVE setze kommando um
+     FI;
+     begin of this char (puffer, zeichenpos);
+     kommandoende INCR 1;
+     INT VAR diese breite    :: breite (puffer, zeichenpos),
+             naechste breite :: breite (puffer, kommandoende);
+     IF in d und e verarbeitung
+       THEN formelbreite DECR diese breite;
+            formelbreite INCR max (diese breite, naechste breite)
+       ELSE zeilenbreite DECR diese breite;
+            zeilenbreite INCR max (diese breite, naechste breite) 
+     FI;
+     zeichenpos := kommandoende;
+     char pos move (vorwaerts);
+     LEAVE verarbeite kommando
+
+CASE counter1, counter2:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     IF pos (counter numbering store, dummy) = 0
+       THEN fehler (34, par1);
+     FI;
+     IF kommando index = counter1
+       THEN par2 := "0"
+     FI;
+     anz blanks freihalten := 3 + 2 * int (par2);
+     zeilenbreite um blankbreite erhoehen (anz blanks freihalten)
+
+CASE set counter:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     IF pos (counter numbering store, dummy) = 0
+       THEN counter numbering store CAT dummy
+       ELSE warnung (15, par1)
+     FI
+
+CASE put counter0:
+     zeilenbreite um blankbreite erhoehen (anz blanks freihalten) 
+
+CASE put counter1:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     INT VAR begin pos :: pos (counter reference store, dummy);
+     IF begin pos = 0
+       THEN counter reference store CAT "u";
+            counter reference store CAT dummy
+     ELIF (counter reference store SUB begin pos - 1) <> "u"
+       THEN insert char (counter reference store,"u", max (begin pos, 1))
+     FI;
+     zeilenbreite um blankbreite erhoehen (5)
+
+CASE store counter:
+     dummy := "#";
+     dummy CAT par1;
+     dummy CAT "#";
+     begin pos := pos (counter reference store, dummy);
+     IF begin pos <> 0
+       THEN IF (counter reference store SUB begin pos - 1) = "i" OR
+               (counter reference store SUB begin pos - 2) = "i"
+              THEN fehler (35, par1)
+            ELIF (counter reference store SUB begin pos - 1) = "u"
+              THEN insert char (counter reference store, "i",
+                                max (begin pos - 1, 1))
+              ELSE insert char (counter reference store, "i",
+                                max (begin pos, 1))
+            FI
+       ELSE counter reference store CAT "i";
+            counter reference store CAT dummy
+     FI
+
+OTHERWISE
+     IF macro command and then process parameters (kommando)
+       THEN IF macro works
+              THEN fehler (15, kommando)
+              ELSE zeichenpos := kommando ende + 1;
+                   neue zeile auffuellen (von, zeichenpos - 1);
+                   von := zeichenpos;
+                   fuehre initialisierung fuer macro aus;
+                   LEAVE verarbeite kommando
+            FI
+     ELIF zusaetzliche commands <> ""
+       THEN analyze command (zusaetzliche commands, kommando, 3,
+                             kommando index, anz params, par1, par2);
+            IF kommando index = 0
+              THEN fehler (8, kommando)
+            FI
+       ELSE fehler (8, kommando)
+     FI;
+END SELECT.
+END PROC verarbeite kommando;
+ 
+(************************* Indizes und Exponenten **********************)
+
+PROC zeilenbreite um blankbreite erhoehen (INT CONST anz):
+  INT CONST blankbreite mal anz :: anz * eingestellte indentation pitch;
+  IF in d und e verarbeitung 
+    THEN formelbreite INCR blankbreite mal anz
+    ELSE zeilenbreite INCR blankbreite mal anz
+  FI;
+  mitzuzaehlende zeichen INCR anz
+END PROC zeilenbreite um blankbreite erhoehen;
+
+PROC speichere font nr:
+  IF index oder exponent anfang
+    THEN suche wortanfang in neuer zeile;
+         zeilenbreite DECR formelbreite
+  FI;
+  font nr speicher CAT " ";
+  font nr speicher CAT text (font nr).
+
+index oder exponent anfang:
+  font nr speicher = "".
+
+suche wortanfang in neuer zeile:
+  auf das letzte zeichen stellen;
+  WHILE NOT wortanfang vor formel REP
+    formelbreite INCR breite (neue zeile, formelanfang);
+    IF formelanfang = 1
+      THEN LEAVE suche wortanfang in neuer zeile
+    FI;
+    char pos move (neue zeile, formelanfang, rueckwaerts);
+  END REP;
+  char pos move (neue zeile, formelanfang, vorwaerts).
+
+wortanfang vor formel:
+  pos (" #", neue zeile SUB formelanfang) <> 0.
+
+auf das letzte zeichen stellen:
+  formelanfang := length (neue zeile);
+  formelbreite := 0;
+  IF formelanfang > 0
+    THEN begin of this char (neue zeile, formelanfang);
+    ELSE formelanfang := 1;
+         LEAVE suche wortanfang in neuer zeile
+  FI
+END PROC speichere font nr;
+
+PROC verarbeite index und exponenten:
+  in d und e verarbeitung := TRUE;
+  zeichenpos := pos (puffer, kommandozeichen, zeichenpos) + 1;
+  INT VAR altes zeichenpos := zeichenpos;
+  verarbeite index oder exponenten zeichen;
+  fehler (52, "");
+  entspeichere font nr.
+
+verarbeite index oder exponenten zeichen:
+  REP
+    stranalyze (pitch table, formelbreite,
+               aktuelle pitch zeilenlaenge - zeilenbreite,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang = kommando ausgang
+      THEN verarbeite zeichen vor kommando;
+           verarbeite kommando und neue zeile auffuellen;
+           IF NOT in d und e verarbeitung
+             THEN zeilenbreite INCR formelbreite;
+                  LEAVE verarbeite index und exponenten
+           FI;
+           altes zeichenpos := zeichenpos
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF     zeichenpos >= pufferlaenge
+         AND formelbreite + zeilenbreite < aktuelle pitch zeilenlaenge
+      THEN LEAVE verarbeite index oder exponenten zeichen
+    ELIF formelanfang <= 1
+      THEN fehler (53, "");
+           formelbreite := 0;
+    ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN fehler (23, "");
+           LEAVE verarbeite index oder exponenten zeichen
+      ELSE schreibe neue zeile vor formelanfang
+    FI
+  END REP.
+
+verarbeite zeichen vor kommando:
+  mitzuzaehlende zeichen INCR
+                         number chars (puffer, altes zeichenpos, zeichenpos);
+  IF (puffer SUB zeichenpos) <> blank
+    THEN aufzaehlungszeichen := (puffer SUB zeichenpos)
+  FI;
+  char pos move (vorwaerts).
+
+schreibe neue zeile vor formelanfang:
+  dummy := subtext (neue zeile, formelanfang);
+  neue zeile := subtext (neue zeile, 1, formelanfang - 1);
+  loesche nachfolgende blanks;
+  schreibe und initialisiere neue zeile;
+  neue zeile CAT dummy;
+  formelanfang := 1;
+  char pos move (vorwaerts)
+END PROC verarbeite index und exponenten;
+
+PROC entspeichere font nr:
+  INT VAR index := length (font nr speicher);
+  IF index <= 1
+    THEN fehler (51, "")
+    ELSE suche nr anfang;
+         entspeichere;
+  FI.
+
+suche nr anfang:
+  WHILE (font nr speicher SUB index) <> " " AND index <> 0 REP
+    index DECR 1
+  END REP.
+
+entspeichere:
+  font nr := int (subtext (font nr speicher, index + 1));
+  IF index <= 1
+    THEN font nr speicher := "";
+         in d und e verarbeitung := FALSE
+    ELSE font nr speicher := subtext (font nr speicher, 1, index - 1)
+  FI;
+  hole font und stelle trennbreite ein
+END PROC entspeichere font nr;
+
+(*************************** skip zeilen ****************************)
+
+PROC skip zeilen verarbeiten:
+  REP
+    IF dateiende
+      THEN errorstop ("Dateiende während skip-Anweisung")
+    ELIF skip ende kommando
+      THEN LEAVE skip zeilen verarbeiten
+    FI;
+    neue zeile auffuellen und ausgabe bei zeilenende
+  END REP.
+
+dateiende:
+  pufferlaenge = 0.
+
+skip ende kommando:
+  TEXT VAR kliste :: "skipend:1.0", k;
+  INT VAR k anf :: pos (puffer, kommandozeichen),
+          kende, anz params, kindex;
+  WHILE noch ein kommando vorhanden REP
+    kindex := 0;
+    analysiere das kommando
+  END REP;
+  FALSE.
+
+noch ein kommando vorhanden:
+  kanf <> 0.
+
+analysiere das kommando:
+  kende := pos (puffer, kommandozeichen, kanf + 1);
+  IF kende = 0
+    THEN fehler (2, "");
+         LEAVE skip ende kommando WITH FALSE
+  FI;
+  k := subtext (puffer, kanf + 1, kende - 1);
+  analyze command (kliste, k, 3, kindex, anz params, par1, par2);
+  IF kindex = 1
+    THEN zeichenpos := kende;
+         LEAVE skip ende kommando WITH TRUE
+  FI;
+  kanf := pos (puffer, kommandozeichen, kende + 1).
+END PROC skip zeilen verarbeiten;
+
+(**************** sonderbehandlung von zeilen vor foot *******************)
+
+PROC fuelle ggf zeile vor foot auf (INT VAR com ende):
+  IF foot am zeilenende ohne absatz AND NOT macro works
+    THEN letzter puffer war absatz := TRUE;
+         IF text vor foot AND NOT zeile hat richtige laenge
+           THEN INT VAR   foot zeilennr := line no (eingabe);
+                INT CONST x1            := com ende;
+                in foot uebertrag := TRUE;
+                get liner state (before foot state);
+                formatiere diese zeile;
+                to line (eingabe, foot zeilennr);
+                footdummy := neue zeile;
+                put liner state (before foot state);
+                neue zeile := footdummy;
+                com ende := x1;
+                in foot uebertrag := FALSE
+         FI
+  ELIF NOT hinter dem kommando steht nix (com ende)
+    THEN fehler (19, kommando);
+         LEAVE fuelle ggf zeile vor foot auf
+  FI;
+  in foot := TRUE.
+
+foot am zeilenende ohne absatz:
+  com ende = pufferlaenge.
+
+text vor foot:
+  pos (neue zeile, ""33"", ""255"", 1) <> 0.
+
+formatiere diese zeile:
+  foot anweisung entfernen;
+  lese eingabe datei bis end kommando;
+  zeile nach end in zeile;
+  formatiere;
+  schreibe die veraenderte zeile nach end.
+ 
+foot anweisung entfernen:
+  zeichenpos := com ende;
+  ueberspringe das kommando (puffer, zeichenpos, rueckwaerts);
+  zeichenpos DECR 1;
+  puffer := subtext (puffer, 1, zeichenpos);
+  WHILE NOT within kanji (puffer, zeichenpos) AND
+        (puffer SUB zeichenpos) = blank AND foot stand nicht am zeilenanfang
+        REP
+    zeilenbreite DECR breite (blank);
+    delete char (puffer, zeichenpos);
+    delete char (neue zeile, length (neue zeile));
+    zeichenpos DECR 1
+  END REP;
+  pufferlaenge := length (puffer).
+
+foot stand nicht am zeilenanfang:
+  zeichenpos > 0.
+
+lese eingabe datei bis end kommando:
+  TEXT VAR kliste :: "end:1.0";
+  dummy := zeile;
+  WHILE NOT foot ende kommando REP
+    IF eof (eingabe)
+      THEN LEAVE formatiere diese zeile
+    FI;
+    read record (eingabe, dummy);
+    down (eingabe);
+  ENDREP;
+  INT CONST zeile nach end := line no (eingabe);
+  IF NOT end kommando steht am zeilenende
+    THEN LEAVE formatiere diese zeile
+  FI.
+
+end kommando steht am zeilenende:
+  k ende = length (dummy) OR k ende + 1 = length (dummy).
+
+foot ende kommando:
+  INT VAR k anf, k ende :: 0, anz params, k index;
+  WHILE noch ein kommando vorhanden REP
+    k ende := pos (dummy, kommandozeichen, k anf + 1);
+    IF k ende = 0
+      THEN LEAVE foot ende kommando WITH FALSE
+      ELSE kommando := subtext (dummy, k anf + 1, k ende - 1);
+    FI;
+    analyze command (kliste, kommando, 3, kindex, anz params, par1, par2);
+    IF k index = 1
+      THEN LEAVE foot ende kommando WITH TRUE
+    FI;
+  END REP;
+  FALSE.
+
+noch ein kommando vorhanden:
+  k anf := pos (dummy, kommandozeichen, k ende + 1);
+  k anf <> 0.
+
+zeile nach end in zeile:
+  read record (eingabe, zeile);
+  INT VAR text anf := pos (zeile, ""33"", ""255"", 1);
+  IF zeile nach end ist leerzeile
+    THEN LEAVE formatiere diese zeile
+    ELSE IF text anf > 1
+           THEN aktuelle blanks := subtext (zeile, 1, text anf - 1);
+                zeile := subtext (zeile, text anf)
+         FI;
+  FI.
+
+zeile nach end ist leerzeile:
+  text anf <= 0.
+
+formatiere:
+  IF foot stand nicht am zeilenanfang
+    THEN verarbeite letztes zeichen von puffer
+    ELSE puffer CAT zeile;
+         pufferlaenge := length (puffer)
+  FI;
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang = kommando ausgang
+      THEN zeichenpos INCR 1;
+           neue zeile auffuellen (von, zeichenpos - 1);
+           von := zeichenpos;
+           INT VAR ende der neuen zeile := length (neue zeile),
+                   zpos davor := zeichenpos;
+           verarbeite kommando;
+           neue zeile auffuellen (von, zeichenpos - 1);
+           von := zeichenpos;
+           IF kommando index = foot
+             THEN behandlung der zeile vor foot;
+                  LEAVE formatiere
+           ELIF zeichenpos >= pufferlaenge
+              OR zeilenbreite > aktuelle pitch zeilenlaenge
+             THEN ende einer neuen zeile;
+                  LEAVE formatiere
+           FI
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = zeilenende ausgang
+         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN up (eingabe);
+           delete record (eingabe);
+           neue zeile auffuellen;
+           IF zeichenwert ausgang = esc char ohne zweites byte ausgang
+             THEN fehler (23, "")
+           FI;
+           LEAVE formatiere diese zeile
+      ELSE ende einer neuen zeile;
+           LEAVE formatiere
+    FI
+  END REP.
+
+behandlung der zeile vor foot:
+  neue zeile := subtext (neue zeile, 1, ende der neuen zeile);
+  zeichenpos := zpos davor.
+
+schreibe die veraenderte zeile nach end:
+  to line (eingabe, zeile nach end);
+  dummy := (text anf - 1) * blank;
+  dummy CAT subtext (puffer, zeichenpos);
+  IF format file in situ
+    THEN insert record (eingabe)
+  FI;
+  write record (eingabe, dummy).
+END PROC fuelle ggf zeile vor foot auf;
+
+(*************** Tabulator- und Tabellen verarbeitung ******************)
+
+PROC tabulatorposition eintragen (INT CONST tab type):
+  ROW 3 INT VAR akt tab pos;
+  IF anz tabs >= max tabs
+    THEN fehler (32, "")
+  ELIF tab in cm umwandeln (par1, tab pos in pitches)
+    THEN IF tab type = b pos AND tab in cm umwandeln (par2, bis tab)
+           THEN 
+           ELSE bis tab := 0
+         FI;
+         TEXT VAR zentrierzeichen;
+         IF tab type = d pos
+           THEN zentrierzeichen := par2
+           ELSE zentrierzeichen := ""
+         FI;
+        tabs sortiert eintragen
+  FI.
+
+tabs sortiert eintragen:
+  INT VAR i;
+  type tab := tab type;
+  FOR i FROM 1 UPTO anz tabs REP
+    IF tab pos in pitches = tabs [i] [1]
+      THEN fehler (42, par1);
+           LEAVE tabulatorposition eintragen
+    ELIF tabs [i] [1] > tab pos in pitches
+      THEN vertauschen
+    FI;
+    IF ueberschneidende bpos
+      THEN fehler (12, text (xstepconversion (tab pos in pitches)))
+    FI;
+  END REP;
+  anz tabs INCR 1;
+  tabs [anz tabs]        := akt tab pos;
+  tab zeichen [anz tabs] := zentrierzeichen.
+
+ueberschneidende bpos:
+  tabs [i] [2] = bpos AND naechste anfang pos liegt in diesem bpos bereich.
+
+naechste anfang pos liegt in diesem bpos bereich:
+  tab pos in pitches <= tabs [i] [3].
+
+vertauschen:
+  ROW 3 INT CONST hilf1 :: tabs [i];
+  TEXT CONST thilf      :: tab zeichen [i];
+  tabs [i]        := akt tab pos;
+  tab zeichen [i] := zentrierzeichen;
+  akt tab pos     := hilf1;
+  zentrierzeichen := thilf.
+
+tab pos in pitches: 
+  akt tab pos [1].
+
+type tab:
+  akt tab pos [2].
+
+bis tab:
+  akt tab pos [3].
+END PROC tabulatorposition eintragen;
+
+BOOL PROC tab in cm umwandeln (TEXT CONST text wert, INT VAR f breite):
+  REAL VAR cm := real (text wert);
+  IF last conversion ok AND pos (text wert, ".") <> 0
+    THEN umwandeln
+    ELSE fehler (4, par1);
+         TRUE
+  FI.
+
+umwandeln:
+  conversion (cm, f breite);
+  IF f breite > aktuelle pitch zeilenlaenge
+    THEN fehler (39, par1)
+  ELIF cm = fehlerwert
+    THEN
+    ELSE LEAVE tab in cm umwandeln WITH TRUE
+  FI;
+  FALSE
+END PROC tab in cm umwandeln;
+
+PROC cm angabe der druckposition in dummy (INT CONST nr):
+  dummy := text (x step conversion (tabs [nr] [1]));
+  IF (dummy SUB length (dummy)) = "."
+    THEN dummy CAT "0"
+  FI;
+  dummy CAT " cm"
+END PROC cm angabe der druckposition in dummy;
+
+PROC tabulator position loeschen:
+  INT VAR tab pos in pitches;
+  IF tab in cm umwandeln (par1, tab pos in pitches)
+    THEN versuche zu loeschen
+  FI.
+
+versuche zu loeschen:
+  INT VAR i;
+  FOR i FROM 1 UPTO anz tabs REP
+    IF tab pos in pitches = tabs [i] [1]
+      THEN verschiebe eintraege nach unten;
+           LEAVE tabulator position loeschen
+    FI
+  END REP;
+  fehler (43, par1).
+
+verschiebe eintraege nach unten:
+  INT VAR k;
+  FOR k FROM i UPTO anz tabs - 1 REP
+    tabs [k] := tabs [k + 1];
+    tab zeichen [k] := tab zeichen [k + 1];
+  END REP;
+  anz tabs DECR 1.
+END PROC tabulatorposition loeschen;
+
+PROC verarbeite tabelle:
+  in tabelle := TRUE;
+  pitch table auf blank ausgang setzen;
+  verarbeite tabellenzeilen;
+  pitch table auf blank setzen;
+  IF suchausgang gesetzt
+    THEN pitch table [pos tab zeichen in pitch table] :=
+                                                breite erstes dezimalzeichen;
+         suchausgang gesetzt := FALSE; 
+  FI;
+  in tabelle := FALSE.
+
+verarbeite tabellenzeilen:
+  WHILE pufferlaenge <> 0 REP
+    ueberpruefe tabellenzeile;
+    zeichenpos := pufferlaenge;
+    neue zeile auffuellen und ausgabe bei zeilenende
+  END REP;
+  puffer       := " ";
+  pufferlaenge := 1;
+  zeichenpos   := 1;
+  fehler (49, "").
+
+ueberpruefe tabellenzeile:
+(* Achtung: Zeilenbreite ist Spaltenbreite;
+            tab zeilen breite ist Summe der Spalten und Positionen *)
+  INT VAR tab zeilen breite :: 0,
+          tab no   :: 1;
+  WHILE noch tab positionen OR only command line (puffer) REP
+    positioniere auf naechste spalte;
+    errechne spaltenbreite;
+    IF anz tabs > 0
+      THEN ueberpruefe ob es passt;
+    FI;
+    tab no INCR 1
+  END REP;
+  IF tabellenzeile breiter als limit
+    THEN warnung (10, "")
+  ELIF noch mehr spaltentexte AND anz tabs <> 0
+    THEN warnung (11, subtext (puffer, zeichenpos))
+  FI.
+
+noch tab positionen: 
+  tab no <= anz tabs.
+
+positioniere auf naechste spalte:
+  zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos);
+  IF leerzeile oder rest der zeile ist leer 
+    THEN IF NOT only command line (puffer) AND pufferlaenge > 1
+           THEN warnung (14, "")
+         FI;
+         LEAVE ueberpruefe tabellenzeile
+  FI.
+
+leerzeile oder rest der zeile ist leer:
+  zeichenpos <= 0.
+
+errechne spaltenbreite:
+  zeilenbreite := 0;
+  BOOL VAR suchausgang gesetzt :: FALSE;
+  IF diese position ist dezimal pos
+    THEN setze dezimalzeichen auf suchausgang
+  FI;
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    zeichenpos INCR 1;
+    IF zeichenwert ausgang = blank ausgang
+      THEN behandele dieses blank
+    ELIF zeichenwert ausgang = kommando ausgang
+      THEN verarbeite das kommando
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = such ausgang
+      THEN verarbeite ersten teil der dezimal zentrierung 
+    ELIF zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN fehler (23, "");
+           LEAVE ueberpruefe tabellenzeile
+    ELIF zeilenbreite + zeichenwert ausgang > aktuelle pitch zeilenlaenge
+      THEN fehler (36, "");
+           LEAVE ueberpruefe tabellenzeile
+      ELSE tabellenzeile ohne absatz
+    FI
+  END REP.
+ 
+diese position ist dezimal pos:
+  tabs [tab no] [2] = dpos.
+
+setze dezimalzeichen auf suchausgang:
+  INT CONST pos tab zeichen in pitch table ::
+                 code (tab zeichen [tab no] SUB 1) + 1;
+  INT VAR breite erstes dezimalzeichen :=breite (tab zeichen [tab no] SUB 1),
+          breite excl dezimalzeichen := 0;
+  suchausgang gesetzt := TRUE;
+  pitch table [pos tab zeichen in pitch table] := such ausgang.
+
+verarbeite ersten teil der dezimal zentrierung:
+  IF pos (puffer, tab zeichen [tab no], zeichenpos) = zeichenpos
+    THEN pitch table [pos tab zeichen in pitch table] :=
+                                           breite erstes dezimalzeichen;
+         suchausgang gesetzt := FALSE;
+         breite excl dezimalzeichen := zeilenbreite
+  FI;
+  zeilenbreite INCR breite (puffer SUB zeichenpos);
+  zeichenpos INCR 1.
+
+behandele dieses blank:
+  IF doppelblank OR absatz
+    THEN LEAVE errechne spaltenbreite
+    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp;
+         zeichenpos INCR 1
+  FI.
+
+doppelblank:
+  (puffer SUB zeichenpos + 1) = blank.
+
+verarbeite das kommando:
+  pitch table auf blank setzen;
+  verarbeite kommando und neue zeile auffuellen;
+  pitch table auf blank ausgang setzen;
+  IF kommando index = table end
+    THEN LEAVE verarbeite tabellenzeilen
+  ELIF suchausgang gesetzt AND
+       pitch table [pos tab zeichen in pitch table] <> suchausgang
+    THEN pitch table [pos tab zeichen in pitch table] := suchausgang
+  FI.
+
+tabellenzeile ohne absatz:
+  IF zeilenende eines macros
+    THEN zeile in puffer und zeile lesen;
+         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos);
+    ELSE LEAVE errechne spaltenbreite
+  FI.
+
+zeilenende eines macros:
+  zeichenwert ausgang = zeilenende ausgang AND macro works.
+
+ueberpruefe ob es passt:
+  INT CONST akt tab pos :: tabs [tab no] [1];
+  IF vorherige spalte ueberschreibt tabulator position 
+    THEN cm angabe der druckposition in dummy (tab no - 1);
+         fehler (44, dummy);
+         tab zeilenbreite := akt tab pos
+  ELIF only command line (puffer)
+    THEN
+    ELSE ueberpruefe nach art des tabulators
+  FI.
+
+ueberpruefe nach art des tabulators:
+  IF   tabs [tab no] [2] = r pos
+    THEN nach links schreibend
+  ELIF tabs [tab no] [2] = l pos
+    THEN nach rechts schreibend
+  ELIF tabs [tab no] [2] = b pos
+    THEN nach rechts blockend schreibend
+  ELIF tabs [tab no] [2] = c pos
+    THEN zentrierend
+    ELSE zentrierend um zeichen
+  FI.
+
+vorherige spalte ueberschreibt tabulator position:
+  tab zeilenbreite > akt tab pos.
+
+nach links schreibend:
+  IF tab zeilenbreite + zeilenbreite > akt tab pos
+    THEN cm angabe der druckposition in dummy (tab no); 
+         fehler (45, dummy);
+  FI;
+  tab zeilenbreite := akt tab pos.
+
+nach rechts schreibend:
+  tab zeilenbreite := akt tab pos + zeilenbreite.
+
+nach rechts blockend schreibend:
+  IF akt tab pos + zeilenbreite > tabs [tab no] [3]
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (48, dummy)
+  FI;
+  tab zeilenbreite := tabs [tab no] [3].
+
+zentrierend:
+  IF tab zeilenbreite + (zeilenbreite DIV 2) > akt tab pos
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (46, dummy)
+  FI;
+  tab zeilenbreite := akt tab pos + (zeilenbreite DIV 2).
+
+zentrierend um zeichen:
+  IF breite excl dezimalzeichen = 0
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (50, dummy)
+  ELIF tab zeilenbreite + breite excl dezimalzeichen > akt tab pos
+    THEN cm angabe der druckposition in dummy (tab no);
+         fehler (47, dummy)
+  FI;
+  IF suchausgang gesetzt
+    THEN pitch table [pos tab zeichen in pitch table] :=
+                                                breite erstes dezimalzeichen;
+         suchausgang gesetzt := FALSE; 
+  FI;
+  tab zeilenbreite := akt tab pos +
+                                 (zeilenbreite - breite excl dezimalzeichen).
+
+tabellenzeile breiter als limit:
+  tab zeilenbreite > aktuelle pitch zeilenlaenge + einrueckbreite.
+
+noch mehr spaltentexte:
+  pos (puffer, ""33"", ""255"", zeichenpos) <> 0.
+END PROC verarbeite tabelle;
+ 
+(*********************** referenzen ueberpruefen **********************)
+ 
+PROC aktuelle referenz erstellen:
+  aktuelle referenz := "#";
+  aktuelle referenz CAT par1;
+  aktuelle referenz CAT "#";
+END PROC aktuelle referenz erstellen;
+
+PROC zielreferenzen speichern ohne warnung:
+  aktuelle referenz erstellen;
+  IF pos (zielreferenzen, aktuelle referenz) = 0 
+    THEN delete char (aktuelle referenz, 1);
+         zielreferenzen CAT aktuelle referenz
+  FI 
+END PROC zielreferenzen speichern ohne warnung;
+
+PROC zielreferenzen speichern:
+  aktuelle referenz erstellen;
+  IF pos (zielreferenzen, aktuelle referenz) <> 0 
+    THEN warnung (9, par1) 
+    ELSE delete char (aktuelle referenz, 1);
+         zielreferenzen CAT aktuelle referenz
+  FI 
+END PROC zielreferenzen speichern;
+ 
+PROC herkunftsreferenzen speichern:
+  aktuelle referenz erstellen;
+  IF pos (herkunftsreferenzen, aktuelle referenz) = 0 
+    THEN delete char (aktuelle referenz, 1);
+         herkunftsreferenzen CAT aktuelle referenz
+  FI 
+END PROC herkunftsreferenzen speichern; 
+ 
+PROC referenzen ueberpruefen: 
+  ueberpruefe zielreferenzen; 
+  ueberpruefe restliche herkunftsreferenzen. 
+ 
+ueberpruefe zielreferenzen: 
+  REP 
+    hole naechste zielreferenz; 
+    IF pos (herkunfts referenzen, aktuelle referenz) = 0 
+      THEN change all (aktuelle referenz,"#", ""); 
+           warnung (3, aktuelle referenz)
+      ELSE delete char (aktuelle referenz, length (aktuelle referenz));
+           change (herkunftsreferenzen, aktuelle referenz, ""); 
+    FI
+  END REP. 
+ 
+hole naechste zielreferenz: 
+  IF length (zielreferenzen) > 1
+    THEN aktuelle referenz :=
+            subtext (zielreferenzen, 1, pos (zielreferenzen, "#", 2));
+         zielreferenzen := 
+            subtext (zielreferenzen, pos (zielreferenzen, "#", 2))
+    ELSE LEAVE ueberpruefe zielreferenzen 
+  FI. 
+ 
+ueberpruefe restliche herkunftsreferenzen: 
+  WHILE length (herkunftsreferenzen) > 1 REP 
+    aktuelle referenz :=
+     subtext (herkunftsreferenzen, 1, pos (herkunftsreferenzen, "#", 2) - 1);
+    change (herkunftsreferenzen, aktuelle referenz, "");
+    delete char (aktuelle referenz, 1); 
+    warnung (4, aktuelle referenz) 
+  END REP. 
+END PROC referenzen ueberpruefen;
+ 
+(*************************** Utilities *******************************)
+
+INT PROC breite (TEXT CONST z):
+  INT VAR b;
+  IF z = ""
+    THEN display and pause (1)
+  ELIF z = kommandozeichen
+    THEN display and pause (2); b := 1
+    ELSE b := pitch table [code (z) + 1]
+  FI;
+  IF zeilenbreite > maxint - b
+    THEN display and pause (3); b := 1
+  FI;
+  b.
+END PROC breite;
+
+INT PROC breite (TEXT CONST ein text, INT CONST zpos):
+  TEXT CONST z :: ein text SUB zpos;
+  INT VAR zeichen breite;
+  IF z = ""
+    THEN display and pause (4); zeichen breite := 1
+  ELIF z = kommandozeichen
+    THEN display and pause (6); zeichen breite := 1
+    ELSE zeichen breite := pitch table [code (z) + 1]
+  FI;
+  IF zeichen breite = extended char ausgang
+    THEN zeichen breite := extended char pitch (font nr,
+           ein text SUB zpos, ein text SUB zpos + 1)
+  FI;
+  zeichen breite
+END PROC breite;
+
+PROC char pos move (INT CONST richtung):
+  char pos move (zeichenpos, richtung)
+END PROC char pos move;
+
+PROC char pos move (INT VAR zpos, INT CONST richtung):
+  char pos move (puffer, zpos, richtung)
+END PROC char pos move;
+
+BOOL PROC absatz:
+  zeichenpos = pufferlaenge AND puffer hat absatz
+END PROC absatz;
+
+BOOL PROC puffer hat absatz:
+  NOT within kanji (puffer, pufferlaenge) AND
+  (puffer SUB pufferlaenge) = blank
+END PROC puffer hat absatz;
+
+PROC pitch table auf blank ausgang setzen:
+  IF pitch table [code (blank) + 1] <> blank ausgang
+    THEN blank breite fuer diesen schrifttyp := breite (blank);
+         pitch table [code (blank) + 1] := blank ausgang
+  FI
+END PROC pitch table auf blank ausgang setzen;
+
+PROC pitch table auf blank setzen:
+  pitch table [code (blank) + 1] := blank breite fuer diesen schrifttyp
+END PROC pitch table auf blank setzen;
+
+(*PROC zustands test (TEXT CONST anf):
+line ;put(anf);
+line ;put("zeilenbreite, aktuelle pitch zeilenlaenge:");
+     put(zeilenbreite);put(aktuelle pitch zeilenlaenge);
+line ;put("zeichenpos, pufferlaenge, ausgang, zeichen:");
+put(zeichenpos);put(pufferlaenge);
+IF zeichenwert ausgang = blank ausgang
+  THEN put ("blank")
+ELIF zeichenwert ausgang = kommando ausgang
+  THEN put ("kommando")
+ELIF zeichenwert ausgang = such ausgang
+  THEN put ("such")
+ELIF zeichenwert ausgang = zeilenende ausgang
+  THEN put ("zeilenende")
+  ELSE put(zeichenwert ausgang);
+FI; put ("ausgang");
+out(">");out(puffer SUB zeichenpos);out("<");
+line ;out("puffer >");
+IF length (puffer) > 65
+  THEN outsubtext (puffer, 1, 65);
+       line ; outsubtext (puffer, 66)
+  ELSE out(puffer);
+FI;
+out("<");
+line ;out("zeile >");
+IF length (zeile) > 65
+  THEN outsubtext (zeile, 1, 65);
+       line ; outsubtext (zeile, 66)
+  ELSE out (zeile);
+FI;
+out("<");
+line ;out("neue zeile >");
+IF length (neue zeile) > 65
+  THEN outsubtext (neue zeile, 1, 65);
+       line ; outsubtext (neue zeile, 66)
+  ELSE out(neue zeile);
+FI;
+out("<");
+line ; 
+END PROC zustands test;*)
+
+(*************************** eigentliche form routine ********************)
+
+PROC zeilen form (TEXT CONST datei):
+  enable stop;
+  form initialisieren (datei);
+  formiere absatzweise;
+  letzte neue zeile ausgeben.
+
+formiere absatzweise:
+  REP
+    letzter puffer war absatz := FALSE;
+    einrueckbreite := eingestellte indentation pitch;
+    IF einfacher absatz nach absatz
+      THEN gebe einfachen absatz aus
+      ELSE verarbeite abschnitt nach absatz
+    FI
+  UNTIL pufferlaenge = 0 END REP.
+
+einfacher absatz nach absatz:
+  absatz.
+
+gebe einfachen absatz aus:
+  neue zeile := blank;
+  ausgabe bei zeilenende.
+
+verarbeite abschnitt nach absatz:
+  berechne erste zeile nach absatz;
+  IF NOT letzter puffer war absatz
+    THEN formiere
+  FI.
+
+formiere:
+  INT VAR letzte zeilennr;
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang   = kommando ausgang
+      THEN zeichenpos INCR 1;
+           verarbeite kommando und neue zeile auffuellen;
+           IF letzter puffer war absatz
+             THEN ausgabe bei zeilenende;
+                  LEAVE verarbeite abschnitt nach absatz
+           ELIF zeichenpos > pufferlaenge OR absatz
+             THEN letzte zeilennr := zeilennr;
+                  verarbeite letztes zeichen von puffer;
+                  IF neue zeile ausgeloest
+                    THEN LEAVE verarbeite abschnitt nach absatz
+                    ELSE letzter puffer war absatz := FALSE
+                  FI
+           FI
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = zeilenende ausgang
+         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN letzte zeilennr := zeilennr;
+           verarbeite letztes zeichen von puffer;
+           IF zeichenwert ausgang = esc char ohne zweites byte ausgang
+             THEN fehler (23, "")
+           FI;
+           IF neue zeile ausgeloest
+             THEN LEAVE verarbeite abschnitt nach absatz
+             ELSE letzter puffer war absatz := FALSE
+           FI
+      ELSE ende einer neuen zeile
+    FI;
+  UNTIL pufferlaenge = 0 END REP. 
+
+neue zeile ausgeloest:
+  letzte zeilennr < zeilennr.
+END PROC zeilen form;
+
+PROC berechne erste zeile nach absatz:
+  INT CONST anz einrueckungszeichen :: zeilenbreite DIV einrueckbreite;
+  INT VAR anz zeichen fuer einzeilige einrueckung :: 0,
+          anz zeichen          :: 0,
+          schlepper zeichenpos :: 1,
+          letzte zeilennr;
+  BOOL CONST puffer hatte anfangs absatz :: puffer hat absatz;
+  BOOL VAR   noch kein blank gewesen :: TRUE;
+  pitch table auf blank ausgang setzen;
+  berechne erste zeile;
+  pitch table auf blank setzen.
+
+berechne erste zeile:
+  REP
+    stranalyze (pitch table, zeilenbreite, aktuelle pitch zeilenlaenge,
+                puffer, zeichenpos, pufferlaenge, zeichenwert ausgang);
+    IF zeichenwert ausgang   = blank ausgang
+      THEN verarbeite text
+    ELIF zeichenwert ausgang = extended char ausgang
+      THEN char pos move (vorwaerts);
+           zeilenbreite INCR breite (puffer, zeichenpos);
+           char pos move (vorwaerts)
+    ELIF zeichenwert ausgang = kommando ausgang
+      THEN verarbeite dieses kommando
+    ELIF zeichenwert ausgang = zeilenende ausgang
+         OR zeichenwert ausgang = esc char ohne zweites byte ausgang
+      THEN behandele zu kurze zeile
+      ELSE behandele zu lange zeile
+    FI
+  END REP.
+
+verarbeite dieses kommando:
+  textzeichen mitzaehlen;
+  IF pos (" #", (puffer SUB zeichenpos)) = 0
+    THEN aufzaehlungszeichen := (puffer SUB zeichenpos)
+  FI;
+  char pos move (vorwaerts);
+  mitzuzaehlende zeichen := 0;
+  pitch table auf blank setzen;
+  verarbeite kommando und neue zeile auffuellen;
+  pitch table auf blank ausgang setzen;
+  IF letzter puffer war absatz
+    THEN neue zeile auffuellen und ausgabe bei zeilenende;
+         LEAVE berechne erste zeile
+  ELIF zeichenpos > pufferlaenge OR absatz
+    THEN letzte zeilennr := zeilennr;
+         verarbeite letztes zeichen von puffer;
+         IF neue zeile ausgeloest
+           THEN LEAVE berechne erste zeile
+           ELSE letzter puffer war absatz := FALSE
+         FI
+  ELIF anweisung erlaubt keine aufzaehlung
+    THEN LEAVE berechne erste zeile
+  FI;
+  anz zeichen INCR mitzuzaehlende zeichen;
+  schlepper zeichenpos := zeichenpos.
+
+neue zeile ausgeloest:
+  letzte zeilennr < zeilennr.
+
+anweisung erlaubt keine aufzaehlung:
+  kommando index = center OR kommando index = right.
+
+verarbeite text:
+  char pos move (vorwaerts);
+  IF absatz
+    THEN verarbeite letztes zeichen von puffer;
+         LEAVE berechne erste zeile
+  ELIF zeilenbreite + blankbreite fuer diesen schrifttyp >
+                                                  aktuelle pitch zeilenlaenge
+    THEN behandele zu lange zeile
+  ELIF mehrfaches blank
+    THEN positionierung mit doppelblank
+  ELIF noch kein blank gewesen AND
+       anz zeichen +
+                number chars (puffer, schlepper zeichenpos, zeichenpos) <= 20
+    THEN ggf aufzaehlung aufnehmen
+    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp
+  FI;
+  noch kein blank gewesen := FALSE;
+  zeichenpos INCR 1.
+
+mehrfaches blank:
+  (puffer SUB zeichenpos + 1) = blank.
+
+positionierung mit doppelblank:
+  WHILE NOT within kanji (puffer, zeichenpos + 1) AND
+        (puffer SUB zeichenpos + 1) = blank REP
+    zeichenpos INCR 1
+  END REP;
+  textzeichen mitzaehlen;
+  pruefe auf ueberschreibung
+              (zeilenbreite, anz zeichen + anz einrueckungszeichen).
+
+ggf aufzaehlung aufnehmen:
+  IF NOT within kanji (puffer, zeichenpos - 1) AND
+     (puffer SUB zeichenpos - 1) <> kommandozeichen
+    THEN aufzaehlungszeichen := (puffer SUB zeichenpos - 1);
+  FI;
+  textzeichen mitzaehlen;
+  IF    aufzaehlungszeichen = ":"
+     OR (aufzaehlungszeichen = "-" AND anz zeichen <= 2)
+     OR (anz zeichen <= 7 AND (   aufzaehlungszeichen = ")"
+                               OR aufzaehlungszeichen = "."))
+    THEN anz zeichen fuer einzeilige einrueckung := anz zeichen;
+         pruefe auf ueberschreibung
+               (zeilenbreite, anz zeichen + anz einrueckungszeichen)
+    ELSE zeilenbreite INCR blankbreite fuer diesen schrifttyp
+  FI.
+
+textzeichen mitzaehlen:
+  anz zeichen INCR number chars (puffer, schlepper zeichenpos, zeichenpos);
+  IF is kanji esc (puffer SUB zeichenpos)
+    THEN schlepper zeichenpos := zeichenpos + 2
+    ELSE schlepper zeichenpos := zeichenpos + 1
+  FI.
+
+behandele zu kurze zeile:
+  textzeichen mitzaehlen;
+  IF zeichenwert ausgang = esc char ohne zweites byte ausgang
+    THEN fehler (23, "");
+         neue zeile auffuellen;
+         schreibe und initialisiere neue zeile;
+         zeichenpos := 1;
+         LEAVE berechne erste zeile
+  FI;
+  letzte zeilennr := zeilennr;
+  verarbeite letztes zeichen von puffer;
+  IF neue zeile ausgeloest
+    THEN LEAVE berechne erste zeile
+  FI;
+  schlepper zeichenpos := 1.
+
+behandele zu lange zeile:
+  pitch table auf blank setzen;
+  IF zeilenende bei erstem zeichen
+    THEN loesche nachfolgende blanks;
+         schreibe und initialisiere neue zeile;
+         zeichenpos := 1;
+         LEAVE berechne erste zeile
+  ELIF (puffer SUB zeichenpos) = kommandozeichen
+    THEN zeichenpos INCR 1
+    ELSE zeilenbreite DECR breite (puffer, zeichenpos)
+  FI;
+  IF puffer hatte anfangs absatz
+    THEN einrueckung gemaess pufferanfang
+  FI;
+  LEAVE berechne erste zeile.
+
+zeilenende bei erstem zeichen:
+  zeichenpos < 1.
+
+einrueckung gemaess pufferanfang:
+alte blanks :=
+(anz einrueckungszeichen + anz zeichen fuer einzeilige einrueckung) * blank.
+END PROC berechne erste zeile nach absatz;
+
+PROC pruefe auf ueberschreibung (INT CONST aufzaehlungsbreite,
+                                           anz aufzaehlungszeichen):
+  IF ueberschreibung
+    THEN fehlende blanks errechnen;
+         INT VAR aufzaehlungsende :: zeichenpos - 1;
+         WHILE (puffer SUB aufzaehlungsende) = blank REP
+           aufzaehlungsende DECR 1
+         END REP;
+         dummy := ">"; 
+         dummy CAT subtext (puffer,
+                            aufzaehlungsende - 15, aufzaehlungsende);
+         dummy CAT "< Fehlende Blanks: ";
+         dummy CAT text (anz fehlende blanks);
+         warnung (12, dummy)
+  FI;
+  zeilenbreite := anz aufzaehlungszeichen * einrueckbreite.
+
+ueberschreibung:
+  INT CONST anz zeichen mal einrueckbreite ::
+                                anz aufzaehlungszeichen * einrueckbreite,
+            min zwischenraum :: (einrueckbreite DIV 4);
+  aufzaehlungsbreite + min zwischenraum > anz zeichen mal einrueckbreite.
+
+fehlende blanks errechnen:
+  INT VAR anz fehlende blanks ::
+  (aufzaehlungsbreite + min zwischenraum
+                   - anz zeichen mal einrueckbreite + einrueckbreite - 1)
+   DIV einrueckbreite.
+END PROC pruefe auf ueberschreibung;
+
+(********************** eingabe routinen **************************)
+
+PROC zeile lesen:
+  alte blanks := aktuelle blanks;
+  hole zeile;
+  behandele einrueckung.
+
+hole zeile:
+  IF macro works
+    THEN get macro line (zeile);
+  ELIF eof (eingabe)
+    THEN zeile := "";
+         LEAVE zeile lesen
+    ELSE lesen
+  FI;
+  IF zeile = ""
+    THEN zeile := blank
+  ELIF (zeile SUB length (zeile) - 1) = blank
+    THEN ggf ueberfluessige leerzeichen am ende entfernen
+  FI.
+
+lesen:
+  IF format file in situ
+    THEN read record (eingabe, zeile);
+         delete record (eingabe)
+    ELSE read record (eingabe, zeile);
+         down (eingabe)
+  FI.
+ 
+ggf ueberfluessige leerzeichen am ende entfernen:
+  WHILE NOT within kanji (zeile, length (zeile) - 1) AND
+        subtext (zeile, length (zeile) - 1) = "  " REP 
+    delete char (zeile, length (zeile)) 
+  END REP. 
+ 
+behandele einrueckung:
+  aktuelle blanks := "";
+  IF zeile <> blank
+    THEN INT VAR einrueckung := pos (zeile, ""33"", ""255"", 1);
+         IF einrueckung > 1
+           THEN aktuelle blanks := subtext (zeile, 1, einrueckung - 1);
+                zeile := subtext (zeile, einrueckung)
+         FI
+  FI
+END PROC zeile lesen;
+
+PROC zeile in puffer und zeile lesen:
+  puffer := zeile;
+  zeichenpos := 1;
+  von        := 1;
+  zeile lesen;
+  pufferlaenge := length (puffer);
+  ggf absatz an puffer anfuegen;
+END PROC zeile in puffer und zeile lesen;
+
+PROC ggf absatz an puffer anfuegen:
+  IF    (zeile ist nur absatz AND NOT puffer hat absatz)
+     OR (NOT puffer hat absatz AND only command line (puffer)
+         AND only command line (zeile))
+    THEN puffer CAT blank;
+         pufferlaenge := length (puffer)
+  ELIF puffer ist nur absatz AND (zeile SUB length (zeile)) <> " " AND
+       only command line (zeile)
+    THEN zeile CAT " "
+  FI. 
+ 
+puffer ist nur absatz:
+  puffer = blank.
+
+zeile ist nur absatz: 
+  zeile = blank. 
+END PROC ggf absatz an puffer anfuegen;
+
+(****************** routinen fuer zeilenende behandlung ***********)
+
+PROC verarbeite letztes zeichen von puffer:
+  zeichenpos := length (puffer);
+  begin of this char (puffer, zeichenpos);
+  zeichen := puffer SUB zeichenpos;
+  IF trennung vorhanden
+    THEN IF zeile hat richtige laenge
+           THEN neue zeile auffuellen und ausgabe bei zeilenende
+           ELSE getrennte zeilen zusammenziehen
+         FI
+  ELSE neue zeile auffuellen;
+       IF absatz
+         THEN letzter puffer war absatz := TRUE;
+              IF letztes kommando war macro AND macro hat absatz getaetigt
+                THEN zeile in puffer und zeile lesen;
+                     initialisiere neue zeile;
+                ELSE ausgabe bei zeilenende;
+              FI
+         ELSE neue zeile ggf weiterfuehren
+       FI
+  FI.
+ 
+neue zeile ggf weiterfuehren:
+  IF macro end in dieser oder naechster zeile
+    THEN
+  ELIF zeile = ""
+    THEN schreibe und initialisiere neue zeile;
+         letzter puffer war absatz := TRUE
+  ELIF zeilenbreite + blank breite fuer diesen schrifttyp >
+                                                 aktuelle pitch zeilenlaenge
+    THEN loesche nachfolgende blanks;
+         schreibe und initialisiere neue zeile
+  ELIF in neuer zeile steht etwas
+    THEN neue zeile CAT blank;
+         zeilenbreite INCR blank breite fuer diesen schrifttyp
+  FI;
+  zeile in puffer und zeile lesen.
+
+macro end in dieser oder naechster zeile:
+  macro works AND (pos (puffer, "#*") <> 0 OR pos (zeile, "#*") <> 0).
+
+in neuer zeile steht etwas:
+  pos (neue zeile, ""33"", ""255"", 1) <> 0.
+
+letztes kommando war macro:
+  pos (kommando, "macro") <> 0.
+
+macro hat absatz getaetigt:
+  NOT in neuer zeile steht etwas.
+END PROC verarbeite letztes zeichen von puffer;
+ 
+PROC getrennte zeilen zusammenziehen:
+  zeichen := puffer SUB pufferlaenge;
+  IF NOT within kanji (puffer, pufferlaenge) AND zeichen = trennzeichen
+    THEN zeilenbreite DECR breite (trennzeichen);
+         delete char (puffer, pufferlaenge);
+         pufferlaenge := length (puffer);
+         IF ((puffer SUB pufferlaenge) = trenn k) AND ((zeile SUB 1) = "k")
+           THEN replace (puffer, pufferlaenge, "c");
+                zeilenbreite DECR breite ("k");
+                zeilenbreite INCR breite ("c");
+         FI;
+         zeichenpos := pufferlaenge + 1
+  FI;
+  puffer CAT zeile;
+  zeile lesen;
+  pufferlaenge := length (puffer);
+  ggf absatz an puffer anfuegen;
+END PROC getrennte zeilen zusammenziehen;
+ 
+BOOL PROC trennung vorhanden:
+  IF within kanji (puffer, pufferlaenge)
+    THEN LEAVE trennung vorhanden WITH FALSE
+  FI;
+  zeichen := puffer SUB pufferlaenge;
+  zeichen = trennzeichen OR wort mit bindestrich.
+
+wort mit bindestrich:
+  zeichen = bindestrich AND kein leerzeichen davor
+   AND NOT naechstes wort ist konjunktion AND kein loser gedankenstrich.
+
+kein leerzeichen davor:
+ NOT within kanji (puffer, pufferlaenge - 1) AND
+     (puffer SUB pufferlaenge - 1) <> blank.
+
+naechstes wort ist konjunktion:
+     pos (zeile, "und")   = 1
+  OR pos (zeile, "oder")  = 1
+  OR pos (zeile, "bzw")   = 1
+  OR pos (zeile, "sowie") = 1.
+
+kein loser gedankenstrich:
+  pufferlaenge > 1.
+END PROC trennung vorhanden;
+ 
+BOOL PROC zeile hat richtige laenge:
+  zeilenbreite > aktuelle pitch zeilenlaenge - trennbreite
+END PROC zeile hat richtige laenge;
+
+(*********************** ausgabe routinen *******************)
+
+PROC ende einer neuen zeile:
+  IF zeichenpos > 0
+    THEN begin of this char (puffer, zeichenpos);
+  FI;
+  zeichen := puffer SUB zeichenpos;
+  zeichenpos bereits verarbeitet := 0;
+  IF naechstes zeichen ist absatz
+    THEN zeichenpos := pufferlaenge;
+         verarbeite letztes zeichen von puffer;
+         LEAVE ende einer neuen zeile 
+  ELIF zeichen = blank
+    THEN neue zeile auffuellen (von, zeichenpos - 1);
+         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos); 
+         von := zeichenpos;
+  ELIF nach zeichenpos beginnt ein neues wort
+    THEN neue zeile auffuellen (von, zeichenpos); 
+         zeichenpos := pos (puffer, ""33"", ""255"", zeichenpos + 1);
+         von := zeichenpos
+  ELIF letzter puffer passte genau
+    THEN (* erstes zeichen des neuen puffers > zeilenbreite *)
+         zeichenpos := 1;
+         von := 1
+    ELSE zeichenpos bereits verarbeitet := zeichenpos;
+         trennung eventuell vornehmen;
+         IF erstes wort auf der absatzzeile laesst sich nicht trennen
+           THEN alte blanks := aktuelle blanks
+         FI
+  FI;
+  loesche nachfolgende blanks;
+  IF NOT in foot uebertrag
+    THEN schreibe und initialisiere neue zeile;
+         zeilenbreite und zeichenpos auf das bereits verarbeitete
+         zeichen setzen;
+  FI.
+
+erstes wort auf der absatzzeile laesst sich nicht trennen:
+  pos (neue zeile, ""33"", ""255"", 1) = 0 AND  (*keine buchstaben*)
+  length (neue zeile) > 1 AND                   (*einrueckung*)
+  (neue zeile SUB length (neue zeile)) = blank. (* Absatz *)
+
+naechstes zeichen ist absatz:
+  zeichenpos + 1 = pufferlaenge AND puffer hat absatz.
+
+nach zeichenpos beginnt ein neues wort:
+  (pufferlaenge > zeichenpos + 2) AND (puffer SUB zeichenpos + 1) = blank.
+
+letzter puffer passte genau:
+  zeichenpos <= 0.
+
+zeilenbreite und zeichenpos auf das bereits verarbeitete zeichen setzen:
+  IF zeichenpos bereits verarbeitet <> 0
+    THEN INT VAR bis := zeichenpos, einfuege pos := bis;
+         zeilenbreite um die bereits verarbeiteten zeichen erhoehen; 
+         zeichenpos := zeichenpos bereits verarbeitet;
+         IF einfuege pos > 1
+           THEN insert char (puffer, blank, einfuege pos);
+                pufferlaenge := length (puffer);
+                von := einfuege pos + 1;
+                char pos move (vorwaerts)
+         FI;
+         char pos move (vorwaerts);
+  FI.
+
+zeilenbreite um die bereits verarbeiteten zeichen erhoehen:
+  zeichenpos := zeichenpos bereits verarbeitet;
+  WHILE (puffer SUB bis) = kommandozeichen REP
+    bis := pos (puffer, kommandozeichen, bis + 1) + 1
+  END REP;
+  begin of this char (puffer, zeichenpos);
+  WHILE zeichenpos >= bis REP
+    IF (puffer SUB zeichenpos) = kommandozeichen
+      THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts)
+      ELSE zeilenbreite INCR breite (puffer, zeichenpos);
+    FI;
+    IF zeichenpos <= 1
+      THEN LEAVE zeilenbreite um die bereits verarbeiteten zeichen erhoehen
+    FI;
+    char pos move (rueckwaerts)
+  END REP.
+END PROC ende einer neuen zeile;
+ 
+PROC loesche nachfolgende blanks:
+  WHILE NOT within kanji (neue zeile, length (neue zeile)) AND
+        (neue zeile SUB length (neue zeile)) = blank REP
+    delete char (neue zeile, length (neue zeile))
+  END REP
+END PROC loesche nachfolgende blanks; 
+ 
+PROC neue zeile auffuellen:
+   dummy := subtext (puffer, von);
+   neue zeile CAT dummy
+END PROC neue zeile auffuellen;
+
+PROC neue zeile auffuellen (INT CONST from, to):
+   dummy := subtext (puffer, from, to);
+   neue zeile CAT dummy
+END PROC neue zeile auffuellen;
+
+PROC schreibe neue zeile:
+  IF macro works
+    THEN IF alte neue zeile einschliesslich macro ist auszugeben
+           THEN schreibe textteil einschliesslich macro;
+         FI
+  ELSE schreibe;
+       pruefe auf abbruch
+  FI.
+
+alte neue zeile:
+  before macro state . new line.
+
+alter puffer:
+  before macro state . buffer line.
+
+alte neue zeile einschliesslich macro ist auszugeben:
+  INT VAR text anf :: pos (alte neue zeile, ""33"", ""255"", 1);
+  text anf <> 0.
+
+schreibe textteil einschliesslich macro:
+  dummy := neue zeile;
+  neue zeile := alte neue zeile;
+  IF macro hatte absatz danach
+    THEN neue zeile CAT " "
+    ELSE zeilennr INCR 1
+  FI;
+  schreibe;
+  neue zeile := dummy;
+  alte neue zeile := subtext (alte neue zeile, 1, text anf - 1).
+
+macro hatte absatz danach:
+  length (alter puffer) - 1 = length (alte neue zeile) AND
+     (alter puffer SUB length (alter puffer)) = " ".
+
+pruefe auf abbruch:
+  IF incharety = escape
+    THEN errorstop ("Abbruch mit ESC")
+  FI.
+END PROC schreibe neue zeile;
+
+PROC schreibe:
+  IF format file in situ
+    THEN insert record (eingabe);
+         write record (eingabe, neue zeile);
+         down (eingabe)
+    ELSE insert record (ausgabe);
+         write record  (ausgabe, neue zeile);
+         down (ausgabe);
+         speicher ueberlauf
+  FI;
+  execute stored commands;
+  IF (neue zeile SUB length (neue zeile)) = blank
+    THEN einrueckbreite := eingestellte indentation pitch
+  FI.
+
+speicher ueberlauf:
+  INT VAR size, used;
+  storage (size, used);
+  IF used > size
+    THEN errorstop ("Speicherengpaß")
+  FI.
+END PROC schreibe;
+
+PROC schreibe und initialisiere neue zeile:
+   schreibe neue zeile;
+   initialisiere neue zeile
+END PROC schreibe und initialisiere neue zeile;
+
+PROC ausgabe bei zeilenende:
+  schreibe und initialisiere neue zeile;
+  zeile in puffer und zeile lesen
+END PROC ausgabe bei zeilenende;
+
+PROC neue zeile auffuellen und ausgabe bei zeilenende:
+  neue zeile auffuellen;
+  schreibe und initialisiere neue zeile;
+  zeile in puffer und zeile lesen
+END PROC neue zeile auffuellen und ausgabe bei zeilenende;
+
+PROC initialisiere neue zeile:
+  einrueckung in die neue zeile;
+  zeilennummer mitzaehlen.
+
+einrueckung in die neue zeile:
+  IF  zeichenpos < pufferlaenge AND
+      (puffer hat absatz OR foot ohne absatz am zeilenende)
+    THEN neue zeile := alte blanks
+    ELSE neue zeile := aktuelle blanks
+  FI;
+  zeilenbreite := length (neue zeile) * einrueckbreite;
+  IF zeilenbreite +trennbreite +einrueckbreite >= aktuelle pitch zeilenlaenge
+    THEN fehler (10, "");
+         zeilenbreite := 0;
+  FI.
+
+foot ohne absatz am zeilenende:
+  pos (puffer, "#foot#") > 1 AND pos (puffer, "#foot#") = length (puffer) -5.
+
+zeilennummer mitzaehlen:
+  IF NOT macro works
+    THEN zeilennr INCR 1;
+         cout (zeilennr);
+  FI.
+END PROC initialisiere neue zeile;
+
+PROC letzte neue zeile ausgeben:
+  IF pos (neue zeile, ""33"", ""255"", 1) <> 0
+    THEN schreibe neue zeile
+  FI;
+  offene modifikationen ausgeben;
+  offene indizes ausgeben;
+  IF aktueller editor < 1
+    THEN referenzen ueberpruefen;
+         offene counter referenzen ausgeben;
+  FI.
+
+offene modifikationen ausgeben:
+  WHILE length (modifikations speicher) <> 0 REP
+    dummy := (modifikations speicher SUB 1);
+    delete char (modifikations speicher, 1);
+    dummy CAT " in Zeile ";
+    dummy CAT text (mod zeilennr speicher ISUB 1);
+    delete int (mod zeilennr speicher, 1);
+    warnung (5, dummy)
+  END REP.
+
+offene indizes ausgeben:
+  WHILE length (index speicher) <> 0 REP
+    dummy := (index speicher SUB 1);
+    delete char (index speicher, 1);
+    dummy CAT " in Zeile ";
+    dummy CAT text (ind zeilennr speicher ISUB 1);
+    delete int (ind zeilennr speicher, 1);
+    warnung (6, dummy)
+  END REP.
+
+offene counter referenzen ausgeben:
+  INT VAR begin pos := pos (counter reference store, "#");
+  WHILE begin pos > 0 REP
+    INT VAR end pos := pos (counter reference store, "#", begin pos + 1);
+    IF (counter reference store SUB begin pos - 1) <> "u"
+      THEN fehler (60, subtext (counter reference store, begin pos + 1,
+                                end pos - 1))
+    ELIF (counter reference store SUB begin pos - 2) <> "i"
+      THEN fehler (61, subtext (counter reference store, begin pos + 1,
+                                end pos - 1))
+    FI;
+    begin pos := pos (counter reference store, "#", end pos + 1)
+  END REP.
+END PROC letzte neue zeile ausgeben;
+
+(*********************** silbentrenn routinen *******************)
+
+INT PROC position von (TEXT CONST such zeichen, INT CONST richtung,
+                       INT VAR anz zeich, breite der z):
+  INT VAR index :: zeichenpos;
+  TEXT VAR akt z;
+  anz zeich    := 0;
+  breite der z := 0;
+  WHILE index > 1 AND index < pufferlaenge REP
+    akt z := puffer SUB index;
+    IF akt z   = such zeichen
+      THEN LEAVE position von WITH index
+    ELIF akt z = kommandozeichen
+      THEN ueberspringe das kommando (puffer, index, richtung);
+           IF nur ein kommandozeichen gefunden
+             THEN gehe nur bis erstes kommandozeichen
+           ELIF index <= 1 OR index >= pufferlaenge
+             THEN LEAVE position von WITH index
+           FI
+      ELSE anz zeich INCR 1;
+           breite der z INCR breite (puffer, index)
+    FI;
+    char pos move (index, richtung)
+  END REP;
+  anz zeich INCR 1;
+  breite der z INCR breite (puffer, index);
+  index.
+
+nur ein kommandozeichen gefunden:
+  (puffer SUB index) <> kommandozeichen.
+
+gehe nur bis erstes kommandozeichen:
+  index := zeichenpos; anz zeich := 0; breite der z := 0;
+  WHILE (puffer SUB index) <> kommandozeichen REP
+    anz zeich INCR 1;
+    breite der z INCR breite (puffer, index);
+    char pos move (index, richtung)
+  END REP;
+  IF richtung <> rueckwaerts
+    THEN index DECR 1
+  FI;
+  LEAVE position von WITH index.
+END PROC position von;
+
+PROC ueberspringe das kommando (TEXT CONST t, INT VAR i, INT CONST richtung):
+  REP
+    i INCR richtung;
+    IF within kanji (t, i)
+      THEN i INCR richtung
+    FI
+  UNTIL (t SUB i) = kommandozeichen OR i <= 1 OR i >= length (t) END REP.
+END PROC ueberspringe das kommando;
+
+PROC trennung eventuell vornehmen: 
+INT VAR xwort1, ywort1,
+        anz zeichen davor,
+        breite davor;
+  IF macro works
+    THEN fehler (6, "")
+  FI;
+  trennsymbol := trennzeichen;
+  wortanfang := position von
+                       (blank, rueckwaerts, anz zeichen davor, breite davor);
+  bereite neue zeile bis wortanfang auf;
+  IF trennung sinnvoll
+    THEN versuche zu trennen
+    ELSE zeichenpos := wortanfang
+  FI.
+ 
+bereite neue zeile bis wortanfang auf:
+  IF wortanfang > 1
+    THEN wortanfang INCR 1
+  FI;
+  IF von > wortanfang
+    THEN eliminiere zeichen in neuer zeile bis wortanfang
+    ELSE neue zeile auffuellen (von, wortanfang - 1)
+  FI;
+  von := wortanfang.
+
+eliminiere zeichen in neuer zeile bis wortanfang:
+  INT VAR y :: length (neue zeile);
+  begin of this char (neue zeile, y);
+  WHILE y >= 1 REP
+    IF (neue zeile SUB y) = kommandozeichen
+      THEN ueberspringe das kommando (neue zeile, y, rueckwaerts)
+    FI;
+    char pos move (neue zeile, y, rueckwaerts)
+  UNTIL (neue zeile SUB y) = blank END REP;
+  neue zeile := subtext (neue zeile, 1, y).
+
+trennung sinnvoll:
+  anz zeichen davor > 2 AND breite davor > trennbreite.
+
+versuche zu trennen: 
+  INT CONST k := zeichenpos;
+  naechste zeile ggf heranziehen;
+  zeichenpos := k;
+  wortteile holen;
+  trenn (trennwort ohne komm, wort1 ohne komm, trennsymbol,
+                                               max trennlaenge ohne komm);
+  wort1 mit komm ermitteln;
+  IF lineform mode
+    THEN wort2 := subtext (trennwort, length (wort1) + 1, max trennlaenge);
+         display vorherige zeile bis wortanfang;
+         schreibe nicht trennbaren teil des trennwortes;
+         schreibe zeile nach trennwort;
+         skip input;
+         interaktive worttrennung
+  FI;
+  neue zeile mit trennwort versehen;
+  IF wort1 <> "" AND NOT lineform mode
+    THEN note (zeilen nr); note (": ");
+         note (trennwort);
+         note (" --> ");
+         note (wort1); note (trennsymbol);
+         wort2 := subtext (trennwort, length (wort1) + 1);
+         note (wort2);
+         note line
+  FI.
+
+wortteile holen:
+  zeichenpos durch trennzeichenbreite verschieben;
+  wort1 := subtext (puffer, wortanfang, zeichenpos);
+  max trennlaenge := length (wort1);
+  wortende ermitteln;
+  wort2 := subtext (puffer, zeichenpos, wortende);
+  trennwort := subtext (puffer, wortanfang, wortende);
+  trennwort ohne komm ermitteln;
+  wort1 ohne komm := subtext (trennwort ohne komm, 1, anz zeichen davor);
+  max trenn laenge ohne komm := anz zeichen davor.
+
+trennwort ohne komm ermitteln:
+  trennwort ohne komm := trennwort;
+  WHILE pos (trennwort ohne komm, kommando zeichen) <> 0 REP
+    INT CONST komm anf := pos (trennwort ohne komm, kommando zeichen),
+              komm ende:= pos (trennwort ohne komm, kommando zeichen,
+                                        komm anf + 1);
+    IF komm ende = 0
+      THEN LEAVE trennwort ohne komm ermitteln
+    FI;
+    dummy := subtext (trennwort ohne komm, komm ende + 1);
+    trennwort ohne komm := subtext (trennwort ohne komm, 1, komm anf - 1);
+    trennwort ohne komm CAT dummy;
+  END REP.
+
+wort1 mit komm ermitteln:
+  IF length (wort1 ohne komm) = 0
+    THEN wort1 := "";
+         LEAVE wort1 mit komm ermitteln
+  FI;
+  INT VAR index ohne := 0,
+          index mit  := 0;
+  REP
+    index ohne INCR 1;
+    index mit  INCR 1;
+    WHILE (wort1 SUB index mit) = kommando zeichen REP
+      index mit := pos (wort1, kommando zeichen, index mit + 1) + 1
+    END REP;
+  UNTIL index ohne >= length (wort1 ohne komm) END REP;
+  wort1 := subtext (wort1, 1, index mit). 
+
+zeichenpos durch trennzeichenbreite verschieben:
+  REP
+    zeichen := puffer SUB zeichenpos;
+    IF zeichen = kommandozeichen
+      THEN ueberspringe das kommando (puffer, zeichenpos, rueckwaerts);
+           char pos move (rueckwaerts)
+    ELIF zeichenpos < wortanfang + 1
+      THEN zeichenpos := wortanfang;
+           LEAVE trennung eventuell vornehmen
+      ELSE zeilenbreite DECR breite (puffer, zeichenpos);
+           anz zeichen davor DECR 1;
+           char pos move (rueckwaerts);
+           IF zeilenbreite+breite(trennzeichen) <= aktuellepitchzeilenlaenge
+              AND (puffer SUB zeichenpos) <> kommandozeichen
+             THEN LEAVE zeichenpos durch trennzeichenbreite verschieben
+           FI
+    FI;
+  END REP.
+ 
+wortende ermitteln:
+  INT VAR x1, x2;
+  wortende := position von (blank, 1, x1, x2);
+  IF pufferlaenge > wortende
+   THEN wortende DECR 1
+  FI.
+
+display vorherige zeile bis wortanfang:
+  dummy := neue zeile;
+  dummy CAT subtext (puffer, von, wortanfang - 2);
+  line ;
+  outsubtext (dummy, length (dummy) - 78).
+
+schreibe nicht trennbaren teil des trennwortes:
+  line ;
+  get cursor (xwort1, ywort1);
+  IF length (trennwort) < 70
+    THEN cursor (max trennlaenge + 4, ywort1);
+         outsubtext (trennwort, max trennlaenge + 1)
+  FI.
+ 
+schreibe zeile nach trennwort: 
+   dummy := subtext (puffer, wortende + 1);
+   get cursor (trennwort endepos, ywort1);
+   IF length (trennwort) >= 70
+     THEN
+   ELIF length (dummy) > 75 - trennwort ende pos
+     THEN outsubtext (dummy, 1, 75 - trennwort endepos);
+     ELSE out (dummy);
+          IF (dummy SUB length (dummy)) = blank
+            THEN cursor (78, ywort1);
+                 out (begin mark);
+                 out (end mark)
+          FI
+   FI.
+ 
+trennwort endepos: 
+  xwort1.
+ 
+interaktive worttrennung:
+   REP
+      out (return); 
+      schreibe erstes wort;
+      get cursor (xwort1, ywort1);
+      schreibe trennung;
+      schreibe zweites wort;
+      schreibe rest bei zu langem trennwort;
+      cursor (xwort1, ywort1);
+      hole steuerzeichen und veraendere worte
+   END REP.
+
+schreibe erstes wort:
+  out (begin mark);
+  IF length (trennwort) < 70
+    THEN out (wort1)
+    ELSE outsubtext (wort1, length (wort1) - 60)
+  FI.
+
+schreibe trennung:
+  IF ck vorhanden
+    THEN out (links); out ("k");
+  FI;
+  out (trennsymbol).
+
+schreibe zweites wort:
+  IF length (trennwort) < 70
+    THEN out (wort2)
+    ELSE outsubtext (wort2, 1, 70 - xwort1);
+  FI;
+  out (end mark).
+
+schreibe rest bei zu langem trennwort:
+  IF length (trennwort) >= 70 
+    THEN INT VAR xakt pos;
+         out (cl eol);
+         get cursor (xakt pos, ywort1);
+         outsubtext (trennwort, max trennlaenge + 1,
+                                max trennlaenge + 1 + (78 - xakt pos))
+  FI.
+
+ck vorhanden: 
+  (wort1 SUB length (wort1)) = "c" AND
+              (trennwort SUB (length (wort1) + 1)) = "k".
+ 
+hole steuerzeichen und veraendere worte:
+TEXT VAR steuerzeichen;
+   inchar (steuerzeichen);
+   IF steuerzeichen = links
+     THEN nach links
+   ELIF steuerzeichen = rechts
+     THEN nach rechts
+   ELIF steuerzeichen = hop
+     THEN sprung
+   ELIF steuerzeichen = return
+     THEN line ;
+          LEAVE interaktive worttrennung
+   ELIF steuerzeichen = escape
+     THEN errorstop ("Abbruch mit ESC")
+   ELIF code (steuerzeichen) < 32
+     THEN
+     ELSE trennsymbol := steuerzeichen;
+          LEAVE hole steuerzeichen und veraendere worte
+   FI;
+   IF wort1 = ""
+      OR (wort1 SUB length (wort1)) = bindestrich 
+     THEN trennsymbol := blank 
+     ELSE trennsymbol := trennzeichen 
+   FI. 
+ 
+nach links:
+TEXT VAR ein zeichen;
+INT VAR  position;
+   IF length (wort1) <> 0
+     THEN position := length (wort1);
+          IF (wort1 SUB position) = kommando zeichen
+            THEN ueberspringe das kommando (wort1, position, rueckwaerts);
+          FI;
+          position DECR 1;
+          wort1 := subtext (trennwort, 1, position);
+          wort2 := subtext (trennwort, position + 1, max trennlaenge); 
+          IF rechtes teilwort mit bindestrich
+            THEN ein zeichen := (wort1 SUB length (wort1));
+                 delete char (wort1, length (wort1));
+                 insert char (wort2, ein zeichen, 1)
+          FI
+   FI.
+
+nach rechts:
+   IF length (wort1) <  max trennlaenge
+     THEN position := length (wort1) + 1;
+          IF (trennwort SUB position) = kommando zeichen
+            THEN ueberspringe das kommando (trennwort, position, +1);
+          FI;
+          wort1 := subtext (trennwort, 1, position);
+          wort2 := subtext (trennwort, position + 1, max trennlaenge); 
+          IF rechtes teilwort mit bindestrich
+            THEN wort1 CAT bindestrich;
+                 delete char (wort2, 1)
+          FI
+   FI.
+ 
+rechtes teilwort mit bindestrich:
+  (wort2 SUB 1) = bindestrich AND
+                             pos (buchstaben, wort1 SUB length (wort1)) <> 0.
+
+sprung:
+   inchar(steuerzeichen);
+   IF steuerzeichen = rechts
+     THEN wort1 := subtext (trennwort, 1, max trennlaenge);
+          wort2 := ""
+   ELIF steuerzeichen = links
+     THEN wort1 := "";
+          wort2 := subtext (trennwort, 1, max trennlaenge)
+   FI.
+
+neue zeile mit trennwort versehen:
+  IF wort1 = ""
+    THEN keine trennung
+    ELSE zeichenpos := wortanfang + length (wort1); 
+         mit trennsymbol trennen;
+         von := zeichenpos
+  FI.
+ 
+keine trennung:
+  IF wort ist zu lang fuer limit
+    THEN warnung (7, trennwort);
+         neue zeile CAT trennwort;
+         zeichenpos := wortende + 1;
+         zeichenpos bereits verarbeitet := 0;
+         von := zeichenpos
+    ELSE loesche nachfolgende blanks;
+         zeichenpos := wortanfang
+  FI.
+
+wort ist zu lang fuer limit:
+  length (alte blanks) * einrueckbreite + breite davor + trennbreite
+                                             >= aktuelle pitch zeilenlaenge.
+
+mit trennsymbol trennen:
+  IF (wort1 SUB length (wort1)) = "c" AND
+      (trennwort SUB (length (wort1) + 1)) = "k"
+    THEN replace (wort1, length (wort1), trenn k)
+  FI;
+  neue zeile CAT wort1;
+  IF trennsymbol <> blank
+    THEN neue zeile CAT trennsymbol
+  FI.
+END PROC trennung eventuell vornehmen;
+ 
+PROC naechste zeile ggf heranziehen:
+  IF puffer hat absatz
+     OR puffer hat noch mindestens zwei woerter
+     OR zeile hat eine foot anweisung
+     OR in foot uebertrag
+    THEN LEAVE naechste zeile ggf heranziehen
+  ELIF trennung vorhanden
+    THEN IF zeichenpos < pufferlaenge
+           THEN zeilenbreite INCR breite (trennzeichen)
+         FI;
+         getrennte zeilen zusammenziehen;
+         LEAVE naechste zeile ggf heranziehen
+  FI;
+  puffer CAT blank;
+  puffer CAT zeile;
+  zeile lesen;
+  pufferlaenge := length (puffer);
+  ggf absatz an puffer anfuegen.
+ 
+puffer hat noch mindestens zwei woerter:
+  INT VAR anz :: 0, i :: zeichenpos;
+  WHILE pos (puffer, " ", i) > 0 REP
+    anz INCR 1;
+    i := pos (puffer, " ", i) + 1
+  END REP;
+  anz > 1.
+
+zeile hat eine foot anweisung:
+  pos (puffer, "#foot") <> 0.
+END PROC naechste zeile ggf heranziehen; 
+ 
+(******************** initialisierungs routine *******************)
+
+PROC form initialisieren (TEXT CONST datei):
+   kommando liste :=
+"type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2
+pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0
+headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0";
+   kommando liste CAT
+"material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1
+goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0
+rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0";
+  kommando liste CAT
+"center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0
+bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2
+markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01
+storecounter:69.1";
+  kommando liste CAT 
+"ub:70.0ue:71.0fb:72.0fe:73.0";
+  line ;
+  erste fehlerzeilennr    := 0;
+  anz tabs                := 0;
+  zeilennr                := 0;
+  zeilenbreite            := 0;
+  anz blanks freihalten   := 3;
+  herkunftsreferenzen     := "#";
+  zielreferenzen          := "#";
+  aktuelle blanks         := "";
+  font nr speicher        := "";
+  modifikationsspeicher   := "";
+  mod zeilennr speicher   := "";
+  index speicher          := "";
+  ind zeilennr speicher   := "";
+  counter numbering store := "";
+  counter reference store := "";
+  command store           := "";
+  kommando                := "";
+  neue zeile              := "";
+  zeile                   := "";
+  puffer                  := " ";
+  macro works             := FALSE;
+  in tabelle              := FALSE;
+  in d und e verarbeitung := FALSE;
+  kommandos speichern     := TRUE;
+  in foot                 := FALSE;
+  in foot uebertrag       := FALSE;
+  test ob font table vorhanden;
+  bildschirm initialisieren;
+  zeile lesen;
+  zeile in puffer und zeile lesen;
+  einrueckung zweite zeile := "xxx";
+  limit und type ggf anfragen;
+  einrueckbreite := eingestellte indentation pitch ;
+  initialisiere neue zeile;
+  IF einrueckung zweite zeile <> "xxx"
+    THEN aktuelle blanks := einrueckung zweite zeile
+  FI.
+
+test ob font table vorhanden:
+  INT VAR xxx :: x step conversion (0.0). 
+
+bildschirm initialisieren:
+  IF online
+    THEN init
+  FI.
+
+init:
+   page;
+   IF lineform mode
+     THEN put ("LINEFORM") 
+     ELSE put ("AUTOFORM")
+   FI;
+   put ("(für"); put (lines (eingabe)); put ("Zeilen):");
+   put (datei);
+   cursor (1, 3).
+END PROC form initialisieren;
+
+PROC limit und type ggf anfragen:
+  conversion (limit in cm, aktuelle pitch zeilenlaenge);
+  IF ask type and limit
+    THEN type und limit setzen
+    ELSE alter schriftname := kein vorhandener schriftname;
+         stelle font ein
+  FI;
+  REAL VAR x :: limit in cm;
+  conversion (x, aktuelle pitch zeilenlaenge);
+  IF x = fehler wert
+    THEN limit in cm := 16.0;
+         conversion (limit in cm, aktuelle pitch zeilenlaenge)
+    ELSE limit in cm := x
+  FI;
+  trennbreite setzen.
+
+type und limit setzen:
+  LET type text                    = "#type (""",
+      limit text                   = "#limit (",
+      kommando ende text           = ")#",
+      kein vorhandener schriftname = "#####";
+  IF type und limit anweisungen nicht vorhanden
+    THEN type und limit fragen
+    ELSE hole font;
+         alter schriftname := kein vorhandener schriftname
+  FI.
+
+type und limit fragen:
+  type anfragen;
+  type in neue zeile;
+  limit anfragen;
+  limit in neue zeile;
+  IF NOT format file in situ
+    THEN schreibe neue zeile;
+         zeilen nr INCR 1
+  FI;
+  IF NOT puffer hat absatz
+    THEN einrueckung zweite zeile := aktuelle blanks;
+         aktuelle blanks := alte blanks;(* Einrueckung fuer die erste zeile*)
+  FI;
+  line.
+
+type und limit anweisungen nicht vorhanden:
+  (pos (puffer, type text) <> 1 OR pos (puffer, "limit") < 12).
+
+type anfragen:
+  put ("Bitte Schrifttyp    :");
+  IF font table name = font table
+    THEN dummy := font (font nr);
+    ELSE dummy := font (1);
+         font table name := font table
+  FI;
+  REP
+    editget (dummy);
+    IF font exists (dummy)
+      THEN alter schriftname := dummy;
+           font nr := font (dummy);
+           hole font;
+           LEAVE type anfragen
+      ELSE line ;
+           put ("ERROR: unbekannter Schrifttyp");
+           line (2);
+           put ("Schrifttyp bitte nochmal:")
+    FI
+  END REP.
+
+type in neue zeile:
+  neue zeile := type text;
+  neue zeile CAT dummy;
+  neue zeile CAT """";
+  neue zeile CAT kommando ende text.
+ 
+limit anfragen:
+  line ;
+  put ("Zeilenbreite (in cm):");
+  dummy := text (limit in cm);
+  REP
+    editget (dummy);
+    limit in cm := real (dummy);
+    IF last conversion ok AND pos (dummy, ".") <> 0
+      THEN LEAVE limit anfragen
+      ELSE line ;
+           put ("ERROR: Falsche Angabe");
+           line (2);
+           put ("Zeilenbreite (in cm) bitte nochmal:");
+    FI
+  END REP.
+
+limit in neue zeile:
+  neue zeile CAT limit text;
+  neue zeile CAT dummy;
+  neue zeile CAT kommando ende text;
+  neue zeile CAT " ".
+END PROC limit und type ggf anfragen;
+
+PROC start form (TEXT CONST datei): 
+  IF NOT format file in situ 
+    THEN last param (datei);
+  FI;
+  disable stop; 
+     dateien assoziieren;
+     zeilen form (datei);
+     IF is error
+       THEN fehlerbehandlung
+       ELSE datei neu nach alt kopieren
+     FI;
+     zwischendatei loeschen;
+  enable stop;
+  col (eingabe, 1);
+  IF aktueller editor > 0
+    THEN set range (file, alter bereich)
+  FI;
+  IF anything noted
+    THEN IF aktueller editor = 0
+           THEN to line (eingabe, erste fehler zeilen nr);
+           ELSE alles neu
+         FI;
+         note edit (eingabe)
+  ELIF NOT format file in situ
+    THEN to line (eingabe, 1)
+  FI.
+
+dateien assoziieren:
+  IF format file in situ 
+    THEN
+  ELIF exists (datei)
+    THEN IF subtext (datei, length (datei) - 1) = ".p"
+           THEN errorstop
+                ("'.p'-Datei kann nicht mit lineform bearbeitet werden")
+         FI;
+         eingabe := sequential file (modify, datei);
+         ausgabe datei einrichten
+    ELSE errorstop ("Datei existiert nicht")
+  FI;
+  to line (eingabe, 1);
+  col (eingabe, 1).
+
+ausgabe datei einrichten:
+  ds := nilspace;
+  ausgabe := sequential file (modify, ds);
+  to line (ausgabe, 1);
+  copy attributes (eingabe, ausgabe).
+
+fehlerbehandlung:
+  put error;
+  clear error;
+  font nr := 1;
+  font table name := "";
+  limit in cm := 16.0;
+  IF format file in situ
+    THEN insert record (eingabe);
+         write record  (eingabe, neue zeile);
+         down (eingabe);
+         insert record (eingabe);
+         write record  (eingabe, puffer);
+         down (eingabe);
+         insert record (eingabe);
+         write record  (eingabe, zeile)
+  FI.
+
+datei neu nach alt kopieren:
+  IF NOT format file in situ 
+    THEN forget (datei, quiet);
+         copy (ds, datei);
+         eingabe := sequential file (modify, datei)
+  FI. 
+
+zwischendatei loeschen:
+  IF NOT format file in situ 
+    THEN forget (ds)
+  FI.
+END PROC start form;
+ 
+(************** line/autoform fuer benannte Dateien ******************)
+
+PROC lineform:
+  IF aktueller editor > 0
+    THEN IF mark
+           THEN editor bereich bearbeiten
+           ELSE errorstop ("kein markierter Bereich")
+         FI
+    ELSE lineform (last param)
+  FI.
+
+editor bereich bearbeiten:
+  disable stop;
+    file := editfile; 
+    set marked range (file, alter bereich); 
+    lineform (file);
+  enable stop;
+END PROC lineform;
+ 
+PROC lineform (TEXT CONST datei):
+  ask type and limit  := TRUE;
+  lineform mode       := TRUE;
+  format file in situ := FALSE; 
+  start form (datei)
+END PROC lineform;
+ 
+PROC autoform:
+  IF aktueller editor > 0
+    THEN IF mark
+           THEN editor bereich bearbeiten
+           ELSE errorstop ("kein markierter Bereich")
+         FI
+    ELSE auto form (last param)
+  FI.
+
+editor bereich bearbeiten:
+  disable stop;
+    file := editfile; 
+    set marked range (file, alter bereich); 
+    autoform (file);
+  enable stop
+END PROC autoform;
+
+PROC autoform (TEXT CONST datei):
+  ask type and limit  := TRUE;
+  lineform mode       := FALSE;
+  format file in situ := FALSE; 
+  start form (datei)
+END PROC autoform;
+ 
+(******************** line/autoform fuer files ************************)
+
+PROC lineform (FILE VAR f):
+  enable stop;
+  eingabe := f; 
+  format file in situ := TRUE;
+  ask type and limit  := TRUE;
+  lineform mode       := TRUE;
+  start form ("");
+END PROC lineform;
+
+PROC autoform (FILE VAR f):
+  enable stop;
+  eingabe := f; 
+  format file in situ := TRUE;
+  ask type and limit  := TRUE;
+  lineform mode       := FALSE;
+  start form ("");
+END PROC autoform;
+
+PROC lineform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): 
+  eingabe := f; 
+  format file in situ := TRUE;
+  lineform mode       := TRUE; 
+  ask type and limit  := FALSE;
+  par1        := type name; 
+  limit in cm := file limit;
+  start form (""); 
+END PROC lineform; 
+
+PROC autoform (FILE VAR f, TEXT CONST type name, REAL CONST file limit): 
+  eingabe := f; 
+  format file in situ := TRUE;
+  lineform mode       := FALSE; 
+  ask type and limit  := FALSE;
+  par1        := type name; 
+  limit in cm := file limit;
+  start form (""); 
+END PROC autoform; 
+END PACKET liner;
+(*
+REP
+    copy("lfehler","zz");
+    IF yes ("autoform")
+      THEN autoform ("zz")
+      ELSE lineform ("zz")
+    FI;
+    edit("zz");
+    forget("zz")
+UNTIL yes ("ENDE") ENDREP;
+*)
+
diff --git a/system/multiuser/1.7.5/src/macro store b/system/multiuser/1.7.5/src/macro store
new file mode 100644
index 0000000..dc13a1b
--- /dev/null
+++ b/system/multiuser/1.7.5/src/macro store
@@ -0,0 +1,298 @@
+(* ------------------- VERSION 13 vom 28.05.86 -------------------- *)
+PACKET macro store DEFINES macro command and then process parameters,
+                           get macro line,
+                           number macro lines,
+                           load macros,
+                           list macros:
+
+(* Programm zur Behandlung von Textkosemtik-Macros
+   Autor: Rainer Hahn
+   Stand: 1.7.1 (Febr. 1984)
+*)
+
+INITFLAG VAR this packet :: FALSE;
+
+DATASPACE VAR ds;
+
+BOUND MACROTABLE VAR macro table;
+
+FILE VAR f;
+
+LET MACROTABLE = STRUCT (ROW max macros TEXT replacement store,
+                         ROW max macro zeilen TEXT macro zeilen,
+                         ROW max macros TEXT macro namen,
+                         ROW max macros INT  anz parameter,
+                         ROW max macros INT  macro start);
+
+ 
+LET tag              = 1, 
+    number           = 3,
+    delimiter        = 6, 
+    end of scan      = 7,
+    max macro zeilen = 1000,
+    max macros       = 200;
+
+INT VAR index aktuelle macro zeile,
+        type,
+        anz zeilen in macro,
+        anz macro zeilen,
+        anz macros :: 0;
+
+TEXT VAR symbol,
+         fehlertext, 
+         dummy,
+         kommando,
+         zeile;
+
+BOOL VAR with parameters,
+         macro end gewesen;
+
+PROC init macros:
+  IF NOT initialized (this packet)
+    THEN ds := nilspace;
+         macro table := ds;
+         macros leeren
+  FI.
+
+macros leeren:
+  anz macro zeilen := 0;
+  anz macros := 0.
+END PROC init macros;
+
+PROC load macros (TEXT CONST fname):
+  init macros;
+  line;
+  IF exists (fname)
+    THEN f := sequential file (input, fname);
+         forget (ds);
+         ds := nilspace;
+         macro table := ds;
+         macros einlesen
+    ELSE errorstop ("Datei existiert nicht")
+  FI.
+
+macros einlesen:
+  macro end gewesen := TRUE;
+  anz macros        := 0;
+  anz macro zeilen  := 0;
+  WHILE NOT eof (f) REP
+    anz macro zeilen INCR 1;
+    IF anz macro zeilen > max macro zeilen
+      THEN errorstop ("Zu viele Zeilen (max.1000)") 
+    FI;
+    cout (anz macro zeilen);
+    getline (f, zeile);
+    IF zeile = ""
+      THEN zeile := " "
+    ELIF pos (zeile, "#*") > 0
+      THEN macro name oder end vermerken
+    FI;
+    IF macro end gewesen AND zeile = " "
+      THEN anz macro zeilen DECR 1
+      ELSE macro table . macro zeilen [anz macro zeilen] := zeile
+    FI
+  END REP;
+  anz macro zeilen INCR 1;
+  macro table . macro zeilen [anz macro zeilen] := " "; 
+  IF anz macros = 0
+    THEN putline  ("Macros geleert")
+  FI.
+
+macro name oder end vermerken:
+  INT CONST komm anfang :: pos (zeile, "#*") + 2,
+            komm ende   :: pos (zeile, "#", komm anfang);
+  IF komm anfang <> 3 OR hinter dem kommando steht noch was
+    THEN errorstop ("Macro-Anweisung steht nicht alleine auf der Zeile");
+  FI;
+  kommando := subtext (zeile, komm anfang, komm ende -1); 
+  scan (kommando); 
+  next symbol (symbol, type); 
+  IF type = tag 
+    THEN macro namen aufnehmen
+    ELSE errorstop ("kein Macroname nach #*") 
+  FI; 
+  next symbol (symbol, type);
+  IF type >= end of scan 
+    THEN macro table . anz parameter [anz macros] := 0; 
+         LEAVE macro name oder end vermerken 
+  ELIF symbol = "(" 
+    THEN parameter aufsammeln;
+    ELSE errorstop ("keine ( nach Macro-Name") 
+  FI.
+ 
+macro namen aufnehmen:
+  IF symbol = "macroend"
+    THEN put ("mit"); put (macro table . anz parameter [anz macros]);
+         put ("Parameter(n) geladen"); 
+         macro end gewesen := TRUE;
+         line;
+         LEAVE macro name oder end vermerken
+  ELIF NOT macro end gewesen
+    THEN errorstop ("macro end fehlt")
+    ELSE macro end gewesen := FALSE;
+         anz macros INCR 1; 
+         IF anz macros > max macros 
+           THEN errorstop ("Zu viele Macros (max. 200") 
+         FI;
+         macro table . macro namen [anz macros] := symbol;
+         macro table . macro start [anz macros] := anz macro zeilen;
+         line;
+         put (symbol);
+  FI.
+
+hinter dem kommando steht noch was:
+  NOT (komm ende = length (zeile) COR
+    (komm ende + 1 = length (zeile) AND (zeile SUB komm ende + 1) = " ")).
+ 
+parameter aufsammeln: 
+  INT VAR parameter number :: 1;
+  next symbol (symbol, type); 
+  WHILE symbol = "$" REP 
+    next symbol (symbol, type); 
+    IF type = number CAND int (symbol) = parameter number 
+      THEN IF parameter number > 9
+             THEN errorstop ("Anzahl Parameter > 9")
+           FI;
+           macro table . anz parameter [anz macros] := parameter number; 
+           parameter number INCR 1; 
+      ELSE errorstop ("Parameter-Nummer inkorrekt: " + symbol)
+    FI;  
+    next symbol (symbol, type); 
+    IF symbol = ")" 
+      THEN LEAVE parameter aufsammeln 
+    ELIF symbol = "," 
+      THEN next symbol (symbol, type) 
+      ELSE errorstop (", oder ) erwartet:" + symbol) 
+    FI 
+  END REP;
+  errorstop ("Parameterliste inkorrekt bei" + symbol).
+END PROC load macros;
+
+PROC load macros: 
+  load macros (last param)
+END PROC load macros;
+
+PROC list macros:
+  init macros;
+  note ("");
+  INT VAR i := 1;
+  WHILE i <= anz macro zeilen REP
+    cout (i);
+    note (macro table . macro zeilen [i]);
+    note line;
+    i INCR 1
+  END REP;
+  note edit
+END PROC list macros;
+
+BOOL PROC macro exists (TEXT CONST name, INT VAR anz params):
+  INT VAR i;
+  FOR i FROM 1 UPTO anz macros REP
+    IF macro table . macro namen [i] = name
+      THEN anz params := macro table . anz parameter [i]; 
+           index aktuelle macro zeile := macro table . macro start [i] + 1;
+           berechne anzahl zeilen in macro;
+           IF anz params = 0 
+             THEN with parameters := FALSE 
+             ELSE with parameters := TRUE;
+                  lade macro in replacement store;
+                  index aktuelle macro zeile := 1;
+           FI;
+           LEAVE macro exists WITH TRUE
+    FI
+  END REP;
+  FALSE.
+ 
+berechne anzahl zeilen in macro: 
+  IF i = anz macros 
+    THEN anz zeilen in macro := 
+           anz macro zeilen - index aktuelle macro zeile; 
+    ELSE anz zeilen in macro := 
+           macro table . macro start [i + 1] - index aktuelle macro zeile 
+  FI.
+ 
+lade macro in replacement store: 
+  INT VAR k; 
+  FOR k FROM 1 UPTO anz zeilen in macro REP 
+    macro table . replacement store [k] := 
+          macro table . macro zeilen [index aktuelle macro zeile +k-1]
+  END REP. 
+END PROC macro exists;
+
+PROC replace macro parameter (INT CONST number, TEXT CONST param): 
+  TEXT VAR param text := "$" + text (number); 
+  INT VAR k; 
+  FOR k FROM 1 UPTO anz zeilen in macro - 1 REP 
+    change all (macro table . replacement store [k], param text, param); 
+  END REP 
+END PROC replace macro parameter; 
+ 
+BOOL PROC macro command and then process parameters (TEXT VAR komm):
+  init macros;
+  LET tag = 1;
+  scan (komm); 
+  next symbol (symbol, type); 
+  IF type = tag  
+    THEN untersuche ob deklariertes macro 
+    ELSE FALSE 
+  FI. 
+ 
+untersuche ob deklariertes macro: 
+  INT VAR anz macro params; 
+  IF macro exists (symbol, anz macro params) 
+    THEN fehlertext := "in Makro: "; fehlertext CAT symbol;
+         IF anz macro params > 0 
+           THEN macro parameter ersetzen
+         FI;
+         TRUE 
+    ELSE FALSE 
+  FI. 
+ 
+macro parameter ersetzen:
+  next symbol (symbol, type); 
+  IF symbol = "(" 
+    THEN ersetze 
+    ELSE report text processing error (34, 0, dummy, symbol + fehlertext); 
+         LEAVE macro command and then process parameters WITH FALSE 
+  FI.
+ 
+ersetze: 
+  LET text type = 4,
+      end of scan = 7;
+  INT VAR number parameter :: 1;
+  REP  
+    next symbol (symbol, type);  
+    IF type = texttype 
+      THEN replace macro parameter (number parameter, symbol);
+      ELSE report text processing error (35, 0, dummy, fehlertext + symbol); 
+           LEAVE macro command and then process parameters WITH FALSE 
+    FI; 
+    number parameter INCR 1; 
+    IF number parameter > anz macro params 
+      THEN LEAVE macro command and then process parameters WITH TRUE 
+    FI; 
+    next symbol (symbol, type); 
+    IF symbol <> "," OR type >= end of scan
+      THEN report text processing error (36, 0, dummy, fehlertext + symbol); 
+           LEAVE macro command and then process parameters WITH FALSE 
+    FI 
+  END REP.
+END PROC macro command and then process parameters;
+ 
+PROC get macro line (TEXT VAR macro zeile):
+  IF index aktuelle macro zeile > anz zeilen in macro
+    THEN macro zeile := "#### "
+  ELIF with parameters 
+    THEN macro zeile :=
+           macro table . replacement store [index aktuelle macro zeile]
+    ELSE macro zeile := 
+           macro table . macro zeilen [index aktuelle macro zeile] 
+  FI; 
+  index aktuelle macro zeile INCR 1; 
+END PROC get macro line;
+ 
+INT PROC number macro lines: 
+  anz zeilen in macro
+END PROC number macro lines; 
+END PACKET macro store;
+
diff --git a/system/multiuser/1.7.5/src/multi user monitor b/system/multiuser/1.7.5/src/multi user monitor
new file mode 100644
index 0000000..dd3051e
--- /dev/null
+++ b/system/multiuser/1.7.5/src/multi user monitor
@@ -0,0 +1,93 @@
+(* ------------------- VERSION 2      16.05.86 ------------------- *)
+PACKET multi user monitor DEFINES              (* Autor: J.Liedtke *)
+
+    monitor :
+ 
+ 
+LET command list =
+ 
+"edit:1.01run:4.01runagain:6.0insert:7.01forget:9.01rename:11.2copy:12.2
+list:13.0storageinfo:14.0taskinfo:15.0
+fetch:16.1save:17.01break:19.0saveall:20.0 " ;
+
+LET text param type = 4 ;
+
+ 
+INT VAR command index , number of params , previous heap size ;
+TEXT VAR param 1, param 2 ;
+ 
+ 
+  lernsequenz auf taste legen ("q", ""1""8""1""12"break"13"") ;
+  lernsequenz auf taste legen ("e", ""1""8""1""12"edit"13"") ;
+
+
+PROC monitor :
+ 
+  disable stop ;
+  previous heap size := heap size ;
+  REP 
+    command dialogue (TRUE) ;
+    sysin ("") ;
+    sysout ("") ;
+    cry if not enough storage ;
+    get command ("gib kommando :") ;
+    reset editor ;
+    analyze command (command list, text param type,
+                     command index, number of params, param1, param2) ;
+    execute command ;
+    collect heap garbage if necessary
+  PER .
+ 
+collect heap garbage if necessary :
+  IF heap size > previous heap size + 10
+    THEN collect heap garbage ;
+         previous heap size := heap size
+  FI .
+
+cry if not enough storage :
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used > size
+    THEN out (""7"Speicher Engpass! Dateien loeschen!"13""10"")
+  FI .
+
+reset editor :
+  WHILE aktueller editor > 0 REP
+    quit
+  PER ;
+  clear error .
+
+ENDPROC monitor ;
+
+PROC execute command :
+
+  enable stop ;
+  SELECT command index OF
+    CASE 1 : edit
+    CASE 2 : edit (param1)
+    CASE 3 : (* war frueher paralleleditor *)
+    CASE 4 : run
+    CASE 5 : run (param1)
+    CASE 6 : run again
+    CASE 7 : insert
+    CASE 8 : insert (param1)
+    CASE 9 : forget
+    CASE 10: forget (param1)
+    CASE 11: rename (param1, param2)
+    CASE 12: copy (param1, param2)
+    CASE 13: list
+    CASE 14: storage info
+    CASE 15: task info
+    CASE 16: fetch (param1)
+    CASE 17: save
+    CASE 18: save (param1)
+    CASE 19: break
+    CASE 20: save all
+
+    OTHERWISE do command
+  ENDSELECT .
+ 
+ENDPROC  execute command ;
+ 
+ENDPACKET multi user monitor ;
+
diff --git a/system/multiuser/1.7.5/src/nameset b/system/multiuser/1.7.5/src/nameset
new file mode 100644
index 0000000..8ea4359
--- /dev/null
+++ b/system/multiuser/1.7.5/src/nameset
@@ -0,0 +1,355 @@
+(* ------------------- VERSION 3     17.03.86 ------------------- *)
+PACKET name set DEFINES                       (* Autor: J.Liedtke *)
+ 
+       ALL ,
+       SOME ,
+       LIKE ,
+       + ,
+       - ,
+       / ,
+       do ,
+       FILLBY ,
+       remainder ,
+       
+       fetch ,
+       save ,
+       fetch all ,
+       save all ,
+       forget ,
+       erase ,
+       insert ,
+       edit :
+
+
+LET cr lf = ""13""10"" ;
+
+TEXT VAR name ;
+DATASPACE VAR edit space ;
+
+THESAURUS VAR remaining thesaurus := empty thesaurus ;
+
+
+THESAURUS OP + (THESAURUS CONST left, right) :
+
+  THESAURUS VAR union := left ;
+  INT VAR index := 0 ;
+  get (right, name, index) ;
+  WHILE name <> "" REP
+    IF NOT (union CONTAINS name)
+      THEN insert (union, name)
+    FI ;
+    get (right, name, index)
+  PER ;
+  union .
+
+ENDOP + ;
+
+THESAURUS OP + (THESAURUS CONST left, TEXT CONST right) :
+
+  THESAURUS VAR union := left ;
+  IF NOT (union CONTAINS right)
+    THEN insert (union, right)
+  FI ;
+  union .
+
+ENDOP + ;
+
+THESAURUS OP - (THESAURUS CONST left, right) :
+
+  THESAURUS VAR difference := empty thesaurus ;
+  INT VAR index := 0 ;
+  get (left, name, index) ;
+  WHILE name <> "" REP
+    IF NOT (right CONTAINS name)
+      THEN insert (difference, name)
+    FI ;
+    get (left, name, index)
+  PER ;
+  difference .
+
+ENDOP - ;
+
+THESAURUS OP - (THESAURUS CONST left, TEXT CONST right) :
+
+  THESAURUS VAR difference := left ;
+  INT VAR index ;
+  delete (difference, right, index) ;
+  difference .
+
+ENDOP - ;
+
+THESAURUS OP / (THESAURUS CONST left, right) :
+
+  THESAURUS VAR intersection := empty thesaurus ;
+  INT VAR index := 0 ;
+  get (left, name, index) ;
+  WHILE name <> "" REP
+    IF right CONTAINS name
+      THEN insert (intersection, name)
+    FI ;
+    get (left, name, index)
+  PER ;
+  intersection .
+
+ENDOP / ;
+
+THESAURUS OP ALL (TEXT CONST file name) :
+
+  FILE VAR file := sequential file (input, file name) ;
+  THESAURUS VAR thesaurus := empty thesaurus ;
+  thesaurus FILLBY file ;
+  thesaurus .
+
+ENDOP ALL ;
+
+THESAURUS OP SOME (THESAURUS CONST thesaurus) :
+
+  copy thesaurus into file ;
+  edit file ;
+  copy file into thesaurus .
+
+copy thesaurus into file :
+  forget (edit space) ;
+  edit space := nilspace ;
+  FILE VAR file := sequential file (output, edit space) ;
+  file FILLBY thesaurus .
+  
+edit file :
+  modify (file) ;
+  edit (file) .
+
+copy file into thesaurus :
+  THESAURUS VAR result := empty thesaurus ;
+  input (file) ;
+  result FILLBY file ;
+  forget (edit space) ;
+  result .
+
+ENDOP SOME ;
+
+THESAURUS OP SOME (TASK CONST task) :
+
+  SOME ALL task
+
+ENDOP SOME ;
+
+THESAURUS OP SOME (TEXT CONST file name) :
+
+  SOME ALL file name
+
+ENDOP SOME ;
+
+THESAURUS OP LIKE (THESAURUS CONST thesaurus, TEXT CONST pattern) : 
+ 
+  THESAURUS VAR result:= empty thesaurus ; 
+  INT VAR index:= 0 ; 
+  REP get (thesaurus, name, index) ; 
+    IF name = "" 
+      THEN LEAVE LIKE WITH result 
+    ELIF name LIKE pattern 
+      THEN insert (result, name) 
+    FI 
+ PER ; 
+ result .
+ 
+ENDOP LIKE ; 
+
+THESAURUS PROC remainder :
+
+  remaining thesaurus
+
+ENDPROC remainder ;
+
+PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) :
+
+  INT VAR index := 0 , operation number := 0 ;
+  TEXT VAR name ;
+  
+  remaining thesaurus := empty thesaurus ;
+  disable stop ;
+  work off thesaurus ;
+  fill leftover with remainder .
+
+work off thesaurus :
+  REP
+    get (thesaurus, name, index) ;
+    IF name = ""
+      THEN LEAVE work off thesaurus
+    FI ;
+    operation number INCR 1 ;
+    cout (operation number) ;
+    execute (PROC (TEXT CONST) operate, name)
+  UNTIL is error ENDREP .
+
+fill leftover with remainder :
+  WHILE name <> "" REP
+    insert (remaining thesaurus, name) ;
+    get (thesaurus, name, index)
+  PER .
+
+ENDPROC do ;
+ 
+PROC execute (PROC (TEXT CONST) operate, TEXT CONST name) :
+
+  enable stop ;
+  operate (name)
+
+ENDPROC execute ;
+ 
+PROC do (PROC (TEXT CONST, TASK CONST) operate, THESAURUS CONST thesaurus,
+         TASK CONST task) :
+
+  INT VAR index := 0 , operation number := 0 ;
+  TEXT VAR name ;
+  
+  remaining thesaurus := empty thesaurus ;
+  disable stop ;
+  work off thesaurus ;
+  fill leftover with remainder .
+
+work off thesaurus :
+  REP
+    get (thesaurus, name, index) ;
+    IF name = ""
+      THEN LEAVE work off thesaurus
+    FI ;
+    operation number INCR 1 ;
+    cout (operation number) ;
+    execute (PROC (TEXT CONST, TASK CONST) operate, name, task)
+  UNTIL is error ENDREP .
+
+fill leftover with remainder :
+  WHILE name <> "" REP
+    insert (remaining thesaurus, name) ;
+    get (thesaurus, name, index)
+  PER .
+
+ENDPROC do ;
+ 
+PROC execute (PROC (TEXT CONST, TASK CONST) operate,
+              TEXT CONST name, TASK CONST task) :
+
+  enable stop ;
+  operate (name, task)
+
+ENDPROC execute ;
+ 
+OP FILLBY (THESAURUS VAR thesaurus, FILE VAR file) :
+
+  WHILE NOT eof (file) REP
+    getline (file, name) ;
+    delete trailing blanks ;
+    IF name <> "" CAND NOT (thesaurus CONTAINS name)
+      THEN insert (thesaurus, name)
+    FI
+  PER .
+
+delete trailing blanks :
+  WHILE (name SUB LENGTH name) = " " REP
+    name := subtext (name, 1, LENGTH name - 1)
+  PER .
+
+ENDOP FILLBY ;
+
+OP FILLBY (FILE VAR file, THESAURUS CONST thesaurus) :
+
+  INT VAR index := 0 ;
+  REP
+    get (thesaurus, name, index) ;
+    IF name = ""
+      THEN LEAVE FILLBY
+    FI ;
+    putline (file, name)
+  PER .
+
+ENDOP FILLBY ;
+
+OP FILLBY (TEXT CONST file name, THESAURUS CONST thesaurus) :
+
+  FILE VAR f := sequential file (output, file name) ;
+  f FILLBY thesaurus
+
+ENDOP FILLBY ;
+
+
+ 
+PROC fetch (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) fetch, nameset)
+
+ENDPROC fetch ;
+ 
+PROC fetch (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) fetch, nameset, task)
+
+ENDPROC fetch ;
+ 
+PROC save (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) save, nameset)
+
+ENDPROC save ;
+ 
+PROC save (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) save, nameset, task)
+
+ENDPROC save ;
+ 
+PROC fetch all :
+
+  fetch all (father)
+
+ENDPROC fetch all ;
+
+PROC fetch all (TASK CONST manager) :
+
+  fetch (ALL manager, manager)
+
+ENDPROC fetch all ;
+
+PROC save all :
+
+  save all (father)
+
+ENDPROC save all ;
+
+PROC save all (TASK CONST manager) :
+
+  save (ALL myself, manager)
+
+ENDPROC save all ;
+
+PROC forget (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) forget, nameset)
+
+ENDPROC forget ;
+ 
+PROC erase (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) erase, nameset)
+
+ENDPROC erase ;
+ 
+PROC erase (THESAURUS CONST nameset, TASK CONST task) :
+
+  do (PROC (TEXT CONST, TASK CONST) erase, nameset, task)
+
+ENDPROC erase ;
+ 
+PROC insert (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) insert, nameset)
+
+ENDPROC insert ;
+ 
+PROC edit (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) edit, nameset)
+
+ENDPROC edit ;
+ 
+ENDPACKET name set ;
+
diff --git a/system/multiuser/1.7.5/src/pager b/system/multiuser/1.7.5/src/pager
new file mode 100644
index 0000000..35189a4
--- /dev/null
+++ b/system/multiuser/1.7.5/src/pager
@@ -0,0 +1,2451 @@
+(*-------------------- VERSION 197 vom 05.05.86 -------(1.7.5)------ *)
+PACKET seiten formatieren DEFINES pageform,
+                                  auto pageform,
+                                  number empty lines before foot,
+                                  first head,
+                                  last bottom:
+
+(* Programm zur interaktiven Formatierung von Seiten, Fussnoten, Kopf- und
+   Fusszeilen, Seitennummern usw.
+   Autor: Rainer Hahn
+ *)
+ 
+(***************** Deklarationen fuer pageform ************)
+
+LET type1        = 1,
+    linefeed     = 3,
+    limit        = 4,
+    free         = 5,
+    page command0= 6,
+    page command1= 7,
+    pagenr       = 8,
+    pagelength   = 9,
+    foot         = 10,
+    end          = 11,
+    head         = 12,
+    headeven     = 13,
+    headodd      = 14,
+    bottom       = 15,
+    bottomeven   = 16,
+    bottomodd    = 17,
+    columns      = 18,
+    columnsend   = 19,
+    topage       = 20,
+    goalpage     = 21,
+    count0       = 22,
+    count1       = 23,
+    setcount     = 24,
+    value0       = 25,
+    value1       = 26,
+    on           = 27, 
+    off          = 28,
+    head on      = 29,
+    head off     = 30,
+    bottom on    = 31,
+    bottom off   = 32,
+    count per page=33,
+    foot contd   = 34,
+    table        = 35,
+    table end    = 36,
+    r pos        = 37,
+    l pos        = 38,
+    c pos        = 39,
+    d pos        = 40,
+    b pos        = 41,
+    clearpos0    = 42,
+    clearpos1    = 43,
+    fillchar     = 44,
+    pageblock    = 45,
+    counter1     = 46,
+    counter2     = 47,
+    counter store= 48,
+    countervalue0= 49,
+    countervalue1= 50,
+    set counter  = 51,
+    u            = 52,
+    d            = 53,
+    e            = 54,
+    fehler index = 100,
+    hop          = ""1"",
+    upchar       = ""3"",
+    cl eop       = ""4"",
+    cl eol       = ""5"",
+    downchar     = ""10"",
+    rub in       = ""11"",
+    rub out      = ""12"",
+    return       = ""13"",
+    end mark     = ""14"",
+    begin mark   = ""15"",
+    begin end mark = ""15""14"",
+    esc          = ""27"",
+    blank        = " ",
+    kommando zeichen = "#",
+    kopf          = 1,
+    kopf gerade   = 2,
+    fuss          = 3,
+    fuss gerade   = 4,
+    kopf ungerade = 5,
+    fuss ungerade = 6,
+    foot note     = 7,
+    dina4 limit           = "16.0",
+    dina4 pagelength      = 25.0,
+    pos seitengrenze      = 17,
+    zeilen nach oben      = 13,
+    zeilen nach unten     = 6,
+    max foot zeilen       = 120,
+    max zeilen zahl       = 15,
+    max refers            = 300,
+    max anz seitenzeichen = 3;
+ 
+BOOL VAR interaktiv,
+         bereich aufnehmen,
+         zeile noch nicht verarbeitet,
+         es war ein linefeed in der zeile,
+         mindestens ein topage gewesen,
+         insert first head  :: TRUE,
+         insert last bottom :: TRUE,
+         pageblock on,
+         ausgeschalteter head,
+         ausgeschalteter bottom,
+         count seitenzaehlung,
+         file works,
+         in tabelle,
+         in nullter seite,
+         letzte textzeile war mit absatz,
+         letztes seitenende war mit absatz,
+         letztes seitenende war in tabelle;
+ 
+INT VAR kommando anfangs pos,
+        kommando ende pos,
+        kommando index,
+        number blank lines before foot :: 1,
+        in index oder exponent,
+        durchgang,
+        nummer erste seite, 
+        nummer letzte seite,
+        laufende spaltennr,
+        anz refers,
+        counter,
+        anz spalten,
+        anz zeilen nach oben,
+        anz vertauschte zeilen,
+        font nr,
+        type          zeilenvorschub,
+        berechneter   zeilenvorschub,
+        max           zeilenvorschub,
+        max type      zeilenvorschub,
+        textbegin zeilennr,
+        anz textzeilen,
+        text laenge vor columns,
+        bereichshoehe,
+        aktuelle seitenlaenge,
+        eingestellte seitenlaenge;
+ 
+REAL VAR real eingestellter zeilenvorschub,
+         realparam;
+
+TEXT VAR kommando,
+         par1, par2,
+         macro line, 
+         vor macro, 
+         nach macro,
+         dummy,
+         fehlerdummy,
+         modifikation,
+         modifikations speicher,
+         kommando seitenspeicher,
+         dec value,
+         counter numbering store,
+         counter reference store,
+         letzte kommandoleiste,
+         kommando speicher,
+         tab pos speicher,
+         bereich kommando speicher,
+         seitenzeichen,
+         name druck datei,
+         name eingabe datei,
+         zeile,
+         eingestellter typ,
+         eingestelltes limit;
+ 
+TEXT VAR kommando liste ::
+"type:1.1linefeed:3.1limit:4.1free:5.1page:6.01pagenr:8.2pagelength:9.1
+foot:10.0end:11.0head:12.0headeven:13.0headodd:14.0bottom:15.0bottomeven:16.0
+bottomodd:17.0columns:18.2columnsend:19.0topage:20.1goalpage:21.1count:22.01
+setcount:24.1";
+ 
+kommando liste CAT
+"value:25.01on:27.1off:28.1headon:29.0headoff:30.0bottomon:31.0bottomoff:32.0
+countperpage:33.0footcontinued:34.0table:35.0tableend:36.0rpos:37.1lpos:38.1
+cpos:39.1dpos:40.2bpos:41.2clearpos:42.01fillchar:44.1pageblock:45.0";
+ 
+kommando liste CAT
+"counter:46.12storecounter:48.1putcounter:49.01setcounter:51.2u:52.0d:53.0
+e:54.0";
+
+FILE VAR eingabe,
+         ausgabe;
+ 
+ROW 6 ROW max zeilenzahl TEXT VAR kopf fuss zeilen;
+ 
+ROW max foot zeilen TEXT VAR foot zeilen;
+ 
+ROW max foot zeilen BOOL VAR kommandos vorhanden;
+
+ROW 7 INT VAR anz kopf oder fuss zeilen,
+              kopf oder fuss laenge; 
+
+ROW max anz seitenzeichen INT VAR laufende seitennr;
+ 
+BOUND ROW max refers REFER VAR refer sammler;
+ 
+LET REFER = STRUCT (TEXT kennzeichen, INT nummer, BOOL referenced);
+ 
+DATASPACE VAR ds;
+ 
+(********************* Einstell-Prozeduren ***************************)
+
+PROC first head (BOOL CONST was): 
+  insert first head := was 
+END PROC first head; 
+ 
+PROC last bottom (BOOL CONST was): 
+  insert last bottom := was 
+END PROC last bottom; 
+ 
+PROC number empty lines before foot (INT CONST n):
+  IF n >= 0 AND n < 10
+    THEN number blank lines before foot := n
+    ELSE errorstop ("nur einstellbar zwischen 0 und 9")
+  FI
+END PROC number empty lines before foot;
+
+(************************** Fehlermeldungen **********************)
+ 
+PROC fehler (INT CONST nr, TEXT CONST addition):
+  IF durchgang = 1 OR
+     kommando index = goalpage  OR kommandoindex = count0 OR
+     kommando index = count1    OR kommando index = value1  OR 
+     kommando index = topage    OR kommando index = pagelength OR
+     kommando index = counterstoreOR kommando index = counter1 OR
+     kommando index = counter2  OR kommando index = countervalue1
+    THEN fehler melden;
+         fehlermeldung auf terminal ausgeben
+  FI.
+ 
+fehler melden:
+  report text processing error (nr, line no (ausgabe), fehlerdummy, addition).
+ 
+fehlermeldung auf terminal ausgeben:
+  IF interaktiv
+    THEN cursor(1,2); out(cleop);
+    ELSE line
+  FI;
+  out (fehlerdummy);
+  line.
+END PROC fehler;
+ 
+PROC warnung (INT CONST nr, TEXT CONST addition):
+  IF durchgang = 1 OR
+     kommando index = goalpage OR kommandoindex = count0 OR
+     kommando index = count1 OR kommando index = value1  OR 
+     kommando index = topage OR kommando index = set counter
+    THEN fehler melden;
+         meldung auf terminal ausgeben
+  FI.
+ 
+fehler melden:
+  report text processing warning (nr, line no (ausgabe), fehlerdummy, addition).
+ 
+meldung auf terminal ausgeben:
+  IF interaktiv
+    THEN cursor(1,2); out(cleop);
+    ELSE line
+  FI;
+  out (fehlerdummy);
+  line.
+END PROC warnung;
+
+(*************************** Globale Dateibehandlung **************)
+ 
+PROC datei assoziieren:
+   IF exists (name eingabe datei)
+     THEN ausgabe datei einrichten
+     ELSE errorstop (name eingabe datei + " existiert nicht")
+   FI.
+ 
+ausgabe datei einrichten:
+   IF name eingabe datei = name druck datei
+     THEN errorstop ("Name Eingabedatei = Name Ausgabedatei")
+   ELIF subtext (name eingabe datei, length (name eingabe datei) - 1) = ".p"
+     THEN errorstop ("Druckdatei kann nicht nochmal formatiert werden")
+     ELSE eingabe := sequential file (input, name eingabe datei);
+          copy (name eingabedatei, name druck datei);
+          ausgabe := sequential file (modify, name druck datei);
+          copy attributes (eingabe, ausgabe);
+          headline (ausgabe, name druck datei);
+   FI
+END PROC datei assoziieren;
+
+PROC record einfuegen (TEXT CONST rec):
+  insert record (ausgabe);
+  write record (ausgabe, rec);
+  down (ausgabe);
+END PROC record einfuegen;
+
+(******************** Kopf- oder Fusszeilen aufnehmen *************)
+ 
+PROC fussnote aufnehmen:
+  bereich aufnehmen := TRUE;
+  IF keine zeichen ausser blank nach dem kommando
+    THEN aufnehmen (footnote)
+    ELSE fehler (19, kommando)
+  FI;
+  in index oder exponent := 0;
+  bereich aufnehmen := FALSE
+END PROC fussnote aufnehmen;
+
+PROC aufnehmen (INT CONST was):
+  kommando zustand vor bereich speichern;
+  aktuelle zeile ggf mitzaehlen;
+  aufnehmen initialisieren;
+  kopf oder fuss zeilen aufnehmen.
+ 
+kommando zustand vor bereich speichern:
+  kommandos in dummy speichern;
+  bereich kommando speicher := dummy.
+
+aktuelle zeile ggf mitzaehlen:
+INT VAR einleitungs kommando anfang :: kommando anfangs pos;
+  IF kommando anfangs pos > 1 
+    THEN IF NOT only command line (zeile)
+           THEN aktuelle seitenlaenge INCR max zeilenvorschub
+         FI;
+         read record (ausgabe, zeile)
+  FI. 
+ 
+aufnehmen initialisieren:
+  IF was = foot note
+    THEN initialisierung fuer fussnoten
+    ELSE anz kopf oder fuss zeilen [was] := 1;
+         kommandos in dummy speichern;
+         kopf fuss zeilen [was] [1] := dummy;
+         kopf oder fuss laenge [was] := 0;
+  FI;
+  bereichshoehe := kopf oder fusslaenge [was].
+
+initialisierung fuer fussnoten:
+  INT CONST fussnotenlaenge vorher :: kopf oder fuss laenge [footnote],
+            anz fusszeilen vorher  :: anz kopf oder fusszeilen [footnote];
+  anz kopf oder fuss zeilen [footnote] INCR 1;
+  kommandos in dummy speichern;
+  kommandoleiste in fussnote speichern; (* davor *)
+  IF anz kopf oder fuss zeilen [footnote] = 1
+    THEN unterstreichungsstrich
+  FI.
+ 
+kommandoleiste in fussnote speichern:
+  foot zeilen [anz kopf oder fuss zeilen [footnote]] := dummy;
+  kommandos vorhanden [anz kopf oder fuss zeilen [footnote]]:= TRUE.
+
+unterstreichungsstrich:
+  FOR i FROM 2 UPTO max foot zeilen REP
+    kommandos vorhanden [i] := FALSE
+  ENDREP;
+  FOR i FROM 1 UPTO number blank lines before foot REP
+    foot zeilen [i + 1] := " "
+  END REP;
+  foot zeilen [number blank lines before foot + 2] :=
+     "#on(""underline"")#               #off(""underline"")# ";
+  kopf oder fuss laenge [footnote] :=
+     (number blank lines before foot + 1) * berechneter zeilenvorschub;
+  anz kopf oder fuss zeilen [footnote] := number blank lines before foot + 2.
+
+kopf oder fuss zeilen aufnehmen:
+INT VAR anzahl :: 1;
+  REP
+    naechste zeile lesen;
+    cout (line no (ausgabe));
+    IF mindestens ein kommando vorhanden
+      THEN kommandos von kopf oder fuss verarbeiten
+    FI;
+    in index oder exponent := 0;
+    zeile aufnehmen;
+    anzahl INCR 1
+  UNTIL eof (ausgabe) END REP;
+  errorstop ("end fehlt bei Dateiende").
+
+kommandos von kopf oder fuss verarbeiten:
+  max zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub;
+  kommando anfangs pos := pos (zeile, kommando zeichen);
+  WHILE kommando anfangs pos <> 0 REP
+    verarbeite kommando;
+    kommandos von kopf oder fuss pruefen;
+    kommando anfangs pos :=
+        pos (zeile, kommando zeichen, kommando ende pos + 1)
+  END REP.
+ 
+kommandos von kopf oder fuss pruefen:
+  IF kommandoindex = end
+    THEN aufnehmen beenden
+  ELIF kommando index = free
+    THEN IF y step conversion (realparam) >= eingestellte seitenlaenge
+           THEN fehler (24, text (realparam))
+           ELSE kopf oder fusslaenge [was] INCR y step conversion (realparam)
+         FI
+  ELIF seitenende
+    THEN INT VAR xx := durchgang;
+         durchgang := 1;
+         fehler (25, "");
+         durchgang := xx;
+         zeile zurueck lesen;
+         kommando index := end;
+         LEAVE aufnehmen
+  ELIF kommando index = fehler index
+    THEN LEAVE aufnehmen
+  ELIF kommando index > free AND kommando index < to page
+    THEN fehler (11, kommando);
+         kommando index := fehler index;
+         LEAVE aufnehmen
+  FI.
+
+aufnehmen beenden:
+  IF kommando anfangs pos > 1
+    THEN IF absatzzeile
+           THEN zeile := subtext (zeile, 1, kommando anfangs pos -1);
+                zeile CAT blank;
+           ELSE zeile := subtext (zeile, 1, kommando anfangs pos -1);
+         FI;
+         zeile aufnehmen
+  FI;
+  IF NOT (durchgang = 1 AND was = footnote)
+    THEN die aufgenommenen zeilen in druckdatei loeschen
+  FI;
+  LEAVE aufnehmen.
+
+die aufgenommenen zeilen in druckdatei loeschen:
+  INT VAR i;
+  delete record (ausgabe);
+  FOR i FROM 1 UPTO anzahl - 1 REP
+    up (ausgabe);
+    delete record (ausgabe)
+  END REP;
+  zeile zurueck lesen;
+  letztes kommando dieser zeile loeschen;
+  ggf kommandoleiste generieren.
+ 
+letztes kommando dieser zeile loeschen:
+  IF einleitungs kommando anfang = 1
+    THEN delete record (ausgabe);
+         IF line no (ausgabe) = 1
+           THEN zeile noch nicht verarbeitet := TRUE
+           ELSE zeile zurueck lesen
+         FI
+    ELSE dummy := subtext (zeile, 1, einleitungs kommando anfang - 1);
+         IF absatz zeile
+           THEN dummy CAT blank;
+         ELIF (dummy SUB length (dummy)) = " "
+           THEN delete char (dummy, length (dummy))
+         FI;
+         write record (ausgabe, dummy)
+  FI.
+ 
+ggf kommandoleiste generieren:
+  kommandos in dummy speichern;
+  IF was = footnote
+    THEN anz kopf oder fusszeilen [footnote] INCR 1;
+         kommandoleiste in fussnote speichern (* danach *)
+  FI;
+  IF dummy <> bereich kommando speicher
+    THEN down (ausgabe);
+         record einfuegen (dummy);
+         up (ausgabe, 2);
+  FI.
+
+zeile aufnehmen:
+  zeile speichern (was, anzahl);
+  IF erreichte seitenlaenge > eingestellte seitenlaenge
+    THEN bereich aufnehmen := FALSE;
+         IF kommando index = end
+           THEN seitenende nach geteilter fussnote
+           ELSE seitenende vor der fussnote
+         FI;
+         kommando index := end;
+         LEAVE aufnehmen
+  FI.
+
+seitenende nach geteilter fussnote:
+  kopf oder fuss laenge     [footnote] DECR max zeilenvorschub;
+  anz kopf oder fuss zeilen [footnote] DECR 1;
+  seitenende einbringen und zurueck.
+
+seitenende vor der fussnote:
+  kopf oder fuss laenge     [footnote] := fussnotenlaenge vorher;
+  anz kopf oder fuss zeilen [footnote] := anz fusszeilen vorher;
+  ende einer seite.
+END PROC aufnehmen;
+ 
+PROC zeile speichern (INT CONST was, anzahl):
+  zeile mitzaehlen;
+  IF was = footnote
+    THEN fussnote aufnehmen
+  ELIF anz kopf oder fuss zeilen [was] > max zeilenzahl
+    THEN errorstop ("Zu viele 'head' oder 'bottom' Zeilen");
+    ELSE kopf fuss zeilen [was] [anz kopf oder fuss zeilen [was]] := zeile
+  FI.
+ 
+zeile mitzaehlen: 
+  anz kopf oder fuss zeilen [was] INCR 1;
+  IF NOT only command line (zeile)
+    THEN IF mindestens ein kommando vorhanden
+           THEN kopf oder fuss laenge [was] INCR max zeilenvorschub;
+                bereichshoehe INCR max zeilenvorschub
+           ELSE kopf oder fuss laenge [was] INCR berechneter zeilenvorschub;
+                bereichshoehe INCR berechneter zeilenvorschub
+         FI;
+         IF bereichshoehe >= eingestellte seitenlaenge
+           THEN errorstop
+            ("head, bottom oder footzeilen > Seitenlänge (end vergessen?)")
+         FI
+  FI;
+  IF es war ein linefeed in der zeile
+    THEN berechne zeilenvorschub;
+         es war ein linefeed in der zeile := FALSE
+  FI;
+  IF erreichte seitenlaenge > eingestellte seitenlaenge
+    THEN fussnotenumbruch pruefung
+  FI.
+ 
+fussnote aufnehmen: 
+  IF anz kopf oder fuss zeilen [footnote] > max footzeilen
+    THEN errorstop ("Zu viele Fußnotenzeilen")
+  ELIF bereichshoehe > eingestellte seitenlaenge - seitenlaenge fester teil
+                       - (eingestellte seitenlaenge DIV 100 * 15) 
+    THEN errorstop ("Fußnote > 85% der Seitenlänge (end vergessen?)")
+    ELSE foot zeilen [anz kopf oder fuss zeilen [footnote]] := zeile
+  FI. 
+ 
+fussnotenumbruch pruefung:
+  IF fussnotenumbruch moeglich
+    THEN ggf fussnote aufbrechen
+    ELSE lese rueckwaerts um (anzahl);
+         IF only command line (zeile)
+           THEN lese rueckwaerts um (1)
+         FI
+  FI.
+
+fussnotenumbruch moeglich:
+  was = footnote AND anzahl > 2.
+
+ggf fussnote aufbrechen:
+  up (ausgabe);
+  IF interaktiv
+    THEN fussnotenumbruch anfrage;
+         line (2)
+  FI;
+  anweisungen fuer umbruch einfuegen.
+
+fussnotenumbruch anfrage:
+  schreibe titelzeile ("Weiterführen der Fußnote auf nächster Seite (j/n)?");
+  line (2);
+  schreibe bildschirm;
+  cursor (53, 1);
+  skip input;
+  REP
+    TEXT VAR steuerzeichen;
+    inchar (steuerzeichen);
+    IF steuerzeichen = "n"
+      THEN lese rueckwaerts um (anzahl - 1);
+           IF only command line (zeile)
+             THEN lese rueckwaerts um (1)
+           FI;
+           LEAVE ggf fussnote aufbrechen
+    ELIF steuerzeichen = "j" OR steuerzeichen = return
+      THEN LEAVE fussnotenumbruch anfrage
+    ELIF steuerzeichen = esc
+      THEN errorstop ("Abbruch durch ESC")
+    FI
+  END REP.
+
+anweisungen fuer umbruch einfuegen:
+  record einfuegen ("#end#");
+  record einfuegen ("#foot continued#");
+  kommandos in dummy speichern;
+  record einfuegen (dummy);
+  record einfuegen ("Forts. von letzter Seite: ");
+  lese rueckwaerts um (3);
+  kommando index := end.
+END PROC zeile speichern;
+
+PROC lese rueckwaerts um (INT CONST anzahl):
+  to line (ausgabe, line no (ausgabe) - anzahl);
+  read record (ausgabe, zeile)
+END PROC lese rueckwaerts um;
+
+PROC schreibe kopf oder fuss (INT CONST was):
+  IF was = footnote
+    THEN fussnoten generieren
+  ELIF laufende spaltennr < 2
+    THEN kopf oder fuss zeilen generieren
+  FI.
+
+kopf oder fusszeilen generieren:
+INT VAR i :: 1;
+BOOL VAR in generierter zeile war kommando :: FALSE;
+   ggf anfangs kommandos generieren;
+   FOR i FROM 2 UPTO anz kopf oder fuss zeilen [was] REP
+      dummy := kopf fuss zeilen [was] [i];
+      IF NOT in generierter zeile war kommando
+        THEN in generierter zeile war kommando :=
+              pos (dummy, kommandozeichen) <> 0
+      FI;
+      fuege seitennr ein;
+      record einfuegen (dummy)
+   END REP;
+   ggf ende kommandos generieren.
+ 
+ggf anfangs kommandos generieren:
+   kommandos in dummy speichern;
+   IF dummy <> kopf fuss zeilen [was] [1]
+     THEN record einfuegen (kopf fuss zeilen [was] [1])
+   FI.
+ 
+ggf ende kommandos generieren:
+   kommandos in dummy speichern;
+   IF dummy <> kopf fuss zeilen [was] [1] OR
+                                       in generierter zeile war kommando
+     THEN record einfuegen (dummy)
+   FI.
+ 
+fuege seitennr ein:
+INT VAR k;
+  change all (dummy,
+              (seitenzeichen SUB 1) + (seitenzeichen SUB 1),
+              text (laufende seitennr [1] +1));
+  FOR k FROM 1 UPTO length (seitenzeichen) REP
+    change all (dummy, seitenzeichen SUB k, text (laufende seitennr [k]));
+  END REP.
+ 
+fussnoten generieren:
+   kommandos in dummy speichern;
+   letzte kommandoleiste := dummy;
+   i := 1;
+   WHILE i < anz kopf oder fusszeilen [footnote] REP
+     IF kommandos vorhanden [i]
+       THEN IF letzte kommandoleiste <> footzeilen [i]
+              THEN record einfuegen (footzeilen [i]);
+                   letzte kommandoleiste := footzeilen [i]
+            FI
+       ELSE record einfuegen (footzeilen [i])
+     FI;
+     i INCR 1
+   END REP;
+   IF footzeilen [i] <> dummy
+     THEN record einfuegen (dummy)
+   FI
+END PROC schreibe kopf oder fuss;
+
+PROC fussnoten loeschen:
+  kopf oder fuss laenge [footnote] := 0;
+  anz kopf oder fuss zeilen [footnote] := 0
+END PROC fussnoten loeschen;
+ 
+PROC schreibe ggf fuss:
+  record einfuegen ("#text end#");
+  ggf tabellenende generieren;
+  letztes seitenende war mit absatz := letzte textzeile war mit absatz;
+  IF erreichte seitenlaenge <> eingestellte seitenlaenge
+    THEN schreibe freien platz
+  FI;
+  IF kopf oder fuss laenge [footnote] > 0
+    THEN ggf tabellenende generieren; 
+         schreibe kopf oder fuss (footnote);
+         fussnoten loeschen
+  FI;
+  IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite)
+     OR ausgeschalteter bottom
+    THEN 
+    ELSE schreibe mal fussbereich
+  FI.
+ 
+schreibe mal fussbereich:
+  IF kopf oder fuss laenge [fuss] > 0
+    THEN schreibe kopf oder fuss (fuss)
+  ELIF kopf oder fuss laenge [fuss gerade] > 0 AND
+            (laufende seitennr [1] MOD 2 = 0)
+    THEN schreibe kopf oder fuss (fuss gerade)
+  ELIF kopf oder fuss laenge [fuss ungerade] > 0 AND
+            (laufende seitennr [1] MOD 2 <> 0)
+    THEN schreibe kopf oder fuss (fuss ungerade)
+  FI.
+
+ggf tabellenende generieren:
+  IF tab pos speicher <> ""
+    THEN record einfuegen ("#clear pos# ")
+  FI;
+  IF in tabelle
+    THEN record einfuegen ("#table end# ");
+         letztes seitenende war in tabelle := TRUE;
+         in tabelle := FALSE
+  FI.
+
+schreibe freien platz:
+  IF pageblock on
+    THEN schreibe ggf stauchung oder streckungs anweisung
+    ELSE schreibe free (eingestellte seitenlaenge - erreichte seitenlaenge) 
+  FI.
+
+schreibe ggf stauchung oder streckungs anweisung:
+  IF interaktiv AND seitenluecke > fuenf prozent der seitenlaenge
+    THEN cursor (1, 2);
+         dummy := begin mark;
+         dummy CAT "Soll die Seite beim Druck gestreckt werden (";
+         dummy CAT text (ystepconversion (seitenluecke)); 
+         dummy CAT " cm)";
+         dummy CAT end mark;
+         IF no (dummy)
+          THEN cursor (1, 2);
+               out (cl eol);
+               schreibe free
+                        (eingestellte seitenlaenge - erreichte seitenlaenge);
+               line;
+               LEAVE schreibe ggf stauchung oder streckungs anweisung
+         FI;
+         cursor (1, 2);
+         out (cl eol);
+         line
+  FI;
+  INT VAR i :: lineno (ausgabe);
+  to line (ausgabe, textbegin zeilennr);
+  dummy := "#textbegin (";
+  dummy CAT text (anz textzeilen);
+  dummy CAT ", """;
+  dummy CAT text (ystepconversion (seitenluecke)); 
+  dummy CAT """)#";
+  read record (ausgabe, zeile);
+  IF (zeile SUB length (zeile)) = blank
+    THEN dummy CAT blank
+  FI;
+  write record (ausgabe, dummy);
+  to line (ausgabe, i).
+
+seitenluecke:
+  eingestellte seitenlaenge - erreichte seitenlaenge.
+
+fuenf prozent der seitenlaenge:
+  ((eingestellte seitenlaenge + 99) DIV 100) * 5.
+END PROC schreibe ggf fuss;
+
+(**************************** kommando speicherung *****************)
+ 
+PROC grenzmarkierung in dummy speichern:
+  dummy := "#page##";
+  dummy CAT (3 * "-----------");
+  dummy CAT " Ende der Seite ";
+  IF in nullter seite
+    THEN dummy CAT "0 "
+    ELSE dummy CAT (text (laufende seitennr [1]) + blank)
+  FI;
+  IF anz spalten > 1
+    THEN dummy CAT "und Spalte ";
+         dummy CAT (text (laufende spaltennr) + blank)
+    ELSE dummy CAT "-----------"
+  FI;
+  dummy CAT kommando zeichen
+END PROC grenzmarkierung in dummy speichern;
+
+PROC kommandos in dummy speichern:
+  type speichern;
+  dummy CAT modifikation;
+  limit speichern;
+  linefeed mit absatzblank speichern.
+ 
+type speichern:
+  dummy := "#type(""";
+  dummy CAT eingestellter typ;
+  dummy CAT """)#".
+
+limit speichern:
+  dummy CAT "#limit(";
+  dummy CAT eingestelltes limit;
+  dummy CAT ")#".
+
+linefeed mit absatzblank speichern:
+  dummy CAT "#linefeed(0";
+  dummy CAT text (real eingestellter zeilenvorschub);
+  dummy CAT ")# ".
+END PROC kommandos in dummy speichern; 
+
+PROC kommandos aufheben:
+   kommandos in dummy speichern;
+   kommando speicher := dummy
+END PROC kommandos aufheben;
+
+PROC kommandos wiederherstellen:
+  zeile := kommando speicher;
+  kommandos verarbeiten;
+  berechneter zeilenvorschub :=
+  int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5);
+  max zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub
+END PROC kommandos wiederherstellen;
+ 
+(**************************** headzeilen einfuegen ************************) 
+ 
+PROC schreibe ggf kopf:
+  IF (NOT insert first head AND laufende seiten nr [1] = nummer erste seite)
+     OR ausgeschalteter head
+    THEN 
+    ELSE schreibe mal 
+  FI;
+  ggf tabellenanfang generieren;
+  text begin anweisung generieren.
+ 
+schreibe mal: 
+  IF kopf oder fuss laenge [kopf] > 0
+    THEN schreibe kopf oder fuss (kopf);
+         aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf]
+  ELIF kopf oder fuss laenge [kopf gerade] > 0
+             AND (laufende seitennr [1] MOD 2 = 0)
+    THEN schreibe kopf oder fuss (kopf gerade);
+         aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf gerade]
+  ELIF kopf oder fuss laenge [kopf ungerade] > 0
+             AND (laufende seitennr [1] MOD 2 <> 0)
+    THEN schreibe kopf oder fuss (kopf ungerade);
+         aktuelle seitenlaenge INCR kopf oder fuss laenge [kopf ungerade]
+  FI.
+
+ggf tabellenanfang generieren:
+  IF tab pos speicher <> ""
+    THEN record einfuegen ("#clearpos#");
+         record einfuegen (tab pos speicher)
+  FI;
+  IF letztes seitenende war in tabelle
+    THEN record einfuegen ("#table# ");
+         letztes seitenende war in tabelle := FALSE;
+         in tabelle := TRUE
+  FI.
+
+text begin anweisung generieren:
+  dummy := "#text begin#";
+  IF letztes seitenende war mit absatz
+    THEN dummy CAT " "
+  FI;
+  record einfuegen (dummy);
+  textbegin zeilennr := line no (ausgabe) - 1.
+END PROC schreibe ggf kopf;
+
+PROC erhoehe seiten und spaltennr:
+  IF anz spalten > 1
+    THEN erhoehe spaltennummer
+  FI;
+  IF NOT in nullter seite
+    THEN erhoehe seitennummer
+  FI.
+ 
+erhoehe spaltennummer:
+  laufende spaltennr INCR 1;
+  IF laufende spaltennr > anz spalten
+    THEN laufende spaltennr := 1;
+         text laenge vor columns := 0
+    ELSE LEAVE erhoehe seiten und spaltennr
+  FI.
+
+erhoehe seitennummer:
+  INT VAR i;
+  FOR i FROM 1 UPTO length (seitenzeichen) REP
+    laufende seitennr [i] INCR 1
+  END REP
+END PROC erhoehe seiten und spaltennr;
+ 
+PROC seitennummer setzen (INT CONST akt nummer):
+  IF pos (seitenzeichen, par1) = 0
+    THEN IF length (seitenzeichen) >= max anz seitenzeichen
+           THEN fehler (16, "");
+                LEAVE seitennummer setzen
+         FI;
+         seitenzeichen CAT par1
+  FI;
+  laufende seitennr [pos (seitenzeichen, par1)] := akt nummer.
+END PROC seitennummer setzen;
+ 
+PROC kommando seitenspeicher fuellen:
+  kommando seitenspeicher CAT "#";
+  kommando seitenspeicher CAT kommando;
+  kommando seitenspeicher CAT "#"
+END PROC kommando seitenspeicher fuellen;
+
+(************************** kommandos verarbeiten ********************) 
+ 
+PROC verarbeite kommando:
+INT VAR anz params, intparam;
+  kommando ende pos :=
+      pos (zeile, kommando zeichen, kommando anfangs pos + 1);
+  IF kommando ende pos <> 0
+    THEN kommando oder kommentar kommando verarbeiten
+    ELSE fehler (2,
+            subtext (zeile, kommandoanfangspos, kommandoanfangspos+9)+"...");
+         zeile CAT kommando zeichen;
+         write record (ausgabe, zeile);
+         kommando ende pos := length (zeile)
+  FI.
+ 
+kommando oder kommentar kommando verarbeiten:
+  IF pos ("-/"":", zeile SUB kommando anfangs pos + 1) = 0
+    THEN kommando :=
+         subtext (zeile, kommando anfangs pos + 1, kommando ende pos - 1);
+         scanne kommando;
+         setze kommando um
+    ELSE kommando index := 0
+  FI.
+
+scanne kommando:
+  analyze command (kommandoliste, kommando, 3,
+                   kommando index, anz params, par1, par2);
+  disable stop;
+   command error;
+   IF is error
+     THEN dummy := error message;
+          clear error;
+          dummy CAT " -> ";
+          dummy CAT kommando;
+          fehler (22, dummy);
+          enable stop;
+          LEAVE verarbeite kommando
+   FI;
+  enable stop.
+ 
+setze kommando um:
+  IF durchgang = 3 AND kommando index <> value1 AND kommando index <> to page
+     AND kommando index <> counter value1
+    THEN LEAVE verarbeite kommando
+  FI;
+  SELECT kommando index OF
+ 
+CASE type1:
+     modifikation := "";
+     IF in index oder exponent > 0
+       THEN LEAVE setze kommando um
+     ELIF font exists (par1)
+       THEN font nr := font (par1);
+            eingestellter typ := par1;
+            type zeilenvorschub :=
+            font height (fontnr) + font lead (fontnr) + font depth (fontnr);
+            IF type zeilenvorschub > max type zeilenvorschub
+              THEN max type zeilenvorschub := type zeilenvorschub
+            FI
+       ELSE fehler (1, par1)
+     FI;
+     berechne zeilenvorschub
+ 
+CASE linefeed:
+     realparam := real (par1);
+     IF last conversion ok AND pos (par1, ".") <> 0
+       THEN real eingestellter zeilenvorschub := realparam;
+            es war ein linefeed in der zeile  := TRUE
+       ELSE fehler (4, par1)
+     FI
+ 
+CASE limit:
+     eingestelltes limit := par1
+ 
+CASE free:
+     realparam := real (par1);
+     IF last conversion ok AND pos (par1, ".") <> 0
+       THEN IF keine zeichen ausser blank nach dem kommando 
+              THEN free kommando ausfuehren
+              ELSE fehler (19, kommando);
+            FI
+       ELSE fehler (4, par1)
+     FI
+ 
+CASE page command0:
+  IF keine zeichen ausser blank nach dem kommando
+    THEN page behandlung;
+         schreibe titelzeile
+    ELSE fehler (19, kommando)
+  FI
+ 
+CASE page command1: 
+  IF keine zeichen ausser blank nach dem kommando
+    THEN INT VAR seitennummer mit page := int (par1);
+         page behandlung;
+         laufende spaltennr := 1;
+         text laenge vor columns := 0;
+         IF seitennummer mit page <= 0 
+           THEN fehler (27, "page (" + text (seitennummer mit page) + ")")
+           ELSE laufende seitennr [1] := seitennummer mit page
+         FI
+     ELSE fehler (19, kommando)
+  FI
+
+CASE pagenr:
+     IF in nullter seite OR durchgang = 4
+       THEN intparam := int (par2);
+            IF length (par1) <> 1
+              THEN fehler (14, "")
+            ELIF NOT last conversion ok
+              THEN fehler (5, kommando)
+            ELIF intparam <= 0
+              THEN fehler (27, kommando)
+              ELSE seitennummer setzen (intparam) 
+            FI
+     ELIF durchgang = 2
+       THEN kommando seitenspeicher fuellen
+     FI
+ 
+CASE pagelength:
+     realparam := real (par1);
+     IF last conversion ok AND pos (par1, ".") <> 0
+       THEN IF in nullter seite OR durchgang = 4
+              THEN eingestellte seitenlaenge := y step conversion (realparam)
+            ELIF durchgang = 2
+              THEN kommando seitenspeicher fuellen
+            FI 
+       ELSE fehler (4, kommando) 
+     FI
+ 
+CASE foot, foot contd:
+     fussnote aufnehmen
+ 
+CASE end:
+     IF NOT bereich aufnehmen
+       THEN fehler (31, "")
+     FI;
+     bereich aufnehmen := FALSE;
+     kommando index := end;
+     IF NOT keine zeichen ausser blank nach dem kommando
+       THEN fehler (19, kommando)
+     FI
+ 
+CASE head:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [kopf ungerade] := 0;
+            kopf oder fuss laenge [kopf gerade] := 0;
+            aufnehmen (kopf)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE headeven:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [kopf] := 0;
+            aufnehmen (kopf gerade)
+       ELSE fehler (19, kommando)
+     FI; 
+     bereich aufnehmen := FALSE
+ 
+CASE headodd:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [kopf] := 0;
+            aufnehmen (kopf ungerade)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE bottom:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [fuss ungerade] := 0;
+            kopf oder fuss laenge [fuss gerade] := 0;
+            aufnehmen (fuss)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE bottomeven:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [fuss] := 0;
+            aufnehmen (fuss gerade)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+ 
+CASE bottomodd:
+     bereich aufnehmen := TRUE;
+     IF keine zeichen ausser blank nach dem kommando
+       THEN kopf oder fuss laenge [fuss] := 0;
+            aufnehmen (fuss ungerade)
+       ELSE fehler (19, kommando)
+     FI;
+     bereich aufnehmen := FALSE
+
+CASE columns:
+     IF anz spalten > 1
+       THEN fehler (29, "")
+       ELSE anz spalten := int (par1);
+            laufende spalten nr := 1;
+            IF anz spalten < 2
+              THEN fehler (26, "");
+                   anz spalten := 2
+            FI;
+            text laenge vor columns :=
+                   aktuelle seitenlaenge + kopf oder fuss laenge [footnote]
+     FI
+
+CASE columnsend:
+     IF durchgang = 1
+       THEN delete record (ausgabe);
+            IF NOT nur dateiende danach
+              THEN seitenende einbringen und zurueck;
+                   record einfuegen ("#columnsend#");
+                   text laenge vor columns := 0;
+                   laufende spaltennr := 1;
+                   anz spalten := 1;
+                   kommando index := page command0;
+                   down (ausgabe)
+            FI
+     FI
+
+CASE topage:
+     IF durchgang > 1
+       THEN ggf gespeicherte nummer einsetzen (par1);
+            mindestens ein topage gewesen := TRUE
+     FI
+
+CASE goalpage:
+     IF durchgang > 1
+       THEN nummer und kennzeichen speichern (laufende seitennr[1], par1)
+     FI
+
+CASE count0, count1:
+     IF durchgang > 1
+       THEN counter INCR 1;
+            change (zeile,
+                    kommando anfangs pos, kommando ende pos, text(counter));
+            kommando ende pos := kommando anfangs pos;
+            write record (ausgabe, zeile);
+            IF anz params = 1
+              THEN nummer und kennzeichen speichern (counter, par1)
+            FI
+     FI
+
+CASE setcount:
+     intparam := int (par1);
+     IF last conversion ok AND intparam >= 0
+       THEN counter := intparam - 1
+       ELSE fehler (30, par1)
+     FI
+
+CASE value0:
+     IF durchgang > 1
+       THEN change (zeile, kommando anfangs pos, kommando ende pos,
+                     text (counter));
+            write record (ausgabe, zeile);
+            kommando ende pos := kommando anfangs pos
+     FI
+
+CASE value1:
+     IF durchgang > 1
+       THEN ggf gespeicherte nummer einsetzen (par1)
+     FI
+ 
+CASE on: 
+     change all (par1, " ", ""); 
+     par1 := (par1 SUB 1); 
+     modifikation CAT "#on(""" + par1 + """)#"
+ 
+CASE off: 
+     change all (par1, " ", ""); 
+     par1 := (par1 SUB 1); 
+     changeall (modifikation, "#on(""" + par1 + """)#", ""); 
+ 
+CASE head on:  ausgeschalteter head := FALSE
+CASE head off: ausgeschalteter head := TRUE
+
+CASE bottom on:  ausgeschalteter bottom := FALSE
+CASE bottom off: ausgeschalteter bottom := TRUE
+
+CASE count per page: count seitenzaehlung := TRUE
+
+CASE table:
+     IF durchgang > 1
+       THEN in tabelle := TRUE
+     FI
+
+CASE table end:
+     IF durchgang > 1
+       THEN in tabelle := FALSE
+     FI
+
+CASE r pos, l pos, c pos, d pos, b pos, clearpos1, fillchar:
+     IF durchgang > 1
+       THEN tab pos speicher CAT "#";
+            tab pos speicher CAT kommando;
+            tab pos speicher CAT "#"
+     FI
+
+CASE clearpos0:
+     IF durchgang > 1
+       THEN tab pos speicher := ""
+     FI
+
+CASE pageblock : pageblock on := TRUE
+
+CASE counter1, counter2:
+     IF durchgang > 1
+       THEN process counter
+     FI
+
+CASE set counter:
+     IF durchgang > 1
+       THEN process set counter
+     FI
+
+CASE counter store:
+     IF durchgang > 1
+       THEN process counter store
+     FI
+
+CASE counter value0:
+     IF durchgang > 1
+       THEN write dec value into file
+     FI
+
+CASE counter value1:
+     IF durchgang > 1
+       THEN process counter value
+     FI
+
+CASE u, d:
+     in index oder exponent INCR 1
+
+CASE e:
+     in index oder exponent DECR 1
+
+OTHERWISE
+     kommando index := 0; 
+     IF macro command and then process parameters (kommando)
+       THEN ersetze macro 
+     FI
+END SELECT.
+
+nur dateiende danach:
+  INT VAR diese zeile :: line no (ausgabe);
+  WHILE NOT eof (ausgabe) REP
+    read record (ausgabe, zeile);
+    IF length (zeile) > 1
+      THEN to line (ausgabe, diese zeile);
+           read record (ausgabe, zeile);
+           LEAVE nur dateiende danach WITH FALSE
+    FI;
+    down (ausgabe)
+  END REP;
+  to line (ausgabe, diese zeile);
+  read record (ausgabe, zeile);
+  TRUE.
+END PROC verarbeite kommando;
+
+(************************ Makro-Ersetzung **************************)
+ 
+PROC ersetze macro: 
+  INT VAR erste zeile :: line no (ausgabe);
+  hole texte um macro herum;
+  fuege macro zeilen ein;
+  fuege text nach macro an;
+  positioniere zurueck.
+
+hole texte um macro herum:
+  vor macro  := subtext (zeile, 1, kommando anfangs pos - 1);
+  nach macro := subtext (zeile, kommando ende pos + 1).
+
+fuege macro zeilen ein:
+  INT VAR anz :: 1;
+  WHILE anz < number macro lines REP 
+    get macro line (macro line);
+    IF anz = 1
+      THEN vor macro CAT macro line ;
+           write record (ausgabe, vor macro);
+      ELSE down (ausgabe);
+           insert record (ausgabe);
+           write record (ausgabe, macro line)
+    FI;
+    anz INCR 1
+  END REP.
+
+fuege text nach macro an: 
+  read record (ausgabe, zeile);
+  IF length (nach macro) <> 0
+    THEN zeile CAT nach macro
+  ELIF (zeile SUB length (zeile)) <> blank AND number macro lines > 2
+    THEN delete record (ausgabe);
+         read record (ausgabe, dummy);
+         zeile CAT dummy
+  FI;
+  IF subtext (zeile, length (zeile) - 1, length (zeile)) = "  "
+    THEN delete char (zeile, length (zeile))
+  FI;
+  write record (ausgabe, zeile). 
+
+positioniere zurueck:
+  to line (ausgabe, erste zeile);
+  read record (ausgabe, zeile);
+  IF in nullter seite
+    THEN zeile noch nicht verarbeitet := TRUE
+  FI;
+  kommando ende pos := kommando anfangs pos - 1. 
+END PROC ersetze macro; 
+ 
+(************************ Zeilenvorschub-Berechnung ****************)
+ 
+PROC berechne zeilenvorschub:
+  berechneter zeilenvorschub :=
+  int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5);
+  IF real eingestellter zeilenvorschub >= 1.0
+    THEN max zeilenvorschub := max
+    (int (real (max type zeilenvorschub)*real eingestellter zeilenvorschub + 0.5),
+     berechneter zeilenvorschub)
+  ELIF berechneter zeilenvorschub > max zeilenvorschub
+    THEN max zeilenvorschub := berechneter zeilenvorschub
+  FI
+END PROC berechne zeilenvorschub;
+ 
+(**************************** counter processing **********************)
+
+PROC process counter:
+  dummy := "#";
+  dummy CAT par1;
+  dummy CAT "#";
+  IF pos (counter numbering store, dummy) = 0
+    THEN fehler (34, par1);
+         LEAVE process counter
+  FI;
+  get dec value (counter numbering store);
+  IF kommando index = counter2
+    THEN resize dec value to needed points
+  FI;
+  IF dec value was just initialized
+    THEN dec value := subtext (dec value, 2)
+  ELIF kommando index = counter1
+    THEN digit value := int (dec value);
+         digit value INCR 1;
+         dec value := text (digit value)
+    ELSE incr counter value
+  FI;
+  write dec value into file;
+  replace value in numbering store (dec value).
+
+resize dec value to needed points:
+  INT VAR needed points       :: int (par2),
+          begin of last digit :: 1;
+  WHILE needed points > 0 REP
+    IF next point pos = 0
+      THEN IF needed points = 1
+             THEN dec value CAT ".0"
+             ELSE dec value CAT ".1"
+           FI;
+           begin of last digit := length (dec value)
+      ELSE begin of last digit := next point pos + 1
+    FI;
+    needed points DECR 1
+  END REP;
+  INT VAR end of last digit := next point pos - 1;
+  IF end of last digit < 0
+    THEN end of last digit := length (dec value)
+  FI;
+  dec value := subtext (dec value, 1, end of last digit).
+
+next point pos:
+  pos (dec value, ".", begin of last digit).
+
+dec value was just initialized:
+  (dec value SUB 1) = "i".
+
+incr counter value:
+  INT VAR digit value :: int (
+               subtext (dec value, begin of last digit, end of last digit));
+  digit value INCR 1;
+  change (dec value, begin of last digit, end of last digit,
+                                                         text (digit value)).
+END PROC process counter;
+
+PROC process set counter:
+  dummy := "#";
+  dummy CAT par1;
+  dummy CAT "#";
+  IF pos (counter numbering store, dummy) <> 0
+    THEN warnung (15, par1);
+         replace value in numbering store (par2);
+         INT VAR begin pos :: pos (counter numbering store, dummy) + 1;
+         begin pos := pos (counter numbering store, "#", beginpos) + 1;
+         insert char (counter numbering store, "i", begin pos)
+    ELSE counter numbering store CAT dummy;
+         counter numbering store CAT "i";
+         counter numbering store CAT par2
+  FI.
+END PROC process set counter;
+
+PROC process counter store:
+  IF pos (counter reference store, par1) <> 0
+    THEN fehler (35, par1)
+    ELSE store it
+  FI.
+
+store it:
+  counter reference store CAT "#";
+  counter reference store CAT par1;
+  counter reference store CAT "#";
+  counter reference store CAT dec value
+END PROC process counter store;
+
+PROC process counter value:
+  dummy := "#";
+  dummy CAT par1;
+  dummy CAT "#";
+  IF pos (counter reference store, dummy) <> 0
+    THEN get dec value (counter reference store);
+         write dec value into file
+  ELIF durchgang = 3
+    THEN fehler (61, par1)
+  FI.
+END PROC process counter value;
+
+PROC replace value in numbering store (TEXT CONST val):
+  INT VAR begin pos :: pos (counter numbering store, dummy) + 1;
+  begin pos := pos (counter numbering store, "#", begin pos) + 1;
+  INT VAR end pos := pos (counter numbering store, "#", begin pos)-1;
+  IF end pos <= 0
+    THEN end pos := length (counter numbering store)
+  FI;
+  change (counter numbering store, begin pos, end pos, val)
+END PROC replace value in numbering store;
+
+PROC write dec value into file:
+  change (zeile, kommando anfangs pos, kommando ende pos, dec value);
+  kommando ende pos := kommando anfangs pos;
+  write record (ausgabe, zeile)
+END PROC write dec value into file;
+
+PROC get dec value (TEXT CONST store):
+  INT VAR value begin :: pos (store, dummy);
+  value begin := pos (store, "#", value begin + 1) + 1;
+  INT VAR value end :: pos (store, "#", value begin)-1;
+  IF value end < 0
+    THEN value end := length (store)
+  FI;
+  dec value := subtext (store, value begin, value end).
+END PROC get dec value;
+
+(************************** Zaehler routinen ('refer') ***************)
+ 
+PROC nummer und kennzeichen speichern (INT CONST number, TEXT VAR kennung):
+  ueberpruefe auf bereits vorhandenes kennzeichen;
+  anz refers INCR 1;
+  IF anz refers > max refers 
+    THEN errorstop ("Anzahl Referenzen zu gross") 
+  FI;
+  refer sammler [anz refers] . kennzeichen := kennung;
+  refer sammler [anz refers] . nummer      := number;
+  refer sammler [anz refers] . referenced  := FALSE.
+ 
+ueberpruefe auf bereits vorhandenes kennzeichen: 
+  INT VAR i;
+  FOR i FROM 1 UPTO anz refers REP 
+    IF refer sammler [i] . kennzeichen = kennung
+      THEN warnung (9, kennung);
+           LEAVE nummer und kennzeichen speichern
+    FI
+  END REP.
+END PROC nummer und kennzeichen speichern;
+ 
+PROC ggf gespeicherte nummer einsetzen (TEXT VAR kennung):
+  IF kennzeichen vorhanden
+    THEN change (zeile, kommando anfangs pos, kommando ende pos, textnummer);
+         refer sammler [i] . referenced := TRUE;
+         kommando ende pos := kommando anfangs pos;
+         write record (ausgabe, zeile)
+  ELIF durchgang = 3
+    THEN warnung (4, kennung)
+  FI. 
+ 
+textnummer:
+  text (refer sammler [i] . nummer).
+ 
+kennzeichen vorhanden: 
+INT VAR i;
+  FOR i FROM 1 UPTO anz refers REP 
+    IF refer sammler [i] . kennzeichen = kennung
+      THEN LEAVE kennzeichen vorhanden WITH TRUE
+    FI
+  END REP;
+  FALSE.
+END PROC ggf gespeicherte nummer einsetzen;
+
+(************************** free-Kommando *****************************) 
+ 
+PROC free kommando ausfuehren:
+INT CONST wert in y steps :: y step conversion (realparam);
+  IF bereich aufnehmen
+    THEN 
+  ELIF wert in y steps>=eingestellte seitenlaenge - seitenlaenge fester teil
+    THEN fehler (13, "")
+  ELIF erreichte seitenlaenge + wert in y steps > eingestellte seitenlaenge
+    THEN ende einer seite;
+         kommando index := fehler index
+    ELSE aktuelle seitenlaenge INCR wert in y steps
+  FI
+END PROC free kommando ausfuehren;
+ 
+(*************************** page-Kommando ******************************) 
+ 
+PROC page behandlung:
+TEXT VAR steuerzeichen;
+  page kommando entfernen;
+  IF aktuelle seitenlaenge <= 0
+    THEN IF line no (ausgabe) = 1
+           THEN zeile noch nicht verarbeitet := TRUE
+           ELSE up (ausgabe)
+         FI;
+         LEAVE page behandlung
+  FI;
+  IF interaktiv
+    THEN initialisiere bildschirm fuer page;
+         mit page interaktiv formatieren;
+         schreibe titelzeile;
+  FI;
+  BOOL CONST hilf :: pageblock on;
+  pageblock on := FALSE;
+  seitenende einbringen und zurueck;
+  pageblock on := hilf;
+  kommando index := page command0.
+ 
+page kommando entfernen:
+  IF kommando anfangs pos = 1
+    THEN delete record (ausgabe);
+         IF line no (ausgabe) = 1
+           THEN zeile noch nicht verarbeitet := TRUE
+         FI
+    ELSE zeile := subtext (zeile, 1, kommando anfangs pos - 1);
+         write record (ausgabe, zeile);
+         IF NOT only command line (zeile)
+           THEN aktuelle seitenlaenge INCR max zeilenvorschub
+         FI;
+         down (ausgabe)
+  FI.
+
+initialisiere bildschirm fuer page:
+  schreibe titelzeile
+  ("#page# bestaetigen: RETURN / loeschen: HOP RUBOUT / Abbruch: ESC");
+  line ; out (cleol);
+  put ("#page# nach");
+  put (y step conversion (erreichte seitenlaenge)); put ("cm");
+  schreibe bildschirm;
+  out (hop).
+
+mit page interaktiv formatieren:
+  REP
+     inchar (steuerzeichen);
+     IF steuerzeichen = return
+       THEN zeilenmitteilung loeschen;
+            LEAVE mit page interaktiv formatieren
+     ELIF steuerzeichen = rubout
+       THEN weitermachen
+     ELIF steuerzeichen = esc
+       THEN errorstop ("Abbruch mit ESC")
+     FI
+  END REP.
+ 
+weitermachen:
+  zeilenmitteilung loeschen;
+  up (ausgabe);
+  LEAVE page behandlung.
+ 
+zeilenmitteilung loeschen:
+  cursor (1, 2); out (cleol); line.
+END PROC page behandlung;
+
+PROC seite nochmal durchgehen:
+  zurueck bis seitenende;
+  kommandos wiederherstellen;
+  down (ausgabe);
+  IF count seitenzaehlung
+    THEN counter := 0
+  FI;
+  schreibe ggf kopf;
+  read record (ausgabe, zeile);
+  seitenlaenge initialisieren;
+  fussnoten loeschen;
+  bis seitenende lesen und kommandos verarbeiten;
+  schreibe ggf fuss;
+  initialisieren fuer neue seite.
+ 
+bis seitenende lesen und kommandos verarbeiten:
+  durchgang := 2;
+  zeilen und kommandos verarbeiten;
+  durchgang := 1.
+ 
+zeilen und kommandos verarbeiten:
+  anz textzeilen := 0;
+  WHILE NOT seitenende REP
+    IF mindestens ein kommando vorhanden
+      THEN IF NOT only command line (zeile)
+             THEN anz textzeilen INCR 1
+           FI;
+           kommandos verarbeiten und ggf zeile mitzaehlen;
+      ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub;
+           anz textzeilen INCR 1
+    FI;
+    naechste zeile lesen
+  END REP.
+ 
+initialisieren fuer neue seite:
+  kommandos aufheben;
+  fussnoten loeschen;
+  erhoehe seiten und spaltennr;
+  seitenlaenge initialisieren
+END PROC seite nochmal durchgehen;
+
+PROC seitenlaenge initialisieren: 
+  IF anz spalten > 1 AND laufende spaltennr > 1
+    THEN aktuelle seitenlaenge := text laenge vor columns
+    ELSE aktuelle seitenlaenge := 0;
+         verarbeite seitenkommandos
+  FI.
+
+verarbeite seitenkommandos:
+  IF kommando seitenspeicher <> ""
+    THEN zeile := kommando seitenspeicher;
+         kommando seitenspeicher := "";
+         INT CONST xx := durchgang;
+         durchgang := 4;
+         kommandos verarbeiten;
+         durchgang := xx
+  FI.
+END PROC seitenlaenge initialisieren; 
+ 
+PROC zurueck bis seitenende:
+  up (ausgabe, "#page##---", line no (ausgabe));
+  IF anz spalten > 1 AND laufende spaltennr > 1
+    THEN down (ausgabe);
+         schreibe free (text laenge vor columns + head laenge);
+         up (ausgabe)
+  FI;
+  read record (ausgabe, zeile);
+  cout (line no (ausgabe));
+END PROC zurueck bis seitenende;
+ 
+BOOL PROC seitenende:
+  pos (zeile, "#page#") = 1 AND pos (zeile, "-----", 8) = 8
+END PROC seitenende;
+
+(**************************** eigentliche seitenform-routine *********) 
+ 
+PROC seiten form:
+  enable stop;
+   datei assoziieren;
+   page form initialisieren;
+   to line (ausgabe, 1);
+   read record (ausgabe, zeile);
+   in nullter seite := TRUE;
+   nullte seite verarbeiten;
+   nullte seitengrenze einfuegen;
+   in nullter seite := FALSE;
+   formieren.
+ 
+nullte seite verarbeiten:
+  aktuelle seitenlaenge := 0;
+  WHILE only command line (zeile) REP
+    IF seitenende 
+      THEN errorstop ("Bitte Originaldatei bearbeiten (keine Druckdatei)")
+    FI;
+    kommandos verarbeiten; 
+    IF es war ein free kommando OR tabellen kommando
+      THEN LEAVE nullte seite verarbeiten
+    ELIF es war ein linefeed in der zeile
+      THEN berechne zeilenvorschub;
+           es war ein linefeed in der zeile := FALSE;
+           naechste zeile lesen
+    ELIF zeile noch nicht verarbeitet
+      THEN read record (ausgabe, zeile);
+           zeile noch nicht verarbeitet := FALSE
+      ELSE naechste zeile lesen
+    FI;
+    cout (line no (ausgabe))
+  ENDREP.
+ 
+es war ein free kommando:
+  aktuelle seitenlaenge <> 0.
+ 
+tabellen kommando:
+  kommando index >= 35 AND kommando index <= 44.
+
+nullte seitengrenze einfuegen:
+  laufende spaltennr := 0;
+  grenzmarkierung in dummy speichern;
+  record einfuegen (dummy);
+  read record (ausgabe, zeile);
+  kommandos aufheben;
+  aktuelle seitenlaenge := 0;
+  erhoehe seiten und spaltennr;
+  nummer erste seite := laufende seiten nr [1].
+
+formieren:
+   REP
+     cout (line no (ausgabe));
+     IF mindestens ein kommando vorhanden
+       THEN kommandos verarbeiten und ggf zeile mitzaehlen
+       ELSE aktuelle seitenlaenge INCR berechneter zeilenvorschub;
+     FI;
+     IF erreichte seitenlaenge > eingestellte seitenlaenge
+       THEN ende einer seite
+     FI;
+     IF eof (ausgabe)
+       THEN eof behandlung;
+            LEAVE formieren
+       ELSE down (ausgabe);
+            IF eof (ausgabe)
+              THEN eof behandlung;
+                   LEAVE formieren
+              ELSE read record (ausgabe, zeile)
+            FI
+     FI
+   END REP.
+END PROC seiten form;
+
+PROC eof behandlung:
+  grenzmarkierung in dummy speichern;
+  insert record (ausgabe);
+  write record (ausgabe, dummy);
+  nummer letzte seite := laufende seiten nr [1];
+  pageblock on := FALSE;
+  seite nochmal durchgehen;
+  IF anz refers <> 0 OR mindestens ein topage gewesen
+     OR counter reference store <> ""
+    THEN ausgabe datei nochmals durchgehen;
+         offene referenzen pruefen
+  FI. 
+ 
+ausgabe datei nochmals durchgehen: 
+  to line (ausgabe, 1); col (ausgabe, 1);
+  durchgang := 3; 
+  REP
+    down (ausgabe, "#", lines (ausgabe));
+    IF pattern found
+      THEN read record (ausgabe, zeile);
+           cout (line no (ausgabe));
+           kommandos verarbeiten;
+           IF eof (ausgabe)
+             THEN LEAVE ausgabe datei nochmals durchgehen
+             ELSE down (ausgabe); col (ausgabe, 1)
+           FI
+      ELSE LEAVE ausgabe datei nochmals durchgehen
+    FI
+  END REP.
+
+offene referenzen pruefen: 
+  INT VAR i;
+  FOR i FROM 1 UPTO anz refers REP 
+    IF NOT refer sammler [i] . referenced
+      THEN report text processing warning
+                  (3, 0, fehlerdummy, CONCR(refersammler) [i] . kennzeichen) 
+    FI 
+  END REP.
+END PROC eof behandlung;
+
+(************************** kommando verarbeitung **********)
+
+BOOL PROC mindestens ein kommando vorhanden:
+   pos (zeile, kommando zeichen) <> 0.
+END PROC mindestens ein kommando vorhanden;
+
+PROC kommandos verarbeiten:
+  kommando anfangs pos := pos (zeile, kommando zeichen);
+  WHILE kommando anfangs pos <> 0 REP
+    verarbeite kommando;
+    IF kommando index = end OR kommando index = page command0
+       OR kommando index = page command1 OR kommando index = fehler index
+      THEN LEAVE kommandos verarbeiten
+      ELSE kommando anfangs pos :=
+                 pos (zeile, kommando zeichen, kommando ende pos + 1)
+    FI
+  END REP. 
+END PROC kommandos verarbeiten;
+
+PROC kommandos verarbeiten und ggf zeile mitzaehlen:
+  max zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub;
+  kommandos verarbeiten;
+  in index oder exponent := 0;
+  zeile zur seitenlaenge ggf addieren;
+  IF es war ein linefeed in der zeile
+    THEN berechne zeilenvorschub;
+         es war ein linefeed in der zeile := FALSE
+  FI.
+
+zeile zur seitenlaenge ggf addieren:
+  IF only command line (zeile) OR
+     kommando index = end OR kommando index = page command0 OR
+     kommando index = page command1 OR kommando index = fehler index
+    THEN 
+    ELSE aktuelle seitenlaenge INCR max zeilenvorschub;
+  FI.
+END PROC kommandos verarbeiten und ggf zeile mitzaehlen;
+
+BOOL PROC keine zeichen ausser blank nach dem kommando:
+  IF kommando anfangs pos > 1 AND
+          pos (zeile, ""33"", ""255"", 1) = kommando anfangs pos
+    THEN warnung (13, kommando)
+  FI;
+  kommando ende pos = length (zeile) OR
+  pos (zeile, ""33"", ""254"", kommando ende pos + 1) = 0
+END PROC keine zeichen ausser blank nach dem kommando;
+
+BOOL PROC absatz zeile:
+  (zeile SUB length (zeile)) = blank
+END PROC absatz zeile;
+ 
+(********************** routinen fuers seitenende *************)
+
+INT PROC erreichte seitenlaenge:
+  aktuelle seitenlaenge + kopf oder fuss laenge [footnote] +
+        seitenlaenge fester teil
+END PROC erreichte seitenlaenge;
+ 
+INT PROC seitenlaenge fester teil:
+  head laenge + bottom laenge.
+ 
+bottom laenge: 
+  IF (NOT insert last bottom AND laufende seitennr [1] = nummer letzte seite)
+     OR ausgeschalteter bottom
+   THEN 0
+    ELSE kopf oder fuss laenge [fuss] +
+         bottom laenge fuer gerade oder ungerade seiten
+  FI. 
+
+bottom laenge fuer gerade oder ungerade seiten:
+  IF laufende seitennr [1] MOD 2 = 0
+    THEN kopf oder fuss laenge [fuss gerade]
+    ELSE kopf oder fuss laenge [fuss ungerade]
+  FI.
+END PROC seitenlaenge fester teil;
+
+INT PROC head laenge: 
+  IF (NOT insert first head AND laufende seitennr [1] = nummer erste seite)
+     OR ausgeschalteter head
+    THEN 0
+    ELSE kopf oder fuss laenge [kopf] + 
+         head laenge fuer gerade oder ungerade seiten 
+  FI. 
+ 
+head laenge fuer gerade oder ungerade seiten:
+  IF laufende seitennr [1] MOD 2 = 0
+    THEN kopf oder fuss laenge [koπ3Πφ&η6φζ�
+    ELSE kopf oder fuss laenge [kopf ungerade]
+  FI.
+END PROC head laenge;
+
+PROC ende einer seite:
+  IF interaktiv
+    THEN seitenende ggf verschieben
+    ELSE seitenende fuer autopageform ggf verschieben
+  FI;
+  seitenende einbringen und zurueck.
+ 
+seitenende ggf verschieben:
+  BOOL VAR veraenderungen in der seite :: FALSE;
+  formatiere ueber bildschirm (veraenderungen in der seite);
+  schreibe titelzeile;
+  IF veraenderungen in der seite
+    THEN zum seitenanfang zur erneuten bearbeitung;
+         LEAVE ende einer seite
+  FI.
+
+seitenende fuer autopageform ggf verschieben:
+INT VAR i, hier :: line no (ausgabe);
+  FOR i FROM 1 UPTO 4 REP
+    zeile zurueck lesen;
+    IF absatz zeile OR line no (ausgabe) <= 2
+      THEN ggf um leerzeilen nach oben lesen;
+           naechste zeile lesen;
+           LEAVE seitenende fuer autopageform ggf verschieben
+    FI
+  END REP;
+  to line (ausgabe, hier);
+  read record (ausgabe, zeile);
+  IF pageblock on
+    THEN FOR i FROM 1 UPTO 4 REP
+           IF absatz zeile OR eof (ausgabe) OR pos (zeile, "#foot") <> 0
+              OR pos (zeile, "#free") <> 0
+             THEN naechste zeile lesen;
+                  LEAVE seitenende fuer autopageform ggf verschieben
+           FI;
+           naechste zeile lesen
+         END REP;
+         to line (ausgabe, hier);
+         read record (ausgabe, zeile)
+  FI.
+
+ggf um leerzeilen nach oben lesen:
+  INT VAR ii := i;
+  WHILE zeile = " " AND pageblock on AND ii <= 4 REP
+    IF line no (ausgabe) <= 2
+      THEN LEAVE ggf um leerzeilen nach oben lesen
+    FI;
+    zeile zurueck lesen;
+    ii INCR 1
+  END REP.
+END PROC ende einer seite;
+
+PROC seitenende einbringen und zurueck:
+  letzte textzeile war mit absatz := letzte zeile;
+  down (ausgabe);
+  grenzmarkierung in dummy speichern;
+  record einfuegen (dummy);
+  up (ausgabe);
+  seite nochmal durchgehen.
+
+letzte zeile:
+  up (ausgabe);
+  read record (ausgabe, zeile);
+  absatz zeile.
+END PROC seitenende einbringen und zurueck;
+
+PROC zum seitenanfang zur erneuten bearbeitung:
+  zurueck bis seitenende; 
+  durchgang := 1;
+  aktuelle seitenlaenge := 0; 
+  fussnoten loeschen; 
+  kommandos wiederherstellen 
+END PROC zum seitenanfang zur erneuten bearbeitung; 
+ 
+(********************** positionierungs routinen ************)
+
+PROC naechste zeile lesen: 
+   down (ausgabe);
+   read record (ausgabe, zeile)
+END PROC naechste zeile lesen; 
+
+PROC zeile zurueck lesen: 
+   up (ausgabe);
+   read record (ausgabe, zeile);
+END PROC zeile zurueck lesen;
+
+(***************** seitenende interaktiv positionieren **********)
+
+PROC formatiere ueber bildschirm (BOOL VAR veraenderungen):
+  veraenderungen := FALSE;
+  anz zeilen nach oben := 0;
+  erste bildschirmzeile schreiben;
+  schreibe bildschirm;
+  REP
+     positioniere lfd satz nach steuerzeichen und ggf schirm schreiben
+  END REP.
+ 
+positioniere lfd satz nach steuerzeichen und ggf schirm schreiben:
+TEXT VAR steuerzeichen;
+   inchar (steuerzeichen);
+   IF steuerzeichen = upchar
+     THEN nach oben;
+          IF fussnoten ende
+            THEN ueberspringe fussnote nach oben;
+                 schreibe bildschirm
+          FI
+   ELIF steuerzeichen = downchar
+     THEN IF fussnoten anfang 
+            THEN ueberspringe fussnote nach unten;
+                 schreibe bildschirm
+            ELSE nach unten;
+                 IF fussnoten anfang 
+                   THEN ueberspringe fussnote nach unten;
+                        schreibe bildschirm
+                 FI
+          FI 
+   ELIF steuerzeichen = hop
+     THEN sprung oder leerzeilen veraenderung;
+          schreibe bildschirm;
+   ELIF steuerzeichen = return
+     THEN IF anz zeilen nach oben < 0
+            THEN down (ausgabe);
+                 read record (ausgabe, zeile)
+          FI;
+          IF zeile = "" OR zeile = " " 
+            THEN leerzeilen vor neuer seite loeschen
+          FI;
+          LEAVE formatiere ueber bildschirm
+  ELIF steuerzeichen = esc
+    THEN errorstop ("Abbruch mit ESC")
+   FI.
+
+fussnoten anfang:
+  pos (zeile, "#foot") <> 0 AND anz zeilen nach oben > 0.
+
+fussnoten ende:
+  pos (zeile, "#end") <> 0.
+
+nach oben:
+  IF anz zeilen nach oben < 0
+    THEN nach oben unterhalb der seitengrenze
+  ELIF eine zeile nach oben war moeglich
+    THEN IF fussnoten ende
+           THEN ueberspringe fussnote nach oben;
+                schreibe bildschirm
+         ELIF anz vertauschte zeilen < zeilen nach oben
+           THEN out (upchar); raus; out (upchar);
+                schreibe seitenbegrenzung auf bildschirm;
+                anz vertauschte zeilen INCR 1
+           ELSE schreibe bildschirm
+         FI
+  FI.
+
+nach oben unterhalb der seitengrenze:
+  IF anz zeilen nach oben = -1
+    THEN cursor (1, pos seitengrenze); out (cl eop);
+         schreibe seitenbegrenzung auf bildschirm;
+         cursor (1, pos seitengrenze);
+         schreibe untere zeilen;
+         anz zeilen nach oben := 0
+    ELSE INT VAR bildschirmzeile unterhalb ::
+                           pos seitengrenze + abs (anz zeilen nach oben) + 1;
+         cursor (1, bildschirmzeile unterhalb);
+         out (cl eol);
+         outsubtext (zeile, 1, 76);
+         anz zeilen nach oben INCR 1;
+         bildschirmzeile unterhalb DECR 1;
+         cursor (1, bildschirmzeile unterhalb);
+         schreibe seitenbegrenzung auf bildschirm;
+         zeile zurueck lesen;
+         cursor (1, pos seitengrenze)
+  FI.
+
+nach unten:
+  IF anz zeilen nach oben < -4
+    THEN
+  ELIF anz zeilen nach oben < 1
+    THEN ggf nach unten formatieren
+  ELIF anz vertauschte zeilen > 0
+    THEN out (upchar); raus; line ;
+         schreibe seitenbegrenzung auf bildschirm;
+         eine zeile nach unten wenn moeglich;
+         anz vertauschte zeilen DECR 1
+    ELSE eine zeile nach unten wenn moeglich;
+         IF fussnoten anfang
+           THEN ueberspringe fussnote nach unten;
+         FI;
+         schreibe bildschirm
+  FI.
+
+ggf nach unten formatieren:
+  IF pageblock on
+    THEN zeile nach unten ueber seitengrenze;
+         cursor (1, pos seitengrenze);
+  FI.
+
+zeile nach unten ueber seitengrenze:
+  IF eof (ausgabe) OR page oder free oder foot anweisung
+    THEN LEAVE zeile nach unten ueber seitengrenze
+    ELSE naechste zeile lesen;
+         IF eof (ausgabe) OR page oder free oder foot anweisung
+           THEN zeile zurueck lesen;
+                LEAVE zeile nach unten ueber seitengrenze
+         FI;
+         zeile zurueck lesen
+  FI;
+  IF anz zeilen nach oben = 0
+    THEN out (cl eol);
+         out (begin mark);
+         out ("Über Seitenende hinaus (Stauchung): UP/DOWN");
+         out (end mark);
+         cursor (1, pos seitengrenze + 1);
+         schreibe untere zeilen;
+    ELSE naechste zeile lesen;
+  FI;
+  cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1);
+  out (cl eol);
+  outsubtext (zeile, 1, 76);
+  anz zeilen nach oben DECR 1;
+  cursor (1, pos seitengrenze + abs (anz zeilen nach oben) + 1);
+  schreibe seitenbegrenzung auf bildschirm.
+
+page oder free oder foot anweisung:
+  pos (zeile, "#page") <> 0 OR pos (zeile, "#free") <> 0
+  OR pos (zeile, "#foot") <> 0.
+
+sprung oder leerzeilen veraenderung:
+  INT VAR i :: 0;
+  REP
+    inchar (steuerzeichen);
+    IF steuerzeichen = upchar
+      THEN sprung nach oben
+    ELIF steuerzeichen = downchar
+      THEN sprung nach unten
+    ELIF steuerzeichen = rub out
+      THEN zeile loeschen;
+    ELIF steuerzeichen = rub in
+      THEN leerzeilen einfuegen;
+    FI
+  END REP.
+
+sprung nach oben:
+   WHILE eine zeile nach oben war moeglich REP
+      i INCR 1;
+      IF fussnoten ende
+        THEN ueberspringe fussnote nach oben;
+             LEAVE sprung oder leerzeilen veraenderung
+      FI
+   UNTIL i >= zeilen nach oben END REP;
+   LEAVE sprung oder leerzeilen veraenderung.
+
+sprung nach unten:
+   WHILE i < zeilen nach oben REP
+      IF fussnoten anfang
+        THEN ueberspringe fussnote nach unten;
+             LEAVE sprung oder leerzeilen veraenderung
+        ELSE eine zeile nach unten wenn moeglich;
+             i INCR 1;
+      FI;
+      IF fussnoten anfang
+        THEN ueberspringe fussnote nach unten;
+             LEAVE sprung oder leerzeilen veraenderung
+      FI
+   END REP;
+   LEAVE sprung oder leerzeilen veraenderung.
+
+zeile loeschen:
+  veraenderungen := TRUE;
+  up (ausgabe);
+  read record (ausgabe, zeile);
+  IF seiten ende
+    THEN down (ausgabe);
+    ELSE delete record (ausgabe);
+  FI;
+  LEAVE formatiere ueber bildschirm.
+
+leerzeilen einfuegen:
+  veraenderungen := TRUE;
+  out (cl eop);
+  REP
+    inchar (steuerzeichen);
+    IF steuerzeichen = return
+      THEN insert record (ausgabe);
+           zeile := " ";
+           write record (ausgabe, zeile);
+           out (upchar);
+           raus;
+           line
+    ELIF steuerzeichen = rubin
+      THEN LEAVE formatiere ueber bildschirm
+    FI
+  END REP.
+END PROC formatiere ueber bildschirm;
+
+PROC leerzeilen vor neuer seite loeschen:
+  WHILE zeile = "" OR zeile = " " REP
+    delete record (ausgabe);
+    IF eof (ausgabe)
+      THEN LEAVE leerzeilen vor neuer seite loeschen
+      ELSE read record (ausgabe, zeile)
+    FI
+  END REP.
+END PROC leerzeilen vor neuer seite loeschen;
+
+PROC ueberspringe fussnote nach oben:
+  WHILE eine zeile nach oben war moeglich REP
+    IF fussnoten anfang
+      THEN IF eine zeile nach oben war moeglich
+             THEN
+           FI;
+           LEAVE ueberspringe fussnote nach oben
+    FI
+  END REP.
+
+fussnoten anfang:
+  pos (zeile, "#foot#") <> 0.
+END PROC ueberspringe fussnote nach oben;
+
+PROC ueberspringe fussnote nach unten:
+  REP
+    eine zeile nach unten wenn moeglich;
+    IF fussnoten ende
+      THEN eine zeile nach unten wenn moeglich;
+           LEAVE ueberspringe fussnote nach unten
+    FI
+  END REP.
+
+fussnoten ende:
+  pos (zeile, "#end#") <> 0.
+END PROC ueberspringe fussnote nach unten;
+
+PROC schreibe free (INT CONST wert):
+REAL CONST wert in y steps :: y step conversion (wert);
+  dummy := "#free(";
+  IF wert in y steps < 1.0
+    THEN dummy CAT "0"; 
+  FI;
+  dummy CAT text (wert in y steps);
+  dummy CAT ")#";
+  record einfuegen (dummy);
+END PROC schreibe free;
+
+BOOL PROC eine zeile nach oben war moeglich:
+  IF line no (ausgabe) = 1
+    THEN FALSE
+    ELSE zeile zurueck lesen;
+         IF seitenende OR columns kommando in dieser zeile
+           THEN naechste zeile lesen;
+                FALSE
+           ELSE anz zeilen nach oben INCR 1;
+                TRUE
+         FI
+  FI.
+
+columns kommando in dieser zeile:
+  anz spalten > 1 AND pos (zeile, "#columns") <> 0.
+END PROC eine zeile nach oben war moeglich;
+
+PROC eine zeile nach unten wenn moeglich:
+   IF anz zeilen nach oben > 0
+     THEN naechste zeile lesen;
+          anz zeilen nach oben DECR 1
+   FI
+END PROC eine zeile nach unten wenn moeglich;
+
+PROC erste bildschirmzeile schreiben:
+  IF anz spalten > 1
+    THEN dummy := "Spalten"
+    ELSE dummy := "Seiten"
+  FI;
+  dummy CAT "ende verschieben: UP, DOWN / bestaetigen: RETURN / Abbruch: ESC";
+  schreibe titelzeile (dummy).
+END PROC erste bildschirmzeile schreiben;
+
+PROC schreibe bildschirm:
+  anz vertauschte zeilen := 0;
+  cursor (1, 3);
+  out (cl eop);
+  gehe zurueck;
+  wieder nach vorne und zeilen ausgeben;
+  cursor (1, pos seitengrenze);
+  schreibe seitenbegrenzung auf bildschirm;
+  cursor (1, pos seitengrenze);
+  schreibe untere zeilen.
+
+gehe zurueck:
+  INT VAR hier :: line no (ausgabe) -1;
+  to line (ausgabe, hier - zeilen nach oben + 1);
+  INT VAR anz read zeilen :: hier - line no (ausgabe) + 2.
+
+ wieder nach vorne und zeilen ausgeben:
+   IF line no (ausgabe) = 1
+     THEN ggf leerzeilen auf bildschirm schreiben;
+   FI;
+   WHILE line no (ausgabe) <= hier REP
+      read record (ausgabe, zeile);
+      raus;
+      down (ausgabe);
+   END REP;
+   read record (ausgabe, zeile).
+
+ggf leerzeilen auf bildschirm schreiben:
+   IF zeilen nach oben - anz read zeilen >= 0
+     THEN INT VAR i;
+          FOR i FROM 1 UPTO zeilen nach oben - anz read zeilen REP
+            line ; out (cl eol); out(" ")
+          END REP;
+          line ; out (cl eol);
+          out ("<< DATEI ANFANG >>"); out (return)
+   FI.
+END PROC schreibe bildschirm;
+
+PROC schreibe untere zeilen:
+  gehe weiter und gebe zeilen aus;
+  gehe wieder zurueck;
+  skip input;
+  cursor (1, pos seitengrenze).
+
+gehe weiter und gebe zeilen aus:
+INT VAR anz read zeilen :: 0,
+        i               :: line no (ausgabe);
+  WHILE anz read zeilen < zeilen nach unten REP
+    IF eof (ausgabe)
+       THEN line ; out (cleol); out ("<< DATEI ENDE >>");
+            LEAVE gehe weiter und gebe zeilen aus
+     FI;
+     raus;
+     naechste zeile lesen;
+     anz read zeilen INCR 1
+  END REP.
+
+gehe wieder zurueck:
+  to line (ausgabe, i);
+  read record (ausgabe, zeile).
+END PROC schreibe untere zeilen;
+
+(***************** schreib-routinen fuer den bildschirm ************)
+
+PROC schreibe seitenbegrenzung auf bildschirm:
+   out (cl eol); out (begin mark);
+   grenzmarkierung in dummy speichern;
+   out (dummy);
+   out (end mark);
+   out (return)
+END PROC schreibe seitenbegrenzung auf bildschirm;
+
+PROC raus:
+INT VAR xzeile, yspalte;
+   line ; out (cl eol);
+   outsubtext (zeile, 1, 76);
+   IF absatz zeile
+     THEN get cursor (yspalte, xzeile);
+          cursor (77, xzeile);
+          out (begin end mark)
+   FI;
+   out (return)
+END PROC raus;
+ 
+PROC schreibe titelzeile:
+  IF online
+    THEN schreibe
+  FI.
+
+schreibe:
+  out (hop); out (cleol);
+  put ("PAGEFORM"); put ("(für"); put (lines (ausgabe)); put ("Zeilen):");
+  put (name eingabe datei);
+  put ("->");
+  put (name druck datei);
+  cursor (1, 3).
+END PROC schreibe titelzeile;
+ 
+PROC schreibe titelzeile (TEXT CONST t):
+  IF online
+    THEN schreibe
+  FI.
+
+schreibe:
+  out (hop); out (cl eol);
+  out (begin mark);
+  out (t);
+  out (end mark)
+END PROC schreibe titelzeile; 
+ 
+(************************** initialisierungs-routine ************)
+
+PROC page form initialisieren:
+BOOL VAR exists;
+INT VAR i;
+  letzte textzeile war mit absatz   := TRUE;
+  letztes seitenende war mit absatz := TRUE;
+  pageblock on                      := FALSE;
+  zeile noch nicht verarbeitet      := FALSE;
+  bereich aufnehmen                 := FALSE;
+  count seitenzaehlung              := FALSE;
+  ausgeschalteter head              := FALSE;
+  ausgeschalteter bottom            := FALSE;
+  in tabelle                        := FALSE;
+  es war ein linefeed in der zeile  := FALSE;
+  letztes seitenende war in tabelle := FALSE;
+  mindestens ein topage gewesen     := FALSE;
+  in index oder exponent    := 0;
+  anz refers                := 0;
+  kommando index            := 0;
+  counter                   := 0;
+  laufende seitennr [1]     := 1;
+  durchgang                 := 1;
+  anz spalten               := 1;
+  modifikation              := "";
+  tab pos speicher          := "";
+  kommando seitenspeicher   := "";
+  counter numbering store   := "";
+  counter reference store   := "";
+  dec value                 := "";
+  seitenzeichen             := "%";
+  eingestelltes limit       := dina4 limit;
+  IF NOT file works
+    THEN font nr := 1;
+         eingestellter typ := font (1);
+         type zeilenvorschub :=
+                          font height (1) + font lead (1) + font depth (1);
+         eingestellte seitenlaenge := y step conversion (dina4 pagelength);
+         real eingestellter zeilenvorschub := 1.0
+  FI;
+  berechneter zeilenvorschub :=
+  int (real (type zeilenvorschub) * real eingestellter zeilenvorschub + 0.5);
+  max      zeilenvorschub := berechneter zeilenvorschub;
+  max type zeilenvorschub := type zeilenvorschub;
+  FOR i FROM 1 UPTO 7 REP
+     kopf oder fuss laenge [i]     := 0;
+     anz kopf oder fuss zeilen [i] := 0
+  END REP;
+  IF online
+    THEN page
+  FI;
+  IF command dialogue
+    THEN interaktiv := TRUE;
+    ELSE interaktiv := FALSE;
+  FI;
+  IF online
+    THEN page
+  FI;
+  schreibe titelzeile
+END PROC page form initialisieren;
+
+PROC central pagefo9ü̈NSγJr+�Cβ+̂γ��{s�β�KrΓλγb�#Τκ�ZK��
+  name eingabe datei := input;
+  name druck datei   := druck;
+  IF exists (druck)
+    THEN forget (druck, quiet)
+  FI;
+  disable stop;
+    ds := nilspace; 
+    refer sammler := ds;
+    seiten form;
+    forget(ds);
+    IF is error
+      THEN put error;
+           clear error; 
+           last param (name eingabe datei)
+      ELSE last param (name druck datei)
+    FI;
+  enable stop;
+  IF anything noted
+    THEN note edit (ausgabe)
+  FI.
+END PROC central pageform routine;
+
+PROC pageform (TEXT CONST input, druck):
+  file works := FALSE;
+  central pageform routine (input, druck).
+END PROC pageform;
+ 
+PROC pageform (TEXT CONST input):
+  file works := FALSE;
+  central pageform routine (input, input + ".p").
+END PROC pageform;
+
+PROC pageform:
+  file works := FALSE;
+  pageform (last param)
+END PROC pageform;
+ 
+PROC pageform (TEXT CONST input, REAL CONST lf, seitenlaenge):
+  file works                := TRUE;
+  eingestellte seitenlaenge := y step conversion (seitenlaenge);
+  real eingestellter zeilenvorschub := lf;
+  central pageform routine (input, input + ".p")
+END PROC pageform;
+
+PROC autopageform:
+  autopageform (last param)
+END PROC autopageform;
+
+PROC autopageform (TEXT CONST input):
+  command dialogue (false);
+  pageform (input);
+  command dialogue (true)
+END PROC autopageform;
+END PACKET seiten formatieren;
+(*
+REP
+  IF yes ("autopageform")
+    THEN autopageform ("pfehler")
+    ELSE pageform ("pfehler")
+  FI;
+  edit("pfehler.p");
+UNTIL yes ("ENDE") ENDREP;
+*)
+
diff --git a/system/multiuser/1.7.5/src/print cmd b/system/multiuser/1.7.5/src/print cmd
new file mode 100644
index 0000000..1fcb475
--- /dev/null
+++ b/system/multiuser/1.7.5/src/print cmd
@@ -0,0 +1,29 @@
+ 
+PACKET print cmd DEFINES print, printer : 
+ 
+PROC print :
+
+  print (last param)
+
+ENDPROC print ;
+
+PROC print (TEXT CONST file name) :
+
+  save (file name, task ("PRINTER")) ; 
+ 
+ENDPROC print ;
+
+PROC print (THESAURUS CONST nameset) :
+
+  do (PROC (TEXT CONST) print, nameset)
+
+ENDPROC print ;
+
+TASK PROC printer :
+
+  task ("PRINTER")
+
+ENDPROC printer ;
+
+ENDPACKET print cmd ;
+
diff --git a/system/multiuser/1.7.5/src/priv ops b/system/multiuser/1.7.5/src/priv ops
new file mode 100644
index 0000000..a92ee76
--- /dev/null
+++ b/system/multiuser/1.7.5/src/priv ops
@@ -0,0 +1,268 @@
+(* ------------------- VERSION 10     22.04.86 ------------------- *)
+PACKET privileged operations DEFINES           (* Autor: J.Liedtke *)
+ 
+     block ,
+     calendar ,
+     collect garbage blocks ,
+     define collector , 
+     fixpoint ,
+     info password ,
+     prio ,
+     save system ,
+     send ,
+     set clock ,
+     set date ,
+     shutup ,
+     unblock :
+ 
+LET prio field           = 6 ,
+    cr                   = ""13"" ,
+    archive channel      = 31 ,
+
+    ack                  = 0 , 
+
+    garbage collect code = 1 ,
+    fixpoint code        = 2 ,
+    shutup code          = 4 ,
+    shutup and save code = 12 ,
+    reserve code         = 19 ,
+    release code         = 20 ;
+
+
+
+INT PROC prio (TASK CONST task) :
+  pcb (task, prio field)
+ENDPROC prio ;
+
+PROC prio (TASK CONST task, INT CONST new prio) :
+  pcb (task, prio field, new prio)
+ENDPROC prio ;
+
+TEXT VAR date text ;
+
+PROC collect garbage blocks :
+
+  system operation (garbage collect code)
+
+ENDPROC collect garbage blocks ;
+
+PROC fixpoint :
+
+  system operation (fixpoint code)
+
+ENDPROC fixpoint ;
+
+PROC info password (TEXT CONST old info password, new info password) :
+
+  INT VAR error code ;
+  IF online
+    THEN say (""3""5""10"")
+  FI ;
+  IF LENGTH new info password < 10
+    THEN infopw (old info password + cr, new info pw, error code) ;
+         IF error code = 0
+           THEN shutup
+           ELSE errorstop ("Falsches Info-Passwort")
+         FI
+    ELSE errorstop ("Passwort zu lang (max. 9 Zeichen)")
+  FI ;
+  cover tracks .
+
+new info pw :
+  IF new info password = "-"
+    THEN "-" + 9 * "0"
+    ELSE new info password + "cr"
+  FI .
+
+ENDPROC info password ;
+
+PROC shutup :
+
+  system operation (shutup code) ;
+  IF command dialogue
+     THEN wait for configurator ;
+          page ;
+          set date
+  FI
+
+ENDPROC shutup ;
+
+PROC save system :
+
+  INT VAR reply ;
+  TASK VAR channel owner ;
+  enable stop ;
+  reserve archive channel ;
+  IF yes ("Leere Floppy eingelegt")
+  THEN
+    reserve archive channel ;
+    system operation (shutup and save code) ;
+    release archive channel ;
+    IF command dialogue
+      THEN wait for configurator ; 
+           page ;
+           set date
+    FI 
+  FI ;
+  release archive channel .
+
+reserve archive channel :
+  channel owner := task (archive channel) ;
+  IF NOT is niltask (channel owner) 
+    THEN  ask channel owner to reserve the channel ;
+          IF channel owner does not reserve channel
+            THEN errorstop ("Task """ + name (channel owner)
+                                      + """ gibt Kanal " 
+                                      + text (archive channel)
+                                      + " nicht frei") 
+         FI 
+  FI . 
+ 
+ask channel owner to reserve the channel :
+  forget (ds) ;
+  ds := nilspace ;
+  pingpong (channel owner, reserve code, ds, reply) . 
+
+channel owner does not reserve channel : 
+  (reply <> ack) AND task exists . 
+ 
+task exists : 
+  reply <> -1 . 
+
+release archive channel :
+  forget (ds) ;
+  ds := nilspace ;
+  pingpong (channel owner, release code, ds, reply) .
+
+ENDPROC save system ;
+
+PROC system operation (INT CONST code) :
+
+  INT VAR size, used ;
+  storage (size, used) ;
+  IF used <= size
+    THEN sys op (code)
+    ELSE errorstop ("Speicherengpass")
+  FI
+
+ENDPROC system operation ;
+
+DATASPACE VAR ds := nilspace ;
+
+PROC wait for configurator :
+
+  INT VAR i , receipt ;
+  FOR i FROM 1 UPTO 20 WHILE configurator exists REP
+    pause (30) ;
+    forget (ds) ;
+    ds := nilspace ;
+    ping pong (configurator, ack, ds, receipt)
+  UNTIL receipt >= 0 PER .
+
+configurator exists :
+  disable stop ;
+  TASK VAR configurator := task ("configurator") ;
+  clear error ;
+  NOT is niltask (configurator) .
+
+ENDPROC wait for configurator ;
+
+BOOL VAR hardware clock ok ; 
+REAL VAR now ;
+ 
+PROC set date : 
+ 
+  hardware clock ok := TRUE ; 
+  try to get date and time from hardware ; 
+  IF NOT hardware clock ok 
+    THEN get date and time from user 
+  FI ; 
+  define date and time . 
+ 
+try to get date and time from hardware : 
+  disable stop ;
+  REAL VAR previous now ;
+  now := 0.0 ; 
+  INT VAR try ; 
+  FOR try FROM 1 UPTO 3 WHILE hardware clock ok REP 
+    previous now := now ; 
+    now := date (hardwares today) + time (hardwares time) 
+  UNTIL now = previous now OR is error PER ; 
+  clear error ;
+  enable stop .
+
+get date and time from user :
+  line (2) ;
+  put ("      Bitte geben Sie das heutige Datum ein :") ;
+  date text := date ;
+  TEXT VAR exit char ;
+  editget (date text, cr, "", exit char) ;
+  now := date (date text) ;
+  line ;
+  put ("      und die aktuelle Uhrzeit :") ;
+  date text := time of day ;
+  editget (date text, cr, "", exit char) ;
+  now INCR time (date text) ;
+  IF NOT last conversion ok 
+    THEN errorstop ("Falsche Zeitangabe")
+  FI .
+
+hardwares today :  calendar (3) + "." + calendar (4) + "." + calendar (5) . 
+
+hardwares time  :  calendar (2) + ":" + calendar (1) . 
+ 
+define date and time : 
+  set clock (now) . 
+ 
+ENDPROC set date ; 
+ 
+TEXT PROC calendar (INT CONST index) : 
+ 
+  INT VAR bcd ; 
+  control (10, index, 0, bcd) ; 
+  IF bcd < 0  
+    THEN hardware clock ok := FALSE ; "" 
+    ELSE text (low digit + 10 * high digit) 
+  FI . 
+ 
+low digit :  bcd AND 15 . 
+
+high digit:  (bcd AND (15*256)) DIV 256 . 
+ 
+ENDPROC calendar ; 
+
+PROC infopw (TEXT CONST old, new, INT VAR error code) :
+  EXTERNAL 81
+ENDPROC infopw ;
+
+PROC sys op (INT CONST code) :
+  EXTERNAL 90
+ENDPROC sys op ;
+
+PROC set clock (REAL CONST time) :
+  EXTERNAL 103
+ENDPROC set clock ;
+
+PROC pcb (TASK CONST task, INT CONST field, value) :
+  EXTERNAL 105
+ENDPROC pcb ;
+
+PROC unblock (TASK CONST task) :
+  EXTERNAL 108
+ENDPROC unblock ;
+
+PROC block (TASK CONST task) :
+  EXTERNAL 109
+ENDPROC block ;
+
+PROC send (TASK CONST from, to, INT CONST order, DATASPACE VAR ds,
+           INT VAR receipt) :
+  EXTERNAL 127
+ENDPROC send ;
+
+PROC define collector (TASK CONST task) :
+  EXTERNAL 128
+ENDPROC define collector ;
+
+ENDPACKET privileged operations ;
+
diff --git a/system/multiuser/1.7.5/src/silbentrennung b/system/multiuser/1.7.5/src/silbentrennung
new file mode 100644
index 0000000..dfbdf75
--- /dev/null
+++ b/system/multiuser/1.7.5/src/silbentrennung
@@ -0,0 +1,1166 @@
+(* ------------------- VERSION 170 vom 30.09.85 -------------------- *)
+PACKET silbentrennung DEFINES
+       trenn,
+       schreibe trennvektor,
+       ist ausnahme wort,
+       lade ausnahmen,
+       entlade ausnahmen:
+
+(* Programm zur Silbentrennung
+   Autor: Klaus-Uwe Koschnick / Rainer Hahn
+   Stand: 1.7.1 (Febr. 1984)
+          1.7.4 (Mai 1984) (Ausnahme-Woerterbuch, Verbesserungen)
+*)
+ 
+(*--------------------- Ausnahme Woerterbuch -----------------------*)
+
+DATASPACE VAR ds1 :: nilspace; 
+ 
+FILE VAR f; 
+ 
+LET name table length = 1024, 
+    max hash chars = 5; 
+ 
+INT VAR anz worte :: 0, 
+        hash index; 
+ 
+INITFLAG VAR this packet :: FALSE; 
+ 
+TEXT VAR dummy, 
+         name ohne trennstellen,
+         trennstellen,
+         blanked name;
+ 
+BOUND ROW name table length TEXT VAR name table; 
+ 
+PROC init packet:
+  IF NOT initialized (this packet)
+    THEN anz worte := 0
+  FI
+END PROC init packet;
+
+PROC init name table:
+  forget (ds1);
+  ds1 := nilspace;
+  name table := ds1;
+  INT VAR i;
+  FOR i FROM 1 UPTO name table length REP
+    cout (i);
+    name table [i] := ""
+  END REP;
+  anz worte := 0.
+END PROC init name table;
+
+PROC lade ausnahmen:
+  lade ausnahmen (last param)
+END PROC lade ausnahmen;
+
+PROC lade ausnahmen (TEXT CONST filename): 
+ IF exists (filename) 
+   THEN lade 
+   ELSE errorstop ("Datei nicht vorhanden") 
+ FI. 
+ 
+lade: 
+  init packet;
+  IF anz worte > 0 
+    THEN IF yes ("überschreiben") 
+           THEN init nametable 
+         ELIF no ("anfügen") 
+           THEN LEAVE lade ausnahmen
+         FI
+    ELSE init nametable
+  FI;
+  line (2);
+  f := sequential file (input, file name);
+  WHILE NOT eof (f) REP
+    get (f, dummy);
+    IF subtext (dummy, 1, 2) = "(*"
+      THEN ueberlese kommentar
+      ELSE lade wort (* Vor.: Worte ohne Blanks *)
+    FI
+  END REP.
+
+ueberlese kommentar:
+  WHILE NOT eof (f) AND pos (dummy, "*)") = 0 REP
+    get (f, dummy);
+  END REP.
+
+lade wort:
+  line ;
+  anz worte INCR 1;
+  put (anz worte);
+  stelle namen ohne trennstellen her;
+  put (name ohne trennstellen);
+  blanked name := " ";
+  name ohne trennstellen CAT " ";
+  blanked name CAT name ohne trennstellen;
+  hash;
+  IF pos (name table [hash index], blanked name) > 0
+    THEN put ("(bereits geladen)")
+    ELSE insert char (name ohne trennstellen, " ", 1);
+         name ohne trennstellen CAT trennstellen;
+         name table [hash index] CAT name ohne trennstellen;
+  FI.
+
+stelle namen ohne trennstellen her:
+  INT VAR number;
+  name ohne trennstellen := dummy;
+  trennstellen := "";
+  WHILE pos (name ohne trennstellen, "-") > 0 REP
+    number := pos (name ohne trennstellen, "-");
+    delete char (name ohne trennstellen, number);
+    trennstellen CAT text (number - 1);
+    trennstellen CAT " "
+  END REP.
+END PROC lade ausnahmen;
+
+PROC entlade ausnahmen (TEXT CONST file name):
+  init packet;
+  IF exists (file name)
+    THEN errorstop ("Datei existiert bereits")
+    ELSE unload
+  FI.
+
+unload:
+  f := sequential file (output, file name);
+  INT VAR i;
+  FOR i FROM 1 UPTO name table length REP
+    cout (i);
+    IF name table [i] <> ""
+      THEN putline (f, name table [i])
+    FI
+  END REP.
+END PROC entlade ausnahmen;
+
+BOOL PROC ist ausnahme wort (TEXT CONST word,
+                             INT CONST maximum, INT VAR trenn position):
+  init packet;
+  IF anz worte > 0 
+    THEN blanked name fuer hash bilden;
+         hash;
+         IF pos (name table [hash index], blanked name) > 0
+           THEN trennstelle suchen
+         FI
+  FI;
+  FALSE.
+
+blanked name fuer hash bilden:
+  blanked name := " ";
+  IF maximum <= max hash chars
+    THEN eliminiere ggf satzzeichen hinter dem wort;
+         blanked name CAT
+           subtext (word, 1, min (max hash chars, wortlaenge))
+    ELSE blanked name CAT subtext (word, 1, maximum);
+  FI.
+
+eliminiere ggf satzzeichen hinter dem wort:
+  INT VAR wort laenge := length (word);
+  WHILE letztes zeichen ist kein buchstabe REP
+    wort laenge DECR 1;
+    IF wort laenge <= 2
+      THEN LEAVE ist ausnahme wort WITH FALSE
+    FI
+  END REP.
+
+letztes zeichen ist kein buchstabe:
+  TEXT CONST letztes zeichen :: (word SUB wortlaenge);
+  NOT (letztes zeichen >= "A" AND letztes zeichen <= "Z" OR
+  letztes zeichen >= "a" AND letztes zeichen <= "z" OR
+  letztes zeichen >= "Ä" AND letztes zeichen <= "k" OR 
+  letztes zeichen = "ß").
+
+trennstelle suchen:
+  index der ersten ziffer suchen;
+  INT VAR neue ziffer := 0;
+  trenn position := 0;
+  ziffern holen.
+
+index der ersten ziffer suchen:
+  dummy := name table [hash index];
+  INT VAR ziffern index := pos (dummy, blanked name);
+  ziffern index := pos (dummy, " ", ziffern index + 1) + 1.
+
+ziffern holen:
+  WHILE ist ziffer REP
+    hole neue ziffer;
+    IF gefundene ziffer ist ausserhalb des trennbereichs
+      THEN LEAVE ist ausnahme wort WITH TRUE
+    FI;
+    trenn position := neue ziffer
+  END REP;
+  LEAVE ist ausnahme wort WITH TRUE.
+
+ist ziffer:
+  ziffern index < length (dummy) AND
+((dummy SUB ziffern index + 1) = " " OR (dummy SUB ziffern index + 2) = " ").
+
+hole neue ziffer:
+  INT VAR ende position :: pos (dummy, " ", ziffern index);
+  neue ziffer := int (subtext (dummy, ziffern index, ende position - 1));
+  ziffern index := ende position + 1.
+
+gefundene ziffer ist ausserhalb des trennbereichs:
+  neue ziffer > maximum.
+END PROC ist ausnahme wort;
+
+PROC hash:
+  INT VAR i;
+  hash index := code (blanked name SUB 2);
+  FOR i FROM 3 UPTO min (length (blanked name), max hash chars) REP
+    hash index INCR hash index;
+    hash index INCR code (blanked name SUB i);
+    decrementiere hash index
+  END REP.
+
+decrementiere hash index:
+  WHILE hash index > name table length REP
+    hash index DECR 1023
+  END REP.
+END PROC hash;
+
+(*-------------- eigentlicher Trenn-Algorithmus --------------*)
+
+LET zeichenkette n = "-/",
+    regelmaessig = " bl br chl chr dr fl fr gl gr kl kn kr pf ph pl pr
+ sp st schl schm schn schr schw th tr zw ",
+    vokal string = "aeiouyäöü",
+    buchstaben   =
+    "abcdefghijklmnopqrstuvwxyzäöüßABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",
+    grosse buchstaben = "ABCDEFGHIJKLMNOPQRSTUVWXYZ",
+    trennstrich = ""221"",
+    cv a = 97 , cv b = 98 , cv c = 99 , cv d = 100, cv e = 101,
+    cv f = 102, cv g = 103, cv i = 105, cv k = 107,
+    cv l = 108, cv m = 109, cv n = 110, cv o = 111,
+    cv p = 112, cv r = 114, cv s = 115, cv t = 116,
+    cv u = 117, cv w = 119, cv x = 120, cv y = 121,
+    cv ae = 217 , cv oe = 218 , cv ue = 219 , cv sz = 251,
+    weder h noch ch = 0 ,
+    buchstabe h     = 1 ,
+    zeichenfolge ch = 2 ;
+
+INT CONST minus one :: - 1;
+
+INT VAR i, grenze, absolute grenze, sonderzeichen trennpos,
+        zeichen vor teilwort, teilwort laenge, a pos, e pos, 
+        a pos minus 2, a pos minus 1, a pos plus 1, a pos plus 2, 
+        e pos minus 1; 
+ 
+ROW 50 INT VAR vektor ;
+ 
+TEXT VAR wort,
+         teilwort,
+         kons gr,
+         search,
+         zeichen;
+
+BOOL VAR trennstelle gefunden ;
+
+PROC trenn (TEXT CONST word, TEXT VAR part1, trennsymbol, INT CONST maximum):
+  IF ist ausnahme wort (word, maximum, position)
+    THEN ausnahme wort behandlung;
+         LEAVE trenn
+  FI;
+  INT VAR laenge :: length (word) ;
+  IF laenge < 4
+     THEN trennung nicht moeglich
+     ELSE wort := word ;
+          grenze := min (50, maximum) ;
+          absolute grenze := min (laenge, grenze + 5) ;
+          trennung versuchen
+  FI .
+ 
+ausnahme wort behandlung:
+  IF position <= 0
+    THEN trennung nicht moeglich
+    ELSE part1 := subtext (word, 1, position);
+         IF pos (zeichenkette n, word SUB position + 1) > 0
+           THEN trennsymbol := " "
+           ELSE trennsymbol := trennstrich
+         FI
+  FI.
+
+trennung nicht moeglich : 
+  part 1 := "";
+  trennsymbol := " ".
+ 
+trennung versuchen :
+  erstelle trennvektor ;
+  IF sonderzeichen trennpos > 0
+     THEN part 1 := subtext (word, 1, sonderzeichen trennpos) ;
+          trennsymbol := " " 
+     ELSE bestimme trennposition ;
+          IF position = 0
+             THEN trennung nicht moeglich
+             ELSE part 1 := subtext (wort, 1, position) ;
+                  trennsymbol := trennstrich
+          FI
+  FI .
+
+bestimme trennposition :
+  INT VAR position ;
+  FOR position FROM grenze DOWNTO 1 REP
+     IF vektor [position] = 1
+        THEN LEAVE bestimme trennposition
+     FI
+  END REP ; 
+  position := 0 
+END PROC trenn ;
+
+BOOL PROC buchstabe (INT CONST posi) : 
+  pos (buchstaben, wort SUB posi) > 0 OR spezialcode.
+
+spezialcode:
+  INT CONST z code :: code (wort SUB posi) ;
+  (zcode > 96 AND zcode < 123).
+END PROC buchstabe ; 
+ 
+OP SPERRE (INT CONST element) :
+  INT CONST w element :: zeichen vor teilwort + element ;
+  IF w element > 0 AND w element <= grenze
+     THEN vektor [w element] := minus one
+  FI
+END OP SPERRE ;
+
+OP SETZE (INT CONST element) :
+  INT CONST w element :: zeichen vor teilwort + element;
+  IF w element > 0 AND w element <= grenze AND vektor [w element] <> minus one
+    THEN vektor [w element] := 1 ;
+         trennstelle gefunden := TRUE 
+  FI
+END OP SETZE ;
+
+BOOL PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt
+                    (INT CONST akt buchstabenpos):
+  vorletzter buchstabe (akt buchstabenpos)
+  OR NOT trennung oder sperre gesetzt (akt buchstabenpos).
+END PROC vorletzter buchstabe oderkeine trennung oder sperre gesetzt;
+
+BOOL PROC vorletzter buchstabe (INT CONST akt buchstabenpos):
+  akt buchstabenpos = absolute grenze - 1
+END PROC vorletzter buchstabe;
+
+BOOL PROC trennung oder sperre gesetzt (INT CONST element):
+  INT CONST w element :: zeichen vor teilwort + element;
+  IF w element > 1 AND w element < teilwort laenge
+    THEN vektor [w element] = 1 OR gesperrt
+    ELSE TRUE
+  FI.
+
+gesperrt:
+  IF w element >= length (wort) - 1
+    THEN TRUE
+    ELSE vektor [w element] = minus one
+  FI.
+END PROC trennung oder sperre gesetzt;
+
+PROC sperren und setzen (INT CONST element) : 
+  INT CONST w element :: zeichen vor teilwort + element ; 
+  vektor [w element - 1] := minus one;
+  vektor [w element] := 1 
+END PROC sperren und setzen ; 
+ 
+TEXT PROC string (INT CONST anf pos, end pos) : 
+  subtext (teilwort, maximum, minimum).
+
+maximum:
+  IF anf pos > 1
+    THEN anf pos
+    ELSE 1
+  FI.
+
+minimum:
+  IF teilwort laenge < end pos
+    THEN teilwort laenge
+    ELSE end pos
+  FI.
+END PROC string ; 
+ 
+BOOL PROC silbenanfang vor (INT CONST akt buchstabenpos): 
+  zwei silber (akt buchstabenpos - 2) OR drei silber (akt buchstabenpos - 3)
+END PROC silbenanfang vor;
+
+BOOL PROC silbenanfang nach (INT CONST akt buchstabenpos):
+  zwei silber (akt buchstabenpos + 1) OR drei silber (akt buchstabenpos + 1)
+END PROC silbenanfang nach;
+
+BOOL PROC zwei silber (INT CONST akt buchstabenpos):
+  TEXT VAR zweier :: string (akt buchstabenpos, akt buchstabenpos + 1);
+  length (zweier) = 2 AND
+  pos ("ab an ar be er ge in um un zu re", zweier) > 0
+END PROC zwei silber;
+
+BOOL PROC drei silber (INT CONST akt buchstabenpos):
+  TEXT VAR dreier :: string (akt buchstabenpos, akt buchstabenpos + 2);
+  length (dreier) = 3 AND
+  pos ("auf aus bei ein end ent mit", dreier) > 0
+END PROC drei silber;
+
+BOOL PROC reg (INT CONST st pos) : 
+  INT CONST code one :: code (teilwort SUB st pos) ,
+            code two :: code (teilwort SUB st pos + 1) ;
+  pos (regelmaessig, konsonanten) > 0 .
+
+konsonanten :
+  search := " " ;
+  IF code one = cv c
+    THEN search CAT string (st pos, st pos + 2)
+  ELIF code one = cv s AND code two = cv c 
+    THEN search CAT string (st pos, st pos + 3)
+    ELSE search CAT string (st pos, st pos + 1) 
+  FI ;
+  search CAT " " ;
+  search
+END PROC reg ;
+ 
+INT PROC grenz position (INT CONST start pos, richtung):
+  INT VAR posit :: start pos ;
+  REP
+     posit INCR richtung 
+  UNTIL sonderzeichen oder position unzulaessig END REP;
+  posit - richtung.
+
+sonderzeichen oder position unzulaessig: 
+  posit = 0 AND posit > absolute grenze OR ist kein buchstabe.
+
+ist kein buchstabe:
+  pos (buchstaben, wort SUB posit) = 0 AND kein spezialcode.
+
+kein spezialcode:
+  INT CONST z code :: code (wort SUB posit) ;
+  (zcode < 97 OR zcode > 121).
+END PROC grenz position ; 
+
+PROC schreibe trennvektor (TEXT CONST ttt):
+line ; put (ttt); INT VAR ii;
+FOR ii FROM 1 UPTO length (wort) REP put(vektor [ii]) PER
+END PROC schreibe trennvektor;
+
+PROC erstelle trennvektor :
+INT VAR akt pos, anfang teilwort, ende teilwort, anzahl, 
+        zuletzt, tr pos, ind, code 1, code 2, code 3,
+        rechts von a pos, z code, posit;
+BOOL VAR sonderzeichen modus,
+         aktueller buchstabe ist vokal,
+         vorsilbe oder nachsilbe;
+
+  sonderzeichen trennpos := 0 ;
+  trennstelle gefunden := FALSE ;
+  initialisiere trennvektor ;
+  akt pos := grenze ;
+  IF buchstabe (akt pos) 
+     THEN zuerst teilwort
+     ELSE zuerst sonderzeichenblock
+  FI;
+  WHILE akt pos > 0 REP
+     IF sonderzeichen modus
+        THEN behandle sonderzeichenblock
+        ELSE suche trennstellen in teilwort
+     FI
+  END REP.
+
+initialisiere trennvektor : 
+  FOR i FROM 1 UPTO grenze REP vektor [i] := 0 END REP .
+
+zuerst teilwort:
+  ende teilwort := grenz position (akt pos, 1) ;
+  sonderzeichen modus := FALSE .
+
+zuerst sonderzeichenblock:
+  sonderzeichen modus := TRUE .
+
+behandle sonderzeichenblock:
+  WHILE sonderzeichen modus REP
+     IF buchstabe (akt pos)
+        THEN sonderzeichen modus := FALSE
+        ELSE zeichen := wort SUB akt pos ;
+             IF pos (zeichenkette n, zeichen) <> 0
+                THEN sonderzeichen trennpos := akt pos ;
+                     LEAVE erstelle trennvektor
+             FI ;
+             akt pos DECR 1 ;
+             IF akt pos = 0 
+                THEN LEAVE erstelle trennvektor
+             FI
+     FI
+  END REP;
+  ende teilwort := akt pos .
+
+suche trennstellen in teilwort:
+  bestimme anfang von teilwort ;
+  IF teilwort lang genug
+     THEN teilwort ausbauen und wandeln ;
+          SPERRE 1 ; SPERRE (teilwort laenge - 1) ;
+          vorsilben untersuchen ;
+          nachsilben untersuchen ;
+          vorsilbe oder nachsilbe := trennstelle gefunden ;
+          trennstelle gefunden := FALSE ;
+          weitere trennstellen suchen ;
+          IF vorsilbe oder nachsilbe
+             THEN LEAVE erstelle trennvektor
+          FI
+  FI ;
+  akt pos := anfang teilwort - 1 ;
+  sonderzeichen modus := TRUE .
+
+bestimme anfang von teilwort:
+  anfang teilwort := grenz position (ende teilwort, minus one) .
+
+teilwort lang genug:
+  teilwort laenge := ende teilwort - anfang teilwort + 1 ;
+  teilwort laenge > 3 .
+
+teilwort ausbauen und wandeln:
+  teilwort := subtext (wort, anfang teilwort, ende teilwort);
+  zeichen vor teilwort := anfang teilwort - 1 ;
+  IF pos (grosse buchstaben, teilwort SUB 1) > 0
+     THEN replace (teilwort, 1, code (code (teilwort SUB 1) + 32))
+  FI .
+  (* Es ist nicht notwendig, gross geschriebene Umlaute am
+  Wortanfang zu wandeln! *)
+
+weitere trennstellen suchen:
+  e pos := teilwort laenge ;
+  aktueller buchstabe ist vokal := letzter buchstabe ist vokal ;
+  WHILE e pos > 1 REP
+     anzahl := 0 ;
+     a pos := e pos ;
+     IF aktueller buchstabe ist vokal
+        THEN behandle vokalgruppe
+        ELSE behandle konsonantengruppe
+     FI ;
+     IF trennstelle gefunden 
+        THEN LEAVE erstelle trennvektor
+     FI ;
+     e pos := a pos - 1 ;
+  END REP .
+
+letzter buchstabe ist vokal:
+  pos (vokal string,teilwort SUB e pos) > 0 .
+
+behandle vokalgruppe:
+  vokalgruppe lokalisieren ;
+  IF a pos > 1 AND e pos < teilwort laenge
+     THEN a pos plus 1 := a pos + 1 ; 
+          a pos plus 2 := a pos + 2 ; 
+          IF anzahl = 2
+             THEN vokal 2
+          ELIF anzahl > 2
+             THEN vokal 3
+             ELSE vokal 1
+          FI
+  FI .
+
+vokalgruppe lokalisieren:
+  zuletzt := 0 ;
+  WHILE aktueller buchstabe ist vokal REP
+     zeichen := teilwort SUB a pos ;
+     IF pos (vokal string,zeichen) > 0
+        THEN z code := code(zeichen) ;
+             IF zuletzt <> cv e
+                OR (z code <> cv a AND z code <> cv o AND z code <> cv u)
+                THEN anzahl INCR 1
+             FI ;
+             IF a pos > 1
+                THEN a pos DECR 1 ;
+                     zuletzt := z code 
+                ELSE aktueller buchstabe ist vokal := FALSE
+             FI
+        ELSE a pos INCR 1 ;
+             aktueller buchstabe ist vokal := FALSE
+     FI 
+  END REP .
+
+behandle konsonantengruppe:
+  konsonantengruppe lokalisieren ;
+  IF a pos > 1 AND e pos < teilwort laenge
+     THEN a pos minus 2 := a pos - 2 ; 
+          a pos minus 1 := a pos - 1 ; 
+          a pos plus 1  := a pos + 1 ; 
+          a pos plus 2  := a pos + 2 ; 
+          e pos minus 1 := e pos - 1 ; 
+          SELECT anzahl OF
+          CASE 1    : konsonant 1
+          CASE 2    : konsonant 2
+          OTHERWISE : konsonant 3
+          END SELECT
+  FI .
+
+konsonantengruppe lokalisieren:
+  rechts von a pos := weder h noch ch ;
+  REP 
+     zeichen := teilwort SUB a pos ;
+     IF pos (vokal string, zeichen) = 0
+        THEN anzahl INCR 1 ;
+             IF zeichen = "h" 
+                THEN rechts von a pos := buchstabe h
+              ELIF zeichen = "c" AND rechts von a pos = buchstabe h
+                THEN anzahl DECR 1 ;
+                     rechts von a pos := zeichenfolge ch
+              ELIF zeichen = "s" AND rechts von a pos = zeichenfolge ch
+                THEN anzahl DECR 1 ;
+                     rechts von a pos := weder h noch ch
+                ELSE rechts von a pos := weder h noch ch 
+             FI ;
+             IF a pos > 1 
+                THEN a pos DECR 1 
+                ELSE aktueller buchstabe ist vokal := TRUE
+             FI
+        ELSE a pos INCR 1 ;
+             aktueller buchstabe ist vokal := TRUE 
+     FI
+  UNTIL aktueller buchstabe ist vokal END REP .
+
+vorsilben untersuchen: 
+  code 2 := code (teilwort SUB 2);
+  code 3 := code (teilwort SUB 3);
+  IF ch vierer silbe
+    THEN sperren und setzen (4)
+    ELSE restliche vorsilben
+  FI.
+
+ch vierer silbe:
+ string (2, 4) = "ach" OR string (2, 4) = "och" OR string (2, 4) = "uch".
+
+restliche vorsilben:
+  ind    := pos ("abdefghimnrstuvwüu", teilwort SUB 1);
+SELECT ind OF 
+CASE1(*a*): IF drei silber (1)
+              THEN sperren und setzen (3) 
+            ELIF code 2 = cv b (*ab*)
+              THEN IF string(3,5) = "end" (*abend*)
+                      THEN SPERRE 2; sperren und setzen (5) 
+                    ELIF string(3,4) = "er" (*aber*)
+                      THEN sperren und setzen (4) 
+                      ELSE sperren und setzen (2)
+                   FI
+            ELIF code 2 = cv n AND string(3,5) <> "alo" (*analo*)
+              THEN SETZE 2
+            FI
+CASE2(*b*): IF code 2 = cv e (* be *)
+              THEN IF    (teilwort SUB 3) = "h" (* be-handeln usw *)
+                      OR (teilwort SUB 3) = "a" (* beamter *)
+                     THEN sperren und setzen (2)
+                   ELIF string (3, 4) = "ob" (* beobachten *)
+                     THEN SETZE 2; sperren und setzen (4)
+                   FI
+            ELIF string (2, 3) = "au" (* bauer usw *)
+              THEN sperren und setzen (3)
+            FI
+CASE3(*d*): IF (code 3 = cv s AND (code 2 = cv i OR code 2 = cv e))
+               OR string (2, 3) = "ar" (* dis, des, dar*)
+              THEN sperren und setzen (3) 
+            ELIF string (2, 4) = "enk" (* denk.. *)
+              THEN sperren und setzen (4)
+            ELIF string(2,5) = "urch" (*durch*)
+              THEN SPERRE 3 ; SETZE 5 
+            FI
+CASE4(*e*): IF code 2 = cv r AND code 3 <> cv n AND code 3 <> cv d 
+              AND string (3, 4) <> "ro" (* er, aber nicht: ern, erd, erro *)
+              THEN SETZE 2
+            ELIF code 2 = cv x (* ex *)
+              THEN SETZE 2
+            ELIF (code 2 = cv m AND code 3 = cv p AND (teilwort SUB 4) = "f")
+                 OR (code 2 = cv n AND code 3 = cv t) (* empf, ent *)
+              THEN sperren und setzen (3)
+            FI 
+CASE5(*f*): 
+CASE6(*g*): IF string (2, 5) = "egen" (* gegen *)
+              THEN sperren und setzen (5)
+            ELIF string (2, 6) = "leich" (* gleich *)
+              THEN IF vorletzter buchstabe (5)
+                     THEN SPERRE 6
+                   ELIF vorletzter buchstabe (6)
+                     THEN sperren und setzen (4)
+                     ELSE sperren und setzen (6)
+                   FI
+            ELIF zwei silber (1)
+              THEN SETZE 2
+            FI
+CASE7(*h*): IF string (2, 3) = "in" OR string (2, 3) = "er" (* hin, her *)
+              THEN sperren und setzen (3)
+            FI
+CASE8(*i*): IF code 2 = cv n (* in *)
+              THEN IF string (3, 5) = "ter" (* inter *)
+                      THEN sperren und setzen (5)
+                   ELIF subtext (teilwort, 1, 5) = "insbe"
+                      THEN sperren und setzen (3)
+                      ELSE sperren und setzen (2)
+                   FI;
+            FI
+CASE9(*m*):  IF string (2, 3) = "ög" AND teilwort laenge > 5 (* mög *)
+               THEN sperren und setzen (3);
+             FI
+CASE10(*n*): IF string (2, 4) = "ach" AND teilwort laenge >= 7 
+                AND (teilwort SUB 5) <> "t" (* nach, aber nicht: nacht *)
+               THEN SETZE 4 
+             ELIF string (2, 6) = "ieder" (* nieder *)
+               THEN sperren und setzen (6) 
+             ELIF string (2, 5) = "icht" (* nicht *)
+               THEN sperren und setzen (5)
+             ELIF string (2, 3) = "eu" (* neu *)
+               THEN sperren und setzen (3);
+                    IF dreisilber (4)
+                      THEN sperren und setzen (6)
+                    FI
+             ELIF string (2, 5) = "iste"
+               THEN sperren und setzen (2)
+             FI
+CASE11(*r*): IF code 2 = cv e (* re *)
+               THEN IF silbenanfang nach (4) (* Realeinkommen *)
+                      THEN sperren und setzen (4)
+                      ELSE sperren und setzen (2)
+                    FI
+             FI
+CASE12(*s*): IF string (2, 6) = "elbst" (* selbst *)
+               THEN sperren und setzen (6); SPERRE 4
+             FI
+CASE13(*t*): IF string (2, 3) = "at" (* tat *)
+               THEN sperren und setzen (3)
+             ELIF string (2, 5) = "rans" (* trans *)
+               THEN sperren und setzen (5)
+             ELIF string (2, 4) = "heo" (* theo *)
+               THEN sperren und setzen (4)
+             FI
+CASE14(*u*): IF code 2 = cv m (* um *)
+               THEN SETZE 2
+             ELIF code 2 = cv n (* un *)
+               THEN IF code 3 = cv i (* uni *)
+                       THEN sperren und setzen (3)
+                       ELSE sperren und setzen (2);
+                            IF string (3, 5) = "ter" (* unter *)
+                               THEN sperren und setzen (5)
+                            FI
+                    FI
+             FI
+CASE15(*v*): IF string (2, 3) = "or" OR string (2, 3) = "on" OR
+                string (2, 3) = "er" (* vor, von, ver *)
+               THEN sperren und setzen (3)
+             FI
+CASE16(*w*): IF code 2 = cv e AND code 3 = cv g (* weg *)
+               THEN sperren und setzen (3) 
+             ELIF code 2 = cv i (* wi *)
+               THEN IF string(3,5) = "der" (* wider *)
+                       THEN sperren und setzen (5)
+                     ELIF string(3,6) = "eder" (* weder *)
+                       THEN sperren und setzen (6) 
+                    FI
+             FI
+CASE17(*ü*): IF string (2, 4) = "ber" (* über *)
+               THEN sperren und setzen (4)
+             FI
+CASE18(*z*): IF code 2 = cv u (*zu*)
+               THEN sperren und setzen (2);
+                    IF drei silber (3) (* zuein *)
+                      THEN sperren und setzen (5)
+                    FI
+             FI
+END SELECT.
+ 
+nachsilben untersuchen:
+  IF (teilwort SUB teilwort laenge) = "t" 
+     THEN IF (string (teilwort laenge - 3,teilwort laenge) = "heit" 
+             AND (teilwort SUB teilwort laenge - 4) <> "c")
+             OR string (teilwort laenge - 3, teilwort laenge -1) = "kei"
+             THEN sperren und setzen (teilwort laenge - 4)
+          FI
+  ELIF string (teilwort laenge - 2, teilwort laenge) = "tag"
+    THEN sperren und setzen (teilwort laenge - 3)
+  ELIF string (teilwort laenge - 3, teilwort laenge) = "tags"
+    THEN sperren und setzen (teilwort laenge - 4)
+  FI.
+
+vokal 1:
+  IF string (a pos, a pos plus 2) = "uel"
+    THEN SETZE a pos
+  FI.
+
+vokal 2 :
+  ind    := pos (vokal string, teilwort SUB a pos);
+  code 2 := code (teilwort SUB a pos plus 1);
+SELECT ind OF 
+CASE1(*a*): IF code 2 = cv a OR code 2 = cv i OR code 2 = cv y (*aa,ai,ay*)
+              THEN
+            ELIF code 2 = cv u
+              THEN silbe au behandlung
+              ELSE SETZE a pos 
+            FI
+CASE2(*e*): IF code 2 = cv u AND (teilwort SUB a pos plus 2) = "e" (*eue*)
+              THEN SETZE a pos plus 1 
+            ELIF code 2 = cv o OR code 2 = cv ae OR code 2 = cv ue
+                OR code 2 = cv oe  (*eo, eä, eü, eö *)
+             THEN SETZE a pos 
+            FI
+CASE3(*i*): IF code 2 <> cv e AND code 2 <> cv o (* i, aber nicht: ie, io *)
+              THEN SETZE a pos
+            FI
+CASE4(*o*): IF code 2 = cv o OR code 2 = cv u (* oo, ou *)
+              THEN 
+            ELIF code 2 = cv e (* oe *)
+              THEN SETZE a pos plus 1 
+              ELSE SETZE a pos 
+            FI
+CASE5(*u*): IF (teilwort SUB a pos - 1) = "q" (* qu *)
+              THEN 
+            ELIF code 2 = cv e (* ue *)
+              THEN SETZE a pos plus 1
+              ELSE SETZE a pos 
+            FI
+CASE7(*y*): IF code 2 <> cv u (* yu *)
+              THEN SETZE a pos
+            FI
+OTHERWISE (*äöü*): SETZE a pos
+END SELECT.
+ 
+silbe au behandlung:
+  IF (teilwort SUB a pos + 2) = "e" (* aue, wie in dau-ernd *)
+    THEN SETZE a pos plus 1 
+  ELIF a pos > 2 AND trennung oder sperre gesetzt (a pos + 2) AND 
+       ((teilwort SUB a pos + 2) = "f" OR (teilwort SUB a pos + 2) = "s")
+       (* aus- oder auf-Mittelsilben *)
+    THEN SETZE (a pos - 1)
+  FI.
+
+vokal 3 : 
+  IF string (a pos, a pos plus 2) <> "eau"
+     AND string (a pos plus 1, a pos+3) <> "eau" 
+     THEN IF e pos - a pos = anzahl - 1 
+             THEN SETZE a pos plus 1
+             ELSE code 1 := code(teilwort SUB a pos) ; 
+                  tr pos := a pos plus 1 ; 
+                  IF (code 1 = cv a OR code 1 = cv o OR code 1 = cv u) 
+                     AND (teilwort SUB a pos plus 1) = "e" 
+                     THEN tr pos INCR 1
+                  FI;
+                  code 2 := code (teilwort SUB tr pos) ; 
+                  IF (code 2 = cv a OR code 2 = cv o OR code 2 = cv u) 
+                     AND (teilwort SUB tr pos + 1) = "e" 
+                     THEN tr pos INCR 1
+                  FI ; 
+                  SETZE tr pos
+          FI 
+  FI .
+
+konsonant 1 : 
+  ind := pos ("bcklmnrstß", teilwort SUB a pos);
+SELECT ind OF 
+CASE1(*b*): IF string (a pos minus 1, a pos plus 2) = "über"
+              THEN SETZE a pos minus 2
+            ELIF silbenanfang nach (a  pos)
+                 AND NOT trennung oder sperre gesetzt (a pos minus 1)
+              THEN SETZE a pos
+            ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE a pos minus 1
+            FI;
+CASE2(* c oder ch *):
+            IF ((teilwort SUB a pos plus 1) = "h"
+                 AND (silbenanfang nach (a pos plus 1)
+                     OR string (a pos, a pos + 3) = "chen"))
+               OR (teilwort SUB a pos plus 1) <> "h"
+              THEN SETZE a pos minus 1
+              ELSE SETZE a pos plus 1
+            FI
+CASE3(*k*): IF string (a pos minus 2, a pos minus 1) = "ti" (* tik *)
+               AND silbenanfang nach (a pos)
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE4(*l*): IF string (a pos - 3, a pos plus 1) = "reali"
+              THEN SETZE a pos plus 1
+            ELIF string (a pos minus 1, a pos plus 1) = "aly"
+              THEN SETZE a pos minus 1
+            ELIF    string (a pos minus 2, a pos minus 1) = "ta" (*..tal..*)
+                 OR string (a pos minus 2, a pos minus 1) = "na" (*..nal..*)
+                 OR string (a pos minus 2, a pos minus 1) = "ia" (*..ial..*) 
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE5(*m*): IF string (a pos minus 2, a pos minus 1) = "to" (* ..tom..*)
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE6(*n*): IF string (a pos - 4, a pos minus 1) = "gege" 
+               OR string (a pos - 4, a pos minus 1) = "nebe" (*gegen, neben*)
+              THEN SETZE (a pos - 3) ; SETZE a pos 
+            ELIF string (a pos minus 1, a pos plus 1) = "ini"
+              THEN 
+            ELIF NOT silbenanfang vor (a pos)
+                 AND ((teilwort SUB a pos minus 1) = "e"  (* en *)
+                       OR (teilwort SUB a pos minus 1) = "u") (* un *)
+                       AND (silbenanfang nach (a pos) 
+                       OR string (a pos plus 1, a pos plus 2) = "ob")
+              THEN SETZE a pos
+            ELIF string (a pos minus 2, a pos plus 1) = "eina"
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1 
+            FI
+CASE7(*r*): IF string (a pos minus 2, a pos minus 1) = "tu" (*..tur..*)
+              THEN IF    string (a pos plus 1, a pos plus 2) = "el" 
+                      OR (string (a pos plus 1, a pos plus 2) = "en"
+                          AND string (a pos minus 1, apos +3) <> "ent")
+                         (* turel OR <>turentwick*)
+                     THEN SETZE a pos minus 1
+                     ELSE SETZE a pos
+                   FI
+            ELIF    string (a pos minus 2, a pos minus 1) = "ve"  (*..ver..*)
+                 OR string (a pos minus 2, a pos minus 1) = "vo"  (*..vor..*)
+              THEN SETZE a pos 
+            ELIF string (a pos minus 2, a pos minus 1) = "te" (* ter *)
+              THEN IF dreisilber (a pos plus 1)
+                      OR string (a pos plus 1, a pos plus 1) = "a" (*tera*)
+                      OR string (a pos - 3, a pos minus 2) <> "zt" (*zter*)
+                     THEN SETZE a pos
+                     ELSE SETZE a pos minus 1
+                   FI
+            ELIF (teilwort SUB a pos minus 1) = "e" (* er*)
+                 AND silbenanfang nach (a pos) 
+                 AND string (a pos plus 1, a pos + 3) <> "ung" (*erung*)
+                 AND string (a pos plus 1, a pos plus 2) <> "er" (*erer*)
+              THEN SETZE a pos
+            ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE a pos minus 1 
+            FI
+CASE8(*s*): IF string (a pos minus 2, a pos minus 1) = "de" (* des *)
+               OR string (a pos minus 2, a pos minus 1) = "xi" (* ..xis *)
+              THEN SETZE a pos
+            ELIF string (a pos minus 2, a pos minus 1) = "ni" (* nis *)
+               AND silbenanfang nach (a pos)
+              THEN SETZE a pos
+            ELIF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE apos minus 1
+            FI
+CASE9(*t*): IF string (a pos plus 1, a pos + 3) = "ion" (* tion *)
+              THEN SETZE a pos minus 1
+            ELIF string (a pos plus 1, a pos + 3) <> "ier" (* imitieren *)
+               AND    (string (a pos minus 2, a pos minus 1) = "mi"(*...mit..*)
+                    OR string (a pos minus 2, a pos minus 1) = "va"(*privat..*)
+                    OR string (a pos minus 2, a pos minus 1) = "fi"(*profit..*)
+                    OR string (a pos - 3, a pos minus 1)     = "zei")(*..zeit..*)
+              THEN SETZE a pos
+              ELSE SETZE a pos minus 1
+            FI
+CASE10(*ß*): IF string (a pos, a pos plus 2) = "ßen"
+               OR vorletzter buchstabe (a pos)
+               THEN SETZE a pos minus 1
+               ELSE SETZE a pos
+             FI
+OTHERWISE:  IF vorletzter buchstabe oderkeine trennung oder sperre gesetzt 
+                        (a pos) 
+              THEN SETZE a pos minus 1
+            FI
+END SELECT.
+ 
+konsonant 2 : 
+  kons gr := string (a pos, e pos);
+  IF a pos > 2 AND trennung oder sperre gesetzt (a pos minus 1)
+    THEN 
+  ELIF ausnahme fuer zwei konsonanten
+    THEN SETZE a pos
+  ELIF kons gr = "ts"
+    THEN IF NOT trennung oder sperre gesetzt (a pos)
+            (* für <> Tatsache, tatsächlich *)
+           THEN SETZE e pos 
+         FI
+  ELIF kons gr = "tz"
+    THEN IF (teilwort SUB a pos plus 2) = "e" (* ..tze.. *)
+            OR (teilwort SUB a pos plus 2) = "u" (* ..tzu.. *)
+           THEN SETZE a pos
+           ELSE SETZE a pos plus 1
+         FI
+  ELIF string (a pos, a pos plus 1) = "ch"(* ch zaehlt als 1 Buchstabe *)
+    THEN SETZE a pos plus 1               (* darum keine Abfrage mit kons gr *)
+  ELIF (kons gr = "dt" OR kons gr = "kt")
+       AND silbenanfang nach (e pos)
+    THEN SETZE e pos
+  ELIF kons gr = "ns" AND
+       (string (a pos - 2, a pos - 1) = "io"    (* ..ions *)
+        OR (string (a pos minus 1, a pos) ="en" (*..ens..*)
+            AND (teilwort SUB a pos minus 2) <> "t")) (* aber nicht ..tensiv*)
+    THEN SETZE e pos
+  ELIF string (a pos minus 2, a pos plus 1) = "nach" 
+    THEN IF (teilwort SUB a pos plus 2) <> "t"
+           THEN SETZE a pos plus 1 
+         FI 
+  ELIF string (e pos, e pos + 3) = "lich" 
+    THEN IF string (a pos minus 2, a pos) = "mög"
+           THEN SETZE a pos
+         ELIF pos ("hg", teilwort SUB e pos minus 1) > 0
+           THEN SPERRE e pos minus 1 
+           ELSE SETZE e pos minus 1
+         FI;
+  ELIF (reg (a pos) AND NOT trennung oder sperre gesetzt (a pos))
+       OR (kons gr = "sp" AND silbenanfang vor (a pos))
+    THEN SETZE a pos minus 1 
+  ELIF string (a pos, a pos plus 2) = "sch"
+    THEN SETZE a pos plus 2
+    ELSE SETZE a pos
+  FI.
+ 
+ausnahme fuer zwei konsonanten:
+  string (a pos minus 2, a pos) = "nis" AND a pos > 1
+          (*..nis.., aber nicht nisten *)
+  OR string (a pos minus 2, a pos plus 1) = "rafr" (* strafrecht *)
+  OR string (a pos - 4, a pos) = "undes" (* Bundes *)
+  OR string (a pos minus 1, a pos + 3) = "unter" 
+  OR silbenanfang vor (e pos).
+
+konsonant 3 : 
+  code 1 := code (teilwort SUB a pos);
+  code 2 := code (teilwort SUB a pos plus 1);
+  code 3 := code (teilwort SUB a pos plus 2);
+  IF NOT (ausnahme 1 OR ausnahme 2 OR ausnahme 3 OR ausnahme 4)
+     THEN suche regelmaessige konsonantenverbindung
+  FI.
+ 
+ausnahme 1 : 
+  ind := pos ("cfgklnprt", code (code 1));
+  SELECT ind OF 
+CASE1(*c*): IF code 2 = cv k (* ck *)
+              THEN SETZE a pos plus 1
+            ELIF string (a pos, a pos + 3) = "chts"
+            (* Rechts.., Gesichts.., .. machts..*)
+              THEN SETZE (a pos + 3)
+            ELIF string (a pos plus 1, a pos + 5) = "hstag" (* Reichstag *)
+                 OR (string (a pos, a pos plus 2) = "chs" AND (* ..chs.. *)
+                     string (a pos plus 2, a pos +3) <> "st") 
+              THEN SETZE a pos plus 2
+              ELSE LEAVE ausnahme 1 WITH FALSE 
+            FI;
+            TRUE
+CASE2(*f*): IF code 2 = cv f (*ff*)
+              THEN IF code 3 = cv s
+                     THEN SETZE a pos plus 2 (* ffs *)
+                     ELSE SETZE a pos plus 1
+                   FI
+            ELIF string (a pos minus 1, a pos plus 1) = "aft" (*..aft..*)
+              THEN IF (teilwort SUB a pos plus 2) = "s"
+                     THEN SETZE a pos plus 2
+                     ELSE SETZE a pos plus 1
+                   FI
+              ELSE LEAVE ausnahme 1 WITH FALSE 
+            FI;
+            TRUE
+CASE3(*g*): IF string (a pos minus 2, a pos minus 1) = "ag" (* ags *)
+              THEN SETZE a pos plus 1
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE4(*k*): IF string (a pos, a pos plus 1) = "kt"
+               AND silbenanfang nach (a pos plus 1)
+              THEN SETZE a pos plus 1
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE5(*l*): IF code 2 = cv d OR code 2 = cv g OR code 2 = cv k (*ld, lg, lk*)
+              THEN SETZE a pos plus 1
+            ELIF string (a pos, a pos + 4) = "ltspr" (* Anwaltsprogramm *)
+              THEN SETZE (a pos + 2)
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE6(*n*): IF string (a pos - 2, a pos) = "ein"
+              THEN SETZE a pos
+            ELIF code 2 = cv d (* nd *)
+              THEN IF code 3 = cv s (* nds, wie in ...stands... *)
+                     THEN SETZE a pos plus 2
+                     ELSE SETZE a pos plus 1
+                   FI
+            ELIF code 2 = cv g (* ng *)
+              THEN IF code 3 = cv s   (* ..ngs.. *)
+                      THEN SETZE a pos plus 2 
+                   ELIF code 3 = cv r (* ..ngr.. *)
+                      THEN SETZE a pos
+                   ELIF code 3 = cv l (* ungleich *)
+                      THEN
+                      ELSE SETZE a pos plus 1
+                   FI 
+            ELIF   string (a pos - 3, a pos plus 1) = "trans" 
+                OR string (a pos - 3, a pos plus 1) = "tions" (*tionsplan*)
+              THEN SETZE a pos plus 1 
+            ELIF string (a pos plus 1, a pos + 6) = "ftsper"  (*ftsperspek*)
+              THEN SETZE (a pos + 3)
+              ELSE LEAVE ausnahme 1 WITH FALSE 
+            FI;
+            TRUE 
+CASE7(*p*): IF code 2 = cv p                        (* pp *)
+               OR (code 2 = cv f AND code 3 = cv t) (* pft *)
+              THEN SETZE a pos plus 1; TRUE
+              ELSE FALSE 
+            FI 
+CASE8(*r*): IF string (a pos plus 1, a pos + 4) = "tner" (* rtner *)
+              THEN SETZE a pos plus 1
+            ELIF trennung oder sperre gesetzt (a pos)
+              THEN
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+CASE9(*t*): IF string (a pos plus 1, a pos plus 2) = "st" (*tst*)
+              THEN SETZE a pos 
+            ELIF string (a pos plus 1, a pos plus 2) = "zt"
+                      (* letzt.. *) 
+              THEN IF (teilwort SUB a pos + 3) = "e" (*letzte..*)
+                     THEN SETZE a pos plus 1
+                     ELSE SETZE a pos plus 2
+                   FI
+            ELIF string (apos - 2, a pos plus 1) = "eits"
+                      (* ..heits.., ..keits.., ..beits.. *)
+                 OR string (a pos plus 1, a pos plus 1)= "z" (*tz*)
+              THEN SETZE a pos plus 1
+              ELSE LEAVE ausnahme 1 WITH FALSE
+            FI;
+            TRUE
+OTHERWISE: FALSE
+END SELECT.
+ 
+ausnahme 2 : 
+  IF e pos - a pos = 2 
+     THEN FALSE 
+   ELIF code 2 = cv p AND string (a pos plus 2, a pos + 3) = "ft" (* pft *)
+     THEN SETZE a pos plus 2; TRUE 
+     ELSE FALSE 
+  FI . 
+ 
+ausnahme 3 : 
+  IF code 1 = cv s 
+     THEN IF code 2 = cv t AND code 3 <> cv r (* st, aber nicht: str *)
+             AND pos (vokal string, teilwort SUB a pos plus 2) = 0 
+             THEN SETZE a pos plus 1 ; TRUE 
+             ELSE FALSE 
+          FI 
+   ELIF code 2 = cv s 
+     THEN IF code 3 = cv t AND (teilwort SUB a pos + 3) <> "r" 
+             AND pos (vokal string, teilwort SUB (a pos + 3)) = 0
+             THEN SETZE a pos plus 2; TRUE 
+             ELSE FALSE
+          FI 
+     ELSE FALSE
+  FI . 
+ 
+ausnahme 4 :
+  IF string (e pos, e pos + 3) = "lich" 
+     THEN IF pos ("hg", teilwort SUB e pos minus 1) > 0
+            THEN SPERRE e pos minus 1
+            ELSE SETZE e pos minus 1 
+          FI;
+          TRUE
+     ELSE FALSE
+  FI .
+ 
+suche regelmaessige konsonantenverbindung : 
+  FOR posit FROM a pos UPTO e pos minus 1 REP 
+      IF reg (posit) 
+         THEN SETZE (posit - 1); LEAVE konsonant 3 
+      FI 
+  END REP ;
+  IF (teilwort SUB e pos) <> "h" OR (teilwort SUB e pos minus 1) <> "c" 
+     THEN SETZE e pos minus 1 
+   ELIF (teilwort SUB e pos - 2) <> "s" 
+     THEN SETZE (e pos - 2) 
+     ELSE SETZE (e pos - 3)
+  FI  
+END PROC erstelle trennvektor ; 
+END PACKET silbentrennung;
+
diff --git a/system/multiuser/1.7.5/src/supervisor b/system/multiuser/1.7.5/src/supervisor
new file mode 100644
index 0000000..00874b2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/supervisor
@@ -0,0 +1,774 @@
+(* ------------------- VERSION 19     03.06.86 ------------------- *)
+PACKET supervisor :                            (* Autor: J.Liedtke *)
+ 
+ 
+ 
+
+LET ack           = 0 ,
+    nak           = 1 ,
+    error nak     = 2 ,
+
+    system catalogue code        = 3 ,
+    begin code                   = 4 ,
+    end code                     = 5 ,
+    break code                   = 6 ,
+    rename code                  = 7 ,
+    halt code                    = 8 ,
+    password code                = 9 ,
+    family password code         = 40 ,
+    set autonom code             = 41 ,
+    reset autonom code           = 42 ,
+    define canal code            = 43 ,
+    go back to old canal code    = 44 ,
+    task of channel code         = 45 ,
+    canal of channel code        = 46 ,
+    set automatic startup code   = 47 ,
+    reset automatic startup code = 48 ,
+
+    continue code low            = 100 ,
+    continue code high           = 132 ,
+
+    system start code            = 100 ,
+    define station code          = 32000 ,
+    max station no               = 127 ,
+ 
+    nil = 0 ,
+
+    number of tasks       = 125 ,
+ 
+    number of channels       = 32 ,
+    highest terminal channel = 16 ,
+    highest user channel     = 24 ,
+    highest system channel   = 32 ,
+    configurator channel     = 32 ,
+
+    shutup and save code = 12 ,
+
+    channel field         = 4 ,
+    fromid field          = 11 ,
+    nilchannel            = 0 ;
+
+
+
+TASK VAR order task ;
+INT VAR  order code ,
+         channel nr ,
+         channel index ;
+
+DATASPACE VAR ds ;
+
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR msg ;
+BOUND TEXT VAR error msg ;
+
+REAL VAR last rename time := 0.0 ;
+
+
+TEXT VAR actual password, supply password ;
+
+ 
+ROW highest terminal channel TASK VAR canal ;
+
+ROW number of channels TASK VAR connected task ;
+
+FOR channel index FROM 1 UPTO highest terminal channel REP
+  canal (channel index) := niltask ;
+PER ;
+FOR channel index FROM 1 UPTO number of channels REP
+  connected task (channel index) := niltask
+PER ;
+
+
+ROW number of tasks BOOL VAR autonom flag ;
+ROW number of tasks BOOL VAR automatic startup flag ;
+ROW number of tasks TEXT VAR task password ;
+
+task password (1) := "-"  ;
+task password (2) := "-"  ;
+
+set clock (date ("09.06.86")) ;
+
+TASK VAR dummy task ;
+command dialogue (TRUE) ; 
+
+ke ;     (* maintenance ke *) 
+
+create son (myself, "SYSUR", dummy task, proca (PROC sysur)) ;
+
+PROC sysur :
+
+  disable stop ;
+  begin ("ARCHIVE", PROC archive manager, dummy task) ;
+  begin ("OPERATOR", PROC monitor, dummy task) ;
+  begin ("conf", PROC configurator, dummy task) ;
+  system manager
+
+ENDPROC sysur ;
+
+PROC configurator :
+
+  page ;
+  REP UNTIL yes("Archiv 'dev' eingelegt") PER;
+  archive ("dev") ;
+  fetch all (archive) ;
+  release (archive) ;
+  REP UNTIL yes ("save system") PER ;
+  command dialogue (FALSE) ;
+  save system ;
+  command dialogue (TRUE) ;
+  rename myself ("configurator") ;
+  disable stop ;
+  REP
+    configuration manager ;
+    clear error
+  PER
+
+ENDPROC configurator ;
+
+
+erase last bootstrap source dataspace ;
+channel (myself, 1) ;
+command dialogue (TRUE) ;
+IF yes("Leere Floppy eingelegt")
+  THEN channel (myself, nilchannel) ;
+       command dialogue (FALSE) ;
+       sys op (shutup and save code)
+  ELSE channel (myself, nilchannel) ;
+       command dialogue (FALSE)
+FI ;
+supervisor ;
+ 
+ 
+PROC supervisor :
+ 
+  disable stop ;
+  INT VAR old session := session ;
+  REP
+    wait (ds, order code, order task) ;
+    IF is niltask (order task)
+      THEN interrupt
+    ELIF station (order task) = station (myself)
+      THEN order from task
+    FI 
+  PER .
+
+interrupt :
+  IF order code = 0
+    THEN IF old session <> session
+           THEN disconnect all terminal tasks ;
+                old session := session
+         FI ;
+         system start interrupt
+    ELSE supervisor interrupt (canal (order code), order code,
+                               connected task (order code)) 
+  FI .
+
+disconnect all terminal tasks :
+  INT VAR i ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    TASK VAR id := connected task (i) ;
+    IF NOT (is niltask (id) COR automatic startup flag (index (id))
+            COR is niltask (canal (i))) 
+      THEN break task
+    FI
+  PER .
+
+break task :
+  IF task direct connected to channel
+    THEN channel (id, nilchannel) ;
+         connected task (i) := niltask 
+    ELSE disconnect if at terminal but overloaded by canal
+  FI .
+
+task direct connected to channel :
+ pcb (id, channel field) <> nilchannel .
+
+disconnect if at terminal but overloaded by canal :
+  connected task (i) := niltask .
+
+order from task :
+  channel index := channel (order task) ;
+  IF is command analyzer task
+    THEN order from command analyzer (connected task (channel index))
+    ELSE order from user task
+  FI ;
+  IF is error
+    THEN send back error message
+  FI .
+
+is command analyzer task :
+        channel index <> nilchannel
+  CAND  channel index <= highest terminal channel
+  CAND  order task = canal (channel index) .
+
+send back error message :
+  forget (ds) ;
+  ds := nilspace ;
+  error msg := ds ;
+  CONCR (error msg) := error message ;
+  clear error ;
+  send (order task, error nak, ds) .
+
+ENDPROC supervisor ;
+
+PROC supervisor interrupt (TASK VAR command analyzer, INT CONST channel nr,
+                           TASK VAR terminal task) :
+ 
+  IF NOT is niltask (terminal task)
+    THEN channel (terminal task, nilchannel)
+  FI ;
+  create command analyzer if necessary ;
+  IF already at terminal
+    THEN halt process (command analyzer)
+    ELSE send acknowledge
+  FI ;
+  channel (command analyzer, channel nr) ;
+  activate (command analyzer) .
+
+create command analyzer if necessary :
+  IF is niltask (command analyzer)
+    THEN create son (myself, "-", command analyzer, proca (PROC analyze supervisor command))
+  FI .
+
+send acknowledge : 
+  forget (ds) ;
+  ds := nilspace ;
+  send (command analyzer, ack, ds) .
+
+already at terminal :  channel (command analyzer) = channel nr .
+
+ENDPROC supervisor interrupt ;
+
+PROC order from command analyzer (TASK VAR terminal task) :
+
+enable stop ;
+IF is continue                          THEN sv cmd continue 
+ELIF order code = system catalogue code THEN task info cmd
+ELIF order code = task of channel code  THEN sv cmd task of channel
+ELSE SELECT order code OF  CASE ack :
+                           CASE end code   : sv cmd end
+                           CASE break code : sv cmd break
+                           CASE halt code  : sv cmd halt 
+                           OTHERWISE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") 
+     END SELECT ;
+     channel (command analyzer, nilchannel)
+FI ;
+
+forget (ds) ;
+IF NOT is niltask (terminal task) AND order code <> system catalogue code
+  THEN channel (order task, nilchannel) ;
+       channel (terminal task, channel index) ;
+       activate (terminal task)
+FI .
+
+sv cmd task of channel :
+  msg := ds ;
+  msg.task := terminal task ;
+  send (order task,ack, ds) ;
+  LEAVE order from command analyzer .
+
+sv cmd end :
+  IF NOT is niltask (terminal task)
+    THEN delete task (terminal task) ;
+         terminal task := niltask
+  FI .
+
+sv cmd break :
+  terminal task := niltask .
+
+sv cmd continue :
+  sv cmd break ;
+  continue cmd by canal .
+
+sv cmd halt :
+  IF is niltask (terminal task)
+    THEN errorstop ("keine Task angekoppelt")
+    ELSE halt process (terminal task)
+  FI .
+
+is continue :
+  order code > continue code low AND order code <= continue code high .
+
+command analyzer : canal (channel index) .
+
+ENDPROC order from command analyzer ;
+
+PROC order from user task :
+
+  enable stop ;
+  SELECT order code OF
+    CASE nak, error nak               : 
+    CASE system catalogue code        : task info cmd
+    CASE begin code                   : user begin cmd
+    CASE end code                     : user end cmd
+    CASE break code                   : user break cmd
+    CASE rename code                  : user rename cmd
+    CASE password code                : password cmd
+    CASE family password code         : family password cmd
+    CASE set autonom code             : set autonom cmd
+    CASE reset autonom code           : reset autonom cmd
+    CASE define canal code            : define new canal
+    CASE go back to old canal code    : go back to old canal
+    CASE task of channel code         : task of channel
+    CASE canal of channel code        : canal of channel
+    CASE set automatic startup code   : set automatic startup cmd
+    CASE reset automatic startup code : reset automatic startup cmd
+    OTHERWISE IF is continue
+                THEN            user continue cmd
+              ELIF is define station
+                THEN            define new station
+                  ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""") 
+              FI
+  ENDSELECT .
+
+user begin cmd :
+  msg := ds ;
+  create son (order task, new task name, new task, new start proc) ;
+  send (order task, ack, ds) .
+
+user end cmd :
+  msg := ds ;
+  TASK VAR to be erased := CONCR (msg).task ;
+  IF task end permitted
+    THEN delete task (to be erased)
+    ELSE errorstop ("'end' unzulaessig")
+  FI ;
+  IF exists (order task)
+    THEN send (order task, ack, ds)
+    ELSE forget (ds)
+  FI .
+
+task end permitted :
+  ( (task is dead AND system catalogue contains entry) OR exists (to be erased))
+  CAND  (     to be erased = order task 
+          COR to be erased < order task
+          COR (order task < myself AND NOT (order task < to be erased)) ) .
+
+task is dead :
+  status (to be erased) > 6 .
+
+system catalogue contains entry :
+  task in catalogue (to be erased, index (to be erased)) .
+
+user rename cmd :
+  IF last rename was long ago
+    THEN msg := ds ;
+         name (order task, CONCR (msg).tname) ;
+         update entry in connected task array ;
+         send (order task, ack, ds) ;
+         remember rename time
+    ELSE send (order task, nak, ds)
+  FI .
+
+update entry in connected task array :
+  IF channel (order task) <> nilchannel
+    THEN connected task (channel (order task)) := order task
+  FI .
+
+remember rename time :
+  last rename time := clock (1) .
+
+last rename was long ago :  abs (clock (1) - last rename time) > 20.0 .
+
+user break cmd :
+  break order task ;
+  send (order task, ack, ds) .
+
+break order task :
+  IF task direct connected to channel
+    THEN channel (order task, nilchannel) ;
+         terminal task := niltask
+    ELSE disconnect if at terminal but overloaded by canal
+  FI .
+
+task direct connected to channel : channel index <> nilchannel .
+
+terminal task :  connected task (channel index) .
+
+disconnect if at terminal but overloaded by canal :
+  INT VAR i ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    IF connected task (i) = order task
+      THEN connected task (i) := niltask ;
+           LEAVE disconnect if at terminal but overloaded by canal
+    FI
+  PER .
+
+user continue cmd :
+  INT CONST dest channel := order code - continue code low ;
+  IF dest channel <= highest user channel OR order task < myself
+    THEN IF NOT channel really existing
+           THEN errorstop ("kein Kanal")
+         ELIF dest channel is free OR task is already at dest channel
+           THEN break order task ;
+                continue (order task, dest channel) ;
+                autonom flag (index (order task)) := FALSE ;
+                send (order task, ack, ds) 
+           ELSE errorstop ("Kanal belegt")
+         FI
+     ELSE errorstop ("ungueltiger Kanal")
+   FI .
+
+channel really existing :
+  channel type (dest channel) <> 0 OR dest channel = configurator channel .
+
+dest channel is free : 
+  (is niltask (connected task (dest channel)) OR channel (connected task (dest channel)) = nilchannel)
+  AND no canal active .
+
+no canal active :
+  dest channel > highest terminal channel    COR
+  is niltask (canal (dest channel))          COR 
+  channel (canal (dest channel)) = nilchannel .
+
+task is already at dest channel :
+  channel index = dest channel .
+
+
+password cmd :
+  msg := ds ;
+  task password (index (order task)) := new task password ;
+  forget (ds) ;
+  ds := nilspace ;
+  send (order task, ack, ds) .
+
+family password cmd :
+  msg := ds ;
+  actual password := new task password ;
+  supply password := task password (index (order task)) ;
+  change pw of all sons where necessary (son (order task)) ;
+  task password (index (order task)) := actual password ;
+  forget (ds) ;
+  ds := nilspace ;
+  send (order task, ack, ds) .
+
+set autonom cmd :
+  autonom flag (index (order task)) := TRUE ;
+  send (order task, ack, ds) .
+
+reset autonom cmd :
+  autonom flag (index (order task)) := FALSE ;
+  send (order task, ack, ds) .
+ 
+define new canal :
+  IF order task < myself AND
+     channel index > 0 AND channel index <= highest terminal channel CAND
+     is niltask (canal (channel index))
+    THEN canal (channel index) := order task ;
+         connected task (channel index) := niltask ;
+         send (order task, ack, ds)
+    ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+  FI .
+
+go back to old canal :
+  IF order task < myself AND
+     channel index > 0 AND channel index <= highest terminal channel 
+    THEN IF NOT is niltask (canal (channel index))
+           THEN delete task (canal (channel index)) 
+         FI ;
+         send (order task, ack, ds)
+    ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+  FI .
+
+task of channel :
+  msg := ds ;
+  channel nr := int (msg.tname) ;
+  msg.task := channel task ;
+  send (order task, ack, ds).
+
+channel task :
+  IF channel nr <= highest terminal channel
+    THEN IF no command analyzer active
+           THEN connected task (channel nr)
+           ELSE canal (channel nr)
+         FI
+    ELSE connected task (channel nr)
+  FI .
+
+no command analyzer active :
+  channel (canal (channel nr)) = nilchannel .
+
+canal of channel :
+  msg := ds ;
+  channel nr := int (msg.tname) ;
+  msg.task := canal (channel nr) ;
+  send (order task, ack, ds).
+
+set automatic startup cmd :
+  automatic startup flag (index (order task)) := TRUE ;
+  send (order task, ack, ds) .
+
+reset automatic startup cmd :
+  automatic startup flag (index (order task)) := FALSE ;
+  send (order task, ack, ds) .
+ 
+is continue :
+  order code > continue code low AND order code <= continue code high .
+
+new task name :     CONCR (msg).tname . 
+
+new task      :     CONCR (msg).task .
+ 
+new task password : subtext (CONCR (msg).tpass, 1, 100) .
+
+new start proc :    CONCR (msg).start proc .
+ 
+is define station :
+  order code >= define station code AND order task < myself AND 
+  order code <= define station code + max station no .
+
+ENDPROC order from user task ;
+
+PROC continue cmd by canal :
+
+  access task name and password ;
+  check password if necessary ;
+  continue or send continue request ;
+  channel (order task, nilchannel) .
+
+access task name and password :
+  msg := ds ;
+  TASK CONST user task := task (CONCR (msg).tname) ;
+  INT CONST task index := index (user task) ;
+  actual password := task password (task index) ;
+  supply password := CONCR (msg).tpass .
+
+check password if necessary :
+  IF actual password <> ""
+    THEN IF supply password = ""
+           THEN ask for password ;
+                LEAVE continue cmd by canal
+         ELIF actual password <> supply password OR actual password = "-"
+           THEN errorstop ("Passwort falsch")
+         FI
+   FI .
+ask for password :
+  send (order task, password code, ds) .
+
+continue or send continue request :
+  IF autonom flag (task index)
+    THEN send continue request to user task
+    ELSE continue (user task, order code - continue code low)
+  FI .
+ 
+send continue request to user task :
+  INT VAR request count , quit ;
+  FOR request count FROM 1 UPTO 10 REP
+    send (user task, order code, ds, quit) ;
+    IF quit = ack
+      THEN LEAVE send continue request to user task
+    FI ;
+    pause (3)
+  PER ;
+  errorstop ("Task antwortet nicht") .
+
+ENDPROC continue cmd by canal ;
+
+PROC continue (TASK CONST id, INT CONST channel nr) :
+
+  IF NOT is niltask (id) CAND channel (id) <> channel nr
+    THEN check whether not linked to another channel ;
+         channel (id, channel nr) ;
+         connected task (channel nr) := id ;
+         prio (id, 0) ;
+         activate (id)
+  FI .
+
+check whether not linked to another channel :
+  INT VAR i ;
+  FOR i FROM 1 UPTO number of channels REP
+    IF connected task (i) = id
+      THEN errorstop ("bereits an Kanal " + text (i) ) ;
+           LEAVE continue
+    FI
+  PER .
+ 
+ENDPROC continue ;
+
+PROC task info cmd :
+
+  forget (ds) ;
+  ds := sys cat ;
+  send (order task, ack, ds) .
+
+ENDPROC task info cmd ;
+ 
+PROC delete task (TASK CONST superfluous) :
+
+  delete all sons of superfluous ;
+  delete superfluous itself .
+
+delete superfluous itself :
+  update cpu time of father ;
+  erase process (superfluous) ;
+  delete (superfluous) ;
+  erase terminal connection remark .
+
+update cpu time of father :
+  TASK CONST father task := father (superfluous) ;
+  IF NOT is niltask (father task)
+    THEN disable stop ;
+         REAL CONST father time := clock (father task) + clock (superfluous);
+         IF is error
+           THEN clear error
+           ELSE set clock (father task, father time)
+         FI ;
+         enable stop
+  FI .
+
+erase terminal connection remark :
+  INT VAR i ;
+  FOR i FROM 1 UPTO number of channels REP
+    IF connected task (i) = superfluous
+      THEN connected task (i) := niltask ;
+           LEAVE erase terminal connection remark
+    FI
+  PER ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    IF canal (i) = superfluous
+      THEN canal (i) := niltask ;
+           LEAVE erase terminal connection remark
+    FI
+  PER .
+
+delete all sons of superfluous :
+  TASK VAR son task ;
+  REP
+    son task := son (superfluous) ;
+    IF is niltask (son task)
+      THEN LEAVE delete all sons of superfluous
+    FI ;
+    delete task (son task)
+  PER .
+
+ENDPROC delete task ;
+
+PROC create son (TASK CONST father, TEXT CONST task name, TASK VAR new task, PROCA CONST start) :
+
+  entry (father, task name, new task) ;
+  autonom flag  (index (new task)) := FALSE ;
+  automatic startup flag (index (new task)) := TRUE ;
+  task password (index (new task)) := "" ;
+  create (father, new task, privilege, start) .
+
+privilege :
+  IF new task < myself
+    THEN 1
+    ELSE 0
+  FI .
+
+ENDPROC create son ;
+
+
+PROC system start interrupt :
+
+  IF exists task ("configurator")
+    THEN send system start message
+  FI .
+
+send system start message :
+  ds := nilspace ;
+  INT VAR request count, quit ;
+  FOR request count FROM 1 UPTO 10 REP
+    send (task ("configurator"), system start code, ds, quit) ;
+    IF quit = ack
+      THEN LEAVE send system start message
+    FI ;
+    pause (3)
+  PER ;
+  forget (ds) .
+
+ENDPROC system start interrupt ;
+
+PROC define new station :
+
+  INT CONST station := order code - define station code ;
+  INT VAR i ;
+  FOR i FROM 1 UPTO highest terminal channel REP
+    IF NOT is niltask (canal (i))
+      THEN delete task (canal (i))
+    FI
+  PER ;
+  define station (station) ;
+  FOR i FROM 1 UPTO number of channels REP
+    update (connected task (i))
+  PER ;
+  forget (ds) .
+
+ENDPROC define new station ;
+
+PROC change pw of all sons where necessary (TASK CONST first son) :
+
+  TASK VAR actual task := first son ;
+  WHILE NOT is niltask (actual task) REP
+    change pw ;
+    change pw of all sons where necessary (son (actual task));
+    actual task := brother (actual task)
+  PER.
+
+  change pw :
+    IF task password (index (actual task)) = supply password 
+                        OR
+       task password (index (actual task)) = ""
+      THEN task password (index (actual task)) := actual password
+    FI.
+
+END PROC change pw of all sons where necessary ;
+
+(******************* basic supervisor operations **********************)
+
+
+PROC channel (TASK CONST id, INT CONST channel nr) :
+  pcb (id, channel field, channel nr)
+ENDPROC channel ;
+
+INT PROC channel type (INT CONST channel nr) :
+  disable stop ;
+  channel (myself, channel nr) ;
+  INT VAR type ;
+  control (1, 0, 0, type) ;
+  channel (myself, nilchannel) ;
+  type
+ENDPROC channel type ;
+
+PROC erase last bootstrap source dataspace :
+
+  disable stop ;
+  errorstop ("") ;
+  clear error
+
+ENDPROC erase last bootstrap source dataspace ;
+
+PROC set clock (TASK CONST id, REAL CONST clock value) :
+  EXTERNAL 82
+ENDPROC set clock ;
+
+PROC sys op (INT CONST code) :
+  EXTERNAL 90
+END PROC sys op ;
+
+PROC create (TASK CONST father, son, INT CONST priv, PROCA CONST start) :
+  EXTERNAL 95
+ENDPROC create ;
+ 
+PROC pcb (TASK CONST id, INT CONST field, value) :
+  EXTERNAL 105
+ENDPROC pcb ;
+
+PROC activate (TASK CONST id) :
+  EXTERNAL 108
+ENDPROC activate ;
+
+PROC deactivate (TASK CONST id) :
+  EXTERNAL 109
+ENDPROC deactivate ;
+
+PROC halt process (TASK CONST id) :
+  EXTERNAL 110
+ENDPROC halt process ;
+
+PROC erase process (TASK CONST id) :
+  EXTERNAL 112
+ENDPROC erase process ;
+
+ENDPACKET supervisor ;
+
diff --git a/system/multiuser/1.7.5/src/sysgen off b/system/multiuser/1.7.5/src/sysgen off
new file mode 100644
index 0000000..9cb999b
--- /dev/null
+++ b/system/multiuser/1.7.5/src/sysgen off
@@ -0,0 +1,9 @@
+ke ; (* maintenance ke *) 
+ 
+PROC sysgen off (INT CONST mode, INT VAR a,b,c,d,e,f,g,h,i,j,k) :
+  EXTERNAL 256
+ENDPROC sysgen off ;
+
+INT VAR x := 0 ;
+sysgen off (3,x,x,x,x,x,x,x,x,x,x,x) ;
+
diff --git a/system/multiuser/1.7.5/src/system info b/system/multiuser/1.7.5/src/system info
new file mode 100644
index 0000000..c29dfc2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/system info
@@ -0,0 +1,342 @@
+
+PACKET system info DEFINES                      (* Autor: J.Liedtke *)
+                                                (* Stand: 10.09.84  *)
+    task info ,
+    task status ,
+    storage info ,
+    help :
+
+
+LET supervisor mode = 0 ,
+    simple mode     = 1 ,
+    status mode     = 2 ,
+    storage mode    = 3 ,
+
+    ack             = 0 ,
+
+    channel field  = 4 ,
+    prio field     = 6 ,
+
+    cr lf     = ""13""10"" , 
+    cr        = ""13"" , 
+    page      = ""1""4"" ,
+    begin mark= ""15"" ,
+    end mark  = ""14"" ,
+    bell      = ""7"" ,
+    esc       = ""27"" ;
+
+
+
+TEXT VAR task name , record ;
+DATASPACE VAR ds := nilspace ;
+
+
+PROC task info :
+
+  task info (simple mode)
+
+ENDPROC task info ;
+
+PROC task info (INT CONST mode) :
+
+  open list file ;
+  task info (mode, list file) ;
+  show task info .
+
+open list file :
+  forget (ds) ;
+  ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) .
+
+show task info :
+  IF mode <> supervisor mode
+    THEN show (list file)
+    ELSE open editor (list file, FALSE) ;
+         edit (groesster editor, "q", PROC (TEXT CONST) no orders)
+  FI .
+
+ENDPROC task info ;
+
+PROC task info (INT CONST mode, FILE VAR list file) :
+
+  access catalogue ;
+  IF mode > simple mode
+    THEN generate head
+  FI ;
+  list tree (list file, supervisor,0, mode) .
+
+generate head :
+  put (list file, date) ;
+  put (list file, " ") ;
+  put (list file, time of day) ;
+  put (list file, "                          ") ;
+  IF mode = storage mode
+    THEN put (list file, "K     ")
+  FI ;
+  put (list file, " CPU    PRIO CHAN STATUS") ;
+  line (list file) .
+
+ENDPROC task info ;
+ 
+PROC task info (INT CONST level, fremdstation): 
+  IF fremdstation = station (myself) 
+  THEN task info (level) 
+  ELSE 
+    disable stop;
+    DATASPACE VAR x:= nilspace; 
+    BOUND INT VAR l := x; l := level; 
+    call (collector, 256+fremdstation, x, rtn); 
+    INT VAR rtn; 
+    IF rtn = ack 
+      THEN FILE VAR ti:= sequential file (modify, x) ;
+           show (ti) 
+      ELSE forget (x) ;
+           errorstop ("Station " + text (fremdstation) + " antwortet nicht")
+    FI ;
+    forget (x) 
+  FI 
+END PROC task info; 
+
+PROC no orders (TEXT CONST ed kommando taste) :
+
+  IF ed kommando taste = "q"
+    THEN quit
+    ELSE out (""7"")
+  FI
+
+ENDPROC no orders ;
+
+PROC list tree (FILE VAR list file,
+                TASK CONST first son, INT CONST depth, mode) :
+
+  enable stop ;
+  TASK VAR actual task := first son ;
+  WHILE NOT is niltask (actual task) REP
+    list actual task ;
+    list tree (list file, son (actual task), depth+1, mode) ;
+    actual task := brother (actual task)
+  PER .
+
+list actual task :
+  record := "" ;
+  generate layout and task name ;
+  IF mode > simple mode
+    THEN tab to info position ;
+         show storage if wanted ;
+         record CAT cpu time of (actual task) ;
+         record CAT prio of actual task ;
+         record CAT channel of actual task ;
+         record CAT "   " ;
+         record CAT status of (actual task)
+   FI ;
+   putline (list file, record) .
+
+generate layout and task name :
+  INT VAR i ;
+  FOR i FROM 1 UPTO depth REP
+    record CAT "    "
+  PER ;
+  task name := name (actual task) ;
+  record CAT task name .
+
+tab to info position :
+  record := subtext (record, 1, 40) ;
+  FOR i FROM LENGTH record + 1 UPTO 40 REP
+    record CAT "."
+  PER ;
+  record CAT " " .
+
+show storage if wanted :
+  IF mode = storage mode
+    THEN record CAT text (storage (actual task), 5) ;
+         record CAT "  "
+  FI .
+
+prio of actual task :
+  text (pcb (actual task, prio field),4) .
+
+channel of actual task :
+  INT CONST channel := pcb (actual task, channel field) ;
+  IF channel = 0
+    THEN "   -"
+    ELSE text (channel,4)
+  FI .
+
+ENDPROC list tree ;
+
+TEXT PROC cpu time of (TASK CONST actual task) :
+
+  disable stop ;
+  TEXT VAR result := subtext (time (clock (actual task), 12), 1, 10) ;
+  IF is error
+    THEN clear error ;
+         result := 10 * "*"
+  FI ;
+  result
+
+ENDPROC cpu time of ;
+
+TEXT PROC status of (TASK CONST actual task) :
+
+  SELECT status (actual task) OF
+    CASE 0 :  "-busy-"
+    CASE 1 :  "i/o"
+    CASE 2 :  "wait"
+    CASE 4 :  "busy-blocked"
+    CASE 5 :  "i/o -blocked"
+    CASE 6 :  "wait-blocked"
+    OTHERWISE "--dead--"
+  END SELECT .
+
+ENDPROC status of ;
+
+PROC task status :
+
+  task status (myself)
+
+ENDPROC task status ;
+
+PROC task status (TEXT CONST task name) :
+
+  task status (task (task name))
+
+ENDPROC task status ;
+
+PROC task status (TASK CONST actual task) :
+
+  IF exists (actual task)
+    THEN put status of task
+    ELSE errorstop ("Task nicht vorhanden")
+  FI .
+
+put status of task :
+  line ;
+  put (date); put (time of day) ;
+  put ("  TASK:") ;
+  put (name (actual task)) ;
+  line (2) ;
+  put ("Speicher:"); put (storage (actual task)); putline ("K");
+  put ("CPU-Zeit:"); put (cpu time of (actual task)) ; line;
+  put ("Zustand :"); write (status of (actual task)); 
+                     put (", (prio");
+                     write (text (pcb (actual task, prio field)));
+                     put ("), Kanal") ;
+                     IF channel (actual task) = 0
+                       THEN put ("-")
+                       ELSE put (channel (actual task))
+                     FI ;
+                     line .
+
+ENDPROC task status ;
+
+PROC storage info :
+ 
+  INT VAR size, used ;
+  storage (size, used) ;
+  out (""13""10"      ") ;
+  put (used) ;
+  put ("K von") ;
+  put (size plus reserve) ;
+  putline ("K sind belegt!") .
+ 
+size plus reserve :
+  int (real (size + 24) * 64.0 / 63.0 ) .
+
+ENDPROC storage info ;
+ 
+ 
+PROC help :
+
+  IF NOT exists ("help")
+    THEN get help file
+  FI ;
+  FILE VAR f := sequential file (modify, "help") ;
+  help (f) .
+
+get help file :
+  TEXT VAR old std param := std ;
+  IF exists ("help", father)
+    THEN fetch ("help")
+    ELSE fetch ("help", public)
+  FI ;
+  last param (old std param) .
+
+ENDPROC help ;
+
+PROC help (FILE VAR help file) :
+ 
+  initialize help command ;
+  REP 
+    out (page) ;
+    to paragraph ; 
+    show paragraph ; 
+    get show command 
+  UNTIL is quit command PER .
+ 
+initialize help command :
+   TEXT VAR
+   help command := getcharety ;
+   IF help command = ""
+     THEN help command := "0"
+   FI .
+
+to paragraph : 
+  col (help file, 1) ;
+  to line (help file, 1) ; 
+  downety (help file, "#" + help command + "#") ; 
+  IF eof (help file) 
+    THEN to line (help file, 1) ;
+         out (bell)
+  FI . 
+ 
+show paragraph : 
+  show headline ;
+  WHILE NOT end of help subfile REP 
+    show help line
+  PER ; 
+  show bottom line .
+
+show headline :
+  out (begin mark) ;
+  INT CONST dots := (x size - len (help file) - 5) DIV 2 ;
+  dots TIMESOUT "." ;
+  exec (PROC show line, help file, 4) ;
+  dots TIMESOUT "." ;
+  out (end mark) ;
+  down (help file) .
+
+show help line :
+  out (cr lf) ;
+  exec (PROC show line, help file, 1) ;
+  down (help file) .
+
+show bottom line :
+  cursor (5, y size) ; 
+  exec (PROC show line, help file, 3) ; 
+  out (cr) . 
+ 
+get show command : 
+  TEXT VAR char ;
+  get char (char) ;
+  IF char = esc
+    THEN get char (char)
+  FI ;
+  IF char >= " "
+    THEN help command := char
+    ELSE out (bell)
+  FI .
+
+end of help subfile : pos (help file,"##",1) <> 0 OR eof (help file) .
+
+is quit command     : help command = "q" OR help command = "Q" .
+
+ENDPROC help ;
+ 
+PROC show line (TEXT CONST line, INT CONST from) : 
+ 
+  outsubtext (line, from, x size - from) 
+ 
+ENDPROC show line ;
+ 
+ENDPACKET system info ;
+
diff --git a/system/multiuser/1.7.5/src/system manager b/system/multiuser/1.7.5/src/system manager
new file mode 100644
index 0000000..5406ff0
--- /dev/null
+++ b/system/multiuser/1.7.5/src/system manager
@@ -0,0 +1,117 @@
+(* ------------------- VERSION 4 vom 31.01.86 ------------------- *)
+PACKET system manager DEFINES                       (* F. Klapper *)
+  system manager , 
+  generate shutup manager ,
+  put log :
+ 
+LET ack            = 0  ,
+    error nak      = 2  ,
+    fetch code     = 11 ,
+    list code      = 15 ,
+    all code       = 17 ,
+    log code       = 21 ,
+    eszet          = ""251"" ,
+    log file name  = "logbuch";
+
+DATASPACE VAR ds;
+
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
+BOUND TEXT VAR log message, 
+               error msg;
+
+INT VAR reply;
+
+TEXT VAR xname;
+ 
+FILE VAR log file;
+
+PROC system manager:
+  lernsequenz auf taste legen ("s", eszet) ;
+  global manager 
+  (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) sys manager) 
+ 
+END PROC system manager; 
+ 
+PROC sys manager (DATASPACE VAR ds, INT CONST order, phase,
+                  TASK CONST order task):
+  enable stop;
+  SELECT order OF
+  CASE log code      : y put log
+  CASE list code     : y list
+  CASE all code      : y all
+  CASE fetch code    : y fetch
+  OTHERWISE std manager (ds, order, phase, order task)
+  END SELECT.
+ 
+y fetch :
+  msg := ds;
+  xname := msg.name;
+  IF read permission (xname, msg.read pass)
+  THEN forget (ds) ;
+       ds := old (xname) ;
+       send (order task, ack, ds)
+  ELSE errorstop ("Passwort falsch")
+  FI .
+ 
+y list :
+  forget (ds) ;
+  ds := nilspace ;
+  FILE VAR list file := sequential file (output, ds) ;
+  list (list file) ;
+  send (order task, ack, ds) .
+ 
+y all :
+  forget (ds);
+  ds := nilspace;
+  BOUND THESAURUS VAR all names := ds ;
+  all names := all ;
+  send (order task, ack, ds) .
+ 
+y put log :
+  log file := sequential file (output, log file name) ;
+  IF lines (log file) < 4000
+    THEN max line length (log file,1000);
+         put (log file, date) ;
+         put (log file, time of day) ;
+         put (log file, text (name (order task), 8));
+         log message := ds ;
+         put (log file, CONCR (log message)) ;
+  FI ;
+  send (order task, ack, ds) .
+
+END PROC sys manager;
+ 
+PROC put log (TEXT CONST message) :
+  enable stop;
+  forget (ds) ;
+  ds := nilspace ;
+  log message := ds ;
+  CONCR (log message) := message ;
+  call (task("SYSUR"), log code, ds, reply) .
+
+ENDPROC put log ;
+
+PROC generate shutup manager :
+
+  TASK VAR son ;
+  begin ("shutup", PROC shutup manager, son)
+
+ENDPROC generate shutup manager ;
+
+PROC shutup manager :
+  disable stop ;
+  task password ("") ;
+  command dialogue (TRUE) ;
+  REP
+    break ;
+    line ;
+    IF yes ("shutup")
+       THEN clear error ;
+            shutup
+    FI
+  PER
+
+ENDPROC shutup manager ;
+
+ENDPACKET system manager ;
+
diff --git a/system/multiuser/1.7.5/src/tasks b/system/multiuser/1.7.5/src/tasks
new file mode 100644
index 0000000..276011e
--- /dev/null
+++ b/system/multiuser/1.7.5/src/tasks
@@ -0,0 +1,978 @@
+(* ------------------- VERSION 9 vom 09.06.86 ------------------- *)
+PACKET tasks DEFINES                          (* Autor: J.Liedtke *)
+ 
+    TASK ,
+    PROCA ,
+    := ,
+    = ,
+    < ,
+    / ,
+    niltask ,
+    is niltask ,
+    exists ,
+    exists task ,
+    supervisor ,
+    myself ,
+    public ,
+    proca ,
+    collector ,
+    access ,
+    name ,
+    task ,
+    canal ,
+    dataspaces ,
+    index ,
+    station ,
+    update ,
+    father ,
+    son ,
+    brother ,
+    next active ,
+    access catalogue ,
+    family password ,
+    task in catalogue ,
+    entry ,
+    delete ,
+    define station ,
+
+    pcb ,
+    status ,
+    channel ,
+    clock ,
+    storage ,
+    callee ,
+
+    send ,
+    wait ,
+    call ,
+    pingpong ,
+    collected destination ,
+ 
+    begin ,
+    end ,
+    break ,
+    continue ,
+    rename myself ,
+    task password ,
+    set autonom ,
+    reset autonom ,
+    set automatic startup ,
+    reset automatic startup ,
+
+    sys cat :
+
+ 
+
+LET nil = 0 ,
+
+    max version = 30000 ,
+    max task = 125 ,
+    max station no = 127 ,
+    sv no = 1 ,
+
+    hex ff   = 255 ,
+    hex 7f00 = 32512 ,
+
+    collected dest field 1 = 2 ,
+    collected dest field 2 = 3 ,
+    channel field = 4 ,
+    myself no field = 9 ,
+    myself version field = 10 ,
+    callee no field = 11 ,
+    callee version field = 12 ,
+
+    highest terminal channel = 16 ,
+    number of channels       = 32 ,
+
+    wait state = 2 ,
+
+    ack                            = 0 ,
+    nak                            = 1 ,
+    error nak                      = 2 ,
+    system catalogue code          = 3 ,
+    begin code                     = 4 ,
+    end code                       = 5 ,
+    break code                     = 6 ,
+    rename code                    = 7 ,
+    password code                  = 9 ,
+    family password code           = 40 ,
+    set autonom code               = 41 ,
+    reset autonom code             = 42 ,
+    task of channel code           = 45 ,
+    canal of channel code          = 46 ,
+    set automatic startup code     = 47 ,
+    reset automatic startup code   = 48 ,
+
+    continue code                  = 100,
+    define station code            = 32000,
+
+    lowest ds number               = 4 ,
+    highest ds number              = 255 ;
+
+
+TYPE TASK  = STRUCT (INT no, version) ,
+     PROCA = STRUCT (INT a, b) ;
+ 
+OP := (PROCA VAR right, PROCA CONST left) :
+  CONCR (right) := CONCR (left)
+ENDOP :=  ;
+
+PROCA PROC proca (PROC p) : 
+
+  push (0, PROC p) ;
+  pop
+
+ENDPROC proca ;
+
+PROC push (INT CONST dummy, PROC p) : ENDPROC push ;
+
+PROCA PROC pop :
+  PROCA VAR res;
+  res
+ENDPROC pop ;
+
+TASK CONST niltask := TASK: (0,0) ,
+           collector  := TASK: (-1,0) ;
+
+TASK PROC supervisor :
+ 
+  TASK: (my station id + sv no, 0) .
+
+my station id :  pcb (myself no field) AND hex 7f00 .
+
+ENDPROC supervisor ;
+
+TASK VAR   father task ;
+
+INITFLAG VAR catalogue known := FALSE , father known := FALSE ;
+
+
+
+LET TASKVECTOR = STRUCT (INT version, father, son, brother) ;
+
+
+DATASPACE VAR catalogue space , sv space ;
+
+BOUND STRUCT (THESAURUS dir,
+              ROW max task TASKVECTOR link) VAR system catalogue ;
+ initialize catalogue ; 
+ 
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg ;
+
+
+PROC initialize catalogue :
+
+  catalogue space := nilspace ;
+  system catalogue := catalogue space ;
+  system catalogue.dir := empty thesaurus ;
+
+  insert (system catalogue.dir, "SUPERVISOR") ;
+  insert (system catalogue.dir, "UR") ;
+  system catalogue.link (1) := TASKVECTOR:(0,0,0,2) ;
+  system catalogue.link (2) := TASKVECTOR:(0,0,0,0) .
+
+ENDPROC initialize catalogue ;
+
+DATASPACE PROC sys cat :
+  catalogue space
+ENDPROC sys cat ;
+
+
+TASK PROC myself :
+
+  TASK: (pcb (myself no field), pcb (myself version field))
+
+ENDPROC myself ;
+
+
+OP := (TASK VAR dest, TASK CONST source):
+
+  CONCR (dest) := CONCR (source)
+
+ENDOP := ;
+
+BOOL OP = (TASK CONST left, right) :
+
+  left.no = right.no  AND  left.version = right.version
+
+ENDOP = ;
+
+BOOL PROC is niltask (TASK CONST t) :
+
+  t.no = 0
+
+ENDPROC is niltask ;
+
+BOOL OP < (TASK CONST left, right) :
+
+  IF both of my station
+    THEN access (left) ;
+         access (right) ;
+            ( index (left) > 0  CAND  index (left) <= max task )
+         CAND
+            ( father (left) = right  COR  father (left) < right )
+    ELSE FALSE
+  FI .
+
+both of my station :
+  station (left) = station (right) AND station (right) = station (myself) .
+
+ENDOP < ;
+
+BOOL PROC exists (TASK CONST task) :
+
+  EXTERNAL 123
+
+ENDPROC exists ;
+ 
+BOOL PROC exists task (TEXT CONST name) :
+
+  task id (name).no <> 0
+
+ENDPROC exists task ;
+
+TEXT PROC name (TASK CONST task) :
+
+  IF is task of other station
+  THEN external name (task)
+  ELSE
+    access (task) ;
+    INT CONST task no := index (task) ;
+    IF task in catalogue (task ,task no)
+      THEN name (system catalogue.dir, task no) 
+      ELSE ""
+    FI 
+  FI.
+
+is task of other station :
+  (task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) .
+ 
+ENDPROC name ;
+
+BOOL PROC task in catalogue (TASK CONST task, INT CONST task no) :
+
+  access catalogue ;
+  task no >= 1 CAND task no <= max task CAND
+  task.version = system catalogue.link (task no).version .
+
+ENDPROC task in catalogue ;
+
+PROC access (TASK CONST task) :
+
+  INT CONST task no := task.no AND hex ff ;
+  IF task no < 1 OR task no > max task
+    THEN
+  ELIF is task of other station
+    THEN errorstop ("TASK anderer Station")
+  ELIF actual task id not in catalogue COR NOT exists (task)
+    THEN access catalogue
+  FI .
+
+actual task id not in catalogue :
+  NOT initialized (catalogue known)  COR
+  ( task no > 0 CAND catalogue version <> task.version ) .
+ 
+catalogue version :  system catalogue.link (task no).version .
+
+is task of other station :
+  (task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) .
+
+ENDPROC access ;
+
+TASK PROC task (TEXT CONST task name) :
+
+  TASK CONST id := task id (task name) ;
+  IF id.no = 0
+    THEN errorstop (""""+task name+""" gibt es nicht")
+  FI ;
+  id
+
+ENDPROC task ;
+
+TASK PROC task id (TEXT CONST task name) :
+
+  IF task name = "-" OR task name = ""
+    THEN errorstop ("Taskname unzulaessig")
+  FI ;
+  IF NOT initialized (catalogue known)
+    THEN access catalogue
+  FI ;
+
+  TASK VAR
+  id := task id (link (system catalogue.dir, task name)) ;
+  IF NOT exists (id)
+    THEN access catalogue ;
+         id  := task id (link (system catalogue.dir, task name)) ;
+  FI ;
+  id .
+
+ENDPROC task id ;
+
+TASK OP / (TEXT CONST task name) :
+
+  task (task name)
+
+ENDOP / ;
+
+INT PROC index (TASK CONST task) :
+
+  IF NOT initialized (catalogue known)
+    THEN access catalogue
+  FI ;
+  task.no AND hex ff
+
+ENDPROC index ;
+
+INT PROC station (TASK CONST task) :
+
+  task.no DIV 256
+
+ENDPROC station ;
+
+PROC update (TASK VAR task) :
+
+  IF task.no <> nil
+    THEN task.no := (task.no AND hex ff) + new station number
+  FI .
+
+new station number :  (pcb (myself no field) AND hex 7f00) .
+
+ENDPROC update ;
+
+
+TASK PROC public :
+
+  task ("PUBLIC")
+
+ENDPROC public ;
+
+TASK PROC father :
+
+  IF NOT initialized (father known) COR station or rename changed father id
+    THEN access catalogue ;
+         father task := father (myself)
+  FI ;
+  father task .
+
+station or rename changed father id :
+  NOT exists (father task) .
+
+ENDPROC father ;
+
+INT VAR task no ;
+
+TASK PROC father (TASK CONST task) :
+
+  task no := index (task) ;
+  task id (system catalogue.link (task no).father) .
+
+ENDPROC father ;
+
+TASK PROC son (TASK CONST task) :
+
+  task no := index (task) ;
+  IF task no = nil
+    THEN supervisor
+    ELSE task id (system catalogue.link (task no).son)
+  FI .
+
+ENDPROC son ;
+
+TASK PROC brother (TASK CONST task) :
+
+  task no := index (task) ;
+  task id (system catalogue.link (task no).brother) .
+
+ENDPROC brother ;
+
+PROC next active (TASK VAR task) :
+
+  next active task index (task.no) ;
+  IF task.no > 0
+    THEN task.version := pcb (task, myself version field)
+    ELSE task.version := 0
+  FI 
+
+ENDPROC next active ;
+
+PROC next active task index (INT CONST no) :
+
+  EXTERNAL 118
+
+ENDPROC next active task index ;
+
+TASK PROC task id (INT CONST task nr) :
+
+  INT VAR task index := task nr AND hex ff ;
+  TASK VAR result ;
+  result.no := task index ;
+  IF task index = nil
+    THEN result.version := 0
+    ELSE result.version := system catalogue.link (task index).version ;
+         result.no INCR my station id
+  FI ;
+  result .
+
+my station id : pcb (myself no field) AND hex 7f00 .
+
+ENDPROC task id ;
+
+PROC access catalogue :
+
+  IF this is not supervisor
+    THEN get catalogue from supervisor
+  FI .
+
+this is not supervisor :
+  (pcb (myself no field) AND hex ff) <> sv no .
+
+get catalogue from supervisor :
+  INT VAR dummy reply ;
+  forget (catalogue space) ;
+  catalogue space := nilspace ;
+  call (supervisor, system catalogue code, catalogue space, dummy reply) ;
+  system catalogue := catalogue space .
+
+ENDPROC access catalogue ;
+
+
+PROC entry (TASK CONST father task, TEXT CONST task name,
+            TASK VAR son task) :
+
+  IF task name <> "-" CAND (system catalogue.dir CONTAINS task name)
+    THEN errorstop (""""+task name+""" existiert bereits")
+  ELIF is niltask (father task)
+    THEN errorstop ("Vatertask existiert nicht")
+  ELSE   entry task 
+  FI .
+
+entry task :
+  INT VAR son task nr ;
+  INT CONST father task nr := index (father task) ;
+  insert (system catalogue.dir, task name, son task nr) ;
+  IF son task nr = nil OR son task nr > max task
+    THEN delete (system catalogue.dir, son task nr) ;
+         son task := niltask ;
+         errorstop ("zu viele Tasks")
+    ELSE insert task (father task, father vec, son task, son vec, son tasknr)
+  FI .
+
+father vec : system catalogue.link (father task nr) .
+
+son vec    : system catalogue.link (son task nr) .
+
+ENDPROC entry ;
+
+PROC insert task (TASK CONST father task, TASKVECTOR VAR father vec,
+                  TASK VAR son task, TASKVECTOR VAR son vec, INT CONST nr) :
+
+  initialize version number if son vec is first time used ; 
+  increment version (son vec) ;
+  son task.no := my station id + nr ;
+  son task.version := son vec.version ;
+  link into task tree .
+
+initialize version number if son vec is first time used :
+  IF son vec.version < 0
+    THEN son vec.version := 0
+  FI .
+
+link into task tree :
+  son vec.son := nil ;
+  son vec.brother := father vec.son ;
+  son vec.father := index (father task) ;
+  father vec.son := son task.no .
+
+my station id :  pcb (myself no field) AND hex 7f00 .
+
+END PROC insert task ;
+
+
+PROC delete (TASK CONST superfluous) :
+
+  INT CONST superfluous nr := index (superfluous) ;
+  delete (system catalogue.dir, superfluous nr) ;
+  delete superfluous task ;
+  increment version (superfluous vec) .
+ 
+delete superfluous task :
+  INT CONST successor of superfluous := superfluous vec.brother ;
+  TASK VAR
+  last := father (superfluous) ,
+  actual := son (last) ;
+  IF actual = superfluous
+    THEN delete first son of last
+    ELSE search previous brother of superfluous ;
+         delete from brother chain
+  FI .
+
+delete first son of last :
+  last vec.son := successor of superfluous .
+
+search previous brother of superfluous :
+  REP
+    last := actual ;
+    actual := brother (actual)
+  UNTIL actual = superfluous PER .
+
+delete from brother chain :
+  last vec.brother := successor of superfluous .
+
+last vec        :   system catalogue.link (index (last)) .
+
+superfluous vec :   system catalogue.link (superfluous nr) .
+
+ENDPROC delete ;
+
+
+PROC name (TASK VAR task, TEXT CONST new name) :
+
+  INT CONST task no := index (task) ;
+  IF (system catalogue.dir CONTAINS new name) AND (new name <> "-")
+                  AND (name (task) <> new name)
+    THEN errorstop (""""+new name+""" existiert bereits")
+    ELSE rename (system catalogue.dir, task no, new name) ;
+         increment version (system catalogue.link (task no)) ;
+         IF this is supervisor
+           THEN update task version in pcb and task variable
+         FI
+  FI .
+
+this is supervisor :  (pcb (myself no field) AND hex ff) = sv no .
+
+update task version in pcb and task variable :
+  INT CONST new version := system catalogue.link (task no).version ;
+  write pcb (task, myself version field, new version) ;
+  task.version := new version .
+
+ENDPROC name ;
+
+
+PROC increment version (TASKVECTOR VAR task vec) :
+
+  task vec.version := task vec.version MOD max version + 1
+
+ENDPROC increment version ;
+
+
+INT PROC pcb (TASK CONST id, INT CONST field) :
+ 
+  EXTERNAL 104
+
+ENDPROC pcb ;
+
+INT PROC status (TASK CONST id) :
+
+  EXTERNAL 107
+
+ENDPROC status ;
+
+INT PROC channel (TASK CONST id) :
+
+  pcb (id, channel field)
+
+ENDPROC channel ;
+
+REAL PROC clock (TASK CONST id) :
+
+  EXTERNAL 106
+
+ENDPROC clock ;
+
+INT PROC storage (TASK CONST id) :
+
+  INT VAR ds number, storage sum := 0, ds size;
+  FOR ds number FROM lowest ds number UPTO highest ds number REP
+    ds size := pages (ds number, id) ;
+    IF ds size > 0
+      THEN storage sum INCR ((ds size + 1) DIV 2)
+    FI
+  PER ;
+  storage sum
+
+ENDPROC storage ;
+
+INT PROC pages (INT CONST ds number, TASK CONST id) :
+
+  EXTERNAL 88
+
+ENDPROC pages ;
+
+TASK PROC callee (TASK CONST from) :
+
+  IF status (from) = wait state
+    THEN TASK:(pcb (from, callee no field), pcb (from, callee version field))
+    ELSE niltask
+  FI
+
+ENDPROC callee ;
+
+
+PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds,
+           INT VAR quit) :
+  EXTERNAL  113
+ 
+ENDPROC send ;
+
+PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds) :
+
+  INT VAR dummy quit ;
+  send (dest, send code, ds, dummy quit) ;
+  forget (ds)
+
+ENDPROC send ;
+
+PROC wait (DATASPACE VAR ds, INT VAR receive code, TASK VAR source) :
+
+  EXTERNAL 114
+ 
+ENDPROC wait ;
+
+PROC call (TASK CONST dest, INT CONST order code, DATASPACE VAR ds,
+           INT VAR reply code) :
+  EXTERNAL 115
+ 
+ENDPROC call ;
+
+PROC pingpong (TASK CONST dest, INT CONST order code, DATASPACE VAR ds,
+                  INT VAR reply code) :
+  EXTERNAL 122
+ 
+ENDPROC pingpong ;
+
+TASK PROC collected destination :
+
+  TASK: (pcb (collected dest field 1), pcb (collected dest field 2))
+
+ENDPROC collected destination ;
+
+
+PROC begin (PROC start, TASK VAR new task) :
+
+  begin ("-", PROC start, new task)
+
+ENDPROC begin ;
+
+PROC begin (TEXT CONST son name, PROC start, TASK VAR new task) :
+
+  enable stop ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).tname := son name ;
+  CONCR (sv msg).start proc := proca (PROC start) ;
+  supervisor call (begin code) ;
+  sv msg := sv space ;
+  new task := CONCR (sv msg).task .
+ 
+ENDPROC begin ;
+
+PROC begin (DATASPACE VAR ds, PROC start, INT VAR reply) :
+
+  sv msg := ds ;
+  sv msg.start proc := proca (PROC start)  ;
+  call (supervisor, begin code, ds, reply)
+
+ENDPROC begin ;
+
+PROC end :
+
+  command dialogue (TRUE) ;
+  say ("task """) ;
+  say (name (myself)) ;
+  IF yes (""" loeschen")
+    THEN eumel must advertise ;
+         end (myself)
+  FI
+
+ENDPROC end ;
+
+PROC end (TASK CONST id) :
+
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).task := id ;
+  supervisor call (end code)
+
+ENDPROC end ;
+
+PROC break (QUIET CONST quiet) :
+
+  simple supervisor call (break code)
+
+ENDPROC break ;
+
+PROC break :
+
+  eumel must advertise ;
+  simple supervisor call (break code)
+
+ENDPROC break ;
+
+PROC continue (INT CONST channel nr) :
+ 
+  simple supervisor call (continue code + channel nr)
+
+ENDPROC continue ;
+
+PROC rename myself (TEXT CONST new name) :
+
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).tname := new name ;
+  supervisor call (rename code) .
+
+ENDPROC rename myself ;
+
+
+PROC simple supervisor call (INT CONST code) :
+
+  forget (sv space) ;
+  sv space := nilspace ;
+  supervisor call (code)
+
+ENDPROC simple supervisor call ;
+ 
+PROC supervisor call (INT CONST code) :
+
+  INT VAR answer ;
+  call (supervisor, code, sv space, answer) ;
+  WHILE answer = nak REP
+    pause (20) ;
+    call (supervisor, code, sv space, answer)
+  PER ;
+  IF answer = error nak
+    THEN BOUND TEXT VAR error message := sv space ;
+         errorstop (CONCR (error message))
+  FI 
+
+ENDPROC supervisor call ;
+
+PROC task password (TEXT CONST password) :
+
+  IF online 
+    THEN say (""3""5""10"")
+  FI ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  CONCR (sv msg).tpass := password ;
+  supervisor call (password code) ;
+  cover tracks .
+
+ENDPROC task password ;
+
+PROC set autonom :
+ 
+  simple supervisor call (set autonom code)
+
+ENDPROC set autonom ;
+
+PROC reset autonom :
+
+  simple supervisor call (reset autonom code)
+
+ENDPROC reset autonom ;
+
+PROC set automatic startup :
+    simple supervisor call (set automatic startup code)
+ENDPROC set automatic startup ;
+
+PROC reset automatic startup :
+    simple supervisor call (reset automatic startup code)
+ENDPROC reset automatic startup ;
+
+PROC define station (INT CONST station number) :
+
+  IF this is supervisor
+    THEN update all tasks
+    ELIF i am privileged
+        THEN IF station number is valid
+               THEN send define station message
+               ELSE errorstop ("ungueltige Stationsnummer (0 - 127)")
+             FI
+        ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+  FI .
+
+update all tasks :
+  start at supervisor ;
+  REP
+    get next task ;
+    IF no more task found
+      THEN update station number of supervisor ;
+           LEAVE update all tasks
+    FI ;
+    update station number of actual task
+  PER .
+
+i am privileged :
+  myself < supervisor .
+
+station number is valid :
+  station number >= 0 AND station number <= max station no .
+
+start at supervisor :
+  TEXT VAR name ;
+  INT VAR index := sv no .
+ 
+get next task :
+  get (system catalogue.dir, name, index) .
+ 
+no more task found :  index = 0 .
+
+update station number of actual task :
+  write pcb (task id (index), myself no field, station number * 256 + index).
+
+update station number of supervisor :
+  write pcb (supervisor, myself no field, station number * 256 + sv no) .
+
+send define station message :
+  forget (sv space) ;
+  sv space := nilspace ;
+  INT VAR receipt ;
+  REP
+    send (supervisor, define station code+station number, sv space, receipt)
+  UNTIL receipt = ack PER .
+
+this is supervisor :
+  (pcb (myself no field) AND hex ff) = sv no .
+
+ENDPROC define station ;
+
+
+TASK OP / (INT CONST station number, TEXT CONST task name) :
+
+  IF station number = station (myself)
+    THEN task (task name)
+    ELSE get task id from other station
+  FI .
+
+get task id from other station :
+  enable stop ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  BOUND TEXT VAR name message := sv space ;
+  name message := task name ;
+  INT VAR reply ;
+  call (collector, station number, sv space, reply) ;
+  IF reply = ack
+    THEN BOUND TASK VAR result := sv space ;
+         CONCR (result) 
+  ELIF reply = error nak
+    THEN name message := sv space;
+         disable stop;
+         errorstop (name message) ;
+         forget (sv space) ;
+         niltask
+    ELSE forget (sv space);
+         errorstop ("Collector-Task fehlt") ;
+         niltask
+  FI
+
+ENDOP / ;
+
+
+TASK OP / (INT CONST station number, TASK CONST tsk):
+
+  station number / name (tsk)
+
+END OP / ;
+
+ 
+TEXT PROC external name (TASK CONST tsk):
+
+  IF tsk = nil task 
+  THEN 
+    ""
+  ELIF tsk = collector
+  THEN
+    "** collector **"
+  ELSE
+    name via net
+  FI.
+
+name via net:
+  enable stop ;
+  forget (sv space);
+  sv space := nil space;
+  BOUND TASK VAR task message := sv space;
+  task message := tsk;
+  INT VAR reply;
+  call (collector, 256, sv space, reply);
+  BOUND TEXT VAR result := sv space;
+  CONCR (result).
+
+END PROC external name;
+
+PROC write pcb (TASK CONST task, INT CONST field, value) :
+  EXTERNAL  105
+ENDPROC write pcb ;
+
+TASK PROC task (INT CONST channel number) :
+
+  IF channel number < 1 OR channel number > 32
+    THEN errorstop ("ungueltige Kanalnummer")
+  FI ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  sv msg.tname := text (channel number) ;
+  supervisor call (task of channel code) ;
+  sv msg := sv space ;
+  sv msg.task
+
+END PROC task;
+
+TASK PROC canal (INT CONST channel number) :
+
+  IF channel number < 1 OR channel number > highest terminal channel
+    THEN errorstop ("ungueltige Kanalnummer")
+  FI ;
+  forget (sv space);
+  sv space := nilspace ;
+  sv msg := sv space ;
+  sv msg.tname := text (channel number) ;
+  supervisor call (canal of channel code) ;
+  sv msg := sv space ;
+  sv msg.task
+
+END PROC canal ;
+
+PROC family password (TEXT CONST password) :
+
+  IF online 
+    THEN say (""3""5""10"")
+  FI ;
+  forget (sv space) ;
+  sv space := nilspace ;
+  sv msg := sv space ;
+  sv msg.tpass := password ;
+  supervisor call (family password code) ;
+  cover tracks .
+
+ENDPROC family password ;
+
+INT PROC dataspaces (TASK CONST task) :
+
+  INT VAR ds number, spaces := 0 ;
+  FOR ds number FROM lowest ds number UPTO highest ds number REP
+    IF pages (ds number, index (task)) >= 0
+      THEN spaces INCR 1
+    FI
+  PER ;
+  spaces
+
+ENDPROC dataspaces ;
+
+INT PROC dataspaces :
+  dataspaces (myself)
+ENDPROC dataspaces ;
+
+INT PROC pages (INT CONST ds number, INT CONST task no) :
+  EXTERNAL 88
+ENDPROC pages ;
+
+ENDPACKET tasks ;
+
diff --git a/system/multiuser/1.7.5/src/ur start b/system/multiuser/1.7.5/src/ur start
new file mode 100644
index 0000000..efbf8c1
--- /dev/null
+++ b/system/multiuser/1.7.5/src/ur start
@@ -0,0 +1,40 @@
+(* ------------------- VERSION 2     06.03.86 ------------------- *)
+PROC begin process (TASK CONST father, son, INT CONST priv, PROCA CONST start) :
+  EXTERNAL 95
+ENDPROC begin process ;
+
+PROC ur :
+  TASK VAR dummy ;
+  begin ("PUBLIC", PROC public manager, dummy) ;
+  global manager (PROC ur manager)
+ENDPROC ur ;
+
+PROC public manager :
+
+  page ;
+  REP UNTIL yes("Archiv 'help' eingelegt") PER;
+  archive ("help") ;
+  fetch ("help", archive) ;
+  release (archive) ;
+  free global manager
+
+ENDPROC public manager ;
+
+PROC ur manager (DATASPACE VAR ds, INT CONST order, phase,
+                 TASK CONST order task) :
+
+  LET begin code = 4 ;
+  enable stop ;
+  IF order = begin code
+    THEN std manager (ds, order, phase, order task)
+    ELSE errorstop ("falscher Auftrag fuer Task ""UR""")
+  FI
+
+ENDPROC ur manager ;
+ 
+check on ;
+command dialogue (TRUE) ;
+begin process (supervisor, task ("UR"), 0, proca (PROC ur)) ;
+command dialogue (FALSE) ;
+check off;
+
diff --git a/system/net/1.7.5/doc/EUMEL Netz b/system/net/1.7.5/doc/EUMEL Netz
new file mode 100644
index 0000000..ad39db3
--- /dev/null
+++ b/system/net/1.7.5/doc/EUMEL Netz
@@ -0,0 +1,832 @@
+#type ("trium8")##limit (11.0)# 

+#start(2.5,1.5)##pagelength (17.4)# 

+#block# 

+#headeven# 

+ 

+%                        EUMEL-Netzbeschreibung 

+ 

+ 

+#end# 

+#headodd# 

+ 

+#center#Inhalt#right#% 

+ 

+ 

+#end# 

+ 

+#type ("triumb12")# 

+1. Einleitung 

+ 

+ 

+Teil 1: Netz einrichten und benutzen 

+#type ("trium8")# 

+ 

+1. Benutzung des Netzes 

+ 

+2. Hardwarevoraussetzungen 

+ 

+3. Einrichten des Netzes 

+ 

+4. Informationsm�glichkeiten 

+ 

+5. Eingriffsm�glichkeiten 

+ 

+6. Fehlerbehebung im Netz 

+ 

+#type ("triumb12")# 

+ 

+Teil 2: Arbeitsweise der Netzsoftware 

+#type ("trium8")# 

+ 

+1. Die Netztask 

+ 

+2. Protokollebenen 

+ 

+3. Stand der Netzsoftware 

+ 

+#page# 

+#headodd# 

+ 

+#center#Einleitung#right#% 

+ 

+ 

+#end# 

+ 

+#type("triumb12")# 

+1. Einleitung #type("trium8")# 

+ 

+ 

+Das EUMEL-Netz dient dazu mehrere EUMEL-Rechner (sog. Stationen) mit-

+einander zu koppeln. Diese Kopplung wird von Betriebsystem dazu benutzt, das

+Sendungskonzept (siehe Systemhandbuch 1.7, Intertaskkommunikation) so auszu-

+dehnen, da� Tasks verschiedener Stationen einander Datenr�ume zusenden

+k�nnen. Auf dem Sendungskonzept aufbauende Konzepte nutzen daher automa-

+tisch das Netz aus: So ist es z.B. m�glich 

+ 

+- von einer Station aus auf einer anderen zu Drucken, 

+ 

+- in PUBLIC einer anderen Station Dateien zu sichern (save), vorausgesetzt, da�

+  PUBLIC dort ein free global manager ist, 

+ 

+- auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk

+  defekt ist oder ein anderes Format hat). 

+ 

+Das Netz kann ab EUMEL-Version 1.7.3 eingesetzt werden. 

+ 

+ 

+#type("triumb12")# 

+Teil 1: Netz einrichten und benutzen 

+ 

+1. Benutzung des Netzes #type("trium8")# 

+#headodd# 

+ 

+#center#Teil 1: Netz einrichten und benutzen#right#% 

+ 

+ 

+#end# 

+ 

+   Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur

+   Verf�gung: 

+ 

+ 

+1.1 

+ 

+   TASK OP / (INT CONST station, TEXT CONST taskname) 

+ 

+   liefert die Task #on("bold")#taskname#off("bold")# von der Station #on("bold")#station#off("bold")#. 

+ 

+   Wenn die Station #on("bold")#station#off("bold")# nicht am Netz ist oder nicht eingeschaltet ist, wird

+   solange gewartet, bis das der Fall ist. 

+ 

+   Fehlerf�lle: 

+ 

+     - task "..." gibt es nicht 

+ 

+       Die angeforderte Task gibt es in der Zielstation nicht. 

+ 

+     - Collectortask fehlt 

+ 

+       Das Kommando #on("bold")#define collector#off("bold")# wurde nicht gegeben (siehe 4.2). 

+ 

+     - Station x antwortet nicht 

+ 

+       Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. 

+       Hinweis: Dieser Fehler wird angenommen, wenn eine �berwachungszeit

+                von ca. 30 Sekunden verschrichen ist, ohne da� Station x die

+                Taskidentifikation angeliefert hat. 

+ 

+   Beispiel: 

+ 

+     list (5/"PUBLIC") 

+ 

+     Dateiliste von PUBLIC auf Station 5 wird angefordert. 

+ 

+1.2 

+ 

+   TASK OP / (INT CONST station, TASK CONST task) 

+ 

+   liefert 

+ 

+   station / name (task) . 

+ 

+ 

+   Beispiel: 

+ 

+     list (4/archive) 

+ 

+ 

+1.3 

+ 

+   INT PROC station (TASK CONST task) 

+ 

+   liefert die Stationsnummer der Task #on("bold")#task#off("bold")#. 

+ 

+   Beispiel: 

+ 

+     put (station (myself)) 

+ 

+     gibt die eigene Stationsnummer aus. 

+ 

+ 

+1.4 

+ 

+   PROC archive (TEXT CONST archivename, INT CONST station) 

+ 

+   dient dazu das Archiv auf der Station #on("bold")#station#off("bold")# anzumelden. 

+ 

+   Beispiel: 

+ 

+   archive ("std", 4); list (4/archive) 

+ 

+   gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. 

+   Hinweis: Vergessen Sie bei solchen Querarchivierungen nicht die Stations-

+            angabe bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")#

+            archive). 

+   Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Flop-

+            pyformate umsetzen wollen. 

+ 

+ 

+1.5 

+ 

+   PROC free global manager 

+ 

+   dient dazu, die eigene Task �ber das Netz ansprechbar zu machen. Jede

+   andere Task im Netz kann dann die �blichen Manageraufrufe ('save', 'fetch',

+   u.s.w.) an die eigene Task machen, sofern diese nicht an ein Terminal gekop-

+   pelt ist. 

+ 

+   Die Task wird (wie bei 'break') abgekoppelt und meldet sich in Zukunft mit

+   'maintenance' statt mit 'gib kommando'. 

+ 

+   Beispiel: 

+ 

+   An Station 4 ruft man in der Task 'hugo' das Kommando #on("bold")#free global manager#off("bold")#

+   auf. Anschlie�end kann man von jeder Station aus z.B. 'list (4/"hugo")' u.s.w.

+   machen. 

+ 

+ 

+1.6 

+ 

+  TEXT PROC name (TASK CONST t) 

+ 

+  Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, da� der

+  Name einer Task einer anderen Station �ber Netz angefordert wird. 

+ 

+  Fehlerfall: 

+ 

+  Station x antwortet nicht 

+ 

+ 

+ 

+ 

+#type("triumb12")#2. Hardwarevoraussetzungen#type("trium8")# 

+ 

+2.1 Zwei Stationen 

+ 

+      Sie k�nnen zwei Stationen miteinander Vernetzen, wenn Sie daf�r an jeder

+      Station eine V24-Schnittstelle zur Verf�gung stellen. 

+ 

+      Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur Rechner-

+      kopplung (siehe Systemhandbuch 1.7 Teil 2). 

+ 

+2.2 Mehrere Stationen 

+ 

+      Wenn Sie mehr als zwei Stationen vernetzen wollen, brauchen neben je

+      einer V24 an jeder Station noch je eine Netzanschlu�box. 

+ 

+      Jede Box besitzt eine V24-Schnittstelle zum Anschlu� an die V24-

+      Schnittstelle der zugeorneten Station und eine weitere Schnittstelle zur

+      Verbindung der Boxen untereinander. 

+ 

+ 

+#type("triumb12")#3. Einrichten des Netzes #type("trium8")# 

+ 

+Hinweis: Dieses Kapitel ist nur f�r Systembetreuer wichtig. 

+ 

+3.1 Legen Sie Stationsnummern f�r die am Netz beteiligten Rechner fest (von 1 an

+    aufsteigend). 

+ 

+    Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box

+    und des zugeordneten Rechners m�ssen �bereinstimmen. 

+ 

+ 

+3.2 Holen Sie an jeder Station die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie

+    das Kommando #on("bold")#define collector ("net port")#off("bold")#. Geben Sie au�erdem das

+    Kommando #on("bold")#define station (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gew�hlte Stationsnummer ist. 

+ 

+    Hinweis: Taskkommunikationen, die zu dem Zeitpunkt laufen, f�hren zu feh-

+             lerhaften Verhalten. Dies liegt daran, da� durch #on("bold")#define station#off("bold")# alle

+             Task-Id's ge�ndert werden m�ssen, weil eine Task-Id u.a. die

+             Stationsnummer der eigenen Station enth�lt (siehe 2.3). TASK-

+             Variable, die noch Task-Id's mit keiner oder falscher Stationsnum-

+             mer enthalten, k�nnen nicht mehr zum Ansprechen einer Task

+             verwendet werden. 

+ 

+    Beispiel: Der Spoolmanager (siehe Benutzerhandbuch 1.7 Teil 12) richtet

+              beim Kommando #on("bold")#start#off("bold")# einen Worker ein und merkt sich dessen

+              Task-Id in einer TASK-Variablen, um sicherzustellen, da� nur der

+              Worker Dateien zum Drucken abholt. Wird jetzt das Kommando #on("bold")#

+              define station#off("bold")# gegeben, kann der Spoolmanager seinen Worker

+              nicht mehr identifizieren, weil der Worker eine neue Task-Id er-

+              halten hat. Man mu� daher den Worker l�schen und mit dem

+              Kommando #on("bold")#start#off("bold")# im Spoolmanager wieder neu einrichten. 

+ 

+ 

+             Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nach den Laden eines

+             frischen Systems von Archiv. 

+ 

+    Konfigurieren Sie mit dem Kommando #on("bold")#configurate#off("bold")# den f�r das Netz vorgese-

+    henen Kanal auf 

+ 

+    - transparent 

+    - 9600 Baud (Standardeinstellung der Boxen) 

+    - RTS/CTS-Protokoll 

+    - gro�en Puffer 

+    - 8 bit 

+    - even parity 

+    - 1 stopbit. 

+ 

+    Falls diese Einstellungen nicht alle angeboten werden, kl�ren Sie mit Ihrem

+    Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden k�nnen. 

+    Hinweis: Notfalls kann auf das RTS/CTS-Protokoll verzichtet werden, wenn

+             der Eingabepuffer der Station gro� genug ist. Die Anzahl simultan

+             laufender Netzkommunikationen ist dann auf 

+ 

+             puffergr��e DIV 150 

+ 

+             begrenzt (bei Z80, 8086: 3; bei M20: 10). 

+   Hinweis: Es k�nnen auch andere Baudraten (2400, 4800, 19200) an der Box

+            eingestellt werden. 

+ 

+3.3 Achten Sie bei der Verbindung von der Station zur Netzbox (bzw. zur Gegen-

+    station bei einem Zweistationennetz ohne Boxen) darauf, da� neben den

+    Empfangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet

+    werden, also ein 5 poliges Kabel verwendet wird (siehe Systemhandbuch 1.7

+    Teil 2). Die Pin-Belegung der Boxen entspricht den dortigen Angaben. 

+ 

+    Beispiel: 

+ 

+    Verbindung eines CSK-Systems mit der Box: 

+ 

+    Stecker                  Stecker 

+    Pin                      Pin 

+ 

+    2  <--------->           3 

+    3  <--------->           2 

+    4  <--------->           5 

+    5  <--------->           4 

+    7  <--------->           7 

+ 

+ 

+3.4 Richten Sie eine Task #on("bold")#net#off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und insertieren Sie dort die Datei-

+en 

+ 

+    net report/M 

+    basic net 

+    net manager/M. 

+ 

+    Beantworten Sie die Frage nach dem Kanal f�r das Netz und nach der Flu�-

+    kontrolle (RTS/CTS). 

+ 

+ 

+#type("triumb12")#4. Informationsm�glichkeiten #type("trium8")# 

+ 

+   In der Task #on("bold")#net#off("bold")# wird eine Datei #on("bold")#report#off("bold")# gef�hrt in der Fehlersituationen des

+   Netzes verzeichnet werden. Diese Datei kann in jeder anderen Task mit #on("bold")#list

+   (/"net")#off("bold")# angezeigt werden. 

+ 

+   In jeder Task kann durch das Kommando #on("bold")#list (/"net port")#off("bold")# eine �bersicht �ber

+   die momentan laufenden Netz�bertragungen der eigenen Station erhalten

+   werden. 

+ 

+ 

+#type("triumb12")#5. Eingriffsm�glichkeiten #type("trium8")# 

+#headodd# 

+ 

+#center#Eingriffsm�glichkeiten#right#% 

+ 

+ 

+#end# 

+ 

+5.1 Jede Task kann Sende- und Empfangsstr�me, die bei #on("bold")#list (/"net port")#off("bold")# gemel-

+    det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das

+    Kommando #on("bold")#erase ("x",/"net port")#off ("bold")# zu geben, wobei x die Stromnummer (aus

+    dem 'list') ist. 

+ 

+    Unberechtigte L�schversuche werden abgewiesen. 

+ 

+    Von der Task 'net' aus k�nnen jedoch damit beliebige Str�me abgebrochen

+    werden. 

+ 

+5.2 Durch das Kommando #on("bold")#start#off("bold")# kann von der Task 'net' aus das Netz neu gestartet

+    werden. Dabei werden alle augenblicklichen Netzkommunikationen gel�scht.

+    Die Tasks 'net port' und 'net timer' werden dabei gel�scht und neu eingerich-

+    tet. 

+ 

+    #on("bold")#start (kanal, quit)#off("bold")# wirkt wie #on("bold")#start#off("bold")#. Zustzlich wird als Netzkanal 'kanal' eingestellt

+    und maximal 'quit' Empfangsstr�me zugelassen. 'quit' ist auf 3 zu setzen,

+    wenn der Kanal ohne RTS/CTS angeschlossen ist (siehe 3.2). 

+ 

+ 

+#type("triumb12")#6. Fehlersuche im Netz #type("trium8")# 

+ 

+   Fehler im Netz k�nnen sich verschiedenartig auswirken. Im Folgenden wird auf

+   einige Beispiele eingegangen: 

+ 

+   Beispiel: 

+ 

+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Station 4 antwortet nicht'. 

+ 

+   Fehlerm�glichkeiten: 

+ 

+   -  Station 4 gibt es nicht am Netz. 

+      Abhilfe: Richtige Station angeben. 

+ 

+   -  Station 4 ist nicht eingeschaltet. 

+      Abhilfe: Station 4 einschalten. Kommando erneut geben. 

+ 

+   -  Netztask an Station 4 ist nicht arbeitsf�hig. 

+      Abhilfe: Kommando 'start' in der Task 'net'. 

+ 

+   -  Stationsnummern und Boxnummern stimmen nicht �berein. 

+      Abhilfe: Mit 'define station' Stationsnummern korrigieren (siehe 3.2). 

+ 

+   -  Verbindung Rechner/Box am eigenen Rechner oder an Station 4 fehlt. 

+      Abhilfe: Verbindungen �berpr�fen. Durch Ansprechen einer dritten Station

+               kann oft schnell gekl�rt werden, welche Rechner/Box-Verbindung

+               defekt sein mu�. 

+ 

+   -  Verbindung der Boxen untereinander defekt. 

+      Abhilfe: Fehlende Verbindung, Masseschlu� und Dreher (keine 1:1 Ver-

+               bindung) �berpr�fen und beheben. 

+      Hinweis: Liegt z.B. ein Masseschlu� vor, so kann es durchaus sein, da�

+               Boxen, die nicht in der N�he des Masseschlu� stehen noch mitei-

+               nander arbeiten k�nnen. Man kann aus der Tatsache, da� zwei

+               Boxen miteinander arbeiten k�nnen, also nicht schlie�en, da� man

+               nicht nach diesem Fehler suchen mu�. 

+ 

+ 

+   Beispiel: 

+ 

+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. 

+ 

+ 

+   -  Station 4 ist w�hrend dieser Sendung zusammengebrochen. 

+      Abhilfe: Station 4 wieder starten. Die Bearbeitung des 'list'-Kommandos

+               wird automatisch wieder aufgenommen. 

+ 

+   -  PUBLIC auf Station 4 ist nicht im Managerzustand. 

+      Abhilfe: PUBLIC in den Managerzustand versetzen. 

+ 

+ 

+      Hinweis: Das Netz hat nocht nicht die volle Sendungslogik des EUMEL. So

+               wird nur ca. 10 Minuten lang versucht, eine Sendung zuzustellen.

+               Danach wird die Sendung gel�scht. Ist dies eingetreten, so mu�

+               das list-Kommando erneut gegeben werden. 

+ 

+   -  Fehler in der Netzhardware. 

+      �berpr�fen Sie, ob 

+ 

+      - die Boxen eingeschaltet sind, 

+      - die Bereitlampe blinkt (wenn nicht: RESET an der Box) 

+      - die V24-Kabel richtig stecken, 

+      - die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5

+        poligen Diodenbuchsen). 

+ 

+ 

+   -  Die Netzsoftware ist auf einen nicht vorhergesehenen Fehler gelaufen. 

+      Dieser wird im Report vermerkt. 

+      Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die

+               Netzsoftware neu gestartet. Alle Netzkommunikationen dieser

+               Station gehen verloren. 

+ 

+ 

+   Beispiel: 

+ 

+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Collectortask fehlt'. 

+ 

+   -  In der Task 'configurator' wurde das Kommando 'define collector' (siehe 3.2)

+      nicht gegeben. 

+ 

+   -  Die Task 'net port' existiert nicht mehr. 

+      Abhilfe: Kommando 'start' in der Task 'net'. 

+ 

+ 

+   Beispiel: 

+ 

+   Nach #on("bold")#fetch ("hugo",4/public)#off("bold")# sind Teile von der Datei "hugo" verf�lscht. 

+ 

+   -  Die V24-Verbindung zur Box ist nicht in Ordnung. 

+      Abhilfe: Abstand zwischen Rechner und Box verk�rzen; Baudrate ernie-

+               drigen; Durch Wechseln der V24-Schnittstelle feststellen, ob

+               diese defekt ist. 

+      Hinweis: Die Verbindung zwischen den Boxen ist durch Pr�fsummen abge-

+               sichert (Hardware). 

+ 

+#headodd# 

+ 

+#center#Teil 2: Arbeitsweise der Netzsoftware#right#% 

+ 

+ 

+#end# 

+#page# 

+#type("triumb12")# 

+ 

+Teil 2: Arbeitsweise der Netzsoftware 

+ 

+ 

+1. Die Netztask #type ("trium8")# 

+ 

+In diesem Kapitel wird beschrieben, wie eine Netztask in das System

+eingebettet ist und welche Aufgaben sie hat. Unter Einhaltung dieser

+Konzepte kann die ausgelieferte Netztask so ge�ndert werden, da� sie

+beliebige andere Netzhardware unterst�tzt. Z.Zt. ist die Netzsoftware noch

+nicht so gegliedert, da� nur eine hardwareabh�ngige Komponente ausgetauscht

+werden mu�. 

+ 

+Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem

+Rendevouskonzept: Die Zieltask einer Sendung mu� empfangsbereit sein, wenn die

+Quelltask sendet. 

+ 

+Die Kommunikationsprozeduren auf der niedrigsten Ebene sind 'send' (Senden)

+und 'wait' (Warten auf Empfang). Bei der Kommunikation werden eine Integer

+'code' und ein Datenraum 'dr' �bergeben. 'code' mu� >= 0 sein, da negative

+Codes systemintern verwandt werden. Ist die empfangende Task an einen Kanal

+gekoppelt ('continue'), so f�hrt eine Zeicheneingabe auf diesem Kanal dazu,

+da� eine

+Sendung mit dem Code -4 ankommt. Die Eingabedaten m�ssen mit den �blichen

+Eingabeprozeduren ('inchar' u.s.w.) abgeholt werden. Der �bermittelte Datenraum

+und die Absendertask sind dabei ohne Bedeutung und d�rfen nicht interpretiert

+werden. 

+ 

+Die Prozedur 'send' hat einen R�ckmeldeparameter, der besagt, ob die Sendung

+�bermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im 'wait', so kann

+die Sendung nicht �bermittelt werden. 

+ 

+ 

+Ein Entwicklungskriterium f�r das EUMEL-Netz war es, m�glichst wenig Unter-

+st�tzung von der virtuellen EUMEL-Maschine (EUMEL0) zu fordern, damit weit-

+gehend in ELAN programmiert werden kann. Dadurch ist es m�glich eine (privili-

+gierte) Task mit der Netzabwicklung zu betrauen. 

+ 

+Zun�chst wird auf die EUMEL0-Unterst�tzung eingegangen: 

+ 

+1.1. Es gibt die Prozedur 'define collector', mit der die f�r das Netz verantwort-

+     liche Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im

+     folgenden Collector genannt. 

+ 

+1.2. Es gibt die Prozedur 'define station', die f�r den Rechner eine Stationsnum-

+     mer einstellt. Anhand dieser Nummer werden die Rechner eines Netzes un-

+     terschieden. Das Einstellen bewirkt, da� f�r alle Tasks die Stationsnummer in

+     ihre Task-Id eingetragen wird (Task-Id's sind die Werte, die der Typ TASK

+     annehmen kann). 

+ 

+1.3. Der Befehl 'station (task)' liefert die Stationsnummer der 'task'. So liefert z.B.

+     'station (myself)' die Stationsnummer des eigenen Rechners. 

+ 

+1.4. Eine Sendung, deren Zieltask in einem anderen Rechner liegt (also station

+     (ziel) <> station (myself)), wird auf die Collectortask geleitet. 

+ 

+1.5. Es gibt eine Prozedur 'collected destination', die es dem Collector erlaubt, die

+     eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. 

+ 

+1.6. Es gibt eine Variante der Prozedur 'send', die es dem Collector gestattet, der

+     Zieltask eine beliebige andere Task als Absender vorzumachen. 

+ 

+1.7. Es gibt eine spezielle Task-Id 'collector', durch die der augenblicklich ein-

+     gestellte Collector erreicht wird. Diese wird als Zieltask beim Aufruf der Ver-

+     mittlungsdienste angegeben (siehe 2.5). Eine Sendung an 'collector' wird von

+     EUMEL0 an den derzeitigen Collector geschickt. 

+ 

+Ein Collector kann also auf drei Wegen von den �brigen Tasks desselben Rechners

+Sendungen erhalten: 

+ 

+  1. �ber ein normales Send (z.B. bei 'list (/"net port")', wenn "net port" der der-

+     zeitige Collector ist), 

+ 

+  2. �ber ein Send an die Task 'collector' (s.u.) und 

+ 

+  3. als umgeleitete Sendung (z.B. bei 'list' an eine Task auf einem anderen

+     Rechner). 

+ 

+Der Collector kann diese F�lle anhand von 'collected destination' unterscheiden. 

+ 

+Die Punkte 1.4...1.6 dienen dazu, den Collector f�r �ber Netz kommunizierende

+Task unsichtbar zu machen: Der Collector taucht nicht als Ziel oder Quelle von

+Sendungen auf. Das ist notwendig, damit normale Tasks sich nicht darum k�mmern

+m�ssen, ob eine Sendung �bers Netz geht oder im eigenen Rechner bleibt. 

+ 

+Wenn ein Datenraum an einen anderen Rechner geschickt wird, mu� der gesamte

+Inhalt (z. Zt. max. 1 MB) �bertragen werden. Dies macht bei der �blichen Netz-

+hardware eine Zerlegung in Packete n�tig (siehe Systemhandbuch 173, Teil 4,

+Punkt 5). F�r Netze �ber V24-Kan�le stehen spezielle Blockbefehle zur verf�-

+gung: 

+ 

+1.8. blockin / blockout (dr,seite,512+abstand,anzahl,rest) 

+ 

+   Es werden maximal 'anzahl' Bytes transferiert. In 'rest' wird zur�ckgemeldet,

+   wieviel Bytes nicht bearbeitet wurden (z.B. weil der Kanal nichts anliefert).

+   Bearbeitet werden die Bytes 

+ 

+      'seite' * 512 + 'abstand' 

+ 

+   bis maximal 

+ 

+      'seite' * 512 + 'abstand' + 'anzahl' - 1 

+ 

+  Der Kanal, an den die Task gekoppelt ist, wird dabei �ber Stream-IO (d.h.

+  'incharety' bei 'blockin' bzw. 'out' bei 'blockout') angesprochen. 

+ 

+  Hinweis: Die Anforderung darf nicht �ber Seitengrenze gehen, d.h. 

+ 

+  'abstand' + 'anzahl' <= 512 

+ 

+  mu� erf�llt sein. 

+ 

+ 

+Eine Netzsendung l�uft wie folgt ab: 

+ 

+Die Task q auf Rechner rq mache ein 'send' an die Task z auf Rechner rz. 

+ 

+1. Die Prozedur send ist ein EUMEL0-Befehl. Die EUMEL0-Ebene erkennt, da�

+   die Sendung an die Station rz geht, da die Stationsnummer in der Task-Id

+   enthalten ist. Daher wird die Sendung zum Collector, den EUMEL0 wegen 'de-

+   fine collector' kennt, umgeleitet. 

+ 

+2. Die Task Collector empf�ngt �ber 'wait' den Datenraum, den Sendecode und

+   die Absendertask q. Die Zieltask z erf�hrt sie durch 'collected destination'. 

+ 

+3. Der Collector nimmt Kontakt mit dem Collector des Rechner rz, dessen Sta-

+   tionsnummer ja 'station(z)' ist, auf und �bermittelt diesem Sendecode, Quelltask

+   (q), eigentliche Zieltask (z) und den Datenraum. Da die Collectoren in ELAN

+   geschrieben sind, k�nnen sie an beliebige Netzhardware und Protokolle ange-

+   pa�t werden. 

+ 

+4. Der Collector auf Rechner rz verwendet das spezielle 'send', um der Zieltask die

+   Sendung zuzustellen. Dadurch erscheint nicht der Collector sondern die Task q

+   als Absender der Sendung. 

+ 

+Zur Abwicklung der Vermittlungsebene (Teil 1: 2.4) mu� der Collector noch

+spezielle Funktionen beherrschen. Diese sind 

+ 

+   der /-Operator (Taskname in Task-Id wandeln) und 

+   die name-Prozedur (Task-Id in Namen wandeln). 

+ 

+Der /-Operator macht eine Sendung an den 'collector', wobei im Datenraum der

+Name der Task steht und der Sendecode gleich der Stationsnummer ist (siehe

+Quellcode 173, Packet tasks). Der Collector setzt sich mit dem Collector dieser Sta-

+tion in Verbindung, damit dieser die Task-Id ermittelt und zur�ckschickt. Der

+eigene Collector schickt dann dem /-Operator als Antwort einen Datenraum, der

+die Task-Id enth�lt. 

+ 

+Umgekehrt l�uft 'name' ab: Wenn die Task-Id von einer fremden Station ist,

+schickt 'name' eine Sendung an den 'collector', wobei im Datenraum die Task-Id

+steht und Sendecode = 256 ist. Der Collector entnimmt die Stationnummer der

+Task aus der Task-Id und l��t sich vom entsprechenden Collector den Tasknamen

+geben. Dieser wird der 'name'-Prozedur im Antwortdatenraum �bergeben. 

+ 

+#type ("triumb12")#2. Ebenen #type("trium8")# 

+ 

+In diesem Kapitel werden die Protokollebenen f�r das Netz beschrieben, wie

+sie die ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer

+Netzhardware m�ssen die Ebenen 1 bis 3 ausgetauscht werden. Unter Einhaltung

+der im vorigen Kapitel beschriebenen Randbedingungen k�nnen auch die h�heren

+Ebenen ge�ndert werden. 

+ 

+ 

+2.1 Physikalische Ebene 

+ 

+    2.1.1  Station <--> Box 

+ 

+           V24-Schnittstelle mit RTS/CTS-Handshake. Vollduplex. 

+ 

+    2.1.2  Box <--> Box 

+ 

+           RS422 �ber 2 verdrillte Leitungspaare (Takt und Daten). 

+ 

+2.2 Verbindungsebene 

+ 

+    2.2.1  Station <--> Box 

+ 

+           Asynchron 

+           8 Bit 

+           Even Parity 

+           2400/4800/9600/19200 Baud (einstellbar �ber L�tbr�cken) 

+ 

+    2.2.2  Box <--> Box 

+ 

+           SDLC 

+           400 KBaud 

+ 

+2.3 Netzebene 

+ 

+    2.3.1  Station <--> Box 

+ 

+           Telegrammformat:  STX, <n>, <ziel>, <quelle>, <(n-4) byte> 

+ 

+           <n> ist L�ngenangabe ( 8 <= n <= 160) 

+           <ziel>, <quelle> sind Stationsnummern. Diese m�ssen an den je-

+           weiligen Boxen �ber L�tbr�cken eingestellt sein. 

+ 

+           Box --> Station: 

+ 

+           Ein Telegramm kommt nur bei der Station an, bei deren Box die

+           Nummer <ziel> eingestellt ist. Dadurch ist ein Mith�ren fremder

+           �bertragungen nicht m�glich (Datenschutz). 

+ 

+           Zwischen Telegrammen k�nnen Fehlermeldungen der Box (Klartext)

+           �bermittelt werden (z.B. 'skipped x', wenn ein STX von der Box er-

+           wartet wurde, aber 'x' von der Station ankommt). 

+ 

+           Station --> Box: 

+ 

+           Ein Telegramm wird nur abgeschickt, wenn <quelle> mit der einge-

+           stellten Nummer �bereinstimmt (Datenschutz: Man kann nicht eine

+           beliebige Station zu sein vorschwindeln, es sei denn man hat physi-

+           schen Zugriff zur Box und stellt dort die Stationsnummer um). 

+ 

+    2.3.2  Box <--> Box 

+ 

+           Telegrammformat: FRAME, <ziel>, <quelle>, <daten> ,

+           <CRC-Code> 

+ 

+           Eine L�ngenangabe ist nicht n�tig, da SDLC eine Rekonstruktion der

+           L�nge erlaubt. 

+ 

+           Telegramme mit falschen CRC-Code werden vernichtet. Auf h�heren

+           Ebenen mu� dies durch Zeit�berwachung erkannt und behandelt

+           werden. 

+ 

+ 

+2.4 Transportebene 

+ 

+    Diese Ebene wickelt das Rendevous zwischen einer Task, die 'send' macht,

+    und einer Task, die im 'wait' steht, ab (siehe: EUMEL-Systemhandbuch). 

+ 

+    Der im 'send' angegebene Datenraum wird als Folge von Seiten (im

+    EUMEL-Sinne: Pagingeinheit und Allokiereinheit) �bermittelt, wobei jede Seite

+    noch in 64 Byte gro�e St�cke zerlegt wird. Es werden nur echt allokierte Seiten

+    �bermittelt. Um nicht jedes Telegramm voll qualifizieren zu m�ssen, wird

+    zun�chst eine Art virtuelle Verbindung durch ein OPEN-Telegramm er�ffnet.

+    Danach folgen variable viele DATA-Telegramme. Beide Sorten werden durch

+    QUIT-Telegramme quittiert, um folgende Funktionen zu erm�glichen: 

+ 

+    Flu�kontrolle (z.B. Zielrechner langsam) 

+    Wiederaufsetzen (verlorene Telegramme) 

+    Abbruch (z.B. weil Zieltask inzwischen beendet). 

+ 

+    Ein CLOSE-Telegramm ist nicht n�tig, da das letzte DATA-Telegramm als

+    solches erkannt werden kann (siehe unten). 

+ 

+    2.4.1 OPEN-Telegramm 

+ 

+          STX, 20, <ziel>, <quelle>, <strom>, <sequenz>, <seite>, 

+          <quelltask>, <zieltask>, <code> 

+ 

+          <ziel>, <quelle> siehe 2.3.1 

+ 

+          <strom>      Die Stromnummer identifiziert die virtuelle Verbindung.

+                       Sie mu� in den QUIT-Telegrammen angegeben wer-

+                       den. 

+ 

+          <sequenz>    -1 (Kennzeichen f�r OPEN) 

+ 

+          <seite>      Nummer der ersten echt allokierten Seite des Datenra-

+                       ums (=-1, falls Nilspace) 

+ 

+          <quelltask>  Taskid der sendenden Task 

+ 

+          <zieltask>   Taskid der empfangenden Task 

+ 

+          <code>       Wert des im 'send' angegebenen Codes. 

+ 

+    2.4.2 DATA-Telegramm 

+ 

+          STX, 74, <ziel>, <quelle>, <sequenz>, <seite>, <64 byte> 

+ 

+          <sequenz>    wird von Telegramm zu Telegramm hochgez�hlt. Dient

+                       der �berwachung gegen verlorengegangene Telegramme

+                       bzw. durch Zeit�berwachung verdoppelter Telegramme. 

+ 

+          <seite>      Nummer der x.ten echt allokierten Seite des Datenra-

+                       ums. (x = (<sequenz>+16) DIV 8). 

+ 

+          <64 byte>    Nutzinformation. Diese geh�rt zur Adresse a des Daten-

+                       raums. 

+ 

+                       a = N (<sequenz> DIV 8 + 1) * 512 

+                           + (<sequenz> MOD 8) * 64 

+ 

+                       wobei N (x) die Nummer der x.ten Seite ist. 

+ 

+                       Aus den Formeln ergibt sich, da� diese Nummer schon in

+                       einem vorhergehenden DATA/OPEN-Telegramm �ber-

+                       mittelt wurde (im Feld <seite>). 

+ 

+    2.4.3 QUIT-Telegramm 

+ 

+          STX, 8, <ziel>, <quelle>, <strom>, <quit> 

+ 

+          <strom>      mu� die Stromnummer sein, die in dem OPEN/DATA-

+                       Telegramm stand, das quittiert wird. 

+ 

+          <quit>       0 :  ok. N�chstes Telegramm schicken. 

+ 

+                       -1:  �bertragung neu starten (mit OPEN), weil die

+                            Empfangsstation das OPEN nicht erhalten hat. 

+ 

+                       -2:  �bertragung ca. 20 Telegramme zur�cksetzen. 

+ 

+                       -3:  �bertragung abbrechen. 

+ 

+ 

+2.5 Vermittlungsebene 

+ 

+    Diese Ebene ist daf�r zust�ndig, Tasknamen von Task auf anderen Stationen

+    in Taskids (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im

+    entsprechenden OPEN-Telegramm der Code -6 (bzw. -7) als <code>

+    eingetragen. Die Netzempfangstask erkennt diese Codes und wickelt die

+    Aufgaben selbst ab, soda� es dabei nicht n�tig ist, irgendeine Taskid der

+    Zielstation zu kennen. 

+ 

+    Dieses Verfahren ist m�glich, weil im 'send' nur positive Codes erlaubt sind. 

+ 

+2.6 H�here Ebenen 

+ 

+    H�here Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem

+    Send/Wait-Konzept des EUMEL. So gibt es z.B. den 'global manager', der

+    Aufbewahrung und Zugriff von Dateien in einer Task regelt. Dabei darf diese

+    Task (bei der Variante 'free global manager') auf einer beliebigen Station im

+    Netz liegen. Wegen des Rendevous-Konzepts k�nnen beliebige Sicherheit-

+    strategien benutzt werden (z.B.: Keine Dateien an Station 11 ausliefern). Von

+    gro�en Wert ist z.B., da� man ohne weiteres das Archiv (Floppylaufwerk) einen

+    anderen Station anmelden und benuzten kann, wodurch eine einfache Kon-

+    vertierung von Floppyformaten m�glich ist. Dies ist m�glich, weil auch die Ar-

+    chiv-Task der Stationen sich an das Globalmanagerprotokoll halten. 

+ 

+ 

+#type("triumb12")# 

+Bemerkungen#type("trium8")# 

+ 

+Fehlerbehandlung besteht bis Ebene 3 darin, fehlerhafte Telegramme einfach zu

+entfernen. Die Ebene 4 �berwacht den Netzverkehr sowieso �ber Timeouts, die

+eine Wiederhohlung eines Telegrammes bewirken, wenn die Quittung ausbleibt. 

+ 

+Da bei der sendenden Station der ganze Datenraum zur Verf�gung steht, ist eine

+Fenstertechnik (wie bei HDLC) nicht n�tig. Es kann zu jedem Zeitpunkt um beliebig

+viele Telegramme zur�ckgesetzt werden. 

+ 

+Da im EUMEL eine Textdatei ein Datenraum mit sehr komplexer Struktur ist (wegen

+der Insert/Delete-M�glichkeiten, ohne den Rest der Datei zu schieben), ist es ein

+hoher Aufwand, von einem fremden Betriebssytem her Textdateien ins EUMEL-

+Netz zu senden. F�r solche Zwecke mu� noch eine einfachere Dateistruktur defi-

+niert werden und entsprechende Dateikonverter erstellt werden. 

+ 

+ 

+ 

+#type("triumb12")#3. Stand der Netzsoftware #type("trium8")# 

+ 

+Das EUMEL-System wickelt die Prozedur #on("bold")#send#off("bold")# �ber das Netz ab, wenn die

+Stationsnummer der Zieltask ungleich der eigenen Stationsnummer ist. Umge-

+kehrt kann man der von der Prozedur #on("bold")#wait#off("bold")# gelieferten Absendertask die Absen-

+derstation entnehmen (siehe Prozedur #on("bold")#station#off("bold")# in Abschnitt 3). 

+ 

+Nicht unterst�tzt wird z.Zt. die Logik der Prozeduren #on("bold")#call#off("bold")# und #on("bold")#pingpong#off("bold")#. Diese

+funktionieren nur in der gewohnten Weise, wenn die Zieltask in #on("bold")#wait#off("bold")# steht. Ist

+die Zieltask l�nger als ca. 10 Minuten #on("bold")#busy#off("bold")# oder nicht mehr vorhanden, geht die

+Sendung einfach verloren (Gefordert ist: bei #on("bold")#call#off("bold")#: immer wieder versuchen; bei #on("bold")#

+pingpong#off("bold")#: R�ckmeldung -2). 

+ 

+Wegen dieser Einschr�nkung kann man z.B. ein sicheres Drucken von Station a

+auf einen Drucker der Station b nur durch einen eigenen Spoolmanager auf

+Station a verwirklichen. Die Einrichtung eines solchen Managers ist allerdings

+sowieso sinnvoll, damit man 

+ 

+- das normale 'print'-Kommando verwenden kann (statt z.B. save ("xxx",

+4/printer);) und 

+- nicht zu warten braucht, bis die Datei �bers Netz gesendet ist. 

+ 

+ 

+ 

+ 

+ 

diff --git a/system/net/1.7.5/src/basic net b/system/net/1.7.5/src/basic net
new file mode 100644
index 0000000..88b41e5
--- /dev/null
+++ b/system/net/1.7.5/src/basic net
@@ -0,0 +1,840 @@
+PACKET basic net DEFINES                          (* D. Heinrichs *)

+                                                  (* 02.10.85     *)

+  nam,

+  max verbindungsnummer,

+  neuer start,

+  packet eingang,

+  neue sendung,

+  zeitueberwachung,

+  verbindung,

+  loesche verbindung:

+

+TEXT PROC nam (TASK CONST t):

+  IF t = collector THEN name (t)

+  ELIF station (t) <> station (myself) 

+  THEN "** fremd **"

+  ELSE name (t)

+  FI

+END PROC nam;

+

+INT PROC tasknr (TASK CONST t):

+  IF t = collector THEN maxtasks

+  ELSE index (t)

+  FI

+END PROC tasknr;

+

+LET

+    maxtasks = 127,

+    max strom = 20,

+    max strom 1 = 21,

+    stx = ""2"",

+    code stx = 2, 

+    ack = 0,

+    nak = 1,

+    error nak = 2,

+    zeichen eingang = 4,

+    list code = 15,

+    fetch code = 11,

+    inspect code = 30,

+    continue code = 100,

+    erase code = 14,

+    report code = 99,

+    seiten groesse = 512,

+    dr verwaltungslaenge = 8,

+    dr verwaltungslaenge2=10,

+    nutzlaenge = 64,

+    openlaenge = 20,

+    vorspannlaenge = 10, 

+    neue ack laenge = 10, 

+    ack laenge = 8,

+

+    (* Typen von Kommunikationsströmen *)

+

+    send wait = 0,

+    zustellung = 1,

+    call pingpong = 2,

+    call im wait = 3,

+    call im abbruch = 4,

+    call in zustellung = 5,

+

+    (*quittungscodes*)

+

+    ok = 0,

+    von vorne = 1,

+    wiederhole = 2,

+    loesche = 3,

+    beende = 4;

+

+LET STEUER =

+      STRUCT ( 

+      INT  head, 

+           rechner nummern, 

+           strom,

+           sequenz,

+           seitennummer,

+      TASK quelle,ziel,

+      INT  sende code);

+ 

+BOUND STEUER VAR open block;

+

+BOUND STRUCT (STEUER steuer, INT typ) VAR info block; 

+ 

+BOUND STRUCT (

+      INT  head, 

+           rechner nummern, 

+           strom,

+           sequenz,

+           seitennummer) VAR vorspann ;

+ 

+BOUND STRUCT ( 

+      INT  head, 

+           rechner nummern, 

+           strom, 

+           code) VAR ack packet ; 

+ 

+INT CONST max verbindungsnummer := max strom;

+

+BOOL PROC blockin (DATASPACE VAR ds, INT CONST seite, abstand, laenge): 

+ INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512;

+ REAL VAR time out := clock (1) + 10.0;

+ REP 

+   blockin (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); 

+ UNTIL hilfslaenge = 0 OR clock (1) > time out PER  ;

+ hilfslaenge = 0

+END PROC blockin; 

+

+PROC blockout (DATASPACE CONST ds, INT CONST seite, abstand, laenge): 

+ INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512; 

+ REP 

+   blockout (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); 

+ UNTIL hilfslaenge = 0 PER 

+END PROC blockout; 

+ 

+ 

+ 

+ 

+DATASPACE VAR work space;

+ 

+ 

+INT CONST packete pro seite:= seitengroesse DIV nutzlaenge, 

+          packete pro seite minus 1 := packete pro seite -1,

+          datenpacketlaenge := vorspannlaenge + nutzlaenge;

+ 

+INT VAR err,strom; 

+ 

+INT VAR   own:=station (myself) ,

+          quit max := 3,

+          quit zaehler := 3,

+          own256 := 256*own;

+INT CONST stx open := code stx+256*openlaenge,

+          stx quit := code stx+256*acklaenge;

+

+  ROW maxstrom1 STEUER VAR verbindungen; 

+  ROW maxstrom1 DATASPACE VAR netz dr; 

+  ROW maxstrom1 INT VAR zeit, typ;

+  FOR strom FROM 1 UPTO maxstrom1 REP vdr := nilspace; forget (vdr) PER;

+  ROW maxstrom INT VAR dr page ;

+  ROW maxtasks INT VAR alter call;

+  STEUER VAR opti;

+ 

+.vx : verbindungen (strom). 

+ 

+vdr: netz dr (strom). 

+ 

+falsche stromnummer: strom < 1 OR strom > maxstrom.

+

+call aufruf: typ(strom) >= call pingpong.

+

+alles raus: vx.seitennummer = -1 AND letztes packet der seite . 

+

+letztes packet der seite :

+(vx.sequenz AND packete pro seite minus 1) = packete pro seite minus 1.

+

+PROC neuer start (INT CONST empfangsstroeme):

+  workspace := nilspace;

+  open block := workspace; 

+  info block := workspace;

+  vorspann := workspace; 

+  ack packet := workspace;

+  FOR strom FROM 1 UPTO maxstrom1 REP 

+  vx.strom := 0;  forget (vdr)

+  PER; 

+  INT VAR i;

+  FOR i FROM 1 UPTO maxtasks REP alter call (i) := 0 PER;

+  quitmax := empfangsstroeme;

+  own:=station (myself);

+  quit zaehler := quit max;

+  own256 := 256*own; 

+  reset box.

+

+reset box: 

+  out (90*""4""); 

+  REP UNTIL incharety (1) = "" PER. 

+ 

+END PROC neuer start;

+

+DATASPACE PROC verbindung (INT CONST nr):

+  infoblock.steuer := verbindungen (nr);

+  infoblock.typ := typ (nr);

+  workspace

+END PROC verbindung;

+

+PROC neue sendung (TASK CONST q,z, INT CONST cod, DATASPACE CONST dr):

+

+  naechste verbindung vorbereiten;

+  forget (vdr); vdr := dr;

+  IF z = collector 

+  THEN 

+    verbindungsebene 

+  ELSE 

+    sendung starten (q,z,cod)

+  FI.

+

+verbindungsebene: 

+  IF cod = 256 THEN name von fremdstation

+  ELIF cod > 256

+  THEN

+    taskinfo fremd 

+  ELSE

+    task id von fremd

+  FI.

+

+taskinfo fremd: sendung starten (q, collector, cod-256, -8).

+

+task id von fremd: sendung starten (q,collector, zielstation,-6) .

+

+name von fremdstation:

+  BOUND TASK VAR tsk := vdr;

+  TASK VAR tsk1 := tsk;

+  forget (vdr);

+  vdr := nilspace;

+  sendung starten (q, tsk1, -7).

+

+zielstation: cod.

+

+END PROC neue sendung; 

+

+PROC zeitueberwachung

+     (INT VAR snr, TASK VAR  q, z, INT VAR ant,DATASPACE VAR  dr):

+  snr INCR 1;

+  FOR strom FROM snr UPTO maxstrom REP zeitkontrolle PER;

+  snr := 0. 

+

+zeitkontrolle: 

+  IF vx.strom <> 0 AND zeit(strom) > 0

+  THEN 

+    zeit(strom) DECR 1; 

+    IF sendung noch nicht zugestellt

+    THEN 

+      IF zeit(strom) = 0 THEN 

+         report ("Nicht zustellbar. """+nam (vx.ziel)+""". "+

+         text (vx.rechnernummernDIV256)); 

+         loesche verbindung (strom)

+      ELSE

+         snr := strom;

+         q := vx.quelle;

+         z := vx.ziel;

+         ant := vx.sendecode;

+         dr := vdr;

+         LEAVE zeitueberwachung

+      FI

+    ELIF zeit(strom) = 0 THEN wiederholen FI 

+  FI. 

+ 

+sendung noch nicht zugestellt:

+  typ (strom) = zustellung.

+

+wiederholen: 

+  IF sendeeintrag 

+  THEN 

+    sendung wiederholen

+  ELSE

+    empfangseintrag freigeben

+  FI. 

+ 

+sendeeintrag : vx.rechnernummern DIV 256 = own . 

+ 

+sendung wiederholen:

+  IF wiederholung noch sinnvoll 

+  THEN

+    IF frisch 

+    THEN 

+      time out bei open

+    ELSE 

+      datenteil wiederholen 

+    FI

+  ELSE

+    sendung loeschen

+  FI.

+

+wiederholung noch sinnvoll:

+  task noch da AND bei call noch im call.

+

+task noch da: vx.quelle = collector OR exists (vx.quelle).

+

+bei call noch im call: 

+  IF call aufruf

+  THEN

+    callee (vx.quelle) = vx.ziel

+  ELSE

+    TRUE

+  FI.

+

+frisch: vx.sequenz = -1. 

+ 

+time out bei open:

+  IF vx.sendecode > -4 THEN open wiederholen ELSE nak an quelle senden FI.

+

+nak an quelle senden:

+  forget (vdr); vdr := nilspace;

+  BOUND TEXT VAR erm := vdr;

+  erm := "Station "+text(vx.rechnernummernMOD256)+" antwortet nicht";

+  snr := strom;

+  q := collector;

+  z := vx.quelle;

+  ant := error nak;

+  dr := vdr;

+  sendung loeschen;

+  LEAVE zeitueberwachung .

+

+open wiederholen: 

+  sendereport ("wdh open"); 

+  zeit(strom) := 20;

+  openblock := vx; 

+  openblock.head := stx open; 

+  ab die post. 

+ 

+datenteil wiederholen: 

+  sendereport ("wdh data. sqnr "+text (vx.sequenz));

+  senden .

+

+empfangseintrag freigeben:

+  IF antwort auf call 

+  THEN

+    weiter warten

+  ELSE

+    empfangsreport ("Empfangseintrag freigegeben");

+    empfang loeschen

+  FI.

+antwort auf call: callee (vx.ziel) = vx.quelle.

+

+weiter warten: zeit (strom) := 200.

+

+END PROC zeitueberwachung;

+

+PROC sendereport (TEXT CONST txt):

+  report (text (strom)+":"+txt+". Absender: """+nam (vx.quelle)+

+          """. Ziel "+text(vx.rechnernummernMOD256)); 

+END PROC sendereport;

+

+PROC empfangsreport  (TEXT CONST txt):

+  report (text (strom)+":"+txt+". Empfänger: """

+          +nam (vx.ziel)+""". Quelle "+text (vx.rechnernummernDIV256));

+END PROC empfangsreport  ;

+

+PROC sendung loeschen:

+    IF callaufruf CAND alter call (tasknr (vx.quelle)) = strom

+    THEN

+       alter call (tasknr (vx.quelle)) := 0

+    FI;

+    vx.strom := 0;

+    forget (vdr)

+END PROC sendung loeschen;

+

+PROC empfang loeschen:

+    quit zaehler INCR 1;

+    IF callaufruf AND alter call (tasknr (vx.ziel)) = strom

+    THEN

+       alter call (tasknr (vx.ziel)) := 0

+    FI; 

+    forget (vdr);

+    vx.strom := 0

+END PROC empfang loeschen;

+

+PROC loesche verbindung (INT CONST nr):

+  strom := nr;

+  IF sendeeintrag

+  THEN

+    sendung loeschen

+  ELSE

+    gegenstelle zum loeschen auffordern; 

+    empfang loeschen

+  FI.

+

+gegenstelle zum loeschen auffordern:

+  IF verbindung aktiv THEN quittieren (-loesche) FI.

+

+verbindung aktiv: vx.strom > 0.

+

+sendeeintrag: vx.rechnernummern DIV 256 = own . 

+

+END PROC loesche verbindung;

+

+PROC weiter senden: 

+  IF NOT alles raus

+  THEN

+    sequenz zaehlung; 

+    IF neue seite THEN seitennummer eintragen FI;

+    senden

+  FI.

+

+sequenz zaehlung: 

+  vx.sequenz INCR 1. 

+ 

+neue seite: 

+  (vx.sequenz AND packete pro seite minus 1) = 0. 

+

+seitennummer eintragen: 

+  dr page (strom) :=  vx.seiten nummer;

+  vx.seitennummer := next ds page (vdr, dr page (strom)). 

+ 

+ 

+END PROC weiter senden;

+ 

+PROC senden:

+  zeit(strom) := 3;

+  vorspann senden;

+  daten senden.

+

+vorspann senden: 

+  openblock := vx; 

+  blockout (workspace, 1, dr verwaltungslaenge, vorspannlaenge). 

+ 

+daten senden: 

+  blockout (vdr,dr page (strom),distanz,nutzlaenge). 

+ 

+distanz: nutzlaenge* (vx.sequenz AND (packete pro seite minus 1)). 

+

+END PROC senden;

+

+PROC naechste verbindung vorbereiten: 

+  FOR strom FROM 1 UPTO maxstrom REP 

+  UNTIL vx.strom = 0 PER; 

+  IF vx.strom <> 0 THEN errorstop ("Verbindungsengpass") FI. 

+END PROC naechste verbindung vorbereiten;

+

+PROC sendung starten (TASK CONST quelle, ziel, INT CONST code): 

+  sendung starten (quelle,ziel, station(ziel), code) 

+END PROC sendung starten;

+ 

+PROC sendung starten (TASK CONST quelle, ziel, INT CONST ziel station,code):

+  IF ziel station = own 

+  THEN

+    report ("Irrläufer: Sendung an eigene Station. Absender:"""+

+            nam (quelle)+""".");

+    vx.strom := 0;

+    forget (vdr)

+  ELSE

+    openblock.ziel := ziel;

+    openblock.quelle :=quelle; 

+    openblock.sendecode := code;

+    openblock.rechnernummern:= ziel station + own256; 

+    alten call loeschen (quelle);

+    IF call oder ping pong

+    THEN typ (strom) := call pingpong; call merken

+    ELSE typ (strom) := send wait FI;

+    sendung neu starten

+  FI.

+

+call oder pingpong: openblock.ziel = callee (openblock.quelle).

+

+call merken: alter call (tasknr (quelle)) := strom.

+

+END PROC sendung starten;

+

+PROC sendung neu starten:

+  openblock.head:= stx open; 

+  openblock.sequenz := -1; 

+  openblock.seitennummer:= next ds page (vdr,-1); 

+  openblock.strom := strom;

+  vx := open block; 

+  zeit(strom) := 3;

+  ab die post;

+  vx.head:=code stx+256*(vorspannlaenge+nutzlaenge). 

+ 

+END PROC sendung neu starten; .

+

+ab die post: 

+  block out (work space,1, dr verwaltungslaenge,open laenge).

+ 

+PROC alten call loeschen (TASK CONST quelle):

+  IF alter call aktiv

+  THEN

+    INT VAR lstrom := strom;

+    vx:=openblock;

+    strom := alter call (tasknr (quelle));

+    IF in ausfuehrungsphase

+    THEN

+      sendereport ("Call-Löschung vorgemerkt");

+      loeschung vormerken

+    ELSE

+      report ("Call gelöscht."""+nam(quelle)+""". Strom "+text(strom));

+      loesche verbindung (strom)

+    FI;

+    strom := lstrom;

+    openblock := vx

+  FI.

+

+in ausfuehrungsphase:

+  typ(strom) = call im wait OR typ (strom) = call in zustellung.

+

+loeschung vormerken:

+  typ(strom) := call im abbruch;

+  alter call (tasknr (quelle)) := 0.

+

+ 

+  alter call aktiv:

+    alter call (tasknr (quelle)) > 0.

+

+END PROC alten call loeschen;

+

+PROC packet eingang

+  (TEXT CONST ft, INT VAR snr, TASK VAR  q, z, INT VAR ant,DATASPACE VAR  dr):

+    snr := 0;

+    vorspann holen; 

+    IF NOT ring logik THEN daten teil FI.

+

+ring logik: FALSE.

+# IF selbst quelle THEN daten aus puffer entfernen ; TRUE

+  ELIF NOT selbst ziel THEN weitergeben; TRUE 

+  ELSE FALSE

+  FI.

+

+selbst quelle: openblock.rechnernummern DIV 256 = station (myself).

+

+selbst ziel:   (openblock.rechnernummern AND 255) = own.

+#

+daten aus puffer entfernen:

+  IF code (t) > nutzlaenge 

+  THEN

+    BOOL VAR dummy :=blockin (workspace, 1, drverwaltungslaenge, nutzlaenge) 

+  FI.

+#

+weitergeben:

+  IF code (t) > nutzlaenge

+  THEN 

+    IF NOT  blockin (workspace, 2, 0, nutzlaenge) 

+    THEN LEAVE test auf packeteingang FI;

+  FI;

+  out (stx+t);

+  blockout (workspace, 1, drverwaltungslaenge2, blocklaenge);

+  IF code (t) > nutzlaenge

+  THEN

+    blockout (workspace, 2, 0, nutzlaenge)

+  FI.

+#

+vorspann holen: 

+  sync; 

+  IF NOT blockin (workspace, 1, dr verwaltungslaenge2, block laenge)

+  THEN LEAVE packeteingang 

+  FI.

+

+

+blocklaenge: IF code t  > nutzlaenge 

+             THEN 

+               vorspannlaenge-2 

+             ELSE 

+               code t -2 

+             FI. 

+

+sync: 

+  TEXT VAR skipped:=ft , t :="";

+  REP 

+    skipped CAT t;

+    t := incharety (1); 

+    IF t = "" THEN 

+      report ("skipped",skipped); 

+      LEAVE packet eingang

+    FI ;

+    INT VAR codet := code (t);

+  UNTIL blockanfang PER; 

+  IF skipped <> stx THEN report ("skipped bei sync:", skipped) FI. 

+ 

+blockanfang: 

+  (skipped SUB length(skipped)) = stx 

+  AND

+  (codet = datenpacketlaenge

+  OR codet = ack laenge OR codet = neue ack laenge OR code t = openlaenge). 

+ 

+daten teil: 

+  IF neue verbindung 

+  THEN

+    verbindung bereitstellen

+  ELIF quittung 

+  THEN 

+    strom := ack packet.strom; 

+    IF falsche stromnummer THEN report ("Strom falsch in Quittung");

+                                LEAVE datenteil FI;

+    IF vx.strom = 0 THEN LEAVE datenteil FI;

+    IF ackpacket.code >= ok   THEN weiter senden

+    ELIF ackpacket.code = -von vorne THEN

+        sendereport ("Neustart");

+        openblock := vx; 

+        sendung neu starten 

+    ELIF ackpacket.code = -wiederhole THEN back 16

+    ELIF ackpacket.code = -loesche    THEN fremdloeschung

+    ELIF ackpacket.code = -beende AND alles raus THEN strom abschliessen

+    FI

+  ELIF verbindung festgestellt 

+  THEN

+    zeit(strom) := 200;

+    opti := vx;

+    datenpacket

+  ELSE 

+    strom := maxstrom1; 

+    vx:=openblock;

+    report ("Daten ohne Eroeffnung von " +text(vx.rechnernummernDIV256) 

+    +"  Sequenznr "+text(openblock.sequenz)); 

+    daten aus puffer entfernen;

+    IF alles raus THEN quittieren (-beende) ELSE quittieren(-von vorne) FI

+  FI. 

+

+verbindung bereitstellen:

+  IF openblock.ziel = collector OR station (openblock.ziel) = own

+  THEN

+    freie verbindungsnummer; 

+    vdr := nilspace;

+    vx := open block; 

+    zeit(strom) := 10;

+    quittieren falls genug pufferplatz;

+    vx.sequenz := 0 ; 

+    IF loeschung vorgemerkt

+    THEN 

+      loesche verbindung (strom)

+    ELSE

+      opti := vx;

+      abschluss testen

+    FI;

+  FI.

+

+loeschung vorgemerkt: typ(strom) = call im abbruch.

+

+strom abschliessen:

+  IF call aufruf THEN zeit(strom) := 80; ausfuehrungsphase merken

+  ELSE

+    vx.strom := 0; 

+    forget (vdr)

+  FI.

+

+ausfuehrungsphase merken: typ(strom) := call in zustellung.

+ 

+back16:

+  datenraum etwas rueckspulen; 

+  nicht sofort senden (* wegen vagabundierender Quittungen *).

+

+nicht sofort senden: zeit(strom) := 2.

+

+datenraum etwas rueckspulen:

+  sendereport ("etwas rueckgespult");

+  INT VAR sk , vs :=-1;

+  dr page (strom) := -1;

+  INT VAR i;

+  FOR i FROM 1 UPTO vx.sequenz DIV packete pro seite - etwas REP

+    vs INCR packete pro seite;

+    dr page (strom) := next ds page (vdr, dr page (strom)) 

+  PER;

+  vx.seiten nummer := next ds page (vdr, dr page (strom)) ;

+  vx.sequenz := vs.

+

+etwas: 3.

+

+fremdloeschung:

+  IF fremdrechner ok und sendung 

+  THEN

+    IF typ (strom) = call in zustellung

+    THEN

+      typ (strom) := call im wait

+    ELSE

+      sendereport ("Sendung von Gegenstelle geloescht");

+      sendung loeschen

+    FI

+  FI.

+

+fremdrechner ok und sendung:

+ (ackpacket.rechnernummern DIV 256) = (vx.rechnernummern AND 255).

+

+

+quittieren falls genug pufferplatz:

+  IF quit zaehler > 0 THEN

+    quit zaehler DECR 1;

+    open quittieren;

+    block vorab quittieren

+  FI.

+

+open quittieren: quittieren (ok).

+block vorab quittieren: quittieren (ok).

+

+quittung:  code t <= neue ack laenge. 

+ 

+neue verbindung: code t = open laenge.

+ 

+verbindung festgestellt: 

+  FOR strom FROM maxstrom DOWNTO 1 REP 

+    IF bekannter strom

+    THEN LEAVE verbindung festgestellt WITH TRUE FI 

+  PER; 

+  FALSE. 

+ 

+bekannter strom: 

+  vx.strom = vorspann.strom AND vom selben rechner. 

+ 

+vom selben rechner: 

+  vx.rechnernummern = vorspann.rechnernummern. 

+ 

+daten: 

+  IF NOT blockin (vdr, opti.seiten nummer, distanz, nutzlaenge)

+  THEN quittieren (-wiederhole); LEAVE packeteingang 

+  FI; 

+  sequenz zaehlung;

+  IF neue seite kommt 

+  THEN 

+    vx.seiten nummer := vorspann.seiten nummer 

+  FI. 

+ 

+datenpacket:

+  IF sendung wartet auf zustellung THEN auffrischen ELSE daten holen FI.

+

+sendung wartet auf zustellung: typ (strom) = zustellung.

+

+auffrischen: zeit (strom) := 100; daten aus puffer entfernen.

+

+daten holen:

+  IF opti.sequenz >= vorspann.sequenz AND opti.sequenz < vorspann.sequenz+100

+  THEN 

+    IF opti.sequenz <> vorspann.sequenz

+    THEN empfangsreport ("Sequenzreset von "+text(opti.sequenz)+" auf "+

+                  text (vorspann.sequenz));

+         vx.sequenz := vorspann.sequenz;

+         vorabquittung regenerieren 

+    FI;

+    quittieren(ok); 

+    daten  ; 

+    abschluss testen

+  ELSE 

+    empfangsreport ("Sequenzfehler: soll "+text(vx.sequenz)+" ist "+ 

+            text(vorspann.sequenz));

+    quittieren (-wiederhole);

+    daten aus puffer entfernen

+  FI. 

+ 

+vorabquittung regenerieren: quittieren (ok).

+ 

+distanz: (opti.sequenz AND  packete pro seite minus 1 ) * nutzlaenge. 

+ 

+sequenz zaehlung: 

+  vx.sequenz INCR 1. 

+ 

+neue seite kommt: 

+(vx.sequenz AND packete pro seite minus1) = 0. 

+ 

+freie verbindungsnummer: 

+  INT VAR h strom :=0;

+  FOR strom FROM 1 UPTO maxstrom REP 

+    IF vx.strom = 0 THEN h strom := strom 

+    ELIF bekannter strom

+    THEN empfangsreport ("Reopen"); 

+         quit zaehler INCR 1;

+         forget (vdr);

+         LEAVE freie verbindungsnummer 

+    ELIF antwort auf call

+    THEN

+      typ (strom) := call pingpong;

+      forget (vdr);

+      LEAVE freie verbindungsnummer 

+    FI

+  PER; 

+  strom := h strom; 

+  IF strom = 0 THEN

+    error stop ("Zuviele simulatane Verbindungen") 

+  FI; 

+  typ(strom) := send wait.

+

+antwort auf call:

+  openblock.sendecode >= 0 AND

+  call aufruf AND vx.quelle = openblock.ziel AND vx.ziel = openblock.quelle. 

+

+abschluss testen: 

+  IF neue seite kommt AND vx.seiten nummer = -1 

+  THEN 

+    quittieren (-beende);

+    an ziel weitergeben 

+  FI. 

+ 

+an ziel weitergeben: 

+  IF tasknummerfrage  THEN taskfrage beantworten ;pufferplatz freigeben;

+  ELIF tasknamenfrage THEN name senden ;pufferplatz freigeben;

+  ELIF taskinfofrage  THEN task info senden;pufferplatz freigeben;

+  ELSE                     senden

+  FI. 

+

+pufferplatz freigeben: quitzaehler INCR 1.

+

+senden:

+  max 100 versuche; 

+  snr := strom;

+  IF NOT callaufruf THEN typ (strom) := zustellung FI;

+  q := vx.quelle;

+  z := vx.ziel;

+  ant := vx.sendecode;

+  dr := vdr;

+  LEAVE packet eingang.

+

+tasknummerfrage:opti.sendecode = -6.

+ 

+tasknamenfrage: opti.sendecode = -7.

+ 

+taskinfofrage: opti.sendecode = -8.

+

+max 100 versuche: zeit(strom) := 100.

+

+taskfrage beantworten:

+  BOUND TEXT VAR tsk := vdr; 

+  TEXT VAR save tsk := tsk;

+  forget (vdr); vdr := nilspace; 

+  BOUND TASK VAR task id := vdr;

+  disable stop;

+  task id := task(save tsk);

+  IF is error THEN 

+    clear error; enable stop;

+    forget (vdr); vdr := nilspace; 

+    BOUND TEXT VAR errtxt := vdr;

+    errtxt := text(station(myself))+"/"""+save tsk+""" gibt es nicht";

+    sendung starten (collector, opti.quelle, 2)

+  ELSE

+    enable stop;

+    sendung starten (collector, opti.quelle, 0)

+  FI.

+ 

+name senden: 

+  forget (vdr); vdr := nilspace;

+  tsk := vdr; 

+  disable stop;

+  tsk := nam (opti.ziel);

+  clear error; enable stop;

+  sendung starten (collector, opti.quelle, 0). 

+ 

+task info senden:

+  BOUND INT VAR ti code := vdr;

+  INT VAR ti cd := ti code;

+  forget (vdr); vdr := nilspace;

+  FILE VAR task inf := sequential file (output,vdr);

+  head line (task inf,"Station "+text(own)); 

+  task info (ti cd, task inf);

+  sendung starten (collector,opti.quelle,0).

+ 

+END PROC packet eingang;

+

+PROC quittieren(INT CONST code) : 

+  quellrechner wird zielrechner; 

+  ackpacket.code := code; 

+  ackpacket.head := stx quit;

+  ackpacket.strom := vx.strom;

+  blockout (workspace,1,dr verwaltungslaenge, ack laenge). 

+ 

+quellrechner wird zielrechner: 

+  ack packet.rechnernummern := vx.rechnernummern DIV 256 

+                               + own256. 

+ 

+END PROC quittieren; 

+ 

+END PACKET basic net;

diff --git a/system/net/1.7.5/src/callee b/system/net/1.7.5/src/callee
new file mode 100644
index 0000000..42d80da
--- /dev/null
+++ b/system/net/1.7.5/src/callee
@@ -0,0 +1,14 @@
+PACKET callee DEFINES callee:

+

+TASK PROC callee (TASK CONST t): 

+  IF im wait THEN trick 1 (t); trick 2 ELSE niltask FI.

+im wait: (status(t) AND 3) = 2. 

+END PROC callee; 

+ 

+PROC trick 1 (TASK CONST t): 

+  INT VAR x := pcb(t,11), y:=pcb(t,12); 

+END PROC trick1; 

+ 

+TASK PROC trick 2: TASK VAR calle; calle END PROC trick2; 

+ 

+END PACKET callee;

diff --git a/system/net/1.7.5/src/net inserter b/system/net/1.7.5/src/net inserter
new file mode 100644
index 0000000..d8c0856
--- /dev/null
+++ b/system/net/1.7.5/src/net inserter
@@ -0,0 +1,50 @@
+

+{ Inserter für EUMEL - Netz - Software;                         04.12.83

+  berücksichtigt EUMEL - Versionen 1.7.3 und 1.7.5, sowie Multi / Single } 

+ 

+ 

+INT VAR version :: id (0), cy :: 4;

+IF online THEN head FI;

+

+IF ich bin multi THEN insert multi net

+                 ELSE meldung an single

+FI.

+

+ich bin multi : (pcb (9) AND 255) > 1.

+

+insert multi net :

+   IF version >= 173 THEN IF version < 175 THEN insert and say ("callee") FI; 

+                          insert and say ("net report/M"); 

+                          insert and say ("basic net"); 

+                          insert and say ("net manager/M") 

+                     ELSE versionsnummer zu klein

+   FI.

+

+meldung an single : 

+   cursor (1, cy);

+   putline

+   ("Das EUMEL - Netz ist zur Zeit nur auf Multi - User - Versionen");

+   putline ("installierbar !").

+

+head :

+   page;

+   putline (" E U M E L  -  Netz  -  Inserter");

+   put     ("---------------------------------").

+ 

+versionsnummer zu klein : 

+   cursor (1, cy);

+   putline ("Netzsoftware erst ab Version 1.7.3 insertierbar !").

+ 

+PROC insert and say (TEXT CONST name of packet): 

+   IF online THEN cl eop (1, cy); 

+                  put ("Paket '" + name of packet + "' wird insertiert"); 

+                  line (2);

+                  cy INCR 1

+   FI;

+   insert (name of packet); 

+END PROC insert and say;

+

+PROC cl eop (INT CONST cx, cy) :

+   cursor (cx, cy);

+   out    (""4"")

+END PROC cl eop;

diff --git a/system/net/1.7.5/src/net manager-M b/system/net/1.7.5/src/net manager-M
new file mode 100644
index 0000000..bf64a68
--- /dev/null
+++ b/system/net/1.7.5/src/net manager-M
@@ -0,0 +1,302 @@
+PACKET net manager DEFINES start,stop,net manager,frei:

+TEXT VAR stand := "Netzsoftware vom  02.09.85";

+                 (*Heinrichs     *)

+ 

+LET

+    ack = 0,

+    nak = 1,

+    error nak = 2,

+    zeichen eingang = 4,

+    list code = 15,

+    fetch code = 11,

+    freigabecode = 29,

+    continue code = 100,

+    erase code = 14,

+    report code = 99, 

+

+    (* Typen von Kommunikationsströmen *)

+

+    send wait = 0,

+    zustellung = 1,

+    call pingpong = 2,

+    call im wait = 3,

+    call im abbruch = 4,

+    call in zustellung = 5;

+ 

+LET STEUER =

+      STRUCT ( 

+      INT  head, 

+           rechner nummern, 

+           strom,

+      INT  sequenz,

+           seiten nummer,

+      TASK quelle,ziel,

+      INT  sende code); 

+ 

+LET INFO = STRUCT (STEUER steuer, INT typ); 

+ 

+TASK VAR sohn;

+INT VAR strom,c.

+ 

+vx: v.steuer.

+ 

+PROC frei (INT CONST stat,lvl): 

+  DATASPACE VAR ds := nilspace;

+  BOUND STRUCT (INT x,y) VAR msg := ds;

+  msg.x := stat; msg.y := lvl;

+  INT VAR return;

+  call (/"net port", freigabecode, ds, return) ;

+  forget (ds)

+END PROC frei; 

+ 

+PROC net manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST

+                  ordertask):

+ 

+    IF order = report code

+    THEN 

+      forget ("report",quiet); 

+      copy (ds,"report"); 

+      forget (ds) 

+    ELSE 

+      IF ordertask < myself

+      OR order = list code

+      OR order > continue code

+      THEN

+        IF order = list code 

+        THEN

+          enable stop;

+          forget (ds); ds := old ("report");

+          FILE VAR ff := sequential file (output,ds);

+          putline (ff,stand);

+          putline (ff,"Rechner "+text(station(myself))+"  um "+time of day);

+          send (ordertask, ack, ds)

+        ELSE

+        free manager (ds,order,phase,order task) 

+        FI

+      ELSE

+      errorstop ("nur 'list' ist erlaubt")

+      FI

+    FI 

+END PROC net manager; 

+

+TASK VAR cd,stask;

+ROW 255 INT VAR erlaubt; 

+INT VAR i;

+FOR i FROM 1 UPTO 255 REP erlaubt (i) := 0 PER;

+

+PROC communicate: 

+  enable stop;

+  INT VAR scode;

+  DATASPACE VAR dr := nilspace;

+  neuer start (quit max);

+REP 

+  forget (dr); 

+  wait (dr, scode, stask); 

+  cd := collected destination;

+  IF zeichen da OR zeit abgelaufen 

+  THEN 

+    packet

+  ELIF cd = myself 

+  THEN 

+    netz info und steuerung 

+  ELSE

+    neue sendung (stask, cd, scode, dr)

+  FI 

+PER. 

+ 

+zeichen da: scode < 0 . 

+ 

+zeit abgelaufen: scode = ack AND cd = myself. 

+

+packet: 

+    TEXT VAR t := incharety; 

+    INT VAR snr, ant,err;

+    TASK VAR quelle, ziel;

+    snr := 0;

+    REP 

+      IF t = "" 

+      THEN 

+        zeitueberwachung (snr, quelle, ziel, ant, dr); 

+      ELSE

+        packet eingang (t, snr, quelle, ziel, ant, dr); 

+      FI;

+      IF snr > 0 

+      THEN 

+        IF ant > 5 AND erlaubt(station (quelle)) < 0 

+        THEN unerlaubt

+        ELSE 

+          send (quelle,ziel,ant,dr,err); 

+          fehlerbehandlung ;

+        FI

+      FI 

+    UNTIL snr = 0 OR zeichen da PER.

+

+fehlerbehandlung: 

+  IF ok oder ziel nicht da THEN loesche verbindung (snr) FI. 

+ 

+ok oder ziel nicht da: err=0 OR err=-1. 

+ 

+netz info und steuerung: 

+    IF scode = list code THEN   list status 

+  ELIF scode = erase code THEN strom beenden

+  ELIF scode = freigabe code AND stask = father THEN freigabelevel 

+  ELSE forget (dr); ablehnen ("nicht möglich") 

+  FI. 

+ 

+freigabelevel: 

+  BOUND STRUCT (INT stat,lvl) VAR lv := dr; 

+  IF lv.stat > 0 AND lv.stat < 256 THEN erlaubt (lv.stat) := lv.lvl FI; 

+  send (stask,ack,dr).

+ 

+unerlaubt: 

+  report ("Fremdzugriff von "+text(station (quelle))+" auf "+nam(ziel)

+          +" code "+text(ant)); 

+  loesche verbindung (snr). 

+ 

+strom beenden:

+  BOUND TEXT VAR stromtext := dr;

+  INT VAR erase strom := int (stromtext);

+  forget (dr);

+  strom := erase strom;

+  IF falsche stromnummer THEN ablehnen ("Strom gibt es nicht")

+  ELSE 

+    BOUND INFO VAR v := verbindung (strom); 

+  IF

+    stask = father OR stask = vx.quelle OR stask = vx.ziel

+  THEN

+    loeschen

+  ELSE ablehnen ("Nur Empfänger/Absender darf löschen")

+  FI

+  FI. 

+ 

+loeschen:

+  IF sendeeintrag  THEN

+    IF callee (vx.quelle) = vx.ziel THEN absender warnen FI;

+    loesche verbindung (strom)

+  ELSE

+    IF callee (vx.ziel) = vx.quelle THEN warnen FI; 

+    loesche verbindung (strom)

+  FI; 

+  dr := nilspace;

+  send (stask,ack,dr).

+

+absender warnen:

+ dr := nilspace;

+ send(vx.ziel,vx.quelle,1,dr,err) .

+

+warnen:

+ dr := nilspace;

+BOUND TEXT VAR errtxt := dr; errtxt:= "Station antwortet nicht"; 

+send (vx.quelle,vx.ziel,error nak, dr, err). 

+ 

+falsche stromnummer: strom < 1 OR strom > max verbindungsnummer.

+sendeeintrag: vx.rechnernummern DIV256 = station (myself).

+END PROC communicate;

+

+PROC ablehnen (TEXT CONST t):

+  DATASPACE VAR vdr := nilspace;

+  BOUND TEXT VAR errtxt := vdr; 

+  errtxt := t;

+  send (stask, error nak, vdr).

+END PROC ablehnen;

+

+PROC stop: 

+  disable stop; 

+  end (task ("net port"));

+  end (task ("net timer")); 

+  clear error;

+END PROC stop; 

+ 

+PROC list status: 

+ 

+  DATASPACE VAR ds := nilspace; 

+  FILE VAR f:=sequential file (output, ds);

+  FOR strom FROM 1 UPTO max verbindungsnummer REP 

+    BOUND INFO VAR v := verbindung (strom);

+    IF vx.strom <> 0 THEN info FI 

+  PER; 

+  send (stask, ack, ds). 

+ 

+info: 

+  put (f,"Strom "+text(strom)+" (sqnr"+text(vx.sequenz)+")"); 

+  IF sendeeintrag THEN sendeinfo ELSE empfangsinfo FI; 

+  line (f). 

+ 

+sendeeintrag: vx.rechnernummern DIV 256 = station(myself) . 

+ 

+sendeinfo: 

+  IF v.typ = call im wait THEN put (f,"erwartet Antwort von")

+  ELIF v.typ = call in zustellung THEN put (f,"Ziel busy. Zielstation:") 

+  ELIF v.typ = call im abbruch THEN put (f,"wird gelöscht bei Antwort von") 

+  ELSE put (f,"sendet an") 

+  FI; 

+  put (f,vx.rechnernummernMOD256); 

+  put (f,". Absender ist """+nam (vx.quelle)+"""."). 

+ 

+empfangsinfo: 

+  IF v.typ = zustellung THEN 

+  put (f,"Sendung noch nicht zustellbar")

+  ELSE

+  put (f,"empfängt von");

+  put (f,vx.rechnernummernDIV256); 

+  FI;

+  put (f,". Empfaenger ist """+nam (vx.ziel)+""".").

+END PROC list status; 

+

+

+PROC start (INT CONST chan):

+  c:=chan;

+  start

+END PROC start;

+INT VAR quitmax := 3;

+PROC start (INT CONST chan,quit):

+  quitmax := quit;

+  c:=chan;

+  start

+END PROC start;

+

+PROC start: 

+stop;

+IF exists ("report") THEN forget ("report") FI;

+FILE VAR s := sequential file (output,"report"); 

+putline (s," N e u e r   S t a r t "+time of day); 

+begin ("net port",PROC net io, sohn); 

+TASK VAR dummy;

+begin ("net timer",PROC timer,dummy);

+define collector (sohn) 

+END PROC start; 

+ 

+PROC timer: 

+  disable stop;

+  REP 

+    clear error;

+    DATASPACE VAR ds := nilspace;

+    pause (100); 

+    send (sohn, ack, ds) 

+  PER; 

+END PROC timer; 

+

+PROC net io:

+  disable stop; 

+  fetch ("report");

+  commanddialogue (FALSE); 

+  continue (c);

+  communicate;

+  TEXT VAR emsg := "++++++ "+error message +" Zeile "+text(errorline);

+  clear error; 

+  report (emsg);

+  save ("report");

+  end (myself) 

+END PROC net io; 

+

+put ("Netzkanalnummer:"); get (c);line;

+IF yes ("Ist der Netzkanal mit Flußkontrolle verdrahtet") THEN

+   quit max := 10

+ELSE

+   quit max := 3

+FI; 

+END PACKET net manager;

+ 

+ 

+start; global manager (PROC (DATASPACE VAR,INT CONST,INT CONST, TASK

+CONST) net manager ) 

diff --git a/system/net/1.7.5/src/net report-M b/system/net/1.7.5/src/net report-M
new file mode 100644
index 0000000..3ce67ff
--- /dev/null
+++ b/system/net/1.7.5/src/net report-M
@@ -0,0 +1,29 @@
+PACKET net report DEFINES report: 

+

+LET reportcode = 99;

+

+PROC report (TEXT CONST x):

+  report(x,"") 

+END PROC report;

+

+PROC report (TEXT CONST txt, info): 

+  IF storage (old("report")) > 20 THEN forget ("report",quiet) FI;

+  reportfile := sequential file (output, "report");

+  put (reportfile, date);

+  put (reportfile, time of day);

+  put (reportfile, txt); 

+  INT VAR i; 

+  FOR i FROM 1 UPTO length (info) REP 

+    INT VAR z :=  code (infoSUBi)  ;

+    IF z < 32 OR z > 126 

+      THEN put (reportfile,"%"+text(z)) 

+      ELSE put (reportfile,infoSUBi)

+    FI

+  PER; 

+  line (reportfile); 

+  DATASPACE VAR net report := old ("report"); 

+  send (father, report code , net report)

+END PROC report; 

+FILE VAR reportfile; 

+ 

+END PACKET net report;

diff --git a/system/net/1.8.7/doc/netzhandbuch b/system/net/1.8.7/doc/netzhandbuch
new file mode 100644
index 0000000..7083462
--- /dev/null
+++ b/system/net/1.8.7/doc/netzhandbuch
@@ -0,0 +1,2045 @@
+____________________________________________________________________________ 
+ 
+ 
+#on("b")##on ("u")# 
+#center#Betriebssystem E U M E L 
+#off ("u")# 
+ 
+ 
+#center#Netzsoftware 
+ 
+ 
+ 
+ 
+#off("b")# 
+#center#Lizenzfreie Software der 
+#on ("b")# 
+ 
+#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, 
+#center#5205 Sankt Augustin 
+ 
+ 
+#off("b")# 
+#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für 
+#center#nichtkommerzielle Zwecke gestattet. 
+ 
+#center#Gewährleistung und Haftung werden ausgeschlossen 
+ 
+ 
+____________________________________________________________________________ 
+#page# 
+#pagenr ("%",1)##setcount(1)##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Inhalt 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right# GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+ 
+#center#Inhalt 
+ 
+#clear pos##lpos(1.0)##rpos(9.5)# 
+#table# 
+ 
+1. Einleitung  #topage("0")# 
+ 
+Teil 1: Netz einrichten und benutzen  #topage("1")# 
+ 
+ 
+1.1. Hardwarevoraussetzungen  #topage("1.1")# 
+1.2. Einrichten des Netzes    #topage("1.2")# 
+1.3. Benutzung des Netzes   #topage("1.3")# 
+1.4. Informationsmöglichkeiten   #topage("1.4")# 
+1.5. Eingriffsmöglichkeiten   #topage("1.5")# 
+1.6. Fehlerbehebung im Netz   #topage("1.6")# 
+1.7. Sicherheit im Netz       #topage("1.7")# 
+ 
+ 
+ 
+Teil 2: Arbeitsweise der Netzsoftware   #topage("2")# 
+ 
+ 
+2.1. Die Netztask    #topage("2.1")# 
+2.2. Protokollebenen   #topage("2.2")# 
+2.3. Stand der Netzsoftware  #topage("2.3")# 
+ 
+ 
+ 
+Teil 3: Netz-Hardware-Interface   #topage("3")# 
+ 
+ 
+3.1. Einführung   #topage("3.1")# 
+3.2. Arbeitsweise des Netz-Hardware-Interfaces   #topage("3.2")# 
+3.3. Netztreiber  #topage("3.3")# 
+3.4. Prozedurschnittstelle des EUMEL-Netzes  #topage("3.4")# 
+ 
+ 
+ 
+Anhang      #topage("A")# 
+ 
+ 
+1. Fehlermeldungen  #topage("A.1")# 
+2. Literaturhinweise    #topage("A.2")# 
+3. Index  #topage("A.3")# 
+ 
+#table end# 
+#clear pos# 
+ 
+#page# 
+#pagenr ("%", 2)##setcount (1)##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Einleitung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right#GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+
+1. Einleitung 
+ 
+#goalpage("0")# 
+Das EUMEL-Netz dient dazu, mehrere EUMEL-Rechner (sog. #ib#Station#ie#en) miteinan­
+der zu koppeln. Diese Kopplung wird vom Betriebssystem dazu benutzt, das Sen­
+dungskonzept [1] so auszudehnen, daß Tasks verschiedener Stationen einander
+Datenräume zusenden können. Auf dem #ib#Sendungskonzept#ie# aufbauende Konzepte
+nutzen daher automatisch das Netz aus: So ist es z.B. möglich 
+ 
+-  von einer Station aus auf einer anderen zu drucken, 
+ 
+-  in die Task PUBLIC einer anderen Station #ib#Datei#ie#en zu sichern (save), vorausge­
+   setzt, daß PUBLIC dort ein #on("b")#free global manager#off("b")# ist, 
+ 
+-  auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk
+   defekt ist oder ein anderes Format hat). 
+ 
+Diese #ib#Netzversion#ie# kann ab EUMEL-Version 1.8.1 eingesetzt werden. 
+ 
+Diese Netzbeschreibung besteht aus drei Teilen. In Teil 1 wird beschrieben, wie das
+EUMEL-Netz benutzt und eingerichtet wird. Als Benutzer eines EUMEL-
+Rechners, der vernetzt ist, ist nur dieser Teil der Netzbeschreibung für Sie wichtig.
+Teil 2 erklärt die Funktionsweise der #ib#Netzsoftware#ie#, im dritten Teil wird die Schnitt­
+stelle für die Anpassung anderer #ib#Netzhardware#ie# definiert. 
+ 
+Hinweis: 
+ 
+Zur erstmaligen #ib#Installation#ie# des EUMEL-Netzes ist außer dieser Beschreibung noch
+die Netzsoftware (auf Floppy) und die EUMEL-Netz-#ib#Installationsanleitung#ie#, die mit
+der Software geliefert wird, notwendig. 
+ 
+In der vorliegenden Netzbeschreibung wird das EUMEL-Netz möglichst "hardware
+unabhängig" beschrieben. Wenn hardwareabhängige Beispiele gegeben werden, so
+ist die dort beschriebene Hardware stets die #ib#Datenbox#ie#. 
+#pagenr ("%", 3)##setcount (1)##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#cneter#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Teil 1 :  Netz einrichten und benutzen 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right#GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+#page# 
+ 
+Teil 1: Netz einrichten und benutzen 
+#goalpage("1")# 
+ 
+ 
+ 
+1.1. Hardwarevoraussetzungen 
+#goalpage("1.1")# 
+ 
+ 
+Zwei Stationen 
+ 
+Sie können zwei #ib#Station#ie# miteinander vernetzen, wenn Sie dafür an jeder Station eine
+#ib#V.24#ie#-#ib#Schnittstelle#ie# zur Verfügung stellen. 
+ 
+Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur #ib#Rechnerkopplung#ie# [2]. 
+ 
+ 
+Mehrere Stationen 
+ 
+Wenn Sie mehr als zwei Stationen vernetzen wollen, stehen Ihnen zwei Konzepte zur
+Verfügung: das Anlegen von #ib#Netzknoten#ie# bzw. das Verwenden eines #ib#Strang#ie#es. Die
+Konzepte können gemischt eingesetzt werden. 
+ 
+Ein Strang besteht aus einer Anzahl von #ib#Netzbox#ie#en (z.B. KHW-Box oder Ethernet­
+anschluß). 
+ 
+Jede Box besitzt eine #ib#Schnittstelle#ie# (z.B. #ib#V.24#ie#) zum Anschluß an einen der Kanäle
+1...15 der zugeordneten #ib#Station#ie# und eine weitere Schnittstelle zur #ib#Verbindung#ie# der
+Boxen untereinander. 
+ 
+Ein #ib#Knoten#ie# ist eine Station, bei der der Netzbetrieb über mehrere Kanäle läuft. 
+ 
+Da die #ib#Netzsoftware#ie# pro #ib#Kanal#ie# eines Knotens eine Task generiert, ist das Knoten­
+konzept dem Strangkonzept hinsichtlich des #ib#Durchsatz#ie#es unterlegen. Preisgünstiger
+ist jedoch das #ib#Knotenkonzept#ie#, weil dabei #ib#Netzbox#ie#en überflüssig werden. 
+ 
+Beim Knotenkonzept wird eine #ib#Vermaschung#ie# nicht zur Optimierung benutzt (Ver­
+maschung heißt, daß eine #ib#Zielstation#ie# über verschiedene Knoten erreichbar ist). Daher
+sollte man keine Vermaschung vorsehen. 
+ 
+#ib#Nachbarn#ie# sind Stationen, die an denselben #ib#Netzstrang#ie# angeschlossen oder direkt
+über ein #ib#V.24#ie#-Kabel verbunden sind. 
+ 
+Bei der Entscheidung, welche Stationen man zu #ib#Knoten#ie# macht, sollte beachtet wer­
+den, daß (a) Stationen, zwischen denen hoher Verkehr besteht, Nachbarn werden und
+daß (b) besonders leistungsfähige Rechner #ib#Knoten#ie#stationen sein sollten. 
+#page# 
+ 
+1.2. Einrichten des Netzes 
+#goalpage("1.2")# 
+ 
+ 
+Hinweis: Dieses Kapitel ist nur für Systembetreuer wichtig. 
+ 
+a) Legen Sie für die am Netz beteiligten Rechner #ib#Stationsnummer#ie#n fest (von 1 an
+   aufsteigend). 
+ 
+   Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box und
+   des zugeordneten Rechners müssen übereinstimmen. 
+ 
+ 
+b) Holen Sie an jeder #ib#Station#ie# die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie
+   das Kommando #on("bold")##ib#define station#ie# (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gewählte Stationsnummer ist. 
+ 
+   Hinweis:  Taskkommunikationen, die zu diesem Zeitpunkt laufen, führen zu feh­
+             lerhaftem Verhalten. Dies liegt daran, daß durch #on("bold")#define station#off("bold")# alle
+             #ib#Task-Id#ie#'s geändert werden müssen, weil eine #ib#Task-Id#ie# u.a. die
+             Stationsnummer der eigenen Station enthält (siehe 1.3). TASK-
+             Variablen, die noch Task-Id's mit keiner oder falscher Stationsnum­
+             mer enthalten, können nicht mehr zum Ansprechen einer Task ver­
+             wendet werden. 
+ 
+   Beispiel: Der #ib#Spoolmanager#ie# [3] richtet beim Kommando #on("bold")#start#off("bold")# einen #ib#Worker#ie# ein
+             und merkt sich dessen #ib#Task-Id#ie# in einer TASK-Variablen, um sicher­
+             zustellen, daß nur der Worker #ib#Datei#ie#en zum Drucken abholt. Wird jetzt
+             das Kommando #on("bold")# define station#off("bold")# gegeben, kann der Spoolmanager
+             seinen Worker nicht mehr identifizieren, weil der Worker eine neue
+             Task-Id erhalten hat. Man muß daher vor #on("b")#define station#off("b")# den Worker
+             löschen und ihn danach mit dem Kommando #on("bold")##ib#start#ie##off("bold")# im Spoolmanager
+             wieder neu einrichten. 
+ 
+ 
+   Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nachdem man ein frisches System
+   vom Archiv geladen hat. 
+ 
+   Zum Anschluß einer #ib#Datenbox#ie# #ib#konfigurieren#ie# Sie mit dem Kommando #on("bold")##ib#configurate#ie##off("bold")#
+   den für das Netz vorgesehenen #ib#Kanal#ie# auf 
+ 
+   -  transparent 
+   -  9600 #ib#Baud#ie# (Standardeinstellung der Boxen) 
+   -  #ib#RTS/CTS#ie#-#ib#Protokoll#ie# 
+   -  großen Puffer 
+   -  8 bit 
+   -  even parity 
+   -  1 stopbit. 
+ 
+   Falls diese Einstellungen nicht alle angeboten werden, klären Sie mit Ihrem
+   Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden können. 
+ 
+   Hinweis:  Notfalls kann auf das #ib#RTS/CTS#ie#-Protokoll verzichtet werden, wenn der
+             Eingabepuffer der #ib#Station#ie# groß genug ist. Die Anzahl simultan laufen­
+             der Netzkommunikationen ist dann auf 
+ 
+                    puffergröße DIV 150 
+ 
+             begrenzt (bei Z80, 8086: 3; bei M20: 10). 
+ 
+   Hinweis:  Es können auch andere #ib#Baud#ie#raten (2400, 4800, 19200) an der Box
+             eingestellt werden. 
+ 
+ 
+c) Achten Sie bei der #ib#Verbindung#ie# von der Station zur #ib#Netzbox#ie# (bzw. zur Gegen­
+   station bei einem Zweistationennetz ohne Boxen) darauf, daß neben den Emp­
+   fangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet wer­
+   den, also ein 5-poliges Kabel verwendet wird [2]. Die #ib#Pin-Belegung#ie# der Boxen
+   entspricht der eines Kabels zur Rechner-Rechner-Kopplung. 
+ 
+   Beispiel: 
+ 
+   Verbindung eines BICOS-Systems mit der Box: 
+ 
+   Stecker                  Stecker 
+   Pin                      Pin 
+ 
+   2  <--------->           3 
+   3  <--------->           2 
+   4  <--------->           5 
+   5  <--------->           4 
+   7  <--------->           7 
+ 
+ 
+d) Richten Sie eine Task #on("bold")##ib#net#ie##off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und legen Sie eine #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# an, die
+   Ihre #ib#Netzkonfiguration#ie# enthält, oder ändern Sie die mitgelieferte Datei ent­
+   sprechend ab (siehe auch 1.5.).#goalpage("sperre")# 
+ 
+ 
+   Dem bisherigen Netz entspricht eine Datei #on("b")#netz#off("b")# mit folgendem Inhalt: 
+ 
+     definiere netz; 
+     routen (1,127,k); 
+     starte kanal (k,1,x); 
+     aktiviere netz. 
+ 
+     k: ihr netzkanal. 
+     x: IF yes ("#ib#Flußkontrolle#ie#") THEN 10 ELSE 3 FI. 
+ 
+ 
+ 
+   Laden Sie die Datei #on("b")##ib#net install#ie##off("b")# vom Archiv #on("b")#net#off("b")# und übersetzen Sie diese. Je nach­
+   dem, welche EUMEL-Version auf der Maschine installiert ist, werden die notwen­
+   digen Programmdateien insertiert. 
+ 
+   Es sind dies 
+ 
+                          net report 
+                          net hardware interface 
+                          basic net 
+                          net manager 
+ 
+ 
+   Das Netz wird dabei gestartet. 
+ 
+ 
+   Hinweis:  Obwohl die Task #on("b")#net#off("b")# sich noch mit #on("bold")##ib#continue#ie##off ("bold")# an ein Terminal holen
+             läßt, sollte man dies nur kurzzeitig tun, da der Netzverkehr solange
+             blockiert ist. 
+ 
+             In der #ib#Datei#ie# #on("b")#netz#off("b")# sollte der #ib#Kanal#ie#, über den der meiste Verkehr erwar­
+             tet wird, zuerst gestartet werden. Für ihn wird die Task #on("b")##ib#net port#ie##off("b")# gene­
+             riert, für jeden weiteren Kanal wird eine Task #on("b")##ib#net port#ie# k#off("b")# (k=Kanal­
+             nummer) generiert. 
+#page# 
+
+1.3. Benutzung des Netzes  
+#goalpage("1.3")# 
+ 
+ 
+Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur Verfü­
+gung: 
+ 
+ 
+ 
+TASK OP #ib#/#ie# (INT CONST station, TEXT CONST taskname) 
+ 
+liefert die Task #on("bold")#taskname#off("bold")# von der #ib#Station#ie# #on("bold")#station#off("bold")#. 
+ 
+ 
+#ib#Fehlerfälle#ie#: 
+ 
+  -  #ib(4)#Task "...." gibt es nicht#ie(4)# 
+ 
+     Die angeforderte Task gibt es auf der #ib#Zielstation#ie# nicht. 
+ 
+  -  #ib(4)##ib#Collectortask#ie# fehlt#ie(4)# 
+ 
+     die Task #on("b")##ib#net port#ie##off("b")# existiert nicht (siehe 6). 
+ 
+     Hinweis:  #on("b")#net port#off("b")# wird bei jedem Start des Netzes neu generiert und beim
+               Auftreten eines nicht vorhergesehenen #ib#Fehler#ie#s beendet. Die Feh­
+               lermeldung steht im #on("b")##ib#report#ie##off("b")# (siehe 4). 
+ 
+  -  #ib(4)#Station x antwortet nicht#ie(4)# 
+ 
+     Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. 
+ 
+     Hinweis: Dieser #ib#Fehler#ie# wird angenommen, wenn eine Überwachungszeit von
+              ca. 30 Sekunden verstrichen ist, ohne daß Station x die Taskidenti­
+              fikation angeliefert hat. 
+ 
+  -  #ib(4)#Station x gibt es nicht#ie(4)# 
+ 
+     #ib#Station#ie# x steht nicht in den #ib#Routentabelle#ie#n. 
+ 
+     Diese Meldung kann auch erscheinen, wenn Station x erst kürzlich an das Netz
+     angeschlossen wurde. Sie steht dann noch nicht in den Routentabellen (siehe
+     auch 5.3.). 
+ 
+     Beispiel: 
+ 
+        list (5/"PUBLIC") 
+ 
+     Die Dateiliste von PUBLIC der Station 5 wird angefordert. 
+ 
+ 
+ 
+TASK OP #ib#/#ie# (INT CONST station, TASK CONST task) 
+ 
+liefert 
+ 
+station / name (task) 
+ 
+Beispiel: 
+ 
+   list (4/public) 
+ 
+ 
+Fehlerfall: 
+ 
+   "......" #ib(4)#gibt es nicht#ie(4)# 
+ 
+   Auf der eigenen Station gibt es die Task #on("b")#task#off("b")# nicht. 
+   Der Taskname wird auf der eigenen Station bestimmt, wenn es dort die Task 
+   nicht gibt, führt dies zur obigen Fehlermeldung. 
+ 
+Abhilfe: 
+ 
+   Statt list(4/public) das Kommando list (4/"PUBLIC") verwenden. 
+ 
+ 
+ 
+INT PROC #ib#station#ie# (TASK CONST task) 
+ 
+liefert die #ib#Stationsnummer#ie# der Task #on("bold")#task#off("bold")#. 
+ 
+Beispiel: 
+ 
+   put (station (myself)) 
+ 
+   gibt die eigene Stationsnummer aus. 
+ 
+ 
+ 
+ 
+PROC #ib#reserve#ie# (TEXT CONST archivename, TASK CONST archivetask) 
+ 
+dient dazu, das Archiv auf der #ib#Station#ie# #on("bold")#station#off("bold")# anzumelden. 
+ 
+Beispiel: 
+ 
+   reserve ("std", 4/"ARCHIVE"); #ib#list#ie# (4/"ARCHIVE") 
+ 
+   gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. 
+ 
+   Hinweis: Vergessen Sie bei solchen #ib#Querarchivierungen#ie# nicht die Stationsangabe
+            bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")#
+            "ARCHIVE")). 
+ 
+   Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Floppy­
+            formate umsetzen wollen. 
+ 
+ 
+ 
+ 
+PROC #ib#free global manager#ie# 
+ 
+dient dazu, die eigene Task über das Netz ansprechbar zu machen. Jede andere
+Task im Netz kann dann die üblichen #ib#Manager#ie#aufrufe (#on("bold")##ib#save#ie##off ("bold")#, #on("bold")##ib#fetch#ie##off ("bold")#, usw.) an die
+eigene Task machen, sofern diese nicht an ein Terminal gekoppelt ist. 
+ 
+Die Task wird (wie bei #on("bold")#break#off ("bold")#) abgekoppelt und meldet sich in Zukunft mit #on("bold")#mainte­
+nance#off ("bold")# statt mit #on("bold")#gib kommando#off ("bold")#. 
+ 
+Beispiel: 
+ 
+   An Station 4 ruft man in der Task "hugo" das Kommando #on("bold")#free global manager#off("bold")#
+   auf. Anschließend kann man von jeder Station aus z.B. #on("bold")#list (4/"hugo")#off ("bold")# usw. auf­
+   rufen. 
+ 
+ 
+ 
+ 
+TEXT PROC #ib#name#ie# (TASK CONST t) 
+ 
+Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, daß der
+Name einer auf einer anderen Station existierenden Task über Netz angefordert wird. 
+ 
+Existiert die Task nicht, so wird #on("bold")##ib#niltext#ie##off ("bold")# geliefert. 
+ 
+Hinweis: Die Prozedur #on("bold")##ib#exists#ie##off ("bold")# wurde nicht auf das Netz ausgedehnt, da sie in Situa­
+         tionen eingesetzt wird, wo es auf eine sehr schnelle Antwort ankommt.
+         Daher liefert #on("bold")#exists#off ("bold")# für eine stationsfremde Task immer FALSE. Will man
+         wissen, ob eine solche Task existiert, verwende man die Abfrage 
+ 
+         #on("bold")#IF name (task) <> "" THEN ... #off ("bold")#. 
+ 
+#ib#Fehlerfall#ie#: 
+ 
+   - #ib(4)#Station x antwortet nicht#ie(4)# 
+ 
+   - #ib(4)##ib#Station#ie# x gibt es nicht#ie(4)# 
+ 
+#page# 
+ 
+1.4. Informationsmöglichkeiten 
+ 
+#goalpage("1.4")# 
+ 
+In der Task #on("bold")#net#off("bold")# wird eine #ib#Datei#ie# #on("bold")##ib#report#ie##off("bold")# geführt, in der #ib#Fehlersituationen#ie# des Netzes
+verzeichnet werden. Diese Datei kann in jeder anderen Task auf derselben Station mit
+#on("bold")##ib#list#ie# (/"#ib#net#ie#")#off("bold")# angesehen werden. Eine Erklärung der wichtigsten Meldungen finden Sie
+im Anhang. 
+ 
+In jeder Task kann durch das Kommando #on("bold")##ib#list#ie# (/"#ib#net port#ie#")#off("bold")# eine Übersicht über die
+momentan laufenden #ib#Netzübertragungen#ie# der eigenen #ib#Station#ie# erhalten werden (nur für
+den #ib#Kanal#ie#, an dem #on("b")##ib#net port#ie##off("b")# hängt). Entsprechendes gilt für die weiteren Netports der
+eigenen Station. 
+ 
+Mit #on("bold")##ib#list#ie# (/"#ib#net list")#ie##off("bold")# erhält man die Informationen, die man mit #on("b")#list (/"net")#off("b")# und #on("b")##ib#list#ie##off("b")# auf
+alle Netports bekommt, sofern #on("b")##ib#listoption#ie##off("b")# (siehe S. #topage("listop")#) beim Generieren des Netzes
+aufgerufen wurde. Dieser Aufruf funktioniert auch bei fremden Stationen (z.B. #on("b")#list
+(5/"net list")#off("b")#). 
+ 
+#page# 
+ 
+1.5. Eingriffsmöglichkeiten 
+ 
+#goalpage("1.5")# 
+ 
+-  Jede Task kann #ib#Sende#ie(1,"ströme")#- und #ib#Empfangsströme#ie#, die bei #on("bold")#list (/"net port")#off("bold")# gemel­
+   det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das Kom­
+   mando #on("bold")##ib#erase#ie# ("x", /"#ib#net port#ie#")#off ("bold")# zu geben, wobei x die #ib#Stromnummer#ie# (aus dem #on("bold")#list#off ("bold")#)
+   ist. 
+   Unberechtigte #ib#Löschversuche#ie# werden abgewiesen. 
+   Von privilegierten Tasks aus können jedoch mit #on("b")##ib#erase#ie##off("b")# beliebige Ströme abge­
+   brochen werden. 
+ 
+ 
+-  Durch das Kommando #on("bold")##ib#start#ie##off("bold")# kann von der Task #on("b")##ib#net#ie##off("b")# aus das Netz neu gestartet
+   werden. Dies setzt eine gültige #ib#Datei#ie# #on("bold")#netz#off("bold")# voraus. Es wird ein #on("bold")##ib#run#ie##off("bold")# auf diese Datei
+   gegeben. Das Kommando #on("b")##ib#start#ie##off("b")# ist nur noch aus Kompatibilitätsgründen zum alten
+   Netz vorhanden. 
+ 
+ 
+-  Durch das Kommando #on("bold")##ib#routen aufbauen#ie##off("bold")# in der Task #on("b")##ib#net#ie##off("b")# werden die #ib#Routentabelle#ie#n
+   neu aufgebaut. Dies kann notwendig werden, wenn eine neue #ib#Station#ie# ans Netz
+   angeschlossen wurde (#ib#Fehlermeldung#ie# '#ib(4)#Station x gibt es nicht#ie(4)#'). #on("bold")#routen aufbauen#off ("bold")#
+   muß zuvor auch an allen dazwischenliegenden #ib#Knotenstation#ie#en gegeben werden. 
+ 
+   #on("bold")#routen aufbauen#off ("bold")# erzeugt eine Task #on("b")##ib#router#ie##off("b")#, die sich an das Terminal koppelt (die
+   Task #on("b")#net#off("b")# koppelt sich ab) und ein #ib#Protokoll#ie# ausgibt. Sind die #ib#Route#ie#n aufgebaut,
+   beendet sich die Task #on("b")#router#off("b")# mit der Meldung #on("b")#fertig#off("b")#. Es werden nur Stationen
+   bearbeitet, die nicht #ib#gesperrt#ie# (siehe S. #topage("sperre")#), und für die keine festen Routen
+   vereinbart sind. Der Vorgang dauert ca. 5 Sek. pro nicht gesperrter Station und
+   #ib#Netzkanal#ie#. Die #ib#Route#ie#n werden in einem #ib#Datenraum#ie# #on("b")##ib#port intern#ie##off("b")# hinterlegt. 
+ 
+ 
+-  Der Aufruf #on("bold")##ib#definiere netz#ie##off("bold")# leitet eine #ib#Netzdefinition#ie# in der #ib#Datei#ie# #on("bold")##ib#netz#ie##off("bold")# ein. Dabei
+   werden alle augenblicklichen Netzkommunikationen gelöscht. Die Tasks #on("b")##ib#net port#ie#
+   (k)#off("b")#, wobei #on("b")#k#off("b")# die #ib#Kanalnummer#ie# ist, und #on("b")##ib#net timer#ie##off("b")# werden gelöscht. 
+ 
+   Dieser Aufruf muß vor den Aufrufen von #on("bold")##ib#starte kanal#ie#, #ib#erlaube#ie#, #ib#sperre#ie#, #ib#routen#ie#,
+   #ib#aktiviere netz#ie# und #ib#list option#ie##off("bold")# erfolgen. 
+ 
+ 
+-  PROC #ib#sperre#ie# (INT CONST a,z) 
+   bewirkt, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# keine Manageraufrufe an Tasks dieser Station
+   geben dürfen (Genauer gesagt werden sendecodes > 6 nicht weitergeleitet, son­
+   dern ein errornak mit dem Text "#ib(4)#kein Zugriff auf Station#ie(4)#" zurückgeschickt). 
+ 
+   Dieser Aufruf muß vor dem ersten #on("bold")##ib#starte kanal#ie##off("bold")# erfolgen. 
+ 
+ 
+-  PROC #ib#erlaube#ie# (INT CONST a,z) 
+   bewirkt, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# Manageraufrufe an Tasks dieser Station geben
+   dürfen. 
+ 
+   Dieser Aufruf muß vor dem ersten #on("bold")##ib#starte kanal#ie##off("bold")# erfolgen. 
+ 
+   Beispiel: Alle Stationen außer 8 und 10 sollen #ib#gesperrt#ie# sein: 
+ 
+             #ib#sperre#ie# (1,127); erlaube (8,8); erlaube (10,10) 
+ 
+   Hinweis: 127 ist z.Zt. die maximale #ib#Stationsnummer#ie(1," maximale")#. 
+ 
+ 
+-  PROC #ib#routen#ie# (INT CONST a,z,k) 
+   legt fest, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# an #ib#Kanal#ie# #on("bold")#k#off("bold")# direkt angeschlossen sind. Sen­
+   dungen dieser Stationen werden nur bearbeitet, wenn sie über diesen Kanal her­
+   einkommen (siehe 1.7.). Fehlt für eine Station ein entsprechender Routenaufruf, so
+   darf sie über einen beliebigen #ib#Netzkanal#ie# angeschlossen sein. Dies wird dann von
+   #on("bold")##ib#routen aufbauen#ie##off("bold")# ermittelt. 
+ 
+   PROC routen (INT CONST a,z,k,zw) 
+   legt fest, daß die Stationen #on("bold")#a#off("bold")# bis #on("bold")#z#off("bold")# indirekt über die #ib#Knotenstation#ie# #on("bold")#zw#off("bold")# angeschlos­
+   sen sind, und #on("b")#zw#off("b")# am Kanal #on("bold")#k#off("bold")# hängt. 
+ 
+ 
+-  PROC #ib#starte kanal#ie# (INT CONST k,m,q) 
+   startet eine #ib#Netztask#ie# am #ib#Kanal#ie# #on("bold")#k#off("bold")# im Modus #on("bold")#m#off("bold")# [4]. Dabei wird mit #on("bold")#q#off("bold")# die Anzahl
+   paralleler #ib#Empfangsströme#ie# festgelegt. Dadurch kann erreicht werden, daß der
+   #ib#Empfangspuffer#ie# nicht überläuft, indem nicht mehr als #on("b")#q#off("b")# Ströme quittiert werden.
+   Bei #ib#V.24#ie#-#ib#Schnittstelle#ie#n gebe man 3 (ohne #ib#Flußkontrolle#ie#) bzw. 10 (mit Flußkon­
+   trolle) an. 
+ 
+ 
+-  PROC #ib#aktiviere netz#ie# 
+   muß als Abschluß in der Datei #on("bold")##ib#netz#ie##off("bold")# aufgerufen werden. Dabei wird die Task vom
+   Terminal abgekoppelt. Falls es bei #on("bold")##ib#definere netz#ie##off("bold")# den #ib#Datenraum#ie# #on("b")##ib#port intern#ie##off("b")#, der
+   die #ib#Route#ie#n enthält, nicht gab, wird #on("bold")##ib#routen aufbauen#ie##off("bold")# aufgerufen. 
+ 
+ 
+-  PROC #ib#listoption#ie##goalpage("listop")# 
+   erzeugt eine Task #on("b")##ib#net list#ie##off("b")#, die bei #on("bold")#list#off("bold")# den #ib#Fehlermeldung#ie#sreport und den Zustand
+   aller Netports liefert. Diese Task ist auch über Netz ansprechbar. In der Regel
+   sollte man #on("b")#listoption#off("b")# in der Datei #on("b")#netz#off("b")# aufrufen, es sei denn, das System ist sehr
+   klein. 
+ 
+#page# 
+ 
+1.6. #ib#Fehlersuche#ie# im Netz 
+ 
+#goalpage("1.6")# 
+ 
+#ib#Fehler#ie# im Netz können sich verschiedenartig auswirken. Im folgenden wird auf einige
+Beispiele eingegangen: 
+ 
+Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung '#ib(4)#Station#ie(4, " x antwortet nicht")# 4 antwortet nicht'. 
+ 
+ 
+#ib#Fehler#ie#möglichkeiten: 
+ 
+   -  #ib#Station#ie# 4 ist nicht eingeschaltet. 
+      Abhilfe: Station 4 einschalten. Kommando erneut geben. 
+ 
+ 
+   -  #ib#Netztask#ie# an Station 4 ist nicht arbeitsfähig. 
+      Abhilfe: Kommando #on("bold")##ib#start#ie##off ("bold")# in der Task "net" auf Station 4. 
+ 
+ 
+   -  Stationsnummern und Boxnummern stimmen nicht überein. 
+      Abhilfe: Mit #on("bold")#define station#off ("bold")# #ib#Stationsnummer#ie#n korrigieren (siehe 3.2). 
+ 
+ 
+   -  #ib#Verbindung#ie# Rechner/Box am eigenen Rechner oder an Station 4 fehlt. 
+      Abhilfe: Verbindungen überprüfen. Durch Ansprechen einer dritten Station
+               kann oft schnell geklärt werden, welche Rechner/Box-Verbindung
+               defekt sein muß. 
+ 
+ 
+   -  Verbindung der Boxen untereinander defekt. 
+      Abhilfe: Fehlende Verbindung, #ib#Masseschluß#ie# und #ib#Dreher#ie# (keine 1:1 Verbin­
+               dung) überprüfen und beheben. 
+ 
+      Hinweis: Liegt z.B. ein Masseschluß vor, so kann es durchaus sein, daß
+               Boxen, die nicht in der Nähe des Masseschlusses stehen, noch
+               miteinander arbeiten können. Man kann aus der Tatsache, daß zwei
+               Boxen miteinander arbeiten können, also nicht schließen, daß man
+               nicht nach diesem Fehler suchen muß. 
+ 
+ 
+ 
+Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. 
+ 
+ 
+   -  Station 4 ist während dieser Sendung zusammengebrochen. 
+      Abhilfe: Station 4 wieder starten. Die Bearbeitung des #on("bold")##ib#list#ie##off ("bold")#-Kommandos wird
+               automatisch wieder aufgenommen. 
+ 
+ 
+   -  PUBLIC auf Station 4 ist nicht im Managerzustand. 
+      Abhilfe: PUBLIC in den Managerzustand versetzen. 
+ 
+ 
+   -  #ib#Fehler#ie# in der #ib#Netzhardware#ie#. 
+      Überprüfen Sie, ob 
+ 
+      -  die Boxen eingeschaltet sind, 
+      -  die Bereitlampe blinkt (wenn nicht: #ib#RESET#ie# an der Box), 
+      -  die #ib#V.24#ie#-Kabel richtig stecken, 
+      -  die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5 poli­
+         gen Diodenbuchsen). 
+ 
+ 
+   -  Fehler bei der #ib#Netzinstallation#ie#. 
+      Überprüfen Sie, ob 
+ 
+      -  alle Stationen an einem #ib#Strang#ie# gleiche oder kompatible Netzmodi einge­
+         stellt haben [4], 
+      -  alle Stationen an einem #ib#Netzstrang#ie# auf die gleiche #ib#Nutzdatenlänge#ie# einge­
+         stellt sind, 
+      -  bei der #ib#Kommunikation#ie# über #ib#Knoten#ie# alle Stationen die gleiche Nutzdaten­
+         länge bei indirekten Sendungen eingestellt haben, 
+      -  die #ib#Route#ie#n auf allen beteiligten Stationen korrekt eingestellt sind. 
+ 
+ 
+ 
+Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung '#ib(4)##ib#Collectortask#ie# fehlt#ie(4)#'. 
+ 
+   -  Das Kommando #on("b")##ib#start#ie##off("b")# (bzw #on("b")##ib#aktiviere netz#ie##off("b")# in der #ib#Datei#ie# #on("b")#netz#off("b")#) wurde nicht gege­
+      ben. Somit existiert #on("b")##ib#net port#ie##off("b")# nicht. 
+      Abhilfe: Kommando #on("bold")#start#off ("bold")# in der Task #on("b")#net#off("b")# geben. 
+ 
+ 
+   -  Die #ib#Netzsoftware#ie# ist auf einen nicht vorhergesehenen #ib#Fehler#ie# gelaufen. Dieser
+      wird im #ib#Report#ie# vermerkt. #on("b")##ib#net port#ie##off("b")# wird dabei gelöscht. 
+      Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die
+               Netzsoftware neu gestartet. Alle Netzkommunikationen dieser Station
+               gehen verloren. 
+ 
+ 
+ 
+Beispiel: 
+ 
+   Nach #on("bold")##ib#fetch#ie# ("hugo",4/public)#off("bold")# sind Teile der Datei "hugo" verfälscht. 
+ 
+   -  Die #ib#V.24#ie#-#ib#Verbindung#ie# zur Box ist nicht in Ordnung. 
+      Abhilfe: Abstand zwischen Rechner und Box verkürzen; #ib#Baud#ie#rate ernie­
+               drigen; durch Wechseln der #ib#V.24#ie#-#ib#Schnittstelle#ie# feststellen, ob diese
+               defekt ist. 
+      Hinweis: Die Verbindung zwischen den Boxen ist durch #ib#Prüfsummen#ie# abge­
+               sichert (Hardware). 
+ 
+#page# 
+ 
+1.7. Sicherheit im Netz 
+ 
+#goalpage("1.7")# 
+ 
+Bei Benutzung eines Rechnernetzes tauchen neue #ib#Sicherheitsprobleme#ie# auf. Um sie
+verstehen und eingrenzen zu können, muß man sich mit dem #ib#Sicherheitskonzept#ie# des
+Betriebssystems EUMEL vertraut machen: 
+ 
+Eine Task im EUMEL kann nur manipuliert werden, wenn man sie entweder an ein
+Terminal koppelt oder ihr Sendungen zustellt. 
+ 
+Das Ankoppeln kann über #ib#Paßwort#ie# abgesichert werden. Nach dem Ankoppeln kann
+die Task außerdem selbst bestimmen, wie sie die dann möglichen Eingaben behan­
+delt. So kann z.B. noch ein komplizierter Paßalgorithmus zu durchlaufen sein, bis
+man auf einer offenen Programmierumgebung landet. 
+ 
+Sendungen können eine Task auch nur mit ihrem Einverständnis beeinflussen, da
+eine Sendung nur zugestellt wird, wenn die Task in der Prozedur #on("b")##ib#wait#ie##off("b")# steht. Insbe­
+sondere kann die Task den Absender einer Sendung überprüfen und gewisse Opera­
+tionen nur bei gewissen Absendern zulassen. So lehnt ein #on("b")##ib#global manager#ie##off("b")# z.B. alle
+Dateimanagerkommandos ab, die nicht von Nachkommen (z.B. Söhnen) der Task
+kommt. #on("b")##ib#free global manager#ie##off("b")# hingegen läßt Operationen wie #on("b")##ib#save#ie##off("b")# oder #on("b")##ib#erase#ie##off("b")# von
+beliebigen Tasks, auch von fremden #ib#Station#ie#en, zu. Will man nur bestimmte Fremd­
+stationen zulassen, kann man z.B. folgendes Schema verwenden: 
+ 
+   PROC my #ib#manager#ie# 
+      (DATASPACE VAR ds, INT CONST code, phase, TASK CONST source): 
+ 
+     IF station (source) = station (myself) OR station (source) = 10 
+     THEN 
+       free manager (ds, code, phase, source) 
+     ELSE 
+       errorstop ("kein Zugriff") 
+     FI 
+ 
+  END PROC my manager; 
+ 
+  global manager (PROC my manager) 
+#page# 
+Hier werden nur #on("b")#save#off("b")# usw. von Tasks der eigenen Station und der Station 10 zuge­
+lassen. Der Rest erhält die #ib#Fehlermeldung#ie# "kein Zugriff". 
+ 
+Dieses Verfahren gewährt nur dann Sicherheit, wenn es nicht möglich ist, daß eine
+beliebige Station sich als Station 10 ausgibt. 
+ 
+Damit das Netz diese Sicherheit garantieren kann, müssen natürlich gewisse phy­
+sische Voraussetzungen erfüllt sein. Wenn z.B. die Station 10 über eine #ib#V.24#ie# ange­
+schlossen ist, aber jeder die Möglichkeit hat, an diese #ib#Schnittstelle#ie# seinen eigenen
+Rechner anzuschliessen, dann kann das Netz natürlich nicht erkennen, ob es mit der
+echten Station 10 verkehrt. 
+ 
+Es muß also sichergestellt sein, daß an Kanälen für das Netz nicht manipuliert werden
+kann. Bei einem #ib#Strang#ie# (Anschluß über #ib#Netzbox#ie#en) heißt das für die Boxen, daß sie
+nur #ib#Telegramm#ie#e weitervermitteln, die die eingestellte #ib#Quellstationsnummer#ie# enthalten.
+Sonst könnte jemand, der an denselben Strang wie #ib#Station#ie# 10 angeschlossen ist,
+#ib#Telegramm#ie#e erzeugen, die so aussehen, als kämen sie von 10. 
+ 
+Die #ib#Netzsoftware#ie# ihrerseits darf nur Telegramme auswerten, die über die richtige
+#ib#Route#ie# (#ib#Kanal#ie# und #ib#Knotenstation#ie#) einlaufen. 
+ 
+Leider hat dies die unangenehme Konsequenz, daß man automatisches Aufbauen und
+Ändern von Routen verbieten muß, wodurch die Wartung der #ib#Netzkonfiguration#ie#
+erschwert wird. 
+ 
+Diese Version der #ib#Netzsoftware#ie# bietet den folgenden Kompromiß an: Nur für sicher­
+heitsrelevante #ib#Stationen#ie(1,", sicherheitsrelevante")# (im Beispiel Station 10) muß in der #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# die Route
+angegeben werden. Dies muß in allen Stationen geschehen, für die die Station
+sicherheitsrelevant ist, und in allen #ib#Knoten#ie# dazwischen. 
+ 
+Für nicht sicherheitsrelevante Stationen werden #ib#Routeninformationen#ie# automatisch
+aufgebaut und geändert. 
+ 
+Hinweis: 
+Man wird oft ohne sicherheitsrelevante Stationen auskommen, indem man auf Ebenen
+oberhalb der Netzebene Paßwortkontrollen einführt. So ist es z.B. ja möglich, Dateien
+durch Paßworte zu schützen. Ein weiteres Beispiel ist ein #ib#Printerserver#ie#, der nur
+ausdruckt, wenn eine mitgegebene Abrechnungskennung stimmt. Dabei ist es sogar
+wünschenswert, daß die #ib#Station#ie# irrelevant ist, die den Druckauftrag gibt. 
+#pagenr ("%",21)##setcount (1)##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Teil 2 :  Arbeitsweise der Netzsoftware 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right#GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+#page# 
+ 
+Teil 2: Arbeitsweise der Netzsoftware 
+#goalpage("2")# 
+ 
+ 
+ 
+2.1. Die Netztask 
+#goalpage("2.1")# 
+ 
+ 
+In diesem Kapitel wird beschrieben, wie eine #ib#Netztask#ie# in das System eingebettet ist
+und welche Aufgaben sie hat. Unter Einhaltung dieser Konzepte kann die ausgeliefer­
+te Netzsoftware so geändert werden, daß sie beliebige andere #ib#Netzhardware#ie# unter­
+stützt. Die Netzsoftware ist so gegliedert, daß i.allg. nur eine hardwareabhängige
+Komponente ausgetauscht werden muß (siehe Teil 3). 
+ 
+Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem
+#ib#Rendezvouskonzept#ie#: Die #ib#Zieltask#ie# einer Sendung muß empfangsbereit sein, wenn die
+#ib#Quelltask#ie# sendet. 
+ 
+Die Kommunikationsprozeduren auf der niedrigsten Ebene sind #on("bold")##ib#send#ie##off ("bold")# (Senden) und
+#on("bold")##ib#wait#ie##off ("bold")# (Warten auf Empfang). Bei der Kommunikation werden ein Integer #on("bold")#code#off ("bold")# und ein
+#ib#Datenraum#ie# #on("bold")#dr#off ("bold")# übergeben. #on("bold")#code#off ("bold")# muß >= 0 sein, da negative Codes systemintern ver­
+wandt werden. Ist die empfangende Task an einen #ib#Kanal#ie# gekoppelt (#on("bold")##ib#continue#ie##off ("bold")#), so
+führt eine Zeicheneingabe auf diesem Kanal dazu, daß eine Sendung mit dem Code
+-4 ankommt. Die Eingabedaten müssen mit den üblichen #ib#Eingabeprozeduren#ie# (#on("bold")##ib#inchar#ie##off ("bold")#
+usw.) abgeholt werden. Der übermittelte #ib#Datenraum#ie# und die Absendertask sind dabei
+ohne Bedeutung und dürfen nicht interpretiert werden. 
+ 
+Die Prozedur #on("bold")#send#off ("bold")# hat einen #ib#Rückmeldeparameter#ie#, der besagt, ob die Sendung
+übermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im #on("bold")#wait#off ("bold")#, so kann die
+Sendung nicht übermittelt werden. 
+ 
+Ein Entwicklungskriterium für das EUMEL-Netz war es, möglichst wenig Unterstüt­
+zung von der virtuellen EUMEL-Maschine (#ib#EUMEL0#ie#) zu fordern, damit weitgehend in
+ELAN programmiert werden kann. Dadurch ist es möglich, eine (privilegierte) Task mit
+der Netzabwicklung zu betrauen. 
+#page# 
+Zunächst wird auf die #ib#EUMEL0#ie#-Unterstützung eingegangen: 
+ 
+a)  Es gibt die Prozedur #on("bold")##ib#define collector#ie##off ("bold")#, mit der die für das Netz verantwortliche
+    Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im fol­
+    genden #ib#Collector#ie# genannt. 
+ 
+b)  Es gibt die Prozedur #on("bold")##ib#define station#ie##off ("bold")#, die für den Rechner eine #ib#Stationsnummer#ie#
+    einstellt. Anhand dieser Nummer werden die Rechner eines Netzes unterschie­
+    den. Das Einstellen bewirkt, daß für alle Tasks die Stationsnummer in ihre
+    #ib#Task-Id#ie# eingetragen wird (Task-Id's sind die Werte, die der Typ TASK anneh­
+    men kann). 
+ 
+c)  Der Befehl #on("bold")##ib#station#ie# (task)#off ("bold")# liefert die Stationsnummer der #on("bold")#task#off ("bold")#. So liefert z.B.
+    #on("bold")##ib#station#ie# (myself)#off ("bold")# die #ib#Stationsnummer#ie# des eigenen Rechners. 
+ 
+d)  Eine Sendung, deren #ib#Zieltask#ie# auf einem anderen Rechner liegt (also station (ziel)
+    <> station (myself)), wird auf die #ib#Collectortask#ie# geleitet. 
+ 
+e)  Es gibt eine Prozedur #on("bold")##ib#collected destination#ie##off ("bold")#, die es dem Collector erlaubt, die
+    eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. 
+ 
+f)  Es gibt eine Variante der Prozedur #on("bold")##ib#send#ie##off ("bold")#, die es dem Collector gestattet, der
+    #ib#Zieltask#ie# eine andere Task als Absender vorzutäuschen. 
+ 
+g)  Es gibt eine spezielle #ib#Task-Id#ie# #on("bold")##ib#collector#ie##off ("bold")#, durch die der augenblicklich eingestell­
+    te #ib#Collector#ie# erreicht wird. Diese wird als Zieltask beim Aufruf der Vermittlungs­
+    dienste angegeben (siehe S. #topage("collector")#). Eine Sendung an #on("bold")#collector#off ("bold")# wird von EUMEL0
+    an den derzeitig eingestellten Collector geschickt. 
+ 
+Ein Collector kann also auf drei Wegen von den übrigen Tasks desselben Rechners
+Sendungen erhalten: 
+ 
+  1. Über ein normales #on("b")#send#off("b")# (z.B. bei #on("bold")#list (/"net port")#off ("bold")#, wenn #on("b")#net port#off("b")# der derzeitige
+     #ib#Collector#ie# ist), 
+ 
+  2. über ein #on("b")#send#off("b")# an die Task #on("bold")#collector#off ("bold")# (s.u.) und 
+ 
+  3. als umgeleitete Sendung (z.B. bei #on("bold")#list#off ("bold")# an eine Task auf einem anderen
+     Rechner). 
+ 
+Der Collector kann diese Fälle anhand von #on("bold")#collected destination#off ("bold")# unterscheiden. 
+ 
+Die Punkte d) bis f) dienen dazu, den Collector für über Netz kommunizierende Tasks
+unsichtbar zu machen: Der Collector taucht nicht als Ziel oder #ib#Quelle#ie# von Sendungen
+auf. Das ist notwendig, damit normale Tasks sich nicht darum kümmern müssen, ob
+eine Sendung übers Netz geht oder im eigenen Rechner bleibt. 
+ 
+Wenn ein #ib#Datenraum#ie# an einen anderen Rechner geschickt wird, muß der gesamte
+Inhalt (z. Zt. max. 1 MB) übertragen werden. Dies macht bei der üblichen Netzhard­
+ware eine Zerlegung in #ib#Paket#ie#e nötig [5]. Bei der Zerlegung eines Datenraumes in
+Pakete (#ib#Telegramm#ie#e) gelten folgende Einschränkungen: 
+ 
+  -  Ein Paket kann maximal eine #ib#Datenraumseite#ie# als #ib#Nutzdaten#ie# enthalten. 
+ 
+  -  Die #ib#Nutzdatenlänge#ie# ist für einen #ib#Übertragungsweg#ie# konstant. 
+ 
+  -  Alle Stationen eines #ib#Netzstrang#ie#s senden mit gleicher Nutzdatenlänge (#on("b")##ib#data
+     length#ie##off("b")#). 
+ 
+  -  Bei indirekter #ib#Kommunikation#ie(1,"indirekte")# (über #ib#Knoten#ie#) muß die Nutzdatenlänge für in­
+     direkte Verbindungen (#on("b")##ib#data length via node#ie##off("b")#) auf allen beteiligten Stationen
+     gleich eingestellt sein. 
+ 
+ 
+Für Netze stehen spezielle Blockbefehle zur Verfügung: 
+ 
+ 
+g)  #ib#blockin#ie# / #ib#blockout#ie# (dr,seite,512+abstand,anzahl,rest) 
+ 
+    Es werden maximal #on("bold")#anzahl#off ("bold")# Bytes transferiert. In #on("bold")#rest#off ("bold")# wird zurückgemeldet, wie
+    viele Bytes nicht bearbeitet wurden (z.B. weil der #ib#Kanal#ie# nichts anliefert). Bear­
+    beitet werden die Bytes 
+ 
+       #on("bold")#seite#off ("bold")# * 512 + #on("bold")#abstand#off ("bold")# 
+ 
+    bis maximal 
+ 
+       #on("bold")#seite#off ("bold")# * 512 + #on("bold")#abstand#off ("bold")# + #on("bold")#anzahl#off ("bold")# - 1 
+ 
+    Der Kanal, an den die Task gekoppelt ist, wird dabei über #ib#Stream-IO#ie# (d.h.
+    #on("bold")##ib#incharety#ie##off ("bold")#, bei #on("bold")#blockin#off ("bold")# bzw. #on("bold")#out#off ("bold")# bei #on("bold")#blockout#off ("bold")#) angesprochen. 
+ 
+    Hinweis: Die Anforderung darf nicht über #ib#Seitengrenze#ie# gehen, d.h. 
+ 
+    #on("bold")#abstand#off ("bold")# + #on("bold")#anzahl#off ("bold")# <= 512 
+ 
+    muß erfüllt sein. 
+ 
+ 
+Eine Netzsendung läuft wie folgt ab: 
+ 
+Die Task q auf Rechner rq mache ein #on("bold")##ib#send#ie##off ("bold")# an die Task z auf Rechner rz. 
+ 
+1. Die Prozedur #on("bold")#send#off ("bold")# ist ein #ib#EUMEL0#ie#-Befehl. Die EUMEL0-Ebene erkennt, daß die
+   Sendung an die #ib#Station#ie# rz geht, da die #ib#Stationsnummer#ie# in der #ib#Task-Id#ie# enthalten
+   ist. Daher wird die Sendung zum #ib#Collector#ie# umgeleitet, den EUMEL0 wegen der
+   Einstellung durch #on("bold")##ib#define collector#ie##off ("bold")# kennt, umgeleitet. 
+ 
+2. Die Task Collector empfängt über #on("bold")##ib#wait#ie##off ("bold")# den #ib#Datenraum#ie#, den #ib#Sendecode#ie# und die
+   Absendertask q. Die #ib#Zieltask#ie# z erfährt sie durch #on("bold")##ib#collected destination#ie##off ("bold")#. 
+ 
+3. Der Collector nimmt Kontakt mit dem Collector des Rechners #on("b")#rz#off("b")# auf, dessen Sta­
+   tionsnummer ja #on("bold")##ib#station#ie#(z)#off ("bold")# ist, und übermittelt diesem Sendecode, #ib#Quelltask#ie# (q),
+   eigentliche Zieltask (z) und den #ib#Datenraum#ie#. Da die Collectoren in ELAN geschrie­
+   ben sind, können sie an beliebige #ib#Netzhardware#ie# und #ib#Protokoll#ie#e angepaßt werden. 
+ 
+4. Der #ib#Collector#ie# auf Rechner #on("b")#rz#off("b")# verwendet das spezielle #on("bold")#send#off ("bold")#, um der Zieltask die
+   Sendung zuzustellen. Dadurch erscheint nicht der Collector, sondern die Task #on("b")#q#off("b")#
+   als Absender der Sendung. 
+ 
+Zur Abwicklung der #ib#Vermittlungsebene#ie# (siehe S. #topage("vermittlung")#) muß der Collector noch spe­
+zielle Funktionen beherrschen. Diese sind 
+ 
+   der #on("b")##ib#/#ie#-Operator#off("b")# (Taskname in #ib#Task-Id#ie# wandeln) und 
+   die #on("b")##ib#name#ie##off("b")#-Prozedur (Task-Id in Namen wandeln). 
+ 
+Der #on("b")#/#off("b")#-Operator macht eine Sendung an den #on("bold")##ib#collector#ie##off ("bold")#, wobei im #ib#Datenraum#ie# der Name
+der Task steht und der #ib#Sendecode#ie# gleich der Stationsnummer ist (siehe [6] ). Der
+#ib#Collector#ie# setzt sich mit dem Collector dieser Station in Verbindung, damit dieser die
+Task-Id ermittelt und zurückschickt. Der eigene Collector schickt dann dem #on("b")#/#off("b")#-Oper­
+ator als Antwort einen Datenraum, der die #ib#Task-Id#ie# enthält. 
+ 
+Umgekehrt läuft #on("bold")##ib#name#ie##off ("bold")# ab: Wenn die Task-Id von einer fremden Station ist, schickt
+#on("bold")#name#off ("bold")# eine Sendung an den #on("bold")##ib#collector#ie##off ("bold")#, wobei im Datenraum die Task-Id steht und
+Sendecode = 256 ist. Der Collector entnimmt die #ib#Stationsnummer#ie# der Task aus der
+Task-Id und läßt sich vom entsprechenden Collector den Tasknamen geben. Dieser
+wird der #on("bold")#name#off ("bold")#-Prozedur im Antwortdatenraum übergeben. 
+ 
+Netztasks bauen sich #ib#Routentabellen#ie# auf (#ib#Datei#ie#name #on("b")##ib#port intern#ie##off("b")#). Aufgrund dieser
+Tabellen weiß jede #ib#Netztask#ie#, über welchen #ib#Kanal#ie# und welche #ib#Nachbarstation#ie# eine
+#ib#Zielstation#ie# erreichbar ist. Wenn der #ib#Collector#ie# einen Sendeauftrag erhält, prüft er, ob
+die Zielstation über seinen Kanal erreichbar ist. Wenn nicht, leitet er Parameter und
+#ib#Datenraum#ie# der Sendung an die geeignete Netztask weiter. 
+#page# 
+ 
+2.2. Ebenen 
+ 
+#goalpage("2.2")# 
+ 
+In diesem Kapitel werden die #ib#Protokollebenen#ie# für das Netz beschrieben, wie sie die
+ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer Netzhardware als Daten­
+boxen müssen die Ebenen a) bis c) ausgetauscht werden [4]. Unter Einhaltung der im
+vorigen Kapitel beschriebenen Randbedingungen können auch die höheren Ebenen
+geändert werden. 
+ 
+ 
+a) Physikalische Ebene 
+ 
+   -  #ib#Station#ie# <--> Box 
+ 
+      #ib#V.24#ie#-#ib#Schnittstelle#ie# mit #ib#RTS/CTS#ie#-Handshake. Vollduplex. 
+ 
+   -  Box <--> Box 
+ 
+      #ib#RS422#ie# über 2 verdrillte Leitungspaare (Takt und Daten). 
+ 
+ 
+b) Verbindungsebene 
+ 
+   -  Station <--> Box 
+ 
+      Asynchron 
+      8 Bit 
+      Even Parity 
+      2400/4800/9600/19200 #ib#Baud#ie# einstellbar über Lötbrücken) 
+ 
+   -  Box <--> Box 
+ 
+      #ib#SDLC#ie# 
+      400 KBaud 
+#page# 
+c) #ib#Netzebene#ie# 
+#goalpage("quelle")# 
+ 
+   -  Station <--> Box 
+ 
+      #ib#Telegrammformat#ie#:  #ib#STX#ie#, <n>, <ziel>, <#ib#quelle#ie#>, <(n-4) byte> 
+ 
+      <n> ist #ib#Längenangabe#ie# ( 8 <= n <= 160) 
+      <ziel>, <quelle> sind #ib#Stationsnummer#ie#n. Diese müssen an den jeweiligen
+      Boxen eingestellt sein. 
+ 
+      Box --> Station: 
+ 
+      Ein #ib#Telegramm#ie# kommt nur bei der #ib#Station#ie# an, bei deren Box die Nummer
+      <ziel> eingestellt ist. Dadurch ist ein Mithören fremder #ib#Übertragung#ie# nicht
+      möglich (Datenschutz). 
+ 
+      Zwischen Telegrammen können #ib#Fehlermeldung#ie#en der Box (Klartext) übermittelt
+      werden (z.B. 'skipped x', wenn ein #ib#STX#ie# von der Box erwartet wurde, aber 'x'
+      von der Station ankommt). 
+ 
+      Station --> Box: 
+ 
+      Ein Telegramm wird nur abgeschickt, wenn <#ib#quelle#ie#> mit der eingestellten
+      Nummer übereinstimmt (Datenschutz: Man kann nicht vorschwindeln, eine
+      beliebige Station zu sein, es sei denn, man hat physischen Zugriff zur Box und
+      stellt dort die Stationsnummer um). 
+ 
+   -  Box <--> Box 
+ 
+      #ib#Telegrammformat#ie#: 
+          FRAME, <ziel>, <#ib#quelle#ie#>, <daten>, <CRC-Code> 
+ 
+      Eine #ib#Längenangabe#ie# ist nicht nötig, da #ib#SDLC#ie# eine Rekonstruktion der Länge
+      erlaubt. 
+ 
+      Telegramme mit falschen #ib#CRC-Code#ie# werden vernichtet. Auf höheren Ebenen
+      muß dies durch #ib#Zeitüberwachung#ie# erkannt und behandelt werden. 
+ 
+#page# 
+d) Transportebene 
+ 
+   Diese Ebene wickelt das Rendezvous zwischen einer Task, die #on("bold")##ib#send#ie##off ("bold")# macht, und
+   einer Task, die im #on("bold")##ib#wait#ie##off ("bold")# steht, ab [1]. 
+ 
+   Der im #on("bold")#send#off ("bold")# angegebene #ib#Datenraum#ie# wird als Folge von #ib#Seiten#ie# (im EUMEL-
+   Sinne: Pagingeinheit und Allokiereinheit) übermittelt, wobei jede Seite ggf. noch in
+   n Byte große Stücke zerlegt wird. Es werden nur echt allokierte Seiten übermit­
+   telt. Um nicht jedes #ib#Telegramm#ie# voll qualifizieren zu müssen, wird zunächst eine
+   Art virtuelle #ib#Verbindung#ie# durch ein #ib#OPEN#ie#-Telegramm eröffnet. Danach folgen
+   variabel viele #ib#DATA#ie#-Telegramme. Beide Sorten werden durch #ib#QUIT#ie#-Tele­
+   gramme quittiert, um folgende Funktionen zu ermöglichen: 
+ 
+   #ib#Flußkontrolle#ie# (z.B. Zielrechner langsam), 
+   Wiederaufsetzen (verlorene Telegramme), 
+   Abbruch (z.B. weil Zieltask inzwischen beendet). 
+ 
+   Ein #ib#CLOSE#ie#-Telegramm ist nicht nötig, da das letzte DATA-Telegramm als
+   solches erkannt werden kann (siehe unten). 
+#page# 
+   -  #ib#OPEN#ie#-Telegramm 
+ 
+#clear pos# 
+    0      1      2      3      4      5      6      7      8      9. Byte 
++------+------+------+------+-------------+-------------+-------------------+ 
+I STX  I  24  I Ziel IQuelleI Endziel     I Endquelle   I Strom             I 
++------+------+------+------+-------------+-------------+-------------------+ 
+ 
+   10     11     12     13     14     15     16     17                
++-------------+-------------+---------------------------+ 
+I Sequenz     I  Seite      I  Quelltask                I 
++-------------+-------------+---------------------------+ 
+ 
+   18     19     20     21     22     23                           
++---------------------------+-------------+ 
+I  Zieltask                 I  Code       I 
++---------------------------+-------------+ 
+ 
+ 
+ 
+          <#ib#ziel#ie#>, <#ib#quelle#ie#> siehe S. #topage("quelle")# 
+ 
+          <#ib#endziel#ie#>    Eigentliche #ib#Zielstation#ie#. Ist <ziel> = <endziel>, so ist
+                       das #ib#Telegramm#ie# angekommen. Andernfalls muß die Station
+                       <ziel> den #ib#Nachbarn#ie# zum Erreichen des <endziel> als
+                       neues <ziel> einsetzen und das Telegramm an diesen
+                       Nachbarn weiterleiten. 
+ 
+          <#ib#endquelle#ie#>  Eigentliche #ib#Absenderstation#ie#. <quelle> ist dagegen immer
+                       die Nummer der sendenden #ib#Nachbarstation#ie#. 
+ 
+          <#ib#strom#ie#>      Die #ib#Stromnummer#ie# identifiziert die virtuelle #ib#Verbindung#ie#. Sie
+                       muß in den #ib#QUIT#ie#-Telegrammen angegeben werden. 
+ 
+          <#ib#sequenz#ie#>    -1 (Kennzeichen für OPEN) 
+ 
+          <#ib#seite#ie#>      Nummer der ersten echt allokierten #ib#Seite#ie# des #ib#Datenraum#ie#s
+                       (=-1, falls Nilspace) 
+ 
+          <#ib#quelltask#ie#>  #ib#Task-Id#ie# der sendenden Task 
+ 
+          <#ib#zieltask#ie#>   Task-Id der empfangenden Task 
+ 
+          <code>       Wert des im #on("bold")##ib#send#ie##off ("bold")# angegebenen Codes 
+#page# 
+   -  #ib#DATA#ie#-Telegramm 
+ 
+ 
+ 
+ 
+ 
+    0      1      2      3      4      5      6      7      8      9. Byte    
++------+------+------+------+-------------+-------------+-------------------+ 
+I STX  I LängeI Ziel IQuelleI Endziel     I Endquelle   I Strom             I 
++------+------+------+------+-------------+-------------+-------------------+ 
+ 
+   10     11     12     13     14                                       
++-------------+-------------+-----------------------------------------------+ 
+I Sequenz     I Seite       I n Byte Daten  (Länge = 14 + n)                I 
++-------------+-------------+-----------------------------------------------+ 
+
+ 
+          <#ib#laenge#ie#>     Gesamtlänge des Telegramms. 
+                       #on("b")#laenge#off("b")# = #on("b")##ib#nutzlaenge#ie##off("b")# + 14. 
+                       Für #on("b")#nutzlaenge#off("b")# sind nur die Werte 64,128,256 und 512
+                       zugelassen (siehe 1). #on("b")#laenge#off("b")# wird codiert dargestellt (siehe
+                       Teil 3). 
+ 
+ 
+          <#ib#sequenz#ie#>    wird von Telegramm zu Telegramm hochgezählt. Sie dient
+                       der Überwachung bzgl. verlorengegangener Telegramme
+                       bzw. durch #ib#Zeitüberwachung#ie# verdoppelter Telegramme. 
+ 
+          <#ib#seite#ie#>      Nummer der x-ten echt allokierten Seite des #ib#Datenraum#ie#s
+                       (x = ((<sequenz> DIV anzahl pakete pro seite) + 2) 
+ 
+          <n byte>     #ib#Nutzinformation#ie#. Diese gehört zur #ib#Adresse#ie# a des Daten­
+                       raums. 
+ 
+                       a = 
+                       N (<sequenz> DIV anzahl pakete pro seite + 1) * 512 
+                           + (<sequenz> MOD anzahl pakete pro seite) * n 
+ 
+                       wobei N (x) die Nummer der x-ten Seite und 
+                       n die #ib#Nutzdatenlänge#ie# ist. 
+ 
+                       Aus den Formeln ergibt sich, daß diese Nummer schon in
+                       einem vorhergehenden DATA/OPEN-Telegramm über­
+                       mittelt wurde (im Feld <seite>). 
+ 
+   -  #ib#QUIT#ie#-Telegramm 
+ 
+ 
+    0      1      2      3      4      5      6      7      8      9. Byte    
++------+------+------+------+-------------+-------------+-------------------+ 
+I STX  I  12  I Ziel IQuelleI Endziel     I Endquelle   I Strom             I 
++------+------+------+------+-------------+-------------+-------------------+ 
+ 
+   10     11                                                    
++-------------+ 
+I Quit        I 
++-------------+ 
+ 
+ 
+ 
+          <#ib#strom#ie#>      muß die #ib#Stromnummer#ie# sein, die in dem #ib#OPEN#ie#/#ib#DATA#ie#­
+                       Telegramm stand, das quittiert wird. 
+ 
+          <quit>       0 :  ok. Nächstes Telegramm schicken. 
+ 
+                       -1:  #ib#Übertragung#ie# neu starten (mit #ib#OPEN#ie#), weil die Emp­
+                            fangsstation das OPEN nicht erhalten hat. 
+ 
+                       -2:  Übertragung ca. 20 Telegramme zurücksetzen. 
+ 
+                       -3:  Übertragung abbrechen. 
+ 
+                       -4:  #ib#Quittung#ie# für letztes Telegramm einer Sendung. 
+ 
+ 
+e) #ib#Vermittlungsebene#ie##goalpage("vermittlung")# #goalpage("collector")# 
+ 
+   Diese Ebene ist dafür zuständig, Namen von Tasks auf anderen Stationen in
+   #ib#Task-Id#ie#'s (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im
+   entsprechenden #ib#OPEN#ie#-Telegramm der Code -6 (bzw. -7) als <code> ein­
+   getragen. Die #ib#Netzempfangstask#ie# erkennt diese #ib#Codes#ie# und wickelt die Aufgaben
+   selbst ab, so daß es dabei nicht nötig ist, irgendeine Task-Id der #ib#Zielstation#ie# zu
+   kennen. 
+ 
+   Dieses Verfahren ist möglich, weil im #on("bold")##ib#send#ie##off ("bold")# nur positive Codes erlaubt sind. 
+#page# 
+f) #ib#Höhere Ebenen#ie# 
+ 
+   Höhere Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem Send/
+   Wait-Konzept des EUMEL. So gibt es z.B. den #on("bold")##ib#global manager#ie##off ("bold")#, der Aufbewah­
+   rung und Zugriff von #ib#Datei#ie#en in einer Task regelt. Dabei darf diese Task (bei der
+   Variante #on("bold")##ib#free global manager#ie##off ("bold")#) auf einer beliebigen #ib#Station#ie# im Netz liegen. Wegen
+   des #ib#Rendezvous-Konzept#ie#s können beliebige Sicherheitsstrategien benutzt werden
+   (z.B.: keine Dateien an Station 11 ausliefern). Von großem Wert ist z.B., daß
+   man ohne weiteres das Archiv (Floppylaufwerk) einer anderen Station anmelden
+   und benutzen kann, wodurch eine einfache Konvertierung von Floppyformaten
+   möglich ist. Dies ist möglich, weil auch die Archiv-Task der Stationen sich an
+   das Globalmanagerprotokoll halten. 
+ 
+ 
+ 
+ 
+ 
+Bemerkungen 
+ 
+#ib#Fehlerbehandlung#ie# besteht bis Ebene c) darin, fehlerhafte #ib#Telegramm#ie#e einfach zu
+entfernen. Die Ebene d) überwacht den Netzverkehr sowieso über #ib#Timeout#ie#s, die eine
+Wiederholung eines Telegrammes bewirken, wenn die #ib#Quittung#ie# ausbleibt. 
+ 
+Da bei der sendenden #ib#Station#ie# der ganze #ib#Datenraum#ie# zur Verfügung steht, ist eine
+#ib#Fenstertechnik#ie# (wie bei #ib#HDLC#ie#) nicht nötig. Es kann zu jedem Zeitpunkt um beliebig
+viele Telegramme zurückgesetzt werden. 
+ 
+Da im EUMEL eine #ib#Textdatei#ie# ein #ib#Datenraum#ie# mit sehr komplexer Struktur ist (wegen
+der Insert/Delete-Möglichkeiten, ohne den Rest der #ib#Datei#ie# zu verschieben), ist es ein
+hoher Aufwand, von einem fremden Betriebssytem aus eine Textdatei in das
+EUMEL-Netz zu senden. Für solche Zwecke muß noch eine einfachere Dateistruktur
+definiert und entsprechende Dateikonverter erstellt werden. 
+#page# 
+ 
+2.3. Stand der Netzsoftware 
+ 
+#goalpage("2.3")# 
+ 
+Das EUMEL-System wickelt die Prozedur #on("bold")##ib#send#ie##off("bold")# über das Netz ab, wenn die Sta­
+tionsnummer der #ib#Zieltask#ie# ungleich der eigenen #ib#Stationsnummer#ie# ist. Umgekehrt kann
+man der von der Prozedur #on("bold")##ib#wait#ie##off("bold")# gelieferten Absendertask die #ib#Absenderstation#ie# entneh­
+men (siehe Prozedur #on("bold")##ib#station#ie##off("bold")# in Teil 1). 
+ 
+Anders als bei einem #on("bold")##ib#send#ie##off("bold")# innerhalb einer Station meldet ein #on("bold")#send#off("bold")# an eine Task einer
+fremden Station immer 0 zurück (Task gibt es und Task war im wait), obwohl dies
+nicht der Fall sein muß. Ist die Sendung vollständig zur Zielstation übertragen, so
+versucht der dortige #ib#Collector#ie# diese hundertmal im Sekundenabstand zuzustellen.
+Bleibt das erfolglos, wird die Sendung vernichtet. 
+#pagenr ("%", 33)##setcount (1)##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Teil 3 :  Netz Hardware Interface 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right#GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+#page# 
+ 
+Teil 3: Netz-Hardware-Interface      
+ 
+ 
+#goalpage("3")# 
+ 
+ 
+3.1. Einführung 
+ 
+ #goalpage("3.1")# 
+ 
+In diesem Teil der Netzbeschreibung wird die #ib#Schnittstelle#ie# beschrieben, über die
+#ib#Netzhardware#ie# (also #ib#Datenbox#ie#en, #ib#Netzbox#ie#en oder Netzkarten) an die EUMEL-Netz­
+Software angepaßt werden kann. Dieser Teil der Beschreibung ist also nur für Netz­
+implementatoren wichtig. 
+ 
+Das EUMEL-Netz wurde dazu konzipiert, zwei oder mehr EUMEL-Rechner über
+#ib#V.24#ie#-Leitungen oder Datenboxen miteinander zu vernetzen. Dem heutigen Stand der
+Technik entsprechend, werden auf dem Markt eine Reihe von Möglichkeiten ange­
+boten, um PC's zu vernetzen. Diese Netze unterscheiden sich auch dadurch, daß
+unterschiedliche Medien zur Datenübertragung benutzt werden. Das #ib#EUMEL-
+Datenboxen-Netz#ie# benutzt Telefonkabel, #ib#Ethernet#ie# beispielsweise Koax-Kabel. Auch
+Lichtleiter werden zur Datenübertragung benutzt. Entsprechend gibt es eine ganze
+Menge Hardware (#ib#Treiber#ie#, Netzzugangsgeräte, Datenboxen, Anschlußkarten), die die
+Kopplung zwischen einem #ib#I/O-Kanal#ie# eines Rechners und dem Übertragungsmedium
+(Kabel) übernimmt. Das Netz-Hardware-Interface soll als #ib#Schnittstelle#ie# zwischen der
+Netz­Software und dem Treiber dienen. Damit wird es möglich, mehrere EUMEL-
+Rechner über verschiedene (Teil-) Netze (in dieser Beschreibung Stränge genannt)
+und unterschiedliche #ib#Netzhardware#ie# (Treiber) miteinander zu verbinden. Für den
+EUMEL-Benutzer soll dabei kein Unterschied in der Benutzung des EUMEL-Netzes
+feststellbar sein. 
+#page# 
+Neben unterschliedlichen Übertragungsmedien und Treibern gibt es weitere Unter­
+schiede zwischen Netzen: 
+ 
+     -  in der Netztopologie (Bus-, Ring- oder Sternnetze), 
+ 
+     -  in den Netzzugangsverfahren (Token passing, time slice token, slotting oder
+        CSMA/CD), 
+ 
+     -  in der #ib#Übertragungsgeschwindigkeit#ie#, 
+ 
+     -  im Aufbau der einzelnen #ib#Pakete#ie(1,", Aufbau der")# (#ib#Netztelegramm#ie#e). 
+ 
+Alles, was mit den ersten drei Punkten zusammenhängt, wird von den Netzzugangs­
+geräten behandelt. 
+ 
+Der Paketaufbau aber muß zumeist im Rechner geschehen und kann in den seltens­
+ten Fällen ganz vom Treiber übernommen werden. Ebenso kann der Treiber aus den
+empfangenen Paketen nicht immer die Teile herausfiltern, die von der EUMEL-
+#ib#Netzsoftware#ie# gebraucht werden. Diese Aufgaben übernimmt das #ib#Netz-Hardware-
+Interface#ie#. Das Netz-Hardware-Interface stellt die #ib#Verbindung#ie# zwischen EUMEL-
+#ib#Netzsoftware#ie# und den verschiedenen Netzhardwarearten dar. Ähnlich wie bei den
+Drucker- und Terminal-Anpassungen wurde ein hardwareabhängiger Teil aus der
+Netzsoftware abgetrennt und in einem eigenen #ib#Paket#ie# zusammengefaßt. Beim Start
+des Netzes wird durch Angabe des entsprechenden #ib#Netzmodus#ie# für den jeweiligen
+#ib#Kanal#ie# die entsprechende Anpassung für den benutzten Treiber ausgewählt. Wenn
+andere, neue Treiber angepaßt werden sollen, so müssen lediglich in dem Paket #on("b")##ib#net
+hardware interface#ie##off("b")# die entsprechenden Prozeduren hinzugefügt und die #ib#Sprungleisten#ie#
+(#ib#SELECT#ie#-Statements) erweitert werden. 
+ 
+Durch das #ib#Knotenkonzept#ie# in der #ib#Netzsoftware#ie# ist es möglich, über einen #ib#Knoten­
+rechner#ie# Teilnetze (Stränge), die mit unterschiedlicher #ib#Netzhardware#ie# arbeiten, mitein­
+ander zu verbinden. Es sind dann beispielsweise Verbindungen zwischen Rechnern,
+die über #ib#Ethernet#ie# vernetzt sind, und Rechnern auf dem EUMEL-Datenboxen-Netz
+möglich. Es ist auch möglich, mit einem Rechner Zugang zu einem Netz zu erhalten,
+für das spezielle #ib#Netzhardware#ie# erforderlich ist (Datenboxen, Ethernet-Anschluß). Man
+kann den Rechner über eine Rechner-Rechner-Kopplung (#ib#V.24#ie#) mit einem Rechner
+verbinden, der bereits ans Netz angeschlossen ist, und so (allerdings auf Kosten der
+Leistung des #ib#Knotenrechner#ie#s) Netzhardware einsparen. 
+#page# 
+ 
+3.2.  Arbeitsweise des 
+      Netz-Hardware-Interfaces
+      
+ 
+ 
+ 
+ 
+    #goalpage("3.2")# 
+ 
+Grob vereinfacht kann man sich die Arbeitsweise der #ib#EUMEL-Netz-Software#ie# so vor­
+stellen: 
+ 
+       reset box; 
+       REP 
+          IF zeichen da THEN lies telegramm ein 
+             ELIF telegramm auszugeben THEN gib telegramm aus 
+          FI 
+       PER . 
+ 
+(Es ist nur der Teil der Software beschrieben, der die Kanalbehandlung betrifft). 
+ 
+ 
+Das Zusammenspiel zwischen EUMEL-Netz und Netz-Hardware-Interface ge­
+schieht auf folgende Weise: 
+ 
+ 
+     #on("b")#reset box;#off("b")# 
+     REP 
+        IF zeichen da THEN  #on("b")#next packet start#off("b")#; 
+                            lies telegramm ein 
+           ELIF telegramm auszugeben THEN gib telegramm aus 
+        FI 
+     PER. 
+ 
+     gib telegramm aus: 
+         #on("b")#transmit header#off("b")#; 
+         gib eumelnetztelegramm aus; 
+         #on("b")#transmit trailer #off("b")#. 
+ 
+Die fett gedruckten Programmteile werden im Netz-Hardware-Interface realisiert, die
+anderen Teile stecken in den darüberliegenden Teilen der EUMEL-Netz-Software. 
+#page# 
+Beim Senden eines #ib#Telegramm#ie#s wird von der #ib#Netzsoftware#ie# zuerst der #ib#Vorspann#ie# in
+einem #ib#Datenraum#ie# an das Hardware-Interface übergeben (#on("b")##ib#transmit header#ie##off("b")#). Im Hard­
+ware-Interface können aus dem Vorspann die entsprechenden Informationen (Tele­
+grammlänge, #ib#Zielstation#ie# usw.) entnommen werden. Dann wird von der Netzsoftware
+das Telegramm (inklusive Vorspann) per #on("b")##ib#blockout#ie##off("b")# übergeben. Danach wird #on("b")##ib#transmit
+trailer#ie##off("b")# aufgerufen, um dem Hardware-Interface das Ende des Telegramms zu mel­
+den. Beim Empfang ruft die Netzsoftware zuerst die #ib#I/O Control#ie# #ib#Telegrammfreigabe#ie#
+auf [7]. Danach wird das erste #ib#Zeichen#ie# des Telegramms angefordert (#on("b")##ib#next packet
+start#ie##off("b")#). Falls ein #ib#STX#ie# geliefert wurde, wird das Telegramm per #on("b")##ib#blockin#ie##off("b")# eingelesen. Falls
+#ib#Niltext#ie# zurückgeliefert wird, wird von der Netzsoftware #ib#Timeout#ie# angenommen. Alle
+anderen Zeichen werden so interpretiert, als ob Störungen aufgetreten wären. Die
+Netzsoftware übernimmt die #ib#Fehlerbehandlung#ie#. Dazu wird u. U. ein Leerlesen des
+Puffers vom Hardware-Interface verlangt (#on("b")##ib#flush buffers#ie##off("b")#). 
+ 
+Bei der Einstellung der #ib#Nutzdatenlänge#ie# (#on("b")##ib#data length#ie##off("b")#) ist zu beachten, daß 
+ 
+a)  alle #ib#Station#ie#en, die an einem #ib#Strang#ie# hängen, auf die gleiche Nutzdatenlänge
+    eingestellt sein müssen. 
+ 
+b)  Wenn mehrere Stränge über #ib#Knoten#ie# miteinander verbunden sind, muß die Nutz­
+    länge für Sendungen über Knoten (#on("b")##ib#data length via node#ie##off("b")#) auf allen Stationen des
+    gesamten Netzes gleich eingestellt sein. Die Zusammenfassung oder Aufteilung
+    von #ib#Telegramm#ie#en in Knoten ist nicht möglich. 
+ 
+c)  Als mögliche Nutzdatenlänge sind folgende Werte erlaubt: 
+ 
+    64, 128, 256 und 512 Byte. 
+ 
+    Größere Nutzdatenlängen sind zur Zeit nicht möglich. 
+ 
+d)  Je größer die #ib#Nutzdatenlänge#ie# ist, desto geringer ist der Overhead an #ib#Zeichen#ie#,
+    die auf den Rechnern verarbeitet werden müssen. Allerdings muß der Rechner
+    leistungsfähig genug sein, die ankommenden Blöcke schnell genung zu verarbei­
+    ten, und die Netztreiber müssen entsprechend große Puffer haben. 
+ 
+ 
+Alle implementierten Netzanpassungen sollen in einem Netz-Hardware-Interface
+zusammengefaßt werden. Dies ist notwendig, um über #ib#Knotenrechner#ie# Netzstränge
+verbinden zu können, die mit unterschiedlicher #ib#Netzhardware#ie# arbeiten. So können
+zum Beispiel ein #ib#Strang#ie#, der mit Datenboxen aufgebaut ist, und ein #ib#Ethernet#ie#-#ib#Strang#ie#
+über einen Knotenrechner miteinander verkoppelt werden. 
+#page# 
+Aus diesem Grund wurden #on("b")#Netzmodi#off("b")# eingeführt. Man kann dadurch, daß die Netz­
+modi, genau wie die #ib#Kanal#ie#angaben, in der #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# niedergelegt sind, ohne Aus­
+tausch einer Softwarekomponente die Netzhardware wechseln. Es gibt auch die
+Möglichkeit, durch verschiedene Netzmodi unterschiedliche Treiber an ein und das­
+selbe Netz anzuschließen. Beispielsweise gibt es für einige Rechnertypen Steckkarten,
+mit denen der Rechner an das Ethernet angeschlossen werden kann. Man kann,
+wenn diese Karten angepaßt sind, den #ib#Ethernet#ie#-Zugang über verschiedene Netz­
+anschlußkarten realisieren. 
+ 
+Das Netz-Hardware-Interface muß folgende Aufgaben übernehmen: 
+ 
+    Bei der Ausgabe an den Treiber: 
+ 
+        -  Generieren und Ausgeben des #ib#Paket#ie#headers, 
+        -  Umsetzen von logischen Stationsadressen (#ib#Stationsnummer#ie#n) in phy­
+           sische #ib#Adresse#ie#n, 
+        -  Ausgeben der Daten (EUMEL-Netz-#ib#Telegramm#ie#e), 
+        -  Generieren und Ausgeben des Trailers und evtl. Auffüllen des Pakets mit
+           #ib#Füllzeichen#ie#, falls auf dem Netz eine Mindestlänge für Pakete gefordert
+           wird. 
+ 
+    Bei der Eingabe vom Treiber: 
+ 
+        -  Weglesen von #ib#Füllzeichen#ie#, 
+        -  Prüfen der #ib#Adresse#ie#n, 
+        -  Weglesen von #ib#Paket#ie#teilen, die in der EUMEL-Netz-Software nicht
+           gebraucht werden. 
+ 
+    Weiterhin können Funktionen wie 
+ 
+        -  Reset des Treibers, 
+        -  Prüfung, ob Stationsadresse und #ib#Adresse#ie# im Treiber übereinstimmen, 
+        -  Statistik und Service 
+ 
+    durch das Netz-Hardware-Interface übernommen werden. 
+ 
+Dazu wird ein Satz von Prozeduren über die #ib#DEFINES#ie#-#ib#Schnittstelle#ie# des Netz-
+Hardware-Interfaces zur Verfügung gestellt. Wenn neue Treiber oder Netzarten
+implementiert werden sollen, so muß an diesem Interface nichts geändert werden. Die
+herausgereichten Prozeduren realisieren #ib#Sprungleisten#ie# (#ib#SELECT#ie#-Statements), über
+die durch Erweiterung (#ib#CASE#ie#) die Prozeduren erreicht werden können, die den ent­
+sprechenden #ib#Netzmodus#ie# realisieren. Außerdem werden Informationsprozeduren für die
+darüberliegenden Programmteile zur Verfügung gestellt. 
+#page# 
+ 
+3.3. Netztreiber 
+ 
+ #goalpage("3.3")# 
+Unter #ib#Netztreiber#ie#n versteht man die Einheiten, die den Anschluß des Rechners an ein
+Netz realisieren. Das können #ib#Netzbox#ie#en sein, die mit dem Rechner über eine #ib#V.24#ie#-
+Leitung verbunden sind, aber auch Anschlußkarten, die direkt auf den Datenbus des
+Rechners gehen. Falls die #ib#Schnittstelle#ie# der Treiber-Hardware eine andere als die
+serielle #ib#V.24#ie# ist, muß in der Regel eine Anpassung für die Hardware im #ib#SHard#ie# vorge­
+nommen werden. 
+ 
+Falls der Treiber über eine serielle #ib#V.24#ie#-#ib#Schnittstelle#ie# mit dem Rechner verbunden
+ist, wie das auch bei der direkten Kopplung oder dem Datenboxennetz der Fall ist,
+wird die hohe #ib#Übertragungsgeschwindigkeit#ie# auf dem eigentlichen Netz durch die
+relativ geringe Übertragungsgeschwindigkeit auf der #ib#V.24#ie#-#ib#Schnittstelle#ie# zwischen
+Rechner und Treiber (Box) gebremst. Über andere Schnittstellen im Rechner, wenn
+sie mit #ib#Stream I/O#ie# [7] betrieben werden, kann man dies vermeiden. Diese Schnitt­
+stellen müssen vom SHard bedient werden. 
+ 
+Wenn in den Rechner integrierte Netztreiber (Netzanschlußkarten) benutzt werden
+sollen, so muß in der Regel die Behandlung dieser Netzanschlußkarte im SHard
+durchgeführt werden. 
+ 
+Um effizient implementieren zu können, sollte darauf geachtet werden, daß möglichst
+wenig zusätzliche #ib#Zeichen#ie# von der #ib#Netzsoftware#ie# bzw. dem Netz-Hardware-Inter­
+face bearbeitet werden müssen. Das Auffüllen von Paketen auf eine Mindestlänge
+sollte möglichst vom Treiber gemacht werden, ebenso wie das Weglesen dieser
+Zeichen. 
+ 
+Um einen sicheren und effektiven Netzbetrieb zu garantieren, sollten die Treiber
+folgende Eigenschaften haben: 
+ 
+     -  Die #ib#Stationsadresse#ie# ist im Treiber festgelegt, sie soll nicht ohne weiteres
+        verändert werden können (Datenschutz). 
+     -  Der Treiber reicht nur #ib#Paket#ie#e mit richtiger #ib#Zieladresse#ie#, keine #ib#Broad- oder
+        Multicasts#ie# an die Netzsoftware weiter. 
+     -  Der Treiber sendet nur #ib#Paket#ie#e mit richtiger #ib#Absenderadresse#ie# bzw. setzt die
+        Absenderadresse selbst ein. 
+     -  Die am Treiber eingestellte #ib#Adresse#ie# kann abgefragt werden, oder es wird,
+        wenn ein Paket mit falscher #ib#Absenderadresse#ie# vom Rechner kommt, eine
+        #ib#Fehlermeldung#ie# an den Rechner gegeben. Die Fehlermeldung muß durch das
+        Netz-Hardware-Interface in den #on("b")##ib#report#ie##off("b")# eingetragen werden. 
+     -  Falls Pakete mit #ib#Füllzeichen#ie# aufgefüllt werden müssen, sollten die Füll­
+        zeichen durch den Treiber generiert und beim Empfang wieder entfernt
+        werden. 
+     -  Falls mehrere Betriebsmodi möglich sind, so sollten sie softwaremäßig
+        einstellbar sein. 
+     -  Falls die Treiber über eine serielle #ib#Schnittstelle#ie# an den Rechner angeschlos­
+        sen werden, so sollte der Treiber konfigurierbar sein. In jedem Fall sollte die
+        serielle Schnittstelle mit #ib#Flußkontrolle#ie# (#ib#RTS/CTS#ie#) implementiert werden. 
+ 
+Zusätzlich ist ein Transparent-Modus als #ib#Netzmodus#ie# von Vorteil: 
+ 
+     -  Der Modus (transparent) kann zu Testzwecken benutzt werden. Beispiels­
+        weise um auch mit Rechnern kommunizieren zu können, die über Netz
+        erreichbar sind, aber kein EUMEL-Netz-#ib#Protokoll#ie# benutzen. 
+ 
+        Modus n:  transparent. 
+ 
+                  Ausgabeseitig: Das #ib#Paket#ie# wird unverändert ausgegeben.
+                                 #ib#Adresse#ie#n usw. müssen schon im Paket vor­
+                                 handen sein. Es wird nicht mit #ib#Füllzeichen#ie#
+                                 aufgefüllt. 
+                  Eingabeseitig: Das Paket wird unverändert an die Netzsoft­
+                                 ware weitergegeben. 
+ 
+#page# 
+ 
+3.4.  Prozedurschnittstelle 
+      des EUMEL-Netzes 
+      
+ 
+ 
+ 
+ 
+     #goalpage("3.4")# 
+Im PACKET #on("b")##ib#net hardware interface#ie##off("b")# sind folgende Prozeduren untergebracht: 
+ 
+ 
+ 
+      BOOL PROC #ib#blockin#ie# 
+          (DATASPACE VAR ds, INT CONST seite, abstand, länge): 
+ 
+           Versucht, #on("b")#länge#off("b")# Zeichen vom #ib#Kanal#ie# einzulesen. Liefert TRUE, wenn alle
+           Zeichen eingelesen wurden, FALSE, wenn innerhalb einer bestimmten
+           Zeit nicht alle #on("b")#länge#off("b")# Zeichen eingelesen werden konnten (z.B. weil der
+           Kanal nicht mehr Zeichen anliefert). Die eingelesenen Zeichen werden im
+           #ib#Datenraum#ie# #on("b")#ds#off("b")# in #ib#Seite#ie# #on("b")#seite#off("b")# ab #on("b")#abstand#off("b")# bis #on("b")#abstand#off("b")# + #on("b")#länge#off("b")# - 1 abge­
+           legt. 
+ 
+               #ib#Fehlerfall#ie#: 
+ 
+                     #on("b")#blockin Abbruch#off("b")# 
+ 
+           Es werden weniger #ib#Zeichen#ie# innerhalb einer festgelegten Zeitspanne über
+           den Kanal angeliefert, als mit #on("b")#länge#off("b")# gefordert. 
+ 
+           Passiert z.B., wenn die Kabel während einer Netzübertragung unter­
+           brochen werden, oder wenn die Gegenstelle abgeschaltet wird. Das
+           #ib#Telegramm#ie# wird vernichtet, die Prozedur liefert FALSE, es wird eine
+           entsprechende Meldung im #on("b")##ib#report#ie##off("b")# erzeugt. 
+ 
+      PROC #ib#blockout#ie# 
+          (DATASPACE CONST ds, INT CONST seite, abstand, länge): 
+ 
+          Der Inhalt von Seite #on("b")#seite#off("b")# des #ib#Datenraum#ie#s #on("b")#ds#off("b")# wird von #on("b")#abstand#off("b")# bis
+          #on("b")#abstand#off("b")# + #on("b")#länge#off("b")# - 1 ausgegeben. 
+#page# 
+      PROC #ib#set net mode#ie# (INT CONST mode): 
+ 
+          Es wird der #ib#Netzmodus#ie# #on("b")#mode#off("b")# eingestellt. Im Netz-Hardware-Interface
+          müssen alle Initialisierungen und Einstellungen vorgenommen werden,
+          damit die mit #on("b")#mode#off("b")# geforderte #ib#Netzhardware#ie# unterstützt wird. Diese
+          Prozedur wird bei jedem #on("b")##ib#start#ie##off("b")#-Kommando in der Netztask aufgerufen.
+          Kann als Initialisierungsprozedur für dieses PACKET verwendet werden.
+          Übergibt den in der #ib#Datei#ie# #on("b")##ib#netz#ie##off("b")# für diesen #ib#Kanal#ie# verlangten Netzmodus an
+          das Netz-Hardware-Interface. Nach Aufruf dieser Prozedur müssen die
+          wertliefernden Prozeduren #on("b")##ib#net mode#ie#, #ib#mode text#ie#, #ib#data length#ie##off("b")# und #on("b")##ib#data
+          length via node#ie##off("b")# korrekt initialisiert sein. Der Aufruf von #on("b")##ib#net addess#ie##off("b")# muß
+          die korrekten (physikalischen) #ib#Adresse#ie# der #ib#Station#ie#en liefern. 
+ 
+      TEXT PROC net address (INT CONST stationsnummer): 
+ 
+          Liefert die (Hardware-) Netz-#ib#Adresse#ie#, über die der EUMEL-Rechner
+          mit der Stationsnummer #on("b")##ib#stationsnummer#ie##off("b")# beim aktuell für diesen Kanal
+          eingestellten #ib#Netzmodus#ie# erreichbar ist. Auf diese #ib#Adresse#ie# muß der Treiber
+          des entsprechenden Rechners eingestellt sein. Auch die eigene Netz-
+          Adresse muß mit der im Treiber eingestellten #ib#Adresse#ie# übereinstimmen.
+          Insbesondere müssen alle Stationen, die auf dem Netz arbeiten, dieselbe
+          Netz-Adresse für eine #ib#Stationsnummer#ie# errechnen. 
+ 
+      TEXT PROC #ib#mode text#ie#: 
+ 
+          Liefert den Text (Namen) des eingestellten #ib#Netzmodus#ie#. Wird in #on("b")##ib#net
+          manager#ie##off("b")# benutzt, um den Netzmodus im #on("b")##ib#report#ie##off("b")# anzugeben. 
+ 
+      TEXT PROC mode text (INT CONST mode): 
+ 
+          Liefert den Text (Namen) zu dem #ib#Netzmodus#ie# #on("b")#mode#off("b")#. 
+ 
+      INT PROC #ib#data length#ie# (INT CONST mode): 
+ 
+          Liefert die #ib#Nutzdatenlänge#ie# (#ib#Länge#ie# der Nettodaten des Eumel-
+          Telegramms) im Netz. Wird von #on("b")##ib#basic net#ie##off("b")# beim Neustart aufgerufen. Muß
+          in einem Netz auf allen Stationen eines #ib#Strang#ie#s denselben Wert liefern. 
+ 
+          Erlaubte Werte:  64, 128, 256 und 512. 
+#page# 
+      INT CONST #ib#data length via node#ie#: 
+ 
+          Liefert die #ib#Nutzdatenlänge#ie# für Sendungen, die über #ib#Knoten#ie# gehen. 
+          Muß auf allen Stationen des Netzes gleich sein. 
+ 
+          Erlaubte Werte:  64, 128, 256 und 512. 
+ 
+      PROC #ib#decode packet length#ie# (INT VAR value): 
+ 
+          Die #ib#Länge#ie# eines Netztelegramms ist im #ib#Telegramm#ie# codiert enthalten. Mit
+          dieser Prozedur wird aus dem Telegrammkopf die Telegrammlänge ermit­
+          telt: 
+ 
+          Falls beim Aufruf dieser Prozedur in #on("b")#value#off("b")# der Wert des Feldes #on("b")#head#off("b")# aus
+          der Struktur #on("b")#vorspann#off("b")#, die in #on("b")#ds#off("b")# per #on("b")##ib#transmit header#ie##off("b")# übergeben wurde,
+          enthalten ist, so wird in #on("b")#value#off("b")# die Länge des EUMEL-Netztelegramms
+          zurückgeliefert. 
+ 
+      PROC #ib#flush buffers#ie#: 
+ 
+          Liest den Eingabepuffer des #ib#Netzkanal#ie#s leer. Die eingelesenen Zeichen
+          werden vernichtet. Wird nach Erkennen von #ib#Übertragungsfehler#ie#n aufge­
+          rufen. 
+ 
+      TEXT PROC #ib#next packet start#ie#: 
+ 
+          Liefert genau ein #ib#Zeichen#ie# (in der Regel das erste Zeichen des EUMEL-
+          Netztelegramms). Wird von der Netzsoftware immer dann aufgerufen,
+          wenn ein neues #ib#Paket#ie# erwartet wird. 
+ 
+          Bedeutung des gelieferten Zeichens für die #ib#Netzsoftware#ie#: 
+ 
+          #ib#STX#ie#:      korrekter #ib#Telegrammanfang#ie# (ist das erste Zeichen des
+                    EUMEL-Netztelegramms). Der Rest des EUMEL-Netztele­
+                    gramms steht im Eingabepuffer, ist also über #ib#blockin#ie# lesbar.
+                    Vorher wurden nur Zeichen eingelesen, die zum verwendeten
+                    #ib#Netzprotokoll#ie# gehören (z.B. #ib#Ethernet#ie#-#ib#Adresse#ie#n, #ib#Füllzeichen#ie#
+                    usw.). 
+          niltext:  kein neues Telegramm da 
+ 
+          jedes andere Zeichen: 
+                    Fehler. Entweder wurden Störzeichen eingelesen oder es
+                    gingen Zeichen verloren. #ib#Fehlerbehandlung#ie# erfolgt durch die
+                    Netzsoftware. 
+#page# 
+      PROC #ib#transmit header#ie# (DATASPACE CONST ds): 
+ 
+          Wird vor Ausgabe eines jeden #ib#Telegramm#ie#s aufgerufen. In dem #ib#Datenraum#ie#
+          #on("b")#ds#off("b")# wird von der EUMEL-Netz-Software der #on("b")##ib#Vorspann#ie##off("b")# übergeben. Über
+          den jeweiligs eingestellten #ib#Netzmodus#ie# kann für jede implementierte Netz­
+          art über eine #ib#Sprungleiste#ie# (#ib#SELECT#ie#) die Prozedur angesprungen werden,
+          die den #ib#Header#ie# für den eingestellten Netzmodus erstellt und ausgibt.
+          Struktur des von der EUMEL-Netz-Software benutzten Headers: 
+ 
+              BOUND STRUCT 
+              (INT  head, 
+                    zwischenziel, 
+                    zielrechner, 
+                    quellrechner, 
+                    strom, 
+                    sequenz, 
+                    seitennummer ) VAR vorspann. 
+ 
+          Aus dem Inhalt des Feldes #on("b")#head#off("b")# kann mittels #on("b")##ib#decode packet length#ie##off("b")# die
+          Gesamtlänge des EUMEL-Netztelegramms errechnet werden. 
+ 
+      PROC #ib#transmit trailer#ie#: 
+ 
+          Wird nach Ausgabe eines jeden Telegramms aufgerufen. Evtl. notwendige
+          Nachspänne können ausgegeben werden. Die notwenigen Informationen
+          wurden  in #on("b")##ib#transmit header#ie##off("b")# übergeben und müssen aufbewahrt werden,
+          falls sie im Trailer mitgeliefert werden müssen. Kann auch dazu benutzt
+          werden, den unter diesem Packet liegenden Schichten (#ib#SHard#ie# oder Hard­
+          ware) das Ende des Telegramms mitzuteilen. Notwendige #ib#Füllzeichen#ie#
+          können in dieser Prozedur in das #ib#Paket#ie# eingebaut werden. 
+ 
+      PROC #ib#reset box#ie# (INT CONST net mode): 
+ 
+          Kann zur Initialisierung der #ib#Netzhardware#ie# benutzt werden. Wird von #on("b")##ib#basic
+          net#ie##off("b")# beim jedem Neustart aufgerufen. 
+ 
+     INT PROC #ib#max mode#ie#: 
+ 
+          Liefert den Wert des größten erlaubten (implementierten) #ib#Netzmodus#ie#. 
+ 
+     INT PROC #ib#net mode#ie#: 
+ 
+          Liefert den eingestellten Netzmodus. 
+#page# 
+#pagenr ("%", 45)##setcount (1)##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Anhang 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right#GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+#clear pos##lpos(1.0)##rpos(9.5)##goalpage("A")# 
+
+Anhang: Netz-Meldungen#goalpage("A.1")# 
+ 
+Mit dem Kommando #on("b")##ib#list#ie# (/"net list")#off("b")# (siehe Teil 1) erhalten Sie eine temporäre #ib#Datei#ie#
+auf den Bildschirm. Diese Datei könnte ungefähr so aussehen: 
+ 
+____________________________________________________________________________ 
+   
+   N e u e r   S t a r t 12:44      Stationsnummer : 38 
+  01.06.87 12:55 net port 8:20:Nicht zustellbar. . Empfänger: "net dok". Quelle 34 Taskindex: 255 
+  02.06.87 06:30 net port 8:1:wdh data. sqnr 7. Absender: "net dok". Ziel 34 Taskindex: 255 
+  02.06.87 07:03 net port:20:Sequenzfehler: soll 13 ist 14. Empfänger: "POST". Quelle 33 Taskindex: 
+  02.06.87 07:03 net port:blockin abbruch 
+  02.06.87 07:03 net port:20:Sequenzreset von 13 auf 10. Empfänger: "POST". Quelle 33 Taskindex: 29 
+  02.06.87 07:36 net port:Call gelöscht."net dok". Strom 1 
+  02.06.87 07:43 net port 8:verbotene Route: 34 
+  02.06.87 07:50 net port:Header inkorret eingelesen: %0 %2 
+  02.06.87 07:50 net port:buffers flushed 
+  02.06.87 07:52 net port:Weiterleitung nicht möglich für 34 
+  02.06.87 07:53 net port 8:skipped0 6 G O 1 0 . 0 %13 %10 2 8 0 6   0 6 G O 1 0 . 0 %13 %10 2 8 0 
+  02.06.87 08:14 net port 8:skipped%13 %10 S p e c .   R e c e i v e   E r r o r   C 2 
+  02.06.87 08:21 net port:20:Reopen. Empfänger: "WÜFE". Quelle 40 Taskindex: 22 
+  02.06.87 09:25 net port:1:etwas rueckgespult. Absender: "-". Ziel 33 Taskindex: 51 
+  02.06.87 09:25 net port:1:wdh data. sqnr 20. Absender: "-". Ziel 33 Taskindex: 51 
+  02.06.87 09:54 net port:20:Blocknummer falsch, neu: 192, alt : -1. Empfänger: "WÜFE". Quelle 44 
+  02.06.87 10:12 net port:Daten ohne Eroeffnung von 40  Sequenznr 7 
+  02.06.87 10:23 net port:Header inkorret eingelesen: O X 0 3 8 B O X 0 4 4 E U %2 
+  02.06.87 10:23 net port:buffers flushed 
+  02.06.87 10:49 net port:1:wdh open. Absender: "-". Ziel 33 Taskindex: 255 
+  02.06.87 10:49 net port:2:wdh open. Absender: "net dok". Ziel 33 Taskindex: 255 
+  02.06.87 10:53 net port:1:Sequenzfehler: soll 2 ist 3. Empfänger: "net dok". Quelle 33 Taskindex: 
+  02.06.87 10:54 net port:1:Sequenzreset von 8 auf 5. Empfänger: "net dok". Quelle 33 Taskindex: 11 
+  02.06.87 10:56 net port:2:etwas rueckgespult. Absender: "-". Ziel 33 Taskindex: 51 
+  bekannte Stationen: 
+  1(8,1) 2(8,2) 3(8,3) 4(8,4) 5(8,5) 6(8,6) 7(8,7) 8(8,8) 9(8,9) 10(8,10) 
+  11(8,11) 12(8,12) 13(8,13) 14(8,14) 15(8,15) 16(8,16) 17(8,17) 18(8,18) 
+  19(8,19) 20(8,20) 21(8,21) 22(8,22) 23(8,23) 24(8,24) 25(8,25) 26(8,26) 
+  27(8,27) 28(8,28) 29(8,29) 30(8,30) 31(8,31) 32(8,32) 33(9,33) 34(8,34) 
+  35(9,35) 36(9,36) 37(9,37) 39(9,39) 40(9,40) 41(9,41) 42(9,42) 43(9,43) 
+  44(9,44) 45(9,45) 46(9,46) 47(9,47) 48(9,48) 
+  -------- 
+  Eingestellte Netzmodi: 
+  net port 8 haengt an Kanal 8, Modus: (1)  EUMEL-Netz            64 Byte 
+  net port haengt an Kanal 9, MODUS: (11) ETHERNET via V.24     512 Byte 
+ 
+  Nutzdatenlänge 512 Byte 
+  Nutzdatenlänge bei indirekter Verbindung: 64 Byte 
+  ******** 
+  Netz-Software vom  23.05.87 
+  Rechner 38  um 11:11 
+  net port 8 
+ 
+  Strom 1 (sqnr7/8) sendet an 34 . Absender ist "net dok". 
+  net port 
+ 
+  Strom 1 (sqnr45/45) empfaengt von 40 . Empfaenger ist "PUBLIC". 
+ 
+____________________________________________________________________________ 
+#page# 
+Die Datei enthält den aktuellen #on("b")##ib#report#ie##off("b")#, in dem #ib#Fehlermeldung#ie#en der einzelnen Tasks
+gesammelt werden. Außerdem wird der Zustand aller Verbindungen (Ströme) von allen
+#on("b")##ib#net port#ie##off("b")#'s angezeigt. Im #on("b")#report#off("b")#-Teil kann man drei Informationsblöcke unterscheiden: 
+ 
+a) den Block mit den Fehlermeldungen. Es werden jeweils Datum, Uhrzeit, der Name
+   des betroffenen #on("b")#net port#off("b")# und, wenn notwendig, die #ib#Stromnummer#ie# angegeben.
+   Darauf folgt der Meldungstext, der auch Informationen über Absender und Emp­
+   fänger enthalten kann. 
+ 
+   <Datum> <Zeit> <Name der #ib#Kanaltask#ie#> : [<#ib#Stromnummer#ie#> : ] <Meldung> 
+ 
+ 
+b) den Block mit der Liste der bekannten #ib#Station#ie#en. Ein Eintrag in dieser Liste ent­
+   hält jeweils die Stationsnummer der bekannten Station und in Klammern dahin­
+   ter die Nummer des Kanals auf diesem Rechner, über den die Station erreichbar
+   ist und die Nummer der nächsten #ib#Zwischenstation#ie#. 
+ 
+   <Zielstation> (<Kanalnr>,<Zwischenstation>) 
+ 
+   Bei direkt erreichbaren Stationen ist Zwischenstation gleich #ib#Zielstation#ie#. 
+ 
+   Hinweis: Auch #ib#gesperrt#ie#e Stationen erscheinen in dieser Liste. 
+ 
+ 
+c) den Block, der Auskunft über die Netzinstallation gibt. Es werden für jeden Netz­
+   kanal die eingestellten Netzmodi angegeben. Des weiteren werden die beiden
+   Größen #on("b")##ib#data length#ie##off("b")# (#ib#Nutzdatenlänge#ie#) und #on("b")##ib#data length via node#ie##off("b")# (Nutzdatenlänge bei
+   indirekter Verbindung) angegeben. Zusätzlich erscheinen noch die #ib#Netzversion#ie# und
+   die genaue Uhrzeit, zu der dieser #on("b")#report#off("b")# erstellt wurde. 
+ 
+#page# 
+Für jeden #on("b")##ib#net port#ie##off("b")# wird pro aktivem #ib#Strom#ie# folgende Meldung generiert: 
+ 
+Strom <Stromnr> (sqnr<akt Seqnr>/<max Seqnr>) <Zustand> <Partner> 
+ 
+ 
+<Stromnr>        #ib#Stromnummer#ie# 
+ 
+<akt Seqnr>      #ib#Sequenznummer#ie# des gerade bearbeiteten #ib#Telegramm#ie#s 
+ 
+<max Seqnr>      Bei #ib#Sendeströme#ie#n die Nummer der letzten zu übertragenden
+                 #ib#Sequenz#ie#, bei Empfangsströmen in der Regel die Nummer der
+                 letzten Sequenz der gerade übertragenen #ib#Datenraumseite#ie#. 
+ 
+<#ib#Zustand#ie#>        Hier wird die Aktion (senden, empfangen usw.) und die Partner­
+                 station angegeben. 
+ 
+<#ib#Partner#ie#>        Der Name der Task mit der kommuniziert wird. 
+ 
+ 
+Die Meldungen, die in der #ib#Datei#ie# #on("b")##ib#report#ie##off("b")# protokolliert werden, kann man in verschiedene
+Gruppen einordnen. Die eine Gruppe beschreibt Störungen durch #ib#Zeichenverluste#ie#
+oder ­verfälschungen, eine andere Gruppe protokolliert besondere Situationen, bei­
+spielsweise den Abbruch von #ib#Übertragung#ie#en, und die letzte Gruppe befasst sich mit
+#ib#Fehlermeldung#ie#en, die ein Eingreifen von aussen notwendig machen. Je nachdem, ob
+die Station, auf der die Meldung protokolliert wird, Empfänger oder Absender ist, wird
+bei den Meldungen #ib#Stationsnummer#ie# und Taskname des Kommunikationspartners mit
+angegeben. 
+ 
+Zur ersten Gruppe gehören: 
+ 
+#ib(4)##ib#skipped#ie##ie(4)# 
+               'skipped' oder skipped mit einem Zusatztext erscheint, wenn Zei­
+               chen eingelesen wurden, die zu keinem gültigen #ib#Telegramm#ie# ge­
+               hören. Dies kann passieren, wenn auf der Leitung zwischen
+               Rechner und Box #ib#Zeichen#ie# verlorengegangen sind. Auch nach dem
+               Einschalten oder nach einem Reset auf Box oder Rechner kann
+               diese Meldung kommen. Mindestens ein Teil der eingelesenen
+               Daten wird mit ausgegeben, wobei Steuerzeichen durch % und den
+               Code des Steuerzeichens dargestellt werden. Die einzelnen Zeichen
+               werden durch ein Blank voneinander getrennt. 
+#page# 
+#ib(4)##ib#Sequenzfehler#ie##ie(4)# 
+               Die #ib#Sequenznummer#ie# ist zu groß, es fehlen also Telegramme. Die
+               Gegenstation wird aufgefordert, ab einem früheren Telegramm zu
+               wiederholen. 
+ 
+#ib(4)#wdh data#ie(4)# 
+               Das letzte Telegramm wird erneut geschickt. Passiert, wenn die
+               #ib#Quittung#ie# für dieses Telegramm nach einer bestimmten Zeit nicht
+               angekommen ist. 
+ 
+#ib(4)##ib#Sequenzreset#ie##ie(4)# 
+               Die #ib#Sequenznummer#ie# des empfangenen Telegramms ist kleiner als
+               die Sequenznummer des vorher empfangenen Telegramms. Die
+               Verbindung wird bei der zuletzt empfangenen Sequenznummer
+               fortgesetzt. 
+ 
+#ib(4)#Blocknummer falsch#ie(4)# 
+               Die #ib#Seitennummer#ie# in dem #ib#Telegramm#ie# ist falsch. 
+ 
+#ib(4)#etwas rueckgespult#ie(4)# 
+               Auf Anforderung der Gegenseite werden die letzten drei #ib#Datenraum­
+               seite#ie#n erneut übertragen. 
+ 
+#ib(4)#Daten ohne Eroeffnung#ie(4)# 
+               Es werden Telegramme mit einer #ib#Stromnummer#ie# empfangen, zu der
+               vorher kein OPEN-Telegramm empfangen wurde. In diesem Fall
+               wird die Gegenstation aufgefordert, die #ib#Übertragung#ie# von vorn zu
+               beginnen. Diese Meldung kann auch kommen, wenn das Netz neu
+               gestartet wurde. 
+ 
+#ib(4)#wdh open#ie(4)# 
+               Die Übertragung wird mit dem #ib#OPEN#ie#-Telegramm von vorn begon­
+               nen. Passiert auf Aufforderung durch die Gegenstation oder wenn
+               das erste OPEN-Telegramm nicht quittiert wurde. 
+ 
+#ib(4)##ib#buffers flushed#ie##ie(4)# 
+               Alle bereits eingelesenen, aber noch nicht bearbeiteten Zeichen
+               wurden gelöscht (der #ib#Eingabepuffer#ie# wurde komplett gelöscht). Verur­
+               sacht durch schwere Störungen (#ib#Zeichenverluste#ie# oder -verfäl­
+               schungen). 
+#page# 
+#ib(4)#blockin abbruch#ie(4)# 
+               Es wurden nicht alle Zeichen eines Telegramms innerhalb eines
+               bestimmten Zeitraums angeliefert. 
+ 
+#ib(4)#Header inkorrekt eingelesen#ie(4)# 
+               Es wurde ein Fehler in dem Teil des Netztelegramms gefunden, der
+               nicht zum EUMEL-Netz gehört. 
+ 
+#ib(4)#Strom falsch in Quittung#ie(4)#: 
+               In der #ib#Quittung#ie# wurde eine nicht zulässige #ib#Stromnummer#ie# festge­
+               stellt. Zulässig sind Stromnummern zwischen 1 und 20. 
+ 
+#ib(4)#Neustart#ie(4)# 
+               Die Gegenstation hat die #ib#Verbindung#ie# von vorne begonnen. 
+ 
+#ib(4)#Falsche Seitennummer#ie(4)# 
+               Die #ib#Seitennummer#ie# in dem empfangenen Telegramm ist falsch.
+               Einige Telegramme werden wiederholt. 
+ 
+#ib(4)#Absteigende Seitennummern#ie(4)# 
+               Die Seitennummer in dem empfangenen Telegramm ist kleiner als
+               die Seitennummer im vorigen #ib#Telegramm#ie#. Es müssen einige Tele­
+               gramme wiederholt werden. 
+ 
+ 
+Die folgenden Meldungen beschreiben Situationen, die nicht durch #ib#Zeichenverluste#ie#
+entstehen, mit denen die #ib#Netzsoftware#ie# selbst fertig wird: 
+ 
+ 
+#ib(4)#Sendung von Gegenstelle gelöscht#ie(4)# 
+               Die Verbindung wurde von der Gegenstelle abgebrochen. 
+ 
+#ib(4)#Empfangseintrag freigegeben#ie(4)# 
+               Die Verbindung wurde von der empfangenden #ib#Station#ie# gelöscht, weil
+               seit dem Eintreffen des letzten Telegramms zuviel Zeit vergangen ist
+               (#ib#Timeout#ie#). 
+ 
+#ib(4)#Irrläufer#ie(4)# 
+               Eine #ib#Intertaskkommunikation#ie# innerhalb der eigenen Station wurde
+               fälschlicherweise über den #on("b")##ib#Collector#ie##off("b")# abgewickelt. Dieser Vorgang
+               wird abgebrochen. 
+#page# 
+#ib(4)#Call-Löschung vorgemerkt#ie(4)# 
+               Sobald der Call abgewickelt ist, wird diese Verbindung gelöscht.
+               Beispielsweise führt ein vom Benutzer abgebrochenes #on("b")##ib#name#ie##off("b")# zu
+               dieser Meldung. 
+ 
+#ib(4)#Call gelöscht#ie(4)# 
+               Die #ib#Verbindung#ie# wurde auf Anforderung durch den Auftraggeber
+               gelöscht. 
+ 
+#ib(4)#Quellrechner#ie(4)# 
+               Als #ib#Quellrechnernummer#ie# wurde ein unzulässiger Wert festgestellt.
+               Zulässig sind Zahlen zwischen 1 und 127. 
+ 
+#ib(4)#Nicht zustellbar#ie(4)# 
+               Innerhalb eines bestimmten Zeitraums war die #ib#Zieltask#ie# nicht emp­
+               fangsbereit. Die Verbindung wird abgebrochen. 
+ 
+Bei diesen Meldungen sollten die #ib#Routenanweisungen#ie# überprüft werden: 
+ 
+#ib(4)#Verbotene Route bei Quittung#ie(4)# 
+               Die #ib#Quittung#ie# kommt auf einer nicht erlaubten #ib#Route#ie# an. Dies kann
+               bei #ib#Vermaschung#ie# passieren, oder aber, wenn eine Station versucht,
+               sich für eine andere Station auszugeben. 
+ 
+#ib(4)#Verbotene Route#ie(4)# 
+               Die danach bezeichnete Station versucht, auf einer anderen Route
+               mit diesem Rechner zu kommunizieren, als auf der Route, die für
+               diesen Rechner in der Datei #on("b")##ib#netz#ie##off("b")# festgelegt wurde. 
+ 
+               Abhilfe: 
+               #ib#Routentabellen#ie# der beiden (oder, falls die Meldung auf einer
+               #ib#Knotenstation#ie# erscheint, auf allen beteiligten) Stationen abgleichen. 
+ 
+#ib(4)#Weiterleitung nicht möglich#ie(4)# 
+               Die #ib#Routeninformationen#ie# auf dem #ib#Knotenrechner#ie#, wo diese Meldung
+               erscheint, und der sendenden #ib#Station#ie# stimmen nicht überein. Die
+               angegebene Station ist von dieser Station aus nicht erreichbar. 
+ 
+               Abhilfe: 
+               #ib#Routentabellen#ie# der Stationen überprüfen. 
+ 
+#ib(4)#Fremdzugriff#ie(4)# 
+               Eine #ib#gesperrt#ie#e Station hat versucht, auf diesen Rechner mit #ib#Sende­
+               codes#ie# > 6 zuzugreifen. 
+ 
+ 
+Folgende Meldungen betreffen '#ib#harte Fehler#ie#'. Diese Fehler werden von der Netzsoft­
+ware nicht abgefangen. In jedem Fall muß das Netz nach einer solchen #ib#Fehler­
+meldung#ie# neu gestartet werden. 
+ 
+#ib(4)#++++++#ie(4)# 
+               Meldungen dieser Form sind 'harte' Fehler. Der aufgetretene Fehler 
+               wird mit angegeben. Das Netz muß neu gestartet werden, da die
+               Task, in welcher der Fehler aufgetreten ist, gelöscht wird. 
+ 
+#ib(4)#Verbindungsengpaß#ie(4)# 
+               Es sind mehr Verbindungen festgestellt worden, als zulässig sind.
+               Nach dieser Meldung wurde der entsprechende Netport gelöscht. 
+ 
+ 
+Literaturverzeichnis 
+ 
+ 
+#goalpage("A.2")# 
+ 
+#clear pos# 
+#lpos(1.0)##lpos(2.5)# 
+#table# 
+[1]   EUMEL-Systemhandbuch, Teil 5, Intertaskkommunikation 
+      GMD St. Augustin, 1986 
+[2]   EUMEL-Systemhandbuch, Teil 2, Hardware und ihre Steuerung 
+[3]   EUMEL-Systemhandbuch, Teil 8, Spooler 
+[4]   EUMEL-Netz Installationsanweisung 
+      GMD St. Augustin, 1987 
+[5]   EUMEL-Systemhandbuch, Teil 4, Blockorientierte Ein/Ausgabe 
+[6]   EUMEL-Quellcode, Packet #on("b")#tasks#off("b")# 
+      GMD St. Augustin, 1986 
+[7]   EUMEL-Portierungshandbuch 8086, Version 8 
+      GMD St. Augustin, 1987 
+ 
+#table end#
+
+
diff --git a/system/net/1.8.7/doc/netzhandbuch.anhang b/system/net/1.8.7/doc/netzhandbuch.anhang
new file mode 100644
index 0000000..17d1ece
--- /dev/null
+++ b/system/net/1.8.7/doc/netzhandbuch.anhang
@@ -0,0 +1,58 @@
+#pagenr ("%", 51)##setcount##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Anhang 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right#GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+#clear pos##lpos(0.0)##rpos(11.0)##fillchar(".")# 
+Anhang: Netz-Fehlermeldungen 
+ 
+#table# 
+++++++   50 
+Absteigende Seitennummern   48 
+blockin abbruch   48 
+Blocknummer falsch   47 
+buffers flushed   47 
+Call gelöscht   49 
+Call-Löschung vorgemerkt   49 
+Collectortask fehlt   8, 18 
+Daten ohne Eroeffnung   47 
+Empfangseintrag freigegeben   48 
+etwas rueckgespult   47 
+Falsche Seitennummer   48 
+Fremdzugriff   50 
+Header inkorrekt eingelesen   48 
+Irrläufer   48 
+kein Zugriff auf Station   14 
+Neustart   48 
+Nicht zustellbar   49 
+Quellrechner   49 
+Sendung von Gegenstelle gelöscht   48 
+Sequenzfehler   47 
+Sequenzreset   47 
+skipped   46 
+Station x antwortet nicht   8, 11, 16 
+Station x gibt es nicht   9, 11, 13 
+Strom falsch in Quittung   48 
+Task "..." gibt es nicht   8 
+Verbindungsengpaß   50 
+Verbotene Route   49 
+Verbotene Route bei Quittung   49 
+wdh data   47 
+wdh open   47 
+Weiterleitung nicht möglich   49 
+#table end#
+
diff --git a/system/net/1.8.7/doc/netzhandbuch.index b/system/net/1.8.7/doc/netzhandbuch.index
new file mode 100644
index 0000000..01d8a0f
--- /dev/null
+++ b/system/net/1.8.7/doc/netzhandbuch.index
@@ -0,0 +1,259 @@
+#pagenr ("%", 52)##setcount (1)##block##pageblock##count per page# 
+#headeven# 
+#center#EUMEL Netzbeschreibung 
+#center#____________________________________________________________ 
+ 
+#end# 
+#headodd# 
+#center#Anhang 
+#center#____________________________________________________________ 
+ 
+#end# 
+#bottomeven# 
+#center#____________________________________________________________ 
+Netz - % #right#GMD 
+#end# 
+#bottomodd# 
+#center#____________________________________________________________ 
+GMD #right#Netz - % 
+#end# 
+#clear pos##lpos(0.0)##rpos(11.0)##fillchar(".")# 
+Anhang: Index 
+ 
+#table# 
+/   8, 9, 24 
+Absenderadresse   39 
+Absenderstation   28, 32 
+Adresse   29, 37, 39, 41, 42 
+aktiviere netz   14, 15, 18 
+basic net   41, 43 
+Baud   6, 18, 25 
+blockin   23, 36, 40, 42 
+blockout   23, 36, 40 
+Broad- oder Multicasts   38 
+buffers flushed   47 
+CASE   37 
+CLOSE   27 
+collected destination   22, 24 
+Collector   22, 24, 32, 48 
+Collectortask   8, 18, 22 
+configurate   6 
+continue   7, 21 
+CRC-Code   26 
+DATA   27, 29, 30 
+data length   23, 36, 41, 45 
+data length via node   23, 36, 41, 42, 45 
+Datei   2, 5, 7, 12, 13, 14, 18, 20, 24, 31, 37, 41, 44, 46 
+Datenbox   2, 6, 33 
+Datenraum   13, 15, 21, 23, 24, 27, 28, 29, 31, 36, 40, 43 
+Datenraumseite   23, 46, 47 
+decode packet length   42, 43 
+define collector   22, 24 
+definere netz   15 
+DEFINES   37 
+define station   5, 22 
+definiere netz   14 
+Dreher   16 
+Durchsatz   3 
+Eingabeprozeduren   21 
+Eingabepuffer   47 
+Empfangspuffer   15 
+Empfangsströme   13, 15 
+endquelle   28 
+endziel   28 
+erase   13, 19 
+erlaube   14 
+Ethernet   33, 34, 36, 37, 42 
+EUMEL0   21, 22, 24 
+EUMEL-Datenboxen-Netz   33 
+EUMEL-Netz-Software   35 
+exists   11 
+Fehler   8, 16, 17, 18 
+Fehlerbehandlung   31, 36, 42 
+Fehlerfälle   8 
+Fehlerfall   11, 40 
+Fehlermeldung   13, 15, 20, 26, 39, 45, 46, 50 
+Fehlersituationen   12 
+Fehlersuche   16 
+Fenstertechnik   31 
+fetch   10, 18 
+flush buffers   36, 42 
+Flußkontrolle   7, 15, 27, 39 
+free global manager   10, 19, 31 
+Füllzeichen   37, 39, 42, 43 
+gesperrt   13, 14, 45, 50 
+global manager   19, 31 
+harte Fehler   50 
+HDLC   31 
+Header   43 
+Höhere Ebenen   31 
+inchar   21 
+incharety   23 
+Installation   2 
+Installationsanleitung   2 
+Intertaskkommunikation   48 
+I/O Control   36 
+I/O-Kanal   33 
+Kanal   3, 6, 7, 12, 14, 15, 20, 21, 23, 24, 34, 37, 40, 41 
+Kanalnummer   14 
+Kanaltask   45 
+Knoten   3, 4, 17, 20, 23, 36, 42 
+Knotenkonzept   3, 34 
+Knotenrechner   34, 36, 49 
+Knotenstation   13, 14, 20, 49 
+Kommunikation   17 
+Kommunikationindirekte   23 
+konfigurieren   6 
+Länge   29, 41, 42 
+Längenangabe   26 
+list   10, 12, 17, 44 
+listoption   12, 14, 15 
+Löschversuche   13 
+Manager   10, 19 
+Masseschluß   16 
+max mode   43 
+mode text   41 
+Nachbarn   4, 28 
+Nachbarstation   24, 28 
+name   11, 24, 49 
+net   7, 12, 13 
+net addess   41 
+net hardware interface   34, 40 
+net install   7 
+net list   12, 15 
+net manager   41 
+net mode   41, 43 
+net port   7, 8, 12, 13, 18, 45, 46 
+net timer   14 
+netz   7, 14, 15, 20, 37, 41, 49 
+Netzbox   3, 6, 20, 33, 38 
+Netzdefinition   14 
+Netzebene   26 
+Netzempfangstask   30 
+Netzhardware   2, 17, 21, 24, 33, 34, 36, 41, 43 
+Netz-Hardware-Interface   34 
+Netzinstallation   17 
+Netzkanal   13, 14, 42 
+Netzknoten   3 
+Netzkonfiguration   7, 20 
+Netzmodus   34, 37, 39, 41, 43 
+Netzprotokoll   42 
+Netzsoftware   2, 3, 18, 20, 34, 36, 38, 42, 48 
+Netzstrang   4, 17, 23 
+Netztask   15, 16, 21, 24 
+Netztelegramm   34 
+Netztreiber   38 
+Netzübertragungen   12 
+Netzversion   2, 45 
+next packet start   36, 42 
+niltext   11, 36 
+Nutzdaten   23 
+Nutzdatenlänge   17, 23, 29, 36, 41, 42, 45 
+Nutzinformation   29 
+nutzlaenge   29 
+OPEN   27, 28, 30, 47 
+Paket   23, 34, 37, 38, 39, 42, 43 
+Pakete, Aufbau der   34 
+Partner   46 
+Paßwort   19 
+Pin-Belegung   6 
+port intern   13, 15, 24 
+Printerserver   20 
+Protokoll   6, 13, 24, 39 
+Protokollebenen   25 
+Prüfsummen   18 
+Quelle   23, 26, 28 
+Quellrechnernummer   49 
+Quellstationsnummer   20 
+quelltask   21, 24, 28 
+Querarchivierungen   10 
+QUIT   27, 28, 30 
+Quittung   30, 31, 47, 48, 49 
+Rechnerkopplung   3 
+Rendezvouskonzept   21, 31 
+report   8, 12, 18, 39, 40, 41, 45, 46 
+reserve   10 
+RESET   17 
+reset box   43 
+Route   13, 15, 17, 20, 49 
+routen   14 
+Routenanweisungen   49 
+routen aufbauen   13, 14, 15 
+Routeninformationen   20, 49 
+Routentabelle   9, 13 
+Routentabellen   24, 49 
+router   13 
+RS422   25 
+RTS/CTS   6, 25, 39 
+Rückmeldeparameter   21 
+run   13 
+save   10, 19 
+Schnittstelle   3, 15, 18, 20, 25, 33, 37, 38, 39 
+SDLC   25, 26 
+seite   28, 29, 40 
+Seiten   27 
+Seitengrenze   23 
+Seitennummer   47, 48 
+SELECT   34, 37, 43 
+send   21, 22, 24, 27, 28, 30, 32 
+Sendecode   24 
+Sendecodes   50 
+Sendeströme   13, 46 
+Sendungskonzept   2 
+sequenz   28, 29, 46 
+Sequenzfehler   47 
+Sequenznummer   46, 47 
+Sequenzreset   47 
+set net mode   41 
+SHard   38, 43 
+Sicherheitskonzept   19 
+Sicherheitsprobleme   19 
+skipped   46 
+sperre   14 
+Spoolmanager   5 
+Sprungleiste   43 
+Sprungleisten   34, 37 
+start   5, 13, 16, 18, 41 
+starte kanal   14, 15 
+station   2, 5, 8, 10, 12, 13, 16, 19, 20, 22, 24, 26, 31, 32, 36, 41, 45, 48, 49 
+Stationen, sicherheitsrelevante   20 
+Stationsadresse   38 
+Stationsnummer   5, 10, 16, 22, 24, 26, 32, 37, 41, 46 
+Stationsnummer maximale   14 
+Strang   3, 17, 20, 36, 41 
+Stream I/O   23, 38 
+strom   28, 30, 46 
+Stromnummer   13, 28, 30, 45, 46, 47, 48 
+STX   26, 36, 42 
+Task-Id   5, 22, 24, 28, 30 
+Telegramm   20, 23, 26, 27, 28, 31, 36, 37, 40, 42, 43, 46, 47, 48 
+Telegrammanfang   42 
+Telegrammformat   26 
+Telegrammfreigabe   36 
+Textdatei   31 
+Timeout   31, 36, 48 
+transmit header   36, 42, 43 
+transmit trailer   36, 43 
+Treiber   33 
+Übertragung   26, 30, 46, 47 
+Übertragungsfehler   42 
+Übertragungsgeschwindigkeit   34, 38 
+Übertragungsweg   23 
+V24   3, 4, 15, 17, 18, 20, 25, 33, 34, 38 
+Verbindung   3, 6, 16, 18, 27, 28, 34, 48, 49 
+Vermaschung   4, 49 
+Vermittlungsebene   24, 30 
+Vorspann   36, 43 
+wait   19, 21, 24, 27, 32 
+Worker   5 
+Zeichen   36, 38, 40, 42, 46 
+Zeichenverluste   46, 47, 48 
+Zeitüberwachung   26, 29 
+ziel   28 
+Zieladresse   38 
+Zielstation   4, 8, 24, 28, 30, 36, 45 
+Zieltask   21, 22, 24, 28, 32, 49 
+Zustand   46 
+Zwischenstation   45 
+#table end#
+
diff --git a/system/net/1.8.7/source-disk b/system/net/1.8.7/source-disk
new file mode 100644
index 0000000..5a39f6c
--- /dev/null
+++ b/system/net/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/11_austausch.img
diff --git a/system/net/1.8.7/src/basic net b/system/net/1.8.7/src/basic net
new file mode 100644
index 0000000..c5e9278
--- /dev/null
+++ b/system/net/1.8.7/src/basic net
@@ -0,0 +1,1148 @@
+PACKET basic net DEFINES                          (* D. Heinrichs *)
+                          (* Version  10 (!) *)   (* 18.02.87     *)
+  nam,                                            (* 03.06.87     *)
+  max verbindungsnummer,                          (*              *)
+  neuer start,
+  neue routen,
+  packet eingang,
+  neue sendung,
+  zeitueberwachung,
+  verbindung,
+  loesche verbindung:
+
+TEXT PROC nam (TASK CONST t):
+  IF t = collector THEN name (t)
+  ELIF station (t) <> station (myself) 
+  THEN "** fremd "+text(station(t))+" **"
+  ELSE name (t)
+  FI
+END PROC nam;
+
+INT PROC tasknr (TASK CONST t):
+  IF t = collector THEN maxtasks
+  ELSE index (t)
+  FI
+END PROC tasknr;
+
+LET
+    maxtasks = 127,
+    maxstat = 127,
+    max strom = 20,
+    max strom 1 = 21,
+    stx = ""2"",
+    code stx = 2, 
+    error nak = 2,
+    seiten groesse = 512,
+    dr verwaltungslaenge = 8,
+    dr verwaltungslaenge2=10,
+    openlaenge = 24,
+    vorspannlaenge = 14, 
+    ack laenge = 12,
+    min data length = 64,
+    (* Codes der Verbindungsebene *) 
+ 
+    task id code = 6, 
+    name code = 7,
+    task info code = 8, 
+    routen liefern code = 9, 
+
+    (* Typen von Kommunikationsströmen *)
+
+    send wait = 0,
+    zustellung = 1,
+    call pingpong = 2,
+    call im wait = 3,
+    call im abbruch = 4,
+    call in zustellung = 5,
+
+    (*quittungscodes*)
+
+    ok = 0,
+    von vorne = 1,
+    wiederhole = 2,
+    loesche = 3,
+    beende = 4;
+
+LET STEUER =
+      STRUCT ( 
+      INT  head, 
+           zwischenziel,
+           zielrechner, 
+           quellrechner,
+           strom,
+           sequenz,
+           seitennummer,
+      TASK quelle,ziel,
+      INT  sende code);
+ 
+BOUND STEUER VAR open block;
+
+BOUND STRUCT (STEUER steuer, INT typ, maxseq) VAR info block; 
+ 
+BOUND STRUCT (
+      INT  head, 
+           zwischenziel,
+           zielrechner, 
+           quellrechner,
+           strom,
+           sequenz,
+           seitennummer) VAR vorspann ;
+ 
+LET ACK = STRUCT ( 
+      INT  head, 
+           zwischenziel,
+           zielrechner, 
+           quellrechner,
+           strom, 
+           code);
+BOUND ACK VAR ack packet ; 
+BOUND ACK VAR transmitted ack packet;
+
+BOUND STRUCT (ROW maxstat INT port, 
+              ROW maxstat INT zwischen)  VAR route;
+ 
+INT CONST max verbindungsnummer := max strom;
+INT VAR codet,net mode, nutzlaenge := data length,
+        data len via node := data length via node;
+
+TEXT VAR buffer first;
+ 
+DATASPACE VAR work space := nilspace;
+DATASPACE VAR transmitted ack space := nilspace;
+ 
+ 
+INT VAR pakete pro seite,
+        pakete pro seite minus 1,
+        packets per page via node,
+        packets per page via node minus 1,
+        datenpacketlaenge via node,
+        datenpacketlaenge ;
+ 
+INT VAR strom; 
+INT VAR last data := -1;
+INT VAR   own:=station (myself) ,
+          quit max := 3,
+          quit zaehler := 3,
+          own256 := 256*own;
+INT CONST stx open := code stx+256*openlaenge,
+          stx quit := code stx+256*acklaenge;
+
+  STEUER VAR opti; 
+  ROW maxstrom1 STEUER VAR verbindungen; 
+  ROW maxstrom1 DATASPACE VAR netz dr; 
+  ROW maxstrom1 INT VAR zeit, typ, open try;
+  FOR strom FROM 1 UPTO maxstrom1 REP vdr := nilspace; forget (vdr) PER;
+  ROW maxstrom INT VAR dr page ;
+  ROW maxtasks INT VAR alter call;
+
+.vx : verbindungen (strom). 
+ 
+vdr: netz dr (strom). 
+
+ via node:
+    vx.zielrechner <= 0 OR vx.quellrechner <= 0 OR
+    transmit via node  OR receive via node.
+
+ transmit via node:
+    route.zwischen (vx.zielrechner) <> vx.zielrechner AND vx.zielrechner <> own.
+
+ receive via node:
+    route.zwischen (vx.quellrechner) <> vx.quellrechner AND vx.quellrechner <> own.
+
+falsche stromnummer: strom < 1 OR strom > maxstrom.
+
+zielrechner ok: vorspann.zielrechner > 0 AND vorspann.zielrechner <= maxstat.
+
+quellrechner ok: vorspann.quellrechner > 0
+                 AND vorspann.quellrechner <= maxstat.
+
+call aufruf: typ(strom) >= call pingpong.
+
+alles raus: vx.seitennummer = -1 AND letztes packet der seite . 
+
+letztes packet der seite :
+(vx.sequenz AND packets per page minus 1) = packets per page minus 1.
+
+neue verbindung: code t = open laenge.
+
+PROC neue routen:
+  route := old ("port intern");
+END PROC neue routen;
+
+PROC neuer start (INT CONST empfangsstroeme, mode):
+  net mode := mode;
+  strom := 1;
+  neue routen;
+  transmitted ack space := nilspace;
+  workspace := nilspace;
+  open block := workspace; 
+  info block := workspace;
+  nutzlaenge := data length;
+  data len via node := data length via node;
+  pakete pro seite:= seitengroesse DIV nutzlaenge;
+  pakete pro seite minus 1 := pakete pro seite -1;
+  packets per page via node := seitengroesse DIV data len via node;
+  packets per page via node minus 1 := packets per page via node - 1;
+  datenpacketlaenge := vorspannlaenge + nutzlaenge;
+  datenpacketlaenge via node := vorspannlaenge + data len via node;
+  vorspann := workspace; 
+  ack packet := workspace;
+  transmitted ack packet := transmitted ack space;
+  FOR strom FROM 1 UPTO maxstrom1 REP 
+  vx.strom := 0;  forget (vdr)
+  PER; 
+  INT VAR i;
+  FOR i FROM 1 UPTO maxtasks REP alter call (i) := 0 PER;
+  quitmax := empfangsstroeme;
+  own:=station (myself);
+  quit zaehler := quit max;
+  own256 := 256*own; 
+  reset box (net mode);
+  buffer first := "";
+  flush buffers;
+  INT VAR err;
+  fehlermeldung ruecksetzen.
+
+ fehlermeldung ruecksetzen:
+  control (12,0,0,err).
+
+END PROC neuer start;
+
+DATASPACE PROC verbindung (INT CONST nr):
+  INT VAR memory := strom;
+  strom := nr;
+  infoblock.steuer := verbindungen (nr);
+  infoblock.typ := typ (nr);
+  infoblock.maxseq := dspages (netzdr(nr)) * packets per page;
+  strom := memory;
+  workspace
+END PROC verbindung;
+
+PROC neue sendung (TASK CONST q,z, INT CONST cod,z stat, DATASPACE CONST dr):
+
+  naechste verbindung vorbereiten;
+  forget (vdr); vdr := dr;
+  sendung starten (q, z, z stat, cod)
+END PROC neue sendung; 
+
+PROC zeitueberwachung
+     (INT VAR snr, TASK VAR  q, z, INT VAR ant,DATASPACE VAR  dr):
+  snr INCR 1;
+  FOR strom FROM snr UPTO maxstrom REP zeitkontrolle PER;
+  snr := 0. 
+
+zeitkontrolle: 
+  IF vx.strom <> 0 AND zeit(strom) > 0
+  THEN 
+    zeit(strom) DECR 1; 
+    IF sendung noch nicht zugestellt
+    THEN 
+      IF zeit(strom) = 0
+      THEN
+         empfangsreport ("Nicht zustellbar. ");
+         loesche verbindung (strom)
+      ELSE
+         snr := strom;
+         q := vx.quelle;
+         z := vx.ziel;
+         ant := vx.sendecode;
+         dr := vdr;
+         LEAVE zeitueberwachung
+      FI
+    ELIF zeit(strom) = 0
+    THEN wiederholen
+    FI 
+  FI. 
+ 
+sendung noch nicht zugestellt:
+  typ (strom) = zustellung.
+
+wiederholen: 
+  IF sendeeintrag 
+  THEN 
+    sendung wiederholen
+  ELSE
+    empfangseintrag freigeben
+  FI. 
+ 
+sendeeintrag : vx.quellrechner = own . 
+ 
+sendung wiederholen:
+  IF wiederholung noch sinnvoll 
+  THEN
+    IF frisch 
+    THEN 
+      time out bei open
+    ELSE 
+      datenteil wiederholen 
+    FI
+  ELSE
+    sendung loeschen
+  FI.
+
+wiederholung noch sinnvoll:
+  task noch da AND bei call noch im call.
+
+task noch da: vx.quelle = collector OR exists (vx.quelle).
+
+bei call noch im call: 
+  IF call aufruf
+  THEN
+    callee (vx.quelle) = vx.ziel
+  ELSE
+    TRUE
+  FI.
+
+frisch: vx.sequenz = -1. 
+ 
+time out bei open:
+  IF vx.sendecode > -4 OR opentry (strom) > 0
+  THEN
+    open wiederholen ;
+    opentry (strom) DECR 1
+  ELSE
+    nak an quelle senden
+  FI.
+
+nak an quelle senden:
+  dr := nilspace;
+  BOUND TEXT VAR erm := dr;
+  erm := "Station "+text(vx.zielrechner)+" antwortet nicht";
+  snr := strom;
+  q := vx.ziel;
+  z := vx.quelle;
+  ant := error nak;
+  sendung loeschen;
+  LEAVE zeitueberwachung .
+
+open wiederholen: 
+  sendereport ("wdh open"); 
+  IF opentry (strom) > 0 THEN zeit(strom) := 4 ELSE zeit(strom) := 40 FI;
+  openblock := vx; 
+  openblock.head := stx open; 
+  ab die post. 
+ 
+datenteil wiederholen: 
+  sendereport ("wdh data. sqnr "+text (vx.sequenz));
+  senden .
+
+empfangseintrag freigeben:
+  IF antwort auf call 
+  THEN
+    weiter warten
+  ELSE
+    empfangsreport ("Empfangseintrag freigegeben");
+    loesche verbindung (strom)
+  FI.
+antwort auf call: callee (vx.ziel) = vx.quelle.
+
+weiter warten: zeit (strom) := 400.
+
+END PROC zeitueberwachung;
+
+PROC sendereport (TEXT CONST txt):
+  report (text (strom)+":"+txt+". Absender: """+nam (vx.quelle)+
+          """. Ziel "+text(vx.zielrechner) + " Taskindex: " +
+          text (index (vx.ziel))); 
+END PROC sendereport;
+
+PROC empfangsreport  (TEXT CONST txt):
+  report (text (strom)+":"+txt+". Empfänger: """
+          +nam (vx.ziel)+""". Quelle "+text (vx.quellrechner) +
+          " Taskindex: " + text (index (vx.quelle)));
+END PROC empfangsreport  ;
+
+PROC sendung loeschen:
+  strom loeschen (tasknr (vx.quelle))
+END PROC sendung loeschen;
+
+PROC strom loeschen (INT CONST tasknr):
+    IF callaufruf CAND alter call (tasknr ) = strom
+    THEN
+       alter call (tasknr ) := 0
+    FI;
+    vx.strom := 0;
+    forget (vdr)
+END PROC strom loeschen;
+
+PROC empfang loeschen:
+    quit zaehler INCR 1;
+    strom loeschen (tasknr (vx.ziel))
+END PROC empfang loeschen;
+
+PROC loesche verbindung (INT CONST nr):
+  strom := nr;
+  IF sendeeintrag
+  THEN
+    sendung loeschen
+  ELSE
+    gegenstelle zum loeschen auffordern; 
+    empfang loeschen
+  FI.
+
+gegenstelle zum loeschen auffordern:
+  IF verbindung aktiv THEN quittieren (-loesche) FI.
+
+verbindung aktiv: vx.strom > 0.
+
+sendeeintrag: vx.quellrechner = own . 
+
+END PROC loesche verbindung;
+
+PROC weiter senden: 
+  IF NOT alles raus
+  THEN
+    sequenz zaehlung; 
+    IF neue seite THEN seitennummer eintragen FI;
+    senden
+  FI.
+
+sequenz zaehlung: 
+  vx.sequenz INCR 1. 
+ 
+neue seite: 
+  IF  via node THEN (vx.sequenz AND packets per page via node minus 1) = 0
+                       ELSE (vx.sequenz AND pakete pro seite minus 1) = 0
+  FI.
+
+seitennummer eintragen: 
+  dr page (strom) :=  vx.seiten nummer;
+  vx.seitennummer := next ds page (vdr, dr page (strom)). 
+ 
+ 
+END PROC weiter senden;
+ 
+.packets per page:
+
+  IF via node THEN packets per page via node
+              ELSE pakete pro seite
+  FI.
+
+packets per page minus 1:
+   IF via node THEN packets per page via node minus 1
+               ELSE pakete pro seite minus 1
+   FI.
+
+used length:
+
+   IF via node THEN data len via node
+               ELSE nutzlaenge
+   FI.
+
+PROC senden:
+  INT VAR nl;
+  zeit(strom) := 6;
+  openblock := vx;
+  nl := used length;
+  transmit header (workspace);
+  vorspann senden;
+  daten senden;
+  transmit trailer.
+
+vorspann senden: 
+  blockout (workspace, 1, dr verwaltungslaenge, vorspannlaenge). 
+ 
+daten senden: 
+  blockout (vdr,dr page (strom),distanz,nl). 
+ 
+distanz: nl* (vx.sequenz AND packets per page minus 1). 
+
+END PROC senden;
+
+PROC naechste verbindung vorbereiten: 
+  FOR strom FROM 1 UPTO maxstrom REP 
+  UNTIL vx.strom = 0 PER; 
+  IF vx.strom <> 0 THEN errorstop ("Verbindungsengpass") FI. 
+END PROC naechste verbindung vorbereiten;
+
+PROC sendung starten (TASK CONST quelle, ziel, INT CONST code): 
+  sendung starten (quelle,ziel, station(ziel), code) 
+END PROC sendung starten;
+ 
+PROC sendung starten (TASK CONST quelle, ziel, INT CONST ziel station,code):
+  IF ziel station = own 
+  THEN
+    report ("Irrläufer: Sendung an eigene Station. Absender:"""+
+            nam (quelle)+""".");
+    vx.strom := 0;
+    forget (vdr)
+  ELSE
+    openblock.ziel := ziel;
+    openblock.quelle :=quelle; 
+    openblock.sendecode := code;
+    openblock.zielrechner:= ziel station;
+    openblock.quellrechner :=own;
+    openblock.zwischenziel := route.zwischen (ziel station)+own256;
+    alten call loeschen (quelle);
+    IF call oder ping pong
+    THEN typ (strom) := call pingpong; call merken
+    ELSE typ (strom) := send wait FI;
+    sendung neu starten
+  FI.
+
+call oder pingpong: openblock.ziel = callee (openblock.quelle).
+
+call merken: alter call (tasknr (quelle)) := strom.
+
+END PROC sendung starten;
+
+PROC encode packet length (INT VAR val):
+
+   IF val < 96 THEN
+     ELIF val < 160 THEN val DECR 32
+       ELIF val < 288 THEN val DECR 128
+         ELIF val < 544 THEN val DECR  352
+           ELIF val < 1056 THEN val DECR 832
+             ELIF val < 2080 THEN val DECR 1824
+    FI;
+    rotate (val, 8)
+
+ENDPROC encode packet length;
+
+PROC sendung neu starten:
+  INT VAR value;
+  openblock.head:= stx open; 
+  openblock.sequenz := -1; 
+  openblock.seitennummer:= next ds page (vdr,-1); 
+  openblock.strom := strom;
+  vx := open block; 
+  schnelles nak bei routen liefern;
+  ab die post;
+  value := vorspannlaenge + used length;
+  encode packet length (value);
+  vx.head:=code stx+value.
+
+schnelles nak bei routen liefern:
+  IF openblock.sendecode = -routen liefern code
+  THEN
+    openblock.zwischenziel := openblock.zielrechner+own256;
+    zeit(strom) := 2;
+    opentry (strom) := 0
+  ELSE
+    zeit (strom) :=8;
+    opentry (strom) := 2
+  FI.
+   
+END PROC sendung neu starten; .
+
+ab die post: 
+   transmit header (workspace);
+   block out (work space,1, dr verwaltungslaenge,open laenge);
+   transmit trailer.
+
+PROC alten call loeschen (TASK CONST quelle):
+  IF alter call aktiv
+  THEN
+    INT VAR lstrom := strom;
+    vx:=openblock;
+    strom := alter call (tasknr (quelle));
+    IF in ausfuehrungsphase
+    THEN
+      sendereport ("Call-Löschung vorgemerkt");
+      loeschung vormerken
+    ELSE
+      report ("Call gelöscht."""+nam(quelle)+""". Strom "+text(strom));
+      loesche verbindung (strom)
+    FI;
+    strom := lstrom;
+    openblock := vx
+  FI.
+
+in ausfuehrungsphase:
+  typ(strom) = call im wait OR typ (strom) = call in zustellung.
+
+loeschung vormerken:
+  typ(strom) := call im abbruch;
+  alter call (tasknr (quelle)) := 0.
+
+ 
+  alter call aktiv:
+    alter call (tasknr (quelle)) > 0.
+
+END PROC alten call loeschen;
+
+PROC packet eingang
+  ( INT VAR snr, TASK VAR  q, z, INT VAR ant,DATASPACE VAR  dr):
+    snr := 0;
+    fehlertest;
+    vorspann holen; 
+    IF NOT ring logik THEN daten teil FI.
+
+ring logik: FALSE.
+
+fehlertest:
+#
+    INT VAR c12;
+    control (12,0,0,c12);
+    IF c12 <> 0
+    THEN
+      flush buffers;
+      report ("E/A-Fehler "+text (c12));
+      control (12,0,0,c12);
+      LEAVE packet eingang
+    FI.
+
+                                                #.
+
+vorspann holen: 
+  sync; 
+  IF NOT blockin (workspace, 1, dr verwaltungslaenge2, block laenge)
+  THEN LEAVE packeteingang 
+  FI.
+
+
+blocklaenge: IF code t  > min data length
+             THEN 
+               vorspannlaenge-2 
+             ELSE 
+               code t -2 
+             FI. 
+
+sync: 
+ IF NOT packet start already inspected
+ THEN
+   TEXT VAR skipped, t:= "";
+   skipped := next packet start;
+   IF skipped = "" THEN LEAVE packet eingang FI;
+   t := incharety (1);
+   code t := code (t);
+ ELSE
+   skipped := buffer first;
+   buffer first := "";
+   t := incharety (1);
+   code t := code (t);
+ FI;
+ decode packet length;
+IF skipped=stx AND laenge ok THEN LEAVE sync FI;
+  REP 
+    skipped CAT t;
+    t := incharety (1);  (* next character *)
+    IF t = "" THEN 
+      report ("skipped",skipped);
+      LEAVE packet eingang
+    FI ;
+    codet := code (t);
+  UNTIL blockanfang OR length (skipped) > 200 PER; 
+  decode packet length;
+  IF skipped <> stx THEN report ("skipped bei sync:", skipped)    FI. 
+ 
+decode packet length:
+
+IF code t < 96 THEN
+  ELIF code t < 128 THEN code t INCR 32
+    ELIF code t < 160 THEN code t INCR 128
+      ELIF code t < 192 THEN code t INCR 352
+        ELIF code t < 224 THEN code t INCR 832
+          ELIF code t < 256 THEN code t INCR 1824
+FI.
+
+packet start already inspected: buffer first <> "".
+
+blockanfang: 
+  (skipped SUB length(skipped)) = stx AND laenge ok.
+
+laenge ok:
+  (codet = datenpacketlaenge OR codet = datenpacketlaenge via node
+  OR codet = ack laenge OR code t = openlaenge). 
+ 
+zielnummer:    vorspann.zielrechner.
+
+daten teil: 
+  IF zielnummer = own
+  THEN
+    ziel erreicht (openblock,snr,q,z,ant,dr)
+  ELSE
+    weiter faedeln
+  FI.
+
+weiter faedeln:
+  INT VAR value;
+  IF zielrechner ok
+  THEN
+    IF neue verbindung
+    THEN
+      IF (openblock.sendecode = -routenlieferncode) OR NOT route ok
+        THEN LEAVE packet eingang
+      FI
+    FI;
+    value := code t;
+    encode packet length (value);
+    vorspann.head := code stx + value;
+    vorspann.zwischenziel := own256 + route.zwischen (vorspann.zielrechner);
+    nutzdaten einlesen;
+    dr := workspace;
+    snr := 1000;
+    ant := zielnummer
+  FI.
+
+nutzdaten einlesen:
+  IF code t > data len via node
+  THEN
+    IF NOT blockin (workspace, 1, drverwaltungslaenge+vorspannlaenge, data len via node)
+    THEN
+      LEAVE packeteingang
+    FI;
+    IF NOT next packet ok THEN LEAVE packeteingang FI
+  FI.
+
+END PROC packet eingang;
+
+PROC ziel erreicht (STEUER CONST prefix,
+          INT VAR snr, TASK VAR  q, z, INT VAR ant,DATASPACE VAR  dr):
+  last data := -1;
+  IF NOT quellrechner ok
+  THEN
+    report ("Quellrechner "+text(prefix.quellrechner));
+    LEAVE ziel erreicht
+  FI;
+  IF neue verbindung 
+  THEN
+    IF NOT route ok OR NOT quelltask ok
+    THEN report ("verbotene Route: " + text (prefix.quellrechner));
+         LEAVE ziel erreicht
+    FI;
+    verbindung bereitstellen
+  ELIF quittung 
+  THEN 
+    strom := ack packet.strom; 
+    IF falsche stromnummer THEN report ("Strom falsch in Quittung");
+                                LEAVE ziel erreicht FI;
+    IF vx.strom = 0 THEN LEAVE ziel erreicht FI;
+    IF ackpacket.code >= ok   THEN weiter senden
+    ELIF NOT route ok THEN
+        sendereport ("verbotene Route bei Quittung");
+        LEAVE ziel erreicht
+    ELIF ackpacket.code = -von vorne THEN
+        sendereport ("Neustart");
+        openblock := vx; 
+        sendung neu starten 
+    ELIF ackpacket.code = -wiederhole THEN back 16
+    ELIF ackpacket.code = -loesche    THEN fremdloeschung
+    ELIF ackpacket.code = -beende AND alles raus THEN strom abschliessen
+    FI
+  ELIF verbindung festgestellt 
+  THEN
+    zeit(strom) := 400;
+    opti := vx;
+    datenpacket
+  ELSE 
+    strom := maxstrom1; 
+    vx:=prefix;
+    report ("Daten ohne Eroeffnung von " +text(prefix.quellrechner) 
+    +"  Sequenznr "+text(prefix.sequenz)); 
+    daten entfernen (used length);
+    IF alles raus THEN quittieren (-beende) ELSE quittieren(-von vorne) FI
+  FI. 
+
+quelltask ok:
+  prefix.quelle = collector OR antwort auf routen liefern
+  OR station (prefix.quelle) = prefix.quellrechner.
+
+antwort auf routen liefern: prefix.quelle = myself.
+
+verbindung bereitstellen:
+  IF (prefix.sendecode < 0 OR station (prefix.ziel) = own)
+     AND quellrechner ok
+  THEN
+    freie verbindungsnummer; 
+    vdr := nilspace;
+    vx := open block; 
+    zeit(strom) := 30;
+    quittieren falls genug pufferplatz;
+    vx.sequenz := 0 ; 
+    opti := vx;
+    dr page (strom) :=-2;
+    IF abschluss THEN rueckmeldung FI
+  FI.
+
+loeschung vorgemerkt: typ(strom) = call im abbruch.
+
+strom abschliessen:
+  IF call aufruf
+  THEN
+    wdh data vor ablauf der zustellversuche bei der gegenstation;
+    ausfuehrungsphase merken
+  ELSE
+    wdh data sperren
+  FI.
+
+wdh data sperren:
+    zeit (strom) := 12000.
+
+wdh data vor ablauf der zustellversuche bei der gegenstation:
+    zeit (strom) := 80.
+
+ausfuehrungsphase merken: typ(strom) := call in zustellung.
+ 
+back16:
+  datenraum etwas rueckspulen; 
+  opentry (strom) := 2;
+  nicht sofort senden (* wegen vagabundierender Quittungen *).
+
+nicht sofort senden: zeit(strom) := 2.
+
+datenraum etwas rueckspulen:
+  INT VAR pps := packets per page ;
+  sendereport ("etwas rueckgespult");
+  INT VAR  vs :=-1;
+  dr page (strom) := -1;
+  INT VAR i;
+  FOR i FROM 1 UPTO vx.sequenz DIV pps - etwas REP
+    vs INCR pps;
+    dr page (strom) := next ds page (vdr, dr page (strom)) 
+  PER;
+  vx.seiten nummer := next ds page (vdr, dr page (strom)) ;
+  vx.sequenz := vs.
+
+etwas: 3.
+
+fremdloeschung:
+  IF fremdrechner ok und sendung 
+  THEN
+    IF typ (strom) = call in zustellung
+    THEN
+      typ (strom) := call im wait
+    ELSE
+      IF NOT alles raus
+      THEN
+        sendereport ("Sendung von Gegenstelle geloescht")
+      FI;
+      sendung loeschen
+    FI
+  FI.
+
+fremdrechner ok und sendung:
+  ackpacket.quellrechner = vx.zielrechner .
+
+
+quittieren falls genug pufferplatz:
+  IF quit zaehler > 0 THEN
+    quit zaehler DECR 1;
+    open quittieren;
+    block vorab quittieren
+  ELSE
+    quittieren (-wiederhole)
+  FI.
+
+open quittieren: quittieren (ok).
+block vorab quittieren:
+  IF prio (myself) < 3 THEN quittieren (ok) FI.
+
+quittung:  code t <= ack laenge. 
+ 
+ 
+verbindung festgestellt: 
+  FOR strom FROM maxstrom DOWNTO 1 REP 
+    IF bekannter strom
+    THEN LEAVE verbindung festgestellt WITH TRUE FI 
+  PER; 
+  FALSE. 
+ 
+bekannter strom: 
+  vx.strom = prefix.strom AND vom selben rechner. 
+ 
+vom selben rechner: 
+  vx.quellrechner = prefix.quellrechner. 
+ 
+daten: 
+      IF neue seite da THEN check for valid pagenr;
+                            dr page(strom) := prefix.seitennummer;
+        ELIF prefix.seitennummer < dr page(strom)
+              THEN empfangsreport ("Falsche Seitennummer, Soll: " +
+                                  text(drpage(strom)) + " ist: " +
+                                  text (prefix.seitennummer)
+                                  + " bei Sequenznr: " +
+                                  text(prefix.sequenz));
+                   flush buffers;
+                   quittieren (- wiederhole);
+                   LEAVE ziel erreicht
+  FI;
+  sequenz zaehlung;
+  IF neue seite kommt 
+  THEN 
+    vx.seiten nummer := prefix.seiten nummer; 
+    dr page(strom) := prefix.seitennummer;
+  FI;
+  quittieren(ok); 
+  IF NOT blockin (vdr, opti.seiten nummer, distanz, nl)
+  COR NOT next packet ok
+  THEN quittieren (-wiederhole);
+       LEAVE ziel erreicht
+  FI; 
+  last data := strom.
+ 
+check for valid pagenr:
+   IF prefix.seitennummer < dr page(strom) AND prefix.seitennummer > -1
+         THEN report ("Absteigende Seitennummern, alt: " + text(drpage(strom))+
+                      " neu: "+ text(prefix.seitennummer) + " Seq.nr: " +
+                       text(vx.sequenz) ) ;
+              flush buffers;
+              quittieren (- von vorne);
+              LEAVE ziel erreicht;
+   FI.
+
+datenpacket:
+  INT VAR nl := used length;
+  INT VAR pps1 := packets per page minus 1;
+  IF sendung wartet auf zustellung THEN auffrischen ELSE daten holen FI.
+
+sendung wartet auf zustellung: typ (strom) = zustellung.
+
+auffrischen: zeit (strom) := 200; daten entfernen (nl).
+
+daten holen:
+  IF opti.sequenz >= prefix.sequenz AND opti.sequenz < prefix.sequenz+100
+     AND prefix.sequenz >= 0
+  THEN 
+    IF opti.sequenz <> prefix.sequenz
+    THEN empfangsreport ("Sequenzreset von "+text(opti.sequenz)+" auf "+
+                  text (prefix.sequenz));
+         vx.sequenz := prefix.sequenz;
+         IF pagenumber ok
+            THEN dr page (strom) := prefix.seitennummer
+            ELSE empfangsreport ("Blocknummer falsch, neu: "+
+                 text (prefix.seitennummer) + ", alt : " +
+                 text (drpage(strom)) );
+         FI;
+         vorabquittung regenerieren 
+    FI;
+    daten  ; 
+    IF abschluss THEN rueckmeldung FI;
+  ELSE 
+    empfangsreport ("Sequenzfehler: soll "+text(vx.sequenz)+" ist "+ 
+            text(prefix.sequenz));
+    quittieren (-wiederhole);
+    daten entfernen (nl)
+  FI. 
+ 
+pagenumber ok:
+   dr page (strom) >= prefix.seitennummer .
+
+rueckmeldung:
+  snr := strom;
+  q := vx.quelle;
+  z := vx.ziel;
+  ant := vx.sendecode;
+  dr := vdr;
+  LEAVE ziel erreicht.
+
+vorabquittung regenerieren:
+  IF prio (myself) < 3
+  THEN
+    quittieren (ok)
+  FI.
+ 
+distanz: (opti.sequenz AND  pps1 ) * nl. 
+ 
+sequenz zaehlung: 
+  vx.sequenz INCR 1. 
+ 
+neue seite da:
+  neue seite kommt.
+
+neue seite kommt: 
+(vx.sequenz AND pps1) = 0. 
+ 
+freie verbindungsnummer: 
+  INT VAR h strom :=maxstrom1, cstrom := 0;
+  FOR strom FROM 1 UPTO maxstrom REP 
+    IF vx.strom = 0 THEN h strom := strom ;
+                         typ(strom) := send wait
+    ELIF bekannter strom
+    THEN empfangsreport ("Reopen"); 
+         quit zaehler INCR 1;
+         IF typ (strom) = zustellung THEN typ (strom) := send wait FI;
+         forget (vdr);
+         LEAVE freie verbindungsnummer 
+    ELIF antwort auf call
+    THEN
+      IF loeschung vorgemerkt
+      THEN 
+        vx := prefix;
+        loesche verbindung (strom);
+        LEAVE ziel erreicht
+      FI;
+      cstrom := strom;
+      typ (strom) := call pingpong;
+      forget (vdr);
+    FI
+  PER; 
+  IF cstrom > 0 THEN strom := cstrom ELSE strom := h strom FI; 
+  IF strom = maxstrom1 THEN
+    vx:=prefix;
+    empfangsreport ("Verbindungsengpass");
+    quittieren (-wiederhole);
+    LEAVE ziel erreicht
+  FI. 
+
+antwort auf call:
+  prefix.sendecode >= 0 AND
+  call aufruf AND vx.quelle = prefix.ziel AND vx.ziel = prefix.quelle. 
+
+END PROC ziel erreicht;
+
+PROC daten entfernen (INT CONST wieviel):
+    BOOL VAR dummy ;
+    dummy:=blockin (workspace, 2, 0, wieviel) 
+END PROC daten entfernen;
+
+BOOL PROC route ok:
+  INT VAR zwischenquelle := vorspann.zwischenziel DIV 256,
+          endquelle := vorspann.quellrechner;
+    zwischenquelle abgleichen;
+    endquelle abgleichen;
+    TRUE.
+
+zwischenquelle abgleichen:
+  IF NOT zwischenroute gleich
+  THEN
+    IF NOT zwischenabgleich erlaubt THEN LEAVE route ok WITH FALSE FI;
+    route.port (zwischenquelle) := channel;
+    route.zwischen (zwischenquelle) := zwischenquelle;
+    abgleich (zwischenquelle, zwischenquelle)
+  FI.
+
+zwischenabgleich erlaubt: route.port (zwischenquelle) < 256.
+
+endquelle abgleichen:
+  IF NOT endroute gleich
+  THEN
+    IF NOT endabgleich erlaubt THEN LEAVE route ok WITH FALSE FI;
+    route.port (endquelle) := channel;
+    route.zwischen (endquelle) := zwischenquelle;
+    abgleich (endquelle, zwischenquelle)
+  FI.
+
+endabgleich erlaubt: route.port (endquelle) < 256.
+
+zwischenroute gleich:
+  (route.port (zwischenquelle) AND 255) = channel
+  AND
+  route.zwischen (zwischenquelle) = zwischenquelle.
+
+endroute gleich:
+  (route.port (endquelle) AND 255) = channel
+  AND
+  route.zwischen (endquelle) = zwischenquelle.
+
+END PROC route ok;
+
+BOOL PROC abschluss:
+
+  last data := -1;
+  IF neue seite kommt AND vx.seiten nummer = -1 
+  THEN 
+    quittieren (-beende);
+    an ziel weitergeben 
+  ELSE
+    FALSE
+  FI. 
+neue seite kommt: 
+(vx.sequenz AND packets per page minus 1) = 0. 
+ 
+an ziel weitergeben: 
+  IF tasknummerfrage  THEN taskfrage beantworten ;pufferplatz ; FALSE
+  ELIF tasknamenfrage THEN name senden ;pufferplatz ; FALSE
+  ELIF taskinfofrage  THEN task info senden;pufferplatz ; FALSE
+  ELIF routenfrage    THEN routen senden; pufferplatz; FALSE
+  ELSE                     senden ; TRUE
+  FI. 
+
+pufferplatz : quitzaehler INCR 1 .
+
+senden:
+  IF  callaufruf
+  THEN
+    ein versuch  (* bei Antwort auf Call muß ein Zustellversuch reichen *)
+  ELSE
+    max 100 versuche; 
+    typ (strom) := zustellung
+  FI.
+
+tasknummerfrage:opti.sendecode = -taskid code.
+ 
+tasknamenfrage: opti.sendecode = -name code.
+ 
+taskinfofrage: opti.sendecode = -task info code.
+
+routenfrage: opti.sendecode = -routen liefern code.
+
+max 100 versuche: zeit(strom) := 100.
+
+ein versuch: zeit (strom) := 1.
+
+taskfrage beantworten:
+  disable stop;
+  BOUND TEXT VAR tsk := vdr; 
+  TEXT VAR save tsk := tsk;
+  forget (vdr); vdr := nilspace; 
+  BOUND TASK VAR task id := vdr;
+  task id := task(save tsk);
+  IF is error THEN 
+    clear error; enable stop;
+    forget (vdr); vdr := nilspace; 
+    BOUND TEXT VAR errtxt := vdr;
+    errtxt := text(own)+"/"""+save tsk+""" gibt es nicht";
+    sendung starten (collector, opti.quelle, 2)
+  ELSE
+    enable stop;
+    sendung starten (collector, opti.quelle, 0)
+  FI.
+ 
+name senden: 
+  quittieren (-loesche);
+  forget (vdr); vdr := nilspace;
+  tsk := vdr; 
+  tsk := nam (opti.ziel);
+  sendung starten (collector, opti.quelle, 0). 
+ 
+routen senden:
+  forget (vdr); vdr := old ("port intern");
+  sendung starten (opti.ziel, opti.quelle, 0).
+
+task info senden:
+  disable stop;
+  BOUND INT VAR ti code := vdr;
+  INT VAR ti cd := ti code;
+  forget (vdr); vdr := nilspace;
+  FILE VAR task inf := sequential file (output,vdr);
+  head line (task inf,"Station "+text(own)); 
+  task info (ti cd, task inf);
+  IF is error
+  THEN
+    forget (vdr); vdr := nilspace;
+    errtxt := vdr;
+    errtxt := errormessage;
+    clear error;
+    sendung starten (collector, opti.quelle, 2)
+  ELSE
+    sendung starten (collector,opti.quelle,0)
+  FI;
+  enable stop
+END PROC abschluss ;
+
+PROC quittieren(INT CONST code) : 
+  INT VAR quell := vx.quellrechner ;
+  transmitted ackpacket := ACK:(stx quit, route.zwischen (quell)+own256, quell, own,
+                    vx.strom, code);
+  transmit header (transmitted ack space);
+  blockout (transmitted ack space,1,dr verwaltungslaenge, ack laenge); 
+  transmit trailer;
+END PROC quittieren; 
+
+BOOL PROC next packet ok:
+  buffer first := next packet start;
+  buffer first = "" COR normal packet start.
+
+normal packet start:
+  IF buffer first = stx
+  THEN
+    TRUE
+  ELSE
+    buffer first := ""; flush buffers; FALSE
+  FI.
+
+END PROC next packet ok;
+END PACKET basic net;
+
+
diff --git a/system/net/1.8.7/src/net files-M b/system/net/1.8.7/src/net files-M
new file mode 100644
index 0000000..ae6f9f3
--- /dev/null
+++ b/system/net/1.8.7/src/net files-M
@@ -0,0 +1,5 @@
+net report
+net hardware interface
+basic net
+net manager
+
diff --git a/system/net/1.8.7/src/net hardware interface b/system/net/1.8.7/src/net hardware interface
new file mode 100644
index 0000000..4e3466a
--- /dev/null
+++ b/system/net/1.8.7/src/net hardware interface
@@ -0,0 +1,389 @@
+PACKET net hardware
+
+(************************************************************************)
+(****  Netzprotokoll Anpassung                                          *)
+(****  Komplette Version mit BUS Anpassung           10.06.87           *)
+(****  mit I/0 Controls  fuer integrierte Karten                        *)
+(****  Verschiedene Nutztelegrammgrössen                                *)
+(****  Version: GMD 2.0                              A.Reichpietsch     *)
+(************************************************************************)
+
+   DEFINES
+        blockin,
+        blockout,
+        set net mode,
+        net address,
+        mode text,
+        data length,
+        data length via node,
+        decode packet length,
+        next packet start,
+        flush buffers,
+        transmit header,
+        transmit trailer,
+        version,
+        reset box,
+        max mode,
+        net mode:
+
+
+
+
+   LET                eak prefix laenge = 6,
+               packet length before stx = 14  (*eth header =14 *),
+                        maximum mode nr = 12,
+                                    stx = ""2"",
+                                niltext = "",
+                                   null = "0",
+                               hex null = ""0"",
+                                  blank = " ",
+                             eak prefix = ""0""0""0""0"",
+                             typefield  = "EU",
+                        prefix adresse  = "BOX",
+                 second prefix adresse  = ""0"BOX",
+             second address type bound  = 90;
+
+   INT CONST data length via node :: 64;
+   TEXT CONST version :: "GMD 2.0  (10.6.87)";
+
+
+   TEXT VAR own address;
+   INT VAR paketlaenge, eumel paket laenge, mode, rahmenlaenge, actual data length;
+
+BOOL PROC blockin (DATASPACE VAR ds, INT CONST seite, abstand, laenge): 
+   INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512;
+   REAL VAR time out := clock (1) + 10.0;
+   REP 
+      blockin (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); 
+   UNTIL hilfslaenge = 0 OR clock (1) > time out PER  ;
+   IF hilfslaenge <> 0
+   THEN report ("blockin abbruch, fehlende Zeichen: "+text(hilfslaenge));
+    FI;
+   hilfslaenge = 0
+END PROC blockin; 
+ 
+PROC blockout (DATASPACE CONST ds, INT CONST seite, abstand, laenge): 
+   INT VAR hilfslaenge:=laenge, code:= abstand+laenge+512; 
+   REP 
+      blockout (ds,seite,code-hilfslaenge, hilfslaenge, hilfslaenge); 
+   UNTIL hilfslaenge = 0 PER 
+END PROC blockout; 
+
+PROC set net mode (INT CONST new mode):
+   mode := new mode ;
+   own address := net address (station(myself));
+   SELECT mode OF
+      CASE 1,3   : set data length (64);
+      CASE 2     : std framelength; set data length (64)
+      CASE 4,6   : set data length (128)
+      CASE 5     : std framelength; set data length (128)
+      CASE 7,9   : set data length (256)
+      CASE 8     : std framelength; set data length (256)
+      CASE 10,12 : set data length (512)
+      CASE 11    : std framelength; set data length (512);
+
+      OTHERWISE
+   END SELECT.
+
+   std framelength:
+      rahmenlaenge := eak prefix laenge + packet length before stx.
+
+ENDPROC set net mode;
+
+INT PROC max mode:
+   maximum mode nr
+ENDPROC max mode;
+
+INT PROC net mode:
+   mode
+ENDPROC net mode;
+
+TEXT PROC mode text:
+   mode text (mode)
+ENDPROC mode text;
+
+TEXT PROC mode text (INT CONST act mode):
+   SELECT act mode OF
+      CASE 1:   "Modus: (1)  EUMEL-Netz           64 Byte"
+      CASE 2:   "Modus: (2)  ETHERNET via V.24    64 Byte"
+      CASE 3:   "Modus: (3)  ETHERNET integrated  64 Byte"
+      CASE 4:   "Modus: (4)  EUMEL-Netz           128 Byte"
+      CASE 5:   "Modus: (5)  ETHERNET via V.24    128 Byte"
+      CASE 6:   "Modus: (6)  ETHERNET integrated  128 Byte"
+      CASE 7:   "MODUS: (7)  EUMEL-Netz           256 Byte"
+      CASE 8:   "MODUS: (8)  ETHERNET via V.24    256 Byte"
+      CASE 9:   "MODUS: (9)  ETHERNET integrated  256 Byte"
+      CASE 10:  "MODUS: (10) EUMEL-Netz           512 Byte"
+      CASE 11:  "MODUS: (11) ETHERNET via V.24    512 Byte"
+      CASE 12:  "MODUS: (12) ETHERNET integrated  512 Byte"
+      OTHERWISE  errorstop ("Modus " + text(mode) + " gibt es nicht");
+                 error message
+   END SELECT
+
+ENDPROC mode text;
+
+PROC set data length (INT CONST new data length):
+    actual data length := new data length
+ENDPROC set data length;
+
+INT PROC data length:
+    actual data length
+ENDPROC data length;
+
+PROC reset box (INT CONST net mode):
+   SELECT net mode OF
+      CASE 1,4,7,10   :   eumel net box reset
+      CASE 2,5,8,11   :   eak reset
+      OTHERWISE    controler reset
+   END SELECT.
+
+   eumel net box reset:
+      out (90*""4""); 
+      REP UNTIL incharety (1) = niltext PER. 
+
+   eak reset:
+      out ("E0"13"E0"13"").
+
+   controler reset:
+      INT VAR dummy;
+      control (-35, 0,0,dummy);
+      control (22,0,0,dummy).
+
+ENDPROC reset box;
+
+PROC remove frame
+   (TEXT VAR erstes zeichen vom eumel telegramm, BOOL VAR kein telegramm da):
+   kein telegramm da := FALSE;
+   SELECT net mode OF
+      CASE 2,5,8,11  : remove ethernet frame
+                       (erstes zeichen vom eumel telegramm, kein telegramm da)
+   OTHERWISE
+   END SELECT;
+ENDPROC remove frame;
+
+PROC remove ethernet frame (TEXT VAR string, BOOL VAR schrott):
+   TEXT VAR  speicher, t;
+   INT VAR lg;
+
+   t := string;
+   speicher := niltext;
+   WHILE kein stx da REP
+      lies zeichen ein;
+      teste auf timeout;
+   UNTIL textoverflow PER;
+   melde eingelesene zeichen.
+
+   lies zeichen ein:
+      speicher CAT t;
+      t := incharety (1).
+
+   teste auf timeout:
+      IF t = niltext THEN schrott := (speicher <> niltext)
+                                         CAND not only fill characters;
+                          string := niltext;
+                          LEAVE remove ethernet frame
+      FI.
+
+   not only fill characters:
+      pos (speicher, ""1"", ""254"",1) <> 0.
+
+   kein stx da :
+      t <> stx.
+
+   textoverflow:
+      length (speicher) > 1000.
+
+   melde eingelesene zeichen:
+      IF kein stx da
+         THEN kein eumeltelegrammanfang
+         ELSE untersuche ethernet header
+      FI.
+
+   kein eumeltelegrammanfang:
+      report ("skipped ,fehlendes <STX> ,letztes Zeichen:", t);
+      string := t;
+      schrott := TRUE.
+
+   untersuche ethernet header:
+      string := t;
+      IF ethernet header inkorrekt
+         THEN melde fehler
+      FI.
+
+   ethernet header inkorrekt:
+      lg := length (speicher);
+      packet zu kurz COR adresse falsch.
+
+   packet zu kurz:
+      lg < packet length before stx.
+
+   adresse falsch:
+      INT VAR adrpos := pos (speicher, own address);
+      zieladresse falsch COR adresse nicht an der richtigen pos .
+
+   zieladresse falsch:
+      adrpos < 1.
+
+   adresse nicht an der richtigen pos:
+      adrpos <> lg - packet length before stx + 1.
+
+   melde fehler:
+      report ("Header inkorrekt eingelesen: ", speicher + t);
+      string := t;
+      schrott := TRUE.
+
+ENDPROC remove ethernet frame;
+
+TEXT PROC next packet start:
+
+  TEXT VAR t := niltext;
+  BOOL VAR schrott := FALSE;
+
+   t:= incharety (1);
+   IF t = niltext THEN LEAVE next packet start WITH niltext
+                  ELSE remove frame (t, schrott)
+   FI;
+   IF schrott THEN no stx or niltext
+              ELSE t
+   FI.
+
+   no stx or niltext:
+      IF t = stx THEN "2"
+        ELIF t = niltext THEN "0"
+          ELSE t
+      FI.
+
+ENDPROC next packet start;
+
+PROC flush buffers:
+  REP UNTIL incharety (5) = niltext PER;
+  report ("buffers flushed");
+ENDPROC flush buffers;
+
+PROC transmit header (DATASPACE CONST w):
+   BOUND INT VAR laengeninformation := w;
+   eumel paket laenge := laengeninformation ;
+   decode packet length (eumel paket laenge);
+   SELECT net mode OF
+      CASE 1,4,7,10     :
+      CASE 2,5,8,11     : eak und eth header senden (w)
+      OTHERWISE         : telegrammanfang melden;
+                          std ethernet header senden (w)
+   END SELECT;
+
+ENDPROC transmit header;
+
+PROC decode packet length (INT VAR decoded length):
+
+  decoded length DECR 2;
+  rotate (decoded length, 8);
+
+  IF decoded length < 96 THEN
+    ELIF decoded length < 128 THEN decoded length INCR 32
+      ELIF decoded length < 160 THEN decoded length INCR 128
+        ELIF decoded length < 192 THEN decoded length INCR 352
+          ELIF decoded length < 224 THEN decoded length INCR 832
+            ELIF decoded length < 256 THEN decoded length INCR 1824
+  FI;
+
+ENDPROC decode packet length;
+
+PROC transmit trailer:
+   INT VAR dummy;
+   SELECT net mode OF
+      CASE 3,6,9,12 : control (21,0,0,dummy)
+       OTHERWISE
+   END SELECT.
+
+ENDPROC transmit trailer;
+
+PROC std ethernet header senden (DATASPACE CONST x):
+   TEXT VAR  eth adresse, ethernet kopf := niltext;
+   INT VAR adresse;
+   BOUND STRUCT (INT head, zwischennummern) VAR header := x;
+   zieladresse holen;
+   zieladresse senden;
+   quelladresse senden;
+   typfeld senden;
+   ausgeben.
+   
+   zieladresse holen:
+      adresse := header.zwischennummern AND 255;
+      eth adresse := net address (adresse).
+
+   zieladresse senden:
+      ethernetkopf CAT eth adresse.
+
+   quelladresse senden:
+      ethernetkopf CAT own address.
+
+   typfeld senden:
+      ethernetkopf CAT typefield.
+
+   ausgeben:
+      out (ethernetkopf).
+
+ENDPROC std ethernet header senden;
+
+PROC telegrammanfang melden:
+   INT VAR dummy;
+      control (20,eumel paket laenge + packet length before stx,0, dummy).
+
+ENDPROC telegrammanfang melden;
+
+PROC eak und eth header senden (DATASPACE CONST x):
+   TEXT VAR res:= niltext;
+
+   neue laenge berechnen;
+   eak kopf senden;
+   std ethernet header senden (x).
+
+   neue laenge berechnen:
+      paket laenge := rahmenlaenge + eumel paket laenge.
+    
+   eak kopf senden:
+      res := code (paket laenge DIV 256);
+      res CAT (code (paket laenge AND 255));
+      res CAT eak prefix;
+      out(res).
+
+ENDPROC eak und eth header senden;
+
+TEXT PROC net address (INT CONST eumel address):
+   TEXT VAR res ;
+   INT VAR low byte;
+
+SELECT mode OF
+   CASE 1,4,7,10 : eumel net address
+   OTHERWISE ethernet address
+END SELECT.
+
+eumel net address:
+    text(eumel address).
+
+ethernet address:
+   IF second adress kind THEN second eth header
+                         ELSE first eth header
+   FI;
+   res.
+
+   second adress kind:
+      eumel address = 34 COR
+       eumel address > second address type bound.
+
+   second eth header:
+      low byte := eumel address AND 255;
+      res := second prefix adresse + code (low byte);
+      res CAT hex null.
+
+   first eth header:
+      res := prefix adresse + text (eumel address, 3);
+      changeall (res, blank, null).
+
+ENDPROC net address;
+
+ENDPACKET net hardware;
+
+
+
+
diff --git a/system/net/1.8.7/src/net inserter b/system/net/1.8.7/src/net inserter
new file mode 100644
index 0000000..c89d0f0
--- /dev/null
+++ b/system/net/1.8.7/src/net inserter
@@ -0,0 +1,145 @@
+(*************************************************************************)
+(*** Insertiert alle notwendigen Pakete, die zum Betrieb des Netzes    ***)
+(*** notwendig sind.                                                   ***)
+(*** Berücksichtigt nur EUMEL - Versionen ab  1.8.1, sowie             ***)
+(*** Multi-User-Version                                                ***)
+(***                                                                   ***)
+(***                                                                   ***)
+(*** 23.05.87  ar                                                      ***)
+(*************************************************************************)
+
+LET netfile = "netz",
+    multi files = "net files/M";
+
+
+INT CONST version :: id (0);
+THESAURUS VAR tesa;
+
+head;
+IF no privileged task
+     THEN errorstop (name (myself) + " ist nicht privilegiert!")
+  ELIF station number wrong
+       THEN errorstop ("'define station' vergessen ")
+FI;
+
+IF version < 181 THEN versionsnummer zu klein
+                 ELSE install net
+FI.
+
+no privileged task:
+   NOT (myself < supervisor).
+
+station number wrong:
+   station (myself) < 1.
+
+install net :
+   IF NOT exists (netfile)
+        THEN errorstop ("Datei " + netfile +" existiert nicht")
+   FI;
+   IF is multi THEN insert multi net
+               ELSE errorstop ("Diese Netzversion ist nur für Multi-user Versionen freigegeben")
+   FI;
+   forget ("net install", quiet);
+   net start.
+
+net start :
+    say line (" ");
+    do ("start");
+    do ("global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST)
+                         net manager)").
+
+is multi :
+   (pcb(9) AND 255) > 1.
+
+insert multi net :
+   hole dateien vom archiv;
+   insert say and forget (tesa).
+
+hole dateien vom archiv :
+   fetch if necessary (multi files);
+   tesa := ALL (multi files);
+   forget (multi files, quiet);
+   fetch if necessary (tesa - all);
+   say line (" ");
+   say line ("Archiv-Floppy kann entnommen werden.");
+   release (archive).
+   
+   
+head :
+   IF online THEN page;
+                  put center (" E U M E L  -  Netz  wird  installiert.");
+                  line;
+                  put center ("----------------------------------------");
+                  line (2)
+   FI.
+
+versionsnummer zu klein : 
+   errorstop ("Netzsoftware erst ab Version 1.8.1 insertierbar !").
+ 
+PROC fetch if necessary (TEXT CONST datei) :
+   IF NOT exists (datei) THEN say line ("Loading """ + datei + """...");
+                              fetch (datei, archive)
+   FI.
+END PROC fetch if necessary;
+
+PROC fetch if necessary (THESAURUS CONST tes) :
+   do (PROC (TEXT CONST) fetch if necessary, tes)
+END PROC fetch if necessary;
+
+PROC insert say and forget (TEXT CONST name of packet): 
+   IF online THEN INT VAR cx, cy;
+                  put ("Inserting """ + name of packet + """..."); 
+                  get cursor (cx, cy)
+   FI;
+   insert (name of packet); 
+   IF online THEN cl eop (cx, cy); line FI;
+   forget (name of packet, quiet)
+END PROC insert say and forget;
+
+PROC insert say and forget (THESAURUS CONST tes): 
+   do (PROC (TEXT CONST) insert say and forget, tes)
+END PROC insert say and forget;
+
+PROC put center (TEXT CONST t):
+   put center (t, xsize);
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t):
+   put center (zeile, t, xsize);
+END PROC put center;
+
+PROC put center (TEXT CONST t, INT CONST gesamtbreite):
+   INT VAR cy;
+   get cursor (cy, cy);
+   put center (cy, t, gesamtbreite)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):
+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);
+   put (t).
+END PROC put center;
+
+PROC cl eol: 
+  out (""5"") 
+END PROC cl eol;
+
+PROC cl eop: 
+  out (""4"") 
+END PROC cl eop; 
+ 
+PROC cl eol (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eol 
+END PROC cl eol; 
+ 
+PROC cl eop (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eop 
+END PROC cl eop; 
+
+PROC say line (TEXT CONST t):
+    IF online THEN put line (t) FI
+ENDPROC say line;
+
+
+
diff --git a/system/net/1.8.7/src/net manager b/system/net/1.8.7/src/net manager
new file mode 100644
index 0000000..05f530e
--- /dev/null
+++ b/system/net/1.8.7/src/net manager
@@ -0,0 +1,797 @@
+PACKET net manager DEFINES stop,net manager,frei, routen aufbauen, 
+ (*   175 net manager   8 (!)   *)
+                           start,
+                           definiere netz,
+                           aktiviere netz,
+                           list option,
+                           erlaube, sperre, starte kanal, routen: 
+ 
+TEXT VAR stand := "Netzsoftware vom  10.06.87  "; 
+                 (*Heinrichs     *)           
+LET
+    maxstat = 127,
+    ack = 0,
+(*  nak = 1, *)
+    error nak = 2,
+(*  zeichen eingang = 4, *)
+    list code = 15,
+(*  fetch code = 11, *)
+    freigabecode = 29,
+    tabellencode = 500,
+    continue code = 100,
+    erase code = 14,
+    report code = 99, 
+    abgleichcode = 98,
+    neue routen code = 97,
+    dr verwaltungslaenge = 8,
+
+    (* Codes der Verbindungsebene *) 
+ 
+    task id code = 6, 
+    name code = 7, 
+    task info code = 8, 
+    routen liefern code = 9, 
+ 
+    (* Weitergabecodes für Netzknoten *)
+
+    route code = 1001,
+    out code = 1003,
+
+    (* Typen von Kommunikationsströmen *)
+
+    zustellung = 1,
+    call im wait = 3,
+    call im abbruch = 4, 
+    call in zustellung = 5;
+
+LET STEUER =
+      STRUCT ( 
+      INT  head, 
+           zwischenziel,
+           zielrechner, 
+           quellrechner,
+           strom,
+      INT  sequenz,
+           seiten nummer,
+      TASK quelle,ziel,
+      INT  sende code); 
+ 
+LET INFO = STRUCT (STEUER steuer, INT typ,maxseq); 
+ 
+LET PARA = STRUCT (TASK quelle, ziel, INT sendecode, zielstation); 
+ 
+ 
+TASK VAR sohn;
+INT VAR strom,c,kanalmode, rzaehler := 20;
+BOUND STRUCT (ROW maxstat INT port, 
+              ROW maxstat INT zwischen)  VAR route;
+ 
+  
+TASK PROC netport (INT CONST ziel): 
+   INT VAR kan := route.port (ziel) AND 255; 
+   IF kan < 1 OR kan > 15
+   THEN 
+     niltask 
+   ELSE 
+     IF NOT exists (nettask (kan)) 
+     THEN 
+       access catalogue;
+       nettask (kan) := task (kan); 
+       IF NOT (nettask (kan) < father) THEN nettask (kan) := niltask FI; 
+     FI; 
+     nettask (kan) 
+   FI
+END PROC netport; 
+ 
+PROC frei (INT CONST stat,lvl): 
+  DATASPACE VAR ds := nilspace;
+  BOUND STRUCT (INT x,y) VAR msg := ds;
+  msg.x := stat; msg.y := lvl;
+  INT VAR return;
+  call (netport (stat), freigabecode, ds, return) ;
+  forget (ds)
+END PROC frei; 
+ 
+PROC net manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST
+                  ordertask):
+ 
+    IF order = report code AND ordertask < myself
+    THEN 
+      IF storage (old("report")) > 20 THEN forget ("report", quiet) FI;
+      FILE VAR rp := sequential file (output, "report");
+      BOUND TEXT VAR rpt := ds;
+      putline (rp, rpt);
+      send (ordertask, ack, ds)
+    ELIF order = abgleichcode AND ordertask < myself
+    THEN  
+      BOUND STRUCT (INT ende, zwischen) VAR x := ds; 
+      route.port (x.ende) := channel (ordertask);
+      route.zwischen (x.ende) := x.zwischen;
+      send (ordertask, ack, ds)
+    ELIF order = neue routen code AND ordertask < myself
+    THEN
+      forget ("port intern");
+      copy (ds,"port intern");
+      route := old ("port intern");
+      send (ordertask, ack, ds)
+    ELIF station (ordertask) = station (myself)
+    THEN
+      IF ordertask < myself
+      OR order = list code
+      OR order > continue code
+      THEN
+        IF order = list code 
+        THEN
+          enable stop;
+          forget (ds); ds := old ("report");
+          FILE VAR ff := sequential file (output,ds);
+          putline (ff,"bekannte Stationen:");
+          stationen; line (ff); putline (ff,"--------");
+          putline (ff,"Eingestellte Netzmodi:"); 
+          kanaele ; 
+          paketgroessen; 
+          line (ff); putline (ff,"********"); 
+          putline (ff,stand);
+          putline (ff,"Rechner "+text(station(myself))+"  um "+time of day);
+          send (ordertask, ack, ds)
+        ELSE
+        free manager (ds,order,phase,order task) 
+        FI
+      ELSE
+      errorstop ("nur 'list' ist erlaubt")
+      FI
+    FI .
+  
+stationen: 
+INT VAR stat; 
+INT VAR mystation := station (myself);
+FOR stat FROM 1 UPTO maxstat REP 
+  IF route.port (stat) > 0 AND stat <> mystation 
+  THEN 
+    put (ff,text(stat)+"("+text (route.port (stat) AND 255)+","+
+    text(route.zwischen(stat))+")") 
+  FI 
+PER. 
+ 
+paketgroessen: 
+ 
+  line(ff); 
+  put (ff, "Nutzlaenge bei indirekter Verbindung "+ 
+           text (data length via node) + " Byte "); line (ff). 
+ 
+kanaele: 
+   INT VAR portnummer; 
+   TASK VAR tsk; 
+   FOR portnummer FROM 1 UPTO 15 REP 
+      tsk := task (portnummer);
+      IF tsk < myself THEN beschreibe kanal FI; 
+   PER. 
+ 
+beschreibe kanal: 
+   putline (ff, name (tsk) + " haengt an Kanal " + text (channel (tsk))
+                + ", " + mode text (netz mode (portnummer))).
+ 
+END PROC net manager; 
+
+TASK VAR cd,stask;
+ROW maxstat INT VAR erlaubt; 
+
+PROC communicate: 
+  enable stop;
+  INT VAR scode, merken :=0;
+  DATASPACE VAR dr := nilspace;
+  neuer start (quit max, kanalmode); 
+REP 
+  forget (dr); 
+  telegrammfreigabe; 
+  wait (dr, scode, stask); 
+  cd := collected destination;
+  IF weiterleitung steht noch aus
+  THEN 
+    send (netport (merken), out code, mds, reply); 
+    IF reply <> -2 THEN forget (mds); merken := 0 FI 
+  FI;
+  IF zeichen da OR zeit abgelaufen 
+  THEN 
+    packet
+  ELIF cd = myself 
+  THEN 
+    netz info und steuerung 
+  ELSE
+    sendung untersuchen (stask, cd, scode, dr)
+  FI 
+PER. 
+ 
+telegrammfreigabe: 
+   INT VAR dummy; 
+   control (22,0,0,dummy). 
+ 
+zeichen da: scode < 0 . 
+ 
+zeit abgelaufen: scode = ack AND cd = myself. 
+
+packet: 
+    INT VAR snr, ant,err;
+    TASK VAR quelle, ziel;
+    snr := 0;
+    IF NOT zeichen da THEN routen erneuern FI;
+    REP 
+      IF NOT zeichen da
+      THEN 
+        forget (dr);
+        zeitueberwachung (snr, quelle, ziel, ant, dr); 
+      ELIF NOT weiterleitung steht noch aus
+      THEN
+        packet eingang (snr, quelle, ziel, ant, dr); 
+      FI;
+      IF snr = 1000
+      THEN
+        packet weiterleiten
+      ELIF snr > 0
+      THEN 
+        IF ant > 6 AND erlaubt(station (quelle)) < 0 
+        THEN unerlaubt
+        ELSE
+          send (quelle,ziel,ant,dr,err); 
+          fehlerbehandlung ;
+        FI
+      FI 
+    UNTIL snr = 0 OR zeichen da PER.
+ 
+routen erneuern: 
+  rzaehler DECR 1; 
+  IF rzaehler = 0 
+  THEN 
+    rzaehler := 20; 
+    neue routen holen
+  FI. 
+
+weiterleitung steht noch aus: merken <> 0. 
+ 
+packet weiterleiten: 
+  INT VAR reply;
+  IF NOT ((route.port (ant) AND 255) = channel OR route.port (ant) < 0)
+  THEN 
+    send (netport (ant), out code, dr, reply);
+    IF reply = -2 
+    THEN
+      merken := ant; 
+      DATASPACE VAR mds := dr 
+    FI
+  ELSE
+    report ("Weiterleitung nicht möglich für "+text(ant)) 
+  FI.
+
+fehlerbehandlung: 
+  IF ok oder ziel nicht da THEN loesche verbindung (snr) FI. 
+ 
+ok oder ziel nicht da: err=0 OR err=-1. 
+
+netz info und steuerung: 
+    IF scode = list code THEN   list status 
+  ELIF scode = erase code THEN strom beenden
+  ELIF scode = freigabe code AND stask = father THEN freigabelevel 
+  ELIF scode >= route code THEN weitergaben
+  ELIF scode > tabellencode THEN routen ausliefern
+  ELSE forget (dr); ablehnen ("nicht möglich") 
+  FI. 
+  
+weitergaben: 
+  IF stask < father
+  THEN 
+    IF scode = out code 
+    THEN 
+      BOUND INT VAR stx lng := dr; 
+      INT VAR decoded lng := stx lng; 
+      decode packet length (decoded lng); 
+      transmit header (dr); 
+      blockout (dr,1,drverwaltungslaenge,decoded lng); 
+      transmit trailer  
+    ELIF scode = route code 
+    THEN 
+      BOUND PARA VAR parah := dr; 
+      PARA VAR para := parah; 
+      pingpong (stask, ack, dr, reply); 
+      neue sendung (para.quelle, para.ziel, para.sendecode, 
+                    para.zielstation, dr); 
+      forget (dr); dr := nilspace; 
+      send (stask, ack, dr) 
+    FI
+  ELSE 
+    forget (dr); 
+    ablehnen ("nicht Sohn von "+name(father)) 
+  FI. 
+  
+routen ausliefern: 
+  neue sendung (stask, myself, -routen liefern code, scode-tabellencode,dr). 
+  
+freigabelevel: 
+  BOUND STRUCT (INT stat,lvl) VAR lv := dr; 
+  IF lv.stat > 0 AND lv.stat <= maxstat THEN erlaubt (lv.stat) := lv.lvl FI; 
+  send (stask,ack,dr). 
+ 
+unerlaubt: 
+  report ("Fremdzugriff von "+text(station (quelle))+" auf "+nam(ziel)
+          +" code "+text(ant)); 
+  loesche verbindung (snr);
+  forget (dr); dr := nilspace;
+  BOUND TEXT VAR errtxt := dr; 
+  errtxt:="Kein Zugriff auf Station "+text (station (myself)); 
+  neue sendung (ziel, quelle, error nak, station (quelle), dr). 
+ 
+strom beenden:
+  BOUND TEXT VAR stromtext := dr;
+  INT VAR erase strom := int (stromtext);
+  forget (dr);
+  strom := erase strom;
+  IF falsche stromnummer THEN ablehnen ("Strom gibt es nicht")
+  ELSE 
+    BOUND INFO VAR v := verbindung (strom); 
+  IF
+    stask < supervisor OR stask = vx.quelle OR stask = vx.ziel
+  THEN
+    loeschen
+  ELSE ablehnen ("Nur Empfänger/Absender darf löschen")
+  FI
+  FI. 
+ 
+loeschen:
+  IF sendeeintrag  THEN
+    IF callee (vx.quelle) = vx.ziel THEN absender warnen FI;
+    loesche verbindung (strom)
+  ELSE
+    IF callee (vx.ziel) = vx.quelle THEN warnen FI; 
+    loesche verbindung (strom)
+  FI; 
+  dr := nilspace;
+  send (stask,ack,dr).
+
+absender warnen:
+ dr := nilspace;
+ send(vx.ziel,vx.quelle,1,dr,err) .
+ 
+warnen:
+ dr := nilspace;
+errtxt := dr; errtxt:= "Station antwortet nicht"; 
+send (vx.quelle,vx.ziel,error nak, dr, err). 
+ 
+falsche stromnummer: strom < 1 OR strom > max verbindungsnummer.
+sendeeintrag: vx.quellrechner = station (myself).
+vx: v.steuer.
+END PROC communicate; 
+ 
+PROC list option: 
+  begin ("net list",PROC list net, sohn) 
+END PROC list option; 
+ 
+PROC list net: 
+  disable stop;
+  DATASPACE VAR ds ;
+  INT VAR scode;
+  REP
+    wait (ds, scode, stask); 
+    forget (ds); ds := nilspace;
+    FILE VAR f := sequential file (output, ds); 
+    list (f, father);
+    list netports; 
+    IF is error THEN clear error; 
+                     forget(ds); 
+                     ds := nilspace; 
+                     f := sequential file (output, ds); 
+                     output (f); putline (f,errormessage); 
+                     clear error 
+    FI; 
+    send (stask, ack, ds) 
+  PER. 
+ 
+list netports: 
+  INT VAR k; 
+  FOR k FROM 1 UPTO 15 REP
+    TASK VAR tsk := task (k); 
+    IF tsk < father  
+    THEN 
+      putline (f, name (tsk)); 
+      list (f,tsk) 
+    FI 
+  PER. 
+ 
+END PROC list net; 
+ 
+PROC neue routen holen: 
+    forget ("port intern", quiet); 
+    fetch ("port intern"); 
+    route := old ("port intern"); 
+    neue routen
+END PROC neue routen holen; 
+ 
+PROC sendung untersuchen (TASK CONST q, z, INT CONST cod, DATASPACE VAR dr): 
+  IF z = collector 
+  THEN 
+    verbindungsebene 
+  ELIF station (z) <> 0
+  THEN
+    sendung (q,z,cod,station (z),dr)
+  ELSE
+    ablehnen ("Station 0")
+  FI.
+
+verbindungsebene: 
+  IF cod = 256 THEN name von fremdstation
+  ELIF cod > 256
+  THEN
+    taskinfo fremd 
+  ELIF callee (q) = z  (* gegen errornak an collector *)
+  THEN
+    task id von fremd
+  FI.
+
+taskinfo fremd: sendung  (q, collector,  -task info code,cod-256,dr).
+
+task id von fremd: sendung  (q, collector, -task id code, zielstation, dr) .
+
+name von fremdstation:
+  BOUND TASK VAR tsk := dr;
+  TASK VAR tsk1 := tsk;
+  forget (dr); 
+  dr := nilspace; 
+  sendung  (q, tsk1, -name code, station (tsk1), dr).
+
+zielstation: cod.
+END PROC sendung untersuchen;
+
+PROC sendung (TASK CONST q, z, INT CONST code, z stat, DATASPACE VAR dr):
+  IF z stat < 1 OR z stat > maxstat
+  THEN
+    ablehnen ("ungültige Stationsnummer");
+    LEAVE sendung
+  FI;
+  INT VAR reply;
+  INT VAR rp := route.port (z stat) AND 255;
+  IF rp = 255 THEN neue routen holen ;rp := route.port (z stat) AND 255 FI;
+  IF rp = channel
+  THEN
+     sendung selbst betreiben
+  ELIF rp > 0 AND rp < 16
+  THEN
+     sendung weitergeben
+  ELSE
+     ablehnen ("Station "+text(z stat)+" gibt es nicht")
+  FI.
+
+sendung selbst betreiben:
+  neue sendung (q, z, code, z stat, dr). 
+
+sendung weitergeben:
+  DATASPACE VAR ds := nilspace;
+  BOUND PARA VAR p := ds;
+  p.quelle := q;
+  p.ziel := z;
+  p.zielstation := z stat;
+  p.sendecode := code;
+  call (netport (z stat), route code, ds, reply);
+  forget (ds);
+  pingpong (netport (z stat), 0, dr, reply);
+  forget (dr);
+  IF reply < 0 THEN ablehnen ("netport "+text(route.port(zstat)AND255)
+                    + " fehlt") FI
+END PROC sendung; 
+
+PROC ablehnen (TEXT CONST t):
+  DATASPACE VAR vdr := nilspace;
+  BOUND TEXT VAR errtxt := vdr; 
+  INT VAR err;
+  errtxt := t;
+  send (cd,stask, error nak, vdr,err);
+  forget (vdr).
+END PROC ablehnen;
+
+PROC stop: 
+  access catalogue;
+  IF exists task ("net timer") 
+  THEN 
+    TASK VAR nets := father (/"net timer"); 
+  ELSE
+    nets := myself
+  FI; 
+  nets := son (nets);
+  WHILE NOT (nets = niltask) REP 
+    IF text (name (nets),3) = "net" OR name (nets) = "router" 
+    THEN
+      end (nets) 
+    FI; 
+    nets := brother (nets)
+  PER 
+END PROC stop; 
+ 
+PROC list status: 
+ 
+  DATASPACE VAR ds := nilspace; 
+  FILE VAR f:=sequential file (output, ds);
+  line(f); 
+  FOR strom FROM 1 UPTO max verbindungsnummer REP 
+    IF strom > 0 THEN 
+    BOUND INFO VAR v := verbindung (strom);
+    IF vx.strom <> 0 THEN info FI 
+    FI; 
+  PER; 
+  send (stask, ack, ds). 
+ 
+info: 
+  put (f,"Strom "+text(strom));
+  put (f,"(sqnr"+text(vx.sequenz)+"/"+text (v.maxseq)+")"); 
+  IF sendeeintrag THEN sendeinfo ELSE empfangsinfo FI; 
+  line (f). 
+ 
+sendeeintrag: vx.quellrechner = station(myself) . 
+ 
+sendeinfo: 
+  IF v.typ = call im wait THEN put (f,"erwartet Antwort von")
+  ELIF v.typ = call in zustellung THEN put (f,"Ziel busy. Zielstation:") 
+  ELIF v.typ = call im abbruch THEN put (f,"wird gelöscht bei Antwort von") 
+  ELSE put (f,"sendet an") 
+  FI; 
+  put (f,vx.zielrechner); 
+  put (f,". Absender ist """+nam (vx.quelle)+"""."). 
+ 
+empfangsinfo: 
+  IF v.typ = zustellung THEN 
+  put (f,"Sendung noch nicht zustellbar")
+  ELSE
+  put (f,"empfängt von");
+  put (f,vx.quellrechner); 
+  FI;
+  put (f,". Empfaenger ist """+nam (vx.ziel)+""".").
+
+vx: v.steuer.
+END PROC list status; 
+ 
+INT VAR quitmax := 3;
+
+ROW 15 TASK VAR net task;  
+ROW 15 INT VAR netz mode; 
+
+PROC erlaube (INT CONST von, bis):
+  IF ein kanal gestartet
+  THEN
+    putline ("Warnung: 'erlaube' muß vor 'starte kanal'")
+  FI;
+  test (von); test (bis);
+  INT VAR i;
+  FOR i FROM von UPTO bis REP erlaubt (i) := 0 PER 
+END PROC erlaube;
+
+PROC sperre  (INT CONST von, bis):
+  IF ein kanal gestartet
+  THEN
+    putline ("Warnung: 'sperre' muß vor 'starte kanal'")
+  FI;
+  test (von); test (bis);
+  INT VAR i;
+  FOR i FROM von UPTO bis REP erlaubt (i) :=-1 PER 
+END PROC sperre ;
+
+BOOL VAR  alte routen, ein kanal gestartet; 
+ 
+PROC definiere netz: 
+  stop;
+  INT VAR i;
+  FOR i FROM 1 UPTO 15 REP net task (i) := niltask PER; 
+  ein kanal gestartet := FALSE;
+  FILE VAR s := sequential file (output,"report"); 
+  putline (s," N e u e r   S t a r t " + date + " " + time of day ); 
+  alte routen := exists ("port intern");
+  IF alte routen
+  THEN
+    route := old ("port intern")
+  ELSE
+    route := new ("port intern"); 
+    initialize routes
+  FI. 
+ 
+  initialize routes: 
+     FOR i FROM 1 UPTO maxstat REP 
+        route.zwischen(i) := i 
+     PER. 
+ 
+END PROC definiere netz; 
+ 
+PROC starte kanal (INT CONST k,modus,stroeme): 
+  ein kanal gestartet := TRUE;
+  IF exists (canal (k)) THEN end (canal (k)) FI;
+  IF stroeme <= 0 THEN errorstop ("3.Parameter negativ") FI; 
+  quitmax := stroeme;
+  c := k; 
+  IF c < 1 OR c > 15 THEN errorstop ("unzulässiger Kanal:"+text(c)) FI; 
+  kanalmode := modus; 
+  IF kanalmode < 1 OR kanalmode > max mode 
+        THEN errorstop ("unzulässiger Netzbetriebsmodus:"+text(kanalmode)) 
+        ELSE netz mode (c) := kanalmode 
+  FI; 
+  IF NOT exists task ("net port") 
+  THEN
+    begin ("net port",PROC net io, net task (c));
+    define collector (/"net port")
+  ELSE 
+    begin ("net port "+text (c),PROC net io, net task (c))
+  FI. 
+END PROC starte kanal;
+
+PROC routen (INT CONST von, bis, kanal, zw): 
+  INT VAR i;
+  IF kanal < 0 OR kanal > 15 THEN errorstop ("Kanal unzulässig") FI;
+  test (von); test (bis); 
+  FOR i FROM von UPTO bis REP 
+      route.port (i) := kanal+256; 
+      IF zw=0
+      THEN 
+        route.zwischen (i) := i  
+      ELSE 
+        test (zw);
+        route.zwischen (i) := zw
+      FI 
+  PER. 
+END PROC routen; 
+ 
+PROC routen (INT CONST von, bis, kanal): 
+  routen (von, bis, kanal, 0) 
+END PROC routen;
+
+PROC test (INT CONST station): 
+  IF station < 1 OR station > maxstat 
+  THEN 
+    errorstop (text (station) + " als Stationsnummer unzulässig") 
+  FI 
+END PROC test; 
+ 
+PROC aktiviere netz: 
+vorgegebene routen pruefen; 
+IF existstask ("net timer") THEN end (/"net timer") FI;
+begin ("net timer",PROC timer,sohn);
+IF NOT alte routen 
+THEN 
+  routen aufbauen
+ELSE
+  IF online THEN break FI
+FI. 
+
+vorgegebene routen pruefen: 
+  INT VAR i; 
+  FOR i FROM 1 UPTO maxstat REP 
+    INT VAR s := route.port (i) AND 255; 
+    IF s > 0 AND s <= 15 CAND nettask (s) = niltask 
+    THEN 
+      errorstop ("Kanal "+text(s)+" nicht gestartet, steht aber in Routen") 
+    FI 
+  PER.
+END PROC aktiviere netz; 
+ 
+ 
+PROC routen aufbauen: 
+  alte routen := TRUE;
+  c := channel;
+  break (quiet);
+  begin ("router", PROC rout0, sohn). 
+END PROC routen aufbauen; 
+ 
+PROC rout0: 
+  disable stop; 
+  rout; 
+  IF is error 
+  THEN 
+    put error 
+  FI; 
+  end (myself) 
+END PROC rout0; 
+ 
+PROC rout:
+  IF c>0 THEN continue (c) FI;
+  clear error;   enable stop;
+  fetch ("port intern");
+  route := old ("port intern"); 
+  routen aufbauen;
+  ds := old ("port intern");
+  call (father, neue routen code, ds, reply). 
+ 
+routen aufbauen:
+  access catalogue; 
+  TASK VAR port := brother (myself); 
+  WHILE NOT (port = niltask) REP 
+    IF text (name (port),8) = "net port" THEN nachbarn FI; 
+    port := brother (port) 
+  PER; 
+  IF online THEN putline ("Fertig. Weiter mit SV !") FI. 
+
+aenderbar: route.port (st) < 256.
+
+nachbarn:  
+  INT VAR st,reply; 
+  FOR st FROM 1 UPTO maxstat REP 
+    IF erlaubt (st) >= 0 AND st <> station (myself) AND aenderbar
+    THEN 
+      IF online THEN put (name (port)); put (st) FI;
+      DATASPACE VAR ds := nilspace; 
+        call (port, tabellencode+st, ds, reply);
+        IF reply = ack 
+        THEN 
+          BOUND STRUCT (ROW maxstat INT port, 
+                        ROW maxstat INT zwischen)  VAR fremd := ds; 
+          route.port (st) := channel(port); 
+          route.zwischen (st) := st; 
+          indirekte ziele 
+        ELIF reply < 0
+        THEN
+          errorstop ("netz läuft nicht (Kanalnummer falsch)")
+        ELSE 
+          BOUND TEXT VAR xt := ds;
+          IF online THEN put (xt) FI;
+        FI;
+      IF online THEN line FI;
+      forget (ds) 
+    FI
+  PER. 
+ 
+indirekte ziele:   
+  INT VAR kanal := fremd.port (station (myself)) AND 255;
+  INT VAR ind; 
+  FOR ind FROM 1 UPTO maxstat REP 
+    IF ind bei st bekannt AND NOT ((fremd.port (ind) AND 255) = kanal)
+      AND route.port (ind) < 256
+    THEN 
+      route.port (ind) := channel (port); 
+      route.zwischen (ind) := st 
+    FI 
+  PER.
+ 
+ind bei st bekannt: NOT (fremd.port (ind) = -1).
+ 
+END PROC rout;
+
+
+PROC timer: 
+  disable stop;
+  access catalogue;
+  INT VAR old session := 1;
+  REP 
+    IF session <> old session
+    THEN
+      define collector (/"net port");
+      old session := session
+    FI;
+    clear error;
+    pause (30); 
+    sende tick an alle ports 
+  PER.
+ 
+sende tick an alle ports :
+  TASK VAR fb := son (father); 
+  REP 
+   IF NOT exists (fb) THEN access catalogue;LEAVE sende tick an alle portsFI;
+   IF channel (fb) > 0
+   THEN 
+     DATASPACE VAR ds := nilspace;
+     send (fb, ack, ds); 
+     pause (10)
+   FI;
+   fb := brother (fb) 
+  UNTIL fb = niltask PER. 
+ 
+END PROC timer; 
+
+PROC net io:
+  disable stop; 
+  set net mode (kanalmode); 
+  fetch ("port intern"); 
+  route := old ("port intern");
+  commanddialogue (FALSE); 
+  continue (c);
+  communicate;
+  TEXT VAR emsg := "++++++ "+error message +" Zeile "+text(errorline);
+  clear error; 
+  report (emsg);
+  end (myself) 
+END PROC net io; 
+ 
+PROC start: run ("netz") END PROC start; 
+ 
+END PACKET net manager;
+
diff --git a/system/net/1.8.7/src/net report b/system/net/1.8.7/src/net report
new file mode 100644
index 0000000..ddc19d2
--- /dev/null
+++ b/system/net/1.8.7/src/net report
@@ -0,0 +1,41 @@
+PACKET net report DEFINES report, abgleich: 
+(* Version   3 (!) *)
+ 
+LET reportcode = 99, abgleichcode = 98; 
+
+PROC abgleich (INT CONST ende, zwischen): 
+  DATASPACE VAR ds := nilspace; 
+  BOUND STRUCT (INT ende, zwischen) VAR x := ds; 
+  x.ende := ende; 
+  x.zwischen := zwischen; 
+  call (father, abgleichcode, ds, rep);
+  INT VAR rep;
+  forget (ds) 
+END PROC abgleich;
+
+PROC report (TEXT CONST x):
+  report(x,"") 
+END PROC report;
+ 
+PROC report (TEXT CONST txt, info): 
+  DATASPACE VAR net report := nilspace;
+  BOUND TEXT VAR rinfo := net report;
+  rinfo := date;
+  rinfo CAT " "+time of day +" "; 
+  rinfo CAT name(myself)+":";
+  rinfo CAT txt;
+  INT VAR i; 
+  FOR i FROM 1 UPTO length (info) REP 
+    INT VAR z :=  code (infoSUBi)  ;
+    IF z < 32 OR z > 126 
+      THEN rinfo CAT "%"+text(z)+" " 
+      ELSE rinfo CAT (infoSUBi)+" "
+    FI
+  PER; 
+  call (father, report code , net report, reply);
+  INT VAR reply;
+  forget (net report);
+END PROC report; 
+ 
+END PACKET net report;
+
diff --git a/system/net/1.8.7/src/netz b/system/net/1.8.7/src/netz
new file mode 100644
index 0000000..c237ba2
--- /dev/null
+++ b/system/net/1.8.7/src/netz
@@ -0,0 +1,20 @@
+IF exists ("port intern") THEN forget ("port intern") FI; 
+definiere netz; 
+list option; 
+erlaube(1,127); 
+sperre (1,9); 
+sperre (15,32); 
+sperre (37,37); 
+sperre (42,42); 
+sperre (46,47); 
+sperre (49,127); 
+routen (1, 32,8); 
+routen (33,43,  9); 
+routen (34,34,8); 
+routen (35,48,9); 
+starte kanal (9,11,10); 
+starte kanal (8,1,10); 
+aktiviere netz;
+
+
+
diff --git a/system/net/unknown/doc/EUMEL Netz b/system/net/unknown/doc/EUMEL Netz
new file mode 100644
index 0000000..941e2ea
--- /dev/null
+++ b/system/net/unknown/doc/EUMEL Netz
@@ -0,0 +1,829 @@
+#type ("trium8")##limit (11.0)# 
+#start(2.5,1.5)##pagelength (17.4)# 
+#block# 
+#headeven# 
+ 
+%                        EUMEL-Netzbeschreibung 
+ 
+ 
+#end# 
+#headodd# 
+ 
+#center#Inhalt#right#% 
+ 
+ 
+#end# 
+ 
+#type ("triumb12")# 
+1. Einleitung 
+ 
+ 
+Teil 1: Netz einrichten und benutzen 
+#type ("trium8")# 
+ 
+1. Benutzung des Netzes 
+ 
+2. Hardwarevoraussetzungen 
+ 
+3. Einrichten des Netzes 
+ 
+4. Informationsmöglichkeiten 
+ 
+5. Eingriffsmöglichkeiten 
+ 
+6. Fehlerbehebung im Netz 
+ 
+#type ("triumb12")# 
+ 
+Teil 2: Arbeitsweise der Netzsoftware 
+#type ("trium8")# 
+ 
+1. Die Netztask 
+ 
+2. Protokollebenen 
+ 
+3. Stand der Netzsoftware 
+ 
+#page# 
+#headodd# 
+ 
+#center#Einleitung#right#% 
+ 
+ 
+#end# 
+ 
+#type("triumb12")# 
+1. Einleitung #type("trium8")# 
+ 
+ 
+Das EUMEL-Netz dient dazu mehrere EUMEL-Rechner (sog. Stationen) mit­
+einander zu koppeln. Diese Kopplung wird von Betriebsystem dazu benutzt, das
+Sendungskonzept (siehe Systemhandbuch 1.7, Intertaskkommunikation) so auszu­
+dehnen, daß Tasks verschiedener Stationen einander Datenräume zusenden
+können. Auf dem Sendungskonzept aufbauende Konzepte nutzen daher automa­
+tisch das Netz aus: So ist es z.B. möglich 
+ 
+- von einer Station aus auf einer anderen zu Drucken, 
+ 
+- in PUBLIC einer anderen Station Dateien zu sichern (save), vorausgesetzt, daß
+  PUBLIC dort ein free global manager ist, 
+ 
+- auf einer anderen Station zu archivieren (z.B. wenn das eigene Archivlaufwerk
+  defekt ist oder ein anderes Format hat). 
+ 
+Das Netz kann ab EUMEL-Version 1.7.3 eingesetzt werden. 
+ 
+ 
+#type("triumb12")# 
+Teil 1: Netz einrichten und benutzen 
+ 
+1. Benutzung des Netzes #type("trium8")# 
+#headodd# 
+ 
+#center#Teil 1: Netz einrichten und benutzen#right#% 
+ 
+ 
+#end# 
+ 
+   Zur Benutzung des Netzes stehen folgende Operatoren und Prozeduren zur
+   Verfügung: 
+ 
+ 
+1.1 
+ 
+   TASK OP / (INT CONST station, TEXT CONST taskname) 
+ 
+   liefert die Task #on("bold")#taskname#off("bold")# von der Station #on("bold")#station#off("bold")#. 
+ 
+   Wenn die Station #on("bold")#station#off("bold")# nicht am Netz ist oder nicht eingeschaltet ist, wird
+   solange gewartet, bis das der Fall ist. 
+ 
+   Fehlerfälle: 
+ 
+     - task "..." gibt es nicht 
+ 
+       Die angeforderte Task gibt es in der Zielstation nicht. 
+ 
+     - Collectortask fehlt 
+ 
+       Das Kommando #on("bold")#define collector#off("bold")# wurde nicht gegeben (siehe 4.2). 
+ 
+     - Station x antwortet nicht 
+ 
+       Eine nicht vorhandene oder abgeschaltete Station wurde angesprochen. 
+       Hinweis: Dieser Fehler wird angenommen, wenn eine Überwachungszeit
+                von ca. 30 Sekunden verschrichen ist, ohne daß Station x die
+                Taskidentifikation angeliefert hat. 
+ 
+   Beispiel: 
+ 
+     list (5/"PUBLIC") 
+ 
+     Dateiliste von PUBLIC auf Station 5 wird angefordert. 
+ 
+1.2 
+ 
+   TASK OP / (INT CONST station, TASK CONST task) 
+ 
+   liefert 
+ 
+   station / name (task) . 
+ 
+ 
+   Beispiel: 
+ 
+     list (4/archive) 
+ 
+ 
+1.3 
+ 
+   INT PROC station (TASK CONST task) 
+ 
+   liefert die Stationsnummer der Task #on("bold")#task#off("bold")#. 
+ 
+   Beispiel: 
+ 
+     put (station (myself)) 
+ 
+     gibt die eigene Stationsnummer aus. 
+ 
+ 
+1.4 
+ 
+   PROC archive (TEXT CONST archivename, INT CONST station) 
+ 
+   dient dazu das Archiv auf der Station #on("bold")#station#off("bold")# anzumelden. 
+ 
+   Beispiel: 
+ 
+   archive ("std", 4); list (4/archive) 
+ 
+   gibt das Inhaltsverzeichnis der Archivfloppy im Laufwerk der Station 4 aus. 
+   Hinweis: Vergessen Sie bei solchen Querarchivierungen nicht die Stations­
+            angabe bei jedem einzelnen Archivkommando (z.B fetch ("xxx", #on("bold")#4/#off("bold")#
+            archive). 
+   Hinweis: Querarchivieren ist langsam. Verwenden Sie es nur, wenn Sie Flop­
+            pyformate umsetzen wollen. 
+ 
+ 
+1.5 
+ 
+   PROC free global manager 
+ 
+   dient dazu, die eigene Task über das Netz ansprechbar zu machen. Jede
+   andere Task im Netz kann dann die üblichen Manageraufrufe ('save', 'fetch',
+   u.s.w.) an die eigene Task machen, sofern diese nicht an ein Terminal gekop­
+   pelt ist. 
+ 
+   Die Task wird (wie bei 'break') abgekoppelt und meldet sich in Zukunft mit
+   'maintenance' statt mit 'gib kommando'. 
+ 
+   Beispiel: 
+ 
+   An Station 4 ruft man in der Task 'hugo' das Kommando #on("bold")#free global manager#off("bold")#
+   auf. Anschließend kann man von jeder Station aus z.B. 'list (4/"hugo")' u.s.w.
+   machen. 
+ 
+ 
+1.6 
+ 
+  TEXT PROC name (TASK CONST t) 
+ 
+  Diese (schon immer vorhandene) Prozedur wurde dahingehend erweitert, daß der
+  Name einer Task einer anderen Station über Netz angefordert wird. 
+ 
+  Fehlerfall: 
+ 
+  Station x antwortet nicht 
+ 
+ 
+ 
+ 
+#type("triumb12")#2. Hardwarevoraussetzungen#type("trium8")# 
+ 
+2.1 Zwei Stationen 
+ 
+      Sie können zwei Stationen miteinander Vernetzen, wenn Sie dafür an jeder
+      Station eine V24-Schnittstelle zur Verfügung stellen. 
+ 
+      Diese beiden Schnittstellen verbinden Sie mit einem Kabel zur Rechner­
+      kopplung (siehe Systemhandbuch 1.7 Teil 2). 
+ 
+2.2 Mehrere Stationen 
+ 
+      Wenn Sie mehr als zwei Stationen vernetzen wollen, brauchen neben je
+      einer V24 an jeder Station noch je eine Netzanschlußbox. 
+ 
+      Jede Box besitzt eine V24-Schnittstelle zum Anschluß an die V24-
+      Schnittstelle der zugeorneten Station und eine weitere Schnittstelle zur
+      Verbindung der Boxen untereinander. 
+ 
+ 
+#type("triumb12")#3. Einrichten des Netzes #type("trium8")# 
+ 
+Hinweis: Dieses Kapitel ist nur für Systembetreuer wichtig. 
+ 
+3.1 Legen Sie Stationsnummern für die am Netz beteiligten Rechner fest (von 1 an
+    aufsteigend). 
+ 
+    Die Boxen haben ebenfalls Stationsnummern. Die Stationsnummern der Box
+    und des zugeordneten Rechners müssen übereinstimmen. 
+ 
+ 
+3.2 Holen Sie an jeder Station die Task #on("bold")#configurator#off("bold")# an ein Terminal und geben Sie
+    das Kommando #on("bold")#define collector ("net port")#off("bold")#. Geben Sie außerdem das
+    Kommando #on("bold")#define station (x)#off("bold")#, wobei #on("bold")#x#off("bold")# die gewählte Stationsnummer ist. 
+ 
+    Hinweis: Taskkommunikationen, die zu dem Zeitpunkt laufen, führen zu feh­
+             lerhaften Verhalten. Dies liegt daran, daß durch #on("bold")#define station#off("bold")# alle
+             Task-Id's geändert werden müssen, weil eine Task-Id u.a. die
+             Stationsnummer der eigenen Station enthält (siehe 2.3). TASK-
+             Variable, die noch Task-Id's mit keiner oder falscher Stationsnum­
+             mer enthalten, können nicht mehr zum Ansprechen einer Task
+             verwendet werden. 
+ 
+    Beispiel: Der Spoolmanager (siehe Benutzerhandbuch 1.7 Teil 12) richtet
+              beim Kommando #on("bold")#start#off("bold")# einen Worker ein und merkt sich dessen
+              Task-Id in einer TASK-Variablen, um sicherzustellen, daß nur der
+              Worker Dateien zum Drucken abholt. Wird jetzt das Kommando #on("bold")#
+              define station#off("bold")# gegeben, kann der Spoolmanager seinen Worker
+              nicht mehr identifizieren, weil der Worker eine neue Task-Id er­
+              halten hat. Man muß daher den Worker löschen und mit dem
+              Kommando #on("bold")#start#off("bold")# im Spoolmanager wieder neu einrichten. 
+ 
+ 
+             Sinnvollerweise gibt man #on("bold")#define station#off("bold")# sofort nach den Laden eines
+             frischen Systems von Archiv. 
+ 
+    Konfigurieren Sie mit dem Kommando #on("bold")#configurate#off("bold")# den für das Netz vorgese­
+    henen Kanal auf 
+ 
+    - transparent 
+    - 9600 Baud (Standardeinstellung der Boxen) 
+    - RTS/CTS-Protokoll 
+    - großen Puffer 
+    - 8 bit 
+    - even parity 
+    - 1 stopbit. 
+ 
+    Falls diese Einstellungen nicht alle angeboten werden, klären Sie mit Ihrem
+    Rechnerlieferanten, ob und wie diese Einstellungen erreicht werden können. 
+    Hinweis: Notfalls kann auf das RTS/CTS-Protokoll verzichtet werden, wenn
+             der Eingabepuffer der Station groß genug ist. Die Anzahl simultan
+             laufender Netzkommunikationen ist dann auf 
+ 
+             puffergröße DIV 150 
+ 
+             begrenzt (bei Z80, 8086: 3; bei M20: 10). 
+   Hinweis: Es können auch andere Baudraten (2400, 4800, 19200) an der Box
+            eingestellt werden. 
+ 
+3.3 Achten Sie bei der Verbindung von der Station zur Netzbox (bzw. zur Gegen­
+    station bei einem Zweistationennetz ohne Boxen) darauf, daß neben den
+    Empfangs- und Sendeleitungen auch die Leitungen RTS und CTS verdrahtet
+    werden, also ein 5 poliges Kabel verwendet wird (siehe Systemhandbuch 1.7
+    Teil 2). Die Pin-Belegung der Boxen entspricht den dortigen Angaben. 
+ 
+    Beispiel: 
+ 
+    Verbindung eines CSK-Systems mit der Box: 
+ 
+    Stecker                  Stecker 
+    Pin                      Pin 
+ 
+    2  <--------->           3 
+    3  <--------->           2 
+    4  <--------->           5 
+    5  <--------->           4 
+    7  <--------->           7 
+ 
+ 
+3.4 Richten Sie eine Task #on("bold")#net#off("bold")# unter #on("bold")#SYSUR#off("bold")# ein und insertieren Sie dort die Datei­
+en 
+ 
+    net report/M 
+    basic net 
+    net manager/M. 
+ 
+    Beantworten Sie die Frage nach dem Kanal für das Netz und nach der Fluß­
+    kontrolle (RTS/CTS). 
+ 
+ 
+#type("triumb12")#4. Informationsmöglichkeiten #type("trium8")# 
+ 
+   In der Task #on("bold")#net#off("bold")# wird eine Datei #on("bold")#report#off("bold")# geführt in der Fehlersituationen des
+   Netzes verzeichnet werden. Diese Datei kann in jeder anderen Task mit #on("bold")#list
+   (/"net")#off("bold")# angezeigt werden. 
+ 
+   In jeder Task kann durch das Kommando #on("bold")#list (/"net port")#off("bold")# eine Übersicht über
+   die momentan laufenden Netzübertragungen der eigenen Station erhalten
+   werden. 
+ 
+ 
+#type("triumb12")#5. Eingriffsmöglichkeiten #type("trium8")# 
+#headodd# 
+ 
+#center#Eingriffsmöglichkeiten#right#% 
+ 
+ 
+#end# 
+ 
+5.1 Jede Task kann Sende- und Empfangsströme, die bei #on("bold")#list (/"net port")#off("bold")# gemel­
+    det worden sind und die eigene Task betreffen, abbrechen. Hierzu ist das
+    Kommando #on("bold")#erase ("x",/"net port")#off ("bold")# zu geben, wobei x die Stromnummer (aus
+    dem 'list') ist. 
+ 
+    Unberechtigte Löschversuche werden abgewiesen. 
+ 
+    Von der Task 'net' aus können jedoch damit beliebige Ströme abgebrochen
+    werden. 
+ 
+5.2 Durch das Kommando #on("bold")#start#off("bold")# kann von der Task 'net' aus das Netz neu gestartet
+    werden. Dabei werden alle augenblicklichen Netzkommunikationen gelöscht.
+    Die Tasks 'net port' und 'net timer' werden dabei gelöscht und neu eingerich­
+    tet. 
+ 
+    #on("bold")#start (kanal, quit)#off("bold")# wirkt wie #on("bold")#start#off("bold")#. Zustzlich wird als Netzkanal 'kanal' eingestellt
+    und maximal 'quit' Empfangsströme zugelassen. 'quit' ist auf 3 zu setzen,
+    wenn der Kanal ohne RTS/CTS angeschlossen ist (siehe 3.2). 
+ 
+ 
+#type("triumb12")#6. Fehlersuche im Netz #type("trium8")# 
+ 
+   Fehler im Netz können sich verschiedenartig auswirken. Im Folgenden wird auf
+   einige Beispiele eingegangen: 
+ 
+   Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Station 4 antwortet nicht'. 
+ 
+   Fehlermöglichkeiten: 
+ 
+   -  Station 4 gibt es nicht am Netz. 
+      Abhilfe: Richtige Station angeben. 
+ 
+   -  Station 4 ist nicht eingeschaltet. 
+      Abhilfe: Station 4 einschalten. Kommando erneut geben. 
+ 
+   -  Netztask an Station 4 ist nicht arbeitsfähig. 
+      Abhilfe: Kommando 'start' in der Task 'net'. 
+ 
+   -  Stationsnummern und Boxnummern stimmen nicht überein. 
+      Abhilfe: Mit 'define station' Stationsnummern korrigieren (siehe 3.2). 
+ 
+   -  Verbindung Rechner/Box am eigenen Rechner oder an Station 4 fehlt. 
+      Abhilfe: Verbindungen überprüfen. Durch Ansprechen einer dritten Station
+               kann oft schnell geklärt werden, welche Rechner/Box-Verbindung
+               defekt sein muß. 
+ 
+   -  Verbindung der Boxen untereinander defekt. 
+      Abhilfe: Fehlende Verbindung, Masseschluß und Dreher (keine 1:1 Ver­
+               bindung) überprüfen und beheben. 
+      Hinweis: Liegt z.B. ein Masseschluß vor, so kann es durchaus sein, daß
+               Boxen, die nicht in der Nähe des Masseschluß stehen noch mitei­
+               nander arbeiten können. Man kann aus der Tatsache, daß zwei
+               Boxen miteinander arbeiten können, also nicht schließen, daß man
+               nicht nach diesem Fehler suchen muß. 
+ 
+ 
+   Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt keine Reaktion. 
+ 
+ 
+   -  Station 4 ist während dieser Sendung zusammengebrochen. 
+      Abhilfe: Station 4 wieder starten. Die Bearbeitung des 'list'-Kommandos
+               wird automatisch wieder aufgenommen. 
+ 
+   -  PUBLIC auf Station 4 ist nicht im Managerzustand. 
+      Abhilfe: PUBLIC in den Managerzustand versetzen. 
+ 
+ 
+      Hinweis: Das Netz hat nocht nicht die volle Sendungslogik des EUMEL. So
+               wird nur ca. 10 Minuten lang versucht, eine Sendung zuzustellen.
+               Danach wird die Sendung gelöscht. Ist dies eingetreten, so muß
+               das list-Kommando erneut gegeben werden. 
+ 
+   -  Fehler in der Netzhardware. 
+      Überprüfen Sie, ob 
+ 
+      - die Boxen eingeschaltet sind, 
+      - die Bereitlampe blinkt (wenn nicht: RESET an der Box) 
+      - die V24-Kabel richtig stecken, 
+      - die Boxen untereinander verbunden sind (1 zu 1 Verbindungen der 5
+        poligen Diodenbuchsen). 
+ 
+ 
+   -  Die Netzsoftware ist auf einen nicht vorhergesehenen Fehler gelaufen. 
+      Dieser wird im Report vermerkt. 
+      Abhilfe: Geben Sie in der Task #on("bold")#net#off("bold")# das Kommando #on("bold")#start#off("bold")#. Dadurch wird die
+               Netzsoftware neu gestartet. Alle Netzkommunikationen dieser
+               Station gehen verloren. 
+ 
+ 
+   Beispiel: 
+ 
+   Auf #on("bold")#list (4/public)#off("bold")# erfolgt die Meldung 'Collectortask fehlt'. 
+ 
+   -  In der Task 'configurator' wurde das Kommando 'define collector' (siehe 3.2)
+      nicht gegeben. 
+ 
+   -  Die Task 'net port' existiert nicht mehr. 
+      Abhilfe: Kommando 'start' in der Task 'net'. 
+ 
+ 
+   Beispiel: 
+ 
+   Nach #on("bold")#fetch ("hugo",4/public)#off("bold")# sind Teile von der Datei "hugo" verfälscht. 
+ 
+   -  Die V24-Verbindung zur Box ist nicht in Ordnung. 
+      Abhilfe: Abstand zwischen Rechner und Box verkürzen; Baudrate ernie­
+               drigen; Durch Wechseln der V24-Schnittstelle feststellen, ob
+               diese defekt ist. 
+      Hinweis: Die Verbindung zwischen den Boxen ist durch Prüfsummen abge­
+               sichert (Hardware). 
+ 
+#headodd# 
+ 
+#center#Teil 2: Arbeitsweise der Netzsoftware#right#% 
+ 
+ 
+#end# 
+#page# 
+#type("triumb12")# 
+ 
+Teil 2: Arbeitsweise der Netzsoftware 
+ 
+ 
+1. Die Netztask #type ("trium8")# 
+ 
+In diesem Kapitel wird beschrieben, wie eine Netztask in das System
+eingebettet ist und welche Aufgaben sie hat. Unter Einhaltung dieser
+Konzepte kann die ausgelieferte Netztask so geändert werden, daß sie
+beliebige andere Netzhardware unterstützt. Z.Zt. ist die Netzsoftware noch
+nicht so gegliedert, daß nur eine hardwareabhängige Komponente ausgetauscht
+werden muß. 
+ 
+Die Kommunikation zwischen Tasks im EUMEL-Betriebssystem basiert auf einem
+Rendevouskonzept: Die Zieltask einer Sendung muß empfangsbereit sein, wenn die
+Quelltask sendet. 
+ 
+Die Kommunikationsprozeduren auf der niedrigsten Ebene sind 'send' (Senden)
+und 'wait' (Warten auf Empfang). Bei der Kommunikation werden eine Integer
+'code' und ein Datenraum 'dr' übergeben. 'code' muß >= 0 sein, da negative
+Codes systemintern verwandt werden. Ist die empfangende Task an einen Kanal
+gekoppelt ('continue'), so führt eine Zeicheneingabe auf diesem Kanal dazu,
+daß eine
+Sendung mit dem Code -4 ankommt. Die Eingabedaten müssen mit den üblichen
+Eingabeprozeduren ('inchar' u.s.w.) abgeholt werden. Der übermittelte Datenraum
+und die Absendertask sind dabei ohne Bedeutung und dürfen nicht interpretiert
+werden. 
+ 
+Die Prozedur 'send' hat einen Rückmeldeparameter, der besagt, ob die Sendung
+übermittelt wurde. Gibt es die Zieltask nicht oder steht sie nicht im 'wait', so kann
+die Sendung nicht übermittelt werden. 
+ 
+ 
+Ein Entwicklungskriterium für das EUMEL-Netz war es, möglichst wenig Unter­
+stützung von der virtuellen EUMEL-Maschine (EUMEL0) zu fordern, damit weit­
+gehend in ELAN programmiert werden kann. Dadurch ist es möglich eine (privili­
+gierte) Task mit der Netzabwicklung zu betrauen. 
+ 
+Zunächst wird auf die EUMEL0-Unterstützung eingegangen: 
+ 
+1.1. Es gibt die Prozedur 'define collector', mit der die für das Netz verantwort­
+     liche Task der EUMEL0-Maschine bekannt gemacht wird. Diese Task wird im
+     folgenden Collector genannt. 
+ 
+1.2. Es gibt die Prozedur 'define station', die für den Rechner eine Stationsnum­
+     mer einstellt. Anhand dieser Nummer werden die Rechner eines Netzes un­
+     terschieden. Das Einstellen bewirkt, daß für alle Tasks die Stationsnummer in
+     ihre Task-Id eingetragen wird (Task-Id's sind die Werte, die der Typ TASK
+     annehmen kann). 
+ 
+1.3. Der Befehl 'station (task)' liefert die Stationsnummer der 'task'. So liefert z.B.
+     'station (myself)' die Stationsnummer des eigenen Rechners. 
+ 
+1.4. Eine Sendung, deren Zieltask in einem anderen Rechner liegt (also station
+     (ziel) <> station (myself)), wird auf die Collectortask geleitet. 
+ 
+1.5. Es gibt eine Prozedur 'collected destination', die es dem Collector erlaubt, die
+     eigentliche Zieltask einer auf ihn geleiteten Sendung zu erfahren. 
+ 
+1.6. Es gibt eine Variante der Prozedur 'send', die es dem Collector gestattet, der
+     Zieltask eine beliebige andere Task als Absender vorzumachen. 
+ 
+1.7. Es gibt eine spezielle Task-Id 'collector', durch die der augenblicklich ein­
+     gestellte Collector erreicht wird. Diese wird als Zieltask beim Aufruf der Ver­
+     mittlungsdienste angegeben (siehe 2.5). Eine Sendung an 'collector' wird von
+     EUMEL0 an den derzeitigen Collector geschickt. 
+ 
+Ein Collector kann also auf drei Wegen von den übrigen Tasks desselben Rechners
+Sendungen erhalten: 
+ 
+  1. Über ein normales Send (z.B. bei 'list (/"net port")', wenn "net port" der der­
+     zeitige Collector ist), 
+ 
+  2. über ein Send an die Task 'collector' (s.u.) und 
+ 
+  3. als umgeleitete Sendung (z.B. bei 'list' an eine Task auf einem anderen
+     Rechner). 
+ 
+Der Collector kann diese Fälle anhand von 'collected destination' unterscheiden. 
+ 
+Die Punkte 1.4...1.6 dienen dazu, den Collector für über Netz kommunizierende
+Task unsichtbar zu machen: Der Collector taucht nicht als Ziel oder Quelle von
+Sendungen auf. Das ist notwendig, damit normale Tasks sich nicht darum kümmern
+müssen, ob eine Sendung übers Netz geht oder im eigenen Rechner bleibt. 
+ 
+Wenn ein Datenraum an einen anderen Rechner geschickt wird, muß der gesamte
+Inhalt (z. Zt. max. 1 MB) übertragen werden. Dies macht bei der üblichen Netz­
+hardware eine Zerlegung in Packete nötig (siehe Systemhandbuch 173, Teil 4,
+Punkt 5). Für Netze über V24-Kanäle stehen spezielle Blockbefehle zur verfü­
+gung: 
+ 
+1.8. blockin / blockout (dr,seite,512+abstand,anzahl,rest) 
+ 
+   Es werden maximal 'anzahl' Bytes transferiert. In 'rest' wird zurückgemeldet,
+   wieviel Bytes nicht bearbeitet wurden (z.B. weil der Kanal nichts anliefert).
+   Bearbeitet werden die Bytes 
+ 
+      'seite' * 512 + 'abstand' 
+ 
+   bis maximal 
+ 
+      'seite' * 512 + 'abstand' + 'anzahl' - 1 
+ 
+  Der Kanal, an den die Task gekoppelt ist, wird dabei über Stream-IO (d.h.
+  'incharety' bei 'blockin' bzw. 'out' bei 'blockout') angesprochen. 
+ 
+  Hinweis: Die Anforderung darf nicht über Seitengrenze gehen, d.h. 
+ 
+  'abstand' + 'anzahl' <= 512 
+ 
+  muß erfüllt sein. 
+ 
+ 
+Eine Netzsendung läuft wie folgt ab: 
+ 
+Die Task q auf Rechner rq mache ein 'send' an die Task z auf Rechner rz. 
+ 
+1. Die Prozedur send ist ein EUMEL0-Befehl. Die EUMEL0-Ebene erkennt, daß
+   die Sendung an die Station rz geht, da die Stationsnummer in der Task-Id
+   enthalten ist. Daher wird die Sendung zum Collector, den EUMEL0 wegen 'de­
+   fine collector' kennt, umgeleitet. 
+ 
+2. Die Task Collector empfängt über 'wait' den Datenraum, den Sendecode und
+   die Absendertask q. Die Zieltask z erfährt sie durch 'collected destination'. 
+ 
+3. Der Collector nimmt Kontakt mit dem Collector des Rechner rz, dessen Sta­
+   tionsnummer ja 'station(z)' ist, auf und Übermittelt diesem Sendecode, Quelltask
+   (q), eigentliche Zieltask (z) und den Datenraum. Da die Collectoren in ELAN
+   geschrieben sind, können sie an beliebige Netzhardware und Protokolle ange­
+   paßt werden. 
+ 
+4. Der Collector auf Rechner rz verwendet das spezielle 'send', um der Zieltask die
+   Sendung zuzustellen. Dadurch erscheint nicht der Collector sondern die Task q
+   als Absender der Sendung. 
+ 
+Zur Abwicklung der Vermittlungsebene (Teil 1: 2.4) muß der Collector noch
+spezielle Funktionen beherrschen. Diese sind 
+ 
+   der /-Operator (Taskname in Task-Id wandeln) und 
+   die name-Prozedur (Task-Id in Namen wandeln). 
+ 
+Der /-Operator macht eine Sendung an den 'collector', wobei im Datenraum der
+Name der Task steht und der Sendecode gleich der Stationsnummer ist (siehe
+Quellcode 173, Packet tasks). Der Collector setzt sich mit dem Collector dieser Sta­
+tion in Verbindung, damit dieser die Task-Id ermittelt und zurückschickt. Der
+eigene Collector schickt dann dem /-Operator als Antwort einen Datenraum, der
+die Task-Id enthält. 
+ 
+Umgekehrt läuft 'name' ab: Wenn die Task-Id von einer fremden Station ist,
+schickt 'name' eine Sendung an den 'collector', wobei im Datenraum die Task-Id
+steht und Sendecode = 256 ist. Der Collector entnimmt die Stationnummer der
+Task aus der Task-Id und läßt sich vom entsprechenden Collector den Tasknamen
+geben. Dieser wird der 'name'-Prozedur im Antwortdatenraum übergeben. 
+ 
+#type ("triumb12")#2. Ebenen #type("trium8")# 
+ 
+In diesem Kapitel werden die Protokollebenen für das Netz beschrieben, wie
+sie die ausgelieferte Netzsoftware benutzt und erwartet. Bei anderer
+Netzhardware müssen die Ebenen 1 bis 3 ausgetauscht werden. Unter Einhaltung
+der im vorigen Kapitel beschriebenen Randbedingungen können auch die höheren
+Ebenen geändert werden. 
+ 
+ 
+2.1 Physikalische Ebene 
+ 
+    2.1.1  Station <--> Box 
+ 
+           V24-Schnittstelle mit RTS/CTS-Handshake. Vollduplex. 
+ 
+    2.1.2  Box <--> Box 
+ 
+           RS422 über 2 verdrillte Leitungspaare (Takt und Daten). 
+ 
+2.2 Verbindungsebene 
+ 
+    2.2.1  Station <--> Box 
+ 
+           Asynchron 
+           8 Bit 
+           Even Parity 
+           2400/4800/9600/19200 Baud (einstellbar über Lötbrücken) 
+ 
+    2.2.2  Box <--> Box 
+ 
+           SDLC 
+           400 KBaud 
+ 
+2.3 Netzebene 
+ 
+    2.3.1  Station <--> Box 
+ 
+           Telegrammformat:  STX, <n>, <ziel>, <quelle>, <(n-4) byte> 
+ 
+           <n> ist Längenangabe ( 8 <= n <= 160) 
+           <ziel>, <quelle> sind Stationsnummern. Diese müssen an den je­
+           weiligen Boxen über Lötbrücken eingestellt sein. 
+ 
+           Box --> Station: 
+ 
+           Ein Telegramm kommt nur bei der Station an, bei deren Box die
+           Nummer <ziel> eingestellt ist. Dadurch ist ein Mithören fremder
+           Übertragungen nicht möglich (Datenschutz). 
+ 
+           Zwischen Telegrammen können Fehlermeldungen der Box (Klartext)
+           übermittelt werden (z.B. 'skipped x', wenn ein STX von der Box er­
+           wartet wurde, aber 'x' von der Station ankommt). 
+ 
+           Station --> Box: 
+ 
+           Ein Telegramm wird nur abgeschickt, wenn <quelle> mit der einge­
+           stellten Nummer übereinstimmt (Datenschutz: Man kann nicht eine
+           beliebige Station zu sein vorschwindeln, es sei denn man hat physi­
+           schen Zugriff zur Box und stellt dort die Stationsnummer um). 
+ 
+    2.3.2  Box <--> Box 
+ 
+           Telegrammformat: FRAME, <ziel>, <quelle>, <daten> ,
+           <CRC-Code> 
+ 
+           Eine Längenangabe ist nicht nötig, da SDLC eine Rekonstruktion der
+           Länge erlaubt. 
+ 
+           Telegramme mit falschen CRC-Code werden vernichtet. Auf höheren
+           Ebenen muß dies durch Zeitüberwachung erkannt und behandelt
+           werden. 
+ 
+ 
+2.4 Transportebene 
+ 
+    Diese Ebene wickelt das Rendevous zwischen einer Task, die 'send' macht,
+    und einer Task, die im 'wait' steht, ab (siehe: EUMEL-Systemhandbuch). 
+ 
+    Der im 'send' angegebene Datenraum wird als Folge von Seiten (im
+    EUMEL-Sinne: Pagingeinheit und Allokiereinheit) übermittelt, wobei jede Seite
+    noch in 64 Byte große Stücke zerlegt wird. Es werden nur echt allokierte Seiten
+    übermittelt. Um nicht jedes Telegramm voll qualifizieren zu müssen, wird
+    zunächst eine Art virtuelle Verbindung durch ein OPEN-Telegramm eröffnet.
+    Danach folgen variable viele DATA-Telegramme. Beide Sorten werden durch
+    QUIT-Telegramme quittiert, um folgende Funktionen zu ermöglichen: 
+ 
+    Flußkontrolle (z.B. Zielrechner langsam) 
+    Wiederaufsetzen (verlorene Telegramme) 
+    Abbruch (z.B. weil Zieltask inzwischen beendet). 
+ 
+    Ein CLOSE-Telegramm ist nicht nötig, da das letzte DATA-Telegramm als
+    solches erkannt werden kann (siehe unten). 
+ 
+    2.4.1 OPEN-Telegramm 
+ 
+          STX, 20, <ziel>, <quelle>, <strom>, <sequenz>, <seite>, 
+          <quelltask>, <zieltask>, <code> 
+ 
+          <ziel>, <quelle> siehe 2.3.1 
+ 
+          <strom>      Die Stromnummer identifiziert die virtuelle Verbindung.
+                       Sie muß in den QUIT-Telegrammen angegeben wer­
+                       den. 
+ 
+          <sequenz>    -1 (Kennzeichen für OPEN) 
+ 
+          <seite>      Nummer der ersten echt allokierten Seite des Datenra­
+                       ums (=-1, falls Nilspace) 
+ 
+          <quelltask>  Taskid der sendenden Task 
+ 
+          <zieltask>   Taskid der empfangenden Task 
+ 
+          <code>       Wert des im 'send' angegebenen Codes. 
+ 
+    2.4.2 DATA-Telegramm 
+ 
+          STX, 74, <ziel>, <quelle>, <sequenz>, <seite>, <64 byte> 
+ 
+          <sequenz>    wird von Telegramm zu Telegramm hochgezählt. Dient
+                       der Überwachung gegen verlorengegangene Telegramme
+                       bzw. durch Zeitüberwachung verdoppelter Telegramme. 
+ 
+          <seite>      Nummer der x.ten echt allokierten Seite des Datenra­
+                       ums. (x = (<sequenz>+16) DIV 8). 
+ 
+          <64 byte>    Nutzinformation. Diese gehört zur Adresse a des Daten­
+                       raums. 
+ 
+                       a = N (<sequenz> DIV 8 + 1) * 512 
+                           + (<sequenz> MOD 8) * 64 
+ 
+                       wobei N (x) die Nummer der x.ten Seite ist. 
+ 
+                       Aus den Formeln ergibt sich, daß diese Nummer schon in
+                       einem vorhergehenden DATA/OPEN-Telegramm über­
+                       mittelt wurde (im Feld <seite>). 
+ 
+    2.4.3 QUIT-Telegramm 
+ 
+          STX, 8, <ziel>, <quelle>, <strom>, <quit> 
+ 
+          <strom>      muß die Stromnummer sein, die in dem OPEN/DATA-
+                       Telegramm stand, das quittiert wird. 
+ 
+          <quit>       0 :  ok. Nächstes Telegramm schicken. 
+ 
+                       -1:  Übertragung neu starten (mit OPEN), weil die
+                            Empfangsstation das OPEN nicht erhalten hat. 
+ 
+                       -2:  Übertragung ca. 20 Telegramme zurücksetzen. 
+ 
+                       -3:  Übertragung abbrechen. 
+ 
+ 
+2.5 Vermittlungsebene 
+ 
+    Diese Ebene ist dafür zuständig, Tasknamen von Task auf anderen Stationen
+    in Taskids (Werte des Typs TASK) zu wandeln und umgekehrt. Hierzu wird im
+    entsprechenden OPEN-Telegramm der Code -6 (bzw. -7) als <code>
+    eingetragen. Die Netzempfangstask erkennt diese Codes und wickelt die
+    Aufgaben selbst ab, sodaß es dabei nicht nötig ist, irgendeine Taskid der
+    Zielstation zu kennen. 
+ 
+    Dieses Verfahren ist möglich, weil im 'send' nur positive Codes erlaubt sind. 
+ 
+2.6 Höhere Ebenen 
+ 
+    Höhere Ebenen sind nicht mehr netzspezifisch. Sie basieren alle auf dem
+    Send/Wait-Konzept des EUMEL. So gibt es z.B. den 'global manager', der
+    Aufbewahrung und Zugriff von Dateien in einer Task regelt. Dabei darf diese
+    Task (bei der Variante 'free global manager') auf einer beliebigen Station im
+    Netz liegen. Wegen des Rendevous-Konzepts können beliebige Sicherheit­
+    strategien benutzt werden (z.B.: Keine Dateien an Station 11 ausliefern). Von
+    großen Wert ist z.B., daß man ohne weiteres das Archiv (Floppylaufwerk) einen
+    anderen Station anmelden und benuzten kann, wodurch eine einfache Kon­
+    vertierung von Floppyformaten möglich ist. Dies ist möglich, weil auch die Ar­
+    chiv-Task der Stationen sich an das Globalmanagerprotokoll halten. 
+ 
+ 
+#type("triumb12")# 
+Bemerkungen#type("trium8")# 
+ 
+Fehlerbehandlung besteht bis Ebene 3 darin, fehlerhafte Telegramme einfach zu
+entfernen. Die Ebene 4 überwacht den Netzverkehr sowieso über Timeouts, die
+eine Wiederhohlung eines Telegrammes bewirken, wenn die Quittung ausbleibt. 
+ 
+Da bei der sendenden Station der ganze Datenraum zur Verfügung steht, ist eine
+Fenstertechnik (wie bei HDLC) nicht nötig. Es kann zu jedem Zeitpunkt um beliebig
+viele Telegramme zurückgesetzt werden. 
+ 
+Da im EUMEL eine Textdatei ein Datenraum mit sehr komplexer Struktur ist (wegen
+der Insert/Delete-Möglichkeiten, ohne den Rest der Datei zu schieben), ist es ein
+hoher Aufwand, von einem fremden Betriebssytem her Textdateien ins EUMEL-
+Netz zu senden. Für solche Zwecke muß noch eine einfachere Dateistruktur defi­
+niert werden und entsprechende Dateikonverter erstellt werden. 
+ 
+ 
+ 
+#type("triumb12")#3. Stand der Netzsoftware #type("trium8")# 
+ 
+Das EUMEL-System wickelt die Prozedur #on("bold")#send#off("bold")# über das Netz ab, wenn die
+Stationsnummer der Zieltask ungleich der eigenen Stationsnummer ist. Umge­
+kehrt kann man der von der Prozedur #on("bold")#wait#off("bold")# gelieferten Absendertask die Absen­
+derstation entnehmen (siehe Prozedur #on("bold")#station#off("bold")# in Abschnitt 3). 
+ 
+Nicht unterstützt wird z.Zt. die Logik der Prozeduren #on("bold")#call#off("bold")# und #on("bold")#pingpong#off("bold")#. Diese
+funktionieren nur in der gewohnten Weise, wenn die Zieltask in #on("bold")#wait#off("bold")# steht. Ist
+die Zieltask länger als ca. 10 Minuten #on("bold")#busy#off("bold")# oder nicht mehr vorhanden, geht die
+Sendung einfach verloren (Gefordert ist: bei #on("bold")#call#off("bold")#: immer wieder versuchen; bei #on("bold")#
+pingpong#off("bold")#: Rückmeldung -2). 
+ 
+Wegen dieser Einschränkung kann man z.B. ein sicheres Drucken von Station a
+auf einen Drucker der Station b nur durch einen eigenen Spoolmanager auf
+Station a verwirklichen. Die Einrichtung eines solchen Managers ist allerdings
+sowieso sinnvoll, damit man 
+ 
+- das normale 'print'-Kommando verwenden kann (statt z.B. save ("xxx",
+4/printer);) und 
+- nicht zu warten braucht, bis die Datei übers Netz gesendet ist. 
+
+
diff --git a/system/printer-24nadel/0.9/doc/readme b/system/printer-24nadel/0.9/doc/readme
new file mode 100644
index 0000000..d526aa3
--- /dev/null
+++ b/system/printer-24nadel/0.9/doc/readme
@@ -0,0 +1,320 @@
+#type("nlq10")##limit(18.0)##start(1.5,1.0)# 
+#head# 
+Treiber-Installations-Programm   #right#Seite % 
+für 24-Nadel-Matrixdrucker   #right#23.12.1988 
+ 
+ 
+#end# 
+#on("u")#Dokumentation zum Treiber-Installations-Programm für 24-Nadel-
+Matrixdrucker#off("u")# 
+ 
+#on("u")#Inhalt:#off("u")# 
+ 
+1. Installations- und Gebrauchsanleitung 
+2. Druckertreiber-Auswahl 
+3. Steuerungsmöglichkeiten und Spezialfeatures 
+4. Weitere Hinweise 
+ 
+ 
+#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# 
+ 
+#on("u")#Einrichten#off("u")# 
+So wird das Treiber-Installationsprogramm eingerichtet: 
+ 
+       SV drücken 
+ 
+    nach 'gib supervisor kommando:' 
+ 
+       begin("PRINTER","SYSUR") 
+ 
+    in der Task "PRINTER" (nach 'gib kommando'): 
+ 
+       archive ("std.printer") 
+       fetch ("printer.24.nadel",archive) 
+       check off 
+       insert ("printer.24.nadel") 
+ 
+Das Programm wird dann insertiert. 
+ 
+#on("u")#Druckerkanal#off("u")# 
+Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker
+über Parallelschnittstelle betrieben wird, ist die Kanalnummer
+meistens 15. 
+ 
+#on("u")#Menüsystem#off("u")# 
+Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern.
+Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste
+der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier
+den passenden Typ aus! 
+Das Installationsprogramm zeigt nun einige Informationen zu dem ange­
+wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi­
+guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt
+wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei­
+ber betrieben werden soll. 
+ 
+Hinweise zu Konfigurationsangaben: 
+1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion
+   des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf
+   achten, welche Funktion die Schalter haben (Druckerhandbuch!). So
+   ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu
+   aktivieren, damit der Drucker nach Papierende nicht auf der Walze
+   weiterdruckt. 
+2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge­
+   wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker
+   als den ausgewählten verwenden, dann beachten Sie folgende Regeln
+   für die Konfiguration: 
+   - Der Drucker muß auf eine passende Emulation konfiguriert werden. 
+   - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei­
+     lenvorschub durchführen. 
+   - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. 
+ 
+   - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht
+     achten. 
+ 
+(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) 
+ 
+Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des
+ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) 
+ 
+Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er­
+laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt,
+welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein­
+stellungen können nachträglich in der Task "PRINTER" mit den entspre­
+chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte
+Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck­
+datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku­
+ments verändert werden (direkte Druckeranweisung \#"..."\#). 
+Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. 
+ 
+ 
+#on("b")#2. Druckertreiber-Auswahl#off("b")# 
+ 
+#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# 
+Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll­
+ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker
+des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. 
+Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im
+Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!),
+welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist.
+(Viele Drucker verfügen über EPSON LQ-1000 oder IBM Grafikdrucker bzw.
+Proprinter-Eumulationen.) 
+Eine der beiden Anpassungen 'EPSON LQ-1050' oder 'OKI ML-393
+IBM-kompatibel' müßte immer einen (Minimal-) Betrieb ermöglichen (wobei die
+Verwendung der Proportionalschrift bzw. der doppelt hohen Schriften u. U.
+nicht funktioniert). 
+ 
+ 
+#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# 
+ 
+Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B.
+DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). 
+Die Einstellungen können über 
+- Steuerprozeduren 
+- Materialanweisungen bzw. 
+- direkte Druckeranweisungen 
+vorgenommen werden. 
+ 
+#on("u")#Steuerprozeduren#off("u")# 
+setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten
+sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER")
+aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in
+der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# 
+ 
+PROC papersize (REAL CONST breite, länge) 
+    Dient zur Einstellung der Größe der physikalisch beschreibbaren
+    Fläche. 
+    Beispiel:  papersize (20.32, 30.48) 
+               (Standardeinstellung für Endlospapier 8 Zoll breit und
+               12 Zoll lang) 
+ 
+PROC papersize 
+    Informationsprozedur 
+ 
+PROC top margin (REAL CONST margin) 
+    Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk­
+    ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser
+    Prozedur die Länge des oberen Randes, den der Drucker nicht be­
+    drucken kann, in cm angegeben werden. 
+    Beispiel:  top margin (2.0) 
+               (Teilt dem Druckertreiber mit, daß die ersten 2 cm
+               nicht bedruckbar sind.) 
+ 
+REAL PROC top margin 
+    Informationsprozedur 
+ 
+PROC std speed (TEXT CONST speed) 
+    Parameter: slow, fast 
+    Wahl zwischen Positionierung in Mikroschritten (slow) oder in
+    Blanks (fast). 
+    Beispiel:  std speed ("slow") 
+ 
+TEXR PROC std speed 
+    Informationsprozedur 
+ 
+PROC std quality (TEXT CONST quality) 
+    übliche Parameter: draft, nlq 
+    Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift-
+    Qualität 
+    Beispiel:  std quality ("draft") 
+ 
+TEXT PROC std quality 
+    Informationsprozedur 
+ 
+PROC std typeface (TEXT CONST typeface) 
+    übliche Parameter: roman, sansserif, courier 
+    Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im
+    NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). 
+    Beispiel: std typeface ("roman") 
+ 
+TEXT PROC std typeface 
+    Informationsprozedur 
+ 
+PROC paper feed (TEXT CONST name) 
+    übliche Parameter: tractor, sheet, schacht1, schacht2 
+    Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. 
+    Beispiel:  paper feed ("sheet") 
+ 
+TEXT PROC paper feed 
+    Informationsprozedur 
+ 
+ 
+#on("u")#Materialanweisungen \#material("...")\##off("u")# 
+müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und
+setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben
+für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­
+stellten Standardwerten. Diese werden durch die Materialanweisung aber
+nicht geändert.) 
+ 
+Beispiel:  \#material("nlq")\# 
+           sorgt bei entsprechendem Treiber dafür, daß das gesamte
+           Dokument in Schönschrift-Qualität ausgedruckt wird, egal
+           wie 'std quality' eingestellt ist. 
+ 
+#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh­
+rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung
+erscheinen. Beispiel:  \#material("sheet;draft")\# 
+ 
+ 
+#on("u")#direkte Druckeranweisungen \#"..."\##off("u")# 
+gelten ab der Position, an der sie in der Datei auftreten. Sie haben
+(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und
+Materialeinstellungen. 
+ 
+Beispiel:  \#"draft"\# 
+           schaltet (bei entsprechendem Treiber) auf Datenverar­
+           beitungs-Qualität, egal welche Standardeinstellung vorliegt
+           und welche Materialanweisung gegeben wurde. 
+ 
+#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen
+werden.#off("b")# Also:  \#"nlq"\#\#"sansserif"\# 
+ 
+ 
+#on("u")#Wichtig#off("u")# 
+- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen
+  besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben
+  berücksichtigt! Also:  \#"nlq"\# und keinesfalls \#"NLQ"\#!!! 
+- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und
+  nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann
+  daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse
+  erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen
+  Reihenfolge an den Drucker sendet, als er in der Datei steht, die
+  mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B.
+  für beide Spalten) unerwünscht erhalten bleibt. 
+ 
+ 
+#on("u")#Tabelle#off("u")# 
+Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel­
+lungen erfolgen können. 
+ 
+#type("17")# 
+                   Steuerprozeduren      Materialanweisungen     direkte Druckeranweisungen 
+ 
+#on("u")#                                                                                          #off("u")# 
+ 
+Positionierung     std speed             slow, fast              ------ 
+                     slow, fast 
+ 
+Qualität           std quality           z.B. draft, nlq         z.B. draft, nlq 
+                     z.B. draft, nlq 
+ 
+Schriftart         std typeface          z.B. roman,             z.B. roman, 
+(nur bei NLQ)        z.B. roman,         sansserif, courier      sansserif, courier 
+                     sansserif, courier 
+ 
+Einzelblatt-       paper feed            z.B. schacht1,          z.B. schacht1, 
+einzug               z.B. tractor,       schacht2                schacht2 
+                     sheet, 
+                     schacht1, schacht2 
+ 
+Farbdruck          ------                ------                  z.B. schwarz, 
+                                                                 rot, blau, 
+                                                                 violett, gelb 
+                                                                 orange, grün 
+ 
+ 
+ 
+#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# 
+ 
+#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# 
+In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb
+des Codes 127 einige internationale Zeichen zur Verfügung gestellt
+(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). 
+Bei den Treibern der vorliegenden Version gilt folgendes: 
+- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL-
+  Zeichensatz (sofern möglich) unterstützt. 
+- Der Code 252 liefert das Paragraphzeichen. 
+- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes
+  oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des
+  IBM-Grafikzeichensatzes. 
+ 
+ 
+#on("u")#Hinweis zu Proportionalschriften#off("u")# 
+Bei Proportionalschriften kann die Modifikation \#on("i")\# zu Problemen
+führen (z.B. beim Blocksatz), wenn die kursiven Zeichen andere
+Proportionalbreiten haben.
+ 
+#on("u")#Hinweis zur Modifikation on/off("b") bzw. on/off("r")#off("u")# 
+Die meisten 24-Nadel Drucker verfügen sowohl über einen horizontalen als
+auch über einen vertikalen Schattendruck. Diese beiden Druckarten können
+mit der Modifikation on("b") (bold) bzw. on("r") (eigentlich für reverse
+gedacht) eingeschaltet werden.
+
+#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# 
+Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel­
+lungen vorgenommen werden (vgl. auch Abschnitt 3!): 
+ 
+   Am Drucker: 
+1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug
+   schalten (siehe Druckerhandbuch!). 
+ 
+   In der Druckspooltask (meist 'PRINTER'): 
+2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü­
+   gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für
+   2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed
+   ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. 
+3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen­
+   den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel­
+   len. 
+   Beispiel:  papersize (21.0, 29.7) 
+              (für DIN A4-Blätter) 
+4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt­
+   anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß
+   mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem
+   Druckertreiber mitgeteilt werden. 
+   Beispiel:  top margin (1.5) 
+   (Wie groß der obere Rand ist, kann festgestellt werden, indem eine
+   Datei mit \#start(0.0,0.0)\# ausgedruckt wird.) 
+ 
+   Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren
+   Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien
+   ein genügend großer y-Wert für die Startposition eingestellt wird
+   ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der
+   ersten Zeile zu Überschreibungen. 
+ 
+ 
+#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben
+   werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# 
+
+
+
+
diff --git a/system/printer-24nadel/0.9/source-disk b/system/printer-24nadel/0.9/source-disk
new file mode 100644
index 0000000..2ed06c0
--- /dev/null
+++ b/system/printer-24nadel/0.9/source-disk
@@ -0,0 +1,3 @@
+grundpaket/07_std.printer_24_nadel.img
+187_ergos/05_std.printer_24nadel.img
+187_ergos/06_std.printer_24nadel.img
diff --git a/system/printer-24nadel/0.9/src/beschreibungen24 b/system/printer-24nadel/0.9/src/beschreibungen24
new file mode 100644
index 0000000..e3d2fa9
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/beschreibungen24
@@ -0,0 +1,62 @@
+ 
+(*************************************************************************)
+(*                                            Stand   :  3. 1.89         *)
+(*  Beschreibungen-Datei für 24-Nadel-Drucker Version : 0.9              *)
+(*                                            Autor   : hjh              *)
+(*************************************************************************)
+ 
+$necp5p7$ 
+begin;headnecp5p7;declarations;feed; 
+open;opendoch;opendocp5p7;openpagep5-7;close;closepage; 
+execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end
+
+$necp6$ 
+begin;headnecp6;declarations;feed; 
+open;opendoch;opendocp6;openpagep5-7;close;closepage; 
+execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end
+ 
+$necp6+$
+begin;headnecp6+;declarations;speed;topmargin;typefacep6+;feed; 
+open;opendoch;initspeed;opendocp6+;openpage;close;closepage; 
+execute;cmdp6+;crs;move;stdmove;onoff;typep6+;end
+
+$epsonlq850$
+begin;headlq850;declarations;speed;topmargin;typefacelq850;feed; 
+open;opendoch;initspeed;opendoclq850;openpage;close;closepage; 
+execute;cmdlq850;crs;move;stdmove;onoff;typeplq850;end
+
+$epsonlq1500$
+printerlq1500;end
+ 
+$oki390/391$
+begin;headoki390/391;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokieps;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end
+
+$oki393/393Ceps$
+begin;headoki393/393Ceps;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokieps;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end 
+ 
+$oki393/393Cibm$
+begin;headoki393/393Cibm;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokiibm;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokiibm;end 
+ 
+$toshp321$ 
+begin;headtoshp321;declarations;speed;feed; 
+open;opendochtosh;initspeed;opendoctosh;openpagetosh;close;closepagetosh; 
+execute;cmdtosh;crs;move;stdmove;onoff;typetosh;end 
+ 
+$starnb24$ 
+begin;headstarnb24;declarations;speed;topmargin;typefacestar;feedschacht; 
+open;opendoch;initspeed;opendocstar;openpage;close;closepage; 
+execute;cmdstar;crs;move;stdmove;onoff;typestar;end 
+ 
+$brotherm1724l$ 
+begin;headbrotherm1724l;declarations;speed;topmargin;feed; 
+open;opendoch;initspeed;opendocbrother;openpage;close;closepage; 
+execute;cmdtosh;crs;move;stdmove;onoff;typebrother;end 
+ 
+
+
diff --git a/system/printer-24nadel/0.9/src/fonttab.brother b/system/printer-24nadel/0.9/src/fonttab.brother
new file mode 100644
index 0000000..2251e18
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.brother
diff --git a/system/printer-24nadel/0.9/src/fonttab.epson.lq1500 b/system/printer-24nadel/0.9/src/fonttab.epson.lq1500
new file mode 100644
index 0000000..1b4c6a6
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.epson.lq1500
diff --git a/system/printer-24nadel/0.9/src/fonttab.epson.lq850 b/system/printer-24nadel/0.9/src/fonttab.epson.lq850
new file mode 100644
index 0000000..7a6d2f0
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.epson.lq850
diff --git a/system/printer-24nadel/0.9/src/fonttab.nec.p5 b/system/printer-24nadel/0.9/src/fonttab.nec.p5
new file mode 100644
index 0000000..9910da6
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.nec.p5
diff --git a/system/printer-24nadel/0.9/src/fonttab.nec.p5.new b/system/printer-24nadel/0.9/src/fonttab.nec.p5.new
new file mode 100644
index 0000000..9804bd5
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.nec.p5.new
diff --git a/system/printer-24nadel/0.9/src/fonttab.nec.p6+ b/system/printer-24nadel/0.9/src/fonttab.nec.p6+
new file mode 100644
index 0000000..b209e81
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.nec.p6+
diff --git a/system/printer-24nadel/0.9/src/fonttab.oki b/system/printer-24nadel/0.9/src/fonttab.oki
new file mode 100644
index 0000000..2251e18
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.oki
diff --git a/system/printer-24nadel/0.9/src/fonttab.toshiba.p321 b/system/printer-24nadel/0.9/src/fonttab.toshiba.p321
new file mode 100644
index 0000000..452afca
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/fonttab.toshiba.p321
diff --git a/system/printer-24nadel/0.9/src/inserter b/system/printer-24nadel/0.9/src/inserter
new file mode 100644
index 0000000..442075d
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/inserter
@@ -0,0 +1,793 @@
+ 
+(*************************************************************************) 
+(*   Installationsprogramm für                Stand   :  3. 1.89         *) 
+(*      24-Nadel Drucker                      Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+PACKET driver inst 24 
+ 
+ 
+       DEFINES treiber einrichten: 
+ 
+ 
+LET up = ""3""13""5"", 
+ 
+    generator name = "printer.24.nadel", 
+ 
+    description file name = "beschreibungen24", 
+    module file name = "module24"; 
+ 
+ 
+INT VAR pr channel, 
+        quality,
+        paper format number,
+        service option; 
+TEXT VAR fonttab name :: "", 
+         driver name :: ""; 
+TEXT VAR inp; 
+BOOL VAR was esc; 
+ 
+treiber einrichten 
+ 
+PROC treiber einrichten:
+
+  treiber einrichten (0)
+END PROC treiber einrichten;
+
+PROC treiber einrichten (INT CONST service opt): 
+ 
+  ask for print channel; 
+  main menu; 
+  IF installed 
+    THEN generate printer spool 
+    ELSE inform about restart 
+  FI. 
+ 
+  ask for printchannel: 
+    inits; 
+    page; 
+    headline ("Druckerkanal - Einstellung"); 
+    cursor (1, 15); 
+    putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); 
+    putline ("         'serverchannel (Kanalnummer)' in der Task """ + 
+             name (myself) + """"); 
+    putline ("         verändert werden."); 
+    REP 
+      cursor (1, 10);
+      put (""5"EUMEL-Kanalnummer des Druckerkanals:");
+      get (pr channel);
+      disable stop; 
+      serverchannel (pr channel);
+      BOOL VAR no error :: NOT is error; 
+      clear error; 
+      no error := no error CAND
+                  (pr channel <> channel (myself)) CAND  
+                  (pr channel > 1)                 CAND  
+                  (pr channel < 17); 
+      
+      IF NOT no error
+        THEN cursor (1, 7); 
+             put error;
+             putline ("Eingabe korrigiert wiederholen!") 
+      FI; 
+      enable stop 
+    UNTIL no error PER; 
+    IF exists task ("canal " + text (pr channel)) 
+      THEN end (/ ("canal " + text (pr channel))); 
+    FI; 
+ 
+. inits: 
+    line; 
+    IF single task 
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI; 
+    INT VAR choice;
+    service option := service opt.
+ 
+  single task:  (pcb (9) AND 255) = 1.
+ 
+  main menu: 
+    BOOL VAR installed :: FALSE; 
+    REP 
+      show main menu; 
+      get choice; 
+      treat choice 
+    UNTIL was esc OR installed PER. 
+ 
+  show main menu: 
+    page; 
+    headline("Hauptmenü 24-Nadel-Drucker"); 
+    putline (" 1. Brother");
+    putline (" 2. Epson");
+    putline (" 3. NEC"); 
+    putline (" 4. OKI");
+    putline (" 5. Toshiba").
+
+  get choice: 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Installation abbrechen"); 
+    ask user (5).
+ 
+  treat choice: 
+    SELECT int (inp) OF 
+      CASE 1: brother menu 
+      CASE 2: epson menu 
+      CASE 3: nec menu 
+      CASE 4: oki menu 
+      CASE 5: toshiba menu 
+    END SELECT. 
+ 
+  
+  brother menu: 
+    page;
+    headline ("brother - Menü"); 
+    putline (" 1. M-1724 L"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           brother m1724l inst
+    FI. 
+  
+    brother m1724l inst: 
+      putline ("brother M-1724 L"); 
+      line; 
+      putline ("Wählen Sie folgende DIP-Schalter Optionen:"); 
+      putline ("Emulationsmodus                IBM Proprinter XL ");
+      putline ("Automatischer Zeilenvorschub       Nein       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.brother"); 
+             generate ("brotherm1724l"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+  toshiba menu:
+    page;
+    headline ("TOSHIBA - Menü"); 
+    putline (" 1. P 321"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           toshiba p321 inst
+    FI. 
+  
+    toshiba p321 inst: 
+       putline ("TOSHIBA P 321"); 
+       putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+       putline ("S3-8  S3-7  S3-5  übrige Schalter"); 
+       putline ("OFF   OFF   *)    egal           "); 
+       putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+       show control options ("std speed, paper feed"); 
+       show material options("slow, fast"); 
+       show command options ("nlq, draft"); 
+       ask for quality; 
+       ask for papersize; 
+       IF all right 
+         THEN get fonttable ("fonttab.toshiba.p321"); 
+              generate ("toshp321"); 
+              adjust papersize; 
+              adjust quality; 
+              do ("papersize(21.0,30.48)"); 
+              installed := TRUE; 
+        FI. 
+ 
+  
+  epson menu: 
+    page; 
+    headline ("Epson - Menü"); 
+    putline (" 1. LQ 850"); 
+    putline (" 2. LQ 1050"); 
+    putline (" 3. LQ 1500"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (3); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1 : lq850 inst
+             CASE 2 : lq850 inst
+             CASE 3 : lq1500 inst
+           END SELECT
+    FI. 
+
+    lq850 inst:
+      IF choice = 1 
+         THEN putline ("Epson LQ 850")
+         ELSE putline ("Epson LQ 1050")
+      FI; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8");
+      putline ("egal  egal  egal  egal  egal  egal  *1)    OFF ");
+      putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line;
+      putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); 
+      putline ("egal  egal  *2)                     OFF   OFF");
+      putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); 
+      putline ("    gesetzt werden (Druckerhandbuch)");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq850"); 
+             generate ("epsonlq850"); 
+             adjust quality; 
+             adjust papersize; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+  lq1500 inst:
+      putline ("EPSON LQ-1500");
+      show control options ("");
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq1500"); 
+             generate ("epsonlq1500"); 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+  nec menu: 
+    page;
+    headline ("NEC - Menü"); 
+    putline (" 1. PINWRITER P5 "); 
+    putline (" 2. PINWRITER P6 "); 
+    putline (" 3. PINWRITER P7 "); 
+    putline (" 4. PINWRITER P6 PLUS"); 
+    putline (" 5. PINWRITER P7 PLUS"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (5); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : necp5p7 inst
+             CASE 2   : necp6 inst
+             CASE 3   : necp5p7 inst 
+             CASE 4   : necp6plus inst
+             CASE 5   : necp6plus inst
+           END SELECT
+    FI. 
+  
+     necp5p7 inst: 
+      IF choice = 1 
+         THEN putline ("NEC PINWRITER P5") 
+         ELSE putline ("NEC PINWRITER P7") 
+      FI; 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp5p7"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6 inst: 
+      putline ("NEC PINWRITER P6 "); 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp6"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6plus inst: 
+      IF choice = 4 
+         THEN putline ("NEC PINWRITER P6 PLUS") 
+         ELSE putline ("NEC PINWRITER P7 PLUS") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("CR FUNCTION             CR ONLY ");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, courier, souvenir"); 
+      show command options ("draft, nlq, courier, souvenir"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p6+"); 
+             generate ("necp6+"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE;
+             IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; 
+      FI. 
+ 
+  oki menu: 
+    page; 
+    headline ("OKI - Menü"); 
+    putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); 
+    putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); 
+    putline (" 3. MICROLINE 393/393C EPSON-kompatibel");                   
+    putline (" 4. MICROLINE 393/393C IBM-kompatibel");                     
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (4); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : oki ml390 inst                                 
+             CASE 2   : oki ml390 inst                                 
+             CASE 3   : oki ml393eps inst 
+             CASE 4   : oki ml393ibm inst 
+           END SELECT
+    FI. 
+ 
+    oki ml390 inst:
+      IF choice = 1
+        THEN putline ("OKI Microline 390") ;
+        ELSE putline ("OKI Microline 391") ;
+      FI;
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           EPSON LQ ");
+      putline ("AUTO LF                  NO       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki390/391"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+    oki ml393eps inst:
+      putline ("OKI Microline 393 EPSON-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki393/393Ceps"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+    oki ml393ibm inst:
+      putline ("OKI Microline 393 IBM-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           ASCII ");
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki");
+             generate ("oki393/393Cibm"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+ 
+ 
+generate printer spool: 
+   IF service opt = 0 
+      THEN forget (generator name, quiet); 
+           forget (driver name, quiet) 
+    FI;
+    eumel must advertise;
+    cursor (1, 10);
+(*  putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (2);
+    putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("         mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); 
+    putline ("         Drucker eingesetzt werden soll."); 
+    line (2); 
+*) 
+(*  put ("Generierung beendet, weiter mit 'SV'");
+    break (quiet);
+*) 
+    putline ("  Generierung beendet."); 
+    putline ("  Weiter: Bitte Taste drücken"); 
+    WHILE incharety <> "" REP ENDREP; 
+    REP UNTIL incharety <> "" ENDREP; 
+    break; 
+    do ("spool manager (PROC printer)").
+ 
+  inform about restart: 
+    page; 
+    putline ("Es ist kein Druckertreiber installiert worden!"); 
+    line; 
+    putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+    line; 
+    pause(50); 
+    break. 
+ 
+END PROC treiber einrichten; 
+ 
+PROC headline (TEXT CONST header): 
+ 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  put (header); 
+  line (2) 
+END PROC headline; 
+ 
+PROC ask user (INT CONST max choice): 
+ 
+  TEXT VAR exit; 
+  inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")  
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. 
+END PROC ask user;
+
+PROC show control options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); 
+  write ("papersize, std quality");
+  IF options <> "" 
+    THEN put (","); 
+         putline (options) 
+  FI
+END PROC show control options; 
+
+PROC show material options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche Materialwerte (#material(""..."")#):"); 
+  putline (options) 
+END PROC show material options; 
+ 
+PROC show command options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); 
+  putline (options) 
+END PROC show command options; 
+ 
+PROC ask for quality: 
+ 
+  line (1); 
+  putline ("Standard - Druckqualität:"); 
+  line; 
+  REP out (up); 
+    IF yes ("Draft Quality (schneller, aber nicht so schön)") 
+      THEN quality := 1; LEAVE ask for quality 
+    FI;
+    out (up);
+    IF yes ("Near Letter Quality (schöner, aber langsamer)")
+      THEN quality := 2; LEAVE ask for quality 
+    FI;
+  PER 
+END PROC ask for quality; 
+ 
+PROC adjust quality: 
+ 
+  IF quality = 1 
+    THEN do ("std quality (""draft"")") 
+    ELSE do ("std quality (""nlq"")") 
+  FI 
+END PROC adjust quality; 
+ 
+PROC ask for papersize : 
+LET up           = ""3""13""5"";
+ 
+  paper format number := paper format ; 
+ 
+    . paper format :
+        line (1); 
+        putline ("Papierformat:"); 
+        line;
+        REP out (up);
+            IF yes ("Endlospapier, 8 Zoll breit")
+               THEN LEAVE paper format WITH 1 FI;
+            out (up);
+            IF yes ("Endlospapier, 13.2 Zoll breit")
+               THEN LEAVE paper format WITH 2 FI;
+            out (up);
+            IF yes ("Einzelblatteinzug, DINA 4")
+               THEN LEAVE paper format WITH 3 FI;
+        PER;
+        0
+END PROC ask for papersize;
+ 
+ 
+PROC adjust papersize: 
+ 
+    SELECT paper format number OF 
+      CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 3 : do("papersize (21.0, 29.7)");
+               do ("paper feed (""sheet"")") 
+    END SELECT
+ 
+END PROC adjust papersize; 
+ 
+BOOL PROC all right: 
+ 
+  line (3);
+  cursor (1,23); 
+  yes ("Soll der ausgewählte Druckertreiber installiert werden") 
+END PROC all right; 
+ 
+PROC get fonttable (TEXT CONST name): 
+ 
+  fonttab name := name; 
+  from archive ((description file name & module file name & fonttab name) 
+                                                                    - all); 
+  fonttable (fonttab name); 
+  command dialogue (FALSE); 
+  save (fonttab name, /"configurator"); 
+  IF service option = 0 
+    THEN forget (fonttab name) 
+  FI; 
+  command dialogue (TRUE); 
+END PROC get fonttable; 
+ 
+PROC from archive (THESAURUS CONST files):
+ 
+  IF highest entry (files) > 0 
+    THEN fetch from archive; 
+         release (archive);
+         putline ("Archiv abgemeldet !")
+  FI.
+ 
+  fetch from archive: 
+    THESAURUS VAR thes :: files; 
+    REP 
+      ask for archive;
+      reserve archive;
+      fetch (thes / ALL archive, archive);
+      thes := thes - all 
+    UNTIL highest entry (thes) = 0 PER.
+
+ask for archive:
+  TEXT VAR buffer;
+(*line;
+  putline ("Bitte Archiv mit den Dateien"); 
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  line; 
+  putline ("Wenn eingelegt: Taste drücken !"); 
+  inchar (buffer)*). 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  disable stop;
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI;
+  enable stop.
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+ 
+PROC generate (TEXT CONST name): 
+ 
+  open files; 
+  read description; 
+  build programme; 
+  insert programme; 
+  forget files. 
+ 
+  open files: 
+    line (5); 
+    cursor (1, 20); 
+    putline (""4"Bitte warten !"); 
+    putline ("    - Der Treiber wird generiert."); 
+    driver name := "printer." + name + "(generiert)"; 
+    IF exists (driver name) 
+      THEN forget (driver name, quiet) 
+    FI; 
+    FILE VAR des file :: sequential file (modify, description file name), 
+             mod file :: sequential file (modify, module file name), 
+             driver file :: sequential file (output, driver name). 
+ 
+  read description: 
+    to line (des file, 1); 
+    col (des file, 1);
+    downety (des file, "$" + name + "$"); 
+    IF eof (des file) 
+      THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + 
+                      "Descriptions-File enthalten")
+    FI; 
+    TEXT VAR description :: "", 
+             record; 
+    BOOL VAR done :: FALSE; 
+    read record (des file, record); 
+    record := subtext (record, col (des file) + LENGTH name + 2);
+    WHILE NOT eof (des file) AND NOT done REP 
+      treat record
+    PER. 
+ 
+  treat record: 
+    INT VAR dollar pos :: pos (record, "$"); 
+    IF dollar pos = 0
+      THEN description CAT compress (record); 
+           down (des file); 
+           read record (des file, record)  
+      ELSE description CAT compress (subtext (record, 1, dollar pos - 1));
+           col (des file, dollar pos); 
+           done := TRUE; 
+    FI. 
+ 
+  build programme: 
+    get module name; 
+    WHILE still modules REP 
+      find module; 
+      transfer module; 
+      get module name 
+    PER. 
+ 
+  get module name: 
+    INT VAR semicol pos :: pos (description, ";"); 
+    TEXT VAR module name; 
+    IF semicol pos > 0 
+      THEN module name := subtext (description, 1, semicol pos - 1); 
+           description := subtext (description, semicol pos + 1) 
+      ELSE module name := description; 
+           description := "" 
+    FI.
+ 
+  still modules: 
+    module name <> "" OR description <> "". 
+ 
+  find module: 
+    to line (mod file, 1); 
+    col (mod file, 1); 
+    downety (mod file, "$" + module name + "$"); 
+    IF eof (mod file) 
+      THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + 
+                      "Modul-File enthalten")
+    FI. 
+ 
+  transfer module: 
+    done := FALSE; 
+    read record (mod file, record); 
+    record := subtext (record, col (mod file) + LENGTH module name + 2);
+    WHILE NOT eof (mod file) AND NOT done REP 
+      transfer record
+    PER. 
+ 
+  transfer record: 
+    dollar pos := pos (record, "$"); 
+    IF dollar pos = 0
+      THEN write (driver file, compress (record)); 
+           line (driver file);
+           down (mod file); 
+           read record (mod file, record)  
+      ELSE write (driver file, compress (subtext (record, 1, 
+                                            dollar pos - 1)));
+           col (mod file, dollar pos); 
+           done := TRUE; 
+           cout (line no (mod file)) 
+    FI. 
+ 
+  insert programme: 
+    IF online 
+      THEN putline ("    - Der Treiber wird insertiert.") 
+    FI;
+    check off; 
+    insert (driver name). 
+ 
+  forget files: 
+    IF service option = 0 
+      THEN forget (description file name, quiet); 
+           forget (module file name, quiet)
+    FI  .
+END PROC generate; 
+ 
+END PACKET driver inst 24
+
diff --git a/system/printer-24nadel/0.9/src/module24 b/system/printer-24nadel/0.9/src/module24
new file mode 100644
index 0000000..a4957c2
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/module24
@@ -0,0 +1,1554 @@
+
+(*************************************************************************) 
+(*                                            Stand   : 03. 1.89         *) 
+(*   Module-Datei für 24-Nadel-Drucker        Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+$begin$ 
+PACKET printer driver 
+ 
+       DEFINES printer,
+               open,
+               close,
+               execute,
+               paper size,
+               std quality,
+
+$headnecp6$    paper feed:
+(* Treiber fuer NEC P6, automatisch generiert *)
+LET underline linetype = 1; 
+INT VAR factor 1, factor 2, draft factor 1, draft factor 2;
+
+$headnecp5p7$  paper feed:
+(* Treiber fuer NEC P5, P7 , automatisch generiert *)
+LET underline linetype = 1; 
+INT VAR factor 1, factor 2, draft factor 1, draft factor 2;
+
+$headnecp6+$   std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für NEC P6 plus/P7 plus ,automatisch generiert *) 
+ 
+
+$headlq850$    std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für EPSON LQ-850/1050 ,automatisch generiert *) 
+ 
+$headbrotherm1724l$ 
+               std speed, 
+               top margin, 
+               paper feed: 
+INT VAR vertical factor := 1; 
+(* Treiber für BROTHER M-1724L in IBM-Emulation, automatisch generiert *) 
+ 
+$headoki390/391$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 390/391  ,automatisch generiert *) 
+ 
+$headoki393/393Ceps$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 393/393C EPSON-kompatibel, automatisch generiert *) 
+ 
+$headoki393/393Cibm$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 393/393C IBM-kompatibel, automatisch generiert *) 
+ 
+$headtoshp321$   std speed, 
+                 paper feed: 
+(* Treiber für TOSHIBA P321, automatisch generiert *) 
+ 
+$headstarnb24$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für STAR NB 24-10/15 in Standard Betriebsart automatisch generiert *) 
+ 
+$declarations$
+INT VAR font nr, font bits, modification bits, 
+        blankbreite, x rest, high, low, steps;
+REAL VAR x size, y size;
+TEXT VAR buffer :: "";
+BOOL VAR is nlq ;
+TEXT VAR font text :: "";
+TEXT VAR std quality name :: "draft";
+ 
+. is pica  : font bits = 0
+. is elite : font bits = 1
+.;
+
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+END PROC paper size;
+ 
+papersize (20.32, 30.48); 
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+END PROC paper size;
+ 
+ 
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality
+     ELSE errorstop ("unzulässige Qualitätsbezeichnung")
+  FI
+END PROC std quality;
+ 
+TEXT PROC std quality : 
+ 
+  std quality name 
+END PROC std quality;
+                        
+ 
+$topmargin$ 
+REAL VAR  y margin := 0.0 ;
+ 
+PROC top margin (REAL CONST margin): 
+ 
+  y margin := margin 
+END PROC top margin; 
+ 
+REAL PROC top margin: 
+ 
+  y margin 
+END PROC top margin;
+ 
+ 
+$speed$
+BOOL VAR is slow :: TRUE; 
+TEXT VAR std speed name :: "slow";
+ 
+PROC std speed (TEXT CONST speed) :
+ 
+  IF speed = "fast" OR speed = "slow"
+     THEN std speed name := speed
+     ELSE errorstop ("unzulässige Geschwindigkeit")
+  FI
+END PROC std speed;
+ 
+TEXT PROC std speed : 
+ 
+std speed name 
+END PROC std speed;
+ 
+ 
+$typefacelq850$ 
+TEXT VAR act typeface name :: "";
+TEXT VAR std typeface name :: "";
+ 
+. is roman: 
+  act typeface name = "roman". 
+. is sansserif: 
+  act typeface name = "sansserif"
+.; 
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "roman" OR typeface = "sansserif"
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+ 
+ 
+$typefacep6+$ 
+BOOL VAR is courier :: TRUE; 
+TEXT VAR std typeface name :: "courier";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "courier" OR typeface = "souvenir" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$typefaceoki$ 
+BOOL VAR is courier ; 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "courier" OR typeface = "kassette" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$typefacestar$ 
+BOOL VAR is roman ; 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "roman" OR typeface = "font1" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$feed$ 
+BOOL VAR is sheet feed :: FALSE;
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "sheet"
+    THEN is sheet feed := TRUE 
+  ELIF feeder = "tractor" 
+    THEN is sheet feed := FALSE 
+    ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: 
+  IF is sheet feed
+    THEN "sheet" 
+    ELSE "tractor" 
+  FI 
+END PROC paper feed;
+ 
+$feedschacht$
+BOOL VAR is sheet feed :: FALSE;
+TEXT VAR feeder name :: "tractor";
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "tractor" 
+     THEN feeder name := "tractor"; 
+          is sheet feed := FALSE
+  ELIF feeder = "sheet" OR feeder = "schacht1" 
+     THEN feeder name := "schacht1" ; 
+          is sheet feed := TRUE
+  ELIF feeder = "schacht2" 
+     THEN feeder name := "schacht2" ; 
+          is sheet feed := TRUE 
+     ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: feeder name END PROC paper feed;
+ 
+$open$
+PROC open (INT CONST op code, INT VAR param1, param2):
+ 
+  SELECT op code OF
+    CASE 1: open document(param1,param2)
+    CASE 2: open page    (param1,param2)
+  END SELECT. 
+END PROC open ; 
+ 
+ 
+$opendoch$
+PROC open document (INT VAR x steps,y steps): 
+    modification bits := 0; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 30) * 30;
+ 
+$opendochtosh$
+PROC open document (INT VAR x steps,y steps): 
+    modification bits := 0; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 36) * 36;
+ 
+$initspeed$ 
+    IF pos (material, "slow") <> 0 
+         THEN is slow := TRUE;
+    ELIF pos (material, "fast") <> 0 
+         THEN is slow := FALSE;
+         ELSE is slow := std speed name = "slow"
+    FI;
+ 
+$opendocp6+$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein             *)
+    FI;
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "souvenir") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ;
+ 
+$opendocp5p7$ 
+    out (""24""27""64"");                  (* Reset des Druckers         *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
+    out (""27"x"0"");                      (* Entwurfsqualität           *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein             *)
+            center paper ;
+    FI;
+ 
+    . center paper :
+        INT CONST x steps in chars := x steps DIV x step conversion (2.54 / 10.0),
+                  left margin      := (136 - x steps in chars) DIV 2;
+        out (""27"P");
+        out (""27"l"); out (code (left margin + 1));
+END PROC open document ;
+
+$opendocp6$ 
+    out (""24""27""64"");                  (* Reset des Druckers         *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
+    out (""27"x"0"");                      (* Entwurfsqualität           *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein              *)
+    FI;
+END PROC open document ;
+
+$opendoclq850$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN out (""27""25"4");                       (* Sheetmode ein    *)
+    FI;
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "roman") <> 0 
+      THEN act typeface name := "roman" 
+    ELIF pos (material, "sansserif") <> 0 
+      THEN act typeface name := "sansserif" 
+      ELSE act typeface name := std typeface name  
+    FI; 
+END PROC open document ; 
+ 
+$opendocokieps$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "kassette") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ; 
+ 
+$opendoctosh$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6");                              (* Zeichensatz *) 
+    out (""27"A"12""27"2") ;
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+END PROC open document ; 
+ 
+$opendocbrother$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6" + ""27"R"0"");                (* Zeichensatz II ascii *) 
+    out (""27"A"10""27"2") ;                    (* Zeilenabstand *)
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    IF is sheet feed
+       THEN out (""27""25"4")  
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+END PROC open document ; 
+ 
+$opendocokiibm$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6" + ""27"!"64"");                (* Zeichensatz II ascii *) 
+    out (""27""91""92""4""0""0""0""180"");      (* 1/180 *)
+    out (""27"A"12""27"2") ;                    (* Zeilenabstand *)
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "kassette") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ; 
+ 
+$opendocstar$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"R"0"");                  (* amerikanischer Zeichensatz *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "roman") <> 0 
+      THEN is roman := TRUE ; 
+    ELIF pos (material, "font1") <> 0 
+      THEN is roman := FALSE ; 
+      ELSE is roman := std typeface name = "roman" 
+    FI; 
+END PROC open document ; 
+ 
+$openpagetosh$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0;
+    IF is sheet feed
+       THEN y start := y step conversion (2.54)    (* 1 Inch *)
+       ELSE y start := 0;
+    FI;
+    x rest  := 0;
+    out (""13"");
+END PROC open page; 
+ 
+$openpage$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0 ; 
+    y start := y step conversion (y margin) ; 
+    x rest := 0; 
+    out (""13""). 
+END PROC open page; 
+ 
+$openpagep5-7$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0;
+    IF is sheet feed
+       THEN y start := y step conversion (8.466667e-1)    (* 2/6 Inch *)
+       ELSE y start := 0;
+    FI;
+    x rest  := 0;
+    out (""13"");
+END PROC open page; 
+ 
+$close$
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+  SELECT op code OF
+    CASE 1: close document 
+    CASE 2: close page (param1)
+  END SELECT.
+ 
+close document : 
+. 
+END PROC close ; 
+ 
+$closepage$ 
+PROC close page (INT CONST remaining y steps) : 
+    IF remaining y steps > 0
+       THEN out (""12"")
+    ELIF is sheet feed
+       THEN out (""27""25"R")
+    FI;
+END PROC close page;
+
+$closepagetosh$ 
+PROC close page (INT CONST remaining y steps) : 
+    IF   is sheet feed
+         THEN out (""12"")
+    ELIF remaining y steps > 0
+         THEN out (""12"")
+    FI;
+END PROC close page;
+
+$execute$
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE 1:  write text
+  CASE 2:  write cmd
+  CASE 3:  carriage return
+  CASE 4:  move
+  CASE 5:  draw
+  CASE 6:  on
+  CASE 7:  off
+  CASE 8:  type
+END SELECT.
+
+from : param1. 
+to   : param2. 
+ 
+  write text :
+    out subtext (string, from, to).
+ 
+$cmdp6+$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "courier"
+      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
+    ELIF buffer = "souvenir"
+      THEN IF is courier THEN is courier := FALSE; switch to souvenir FI;
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdp5-7$ 
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+         THEN IF NOT is nlq THEN switch to nlq FI;
+              is nlq := TRUE;
+    ELIF buffer = "draft"
+         THEN IF     is nlq THEN switch to draft FI;
+              is nlq := FALSE;
+         ELSE out (buffer);
+    FI;.
+ 
+$cmdlq850$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "roman"
+      THEN IF NOT is roman THEN act typeface name := "roman" ; 
+                                switch to roman FI;
+    ELIF buffer = "sansserif"
+      THEN IF NOT is sansserif THEN act typeface name := "sansserif"; 
+                                    switch to sansserif FI;
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdoki$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "courier"
+      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
+    ELIF buffer = "kassette"
+      THEN IF is courier THEN is courier := FALSE; switch to kassette FI;
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdtosh$ 
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE;  switch to draft FI;
+      ELSE out (buffer);
+    FI;.
+ 
+$cmdstar$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "roman"
+      THEN IF NOT is roman THEN is roman := TRUE; switch to roman FI;
+    ELIF buffer = "font1"
+      THEN IF is roman THEN is roman := FALSE; switch to font1 FI;
+    FI. 
+ 
+$crs$
+  carriage return :
+    x rest := 0;
+    out (""13"").
+ 
+$move$ 
+x steps : param1.
+y steps : param2.
+
+move :
+  IF x steps < 0 OR y steps < 0 THEN stop FI; 
+  IF x steps > 0 THEN x move FI; 
+  IF y steps > 0 THEN y move FI. 
+
+$stdmove$ 
+x move : 
+  x rest INCR x steps;
+  high   := (x rest) DIV blankbreite;
+  x rest := (x rest) MOD blankbreite; 
+  steps := x rest DIV 3;
+  IF high   > 0 THEN high TIMESOUT " " FI;
+  IF steps > 0 AND is slow
+     THEN IF is underline THEN out (" "8"") FI;
+          out (""27"Y" + code (steps) + ""0"");  (* 1/360 *)
+          steps TIMESOUT ""0"";
+          x rest := x rest MOD 3
+  FI. 
+ 
+is underline: 
+  bit (modification bits,7). 
+ 
+y move : 
+  IF y steps > 0
+     THEN high := y steps DIV 255;
+          low  := y steps MOD 255;
+          IF high > 0 THEN high TIMESOUT ""27"J"255"" FI;   (* 1/180 *)
+          IF low  > 0 THEN out (""27"J" + code (low)) FI;
+  FI. 
+ 
+draw :
+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 
+    THEN stop
+  ELIF x steps > 0
+    THEN x draw
+  FI. 
+ 
+x draw : 
+  x rest INCR x steps ; 
+  steps := x steps DIV 3 ; 
+  IF steps > 0 THEN 
+    x rest := x steps MOD 3 ; 
+    out (""27"Y");
+    out (code (steps MOD 256));
+    out (code (steps DIV 256));
+    steps TIMESOUT ""1""; 
+  FI.
+ 
+$movep5-7$ 
+      x move :
+        x rest INCR x steps; 
+        IF not is underline
+           THEN simple x move
+           ELSE underline x move
+        FI;
+
+        . not is underline :
+            NOT bit (modification bits, 7)
+ 
+        . simple x move :
+            high   := x rest DIV factor 1;
+            x rest := x rest MOD factor 1;
+            out (""27"\");
+            out (code (high MOD 256));
+            out (code (high DIV 256));
+ 
+        . underline x move :
+            high   := x rest DIV factor 2;
+            x rest := x rest MOD factor 2;
+            IF high < blankbreite
+               THEN stop
+               ELSE low  := high MOD 127;
+                    high := high DIV 127;
+                    IF low >= blankbreite
+                       THEN low  DECR blankbreite;
+                       ELSE high DECR 1;
+                            low  DECR (blankbreite - 127);
+                    FI;
+                    IF high > 0 
+                       THEN out (""27" ");
+                            out (code (127 - blankbreite));
+                            high TIMESOUT " ";
+                    FI;
+                    out (""27" ");
+                    out (code (low)); 
+                    out (" "27" "0"");
+            FI;
+. y move:
+
+  low  := y steps MOD 255;
+  high := y steps DIV 255;
+  IF high > 0 THEN high TIMESOUT (""27"J"255"") FI;
+  IF low  > 0 THEN out (""27"J" + code (low))   FI;
+ 
+. draw :
+    IF   x steps < 0 OR y steps <> 0 
+         THEN stop
+    ELIF x steps > 0
+         THEN x draw
+    FI;
+ 
+    . x draw :
+        x rest INCR x steps;
+        steps  := x rest DIV 4;
+        x rest := x rest MOD 4;
+        IF steps > 0
+           THEN low  := steps MOD 256;
+                high := steps DIV 256;
+                out (""27"*"39"");
+                out (code (low));
+                out (code (high));
+                steps TIMESOUT dot;
+        FI;
+
+        . dot :
+            IF linetype = underline linetype
+               THEN ""000""000""001""
+               ELSE ""000""000""048""
+            FI. 
+ 
+ 
+$onoff$ 
+  modification : param1
+.
+  on :
+    buffer := on string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits OR code (buffer);
+            switch to font;
+       ELSE stop
+    FI
+ 
+.
+  off :
+    buffer := off string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits XOR code (buffer);
+            switch to font;
+       ELSE stop
+    FI.
+ 
+$typep6+$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to souvenir 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to souvenir : 
+    out (""27"k"15"") ; 
+END PROC execute;
+ 
+$typeplq850$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is roman 
+      THEN switch to roman 
+      ELSE switch to sansserif 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to roman : 
+    out (""27"k"0"") ; 
+
+. switch to sansserif : 
+    out (""27"k"1"") ; 
+END PROC execute;
+ 
+$typeokieps$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    vertical factor := code (buffer SUB 1); 
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to kassette 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    IF vertical factor = 2 
+      THEN out (""27"w"1"") 
+      ELSE out (""27"w"0"") 
+    FI; 
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to kassette : 
+    out (""27"k"127"") ; 
+END PROC execute;
+ 
+$typep5-7$ 
+  type :
+    font nr     := param1;
+    buffer      := font string (font nr);
+    factor 1    := code (buffer SUB 1);  (* 720 / Mikroschritte pro Inch mit ESC \ *)
+    factor 2    := code (buffer SUB 2);  (* 720 / Mikroschritte pro Inch mit ESC Blank *)
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") DIV factor 2; 
+    switch to font;
+    IF is nlq THEN switch to nlq FI;
+ 
+END PROC execute;
+ 
+ 
+PROC switch to font :
+ 
+  out (""27"!");
+  out (code (font bits OR modification bits));
+  out (font text);
+ 
+END PROC switch to font;
+ 
+ 
+PROC switch to nlq :
+ 
+  IF is pica OR is elite
+     THEN draft factor 1 := factor 1;
+          factor 1       := 4;
+          draft factor 2 := factor 2; 
+          IF is pica
+             THEN factor 2    := 4 * factor 2 DIV 6;
+                  blankbreite := char pitch (font nr, " ") DIV factor 2;
+          FI;
+          out (""27"x"1"");
+     ELSE out (""27"x"0"");
+  FI;
+ 
+END PROC switch to nlq;
+ 
+ 
+PROC switch to draft :
+ 
+  IF is pica OR is elite
+     THEN factor 1 := draft factor 1;
+          factor 2 := draft factor 2;
+          out (""27"x"0"");
+  FI;
+ 
+END PROC switch to draft;
+
+$typetosh$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN
+       ELSE
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    out (font text);
+ 
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"1"");
+ 
+END PROC execute;
+ 
+$typeokiibm$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    vertical factor := code (buffer SUB 1); 
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to kassette 
+    FI ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN  out(""27"%G")
+       ELSE  out(""27"%H")
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    IF vertical factor = 2 
+      THEN out (""27""91""64""4""0""0""0""2""0"") 
+      ELSE out (""27""91""64""4""0""0""0""1""0"") 
+    FI; 
+    out (font text);
+ 
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to kassette : 
+    out (""27"k"127"") ; 
+END PROC execute;
+ 
+$typebrother$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    vertical factor := code (buffer SUB 1); 
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN
+       ELSE
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    IF vertical factor = 2 
+      THEN out (""27""91""64""4""0""0""0""2""0"") 
+      ELSE out (""27""91""64""4""0""0""0""1""0"") 
+    FI; 
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"0"");
+ 
+END PROC execute;
+ 
+$typestar$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is roman 
+      THEN switch to roman 
+      ELSE switch to font1 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to roman : 
+    out (""27"k"0"") ; 
+
+. switch to font1 : 
+    out (""27"k"1"") ; 
+END PROC execute;
+ 
+ 
+
+$printerlq1500$ 
+PACKET printer driver
+ 
+(**************************************************************************)
+(*                                                Stand   : 29.07.86      *)
+(*   EPSON   LQ-1500                              Version : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(*   geändert am 15.12.88 hjh                                             *)
+(**************************************************************************)
+ 
+       DEFINES printer,
+               open,
+               close,
+               execute,
+ 
+               paper size,
+               std quality:
+ 
+LET
+(*  underline           =  1,
+    bold                =  2,
+    italics             =  4,
+    reverse             =  8, *)
+ 
+    underline linetype  =  1,
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8;
+ 
+INT VAR rest, high, low, factor;
+BOOL VAR is nlq, factor was 6, condensed;
+REAL VAR x size, y size;
+TEXT VAR std quality name, buffer;
+ 
+(*********************************************************************)
+ 
+paper size  (13.6 * 2.54, 12.0 * 2.54);
+std quality ("draft");
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality;
+     ELSE errorstop ("unzulaessige Betriebsart")
+  FI;
+ 
+END PROC std quality;
+ 
+TEXT PROC std quality : std quality name END PROC std quality;
+ 
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    factor       := 0;
+    factor was 6 := FALSE;
+    condensed    := FALSE; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 30) * 30;
+    out (""27""64"");                      (* Reset des Druckers             *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                 *)
+    out (""27"x"0"");                      (* Entwurfsqualität               *) 
+ 
+ 
+. x start : param1
+. y start : param2
+. 
+  open page :
+    x start := 0;
+    y start := 0;
+    rest    := 0;
+    out (""13"");
+ 
+END PROC open;
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+END SELECT; 
+ 
+. 
+  close document :
+ 
+ 
+. remaining y steps : param1
+.
+  close page :
+    IF remaining y steps > 0 THEN out (""12"") FI
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    out subtext (string, from, to)
+ 
+.
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+         THEN is nlq := TRUE;
+              near letter quality;
+    ELIF buffer = "draft"
+         THEN is nlq := FALSE;
+              draft quality;
+         ELSE out (buffer);
+    FI;
+ 
+    . near letter quality :
+        IF factor = 6
+           THEN factor was 6 := TRUE;
+                factor       := 4; 
+           ELSE factor was 6 := FALSE;
+        FI;
+        IF condensed
+           THEN out (""27"x"0"")
+           ELSE out (""27"x"1"") 
+        FI;
+ 
+    . draft quality :
+        IF factor was 6
+           THEN factor was 6 := FALSE;
+                factor       := 6; 
+        FI;
+        out (""27"x"0"");
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    rest := 0;
+    out (""13"");
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF   x steps < 0 OR y steps < 0
+         THEN stop
+    ELIF x steps > 0
+         THEN x move
+    ELIF y steps > 0
+         THEN y move
+    FI;
+ 
+    . x move :
+        high := (x steps + rest) DIV factor;
+        rest := (x steps + rest) MOD factor;
+        out (""27"\");
+        out (code (high MOD 256));
+        out (code (high DIV 256));
+ 
+    . y move :
+        high := y steps DIV 255;
+        low  := y steps MOD 255;
+        IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;
+        IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
+ 
+. 
+  draw :
+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype
+         THEN stop
+    ELIF x steps > 0
+         THEN x draw
+    FI;
+ 
+    . x draw :
+        high := (x steps + rest) DIV 6;
+        rest := (x steps + rest) MOD 6;
+        IF high > 0
+           THEN low  := high MOD 255;
+                high := high DIV 255;
+                out (""27"V");
+                out (code (low));
+                out (""27"*"1""1""0""1""27"V"0"");
+                FOR low FROM 1 UPTO high
+                    REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; 
+        FI;
+ 
+ 
+. modification : param1
+.
+  on :
+    IF on string (modification) <> "" 
+       THEN out (on string (modification))
+       ELSE stop
+    FI
+ 
+.
+  off :
+    IF off string (modification) <> ""
+       THEN out (off string (modification))
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    buffer := font string (font nr);
+    out (buffer);
+    factor := pitch factor;
+    IF is nlq THEN near letter quality FI;
+ 
+    . pitch factor :                           (*             Mikroschritt *)
+        INT CONST font bits := code (buffer SUB 3);
+        IF   bit (font bits, 1) 
+             THEN condensed := FALSE;       2  (* proportional  1/360 Inch *)
+        ELIF pos (buffer, ""27"x"1"") <> 0
+             THEN condensed := FALSE;       4  (* near letter   1/180 Inch *)
+        ELIF bit (font bits, 2) 
+             THEN condensed := TRUE;        3  (* condensed     1/240 Inch *)
+        ELIF bit (font bits, 0) 
+             THEN condensed := FALSE;       4  (* elite         1/180 Inch *)
+             ELSE condensed := FALSE;       6  (* pica          1/120 Inch *)
+        FI
+ 
+END PROC execute;
+
+
+$end$
+INT VAR reply; DATASPACE VAR ds; FILE VAR file;
+ 
+PROC printer:
+ 
+  disable stop;
+  continue (server channel);
+  check error (error message);
+  ds := nilspace;
+  REP forget (ds);
+      execute print;
+      IF is error AND online THEN put error; clear error; FI;
+  PER;
+END PROC printer;
+ 
+PROC execute print:
+ 
+  LET ack = 0, fetch code = 11, file type = 1003;
+  enable stop;
+  ds := nilspace;
+  call (father, fetch code, ds, reply);
+  IF reply = ack CAND type (ds) = file type
+     THEN file := sequential file (input, ds);
+          print (file,
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+  FI;
+END PROC execute print;
+ 
+PROC check error(TEXT CONST message):
+ 
+  IF is error
+     THEN clear error; rename myself (message);
+          IF is error THEN end(myself) FI;
+          pause (9000); end(myself);
+  FI;
+END PROC check error;
+ 
+END PACKET printerdriver
+
+
diff --git a/system/printer-24nadel/0.9/src/printer.24.nadel b/system/printer-24nadel/0.9/src/printer.24.nadel
new file mode 100644
index 0000000..579f67f
--- /dev/null
+++ b/system/printer-24nadel/0.9/src/printer.24.nadel
@@ -0,0 +1,776 @@
+ 
+(*************************************************************************) 
+(*   Installationsprogramm für                Stand   :  3. 1.89         *) 
+(*      24-Nadel Drucker                      Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+PACKET driver inst 24 
+ 
+ 
+       DEFINES treiber einrichten: 
+ 
+ 
+LET up = ""3""13""5"", 
+ 
+    generator name = "printer.24.nadel", 
+ 
+    description file name = "beschreibungen24", 
+    module file name = "module24"; 
+ 
+ 
+INT VAR pr channel, 
+        quality,
+        paper format number,
+        service option; 
+TEXT VAR fonttab name :: "", 
+         driver name :: ""; 
+TEXT VAR inp; 
+BOOL VAR was esc; 
+ 
+treiber einrichten 
+ 
+PROC treiber einrichten:
+
+  treiber einrichten (0)
+END PROC treiber einrichten;
+
+PROC treiber einrichten (INT CONST service opt): 
+ 
+  ask for print channel; 
+  main menu; 
+  IF installed 
+    THEN generate printer spool 
+    ELSE inform about restart 
+  FI. 
+ 
+  ask for printchannel: 
+    inits; 
+    page; 
+    headline ("Druckerkanal - Einstellung"); 
+    cursor (1, 15); 
+    putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); 
+    putline ("         'serverchannel (Kanalnummer)' in der Task """ + 
+             name (myself) + """"); 
+    putline ("         verändert werden."); 
+    REP 
+      cursor (1, 10);
+      put (""5"EUMEL-Kanalnummer des Druckerkanals:");
+      get (pr channel);
+      disable stop; 
+      serverchannel (pr channel);
+      BOOL VAR no error :: NOT is error; 
+      IF is error 
+        THEN cursor (1, 7); 
+             put error;
+             putline ("Eingabe korrigiert wiederholen!") 
+      FI; 
+      clear error; 
+      enable stop 
+    UNTIL no error PER. 
+ 
+  inits: 
+    line; 
+    IF single task 
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI; 
+    INT VAR choice;
+    service option := service opt.
+ 
+  single task:  (pcb (9) AND 255) = 1.
+ 
+  main menu: 
+    BOOL VAR installed :: FALSE; 
+    REP 
+      show main menu; 
+      get choice; 
+      treat choice 
+    UNTIL was esc OR installed PER. 
+ 
+  show main menu: 
+    page; 
+    headline("Hauptmenü 24-Nadel-Drucker"); 
+    putline (" 1. Brother");
+    putline (" 2. Epson");
+    putline (" 3. NEC"); 
+    putline (" 4. OKI");
+    putline (" 5. Toshiba").
+
+  get choice: 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Installation abbrechen"); 
+    ask user (5).
+ 
+  treat choice: 
+    SELECT int (inp) OF 
+      CASE 1: brother menu 
+      CASE 2: epson menu 
+      CASE 3: nec menu 
+      CASE 4: oki menu 
+      CASE 5: toshiba menu 
+    END SELECT. 
+ 
+  
+  brother menu: 
+    page;
+    headline ("brother - Menü"); 
+    putline (" 1. M-1724 L"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           brother m1724l inst
+    FI. 
+  
+    brother m1724l inst: 
+      putline ("brother M-1724 L"); 
+      line; 
+      putline ("Wählen Sie folgende DIP-Schalter Optionen:"); 
+      putline ("Emulationsmodus                IBM Proprinter XL ");
+      putline ("Automatischer Zeilenvorschub       Nein       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.brother"); 
+             generate ("brotherm1724l"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+  toshiba menu:
+    page;
+    headline ("TOSHIBA - Menü"); 
+    putline (" 1. P 321"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           toshiba p321 inst
+    FI. 
+  
+    toshiba p321 inst: 
+       putline ("TOSHIBA P 321"); 
+       putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+       putline ("S3-8  S3-7  S3-5  übrige Schalter"); 
+       putline ("OFF   OFF   *)    egal           "); 
+       putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+       show control options ("std speed, paper feed"); 
+       show material options("slow, fast"); 
+       show command options ("nlq, draft"); 
+       ask for quality; 
+       ask for papersize; 
+       IF all right 
+         THEN get fonttable ("fonttab.toshiba.p321"); 
+              generate ("toshp321"); 
+              adjust papersize; 
+              adjust quality; 
+              do ("papersize(21.0,30.48)"); 
+              installed := TRUE; 
+        FI. 
+ 
+  
+  epson menu: 
+    page; 
+    headline ("Epson - Menü"); 
+    putline (" 1. LQ 850"); 
+    putline (" 2. LQ 1050"); 
+    putline (" 3. LQ 1500"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (3); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1 : lq850 inst
+             CASE 2 : lq850 inst
+             CASE 3 : lq1500 inst
+           END SELECT
+    FI. 
+
+    lq850 inst:
+      IF choice = 1 
+         THEN putline ("Epson LQ 850")
+         ELSE putline ("Epson LQ 1050")
+      FI; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8");
+      putline ("egal  egal  egal  egal  egal  egal  *1)    OFF ");
+      putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line;
+      putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); 
+      putline ("egal  egal  *2)                     OFF   OFF");
+      putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); 
+      putline ("    gesetzt werden (Druckerhandbuch)");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq850"); 
+             generate ("epsonlq850"); 
+             adjust quality; 
+             adjust papersize; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+  lq1500 inst:
+      putline ("EPSON LQ-1500");
+      show control options ("");
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq1500"); 
+             generate ("epsonlq1500"); 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+  nec menu: 
+    page;
+    headline ("NEC - Menü"); 
+    putline (" 1. PINWRITER P5 "); 
+    putline (" 2. PINWRITER P6 "); 
+    putline (" 3. PINWRITER P7 "); 
+    putline (" 4. PINWRITER P6 PLUS"); 
+    putline (" 5. PINWRITER P7 PLUS"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (5); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : necp5p7 inst
+             CASE 2   : necp6 inst
+             CASE 3   : necp5p7 inst 
+             CASE 4   : necp6plus inst
+             CASE 5   : necp6plus inst
+           END SELECT
+    FI. 
+  
+     necp5p7 inst: 
+      IF choice = 1 
+         THEN putline ("NEC PINWRITER P5") 
+         ELSE putline ("NEC PINWRITER P7") 
+      FI; 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp5p7"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6 inst: 
+      putline ("NEC PINWRITER P6 "); 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp6"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6plus inst: 
+      IF choice = 4 
+         THEN putline ("NEC PINWRITER P6 PLUS") 
+         ELSE putline ("NEC PINWRITER P7 PLUS") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("CR FUNCTION             CR ONLY ");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, courier, souvenir"); 
+      show command options ("draft, nlq, courier, souvenir"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p6+"); 
+             generate ("necp6+"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE;
+             IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; 
+      FI. 
+ 
+  oki menu: 
+    page; 
+    headline ("OKI - Menü"); 
+    putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); 
+    putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); 
+    putline (" 3. MICROLINE 393/393C EPSON-kompatibel");                   
+    putline (" 4. MICROLINE 393/393C IBM-kompatibel");                     
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (4); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : oki ml390 inst                                 
+             CASE 2   : oki ml390 inst                                 
+             CASE 3   : oki ml393eps inst 
+             CASE 4   : oki ml393ibm inst 
+           END SELECT
+    FI. 
+ 
+    oki ml390 inst:
+      IF choice = 1
+        THEN putline ("OKI Microline 390") ;
+        ELSE putline ("OKI Microline 391") ;
+      FI;
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           EPSON LQ ");
+      putline ("AUTO LF                  NO       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki390/391"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+    oki ml393eps inst:
+      putline ("OKI Microline 393 EPSON-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki393/393Ceps"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+    oki ml393ibm inst:
+      putline ("OKI Microline 393 IBM-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           ASCII ");
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki");
+             generate ("oki393/393Cibm"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+ 
+ 
+generate printer spool: 
+   IF service opt = 0 
+      THEN forget (generator name, quiet); 
+           forget (driver name, quiet) 
+    FI;
+    eumel must advertise;
+    cursor (1, 10);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (2);
+    putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("         mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); 
+    putline ("         Drucker eingesetzt werden soll."); 
+    line (2); 
+    put ("Generierung beendet, weiter mit 'SV'");
+    break (quiet);
+    do ("spool manager (PROC printer)").
+ 
+  inform about restart: 
+    page; 
+    putline ("Es ist kein Druckertreiber installiert worden!"); 
+    line; 
+    putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+    line. 
+ 
+END PROC treiber einrichten; 
+ 
+PROC headline (TEXT CONST header): 
+ 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  put (header); 
+  line (2) 
+END PROC headline; 
+ 
+PROC ask user (INT CONST max choice): 
+ 
+  TEXT VAR exit; 
+  inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")  
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. 
+END PROC ask user;
+
+PROC show control options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); 
+  write ("papersize, std quality");
+  IF options <> "" 
+    THEN put (","); 
+         putline (options) 
+  FI
+END PROC show control options; 
+
+PROC show material options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche Materialwerte (#material(""..."")#):"); 
+  putline (options) 
+END PROC show material options; 
+ 
+PROC show command options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); 
+  putline (options) 
+END PROC show command options; 
+ 
+PROC ask for quality: 
+ 
+  line (1); 
+  putline ("Standard - Druckqualität:"); 
+  line; 
+  REP out (up); 
+    IF yes ("Draft Quality (schneller, aber nicht so schön)") 
+      THEN quality := 1; LEAVE ask for quality 
+    FI;
+    out (up);
+    IF yes ("Near Letter Quality (schöner, aber langsamer)")
+      THEN quality := 2; LEAVE ask for quality 
+    FI;
+  PER 
+END PROC ask for quality; 
+ 
+PROC adjust quality: 
+ 
+  IF quality = 1 
+    THEN do ("std quality (""draft"")") 
+    ELSE do ("std quality (""nlq"")") 
+  FI 
+END PROC adjust quality; 
+ 
+PROC ask for papersize : 
+LET up           = ""3""13""5"";
+ 
+  paper format number := paper format ; 
+ 
+    . paper format :
+        line (1); 
+        putline ("Papierformat:"); 
+        line;
+        REP out (up);
+            IF yes ("Endlospapier, 8 Zoll breit")
+               THEN LEAVE paper format WITH 1 FI;
+            out (up);
+            IF yes ("Endlospapier, 13.2 Zoll breit")
+               THEN LEAVE paper format WITH 2 FI;
+            out (up);
+            IF yes ("Einzelblatteinzug, DINA 4")
+               THEN LEAVE paper format WITH 3 FI;
+        PER;
+        0
+END PROC ask for papersize;
+ 
+ 
+PROC adjust papersize: 
+ 
+    SELECT paper format number OF 
+      CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 3 : do("papersize (21.0, 29.7)");
+               do ("paper feed (""sheet"")") 
+    END SELECT
+ 
+END PROC adjust papersize; 
+ 
+BOOL PROC all right: 
+ 
+  line (3);
+  cursor (1,23); 
+  yes ("Soll der ausgewählte Druckertreiber installiert werden") 
+END PROC all right; 
+ 
+PROC get fonttable (TEXT CONST name): 
+ 
+  fonttab name := name; 
+  from archive ((description file name & module file name & fonttab name) 
+                                                                    - all); 
+  fonttable (fonttab name); 
+  command dialogue (FALSE); 
+  save (fonttab name, /"configurator"); 
+  IF service option = 0 
+    THEN forget (fonttab name) 
+  FI; 
+  command dialogue (TRUE); 
+END PROC get fonttable; 
+ 
+PROC from archive (THESAURUS CONST files):
+ 
+  IF highest entry (files) > 0 
+    THEN fetch from archive; 
+         release (archive);
+         putline ("Archiv abgemeldet !")
+  FI.
+ 
+  fetch from archive: 
+    THESAURUS VAR thes :: files; 
+    REP 
+      ask for archive;
+      reserve archive;
+      fetch (thes / ALL archive, archive);
+      thes := thes - all 
+    UNTIL highest entry (thes) = 0 PER.
+
+ask for archive:
+  line;
+  putline ("Bitte Archiv mit den Dateien"); 
+  TEXT VAR buffer;
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  line; 
+  putline ("Wenn eingelegt: Taste drücken !"); 
+  inchar (buffer). 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  disable stop;
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI;
+  enable stop.
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+ 
+PROC generate (TEXT CONST name): 
+ 
+  open files; 
+  read description; 
+  build programme; 
+  insert programme; 
+  forget files. 
+ 
+  open files: 
+    line (5); 
+    cursor (1, 20); 
+    putline (""4"Bitte warten !"); 
+    putline ("    - Der Treiber wird generiert."); 
+    driver name := "printer." + name + "(generiert)"; 
+    IF exists (driver name) 
+      THEN forget (driver name, quiet) 
+    FI; 
+    FILE VAR des file :: sequential file (modify, description file name), 
+             mod file :: sequential file (modify, module file name), 
+             driver file :: sequential file (output, driver name). 
+ 
+  read description: 
+    to line (des file, 1); 
+    col (des file, 1);
+    downety (des file, "$" + name + "$"); 
+    IF eof (des file) 
+      THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + 
+                      "Descriptions-File enthalten")
+    FI; 
+    TEXT VAR description :: "", 
+             record; 
+    BOOL VAR done :: FALSE; 
+    read record (des file, record); 
+    record := subtext (record, col (des file) + LENGTH name + 2);
+    WHILE NOT eof (des file) AND NOT done REP 
+      treat record
+    PER. 
+ 
+  treat record: 
+    INT VAR dollar pos :: pos (record, "$"); 
+    IF dollar pos = 0
+      THEN description CAT compress (record); 
+           down (des file); 
+           read record (des file, record)  
+      ELSE description CAT compress (subtext (record, 1, dollar pos - 1));
+           col (des file, dollar pos); 
+           done := TRUE; 
+    FI. 
+ 
+  build programme: 
+    get module name; 
+    WHILE still modules REP 
+      find module; 
+      transfer module; 
+      get module name 
+    PER. 
+ 
+  get module name: 
+    INT VAR semicol pos :: pos (description, ";"); 
+    TEXT VAR module name; 
+    IF semicol pos > 0 
+      THEN module name := subtext (description, 1, semicol pos - 1); 
+           description := subtext (description, semicol pos + 1) 
+      ELSE module name := description; 
+           description := "" 
+    FI.
+ 
+  still modules: 
+    module name <> "" OR description <> "". 
+ 
+  find module: 
+    to line (mod file, 1); 
+    col (mod file, 1); 
+    downety (mod file, "$" + module name + "$"); 
+    IF eof (mod file) 
+      THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + 
+                      "Modul-File enthalten")
+    FI. 
+ 
+  transfer module: 
+    done := FALSE; 
+    read record (mod file, record); 
+    record := subtext (record, col (mod file) + LENGTH module name + 2);
+    WHILE NOT eof (mod file) AND NOT done REP 
+      transfer record
+    PER. 
+ 
+  transfer record: 
+    dollar pos := pos (record, "$"); 
+    IF dollar pos = 0
+      THEN write (driver file, compress (record)); 
+           line (driver file);
+           down (mod file); 
+           read record (mod file, record)  
+      ELSE write (driver file, compress (subtext (record, 1, 
+                                            dollar pos - 1)));
+           col (mod file, dollar pos); 
+           done := TRUE; 
+           cout (line no (mod file)) 
+    FI. 
+ 
+  insert programme: 
+    IF online 
+      THEN putline ("    - Der Treiber wird insertiert.") 
+    FI;
+    check off; 
+    insert (driver name). 
+ 
+  forget files: 
+    IF service option = 0 
+      THEN forget (description file name, quiet); 
+           forget (module file name, quiet)
+    FI  .
+END PROC generate; 
+ 
+END PACKET driver inst 24
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/doc/readme b/system/printer-24nadel/schulis-mathe-1.0/doc/readme
new file mode 100644
index 0000000..d526aa3
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/doc/readme
@@ -0,0 +1,320 @@
+#type("nlq10")##limit(18.0)##start(1.5,1.0)# 
+#head# 
+Treiber-Installations-Programm   #right#Seite % 
+für 24-Nadel-Matrixdrucker   #right#23.12.1988 
+ 
+ 
+#end# 
+#on("u")#Dokumentation zum Treiber-Installations-Programm für 24-Nadel-
+Matrixdrucker#off("u")# 
+ 
+#on("u")#Inhalt:#off("u")# 
+ 
+1. Installations- und Gebrauchsanleitung 
+2. Druckertreiber-Auswahl 
+3. Steuerungsmöglichkeiten und Spezialfeatures 
+4. Weitere Hinweise 
+ 
+ 
+#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# 
+ 
+#on("u")#Einrichten#off("u")# 
+So wird das Treiber-Installationsprogramm eingerichtet: 
+ 
+       SV drücken 
+ 
+    nach 'gib supervisor kommando:' 
+ 
+       begin("PRINTER","SYSUR") 
+ 
+    in der Task "PRINTER" (nach 'gib kommando'): 
+ 
+       archive ("std.printer") 
+       fetch ("printer.24.nadel",archive) 
+       check off 
+       insert ("printer.24.nadel") 
+ 
+Das Programm wird dann insertiert. 
+ 
+#on("u")#Druckerkanal#off("u")# 
+Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker
+über Parallelschnittstelle betrieben wird, ist die Kanalnummer
+meistens 15. 
+ 
+#on("u")#Menüsystem#off("u")# 
+Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern.
+Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste
+der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier
+den passenden Typ aus! 
+Das Installationsprogramm zeigt nun einige Informationen zu dem ange­
+wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi­
+guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt
+wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei­
+ber betrieben werden soll. 
+ 
+Hinweise zu Konfigurationsangaben: 
+1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion
+   des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf
+   achten, welche Funktion die Schalter haben (Druckerhandbuch!). So
+   ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu
+   aktivieren, damit der Drucker nach Papierende nicht auf der Walze
+   weiterdruckt. 
+2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge­
+   wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker
+   als den ausgewählten verwenden, dann beachten Sie folgende Regeln
+   für die Konfiguration: 
+   - Der Drucker muß auf eine passende Emulation konfiguriert werden. 
+   - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei­
+     lenvorschub durchführen. 
+   - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. 
+ 
+   - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht
+     achten. 
+ 
+(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) 
+ 
+Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des
+ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) 
+ 
+Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er­
+laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt,
+welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein­
+stellungen können nachträglich in der Task "PRINTER" mit den entspre­
+chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte
+Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck­
+datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku­
+ments verändert werden (direkte Druckeranweisung \#"..."\#). 
+Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. 
+ 
+ 
+#on("b")#2. Druckertreiber-Auswahl#off("b")# 
+ 
+#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# 
+Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll­
+ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker
+des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. 
+Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im
+Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!),
+welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist.
+(Viele Drucker verfügen über EPSON LQ-1000 oder IBM Grafikdrucker bzw.
+Proprinter-Eumulationen.) 
+Eine der beiden Anpassungen 'EPSON LQ-1050' oder 'OKI ML-393
+IBM-kompatibel' müßte immer einen (Minimal-) Betrieb ermöglichen (wobei die
+Verwendung der Proportionalschrift bzw. der doppelt hohen Schriften u. U.
+nicht funktioniert). 
+ 
+ 
+#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# 
+ 
+Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B.
+DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). 
+Die Einstellungen können über 
+- Steuerprozeduren 
+- Materialanweisungen bzw. 
+- direkte Druckeranweisungen 
+vorgenommen werden. 
+ 
+#on("u")#Steuerprozeduren#off("u")# 
+setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten
+sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER")
+aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in
+der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# 
+ 
+PROC papersize (REAL CONST breite, länge) 
+    Dient zur Einstellung der Größe der physikalisch beschreibbaren
+    Fläche. 
+    Beispiel:  papersize (20.32, 30.48) 
+               (Standardeinstellung für Endlospapier 8 Zoll breit und
+               12 Zoll lang) 
+ 
+PROC papersize 
+    Informationsprozedur 
+ 
+PROC top margin (REAL CONST margin) 
+    Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk­
+    ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser
+    Prozedur die Länge des oberen Randes, den der Drucker nicht be­
+    drucken kann, in cm angegeben werden. 
+    Beispiel:  top margin (2.0) 
+               (Teilt dem Druckertreiber mit, daß die ersten 2 cm
+               nicht bedruckbar sind.) 
+ 
+REAL PROC top margin 
+    Informationsprozedur 
+ 
+PROC std speed (TEXT CONST speed) 
+    Parameter: slow, fast 
+    Wahl zwischen Positionierung in Mikroschritten (slow) oder in
+    Blanks (fast). 
+    Beispiel:  std speed ("slow") 
+ 
+TEXR PROC std speed 
+    Informationsprozedur 
+ 
+PROC std quality (TEXT CONST quality) 
+    übliche Parameter: draft, nlq 
+    Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift-
+    Qualität 
+    Beispiel:  std quality ("draft") 
+ 
+TEXT PROC std quality 
+    Informationsprozedur 
+ 
+PROC std typeface (TEXT CONST typeface) 
+    übliche Parameter: roman, sansserif, courier 
+    Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im
+    NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). 
+    Beispiel: std typeface ("roman") 
+ 
+TEXT PROC std typeface 
+    Informationsprozedur 
+ 
+PROC paper feed (TEXT CONST name) 
+    übliche Parameter: tractor, sheet, schacht1, schacht2 
+    Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. 
+    Beispiel:  paper feed ("sheet") 
+ 
+TEXT PROC paper feed 
+    Informationsprozedur 
+ 
+ 
+#on("u")#Materialanweisungen \#material("...")\##off("u")# 
+müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und
+setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben
+für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­
+stellten Standardwerten. Diese werden durch die Materialanweisung aber
+nicht geändert.) 
+ 
+Beispiel:  \#material("nlq")\# 
+           sorgt bei entsprechendem Treiber dafür, daß das gesamte
+           Dokument in Schönschrift-Qualität ausgedruckt wird, egal
+           wie 'std quality' eingestellt ist. 
+ 
+#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh­
+rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung
+erscheinen. Beispiel:  \#material("sheet;draft")\# 
+ 
+ 
+#on("u")#direkte Druckeranweisungen \#"..."\##off("u")# 
+gelten ab der Position, an der sie in der Datei auftreten. Sie haben
+(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und
+Materialeinstellungen. 
+ 
+Beispiel:  \#"draft"\# 
+           schaltet (bei entsprechendem Treiber) auf Datenverar­
+           beitungs-Qualität, egal welche Standardeinstellung vorliegt
+           und welche Materialanweisung gegeben wurde. 
+ 
+#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen
+werden.#off("b")# Also:  \#"nlq"\#\#"sansserif"\# 
+ 
+ 
+#on("u")#Wichtig#off("u")# 
+- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen
+  besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben
+  berücksichtigt! Also:  \#"nlq"\# und keinesfalls \#"NLQ"\#!!! 
+- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und
+  nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann
+  daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse
+  erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen
+  Reihenfolge an den Drucker sendet, als er in der Datei steht, die
+  mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B.
+  für beide Spalten) unerwünscht erhalten bleibt. 
+ 
+ 
+#on("u")#Tabelle#off("u")# 
+Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel­
+lungen erfolgen können. 
+ 
+#type("17")# 
+                   Steuerprozeduren      Materialanweisungen     direkte Druckeranweisungen 
+ 
+#on("u")#                                                                                          #off("u")# 
+ 
+Positionierung     std speed             slow, fast              ------ 
+                     slow, fast 
+ 
+Qualität           std quality           z.B. draft, nlq         z.B. draft, nlq 
+                     z.B. draft, nlq 
+ 
+Schriftart         std typeface          z.B. roman,             z.B. roman, 
+(nur bei NLQ)        z.B. roman,         sansserif, courier      sansserif, courier 
+                     sansserif, courier 
+ 
+Einzelblatt-       paper feed            z.B. schacht1,          z.B. schacht1, 
+einzug               z.B. tractor,       schacht2                schacht2 
+                     sheet, 
+                     schacht1, schacht2 
+ 
+Farbdruck          ------                ------                  z.B. schwarz, 
+                                                                 rot, blau, 
+                                                                 violett, gelb 
+                                                                 orange, grün 
+ 
+ 
+ 
+#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# 
+ 
+#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# 
+In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb
+des Codes 127 einige internationale Zeichen zur Verfügung gestellt
+(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). 
+Bei den Treibern der vorliegenden Version gilt folgendes: 
+- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL-
+  Zeichensatz (sofern möglich) unterstützt. 
+- Der Code 252 liefert das Paragraphzeichen. 
+- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes
+  oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des
+  IBM-Grafikzeichensatzes. 
+ 
+ 
+#on("u")#Hinweis zu Proportionalschriften#off("u")# 
+Bei Proportionalschriften kann die Modifikation \#on("i")\# zu Problemen
+führen (z.B. beim Blocksatz), wenn die kursiven Zeichen andere
+Proportionalbreiten haben.
+ 
+#on("u")#Hinweis zur Modifikation on/off("b") bzw. on/off("r")#off("u")# 
+Die meisten 24-Nadel Drucker verfügen sowohl über einen horizontalen als
+auch über einen vertikalen Schattendruck. Diese beiden Druckarten können
+mit der Modifikation on("b") (bold) bzw. on("r") (eigentlich für reverse
+gedacht) eingeschaltet werden.
+
+#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# 
+Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel­
+lungen vorgenommen werden (vgl. auch Abschnitt 3!): 
+ 
+   Am Drucker: 
+1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug
+   schalten (siehe Druckerhandbuch!). 
+ 
+   In der Druckspooltask (meist 'PRINTER'): 
+2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü­
+   gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für
+   2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed
+   ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. 
+3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen­
+   den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel­
+   len. 
+   Beispiel:  papersize (21.0, 29.7) 
+              (für DIN A4-Blätter) 
+4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt­
+   anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß
+   mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem
+   Druckertreiber mitgeteilt werden. 
+   Beispiel:  top margin (1.5) 
+   (Wie groß der obere Rand ist, kann festgestellt werden, indem eine
+   Datei mit \#start(0.0,0.0)\# ausgedruckt wird.) 
+ 
+   Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren
+   Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien
+   ein genügend großer y-Wert für die Startposition eingestellt wird
+   ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der
+   ersten Zeile zu Überschreibungen. 
+ 
+ 
+#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben
+   werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# 
+
+
+
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24 b/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24
new file mode 100644
index 0000000..e3d2fa9
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/beschreibungen24
@@ -0,0 +1,62 @@
+ 
+(*************************************************************************)
+(*                                            Stand   :  3. 1.89         *)
+(*  Beschreibungen-Datei für 24-Nadel-Drucker Version : 0.9              *)
+(*                                            Autor   : hjh              *)
+(*************************************************************************)
+ 
+$necp5p7$ 
+begin;headnecp5p7;declarations;feed; 
+open;opendoch;opendocp5p7;openpagep5-7;close;closepage; 
+execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end
+
+$necp6$ 
+begin;headnecp6;declarations;feed; 
+open;opendoch;opendocp6;openpagep5-7;close;closepage; 
+execute;cmdp5-7;crs;move;movep5-7;onoff;typep5-7;end
+ 
+$necp6+$
+begin;headnecp6+;declarations;speed;topmargin;typefacep6+;feed; 
+open;opendoch;initspeed;opendocp6+;openpage;close;closepage; 
+execute;cmdp6+;crs;move;stdmove;onoff;typep6+;end
+
+$epsonlq850$
+begin;headlq850;declarations;speed;topmargin;typefacelq850;feed; 
+open;opendoch;initspeed;opendoclq850;openpage;close;closepage; 
+execute;cmdlq850;crs;move;stdmove;onoff;typeplq850;end
+
+$epsonlq1500$
+printerlq1500;end
+ 
+$oki390/391$
+begin;headoki390/391;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokieps;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end
+
+$oki393/393Ceps$
+begin;headoki393/393Ceps;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokieps;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokieps;end 
+ 
+$oki393/393Cibm$
+begin;headoki393/393Cibm;declarations;speed;topmargin;typefaceoki;feedschacht; 
+open;opendoch;initspeed;opendocokiibm;openpage;close;closepage; 
+execute;cmdoki;crs;move;stdmove;onoff;typeokiibm;end 
+ 
+$toshp321$ 
+begin;headtoshp321;declarations;speed;feed; 
+open;opendochtosh;initspeed;opendoctosh;openpagetosh;close;closepagetosh; 
+execute;cmdtosh;crs;move;stdmove;onoff;typetosh;end 
+ 
+$starnb24$ 
+begin;headstarnb24;declarations;speed;topmargin;typefacestar;feedschacht; 
+open;opendoch;initspeed;opendocstar;openpage;close;closepage; 
+execute;cmdstar;crs;move;stdmove;onoff;typestar;end 
+ 
+$brotherm1724l$ 
+begin;headbrotherm1724l;declarations;speed;topmargin;feed; 
+open;opendoch;initspeed;opendocbrother;openpage;close;closepage; 
+execute;cmdtosh;crs;move;stdmove;onoff;typebrother;end 
+ 
+
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother
new file mode 100644
index 0000000..2251e18
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.brother
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500
new file mode 100644
index 0000000..1b4c6a6
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq1500
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850
new file mode 100644
index 0000000..7a6d2f0
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.epson.lq850
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5
new file mode 100644
index 0000000..9910da6
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new
new file mode 100644
index 0000000..9804bd5
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p5.new
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+
new file mode 100644
index 0000000..b209e81
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.nec.p6+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki
new file mode 100644
index 0000000..2251e18
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.oki
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321 b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321
new file mode 100644
index 0000000..452afca
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/fonttab.toshiba.p321
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/inserter b/system/printer-24nadel/schulis-mathe-1.0/src/inserter
new file mode 100644
index 0000000..1a165e0
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/inserter
@@ -0,0 +1,793 @@
+ 
+(*************************************************************************) 
+(*   Installationsprogramm für                Stand   :  3. 1.89         *) 
+(*      24-Nadel Drucker                      Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+PACKET driver inst 24 
+ 
+ 
+       DEFINES treiber einrichten: 
+ 
+ 
+LET up = ""3""13""5"", 
+ 
+    generator name = "printer.24.nadel", 
+ 
+    description file name = "beschreibungen24", 
+    module file name = "module24"; 
+ 
+ 
+INT VAR pr channel, 
+        quality,
+        paper format number,
+        service option; 
+TEXT VAR fonttab name :: "", 
+         driver name :: ""; 
+TEXT VAR inp; 
+BOOL VAR was esc; 
+ 
+treiber einrichten 
+ 
+PROC treiber einrichten:
+
+  treiber einrichten (0)
+END PROC treiber einrichten;
+
+PROC treiber einrichten (INT CONST service opt): 
+ 
+  ask for print channel; 
+  main menu; 
+  IF installed 
+    THEN generate printer spool 
+    ELSE inform about restart 
+  FI. 
+ 
+  ask for printchannel: 
+    inits; 
+    page; 
+    headline ("Druckerkanal - Einstellung"); 
+    cursor (1, 15); 
+    putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); 
+    putline ("         'serverchannel (Kanalnummer)' in der Task """ + 
+             name (myself) + """"); 
+    putline ("         verändert werden."); 
+    REP 
+      cursor (1, 10);
+      put (""5"EUMEL-Kanalnummer des Druckerkanals:");
+      get (pr channel);
+      disable stop; 
+      serverchannel (pr channel);
+      BOOL VAR no error :: NOT is error; 
+      clear error; 
+      no error := no error CAND
+                  (pr channel <> channel (myself)) CAND  
+                  (pr channel > 1)                 CAND  
+                  (pr channel < 17); 
+      
+      IF NOT no error
+        THEN cursor (1, 7); 
+             put error;
+             putline ("Eingabe korrigiert wiederholen!") 
+      FI; 
+      enable stop 
+    UNTIL no error PER; 
+    IF exists task ("canal " + text (pr channel)) 
+      THEN end (/ ("canal " + text (pr channel))); 
+    FI; 
+ 
+. inits: 
+    line; 
+    IF single task 
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI; 
+    INT VAR choice;
+    service option := service opt.
+ 
+  single task:  (pcb (9) AND 255) = 1.
+ 
+  main menu: 
+    BOOL VAR installed :: FALSE; 
+    REP 
+      show main menu; 
+      get choice; 
+      treat choice 
+    UNTIL was esc OR installed PER. 
+ 
+  show main menu: 
+    page; 
+    headline("Hauptmenü 24-Nadel-Drucker"); 
+    putline (" 1. Brother");
+    putline (" 2. Epson");
+    putline (" 3. NEC"); 
+    putline (" 4. OKI");
+    putline (" 5. Toshiba").
+
+  get choice: 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Installation abbrechen"); 
+    ask user (5).
+ 
+  treat choice: 
+    SELECT int (inp) OF 
+      CASE 1: brother menu 
+      CASE 2: epson menu 
+      CASE 3: nec menu 
+      CASE 4: oki menu 
+      CASE 5: toshiba menu 
+    END SELECT. 
+ 
+  
+  brother menu: 
+    page;
+    headline ("brother - Menü"); 
+    putline (" 1. M-1724 L"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           brother m1724l inst
+    FI. 
+  
+    brother m1724l inst: 
+      putline ("brother M-1724 L"); 
+      line; 
+      putline ("Wählen Sie folgende DIP-Schalter Optionen:"); 
+      putline ("Emulationsmodus                IBM Proprinter XL ");
+      putline ("Automatischer Zeilenvorschub       Nein       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.brother"); 
+             generate ("brotherm1724l"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+  toshiba menu:
+    page;
+    headline ("TOSHIBA - Menü"); 
+    putline (" 1. P 321"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           toshiba p321 inst
+    FI. 
+  
+    toshiba p321 inst: 
+       putline ("TOSHIBA P 321"); 
+       putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+       putline ("S3-8  S3-7  S3-5  übrige Schalter"); 
+       putline ("OFF   OFF   *)    egal           "); 
+       putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+       show control options ("std speed, paper feed"); 
+       show material options("slow, fast"); 
+       show command options ("nlq, draft"); 
+       ask for quality; 
+       ask for papersize; 
+       IF all right 
+         THEN get fonttable ("fonttab.toshiba.p321"); 
+              generate ("toshp321"); 
+              adjust papersize; 
+              adjust quality; 
+              do ("papersize(21.0,30.48)"); 
+              installed := TRUE; 
+        FI. 
+ 
+  
+  epson menu: 
+    page; 
+    headline ("Epson - Menü"); 
+    putline (" 1. LQ 850"); 
+    putline (" 2. LQ 1050"); 
+    putline (" 3. LQ 1500"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (3); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1 : lq850 inst
+             CASE 2 : lq850 inst
+             CASE 3 : lq1500 inst
+           END SELECT
+    FI. 
+
+    lq850 inst:
+      IF choice = 1 
+         THEN putline ("Epson LQ 850")
+         ELSE putline ("Epson LQ 1050")
+      FI; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8");
+      putline ("egal  egal  egal  egal  egal  egal  *1)    OFF ");
+      putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line;
+      putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); 
+      putline ("egal  egal  *2)                     OFF   OFF");
+      putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); 
+      putline ("    gesetzt werden (Druckerhandbuch)");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq850"); 
+             generate ("epsonlq850"); 
+             adjust quality; 
+             adjust papersize; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+  lq1500 inst:
+      putline ("EPSON LQ-1500");
+      show control options ("");
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq1500"); 
+             generate ("epsonlq1500"); 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+  nec menu: 
+    page;
+    headline ("NEC - Menü"); 
+    putline (" 1. PINWRITER P5 "); 
+    putline (" 2. PINWRITER P6 "); 
+    putline (" 3. PINWRITER P7 "); 
+    putline (" 4. PINWRITER P6 PLUS"); 
+    putline (" 5. PINWRITER P7 PLUS"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (5); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : necp5p7 inst
+             CASE 2   : necp6 inst
+             CASE 3   : necp5p7 inst 
+             CASE 4   : necp6plus inst
+             CASE 5   : necp6plus inst
+           END SELECT
+    FI. 
+  
+     necp5p7 inst: 
+      IF choice = 1 
+         THEN putline ("NEC PINWRITER P5") 
+         ELSE putline ("NEC PINWRITER P7") 
+      FI; 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp5p7"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6 inst: 
+      putline ("NEC PINWRITER P6 "); 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp6"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6plus inst: 
+      IF choice = 4 
+         THEN putline ("NEC PINWRITER P6 PLUS") 
+         ELSE putline ("NEC PINWRITER P7 PLUS") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("CR FUNCTION             CR ONLY ");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, courier, souvenir"); 
+      show command options ("draft, nlq, courier, souvenir"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p6+"); 
+             generate ("necp6+"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE;
+             IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; 
+      FI. 
+ 
+  oki menu: 
+    page; 
+    headline ("OKI - Menü"); 
+    putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); 
+    putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); 
+    putline (" 3. MICROLINE 393/393C EPSON-kompatibel");                   
+    putline (" 4. MICROLINE 393/393C IBM-kompatibel");                     
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (4); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : oki ml390 inst                                 
+             CASE 2   : oki ml390 inst                                 
+             CASE 3   : oki ml393eps inst 
+             CASE 4   : oki ml393ibm inst 
+           END SELECT
+    FI. 
+ 
+    oki ml390 inst:
+      IF choice = 1
+        THEN putline ("OKI Microline 390") ;
+        ELSE putline ("OKI Microline 391") ;
+      FI;
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           EPSON LQ ");
+      putline ("AUTO LF                  NO       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki390/391"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+    oki ml393eps inst:
+      putline ("OKI Microline 393 EPSON-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki393/393Ceps"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+    oki ml393ibm inst:
+      putline ("OKI Microline 393 IBM-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           ASCII ");
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki");
+             generate ("oki393/393Cibm"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+ 
+ 
+generate printer spool: 
+   IF service opt = 0 
+      THEN forget (generator name, quiet); 
+           forget (driver name, quiet) 
+    FI;
+    eumel must advertise;
+    cursor (1, 10);
+(*  putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (2);
+    putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("         mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); 
+    putline ("         Drucker eingesetzt werden soll."); 
+    line (2); 
+*) 
+(*  put ("Generierung beendet, weiter mit 'SV'");
+    break (quiet);
+*) 
+    putline ("  Generierung beendet."); 
+    putline ("  Weiter: Bitte Taste drücken"); 
+    WHILE incharety <> "" REP ENDREP; 
+    REP UNTIL incharety <> "" ENDREP; 
+    unlink; 
+    do ("spool manager (PROC printer)").
+ 
+  inform about restart: 
+    page; 
+    putline ("Es ist kein Druckertreiber installiert worden!"); 
+    line; 
+    putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+    line; 
+    pause(50); 
+    unlink. 
+ 
+END PROC treiber einrichten; 
+ 
+PROC headline (TEXT CONST header): 
+ 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  put (header); 
+  line (2) 
+END PROC headline; 
+ 
+PROC ask user (INT CONST max choice): 
+ 
+  TEXT VAR exit; 
+  inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")  
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. 
+END PROC ask user;
+
+PROC show control options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); 
+  write ("papersize, std quality");
+  IF options <> "" 
+    THEN put (","); 
+         putline (options) 
+  FI
+END PROC show control options; 
+
+PROC show material options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche Materialwerte (#material(""..."")#):"); 
+  putline (options) 
+END PROC show material options; 
+ 
+PROC show command options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); 
+  putline (options) 
+END PROC show command options; 
+ 
+PROC ask for quality: 
+ 
+  line (1); 
+  putline ("Standard - Druckqualität:"); 
+  line; 
+  REP out (up); 
+    IF yes ("Draft Quality (schneller, aber nicht so schön)") 
+      THEN quality := 1; LEAVE ask for quality 
+    FI;
+    out (up);
+    IF yes ("Near Letter Quality (schöner, aber langsamer)")
+      THEN quality := 2; LEAVE ask for quality 
+    FI;
+  PER 
+END PROC ask for quality; 
+ 
+PROC adjust quality: 
+ 
+  IF quality = 1 
+    THEN do ("std quality (""draft"")") 
+    ELSE do ("std quality (""nlq"")") 
+  FI 
+END PROC adjust quality; 
+ 
+PROC ask for papersize : 
+LET up           = ""3""13""5"";
+ 
+  paper format number := paper format ; 
+ 
+    . paper format :
+        line (1); 
+        putline ("Papierformat:"); 
+        line;
+        REP out (up);
+            IF yes ("Endlospapier, 8 Zoll breit")
+               THEN LEAVE paper format WITH 1 FI;
+            out (up);
+            IF yes ("Endlospapier, 13.2 Zoll breit")
+               THEN LEAVE paper format WITH 2 FI;
+            out (up);
+            IF yes ("Einzelblatteinzug, DINA 4")
+               THEN LEAVE paper format WITH 3 FI;
+        PER;
+        0
+END PROC ask for papersize;
+ 
+ 
+PROC adjust papersize: 
+ 
+    SELECT paper format number OF 
+      CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 3 : do("papersize (21.0, 29.7)");
+               do ("paper feed (""sheet"")") 
+    END SELECT
+ 
+END PROC adjust papersize; 
+ 
+BOOL PROC all right: 
+ 
+  line (3);
+  cursor (1,23); 
+  yes ("Soll der ausgewählte Druckertreiber installiert werden") 
+END PROC all right; 
+ 
+PROC get fonttable (TEXT CONST name): 
+ 
+  fonttab name := name; 
+  from archive ((description file name & module file name & fonttab name) 
+                                                                    - all); 
+  fonttable (fonttab name); 
+  command dialogue (FALSE); 
+  save (fonttab name, /"configurator"); 
+  IF service option = 0 
+    THEN forget (fonttab name) 
+  FI; 
+  command dialogue (TRUE); 
+END PROC get fonttable; 
+ 
+PROC from archive (THESAURUS CONST files):
+ 
+  IF highest entry (files) > 0 
+    THEN fetch from archive; 
+         release (archive);
+         putline ("Archiv abgemeldet !")
+  FI.
+ 
+  fetch from archive: 
+    THESAURUS VAR thes :: files; 
+    REP 
+      ask for archive;
+      reserve archive;
+      fetch (thes / ALL archive, archive);
+      thes := thes - all 
+    UNTIL highest entry (thes) = 0 PER.
+
+ask for archive:
+  TEXT VAR buffer;
+(*line;
+  putline ("Bitte Archiv mit den Dateien"); 
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  line; 
+  putline ("Wenn eingelegt: Taste drücken !"); 
+  inchar (buffer)*). 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  disable stop;
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI;
+  enable stop.
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+ 
+PROC generate (TEXT CONST name): 
+ 
+  open files; 
+  read description; 
+  build programme; 
+  insert programme; 
+  forget files. 
+ 
+  open files: 
+    line (5); 
+    cursor (1, 20); 
+    putline (""4"Bitte warten !"); 
+    putline ("    - Der Treiber wird generiert."); 
+    driver name := "printer." + name + "(generiert)"; 
+    IF exists (driver name) 
+      THEN forget (driver name, quiet) 
+    FI; 
+    FILE VAR des file :: sequential file (modify, description file name), 
+             mod file :: sequential file (modify, module file name), 
+             driver file :: sequential file (output, driver name). 
+ 
+  read description: 
+    to line (des file, 1); 
+    col (des file, 1);
+    downety (des file, "$" + name + "$"); 
+    IF eof (des file) 
+      THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + 
+                      "Descriptions-File enthalten")
+    FI; 
+    TEXT VAR description :: "", 
+             record; 
+    BOOL VAR done :: FALSE; 
+    read record (des file, record); 
+    record := subtext (record, col (des file) + LENGTH name + 2);
+    WHILE NOT eof (des file) AND NOT done REP 
+      treat record
+    PER. 
+ 
+  treat record: 
+    INT VAR dollar pos :: pos (record, "$"); 
+    IF dollar pos = 0
+      THEN description CAT compress (record); 
+           down (des file); 
+           read record (des file, record)  
+      ELSE description CAT compress (subtext (record, 1, dollar pos - 1));
+           col (des file, dollar pos); 
+           done := TRUE; 
+    FI. 
+ 
+  build programme: 
+    get module name; 
+    WHILE still modules REP 
+      find module; 
+      transfer module; 
+      get module name 
+    PER. 
+ 
+  get module name: 
+    INT VAR semicol pos :: pos (description, ";"); 
+    TEXT VAR module name; 
+    IF semicol pos > 0 
+      THEN module name := subtext (description, 1, semicol pos - 1); 
+           description := subtext (description, semicol pos + 1) 
+      ELSE module name := description; 
+           description := "" 
+    FI.
+ 
+  still modules: 
+    module name <> "" OR description <> "". 
+ 
+  find module: 
+    to line (mod file, 1); 
+    col (mod file, 1); 
+    downety (mod file, "$" + module name + "$"); 
+    IF eof (mod file) 
+      THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + 
+                      "Modul-File enthalten")
+    FI. 
+ 
+  transfer module: 
+    done := FALSE; 
+    read record (mod file, record); 
+    record := subtext (record, col (mod file) + LENGTH module name + 2);
+    WHILE NOT eof (mod file) AND NOT done REP 
+      transfer record
+    PER. 
+ 
+  transfer record: 
+    dollar pos := pos (record, "$"); 
+    IF dollar pos = 0
+      THEN write (driver file, compress (record)); 
+           line (driver file);
+           down (mod file); 
+           read record (mod file, record)  
+      ELSE write (driver file, compress (subtext (record, 1, 
+                                            dollar pos - 1)));
+           col (mod file, dollar pos); 
+           done := TRUE; 
+           cout (line no (mod file)) 
+    FI. 
+ 
+  insert programme: 
+    IF online 
+      THEN putline ("    - Der Treiber wird insertiert.") 
+    FI;
+    check off; 
+    insert (driver name). 
+ 
+  forget files: 
+    IF service option = 0 
+      THEN forget (description file name, quiet); 
+           forget (module file name, quiet)
+    FI  .
+END PROC generate; 
+ 
+END PACKET driver inst 24
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/module24 b/system/printer-24nadel/schulis-mathe-1.0/src/module24
new file mode 100644
index 0000000..a4957c2
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/module24
@@ -0,0 +1,1554 @@
+
+(*************************************************************************) 
+(*                                            Stand   : 03. 1.89         *) 
+(*   Module-Datei für 24-Nadel-Drucker        Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+$begin$ 
+PACKET printer driver 
+ 
+       DEFINES printer,
+               open,
+               close,
+               execute,
+               paper size,
+               std quality,
+
+$headnecp6$    paper feed:
+(* Treiber fuer NEC P6, automatisch generiert *)
+LET underline linetype = 1; 
+INT VAR factor 1, factor 2, draft factor 1, draft factor 2;
+
+$headnecp5p7$  paper feed:
+(* Treiber fuer NEC P5, P7 , automatisch generiert *)
+LET underline linetype = 1; 
+INT VAR factor 1, factor 2, draft factor 1, draft factor 2;
+
+$headnecp6+$   std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für NEC P6 plus/P7 plus ,automatisch generiert *) 
+ 
+
+$headlq850$    std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für EPSON LQ-850/1050 ,automatisch generiert *) 
+ 
+$headbrotherm1724l$ 
+               std speed, 
+               top margin, 
+               paper feed: 
+INT VAR vertical factor := 1; 
+(* Treiber für BROTHER M-1724L in IBM-Emulation, automatisch generiert *) 
+ 
+$headoki390/391$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 390/391  ,automatisch generiert *) 
+ 
+$headoki393/393Ceps$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 393/393C EPSON-kompatibel, automatisch generiert *) 
+ 
+$headoki393/393Cibm$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+INT VAR vertical factor := 1; 
+(* Treiber für OKI MIKROLINE 393/393C IBM-kompatibel, automatisch generiert *) 
+ 
+$headtoshp321$   std speed, 
+                 paper feed: 
+(* Treiber für TOSHIBA P321, automatisch generiert *) 
+ 
+$headstarnb24$ 
+               std speed, 
+               top margin, 
+               paper feed, 
+               std typeface:
+(* Treiber für STAR NB 24-10/15 in Standard Betriebsart automatisch generiert *) 
+ 
+$declarations$
+INT VAR font nr, font bits, modification bits, 
+        blankbreite, x rest, high, low, steps;
+REAL VAR x size, y size;
+TEXT VAR buffer :: "";
+BOOL VAR is nlq ;
+TEXT VAR font text :: "";
+TEXT VAR std quality name :: "draft";
+ 
+. is pica  : font bits = 0
+. is elite : font bits = 1
+.;
+
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+END PROC paper size;
+ 
+papersize (20.32, 30.48); 
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+END PROC paper size;
+ 
+ 
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality
+     ELSE errorstop ("unzulässige Qualitätsbezeichnung")
+  FI
+END PROC std quality;
+ 
+TEXT PROC std quality : 
+ 
+  std quality name 
+END PROC std quality;
+                        
+ 
+$topmargin$ 
+REAL VAR  y margin := 0.0 ;
+ 
+PROC top margin (REAL CONST margin): 
+ 
+  y margin := margin 
+END PROC top margin; 
+ 
+REAL PROC top margin: 
+ 
+  y margin 
+END PROC top margin;
+ 
+ 
+$speed$
+BOOL VAR is slow :: TRUE; 
+TEXT VAR std speed name :: "slow";
+ 
+PROC std speed (TEXT CONST speed) :
+ 
+  IF speed = "fast" OR speed = "slow"
+     THEN std speed name := speed
+     ELSE errorstop ("unzulässige Geschwindigkeit")
+  FI
+END PROC std speed;
+ 
+TEXT PROC std speed : 
+ 
+std speed name 
+END PROC std speed;
+ 
+ 
+$typefacelq850$ 
+TEXT VAR act typeface name :: "";
+TEXT VAR std typeface name :: "";
+ 
+. is roman: 
+  act typeface name = "roman". 
+. is sansserif: 
+  act typeface name = "sansserif"
+.; 
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "roman" OR typeface = "sansserif"
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+ 
+ 
+$typefacep6+$ 
+BOOL VAR is courier :: TRUE; 
+TEXT VAR std typeface name :: "courier";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "courier" OR typeface = "souvenir" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$typefaceoki$ 
+BOOL VAR is courier ; 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "courier" OR typeface = "kassette" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$typefacestar$ 
+BOOL VAR is roman ; 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "roman" OR typeface = "font1" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : 
+ 
+  std typeface name 
+END PROC std typeface;
+ 
+$feed$ 
+BOOL VAR is sheet feed :: FALSE;
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "sheet"
+    THEN is sheet feed := TRUE 
+  ELIF feeder = "tractor" 
+    THEN is sheet feed := FALSE 
+    ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: 
+  IF is sheet feed
+    THEN "sheet" 
+    ELSE "tractor" 
+  FI 
+END PROC paper feed;
+ 
+$feedschacht$
+BOOL VAR is sheet feed :: FALSE;
+TEXT VAR feeder name :: "tractor";
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "tractor" 
+     THEN feeder name := "tractor"; 
+          is sheet feed := FALSE
+  ELIF feeder = "sheet" OR feeder = "schacht1" 
+     THEN feeder name := "schacht1" ; 
+          is sheet feed := TRUE
+  ELIF feeder = "schacht2" 
+     THEN feeder name := "schacht2" ; 
+          is sheet feed := TRUE 
+     ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: feeder name END PROC paper feed;
+ 
+$open$
+PROC open (INT CONST op code, INT VAR param1, param2):
+ 
+  SELECT op code OF
+    CASE 1: open document(param1,param2)
+    CASE 2: open page    (param1,param2)
+  END SELECT. 
+END PROC open ; 
+ 
+ 
+$opendoch$
+PROC open document (INT VAR x steps,y steps): 
+    modification bits := 0; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 30) * 30;
+ 
+$opendochtosh$
+PROC open document (INT VAR x steps,y steps): 
+    modification bits := 0; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 36) * 36;
+ 
+$initspeed$ 
+    IF pos (material, "slow") <> 0 
+         THEN is slow := TRUE;
+    ELIF pos (material, "fast") <> 0 
+         THEN is slow := FALSE;
+         ELSE is slow := std speed name = "slow"
+    FI;
+ 
+$opendocp6+$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein             *)
+    FI;
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "souvenir") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ;
+ 
+$opendocp5p7$ 
+    out (""24""27""64"");                  (* Reset des Druckers         *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
+    out (""27"x"0"");                      (* Entwurfsqualität           *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein             *)
+            center paper ;
+    FI;
+ 
+    . center paper :
+        INT CONST x steps in chars := x steps DIV x step conversion (2.54 / 10.0),
+                  left margin      := (136 - x steps in chars) DIV 2;
+        out (""27"P");
+        out (""27"l"); out (code (left margin + 1));
+END PROC open document ;
+
+$opendocp6$ 
+    out (""24""27""64"");                  (* Reset des Druckers         *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
+    out (""27"x"0"");                      (* Entwurfsqualität           *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF is sheet feed
+       THEN out (""27""25"4");             (* Sheetmode ein              *)
+    FI;
+END PROC open document ;
+
+$opendoclq850$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN out (""27""25"4");                       (* Sheetmode ein    *)
+    FI;
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "roman") <> 0 
+      THEN act typeface name := "roman" 
+    ELIF pos (material, "sansserif") <> 0 
+      THEN act typeface name := "sansserif" 
+      ELSE act typeface name := std typeface name  
+    FI; 
+END PROC open document ; 
+ 
+$opendocokieps$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "kassette") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ; 
+ 
+$opendoctosh$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6");                              (* Zeichensatz *) 
+    out (""27"A"12""27"2") ;
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+END PROC open document ; 
+ 
+$opendocbrother$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6" + ""27"R"0"");                (* Zeichensatz II ascii *) 
+    out (""27"A"10""27"2") ;                    (* Zeilenabstand *)
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    IF is sheet feed
+       THEN out (""27""25"4")  
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+END PROC open document ; 
+ 
+$opendocokiibm$ 
+    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
+    out (""27"6" + ""27"!"64"");                (* Zeichensatz II ascii *) 
+    out (""27""91""92""4""0""0""0""180"");      (* 1/180 *)
+    out (""27"A"12""27"2") ;                    (* Zeilenabstand *)
+    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "courier") <> 0 
+      THEN is courier := TRUE ; 
+    ELIF pos (material, "kassette") <> 0 
+      THEN is courier := FALSE ; 
+      ELSE is courier := std typeface name = "courier" 
+    FI; 
+END PROC open document ; 
+ 
+$opendocstar$ 
+    out (""24""27""64"");                  (* Reset des Druckers *) 
+    out (""27"R"0"");                  (* amerikanischer Zeichensatz *) 
+    out (""27"O"); 
+    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
+    out (""27"x"0"");                                  (* Entwurfsqualität *) 
+    IF is sheet feed
+         THEN IF feeder name = "schacht2"
+                 THEN out (""27""25"2")  
+                 ELSE out (""27""25"1")
+              FI 
+    FI;                                                (* Sheetmode ein    *) 
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    IF pos (material, "roman") <> 0 
+      THEN is roman := TRUE ; 
+    ELIF pos (material, "font1") <> 0 
+      THEN is roman := FALSE ; 
+      ELSE is roman := std typeface name = "roman" 
+    FI; 
+END PROC open document ; 
+ 
+$openpagetosh$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0;
+    IF is sheet feed
+       THEN y start := y step conversion (2.54)    (* 1 Inch *)
+       ELSE y start := 0;
+    FI;
+    x rest  := 0;
+    out (""13"");
+END PROC open page; 
+ 
+$openpage$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0 ; 
+    y start := y step conversion (y margin) ; 
+    x rest := 0; 
+    out (""13""). 
+END PROC open page; 
+ 
+$openpagep5-7$ 
+PROC open page (INT VAR x start , y start): 
+ 
+    x start := 0;
+    IF is sheet feed
+       THEN y start := y step conversion (8.466667e-1)    (* 2/6 Inch *)
+       ELSE y start := 0;
+    FI;
+    x rest  := 0;
+    out (""13"");
+END PROC open page; 
+ 
+$close$
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+  SELECT op code OF
+    CASE 1: close document 
+    CASE 2: close page (param1)
+  END SELECT.
+ 
+close document : 
+. 
+END PROC close ; 
+ 
+$closepage$ 
+PROC close page (INT CONST remaining y steps) : 
+    IF remaining y steps > 0
+       THEN out (""12"")
+    ELIF is sheet feed
+       THEN out (""27""25"R")
+    FI;
+END PROC close page;
+
+$closepagetosh$ 
+PROC close page (INT CONST remaining y steps) : 
+    IF   is sheet feed
+         THEN out (""12"")
+    ELIF remaining y steps > 0
+         THEN out (""12"")
+    FI;
+END PROC close page;
+
+$execute$
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE 1:  write text
+  CASE 2:  write cmd
+  CASE 3:  carriage return
+  CASE 4:  move
+  CASE 5:  draw
+  CASE 6:  on
+  CASE 7:  off
+  CASE 8:  type
+END SELECT.
+
+from : param1. 
+to   : param2. 
+ 
+  write text :
+    out subtext (string, from, to).
+ 
+$cmdp6+$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "courier"
+      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
+    ELIF buffer = "souvenir"
+      THEN IF is courier THEN is courier := FALSE; switch to souvenir FI;
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdp5-7$ 
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+         THEN IF NOT is nlq THEN switch to nlq FI;
+              is nlq := TRUE;
+    ELIF buffer = "draft"
+         THEN IF     is nlq THEN switch to draft FI;
+              is nlq := FALSE;
+         ELSE out (buffer);
+    FI;.
+ 
+$cmdlq850$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "roman"
+      THEN IF NOT is roman THEN act typeface name := "roman" ; 
+                                switch to roman FI;
+    ELIF buffer = "sansserif"
+      THEN IF NOT is sansserif THEN act typeface name := "sansserif"; 
+                                    switch to sansserif FI;
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdoki$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "courier"
+      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
+    ELIF buffer = "kassette"
+      THEN IF is courier THEN is courier := FALSE; switch to kassette FI;
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdtosh$ 
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE;  switch to draft FI;
+      ELSE out (buffer);
+    FI;.
+ 
+$cmdstar$ 
+  write cmd :
+    buffer := subtext (string, from, to); 
+    IF   buffer = "nlq"
+      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
+    ELIF buffer = "draft"
+      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
+    ELIF   buffer = "roman"
+      THEN IF NOT is roman THEN is roman := TRUE; switch to roman FI;
+    ELIF buffer = "font1"
+      THEN IF is roman THEN is roman := FALSE; switch to font1 FI;
+    FI. 
+ 
+$crs$
+  carriage return :
+    x rest := 0;
+    out (""13"").
+ 
+$move$ 
+x steps : param1.
+y steps : param2.
+
+move :
+  IF x steps < 0 OR y steps < 0 THEN stop FI; 
+  IF x steps > 0 THEN x move FI; 
+  IF y steps > 0 THEN y move FI. 
+
+$stdmove$ 
+x move : 
+  x rest INCR x steps;
+  high   := (x rest) DIV blankbreite;
+  x rest := (x rest) MOD blankbreite; 
+  steps := x rest DIV 3;
+  IF high   > 0 THEN high TIMESOUT " " FI;
+  IF steps > 0 AND is slow
+     THEN IF is underline THEN out (" "8"") FI;
+          out (""27"Y" + code (steps) + ""0"");  (* 1/360 *)
+          steps TIMESOUT ""0"";
+          x rest := x rest MOD 3
+  FI. 
+ 
+is underline: 
+  bit (modification bits,7). 
+ 
+y move : 
+  IF y steps > 0
+     THEN high := y steps DIV 255;
+          low  := y steps MOD 255;
+          IF high > 0 THEN high TIMESOUT ""27"J"255"" FI;   (* 1/180 *)
+          IF low  > 0 THEN out (""27"J" + code (low)) FI;
+  FI. 
+ 
+draw :
+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 
+    THEN stop
+  ELIF x steps > 0
+    THEN x draw
+  FI. 
+ 
+x draw : 
+  x rest INCR x steps ; 
+  steps := x steps DIV 3 ; 
+  IF steps > 0 THEN 
+    x rest := x steps MOD 3 ; 
+    out (""27"Y");
+    out (code (steps MOD 256));
+    out (code (steps DIV 256));
+    steps TIMESOUT ""1""; 
+  FI.
+ 
+$movep5-7$ 
+      x move :
+        x rest INCR x steps; 
+        IF not is underline
+           THEN simple x move
+           ELSE underline x move
+        FI;
+
+        . not is underline :
+            NOT bit (modification bits, 7)
+ 
+        . simple x move :
+            high   := x rest DIV factor 1;
+            x rest := x rest MOD factor 1;
+            out (""27"\");
+            out (code (high MOD 256));
+            out (code (high DIV 256));
+ 
+        . underline x move :
+            high   := x rest DIV factor 2;
+            x rest := x rest MOD factor 2;
+            IF high < blankbreite
+               THEN stop
+               ELSE low  := high MOD 127;
+                    high := high DIV 127;
+                    IF low >= blankbreite
+                       THEN low  DECR blankbreite;
+                       ELSE high DECR 1;
+                            low  DECR (blankbreite - 127);
+                    FI;
+                    IF high > 0 
+                       THEN out (""27" ");
+                            out (code (127 - blankbreite));
+                            high TIMESOUT " ";
+                    FI;
+                    out (""27" ");
+                    out (code (low)); 
+                    out (" "27" "0"");
+            FI;
+. y move:
+
+  low  := y steps MOD 255;
+  high := y steps DIV 255;
+  IF high > 0 THEN high TIMESOUT (""27"J"255"") FI;
+  IF low  > 0 THEN out (""27"J" + code (low))   FI;
+ 
+. draw :
+    IF   x steps < 0 OR y steps <> 0 
+         THEN stop
+    ELIF x steps > 0
+         THEN x draw
+    FI;
+ 
+    . x draw :
+        x rest INCR x steps;
+        steps  := x rest DIV 4;
+        x rest := x rest MOD 4;
+        IF steps > 0
+           THEN low  := steps MOD 256;
+                high := steps DIV 256;
+                out (""27"*"39"");
+                out (code (low));
+                out (code (high));
+                steps TIMESOUT dot;
+        FI;
+
+        . dot :
+            IF linetype = underline linetype
+               THEN ""000""000""001""
+               ELSE ""000""000""048""
+            FI. 
+ 
+ 
+$onoff$ 
+  modification : param1
+.
+  on :
+    buffer := on string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits OR code (buffer);
+            switch to font;
+       ELSE stop
+    FI
+ 
+.
+  off :
+    buffer := off string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits XOR code (buffer);
+            switch to font;
+       ELSE stop
+    FI.
+ 
+$typep6+$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to souvenir 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to souvenir : 
+    out (""27"k"15"") ; 
+END PROC execute;
+ 
+$typeplq850$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is roman 
+      THEN switch to roman 
+      ELSE switch to sansserif 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to roman : 
+    out (""27"k"0"") ; 
+
+. switch to sansserif : 
+    out (""27"k"1"") ; 
+END PROC execute;
+ 
+$typeokieps$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    vertical factor := code (buffer SUB 1); 
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to kassette 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    IF vertical factor = 2 
+      THEN out (""27"w"1"") 
+      ELSE out (""27"w"0"") 
+    FI; 
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to kassette : 
+    out (""27"k"127"") ; 
+END PROC execute;
+ 
+$typep5-7$ 
+  type :
+    font nr     := param1;
+    buffer      := font string (font nr);
+    factor 1    := code (buffer SUB 1);  (* 720 / Mikroschritte pro Inch mit ESC \ *)
+    factor 2    := code (buffer SUB 2);  (* 720 / Mikroschritte pro Inch mit ESC Blank *)
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") DIV factor 2; 
+    switch to font;
+    IF is nlq THEN switch to nlq FI;
+ 
+END PROC execute;
+ 
+ 
+PROC switch to font :
+ 
+  out (""27"!");
+  out (code (font bits OR modification bits));
+  out (font text);
+ 
+END PROC switch to font;
+ 
+ 
+PROC switch to nlq :
+ 
+  IF is pica OR is elite
+     THEN draft factor 1 := factor 1;
+          factor 1       := 4;
+          draft factor 2 := factor 2; 
+          IF is pica
+             THEN factor 2    := 4 * factor 2 DIV 6;
+                  blankbreite := char pitch (font nr, " ") DIV factor 2;
+          FI;
+          out (""27"x"1"");
+     ELSE out (""27"x"0"");
+  FI;
+ 
+END PROC switch to nlq;
+ 
+ 
+PROC switch to draft :
+ 
+  IF is pica OR is elite
+     THEN factor 1 := draft factor 1;
+          factor 2 := draft factor 2;
+          out (""27"x"0"");
+  FI;
+ 
+END PROC switch to draft;
+
+$typetosh$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN
+       ELSE
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    out (font text);
+ 
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"1"");
+ 
+END PROC execute;
+ 
+$typeokiibm$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    vertical factor := code (buffer SUB 1); 
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is courier 
+      THEN switch to courier 
+      ELSE switch to kassette 
+    FI ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN  out(""27"%G")
+       ELSE  out(""27"%H")
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    IF vertical factor = 2 
+      THEN out (""27""91""64""4""0""0""0""2""0"") 
+      ELSE out (""27""91""64""4""0""0""0""1""0"") 
+    FI; 
+    out (font text);
+ 
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"0"");
+ 
+. switch to courier : 
+    out (""27"k"0"") ; 
+
+. switch to kassette : 
+    out (""27"k"127"") ; 
+END PROC execute;
+ 
+$typebrother$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    vertical factor := code (buffer SUB 1); 
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is nlq 
+      THEN switch to nlq
+      ELSE switch to draft 
+    FI;
+    switch to font;
+ 
+. switch to font :
+    INT VAR master select bits := font bits OR modification bits ; 
+    IF bit (master select bits,0) 
+       THEN out (""27":")
+       ELSE out (""18"") 
+    FI;
+    IF bit (master select bits,1) 
+       THEN out (""27"I"2""27"P"1"")
+       ELSE out (""27"P"0"") 
+    FI;
+    IF bit (master select bits,2) 
+       THEN out (""27""15"")
+    FI;
+    IF bit (master select bits,3) 
+       THEN out (""27"E")
+       ELSE out (""27"F") 
+    FI;
+    IF bit (master select bits,4) 
+       THEN out (""27"G")
+       ELSE out (""27"H") 
+    FI;
+    IF bit (master select bits,5) 
+       THEN out (""27"W"1"")
+       ELSE out (""27"W"0"") 
+    FI;
+    IF bit (master select bits,6) 
+       THEN
+       ELSE
+    FI;
+    IF bit (master select bits,7) 
+       THEN out (""27"-"1"")
+       ELSE out (""27"-"0"") 
+    FI;
+    IF vertical factor = 2 
+      THEN out (""27""91""64""4""0""0""0""2""0"") 
+      ELSE out (""27""91""64""4""0""0""0""1""0"") 
+    FI; 
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"I"2"");
+ 
+. switch to draft :
+    out (""27"I"0"");
+ 
+END PROC execute;
+ 
+$typestar$ 
+   type : 
+    font nr := param1 ; 
+    buffer := font string (font nr);
+    font bits   := code (buffer SUB 3);
+    font text   := subtext (buffer, 4);
+    blankbreite := char pitch (font nr, " ") ; 
+    IF is roman 
+      THEN switch to roman 
+      ELSE switch to font1 
+    FI ; 
+    switch to font;
+    IF is nlq 
+      THEN switch to nlq 
+      ELSE switch to draft 
+    FI;
+ 
+. switch to font :
+    out (""27"!");
+    out (code (font bits OR modification bits));
+    out (font text);
+ 
+. switch to nlq :
+    out (""27"x"1"");
+ 
+. switch to draft :
+    out (""27"x"0"");
+ 
+. switch to roman : 
+    out (""27"k"0"") ; 
+
+. switch to font1 : 
+    out (""27"k"1"") ; 
+END PROC execute;
+ 
+ 
+
+$printerlq1500$ 
+PACKET printer driver
+ 
+(**************************************************************************)
+(*                                                Stand   : 29.07.86      *)
+(*   EPSON   LQ-1500                              Version : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(*   geändert am 15.12.88 hjh                                             *)
+(**************************************************************************)
+ 
+       DEFINES printer,
+               open,
+               close,
+               execute,
+ 
+               paper size,
+               std quality:
+ 
+LET
+(*  underline           =  1,
+    bold                =  2,
+    italics             =  4,
+    reverse             =  8, *)
+ 
+    underline linetype  =  1,
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8;
+ 
+INT VAR rest, high, low, factor;
+BOOL VAR is nlq, factor was 6, condensed;
+REAL VAR x size, y size;
+TEXT VAR std quality name, buffer;
+ 
+(*********************************************************************)
+ 
+paper size  (13.6 * 2.54, 12.0 * 2.54);
+std quality ("draft");
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality;
+     ELSE errorstop ("unzulaessige Betriebsart")
+  FI;
+ 
+END PROC std quality;
+ 
+TEXT PROC std quality : std quality name END PROC std quality;
+ 
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+    factor       := 0;
+    factor was 6 := FALSE;
+    condensed    := FALSE; 
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 30) * 30;
+    out (""27""64"");                      (* Reset des Druckers             *)
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                 *)
+    out (""27"x"0"");                      (* Entwurfsqualität               *) 
+ 
+ 
+. x start : param1
+. y start : param2
+. 
+  open page :
+    x start := 0;
+    y start := 0;
+    rest    := 0;
+    out (""13"");
+ 
+END PROC open;
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+END SELECT; 
+ 
+. 
+  close document :
+ 
+ 
+. remaining y steps : param1
+.
+  close page :
+    IF remaining y steps > 0 THEN out (""12"") FI
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    out subtext (string, from, to)
+ 
+.
+  write cmd :
+    buffer := subtext (string, from, to);
+    IF   buffer = "nlq"
+         THEN is nlq := TRUE;
+              near letter quality;
+    ELIF buffer = "draft"
+         THEN is nlq := FALSE;
+              draft quality;
+         ELSE out (buffer);
+    FI;
+ 
+    . near letter quality :
+        IF factor = 6
+           THEN factor was 6 := TRUE;
+                factor       := 4; 
+           ELSE factor was 6 := FALSE;
+        FI;
+        IF condensed
+           THEN out (""27"x"0"")
+           ELSE out (""27"x"1"") 
+        FI;
+ 
+    . draft quality :
+        IF factor was 6
+           THEN factor was 6 := FALSE;
+                factor       := 6; 
+        FI;
+        out (""27"x"0"");
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    rest := 0;
+    out (""13"");
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF   x steps < 0 OR y steps < 0
+         THEN stop
+    ELIF x steps > 0
+         THEN x move
+    ELIF y steps > 0
+         THEN y move
+    FI;
+ 
+    . x move :
+        high := (x steps + rest) DIV factor;
+        rest := (x steps + rest) MOD factor;
+        out (""27"\");
+        out (code (high MOD 256));
+        out (code (high DIV 256));
+ 
+    . y move :
+        high := y steps DIV 255;
+        low  := y steps MOD 255;
+        IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;
+        IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
+ 
+. 
+  draw :
+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype
+         THEN stop
+    ELIF x steps > 0
+         THEN x draw
+    FI;
+ 
+    . x draw :
+        high := (x steps + rest) DIV 6;
+        rest := (x steps + rest) MOD 6;
+        IF high > 0
+           THEN low  := high MOD 255;
+                high := high DIV 255;
+                out (""27"V");
+                out (code (low));
+                out (""27"*"1""1""0""1""27"V"0"");
+                FOR low FROM 1 UPTO high
+                    REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; 
+        FI;
+ 
+ 
+. modification : param1
+.
+  on :
+    IF on string (modification) <> "" 
+       THEN out (on string (modification))
+       ELSE stop
+    FI
+ 
+.
+  off :
+    IF off string (modification) <> ""
+       THEN out (off string (modification))
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    buffer := font string (font nr);
+    out (buffer);
+    factor := pitch factor;
+    IF is nlq THEN near letter quality FI;
+ 
+    . pitch factor :                           (*             Mikroschritt *)
+        INT CONST font bits := code (buffer SUB 3);
+        IF   bit (font bits, 1) 
+             THEN condensed := FALSE;       2  (* proportional  1/360 Inch *)
+        ELIF pos (buffer, ""27"x"1"") <> 0
+             THEN condensed := FALSE;       4  (* near letter   1/180 Inch *)
+        ELIF bit (font bits, 2) 
+             THEN condensed := TRUE;        3  (* condensed     1/240 Inch *)
+        ELIF bit (font bits, 0) 
+             THEN condensed := FALSE;       4  (* elite         1/180 Inch *)
+             ELSE condensed := FALSE;       6  (* pica          1/120 Inch *)
+        FI
+ 
+END PROC execute;
+
+
+$end$
+INT VAR reply; DATASPACE VAR ds; FILE VAR file;
+ 
+PROC printer:
+ 
+  disable stop;
+  continue (server channel);
+  check error (error message);
+  ds := nilspace;
+  REP forget (ds);
+      execute print;
+      IF is error AND online THEN put error; clear error; FI;
+  PER;
+END PROC printer;
+ 
+PROC execute print:
+ 
+  LET ack = 0, fetch code = 11, file type = 1003;
+  enable stop;
+  ds := nilspace;
+  call (father, fetch code, ds, reply);
+  IF reply = ack CAND type (ds) = file type
+     THEN file := sequential file (input, ds);
+          print (file,
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+  FI;
+END PROC execute print;
+ 
+PROC check error(TEXT CONST message):
+ 
+  IF is error
+     THEN clear error; rename myself (message);
+          IF is error THEN end(myself) FI;
+          pause (9000); end(myself);
+  FI;
+END PROC check error;
+ 
+END PACKET printerdriver
+
+
diff --git a/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel b/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel
new file mode 100644
index 0000000..579f67f
--- /dev/null
+++ b/system/printer-24nadel/schulis-mathe-1.0/src/printer.24.nadel
@@ -0,0 +1,776 @@
+ 
+(*************************************************************************) 
+(*   Installationsprogramm für                Stand   :  3. 1.89         *) 
+(*      24-Nadel Drucker                      Version : 0.9              *) 
+(*                                            Autor   : hjh              *) 
+(*************************************************************************) 
+ 
+PACKET driver inst 24 
+ 
+ 
+       DEFINES treiber einrichten: 
+ 
+ 
+LET up = ""3""13""5"", 
+ 
+    generator name = "printer.24.nadel", 
+ 
+    description file name = "beschreibungen24", 
+    module file name = "module24"; 
+ 
+ 
+INT VAR pr channel, 
+        quality,
+        paper format number,
+        service option; 
+TEXT VAR fonttab name :: "", 
+         driver name :: ""; 
+TEXT VAR inp; 
+BOOL VAR was esc; 
+ 
+treiber einrichten 
+ 
+PROC treiber einrichten:
+
+  treiber einrichten (0)
+END PROC treiber einrichten;
+
+PROC treiber einrichten (INT CONST service opt): 
+ 
+  ask for print channel; 
+  main menu; 
+  IF installed 
+    THEN generate printer spool 
+    ELSE inform about restart 
+  FI. 
+ 
+  ask for printchannel: 
+    inits; 
+    page; 
+    headline ("Druckerkanal - Einstellung"); 
+    cursor (1, 15); 
+    putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); 
+    putline ("         'serverchannel (Kanalnummer)' in der Task """ + 
+             name (myself) + """"); 
+    putline ("         verändert werden."); 
+    REP 
+      cursor (1, 10);
+      put (""5"EUMEL-Kanalnummer des Druckerkanals:");
+      get (pr channel);
+      disable stop; 
+      serverchannel (pr channel);
+      BOOL VAR no error :: NOT is error; 
+      IF is error 
+        THEN cursor (1, 7); 
+             put error;
+             putline ("Eingabe korrigiert wiederholen!") 
+      FI; 
+      clear error; 
+      enable stop 
+    UNTIL no error PER. 
+ 
+  inits: 
+    line; 
+    IF single task 
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI; 
+    INT VAR choice;
+    service option := service opt.
+ 
+  single task:  (pcb (9) AND 255) = 1.
+ 
+  main menu: 
+    BOOL VAR installed :: FALSE; 
+    REP 
+      show main menu; 
+      get choice; 
+      treat choice 
+    UNTIL was esc OR installed PER. 
+ 
+  show main menu: 
+    page; 
+    headline("Hauptmenü 24-Nadel-Drucker"); 
+    putline (" 1. Brother");
+    putline (" 2. Epson");
+    putline (" 3. NEC"); 
+    putline (" 4. OKI");
+    putline (" 5. Toshiba").
+
+  get choice: 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Installation abbrechen"); 
+    ask user (5).
+ 
+  treat choice: 
+    SELECT int (inp) OF 
+      CASE 1: brother menu 
+      CASE 2: epson menu 
+      CASE 3: nec menu 
+      CASE 4: oki menu 
+      CASE 5: toshiba menu 
+    END SELECT. 
+ 
+  
+  brother menu: 
+    page;
+    headline ("brother - Menü"); 
+    putline (" 1. M-1724 L"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           brother m1724l inst
+    FI. 
+  
+    brother m1724l inst: 
+      putline ("brother M-1724 L"); 
+      line; 
+      putline ("Wählen Sie folgende DIP-Schalter Optionen:"); 
+      putline ("Emulationsmodus                IBM Proprinter XL ");
+      putline ("Automatischer Zeilenvorschub       Nein       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.brother"); 
+             generate ("brotherm1724l"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+  toshiba menu:
+    page;
+    headline ("TOSHIBA - Menü"); 
+    putline (" 1. P 321"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           toshiba p321 inst
+    FI. 
+  
+    toshiba p321 inst: 
+       putline ("TOSHIBA P 321"); 
+       putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+       putline ("S3-8  S3-7  S3-5  übrige Schalter"); 
+       putline ("OFF   OFF   *)    egal           "); 
+       putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+       show control options ("std speed, paper feed"); 
+       show material options("slow, fast"); 
+       show command options ("nlq, draft"); 
+       ask for quality; 
+       ask for papersize; 
+       IF all right 
+         THEN get fonttable ("fonttab.toshiba.p321"); 
+              generate ("toshp321"); 
+              adjust papersize; 
+              adjust quality; 
+              do ("papersize(21.0,30.48)"); 
+              installed := TRUE; 
+        FI. 
+ 
+  
+  epson menu: 
+    page; 
+    headline ("Epson - Menü"); 
+    putline (" 1. LQ 850"); 
+    putline (" 2. LQ 1050"); 
+    putline (" 3. LQ 1500"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (3); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1 : lq850 inst
+             CASE 2 : lq850 inst
+             CASE 3 : lq1500 inst
+           END SELECT
+    FI. 
+
+    lq850 inst:
+      IF choice = 1 
+         THEN putline ("Epson LQ 850")
+         ELSE putline ("Epson LQ 1050")
+      FI; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8");
+      putline ("egal  egal  egal  egal  egal  egal  *1)    OFF ");
+      putline ("*1) ON: Einzelblatteinzug, OFF: kein Einzug"); line;
+      putline ("SW2-1 SW2-2 SW2-3 SW2-4 SW2-5 SW2-6 SW2-7 SW2-8"); 
+      putline ("egal  egal  *2)                     OFF   OFF");
+      putline ("*2) SW2-2 bis SW2-6 müssen je nach Art der Schnittstelle "); 
+      putline ("    gesetzt werden (Druckerhandbuch)");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq850"); 
+             generate ("epsonlq850"); 
+             adjust quality; 
+             adjust papersize; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+  lq1500 inst:
+      putline ("EPSON LQ-1500");
+      show control options ("");
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.epson.lq1500"); 
+             generate ("epsonlq1500"); 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+  nec menu: 
+    page;
+    headline ("NEC - Menü"); 
+    putline (" 1. PINWRITER P5 "); 
+    putline (" 2. PINWRITER P6 "); 
+    putline (" 3. PINWRITER P7 "); 
+    putline (" 4. PINWRITER P6 PLUS"); 
+    putline (" 5. PINWRITER P7 PLUS"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (5); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : necp5p7 inst
+             CASE 2   : necp6 inst
+             CASE 3   : necp5p7 inst 
+             CASE 4   : necp6plus inst
+             CASE 5   : necp6plus inst
+           END SELECT
+    FI. 
+  
+     necp5p7 inst: 
+      IF choice = 1 
+         THEN putline ("NEC PINWRITER P5") 
+         ELSE putline ("NEC PINWRITER P7") 
+      FI; 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp5p7"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6 inst: 
+      putline ("NEC PINWRITER P6 "); 
+      show control options ("paper feed"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for quality; 
+      ask for papersize; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p5.new"); 
+             generate ("necp6"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE 
+      FI. 
+ 
+     necp6plus inst: 
+      IF choice = 4 
+         THEN putline ("NEC PINWRITER P6 PLUS") 
+         ELSE putline ("NEC PINWRITER P7 PLUS") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("CR FUNCTION             CR ONLY ");
+      show control options ("std speed, top margin, std typeface, paperfeed");
+      show material options ("slow, fast, draft, nlq, courier, souvenir"); 
+      show command options ("draft, nlq, courier, souvenir"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.nec.p6+"); 
+             generate ("necp6+"); 
+             adjust papersize; 
+             adjust quality; 
+             installed := TRUE;
+             IF choice = 5 THEN do ("papersize (34.544, 30.48)") FI; 
+      FI. 
+ 
+  oki menu: 
+    page; 
+    headline ("OKI - Menü"); 
+    putline (" 1. MICROLINE 390 IBM-/EPSON-kompatibel"); 
+    putline (" 2. MICROLINE 391 IBM-/EPSON-kompatibel"); 
+    putline (" 3. MICROLINE 393/393C EPSON-kompatibel");                   
+    putline (" 4. MICROLINE 393/393C IBM-kompatibel");                     
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (4); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1   : oki ml390 inst                                 
+             CASE 2   : oki ml390 inst                                 
+             CASE 3   : oki ml393eps inst 
+             CASE 4   : oki ml393ibm inst 
+           END SELECT
+    FI. 
+ 
+    oki ml390 inst:
+      IF choice = 1
+        THEN putline ("OKI Microline 390") ;
+        ELSE putline ("OKI Microline 391") ;
+      FI;
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           EPSON LQ ");
+      putline ("AUTO LF                  NO       ");
+      show control options ("paperfeed, std speed, top margin"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki390/391"); 
+             adjust papersize; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+ 
+    oki ml393eps inst:
+      putline ("OKI Microline 393 EPSON-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki"); 
+             generate ("oki393/393Ceps"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+    oki ml393ibm inst:
+      putline ("OKI Microline 393 IBM-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Wählen Sie folgende Optionen im Druckmenü des Druckers:"); 
+      putline ("EMULATION MODE           ASCII ");
+      putline ("AUTO LF                  NO    ");
+      show control options ("paperfeed, std speed, top margin, std typeface"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq, courier, kassette, schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for papersize; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.oki");
+             generate ("oki393/393Cibm"); 
+             adjust papersize; 
+             adjust quality;
+             installed := TRUE 
+      FI.
+ 
+ 
+ 
+generate printer spool: 
+   IF service opt = 0 
+      THEN forget (generator name, quiet); 
+           forget (driver name, quiet) 
+    FI;
+    eumel must advertise;
+    cursor (1, 10);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (2);
+    putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("         mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); 
+    putline ("         Drucker eingesetzt werden soll."); 
+    line (2); 
+    put ("Generierung beendet, weiter mit 'SV'");
+    break (quiet);
+    do ("spool manager (PROC printer)").
+ 
+  inform about restart: 
+    page; 
+    putline ("Es ist kein Druckertreiber installiert worden!"); 
+    line; 
+    putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+    line. 
+ 
+END PROC treiber einrichten; 
+ 
+PROC headline (TEXT CONST header): 
+ 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  put (header); 
+  line (2) 
+END PROC headline; 
+ 
+PROC ask user (INT CONST max choice): 
+ 
+  TEXT VAR exit; 
+  inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")  
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. 
+END PROC ask user;
+
+PROC show control options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); 
+  write ("papersize, std quality");
+  IF options <> "" 
+    THEN put (","); 
+         putline (options) 
+  FI
+END PROC show control options; 
+
+PROC show material options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche Materialwerte (#material(""..."")#):"); 
+  putline (options) 
+END PROC show material options; 
+ 
+PROC show command options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); 
+  putline (options) 
+END PROC show command options; 
+ 
+PROC ask for quality: 
+ 
+  line (1); 
+  putline ("Standard - Druckqualität:"); 
+  line; 
+  REP out (up); 
+    IF yes ("Draft Quality (schneller, aber nicht so schön)") 
+      THEN quality := 1; LEAVE ask for quality 
+    FI;
+    out (up);
+    IF yes ("Near Letter Quality (schöner, aber langsamer)")
+      THEN quality := 2; LEAVE ask for quality 
+    FI;
+  PER 
+END PROC ask for quality; 
+ 
+PROC adjust quality: 
+ 
+  IF quality = 1 
+    THEN do ("std quality (""draft"")") 
+    ELSE do ("std quality (""nlq"")") 
+  FI 
+END PROC adjust quality; 
+ 
+PROC ask for papersize : 
+LET up           = ""3""13""5"";
+ 
+  paper format number := paper format ; 
+ 
+    . paper format :
+        line (1); 
+        putline ("Papierformat:"); 
+        line;
+        REP out (up);
+            IF yes ("Endlospapier, 8 Zoll breit")
+               THEN LEAVE paper format WITH 1 FI;
+            out (up);
+            IF yes ("Endlospapier, 13.2 Zoll breit")
+               THEN LEAVE paper format WITH 2 FI;
+            out (up);
+            IF yes ("Einzelblatteinzug, DINA 4")
+               THEN LEAVE paper format WITH 3 FI;
+        PER;
+        0
+END PROC ask for papersize;
+ 
+ 
+PROC adjust papersize: 
+ 
+    SELECT paper format number OF 
+      CASE 1 : do("papersize ( 8.0 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 2 : do("papersize (13.2 * 2.54, 12.0 * 2.54)");
+               do ("paper feed (""tractor"")") 
+      CASE 3 : do("papersize (21.0, 29.7)");
+               do ("paper feed (""sheet"")") 
+    END SELECT
+ 
+END PROC adjust papersize; 
+ 
+BOOL PROC all right: 
+ 
+  line (3);
+  cursor (1,23); 
+  yes ("Soll der ausgewählte Druckertreiber installiert werden") 
+END PROC all right; 
+ 
+PROC get fonttable (TEXT CONST name): 
+ 
+  fonttab name := name; 
+  from archive ((description file name & module file name & fonttab name) 
+                                                                    - all); 
+  fonttable (fonttab name); 
+  command dialogue (FALSE); 
+  save (fonttab name, /"configurator"); 
+  IF service option = 0 
+    THEN forget (fonttab name) 
+  FI; 
+  command dialogue (TRUE); 
+END PROC get fonttable; 
+ 
+PROC from archive (THESAURUS CONST files):
+ 
+  IF highest entry (files) > 0 
+    THEN fetch from archive; 
+         release (archive);
+         putline ("Archiv abgemeldet !")
+  FI.
+ 
+  fetch from archive: 
+    THESAURUS VAR thes :: files; 
+    REP 
+      ask for archive;
+      reserve archive;
+      fetch (thes / ALL archive, archive);
+      thes := thes - all 
+    UNTIL highest entry (thes) = 0 PER.
+
+ask for archive:
+  line;
+  putline ("Bitte Archiv mit den Dateien"); 
+  TEXT VAR buffer;
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  line; 
+  putline ("Wenn eingelegt: Taste drücken !"); 
+  inchar (buffer). 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  disable stop;
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI;
+  enable stop.
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+ 
+PROC generate (TEXT CONST name): 
+ 
+  open files; 
+  read description; 
+  build programme; 
+  insert programme; 
+  forget files. 
+ 
+  open files: 
+    line (5); 
+    cursor (1, 20); 
+    putline (""4"Bitte warten !"); 
+    putline ("    - Der Treiber wird generiert."); 
+    driver name := "printer." + name + "(generiert)"; 
+    IF exists (driver name) 
+      THEN forget (driver name, quiet) 
+    FI; 
+    FILE VAR des file :: sequential file (modify, description file name), 
+             mod file :: sequential file (modify, module file name), 
+             driver file :: sequential file (output, driver name). 
+ 
+  read description: 
+    to line (des file, 1); 
+    col (des file, 1);
+    downety (des file, "$" + name + "$"); 
+    IF eof (des file) 
+      THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + 
+                      "Descriptions-File enthalten")
+    FI; 
+    TEXT VAR description :: "", 
+             record; 
+    BOOL VAR done :: FALSE; 
+    read record (des file, record); 
+    record := subtext (record, col (des file) + LENGTH name + 2);
+    WHILE NOT eof (des file) AND NOT done REP 
+      treat record
+    PER. 
+ 
+  treat record: 
+    INT VAR dollar pos :: pos (record, "$"); 
+    IF dollar pos = 0
+      THEN description CAT compress (record); 
+           down (des file); 
+           read record (des file, record)  
+      ELSE description CAT compress (subtext (record, 1, dollar pos - 1));
+           col (des file, dollar pos); 
+           done := TRUE; 
+    FI. 
+ 
+  build programme: 
+    get module name; 
+    WHILE still modules REP 
+      find module; 
+      transfer module; 
+      get module name 
+    PER. 
+ 
+  get module name: 
+    INT VAR semicol pos :: pos (description, ";"); 
+    TEXT VAR module name; 
+    IF semicol pos > 0 
+      THEN module name := subtext (description, 1, semicol pos - 1); 
+           description := subtext (description, semicol pos + 1) 
+      ELSE module name := description; 
+           description := "" 
+    FI.
+ 
+  still modules: 
+    module name <> "" OR description <> "". 
+ 
+  find module: 
+    to line (mod file, 1); 
+    col (mod file, 1); 
+    downety (mod file, "$" + module name + "$"); 
+    IF eof (mod file) 
+      THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + 
+                      "Modul-File enthalten")
+    FI. 
+ 
+  transfer module: 
+    done := FALSE; 
+    read record (mod file, record); 
+    record := subtext (record, col (mod file) + LENGTH module name + 2);
+    WHILE NOT eof (mod file) AND NOT done REP 
+      transfer record
+    PER. 
+ 
+  transfer record: 
+    dollar pos := pos (record, "$"); 
+    IF dollar pos = 0
+      THEN write (driver file, compress (record)); 
+           line (driver file);
+           down (mod file); 
+           read record (mod file, record)  
+      ELSE write (driver file, compress (subtext (record, 1, 
+                                            dollar pos - 1)));
+           col (mod file, dollar pos); 
+           done := TRUE; 
+           cout (line no (mod file)) 
+    FI. 
+ 
+  insert programme: 
+    IF online 
+      THEN putline ("    - Der Treiber wird insertiert.") 
+    FI;
+    check off; 
+    insert (driver name). 
+ 
+  forget files: 
+    IF service option = 0 
+      THEN forget (description file name, quiet); 
+           forget (module file name, quiet)
+    FI  .
+END PROC generate; 
+ 
+END PACKET driver inst 24
+
diff --git a/system/printer-24nadel/schulis-sim-3.0 b/system/printer-24nadel/schulis-sim-3.0
new file mode 120000
index 0000000..5ca05f9
--- /dev/null
+++ b/system/printer-24nadel/schulis-sim-3.0
@@ -0,0 +1 @@
+schulis-mathe-1.0/
\ No newline at end of file
diff --git a/system/printer-9nadel/0.9/doc/readme b/system/printer-9nadel/0.9/doc/readme
new file mode 100644
index 0000000..2047abe
--- /dev/null
+++ b/system/printer-9nadel/0.9/doc/readme
@@ -0,0 +1,324 @@
+#type("nlq10")##limit(18.0)##start(1.5,1.0)# 
+#head# 
+Treiber-Installations-Programm   #right#Seite % 
+für 9-Nadel-Matrixdrucker   #right#23.06.1988 
+ 
+ 
+#end# 
+#on("u")#Dokumentation zum Treiber-Installations-Programm für 9-Nadel-
+Matrixdrucker#off("u")# 
+ 
+#on("u")#Inhalt:#off("u")# 
+ 
+1. Installations- und Gebrauchsanleitung 
+2. Druckertreiber-Auswahl 
+3. Steuerungsmöglichkeiten und Spezialfeatures 
+4. Weitere Hinweise 
+ 
+ 
+#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# 
+ 
+#on("u")#Einrichten#off("u")# 
+So wird das Treiber-Installationsprogramm eingerichtet: 
+ 
+       SV drücken 
+ 
+    nach 'gib supervisor kommando:' 
+ 
+       begin("PRINTER","SYSUR") 
+ 
+    in der Task "PRINTER" (nach 'gib kommando'): 
+ 
+       archive ("std.printer") 
+       fetch ("printer.neun.nadel",archive) 
+       check off 
+       insert ("printer.neun.nadel") 
+ 
+Das Programm wird dann insertiert. 
+ 
+#on("u")#Druckerkanal#off("u")# 
+Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker
+über Parallelschnittstelle betrieben wird, ist die Kanalnummer
+meistens 15. 
+ 
+#on("u")#Menüsystem#off("u")# 
+Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern.
+Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste
+der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier
+den passenden Typ aus! 
+Das Installationsprogramm zeigt nun einige Informationen zu dem ange­
+wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi­
+guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt
+wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei­
+ber betrieben werden soll. 
+ 
+Hinweise zu Konfigurationsangaben: 
+1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion
+   des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf
+   achten, welche Funktion die Schalter haben (Druckerhandbuch!). So
+   ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu
+   aktivieren, damit der Drucker nach Papierende nicht auf der Walze
+   weiterdruckt. 
+2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge­
+   wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker
+   als den ausgewählten verwenden, dann beachten Sie folgende Regeln
+   für die Konfiguration: 
+   - Der Drucker muß auf eine passende Emulation konfiguriert werden. 
+   - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei­
+     lenvorschub durchführen. 
+   - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. 
+ 
+   - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht
+     achten. 
+ 
+(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) 
+ 
+Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des
+ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) 
+ 
+Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er­
+laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt,
+welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein­
+stellungen können nachträglich in der Task "PRINTER" mit den entspre­
+chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte
+Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck­
+datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku­
+ments verändert werden (direkte Druckeranweisung \#"..."\#). 
+Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. 
+ 
+ 
+#on("b")#2. Druckertreiber-Auswahl#off("b")# 
+ 
+#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# 
+Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll­
+ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker
+des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. 
+Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im
+Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!),
+welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist.
+(Viele Drucker verfügen über EPSON FX-85 bzw. FX-800-Emulationen oder
+IBM Grafikdrucker bzw. Proprinter-Eumulationen.) 
+Eine der beiden Anpassungen 'EPSON MX' oder 'IBM-Grafikdrucker' müßte
+immer einen (Minimal-) Betrieb ermöglichen. 
+ 
+#on("u")#Hinweise zu den Treibern für FX-80/85-kompatilble Drucker#off("u")# 
+Die Treiber für FX-80-bzw. FX-85-kompatible Geräte, die oft auch IBM-
+kompatibel sind, basieren üblicherweise auf den Treibern für EPSON-
+Drucker, weil so einige Schrifttypen (z.B. Proportionalschrift) und
+Modifikationen leichter ausgenutzt werden können. Ein Nachteil liegt
+aber darin, daß beim FX-80 und FX-85 noch die alten EPSON-Zeichensätze
+benutzt werden, die nicht die IBM-üblichen Grafik- und Sonderzeichen
+enthalten. 
+Falls für Sie die Benutzung dieser Zeichen vordringlich ist, sollten
+Sie Ihren Drucker (nachdem er auf IBM-Emulation konfiguriert wurde)
+zusammen mit dem Treiber für IBM-Grafikdrucker bzw. -Proprinter ver­
+wenden. 
+ 
+ 
+#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# 
+ 
+Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B.
+DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). 
+Die Einstellungen können über 
+- Steuerprozeduren 
+- Materialanweisungen bzw. 
+- direkte Druckeranweisungen 
+vorgenommen werden. 
+ 
+#on("u")#Steuerprozeduren#off("u")# 
+setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten
+sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER")
+aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in
+der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# 
+ 
+PROC papersize (REAL CONST breite, länge) 
+    Dient zur Einstellung der Größe der physikalisch beschreibbaren
+    Fläche. 
+    Beispiel:  papersize (20.32, 30.48) 
+               (Standardeinstellung für Endlospapier 8 Zoll breit und
+               12 Zoll lang) 
+ 
+PROC papersize 
+    Informationsprozedur 
+ 
+PROC top margin (REAL CONST margin) 
+    Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk­
+    ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser
+    Prozedur die Länge des oberen Randes, den der Drucker nicht be­
+    drucken kann, in cm angegeben werden. 
+    Beispiel:  top margin (2.0) 
+               (Teilt dem Druckertreiber mit, daß die ersten 2 cm
+               nicht bedruckbar sind.) 
+ 
+REAL PROC top margin 
+    Informationsprozedur 
+ 
+PROC std speed (TEXT CONST speed) 
+    Parameter: slow, fast 
+    Wahl zwischen Positionierung in Mikroschritten (slow) oder in
+    Blanks (fast). 
+    Beispiel:  std speed ("slow") 
+ 
+TEXR PROC std speed 
+    Informationsprozedur 
+ 
+PROC std quality (TEXT CONST quality) 
+    übliche Parameter: draft, nlq 
+    Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift-
+    Qualität 
+    Beispiel:  std quality ("draft") 
+ 
+TEXT PROC std quality 
+    Informationsprozedur 
+ 
+PROC std typeface (TEXT CONST typeface) 
+    übliche Parameter: roman, sansserif, courier 
+    Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im
+    NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). 
+    Beispiel: std typeface ("roman") 
+ 
+TEXT PROC std typeface 
+    Informationsprozedur 
+ 
+PROC paper feed (TEXT CONST name) 
+    übliche Parameter: tractor, sheet, schacht1, schacht2 
+    Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. 
+    Beispiel:  paper feed ("sheet") 
+ 
+TEXT PROC paper feed 
+    Informationsprozedur 
+ 
+ 
+#on("u")#Materialanweisungen \#material("...")\##off("u")# 
+müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und
+setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben
+für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­
+stellten Standardwerten. Diese werden durch die Materialanweisung aber
+nicht geändert.) 
+ 
+Beispiel:  \#material("nlq")\# 
+           sorgt bei entsprechendem Treiber dafür, daß das gesamte
+           Dokument in Schönschrift-Qualität ausgedruckt wird, egal
+           wie 'std quality' eingestellt ist. 
+ 
+#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh­
+rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung
+erscheinen. Beispiel:  \#material("sheet;draft")\# 
+ 
+ 
+#on("u")#direkte Druckeranweisungen \#"..."\##off("u")# 
+gelten ab der Position, an der sie in der Datei auftreten. Sie haben
+(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und
+Materialeinstellungen. 
+ 
+Beispiel:  \#"draft"\# 
+           schaltet (bei entsprechendem Treiber) auf Datenverar­
+           beitungs-Qualität, egal welche Standardeinstellung vorliegt
+           und welche Materialanweisung gegeben wurde. 
+ 
+#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen
+werden.#off("b")# Also:  \#"nlq"\#\#"sansserif"\# 
+ 
+ 
+#on("u")#Wichtig#off("u")# 
+- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen
+  besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben
+  berücksichtigt! Also:  \#"nlq"\# und keinesfalls \#"NLQ"\#!!! 
+- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und
+  nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann
+  daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse
+  erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen
+  Reihenfolge an den Drucker sendet, als er in der Datei steht, die
+  mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B.
+  für beide Spalten) unerwünscht erhalten bleibt. 
+ 
+ 
+#on("u")#Tabelle#off("u")# 
+Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel­
+lungen erfolgen können. 
+ 
+#type("17")# 
+                   Steuerprozeduren      Materialanweisungen     direkte Druckeranweisungen 
+ 
+#on("u")#                                                                                          #off("u")# 
+ 
+Positionierung     std speed             slow, fast              ------ 
+                     slow, fast 
+ 
+Qualität           std quality           z.B. draft, nlq         z.B. draft, nlq 
+                     z.B. draft, nlq 
+ 
+Schriftart         std typeface          z.B. roman,             z.B. roman, 
+(nur bei NLQ)        z.B. roman,         sansserif, courier      sansserif, courier 
+                     sansserif, courier 
+ 
+Einzelblatt-       paper feed            z.B. schacht1,          z.B. schacht1, 
+einzug               z.B. tractor,       schacht2                schacht2 
+                     sheet, 
+                     schacht1, schacht2 
+ 
+Farbdruck          ------                ------                  z.B. schwarz, 
+                                                                 rot, blau, 
+                                                                 violett, gelb 
+                                                                 orange, grün 
+ 
+ 
+ 
+#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# 
+ 
+#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# 
+In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb
+des Codes 127 einige internationale Zeichen zur Verfügung gestellt
+(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). 
+Bei den Treibern der vorliegenden Version gilt folgendes: 
+- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL-
+  Zeichensatz (sofern möglich) unterstützt. 
+- Der Code 252 liefert das Paragraphzeichen. 
+- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes
+  oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des
+  IBM-Grafikzeichensatzes. 
+ 
+ 
+#on("u")#Hinweis zu Proportionalschriften#off("u")# 
+Bei Proportionalschriften sollte die Modifikation \#on("i")\# nicht
+benutzt werden, da die kursiven Zeichen andere Proportionalbreiten
+haben. Stattdessen sollte auf den schrägen Typ umgeschaltet werden
+(z.B. von "prop10" auf "prop10i"). 
+ 
+ 
+#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# 
+Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel­
+lungen vorgenommen werden (vgl. auch Abschnitt 3!): 
+ 
+   Am Drucker: 
+1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug konfigu­
+   rieren (siehe Druckerhandbuch!). 
+ 
+   In der Druckspooltask (meist 'PRINTER'): 
+2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü­
+   gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für
+   2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed
+   ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. 
+3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen­
+   den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel­
+   len. 
+   Beispiel:  papersize (21.0, 29.7) 
+              (für DIN A4-Blätter) 
+4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt­
+   anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß
+   mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem
+   Druckertreiber mitgeteilt werden. 
+   Beispiel:  top margin (1.5) 
+   (Wie groß der obere Rand ist, kann festgestellt werden, indem eine
+   Datei mit \#start(0.0,0.0)\# ausgedruckt wird.) 
+ 
+   Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren
+   Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien
+   ein genügend großer y-Wert für die Startposition eingestellt wird
+   ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der
+   ersten Zeile zu Überschreibungen. 
+ 
+ 
+#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben
+   werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# 
+
diff --git a/system/printer-9nadel/0.9/source-disk b/system/printer-9nadel/0.9/source-disk
new file mode 100644
index 0000000..ddcd852
--- /dev/null
+++ b/system/printer-9nadel/0.9/source-disk
@@ -0,0 +1 @@
+grundpaket/06_std.printer_9_nadel.img
diff --git a/system/printer-9nadel/0.9/src/beschreibungen9 b/system/printer-9nadel/0.9/src/beschreibungen9
new file mode 100644
index 0000000..6a74b88
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/beschreibungen9
@@ -0,0 +1,97 @@
+ 
+(*************************************************************************)
+(*                                            Stand   : 01.10.88         *)
+(*  Beschreibungen-Datei für 9-Nadel-Drucker  Version : 0.9              *)
+(*                                            Autoren : mov/hjh          *)
+(*************************************************************************)
+ 
+$fx85$ 
+head;hfx85;decl;speed;openh;opendoch;initspeed;opendocfx85;openpge;betwoc; 
+clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 
+
+$fx800$ 
+head;hfx800;decl;quality;typeface;openh;opendoch;opendocfx800;openpge;betwoc; 
+clpge;betwce;cmdfx800;crs;moh;mofx800;ymodr;onoff;tyfx800;end 
+
+$mx$ 
+head;hmx;decl;speed;openh;opendoch;initspeed;opendocmx;openpge;betwoc;clpge; 
+betwce;cmd;crs;moh;modrmx;onoff;tymx;end 
+ 
+$lx800$ 
+head;hlx800;decl;speed;quality;typeface;openh;opendoch;initspeed; 
+opendocfx800;openpge;betwoc;clpge;betwce;cmdfx800;crs;moh;mofx85;ymodr;onoff; 
+tyfx800;end 
+
+$ibmgp$ 
+head;hgp;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; 
+clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end 
+ 
+$ibmpp$ 
+head;hpp;decl;speed;quality;openh;opendoch;initspeed;opendocpp;openpge; 
+betwoc;clpge;betwce;cmdpp;crs;moh;mofx85;ymodr;onoffpp;tyfx85;end 
+ 
+$okiml182i$
+head;hml182i;decl;speed;quality;openh;opendoch;initspeed;opendocml182i; 
+opendocgp;openpge;betwoc;clpge;betwce;cmdml182i;crs;moh;mogp;ymodr;onoff; 
+tyohnesmall;end 
+ 
+$okiml192el$ 
+head;hml192el;decl;speed;feed;openh;opendoch;initspeed;opendocml192el; 
+openpgemlsf;betwoc;clmlsf;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; 
+end 
+ 
+$okiml292el$ 
+head;hml292el;decl;quality;typeface292;feed;openh;opendoch;opendocml292el; 
+openpgemlsf;betwoc;clmlsf;betwce;cmdml292el;crs;moh;mofx800;ymodr;onoff; 
+tyml292el;end 
+ 
+$okiml294i$ 
+head;hml294i;decl;speed;quality;feed;openh;opendoch;initspeed;opendocml294i; 
+openpgemlsf;betwoc;clmlsf;betwce;cmdml294i;crs;moh;mofx85;ymodr;ontyml294i;end 
+ 
+$okiml320$ 
+head;hml320;decl;speed;openh;opendoch;initspeed;opendocml320; 
+openpge;betwoc;clpge;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; 
+end 
+ 
+$starlc10$ 
+head;hlc10;decl;quality;typefacelc10;openh;opendoch;opendoclc10;openpge; 
+betwoc;clpge;betwce;cmdlc10;crs;moh;mofx800;ymodr;onoff;tyfx800;end 
+ 
+$dmp4000$ 
+head;hdmp4000;decl;speed;openh;opendoch;initspeed;opendocdmp4000;openpge; 
+betwoc;clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 
+ 
+$starnx15$ 
+head;hnx15;decl;speed;openh;opendoch;initspeed;opendocnx15;openpge;betwoc; 
+clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 
+ 
+$mt230$ 
+head;hmt230;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; 
+openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;mofx85;ymodr;onoff; 
+tyfx85;end 
+ 
+$mt340$ 
+head;hmt340;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; 
+openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;moml192el;ymodr;onoff; 
+tyml192el;end 
+ 
+$citi120d$ 
+head;h120d;decl;openh;opendoch;opendoc120d;openpge;betwoc; 
+clpge;betwce;cmd;crs;moh;mofx800;ymodr;onoff;tyfx85;end 
+ 
+$citohc310cxp$ 
+head;hc310;decl;speed;feedschacht;openh;opendoch;initspeed;opendocc310; 
+openpgec310sf;betwoc;clc310sf;betwce;cmdc310;crs;moh;mofx85;ymodr;onoff; 
+tyfx85;end 
+ 
+$citohci3500$ 
+head;hci3500;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; 
+clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end 
+ 
+$fujdx2100$ 
+head;hdx2100;decl;speed;feed;openh;opendoch;initspeed;opendocdx2100; 
+openpge;betwoc;clpge;betwce;cmddx2100;crs;moh;moml192el;ymodr;onoff;tyml192el; 
+end 
+
+
diff --git a/system/printer-9nadel/0.9/src/fonttab.1 b/system/printer-9nadel/0.9/src/fonttab.1
new file mode 100644
index 0000000..b5d17e6
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.1
diff --git a/system/printer-9nadel/0.9/src/fonttab.10 b/system/printer-9nadel/0.9/src/fonttab.10
new file mode 100644
index 0000000..6a13c49
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.10
diff --git a/system/printer-9nadel/0.9/src/fonttab.20 b/system/printer-9nadel/0.9/src/fonttab.20
new file mode 100644
index 0000000..7cf0aaf
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.20
diff --git a/system/printer-9nadel/0.9/src/fonttab.20.lc b/system/printer-9nadel/0.9/src/fonttab.20.lc
new file mode 100644
index 0000000..ddf4535
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.20.lc
diff --git a/system/printer-9nadel/0.9/src/fonttab.20.lx b/system/printer-9nadel/0.9/src/fonttab.20.lx
new file mode 100644
index 0000000..1ce0940
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.20.lx
diff --git a/system/printer-9nadel/0.9/src/fonttab.7 b/system/printer-9nadel/0.9/src/fonttab.7
new file mode 100644
index 0000000..676b9a0
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.7
diff --git a/system/printer-9nadel/0.9/src/fonttab.7.cxp b/system/printer-9nadel/0.9/src/fonttab.7.cxp
new file mode 100644
index 0000000..0a996f3
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.7.cxp
diff --git a/system/printer-9nadel/0.9/src/fonttab.7.fuj b/system/printer-9nadel/0.9/src/fonttab.7.fuj
new file mode 100644
index 0000000..1ed83be
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.7.fuj
diff --git a/system/printer-9nadel/0.9/src/fonttab.7.mt b/system/printer-9nadel/0.9/src/fonttab.7.mt
new file mode 100644
index 0000000..c816646
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/fonttab.7.mt
diff --git a/system/printer-9nadel/0.9/src/module9 b/system/printer-9nadel/0.9/src/module9
new file mode 100644
index 0000000..65de1ee
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/module9
@@ -0,0 +1,1099 @@
+ 
+(*************************************************************************)
+(*                                            Stand   : 01.10.88         *)
+(*   Module-Datei für 9-Nadel-Drucker         Version : 0.9              *)
+(*                                            Autoren : mov/hjh          *)
+(*************************************************************************)
+
+$head$ 
+PACKET printer driver 
+ 
+       DEFINES printer,
+               open,
+               close,
+               execute,
+               paper size,
+               top margin,
+
+$hfx85$        std speed:
+(* Treiber für EPSON FX85/105, automatisch generiert *)
+
+$hfx800$       std quality,
+               std typeface:
+(* Treiber für EPSON FX800/1000, automatisch generiert *) 
+BOOL VAR was tall font;
+ 
+$hmx$          std speed:
+(* Treiber für EPSON MX80/100, Typ III *) 
+(* Treiber automatisch generiert *)
+BOOL VAR is condensed, is small;
+
+$hlx800$       std speed, 
+               std quality,
+               std typeface:
+(* Treiber für EPSON LX800/1000, automatisch generiert *) 
+BOOL VAR was tall font;
+
+$hgp$          std speed: 
+(* Treiber für IBM-Grafikdrucker *) 
+(* Treiber automatisch generiert *) 
+
+$hpp$          std speed, 
+               std quality:
+(* Treiber für IBM-Proprinter *) 
+(* Treiber automatisch generiert *) 
+ 
+$hml182i$      std speed,
+               std quality:
+(* Treiber für OKI ML182/183 IBM-kompatibel *) 
+(* Treiber automatisch generiert *) 
+ 
+$hml192el$     paper feed,
+               std speed:
+(* Treiber für OKI ML192/193 Elite *) 
+(* Treiber automatisch generiert *) 
+BOOL VAR prop font;
+ 
+$hml292el$     std quality, 
+               std typeface, 
+               paper feed: 
+(* Treiber für OKI ML292/293 Elite *) 
+(* Treiber automatisch generiert *) 
+BOOL VAR was tall font;
+
+$hml294i$      std speed, 
+               paper feed,
+               std quality:
+(* Treiber für OKI ML294 IBM-kompatibel *)
+(* Treiber automatisch generiert *) 
+
+$hml320$       std speed:
+(* Treiber für OKI ML320 IBM/EPSON-kompatibel *) 
+(* Treiber automatisch generiert *) 
+BOOL VAR prop font;
+ 
+$hlc10$        std quality, 
+               std typeface:
+(* Treiber für Star LC-10 oder LC-10 Colour *) 
+(* Treiber automatisch generiert *) 
+BOOL VAR was tall font;
+ 
+$hdmp4000$     std speed:
+(* Treiber für Schneider DMP4000, automatisch generiert *)
+ 
+$hnx15$        std speed:
+(* Treiber für Star NX-15, ND-10, ND-15, NR-10 und NR-15 *)
+(* Treiber automatisch generiert *)
+ 
+$hmt230$       paper feed, 
+               std speed: 
+(* Treiber für Mannesmann-Tally MT 230 *) 
+(* Treiber automatisch generiert *) 
+ 
+$hmt340$       paper feed,
+               std speed:
+(* Treiber für Mannesmann-Tally MT 340 *) 
+(* Treiber automatisch generiert *) 
+BOOL VAR prop font := FALSE; 
+ 
+$h120d$        : 
+(* Treiber für Citizen 120-D *) 
+(* Treiber automatisch generiert *) 
+ 
+$hc310$        paper feed,
+               std speed:
+(* Treiber für C. Itoh C 310/315 CXP *) 
+(* Treiber automatisch generiert *) 
+
+$hci3500$      std speed: 
+(* Treiber für C. Itoh CI-3500 *) 
+(* Treiber automatisch generiert *) 
+ 
+$hdx2100$     paper feed,
+              std speed:
+(* Treiber für Fujitsu DX 2100 *)
+(* Treiber automatisch generiert *)
+BOOL VAR prop font := FALSE ;
+ 
+$decl$
+INT VAR blankbreite, x rest, y rest, high, low, small, modifikations;
+REAL VAR x size, y size, y margin;
+TEXT VAR buffer :: "";
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+END PROC paper size;
+ 
+papersize (20.32, 30.48); 
+ 
+PROC top margin (REAL CONST margin): 
+ 
+  y margin := margin 
+END PROC top margin; 
+ 
+REAL PROC top margin:   y margin   END PROC top margin;
+ 
+top margin (0.0); 
+ 
+$speed$
+BOOL VAR is slow; 
+TEXT VAR std speed name :: "slow";
+ 
+PROC std speed (TEXT CONST speed) :
+ 
+  IF speed = "fast" OR speed = "slow"
+     THEN std speed name := speed
+     ELSE errorstop ("unzulässige Geschwindigkeit")
+  FI
+END PROC std speed;
+ 
+TEXT PROC std speed : std speed name END PROC std speed;
+ 
+$quality$ 
+TEXT VAR std quality name :: "draft";
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality
+     ELSE errorstop ("unzulässige Qualitätsbezeichnung")
+  FI
+END PROC std quality;
+ 
+TEXT PROC std quality : std quality name END PROC std quality;
+ 
+$typeface$ 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "roman" OR typeface = "sansserif"
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : std typeface name END PROC std typeface;
+ 
+$typeface292$ 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "courier" OR typeface = "sansserif"
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : std typeface name END PROC std typeface;
+ 
+$typefacelc10$ 
+TEXT VAR std typeface name :: "";
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  IF typeface = "" OR typeface = "courier" OR typeface = "sansserif" 
+                   OR typeface = "orator1" OR typeface = "orator2" 
+     THEN std typeface name := typeface
+     ELSE errorstop ("unzulässige Schriftart")
+  FI
+END PROC std typeface;
+ 
+TEXT PROC std typeface : std typeface name END PROC std typeface;
+ 
+$feed$ 
+TEXT VAR feeder name :: "tractor";
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "sheet" OR feeder = "tractor"
+     THEN feeder name := feeder
+     ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: feeder name END PROC paper feed;
+ 
+$feedschacht$
+TEXT VAR act feeder :: "", 
+         feeder name :: "tractor";
+ 
+PROC paper feed (TEXT CONST feeder) :
+ 
+  IF feeder = "tractor" OR feeder = "schacht1" OR feeder = "schacht2" 
+     THEN feeder name := feeder
+  ELIF feeder = "sheet" 
+     THEN feeder name := "schacht1" 
+     ELSE errorstop ("unzulässige Einzugsart")
+  FI
+END PROC paper feed;
+ 
+TEXT PROC paper feed: feeder name END PROC paper feed;
+ 
+$openh$
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE 1: open document 
+  CASE 2: open page
+END SELECT.
+ 
+$opendoch$
+  open document :
+    modifikations := 0; 
+    param 1 := x step conversion ( x size );
+    param 2 := y step conversion ( y size );
+$initspeed$ 
+    IF pos (material, "slow") <> 0 
+         THEN is slow := TRUE;
+    ELIF pos (material, "fast") <> 0 
+         THEN is slow := FALSE;
+         ELSE is slow := std speed name = "slow"
+    FI;
+$opendocfx85$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"R"0""27"2"27"6");
+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)
+ 
+$opendocfx800$ 
+    param 2 := (param 2 DIV 36) * 36;
+    was tall font := TRUE; 
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)
+    out (""27"R"0""27"9"27"O"27"2"); 
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)
+    IF pos (material, "nlq") <> 0 
+      THEN out (""27"x"1"") 
+    ELIF pos (material, "draft") <> 0 
+      THEN out (""27"x"0"") 
+    ELIF std quality name = "nlq"
+      THEN out (""27"x"1"") 
+      ELSE out (""27"x"0"")
+    FI; 
+    IF pos (material, "roman") <> 0 
+         THEN out (""27"k"0"") 
+    ELIF pos (material, "sansserif") <> 0 
+         THEN out (""27"k"1"") 
+    ELIF std typeface name = "roman" 
+      THEN out (""27"k"0"") 
+    ELIF std typeface name = "sansserif" 
+      THEN out (""27"k"1"") 
+    FI. 
+ 
+$opendocmx$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27"R"0""27""64"");               (* Reset des Druckers *) 
+    out (""27"R"0""27"2");
+    out (""27"C" + code (param 2 DIV 36));  (* Formularlaenge *) 
+    out (""27"9"27"O").
+ 
+$opendocgp$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27"6");                               (* Zeichensatz 2 *)
+    out (""18""27"F"27"H"27"W"0""27"T"27"-"0""); (* Modifikationen rücksetzen *) 
+    out (""27"9"27"O"27"A"12""27"2"); 
+    out (""27"C" + code (param 2 DIV 36)).       (* Formularlaenge *)
+ 
+$opendocpp$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27"6");                               (* Zeichensatz 2 *)
+    out (""18""27"F"27"W"0""27"T"27"-"0"");      (* Modifikationen rücksetzen *) 
+    out (""27"9"27"O"27"A"12""27"2"); 
+    out (""27"C" + code (param 2 DIV 36));       (* Formularlaenge *)
+    IF pos (material, "nlq") <> 0 
+      THEN out (""27"G")
+    ELIF pos (material, "draft") <> 0 
+      THEN out (""27"H") 
+    ELIF std quality name = "nlq" 
+      THEN out (""27"G") 
+      ELSE out (""27"H") 
+    FI. 
+    
+$opendocml182i$ 
+    IF pos (material, "nlq") <> 0 
+      THEN out (""27"I3") 
+    ELIF pos (material, "draft") <> 0 
+      THEN out (""27"I1") 
+    ELIF std quality name = "nlq"
+      THEN out (""27"I3") 
+      ELSE out (""27"I1")
+    FI; 
+    out (""27"N"0"");           (* Kein Sprung über Perf. *)
+
+$opendocml192el$ 
+    param 2 := (param 2 DIV 36) * 36;
+    prop font := FALSE;
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"R"0""27"2");
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) 
+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)
+    out (""27"9"27"O"27"x"0"").
+ 
+$opendocml292el$ 
+    param 2 := (param 2 DIV 36) * 36;
+    was tall font := TRUE; 
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)
+    out (""27"R"0""27"2");
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)
+    out (""27"9"27"O"27"r0"); 
+    IF pos (material, "nlq") <> 0 
+      THEN out (""27"x"1"") 
+    ELIF pos (material, "draft") <> 0 
+      THEN out (""27"x"0"") 
+    ELIF std quality name = "nlq"
+      THEN out (""27"x"1"") 
+      ELSE out (""27"x"0"")
+    FI; 
+    IF pos (material, "courier") <> 0 
+         THEN out (""27"k"0"") 
+    ELIF pos (material, "sansserif") <> 0 
+         THEN out (""27"k"1"") 
+    ELIF std typeface name = "courier" 
+      THEN out (""27"k"0"") 
+    ELIF std typeface name = "sansserif" 
+      THEN out (""27"k"1"") 
+    FI. 
+ 
+$opendocml294i$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27"6");                               (* Zeichensatz 2 *)
+    out (""18""27"F"27"W0"27"T"27"-0"27"%H");    (* Modifikationen rücksetzen *) 
+    out (""27"9"27"O"27"A"12""27"2");
+    out (""27"C" + code (param 2 DIV 36));       (* Formularlaenge *)
+    IF pos (material, "nlq") <> 0 
+      THEN out (""27"G")
+    ELIF pos (material, "draft") <> 0 
+      THEN out (""27"H") 
+    ELIF std quality name = "nlq" 
+      THEN out (""27"G") 
+      ELSE out (""27"H") 
+    FI. 
+ 
+$opendocml320$ 
+    param 2 := (param 2 DIV 36) * 36;
+    prop font := FALSE;
+    out (""27"{"99""27"{"40"");            (* Umschaltung auf EPSON-Emulation *) 
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"R"0""27"2");
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) 
+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)
+    out (""27"9"27"O"27"x"0"").
+ 
+$opendoclc10$ 
+    param 2 := (param 2 DIV 36) * 36;
+    was tall font := TRUE; 
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)
+    out (""27"R"0""27"2");
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)
+    out (""27"9"27"r"0"");
+    IF pos (material, "nlq") <> 0 
+      THEN out (""27"x"1"") 
+    ELIF pos (material, "draft") <> 0 
+      THEN out (""27"x"0"") 
+    ELIF std quality name = "nlq"
+      THEN out (""27"x"1"") 
+      ELSE out (""27"x"0"")
+    FI; 
+    IF pos (material, "courier") <> 0 
+         THEN out (""27"k"0"") 
+    ELIF pos (material, "sansserif") <> 0 
+         THEN out (""27"k"1"") 
+    ELIF pos (material, "orator1") <> 0 
+         THEN out (""27"k"2"") 
+    ELIF pos (material, "orator2") <> 0 
+         THEN out (""27"k"3"") 
+    ELIF std typeface name = "courier" 
+      THEN out (""27"k"0"") 
+    ELIF std typeface name = "sansserif" 
+      THEN out (""27"k"1"") 
+    ELIF std typeface name = "orator1" 
+      THEN out (""27"k"2"") 
+    ELIF std typeface name = "orator2" 
+      THEN out (""27"k"3"") 
+    FI. 
+ 
+$opendocnx15$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"R"0""27"2"); 
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)
+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)
+    out (""27"9"27"x"0"").
+ 
+$opendocdmp4000$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27""64""27""64"");              (* Reset des Druckers *) 
+    out (""27"m"0""27"R"0""27"9"27"O"27"2"27"6");
+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)
+ 
+$opendocmt$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"R"0""27"2");
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)
+    out (""27"O"27"x"0""27"r"0""27"6"); 
+    IF feeder name = "tractor" 
+      THEN act feeder := feeder name; 
+           out (""27"[5{") 
+      ELSE out (""27"[0{");
+           IF pos (material, "schacht1") <> 0 
+             THEN act feeder := "schacht1" 
+           ELIF pos (material, "schacht2") <> 0 
+             THEN act feeder := "schacht2" 
+             ELSE act feeder := feeder name 
+           FI 
+    FI.
+ 
+$opendocdx2100$
+param 2 := (param 2 DIV 36) * 36;
+out (""24""27""64"");                            (* Reset des Druckers *) 
+out (""27"R"0"");                                (* US-Zeichensatz *)
+out (""27"2" + ""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)
+out (""27"N"0"");                                (* skip perforation *)
+out (""27"x"0"" + ""27"r"0"").                   (* draft und black *)
+ 
+ 
+$opendoc120d$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"R"0""27"9"27"O"27"x0"27"2");
+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)
+
+$opendocc310$ 
+    param 2 := (param 2 DIV 36) * 36;
+    out (""27""64""27""64"");              (* Reset des Druckers *)
+    out (""27"R"0""27"2");
+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)
+    out (""27"O"27"x"0""27"r"0""27"6"); 
+    IF feeder name = "tractor" 
+      THEN act feeder := feeder name; 
+      ELSE IF pos (material, "schacht1") <> 0 
+             THEN act feeder := "schacht1" 
+           ELIF pos (material, "schacht2") <> 0 
+             THEN act feeder := "schacht2" 
+             ELSE act feeder := feeder name 
+           FI 
+    FI.
+ 
+$openpge$
+  open page :
+    param 1 := 0;
+    param 2 := y step conversion (y margin);
+    x rest  := 0;
+    y rest  := 0;
+    small   := 0;
+    out (""13"").
+$openpgemlsf$ 
+  open page :
+    param 1 := 0;
+    param 2 := 0;
+    x rest  := 0;
+    y rest  := 0;
+    small   := 0;
+    IF feeder name = "sheet" THEN out (""12"") FI; 
+    out (""13"").
+$openpgemtsf$ 
+  open page :
+    param 1 := 0;
+    param 2 := 0;
+    x rest  := 0;
+    y rest  := 0;
+    small   := 0;
+    IF feeder name = "schacht1" 
+      THEN out (""27"[21{"12"") 
+    ELIF feeder name = "schacht2" 
+      THEN out (""27"[22{"12"") 
+    FI; 
+    out (""13"").
+  
+$openpgec310sf$ 
+  open page :
+    param 1 := 0;
+    param 2 := 0;
+    x rest  := 0;
+    y rest  := 0;
+    small   := 0;
+    IF feeder name = "schacht1" 
+      THEN out (""27""25"1"12"") 
+    ELIF feeder name = "schacht2" 
+      THEN out (""27""25"2"12"") 
+    FI; 
+    out (""13"").
+  
+$betwoc$
+END PROC open; 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE 1: close document 
+  CASE 2: close page
+END SELECT.
+close document : 
+$clpge$
+. close page :
+    IF param 1 > 0 THEN out (""12"") FI.
+$clmlsf$ 
+.close page :
+  IF feeder name = "sheet" 
+    THEN out (""27""25""3"") 
+  ELIF param 1 > 0 
+    THEN out (""12"") 
+  FI. 
+$clmtsf$ 
+.close page :
+  IF feeder name <> "tractor" 
+    THEN out (""27"[2J") 
+  ELIF param 1 > 0 
+    THEN out (""12"") 
+  FI.
+$clc310sf$ 
+.close page :
+  IF feeder name = "sheet" 
+    THEN out (""27""25"R") 
+  ELIF param 1 > 0 
+    THEN out (""12"") 
+  FI. 
+ 
+$betwce$
+END PROC close;
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE 1:  write text
+  CASE 2:  write cmd
+  CASE 3:  carriage return
+  CASE 4:  move
+  CASE 5:  draw
+  CASE 6:  on
+  CASE 7:  off
+  CASE 8:  type
+END SELECT.
+
+is underline: bit (modifikations, 0).
+is bold     : bit (modifikations, 1). 
+is italics  : bit (modifikations, 2). 
+ 
+  write text :
+    out subtext (string, param 1, param 2).
+$cmd$ 
+  write cmd :
+    out subtext (string, param 1, param 2). 
+$cmdfx800$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF buffer = "draft" 
+      THEN out (""27"x"0"") 
+    ELIF buffer = "nlq"
+      THEN out (""27"x"1"") 
+    ELIF buffer = "roman" 
+      THEN out (""27"k"0"") 
+    ELIF buffer = "sansserif" 
+      THEN out (""27"k"1"") 
+      ELSE out (buffer) 
+    FI. 
+$cmdpp$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF buffer = "draft" 
+      THEN out (""27"H")
+    ELIF buffer = "nlq"
+      THEN out (""27"G") 
+      ELSE out (buffer) 
+    FI. 
+$cmdml182i$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF buffer = "draft" 
+      THEN out (""27"I1") 
+    ELIF buffer = "nlq"
+      THEN out (""27"I3") 
+      ELSE out (buffer) 
+    FI. 
+$cmdml292el$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF buffer = "draft" 
+      THEN out (""27"x"0"") 
+    ELIF buffer = "nlq"
+      THEN out (""27"x"1"") 
+    ELIF buffer = "courier" 
+      THEN out (""27"k"0"") 
+    ELIF buffer = "sansserif" 
+      THEN out (""27"k"1"") 
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+$cmdml294i$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF buffer = "draft" 
+      THEN out (""27"H") 
+    ELIF buffer = "nlq"
+      THEN out (""27"G") 
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r0")
+    ELIF buffer = "rot" 
+      THEN out (""27"r1")
+    ELIF buffer = "blau" 
+      THEN out (""27"r2")
+    ELIF buffer = "violett" 
+      THEN out (""27"r3")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r4")
+    ELIF buffer = "orange" 
+      THEN out (""27"r5")
+    ELIF buffer = "grün" 
+      THEN out (""27"r6")
+      ELSE out (buffer) 
+    FI. 
+$cmdlc10$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF buffer = "draft" 
+      THEN out (""27"x"0"") 
+    ELIF buffer = "nlq"
+      THEN out (""27"x"1"") 
+    ELIF buffer = "courier" 
+      THEN out (""27"k"0"") 
+    ELIF buffer = "sansserif" 
+      THEN out (""27"k"1"") 
+    ELIF buffer = "orator1" 
+      THEN out (""27"k"2"") 
+    ELIF buffer = "orator2" 
+      THEN out (""27"k"3"") 
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r"0"")
+    ELIF buffer = "rot" 
+      THEN out (""27"r"1"")
+    ELIF buffer = "blau" 
+      THEN out (""27"r"2"")
+    ELIF buffer = "violett" 
+      THEN out (""27"r"3"")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r"4"")
+    ELIF buffer = "orange" 
+      THEN out (""27"r"5"")
+    ELIF buffer = "grün" 
+      THEN out (""27"r"6"")
+      ELSE out (buffer) 
+    FI. 
+$cmdmt230$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF feeder name <> "tractor" 
+      THEN IF buffer = "schacht1" OR buffer = "schacht2" 
+             THEN act feeder := buffer 
+           FI 
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r"0"")
+    ELIF buffer = "magenta" 
+      THEN out (""27"r"1"")
+    ELIF buffer = "cyan" 
+      THEN out (""27"r"2"")
+    ELIF buffer = "blau" 
+      THEN out (""27"r"3"")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r"4"")
+    ELIF buffer = "rot" 
+      THEN out (""27"r"5"")
+    ELIF buffer = "grün" 
+      THEN out (""27"r"6"")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmdc310$ 
+  write cmd :
+    buffer := subtext (string, param 1, param 2); 
+    IF feeder name <> "tractor" 
+      THEN IF buffer = "schacht1" OR buffer = "schacht2" 
+             THEN act feeder := buffer 
+           FI 
+    ELIF buffer = "schwarz" 
+      THEN out (""27"r"0"")
+    ELIF buffer = "rot" 
+      THEN out (""27"r"1"")
+    ELIF buffer = "blau" 
+      THEN out (""27"r"2"")
+    ELIF buffer = "violett" 
+      THEN out (""27"r"3"")
+    ELIF buffer = "gelb" 
+      THEN out (""27"r"4"")
+    ELIF buffer = "orange" 
+      THEN out (""27"r"5"")
+    ELIF buffer = "grün" 
+      THEN out (""27"r"6"")
+      ELSE out (buffer) 
+    FI. 
+ 
+$cmddx2100$ 
+   write cmd :
+     buffer := subtext (string, param 1, param 2); 
+     IF buffer = "schwarz"
+       THEN out (""27"r"0"")
+     ELIF buffer = "rot"
+       THEN out (""27"r"1"")
+     ELIF buffer = "blau"
+       THEN out (""27"r"2"")
+     ELIF buffer = "violett"
+       THEN out (""27"r"3"")
+     ELIF buffer = "gelb"
+       THEN out (""27"r"4"")
+     ELIF buffer = "orange"
+       THEN out (""27"r"5"")
+     ELIF buffer = "grün"
+       THEN out (""27"r"6"")
+     ELSE out (buffer)
+     FI.
+ 
+$crs$
+  carriage return :
+    y rest INCR small;
+    x rest := 0;
+    small  := 0;
+    out (""13"").
+$moh$ 
+x steps : param1.
+y steps : param2.
+
+move :
+  IF x steps < 0 OR y steps < 0 THEN stop FI; 
+  IF x steps > 0 THEN x move FI; 
+  IF y steps > 0 THEN y move FI. 
+
+$mofx85$ 
+x move :
+  high   := (x steps + x rest) DIV blankbreite;
+  x rest := (x steps + x rest) MOD blankbreite;
+  IF high   > 0 THEN high TIMESOUT " " FI;
+  IF x rest > 0 AND is slow
+     THEN IF is underline THEN out (" "8"") FI;
+          out (""27"Y"+ code (x rest) + ""0"");
+          x rest TIMESOUT ""0"";
+          x rest := 0
+  FI. 
+ 
+ 
+$mofx800$
+x move :
+  IF is underline
+    THEN underline x move
+    ELSE simple x move
+  FI. 
+ 
+underline x move: 
+  high   := (x steps + x rest) DIV blankbreite;
+  low    := (x steps + x rest) MOD blankbreite;
+  IF high > 0 THEN high TIMESOUT " " FI;
+  IF low > 0
+     THEN out (" "8""27"\"+ code (low) + ""0"")
+  FI. 
+ 
+simple x move:
+  out (""27"\");
+  out (code (x steps MOD 256));
+  out (code (x steps DIV 256)). 
+ 
+$modrmx$ 
+x move :
+  high := (x steps + x rest) DIV blankbreite;
+  low  := (x steps + x rest) MOD blankbreite;
+  IF high > 0 THEN high TIMESOUT " " FI;
+  IF low  > 0 AND is slow
+     THEN IF is underline THEN out ("_"8"") FI;
+          IF is condensed 
+             THEN high := low;
+                  low  := 0;
+                  out (""27"L"+ code (high) + ""0"");
+             ELSE high := low DIV 2;
+                  low  := low MOD 2;
+                  out (""27"K"+ code (high) + ""0"");
+          FI;
+          high TIMESOUT ""0"";
+          IF is small
+             THEN out (""27"S"1"");
+                  small DECR 1;
+          FI;
+  FI;
+  x rest := low. 
+ 
+y move : 
+  y rest INCR y steps;
+  IF y rest > 0
+     THEN high := y rest DIV 255;
+          low  := y rest MOD 255;
+          IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;
+          IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
+          y rest := 0
+  FI. 
+ 
+draw :
+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 
+    THEN stop
+  ELIF x steps > 0
+    THEN x draw
+  FI. 
+ 
+x draw :
+  out (""27"L");
+  out (code (x steps MOD 256));
+  out (code (x steps DIV 256));
+  x steps TIMESOUT ""1"";
+  IF is small THEN out (""27"S"1"") FI. 
+ 
+$mogp$ 
+x move :
+  high   := (x steps + x rest) DIV blankbreite;
+  x rest := (x steps + x rest) MOD blankbreite;
+  IF high   > 0 THEN high TIMESOUT " " FI;
+  IF x rest > 0 AND is slow
+     THEN IF is underline 
+            THEN out (" "13""27"Y"); 
+                 out (code (x pos MOD 256)); 
+                 out (code (x pos DIV 256)); 
+                 x pos TIMESOUT ""0"" 
+            ELSE out (""27"Y"+ code (x rest) + ""0"");
+                 x rest TIMESOUT ""0"" 
+          FI;
+          x rest := 0 
+  FI. 
+ 
+$moml192el$ 
+x move :
+  high   := (x steps + x rest) DIV blankbreite;
+  x rest := (x steps + x rest) MOD blankbreite;
+  IF high   > 0 THEN high TIMESOUT " " FI;
+  IF x rest > 0 AND is slow
+    THEN  IF is underline THEN 
+             IF prop font THEN 
+               out (""27"p"0"" + " "8"" + ""27"p"1"") 
+             ELSE 
+               out (" "8"") 
+             FI; 
+          FI;
+          out (""27"Y"+ code (x rest) + ""0"");
+          x rest TIMESOUT ""0"";
+          x rest := 0
+  FI.
+ 
+$ymodr$ 
+y move : 
+  y rest INCR y steps;
+  IF y rest > 0
+    THEN high := y rest DIV 255;
+         low  := y rest MOD 255;
+         IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;
+         IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
+         y rest := 0 
+  FI.
+ 
+draw :
+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 
+    THEN stop
+  ELIF x steps > 0
+    THEN x draw
+  FI. 
+ 
+x draw :
+  out (""27"Y");
+  out (code (x steps MOD 256));
+  out (code (x steps DIV 256));
+  x steps TIMESOUT ""1"".
+ 
+$onoff$              
+  on :
+    IF on string (param 1) <> ""
+       THEN out (on string (param 1));
+            modifikations := modifikations OR param 1
+       ELSE stop
+    FI. 
+ 
+  off :
+    IF off string (param 1) <> ""
+       THEN out (off string (param 1));
+            modifikations := modifikations AND (param 1 XOR -1) 
+       ELSE stop
+    FI.
+ 
+$onoffpp$              
+  on :
+    IF on string (param 1) <> "" AND param 1 <> 2
+       THEN out (on string (param 1));
+            modifikations := modifikations OR param 1
+       ELSE stop
+    FI. 
+ 
+  off :
+    IF off string (param 1) <> "" AND param 1 <> 2 
+       THEN out (off string (param 1));
+            modifikations := modifikations AND (param 1 XOR -1) 
+       ELSE stop
+    FI.
+ 
+$tyfx85$ 
+  type :
+    buffer := font string (param 1);
+    out (buffer);
+    restore modifikations; 
+    blankbreite  := char pitch (param 1, " ");
+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.  
+
+$tyfx800$ 
+ type :
+    buffer := font string (param 1);
+    IF was tall font 
+      THEN out (""27"w"0"") 
+    FI; 
+    out (buffer);
+    restore modifikations;
+    blankbreite  := char pitch (param 1, " "); 
+    was tall font := pos (buffer, ""27"w"1"") <> 0.
+
+$tymx$ 
+  type :
+    buffer := font string (param 1);
+    blankbreite  := char pitch (param 1, " ");
+    is condensed := pos (buffer, ""15"") <> 0;
+    IF pos (buffer, ""27"S") <> 0 
+       THEN small DECR 1;
+            is small := TRUE;
+       ELSE is small := FALSE;
+    FI;
+    out (buffer);
+    restore modifikations.
+
+$tyohnesmall$
+ type :
+    buffer := font string (param 1);
+    out (buffer);
+    restore modifikations;
+    blankbreite  := char pitch (param 1, " ").
+
+$tyml192el$ 
+  type :
+    buffer := font string (param 1);
+    out (buffer);
+    restore modifikations; 
+    blankbreite  := char pitch (param 1, " ");
+    prop font    := pos (buffer, ""27"p"1"") <> 0;
+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.
+
+$tyml292el$ 
+  type :
+    buffer := font string (param 1);
+    IF was tall font 
+      THEN out (""27""31"0"27"U0") 
+    FI; 
+    was tall font := pos (buffer, ""27"w"1"") <> 0;
+    change all (buffer, ""27"w"0"", ""27""31"0"27"U0"); 
+    change all (buffer, ""27"w"1"", ""27""31"1"27"U1"); 
+    out (buffer);
+    restore modifikations; 
+    blankbreite  := char pitch (param 1, " ").
+ 
+$ontyml294i$ 
+  on :
+    IF on string (param 1) <> "" AND param 1 <> 2 
+       THEN out (on string (param 1));
+            modifikations := modifikations OR param 1 
+    ELIF param 1 = 4
+       THEN out (""27"%G"); 
+            modifikations := modifikations OR param 1 
+       ELSE stop
+    FI. 
+ 
+  off :
+    IF off string (param 1) <> "" AND param 1 <> 2
+       THEN out (off string (param 1));
+            modifikations := modifikations AND (param 1 XOR -1) 
+    ELIF param 1 = 4 
+       THEN out (""27"%H"); 
+            modifikations := modifikations AND (param 1 XOR -1) 
+       ELSE stop
+    FI.
+ 
+  type :
+    buffer := font string (param 1);
+    out (buffer);
+    IF is underline THEN out (on string (1)) FI; 
+    IF is bold      THEN out (on string (2)) FI; 
+    IF is italics   THEN out (""27"%G") FI;
+    blankbreite  := char pitch (param 1, " ");
+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.
+
+$end$
+  restore modifikations: 
+    IF is underline THEN out (on string (1)) FI; 
+    IF is bold      THEN out (on string (2)) FI; 
+    IF is italics   THEN out (on string (4)) FI. 
+ 
+END PROC execute;
+
+INT VAR reply; DATASPACE VAR ds; FILE VAR file;
+ 
+PROC printer:
+ 
+  disable stop;
+  continue (server channel);
+  check error (error message);
+  ds := nilspace;
+  REP forget (ds);
+      execute print;
+      IF is error AND online THEN put error; clear error; FI;
+  PER;
+END PROC printer;
+ 
+PROC execute print:
+ 
+  LET ack = 0, fetch code = 11, file type = 1003;
+  enable stop;
+  ds := nilspace;
+  call (father, fetch code, ds, reply);
+  IF reply = ack CAND type (ds) = file type
+     THEN file := sequential file (input, ds);
+          print (file,
+            PROC (INT CONST, INT VAR, INT VAR) open,
+            PROC (INT CONST, INT CONST) close,
+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+  FI;
+END PROC execute print;
+ 
+PROC check error(TEXT CONST message):
+ 
+  IF is error
+     THEN clear error; rename myself (message);
+          IF is error THEN end(myself) FI;
+          pause (9000); end(myself);
+  FI;
+END PROC check error;
+ 
+END PACKET printerdriver
+ 
+
diff --git a/system/printer-9nadel/0.9/src/printer.neun.nadel b/system/printer-9nadel/0.9/src/printer.neun.nadel
new file mode 100644
index 0000000..00f698b
--- /dev/null
+++ b/system/printer-9nadel/0.9/src/printer.neun.nadel
@@ -0,0 +1,1129 @@
+PACKET driver inst 9                         (* Autoren : mov/hjh     *) 
+                                             (* Stand   : 01.10.88    *) 
+ 
+       DEFINES druckerkanal, 
+               treiber einrichten: 
+ 
+ 
+LET up = ""3""13""5"", 
+ 
+    generator name = "printer.neun.nadel", 
+ 
+    description file name = "beschreibungen9", 
+    module file name = "module9"; 
+ 
+ 
+INT VAR pr channel, 
+        positioning,
+        quality,
+        sheet feeder, 
+        service option; 
+TEXT VAR fonttab name :: "", 
+         driver name :: ""; 
+TEXT VAR inp; 
+BOOL VAR was esc; 
+ 
+ 
+PROC druckerkanal (INT CONST channel) :
+ 
+  serverchannel (channel)
+ 
+END PROC druckerkanal; 
+ 
+INT PROC druckerkanal : pr channel END PROC druckerkanal; 
+ 
+ 
+PROC treiber einrichten:
+
+  treiber einrichten (0)
+END PROC treiber einrichten;
+
+PROC treiber einrichten (INT CONST service opt): 
+ 
+  ask for print channel; 
+  main menu; 
+  IF installed 
+    THEN generate printer spool 
+    ELSE inform about restart 
+  FI. 
+ 
+  ask for printchannel: 
+    inits; 
+    page; 
+    headline ("Druckerkanal - Einstellung"); 
+    cursor (1, 15); 
+    putline ("Hinweis: Die Druckerkanalnummer kann auch nachträglich mit"); 
+    putline ("         'druckerkanal (Kanalnummer)' in der Task """ + 
+             name (myself) + """"); 
+    putline ("         verändert werden."); 
+    REP 
+      cursor (1, 10);
+      put (""5"EUMEL-Kanalnummer des Druckerkanals:");
+      get (pr channel);
+      disable stop; 
+      druckerkanal (pr channel);
+      BOOL VAR no error :: NOT is error; 
+      IF is error 
+        THEN cursor (1, 7); 
+             put error;
+             putline ("Eingabe korrigiert wiederholen!") 
+      FI; 
+      clear error; 
+      enable stop 
+    UNTIL no error PER. 
+ 
+  inits: 
+    line; 
+    IF single task 
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI; 
+    INT VAR choice;
+    service option := service opt.
+ 
+  single task:  (pcb (9) AND 255) = 1.
+ 
+  main menu: 
+    BOOL VAR installed :: FALSE; 
+    REP 
+      show main menu; 
+      get choice; 
+      treat choice 
+    UNTIL was esc OR installed PER. 
+ 
+  show main menu: 
+    page; 
+    headline ("Hauptmenü 9-Nadel-Drucker"); 
+    putline (" 1. Brother");
+    putline (" 2. Citizen");
+    putline (" 3. C. Itoh");
+    putline (" 4. Epson");
+    putline (" 5. Fujitsu");
+    putline (" 6. IBM"); 
+    putline (" 7. Mannesmann - Tally");
+    putline (" 8. OKI");
+    putline (" 9. Schneider");
+    putline ("10. Star").
+
+  get choice: 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Installation abbrechen"); 
+    ask user (10).
+ 
+  treat choice: 
+    SELECT int (inp) OF 
+      CASE 1: brother menu 
+      CASE 2: citizen menu 
+      CASE 3: c itoh menu 
+      CASE 4: epson menu 
+      CASE 5: fujitsu menu 
+      CASE 6: ibm menu 
+      CASE 7: mannesmann menu 
+      CASE 8: oki menu 
+      CASE 9: schneider menu 
+      CASE 10: star menu 
+    END SELECT. 
+ 
+  
+  brother menu:. 
+
+  citizen menu: 
+    page; 
+    headline ("Citizen - Menü"); 
+    putline (" 1. 120-D"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           citi120d inst 
+    FI. 
+ 
+    citi120d inst: 
+      putline ("Citizen 120-D"); 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("S1    S2    S3    S4    S5    S6    S7    S8");
+      putline ("egal  OFF   OFF   egal  egal  egal  egal  egal"); 
+      show control options (""); 
+      IF all right 
+        THEN get fonttable ("fonttab.7");
+             generate ("citi120d"); 
+             installed := TRUE 
+      FI.
+  
+  c itoh menu:
+    page; 
+    headline ("C. Itoh - Menü"); 
+    putline (" 1. C 310 CXP"); 
+    putline (" 2. C 315 CXP"); 
+    putline (" 3. CI-3500");
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (3); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           IF choice = 3 
+             THEN ci3500 inst 
+             ELSE c310 inst 
+           FI 
+    FI. 
+ 
+    c310 inst: 
+      IF choice = 1 
+        THEN putline ("C. Itoh C 310 CXP") 
+        ELSE putline ("C. Itoh C 315 CXP") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); 
+      putline ("- 00: Epson-Modus (02)"); 
+      putline ("- 22: nur Wagenrücklauf (01)");
+      show control options ("std speed, paperfeed"); 
+      show material options ("slow, fast, schacht1, schacht2");
+      show command options ("schacht1, schacht2,  schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for positioning;
+      ask for paper feed; 
+      IF all right 
+        THEN get fonttable ("fonttab.7.cxp"); 
+             generate ("citohc310cxp"); 
+             adjust positioning;
+             adjust paper feed; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+  
+    ci3500 inst: 
+      putline ("C. Itoh CI-3500"); 
+      line; 
+      putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); 
+      putline ("- 26: nur Wagenrücklauf (1)"); 
+      putline ("- 49: 17,1 Zeichen pro Zoll (17)");
+      show control options ("std speed"); 
+      show material options ("slow, fast"); 
+      ask for positioning; 
+      IF all right 
+        THEN get fonttable ("fonttab.10");
+             generate ("citohci3500"); 
+             adjust positioning; 
+             installed := TRUE 
+      FI.
+  
+  epson menu: 
+    page; 
+    headline ("Epson - Menü"); 
+    putline (" 1. MX 80 Typ III"); 
+    putline (" 2. MX 100 Typ III"); 
+    putline (" 3. LX 800"); 
+    putline (" 4. LX 1000"); 
+    putline (" 5. FX 85"); 
+    putline (" 6. FX 105"); 
+    putline (" 7. FX 800 oder FX 850"); 
+    putline (" 8. FX 1000 oder FX 1050"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (8); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1, 2: mx80 inst
+             CASE 3, 4: lx800 inst
+             CASE 5, 6: fx85 inst
+             CASE 7, 8: fx800 inst 
+           END SELECT
+    FI. 
+ 
+    mx80 inst: 
+      IF choice = 1 
+        THEN putline ("Epson MX 80 Typ III") 
+        ELSE putline ("Epson MX 100 Typ III") 
+      FI; 
+      show control options ("std speed"); 
+      show material options ("slow, fast"); 
+      ask for positioning; 
+      IF all right 
+        THEN get fonttable ("fonttab.1");
+             generate ("mx"); 
+             adjust positioning; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+    lx800 inst:
+      IF choice = 3 
+        THEN putline ("Epson LX 800") 
+        ELSE putline ("Epson LX 1000") 
+      FI; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8   SW2-1 SW2-2 SW2-3 SW2-4"); 
+      putline ("egal  egal  egal  egal  egal  egal  egal  egal    egal  *)    OFF   OFF"); 
+      putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+      show control options ("std speed, std quality, std typeface"); 
+      show material options ("slow, fast, draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for positioning; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.20.lx"); 
+             generate ("lx800"); 
+             adjust positioning; 
+             adjust quality; 
+             IF choice = 4 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+    fx85 inst: 
+      IF choice = 5 
+        THEN putline ("Epson FX 85") 
+        ELSE putline ("Epson FX 105") 
+      FI; 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8   SW2-1 SW2-2 SW2-3 SW2-4"); 
+      putline ("egal  egal  egal  ON    egal  egal  egal  egal    egal  egal  OFF   OFF"); 
+      show control options ("std speed"); 
+      show material options ("slow, fast"); 
+      ask for positioning; 
+      IF all right 
+        THEN get fonttable ("fonttab.7"); 
+             generate ("fx85"); 
+             adjust positioning; 
+             IF choice = 6 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+    fx800 inst: 
+      IF choice = 7 
+        THEN putline ("Epson FX 800 oder FX 850") 
+        ELSE putline ("Epson FX 1000 oder FX 1050") 
+      FI; 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8   SW2-1 SW2-2 SW2-3 SW2-4"); 
+      putline ("egal  egal  egal  ON    egal  egal  egal  egal    egal  *)    OFF   OFF"); 
+      putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+      show control options ("std quality, std typeface"); 
+      show material options ("draft, nlq, roman, sansserif"); 
+      show command options ("draft, nlq, roman, sansserif"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.20"); 
+             generate ("fx800"); 
+             adjust quality; 
+             IF choice = 8 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+  fujitsu menu: 
+    page; 
+    headline ("Fujitsu - Menü"); 
+    putline (" 1. DX 2100"); 
+    putline (" 2. DX 2200"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (2); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1,2   : dx2100 inst
+           END SELECT
+    FI. 
+
+    dx2100 inst: 
+      IF choice = 1 
+        THEN putline ("Fujitsu DX 2100") 
+        ELSE putline ("Fujitsu DX 2200") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("SW1-1 SW1-2 SW1-3 SW1-4 SW1-5 SW1-6 SW1-7 SW1-8   SW2-1 SW2-2 SW2-3 SW2-4"); 
+      putline ("egal  egal  egal  egal  egal  egal  egal  egal    egal  *)    OFF   OFF"); 
+      putline ("*) ON: Einzelblatteinzug, OFF: kein Einzug"); 
+      show control options ("std speed, paper feed"); 
+      show material options ("slow, fast"); 
+      show command options ("schwarz, rot, blau, violett, gelb, rot, grün"); 
+      ask for positioning; 
+      ask for paper feed; 
+      IF all right 
+        THEN get fonttable ("fonttab.7.fuj"); 
+             generate ("fujdx2100"); 
+             adjust positioning; 
+             adjust paper feed; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI. 
+ 
+ 
+ 
+  ibm menu: 
+    page; 
+    headline ("IBM - Menü"); 
+    putline (" 1. Grafikdrucker (""80 Zeichen breit"")"); 
+    putline (" 2. Grafikdrucker (""136 Zeichen breit"")"); 
+    putline (" 3. Proprinter/Grafikdrucker II (""80 Zeichen breit"")"); 
+    putline (" 4. Proprinter/Grafikdrucker II (""136 Zeichen breit"")"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (4); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           IF choice = 1 OR choice = 2
+             THEN ibmgp inst
+             ELSE ibmpp inst 
+           FI 
+    FI. 
+ 
+    ibmgp inst: 
+      IF choice = 1 
+        THEN putline ("IBM Grafikdrucker (""80 Zeichen breit"")") 
+        ELSE putline ("IBM Grafikdrucker (""136 Zeichen breit"")") 
+      FI; 
+      show control options ("std speed"); 
+      show material options ("slow, fast"); 
+      ask for positioning; 
+      IF all right 
+        THEN get fonttable ("fonttab.10");
+             generate ("ibmgp"); 
+             adjust positioning; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+
+    ibmpp inst:
+      IF choice = 3 
+        THEN putline ("IBM Proprinter/Grafikdrucker II (""80 Zeichen breit"")") 
+        ELSE putline ("IBM Proprinter/Grafikdrucker II (""136 Zeichen breit"")") 
+      FI; 
+      show control options ("std speed, std quality"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq");
+      ask for positioning; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.10"); 
+             generate ("ibmpp"); 
+             adjust positioning; 
+             adjust quality;
+             IF choice = 4 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+  mannesmann menu: 
+    page; 
+    headline ("Mannesmann - Tally - Menü"); 
+    putline (" 1. MT 230"); 
+    putline (" 2. MT 340"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (2); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           IF choice = 1  
+             THEN mt230 inst
+             ELSE mt340 inst 
+           FI
+    FI. 
+ 
+    mt230 inst:
+      putline ("Mannesmann-Tally MT 230"); 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Der Drucker muß auf den ANSI+EPSON - Modus eingestellt werden.");
+      putline ("(Siehe: MT 230 Anwenderhandbuch, S. 4-145)"); 
+      show control options ("std speed, paperfeed"); 
+      show material options ("slow, fast, schacht1, schacht2");
+      show command options ("schacht1, schacht2,  schwarz, magenta, cyan, blau, gelb, rot, grün"); 
+      ask for positioning;
+      ask for paper feed; 
+      IF all right 
+        THEN get fonttable ("fonttab.7"); 
+             generate ("mt230"); 
+             adjust positioning;
+             adjust paper feed; 
+             do ("papersize (39.37, 30.48)"); 
+             installed := TRUE 
+      FI. 
+  
+    mt340 inst:
+      putline ("Mannesmann-Tally MT 340"); 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Der Drucker muß auf den ANSI+EPSON - Modus eingestellt werden.");
+      putline ("(Siehe: MT 340 Anwenderhandbuch, S. 4-104)"); 
+      show control options ("std speed, paperfeed"); 
+      show material options ("slow, fast, schacht1, schacht2");
+      show command options ("schacht1, schacht2,  schwarz, magenta, cyan, blau, gelb, rot, grün"); 
+      ask for positioning;
+      ask for paper feed; 
+      IF all right 
+        THEN get fonttable ("fonttab.7.mt"); 
+             generate ("mt340"); 
+             adjust positioning;
+             adjust paper feed; 
+             do ("papersize (39.37, 30.48)"); 
+             installed := TRUE 
+      FI. 
+
+  oki menu: 
+    page; 
+    headline ("OKI - Menü"); 
+    putline (" 1. MICROLINE 182 IBM-kompatibel"); 
+    putline (" 2. MICROLINE 183 IBM-kompatibel"); 
+    putline (" 3. MICROLINE 192 ELITE");
+    putline (" 4. MICROLINE 193 ELITE"); 
+    putline (" 5. MICROLINE 292 ELITE");
+    putline (" 6. MICROLINE 293 ELITE"); 
+    putline (" 7. MICROLINE 294 IBM-kompatibel"); 
+    putline (" 8. MICROLINE 320"); 
+    putline (" 9. MICROLINE 321"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (9); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           SELECT choice OF 
+             CASE 1, 2: ml182i inst
+             CASE 3, 4: ml192el inst 
+             CASE 5, 6: ml292el inst 
+             CASE 7   : ml294i inst 
+             CASE 8, 9: ml320 inst 
+           END SELECT
+    FI. 
+ 
+    ml182i inst:
+      IF choice = 1 
+        THEN putline ("OKI Microline 182 IBM-kompatibel")
+        ELSE putline ("OKI Microline 183 IBM-kompatibel") 
+      FI; 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("S-1   S-2   S-3   S-4   S-5   S-6   S-7   S-8");
+      putline ("egal  egal  OFF   egal  egal  OFF   egal  OFF");
+      show control options ("std speed, std quality"); 
+      show material options ("slow, fast, draft, nlq"); 
+      show command options ("draft, nlq"); 
+      ask for positioning; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.10"); 
+             generate ("okiml182i"); 
+             adjust positioning; 
+             adjust quality; 
+             IF choice = 2 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+    ml192el inst:
+      IF choice = 3 
+        THEN putline ("OKI Microline 192 ELITE (IBM/EPSON-kompatibel)")
+        ELSE putline ("OKI Microline 193 ELITE (IBM/EPSON-kompatibel)") 
+      FI; 
+      line; 
+      putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); 
+      putline ("- 13: Automatic Line Feed: Nein"); 
+      putline ("- 18: Compatibility: EPSON FX"); 
+      putline ("(Außerdem: Jumper SP5 in Position 'B')"); 
+      show control options ("std speed, paperfeed"); 
+      show material options ("slow, fast"); 
+      ask for positioning;
+      ask for paper feed; 
+      IF all right 
+        THEN get fonttable ("fonttab.7"); 
+             generate ("okiml192el"); 
+             adjust positioning;
+             adjust paper feed; 
+             IF choice = 4 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+    ml292el inst:
+      IF choice = 5 
+        THEN putline ("OKI Microline 292 ELITE (IBM/EPSON-kompatibel)")
+        ELSE putline ("OKI Microline 293 ELITE (IBM/EPSON-kompatibel)") 
+      FI; 
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); 
+      putline ("- Automatic Line Feed: NO"); 
+      putline ("- Compatibility: EPSON EX"); 
+      putline ("(Außerdem: Jumper SP5 in Position 'B')"); 
+      show control options ("paperfeed, std quality, std typeface"); 
+      show material options ("draft, nlq, courier, sansserif"); 
+      show command options ("draft, nlq, courier, sansserif"); 
+      putline ("schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for paper feed; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.20"); 
+             generate ("okiml292el"); 
+             adjust paper feed; 
+             adjust quality;
+             IF choice = 6 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+    ml294i inst:
+      putline ("OKI Microline 294 IBM-kompatibel");
+      putline ("Der Druckertreiber unterstützt auch den Farbdruck mit entsprechendem"); 
+      putline ("Farbband.");
+      line; 
+      putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); 
+      putline ("- Proportional Spacing: NO");
+      putline ("- Automatic Line Feed: NO"); 
+      putline ("- Compatibility: PROPRINTER XL"); 
+      show control options ("paperfeed, std quality"); 
+      show material options ("draft, nlq"); 
+      show command options ("draft, nlq,  schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for paper feed; 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.10"); 
+             generate ("okiml294i"); 
+             adjust paper feed; 
+             adjust quality;
+             do ("papersize (34.544, 30.48)");
+             installed := TRUE 
+      FI.
+ 
+    ml320 inst:
+      IF choice = 8 
+        THEN putline ("OKI Microline 320 IBM/EPSON-kompatibel") 
+        ELSE putline ("OKI Microline 321 IBM/EPSON-kompatibel") 
+      FI; 
+      line; 
+      putline ("Der Drucker muß so konfiguriert sein (Druckmenü des Druckers):"); 
+      putline ("- Automatic Line Feed: Nein"); 
+      show control options ("std speed"); 
+      show material options ("slow, fast"); 
+      ask for positioning;
+      IF all right 
+        THEN get fonttable ("fonttab.7"); 
+             generate ("okiml320"); 
+             adjust positioning;
+             IF choice = 9 THEN do ("papersize (34.544, 30.48)") FI; 
+             installed := TRUE 
+      FI.
+ 
+  schneider menu: 
+    page; 
+    headline ("Schneider - Menü"); 
+    putline (" 1. DMP 4000"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (1); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           dmp4000 inst 
+    FI. 
+ 
+    dmp4000 inst:
+      putline ("Schneider DMP 4000"); 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("DS1-4           übrige Schalter"); 
+      putline (" OFF                 egal");
+      show control options ("std speed"); 
+      show material options ("slow, fast");
+      ask for positioning; 
+      IF all right 
+        THEN get fonttable ("fonttab.7"); 
+             generate ("dmp4000"); 
+             adjust positioning; 
+             do ("papersize (39.37, 30.48)"); 
+             installed := TRUE 
+      FI. 
+ 
+  star menu: 
+    page; 
+    headline ("Star - Menü"); 
+    putline (" 1. LC-10 (auch LC-10 Colour)"); 
+    putline (" 2. NX-15"); 
+    putline (" 3. ND-10");
+    putline (" 4. ND-15"); 
+    putline (" 5. NR-10");
+    putline (" 6. NR-15"); 
+    cursor (1,24); 
+    put ("CR: Eingabe        ESC: Zurück zum Hauptmenü"); 
+    ask user (6); 
+    page; 
+    choice := int (inp);
+    IF was esc 
+      THEN was esc := FALSE 
+      ELSE headline ("");
+           putline ("Druckertyp:"); 
+           IF choice = 1  
+             THEN lc10 inst
+           ELIF choice = 2 
+             THEN nx15 inst 
+             ELSE nd10 inst 
+           FI
+    FI. 
+ 
+    lc10 inst:
+      putline ("Star LC-10 oder LC-10 Colour"); 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("S1-1  S1-2  S1-3  S1-4  S1-5  S1-6  S1-7  S1-8     S2-1  S2-2  S2-3  S2-4");
+      putline ("egal  egal  egal  *)    egal  EIN   egal  EIN      egal  egal  egal  egal"); 
+      putline ("*) AUS: Einzelblatteinzug, EIN: kein Einzug"); 
+      show control options ("std quality, std typeface"); 
+      show material options ("draft, nlq, courier, sansserif, orator1, orator2");
+      show command options ("draft, nlq, courier, sansserif, orator1, orator2");
+      putline ("schwarz, rot, blau, violett, gelb, orange, grün"); 
+      ask for quality; 
+      IF all right 
+        THEN get fonttable ("fonttab.20.lc"); 
+             generate ("starlc10"); 
+             adjust quality; 
+             do ("papersize (21.0, 30.48)"); 
+             installed := TRUE 
+      FI. 
+ 
+    nx15 inst:
+      putline ("Star NX-15"); 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("S1-4  S1-8  S2-5         übrige Schalter"); 
+      putline ("EIN   EIN   EIN               egal");
+      show control options ("std speed"); 
+      show material options ("slow, fast"); 
+      ask for positioning;
+      IF all right 
+        THEN get fonttable ("fonttab.7"); 
+             generate ("starnx15"); 
+             adjust positioning; 
+             do ("papersize (36.0, 30.48)"); 
+             installed := TRUE 
+      FI. 
+ 
+    nd10 inst:
+      IF choice = 3 
+        THEN putline ("Star ND-10"); 
+      ELIF choice = 4 
+        THEN putline ("Star ND-15"); 
+      ELIF choice = 5 
+        THEN putline ("Star NR-10"); 
+        ELSE putline ("Star NR-15"); 
+      FI; 
+      line; 
+      putline ("Die DIP-Schalter müssen so eingestellt sein:"); 
+      putline ("S1-5  S1-6  S2-2          übrige Schalter"); 
+      putline ("EIN   EIN   EIN                egal");
+      show control options ("std speed"); 
+      show material options ("slow, fast"); 
+      ask for positioning; 
+      IF all right 
+        THEN get fonttable ("fonttab.7"); 
+             generate ("starnx15"); 
+             adjust positioning;
+             IF choice = 3 OR choice = 5 
+               THEN do ("papersize (21.0, 30.48)") 
+               ELSE do ("papersize (36.0, 30.48)")
+             FI; 
+             installed := TRUE 
+      FI. 
+ 
+generate printer spool: 
+    IF service opt = 0 
+      THEN forget (generator name, quiet); 
+           forget (driver name, quiet) 
+    FI;
+    eumel must advertise;
+    cursor (1, 10);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (2);
+    putline ("Hinweis: Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("         mit 'treiber einrichten' aufgerufen werden, wenn ein anderer"); 
+    putline ("         Drucker eingesetzt werden soll."); 
+    line (2); 
+    put ("Generierung beendet, weiter mit 'SV'");
+    break (quiet);
+    do ("spool manager (PROC printer)").
+ 
+  inform about restart: 
+    page; 
+    putline ("Es ist kein Druckertreiber installiert worden!"); 
+    line; 
+    putline ("Dieses Installationsprogramm kann in der Task """ + name (myself) + """"); 
+    putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+    line. 
+ 
+END PROC treiber einrichten; 
+ 
+PROC headline (TEXT CONST header): 
+ 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  put (header); 
+  line (2) 
+END PROC headline; 
+ 
+PROC ask user (INT CONST max choice): 
+ 
+  TEXT VAR exit; 
+  inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")  
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    int (inp) > 0 AND int (inp) <= max choice AND last conversion ok. 
+END PROC ask user;
+
+PROC show control options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Steuerprozeduren in der Task """ + name (myself) + """:"); 
+  write ("papersize, top margin");
+  IF options <> "" 
+    THEN put (","); 
+         putline (options) 
+  FI
+END PROC show control options; 
+
+PROC show material options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche Materialwerte (#material(""..."")#):"); 
+  putline (options) 
+END PROC show material options; 
+ 
+PROC show command options (TEXT CONST options): 
+ 
+  line; 
+  putline ("Mögliche direkte Druckeranweisungen (#""...""#):"); 
+  putline (options) 
+END PROC show command options; 
+ 
+PROC ask for positioning: 
+ 
+  line (2); 
+  putline ("Positionierung in x-Richtung:"); 
+  line; 
+  REP out (up); 
+    IF yes ("in Mikroschritten (genauer, aber langsamer)")
+      THEN positioning := 1; LEAVE ask for positioning 
+    FI;
+    out (up);
+    IF yes ("in Blanks (schneller, aber ungenauer)")
+      THEN positioning := 2; LEAVE ask for positioning 
+    FI;
+  PER 
+END PROC ask for positioning; 
+ 
+PROC ask for quality: 
+ 
+  line (2); 
+  putline ("Standard - Druckqualität:"); 
+  line; 
+  REP out (up); 
+    IF yes ("Draft Quality (schneller, aber nicht so schön)") 
+      THEN quality := 1; LEAVE ask for quality 
+    FI;
+    out (up);
+    IF yes ("Near Letter Quality (schöner, aber langsamer)")
+      THEN quality := 2; LEAVE ask for quality 
+    FI;
+  PER 
+END PROC ask for quality; 
+ 
+PROC ask for paper feed: 
+ 
+  line (2); 
+  putline ("Einzelblatteinzug:"); 
+  line; 
+  REP out (up); 
+    IF yes ("kein Einzelblatteinzug vorhanden") 
+      THEN sheet feeder := 0; LEAVE ask for paper feed 
+    FI;
+    out (up);
+    IF yes ("Einzelblatteinzug vorhanden")
+      THEN sheet feeder := 1; LEAVE ask for paper feed 
+    FI;
+  PER 
+END PROC ask for paper feed; 
+ 
+BOOL PROC all right: 
+ 
+  line (3);
+  cursor (1,23); 
+  yes ("Soll der ausgewählte Druckertreiber installiert werden") 
+END PROC all right; 
+ 
+PROC get fonttable (TEXT CONST name): 
+ 
+  fonttab name := name; 
+  from archive ((description file name & module file name & fonttab name) 
+                                                                    - all); 
+  fonttable (fonttab name); 
+  command dialogue (FALSE); 
+  save (fonttab name, /"configurator"); 
+  IF service option = 0 
+    THEN forget (fonttab name) 
+  FI; 
+  command dialogue (TRUE); 
+END PROC get fonttable; 
+ 
+PROC from archive (THESAURUS CONST files):
+ 
+  IF highest entry (files) > 0 
+    THEN fetch from archive; 
+         release (archive);
+         putline ("Archiv abgemeldet !")
+  FI.
+ 
+  fetch from archive: 
+    THESAURUS VAR thes :: files; 
+    REP 
+      ask for archive;
+      reserve archive;
+      fetch (thes / ALL archive, archive);
+      thes := thes - all 
+    UNTIL highest entry (thes) = 0 PER.
+
+ask for archive:
+  line;
+  putline ("Bitte Archiv mit den Dateien"); 
+  TEXT VAR buffer;
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  line; 
+  putline ("Wenn eingelegt: Taste drücken !"); 
+  inchar (buffer). 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  disable stop;
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI;
+  enable stop.
+
+END PROC from archive;
+
+THESAURUS OP & (TEXT CONST left, right):
+  THESAURUS VAR result := empty thesaurus;
+  insert (result, left);
+  insert (result, right);
+  result
+END OP &;
+
+THESAURUS OP & (THESAURUS CONST left, TEXT CONST right):
+  THESAURUS VAR result := left;
+  insert (result, right);
+  result
+END OP &;
+ 
+PROC generate (TEXT CONST name): 
+ 
+  open files; 
+  read description; 
+  build programme; 
+  insert programme; 
+  forget files. 
+ 
+  open files: 
+    line (5); 
+    cursor (1, 20); 
+    putline (""4"Bitte warten !"); 
+    putline ("    - Der Treiber wird generiert."); 
+    driver name := "printer." + name + "(generiert)"; 
+    IF exists (driver name) 
+      THEN forget (driver name, quiet) 
+    FI; 
+    FILE VAR des file :: sequential file (modify, description file name), 
+             mod file :: sequential file (modify, module file name), 
+             driver file :: sequential file (output, driver name). 
+ 
+  read description: 
+    to line (des file, 1); 
+    col (des file, 1);
+    downety (des file, "$" + name + "$"); 
+    IF eof (des file) 
+      THEN errorstop ("Beschreibung von """ + name + """ nicht im"13""10"" + 
+                      "Descriptions-File enthalten")
+    FI; 
+    TEXT VAR description :: "", 
+             record; 
+    BOOL VAR done :: FALSE; 
+    read record (des file, record); 
+    record := subtext (record, col (des file) + LENGTH name + 2);
+    WHILE NOT eof (des file) AND NOT done REP 
+      treat record
+    PER. 
+ 
+  treat record: 
+    INT VAR dollar pos :: pos (record, "$"); 
+    IF dollar pos = 0
+      THEN description CAT compress (record); 
+           down (des file); 
+           read record (des file, record)  
+      ELSE description CAT compress (subtext (record, 1, dollar pos - 1));
+           col (des file, dollar pos); 
+           done := TRUE; 
+    FI. 
+ 
+  build programme: 
+    get module name; 
+    WHILE still modules REP 
+      find module; 
+      transfer module; 
+      get module name 
+    PER. 
+ 
+  get module name: 
+    INT VAR semicol pos :: pos (description, ";"); 
+    TEXT VAR module name; 
+    IF semicol pos > 0 
+      THEN module name := subtext (description, 1, semicol pos - 1); 
+           description := subtext (description, semicol pos + 1) 
+      ELSE module name := description; 
+           description := "" 
+    FI.
+ 
+  still modules: 
+    module name <> "" OR description <> "". 
+ 
+  find module: 
+    to line (mod file, 1); 
+    col (mod file, 1); 
+    downety (mod file, "$" + module name + "$"); 
+    IF eof (mod file) 
+      THEN errorstop ("Modul """ + module name + """ nicht im"13""10"" + 
+                      "Modul-File enthalten")
+    FI. 
+ 
+  transfer module: 
+    done := FALSE; 
+    read record (mod file, record); 
+    record := subtext (record, col (mod file) + LENGTH module name + 2);
+    WHILE NOT eof (mod file) AND NOT done REP 
+      transfer record
+    PER. 
+ 
+  transfer record: 
+    dollar pos := pos (record, "$"); 
+    IF dollar pos = 0
+      THEN write (driver file, compress (record)); 
+           line (driver file);
+           down (mod file); 
+           read record (mod file, record)  
+      ELSE write (driver file, compress (subtext (record, 1, 
+                                            dollar pos - 1)));
+           col (mod file, dollar pos); 
+           done := TRUE; 
+           cout (line no (mod file)) 
+    FI. 
+ 
+  insert programme: 
+    IF online 
+      THEN putline ("    - Der Treiber wird insertiert.") 
+    FI;
+    check off; 
+    insert (driver name). 
+ 
+  forget files: 
+    IF service option = 0 
+      THEN forget (description file name, quiet); 
+           forget (module file name, quiet)
+    FI.
+END PROC generate; 
+ 
+PROC adjust positioning: 
+ 
+  IF positioning = 1 
+    THEN do ("std speed (""slow"")") 
+    ELSE do ("std speed (""fast"")") 
+  FI 
+END PROC adjust positioning; 
+ 
+PROC adjust quality: 
+ 
+  IF quality = 1 
+    THEN do ("std quality (""draft"")") 
+    ELSE do ("std quality (""nlq"")") 
+  FI 
+END PROC adjust quality; 
+ 
+PROC adjust paper feed: 
+ 
+  IF sheet feeder = 1 
+    THEN do ("paper feed (""sheet"")") 
+    ELSE do ("paper feed (""tractor"")") 
+  FI 
+END PROC adjust paperfeed; 
+ 
+treiber einrichten 
+ 
+END PACKET driver inst 9
+
diff --git a/system/printer-9nadel/1986/doc/readme b/system/printer-9nadel/1986/doc/readme
new file mode 100644
index 0000000..4fe4035
--- /dev/null
+++ b/system/printer-9nadel/1986/doc/readme
@@ -0,0 +1,323 @@
+#type("nlq10")##limit(18.0)##start(1.5,1.0)# 

+#head# 

+Treiber-Installations-Programm   #right#Seite % 

+für 9-Nadel-Matrixdrucker   #right#23.06.1988 

+ 

+ 

+#end# 

+#on("u")#Dokumentation zum Treiber-Installations-Programm für 9-Nadel-

+Matrixdrucker#off("u")# 

+ 

+#on("u")#Inhalt:#off("u")# 

+ 

+1. Installations- und Gebrauchsanleitung 

+2. Druckertreiber-Auswahl 

+3. Steuerungsmöglichkeiten und Spezialfeatures 

+4. Weitere Hinweise 

+ 

+ 

+#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# 

+ 

+#on("u")#Einrichten#off("u")# 

+So wird das Treiber-Installationsprogramm eingerichtet: 

+ 

+       SV drücken 

+ 

+    nach 'gib supervisor kommando:' 

+ 

+       begin("PRINTER","SYSUR") 

+ 

+    in der Task "PRINTER" (nach 'gib kommando'): 

+ 

+       archive ("std.printer") 

+       fetch ("printer.neun.nadel",archive) 

+       check off 

+       insert ("printer.neun.nadel") 

+ 

+Das Programm wird dann insertiert. 

+ 

+#on("u")#Druckerkanal#off("u")# 

+Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker

+über Parallelschnittstelle betrieben wird, ist die Kanalnummer

+meistens 15. 

+ 

+#on("u")#Menüsystem#off("u")# 

+Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern.

+Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste

+der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier

+den passenden Typ aus! 

+Das Installationsprogramm zeigt nun einige Informationen zu dem ange-

+wählten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi-

+guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker muß unbedingt

+wie angegeben konfiguriert werden, wenn er mit dem ausgewählten Trei-

+ber betrieben werden soll. 

+ 

+Hinweise zu Konfigurationsangaben: 

+1. Die Angabe 'egal' bedeutet, daß die Einstellung für die Funktion

+   des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf

+   achten, welche Funktion die Schalter haben (Druckerhandbuch!). So

+   ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu

+   aktivieren, damit der Drucker nach Papierende nicht auf der Walze

+   weiterdruckt. 

+2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge-

+   wählten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker

+   als den ausgewählten verwenden, dann beachten Sie folgende Regeln

+   für die Konfiguration: 

+   - Der Drucker muß auf eine passende Emulation konfiguriert werden. 

+   - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei-

+     lenvorschub durchführen. 

+   - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch überspringen. 

+ 

+   - Auf Seitenlängen und internationale Zeichensätze müssen Sie nicht

+     achten. 

+ 

+(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) 

+ 

+Nach den Konfigurationsangaben werden Steuerungsmöglichkeiten des

+ausgewählten Treibers angezeigt. (Siehe hierzu Abschnitt 3) 

+ 

+Falls der Treiber bestimmte grundsätzliche Betriebsmöglichkeiten er-

+laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt,

+welche Möglichkeit standardmäßig gewählt werden soll. diese Vorein-

+stellungen können nachträglich in der Task "PRINTER" mit den entspre-

+chenden Steuerprozeduren neu gesetzt werden. Außerdem können bestimmte

+Einstellungen noch für jedes einzelne Dokument (d.h. für jede Druck-

+datei) gewählt ('material'-Anweisung) oder sogar innerhalb eines Doku-

+ments verändert werden (direkte Druckeranweisung #"..."#). 

+Über die Steuerungsmöglichkeiten informiert Abschnitt 3 ausführlicher. 

+ 

+ 

+#on("b")#2. Druckertreiber-Auswahl#off("b")# 

+ 

+#on("u")#Verwendung nicht im Menü enthaltener Drucker#off("u")# 

+Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden, soll-

+ten Sie zunächst versuchen, ob ein Treiber für einen anderen Drucker

+des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. 

+Falls dies nicht funktioniert oder der Hersteller überhaupt nicht im

+Menü erscheint, müssen Sie herausfinden (Druckerhandbuch, -händler!),

+welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist.

+(Viele Drucker verfügen über EPSON FX-85 bzw. FX-800-Emulationen oder

+IBM Grafikdrucker bzw. Proprinter-Eumulationen.) 

+Eine der beiden Anpassungen 'EPSON MX' oder 'IBM-Grafikdrucker' müßte

+immer einen (Minimal-) Betrieb ermöglichen. 

+ 

+#on("u")#Hinweise zu den Treibern für FX-80/85-kompatilble Drucker#off("u")# 

+Die Treiber für FX-80-bzw. FX-85-kompatible Geräte, die oft auch IBM-

+kompatibel sind, basieren üblicherweise auf den Treibern für EPSON-

+Drucker, weil so einige Schrifttypen (z.B. Proportionalschrift) und

+Modifikationen leichter ausgenutzt werden können. Ein Nachteil liegt

+aber darin, daß beim FX-80 und FX-85 noch die alten EPSON-Zeichensätze

+benutzt werden, die nicht die IBM-üblichen Grafik- und Sonderzeichen

+enthalten. 

+Falls für Sie die Benutzung dieser Zeichen vordringlich ist, sollten

+Sie Ihren Drucker (nachdem er auf IBM-Emulation konfiguriert wurde)

+zusammen mit dem Treiber für IBM-Grafikdrucker bzw. -Proprinter ver-

+wenden. 

+ 

+ 

+#on("b")#3. Steuerungsmöglichkeiten und Spezialfeatures#off("b")# 

+ 

+Einige Treiber bieten bestimmte Einstellungsmöglichkeiten (z.B.

+DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). 

+Die Einstellungen können über 

+- Steuerprozeduren 

+- Materialanweisungen bzw. 

+- direkte Druckeranweisungen 

+vorgenommen werden. 

+ 

+#on("u")#Steuerprozeduren#off("u")# 

+setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten

+sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER")

+aufgerufen werden. #on("b")#Gültig werden die Änderungen erst, wenn danach in

+der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# 

+ 

+PROC papersize (REAL CONST breite, länge) 

+    Dient zur Einstellung der Größe der physikalisch beschreibbaren

+    Fläche. 

+    Beispiel:  papersize (20.32, 30.48) 

+               (Standardeinstellung für Endlospapier 8 Zoll breit und

+               12 Zoll lang) 

+ 

+PROC papersize 

+    Informationsprozedur 

+ 

+PROC top margin (REAL CONST margin) 

+    Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk-

+    ken (zum Beispiel wegen eines Einzelblatteinzugs), muß mit dieser

+    Prozedur die Länge des oberen Randes, den der Drucker nicht be-

+    drucken kann, in cm angegeben werden. 

+    Beispiel:  top margin (2.0) 

+               (Teilt dem Druckertreiber mit, daß die ersten 2 cm

+               nicht bedruckbar sind.) 

+ 

+REAL PROC top margin 

+    Informationsprozedur 

+ 

+PROC std speed (TEXT CONST speed) 

+    Parameter: slow, fast 

+    Wahl zwischen Positionierung in Mikroschritten (slow) oder in

+    Blanks (fast). 

+    Beispiel:  std speed ("slow") 

+ 

+TEXR PROC std speed 

+    Informationsprozedur 

+ 

+PROC std quality (TEXT CONST quality) 

+    übliche Parameter: draft, nlq 

+    Wahl zwischen Datenverarbeitungs-Qualität und Schönschrift-

+    Qualität 

+    Beispiel:  std quality ("draft") 

+ 

+TEXT PROC std quality 

+    Informationsprozedur 

+ 

+PROC std typeface (TEXT CONST typeface) 

+    übliche Parameter: roman, sansserif, courier 

+    Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im

+    NLQ-Modus, das heißt 'std typeface' schaltet nicht auf NLQ). 

+    Beispiel: std typeface ("roman") 

+ 

+TEXT PROC std typeface 

+    Informationsprozedur 

+ 

+PROC paper feed (TEXT CONST name) 

+    übliche Parameter: tractor, sheet, schacht1, schacht2 

+    Wählt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. 

+    Beispiel:  paper feed ("sheet") 

+ 

+TEXT PROC paper feed 

+    Informationsprozedur 

+ 

+ 

+#on("u")#Materialanweisungen #material("...")##off("u")# 

+müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und

+setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben

+für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge-

+stellten Standardwerten. Diese werden durch die Materialanweisung aber

+nicht geändert.) 

+ 

+Beispiel:  #material("nlq")# 

+           sorgt bei entsprechendem Treiber dafür, daß das gesamte

+           Dokument in Schönschrift-Qualität ausgedruckt wird, egal

+           wie 'std quality' eingestellt ist. 

+ 

+#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh-

+rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung

+erscheinen. Beispiel:  #material("sheet;draft")# 

+ 

+ 

+#on("u")#direkte Druckeranweisungen #"..."##off("u")# 

+gelten ab der Position, an der sie in der Datei auftreten. Sie haben

+(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und

+Materialeinstellungen. 

+ 

+Beispiel:  #"draft"# 

+           schaltet (bei entsprechendem Treiber) auf Datenverar-

+           beitungs-Qualität, egal welche Standardeinstellung vorliegt

+           und welche Materialanweisung gegeben wurde. 

+ 

+#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen

+werden.#off("b")# Also:  #"nlq"##"sansserif"# 

+ 

+ 

+#on("u")#Wichtig#off("u")# 

+- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen

+  besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben

+  berücksichtigt! Also:  #"nlq"# und keinesfalls #"NLQ"#!!! 

+- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und

+  nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann

+  daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse

+  erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen

+  Reihenfolge an den Drucker sendet, als er in der Datei steht, die

+  mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B.

+  für beide Spalten) unerwünscht erhalten bleibt. 

+ 

+ 

+#on("u")#Tabelle#off("u")# 

+Die Tabelle soll einen Anhaltspunkt dafür geben, wie welche Einstel-

+lungen erfolgen können. 

+ 

+#type("17")# 

+                   Steuerprozeduren      Materialanweisungen     direkte Druckeranweisungen 

+ 

+#on("u")#                                                                                          #off("u")# 

+ 

+Positionierung     std speed             slow, fast              ------ 

+                     slow, fast 

+ 

+Qualität           std quality           z.B. draft, nlq         z.B. draft, nlq 

+                     z.B. draft, nlq 

+ 

+Schriftart         std typeface          z.B. roman,             z.B. roman, 

+(nur bei NLQ)        z.B. roman,         sansserif, courier      sansserif, courier 

+                     sansserif, courier 

+ 

+Einzelblatt-       paper feed            z.B. schacht1,          z.B. schacht1, 

+einzug               z.B. tractor,       schacht2                schacht2 

+                     sheet, 

+                     schacht1, schacht2 

+ 

+Farbdruck          ------                ------                  z.B. schwarz, 

+                                                                 rot, blau, 

+                                                                 violett, gelb 

+                                                                 orange, grün 

+ 

+ 

+ 

+#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# 

+ 

+#on("u")#Zeichensatzänderungen gegenüber früheren Versionen#off("u")# 

+In den Fonttabellen früherer Druckertreiber-Versionen wurden oberhalb

+des Codes 127 einige internationale Zeichen zur Verfügung gestellt

+(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). 

+Bei den Treibern der vorliegenden Version gilt folgendes: 

+- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL-

+  Zeichensatz (sofern möglich) unterstützt. 

+- Der Code 252 liefert das Paragraphzeichen. 

+- Alle übrigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes

+  oberhalb 127 liefern, sofern möglich, die entsprechenden Zeichen des

+  IBM-Grafikzeichensatzes. 

+ 

+ 

+#on("u")#Hinweis zu Proportionalschriften#off("u")# 

+Bei Proportionalschriften sollte die Modifikation #on("i")# nicht

+benutzt werden, da die kursiven Zeichen andere Proportionalbreiten

+haben. Stattdessen sollte auf den schrägen Typ umgeschaltet werden

+(z.B. von "prop10" auf "prop10i"). 

+ 

+ 

+#on("u")#Hinweis zur Benutzung von Einzelblatteinzügen#off("u")# 

+Bei der Benutzung von Einzelblatteinzügen müssen folgende Einstel-

+lungen vorgenommen werden (vgl. auch Abschnitt 3!): 

+ 

+   Am Drucker: 

+1. Sie müssen Ihren Drucker auf die Option Einzelblatteinzug konfigu-

+   rieren (siehe Druckerhandbuch!). 

+ 

+   In der Druckspooltask (meist 'PRINTER'): 

+2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verfü-

+   gung stellt, müssen Sie mit 'paperfeed ("sheet")' oder (für

+   2-Schacht-Einzüge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed

+   ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. 

+3. Falls Sie eine andere Papierlänge als 12 Zoll (=30.48 cm) verwen-

+   den, müssen Sie die neuen Papiermaße mit 'papersize' in cm einstel-

+   len. 

+   Beispiel:  papersize (21.0, 29.7) 

+              (für DIN A4-Blätter) 

+4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt-

+   anfang drucken kann, sondern ein gewisser oberer Rand bleibt, muß

+   mit 'top margin' die Länge des nicht bedruckbaren Randes in cm dem

+   Druckertreiber mitgeteilt werden. 

+   Beispiel:  top margin (1.5) 

+   (Wie groß der obere Rand ist, kann festgestellt werden, indem eine

+   Datei mit #start(0.0,0.0)# ausgedruckt wird.) 

+ 

+   Wurde mit 'top margin' dem Treiber die Größe der nicht bedruckbaren

+   Fläche mitgeteilt, so ist darauf zu achten, daß in den Druckdateien

+   ein genügend großer y-Wert für die Startposition eingestellt wird

+   ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der

+   ersten Zeile zu Überschreibungen. 

+ 

+ 

+#on("b")#5. Die Änderungen, die Sie in der Druckspooltask vorgenommen haben

+   werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# 

diff --git a/system/printer-9nadel/1986/src/CHARED.ELA b/system/printer-9nadel/1986/src/CHARED.ELA
new file mode 100644
index 0000000..a54679f
--- /dev/null
+++ b/system/printer-9nadel/1986/src/CHARED.ELA
@@ -0,0 +1,47 @@
+PACKET chared DEFINES chared : 

+ 

+PROC chared (TEXT VAR text denoter, BOOL CONST dens) :

+FILE VAR f := editfile; 

+TEXT VAR t ; 

+ROW 30 INT VAR bytes ; 

+INT VAR i, zeile, max breite := 0 ; 

+FOR i FROM 1 UPTO 30 REP 

+ bytes(i) := 0 

+PER ; 

+input (f) ; 

+zeile := 7 ;

+WHILE NOT eof (f) REP 

+ getline (f, t) ; 

+ convert line ; 

+ zeile DECR 1

+UNTIL zeile < 0 PER ; 

+convert to text denoter . 

+ 

+ 

+convert line : 

+ FOR i FROM 1 UPTO LENGTH t REP 

+  IF (t SUB i) <> " " AND (t SUB i) <> "." 

+     THEN setbit (bytes (i), zeile) ; 

+          max breite := max (max breite, i)

+  FI 

+ PER . 

+ 

+convert to text denoter : 

+ text denoter := """""27""K""" ;

+ IF dens 

+   THEN text denoter CAT text (max breite) 

+   ELSE text denoter CAT text (max breite DIV 2) 

+ FI ; 

+ text denoter CAT """""0""" ; 

+ FOR i FROM 1 UPTO max breite REP 

+  IF dens OR (i AND 1) = 1 

+     THEN text denoter CAT """" ; 

+          text denoter CAT text (bytes (i)) ; 

+          text denoter CAT """"

+  FI

+ PER ; 

+ text denoter CAT """" . 

+ 

+ENDPROC chared ; 

+ 

+ENDPACKET chared

diff --git a/system/printer-9nadel/1986/src/EPSONFX.ELA b/system/printer-9nadel/1986/src/EPSONFX.ELA
new file mode 100644
index 0000000..40b9cc3
--- /dev/null
+++ b/system/printer-9nadel/1986/src/EPSONFX.ELA
@@ -0,0 +1,575 @@
+ FONTTABLE  :  "fonttab.epson.fx+";

+   x unit      =  47.24409;

+   y unit      =  85.03937;

+   on string   =  ""27"-1",  ""27"G",  ""27"4",  "";

+   off string  =  ""27"-0",  ""27"H",  ""27"5",  "";

+ 

+           ""127"",   "";

+           ""128"",   "-";

+           ""129"",   "-";

+           ""130"",   "-";

+           ""131"",   "-";

+           ""132"",   "-";

+           ""133"",   "-";

+           ""134"",   "-";

+           ""135"",   "-";

+           ""136"",   "-";

+           ""137"",   "-";

+           ""138"",   "-";

+           ""139"",   "-";

+           ""140"",   "-";

+           ""141"",   "-";

+           ""142"",   "-";

+           ""143"",   "-";

+           ""144"",   "-";

+           ""145"",   "-";

+           ""146"",   "-";

+           ""147"",   "-";

+           ""148"",   "-";

+           ""149"",   "-";

+           ""150"",   "-";

+           ""151"",   "-";

+           ""152"",   "-";

+           ""153"",   "-";

+           ""154"",   "-";

+           ""155"",   "-";

+           ""156"",   "-";

+           ""157"",   "-";

+           ""158"",   "-";

+           ""159"",   "-";

+           ""160"",   "-";

+           ""161"",   "-";

+           ""162"",   "-";

+           ""163"",   "-";

+           ""164"",   "-";

+           ""165"",   "-";

+           ""166"",   "-";

+           ""167"",   "-";

+           ""168"",   "-";

+           ""169"",   "-";

+           ""170"",   "-";

+           ""171"",   "-";

+           ""172"",   "-";

+           ""173"",   "-";

+           ""174"",   "-";

+           ""175"",   "-";

+           ""176"",   "-";

+           ""177"",   "-";

+           ""178"",   "-";

+           ""179"",   "-";

+           ""180"",   "-";

+           ""181"",   "-";

+           ""182"",   "-";

+           ""183"",   "-";

+           ""184"",   "-";

+           ""185"",   "-";

+(*i`*)     ""186"",   ""27"%"0""0""4""27"%"1""0"";

+           ""187"",   "-";

+           ""188"",   "-";

+           ""189"",   "-";

+(*a`*)     ""190"",   ""27"%"0""0""0""27"%"1""0"";

+           ""191"",   "-";

+           ""192"",   "-";

+(*e'*)     ""193"",   ""27"R"1"{"27"R"0"";

+(*e`*)     ""194"",   ""27"%"0""0""1""27"%"1""0"";

+           ""195"",   "-";

+           ""196"",   "-";

+           ""197"",   "-";

+(*o`*)     ""198"",   ""27"%"0""0""3""27"%"1""0"";

+           ""199"",   "-";

+(*c,*)     ""200"",   ""27"R"1"\"27"R"0"";

+           ""201"",   "-";

+(*u`*)     ""202"",   ""27"%"0""0""2""27"%"1""0"";

+           ""203"",   "-";

+           ""204"",   "-";

+(*grad*)   ""205"",   ""27"R"1"["27"R"0"";

+(*A-grad*) ""206"",   ""27"R"4"]"27"R"0"";

+(*AE*)     ""207"",   ""27"R"4"]"27"R"0"";

+(*E'*)     ""208"",   ""27"R"5"@"27"R"0"";

+(*N~*)     ""209"",   ""27"R"7"\"27"R"0"";

+(*a-punkt*)""210"",   ""27"R"4"}"27"R"0"";

+(*ae*)     ""211"",   ""27"R"4"{"27"R"0"";

+(*n~*)     ""212"",   ""27"R"7"|"27"R"0"";

+(*pound*)  ""213"",   ""27"R"3"#"27"R"0"";

+   (* Ä *) ""214"",   ""27"R"2"["27"R"0"";

+   (* Ö *) ""215"",   ""27"R"2"\"27"R"0"";

+   (* Ü *) ""216"",   ""27"R"2"]"27"R"0"";

+   (* ä *) ""217"",   ""27"R"2"{"27"R"0"";

+   (* ö *) ""218"",   ""27"R"2"|"27"R"0"";

+   (* ü *) ""219"",   ""27"R"2"}"27"R"0"";

+   (* k *) ""220"",   "k";

+   (* - *) ""221"",   "-";

+   (* # *) ""222"",   "#";

+   (*   *) ""223"",   " ";

+           ""224"",   "-";

+           ""225"",   "-";

+           ""226"",   "-";

+           ""227"",   "-";

+           ""228"",   "-";

+           ""229"",   "-";

+           ""230"",   "-";

+           ""231"",   "-";

+           ""232"",   "-";

+           ""233"",   "-";

+           ""234"",   "-";

+           ""235"",   "-";

+           ""236"",   "-";

+           ""237"",   "-";

+           ""238"",   "-";

+           ""239"",   "-";

+           ""240"",   "-";

+           ""241"",   "-";

+           ""242"",   "-";

+           ""243"",   "-";

+           ""244"",   "-";

+           ""245"",   "-";

+           ""246"",   "-";

+           ""247"",   "-";

+           ""248"",   "-";

+           ""249"",   "-";

+           ""250"",   "-";

+   (* ß *) ""251"",   ""27"R"2"~"27"R"0"";

+(*paragr.*)""252"",   ""27"R"2"@"27"R"0"";

+           ""253"",   "-";

+           ""254"",   "-";

+           ""255"",   "-";

+ 

+ 

+   FONT  :  "17",  "micron",  "elanlist";

+     indentation pitch  =  7;

+     font height        =  36;

+     next smaller font  =  "17.klein";

+     font string        =  ""27"!"4""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "17.klein",  "micron.klein";

+     indentation pitch  =  7;

+     font height        =  19;

+     font string        =  ""27"!"4""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10",  "pica";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10.klein";

+     font string        =  ""27"!"0""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10.klein",  "pica.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!"0""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10b.klein";

+     font string        =  ""27"!"8""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!"8""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "20";

+     indentation pitch  =  6;

+     font height        =  36;

+     next smaller font  =  "10.klein";

+     font string        =  ""27"!"5""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "20.klein";

+     indentation pitch  =  6;

+     font height        =  19;

+     font string        =  ""27"!"5""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12",  "elite";

+     indentation pitch  =  10;

+     font height        =  36;

+     next smaller font  =  "12.klein";

+     font string        =  ""27"!"1""27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12.klein",  "elite.klein";

+     indentation pitch  =  10;

+     font height        =  19;

+     font string        =  ""27"!"1""27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8.5",  "8";

+     indentation pitch  =  14;

+     font height        =  36;

+     next smaller font  =  "8.5.klein";

+     font string        =  ""27"!$"27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8.5.klein",  "8.klein";

+     indentation pitch  =  14;

+     font height        =  19;

+     font string        =  ""27"!$"27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5.klein";

+     font string        =  ""27"! "27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"! "27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5b.klein";

+     font string        =  ""27"!("27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"!("27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10-2";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10-2.klein";

+     font string        =  ""27"!%"27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10-2.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!%"27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6";

+     indentation pitch  =  20;

+     font height        =  36;

+     next smaller font  =  "6.klein";

+     font string        =  ""27"!!"27"5"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6.klein";

+     indentation pitch  =  20;

+     font height        =  19;

+     font string        =  ""27"!!"27"5"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "prop10";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "prop10.klein";

+     font string        =  ""27"!"0""27"5"27"T"27"p1";

+ 

+   (* ! *) ""033"",    5;              (* " *) ""034"",    8;

+   (* ' *) ""039"",    5;              (* ( *) ""040"",    6;

+   (* ) *) ""041"",    6;              (* , *) ""044"",    7;

+   (* . *) ""046"",    6;              (* / *) ""047"",   10;

+   (* 1 *) ""049"",    8;              (* : *) ""058"",    6;

+   (* ; *) ""059"",    6;              (* < *) ""060"",   10;

+   (* > *) ""062"",   10;              (* I *) ""073"",    8;

+   (* J *) ""074"",   11;              (* X *) ""088"",   10;

+   (* Z *) ""090"",   10;              (* [ *) ""091"",    8;

+   (* \ *) ""092"",   10;              (* ] *) ""093"",    8;

+   (* ` *) ""096"",    5;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* d *) ""100"",   11;

+   (* f *) ""102"",   10;              (* g *) ""103"",   11;

+   (* h *) ""104"",   11;              (* i *) ""105"",    8;

+   (* j *) ""106"",    9;              (* k *) ""107"",   10;

+   (* l *) ""108"",    8;              (* n *) ""110"",   11;

+   (* p *) ""112"",   11;              (* q *) ""113"",   11;

+   (* r *) ""114"",   11;              (* t *) ""116"",   11;

+   (* x *) ""120"",   10;              (* z *) ""122"",   10;

+           ""123"",    9;              (* | *) ""124"",    5;

+           ""125"",    9;                      ""127"",    0;

+           ""186"",    6;                      ""198"",   10;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""212"",   11;

+   (* ö *) ""218"",   10;              (* ü *) ""219"",   11;

+   (* k *) ""220"",   10;              (* ß *) ""251"",   11;

+           ""252"",   10;              

+ 

+   FONT  :  "prop10.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     next smaller font  =  "prop10";

+     font string        =  ""27"!"0""27"5"27"S1"27"p1";

+ 

+   (* ! *) ""033"",    5;              (* " *) ""034"",    8;

+   (* ' *) ""039"",    5;              (* ( *) ""040"",    6;

+   (* ) *) ""041"",    6;              (* , *) ""044"",    7;

+   (* . *) ""046"",    6;              (* / *) ""047"",   10;

+   (* 1 *) ""049"",    8;              (* : *) ""058"",    6;

+   (* ; *) ""059"",    6;              (* < *) ""060"",   10;

+   (* > *) ""062"",   10;              (* I *) ""073"",    8;

+   (* J *) ""074"",   11;              (* X *) ""088"",   10;

+   (* Z *) ""090"",   10;              (* [ *) ""091"",    8;

+   (* \ *) ""092"",   10;              (* ] *) ""093"",    8;

+   (* ` *) ""096"",    5;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* d *) ""100"",   11;

+   (* f *) ""102"",   10;              (* g *) ""103"",   11;

+   (* h *) ""104"",   11;              (* i *) ""105"",    8;

+   (* j *) ""106"",    9;              (* k *) ""107"",   10;

+   (* l *) ""108"",    8;              (* n *) ""110"",   11;

+   (* p *) ""112"",   11;              (* q *) ""113"",   11;

+   (* r *) ""114"",   11;              (* t *) ""116"",   11;

+   (* x *) ""120"",   10;              (* z *) ""122"",   10;

+           ""123"",    9;              (* | *) ""124"",    5;

+           ""125"",    9;                      ""127"",    0;

+           ""186"",    6;                      ""198"",   10;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""212"",   11;

+   (* ö *) ""218"",   10;              (* ü *) ""219"",   11;

+   (* k *) ""220"",   10;              (* ß *) ""251"",   11;

+           ""252"",   10;              

+ 

+   FONT  :  "prop10i";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "prop10i.klein";

+     font string        =  ""27"!"0""27"4"27"T"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   10;

+   (* $ *) ""036"",   11;              (* ' *) ""039"",    5;

+   (* ( *) ""040"",    8;              (* ) *) ""041"",    8;

+   (* , *) ""044"",    8;              (* . *) ""046"",    7;

+   (* / *) ""047"",   10;              (* 1 *) ""049"",    9;

+   (* 6 *) ""054"",   11;              (* 9 *) ""057"",   11;

+   (* : *) ""058"",    8;              (* ; *) ""059"",    9;

+   (* < *) ""060"",   10;              (* = *) ""061"",   11;

+   (* > *) ""062"",    9;              (* ? *) ""063"",   11;

+   (* I *) ""073"",   10;              (* L *) ""076"",   10;

+   (* V *) ""086"",   11;              (* [ *) ""091"",   11;

+   (* \ *) ""092"",    7;              (* ] *) ""093"",   11;

+   (* ^ *) ""094"",   10;              (* ` *) ""096"",    5;

+   (* a *) ""097"",   11;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* e *) ""101"",   11;

+   (* g *) ""103"",   11;              (* h *) ""104"",   11;

+   (* i *) ""105"",    9;              (* j *) ""106"",   10;

+   (* k *) ""107"",   11;              (* l *) ""108"",    9;

+   (* m *) ""109"",   11;              (* n *) ""110"",   10;

+   (* o *) ""111"",   11;              (* p *) ""112"",   11;

+   (* q *) ""113"",   11;              (* r *) ""114"",   10;

+   (* s *) ""115"",   11;              (* t *) ""116"",   10;

+   (* u *) ""117"",   11;              (* v *) ""118"",   10;

+   (* y *) ""121"",   11;                      ""123"",   10;

+   (* | *) ""124"",    9;                      ""125"",   10;

+           ""127"",    0;                      ""186"",    8;

+           ""190"",   11;                      ""193"",   11;

+           ""194"",   11;                      ""198"",   11;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""210"",   11;

+   (* ä *) ""217"",   11;              (* ö *) ""218"",   11;

+   (* k *) ""220"",   11;              (* ß *) ""251"",   11;

+ 

+   FONT  :  "prop10i.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"!"0""27"4"27"S1"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   10;

+   (* $ *) ""036"",   11;              (* ' *) ""039"",    5;

+   (* ( *) ""040"",    8;              (* ) *) ""041"",    8;

+   (* , *) ""044"",    8;              (* . *) ""046"",    7;

+   (* / *) ""047"",   10;              (* 1 *) ""049"",    9;

+   (* 6 *) ""054"",   11;              (* 9 *) ""057"",   11;

+   (* : *) ""058"",    8;              (* ; *) ""059"",    9;

+   (* < *) ""060"",   10;              (* = *) ""061"",   11;

+   (* > *) ""062"",    9;              (* ? *) ""063"",   11;

+   (* I *) ""073"",   10;              (* L *) ""076"",   10;

+   (* V *) ""086"",   11;              (* [ *) ""091"",   11;

+   (* \ *) ""092"",    7;              (* ] *) ""093"",   11;

+   (* ^ *) ""094"",   10;              (* ` *) ""096"",    5;

+   (* a *) ""097"",   11;              (* b *) ""098"",   11;

+   (* c *) ""099"",   11;              (* e *) ""101"",   11;

+   (* g *) ""103"",   11;              (* h *) ""104"",   11;

+   (* i *) ""105"",    9;              (* j *) ""106"",   10;

+   (* k *) ""107"",   11;              (* l *) ""108"",    9;

+   (* m *) ""109"",   11;              (* n *) ""110"",   10;

+   (* o *) ""111"",   11;              (* p *) ""112"",   11;

+   (* q *) ""113"",   11;              (* r *) ""114"",   10;

+   (* s *) ""115"",   11;              (* t *) ""116"",   10;

+   (* u *) ""117"",   11;              (* v *) ""118"",   10;

+   (* y *) ""121"",   11;                      ""123"",   10;

+   (* | *) ""124"",    9;                      ""125"",   10;

+           ""127"",    0;                      ""186"",    8;

+           ""190"",   11;                      ""193"",   11;

+           ""194"",   11;                      ""198"",   11;

+           ""200"",   11;                      ""202"",   11;

+           ""205"",    8;                      ""210"",   11;

+   (* ä *) ""217"",   11;              (* ö *) ""218"",   11;

+   (* k *) ""220"",   11;              (* ß *) ""251"",   11;

+ 

+   FONT  :  "prop5";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "prop5.klein";

+     font string        =  ""27"! "27"5"27"T"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   16;

+   (* ' *) ""039"",   10;              (* ( *) ""040"",   12;

+   (* ) *) ""041"",   12;              (* , *) ""044"",   14;

+   (* . *) ""046"",   12;              (* / *) ""047"",   20;

+   (* 1 *) ""049"",   16;              (* : *) ""058"",   12;

+   (* ; *) ""059"",   12;              (* < *) ""060"",   20;

+   (* > *) ""062"",   20;              (* I *) ""073"",   16;

+   (* J *) ""074"",   22;              (* X *) ""088"",   20;

+   (* Z *) ""090"",   20;              (* [ *) ""091"",   16;

+   (* \ *) ""092"",   20;              (* ] *) ""093"",   16;

+   (* ` *) ""096"",   10;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* d *) ""100"",   22;

+   (* f *) ""102"",   20;              (* g *) ""103"",   22;

+   (* h *) ""104"",   22;              (* i *) ""105"",   16;

+   (* j *) ""106"",   18;              (* k *) ""107"",   20;

+   (* l *) ""108"",   16;              (* n *) ""110"",   22;

+   (* p *) ""112"",   22;              (* q *) ""113"",   22;

+   (* r *) ""114"",   22;              (* t *) ""116"",   22;

+   (* x *) ""120"",   20;              (* z *) ""122"",   20;

+           ""123"",   18;              (* | *) ""124"",   10;

+           ""125"",   18;                      ""127"",    0;

+           ""186"",   12;                      ""198"",   20;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""212"",   22;

+   (* ö *) ""218"",   20;              (* ü *) ""219"",   22;

+   (* k *) ""220"",   20;              (* ß *) ""251"",   22;

+           ""252"",   20;              

+ 

+   FONT  :  "prop5.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"! "27"5"27"S1"27"p1";

+ 

+   (* ! *) ""033"",   10;              (* " *) ""034"",   16;

+   (* ' *) ""039"",   10;              (* ( *) ""040"",   12;

+   (* ) *) ""041"",   12;              (* , *) ""044"",   14;

+   (* . *) ""046"",   12;              (* / *) ""047"",   20;

+   (* 1 *) ""049"",   16;              (* : *) ""058"",   12;

+   (* ; *) ""059"",   12;              (* < *) ""060"",   20;

+   (* > *) ""062"",   20;              (* I *) ""073"",   16;

+   (* J *) ""074"",   22;              (* X *) ""088"",   20;

+   (* Z *) ""090"",   20;              (* [ *) ""091"",   16;

+   (* \ *) ""092"",   20;              (* ] *) ""093"",   16;

+   (* ` *) ""096"",   10;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* d *) ""100"",   22;

+   (* f *) ""102"",   20;              (* g *) ""103"",   22;

+   (* h *) ""104"",   22;              (* i *) ""105"",   16;

+   (* j *) ""106"",   18;              (* k *) ""107"",   20;

+   (* l *) ""108"",   16;              (* n *) ""110"",   22;

+   (* p *) ""112"",   22;              (* q *) ""113"",   22;

+   (* r *) ""114"",   22;              (* t *) ""116"",   22;

+   (* x *) ""120"",   20;              (* z *) ""122"",   20;

+           ""123"",   18;              (* | *) ""124"",   10;

+           ""125"",   18;                      ""127"",    0;

+           ""186"",   12;                      ""198"",   20;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""212"",   22;

+   (* ö *) ""218"",   20;              (* ü *) ""219"",   22;

+   (* k *) ""220"",   20;              (* ß *) ""251"",   22;

+           ""252"",   20;              

+ 

+   FONT  :  "prop5i";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "prop5i.klein";

+     font string        =  ""27"! "27"4"27"T"27"p1";

+ 

+   (* ! *) ""033"",   20;              (* " *) ""034"",   20;

+   (* $ *) ""036"",   22;              (* ' *) ""039"",   10;

+   (* ( *) ""040"",   16;              (* ) *) ""041"",   16;

+   (* , *) ""044"",   16;              (* . *) ""046"",   14;

+   (* / *) ""047"",   20;              (* 1 *) ""049"",   18;

+   (* 6 *) ""054"",   22;              (* 9 *) ""057"",   22;

+   (* : *) ""058"",   16;              (* ; *) ""059"",   18;

+   (* < *) ""060"",   20;              (* = *) ""061"",   22;

+   (* > *) ""062"",   18;              (* ? *) ""063"",   22;

+   (* I *) ""073"",   20;              (* L *) ""076"",   20;

+   (* V *) ""086"",   22;              (* [ *) ""091"",   22;

+   (* \ *) ""092"",   14;              (* ] *) ""093"",   22;

+   (* ^ *) ""094"",   20;              (* ` *) ""096"",   10;

+   (* a *) ""097"",   22;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* e *) ""101"",   22;

+   (* g *) ""103"",   22;              (* h *) ""104"",   22;

+   (* i *) ""105"",   18;              (* j *) ""106"",   20;

+   (* k *) ""107"",   22;              (* l *) ""108"",   18;

+   (* m *) ""109"",   22;              (* n *) ""110"",   20;

+   (* o *) ""111"",   22;              (* p *) ""112"",   22;

+   (* q *) ""113"",   22;              (* r *) ""114"",   20;

+   (* s *) ""115"",   22;              (* t *) ""116"",   20;

+   (* u *) ""117"",   22;              (* v *) ""118"",   20;

+   (* y *) ""121"",   22;                      ""123"",   20;

+   (* | *) ""124"",   18;                      ""125"",   20;

+           ""127"",    0;                      ""186"",   16;

+           ""190"",   22;                      ""193"",   22;

+           ""194"",   22;                      ""198"",   22;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""210"",   22;

+   (* ä *) ""217"",   22;              (* ö *) ""218"",   22;

+   (* k *) ""220"",   22;              (* ß *) ""251"",   22;

+ 

+   FONT  :  "prop5i.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"! "27"4"27"S1"27"p1";

+ 

+   (* ! *) ""033"",   20;              (* " *) ""034"",   20;

+   (* $ *) ""036"",   22;              (* ' *) ""039"",   10;

+   (* ( *) ""040"",   16;              (* ) *) ""041"",   16;

+   (* , *) ""044"",   16;              (* . *) ""046"",   14;

+   (* / *) ""047"",   20;              (* 1 *) ""049"",   18;

+   (* 6 *) ""054"",   22;              (* 9 *) ""057"",   22;

+   (* : *) ""058"",   16;              (* ; *) ""059"",   18;

+   (* < *) ""060"",   20;              (* = *) ""061"",   22;

+   (* > *) ""062"",   18;              (* ? *) ""063"",   22;

+   (* I *) ""073"",   20;              (* L *) ""076"",   20;

+   (* V *) ""086"",   22;              (* [ *) ""091"",   22;

+   (* \ *) ""092"",   14;              (* ] *) ""093"",   22;

+   (* ^ *) ""094"",   20;              (* ` *) ""096"",   10;

+   (* a *) ""097"",   22;              (* b *) ""098"",   22;

+   (* c *) ""099"",   22;              (* e *) ""101"",   22;

+   (* g *) ""103"",   22;              (* h *) ""104"",   22;

+   (* i *) ""105"",   18;              (* j *) ""106"",   20;

+   (* k *) ""107"",   22;              (* l *) ""108"",   18;

+   (* m *) ""109"",   22;              (* n *) ""110"",   20;

+   (* o *) ""111"",   22;              (* p *) ""112"",   22;

+   (* q *) ""113"",   22;              (* r *) ""114"",   20;

+   (* s *) ""115"",   22;              (* t *) ""116"",   20;

+   (* u *) ""117"",   22;              (* v *) ""118"",   20;

+   (* y *) ""121"",   22;                      ""123"",   20;

+   (* | *) ""124"",   18;                      ""125"",   20;

+           ""127"",    0;                      ""186"",   16;

+           ""190"",   22;                      ""193"",   22;

+           ""194"",   22;                      ""198"",   22;

+           ""200"",   22;                      ""202"",   22;

+           ""205"",   16;                      ""210"",   22;

+   (* ä *) ""217"",   22;              (* ö *) ""218"",   22;

+   (* k *) ""220"",   22;              (* ß *) ""251"",   22;

diff --git a/system/printer-9nadel/1986/src/EPSONRX.ELA b/system/printer-9nadel/1986/src/EPSONRX.ELA
new file mode 100644
index 0000000..ebc9f23
--- /dev/null
+++ b/system/printer-9nadel/1986/src/EPSONRX.ELA
@@ -0,0 +1,171 @@
+ FONTTABLE  :  "fonttab.epson.rx";

+   x unit      =  47.24409;

+   y unit      =  85.03937;

+   on string   =  ""27"-1",  ""27"G",  ""27"4",  "";

+   off string  =  ""27"-0",  ""27"H",  ""27"5",  "";

+ 

+           ""127"",   "";

+(*Herz*)   ""153"",   ""146"";

+(*Karo*)   ""154"",   ""147"";

+(*Baum*)   ""155"",   ""148"";

+(*Pik *)   ""156"",   ""145"";

+(*Note*)   ""157"",   ""149"";

+(*Telefon*)""158"",   ""150"";

+(*Flugzg.*)""159"",   ""151"";

+(*Auto*)   ""160"",   ""152"";

+(*Glas*)   ""161"",   ""153"";

+(*Mann*)   ""162"",   ""154"";

+(*i`*)     ""186"",   ""27"R"6"~"27"R"0"";

+(*a`*)     ""190"",   ""27"R"6"{"27"R"0"";

+(*e'*)     ""193"",   ""27"R"6"]"27"R"0"";

+(*e`*)     ""194"",   ""27"R"6"}"27"R"0"";

+(*o`*)     ""198"",   ""27"R"6"|"27"R"0"";

+(*c,*)     ""200"",   ""27"R"1"\"27"R"0"";

+(*u`*)     ""202"",   ""27"R"6"`"27"R"0"";

+(*grad*)   ""205"",   ""27"R"1"["27"R"0"";

+(*A-grad*) ""206"",   ""27"R"4"]"27"R"0"";

+(*AE*)     ""207"",   ""27"R"4"["27"R"0"";

+(*E'*)     ""208"",   ""27"R"5"@"27"R"0"";

+(*N~*)     ""209"",   ""27"R"7"\"27"R"0"";

+(*a-punkt*)""210"",   ""27"R"4"}"27"R"0"";

+(*ae*)     ""211"",   ""27"R"4"{"27"R"0"";

+(*n~*)     ""212"",   ""27"R"7"|"27"R"0"";

+(*pound*)  ""213"",   ""27"R"3"#"27"R"0"";

+   (* Ä *) ""214"",   ""27"R"2"["27"R"0"";

+   (* Ö *) ""215"",   ""27"R"2"\"27"R"0"";

+   (* Ü *) ""216"",   ""27"R"2"]"27"R"0"";

+   (* ä *) ""217"",   ""27"R"2"{"27"R"0"";

+   (* ö *) ""218"",   ""27"R"2"|"27"R"0"";

+   (* ü *) ""219"",   ""27"R"2"}"27"R"0"";

+   (* k *) ""220"",   "k";

+   (* - *) ""221"",   "-";

+   (* # *) ""222"",   "#";

+   (*   *) ""223"",   " ";

+(* +/- *)  ""224"",   ""159"";

+(*uparrow*)""236"",   ""155"";

+(*downarr*)""238"",   ""156"";

+(*x-kreuz*)""245"",   ""157"";

+(*geteilt*)""246"",   ""158"";

+   (* ß *) ""251"",   ""27"R"2"~"27"R"0"";

+(*paragr.*)""252"",   ""27"R"2"@"27"R"0"";

+ 

+ 

+   FONT  :  "17",  "micron";

+     indentation pitch  =  7;

+     font height        =  36;

+     next smaller font  =  "17.klein";

+     font string        =  ""27"P"15""27"W"0""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "17.klein",  "micron.klein", "elanlist";

+     indentation pitch  =  7;

+     font height        =  19;

+     font string        =  ""27"P"15""27"W"0""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8";

+     indentation pitch  =  14;

+     font height        =  36;

+     next smaller font  =  "8.klein";

+     font string        =  ""27"P"15""27"W"1""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "8.klein";

+     indentation pitch  =  14;

+     font height        =  19;

+     font string        =  ""27"P"15""27"W"1""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10",  "pica";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10.klein";

+     font string        =  ""27"P"18""27"W"0""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10.klein",  "pica.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"0""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b";

+     indentation pitch  =  12;

+     font height        =  36;

+     next smaller font  =  "10b.klein";

+     font string        =  ""27"P"18""27"W"0""27"E"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "10b.klein";

+     indentation pitch  =  12;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"0""27"E"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12",  "elite";

+     indentation pitch  =  10;

+     font height        =  36;

+     next smaller font  =  "12.klein";

+     font string        =  ""18""27"M"27"W"0""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "12.klein",  "elite.klein";

+     indentation pitch  =  10;

+     font height        =  19;

+     font string        =  ""18""27"M"27"W"0""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5.klein";

+     font string        =  ""27"P"18""27"W"1""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"1""27"F"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b";

+     indentation pitch  =  24;

+     font height        =  36;

+     next smaller font  =  "5b.klein";

+     font string        =  ""27"P"18""27"W"1""27"E"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "5b.klein";

+     indentation pitch  =  24;

+     font height        =  19;

+     font string        =  ""27"P"18""27"W"1""27"E"27"S"1"";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6";

+     indentation pitch  =  20;

+     font height        =  36;

+     next smaller font  =  "6.klein";

+     font string        =  ""18""27"M"27"W"1""27"F"27"T";

+ 

+           ""127"",    0;              

+ 

+   FONT  :  "6.klein";

+     indentation pitch  =  20;

+     font height        =  19;

+     font string        =  ""18""27"M"27"W"1""27"F"27"S"1"";

+ 

+           ""127"",    0;              

diff --git a/system/printer-9nadel/1986/src/FONTTAB.10A b/system/printer-9nadel/1986/src/FONTTAB.10A
new file mode 100644
index 0000000..8a8cd59
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.10A
diff --git a/system/printer-9nadel/1986/src/FONTTAB.12A b/system/printer-9nadel/1986/src/FONTTAB.12A
new file mode 100644
index 0000000..ed08d88
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.12A
diff --git a/system/printer-9nadel/1986/src/FONTTAB.S10 b/system/printer-9nadel/1986/src/FONTTAB.S10
new file mode 100644
index 0000000..90769b0
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.S10
diff --git a/system/printer-9nadel/1986/src/FONTTAB.S12 b/system/printer-9nadel/1986/src/FONTTAB.S12
new file mode 100644
index 0000000..e367bcc
--- /dev/null
+++ b/system/printer-9nadel/1986/src/FONTTAB.S12
diff --git a/system/printer-9nadel/1986/src/beschreibungen9 b/system/printer-9nadel/1986/src/beschreibungen9
new file mode 100644
index 0000000..21aa015
--- /dev/null
+++ b/system/printer-9nadel/1986/src/beschreibungen9
@@ -0,0 +1,96 @@
+ 

+(*************************************************************************)

+(*                                            Stand   : 01.10.88         *)

+(*  Beschreibungen-Datei für 9-Nadel-Drucker  Version : 0.9              *)

+(*                                            Autoren : mov/hjh          *)

+(*************************************************************************)

+ 

+$fx85$ 

+head;hfx85;decl;speed;openh;opendoch;initspeed;opendocfx85;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 

+

+$fx800$ 

+head;hfx800;decl;quality;typeface;openh;opendoch;opendocfx800;openpge;betwoc; 

+clpge;betwce;cmdfx800;crs;moh;mofx800;ymodr;onoff;tyfx800;end 

+

+$mx$ 

+head;hmx;decl;speed;openh;opendoch;initspeed;opendocmx;openpge;betwoc;clpge; 

+betwce;cmd;crs;moh;modrmx;onoff;tymx;end 

+ 

+$lx800$ 

+head;hlx800;decl;speed;quality;typeface;openh;opendoch;initspeed; 

+opendocfx800;openpge;betwoc;clpge;betwce;cmdfx800;crs;moh;mofx85;ymodr;onoff; 

+tyfx800;end 

+

+$ibmgp$ 

+head;hgp;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end 

+ 

+$ibmpp$ 

+head;hpp;decl;speed;quality;openh;opendoch;initspeed;opendocpp;openpge; 

+betwoc;clpge;betwce;cmdpp;crs;moh;mofx85;ymodr;onoffpp;tyfx85;end 

+ 

+$okiml182i$

+head;hml182i;decl;speed;quality;openh;opendoch;initspeed;opendocml182i; 

+opendocgp;openpge;betwoc;clpge;betwce;cmdml182i;crs;moh;mogp;ymodr;onoff; 

+tyohnesmall;end 

+ 

+$okiml192el$ 

+head;hml192el;decl;speed;feed;openh;opendoch;initspeed;opendocml192el; 

+openpgemlsf;betwoc;clmlsf;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; 

+end 

+ 

+$okiml292el$ 

+head;hml292el;decl;quality;typeface292;feed;openh;opendoch;opendocml292el; 

+openpgemlsf;betwoc;clmlsf;betwce;cmdml292el;crs;moh;mofx800;ymodr;onoff; 

+tyml292el;end 

+ 

+$okiml294i$ 

+head;hml294i;decl;speed;quality;feed;openh;opendoch;initspeed;opendocml294i; 

+openpgemlsf;betwoc;clmlsf;betwce;cmdml294i;crs;moh;mofx85;ymodr;ontyml294i;end 

+ 

+$okiml320$ 

+head;hml320;decl;speed;openh;opendoch;initspeed;opendocml320; 

+openpge;betwoc;clpge;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; 

+end 

+ 

+$starlc10$ 

+head;hlc10;decl;quality;typefacelc10;openh;opendoch;opendoclc10;openpge; 

+betwoc;clpge;betwce;cmdlc10;crs;moh;mofx800;ymodr;onoff;tyfx800;end 

+ 

+$dmp4000$ 

+head;hdmp4000;decl;speed;openh;opendoch;initspeed;opendocdmp4000;openpge; 

+betwoc;clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 

+ 

+$starnx15$ 

+head;hnx15;decl;speed;openh;opendoch;initspeed;opendocnx15;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end 

+ 

+$mt230$ 

+head;hmt230;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; 

+openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;mofx85;ymodr;onoff; 

+tyfx85;end 

+ 

+$mt340$ 

+head;hmt340;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; 

+openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;moml192el;ymodr;onoff; 

+tyml192el;end 

+ 

+$citi120d$ 

+head;h120d;decl;openh;opendoch;opendoc120d;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mofx800;ymodr;onoff;tyfx85;end 

+ 

+$citohc310cxp$ 

+head;hc310;decl;speed;feedschacht;openh;opendoch;initspeed;opendocc310; 

+openpgec310sf;betwoc;clc310sf;betwce;cmdc310;crs;moh;mofx85;ymodr;onoff; 

+tyfx85;end 

+ 

+$citohci3500$ 

+head;hci3500;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; 

+clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end 

+ 

+$fujdx2100$ 

+head;hdx2100;decl;speed;feed;openh;opendoch;initspeed;opendocdx2100; 

+openpge;betwoc;clpge;betwce;cmddx2100;crs;moh;moml192el;ymodr;onoff;tyml192el; 

+end 

+

diff --git a/system/printer-9nadel/1986/src/fonttab.1 b/system/printer-9nadel/1986/src/fonttab.1
new file mode 100644
index 0000000..c008441
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.1
diff --git a/system/printer-9nadel/1986/src/fonttab.10 b/system/printer-9nadel/1986/src/fonttab.10
new file mode 100644
index 0000000..cf79bc7
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.10
diff --git a/system/printer-9nadel/1986/src/fonttab.20 b/system/printer-9nadel/1986/src/fonttab.20
new file mode 100644
index 0000000..774029f
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.20
diff --git a/system/printer-9nadel/1986/src/fonttab.20.lc b/system/printer-9nadel/1986/src/fonttab.20.lc
new file mode 100644
index 0000000..030f9fa
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.20.lc
diff --git a/system/printer-9nadel/1986/src/fonttab.20.lx b/system/printer-9nadel/1986/src/fonttab.20.lx
new file mode 100644
index 0000000..423cda1
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.20.lx
diff --git a/system/printer-9nadel/1986/src/fonttab.7 b/system/printer-9nadel/1986/src/fonttab.7
new file mode 100644
index 0000000..c18f223
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7
diff --git a/system/printer-9nadel/1986/src/fonttab.7.cxp b/system/printer-9nadel/1986/src/fonttab.7.cxp
new file mode 100644
index 0000000..a2b833a
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7.cxp
diff --git a/system/printer-9nadel/1986/src/fonttab.7.fuj b/system/printer-9nadel/1986/src/fonttab.7.fuj
new file mode 100644
index 0000000..1244175
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7.fuj
diff --git a/system/printer-9nadel/1986/src/fonttab.7.mt b/system/printer-9nadel/1986/src/fonttab.7.mt
new file mode 100644
index 0000000..a7eea47
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.7.mt
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.fx b/system/printer-9nadel/1986/src/fonttab.epson.fx
new file mode 100644
index 0000000..ad68a4d
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.fx
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.lq b/system/printer-9nadel/1986/src/fonttab.epson.lq
new file mode 100644
index 0000000..3e7dc5d
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.lq
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.mx b/system/printer-9nadel/1986/src/fonttab.epson.mx
new file mode 100644
index 0000000..b813fe9
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.mx
diff --git a/system/printer-9nadel/1986/src/fonttab.epson.rx b/system/printer-9nadel/1986/src/fonttab.epson.rx
new file mode 100644
index 0000000..7042102
--- /dev/null
+++ b/system/printer-9nadel/1986/src/fonttab.epson.rx
diff --git a/system/printer-9nadel/1986/src/module9 b/system/printer-9nadel/1986/src/module9
new file mode 100644
index 0000000..2ab5304
--- /dev/null
+++ b/system/printer-9nadel/1986/src/module9
@@ -0,0 +1,1098 @@
+ 

+(*************************************************************************)

+(*                                            Stand   : 01.10.88         *)

+(*   Module-Datei für 9-Nadel-Drucker         Version : 0.9              *)

+(*                                            Autoren : mov/hjh          *)

+(*************************************************************************)

+

+$head$ 

+PACKET printer driver 

+ 

+       DEFINES printer,

+               open,

+               close,

+               execute,

+               paper size,

+               top margin,

+

+$hfx85$        std speed:

+(* Treiber für EPSON FX85/105, automatisch generiert *)

+

+$hfx800$       std quality,

+               std typeface:

+(* Treiber für EPSON FX800/1000, automatisch generiert *) 

+BOOL VAR was tall font;

+ 

+$hmx$          std speed:

+(* Treiber für EPSON MX80/100, Typ III *) 

+(* Treiber automatisch generiert *)

+BOOL VAR is condensed, is small;

+

+$hlx800$       std speed, 

+               std quality,

+               std typeface:

+(* Treiber für EPSON LX800/1000, automatisch generiert *) 

+BOOL VAR was tall font;

+

+$hgp$          std speed: 

+(* Treiber für IBM-Grafikdrucker *) 

+(* Treiber automatisch generiert *) 

+

+$hpp$          std speed, 

+               std quality:

+(* Treiber für IBM-Proprinter *) 

+(* Treiber automatisch generiert *) 

+ 

+$hml182i$      std speed,

+               std quality:

+(* Treiber für OKI ML182/183 IBM-kompatibel *) 

+(* Treiber automatisch generiert *) 

+ 

+$hml192el$     paper feed,

+               std speed:

+(* Treiber für OKI ML192/193 Elite *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR prop font;

+ 

+$hml292el$     std quality, 

+               std typeface, 

+               paper feed: 

+(* Treiber für OKI ML292/293 Elite *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR was tall font;

+

+$hml294i$      std speed, 

+               paper feed,

+               std quality:

+(* Treiber für OKI ML294 IBM-kompatibel *)

+(* Treiber automatisch generiert *) 

+

+$hml320$       std speed:

+(* Treiber für OKI ML320 IBM/EPSON-kompatibel *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR prop font;

+ 

+$hlc10$        std quality, 

+               std typeface:

+(* Treiber für Star LC-10 oder LC-10 Colour *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR was tall font;

+ 

+$hdmp4000$     std speed:

+(* Treiber für Schneider DMP4000, automatisch generiert *)

+ 

+$hnx15$        std speed:

+(* Treiber für Star NX-15, ND-10, ND-15, NR-10 und NR-15 *)

+(* Treiber automatisch generiert *)

+ 

+$hmt230$       paper feed, 

+               std speed: 

+(* Treiber für Mannesmann-Tally MT 230 *) 

+(* Treiber automatisch generiert *) 

+ 

+$hmt340$       paper feed,

+               std speed:

+(* Treiber für Mannesmann-Tally MT 340 *) 

+(* Treiber automatisch generiert *) 

+BOOL VAR prop font := FALSE; 

+ 

+$h120d$        : 

+(* Treiber für Citizen 120-D *) 

+(* Treiber automatisch generiert *) 

+ 

+$hc310$        paper feed,

+               std speed:

+(* Treiber für C. Itoh C 310/315 CXP *) 

+(* Treiber automatisch generiert *) 

+

+$hci3500$      std speed: 

+(* Treiber für C. Itoh CI-3500 *) 

+(* Treiber automatisch generiert *) 

+ 

+$hdx2100$     paper feed,

+              std speed:

+(* Treiber für Fujitsu DX 2100 *)

+(* Treiber automatisch generiert *)

+BOOL VAR prop font := FALSE ;

+ 

+$decl$

+INT VAR blankbreite, x rest, y rest, high, low, small, modifikations;

+REAL VAR x size, y size, y margin;

+TEXT VAR buffer :: "";

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+END PROC paper size;

+ 

+papersize (20.32, 30.48); 

+ 

+PROC top margin (REAL CONST margin): 

+ 

+  y margin := margin 

+END PROC top margin; 

+ 

+REAL PROC top margin:   y margin   END PROC top margin;

+ 

+top margin (0.0); 

+ 

+$speed$

+BOOL VAR is slow; 

+TEXT VAR std speed name :: "slow";

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed

+     ELSE errorstop ("unzulässige Geschwindigkeit")

+  FI

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+$quality$ 

+TEXT VAR std quality name :: "draft";

+ 

+PROC std quality (TEXT CONST quality) :

+ 

+  IF quality = "nlq" OR quality = "draft"

+     THEN std quality name := quality

+     ELSE errorstop ("unzulässige Qualitätsbezeichnung")

+  FI

+END PROC std quality;

+ 

+TEXT PROC std quality : std quality name END PROC std quality;

+ 

+$typeface$ 

+TEXT VAR std typeface name :: "";

+ 

+PROC std typeface (TEXT CONST typeface) :

+ 

+  IF typeface = "" OR typeface = "roman" OR typeface = "sansserif"

+     THEN std typeface name := typeface

+     ELSE errorstop ("unzulässige Schriftart")

+  FI

+END PROC std typeface;

+ 

+TEXT PROC std typeface : std typeface name END PROC std typeface;

+ 

+$typeface292$ 

+TEXT VAR std typeface name :: "";

+ 

+PROC std typeface (TEXT CONST typeface) :

+ 

+  IF typeface = "" OR typeface = "courier" OR typeface = "sansserif"

+     THEN std typeface name := typeface

+     ELSE errorstop ("unzulässige Schriftart")

+  FI

+END PROC std typeface;

+ 

+TEXT PROC std typeface : std typeface name END PROC std typeface;

+ 

+$typefacelc10$ 

+TEXT VAR std typeface name :: "";

+ 

+PROC std typeface (TEXT CONST typeface) :

+ 

+  IF typeface = "" OR typeface = "courier" OR typeface = "sansserif" 

+                   OR typeface = "orator1" OR typeface = "orator2" 

+     THEN std typeface name := typeface

+     ELSE errorstop ("unzulässige Schriftart")

+  FI

+END PROC std typeface;

+ 

+TEXT PROC std typeface : std typeface name END PROC std typeface;

+ 

+$feed$ 

+TEXT VAR feeder name :: "tractor";

+ 

+PROC paper feed (TEXT CONST feeder) :

+ 

+  IF feeder = "sheet" OR feeder = "tractor"

+     THEN feeder name := feeder

+     ELSE errorstop ("unzulässige Einzugsart")

+  FI

+END PROC paper feed;

+ 

+TEXT PROC paper feed: feeder name END PROC paper feed;

+ 

+$feedschacht$

+TEXT VAR act feeder :: "", 

+         feeder name :: "tractor";

+ 

+PROC paper feed (TEXT CONST feeder) :

+ 

+  IF feeder = "tractor" OR feeder = "schacht1" OR feeder = "schacht2" 

+     THEN feeder name := feeder

+  ELIF feeder = "sheet" 

+     THEN feeder name := "schacht1" 

+     ELSE errorstop ("unzulässige Einzugsart")

+  FI

+END PROC paper feed;

+ 

+TEXT PROC paper feed: feeder name END PROC paper feed;

+ 

+$openh$

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE 1: open document 

+  CASE 2: open page

+END SELECT.

+ 

+$opendoch$

+  open document :

+    modifikations := 0; 

+    param 1 := x step conversion ( x size );

+    param 2 := y step conversion ( y size );

+$initspeed$ 

+    IF pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+$opendocfx85$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2"27"6");

+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)

+ 

+$opendocfx800$ 

+    param 2 := (param 2 DIV 36) * 36;

+    was tall font := TRUE; 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)

+    out (""27"R"0""27"9"27"O"27"2"); 

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"x"1"") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"x"0"") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"x"1"") 

+      ELSE out (""27"x"0"")

+    FI; 

+    IF pos (material, "roman") <> 0 

+         THEN out (""27"k"0"") 

+    ELIF pos (material, "sansserif") <> 0 

+         THEN out (""27"k"1"") 

+    ELIF std typeface name = "roman" 

+      THEN out (""27"k"0"") 

+    ELIF std typeface name = "sansserif" 

+      THEN out (""27"k"1"") 

+    FI. 

+ 

+$opendocmx$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"R"0""27""64"");               (* Reset des Druckers *) 

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36));  (* Formularlaenge *) 

+    out (""27"9"27"O").

+ 

+$opendocgp$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"6");                               (* Zeichensatz 2 *)

+    out (""18""27"F"27"H"27"W"0""27"T"27"-"0""); (* Modifikationen rücksetzen *) 

+    out (""27"9"27"O"27"A"12""27"2"); 

+    out (""27"C" + code (param 2 DIV 36)).       (* Formularlaenge *)

+ 

+$opendocpp$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"6");                               (* Zeichensatz 2 *)

+    out (""18""27"F"27"W"0""27"T"27"-"0"");      (* Modifikationen rücksetzen *) 

+    out (""27"9"27"O"27"A"12""27"2"); 

+    out (""27"C" + code (param 2 DIV 36));       (* Formularlaenge *)

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"G")

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"H") 

+    ELIF std quality name = "nlq" 

+      THEN out (""27"G") 

+      ELSE out (""27"H") 

+    FI. 

+    

+$opendocml182i$ 

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"I3") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"I1") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"I3") 

+      ELSE out (""27"I1")

+    FI; 

+    out (""27"N"0"");           (* Kein Sprung über Perf. *)

+

+$opendocml192el$ 

+    param 2 := (param 2 DIV 36) * 36;

+    prop font := FALSE;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) 

+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)

+    out (""27"9"27"O"27"x"0"").

+ 

+$opendocml292el$ 

+    param 2 := (param 2 DIV 36) * 36;

+    was tall font := TRUE; 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"9"27"O"27"r0"); 

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"x"1"") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"x"0"") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"x"1"") 

+      ELSE out (""27"x"0"")

+    FI; 

+    IF pos (material, "courier") <> 0 

+         THEN out (""27"k"0"") 

+    ELIF pos (material, "sansserif") <> 0 

+         THEN out (""27"k"1"") 

+    ELIF std typeface name = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF std typeface name = "sansserif" 

+      THEN out (""27"k"1"") 

+    FI. 

+ 

+$opendocml294i$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27"6");                               (* Zeichensatz 2 *)

+    out (""18""27"F"27"W0"27"T"27"-0"27"%H");    (* Modifikationen rücksetzen *) 

+    out (""27"9"27"O"27"A"12""27"2");

+    out (""27"C" + code (param 2 DIV 36));       (* Formularlaenge *)

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"G")

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"H") 

+    ELIF std quality name = "nlq" 

+      THEN out (""27"G") 

+      ELSE out (""27"H") 

+    FI. 

+ 

+$opendocml320$ 

+    param 2 := (param 2 DIV 36) * 36;

+    prop font := FALSE;

+    out (""27"{"99""27"{"40"");            (* Umschaltung auf EPSON-Emulation *) 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) 

+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)

+    out (""27"9"27"O"27"x"0"").

+ 

+$opendoclc10$ 

+    param 2 := (param 2 DIV 36) * 36;

+    was tall font := TRUE; 

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"t"1""27"6");                 (* Zeichentabelle 4 (Grafik) *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"9"27"r"0"");

+    IF pos (material, "nlq") <> 0 

+      THEN out (""27"x"1"") 

+    ELIF pos (material, "draft") <> 0 

+      THEN out (""27"x"0"") 

+    ELIF std quality name = "nlq"

+      THEN out (""27"x"1"") 

+      ELSE out (""27"x"0"")

+    FI; 

+    IF pos (material, "courier") <> 0 

+         THEN out (""27"k"0"") 

+    ELIF pos (material, "sansserif") <> 0 

+         THEN out (""27"k"1"") 

+    ELIF pos (material, "orator1") <> 0 

+         THEN out (""27"k"2"") 

+    ELIF pos (material, "orator2") <> 0 

+         THEN out (""27"k"3"") 

+    ELIF std typeface name = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF std typeface name = "sansserif" 

+      THEN out (""27"k"1"") 

+    ELIF std typeface name = "orator1" 

+      THEN out (""27"k"2"") 

+    ELIF std typeface name = "orator2" 

+      THEN out (""27"k"3"") 

+    FI. 

+ 

+$opendocnx15$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2"); 

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"6");                         (* Erweiterung des Zeichensatzes  *)

+    out (""27"9"27"x"0"").

+ 

+$opendocdmp4000$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *) 

+    out (""27"m"0""27"R"0""27"9"27"O"27"2"27"6");

+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)

+ 

+$opendocmt$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"O"27"x"0""27"r"0""27"6"); 

+    IF feeder name = "tractor" 

+      THEN act feeder := feeder name; 

+           out (""27"[5{") 

+      ELSE out (""27"[0{");

+           IF pos (material, "schacht1") <> 0 

+             THEN act feeder := "schacht1" 

+           ELIF pos (material, "schacht2") <> 0 

+             THEN act feeder := "schacht2" 

+             ELSE act feeder := feeder name 

+           FI 

+    FI.

+ 

+$opendocdx2100$

+param 2 := (param 2 DIV 36) * 36;

+out (""24""27""64"");                            (* Reset des Druckers *) 

+out (""27"R"0"");                                (* US-Zeichensatz *)

+out (""27"2" + ""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+out (""27"N"0"");                                (* skip perforation *)

+out (""27"x"0"" + ""27"r"0"").                   (* draft und black *)

+ 

+ 

+$opendoc120d$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"9"27"O"27"x0"27"2");

+    out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *)

+

+$opendocc310$ 

+    param 2 := (param 2 DIV 36) * 36;

+    out (""27""64""27""64"");              (* Reset des Druckers *)

+    out (""27"R"0""27"2");

+    out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *)

+    out (""27"O"27"x"0""27"r"0""27"6"); 

+    IF feeder name = "tractor" 

+      THEN act feeder := feeder name; 

+      ELSE IF pos (material, "schacht1") <> 0 

+             THEN act feeder := "schacht1" 

+           ELIF pos (material, "schacht2") <> 0 

+             THEN act feeder := "schacht2" 

+             ELSE act feeder := feeder name 

+           FI 

+    FI.

+ 

+$openpge$

+  open page :

+    param 1 := 0;

+    param 2 := y step conversion (y margin);

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"").

+$openpgemlsf$ 

+  open page :

+    param 1 := 0;

+    param 2 := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    IF feeder name = "sheet" THEN out (""12"") FI; 

+    out (""13"").

+$openpgemtsf$ 

+  open page :

+    param 1 := 0;

+    param 2 := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    IF feeder name = "schacht1" 

+      THEN out (""27"[21{"12"") 

+    ELIF feeder name = "schacht2" 

+      THEN out (""27"[22{"12"") 

+    FI; 

+    out (""13"").

+  

+$openpgec310sf$ 

+  open page :

+    param 1 := 0;

+    param 2 := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    IF feeder name = "schacht1" 

+      THEN out (""27""25"1"12"") 

+    ELIF feeder name = "schacht2" 

+      THEN out (""27""25"2"12"") 

+    FI; 

+    out (""13"").

+  

+$betwoc$

+END PROC open; 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE 1: close document 

+  CASE 2: close page

+END SELECT.

+close document : 

+$clpge$

+. close page :

+    IF param 1 > 0 THEN out (""12"") FI.

+$clmlsf$ 

+.close page :

+  IF feeder name = "sheet" 

+    THEN out (""27""25""3"") 

+  ELIF param 1 > 0 

+    THEN out (""12"") 

+  FI. 

+$clmtsf$ 

+.close page :

+  IF feeder name <> "tractor" 

+    THEN out (""27"[2J") 

+  ELIF param 1 > 0 

+    THEN out (""12"") 

+  FI.

+$clc310sf$ 

+.close page :

+  IF feeder name = "sheet" 

+    THEN out (""27""25"R") 

+  ELIF param 1 > 0 

+    THEN out (""12"") 

+  FI. 

+ 

+$betwce$

+END PROC close;

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE 1:  write text

+  CASE 2:  write cmd

+  CASE 3:  carriage return

+  CASE 4:  move

+  CASE 5:  draw

+  CASE 6:  on

+  CASE 7:  off

+  CASE 8:  type

+END SELECT.

+

+is underline: bit (modifikations, 0).

+is bold     : bit (modifikations, 1). 

+is italics  : bit (modifikations, 2). 

+ 

+  write text :

+    out subtext (string, param 1, param 2).

+$cmd$ 

+  write cmd :

+    out subtext (string, param 1, param 2). 

+$cmdfx800$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"x"0"") 

+    ELIF buffer = "nlq"

+      THEN out (""27"x"1"") 

+    ELIF buffer = "roman" 

+      THEN out (""27"k"0"") 

+    ELIF buffer = "sansserif" 

+      THEN out (""27"k"1"") 

+      ELSE out (buffer) 

+    FI. 

+$cmdpp$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"H")

+    ELIF buffer = "nlq"

+      THEN out (""27"G") 

+      ELSE out (buffer) 

+    FI. 

+$cmdml182i$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"I1") 

+    ELIF buffer = "nlq"

+      THEN out (""27"I3") 

+      ELSE out (buffer) 

+    FI. 

+$cmdml292el$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"x"0"") 

+    ELIF buffer = "nlq"

+      THEN out (""27"x"1"") 

+    ELIF buffer = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF buffer = "sansserif" 

+      THEN out (""27"k"1"") 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r0")

+    ELIF buffer = "rot" 

+      THEN out (""27"r1")

+    ELIF buffer = "blau" 

+      THEN out (""27"r2")

+    ELIF buffer = "violett" 

+      THEN out (""27"r3")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r4")

+    ELIF buffer = "orange" 

+      THEN out (""27"r5")

+    ELIF buffer = "grün" 

+      THEN out (""27"r6")

+      ELSE out (buffer) 

+    FI. 

+$cmdml294i$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"H") 

+    ELIF buffer = "nlq"

+      THEN out (""27"G") 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r0")

+    ELIF buffer = "rot" 

+      THEN out (""27"r1")

+    ELIF buffer = "blau" 

+      THEN out (""27"r2")

+    ELIF buffer = "violett" 

+      THEN out (""27"r3")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r4")

+    ELIF buffer = "orange" 

+      THEN out (""27"r5")

+    ELIF buffer = "grün" 

+      THEN out (""27"r6")

+      ELSE out (buffer) 

+    FI. 

+$cmdlc10$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF buffer = "draft" 

+      THEN out (""27"x"0"") 

+    ELIF buffer = "nlq"

+      THEN out (""27"x"1"") 

+    ELIF buffer = "courier" 

+      THEN out (""27"k"0"") 

+    ELIF buffer = "sansserif" 

+      THEN out (""27"k"1"") 

+    ELIF buffer = "orator1" 

+      THEN out (""27"k"2"") 

+    ELIF buffer = "orator2" 

+      THEN out (""27"k"3"") 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r"0"")

+    ELIF buffer = "rot" 

+      THEN out (""27"r"1"")

+    ELIF buffer = "blau" 

+      THEN out (""27"r"2"")

+    ELIF buffer = "violett" 

+      THEN out (""27"r"3"")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r"4"")

+    ELIF buffer = "orange" 

+      THEN out (""27"r"5"")

+    ELIF buffer = "grün" 

+      THEN out (""27"r"6"")

+      ELSE out (buffer) 

+    FI. 

+$cmdmt230$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF feeder name <> "tractor" 

+      THEN IF buffer = "schacht1" OR buffer = "schacht2" 

+             THEN act feeder := buffer 

+           FI 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r"0"")

+    ELIF buffer = "magenta" 

+      THEN out (""27"r"1"")

+    ELIF buffer = "cyan" 

+      THEN out (""27"r"2"")

+    ELIF buffer = "blau" 

+      THEN out (""27"r"3"")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r"4"")

+    ELIF buffer = "rot" 

+      THEN out (""27"r"5"")

+    ELIF buffer = "grün" 

+      THEN out (""27"r"6"")

+      ELSE out (buffer) 

+    FI. 

+ 

+$cmdc310$ 

+  write cmd :

+    buffer := subtext (string, param 1, param 2); 

+    IF feeder name <> "tractor" 

+      THEN IF buffer = "schacht1" OR buffer = "schacht2" 

+             THEN act feeder := buffer 

+           FI 

+    ELIF buffer = "schwarz" 

+      THEN out (""27"r"0"")

+    ELIF buffer = "rot" 

+      THEN out (""27"r"1"")

+    ELIF buffer = "blau" 

+      THEN out (""27"r"2"")

+    ELIF buffer = "violett" 

+      THEN out (""27"r"3"")

+    ELIF buffer = "gelb" 

+      THEN out (""27"r"4"")

+    ELIF buffer = "orange" 

+      THEN out (""27"r"5"")

+    ELIF buffer = "grün" 

+      THEN out (""27"r"6"")

+      ELSE out (buffer) 

+    FI. 

+ 

+$cmddx2100$ 

+   write cmd :

+     buffer := subtext (string, param 1, param 2); 

+     IF buffer = "schwarz"

+       THEN out (""27"r"0"")

+     ELIF buffer = "rot"

+       THEN out (""27"r"1"")

+     ELIF buffer = "blau"

+       THEN out (""27"r"2"")

+     ELIF buffer = "violett"

+       THEN out (""27"r"3"")

+     ELIF buffer = "gelb"

+       THEN out (""27"r"4"")

+     ELIF buffer = "orange"

+       THEN out (""27"r"5"")

+     ELIF buffer = "grün"

+       THEN out (""27"r"6"")

+     ELSE out (buffer)

+     FI.

+ 

+$crs$

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"").

+$moh$ 

+x steps : param1.

+y steps : param2.

+

+move :

+  IF x steps < 0 OR y steps < 0 THEN stop FI; 

+  IF x steps > 0 THEN x move FI; 

+  IF y steps > 0 THEN y move FI. 

+

+$mofx85$ 

+x move :

+  high   := (x steps + x rest) DIV blankbreite;

+  x rest := (x steps + x rest) MOD blankbreite;

+  IF high   > 0 THEN high TIMESOUT " " FI;

+  IF x rest > 0 AND is slow

+     THEN IF is underline THEN out (" "8"") FI;

+          out (""27"Y"+ code (x rest) + ""0"");

+          x rest TIMESOUT ""0"";

+          x rest := 0

+  FI. 

+ 

+ 

+$mofx800$

+x move :

+  IF is underline

+    THEN underline x move

+    ELSE simple x move

+  FI. 

+ 

+underline x move: 

+  high   := (x steps + x rest) DIV blankbreite;

+  low    := (x steps + x rest) MOD blankbreite;

+  IF high > 0 THEN high TIMESOUT " " FI;

+  IF low > 0

+     THEN out (" "8""27"\"+ code (low) + ""0"")

+  FI. 

+ 

+simple x move:

+  out (""27"\");

+  out (code (x steps MOD 256));

+  out (code (x steps DIV 256)). 

+ 

+$modrmx$ 

+x move :

+  high := (x steps + x rest) DIV blankbreite;

+  low  := (x steps + x rest) MOD blankbreite;

+  IF high > 0 THEN high TIMESOUT " " FI;

+  IF low  > 0 AND is slow

+     THEN IF is underline THEN out ("_"8"") FI;

+          IF is condensed 

+             THEN high := low;

+                  low  := 0;

+                  out (""27"L"+ code (high) + ""0"");

+             ELSE high := low DIV 2;

+                  low  := low MOD 2;

+                  out (""27"K"+ code (high) + ""0"");

+          FI;

+          high TIMESOUT ""0"";

+          IF is small

+             THEN out (""27"S"1"");

+                  small DECR 1;

+          FI;

+  FI;

+  x rest := low. 

+ 

+y move : 

+  y rest INCR y steps;

+  IF y rest > 0

+     THEN high := y rest DIV 255;

+          low  := y rest MOD 255;

+          IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+          IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+          y rest := 0

+  FI. 

+ 

+draw :

+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 

+    THEN stop

+  ELIF x steps > 0

+    THEN x draw

+  FI. 

+ 

+x draw :

+  out (""27"L");

+  out (code (x steps MOD 256));

+  out (code (x steps DIV 256));

+  x steps TIMESOUT ""1"";

+  IF is small THEN out (""27"S"1"") FI. 

+ 

+$mogp$ 

+x move :

+  high   := (x steps + x rest) DIV blankbreite;

+  x rest := (x steps + x rest) MOD blankbreite;

+  IF high   > 0 THEN high TIMESOUT " " FI;

+  IF x rest > 0 AND is slow

+     THEN IF is underline 

+            THEN out (" "13""27"Y"); 

+                 out (code (x pos MOD 256)); 

+                 out (code (x pos DIV 256)); 

+                 x pos TIMESOUT ""0"" 

+            ELSE out (""27"Y"+ code (x rest) + ""0"");

+                 x rest TIMESOUT ""0"" 

+          FI;

+          x rest := 0 

+  FI. 

+ 

+$moml192el$ 

+x move :

+  high   := (x steps + x rest) DIV blankbreite;

+  x rest := (x steps + x rest) MOD blankbreite;

+  IF high   > 0 THEN high TIMESOUT " " FI;

+  IF x rest > 0 AND is slow

+    THEN  IF is underline THEN 

+             IF prop font THEN 

+               out (""27"p"0"" + " "8"" + ""27"p"1"") 

+             ELSE 

+               out (" "8"") 

+             FI; 

+          FI;

+          out (""27"Y"+ code (x rest) + ""0"");

+          x rest TIMESOUT ""0"";

+          x rest := 0

+  FI.

+ 

+$ymodr$ 

+y move : 

+  y rest INCR y steps;

+  IF y rest > 0

+    THEN high := y rest DIV 255;

+         low  := y rest MOD 255;

+         IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+         IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+         y rest := 0 

+  FI.

+ 

+draw :

+  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 

+    THEN stop

+  ELIF x steps > 0

+    THEN x draw

+  FI. 

+ 

+x draw :

+  out (""27"Y");

+  out (code (x steps MOD 256));

+  out (code (x steps DIV 256));

+  x steps TIMESOUT ""1"".

+ 

+$onoff$              

+  on :

+    IF on string (param 1) <> ""

+       THEN out (on string (param 1));

+            modifikations := modifikations OR param 1

+       ELSE stop

+    FI. 

+ 

+  off :

+    IF off string (param 1) <> ""

+       THEN out (off string (param 1));

+            modifikations := modifikations AND (param 1 XOR -1) 

+       ELSE stop

+    FI.

+ 

+$onoffpp$              

+  on :

+    IF on string (param 1) <> "" AND param 1 <> 2

+       THEN out (on string (param 1));

+            modifikations := modifikations OR param 1

+       ELSE stop

+    FI. 

+ 

+  off :

+    IF off string (param 1) <> "" AND param 1 <> 2 

+       THEN out (off string (param 1));

+            modifikations := modifikations AND (param 1 XOR -1) 

+       ELSE stop

+    FI.

+ 

+$tyfx85$ 

+  type :

+    buffer := font string (param 1);

+    out (buffer);

+    restore modifikations; 

+    blankbreite  := char pitch (param 1, " ");

+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.  

+

+$tyfx800$ 

+ type :

+    buffer := font string (param 1);

+    IF was tall font 

+      THEN out (""27"w"0"") 

+    FI; 

+    out (buffer);

+    restore modifikations;

+    blankbreite  := char pitch (param 1, " "); 

+    was tall font := pos (buffer, ""27"w"1"") <> 0.

+

+$tymx$ 

+  type :

+    buffer := font string (param 1);

+    blankbreite  := char pitch (param 1, " ");

+    is condensed := pos (buffer, ""15"") <> 0;

+    IF pos (buffer, ""27"S") <> 0 

+       THEN small DECR 1;

+            is small := TRUE;

+       ELSE is small := FALSE;

+    FI;

+    out (buffer);

+    restore modifikations.

+

+$tyohnesmall$

+ type :

+    buffer := font string (param 1);

+    out (buffer);

+    restore modifikations;

+    blankbreite  := char pitch (param 1, " ").

+

+$tyml192el$ 

+  type :

+    buffer := font string (param 1);

+    out (buffer);

+    restore modifikations; 

+    blankbreite  := char pitch (param 1, " ");

+    prop font    := pos (buffer, ""27"p"1"") <> 0;

+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.

+

+$tyml292el$ 

+  type :

+    buffer := font string (param 1);

+    IF was tall font 

+      THEN out (""27""31"0"27"U0") 

+    FI; 

+    was tall font := pos (buffer, ""27"w"1"") <> 0;

+    change all (buffer, ""27"w"0"", ""27""31"0"27"U0"); 

+    change all (buffer, ""27"w"1"", ""27""31"1"27"U1"); 

+    out (buffer);

+    restore modifikations; 

+    blankbreite  := char pitch (param 1, " ").

+ 

+$ontyml294i$ 

+  on :

+    IF on string (param 1) <> "" AND param 1 <> 2 

+       THEN out (on string (param 1));

+            modifikations := modifikations OR param 1 

+    ELIF param 1 = 4

+       THEN out (""27"%G"); 

+            modifikations := modifikations OR param 1 

+       ELSE stop

+    FI. 

+ 

+  off :

+    IF off string (param 1) <> "" AND param 1 <> 2

+       THEN out (off string (param 1));

+            modifikations := modifikations AND (param 1 XOR -1) 

+    ELIF param 1 = 4 

+       THEN out (""27"%H"); 

+            modifikations := modifikations AND (param 1 XOR -1) 

+       ELSE stop

+    FI.

+ 

+  type :

+    buffer := font string (param 1);

+    out (buffer);

+    IF is underline THEN out (on string (1)) FI; 

+    IF is bold      THEN out (on string (2)) FI; 

+    IF is italics   THEN out (""27"%G") FI;

+    blankbreite  := char pitch (param 1, " ");

+    IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI.

+

+$end$

+  restore modifikations: 

+    IF is underline THEN out (on string (1)) FI; 

+    IF is bold      THEN out (on string (2)) FI; 

+    IF is italics   THEN out (on string (4)) FI. 

+ 

+END PROC execute;

+

+INT VAR reply; DATASPACE VAR ds; FILE VAR file;

+ 

+PROC printer:

+ 

+  disable stop;

+  continue (server channel);

+  check error (error message);

+  ds := nilspace;

+  REP forget (ds);

+      execute print;

+      IF is error AND online THEN put error; clear error; FI;

+  PER;

+END PROC printer;

+ 

+PROC execute print:

+ 

+  LET ack = 0, fetch code = 11, file type = 1003;

+  enable stop;

+  ds := nilspace;

+  call (father, fetch code, ds, reply);

+  IF reply = ack CAND type (ds) = file type

+     THEN file := sequential file (input, ds);

+          print (file,

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+  FI;

+END PROC execute print;

+ 

+PROC check error(TEXT CONST message):

+ 

+  IF is error

+     THEN clear error; rename myself (message);

+          IF is error THEN end(myself) FI;

+          pause (9000); end(myself);

+  FI;

+END PROC check error;

+ 

+END PACKET printerdriver

+ 

diff --git a/system/printer-9nadel/1986/src/printer.epson.fx b/system/printer-9nadel/1986/src/printer.epson.fx
new file mode 100644
index 0000000..ecb8a27
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.fx
@@ -0,0 +1,505 @@
+PACKET epson fx printer

+ 

+(*************************************************************************)

+(*                                               Stand   : 29.07.86      *)

+(*   EPSON    FX-80 / FX-100 / FX-100+           Version : 4             *)

+(*                                               Autor   : Rudolf Ruland *)

+(*************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std speed :

+ 

+LET underline           =  1,

+(*  bold                =  2, *)

+    italics             =  4,

+(*  reverse             =  8, *)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR blankbreite, x rest, y rest, high, low, small;

+BOOL VAR is slow, is underline, is italics,

+         double font, prop font, italics font; 

+REAL VAR x size, y size;

+TEXT VAR std speed name;

+ 

+(*********************************************************************)

+ 

+(* paper size ( 8.0 * 2.54, 12.0 * 2.54); *) (* FX-80  *)

+   paper size (13.6 * 2.54, 12.0 * 2.54);    (* FX-100 *)

+   std speed  ("fast");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed;

+     ELSE errorstop ("unzulaessige Geschwindigkeit")

+  FI;

+ 

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+    is underline := FALSE;

+    is italics   := FALSE;

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 36) * 36;

+    out (""27""64"");                      (* Reset des Druckers             *)

+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 36)); (* Formularlaenge                 *)

+    out (""27"I1"27"6");                   (* Erweiterung des Zeichensatzes  *)

+    out (""27":"0""0""0""27"%"1""0"");     (* Ladbarer Zeichensatz           *)

+    (* Definieren von Zeichen der Breiten 5, 6, 7, 8 und 9 Mikroschritte     *)

+    out (""27"&"0""000""000""4""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""001""001""5""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""002""002""6""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""003""003""7""0""0""0""0""0""0""0""0""0""0""0"");

+    out (""27"&"0""004""004""8""0""0""0""0""0""0""0""0""0""0""0"");

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        IF prop font

+           THEN prop x move

+           ELSE fest x move

+        FI;

+ 

+        . prop x move :

+            high := (x steps + x rest) DIV 5 - 1;

+            low  := (x steps + x rest) MOD 5 + 5;

+            IF high < 0

+               THEN x rest := low - 5;

+               ELSE IF double font                THEN out (""27"W"0"")     FI; 

+                    IF italics font OR is italics THEN out (""27"5")        FI;

+                    IF high > 0                   THEN high TIMESOUT ""0""  FI;

+                    IF low  > 0                   THEN out (code (low - 5)) FI;

+                    IF double font                THEN out (""27"W"1"")     FI;

+                    IF italics font OR is italics THEN out (""27"4")        FI;

+                    x rest := 0;

+           FI;

+ 

+        . fest x move :

+            high   := (x steps + x rest) DIV blankbreite;

+            x rest := (x steps + x rest) MOD blankbreite;

+            IF high   > 0 THEN high TIMESOUT " " FI;

+            IF x rest > 0 AND is slow

+               THEN IF is underline THEN out (" "8"") FI;

+                    out (""27"Y"+ code (x rest) + ""0"");

+                    x rest TIMESOUT ""0"";

+                    x rest := 0;

+            FI;

+ 

+    . y move :

+        y rest INCR y steps;

+        IF y rest > 0

+           THEN high := y rest DIV 255;

+                low  := y rest MOD 255;

+                IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+                IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+                y rest := 0;

+        FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := x steps DIV 256;

+        low  := x steps MOD 256;

+        out (""27"Y");

+        out (code (low));

+        out (code (high));

+        x steps TIMESOUT ""1"";

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification));

+            IF modification = underline THEN is underline := TRUE FI;

+            IF modification = italics   THEN is italics   := TRUE FI;

+       ELSE stop

+    FI;

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification));

+            IF modification = underline THEN is underline := FALSE FI;

+            IF modification = italics   THEN is italics   := FALSE FI;

+       ELSE stop

+    FI;

+ 

+ 

+. font nr : param1

+.

+  type :

+    TEXT CONST buffer := font string (font nr);

+    out (buffer);

+    IF is italics THEN out (""27"4") FI;

+    blankbreite  := char pitch (font nr, " ");

+    prop font    := pos (buffer, ""27"p") <> 0;

+    italics font := pos (buffer, ""27"4") <> 0;

+    double font  := blankbreite > 12;

+    IF pos (string, ""27"S") <> 0 THEN small DECR 1 FI;

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson fx printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 18.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.fx",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.fx";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for printer type;

+ask for positioning;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for printer type :

+    line;

+    SELECT printer type OF

+      CASE 0 : papersize ( 8.0 * 2.54, 12.0 * 2.54);

+      CASE 1 : papersize (13.6 * 2.54, 12.0 * 2.54);

+      CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54);

+               fonttab name CAT "+";

+    END SELECT;

+ 

+    . printer type :

+        REP out (up); 

+            IF yes ("Druckertyp : FX-80")

+               THEN LEAVE printer type WITH 0 FI;

+            out (up);

+            IF yes ("Druckertyp : FX-100")

+               THEN LEAVE printer type WITH 1 FI;

+            out (up);

+            IF yes ("Druckertyp : FX-100+")

+               THEN LEAVE printer type WITH 2 FI;

+        PER;

+        0

+. 

+  ask for positioning :

+    line;

+    std speed (positioning);

+ 

+    . positioning :

+        REP out (up); 

+            IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)")

+               THEN LEAVE positioning WITH "slow" FI;

+            out (up);

+            IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)")

+               THEN LEAVE positioning WITH "fast" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;";

diff --git a/system/printer-9nadel/1986/src/printer.epson.lq b/system/printer-9nadel/1986/src/printer.epson.lq
new file mode 100644
index 0000000..3be408c
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.lq
@@ -0,0 +1,501 @@
+PACKET epson lq printer

+ 

+(**************************************************************************)

+(*                                                Stand   : 29.07.86      *)

+(*   EPSON   LQ-1500                              Version : 4             *)

+(*                                                Autor   : Rudolf Ruland *)

+(**************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std quality:

+ 

+LET

+(*  underline           =  1,

+    bold                =  2,

+    italics             =  4,

+    reverse             =  8, *)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR rest, high, low, factor;

+BOOL VAR is nlq, factor was 6, condensed;

+REAL VAR x size, y size;

+TEXT VAR std quality name, buffer;

+ 

+(*********************************************************************)

+ 

+paper size  (13.6 * 2.54, 12.0 * 2.54);

+std quality ("draft");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std quality (TEXT CONST quality) :

+ 

+  IF quality = "nlq" OR quality = "draft"

+     THEN std quality name := quality;

+     ELSE errorstop ("unzulaessige Betriebsart")

+  FI;

+ 

+END PROC std quality;

+ 

+TEXT PROC std quality : std quality name END PROC std quality;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "nlq") <> 0 

+         THEN is nlq := TRUE;

+    ELIF pos (material, "draft") <> 0 

+         THEN is nlq := FALSE;

+         ELSE is nlq := std quality = "nlq"

+    FI;

+    factor       := 0;

+    factor was 6 := FALSE;

+    condensed    := FALSE; 

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 30) * 30;

+    out (""27""64"");                      (* Reset des Druckers             *)

+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                 *)

+    out (""27"x"0"");                      (* Entwurfsqualität               *) 

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    rest    := 0;

+    out (""13"");

+ 

+END PROC open;

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    buffer := subtext (string, from, to);

+    IF   buffer = "nlq"

+         THEN is nlq := TRUE;

+              near letter quality;

+    ELIF buffer = "draft"

+         THEN is nlq := FALSE;

+              draft quality;

+         ELSE out (buffer);

+    FI;

+ 

+    . near letter quality :

+        IF factor = 6

+           THEN factor was 6 := TRUE;

+                factor       := 4; 

+           ELSE factor was 6 := FALSE;

+        FI;

+        IF condensed

+           THEN out (""27"x"0"")

+           ELSE out (""27"x"1"") 

+        FI;

+ 

+    . draft quality :

+        IF factor was 6

+           THEN factor was 6 := FALSE;

+                factor       := 6; 

+        FI;

+        out (""27"x"0"");

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    rest := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + rest) DIV factor;

+        rest := (x steps + rest) MOD factor;

+        out (""27"\");

+        out (code (high MOD 256));

+        out (code (high DIV 256));

+ 

+    . y move :

+        high := y steps DIV 255;

+        low  := y steps MOD 255;

+        IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+        IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := (x steps + rest) DIV 6;

+        rest := (x steps + rest) MOD 6;

+        IF high > 0

+           THEN low  := high MOD 255;

+                high := high DIV 255;

+                out (""27"V");

+                out (code (low));

+                out (""27"*"1""1""0""1""27"V"0"");

+                FOR low FROM 1 UPTO high

+                    REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; 

+        FI;

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> "" 

+       THEN out (on string (modification))

+       ELSE stop

+    FI

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification))

+       ELSE stop

+    FI

+ 

+ 

+. font nr : param1

+.

+  type :

+    buffer := font string (font nr);

+    out (buffer);

+    factor := pitch factor;

+    IF is nlq THEN near letter quality FI;

+ 

+    . pitch factor :                           (*             Mikroschritt *)

+        INT CONST font bits := code (buffer SUB 3);

+        IF   bit (font bits, 1) 

+             THEN condensed := FALSE;       2  (* proportional  1/360 Inch *)

+        ELIF pos (buffer, ""27"x"1"") <> 0

+             THEN condensed := FALSE;       4  (* near letter   1/180 Inch *)

+        ELIF bit (font bits, 2) 

+             THEN condensed := TRUE;        3  (* condensed     1/240 Inch *)

+        ELIF bit (font bits, 0) 

+             THEN condensed := FALSE;       4  (* elite         1/180 Inch *)

+             ELSE condensed := FALSE;       6  (* pica          1/120 Inch *)

+        FI

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson lq printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 18.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.lq",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.lq";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for paper format;

+ask for print quality;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for paper format :

+    SELECT paper format OF

+      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)

+      CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54)

+      CASE 3 : papersize (21.0, 29.7)

+    END SELECT

+

+    . paper format :

+        line;

+        REP out (up);

+            IF yes ("Papierformat : endlos, 8 Zoll breit")

+               THEN LEAVE paper format WITH 1 FI;

+            out (up);

+            IF yes ("Papierformat : endlos, 13.2 Zoll breit")

+               THEN LEAVE paper format WITH 2 FI;

+            out (up);

+            IF yes ("Papierformat : DINA 4")

+               THEN LEAVE paper format WITH 3 FI;

+        PER;

+        0

+.

+  ask for print quality :

+    line;

+    std quality (quality);

+ 

+    . quality :

+        REP out (up);

+            IF yes ("standardmäßige Druckqualität : draft quality")

+               THEN LEAVE quality WITH "draft" FI;

+            out (up);

+            IF yes ("standardmäßige Druckqualität : near letter quality")

+               THEN LEAVE quality WITH "nlq" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/system/printer-9nadel/1986/src/printer.epson.mx b/system/printer-9nadel/1986/src/printer.epson.mx
new file mode 100644
index 0000000..706f8ab
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.mx
@@ -0,0 +1,488 @@
+PACKET epson mx printer

+ 

+(**************************************************************************)

+(*                                                Stand   : 29.07.86      *)

+(*   EPSON   MX-80 TYPE III                       Version : 4             *)

+(*                                                Autor   : Rudolf Ruland *)

+(**************************************************************************)

+ 

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std speed :

+ 

+LET underline           =  1,

+    bold                =  2,

+(*  italics             =  4,

+    reverse             =  8, *)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR blankbreite, x rest, y rest, high, low, small;

+BOOL VAR is underline, is bold, is condensed, is small, is slow;

+REAL VAR x size, y size;

+TEXT VAR std speed name;

+ 

+(*********************************************************************)

+ 

+paper size (8.0 * 2.54, 12.0 * 2.54);

+std speed  ("slow");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed;

+     ELSE errorstop ("unzulaessige Geschwindigkeit")

+  FI;

+ 

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+    is underline := FALSE;

+    is bold      := FALSE;

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 36) * 36;

+    out (""27"R"0""27""64"");               (* Reset des Druckers             *)

+    out (""27"R"0"");                       (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 36));  (* Formularlaenge                 *)

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + x rest) DIV blankbreite;

+        low  := (x steps + x rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT " " FI;

+        IF low  > 0 AND is slow

+           THEN IF is underline THEN out ("_"8"") FI;

+                IF is condensed 

+                   THEN high := low;

+                        low  := 0;

+                        out (""27"L"+ code (high) + ""0"");

+                   ELSE high := low DIV 2;

+                        low  := low MOD 2;

+                        out (""27"K"+ code (high) + ""0"");

+                FI;

+                high TIMESOUT ""0"";

+                IF is small

+                   THEN out (""27"S"1"");

+                        small DECR 1;

+                FI;

+        FI;

+        x rest := low;

+ 

+    . y move :

+        y rest INCR y steps;

+        IF y rest > 0

+           THEN high := y rest DIV 255;

+                low  := y rest MOD 255;

+                IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+                IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+                y rest := 0;

+        FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := x steps DIV 256;

+        low  := x steps MOD 256;

+        out (""27"L");

+        out (code (low));

+        out (code (high));

+        x steps TIMESOUT ""1"";

+        IF is small THEN out (""27"S"1"") FI;

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification));

+            IF modification = underline THEN is underline := TRUE FI;

+            IF modification = bold      THEN is bold      := TRUE FI;

+       ELSE stop

+    FI;

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification));

+            IF modification = underline THEN is underline := FALSE FI;

+            IF modification = bold      THEN is bold      := FALSE FI;

+       ELSE stop

+    FI;

+ 

+ 

+. font nr : param1

+.

+  type :

+    blankbreite  := char pitch (font nr, " ");

+    is condensed := pos (font string (font nr), ""15"") <> 0;

+    IF pos (font string (font nr), ""27"S") <> 0 

+       THEN small DECR 1;

+            is small := TRUE;

+       ELSE is small := FALSE;

+    FI;

+    out (font string (font nr));

+    IF is bold THEN out (on string (bold)) FI;

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson mx printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 19.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.mx",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.mx";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for paper format;

+ask for positioning;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for paper format :

+    SELECT paper format OF

+      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)

+      CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54)

+      CASE 3 : papersize (21.0, 29.7)

+    END SELECT

+

+    . paper format :

+        line;

+        REP out (up);

+            IF yes ("Papierformat : endlos, 8 Zoll breit")

+               THEN LEAVE paper format WITH 1 FI;

+            out (up);

+            IF yes ("Papierformat : endlos, 13.2 Zoll breit")

+               THEN LEAVE paper format WITH 2 FI;

+            out (up);

+            IF yes ("Papierformat : DINA 4")

+               THEN LEAVE paper format WITH 3 FI;

+        PER;

+        0

+. 

+  ask for positioning :

+    line;

+    std speed (positioning);

+ 

+    . positioning :

+        REP out (up); 

+            IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)")

+               THEN LEAVE positioning WITH "slow" FI;

+            out (up);

+            IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)")

+               THEN LEAVE positioning WITH "fast" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/system/printer-9nadel/1986/src/printer.epson.rx b/system/printer-9nadel/1986/src/printer.epson.rx
new file mode 100644
index 0000000..5554efd
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.epson.rx
@@ -0,0 +1,446 @@
+PACKET epson rx printer

+ 

+(**************************************************************************)

+(*                                                Stand   : 29.07.86      *)

+(*   EPSON   RX-80 F/T +                          Version : 4             *)

+(*                                                Autor   : Rudolf Ruland *)

+(**************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size,

+               std speed :

+ 

+LET underline           =  1,

+(*  bold                =  2,

+    italics             =  4,

+    reverse             =  8,*)

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR blankbreite, x rest, y rest, high, low, small;

+BOOL VAR is underline, is slow;

+REAL VAR x size, y size;

+TEXT VAR std speed name;

+ 

+(*********************************************************************)

+ 

+paper size (8.0 * 2.54, 12.0 * 2.54);

+std speed  ("slow");

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+ 

+PROC std speed (TEXT CONST speed) :

+ 

+  IF speed = "fast" OR speed = "slow"

+     THEN std speed name := speed;

+     ELSE errorstop ("unzulaessige Geschwindigkeit")

+  FI;

+ 

+END PROC std speed;

+ 

+TEXT PROC std speed : std speed name END PROC std speed;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    IF   pos (material, "slow") <> 0 

+         THEN is slow := TRUE;

+    ELIF pos (material, "fast") <> 0 

+         THEN is slow := FALSE;

+         ELSE is slow := std speed name = "slow"

+    FI;

+    is underline := FALSE;

+    x steps := x step conversion ( x size );

+    y steps := y step conversion ( y size );

+    y steps := (y steps DIV 36) * 36;

+    out (""27""64"");                       (* Reset des Druckers             *)

+    out (""27"R"0"");                       (* Amerikanischer Zeichensatz     *)

+    out (""27"C" + code (y steps DIV 36));  (* Formularlaenge                 *)

+    out (""27"m"4"");                       (* graphischer Zeichensatz        *)

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    x rest  := 0;

+    y rest  := 0;

+    small   := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    IF remaining y steps > 0 THEN out (""12"") FI

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    y rest INCR small;

+    x rest := 0;

+    small  := 0;

+    out (""13"");

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+         THEN stop

+    ELIF x steps > 0

+         THEN x move

+    ELIF y steps > 0

+         THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + x rest) DIV blankbreite;

+        low  := (x steps + x rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT " " FI;

+        IF low  > 0 AND is slow

+           THEN IF is underline THEN out (" "8"") FI;

+                out (""27"Y"+ code (low) + ""0"");

+                low TIMESOUT ""0"";

+                x rest := 0;

+           ELSE x rest := low;

+        FI;

+ 

+    . y move :

+        y rest INCR y steps;

+        IF y rest > 0

+           THEN high := y rest DIV 255;

+                low  := y rest MOD 255;

+                IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;

+                IF low  > 0 THEN out (""27"J"); out (code (low)) FI;

+                y rest := 0;

+        FI;

+ 

+. 

+  draw :

+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+         THEN stop

+    ELIF x steps > 0

+         THEN x draw

+    FI;

+ 

+    . x draw :

+        high := x steps DIV 256;

+        low  := x steps MOD 256;

+        out (""27"Y");

+        out (code (low));

+        out (code (high));

+        x steps TIMESOUT ""1"";

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification));

+            IF modification = underline THEN is underline := TRUE FI;

+       ELSE stop

+    FI;

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification));

+            IF modification = underline THEN is underline := FALSE FI;

+       ELSE stop

+    FI;

+ 

+ 

+. font nr : param1

+.

+  type :

+    blankbreite := char pitch (font nr, " ");

+    IF pos (font string (font nr), ""27"S") <> 0 THEN small DECR 1 FI;

+    out (font string (font nr));

+ 

+END PROC execute;

+ 

+ 

+END PACKET epson rx printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 19.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.epson.rx",

+    up           = ""3""13""5"";

+ 

+TEXT VAR fonttab name := "fonttab.epson.rx";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for positioning;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for positioning :

+    line;

+    std speed (positioning);

+ 

+    . positioning :

+        REP out (up); 

+            IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)")

+               THEN LEAVE positioning WITH "slow" FI;

+            out (up);

+            IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)")

+               THEN LEAVE positioning WITH "fast" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/system/printer-9nadel/1986/src/printer.std b/system/printer-9nadel/1986/src/printer.std
new file mode 100644
index 0000000..587e582
--- /dev/null
+++ b/system/printer-9nadel/1986/src/printer.std
@@ -0,0 +1,431 @@
+PACKET std printer 

+ 

+(************************************************************************)

+(*                                              Stand   : 29.07.86      *)

+(*   STANDARD PRINTER                           Version : 4             *)

+(*                                              Autor   : Rudolf Ruland *)

+(************************************************************************)

+ 

+       DEFINES open,

+               close,

+               execute,

+ 

+               paper size :

+ 

+LET underline           =  1,

+    bold                =  2,

+    italics             =  4,

+    reverse             =  8,

+ 

+    underline linetype  =  1,

+ 

+    c document          =  1,

+    c page              =  2,

+ 

+    c write text        =  1,

+    c write cmd         =  2,

+    c carriage return   =  3, 

+    c move              =  4,

+    c draw              =  5,

+    c on                =  6, 

+    c off               =  7,

+    c type              =  8;

+ 

+INT VAR high, rest, blankbreite;

+REAL VAR x size, y size;

+ 

+(*********************************************************************)

+

+paper size (8.0 * 2.54, 12.0 * 2.54);

+ 

+PROC paper size (REAL CONST x, y) :

+ 

+  x size := x;

+  y size := y;

+ 

+END PROC paper size;

+ 

+PROC paper size : 

+ 

+  line;

+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");

+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");

+ 

+END PROC paper size;

+ 

+(*********************************************************************)

+ 

+PROC open (INT CONST op code, INT VAR param1, param2) :

+ 

+SELECT op code OF

+  CASE c document : open document 

+  CASE c page     : open page

+END SELECT; 

+ 

+ 

+. x steps : param1

+. y steps : param2

+. 

+  open document :

+    x steps      := x step conversion ( x size );

+    y steps      := y step conversion ( y size );

+    out (off string (underline));

+    out (off string (bold));

+    out (off string (italics));

+    out (off string (reverse));

+ 

+ 

+. x start : param1

+. y start : param2

+. 

+  open page :

+    x start := 0;

+    y start := 0;

+    rest    := 0;

+    out (""13"");

+ 

+END PROC open; 

+ 

+ 

+PROC close (INT CONST op code, INT CONST param1) :

+ 

+SELECT op code OF

+  CASE c document : close document 

+  CASE c page     : close page

+END SELECT; 

+ 

+. 

+  close document :

+ 

+ 

+. remaining y steps : param1

+.

+  close page :

+    remaining y steps TIMESOUT ""10""

+ 

+END PROC close;

+ 

+ 

+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :

+ 

+SELECT op code OF

+  CASE c write text       :  write text

+  CASE c write cmd        :  write cmd

+  CASE c carriage return  :  carriage return

+  CASE c move             :  move

+  CASE c draw             :  draw

+  CASE c on               :  on

+  CASE c off              :  off

+  CASE c type             :  type

+END SELECT

+

+ 

+. from : param1

+. to   : param2

+.

+  write text :

+    out subtext (string, from, to)

+ 

+.

+  write cmd :

+    out subtext (string, from, to)

+ 

+ 

+(*. x steps to left margin : param1*)

+.

+  carriage return :

+    rest := 0;

+    out (""13"")

+ 

+ 

+. x steps : param1

+. y steps : param2

+.

+  move :

+    IF   x steps < 0 OR y steps < 0

+        THEN stop

+    ELIF x steps > 0

+        THEN x move

+    ELIF y steps > 0

+        THEN y move

+    FI;

+ 

+    . x move :

+        high := (x steps + rest) DIV blankbreite;

+        rest := (x steps + rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT " " FI;

+ 

+    . y move :

+        y steps TIMESOUT ""10""

+ 

+. 

+  draw :

+    IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype

+       THEN stop

+       ELSE x draw

+    FI

+ 

+    . x draw :

+        high := (x steps + rest) DIV blankbreite;

+        rest := (x steps + rest) MOD blankbreite;

+        IF high > 0 THEN high TIMESOUT "_" FI;

+ 

+ 

+. modification : param1

+.

+  on :

+    IF on string (modification) <> ""

+       THEN out (on string (modification))

+       ELSE stop

+    FI

+ 

+.

+  off :

+    IF off string (modification) <> ""

+       THEN out (off string (modification))

+       ELSE stop

+    FI

+ 

+ 

+. font nr : param1

+.

+  type :

+    blankbreite := char pitch (font nr, " ");

+    out (font string (font nr));

+ 

+END PROC execute;

+ 

+ 

+END PACKET std printer;

+ 

+ 

+PACKET print cmd for single user                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 18.02.86      *)

+       DEFINES print,

+               print channel :

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+FILE VAR print file;

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+ 

+PROC print channel (INT CONST channel) :

+ 

+  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;

+  pr channel := channel;

+ 

+END PROC print channel; 

+ 

+INT PROC print channel : pr channel END PROC print channel; 

+ 

+ 

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  INT CONST myself channel := channel (myself);

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  remember error message if neccessary;

+  IF multi user THEN do ("break (quiet)") FI;

+  continue (myself channel);

+  clear error;

+  put error message if neccessary;

+

+  . remember error message if neccessary :

+      IF is error

+         THEN buffer := error message;

+              clear error;

+         ELSE buffer := "";

+      FI;

+ 

+  . put error message if neccessary :

+      IF buffer <> "" THEN errorstop (buffer) FI;

+ 

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  print (print file,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+ENDPROC execute print ;

+

+ENDPACKET print cmd for single user;

+ 

+#page# 

+(******************************************************************)

+(***                                                            ***)

+(***   Generierung des Printers                                 ***)

+(***                                                            ***)

+(******************************************************************)

+ 

+LET printer name = "printer.std",

+    up           = ""3""13""5"" ;

+ 

+TEXT VAR fonttab name := "fonttab.std";

+ 

+BOOL CONST multi user := (pcb (9) AND 255) <> 1;

+ 

+INT VAR pr channel;

+TEXT VAR buffer;

+ 

+command dialogue (TRUE);

+ask for print channel;

+ask for paper format;

+ask for font table;

+load font table;

+forget (printer name, quiet);

+IF multi user THEN generate printer spool FI;

+check on;

+.

+  ask for print channel : 

+    line;

+    put ("gib Druckerkanal:");

+    get (pr channel);

+    print channel (pr channel);

+    line;

+. 

+  ask for paper format :

+    SELECT paper format OF

+      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)

+      CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54)

+      CASE 3 : papersize (21.0, 29.7)

+    END SELECT

+

+    . paper format :

+        line;

+        REP out (up);

+            IF yes ("Papierformat : endlos, 8 Zoll breit")

+               THEN LEAVE paper format WITH 1 FI;

+            out (up);

+            IF yes ("Papierformat : endlos, 13.2 Zoll breit")

+               THEN LEAVE paper format WITH 2 FI;

+            out (up);

+            IF yes ("Papierformat : DINA 4")

+               THEN LEAVE paper format WITH 3 FI;

+        PER;

+        0

+.

+  ask for font table :

+    line;

+    fonttab name CAT char pitch;

+    line;

+    fonttab name CAT language

+ 

+    . char pitch :

+        REP out (up); 

+            IF yes ("Zeichenbreite des Druckers : 10 Zeichen pro Zoll")

+               THEN LEAVE char pitch WITH "-10" FI;

+            out (up);

+            IF yes ("Zeichenbreite des Druckers : 12 Zeichen pro Zoll")

+               THEN LEAVE char pitch WITH "-12" FI;

+        PER;

+        ""

+ 

+    . language :

+        REP out (up); 

+            IF yes ("Zeichensatz des Druckers : deutsch") 

+               THEN LEAVE language WITH "" FI;

+            out (up);

+            IF yes ("Zeichensatz des Druckers : ascii") 

+               THEN LEAVE language WITH ".ascii" FI;

+        PER;

+        ""

+.

+  load font table :

+    IF NOT exists (fonttab name)

+       THEN command dialogue (TRUE); 

+            REP line (2); 

+                putline ("Bitte Archiv mit der Fonttabelle """ +

+                          fonttab name + """ einlegen!");

+                line;

+            UNTIL yes ("Archiv eingelegt") PER;

+            reserve archive;

+            fetch (fonttab name, archive);

+            release (archive);

+    FI;

+    font table (fonttab name);

+    IF multi user

+       THEN command dialogue (FALSE); 

+            do ("save(""" + font tab name + """,task(""configurator""))") 

+    FI;

+    forget (fonttab name, quiet);

+ 

+    . reserve archive :

+        INT VAR p1, p2;

+        archive (" "31" ");

+        disable stop;

+        list (archive);

+        IF is error

+           THEN buffer := errormessage;

+                p1 := pos (buffer, """", 1 ) + 1;

+                p2 := pos (buffer, """", p1) - 1;

+                IF p1 > 0 AND p2 > 0

+                   THEN clear error;

+                        buffer := subtext (buffer, p1, p2);

+                        archive (buffer);

+                FI;

+        FI;

+        enable stop;

+ 

+. generate printer spool :

+    eumel must advertise;

+    cursor (1, 12);

+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");

+    putline ("die Fonttabelle mit dem Kommando");

+    line;

+    putline ("      font table (""" + font tab name + """)");

+    line;

+    putline ("eingestellt werden!!!");

+    line (4);

+    putline ("Generierung beendet, weiter mit 'SV'");

+    generate printer server;

+    do (buffer);

+ 

+. generate printer server :

+    buffer :=  "break (quiet);";

+    buffer CAT "spool manager (PROC printer);";

+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";

+    buffer CAT "PROC printer:";

+    buffer CAT "  disable stop;";

+    buffer CAT "  continue (server channel);";

+    buffer CAT "  check error (error message);";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  REP forget (ds);";

+    buffer CAT "      execute print;";

+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";

+    buffer CAT "  PER;";

+    buffer CAT "END PROC printer;";

+    buffer CAT "PROC execute print:";

+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";

+    buffer CAT "  enable stop;";

+    buffer CAT "  ds := nilspace;";

+    buffer CAT "  call (father, fetch code, ds, reply);";

+    buffer CAT "  IF reply = ack CAND type (ds) = file type";

+    buffer CAT "     THEN file := sequential file (input, ds);";

+    buffer CAT "          print (file,";

+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";

+    buffer CAT "            PROC (INT CONST, INT CONST) close,";

+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC execute print;"; 

+    buffer CAT "PROC check error(TEXT CONST message):";

+    buffer CAT "  IF is error";

+    buffer CAT "     THEN clear error; rename myself (message);";

+    buffer CAT "          IF is error THEN end(myself) FI;"; 

+    buffer CAT "          pause (9000); end(myself);";

+    buffer CAT "  FI;";

+    buffer CAT "END PROC check error;"; 

diff --git a/system/printer-laser/4/doc/readme b/system/printer-laser/4/doc/readme
new file mode 100644
index 0000000..019d75c
--- /dev/null
+++ b/system/printer-laser/4/doc/readme
@@ -0,0 +1,155 @@
+Treiber-Installations-Programm für Laserdrucker   21. 2.1989 
+ 
+ 
+1. Installations- und Gebrauchsanleitung 
+ 
+Einrichten 
+So wird das Treiber-Installationsprogramm eingerichtet: 
+ 
+    Richten Sie die Task PRINTER als Sohn von SYSUR ein : 
+ 
+           begin ("PRINTER", "SYSUR") 
+            
+    Geben Sie in der Task PRINTER nacheinander folgende Kommandos
+    ein, die Sie jeweils mit der ENTER-Taste bestätigen: 
+ 
+       archive ("std.printer") 
+       fetch("laser.inserter",archive) 
+       insert ("laser.inserter") 
+ 
+Das Programm wird dann insertiert. 
+ 
+ 
+Menüsystem 
+Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern.
+Wählen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste
+der unterstützten Drucker dieses Herstellers gezeigt. Wählen Sie hier
+den passenden Typ aus! 
+Das Installationsprogramm fragt nun nach der Art der Druckerschnittstelle.
+Die Druckerhardware muß wie hier angegeben konfiguriert sein, wenn sie
+mit dem ausgewählten Treiber betrieben werden soll. 
+ 
+Das Installationsprogramm kann mit 'treiber einrichten' erneut aufgerufen
+werden. Die Druckerschnittstelle kann mit 'printer setup' nachträglich
+umkonfiguriert werden. 
+ 
+2. Druckertreiber-Auswahl 
+ 
+Verwendung nicht im Menü enthaltener Drucker 
+Für den Fall, daß Sie genau Ihren Drucker im Menü nicht finden,
+müssen Sie herausfinden (Druckerhandbuch, -händler!),
+welchen Drucker Ihr Drucker emuliert oder welchem er ähnlich ist.
+(Die meisten Laserdrucker verfügen über eine HP-Laserjet Emulation).
+ 
+ 
+3. Steuerungsmöglichkeiten und Spezialfeatures 
+ 
+Einige Treiber bieten bestimmte Einstellungsmöglichkeiten.
+Die Einstellungen können über 
+- Steuerprozeduren 
+- Materialanweisungen bzw. 
+- direkte Druckeranweisungen 
+vorgenommen werden. 
+ 
+Steuerprozeduren 
+setzen Einstellungen, die für alle Dokumente (Druckdateien) gelten
+sollen. Die Prozeduren müssen in der Druckspooltask (meist: "PRINTER")
+aufgerufen werden. Vor Aufruf der Prozeduren muß das Spoolkommando 
+'stop spool' gegeben werden!
+ 
+ 
+ 
+PROC papersize (REAL CONST breite, länge) 
+    Dient zur Einstellung der Größe der physikalisch beschreibbaren
+    Fläche. 
+    Beispiel:  papersize (21.0, 29.7) 
+               (Standardeinstellung für DIN A4 Format)
+ 
+PROC papersize 
+    Informationsprozedur 
+ 
+Die Änderungen, die Sie in der Druckspooltask vorgenommen haben
+werden erst wirksam, nachdem das Spool-Kommando 'start spool' ge­
+geben und die Druckspooltask verlassen wurde. 
+ 
+ 
+ 
+Materialanweisungen \#material("...")\# 
+müssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und
+setzen Einstellungen für eine ganze Datei. (Materialanweisungen haben
+für die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge­
+stellten Standardwerten. Diese werden durch die Materialanweisung aber
+nicht geändert.) 
+ 
+Beispiel:  \#material("landscape")\#  oder \#material("quer")\#
+           Der Druckertreiber stellt sich auf Querdruck ein. Für das 
+           Papierformat werden die
+           durch papersize eingestellten Werte vertauscht angenommen.
+           Es sollten nur Schrifttypen verwendet werden, die auch im 
+           Landscape-Modus vorhanden sind.
+
+ 
+- Es darf in einer Datei nur eine Materialanweisung stehen! Sollen meh­
+  rere Einstellungen vorgenommen werden, müssen sie in einer Anweisung
+  erscheinen. Beispiel:  \#material("quer;2")\# 
+ 
+- Achten Sie bei Materialanweisungen
+  besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben
+  berücksichtigt! Also:  \#"quer"\# und keinesfalls \#"QUER"\#!!! 
+ 
+- Bei Laserdruckern gebräuchliche Materialanweisungen sind: 
+    - landscape (quer) 
+    - manual 
+    - tray 
+ 
+direkte Druckeranweisungen \#"..."\# 
+gelten ab der Position, an der sie in der Datei auftreten. Sie haben
+(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und
+Materialeinstellungen. 
+ 
+ 
+- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und
+  nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann
+  daher vorkommen, daß (z.B. bei Spaltendruck) unerwartete Ergebnisse
+  erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen
+  Reihenfolge an den Drucker sendet, als er in der Datei steht, die
+  mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B.
+  für beide Spalten) unerwünscht erhalten bleibt. Direkte
+  Druckeranweisungen, die das Schriftformat verändern,
+  sollten grundsätzlich nicht gegeben werden. 
+ 
+ 
+4. Spezialfeatures: 
+ 
+Die Druckertreiber für die Drucker APPLE-Laserwriter und NEC LC-08
+verfügen über Anweisungen zum Zeichnen einer Linie, Box oder eines Kuchen- 
+stücks, die als direkte Druckeranweisungen in ELAN-Syntax gegeben werden
+müssen. 
+Folgende Anweisungen stehen zur Verfügung: 
+ 
+PROC line (REAL CONST x offset, y offset, width, height, line width) :
+
+PROC x line (REAL CONST x offset, y offset, width, line width) :
+
+PROC y line (REAL CONST x offset, y offset, height, line width) :
+ 
+PROC box (REAL CONST x offset, y offset, width, height, line width, pattern):
+
+PROC box shade (REAL CONST x offset, y offset, width, height, pattern) :
+
+PROC box frame (REAL CONST x offset, y offset, width, height, line width) :
+
+PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle, 
+                      line width, pattern) :
+
+PROC cake shade (REAL CONST x offset, y offset, radius, start angle, 
+                            sweep angle, pattern) :
+
+PROC cake frame (REAL CONST x offset, y offset, radius, start angle, 
+                            sweep angle, line width) :
+
+
+
+
+
+
diff --git a/system/printer-laser/4/source-disk b/system/printer-laser/4/source-disk
new file mode 100644
index 0000000..d21e78b
--- /dev/null
+++ b/system/printer-laser/4/source-disk
@@ -0,0 +1 @@
+grundpaket/08_std.printer_laser.img
diff --git a/system/printer-laser/4/src/fonttab.apple.laserwriter b/system/printer-laser/4/src/fonttab.apple.laserwriter
new file mode 100644
index 0000000..bee2d6a
--- /dev/null
+++ b/system/printer-laser/4/src/fonttab.apple.laserwriter
diff --git a/system/printer-laser/4/src/fonttab.canon.lbp-8 b/system/printer-laser/4/src/fonttab.canon.lbp-8
new file mode 100644
index 0000000..45314ac
--- /dev/null
+++ b/system/printer-laser/4/src/fonttab.canon.lbp-8
diff --git a/system/printer-laser/4/src/fonttab.epson.sq b/system/printer-laser/4/src/fonttab.epson.sq
new file mode 100644
index 0000000..a3f7af3
--- /dev/null
+++ b/system/printer-laser/4/src/fonttab.epson.sq
diff --git a/system/printer-laser/4/src/fonttab.hp.laserjet b/system/printer-laser/4/src/fonttab.hp.laserjet
new file mode 100644
index 0000000..4082e46
--- /dev/null
+++ b/system/printer-laser/4/src/fonttab.hp.laserjet
diff --git a/system/printer-laser/4/src/fonttab.kyocera.f-1010 b/system/printer-laser/4/src/fonttab.kyocera.f-1010
new file mode 100644
index 0000000..9c3fbda
--- /dev/null
+++ b/system/printer-laser/4/src/fonttab.kyocera.f-1010
diff --git a/system/printer-laser/4/src/fonttab.nec.lc-08 b/system/printer-laser/4/src/fonttab.nec.lc-08
new file mode 100644
index 0000000..f032953
--- /dev/null
+++ b/system/printer-laser/4/src/fonttab.nec.lc-08
diff --git a/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1
new file mode 100644
index 0000000..fae8c09
--- /dev/null
+++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic1
@@ -0,0 +1,30 @@
+#"!"82"! "# 
+#"CMNT 'dyn1.6   '; GENF 10220, 'DYNAMIC1',  22, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.6.i '; GENF 10224, 'DYNAMIC1',  22, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.8   '; GENF 10280, 'DYNAMIC1',  28, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.8.i '; GENF 10284, 'DYNAMIC1',  28, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.10  '; GENF 10340, 'DYNAMIC1',  34, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.10.i'; GENF 10344, 'DYNAMIC1',  34, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.12  '; GENF 10420, 'DYNAMIC1',  42, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.12.i'; GENF 10424, 'DYNAMIC1',  42, 32, 126, 32, 0.94, 0.3, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.14  '; GENF 10500, 'DYNAMIC1',  50, 32, 126, 32, 0.94, 0.0, 0, 0, 0.0, 0.0; "# 
+#"CMNT 'dyn1.14.b'; GENF 10502, 'DYNAMIC1',  50, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# 
+#"CMNT 'dyn1.18.b'; GENF 10682, 'DYNAMIC1',  68, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# 
+#"CMNT 'dyn1.24.b'; GENF 10922, 'DYNAMIC1',  92, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# 
+#"CMNT 'dyn1.36.b'; GENF 11322, 'DYNAMIC1', 132, 32, 126, 32, 1.04, 0.0, 0, 0, 5.0, 3.0; "# 
+#"MAP 0, 0; EXIT;"# 
+ 
+#type ("dyn1.6")   #\#type("dyn1.6")\# 
+#type ("dyn1.6.i") #\#type("dyn1.6.i")\# 
+#type ("dyn1.8")   #\#type("dyn1.8")\# 
+#type ("dyn1.8.i") #\#type("dyn1.8.i")\# 
+#type ("dyn1.10")  #\#type("dyn1.10")\# 
+#type ("dyn1.10.i")#\#type("dyn1.10.i")\# 
+#type ("dyn1.12")  #\#type("dyn1.12")\# 
+#type ("dyn1.12.i")#\#type("dyn1.12.i")\# 
+#type ("dyn1.14")  #\#type("dyn1.14")\# 
+#type ("dyn1.14.b")#\#type("dyn1.14.b")\# 
+#type ("dyn1.18.b")#\#type("dyn1.18.b")\# 
+#type ("dyn1.24.b")#\#type("dyn1.24.b")\# 
+#type ("dyn1.36.b")#\#type("dyn1.36.b")\# 
+
diff --git a/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2 b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2
new file mode 100644
index 0000000..f425a7f
--- /dev/null
+++ b/system/printer-laser/4/src/genfont.kyocera.f-1010.dynamic2
@@ -0,0 +1,30 @@
+#"!"82"! "# 
+#"CMNT 'dyn2.6   '; GENF 20200, 'DYNAMIC2',  20, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.6.i '; GENF 20204, 'DYNAMIC2',  20, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.8   '; GENF 20260, 'DYNAMIC2',  26, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.8.i '; GENF 20264, 'DYNAMIC2',  26, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.10  '; GENF 20320, 'DYNAMIC2',  32, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.10.i'; GENF 20324, 'DYNAMIC2',  32, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.12  '; GENF 20400, 'DYNAMIC2',  40, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.12.i'; GENF 20404, 'DYNAMIC2',  40, 32, 126, 32, 0.94, 0.3, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.14  '; GENF 20480, 'DYNAMIC2',  48, 32, 126, 32, 0.94, 0.0, 0, 0, 2.0, 0.0; "# 
+#"CMNT 'dyn2.14.b'; GENF 20482, 'DYNAMIC2',  48, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# 
+#"CMNT 'dyn2.18.b'; GENF 20662, 'DYNAMIC2',  66, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# 
+#"CMNT 'dyn2.24.b'; GENF 20902, 'DYNAMIC2',  90, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# 
+#"CMNT 'dyn2.36.b'; GENF 21302, 'DYNAMIC2', 130, 32, 126, 32, 0.99, 0.0, 0, 0, 5.0, 3.0; "# 
+#"MAP 0, 0; EXIT;"# 
+ 
+#type ("dyn2.6")   #\#type("dyn2.6")\# 
+#type ("dyn2.6.i") #\#type("dyn2.6.i")\# 
+#type ("dyn2.8")   #\#type("dyn2.8")\# 
+#type ("dyn2.8.i") #\#type("dyn2.8.i")\# 
+#type ("dyn2.10")  #\#type("dyn2.10")\# 
+#type ("dyn2.10.i")#\#type("dyn2.10.i")\# 
+#type ("dyn2.12")  #\#type("dyn2.12")\# 
+#type ("dyn2.12.i")#\#type("dyn2.12.i")\# 
+#type ("dyn2.14")  #\#type("dyn2.14")\# 
+#type ("dyn2.14.b")#\#type("dyn2.14.b")\# 
+#type ("dyn2.18.b")#\#type("dyn2.18.b")\# 
+#type ("dyn2.24.b")#\#type("dyn2.24.b")\# 
+#type ("dyn2.36.b")#\#type("dyn2.36.b")\# 
+
diff --git a/system/printer-laser/4/src/laser.inserter b/system/printer-laser/4/src/laser.inserter
new file mode 100644
index 0000000..c28766f
--- /dev/null
+++ b/system/printer-laser/4/src/laser.inserter
@@ -0,0 +1,275 @@
+PACKET laserdrucker inserter DEFINES treiber einrichten : 
+ 
+(**************************************************************************)
+(*   Installationsprogramm                        Stand   : 12.12.88      *)
+(*   für Tintenstrahl-                            Version : 0.9           *)
+(*   und Laserdrucker                             Autor   : hjh           *)
+(**************************************************************************)
+ 
+LET anzahl firmen = 6 ; 
+LET apple = "APPLE" , 
+    canon = "CANON" , 
+    epson = "EPSON" , 
+    hp    = "HEWLETT PACKARD" , 
+    kyo   = "KYOCERA" , 
+    nec   = "NEC" ; 
+ 
+THESAURUS VAR firmen := empty thesaurus ; 
+ 
+INT VAR i ; 
+ROW anzahl firmen THESAURUS VAR drucker ; 
+FOR i FROM 1 UPTO anzahl firmen REP 
+  drucker (i) := empty thesaurus 
+PER ;
+ROW anzahl firmen THESAURUS VAR printer ; 
+FOR i FROM 1 UPTO anzahl firmen REP 
+  printer (i) := empty thesaurus 
+PER ;
+ROW anzahl firmen THESAURUS VAR fonttables ; 
+FOR i FROM 1 UPTO anzahl firmen REP 
+  fonttables (i) := empty thesaurus 
+PER ;
+ 
+liste (apple,"LASERWRITER","printer.apple.laserwriter","fonttab.apple.laserwriter"); 
+liste (canon , "LBP-8"    ,"printer.canon.lbp-8"      ,"fonttab.canon.lbp-8"); 
+liste (epson , "SQ 2500"  ,"printer.epson.sq"         ,"fonttab.epson.sq"); 
+liste (hp , "HP LASERJET" ,"printer.hp.laserjet"      ,"fonttab.hp.laserjet"); 
+liste (hp , "HP LASERJET+" ,"printer.hp.laserjet"      ,"fonttab.hp.laserjet"); 
+liste (kyo , "F-1010"     ,"printer.kyocera.f-1010"   ,"fonttab.kyocera.f-1010"); 
+liste (kyo , "F-2200"     ,"printer.kyocera.f-1010"   ,"fonttab.kyocera.f-1010"); 
+liste (nec , "SILENTWRITER LC-08"      ,"printer.nec.lc-08"
+,"fonttab.nec.lc-08"); 
+
+treiber einrichten;
+ 
+PROC liste (TEXT CONST firmenname, druckername , 
+                        printername, fonttabname ) : 
+  INT VAR firmnum ; 
+  IF firmen CONTAINS firmenname 
+    THEN firmnum := link (firmen,firmenname) 
+    ELSE insert (firmen,firmenname,firmnum) 
+  FI; 
+  insert (drucker(firmnum), druckername) ; 
+  insert (printer(firmnum), printername) ; 
+  insert (fonttables(firmnum), fonttabname) ; 
+END PROC liste ;
+ 
+PROC treiber einrichten : 
+  INT VAR menu phase := 1 ; 
+  BOOL VAR installed := FALSE ; 
+  BOOL VAR was esc ; 
+  INT VAR firmnum, druckernum ;
+  TEXT VAR firmenname, druckername, printername, fonttabname ;
+ 
+  pre menu ;
+  REP 
+    SELECT menu phase OF 
+      CASE 1 : menu ("Hauptmenü Tintenstrahl und Laserdrucker", firmen, 
+                     "CR: Eingabe        ESC : Installation abrechen", 
+                     firmnum, was esc ) ;
+               IF was esc 
+                 THEN menu phase := 0 
+                 ELSE menu phase := 2 ; 
+                      firmenname := name (firmen,firmnum) ;
+               FI ;
+  
+      CASE 2 : menu (firmenname + " - Menü", drucker(firmnum),
+                     "CR: Eingabe        ESC : Zurück zum Hauptmenü",      
+                     druckernum, was esc) ;
+               IF was esc 
+                 THEN menu phase := 1 
+                 ELSE menu phase := 3 ; 
+                      druckername := name (drucker(firmnum),druckernum);  
+                      printername := name (printer(firmnum),druckernum); 
+                      fonttabname := name (fonttables(firmnum),druckernum); 
+               FI;
+ 
+      CASE 3 : inst (druckername, printername, fonttabname, installed) ; 
+               IF NOT installed THEN menu phase := 1 FI;
+    END SELECT 
+  UNTIL installed OR abbruch PER ;
+  post menu. 
+ 
+  abbruch: 
+    menu phase < 1 .
+ 
+  pre menu: 
+    line; 
+    IF is single task system
+      THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+    FI; 
+    IF NOT is system task (myself)
+      THEN errorstop ("Die Druckertask muß im Systemzweig angelegt werden") 
+    FI; 
+    command dialogue (TRUE);
+    IF name (myself) <> "PRINTER" 
+      THEN putline ("Diese Task heißt nicht ""PRINTER"", sondern """ + 
+                    name (myself) + """ !"); 
+           IF yes ("Soll die Task in ""PRINTER"" umbenannt werden ?") 
+             THEN rename myself ("PRINTER") 
+           FI 
+    FI. 
+ 
+  is single task system:  (pcb (9) AND 255) = 1.
+ 
+  post menu: 
+   IF NOT installed 
+    THEN page; 
+         putline ("Es ist kein Druckertreiber installiert worden!"); 
+         line; 
+         putline ("Wenn dieses Installationsprogramm insertiert wurde,");
+         putline ("kann es in der Task """ + name (myself) + """ "); 
+         putline ("mit 'treiber einrichten' erneut aufgerufen werden."); 
+         line; 
+   FI. 
+ 
+END PROC treiber einrichten ;
+ 
+PROCEDURE menu (TEXT CONST header, THESAURUS CONST items, TEXT CONST bottom, 
+                INT VAR choice, BOOL VAR was esc) : 
+  INT VAR anzahl ; 
+  page; 
+  headline (header) ; 
+  show list (items,anzahl) ; 
+  bottomline (bottom) ;
+  ask user (anzahl,choice,was esc);  
+END PROC menu ;
+ 
+PROC headline (TEXT CONST header): 
+  cursor (13,1); 
+  putline ("E U M E L - Druckertreiber - Installations - Programm"); 
+  cursor (40 - LENGTH header DIV 2, 2); 
+  IF header <> "" THEN put (header) FI ;
+  line (2) 
+END PROC headline; 
+ 
+PROC bottomline (TEXT CONST bottom): 
+  cursor (1,24); 
+  IF bottom <> "" THEN put (""5"" + bottom) FI ;
+END PROC bottomline; 
+ 
+PROC show list (THESAURUS CONST items , INT VAR anzahl ) : 
+  INT VAR i ; 
+  anzahl := highest entry (items);
+  FOR i FROM 1 UPTO anzahl REP 
+    putline ( text(i) + ".  " + name (items,i) ) ; 
+  PER;
+END PROC show list ;
+ 
+PROC ask user (INT CONST max choice, INT VAR choice, BOOL VAR was esc): 
+  TEXT VAR exit; 
+  TEXT VAR inp := "";
+  REP 
+    cursor (1,23); 
+    IF inp = "" 
+      THEN put ("Ihre Wahl (Nummer eingeben):")
+      ELSE put ("FEHLER! Eingabe korrigieren:")
+    FI; 
+    editget (inp, ""27"", "", exit); 
+    was esc :=  exit = ""27"";
+  UNTIL was esc OR ok PER. 
+ 
+  ok: 
+    choice := int (inp) ; 
+    last conversion ok CAND ( choice > 0 AND choice <= max choice) . 
+END PROC ask user; 
+ 
+BOOL PROC is system task (TASK CONST task): 
+  TASK VAR tsk := task ; 
+  WHILE NOT (tsk = supervisor OR tsk = niltask) REP  
+    tsk := father (tsk) ; 
+  PER;
+  tsk = supervisor 
+END PROC is system task ;
+ 
+PROC inst (TEXT CONST druckername, printername, fonttabname, 
+           BOOL VAR success) : 
+   page ; 
+   headline (druckername) ; 
+   fetch from archive if necessary ((empty thesaurus 
+      + printer name + fonttab name) - all ,success); 
+   IF success  AND ok
+     THEN page ; 
+          putline ("Der Drucker wird insertiert"); 
+          insert (printer name) ; 
+     ELSE success := FALSE ; 
+   FI. 
+ 
+ok: 
+  bottomline (" "); 
+  yes ("Soll der ausgewählte Drucker insertiert werden"). 
+   
+END PROC inst ; 
+ 
+PROC fetch from archive if necessary (THESAURUS CONST files, 
+                                       BOOL VAR success ):
+  BOOL VAR was esc ; 
+  THESAURUS VAR thes :: files; 
+ 
+  WHILE highest entry (thes) > 0  REP
+    ask for archive;
+    IF NOT was esc 
+      THEN disable stop ; 
+           bottomline ("Bitte warten !  "); 
+           reserve archive;
+           IF NOT is error 
+             THEN IF highest entry (thes / ALL archive) > 0 
+                    THEN fetch (thes / ALL archive, archive);
+                    ELSE fehler ("Dateien nicht gefunden") 
+                  FI; 
+                  thes := thes - all;
+           FI; 
+           IF is error 
+             THEN fehler (errormessage);
+                  clear error 
+           FI; 
+           command dialogue (FALSE); 
+           release (archive);
+           command dialogue (TRUE); 
+           enable stop ; 
+    FI;
+  UNTIL was esc PER; 
+  success := highest entry (thes) = 0. 
+ 
+ask for archive:
+  headline ("") ;
+  putline ("Bitte Archiv mit den Dateien"); 
+  TEXT VAR buffer;
+  INT VAR index :: 0; 
+  REP 
+    get (thes, buffer, index); 
+    putline ("    " + buffer) 
+  UNTIL index = 0 PER; 
+  putline ("einlegen !"); 
+  bottomline ("CR: Wenn Archiv eingelegt        ESC : Zurück zum Hauptmenü"); 
+  cursor (1,24); 
+  REP 
+    inchar (buffer) ; 
+  UNTIL buffer = ""13"" OR buffer = ""27"" PER ; 
+  was esc := buffer = ""27"". 
+ 
+reserve archive :
+  INT VAR p1, p2;
+  archive (" "31" ");
+  list (archive);
+  IF is error
+     THEN buffer := errormessage;
+          p1 := pos (buffer, """", 1 ) + 1;
+          p2 := pos (buffer, """", p1) - 1;
+          IF p1 > 0 AND p2 > 0
+             THEN clear error;
+                  buffer := subtext (buffer, p1, p2);
+                  archive (buffer);
+          FI;
+  FI.
+
+END PROC fetch from archive if necessary ;
+
+PROC fehler (TEXT CONST fehlermeldung): 
+  bottomline (""7"" + fehlermeldung + "   Bitte eine Taste drücken") ; 
+  pause ; 
+  bottomline (" ") ; 
+END PROC fehler;
+ 
+END PACKET laserdrucker inserter;
+
diff --git a/system/printer-laser/4/src/printer.apple.laserwriter b/system/printer-laser/4/src/printer.apple.laserwriter
new file mode 100644
index 0000000..d4c6adf
--- /dev/null
+++ b/system/printer-laser/4/src/printer.apple.laserwriter
@@ -0,0 +1,770 @@
+PACKET apple laser writer printer
+ 
+(**************************************************************************)
+(*                                                Stand   : 24.02.88      *)
+(*  APPLE LaswerWriter (PostScript)               Verison : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(**************************************************************************)
+ 
+       DEFINES open,
+               close,
+               execute,
+ 
+               paper size,
+               paper x size,
+               paper y size,
+
+               load positioning procs,
+               load underline procs,
+               load italics procs,
+               load encoding,
+
+               read ps input,
+
+               box commands,
+               insert box command,
+               delete box command,
+
+               print error,
+               :
+ 
+LET
+(*  underline           =  1,
+    bold                =  2,
+    italics             =  4,
+    reverse             =  8,
+*) 
+    underline linetype  =  1,
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8,
+ 
+    ps input name       =  "PostScript.input",
+    ps error            =  999,
+
+    tag type            =  1;
+
+INT VAR paper length, font no, underline no, symbol type;
+REAL VAR x size, y size;
+BOOL VAR is landscape;
+TEXT VAR record, char, command, symbol;
+FILE VAR ps input;
+THESAURUS VAR box cmds := empty thesaurus;
+
+(*********************************************************************)
+ 
+paper size (21.0, 29.7);
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+REAL PROC paper x size : x size END PROC paper x size;
+
+REAL PROC paper y size : y size END PROC paper y size;
+
+
+THESAURUS PROC box commands : box cmds END PROC box commands;
+
+PROC insert box command (TEXT CONST new command) :
+
+  command := new command;
+  change all (command, " ", "");
+  insert (box cmds, command)
+
+END PROC insert box command;
+
+PROC delete box command (TEXT CONST old command) :
+
+  INT VAR dummy;
+  command := old command;
+  change all (command, " ", "");
+  delete (box cmds, command, dummy)
+
+END PROC delete box command;
+
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0
+       THEN is landscape := TRUE;
+            x steps      := x step conversion ( y size );
+            y steps      := y step conversion ( x size );
+       ELSE is landscape := FALSE;
+            x steps      := x step conversion ( x size );
+            y steps      := y step conversion ( y size );
+    FI;
+    forget (ps input name, quiet);
+    ps input     := sequential file (output, ps input name);
+    paper length := y steps;
+    font no      := 0;
+    underline no := 0;
+    disable stop;
+    out (""4"");
+    read ps input (ps input, 18000, ""4"");
+    clear error;
+    enable stop;
+    out ("initgraphics erasepage statusdict /waittimeout 3000 put ");
+    load positioning procs;
+    load underline procs;
+    load italics procs;
+    load encoding;
+    read ps input (ps input, 0, "");
+ 
+. x start : param1
+. y start : param2
+. 
+  open page :
+    x start := 0;
+    y start := 0;
+    IF   pos (material, "tray") > 0
+         THEN out ("statusdict /manualfeed false put ");
+    ELIF pos (material, "manual") > 0
+         THEN out ("statusdict /manualfeed true put statusdict /manualfeedtimeout 3600 put ");
+    FI;
+    IF material contains a number
+       THEN out ("/#copies "); out (number); out ("def ");
+    FI;
+    IF is landscape
+       THEN out (paper length);
+            out ("ys 0 translate 90 rotate ");
+    FI;
+    read ps input (ps input, 0, "");
+ 
+    . material contains a number :
+        INT VAR number := pos (material, "0", "9", 1);
+        IF number = 0
+           THEN FALSE
+           ELSE number := max (1, int (subtext (material, number, number + 1)));
+                TRUE
+        FI
+ 
+END PROC open; 
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+  OTHERWISE : put (param1)
+END SELECT; 
+ 
+. 
+  close document :
+    disable stop;
+    out (""4"");
+    read ps input (ps input, 18000, ""4"");
+
+ 
+(*. remaining y steps : param1*)
+.
+  close page :
+    outline ("showpage"); 
+    read ps input (ps input, 0, "");
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    out ("(");
+    out subtext (string, from, to);
+    out (") show ");
+.
+  write cmd :
+    command := subtext (string, from, to);
+    IF is box cmd
+       THEN disable stop;
+            do (command);
+            clear error;
+       ELSE out (command);
+            out (" ");
+    FI;
+ 
+    . is box cmd :
+        scan (command);
+        next symbol (symbol, symbol type);
+        (symbol type = tag type) CAND (box cmds CONTAINS symbol)
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    move to (0, y pos);
+    line;
+    read ps input (ps input, 0, "");
+ 
+
+. x steps : param1
+. y steps : param2
+
+.
+  move :
+    move to (x pos, y pos);
+ 
+. 
+  draw :
+    IF y steps <> 0 COR x steps < 0 COR linetype <> underline linetype
+       THEN stop
+       ELSE IF underline no <> font no THEN out ("lu ") FI;
+            out (x steps); 
+            out ("ul ");
+    FI;
+
+ 
+. modification : param1
+.
+  on :
+    IF on string (modification) <> ""
+       THEN out (on string (modification));
+            out (" ");
+       ELSE stop
+    FI
+ 
+.
+  off :
+    IF off string (modification) <> ""
+       THEN out (off string (modification));
+            out (" ");
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    font no := font nr;
+    out (fontstring (font nr));
+    out (" /af exch def af setfont ");
+ 
+END PROC execute;
+ 
+ 
+PROC move to (INT CONST x, y) :
+
+  out (x);                out ("xs ");
+  out (paper length - y); out ("ys moveto ");
+
+END PROC move to;
+
+
+PROC line                        : out (""13""10"")               END PROC line;
+
+PROC outline (TEXT CONST string) : out (string); out (""13""10"") END PROC outline;
+
+PROC out     (INT  CONST value)  : out (text (value)); out (" ")  END PROC out;
+
+PROC out     (REAL CONST value)  : out (text (value)); out (" ")  END PROC out;
+
+
+PROC load positioning procs :
+
+  out ("/xs {"); out (72.0 / 2.54 * x step conversion (1)); out ("mul} def ");
+  out ("/ys {"); out (72.0 / 2.54 * y step conversion (1)); out ("mul} def ");
+
+END PROC load positioning procs;
+
+
+PROC load underline procs :
+
+  out ("/ul {xs ut setlinewidth 0 up rmoveto dup gsave 0 rlineto stroke grestore up neg rmoveto} def ");
+  out ("/lu {af /FontMatrix get 3 get af /FontInfo get 2 copy /up 3 1 roll /UnderlinePosition get mul 3 mul def /ut 3 1 roll /UnderlineThickness get mul def} def ");
+
+END PROC load underline procs;
+
+
+PROC load italics procs :
+
+  out ("/iton {/m matrix def m 2 12 sin 12 cos div put af m makefont setfont} def ");
+  out ("/itoff {af setfont} def ");
+
+END PROC load italics procs;
+
+
+PROC load encoding :
+
+  out ("/reencsmalldict 12 dict def ");
+  out ("/ReEncodeSmall {reencsmalldict begin ");
+  out ("/newcodesandnames exch def /newfontname exch def /basefontname exch def ");
+  out ("/basefontdict basefontname findfont def /newfont basefontdict maxlength dict def ");
+  out ("basefontdict {exch dup /FID ne {dup /Encoding eq {exch dup length array copy newfont 3 1 roll put} {exch newfont 3 1 roll put} ifelse} {pop pop} ifelse} forall ");
+  out ("newfont /FontName newfontname put newcodesandnames aload pop newcodesandnames length 2 idiv {newfont /Encoding get 3 1 roll put} repeat ");
+  out ("newfontname newfont definefont pop ");
+  out ("end} def ");
+  out ("/eumelencoding[10#128 /Ccedilla 10#129 /udieresis 10#128 /Ccedilla 10#129 /udieresis ");
+  out ("10#130 /eacute 10#131 /acircumflex 10#132 /adieresis 10#133 /agrave 10#134 /aring 10#135 /ccedilla 10#136 /ecircumflex 10#137 /edieresis 10#138 /egrave 10#139 /idieresis ");
+  out ("10#140 /icircumflex 10#141 /igrave 10#142 /Adieresis 10#143 /Aring 10#144 /Eacute 10#145 /ae 10#146 /AE 10#147 /ocircumflex 10#148 /odieresis 10#149 /ograve ");
+  out ("10#150 /ucircumflex 10#151 /ugrave 10#152 /ydieresis 10#153 /Odieresis 10#154 /Udieresis 10#155 /cent 10#156 /sterling 10#157 /yen 10#158 /currency 10#159 /florin ");
+  out ("10#160 /aacute 10#161 /iacute 10#162 /oacute 10#163 /uacute 10#164 /ntilde 10#165 /Ntilde 10#166 /ordfeminine 10#167 /ordmasculine 10#168 /questiondown 10#169 /quotedblleft ");
+  out ("10#170 /quotedblright 10#171 /guilsinglleft 10#172 /guilsinglright 10#173 /exclamdown 10#174 /guillemotleft 10#175 /guillemotright 10#176 /atilde 10#177 /otilde 10#178 /Oslash 10#179 /oslash ");
+  out ("10#180 /oe 10#181 /OE 10#182 /Agrave 10#183 /Atilde 10#184 /Otilde 10#185 /section 10#186 /daggerdbl 10#187 /dagger 10#188 /paragraph 10#189 /space ");
+  out ("10#190 /space 10#191 /space 10#192 /quotedblbase 10#193 /ellipsis 10#194 /perthousand 10#195 /bullet 10#196 /endash 10#197 /emdash 10#198 /space 10#199 /Aacute ");
+  out ("10#200 /Acircumflex 10#201 /Egrave 10#202 /Ecircumflex 10#203 /Edieresis 10#204 /Igrave 10#205 /Iacute 10#206 /Icircumflex 10#207 /Idieresis 10#208 /Ograve 10#209 /Oacute ");
+  out ("10#210 /Ocircumflex 10#211 /Scaron 10#212 /scaron 10#213 /Ugrave 10#214 /Adieresis 10#215 /Odieresis 10#216 /Udieresis 10#217 /adieresis 10#218 /odieresis 10#219 /udieresis ");
+  out ("10#220 /k 10#221 /hyphen 10#222 /numbersign 10#223 /space 10#224 /grave 10#225 /acute 10#226 /circumflex 10#227 /tilde 10#228 /dieresis 10#229 /ring ");
+  out ("10#230 /cedilla 10#231 /caron 10#232 /Lslash 10#233 /Oslash 10#234 /OE 10#235 /ordmasculine 10#236 /Uacute 10#237 /Ucircumflex 10#238 /Ydieresis 10#239 /germandbls ");
+  out ("10#240 /Zcaron 10#241 /zcaron 10#242 /fraction 10#243 /ae ");
+  out ("10#251 /germandbls 10#252 /section] def ");
+  out ("/Helvetica /EHelvetica eumelencoding ReEncodeSmall ");
+  out ("/Helvetica-Bold /EHelvetica-Bold eumelencoding ReEncodeSmall ");
+  out ("/Helvetica-Oblique /EHelvetica-Oblique eumelencoding ReEncodeSmall ");
+  out ("/Helvetica-BoldOblique /EHelvetica-BoldOblique eumelencoding ReEncodeSmall ");
+  out ("/Times-Roman /ETimes-Roman eumelencoding ReEncodeSmall ");
+  out ("/Times-Bold /ETimes-Bold eumelencoding ReEncodeSmall ");
+  out ("/Times-Italic /ETimes-Italic eumelencoding ReEncodeSmall ");
+  out ("/Times-BoldItalic /ETimes-BoldItalic eumelencoding ReEncodeSmall ");
+  out ("/Courier /ECourier eumelencoding ReEncodeSmall ");
+  out ("/Courier-Oblique /ECourier-Oblique eumelencoding ReEncodeSmall ");
+  out ("/Courier-BoldOblique /ECourier-BoldOblique eumelencoding ReEncodeSmall ");
+  out ("/Courier-Bold /ECourier-Bold eumelencoding ReEncodeSmall ");
+  line;
+
+END PROC load encoding;
+
+
+PROC read ps input (FILE VAR input file, INT CONST timeout, TEXT CONST ok) :
+
+  BOOL VAR was cr;
+  record := "";
+  was cr := FALSE;
+  char   := incharety (timeout);
+  REP IF   char = ""10"" CAND was cr
+           THEN put record;
+                was cr := FALSE;
+      ELIF char = ""13"" CAND NOT was cr
+           THEN was cr := TRUE;
+           ELSE IF was cr
+                   THEN record CAT """13""";
+                        was cr := FALSE;
+                FI;
+                IF   char = ""4""
+                     THEN IF record <> "" THEN put record FI;
+                          putline (input file, "--  EOF  --");
+                          line (input file);
+                ELIF char >= " "
+                     THEN record CAT char
+                ELIF char >= ""0""
+                     THEN record CAT """";
+                          record CAT text (code (char));
+                          record CAT """";
+                     ELSE IF record <> "" THEN put record FI;
+                          LEAVE read ps input;
+                FI;
+      FI;
+      IF pos (ok, char) > 0
+         THEN IF record <> "" THEN put record FI;
+              LEAVE read ps input;
+      FI;
+      cat input (record, char);
+      IF char = "" THEN char := incharety (min (5, time out)) FI;
+  PER;
+
+  . put record :
+      putline (input file, record);
+      IF NOT is error CAND pos (record, "%%[ Error:") > 0
+         THEN errorstop (ps error, record) FI;
+      record := "";
+
+END PROC read ps input; 
+
+
+PROC print error (TEXT CONST error message, INT CONST error line) :
+
+  REAL CONST pl := y size * 72.0 / 2.54,
+             ys := 56.69291,
+             xs := 51.02362,
+             h  := 12.0;
+  REAL VAR x := xs, y := ys + h;
+  outline ("/Courier findfont 10 scalefont setfont");
+  move to x and y;
+  out     ("(FEHLER : ");
+  out     (error message);
+  IF error line > 0
+     THEN out (" in Zeile ");
+          out (error line);
+  FI;
+  outline (") show");
+  IF exists (ps input name)
+     THEN ps input := sequential file (input, ps input name);
+          y INCR 3.0 * h;
+          move to x and y;
+          outline ("(PostScript - Input :) show");
+          y INCR h;
+          WHILE NOT eof (ps input)
+          REP getline (ps input, record);
+              y INCR h;
+              move to x and y;
+              out     ("(");
+              out     (record);
+              outline (") show");
+          PER;
+          output (ps input);
+  FI;
+  outline ("showpage");
+  out (""4"");
+  read ps input (ps input, 18000, ""4"");
+
+  . move to x and y :
+      out (x); out (pl - y); out ("moveto ");
+
+END PROC print error;
+
+
+END PACKET apple laser writer printer;
+
+
+PACKET apple laserwriter box commands 
+
+(**************************************************************************)
+(*                                                                        *)
+(*      Kommandos zum Zeichen von Boxen, Linien und Schraffuren           *)
+(*                für den Apple LaserWriter                               *)
+(*                                                                        *)
+(*                                                Autor   : Rudolf Ruland *)
+(*                                                Stand   : 24.02.88      *)
+(**************************************************************************)
+
+       DEFINES line,
+               x line,
+               y line,
+
+               box,
+               box frame,
+               box shade,
+
+               cake,
+               cake frame,
+               cake shade,
+               :
+
+INT VAR x, y, h, w;
+
+WHILE highest entry (box commands) > 0
+  REP delete box command (name (box commands, highest entry (box commands))) PER;
+insert box command ("line");
+insert box command ("xline");
+insert box command ("yline");
+insert box command ("box");
+insert box command ("boxshade");
+insert box command ("boxframe");
+insert box command ("cake");
+insert box command ("cakeshade");
+insert box command ("cakeframe");
+
+
+PROC line (REAL CONST x offset, y offset, width, height, line width) :
+
+  IF line width > 0.0
+     THEN graph on (x offset, y offset, width, height);
+          out (text (line width / 300.0 * 72.0));
+          out (" setlinewidth ");
+          out (text (w));
+          out (" xs ");
+          out (text (-h));
+          out (" ys rlineto stroke ");
+          graph off;
+  FI;
+
+END PROC line;
+
+PROC x line (REAL CONST x offset, y offset, width, line width) :
+
+  line (x offset, y offset, width, 0.0, line width);
+
+END PROC x line;
+
+PROC y line (REAL CONST x offset, y offset, height, line width) :
+
+  line (x offset, y offset, 0.0, height, line width);
+
+END PROC y line;
+
+
+PROC box (REAL CONST x offset, y offset, width, height, line width, pattern):
+
+  box shade (x offset, y offset, width, height, pattern);
+  box frame (x offset, y offset, width, height, line width);
+
+END PROC box;
+
+
+PROC box shade (REAL CONST x offset, y offset, width, height, pattern) :
+
+  graph on (x offset, y offset, width, height);
+  box path;
+  out (text (pattern));
+  out (" setgray fill ");
+  graph off;
+
+END PROC box shade;
+
+
+PROC box frame (REAL CONST x offset, y offset, width, height, line width) :
+
+  IF line width <> 0.0
+     THEN graph on (x offset, y offset, width, height);
+          box path;
+          out (text (line width / 300.0 * 72.0));
+          out (" setlinewidth stroke ");
+          graph off;
+   FI;
+
+END PROC box frame;
+
+
+PROC box path :
+
+  out (text (w));
+  out (" xs 0 rlineto 0 ");
+  out (text (-h));
+  out (" ys rlineto ");
+  out (text (-w));
+  out (" xs 0 rlineto closepath ");
+
+END PROC box path;
+
+
+
+PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle, line width, pattern) :
+
+  cake shade (x offset, y offset, radius, start angle, sweep angle, pattern);
+  cake frame (x offset, y offset, radius, start angle, sweep angle, line width);
+
+END PROC cake;
+
+
+PROC cake shade (REAL CONST x offset, y offset, radius, start angle, sweep angle, pattern) :
+
+  graph on (x offset, y offset, radius, 0.0);
+  cake path (start angle, sweep angle);
+  out (text (pattern));
+  out (" setgray fill ");
+  graph off;
+
+END PROC cake shade;
+
+
+PROC cake frame (REAL CONST x offset, y offset, radius, start angle, sweep angle, line width) :
+
+
+  IF line width <> 0.0
+     THEN graph on (x offset, y offset, radius, 0.0);
+          cake path (start angle, sweep angle);
+          out (text (line width / 300.0 * 72.0));
+          out (" setlinewidth stroke ");
+          graph off;
+   FI;
+
+END PROC cake frame;
+
+
+PROC cake path (REAL CONST start angle, sweep angle) :
+
+  out (text (start angle));
+  out (" rotate ");
+  out ("currentpoint ");
+  out (text (w));
+  out (" xs 0 ");
+  out (text (sweep angle));
+  out (" ");
+  IF sweep angle < 360.0
+     THEN out ("2 setlinejoin arc closepath ");
+     ELSE out (text (w));
+          out (" xs 0 rmoveto arc ");
+  FI;
+
+END PROC cake path;
+
+
+PROC graph on (REAL CONST x offset, y offset, width, height) :
+
+  x := x step conversion (x offset);
+  y := y step conversion (y offset);
+  w := x step conversion (width);
+  h := y step conversion (height);
+  out ("gsave ");
+  out (text (x));
+  out (" xs ");
+  out (text (-y));
+  out (" ys rmoveto ");
+
+END PROC graph on;
+
+PROC graph off :
+
+  out ("grestore ");
+
+END PROC graph off;
+
+
+END PACKET apple laserwriter box commands;
+
+
+ 
+#page# 
+(******************************************************************)
+(***                                                            ***)
+(***   Generierung des Printers                                 ***)
+(***                                                            ***)
+(******************************************************************)
+(* 
+LET up = ""3""13""5"";
+*) 
+LET      printer name  = "printer.apple.laserwriter";
+TEXT VAR fonttab name := "fonttab.apple.laserwriter";
+ 
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+ 
+INT VAR pr channel;
+TEXT VAR buffer;
+ 
+command dialogue (TRUE);
+IF NOT multi user 
+  THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+FI; 
+ask for print channel;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+command dialogue (TRUE);
+check on;
+.
+  ask for print channel : 
+    line;
+    put ("gib Druckerkanal:");
+    get (pr channel);
+    do ("serverchannel(" + text (pr channel) + ")" ) ;
+    line;
+.
+  load font table :
+    IF NOT exists (fonttab name)
+       THEN REP line (2); 
+                putline ("Bitte Archiv mit der Fonttabelle """ +
+                          fonttab name + """ einlegen!");
+                line;
+            UNTIL yes ("Archiv eingelegt") PER;
+            reserve archive;
+            fetch (fonttab name, archive);
+            release (archive);
+    FI;
+    font table (fonttab name);
+    IF multi user
+       THEN command dialogue (FALSE);
+            do ("save(""" + font tab name + """,task(""configurator""))")
+    FI;
+    forget (fonttab name, quiet);
+ 
+    . reserve archive :
+        INT VAR p1, p2;
+        archive (" "31" ");
+        disable stop;
+        list (archive);
+        IF is error
+           THEN buffer := errormessage;
+                p1 := pos (buffer, """", 1 ) + 1;
+                p2 := pos (buffer, """", p1) - 1;
+                IF p1 > 0 AND p2 > 0
+                   THEN clear error;
+                        buffer := subtext (buffer, p1, p2);
+                        archive (buffer);
+                FI;
+        FI;
+        enable stop;
+ 
+. generate printer spool :
+    eumel must advertise;
+    cursor (1, 12);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (4);
+    putline ("Generierung beendet, weiter mit 'SV'");
+    generate printer server;
+    do (buffer);
+ 
+. generate printer server :
+    buffer :=  "break (quiet);";
+    buffer CAT "spool manager (PROC printer);";
+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+    buffer CAT "PROC printer:";
+    buffer CAT "  disable stop;";
+    buffer CAT "  continue (server channel);";
+    buffer CAT "  check error (error message);";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  REP forget (ds);";
+    buffer CAT "      execute print;";
+    buffer CAT "      IF is error AND online THEN clear error; print error (error message, 0); clear error FI;";
+    buffer CAT "  PER;";
+    buffer CAT "END PROC printer;";
+    buffer CAT "PROC execute print:";
+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";
+    buffer CAT "  enable stop;";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  call (father, fetch code, ds, reply);";
+    buffer CAT "  IF reply = ack CAND type (ds) = file type";
+    buffer CAT "     THEN file := sequential file (input, ds);";
+    buffer CAT "          print (file,";
+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";
+    buffer CAT "            PROC (INT CONST, INT CONST) close,";
+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC execute print;";
+    buffer CAT "PROC check error(TEXT CONST message):";
+    buffer CAT "  IF is error";
+    buffer CAT "     THEN clear error; rename myself (message);";
+    buffer CAT "          IF is error THEN end(myself) FI;";
+    buffer CAT "          pause (9000); end(myself);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC check error;";
+
diff --git a/system/printer-laser/4/src/printer.canon.lbp-8 b/system/printer-laser/4/src/printer.canon.lbp-8
new file mode 100644
index 0000000..4dfe9f8
--- /dev/null
+++ b/system/printer-laser/4/src/printer.canon.lbp-8
@@ -0,0 +1,327 @@
+PACKET canon lbp 8 printer
+ 
+(*************************************************************************)
+(*                                               Stand   : 29.07.86      *)
+(*   CANON  LBP-8  A1/A2                         Version : 4             *)
+(*                                               Autor   : Rudolf Ruland *)
+(*************************************************************************)
+ 
+ 
+       DEFINES open,
+               close,
+               execute,
+ 
+               paper size :
+ 
+LET underline           =  1,
+(*  bold                =  2,
+    italics             =  4,
+    reverse             =  8,
+ 
+    underline linetype  =  1, *)
+
+    csi                 =  ""155"",
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8;
+ 
+REAL VAR x size, y size;
+BOOL VAR is underline;
+ 
+(*********************************************************************)
+ 
+paper size (21.0, 29.7);
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+(*********************************************************************)
+
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    is underline := FALSE;
+    x steps := x step conversion ( x size - 0.8043333 );
+    y steps := y step conversion ( y size - 0.508);
+    out (""27":"27"P"13"");             (* Enable - Prop.Type *)
+    out (""27";"27"<"155"11h");         (* Reset des Druckers *)
+    out (""27"(B");                     (* ACSII-Zeichensatz  *)
+    out (""155"1;4 D");                 (* Char.Satz 1 = PICA *)
+ 
+. x start : param1
+. y start : param2
+. 
+  open page :
+    x start := x step conversion (0.4064 );
+    y start := y step conversion (0.508  + 0.6345);
+    out (""13"");
+ 
+END PROC open; 
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+  OTHERWISE : put (param1)
+END SELECT; 
+ 
+. 
+  close document :
+   (*  out(""155"0q")    von Standard-Cassette Papier holen *)
+ 
+(*. remaining y steps : param1*)
+.
+  close page :
+    out (""13""12"");
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    INT VAR new from, new to;
+    IF is underline
+       THEN IF pos (string, " ", from, from) <> 0
+               THEN out ("_");
+                    new from := from + 1;
+               ELSE new from := from;
+            FI;
+            IF from < to AND pos (string, " ", to, to) <> 0
+               THEN new to := to - 1;
+               ELSE new to := to;
+            FI;
+            out subtext (string, new from, new to);
+            IF to <> new to THEN out ("_") FI;
+       ELSE out subtext (string, from, to)
+    FI;
+ 
+.
+  write cmd :
+    out subtext (string, from, to)
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    out (""13"")
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF   x steps > 0
+         THEN out (csi); out (text (  x steps)); out ("a")
+    ELIF x steps < 0
+         THEN out (csi); out (text (- x steps)); out ("j")
+    FI;
+    IF   y steps > 0
+         THEN out (csi); out (text (  y steps)); out ("e")
+    ELIF y steps < 0
+         THEN out (csi); out (text (- y steps)); out ("k")
+    FI;
+ 
+. 
+  draw :
+    stop
+ 
+ 
+. modification : param1
+.
+  on :
+    IF on string (modification) <> ""
+       THEN out (on string (modification));
+            IF modification = underline THEN is underline := TRUE FI; 
+       ELSE stop
+    FI
+ 
+.
+  off :
+    IF off string (modification) <> ""
+       THEN out (off string (modification));
+            IF modification = underline THEN is underline := FALSE FI; 
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    out (font string (font nr));
+ 
+END PROC execute;
+ 
+ 
+END PACKET canon lbp 8 printer;
+ 
+ 
+ 
+#page# 
+(******************************************************************)
+(***                                                            ***)
+(***   Generierung des Printers                                 ***)
+(***                                                            ***)
+(******************************************************************)
+ 
+LET printer name = "printer.canon.lbp-8";
+ 
+TEXT VAR fonttab name := "fonttab.canon.lbp-8";
+ 
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+ 
+INT VAR pr channel;
+TEXT VAR buffer;
+ 
+command dialogue (TRUE);
+IF NOT multi user 
+  THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+FI; 
+ask for print channel;
+ask for font cartridge;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+.
+  ask for print channel :
+    line;
+    put ("gib Druckerkanal:");
+    get (pr channel);
+    do ("serverchannel(" + text (pr channel) + ")" ) ;
+    line;
+. 
+  ask for font cartridge :
+.
+  load font table :
+    IF NOT exists (fonttab name)
+       THEN command dialogue (TRUE); 
+            REP line (2); 
+                putline ("Bitte Archiv mit der Fonttabelle """ +
+                          fonttab name + """ einlegen!");
+                line;
+            UNTIL yes ("Archiv eingelegt") PER;
+            reserve archive;
+            fetch (fonttab name, archive);
+            release (archive);
+    FI;
+    font table (fonttab name);
+    IF multi user
+       THEN command dialogue (FALSE); 
+            do ("save(""" + font tab name + """,task(""configurator""))") 
+    FI;
+    forget (fonttab name, quiet);
+ 
+    . reserve archive :
+        INT VAR p1, p2;
+        archive (" "31" ");
+        disable stop;
+        list (archive);
+        IF is error
+           THEN buffer := errormessage;
+                p1 := pos (buffer, """", 1 ) + 1;
+                p2 := pos (buffer, """", p1) - 1;
+                IF p1 > 0 AND p2 > 0
+                   THEN clear error;
+                        buffer := subtext (buffer, p1, p2);
+                        archive (buffer);
+                FI;
+        FI;
+        enable stop;
+ 
+. generate printer spool :
+    eumel must advertise;
+    cursor (1, 12);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (4);
+    putline ("Generierung beendet, weiter mit 'SV'");
+    generate printer server;
+    do (buffer);
+ 
+. generate printer server :
+    buffer :=  "break (quiet);";
+    buffer CAT "spool manager (PROC printer);";
+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+    buffer CAT "PROC printer:";
+    buffer CAT "  disable stop;";
+    buffer CAT "  continue (server channel);";
+    buffer CAT "  check error (error message);";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  REP forget (ds);";
+    buffer CAT "      execute print;";
+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";
+    buffer CAT "  PER;";
+    buffer CAT "END PROC printer;";
+    buffer CAT "PROC execute print:";
+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";
+    buffer CAT "  enable stop;";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  call (father, fetch code, ds, reply);";
+    buffer CAT "  IF reply = ack CAND type (ds) = file type";
+    buffer CAT "     THEN file := sequential file (input, ds);";
+    buffer CAT "          print (file,";
+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";
+    buffer CAT "            PROC (INT CONST, INT CONST) close,";
+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC execute print;"; 
+    buffer CAT "PROC check error(TEXT CONST message):";
+    buffer CAT "  IF is error";
+    buffer CAT "     THEN clear error; rename myself (message);";
+    buffer CAT "          IF is error THEN end(myself) FI;"; 
+    buffer CAT "          pause (9000); end(myself);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC check error;"; 
+
diff --git a/system/printer-laser/4/src/printer.epson.sq b/system/printer-laser/4/src/printer.epson.sq
new file mode 100644
index 0000000..63e474f
--- /dev/null
+++ b/system/printer-laser/4/src/printer.epson.sq
@@ -0,0 +1,585 @@
+PACKET epson sq printer
+ 
+(**************************************************************************)
+(*                                                Stand   : 03.12.86      *)
+(*   EPSON  SQ-2500                               Version : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(**************************************************************************)
+ 
+       DEFINES open,
+               close,
+               execute,
+ 
+               paper size,
+           (*  paper feed,    *)  (* <-- nicht getestet *)
+               std typeface,
+               std quality:
+ 
+LET
+(*  underline           =  1,
+    bold                =  2,
+    italics             =  4,
+    reverse             =  8, *)
+ 
+    underline linetype  =  1,
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,           cmd draft      =  1,
+    c write cmd         =  2,           cmd nlq        =  2,
+    c carriage return   =  3,           cmd roman      =  3,
+    c move              =  4,           cmd sansserif  =  4,
+    c draw              =  5,           cmd courier    =  5,
+    c on                =  6,           cmd prestige   =  6,
+    c off               =  7,           cmd script     =  7,
+    c type              =  8;
+ 
+INT VAR font nr, x rest, high, low, font bits, modification bits, blank pitch,
+        factor 1, factor 2, steps;
+BOOL VAR is nlq, sheet feed;
+REAL VAR x size, y size;
+TEXT VAR std quality name, std typeface name, buffer, symbol, font text;
+THESAURUS VAR commands := empty thesaurus;
+
+insert (commands, "draft");
+insert (commands, "nlq");
+insert (commands, "roman");
+insert (commands, "sansserif");
+insert (commands, "courier");
+insert (commands, "prestige");
+insert (commands, "script");
+
+. is prop        : bit (font bits, 1)
+. is double      : bit (font bits, 5)
+.;
+ 
+(*********************************************************************)
+ 
+paper size  (13.6 * 2.54, 12.0 * 2.54);
+paper size  ( 8.0 * 2.54, 12.0 * 2.54);
+paper feed ("tractor");
+std typeface ("roman");
+std quality ("draft");
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+ 
+PROC paper feed (TEXT CONST paper) :
+ 
+  IF   pos (paper, "sheet") <> 0
+       THEN sheet feed := TRUE;
+  ELIF pos (paper, "tractor") <> 0
+       THEN sheet feed := FALSE;
+       ELSE errorstop ("unzulaessige Papiereinfuehrung")
+  FI;
+ 
+END PROC paper feed;
+ 
+TEXT PROC paper feed :
+ 
+  IF sheet feed
+     THEN "sheet"
+     ELSE "tractor"
+  FI
+
+END PROC paper feed;
+ 
+ 
+PROC std typeface (TEXT CONST typeface) :
+ 
+  buffer := typeface;
+  changeall (buffer, " ", "");
+  IF link (commands, buffer) >= cmd roman
+     THEN std typeface name := buffer
+     ELSE errorstop ("unzulaessige Schriftart")
+  FI;
+ 
+END PROC std typeface;
+ 
+TEXT PROC std typeface : std typeface name END PROC std typeface;
+ 
+ 
+PROC std quality (TEXT CONST quality) :
+ 
+  IF quality = "nlq" OR quality = "draft"
+     THEN std quality name := quality;
+     ELSE errorstop ("unzulaessige Betriebsart")
+  FI;
+ 
+END PROC std quality;
+ 
+TEXT PROC std quality : std quality name END PROC std quality;
+ 
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    x steps := x step conversion ( x size );
+    y steps := y step conversion ( y size );
+    y steps := (y steps DIV 30) * 30;
+    modification bits := 0;
+    out (""24""27""64"");                  (* Reset des Druckers            *)
+    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                *)
+    out (""27"x"0"");                      (* Entwurfsqualität              *) 
+    out (""27"R"0"");                      (* Amerikanischer Zeichensatz    *)
+    out (""27"t"1""27"6");                 (* Erweiterung des Zeichensatzes *)
+    IF sheet feed THEN out (""27""25"4") FI; (* Sheetmode ein               *)
+    IF   pos (material, "roman") <> 0
+         THEN out (""27"k"0"")
+    ELIF pos (material, "sansserif") <> 0
+         THEN out (""27"k"1"")
+    ELIF pos (material, "courier") <> 0
+         THEN out (""27"k"2"")
+    ELIF pos (material, "prestige") <> 0
+         THEN out (""27"k"3"")
+    ELIF pos (material, "script") <> 0
+         THEN out (""27"k"4"")
+         ELSE out (""27"k" + code (link (commands, std typeface) - cmd roman));
+    FI;
+    IF   pos (material, "nlq") <> 0 
+         THEN is nlq := TRUE;
+    ELIF pos (material, "draft") <> 0 
+         THEN is nlq := FALSE;
+         ELSE is nlq := std quality = "nlq"
+    FI;
+ 
+ 
+. x start : param1
+. y start : param2
+. 
+  open page :
+    x start := 0;
+    IF sheet feed
+       THEN y start := y step conversion (8.466667e-1)    (* 2/6 Inch *)
+       ELSE y start := 0;
+    FI;
+    x rest  := 0;
+    out (""13"");
+ 
+END PROC open;
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+END SELECT; 
+ 
+. 
+  close document :
+ 
+ 
+. remaining y steps : param1
+.
+  close page :
+    IF   sheet feed
+         THEN out (""27""25"R")
+    ELIF remaining y steps > 0
+         THEN out (""12"")
+    FI;
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    out subtext (string, from, to)
+ 
+.
+  write cmd :
+    buffer := subtext (string, from, to);
+    scan (buffer);
+    next symbol (symbol);
+    SELECT link (commands, symbol) OF
+      CASE cmd draft     : IF     is nlq THEN switch to draft FI; is nlq := FALSE;
+      CASE cmd nlq       : IF NOT is nlq THEN switch to nlq   FI; is nlq := TRUE;
+      CASE cmd roman     : out (""27"k"0"")
+      CASE cmd sansserif : out (""27"k"1"")
+      CASE cmd courier   : out (""27"k"2"")
+      CASE cmd prestige  : out (""27"k"3"")
+      CASE cmd script    : out (""27"k"4"")
+      OTHERWISE : out (buffer);
+    END SELECT;
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    x rest := 0;
+    out (""13"");
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF x steps < 0 OR y steps < 0
+       THEN stop
+       ELSE IF x steps > 0 THEN x move FI;
+            IF y steps > 0 THEN y move FI;
+    FI;
+ 
+    . x move :
+        x rest INCR x steps; 
+        IF not is underline
+           THEN simple x move
+           ELSE underline x move
+        FI;
+
+        . not is underline :
+            NOT bit (modification bits, 7)
+ 
+        . simple x move :
+            high   := x rest DIV factor 1;
+            x rest := x rest MOD factor 1;
+            out (""27"\");
+            out (code (high MOD 256));
+            out (code (high DIV 256));
+ 
+        . underline x move :
+            high   := x rest DIV factor 2;
+            x rest := x rest MOD factor 2;
+            IF high < blank pitch
+               THEN stop
+               ELSE low  := high MOD 127;
+                    high := high DIV 127;
+                    IF low >= blank pitch
+                       THEN low  DECR blankpitch;
+                       ELSE high DECR 1;
+                            low  DECR (blankpitch - 127);
+                    FI;
+                    IF high > 0 
+                       THEN out (""27" ");
+                            out (code (127 - blankpitch));
+                            high TIMESOUT " ";
+                    FI;
+                    out (""27" ");
+                    out (code (low)); 
+                    out (" "27" "0"");
+            FI;
+ 
+     . y move :
+         low  := y steps MOD 255;
+         high := y steps DIV 255;
+         IF high > 0 THEN high TIMESOUT (""27"J"255"")    FI;
+         IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
+. 
+  draw :
+    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype
+         THEN stop
+    ELIF x steps > 0
+         THEN x draw
+    FI;
+ 
+    . x draw :
+        x rest INCR x steps;
+        steps  := x rest DIV 6;
+        x rest := x rest MOD 6;
+        IF steps > 0
+           THEN low  := steps MOD 256;
+                high := steps DIV 256;
+                out (""27"L");
+                out (code (low));
+                out (code (high));
+                steps TIMESOUT ""1"";
+        FI;
+ 
+ 
+. modification : param1
+.
+  on :
+    buffer := on string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits OR code (buffer);
+            switch to font;
+       ELSE stop
+    FI
+ 
+.
+  off :
+    buffer := off string (modification);
+    IF buffer <> ""
+       THEN modification bits := modification bits XOR code (buffer);
+            switch to font;
+       ELSE stop
+    FI
+ 
+.
+  type :
+    font nr   := param1;
+    buffer    := font string (font nr);
+    font bits := code (buffer SUB 1);
+    font text := subtext (buffer, 2);
+    IF is prop
+       THEN factor 1 := 4;
+            factor 2 := 4;
+       ELSE factor 1 := 6;
+            factor 2 := 6;
+    FI;
+    IF is double THEN factor 2 INCR factor 2 FI;
+    blank pitch := char pitch (font nr, " ") DIV factor 2; 
+    switch to font;
+    IF is nlq THEN switch to nlq FI;
+ 
+END PROC execute;
+ 
+ 
+PROC switch to font :
+ 
+  out (""27"!");
+  out (code (font bits OR modification bits));
+  out (font text);
+ 
+END PROC switch to font;
+ 
+ 
+PROC switch to nlq :
+ 
+  IF NOT is prop
+     THEN factor 1   := 4;
+          factor 2   := (4 * factor 2) DIV 6;
+          blankpitch := (6 * blankpitch) DIV 4;
+          out (""27"x"1"");
+     ELSE out (""27"x"0"");
+  FI;
+ 
+END PROC switch to nlq;
+ 
+ 
+PROC switch to draft :
+ 
+  IF NOT is prop
+     THEN factor 1   := 6;
+          factor 2   := (6 * factor 2) DIV 4;
+          blankpitch := (4 * blankpitch) DIV 6;
+          out (""27"x"0"");
+  FI;
+ 
+END PROC switch to draft;
+
+ 
+END PACKET epson sq printer;
+ 
+ 
+ 
+#page# 
+(******************************************************************)
+(***                                                            ***)
+(***   Generierung des Printers                                 ***)
+(***                                                            ***)
+(******************************************************************)
+ 
+LET printer name = "printer.epson.sq",
+    up           = ""3""13""5"";
+ 
+TEXT VAR fonttab name := "fonttab.epson.sq";
+ 
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+ 
+INT VAR pr channel;
+TEXT VAR buffer;
+ 
+command dialogue (TRUE);
+IF NOT multi user 
+  THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+FI; 
+ask for print channel;
+ask for paper format;
+ask for typeface;
+ask for print quality;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+.
+  ask for print channel : 
+    line;
+    put ("gib Druckerkanal:");
+    get (pr channel);
+    do ("serverchannel(" + text (pr channel) + ")" ) ;
+    line;
+. 
+  ask for paper format :
+    SELECT paper format OF
+      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)
+      CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54)
+      CASE 3 : papersize (21.0, 29.7)
+    END SELECT
+
+    . paper format :
+        line;
+        REP out (up);
+            IF yes ("Papierformat : endlos, 8 Zoll breit")
+               THEN LEAVE paper format WITH 1 FI;
+            out (up);
+            IF yes ("Papierformat : endlos, 13.6 Zoll breit")
+               THEN LEAVE paper format WITH 2 FI;
+            out (up);
+            IF yes ("Papierformat : DINA 4")
+               THEN LEAVE paper format WITH 3 FI;
+        PER;
+        0
+.
+  ask for typeface :
+    line;
+    std typeface (typeface)
+ 
+    . typeface :
+        REP out (up);
+            IF yes ("standardmäßige Schriftart : roman")
+               THEN LEAVE typeface WITH "roman" FI;
+            out (up);
+            IF yes ("standardmäßige Schriftart : sansserif")
+               THEN LEAVE typeface WITH "sansserif" FI;
+            out (up);
+            IF yes ("standardmäßige Schriftart : courier")
+               THEN LEAVE typeface WITH "courier" FI;
+            out (up);
+            IF yes ("standardmäßige Schriftart : prestige")
+               THEN LEAVE typeface WITH "prestige" FI;
+            out (up);
+            IF yes ("standardmäßige Schriftart : script")
+               THEN LEAVE typeface WITH "script" FI;
+        PER;
+        ""
+.
+  ask for print quality :
+    line;
+    std quality (quality);
+ 
+    . quality :
+        REP out (up);
+            IF yes ("standardmäßige Druckqualität : draft quality")
+               THEN LEAVE quality WITH "draft" FI;
+            out (up);
+            IF yes ("standardmäßige Druckqualität : near letter quality")
+               THEN LEAVE quality WITH "nlq" FI;
+        PER;
+        ""
+.
+  load font table :
+    IF NOT exists (fonttab name)
+       THEN command dialogue (TRUE); 
+            REP line (2); 
+                putline ("Bitte Archiv mit der Fonttabelle """ +
+                          fonttab name + """ einlegen!");
+                line;
+            UNTIL yes ("Archiv eingelegt") PER;
+            reserve archive;
+            fetch (fonttab name, archive);
+            release (archive);
+    FI;
+    font table (fonttab name);
+    IF multi user
+       THEN command dialogue (FALSE); 
+            do ("save(""" + font tab name + """,task(""configurator""))") 
+    FI;
+    forget (fonttab name, quiet);
+ 
+    . reserve archive :
+        INT VAR p1, p2;
+        archive (" "31" ");
+        disable stop;
+        list (archive);
+        IF is error
+           THEN buffer := errormessage;
+                p1 := pos (buffer, """", 1 ) + 1;
+                p2 := pos (buffer, """", p1) - 1;
+                IF p1 > 0 AND p2 > 0
+                   THEN clear error;
+                        buffer := subtext (buffer, p1, p2);
+                        archive (buffer);
+                FI;
+        FI;
+        enable stop;
+ 
+. generate printer spool :
+    eumel must advertise;
+    cursor (1, 12);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (4);
+    putline ("Generierung beendet, weiter mit 'SV'");
+    generate printer server;
+    do (buffer);
+ 
+. generate printer server :
+    buffer :=  "break (quiet);";
+    buffer CAT "spool manager (PROC printer);";
+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+    buffer CAT "PROC printer:";
+    buffer CAT "  disable stop;";
+    buffer CAT "  continue (server channel);";
+    buffer CAT "  check error (error message);";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  REP forget (ds);";
+    buffer CAT "      execute print;";
+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";
+    buffer CAT "  PER;";
+    buffer CAT "END PROC printer;";
+    buffer CAT "PROC execute print:";
+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";
+    buffer CAT "  enable stop;";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  call (father, fetch code, ds, reply);";
+    buffer CAT "  IF reply = ack CAND type (ds) = file type";
+    buffer CAT "     THEN file := sequential file (input, ds);";
+    buffer CAT "          print (file,";
+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";
+    buffer CAT "            PROC (INT CONST, INT CONST) close,";
+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC execute print;"; 
+    buffer CAT "PROC check error(TEXT CONST message):";
+    buffer CAT "  IF is error";
+    buffer CAT "     THEN clear error; rename myself (message);";
+    buffer CAT "          IF is error THEN end(myself) FI;"; 
+    buffer CAT "          pause (9000); end(myself);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC check error;"; 
+
diff --git a/system/printer-laser/4/src/printer.hp.laserjet b/system/printer-laser/4/src/printer.hp.laserjet
new file mode 100644
index 0000000..152ee8e
--- /dev/null
+++ b/system/printer-laser/4/src/printer.hp.laserjet
@@ -0,0 +1,417 @@
+PACKET hp laserjet printer
+ 
+(**************************************************************************)
+(*                                                Stand   : 03.02.88      *)
+(*  HP 2686A LaserJet / LaserJet+                 Verison : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(**************************************************************************)
+ 
+       DEFINES open,
+               close,
+               execute,
+ 
+               paper size,
+               printer type :
+ 
+LET
+(*  underline           =  1,
+    bold                =  2,
+    italics             =  4,
+    reverse             =  8,
+ 
+    underline linetype  =  1, *)
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8;
+ 
+INT VAR abs x pos
+REAL VAR x size, y size;
+BOOL VAR is laser jet plus, is landscape;
+
+(*********************************************************************)
+ 
+paper size (21.0, 29.7);
+printer type ("LaserJet");
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+PROC printer type (TEXT CONST type) :
+
+  is laser jet plus := pos (type, "+") <> 0
+
+END PROC printer type;
+ 
+TEXT PROC printer type :
+
+  IF is laser jet plus
+     THEN "LaserJet+"
+     ELSE "LaserJet"
+  FI
+
+END PROC printer type;
+
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    out (""27"E");      (* Reset des Druckers *)
+    out (""27"&s1C");   (* 'end of line wrap' aus *)
+    out (""27"&l0L");   (* 'perforation skip' aus *)
+    out (""27"&l1X");   (* eine Kopie             *)
+    out (""27"&l1H");   (* upper tray             *)
+    IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0
+       THEN is landscape := TRUE;
+            x steps      := x step conversion ( y size );
+            y steps      := y step conversion ( x size );
+            out (""27"&l1O");
+       ELSE is landscape := FALSE;
+            x steps      := x step conversion ( x size );
+            y steps      := y step conversion ( y size );
+    FI;
+ 
+. x start : param1
+. y start : param2
+. 
+  open page :
+    IF is landscape
+       THEN x start  := x step conversion (0.508);     (* 0.200*2.54 *)
+            y start  := y step conversion (1.693333);  (* 0.500*2.54 + 2.54/6.0 *)
+       ELSE x start  := x step conversion (0.39878);   (* 0.157*2.54 *)
+            y start  := y step conversion (1.693333);  (* 0.500*2.54 + 2.54/6.0 *)
+    FI;
+    IF   pos (material, "lower tray") > 0 COR pos (material, "lowertray") > 0
+         THEN out (""27"&l4H");
+    ELIF pos (material, "tray") > 0 COR pos (material, "upper tray") > 0 COR pos (material, "uppertray") > 0
+         THEN out (""27"&l1H");
+    ELIF pos (material, "manual") > 0
+         THEN out (""27"&l2H");
+    ELIF pos (material, "envelope") > 0
+         THEN out (""27"&l3H");
+    FI;
+    IF material contains a number
+       THEN out (""27"&l" + text (number) + "X");
+    FI;
+    out (""13"");
+ 
+    . material contains a number :
+        INT VAR number := pos (material, "0", "9", 1);
+        IF number = 0
+           THEN FALSE
+           ELSE number := max (1, int (subtext (material, number, number + 1)));
+                TRUE
+        FI
+ 
+END PROC open; 
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+  OTHERWISE : put (param1)
+END SELECT; 
+ 
+. 
+  close document :
+ 
+ 
+(*. remaining y steps : param1*)
+.
+  close page :
+    out (""12"") 
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    out subtext (string, from, to)
+ 
+.
+  write cmd :
+    out subtext (string, from, to)
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    out (""13"")
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF   x steps <> 0
+         THEN x move
+    ELIF y steps > 0
+         THEN out (""27"&a+" + text (y steps) + "V");
+    ELIF y steps < 0
+         THEN out (""27"&a"  + text (y steps) + "V");
+    FI;
+ 
+    . x move :
+        IF is laser jet plus
+           THEN laser jet plus x move
+           ELSE laser jet x move
+        FI;
+
+    . laser jet plus x move :
+        IF x steps >= 0
+           THEN out (""27"*p+" + text (x steps) + "X");
+           ELSE out (""27"*p"  + text (x steps) + "X");
+        FI;
+
+    . laser jet x move :
+        abs x pos := x pos;
+        IF abs x pos >= 0
+           THEN out (""27"&a");
+                out (text ((abs x pos DIV 5) * 12 + ((abs x pos MOD 5) * 12 + 4) DIV 5));
+                out ("H");
+           ELSE stop
+        FI;
+
+. 
+  draw :
+    stop
+ 
+ 
+. modification : param1
+.
+  on :
+    IF on string (modification) <> ""
+       THEN out (on string (modification))
+       ELSE stop
+    FI
+ 
+.
+  off :
+    IF off string (modification) <> ""
+       THEN out (off string (modification))
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    out (font string (font nr));
+ 
+END PROC execute;
+ 
+ 
+END PACKET hp laserjet printer;
+ 
+ 
+#page# 
+(******************************************************************)
+(***                                                            ***)
+(***   Generierung des Printers                                 ***)
+(***                                                            ***)
+(******************************************************************)
+ 
+LET printer name = "printer.hp.laserjet",
+    up           = ""3""13""5"";
+ 
+TEXT VAR fonttab name := "fonttab.hp.laserjet";
+ 
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+ 
+INT VAR pr channel;
+TEXT VAR buffer;
+ 
+command dialogue (TRUE);
+IF NOT multi user 
+  THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+FI; 
+ask for print channel;
+ask for printer type;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+.
+  ask for print channel :
+    line;
+    put ("gib Druckerkanal:");
+    get (pr channel);
+    do ("serverchannel(" + text (pr channel) + ")" ) ;
+    line;
+. 
+  ask for printer type :
+    printer type (laser jet);
+ 
+    . laser jet :
+        line;
+        REP out (up); 
+            IF yes ("Druckertyp : HP LaserJet")
+               THEN LEAVE laser jet WITH "LaserJet" FI;
+            out (up);
+            IF yes ("Druckertyp : HP LaserJet+")
+               THEN LEAVE laser jet WITH "LaserJet+" FI;
+        PER;
+        ""
+.
+  load font table :
+    line (2);
+    write (""13""4"");
+    putline ("Die Fonttabelle """ + fonttab name +
+             """ enthält die Schrifttypen der");
+    putline ("Font Cartriges:");
+    putline ("                  92286A  Courier 1");
+    putline ("                  92286C  International 1");
+    putline ("                  92286D  Prestige Elite");
+    putline ("                  92286E  Letter Gothic");
+    putline ("                  92286F  TMS Proportional 2");
+    putline ("                  92286L  Courier P&L");
+    putline ("                  92286M  Prestige Elite P&L");
+    putline ("                  92286N  Letter Gothic P&L");
+    putline ("                  92286P  TMS RMN P&L");
+    putline ("                  92286Q  Memo 1");
+    line;
+    putline ("Für ein korrektes Druckbild dürfen immer nur die Schrifttypen angesprochen");
+    putline ("werden, deren Cartrige eingeschoben ist!");
+    IF printer type = "LaserJet"
+       THEN line;
+            putline ("ELAN-Listings können nur gedruckt werden, wenn ein Cartrige mit dem");
+            putline ("Schrifttyp 'LINE PRINTER' eingeschoben ist!");
+    FI;
+    line (2);
+    putline ("Weiter nach Eingabe einer Taste");
+    pause;
+    IF NOT exists (fonttab name)
+       THEN command dialogue (TRUE); 
+            REP line (2); 
+                putline ("Bitte Archiv mit der Fonttabelle """ +
+                          fonttab name + """ einlegen!");
+                line;
+            UNTIL yes ("Archiv eingelegt") PER;
+            reserve archive;
+            fetch (fonttab name, archive);
+            release (archive);
+    FI;
+    font table (fonttab name);
+    IF multi user
+       THEN command dialogue (FALSE); 
+            do ("save(""" + font tab name + """,task(""configurator""))") 
+    FI;
+    forget (fonttab name, quiet);
+ 
+    . reserve archive :
+        INT VAR p1, p2;
+        archive (" "31" ");
+        disable stop;
+        list (archive);
+        IF is error
+           THEN buffer := errormessage;
+                p1 := pos (buffer, """", 1 ) + 1;
+                p2 := pos (buffer, """", p1) - 1;
+                IF p1 > 0 AND p2 > 0
+                   THEN clear error;
+                        buffer := subtext (buffer, p1, p2);
+                        archive (buffer);
+                FI;
+        FI;
+        enable stop;
+ 
+. generate printer spool :
+    eumel must advertise;
+    cursor (1, 12);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (4);
+    putline ("Generierung beendet, weiter mit 'SV'");
+    generate printer server;
+    do (buffer);
+ 
+. generate printer server :
+    buffer :=  "break (quiet);";
+    buffer CAT "spool manager (PROC printer);";
+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+    buffer CAT "PROC printer:";
+    buffer CAT "  disable stop;";
+    buffer CAT "  continue (server channel);";
+    buffer CAT "  check error (error message);";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  REP forget (ds);";
+    buffer CAT "      execute print;";
+    buffer CAT "      IF is error AND online";
+    buffer CAT "         THEN out (""""27""(8U""27""(s0p10h12v0s0b3T"");";
+    buffer CAT "              put error; clear error; out (""""12"""");";
+    buffer CAT "      FI;";
+    buffer CAT "  PER;";
+    buffer CAT "END PROC printer;";
+    buffer CAT "PROC execute print:";
+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";
+    buffer CAT "  enable stop;";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  call (father, fetch code, ds, reply);";
+    buffer CAT "  IF reply = ack CAND type (ds) = file type";
+    buffer CAT "     THEN file := sequential file (input, ds);";
+    buffer CAT "          print (file,";
+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";
+    buffer CAT "            PROC (INT CONST, INT CONST) close,";
+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC execute print;"; 
+    buffer CAT "PROC check error(TEXT CONST message):";
+    buffer CAT "  IF is error";
+    buffer CAT "     THEN clear error; rename myself (message);";
+    buffer CAT "          IF is error THEN end(myself) FI;"; 
+    buffer CAT "          pause (9000); end(myself);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC check error;"; 
+
diff --git a/system/printer-laser/4/src/printer.kyocera.f-1010 b/system/printer-laser/4/src/printer.kyocera.f-1010
new file mode 100644
index 0000000..a46f7b3
--- /dev/null
+++ b/system/printer-laser/4/src/printer.kyocera.f-1010
@@ -0,0 +1,373 @@
+PACKET kyocera f 1010 printer
+ 
+(**************************************************************************)
+(*                                                Stand   : 03.12.86      *)
+(*  KYOCERA   F - 1010                            Verison : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(**************************************************************************)
+
+(**************************************************************************)
+(*  Hinweis : Die 'time-out' Zeit, nach der der Eingabepuffer ausgegeben  *)
+(*            wird, wenn keine Eingabe mehr erfolgt, sollte moeglichst    *)
+(*            gross gewaehlt werden,                                      *)
+(*            z.B.  mit   FRPO H9, 60;   wird sie auf 5 Min. gesetzt      *)
+(**************************************************************************)
+
+ 
+       DEFINES open,
+               close,
+               execute,
+ 
+               paper size :
+ 
+LET underline           =  1,
+(*  bold                =  2,
+    italics             =  4,
+    reverse             =  8,
+ 
+    underline linetype  =  1, *)
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8;
+ 
+INT VAR blankpitch, high, low;
+REAL VAR x size, y size;
+BOOL VAR is landscape, is underline;
+
+(*********************************************************************)
+ 
+paper size (21.0, 29.7);
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    out ("!"82"! RES; UNIT D; EXIT;");         (* Reset des Druckers *)
+    IF pos (material, "landscape") > 0 OR pos (material, "quer") > 0
+       THEN is landscape := TRUE;
+            x steps      := x step conversion ( y size );
+            y steps      := y step conversion ( x size );
+            out (""27"&l1O");
+       ELSE is landscape := FALSE;
+            x steps      := x step conversion ( x size );
+            y steps      := y step conversion ( y size );
+    FI;
+    is underline := FALSE;
+    IF y size < 29.7 OR x size < 21.0
+       THEN out ("!"82"! SLM ");
+            IF is landscape
+               THEN out (text (x step conversion (29.7 - y size)));
+                    out ("; STM ");
+                    out (text (y step conversion ((21.0 - x size) * 0.5)));
+               ELSE out (text (x step conversion ((21.0 - x size) * 0.5)));
+            FI;
+            out ("; EXIT;");
+     FI;
+
+. x start : param1
+. y start : param2
+. 
+  open page :
+    out ("!"82"! MZP 0, 0; EXIT;");       (* Positionierung zum Nullpunkt *)
+    IF is landscape
+       THEN x start  := x step conversion (0.19);
+            y start  := y step conversion (0.70);
+       ELSE x start  := x step conversion (0.56);
+            y start  := y step conversion (0.60);
+    FI;
+    IF   pos (material, "tray") > 0
+         THEN out (""27"&l1H");
+    ELIF pos (material, "manual") > 0
+         THEN out (""27"&l2H");
+    FI;
+    out (""13"");
+ 
+END PROC open; 
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+  OTHERWISE : put (param1)
+END SELECT; 
+ 
+. 
+  close document :
+ 
+ 
+(*. remaining y steps : param1*)
+.
+  close page :
+    out (""12"");
+
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    out subtext (string, from, to)
+ 
+.
+  write cmd :
+    out subtext (string, from, to)
+ 
+ 
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    out (""13"")
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF   x steps > 0
+         THEN IF is underline
+                 THEN underline x move
+                 ELSE out (""27"*p+" + text (x steps) + "X");
+              FI;
+    ELIF x steps < 0
+         THEN out (""27"*p"  + text (x steps) + "X");
+    ELIF y steps > 0
+         THEN out (""27"*p+" + text (y steps) + "Y");
+    ELIF y steps < 0
+         THEN out (""27"*p"  + text (y steps) + "Y");
+    FI;
+
+    . underline x move :
+        high := x steps DIV blankpitch;
+        low  := x steps MOD blankpitch;
+        IF high > 0 THEN high TIMESOUT " " FI;
+        IF low  > 0 THEN out (" "27"*p" + text (low - blank pitch) + "X") FI;
+ 
+. 
+  draw :
+    stop
+ 
+ 
+. modification : param1
+.
+  on :
+    IF on string (modification) <> ""
+       THEN out (on string (modification));
+            IF modification = underline THEN is underline := TRUE FI;
+       ELSE stop
+    FI
+ 
+.
+  off :
+    IF off string (modification) <> ""
+       THEN out (off string (modification));
+            IF modification = underline THEN is underline := FALSE FI;
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    out (font string (font nr));
+    blankpitch := char pitch (font nr, " ");
+ 
+END PROC execute;
+ 
+ 
+END PACKET kyocera f 1010 printer;
+ 
+ 
+ 
+#page# 
+(******************************************************************)
+(***                                                            ***)
+(***   Generierung des Printers                                 ***)
+(***                                                            ***)
+(******************************************************************)
+ 
+LET printer name = "printer.kyocera.f-1010";
+ 
+TEXT VAR fonttab name := "fonttab.kyocera.f-1010";
+ 
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+ 
+INT VAR pr channel;
+TEXT VAR buffer;
+ 
+command dialogue (TRUE);
+IF NOT multi user 
+  THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+FI; 
+ask for print channel;
+dynamic font hint;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+check on;
+command dialogue (TRUE);
+.
+  ask for print channel : 
+    line;
+    put ("gib Druckerkanal:");
+    get (pr channel);
+    do ("serverchannel(" + text (pr channel) + ")" ) ;
+    line;
+.
+  dynamic font hint :
+    line (3);
+    putline (""4"Hinweis zur Benutzung der dynamischen Schrifttypen:");
+    line;
+    putline ("    In der Fonttabelle """ + fonttab name + """ sind einige dynamische");
+    putline ("    Schrifttypen angepaßt. Diese müssen nach jedem Einschalten des");
+    putline ("    Druckers neu generiert werden.");
+    putline ("    Zur Generierung dieser Schrifttypen befinden sich auf dem Standard-");
+    putline ("    archive die folgenden Dateien:");
+    line;
+    putline ("               ""genfont.kyocera.f-1010.dynamic1""");
+    putline ("               ""genfont.kyocera.f-1010.dynamic2""");
+    line;
+    putline ("    Nach Einschalten des Druckers müssen diese Dateien zuerst ausgedruckt");
+    putline ("    werden.");
+    putline ("    Die Generierung benötigt pro Schriftart etwa 15 Minuten.");
+    line (2);
+    putline ("Weiter nach Eingabe einer Taste");
+    pause;
+.
+  load font table :
+    IF NOT exists (fonttab name)
+       THEN REP line (2); 
+                putline ("Bitte Archiv mit der Fonttabelle """ +
+                          fonttab name + """ einlegen!");
+                line;
+            UNTIL yes ("Archiv eingelegt") PER;
+            reserve archive;
+            fetch (fonttab name, archive);
+            release (archive);
+    FI;
+    font table (fonttab name);
+    IF multi user
+       THEN command dialogue (FALSE);
+            do ("save(""" + font tab name + """,task(""configurator""))")
+    FI;
+    forget (fonttab name, quiet);
+ 
+    . reserve archive :
+        INT VAR p1, p2;
+        archive (" "31" ");
+        disable stop;
+        list (archive);
+        IF is error
+           THEN buffer := errormessage;
+                p1 := pos (buffer, """", 1 ) + 1;
+                p2 := pos (buffer, """", p1) - 1;
+                IF p1 > 0 AND p2 > 0
+                   THEN clear error;
+                        buffer := subtext (buffer, p1, p2);
+                        archive (buffer);
+                FI;
+        FI;
+        enable stop;
+ 
+. generate printer spool :
+    eumel must advertise;
+    cursor (1, 12);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (4);
+    putline ("Generierung beendet, weiter mit 'SV'");
+    generate printer server;
+    do (buffer);
+ 
+. generate printer server :
+    buffer :=  "break (quiet);";
+    buffer CAT "spool manager (PROC printer);";
+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+    buffer CAT "PROC printer:";
+    buffer CAT "  disable stop;";
+    buffer CAT "  continue (server channel);";
+    buffer CAT "  check error (error message);";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  REP forget (ds);";
+    buffer CAT "      execute print;";
+    buffer CAT "      IF is error AND online";
+    buffer CAT "         THEN out (""""27""(8U""27""(s0p10h12v0s0b3T"");";
+    buffer CAT "              put error; clear error; out (""""12"""");";
+    buffer CAT "      FI;";
+    buffer CAT "  PER;";
+    buffer CAT "END PROC printer;";
+    buffer CAT "PROC execute print:";
+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";
+    buffer CAT "  enable stop;";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  call (father, fetch code, ds, reply);";
+    buffer CAT "  IF reply = ack CAND type (ds) = file type";
+    buffer CAT "     THEN file := sequential file (input, ds);";
+    buffer CAT "          print (file,";
+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";
+    buffer CAT "            PROC (INT CONST, INT CONST) close,";
+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC execute print;";
+    buffer CAT "PROC check error(TEXT CONST message):";
+    buffer CAT "  IF is error";
+    buffer CAT "     THEN clear error; rename myself (message);";
+    buffer CAT "          IF is error THEN end(myself) FI;";
+    buffer CAT "          pause (9000); end(myself);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC check error;";
+
diff --git a/system/printer-laser/4/src/printer.nec.lc-08 b/system/printer-laser/4/src/printer.nec.lc-08
new file mode 100644
index 0000000..9ee2837
--- /dev/null
+++ b/system/printer-laser/4/src/printer.nec.lc-08
@@ -0,0 +1,626 @@
+PACKET nec lc 08 printer
+ 
+(**************************************************************************)
+(*                                                Stand   : 29.01.88      *)
+(*  NEC Silentwriter LC-08                        Verison : 4             *)
+(*                                                Autor   : Rudolf Ruland *)
+(**************************************************************************)
+ 
+       DEFINES open,
+               close,
+               execute,
+ 
+               box commands,
+               insert box command,
+               delete box command,
+
+               paper size,
+               paper x size,
+               paper y size:
+ 
+LET
+(*  underline           =  1,
+    bold                =  2,
+    italics             =  4,
+    reverse             =  8,
+ 
+    underline linetype  =  1, *)
+ 
+    c document          =  1,
+    c page              =  2,
+ 
+    c write text        =  1,
+    c write cmd         =  2,
+    c carriage return   =  3, 
+    c move              =  4,
+    c draw              =  5,
+    c on                =  6, 
+    c off               =  7,
+    c type              =  8,
+
+    tag type            =  1;
+ 
+INT VAR symbol type;
+REAL VAR x size, y size;
+BOOL VAR is landscape, was cr;
+TEXT VAR bold buffer, mod string, command, symbol;
+THESAURUS VAR box cmds := empty thesaurus;
+
+(*********************************************************************)
+ 
+paper size (21.0, 29.7);
+ 
+PROC paper size (REAL CONST x, y) :
+ 
+  x size := x;
+  y size := y;
+ 
+END PROC paper size;
+ 
+PROC paper size : 
+ 
+  line;
+  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
+  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
+ 
+END PROC paper size;
+ 
+REAL PROC paper x size : x size END PROC paper x size;
+REAL PROC paper y size : y size END PROC paper y size;
+
+
+THESAURUS PROC box commands : box cmds END PROC box commands;
+
+PROC insert box command (TEXT CONST new command) :
+
+  command := new command;
+  change all (command, " ", "");
+  insert (box cmds, command)
+
+END PROC insert box command;
+
+PROC delete box command (TEXT CONST old command) :
+
+  INT VAR dummy;
+  command := old command;
+  change all (command, " ", "");
+  delete (box cmds, command, dummy)
+
+END PROC delete box command;
+
+(*********************************************************************)
+ 
+PROC open (INT CONST op code, INT VAR param1, param2) :
+ 
+SELECT op code OF
+  CASE c document : open document 
+  CASE c page     : open page
+END SELECT; 
+ 
+ 
+. x steps : param1
+. y steps : param2
+. 
+  open document :
+    out (""28"Cz");                      (* Diablo 630 Emulation    *)
+    out (""27""13"P");                   (* Reset                   *)
+    out (""28"$");                       (* Formatlaenge loeschen   *)
+    out (""28"Ca"27"6"28"Cz");           (* Zeichensatz 2           *)
+    out (""28"Ra");                      (* USA-Zeichensatz         *)
+    out (""27""25"1");                   (* Sheet 1                 *)
+    is landscape := pos (material, "landscape") > 0;
+    IF is landscape
+       THEN x steps := x step conversion ( y size );
+            y steps := y step conversion ( x size );
+            out (""28")"128""0"");       (* Landscape-Mode          *)
+       ELSE x steps := x step conversion ( x size );
+            y steps := y step conversion ( y size );
+            out (""28")"001""0"");       (* Portait  -Mode          *)
+    FI;
+    was cr      := FALSE;
+    bold buffer := "";
+
+. x start : param1
+. y start : param2
+. 
+  open page :
+    IF is landscape
+       THEN x start := x step conversion (0.45);
+            y start := y step conversion (0.9);
+       ELSE x start := x step conversion (0.7);
+            y start := y step conversion (0.9);
+    FI;
+    IF   pos (material, "sheet1") > 0
+         THEN out (""27""25"1")
+    ELIF pos (material, "sheet2") > 0
+         THEN out (""27""25"2")
+    ELIF pos (material, "manual") > 0
+         THEN out (""27""25"E")
+    FI;
+    out (""28"'a"0""0""28"&a"0""0"");  (* Positionierung auf den Nullpunkt *)
+ 
+END PROC open; 
+ 
+ 
+PROC close (INT CONST op code, INT CONST param1) :
+ 
+SELECT op code OF
+  CASE c document : close document 
+  CASE c page     : close page
+  OTHERWISE : put (param1)
+END SELECT; 
+ 
+. 
+  close document :
+ 
+ 
+(*. remaining y steps : param1*)
+.
+  close page :
+    out (""12"") 
+ 
+END PROC close;
+ 
+ 
+PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
+ 
+SELECT op code OF
+  CASE c write text       :  write text
+  CASE c write cmd        :  write cmd
+  CASE c carriage return  :  carriage return
+  CASE c move             :  move
+  CASE c draw             :  draw
+  CASE c on               :  on
+  CASE c off              :  off
+  CASE c type             :  type
+END SELECT
+
+ 
+. from : param1
+. to   : param2
+.
+  write text :
+    IF was cr
+       THEN was cr := FALSE;
+            out (bold buffer);
+    FI;
+    out subtext (string, from, to)
+ 
+.
+  write cmd :
+    IF was cr
+       THEN was cr := FALSE;
+            out (bold buffer);
+    FI;
+    command := subtext (string, from, to);
+    IF is box cmd
+       THEN disable stop;
+            do (command);
+            clear error;
+       ELSE out (command);
+    FI;
+ 
+    . is box cmd :
+        scan (command);
+        next symbol (symbol, symbol type);
+        (symbol type = tag type) CAND (box cmds CONTAINS symbol)
+
+
+(*. x steps to left margin : param1*)
+.
+  carriage return :
+    out (""13"");
+    was cr := TRUE;
+ 
+ 
+. x steps : param1
+. y steps : param2
+.
+  move :
+    IF x steps <> 0 THEN x move FI;
+    IF y steps <> 0 THEN y move FI;
+
+    . x move :
+        IF x steps > 0  THEN out (""28"&c") ELSE out (""28"&d") FI;
+        out (x steps low);
+        out (x steps high);
+
+        . x steps low  : code (abs (x steps) MOD 256)
+        . x steps high : code (abs (x steps) DIV 256)
+
+    . y move :
+        IF y steps > 0  THEN out (""28"'c") ELSE out (""28"'d") FI;
+        out (y steps low);
+        out (y steps high);
+
+        . y steps low  : code (abs (y steps) MOD 256)
+        . y steps high : code (abs (y steps) DIV 256)
+. 
+  draw :
+    stop
+ 
+ 
+. modification : param1
+.
+  on :
+    mod string := on string (modification);
+    IF mod string <> ""
+       THEN out (mod string);
+            IF pos (""27"W"27"O", mod string) > 0
+               THEN bold buffer CAT mod string;
+            FI;
+       ELSE stop
+    FI
+ 
+.
+  off :
+    mod string := off string (modification);
+    IF mod string <> ""
+       THEN out (mod string);
+            IF pos (""27"&", mod string) > 0
+               THEN bold buffer := subtext (bold buffer, 1, LENGTH bold buffer - 2);
+                    out (bold buffer);
+            FI;
+       ELSE stop
+    FI
+ 
+ 
+. font nr : param1
+.
+  type :
+    out (""28")");                            (* Font Identifikation *)
+    command := font string (font nr);
+    IF is landscape
+       THEN out subtext (command, 3, 4);
+       ELSE out subtext (command, 1, 2);
+    FI;
+    out (""28"E");                            (* Zeilenvorschub (VMI) *)
+    out (code (font height (font nr) + font depth (font nr) + font lead (font nr)));
+    out (""28"F");                            (* Zeichenabstand (HMI) *)
+    out (code (char pitch (font nr, " ")));
+    out (""27"P");                            (* proportional ein     *)
+    out subtext (command, 5);
+
+END PROC execute;
+ 
+END PACKET nec lc 08 printer;
+ 
+ 
+PACKET nec lc 08 box commands 
+
+(**************************************************************************)
+(*                                                                        *)
+(*      Kommandos zum Zeichen von Boxen, Linien und Schraffuren           *)
+(*                für den NEC Laserdrucker LC-08                          *)
+(*                                                                        *)
+(*                                                Autor   : Rudolf Ruland *)
+(*                                                Stand   : 29.01.88      *)
+(**************************************************************************)
+
+       DEFINES line,
+               x line,
+               y line,
+
+               box,
+               box frame,
+               box shade,
+
+               cake,
+               cake frame,
+               cake shade,
+               :
+
+INT VAR x, y, h, w;
+
+WHILE highest entry (box commands) > 0
+  REP delete box command (name (box commands, highest entry (box commands))) PER;
+insert box command ("line");
+insert box command ("xline");
+insert box command ("yline");
+insert box command ("box");
+insert box command ("boxshade");
+insert box command ("boxframe");
+insert box command ("cake");
+insert box command ("cakeshade");
+insert box command ("cakeframe");
+
+
+PROC line (REAL CONST x offset, y offset, width, height, INT CONST line width) :
+
+  IF line width > 0
+     THEN graph on (x offset, y offset, width, height);
+          out ("LW" + text (line width) + ";");
+          out ("PR;");
+          out ("PD" + text (+w) + "," + text (-h) + ";");
+          graph off;
+  FI;
+
+END PROC line;
+
+PROC x line (REAL CONST x offset, y offset, width, INT CONST line width) :
+
+  IF line width > 0
+     THEN graph on (x offset, y offset, width, 0.0);
+          out ("LW" + text (line width) + ";");
+          out ("PR;");
+          out ("PD" + text (+w) + "," + "0;");
+          graph off;
+  FI;
+
+END PROC x line;
+
+PROC y line (REAL CONST x offset, y offset, height, INT CONST line width) :
+
+  IF line width > 0
+     THEN graph on (x offset, y offset, 0.0, height);
+          out ("LW" + text (line width) + ";");
+          out ("PR;");
+          out ("PD0," + text (-h) + ";");
+          graph off;
+  FI;
+
+END PROC y line;
+
+
+PROC box (REAL CONST x offset, y offset, width, height,
+          INT CONST pattern type, line width) :
+
+  IF   pattern type = 0
+       THEN box frame (x offset, y offset, width, height, line width)
+  ELIF line width   = 0
+       THEN box shade (x offset, y offset, width, height, pattern type)
+       ELSE graph on (x offset, y offset, width, height);
+            out ("LW" + text (line width) + ";");
+            set pattern (pattern type);
+            out ("ER" + text (+w) + "," + text (-h) + ";");
+            graph off;
+  FI;
+
+END PROC box;
+
+
+PROC box shade (REAL CONST x offset, y offset, width, height,
+                INT CONST pattern type) :
+
+  IF pattern type <> 0
+     THEN graph on (x offset, y offset, width, height);
+          set pattern (pattern type);
+          out ("RR" + text (+w) + "," + text (-h) + ";");
+          graph off;
+  FI;
+
+END PROC box shade;
+
+
+PROC box frame (REAL CONST x offset, y offset, width, height,
+                INT CONST line width) :
+
+  IF line width <> 0
+     THEN graph on (x offset, y offset, width, height);
+          out ("LW" + text (line width) + ";");
+          out ("PR;");
+          out ("PD");
+          out (text (+w) + "," +            "0,");
+          out (           "0," + text (-h) + ",");
+          out (text (-w) + "," +            "0,");
+          out (           "0," + text (+h) + ";");
+          graph off;
+   FI;
+
+END PROC box frame;
+
+
+PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle,
+          INT CONST pattern type, line width) :
+
+  IF   pattern type = 0
+       THEN cake frame (x offset, y offset, radius, start angle, sweep angle, line width)
+  ELIF line width   = 0
+       THEN cake shade (x offset, y offset, radius, start angle, sweep angle, pattern type)
+       ELSE graph on (x offset, y offset, radius, 0.0);
+            out ("LW" + text (line width) + ";");
+            set pattern (pattern type);
+            out ("EW" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";");
+            graph off;
+  FI;
+
+END PROC cake;
+
+
+PROC cake shade (REAL CONST x offset, y offset, radius, start angle, sweep angle,
+                INT CONST pattern type) :
+
+  IF pattern type > 0 CAND w > 0
+     THEN graph on (x offset, y offset, radius, 0.0);
+          set pattern (pattern type);
+          out ("WG" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";");
+          graph off;
+  FI;
+
+END PROC cake shade;
+
+
+PROC cake frame (REAL CONST x offset, y offset, radius, start angle, sweep angle,
+                 INT CONST line width) :
+
+
+  IF line width <> 0
+     THEN REAL CONST xs := real (x) + cos (start angle*pi/180.0) * real (w),
+                     ys := real (y) + sin (start angle*pi/180.0) * real (w);
+          graph on (x offset, y offset, radius, 0.0);
+          out ("LW" + text (line width) + ";");
+          out ("MA"+ text (xs) + "," + text (ys) + ";");
+          out ("FA"+ text ( x) + "," + text ( y) + "," + text (sweep angle) + ";");
+          out ("MA"+ text ( x) + "," + text ( y) + ";");
+          graph off;
+   FI;
+
+END PROC cake frame;
+
+
+PROC graph on (REAL CONST x offset, y offset, width, height) :
+
+  x := x pos + x step conversion (x offset);
+  y := plot y size - (y pos + y step conversion (y offset));
+  w := x step conversion (width);
+  h := y step conversion (height);
+  out (""28"Aa");
+  out ("DF;");
+  out ("MA"+ text (x) + "," + text (y) + ";");
+
+  . plot y size : 3389 - y step conversion (1.0)
+
+END PROC graph on;
+
+PROC graph off :
+
+  out (""28"Az");
+
+END PROC graph off;
+
+
+PROC set pattern (INT CONST pattern type) :
+
+  out ("XX1;");
+  out (pattern);
+
+  . pattern :
+      SELECT pattern type OF
+        CASE  1 : "FT2,1,0;"
+        CASE  2 : "FT2,1,90;"
+        CASE  3 : "FT2,1,45;"
+        CASE  4 : "FT3,1,0;"
+        CASE  5 : "FT3,1,45;"
+        CASE  6 : "FT2,100,0;"
+        CASE  7 : "FT2,100,90;"
+        CASE  8 : "FT2,100,45;"
+        CASE  9 : "FT3,100,0;"
+        CASE 10 : "FT3,100,45;"
+        OTHERWISE : "FT1;"
+      END SELECT
+
+END PROC set pattern;
+
+
+END PACKET nec lc 08 box commands;
+
+
+ 
+#page# 
+(******************************************************************)
+(***                                                            ***)
+(***   Generierung des Printers                                 ***)
+(***                                                            ***)
+(******************************************************************)
+ 
+LET printer name = "printer.nec.lc-08";
+ 
+TEXT VAR fonttab name := "fonttab.nec.lc-08";
+ 
+BOOL CONST multi user := (pcb (9) AND 255) <> 1;
+ 
+INT VAR pr channel;
+TEXT VAR buffer;
+ 
+command dialogue (TRUE);
+IF NOT multi user 
+  THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
+FI; 
+ask for print channel;
+load font table;
+forget (printer name, quiet);
+IF multi user THEN generate printer spool FI;
+command dialogue (TRUE);
+check on;
+.
+  ask for print channel : 
+    line;
+    put ("gib Druckerkanal:");
+    get (pr channel);
+    do ("serverchannel(" + text (pr channel) + ")" ) ;
+    line;
+.
+  load font table :
+    IF NOT exists (fonttab name)
+       THEN REP line (2); 
+                putline ("Bitte Archiv mit der Fonttabelle """ +
+                          fonttab name + """ einlegen!");
+                line;
+            UNTIL yes ("Archiv eingelegt") PER;
+            reserve archive;
+            fetch (fonttab name, archive);
+            release (archive);
+    FI;
+    font table (fonttab name);
+    IF multi user
+       THEN command dialogue (FALSE);
+            do ("save(""" + font tab name + """,task(""configurator""))")
+    FI;
+    forget (fonttab name, quiet);
+ 
+    . reserve archive :
+        INT VAR p1, p2;
+        archive (" "31" ");
+        disable stop;
+        list (archive);
+        IF is error
+           THEN buffer := errormessage;
+                p1 := pos (buffer, """", 1 ) + 1;
+                p2 := pos (buffer, """", p1) - 1;
+                IF p1 > 0 AND p2 > 0
+                   THEN clear error;
+                        buffer := subtext (buffer, p1, p2);
+                        archive (buffer);
+                FI;
+        FI;
+        enable stop;
+ 
+. generate printer spool :
+    eumel must advertise;
+    cursor (1, 12);
+    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
+    putline ("die Fonttabelle mit dem Kommando");
+    line;
+    putline ("      font table (""" + font tab name + """)");
+    line;
+    putline ("eingestellt werden!!!");
+    line (4);
+    putline ("Generierung beendet, weiter mit 'SV'");
+    generate printer server;
+    do (buffer);
+ 
+. generate printer server :
+    buffer :=  "break (quiet);";
+    buffer CAT "spool manager (PROC printer);";
+    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
+    buffer CAT "PROC printer:";
+    buffer CAT "  disable stop;";
+    buffer CAT "  continue (server channel);";
+    buffer CAT "  check error (error message);";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  REP forget (ds);";
+    buffer CAT "      execute print;";
+    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";
+    buffer CAT "  PER;";
+    buffer CAT "END PROC printer;";
+    buffer CAT "PROC execute print:";
+    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";
+    buffer CAT "  enable stop;";
+    buffer CAT "  ds := nilspace;";
+    buffer CAT "  call (father, fetch code, ds, reply);";
+    buffer CAT "  IF reply = ack CAND type (ds) = file type";
+    buffer CAT "     THEN file := sequential file (input, ds);";
+    buffer CAT "          print (file,";
+    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";
+    buffer CAT "            PROC (INT CONST, INT CONST) close,";
+    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC execute print;";
+    buffer CAT "PROC check error(TEXT CONST message):";
+    buffer CAT "  IF is error";
+    buffer CAT "     THEN clear error; rename myself (message);";
+    buffer CAT "          IF is error THEN end(myself) FI;";
+    buffer CAT "          pause (9000); end(myself);";
+    buffer CAT "  FI;";
+    buffer CAT "END PROC check error;";
+
diff --git a/system/ruc-terminal/unknown/doc/BIOSINT.PRT b/system/ruc-terminal/unknown/doc/BIOSINT.PRT
new file mode 100644
index 0000000..26bde5a
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/BIOSINT.PRT
@@ -0,0 +1,281 @@
+#type ("17.klein")# 

+Interrupts/Traps/Exeptions (Bios)                                 29.04.87

+ 

+Interrupt: IRQn (Durch Hardware ausgelöst, werden auf Traps umgelenkt) 

+Trap     : INTn (Durch Software ausgelöst) 

+Exeption : INTn (Im Protected Mode vom Prozessor ausgelöst) 

+ 

+Traps   | Funktion 

+--------+------------------------------------------------------------------ 

+INT 00H : Abort Program

+INT 01H : 

+INT 02H : NMI-Routine (Parity-Check & Power-Fail & Redirected from INT 75H) 

+INT 03H : INT3 - Break

+INT 04H : INTO - Overflow

+INT 05H : Print Screen 

+INT 06H : 

+INT 07H : 

+INT 08H : IRQ0 System Interrupt 

+INT 09H : IRQ1 Keyboard Buffer full

+INT 0AH : Software redirected from IRQ9 

+INT 0BH : IRQ3 Serial Port 2 

+INT 0CH : IRQ4 Serial Port 1 

+INT 0DH : IRQ5 Parallel Port 2 

+INT 0EH : IRQ6 Diskette Interrupt 

+INT 0FH : IRQ7 Parallel Port 1 

+ 

+INT 10H : Video Trap 

+  ah = 00H : set mode (al = mode) 

+             (Videoram: Herkules: B0000 

+                        EGA     : B8000)

+             al | Tx/Gr| Pixel | Zeichen | Monitor | Farbe | Seiten 

+             ---+------+-------+---------+---------+-------+-------- 

+             00 | Text |640x200| 40 x 25 | Mono/Col| 16/64*|   8 

+             01 | Text |640x200| 40 x 25 | Color   | 16/64*|   8 

+             02 | Text |640x200| 80 x 25 | Mono/Col| 16/64*|   8 

+             03 | Text |640x200| 80 x 25 | Color   | 16/64*|   8 

+             04 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             05 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             06 | Graf |640x200| 80 x 25 | Mono/Col|   2   |   1 

+             07 | Text |720x348| 80 x 25 | Mono    |   4   |   8 

+             08 | Graf |720x348| 90 x 48 | Mono    |   2   |   1

+       --------- ab hier nicht implementiert, nur EGA ------------------ 

+             VideoRAM-Adresse A0000

+             0D | Graf |320x200| 40 x 25 | Color   |  16   |   8 

+             0E | Graf |640x350| 80 x 25 | Color   |  16   |   4 

+             0F | Graf |640x350| 80 x 25 | Mono    |   4   |   2 

+             10 | Graf |640x350| 80 x 25 | Enhanced| 16/64*|   2 

+                                                           * mit EGA-Monitor 

+  ah = 01H : set cursor type (Eingang: CH, CL Werte 0..31) 

+             CH=Startzeile des Cursorblocks, CL=Endzeile des Cursorblocks 

+  ah = 02H : set cursor pos (BH = Page, DL = Spalte, DH = Zeile)

+  ah = 03H : read cursor 

+             Ausgang: BH=Page, DL=Spalte, DH=Zeile, CL=Starzeile des 

+                      Cursorblocks, CH=Endzeile des Cursorblocks

+  ah = 04H : read lightpen 

+             Ausgang: AH=1 : Register sind gültig, AH=0: Taste nicht gedrückt

+                      DH = Zeile, DL = Spalte des Lightpens

+                      CH=Rasterlinie (1..199), CX=Rasterlinie (1..349) 

+                      BX = Rasterspalte (1..319/1..639) 

+  ah = 05H : set actual display (AL = Neue Seite)

+  ah = 06H : scroll up 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 07H : scroll down 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 08H : read current attribute and char

+             Ausgang: BH=Anzeigeseite, AL=Zeichen, AH=Attribut (nur Alpha) 

+  ah = 09H : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen, BL=Attribut/Farbe

+  ah = 0AH : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen 

+  ah = 0BH : set color (BH=Palettenfarbe 0..127, BH=Farbwert) 

+  ah = 0CH : write dot 

+             BH=Seite, DX=Zeile, CX=Spalte, AL=Farbwert (falls Bit 7=1, wird

+             alte Farbe mit neuer Farbe geXORed)

+  ah = 0DH : read dot (BH=Seite, DX=Zeile, CX=Spalte, AL=Punktfarbwert)

+  ah = 0EH : write tty (Zeichen schreiben, AL=Zeichen, BL=Farbe) 

+  ah = 0FH : video state (Ausgang: AL=Video-Mode (0..8), AH=Anzahl

+                                   Zeichenspalten, BH=Seite)

+  ah = 10H : reserved (EGA-Bios: Write Palette/Overscan/Intensity/Flash) 

+  ax = 1142H: draw line (EGA-Bios: 12 Routinen für den Charactergenerator) 

+             CX=X-pos-from, DX= Y-pos-from, BP=X-pos-to, DI=Y-pos-to

+  ah = 12H : reserved (EGA-Bios: Alternate Characterset) 

+  ah = 13H : write string

+             Allgemein: 

+               ES:BP = Stringanfang 

+               CX = Stringlänge

+               DL, DH = Cursorposition (Stringanfang) 

+               BH = Seite 

+       al = 0: BL=Attribut, String: CHAR, CHAR, CHAR,...,Cursor wird nicht 

+               bewegt.

+       al = 1: BL=Attribut, String: CHAR, CHAR, CHAR,..., Cursor wird bewegt.

+       al = 2: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird nicht bewegt. 

+       al = 3: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird bewegt. 

+ 

+INT 11H : Equipment Trap (Ausgang: AX = Equipment Flag) 

+          AX : 

+             Bit 1 : 80287 installiert

+             Bit 3 : Herkules installiert

+             Bit 4/5   : 0 = No Primary Display set 

+                         1 = Monochrome 

+                         2 = Color 80 * 25 

+                         3 = EGA

+             Bit 6     : Drive B installiert

+             Bit 9..12 : Anzahl RS232

+             Bit 14/15 : Anzahl Printer

+ 

+INT 12H : Memory Size Trap (Ausgang: AX = Memorysize in KB) 

+ 

+INT 13H : Hardisk Trap 

+          Allgemein: 

+          DL = Drive (0, 1...) 

+          AL = Sector count 

+          CX = Bit 0... Bit 5 = Sector 

+               Bit 6... Bit 15 = Cylinder 

+          Exit: AH = 0 ok, <> 0 Fehler (z.b. in hf_error nachsehen) 

+  ah = 0 reset diskette, wd1010, hdisks 

+  ah = 1 return status 

+  ah = 2 read 

+  ah = 3 write 

+  ah = 4 verify 

+  ah = 5 format 

+  ah = 8 drive params 

+  ah = 9 init drive 

+  ah = A read long 

+  ah = B write long 

+  ah = C seek 

+  ah = D reset wd1010 (DL = Drive) 

+  ah =10 ready test

+  ah =11 reclibrate 

+  ah =14 check controller  

+  ah =15 read dasd (stacktop 2 words: anzahl sektoren der platte) 

+ 

+INT 14H : RS232C Trap 

+  Allgemein: dx = port (>= 1FE0H : SCC = 8530) 

+  ah = 0 : Init

+           al : Bit 5..7 = Baudrate 

+                    000 = 110,

+                    001 = 150, 

+                    010 = 300, 

+                    011 = 600, 

+                    100 = 1200, 

+                    101 = 2400, 

+                    110 = 4800, 

+                    111 = 9600, 

+                Bit 3..4 = Parity    (no, odd, even) 

+                Bit 2    = Stopbits  (1, 2)

+                Bit 0..1 = Datenbits (5, 6, 7, 8)

+  ah = 1 : Send (al = Zeichen, Ausgang: ah=80H Timeout, Zeichen dann in al) 

+  ah = 2 : Read (Ausgang: ah=80H:Timeout, sonst ah=Statusregister,al=Zeichen)

+  ah = 3 : Status (Ausgang: Nur 8250: al = Modemstatus) 

+           ah : Bit 0 = 1 : Data available 

+                Bit 1 = 1 : Receiver overrun 

+                Bit 2 = 1 : Parity Error 

+                Bit 3 = 1 : Framing Error 

+                Bit 4 = 1 : Transmitter empty 

+                Bit 5 = 1 : Break received 

+ 

+INT 15H : Utility Trap 

+  ah = 80H open device (nicht implementiert) 

+  ah = 81H close device (nicht implementiert)

+  ah = 82H prog term (nicht implementiert)

+  ah = 83H event wait (Eingang: CX=RTCtmr high, DX=RTCtmr high, ES:BX=userflag) 

+           Ausgang: CY=0, Event wait wurde aktiviert 

+                    CY=1, Noch kein RTC-Event aufgetreten 

+                          (INT 15H periodisch aufrufen zum pollen)

+  ah = 84H joy stick (Eingang: DX)

+       DX = 0: Ausgang: AL (Bits 4..7) = Buttons 

+       DX = 1: Ausgang: AX=Xa, BX=Ya, CX=Xb, DX=Yb

+  ah = 85H sys request (nicht implementiert) 

+  ah = 86H wait a moment (CX=RTCtimer high, DX=RTCtimer low) 

+  ah = 87H block move (extended memory) (Eingang: CX: Words, ES:SI = Block

+           Descriptoren: 8 Bytes Source, 8 Bytes Destination)

+  ah = 88H extended memory (Ausgang: AX= KB extended Memory) 

+  ah = 89H enter protected mode

+  ax = 8A42H run setup 

+  ax = 8B42H error beep

+  ax = 8C42H usr-powerfail-shutdown-routine

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS abgelegt werden) 

+  ax = 8D42H usr-powerfail-resume-routine 

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS geholt werden) 

+  ax = 8E42H set timer (Eingang: BL = Timer (0, 1, 2), CX = Countervalue 

+                                 BH: Bit 0 = BCD, Bit 1..3 = Mode, 

+                                     Bit 4..5 Write CMD, Bit 6/7 unused) 

+                       (Timer wird bei Resume wieder so initialisert)

+  ax = 8F42H hardcopy (Grafik & Mono)

+  ah = 90H device busy (nicht implementiert)

+  ah = 91H set int complete (nicht implementiert)

+  ah = 9242H backup memory (CX=Anzahl Bytes, DS:SI = Sourceadr, E000H:DI 

+                              = Destinationadr.)

+  ah = 9342H restore memory (CX=Anzahl Bytes, E000H:SI = Sourceadr, ES:DI = 

+                                Destinationadr.)

+INT 16H : Keyboard Trap 

+  ah = 00 Ascii read (Ausgnag: AX=Zeichen CY=1, sonst CY=0)

+  ah = 01 Ascii status (Ausgang: ZF = 0 : Zeichen in Queue)

+  ah = 02 Shift status (Ausgang: AL = KB_flag) 

+  ax = 0342 set typematic (Ausgang: BL = Rate, BH = Delay) 

+  ax = 0442 soft power down 

+ 

+INT 17H : Printer Trap

+  Allgemein: dx = port 

+  ah = 0 : print char (Eingang: al = Char, Ausgang: ah = Printer Status) 

+  ah = 1 : init printer port 

+  ah = 2 : ah = Status 

+ 

+INT 18H : Basic (nicht implementiert) 

+ 

+INT 19H : Bootstrap Trap 

+  Block 0 von Harddisk oder Floppy --> ES:BX laden und starten (Booting...) 

+  Der Block hat in Bytes 510/511 das Kennzeichen AA55H. 

+ 

+INT 1AH : Time of day Trap

+  ah = 0 : Read Timer (Ausgang: CX=Timer low, DX=Timer high, AL<>0:Overflow)

+  ah = 1 : Set Timer (CS=Timer low, DX=Timer high)  

+  ah = 2 : Read Clock (Ausgang: DH = Sec, CL = Min, CH = Std) 

+  ah = 3 : Set Clock  (DL=Sommerzeit (01), DH=sec, CL=Min, CH=Std)

+  ah = 4 : Read Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 5 : Set Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 6 : Set Alarm (DH=Sec, CL=Min, CH=Std)

+  ah = 7 : Reset Alarm 

+ 

+INT 1BH : Dummy Return 

+ 

+INT 1CH : User Timer Tic, wird einmal pro Sekunde aufgerufen.

+ 

+INT 1DH : Zeigt auf die Video Parameter

+INT 1EH : Zeigt auf Disk_base (DF, 02, 25, 02, 0F, 1B, FF, 54, F6, 0F, 08) 

+INT 1FH : Pointer auf Zeichensatz mit Zeichen 128..255

+

+INT 20H ... INT 3FH sind für das Betriebssystem reserviert.

+ 

+INT 20H : DOS: Terminate Program

+INT 21H : DOS: Function Call

+INT 22H : DOS:

+INT 23H : DOS:

+INT 24H : DOS: 

+INT 25H : DOS: 

+ 

+INT 40H : Diskette Trap 

+  AH = 0 disk reset 

+  AH = 1 disk status (ret) 

+  AH = 2 disk read (ES:BP = Pointer auf Buffer, DI = Anzahl Sektoren,

+                    DH = Head, DL = Drive, CL = Sektor, CH = Cylinder)

+  AH = 3 disk write           "

+  AH = 4 disk verify          "

+  AH = 5 disk format          "

+  AH = 21 disk type  (Ausgang: BL (Bit 0..3) 0=360K, 1/2 = 1.2MB) 

+  AH = 22 disk change 

+  AH = 23 format set 

+ 

+INT 44H : Pointer auf weiteren Zeichensatz (Nur von EGA-Bios unterstützt)

+ 

+INT 4AH : Für User software redirected from RTC-IRQ (Alarm, periodic) 

+ 

+INT 60H 

+  ...     User 

+INT 6FH

+ 

+Hardware-Interrupts 8..15:

+INT 70H : IRQ 8 RTC-Interrupt

+INT 71H : IRQ 9 Software Redirected to INT 0AH 

+INT 72H : IRQ10 Frei

+INT 73H : IRQ11 Frei 

+INT 74H : IRQ12 Frei 

+INT 75H : IRQ13 Coprozessor, Software Redirected to NMI (INT 02H) 

+INT 76H : IRQ14 Harddisk Interrupt

+INT 77H : IRQ15 Frei

+ 

+INT 78H : User 0

+INT 79H : User 1

+INT 7AH : User 2

+INT 7BH : User 3

+INT 7CH : User 4

+INT 7DH : User 5 

+INT 7EH : User 6

+INT 7FH : User 7

diff --git a/system/ruc-terminal/unknown/doc/MACROS.PRT b/system/ruc-terminal/unknown/doc/MACROS.PRT
new file mode 100644
index 0000000..4a3b78f
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/MACROS.PRT
@@ -0,0 +1,54 @@
+#*t ($1)# 

+#topage("$1")#

+#*macroend# 

+

+

+#*linie ($1)# 

+#rpos($1)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos#

+#*macroend# 

+ 

+

+

+#*k ($1, $2)#

+#type("8")##center##ib(3)#$1  $2#ie(3)##type("elite")# 

+#*macroend#

+ 

+

+

+

+

+#*h ($1, $2)#

+#type("8")##center##on("i")##on("u")##ib(3)#$1  $2#ie(3)##off("u")##off("i")##type("elite")# 

+#headodd#

+#center##on("b")#$1  $2#off("b")# 

+ 

+ 

+ 

+#end#

+#*macroend#

+ 

+

+

+

+

+#*kopf ($1)#

+#headeven#

+#center##on("b")#$1#off("b")# 

+ 

+ 

+ 

+#end# 

+#bottomodd# 

+ 

+ 

+ α 

+#end# 

+#bottomeven# 

+ 

+ 

+#right#α 

+#end# 

+#*macroend#

diff --git a/system/ruc-terminal/unknown/doc/TDOC.PRT b/system/ruc-terminal/unknown/doc/TDOC.PRT
new file mode 100644
index 0000000..2326c5e
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TDOC.PRT
@@ -0,0 +1,3012 @@
+#type ("elite")##limit (16.2)##block# 

+ 

+#type ("8")##center##on("b")##on("u")#Bedienungshandbuch zum ruc - Graphikterminal#off("u")##off("b")##type ("elite")# 

+ 

+#center#Version 1.1 

+ 

+#center#Oktober 1986 

+#free (16.0)# 

+ruc - Rolf Uhlig Computer 

+GmbH & Co Kommanditgesellschaft 

+Sendenhorster Straße 82 

+D - 4406 Drensteinfurt 1 

+Telefon 02508/8500 

+ 

+Michael Staubermann 

+Moränenstraße 29 

+D - 4400 Münster-Hiltrup 

+Telefon 02501/4320 

+#pagenr (""224"", 1)##page (1)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("1.", "Einige Worte zuvor")# 

+ 

+ 

+Dieses Terminalprogramm wird in zwei Versionen (für den Basis 108 und den

+Apple IIe) geliefert. Die Version ist in der Kommandozeile erkenntlich

+(BASIS oder APPLE). 

+ 

+Eigenschaften des Terminals: 

+ 

+- Kommandozeilen für schnelle Offline Parametereinstellung 

+- Statuszeile für spezielle Betriebzustände 

+- Über 70 programmierbare Funktionstasten 

+- Druckerspooler 32k (4 ganze Graphikhardcopys und noch mehr) 

+- 7935 Zeichen Empfangspuffer 

+- Verschiedene Hardcopy Modi für Text und Graphik 

+- 192x280 Punkte auflösender Graphikmodus mit zwei Helligkeitsstufen 

+- Zwei Graphikseiten mit getrennter Anzeige/Bearbeitung 

+- Viele Graphikroutinen (Bogen, Flächenfüllung, Kreis, Rechteck...) 

+- Graphikmodus für Texte in verschieden Richtungen, Dicken, Grössen 

+- Griechische Graphikzeichen und Kursivschrift 

+- Graphikseiten Scrollen, Mischen, vom Host laden, zum Host schicken 

+ 

+ 

+Zum Handbuch 

+ 

+Tasten werden durch Angabe ihres Aufdruckes in Grossbuchstaben angegeben und

+in spitze Klammern gesetzt (z.B. <TAB>) in einigen Fällen auch durch ihren

+Namen (z.B. <DOWN> oder <TOPLEFT>). Eine zusätzlich zu betätigende Umschalt-

+taste, wie SHIFT, CTRL, OPEN APPLE (kurz: OA) oder beide zusammen, wird in

+der Klammer davorgestellt (z.B. <SHIFT RETURN>). 

+ 

+Nicht druckbare Ascii-Codes (z.B. <ESC> oder <SPACE>), sowie Kommandopara-

+meter (z.B. <n>) werden ebenfalls in spitze Klammern gesetzt. Komandopara-

+meter werden mit Kleinbuchstaben bezeichnet. 

+ 

+#page# 

+#h("2.", "Die Hardware")# 

+ 

+ 

+Unterstützt wird eine 80-Zeichen Textanzeige, ein Basiskeyboard oder ein

+Applekeyboard mit Open-Apple Taste. Am Basis kann ein Drucker angeschlossen

+werden. 

+ 

+ 

+#k("2.1", "Die serielle Schnittstelle")# 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host oder vom Terminal

+(LOCAL) eingestellt werden (Siehe Kommando <ESC> <SPACE> <SPACE>). Es wer-

+den alle 15 gängigen Baudrates zwischen 50 und 19200 Baud unterstützt. Pari-

+tycheck kann mit gerader oder ungerader Parität durchgeführt werden. Fluß-

+kontrolle ist in allen Kombinationen aus RTS/CTS, DTR/DSR, XON/XOFF möglich.

+Empfohlen wird DTR/DSR oder XON/XOFF. 

+ 

+             Benötigte Verdrahtung der seriellen Schnittstelle 

+ 

+            Pin                                        Priorität 

+              2 : TXD Sendedaten    zum Host (RXD)         1 

+              3 : RXD Empfangsdaten vom Host (TXD)         1 

+              4 : RTS Ready To Send zum Host (CTS)         3 

+              5 : CTS Clear To Send vom Host (RTS)         3 

+              6 : DSR DataSet Ready vom Host (DTR)         2 

+              7 : Masse an Host Masse                      1 

+              8 : DCD Eingang, nicht benötigt 

+             20 : DTR Data Terminal Ready zum Host (DSR)   2 

+ 

+Priorität: 

+ 1 : Muß verdrahtet werden 

+ 2 : Ist bei DSR/DTR Flußkontrolle zu verdrahten 

+ 3 : Ist bei RTS/CTS Flußkontrolle zu verdrahten 

+ 

+Der Datentransfer geschieht in der Regel mit 8 Datenbits. Sollte der Host

+nur über 7 Bit Datentransfer verfügen, müssen einige Einschränkungen bei der

+Parameterübergabe von Uploads/Downloads gemacht werden (Kein Farbbit). Die

+Anzahl der Datenbits kann auch in der Kommandozeile verändert werden. 

+ 

+ 

+#k("2.2", "Der Reset")# 

+ 

+Ein Reset bringt das Terminal in einen definierten Zustand. Alle Bildschirm-

+seiten und Puffer, sowie der Druckerspooler werden gelöscht. Der Reset kann

+vom Host durch 

+ 

+                         #ib(1)#<ESC> 0#ie(1)#    (Hex 1B 30) 

+ 

+initiiert werden, vom Basiskeyboard aus durch <SHIFT SHIFT CTRL>. Die Para-

+meter in der Kommandozeile werden dem Setup entnommen. Nach dem Löschen

+aller Bildschirmseiten, wird das Makro mit dem Code Hex EF aufgerufen. Dies

+ist die Funktionstaste <SHIFT BOTRIGHT>. 

+ 

+#page# 

+#h("3.", "Die Kommandozeile")# 

+ 

+ 

+Die wichtigsten Parameter des Terminals können im laufenden Betrieb in den

+beiden Kommandozeilen geändert werden. Die erste Kommandozeile erscheint

+beim Basiskeyboard durch Drücken von <SHIFT CE> und beim Apple durch <OA

+CTRL X>. 

+ 

+Im Graphikmodus ersetzt die Kommandozeile die untersten 32 Graphikzeilen

+(entspricht vier Textzeilen). Man hat also auch im Graphikmodus die Mög-

+lichkeit wichtige Parameter in der Kommandozeile zu ändern. 

+ 

+Die angezeigten Einstellungen bieten außerdem eine Informationsmöglichkeit

+über die aktuellen Parameter der seriellen Schnittstelle u.s.w. Die zweite

+Kommandozeile enthält die Parameter der seriellen Schnittstelle. 

+ 

+Alle in den Kommandozeilen angezeigten Parameter (bis auf BELL ON/BELL OFF)

+können auch durch ESC-Kommandos vom Host oder im Localmodus geändert wer-

+den. 

+Ein laufender Druckvorgang wird unterbrochen, solange die Kommandozeilen

+sichtbar sind. 

+ 

+ 

+#k("3.1", "Tastenfunktionen in der Kommandozeile")# 

+ 

+Folgende Tasten haben in der Kommandozeile eine Wirkung: 

+ 

+Taste              Bedeutung 

+#linie ("16.2")#

+<UP> oder <DOWN>   Wechselt in die jeweils andere Kommandozeile 

+ 

+<LEFT>             Springt zum vorherigen (linken) Parameter ohne etwas zu

+                   verändern. 

+ 

+<RIGHT>            Springt zum nächsten (rechten) Parameter ohne etwas zu

+                   verändern. 

+ 

+<SPACE>            Ändert das selektierte Parameterfeld. Das selektierte

+                   Parameterfeld ist durch Invertierung hervorgehoben. Die

+                   möglichen Parameter wiederholen sich zyklisch. 

+ 

+<ESC>              Die Kommandozeile wird verlassen. Es werden keine Ände-

+                   rungen durchgeführt. 

+ 

+<SHIFT S>          Die Kommandozeile wird verlassen. Vorher werden alle

+                   Änderungen permanent auf die Diskette geschrieben. Wei-

+                   tere Einzelheiten s.u. (Setup) 

+ 

+<SHIFT R>          Alle Parameter werden auf ihre Defaultwerte zurückge-

+                   setzt. Die Kommandozeile wird noch nicht verlassen, daher

+                   kann dieser 'Reset' durch <ESC> wieder aufgehoben werden. 

+                   <CE> oder <CTRL X> Die Kommandozeile wird verlassen. Die

+                   Änderungen werden nur im Speicher vermerkt. Nach dem

+                   Ein-/Ausschalten des Rechners werden die alten Parameter

+                   von der Diskette gelesen. Wird allerdings ein Hardware-

+                   reset (s.o.) durchgeführt, sind diese Änderungen nicht

+                   verloren. 

+ 

+ 

+#k("3.2", "Setup")# 

+ 

+Beim Setup, der in der Kommandozeile durch <SHIFT S> ausgelöst werden kann,

+werden wichtige Parameter auf die Diskette geschrieben. Sie werden dann

+'permanent' und müssen nach dem Einschalten des Terminals nicht neu einge-

+stellt werden. Diese Parameter sind die 

+- Parameter der seriellen Schnittstelle (2. Kommandozeile) 

+- anderen Parameter der Kommandozeilen 

+- vom Benutzer programmierte Belegung der Funktionstasten 

+- Druckerspezifischen Hardcopyparameter 

+ 

+Vor dem Setup ist zu prüfen, ob der Diskettenschreibschutz entfernt wurde

+(Klebeschildchen an der Diskettenseite entfernen). Der Schreibschutz sollte

+nach dem Setup wieder angebracht werden. Wurde der Schreibschutz nicht ent-

+fernt, wird eine Meldung 'Diskettenschreibschutz entfernen !' angezeigt. In

+diesem Falle erscheint nach dem Drücken einer Taste wieder die Kommando-

+zeile. 

+Wenn keine Diskette einliegt oder ein harter Schreibfehler auftritt, er-

+scheint die Meldung 'Setup kann nicht geschrieben werden (Diskettenfeh-

+ler)!'. Weitere Schreibversuche sind möglicherweise erfolgreich. 

+ 

+ 

+#k("3.3", "Die zweite Kommandozeile")# 

+ 

+Beim Basis (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+GER|BASIS|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+USA  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+APL       HEX ON                                                  CUR OFF 

+UNI 

+#type ("elite")# 

+ 

+Beim Apple (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+USA|APPLE|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+FLH  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+          HEX ON                                                  CUR OFF 

+#type ("elite")# 

+ 

+ 

+Default Andere   Funktion 

+#linie ("16.2")# 

+Basis 

+ GER    USA      Die Zeichensatzeinstellung ist für die gebräuchlichsten 

+        APL      vier Zeichensätze in der Kommandozeile möglich. 

+        UNI      GER = Deutsch Ascii, USA = US Ascii, APL = APL-Zeichensatz

+                 UNI = Deutscher Zeichensatz mit inversen APL Zeichen. Der

+                 APL-Zeichensatz entählt auch die Zeichen [\]{|}~. Über

+                 ESC-Kommandos lassen weitere Möglichkeiten einstellen. 

+ 

+ BASIS  TVI      Keyboard Emulation. BASIS sendet die Funktionstastencodes

+                 mit Bit 7 = 1. TVI sendet für jede Funktionstaste eine

+                 Zeichenfolge <SOH> x <CR>. Die Cursortasten sowie DEL CHAR,

+                 INS CHAR, DEL LINE, INS LINE werden wie bei TVI üblich

+                 gesendet. Weiter Einzelheiten s.u. (TVI-Emulation) 

+ 

+Apple 

+ USA    FLH      USA = US Ascii, FLH = Voller Ascii Zeichensatz mit Blinken

+                 und Invers. 

+ 

+ APPLE  TVI      Keyboard Emulation. APPLE führt keine Codeumsetzung durch.

+                 Wird allerdings die <OPEN APPLE>-Taste mit einer anderen

+                 Taste zusammen gedrückt, wird das Bit 7 im Code auf 1 ge-

+                 setzt. Zur TVI-Emulation siehe oben. 

+ 

+MON OFF MON ON   Der Monitor Modus wird mit MON ON eingeschaltet. In diesem 

+        HEX ON   Modus werden alle Steuerzeichen auf dem Bildschirm mar-

+                 kiert ausgegeben. Bis auf die Kommandos <ESC> u oder <ESC>

+                 X (um den Monitormodus auszuschalten) werden keine Komman-

+                 dos interpretiert. Alle anderen Zeichen werden unverändert

+                 dargestellt. Der Monitormodus kann auch durch MON OFF aus-

+                 geschaltet werden. 

+                 Im Hexmodus werden keine Zeichen, sondern deren Ascii-

+                 Codes in Hexadezimaldarstellung ausgegeben. 

+ 

+PRT OFF PRT ON   Parallele Druckerausgabe. Ist PRT ON eingeschaltet, werden

+                 alle Zeichen die von der seriellen Schnittstelle kommen,

+                 auf dem Drucker ausgegeben bzw. in den Druckerspooler ge-

+                 schrieben. Die Bildschirmausgabe wird hiervon nicht beein-

+                 flußt. 

+ 

+SCRN ON SCR OFF  Bildschirmausgabe an/aus. Ist SCRN ON eingeschaltet, wer-

+                 den alle Zeichen die von der seriellen Schnittstelle kom-

+                 men, auf dem Bildschirm ausgegeben. SCR OFF und PRT ON kann

+                 zum Beispiel benutzt werden, um Daten nur an den Drucker zu

+                 schicken, ohne daß diese auch auf dem Bildschirm erschei-

+                 nen. 

+ 

+KEY CLK CLK OFF  Tastaturklick an/aus. Ist KEY CLK eingeschaltet, gibt jede

+                 Taste (bis auf SHIFT, CTRL) bei ihrer Betätigung einen Ton

+                 (Klick) von sich. CLK OFF schaltet dies ab. 

+ 

+NORVID  REVVID   Bildschirmdarstellung. NORVID stellt hellen Text auf

+                 schwarzem Grund dar, REVVID stellt schwarzen Text auf hel-

+                 lem Grund dar (Möglicherweise angenehmer für die Augen). 

+ 

+SCROLL  PAGE     Ist SCROLL eingeschaltet, wird der Bildschirm um eine Zeile

+                 nach oben geschoben, sobald der Cursor in der letzten Bild-

+                 schirmzeile steht und ein Zeilenvorschub <LF> ausgeführt

+                 werden soll. Die erste Bildschirmzeile verschwindet. Ist

+                 PAGE eingeschaltet, springt der Cursor in einer solchen

+                 Situation in die erste Bildschirmzeile. Die Cursorspalte

+                 wird dabei nicht verändert. 

+ 

+BELL ON BELL OFF Normalerweise erzeugt jedes empfangene <CTRL G> einen kur-

+                 zen Signalton. Wenn das stört, kann die Tonausgabe mit BELL

+                 OFF abgeschaltet werden. 

+ 

+CUR FLH CUR STD  Cursordarstellung. CUR FLH zeigt einen blinkenden CUR OFF

+                 Cursorblock. CUR STD zeigt einen nichtblinkenden Cursor-

+                 block. CUR OFF schaltet den Cursor ab (unsichtbar). 

+ 

+F STRG  F CODE   Funktionstastenbelegung. Ist F STRG eingeschaltet, erzeugt

+                 eine programmierte (belegte) Funktionstaste keinen Tasten-

+                 code, sondern sendet die programmierten Zeichen. Eine unbe-

+                 legte Funktionstaste sendet ihren Tastencode. Ist F CODE

+                 eingeschaltet, erzeugen auch belegte Funktionstasten einen

+                 Tastencode und senden keine programmierten Zeichen. 

+ 

+ 

+#k("3.4", "Die zweite Kommandozeile")# 

+ 

+Die erste Zeile zeigt Defaultwerte für <SHIFT R>: 

+ 

+#type ("micron")# 

+STATOFF|TXT| 9600|STOP 1|DATA 8|NO  PAR|NO XONOFF|NO RTSCTS|NO DTRDSR 

+STAT ON GFX 19200 STOP 2 DATA 7 EVN PAR  XON/XOFF  RTS/CTS   DTR/DSR 

+               50               ODD PAR 

+               75 

+            109.9 

+            134.6 

+              150 

+              300 

+              600 

+             1200 

+             1800 

+             2400 

+             3600 

+             4800 

+             7200 

+#type ("elite")# 

+ 

+Default Andere   Funktion 

+#linie ("16.2")# 

+STATOFF STAT ON  Anzeige der Statuszeile. Der Arbeitsbereich des Bildschirms

+                 beträgt zwar immer 24 Zeilen, allerdings ist bei STAT ON

+                 anstelle der 24. Textzeile die Statuszeile sichtbar. Bei

+                 STATOFF wird der aktuelle Inhalt der 24. Textzeile sicht-

+                 bar. Einzelheiten s.u. (Die Statuszeile) 

+ 

+TXT     GFX      Textmodus/Graphikmodus. TXT schaltet in die 80x24 Zeichen

+                 Textdarstellung um. GFX schaltet auf die aktuelle Graphik-

+                 seite um. 

+ 

+9600    19200    Wählt die Baudrate für die serielle Schnittstelle. 

+           50    Die Angabe erfolgt in Bits/Sekunde (Baud) 

+           75 

+          109.9 

+          134.6 

+          150 

+          300 

+          600 

+         1200 

+         1800 

+         2400 

+         3600 

+         4800 

+         7200 

+ 

+STOP 1  STOP 2   Wählt die Anzahl der Stopbits für die serielle Schnitt-

+                 stelle. 

+ 

+DATA 8  DATA 7   Wählt die Anzahl der Datenbits für die serielle Schnitt-

+                 stelle. 

+ 

+NO PAR  EVN PAR  Wählt Parity Check Art. NO PAR = Kein Paritätsbit, keine 

+        ODD PAR  Paritätsprüfung. EVN PAR = Gerade Parität, ODD PAR = Unge-

+                 rade Parität. 

+ 

+NO XONOFF        Wählt XON (CTRL Q) und XOFF (CTRL S) als Protokoll für die 

+        XON/XOFF serielle Schnittstelle. Wird XOFF vom Host gesendet, kann

+                 das Terminal noch 255 Zeichen empfangen, bis der Empfangs-

+                 puffer überläuft. Mit NO XONXOFF wird dieses Protokoll

+                 ausgeschaltet. 

+ 

+NO RTSCTS        Wählt RTS/CTS als Protokoll für die serielle Schnittstel-

+        RTS/CTS  le. Mit NO RTSCTS wird dieses Protokoll ausgeschaltet. 

+ 

+NO DTRDSR        Wählt DTR/DSR als Protokoll für die serielle Schnittstel-

+        DTR/DSR  le. Mit NO DTRDSR wird dieses Protokoll ausgeschaltet. 

+ 

+#page# 

+#h("4.", "Die Statuszeile")# 

+ 

+ 

+Die Statuszeile enthält 5 Felder, die über die wichtigsten Betriebszustände

+des Terminals Auskunft geben. Die Statuszeile ersetzt die (dann in den 'Hin-

+tergrund' verlegte) 24. Zeile. Die Statuszeile kann in der Kommandozeile mit

+STAT ON oder vom Host oder im Local Modus mit 

+ 

+                         #ib(1)#<ESC> }#ie(1)#   (Hex 1B 7D) 

+ 

+eingeschaltet werden. Ausschalten ebenso mit STATOFF oder 

+ 

+                         #ib(1)#<ESC> {#ie(1)#   (Hex 1B 7B) 

+ 

+Die Zuordnung der Felder: 

+ 

+#type ("micron")# 

+Spooler | Empfängerpuffer | Senderpuffer | Bereit/Beschäftigt | Local/Online

+#type ("elite")# 

+ 

+Kritische Zustände werden invers markiert. Dies sind alle Fälle, in denen

+ein Puffer überläuft. 

+Ist dies beim Empfangspuffer der Fall (RX FULL), gehen Daten verloren. 

+Sollte der Druckerpuffer voll sein (PR FULL) und das Terminal keine Eingabe

+mehr annehmen, kann man durch längeres Drücken von <SHIFT ESC> Zeichen aus

+dem Druckerpuffer entfernen, damit wieder Platz frei wird. 

+Sollte der Senderpuffer voll sein (TX FULL), so liegt das wahrscheinlich

+daran, daß der Host kein XON gesendet hat oder dieses falsch übertragen

+wurde. Durch Drücken von <SHIFT ESC> kann man den Transmitter wieder star-

+ten. 

+ 

+ 

+#k("4.1", "Spoolerstatus")# 

+ 

+- Ein leeres Feld bedeutet: Der Spooler (Druckerpuffer) ist leer, es ist

+  nichts zum Drucken im Puffer. 

+ 

+- PRINT zeigt an: Der Spooler ist gefüllt. Das Terminal ist druckwillig oder

+  der Drucker druckt. 

+ 

+- PR FULL bedeutet: Der Druckerpuffer ist voll. Da das Terminal keine wei-

+  teren Zeichen annimmt bis wieder Platz im Druckerpuffer ist, kann man

+  einzelne Zeichen mit <SHIFT ESC> aus dem Druckerpuffer entfernen bis PRINT

+  im Feld erscheint. 

+ 

+ 

+#k("4.2", "Empfängerstatus")# 

+ 

+- Ein leeres Feld bedeutet: Im Empfängerpuffer ist noch Platz. 

+ 

+- RX FULL zeigt an: Es gehen Empfangsdaten verloren, da der Empfängerpuffer

+  voll ist. 

+ 

+ 

+#k("4.3", "Senderstatus")# 

+ 

+- TX ON bedeutet: Der Sender ist eingeschaltet. Wenn jetzt ein Zeichen ge-

+  sendet werden muß, wird es sofort auf die serielle Schnittstelle ge-

+  schickt. 

+  Ein > vor TX ON zeigt an, daß das Terminal auf Freiwerden der seriellen

+  Schnittstelle wartet. 

+ 

+- TX OFF bedeutet: Der Host hat entweder XOFF gesendet oder die Hardware-

+  flußkontrolle aktiviert, um das Terminal zu stoppen. 

+ 

+- TX FULL zeigt an: Der Senderpuffer ist voll. Das Terminal nimmt keine

+  Eingaben mehr an bis der Puffer wieder frei ist. Dies kann mit <SHIFT ESC>

+  erzwungen werden. 

+ 

+ 

+#k("4.4", "Busy - Anzeige")# 

+ 

+- READY bedeutet: Der Empfänger ist empfangsbereit, d.h. im Empfangspuffer

+  sind noch mindestens 256 Zeichen frei und das Terminal hat den Host nicht

+  per Flußkontrolle gestoppt. 

+ 

+- BUSY bedeutet: Der Empfänger hat dem Host per Flußkontrolle angezeigt, daß

+  nicht mehr genügend Platz im Empfangspuffer war. Die Flußkontrolle wird

+  wieder freigegeben, wenn nur noch 256 Bytes im Empfangspuffer sind. 

+  (Warnung: Wenn BUSY angezeigt wird, eine Taste gedrückt wird und der Host

+  #on("u")#nicht#off("u")# empfangsbereit ist, gerät das Terminal in eine

+  "Deadlock-Situation", die (mit Datenverlust) nur durch einen Hardwarereset

+  abgebrochen werden kann.) 

+ 

+ 

+#k("4.5", "Online/Local - Anzeige")# 

+ 

+- ONLINE bedeutet: Das Terminal sendet Tasteneingaben an den Host und emp-

+  fängt Zeichen und Kommandos vom Host. 

+ 

+- LOCAL bedeutet: Keyboardeingaben erscheinen auf dem Bildschirm bzw. blei-

+  ben innerhalb des Terminals. Escape-Kommandos wirken direkt auf das Ter-

+  minal. 

+ 

+#page# 

+#h("5.", "Die Bedeutung der Tasten")# 

+ 

+ 

+Zusätzlich zu den normalerweise von der Tastatur gesendeten Tastencodes sind

+einige weitere zur Verfügung gestellt worden. Beim Apple senden fast alle

+Tasten mit Open-Apple zusammen einen Code mit Bit 7 = 1. Diese werden vom

+Terminal als Funktions- oder Steuertasten interpretiert. Beim Basis wurden

+einige bisher nur einfach belegte Tasten wie <RETURN>, <TAB>, <ESC>, <CE>

+und der Zehnerblock mit Doppelfunktionen über <SHIFT> versehen. 

+ 

+ 

+#k("5.1", "Die Funktions- und Steuertasten")# 

+ 

+Zuerst werden die Tastenfunktionen erläutert für ein nicht emulierendes

+Terminal. Die TVI-Emulation kann in der Kommandozeile abgeschaltet werden

+(1. Zeile, 2. Feld) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 0#ie(1)#    (Hex 1B 20 30) 

+ 

+Die Cursortasten liefern beim Basiskeyboard andere Tastencodes als beim

+Applekeyboard. Wird das Bit 7 ignoriert (ausgeblendet), stimmen die Codes

+überein. <TOPLEFT> bezeichnet beim Basiskeyboard die linke obere Eckposi-

+tion des Cursorblocks, <TOPRIGHT> die rechte obere etc. 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#linie ("16.2")# 

+<TAB>            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten. Also 1, 9, 17, 25, 33, 41, 49,

+                                       57, 65, 73. War der Cursor in Spalte

+                                       73 bis 79, dann wird er in die erste

+                                       Spalte der nächst tieferen Bild-

+                                       schirmzeile gesetzt. War der Cursor

+                                       vorher auch noch in Zeile 24, dann

+                                       wird der Bildschirminhalt entweder

+                                       nach oben gescrollt (SCROLL) oder in

+                                       Homeposition gebracht (PAGE). 

+ 

+<SHIFT TAB>      <OA TAB>      89      Back-Tab (Rückwärtstabulator). Der

+                                       Cursor wird in die nächste links vom

+                                       Cursor befindliche Tabulatorposition

+                                       gebracht. War der Cursor in Spalte 1,

+                                       dann steht er jetzt in Spalte 73 der

+                                       darüberliegenden Zeile. War der Cur-

+                                       sor in Homeposition, dann ändert sich

+                                       seine Position nicht. 

+ 

+<SHIFT CE>       <OA CTRL X>    -      Kommandozeile aktivieren. Einzelhei-

+                                       ten zur Kommandozeile siehe Abschnitt

+                                       3.: Die Kommandozeilen. 

+ 

+<CE>             <CTRL X>      18      U.a. Kommandozeile verlassen. 

+ 

+<RETURN>         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub.

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+<SHIFT RETURN>   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten (24.) Bild-

+                                       schirmzeile war, wird der Bildschir-

+                                       minhalt entweder nach oben gescrollt

+                                       (SCROLL) oder in Homeposition ge-

+                                       bracht (PAGE). 

+ 

+<UP>             <UP>       8B/0B      Cursor eine Zeile höher. War der

+                                       Cursor in der ersten Bildschirmzei-

+                                       le, ändert sich seine Position nicht. 

+ 

+<DOWN>           <DOWN>     8A/0A      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann wird der

+                                       Bildschirminhalt entweder nach oben

+                                       gescrollt (SCROLL) oder der Cursor in

+                                       die erste Bildschirmzeile gesetzt

+                                       (PAGE). 

+ 

+<CTRL V>         <CTRL V>      16      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+<LEFT>           <LEFT>     88/08      Cursor eine Spalte nach links. War

+                                       der Cursor in der ersten Bildschirm-

+                                       spalte, dann steht er jetzt in der

+                                       letzten Spalte der darüberliegenden

+                                       Bildschirmspalte. War der Cursor

+                                       allerdings in Homeposition, ändert

+                                       sich seine Position nicht. 

+ 

+<RIGHT>             -          95      Cursor eine Spalte nach rechts. War

+                                       der Cursor in Spalte 79, dann steht

+                                       er jetzt in der ersten Spalte der

+                                       folgenden Zeile. War der Cursor in

+                                       der letzten Zeile, dann wird der

+                                       Bildschirminhalt um eine Zeile nach

+                                       oben gescrollt (SCROLL) oder der

+                                       Cursor in Homeposition gebracht

+                                       (PAGE). 

+ 

+<HOME>           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+<SHIFT HOME>     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+ 

+<DELETE>         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm als Punktraster dargestellt.

+                                       Der Host interpretiert es in der

+                                       Regel als Zeichenlöschbefehl. 

+ 

+<TOPLEFT>        <OA CTRL N>   8E      Zeichen bei Cursorposition einfügen.

+                                       Der Cursor ändert seine Position

+                                       nicht. Unter dem Cursor steht dann

+                                       ein Leerzeichen. Das Zeichen in Spal-

+                                       te 79 geht verloren. 

+ 

+<SHIFT TOPLEFT>  <OA CTRL B>   82      Zeichen unter Cursorposition löschen.

+                                       In Spalte 79 steht dann ein Leerzei-

+                                       chen. 

+ 

+<TOPRIGHT>       <OA CTRL O>   8F      Zeile bei Cursorposition einfügen.

+                                       Die Cursorposition ändert sich nicht.

+                                       Der Inhalt der letzten Bildschirmzei-

+                                       le ist verloren. Die Zeile in der der

+                                       Cursor steht wird mit Leerzeichen

+                                       gefüllt. 

+ 

+<SHIFT TOPRIGHT> <OA CTRL C>   83      Zeile in der der Cursor steht lö-

+                                       schen. Die Cursorposition ändert sich

+                                       nicht. Der Inhalt der gelöschten

+                                       Zeile ist verloren. Die letzte Bild-

+                                       schirmzeile wird mit Leerzeichen

+                                       aufgefüllt. 

+ 

+<BOTTOMLEFT>     <BACKSPACE>   08      Cursor eine Spalte nach links. Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+<BOTTOMRIGHT>    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts. Die Funktion ist mit der von

+                                       <RIGHT> identisch. 

+ 

+<SHIFT BOTTOMRIGHT> <OA RIGHT> EF      Diese Taste ist eine programmierbare

+                                       Funktionstaste (siehe <ESC> e). 

+ 

+<SHIFT DELETE>   <OA DELETE>   81      Diese das liefert den

+                                       Makroparametercode (siehe <ESC> e). 

+ 

+<ESC>            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+<SHIFT ESC>      <OA ESC>      9B      Während der Funktionstastedefinition

+                                       wirkt diese Taste wie ein Local

+                                       Escape, sonst liefert sie den Code 9B.

+                                       (siehe <ESC> e). 

+                                       

+<SHIFT CTRL HOME><OA 0>         -      Local/Online umschalten. 

+ 

+<CTRL HOME>      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...    <OA a> ...    E1 ...  programmierbare Funktionstasten 

+<SHIFT 9>        <OA i>        E9             "               " 

+<SHIFT 0>        <OA j>        EA             "               " 

+<SHIFT .>        <OA k>        EB             "               " 

+<SHIFT +>        <OA l>        EC             "               " 

+<SHIFT ->        <OA m>        ED             "               " 

+ 

+<SHIFT BOTRIGHT> <OA RIGHT>    EF             "               " 

+ (Dieser Code wird beim RESET des 

+ Terminals ausgeführt. Der Benut- 

+ zer kann damit das Terminal nach 

+ seinen Wünschen konfigurieren.) 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+<F1> ...         <OA A> ...    C1             "               " 

+<F15>            <OA O>        CF             "               " 

+<SHIFT F1> ...   <OA Q> ...    D1             "               " 

+<SHIFT F15>      <OA _>        DF             "               " 

+<CTRL F1> ...    <OA !> ...    A1             "               " 

+<CTRL F15>       <OA />        AF             "               " 

+<SHIFT CTRL F1>..<OA 1> ...    B1             "               " 

+<SHIFT CTRL F15> <OA ?>        BF             "               " 

+ 

+Die Programmierung der Funktionstasten geschieht mit #ib(1)#<ESC> e#ie(1)#. 

+ 

+ 

+#k("5.2", "Die TVI-Emulation")# 

+ 

+Wird das Terminal in den TVI-Emulationsmode gebracht, dann senden einige

+Tasten andere Tastencodes oder Codesequenzen. Die Bedeutung der Escape-

+Sequenzen ändert sich dadurch nicht. 

+Der TVI-Modus kann in der Kommandozeile eingeschaltet werden (1. Zeile, 2.

+Feld) oder durch 

+ 

+                         #ib(1)#<ESC> <SPACE> 1#ie(1)#    (Hex 1B 20 31) 

+ 

+An dieser Stelle erscheinen nur noch die Tastenbezeichnungen des Basiskey-

+boards. Die entsprechenden Tasten, die beim Applekeyboard zu drücken sind,

+kann man im letzten Abschnitt nachlesen. 

+ 

+Folgende Tasten senden andere Tastencodes: 

+ 

+Taste       TVI-Code(sequenz)       Bemerkung 

+#linie ("16.2")# 

+<RIGHT>     0C    #ib(1)#<CTRL L>#ie(1)#          Cursor nach rechts 

+ 

+<HOME>      1E    #ib(1)#<CTRL SHIFT ^>#ie(1)#    Cursor in Homeposition 

+ 

+<CLEAR>     1A    #ib(1)#<CTRL Z>#ie(1)#          Durch Drücken von <SHIFT HOME> 

+                                    Bildschirm löschen und Cursor Home 

+ 

+<DEL CHAR>  1B 57 #ib(1)#<ESC> W#ie(1)#           Durch Drücken von <SHIFT TOPLEFT> 

+                                    Zeichen löschen 

+ 

+<DEL LINE>  1B 52 #ib(1)#<ESC> R#ie(1)#           Durch Drücken von <SHIFT TOPRIGHT> 

+                                    Zeile löschen 

+ 

+<INS CHAR>  1B 51 #ib(1)#<ESC> Q#ie(1)#           Durch Drücken von <TOPLEFT> 

+                                    Zeichen einfügen 

+ 

+<INS LINE>  1B 45 #ib(1)#<ESC> E#ie(1)#           Durch Drücken von <TOPRIGHT> 

+                                    Zeile einfügen 

+ 

+<LEFT>      08    #ib(1)#<BACKSPACE>#ie(1)#       Cursor nach links 

+ 

+<BACK TAB>  1B 49 #ib(1)#<ESC> I#ie(1)#           Durch Drücken von <SHIFT TAB> 

+                                    Rückwärtstabulator 

+ 

+<DOWN>      0A    #ib(1)#<LF>#ie(1)#              Cursor nach unten 

+ 

+<UP>        0B    #ib(1)#<CTRL K>#ie(1)#          Cursor nach oben 

+ 

+<NEWLINE>   1F    #ib(1)#<CTRL SHIFT _>#ie(1)#    Durch Drücken von <SHIFT RETURN> 

+                                    Waagenrücklauf und Zeilenvorschub 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+Für jede Funktionstaste, die nicht belegt wurde wird eine Codesequenz der

+Form <CTRL A> <code> <CR> also 01 <code> 0D gesendet. Für <code> gilt: 

+ 

+Taste             <code>    Hex-Code 

+<F1> ...            @ ...      40 ...   Diese Tasten sind auf fast allen 

+<F11>               J          4A       TVI-Terminals vorhanden. 

+<F12> ...           ` ...      60 ... 

+<F15>               c          63 

+ 

+<SHIFT F1> ...      K ...      4B ... 

+<SHIFT F15>         Y          59 

+ 

+ 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...       d ...      64 ... 

+<SHIFT 9>           l          6C 

+<SHIFT 0>           m          6D 

+<SHIFT .>           n          6E 

+<SHIFT +>           o          6F 

+<SHIFT ->           p          70 

+ 

+<SHIFT BOTRIGHT>    r          72 

+ 

+Alle nicht in dieser Tabelle aufgeführten Funktionstasten senden den Basis-

+tastencode. 

+ 

+#page# 

+#h("6.", "Der Graphikmodus")# 

+ 

+ 

+#k("6.1", "Allgemeines")# 

+ 

+Der Graphikmodus kann in der 2. Kommandozeile ein- und ausgeschaltet (Gra-

+phik: GFX, Text: TXT) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> $#ie(1)#    (Hex 1B 24) 

+ 

+eingeschaltet und mit dem Kommando 

+ 

+                         #ib(1)#<ESC> %#ie(1)#    (Hex 1B 25) 

+ 

+ausgeschaltet. 

+ 

+Die Auflösung beträgt in y-Richtung 280 Punkte und in x-Richtung 192 Punk-

+te, das sind 53760 Punkte. 

+ 

+ 

+#k("6.2", "Koordinaten und Parameterübergabe")# 

+ 

+Die Koordinaten für die Graphikkommandos dürfen den Bereich von -32768 bis

+32767 überstreichen. Der sichtbare Bereich ist für die X-Koordinate 0..279

+und für die Y-Koordinate von 0..191. Der Ursprung (d.h. der Punkt (0,0) )

+des Koordinatensystems ist die linke untere Ecke. Die Graphikroutinen zeic-

+hnen nur innerhalb des sichtbaren Bereichs (Clipping). 

+ 

+ 

+#k("6.2.1", "Cursorposition/Fadenkreuz")# 

+ 

+Der Graphikcursor ist ein gedachter unsichtbarer Punkt, der sich im gesam-

+ten (auch unsichtbaren) Bereich des Koordinatensystems befinden kann. Wenn

+sich der Cursor im sichtbaren Bereich befindet, dann kann man an der Posi-

+tion ein Fadenkreuz darstellen. Das Fadenkreuz kann mit 

+ 

+                         #ib(1)#<CTRL X>#ie(1)# oder #ib(1)#<CE>#ie(1)#    (Hex 18) 

+ 

+ein- und ausgeschaltet werden. Das Fadenkreuz wird Exklusiv-Oder (XOR) ge-

+zeichnet. Das heißt, daß die Punkte an der Stelle des Fadenkreuzes inver-

+tiert (umgedreht) werden. Das hat wiederum zur Folge, daß an der Graphik-

+seite nichts verändert wird, wenn zweimal <CTRL X> gesendet wird. Solange

+der Bereich oder die Position des Fadenkreuzes nicht verändert wird, können

+zwischen den beiden <CTRL X> Kommandos auch andere Graphikkommandos ausge-

+führt werden. 

+ 

+ 

+#k("6.2.2", "Binäre oder dezimale Parameter")# 

+ 

+Die Übergabe der x/y Koordinaten, eines Radius oder relativer Koordinaten

+und in einigen Fällen auch anderer Parameter, kann auf zwei verschiedene

+Arten erfolgen. Das Terminal erkennt die Übergabeart am ersten Parameterby-

+te: 

+Bei dezimalen Parametern ist dies entweder <SPACE>, +, - oder eine Zahl. Bei

+Binären Parametern liegt das Höherwertige Byte (das erste!) im Bereich von

+00..1F oder 3A..FF. Die Festlegung auf dezimale oder binäre Parameter gilt

+für beide (X und Y) Koordinaten. 

+ 

+ 

+#k("6.2.2.1", "Binäre Parameter")# 

+ 

+Binäre Parameter sind eine Folge von vier Bytes (mit 8 Bits). Die ersten

+beiden Bytes stellen die X-Koordinate dar, die anderen beiden Bytes die

+Y-Koordinate. Negative Koordinaten oder negative relative Koordinaten wer-

+den durch Bilden des Zweierkomplements dargestellt. 

+Zu beachten ist, daß zuerst das höherwertige (Highbyte) und dann das nie-

+derwertige (Lowbyte) gesendet werden muß. 

+ 

+Der Vorteil der binären Parameter ist, daß die Parameterübergabe schneller

+ist als bei dezimalen Parametern, da weder Host noch Terminal eine Konver-

+tierung vornehmen müssen und die Anzahl der Parameterbytes in der Regel

+geringer ist als bei dezimaler Parameterübergabe. 

+ 

+Der Nachteil ist, daß bei XON/XOFF Flußkontrolle einige Zahlen als XON oder

+XOFF interpretiert werden können und daß diese Parameter nicht auf Funk-

+tionstasten gelegt werden können, wenn sie Zeichen > Hex 7F enthalten. 

+ 

+ 

+#k("6.2.2.2", "Dezimale Parameter")# 

+ 

+Dezimale Parameter bestehen aus einer Folge von ASCII-Zeichen. Die beiden

+Koordinaten werden durch einen Separator (Komma, CR, Semikolon o.ä.) ge-

+trennt. Nach dem 2. Parameter steht ein weiterer Separator. An beliebiger

+Stelle in und vor den Zahlen dürfen Leerzeichen (<SPACE>) oder Pluszeichen

+(+) stehen, die keine Änderung des Ergebnisses bewirken. Ein Minuszeichen

+vor einer Zahl negiert sie. 

+ 

+Der Vorteil der dezimalen Parameter ist, daß sie in höheren Programmier-

+sprachen bequem und lesbar in ein Programm geschrieben werden können und daß

+keine Steuerzeichen vorkommen, die die XON/XOFF - Flußkontrolle stören könn-

+ten. Außerdem können diese Parameter immer auf Funktionstasten gelegt wer-

+den, da sie keine Codes > Hex 7F enthalten. 

+ 

+Der Nachteil ist wie unter 6.2.2.1 geschrieben, die Zeitdauer der zweima-

+liegen Konvertierung (Host, Terminal) und die in der Regel längeren Parame-

+ter. 

+ 

+ 

+#k("6.2.3", "Absolute oder relative Koordinaten")# 

+ 

+Bei den Move- und Drawbefehlen hat man die Wahl zwischen relativen und abso-

+luten Koordinaten. 

+ 

+Absolute Koordinaten setzen den Graphikcursor direkt auf die als Parameter

+angegebene Position. Z.B. <ESC> v 200, 100; setzt den Cursor direkt auf die

+Position X=200, Y=100. Die meisten Programme unterstützen nur absolute Koor-

+dinaten. 

+ 

+Relative Koordinaten werden zur aktuellen Position des Graphikcursors ad-

+diert. Das hat den Vorteil, daß eine Routine nicht zu wissen braucht, wo der

+Graphikcursor gerade steht. Man kann sich zum Beispiel Folgen von relativen

+Move's und Draw's auf Funktionstasten legen, die dann im Localmodus an der

+aktuellen Cursorposition irgendwelche Symbole oder Sonderzeichen zeichnen.

+Z.B. <ESC> q -4, 3; bewegt den Graphikcursor 4 Punkte nach links und 3 Punk-

+te nach oben. 

+ 

+ 

+#k("6.2.4", "Byteparameter")# 

+ 

+Byteparameter sind solche, die nur aus einem Byte bestehen. Die Werte kön-

+nen also normalerweise von 0 bis 255 oder Hex 00 bis Hex FF. In den Fällen,

+in denen nicht der ganze Wertebereich genutzt wird, werden nur die nieder-

+wertigsten Bits ausaskiert, die höherwertigen werden ignoriert, wenn nicht

+ausdrücklich etwas anderes angegeben ist. Im Bereich von 0 bis 7 sind Wert

+und ASCII-Ziffer identisch. Bei Werten großer als 9 geht das allerdings

+nicht mehr. Sind zum Beispiel die Werte von 0 bis 15 erlaubt, dann kann man

+folgende Tabelle benutzen: 

+ 

+#on("u")#Wert   ASCII (Hex) oder Binär#off("u")# 

+  0      0     30        00 

+  1      1     31        01 

+  2      2     32        02 

+  3      3     33        03 

+  4      4     34        04 

+  5      5     35        05 

+  6      6     36        06 

+  7      7     37        07 

+  8      8     38        08 

+  9      9     39        09 

+ 10      :     3A        0A 

+ 11      ;     3B        0B 

+ 12      <     3C        0C 

+ 13      =     3D        0D 

+ 14      >     3E        0E 

+ 15      ?     3F        0F 

+ 

+Für Werte zwischen 0 und 31 benutzt man dann besser die Buchstaben (Groß-

+buchstaben und [\]^_ oder Kleinbuchstaben und {|}~ und <DEL>). Die Zuord-

+nung entnimmt man der ASCII-Tabelle in Anhang A. 

+ 

+ 

+#k("6.3", "Die Graphikparameter")# 

+ 

+Für die Linien und Zeichen in der Graphik gibt es verschiedene Darstellungs-

+weisen. Man kann die Strichdicke, die Farbe (auf einem Monochrommonitor die

+Helligkeit), den Linientyp (durchgehend, gepunktet, gestrichelt etc.) und

+die Bitverknüpfungen (löschen, invertieren...) festlegen. Diese Parameter

+werden mit einem Kommando <ESC> O <n> ... verändert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden all diese Parameter auf Defaultwerte zurückgesetzt. Diese Default-

+werte sind: Strichdicke 1, durchgehende Linie, OR-Bitverknüpfung (Punkte

+setzen), helle Farbe (gelb). Ausserdem wird die Seite 0 als sichtbare und

+als Arbeitsseite gewählt. Es wird auf ganzseitige Graphik geschaltet (falls

+im Graphikmodus). 

+ 

+ 

+#k("6.3.1", "Strichdicke")# 

+ 

+Die Strichdicke einer Linie ist normalerweise 1. Die Strichdicke 2 zeichnet

+parallel zur ursprünglichen Linie auf beiden Seiten jeweils eine weitere

+Linie der gleichen Länge. Die Strichdicke 3 zeichnet dann auf beiden Seiten

+jeweils zwei parallele Linien usw. Die Strichdicke kann von 1 bis 15 ge-

+wählt werden. Sie wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 1#ie(1)# <dicke>   (Hex 1B 4F 31 <dicke>) 

+ 

+eingestellt. <dicke> ist ein Byteparameter (Kapitel 6.2.4) mit dem Wertebe-

+reich 1 bis 15. 

+ 

+ 

+#k("6.3.2", "Farbe/Helligkeit")# 

+ 

+Normalerweise ist Gelb (hell) eingestellt. Die Alternative ist Violett (dun-

+kel). Jeweils 7 nebeneinanderliegene Graphikpunkte haben die gleiche Farbe.

+Auf einem Farbmonitor kann die Farbe auch noch durch den Inhalt dieser 7

+Graphikpunkte bestimmt werden. Der Farbmodus wird von diesem Terminalpro-

+gramm allerdings nicht unterstützt, da sich dann die Auflösung in X-Richtung

+halbiert (also nur noch 140 x 192 Punkte). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 2#ie(1)# <n>    (Hex 1B 4F 32 <n>) 

+ 

+kann die Helligkeit eingestellt werden. <n> ist ein Byteparameter bei dem

+nur das Bit 0 wichtig ist: 

+ 

+Bit 0   Bedeutung 

+  0     dunkel/Violett     <n> ist eine gerade Zahl 

+  1     hell/Gelb          <n> ist eine ungerade Zahl 

+ 

+ 

+#k("6.3.3", "Linientyp")# 

+ 

+Der Linientyp ist das "Muster" der Striche. Es gibt 7 vordefinierte Strich-

+muster und ein vom Benutzer definiertes. Der Linientyp (im folgenden auch

+Pattern genannt) wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 3#ie(1)# <n>    (Hex 1B 4F 33 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 7. Die

+Strichtypen sind <n> folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bitmuster (16 Bit)  Name                    #off("u")# 

+ 0                       unsichtbare Linie 

+ 1   ----------------    durchgehende Linie 

+ 2   - - - - - - - -     gepunktete Linie 

+ 3   ----    ----        kurz gestrichelte Linie 

+ 4   --------            lang gestrichelte Linie 

+ 5   --------    -       Strichpunktlinie 

+ 6   -   -   -----       Strich-Punkt-Punkt Linie 

+ 7   - - - -  - - - -    Benutzerdefinierte Linie 

+                         (Hier Defaultangabe) 

+ 

+Die Bitmuster sind immer 16 Bit lang. Nach einem Movebefehl startet der

+nächste Draw-Befehl mit dem linkesten (niederwertigsten!) Bit des Bitmu-

+sters. Das Muster wiederholt sich bei längeren Linien zyklisch. Wird zwi-

+schen zwei Draw-Befehlen kein Move-Befehl gegeben, dann setzt der zweite

+Draw-Befehl im Bitmuster nach der gleichen Stelle fort, an der der erste

+Draw-Befehl aufgehört hat. Auch dicke Linien behalten das Linienmuster bei,

+man sollte dann allerdings von gepunkteter auf lang gestrichelte Linie über-

+gehen, wenn man eine gepunktete dicke Linie haben will. 

+ 

+ 

+#k("6.3.3.1", "Selbstdefinierte Linientypen (Pattern)")# 

+ 

+Wie in 6.3.3 angemerkt kann ein Linientyp auch vom Benutzer selbst definiert

+werden. Da die Länge 16 Bit ist, kann man mit den relativen Move's und

+Draw's zusammen gut kleine Bildchen (Icons) zusammenstellen. Eine Hilfe ist

+dabei auch die Bitverknüpfung COPY, die im nächsten Abschnitt erläutert

+wird. Man legt dazu zuerst das 16 Bit-Pattern als jeweils eine Zeile des

+Icons fest und zieht dann von links nach rechts eine 16 Punkte lange Linie

+mit dem benutzerdefinierten Pattern. Nach einem relativen Move (-16, -1)

+kann der Vorgang für die nächste Zeile fortgesetzt werden. 

+ 

+Das benutzerdefinierbare Pattern wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 6#ie(1)# <l> <h>    (Hex 1B 4F 36 <l> <h>) 

+ 

+festgelegt. <l> ist dabei das niederwertige (Lowbyte) des Bitmusters, <h>

+ist das höherwertige (Highbyte) des Bitmusters. Wenn das Pattern als Muster

+für Linien (und nicht für Icons) benutzt wird, dann sollte man darauf ach-

+ten, daß das Bit 0 im Lowbyte 1 ist, damit man bei kurzen Linien, denen ein

+Move vorangegangen ist, zumindestes einen Punkt sieht. 

+ 

+ 

+#k("6.3.4", "Bitverknüpfungen")# 

+ 

+Über Bitverknüpfungen werden die Punkte auf der Graphikseite verändert. Das

+Linienmuster wird dazu zyklisch punktweise abgetastet und jenachdem ob das

+aktuelle Bit im Linienbitmuster 0 oder 1 ist eine Veränderung der Graphik-

+seite durchgeführt. 

+Bis auf die COPY-Funktion wirken die Bitverknüpfungen nur auf die Graphik-

+seite, wenn der aktuelle Punkt im Linientyp-Bitmuster 1 ist. 

+ 

+- Das Zeichnen einer sichtbaren Linie mit weißen Punkten geschieht zum Bei-

+  spiel durch eine OR- (Oder-) Verknüpfung. 

+ 

+- Das Löschen einer Linie (also das Zeichnen von "schwarzen" Punkten) ge-

+  schieht mit einer AND- (Und-) Verknüpfung (Genau genommen eine NAND-, d.h.

+  negierte AND-Verknüpfung). 

+ 

+- Das Invertieren (d.h. Weißer Punkt wird schwarz, schwarzer Punkt wird

+  weiß) kann man mit einer XOR- (Exklusiv-Oder-) Verknüpfung erreichen. 

+ 

+- Für Icons (siehe 6.3.3.1) und andere Zwecke, gibt es noch die COPY-Funk-

+  tion, die eigentlich keine einzelne Bitverknüpfung ist. Ist im Linientyp

+  das aktuelle Bit 0, dann wird in der Graphikseite eine AND-Verknüpfung

+  durchgeführt (d.h. der Punkt wird gelöscht) ist das aktuelle Bit im Li-

+  nientyp 1, dann wird eine OR-Verknüpfung durchgeführt (d.h. der Punkt wird

+  gelöscht). Der Effekt ist, daß genau das Bitmuster des Linientyps in der

+  Graphikseite erscheint ("kopiert" wird), egal was vorher da stand, wo die

+  Linie gezeichnet wurde. 

+ 

+Die Bitverknüpfung kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 4#ie(1)# <n>    (Hex 1B 4F 34 <n>) 

+ 

+festgelegt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+<n> hat folgende Bedeutung: 

+ 

+<n>  Bitverknüpfung         Verwendung 

+#linie ("16.2")# 

+ 0   OR (Oder)              Weiß (auf schwarzem Grund) zeichnen 

+ 1   AND (Und)              Schwarz (auf weißem Grund) zeichnen 

+ 2   XOR (Exklusiv Oder)    Schwarze und Weiße Punkte umdrehen (invertie-

+ ren) 

+ 3   COPY (kopieren)        Icons zeichnen oder Bilduntergrund überschrei-

+ ben 

+ 

+ 

+#k("6.3.5", "Multiparametereinstellung")# 

+ 

+Die obigen Parameter (bis auf Linientyp) können alle zugleich mit einem

+Kommando gesetzt werden. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> O 5#ie(1)# <n>    (Hex 1B 4F 35 <n>) 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 127. Die Bits sind

+folgendermaßen zugeordnet: 

+ 

+   Bit     Bedeutung        Werte 

+#linie ("16.2")# 

+ 0 .. 3  : Strickdicke      1 .. 15 

+ 4 .. 5  : Bitverknüpfung   0 = OR, 16 = AND, 32 = XOR, 48 = COPY 

+      6  : Farbe/Helligkeit 0 = Violett (dunkel), 64 = Gelb (hell) 

+ 

+Standardeinstellung ist also '<ESC> O 5 A'. 

+ 

+ 

+#k("6.4", "Graphikseiten")# 

+ 

+Das Terminal verwaltet zwei Graphikseiten mit einer Größe von jeweils 8k

+Byte (d.h. 8192 Bytes). 

+ 

+ 

+#k("6.4.1", "Die sichtbare Seite und die Arbeitsseite")# 

+ 

+Die beiden Graphikseiten können (müssen aber nicht) getrennt voneinander

+angezeigt und bearbeitet werden. Das kann sinnvoll sein, wenn eine Seite "im

+Hintergrund" aufbereitet werden soll, während die andere (schon aufbereite-

+te) Seite angezeigt wird. Man kann auch die 80-Zeichen Textseite anzeigen

+und eine oder beide Graphikseiten im Hintergrund aufbereiten. Durch abwec-

+hselndes Umschalten der Arbeits- und Anzeigeseite kann dann der Eindruck

+eines bewegten Bildes erzeugt werden. Um diesen Vorgang zu beschleunigen,

+kann man die Graphikseiten auch auf dem Host vorbereiten und (im Hinter-

+grund) an das Terminal senden (bei 19200 Baud dauert das pro Seite ca. 4.7

+Sekunden). 

+ 

+Die sichtbare und die Arbeitsseite können mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 7#ie(1)# <n>    (Hex 1B 4F 37 <n>) 

+ 

+gewählt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 7. 

+ 

+Bit 0 von <n> : Sichtbare Seite (0 oder 1) 

+Bit 1 von <n> : Arbeitsseite (0 oder 1) 

+Bit 2 von <n> : 1 = 80 Zeichen Textseite wird in den untersten 32 Graphik-

+                zeilen eingeblendet. 0 = Nur Graphikmode. 

+ 

+#on("u")#<n>     Sichtbar Arbeitsseite  Inhalt der untersten 32 Graphikzeilen#off("u")# 

+ 0      Seite 0  Seite 0       Graphik (Seite 0) 

+ 1      Seite 1  Seite 0       Graphik (Seite 1) 

+ 2      Seite 0  Seite 1       Graphik (Seite 0) 

+ 3      Seite 1  Seite 1       Graphik (Seite 1) 

+ 4      Seite 0  Seite 0       Text 

+ 5      Seite 1  Seite 0       Müll 

+ 6      Seite 0  Seite 1       Text 

+ 7      Seite 1  Seite 1       Müll 

+ 

+ 

+#k("6.4.1.1", "80-Zeichen Text und Graphik")# 

+ 

+Mit dem in 6.4.1 beschriebenen Kommando können, wie beschrieben, die unter-

+sten 4 Zeilen der Textzeile (d.h. ggf. auch die Statuszeile) statt der un-

+tersten 32 Graphikzeilen dargestellt werden. Da es nur eine Textseite gibt

+und jeder Graphikseite eine eigene Textseite zugeordnet ist, ist die Mi-

+schung von Text und Graphik in der Graphikseite 1 auf diese Weise nicht

+sinnvoll, da dann in den unstersten 32 Graphikzeilen nur Müll erscheint. Das

+Einblenden wird vom Terminal z.B. genutzt, wenn die Kommandozeile aktiviert

+wird. Man kann zum Beispiel Benutzerhinweise in die untersten 4 Zeilen der

+Textseite schreiben. Zeichenbefehle arbeiten in dem unsichtbaren (ausgeblen-

+deten) Teil der Graphikseite weiter. Das Ergebnis kann man sich beim Wieder-

+-Einblenden ansehen. 

+ 

+ 

+#k("6.4.2", "Aufbau einer Graphikseite")# 

+ 

+Eine Graphikseite besteht aus 8192 Bytes, von denen 7680 genutzt werden, 512

+sind somit (in der Graphikseite verstreut) ungenutzt. Jedes Byte besteht aus

+einem Farbbit (Bit 7) und 7 angezeigten Graphikbits. Ein gesetztes Bit ent-

+spricht einem sichtbaren Punkt auf dem Bildschirm. Das niederwertigste Bit

+eines Bytes wird am weitesten links angezeigt. 

+Jede der 192 Graphikzeilen besteht also aus 40 Bytes. Jeweils 8 Graphikzei-

+len sind zu Reihen zusammengefaßt. Es gibt also 24 Reihen. Jede erste Gra-

+phikzeile einer Reihe hat eine Anfangsadresse, die in folgender Tabelle

+aufgelistet ist: 

+ 

+#on("u")#Reihe  Adresse  Hex  |  Reihe  Adresse  Hex  |  Reihe  Adresse  Hex#off("u")# 

+  0        0    000  |    8      40     028  |   16      80     050 

+  1      128    080  |    9     168     0A8  |   17     208     0D0 

+  2      256    100  |   10     296     128  |   18     336     150 

+  3      384    180  |   11     424     1A8  |   19     464     1D0 

+  4      512    200  |   12     552     228  |   20     592     250 

+  5      640    280  |   13     680     2A8  |   21     720     2D0 

+  6      768    300  |   14     808     328  |   22     848     350 

+  7      896    380  |   15     936     3A8  |   23     976     3D0 

+ 

+Um den Offset den n. Graphikzeile in einer Reihe zu finden kann man folgen-

+de Tabelle benutzen: 

+ 

+#on("u")#n  Offset (Hex)#off("u")# 

+0      0   0000 

+1   1024   0400 

+2   2048   0800 

+3   3072   0C00 

+4   4096   1000 

+5   5120   1400 

+6   6144   1800 

+7   7168   1C00 

+ 

+Beispiel: 

+  Die Adresse des Punktes (123, 45) soll bestimmt werden. 

+  45 DIV 8 = 5, d.h. Y liegt in Reihe 5 mit Adresse 640 (Dezimal). 45 MOD 8

+                = 5, d.h. Y liegt in der n=5. Graphikzeile von Reihe 5. Der

+                Y-Offset also 5120. 

+  123 DIV 7 = 17 d.h. X liegt im Byte mit X-Offset 17. 

+  Die Adresse des Punktes ist also im Byte 17 + 5120 + 640 = 5777. 

+  123 MOD 7 = 4  d.h. Bit 4 in Byte 5777 ist der gesuchte Punkt. 

+ 

+ 

+#k("6.4.3", "Operationen auf den Graphikseiten")# 

+ 

+Hier sollen nur die Operationen erläutert werden, die nicht in andere Kate-

+gorien (z.B. Löschen, Linien zeichnen etc.) passen. 

+ 

+Es gibt ein universelles Kommando, mit dem zwei Graphikseiten invertiert,

+kopiert, gemischt und miteinander logisch verknüpft werden können. Verän-

+dert wird bei diesem Kommando nur die Arbeitsseite. 

+ 

+Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> !#ie(1)# <n>    (Hex 1B 21 <n>) 

+ 

+<n> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 15 und hat fol-

+gende Bedeutung: 

+ 

+<n>   Bedeutung 

+#linie ("16.2")# 

+ 0    Keine Veränderung. Kopiert die Arbeitsseite in sich selbst (Färbt die

+      Arbeitsseite allerdings mit der aktuellen Farbe/Helligkeit). 

+ 1    Die Arbeitsseite wird invertiert. 

+ 2    Mischt beide Seiten zusammen (OR Verknüpfung). 

+ 3    Mischt beide Seiten zusammen (OR) und invertiert das Ergebnis. 

+ 6    Bildet den Durchschnitt beider Seiten (AND Verknüpfung). 

+ 7    Bildet den Durchschnitt beider Seite (AND) und invertiert das Ergebnis

+10    Es sind die Punkte gesetzt, die in beiden Seiten verschieden sind (XOR

+      Verknüpfung). 

+11    Es sind die Punkte gesetzt, die in beiden Seiten gleich sind (d.h. das

+      Inverse von <n>=10). 

+14    Kopiert die andere Seite in die Arbeitsseite. 

+15    Kopiert das Inverse von der anderen Seite in die Arbeitsseite. 

+ 

+Andere Werte für <n> wiederholen sich in der Tabelle. Die ganze Arbeitssei-

+te hat nach der Operation die gewählte Farbe/Helligkeit. 

+ 

+ 

+#k("6.4.4", "Laden einer Graphikseite vom Host")# 

+ 

+Graphikseiten können ganz oder teilweise vom Host geladen werden. Das kön-

+nen auf dem Terminal erstellte und dann an den Host gesendete (Teil-)

+Graphiken sein, aber auch auf dem Host erstellte. In diesem Fall ist das

+Kapitel 6.4.2 (Aufbau einer Graphikseite) interessant. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> /#ie(1)# <ll> <lh> <al> <ah> <b...> 

+                                                    (Hex 1B 2F ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in die Arbeitsseite geladen wer-

+den. <lh>, <ll>, <ah>, <al> und <p...> sind Byteparameter (8 Bits). <ll> und

+<lh> bilden zusammen die binäre Länge, d.h. die Anzahl der Datenbytes

+<p...>, die die Graphik enthalten. Die Länge kann von 0 bis Hex 2000 (dezi-

+mal 8192) reichen. Die Adresse, durch <al> und <ah> gebildet, darf von 0 bis

+Hex 1FFF reichen. Zusätzlich gilt, daß die Summe von Länge und Adresse nicht

+größer als Hex 2000 sein darf, da sonst außerhalb der Graphikseite geladen

+würde. In einem dieser Fehlerfälle werden die folgenden Graphikdatenbytes

+ignoriert. Die Datenbytes werden dann als Kommandos interpretiert, was zu

+unvorhersehbaren Reaktionen des Terminals führt. 

+ 

+ 

+#k("6.4.5", "Graphik auf Diskette speichern/laden")# 

+ 

+Um Graphikseiten, zum Besipiel für Präsentationen, unabhängig vom Host auf

+dem Bildschirm darstellen zu können, benutzt man das Kommando 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+Man kann bis zu 8 verschiedene Graphikseiten vorbereiten, auf Diskette spei-

+chern und zu einem späteren Zeitpunkt wieder in das Terminal zurückladen.

+Dieses Kommando wird auch verwendet, um eine Textseite auf Diskette zu

+schreiben oder von Diskette zu lesen. <n> ist ein Byteparameter mit dem

+Wertebereich 0 bis 31, wobei die Bits folgendermaßen belegt sind: 

+ 

+Bit 0..2 : "Fachnummer" der Graphikseite auf der Diskette (0 bs 7) 

+Bit 3    : Bei Graphikseiten immer 1 (Bei Textseiten 0) 

+Bit 4    : 0 heißt: die Graphikseite wird von der Diskette gelesen, 

+           1 heißt: die Graphikseite wird auf die Diskette geschrieben. 

+ 

+Wird die Graphikseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Graphikseite überschrieben. 

+ 

+Wie bei allen Graphikkommandos, bezieht sich dieses Kommando nicht unbedingt

+auf die sichtbare Graphikseite, sondern auf die Arbeitsseite. 

+ 

+Beispiele: 

+    <ESC> S <CTRL H> liest die Graphikseite in Fach 0 in die Arbeitsseite. 

+    <ESC> S <CTRL X> schreibt die Arbeitsseite in Fach 0 der Diskette. 

+ 

+Da das Lesen einer Graphikseite von Diskette mit ca. 1.1 Sekunden, um eini-

+ges schneller als der Datentransfer vom Host ist, sollte man bewegte Graphi-

+ken auf Diskette vorbereiten und sie dann mit verschränkter Arbeits- und

+Sichtbarkeitsseite anzeigen. 

+Z.B.: Seite 1 als Arbeitsseite wählen, Seite 0 als sichtbare Seite. Graphik

+      von Diskette laden (wird in Seite 1 (= Arbeitsseite) geladen) Seite 1

+      als sichtbare Seite wählen, Seite 0 jetzt als Arbeitsseite wählen. Die

+      nächste Graphikseite wird von der Diskette in die Seite 1 geladen etc. 

+      Bei dieser Vorgehensweise scheinen Übergänge kontinuierlich zu sein. 

+ 

+Für Insider: Eine Graphikseite belegt zwei Tracks (8k). Die 8 Graphikseiten

+             befinden sich auf den Tracks 10 bis 25 in aufsteigender Reihen-

+             folge. 

+ 

+ 

+#k("6.5", "Textdarstellung im Graphikmodus")# 

+ 

+Nicht nur auf der 80-Zeichen Textseite können Buchstaben und Zeichen darge-

+stellt werden, sondern auch auf den Graphikseiten. Die Auflösung ist zwar

+nicht so groß wie auf der reinen Textseite, aber die Anzahl der verschiede-

+nen Darstellungsmöglichkeiten ist sehr viel größer. Fast alle Kommandos, die

+in der Textseite angewandt werden können, haben in der Graphikseite die

+gleiche Funktion. 

+ 

+Textdarstellung in der Graphikseite ist hauptsächlich zum Beschriften von

+Graphiken oder zum Drucken von Überschriften etc. vorgesehen. Da aber fast

+alle Textkommandos (Delete/Insert Line/Character fehlt) auch im Graphikmo-

+dus zur Verfügung stehen, kann man auch im Graphikmodus Textverarbeitung

+oder Editor benutzen. 

+ 

+ 

+#k("6.5.1", "Zeichendarstellung")# 

+ 

+Die normale Größe eines Zeichens ist 6 x 10 Punkte (x * y), damit lassen

+sich 46 x 19 Zeichen (874 Zeichen) voll auf dem Bildschirm darstellen. Wenn

+die Größe mit einem Kommando auf 5 x 8 Punkte verringert wird, dann lassen

+sich 56 x 24 Zeichen (1344 Zeichen) auf dem Bildschirm darstellen. Komfor-

+table Textverarbeitung läßt sich damit natürlich nicht machen, zumal die

+Geschwindigkeit, mit der die Zeichen auf den Bildschirm geschrieben werden

+gegenüber der der reinen Textseite langsamer ist. 

+ 

+ 

+#k("6.5.1.1", "Zeichengröße und Schreibrichtung")# 

+ 

+Die Zeichen können in verschiedenen Größen und unter verschiedenen Winkeln

+auf den Bildschirm geschrieben werden. Damit ist auch ein Schreiben von

+rechts nach links mit auf dem Kopf stehenden Zeichen möglich. 

+Bei normaler Schreibrichtung (waagerecht von links nach rechts) befindet

+sich die linke untere Ecke eines Zeichens an der Position des Graphikcur-

+sors. Nach dem Zeichnen des Zeichens befindet sich der Graphikcursor hinter

+der rechten unteren Ecke des Zeichens. Da sich die Zeichen aus Vektoren

+(Linien) zusammensetzen und nicht aus einer festen Punktmatrix, können sie

+schnell beliebig gedreht und vergrössert (und verkleinert) werden. Der Dreh-

+winkel ist wie bei allen Graphikwinkelangaben in 5 Grad Schritten anzugeben.

+Die Zuordnung der Winkel zu den Parameterwerten oder ASCII-Zeichen ist im

+Anhang A angegeben. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> N#ie(1)# <b> <h> <w>    (Hex 1B 4E <b><h><w>) 

+ 

+stellt Breite, Höhe und Drehwinkel der Zeichen ein. Alle Parameter sind

+Byteparameter mit dem Wertebereich 0 bis 255. Mit einem Parameter Hex 00

+kann der Defaultwert (Standardwert) für den jeweiligen Parameter eingestellt

+werden. 

+<b> bezeichnet die Zeichenbreite in Punkten. Standardwert ist 6. 

+<h> bezeichnet die Zeichenhöhe in Punkten. Standardwert ist 10. 

+<w> bezeichnet den Drehwinkel in 5 Grad Schritten. Standardwert ist 0. 

+ 

+Einige ausgezeichnet Werte für <w> sind: 

+<w>    Richtung 

+#linie ("16.2")# 

+ 0     Waagerecht von links nach rechts (Ost) 

+ 9     Schräg nach unten rechts         (Süd-Ost) 

+18     Senkrecht von oben nach unten    (Süd) 

+27     Schräg nach unten links          (Süd-West) 

+36     Waagerecht (auf dem Kopf stehend) von rechts nach links (West) 

+45     Schräg nach oben links           (Nord-West) 

+54     Senkrecht von unten nach oben    (Nord) 

+63     Schräg von nach oben rechts (Aufwärts) (Nord-Ost) 

+72...  Wie 0 ... 

+ 

+ 

+#k("6.5.1.2", "Dicke, Farbe etc.")# 

+ 

+Buchstaben werden mit Vektoren (Linien) gezeichnet. Die gleichen Parameter,

+die für Striche eingestellt werden, wirken dann auch auf die Zeichen. Mög-

+liche Parameter sind Farbe, Linientyp, Strichdicke und Bitverknüpfung. Mit

+dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden alle diese Parameter auf Standardwerte zurückgesetzt. Die Standard-

+werte sind in Kapitel 6.3 erläutert. Die Beschreibung des Kommandos zur

+Einstellung der Zeichenfarbe ist in Kapitel 6.3.2 beschrieben, das Einstel-

+len der Zeichendicke in Kapitel 6.3.1, das Einstellen des Linientyps in

+Kapitel 6.3.3 und das Einstellen der Bitverknüpfung ist in Kapitel 6.3.4

+beschrieben. Auch für die Zeichendarstellung können mehrere dieser Parame-

+ter zugleich mit einem Kommando eingestellt werden. Das Multiparameterkom-

+mando ist in Kapitel 6.3.5 beschrieben. 

+ 

+ 

+#k("6.5.1.3", "Zeichensätze und Attribute")# 

+ 

+Ähnlich wie bei der 80-Zeichen Textdarstellung können Zeichensatz und Text-

+attribute eingestellt werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+kann einer der beiden Zeichensätze USA oder GER (ASCII und Deutsch) gewählt

+werden. Ein griechischer Zeichensatz ist unabhängig von beiden immer vor-

+handen. 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 15, im Graphikmodus

+sind aber nur die beiden folgende Werte sinnvoll: 

+ 

+#on("u")#<n>  Zeichensatz  Abweichende Zeichen#off("u")# 

+ 2   Deutsch      Ä Ö Ü ä ö ü ß 

+ 4   Ascii        [ \ ] { | } ~ 

+ 

+Außerdem kann der Zeichensatz im ersten Feld der ersten Kommandozeile ein-

+gestellt werden. Im amerikanischen Zeichensatz treten die deutschen Buch-

+staben außerdem im Bereich von 214 bis 219 und 251 auf. Der Graphikzeichen-

+satz ist im Anhang abgebildet. 

+ 

+Wie im Textmodus können Attribute mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt werden. <n> ist ein Byteparameter mit dem Wertebereich 0, 1, 4

+und 5. Die Werte von <n> sind folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bedeutung                                       #off("u")#

+ 0   Normaler Text (sichtbar und aufrecht) 

+ 1   Unsichtbarer Text (Nur der Cursor wird bewegt) 

+ 4   Kursivschrift, die Zeichen werden schräggestellt 

+ 5   Wie 1 (unsichtbarer Text) 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#   (Hex 1B 29) 

+ 

+hat wie im Textmodus die gleiche Bedeutung wie <ESC> G 4. Damit wird im

+Graphikmodus die Kursivschrift eingeschaltet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#   (hex 1B 28) 

+ 

+wird die Kursivschrift wieder ausgeschaltet. Im Textmodus invers hervorge-

+hobene Textstellen werden im Graphikmodus also durch Kursivschrift hervor-

+gehoben. 

+Steht rechts neben der Zeichenspalte mit einem Kursivzeichen ein nicht kur-

+sives Zeichen, dann wird das rechte Zeichen möglicherweise etwas überschrie-

+ben, da es in den oberen Teil des Kursivzeichens hineinragt. Das kann ver-

+mieden werden, wenn nach dem Ausschalten der Kursivschrift ein Leerzeichen

+ausgegeben wird. 

+ 

+ 

+#k("6.5.1.4", "Zeichen überschreiben")# 

+ 

+Im 80-Zeichen Textmodus kann man Zeichen einfach übereinandertippen, das

+zweite Zeichen ersetzt dann das erste. Im Graphikmodus sollen Texte auch mit

+in eine Zeichnung geschrieben werden können, ohne daß Teile von Linien even-

+tuell gelöscht werden. Dieser Modus bringt außerdem eine etwas größere

+Schreibgeschwindigkeit mit sich. Es ist aber auch möglich, daß die Fläche,

+in die das Zeichen geschrieben werden soll, vorher gelöscht wird, um ein

+sauberes Schriftbild zu erzielen. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> &#ie(1)#   (Hex 1B 26) 

+ 

+kann man das vorherige Löschen einschalten, mit dem Kommando 

+ 

+                         #ib(1)#<ESC> '#ie(1)#   (Hex 1B 27) 

+ 

+wird der Modus des Überschreibens ausgeschaltet. 

+ 

+Bei Kursivzeichen wird eine rautenförmige Fläche gelöscht oder gefüllt (wenn

+Bitverknüpfung AND eingeschaltet ist). Bei normalen Zeichen wird eine re-

+chteckige Fläche, der mit #ib(1)#<ESC> N#ie(1)# eingestellten Breite und Höhe, gelöscht

+oder gefüllt. Zu beachten ist, daß das Löschen/Füllen nur bei waagerechter

+Schreibrichtung von links nach rechts funktioniert. 

+ 

+Da die Größe der Zeichen in weiten Grenzen mit <ESC> N eingestellt werden

+kann, ist es auch möglich mit dem durch <ESC> & eingeschalteten Ersetzungs-

+modus schnell rechteckige Flächen zu füllen oder zu löschen, wenn nicht auf

+das später beschriebene Füllkommando für beliebige Flächen zurückgegriffen

+werden soll. Dazu schaltet man mit dem Kommando <ESC> O 4 1 die Bitverknü-

+pfung AND (für Füllen) ein und gibt dann einfach ein Leerzeichen aus, das

+dann invertiert dargestellt wird. 

+ 

+ 

+#k("6.5.2", "Textkommandos im Graphikmodus")# 

+ 

+Fast alle Textkommandos des 80-Zeichen Textmodus wirken auch im Graphikmo-

+dus. Einige Kommandos, wie Zeichen senden, Zeile senden, Cursorposition

+senden, haben im Graphikmodus andere Funktionen und haben deshalb andere

+Escape-Sequenzen. Textkommandos, die nicht im Graphikmodus vorhanden sind:

+<ESC> I (Backtab), <ESC> j (Reverse Linefeed), <ESC> E (Insert Line), <ESC>

+Q (Insert Character), <ESC> R (Delete Line), <ESC> W (Delete Character). 

+ 

+ 

+#k("6.5.2.1", "Die Cursorpositionierung")# 

+ 

+Die Cursorpositionierungskommandos (UP, DOWN, LEFT, RIGHT) wirken im Gra-

+phikmodus in die aktuelle Schreibrichtung. Beispiel: Wenn als Schreibwinkel

+180 Grad eingestellt wurde (Winkel 36, also von rechts nach links auf dem

+Kopf schreiben), dann muß man, um einen Backspace (d.h. ein Zeichen zurück)

+auszuführen, nicht <RIGHT> sondern wie bei normaler Schreibrichtung üblich,

+<LEFT> drücken. Die vier Cursorsteuertasten funktionieren für beliebige

+Schreibrichtungen. Alle anderen Steuertasten beziehen sich immer auf waage-

+rechte Schreibrichtung von links nach rechts. 

+ 

+Alle Steuertasten berücksichtigen die Zeichengröße (Breite und Höhe). Auch

+die Graphikseite wird am Ende der letzten Zeile um soviele Graphikzeilen

+gescrollt, wie ein Zeichen hoch ist. 

+ 

+Folgende Steuerkommandos/Tasten wirken im Graphikmodus: 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#linie ("16.2")# 

+#ib(1)#<TAB>#ie(1)#            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten (wie im Textmodus). Liegt die

+                                       nächste Tabulatorposition außerhalb

+                                       des sichtbaren Bereichs, dann steht

+                                       der Cursor jetzt da. 

+ 

+#ib(1)#<SHIFT CE>#ie(1)#       <OA CTRL X>    -      Kommandozeile aktivieren. 

+                                       Einzelheiten zur Kommandozeile siehe

+                                       Abschnitt 3.: Die Kommandozeilen. 

+ 

+#ib(1)#<CE>#ie(1)#             <CTRL X>      18      u.a. Kommandozeile verlassen. 

+ 

+#ib(1)#<RETURN>#ie(1)#         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub. 

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+#ib(1)#<SHIFT RETURN>#ie(1)#   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten sichtbaren

+                                       Bildschirmzeile war, wird der Bild-

+                                       schirminhalt entweder nach oben ge-

+                                       scrollt (SCROLL) oder in Homeposition

+                                       gebracht (PAGE). 

+ 

+#ib(1)#<UP>#ie(1)#             <UP>       8B/0B      Cursor eine Zeile höher (bzw. über

+                                       die Zeile). War der Cursor in der

+                                       ersten sichtbaren Bildschirmzeile,

+                                       dann steht er jetzt im unsichtbaren

+                                       Bereich. 

+ 

+#ib(1)#<DOWN>#ie(1)#           <DOWN>     8A/0A      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten sichtbaren Zeile, dann

+                                       wird der Inhalt des Graphikbild-

+                                       schirms nach oben gescrollt, d.h. die

+                                       obersten Zeilen werden gelöscht (im

+                                       SCROLL-Modus) oder der Cursor in die

+                                       erste Zeile gesetzt (im PAGE-Modus). 

+ 

+#ib(1)#<CTRL V>#ie(1)#         <CTRL V>      16      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten Zeile, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+#ib(1)#<LEFT>#ie(1)#           <LEFT>     88/08      Cursor eine Spalte nach links (bzw.

+                                       entegegen der Schreibrichtung). War

+                                       der Cursor in der ersten sichtbaren

+                                       Bildschirmspalte, dann ist er jetzt

+                                       unsichtbar "links" davon. 

+ 

+#ib(1)#<RIGHT>#ie(1)#             -          95      Cursor eine Spalte nach rechts (bzw.

+                                       in Schreibrichtung). War der Cursor

+                                       in der letzten sichtbaren Spalte,

+                                       dann befindet er sich jetzt außer-

+                                       halb des Bildschirms. Im Gegensatz

+                                       zum Textmodus wird kein Linefeed oder

+                                       Scroll ausgeführt. 

+ 

+#ib(1)#<HOME>#ie(1)#           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+#ib(1)#<SHIFT HOME>#ie(1)#     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+ 

+#ib(1)#<DELETE>#ie(1)#         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm nicht dargestellt. Der Host

+                                       interpretiert es in der Regel als

+                                       Zeichenlöschbefehl. 

+ 

+#ib(1)#<BOTTOMLEFT>#ie(1)#     <BACKSPACE>   08      Cursor eine Spalte nach links (bzw.

+                                       entgegen der Schreibrichtung). Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+#ib(1)#<BOTTOMRIGHT>#ie(1)#    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts (bzw. in Schreibrichtung). Die

+                                       Funktion ist mit der von <RIGHT>

+                                       identisch. 

+ 

+#ib(1)#<ESC>#ie(1)#            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+#ib(1)#<SHIFT CTRL HOME>#ie(1)#<OA 0>         -      Local/Online umschalten 

+ 

+#ib(1)#<CTRL HOME>#ie(1)#      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+Unbelegte Funktionstasten erzeugen Graphikzeichen, die im Anhang A nachge-

+sehen werden können. 

+ 

+ 

+#k("6.5.2.2", "Löschbefehle")# 

+ 

+Das Kommando (Clear to End Of Line) 

+ 

+                         #ib(1)#<ESC> T#ie(1)#    (Hex 1B 54) 

+ 

+löscht ab der aktuellen Cursorposition bis zum Zeilenende. Die Höhe des

+gelöschten Balkens entspricht der Buchstabenhöhe. Der Balken wird unabhän-

+gig von der Bitverknüpfung immer gelöscht. Der Balken wird unabhängig von

+der Schreibrichtung immer waagerecht gelöscht. 

+ 

+Das Kommando (Clear to End Of Page) 

+ 

+                         #ib(1)#<ESC> Y#ie(1)#    (Hex 1B 59) 

+ 

+löscht den Graphikbildschirm von der aktuellen Cursorposition an bis zum

+Bildschirmende. Auch dieses Kommando löscht unabhängig von der gewählten

+Bitverknüpfung und Schreibrichtung immer waagerecht. 

+ 

+Die Kommandos 

+ 

+                         #ib(1)#<ESC> *#ie(1)#    (Hex 1B 2A) 

+                         #ib(1)#<ESC> ,#ie(1)#    (Hex 1B 2C) 

+                         #ib(1)#<ESC> +#ie(1)#    (Hex 1B 2B) 

+                         #ib(1)#<ESC> :#ie(1)#    (Hex 1B 3A) 

+                         #ib(1)#<CTRL Z>#ie(1)#   (Hex 1A) 

+ 

+löschen den Bildschirm und bringen den Graphikcursor in Homeposition, d.h.

+eine Buchstabenhöhe unter dem oberen Bildschirmrand. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> y#ie(1)#    (Hex 1B 79) 

+ 

+löscht den Bildschirm und bringt den Graphikcursor in die linke untere Ecke,

+d.h. den Ursprung des Koordinatensystems. 

+ 

+ 

+#k("6.6", "Die Graphikkommandos")# 

+ 

+ 

+#k("6.6.1", "Draw's und Move's")# 

+ 

+Draw's sind Zeichenbefehle, die eine Linie zeichnen und den Cursor an den

+Endpunkt der Linie positionieren. Move's positionieren nur den Cursor und

+zeichnen nicht. Bei allen Draw's ist der Anfangspunkt der Linie die aktuel-

+le Cursorposition. Die Endposition kann relativ, absolut oder mit einem

+relativen Winkel angegeben werden. Der Befehl zum Setzen/Löschen eines Punk-

+tes wurde mit in diese Befehlskategorie aufgenommen. 

+ 

+ 

+#k("6.6.1.1", "Punkt setzen")# 

+ 

+Der Befehl zum Setzen eines Graphikpunktes ist ein absoluter Befehl, d.h.

+die Koordinaten des Punktes folgen dem Kommando. Die Position des Graphik-

+cursors wird durch diesen Befehl nicht verändert. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> m#ie(1)# <x, y;>    (Hex 1B 6D <x, y;>) 

+ 

+setzt einen Punkt an die Position x/y, wenn diese innerhalb des sichtbaren

+Bereichs liegt. <x, y;> sind dezimale oder binäre Koordinaten. Das Aussehen

+des Punktes kann durch Farbe/Helligkeit oder Bitverknüpfung festgelegt wer-

+den. Mit einer AND-Bitverknüpfung wird der angegebene Punkt gelöscht, mit

+einer OR oder COPY Bitverknüpfung wird der angegebene Punkt gesetzt, mit

+einer XOR Bitverknüpfung wird sein Zustand umgedreht (invertiert). 

+Soll ein dicker Punkt gezeichnet werden, dann kann man den (relativen)

+Draw-Befehl <ESC> r 0, 0; benutzen, der an die Position des Graphikcursors,

+einen Punkt der eingestellten Dicke zeichnet. 

+ 

+ 

+#k("6.6.1.2", "Move-Befehle")# 

+ 

+Den Move-Befehl gibt es in zwei Versionen, einer relativen und einer abso-

+luten. Das Kommando für einen absoluten Move lautet 

+ 

+                         #ib(1)#<ESC> v#ie(1)# <x, y;>    (Hex 1B 76 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die neue Position

+des Graphikcursors bezeichnen. Diese Position muß nicht im sichtbaren Be-

+reich liegen, sondern kann auch außerhalb des Fensters liegen. Der Wertebe-

+reich von <x> und <y> ist -32768 bis 32767. 

+ 

+Das Kommando für den relativen Move-Befehl lautet 

+ 

+                         #ib(1)#<ESC> q#ie(1)# <x, y;>    (Hex 1B 71 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert. Auch hier darf die neue Position des Graphik-

+cursors außerhalb des sichtbaren Bereichs liegen. 

+ 

+Die Move-Befehle setzen außerdem das Bitmuster für den Linientyp wieder auf

+den Startwert zurück, damit der nächste Draw-Befehl auch mit einem Punkt

+beginnt. 

+ 

+ 

+#k("6.6.1.3", "Draw-Befehle")# 

+ 

+Ebenso wie den Move-Befehl gibt es auch den Draw-Befehl in zwei Versionen,

+einer relativen und einer absoluten. Das Kommando für einen absoluten Draw

+lautet 

+ 

+                         #ib(1)#<ESC> w#ie(1)# <x, y;>    (Hex 1B 77 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die Endposition der

+Linie bezeichnen. Diese Position muß nicht im sichtbaren Bereich liegen,

+sondern kann auch außerhalb des Fensters liegen. Der unsichtbare Teil der

+Linie wird dann "geclippt". Der Wertebereich von <x> und <y> ist -32768 bis

+32767. 

+ 

+Das Kommando für den relativen Draw-Befehl lautet 

+ 

+                         #ib(1)#<ESC> r#ie(1)# <x, y;>    (Hex 1B 72 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert, die dann die Endposition der Linie bilden. Auch

+hier darf die Endposition der Linie außerhalb des sichtbaren Bereichs lie-

+gen. 

+ 

+ 

+#k("6.6.1.4", "Turtle-Graphik")# 

+ 

+Turtle-Graphik (Schildkröten-Graphik, obwohl hier keine Schildkröte sicht-

+bar ist) wird zur Erzeugung von "rekursiven" Graphiken, die mit Längen und

+Winkelangaben, statt mit x/y-Koordinaten, arbeiten benötigt. Man stellt sich

+dazu eine Schildkröte vor, die auf ihrem Weg über den Bildschirm eine sicht-

+bare Spur zurücklassen kann (aber nicht muß). Die Schildkröte kann einen Weg

+bestimmter Länge in ihre Blickrichtung gehen und bleibt dann stehen. Außer-

+dem kann sie sich nach links oder rechts drehen, d.h. ihre Blickrichtung

+ändert sich. Alles was man dazu braucht, ist ein Befehl, der die Richtung

+der Schildkröte verändern kann und dann einen Weg bestimmter Länge in dieser

+Richtung zurücklegt. Außerdem wird noch ein Befehl benötigt, der das "Spur-

+verhalten" der Schildkröte ändert, also von "Spur sichtbar" auf "Spur un-

+sichtbar" umschaltet und umgekehrt. Natürlich ist die Zeichengeschwindigkeit

+nicht mit der Fortbewegungsgeschwindigkeit von Schildkröten zu vergleichen.

+Das erste Kommando lautet 

+ 

+                         #ib(1)#<ESC> n#ie(1)# <l, w;>    (Hex 1B 6E <l, w;>) 

+ 

+<l> und <w> sind dezimale oder binäre Parameter. <l> ist die Länge der Spur

+mit einem Wertebereich von 0 bis 511. <w> ist der relative Drehwinkel der

+Schildkröte, also die Änderung von der ursprünglichen Blickrichtung aus. <w>

+überstreicht den positiven und negativen Winkelbereich (0..71 entsprechen 0

+bis 355 in 5 Grad Schritten. -1 entspricht z.B. 355 Grad). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> o#ie(1)#    (Hex 1B 6F) 

+ 

+kann von 'Draw' einer Spur auf 'Move' umgeschaltet werden und umgekehrt. 

+ 

+Um die Sichtbarkeit der Spur am Programmamfang auf einen definierten Wert zu

+setzen, kann man das Kommando 

+ 

+                         #ib(1)#<ESC> O 8#ie(1)# <n>    (Hex 1B 4F 38 <n>) 

+ 

+benutzen. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+ 

+#on("u")#Bit 0 hat folgende Bedeutung:                                    #off("u")# 

+  0       Pendown. Die Schildkröte hinterläßt eine sichtbare Spur 

+  1       Penup. Die Schildkröte hinterläßt keine Spur 

+ 

+#on("u")#Bit 1 hat folgende Bedeutung:                                    #off("u")# 

+  0       Drawer. Es wird eine weiße Linie gezeichnet. 

+  1       Eraser. Es wird eine schwarze Linie gezeichnet (gelöscht) 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 9#ie(1)#    (Hex 1B 4F 39) 

+ 

+wird die Turtle-Graphik initialisiert. Dieses Kommando muß nicht aufgerufen

+werden bevor die Turtle-Graphik benutzt wird, sollte aber nach Möglichkeit

+am Anfang eines Turtle-Graphik-Programmes benutzt werden. Das Kommando setzt

+die Schildkröte in die Mitte des Bildschirms (140, 96) mit Blickrichtung

+nach oben. Der Drawer wird eingeschaltet (zeichnen) und eine sichtbare Linie

+wird voreingestellt (Pendown). 

+ 

+ 

+#k("6.6.2", "Komplexere Zeichenkommandos")# 

+ 

+Außer den Kommandos zum Zeichnen von Linien und zum Bewegen des Graphikcur-

+sors gibt es noch verschiedene andere Zeichenkommandos. 

+ 

+ 

+#k("6.6.2.1", "Kreise und Kreissegmente")# 

+ 

+Der Mittelpunkt eines Kreises liegt immer an der aktuellen Cursorposition.

+Der Radius eines Kreises ist in weiten Grenzen von 0 bis über 30000 Punkten

+wählbar. Clipping wird ausserhalb des Bildschirmrandes durchgeführt. Ein

+Kreis kann in 8 Segmente unterteilt werden, von denen alle oder nur einzel-

+ne gezeichnet werden können. Damit ist es dann auch möglich, Halb- oder

+Viertelkreise zu Zeichnen. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> K#ie(1)# <r, s;>   (Hex 1B 4B <r, s;>) 

+ 

+wird ein Kreis mit dem Radius <r> um die aktuelle Cursorposition gezeichnet

+(relative Kreise). <s> legt fest, welche Segmente gezeichnet werden sollen.

+<r, s;> sind dezimale oder binäre Parameter. <s> hat den Wertebereich von 0

+bis 255. 

+Jedes Bit in <s> ist einem Kreissegment zugeordnet. Ist das Bit gesetzt (1),

+dann wird das zugehörige Segment gezeichnet. Der Wert 0 entspricht dem Wert

+255 (der ganze Kreis wird gezeichnet), ist aber etwas schneller, da keine

+Abfrage der einzelnen Bits durchgeführt wird. 

+ 

+Die Segmente sind folgendermaßen numeriert: 

+ 

+                                  7  0 

+                                6      1 

+                                5      2 

+                                  4  3 

+ 

+Beispiele für <n> : 

+ 

+#on("u")#<n>  Bedeutung                               #off("u")#

+  0  Zeichnet einen ganzen Kreis 

+ 15  Zeichnet einen links offenen Halbkreis 

+240  Zeichnet einen rechts offenen Halbkreis 

+195  Zeichnet einen unten offenen Halbkreis 

+ 60  Zeichnet einen oben offenen Halbkreis 

+  3  Zeichnet ein Kreisviertel rechts oben 

+ 12  Zeichnet ein Kreisviertel rechts unten 

+ 48  Zeichnet ein Kreisviertel links unten 

+192  Zeichnet ein Kreisviertel links oben 

+etc. 

+ 

+Das Aussehen von Kreisen kann durch die Parameter Farbe/Helligkeit und die

+Bitverknüpfung verändert werden. Der Linientyp (Punkt-, Strichlinie) und die

+Strickdicke haben keinen Einfluß, d.h. der Kreis wird immer mit durchgehen-

+der Linie und einfacher Dicke gezeichnet. Sollen diese beiden Parameter auch

+verändert werden, sollte man den Befehl <ESC> s für Ellipsenbögen verwenden. 

+ 

+ 

+#k("6.6.2.2", "Rechtecke")# 

+ 

+Rechtecke werden ebenso wie Kreise relativ gezeichnet, d.h. die aktuelle

+Cursorposition bildet eine Ecke des Rechtecks. Die Seiten des Rechtecks

+liegen parallel zur X- und Y-Achse, gedrehte Rechtecke können aber aus 4

+relativen Draw-Befehlen zusammengesetzt werden. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> J#ie(1)# <b, h;>    (Hex 1B 4A <b, h;>) 

+ 

+zeichnet ein leeres Rechteck (Rahmen) an der aktuellen Cursorposition. <b,

+h;> sind dezimale oder binäre Parameter. <b> ist die Breite des Rechtecks

+und kann den ganzen Wertebereich von -32768 bis 32767 überstreichen, <h> ist

+die Höhe des Rechtecks und kann ebenfalls diesen Wertebereich überstreichen.

+Je nach Vorzeichen von <b> und <h> wird das Rechteck links/ rechts und

+oben/unten von der aktuelle Cursorposition gezeichnet. 

+ 

+<b> <h>  Cursorposition bildet die Ecke 

+ +   +   unten links 

+ +   -   oben links 

+ -   +   unten rechts 

+ -   -   oben rechts 

+ 

+ 

+#k("6.6.2.3", "Bögen und Ellipsen")# 

+ 

+Um die Zeichengeschwindigkeit eines Kreises zu vergrößern, wurde ein sepa-

+rater Befehl für Kreise eingeführt (6.6.2.1). Da der Kreis ein Sonderfall

+der Ellipse ist, kann man das in diesem Abschnitt beschriebene Kommando auch

+benutzen, um Kreise mit anderen als den unter 6.6.2.1 beschriebenen Segmen-

+ten oder Parametern (Dicke, Strichtyp) zu Zeichnen. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> s#ie(1)# <xr, yr,> <aw, ew;>    (Hex 1B 73 ...) 

+ 

+zeichnet um die aktuelle Cursorposition (also relativ) einen Ellipsenbogen

+mit Radius <xr> in X-Richtung und Radius <yr> in Y-Richtung, ausgehend vom

+Anfangswinkel <aw> im Uhrzeigersinn, bis zum Endwinkel <ew>. Der Winkel 0

+Grad ist dabei oben (Norden). 

+ 

+Alle Parameter sind dezimale oder binäre Parameter. <aw> und <ew> haben den

+Wertebereich von 0 bis 255, wobei eine ganze Ellipse einem Anfangswinkel von

+0 und einem Endwinkel von 72 entspricht. Die Winkelangaben sind in 5 Grad

+Schritten und können Anhang A entnommen werden.. <xr> und <yr> dürfen den

+vollen Wertebereich von -32768 bis 32767 überstreichen. 

+ 

+ 

+#k("6.6.2.4", "Gefüllte Flächen")# 

+ 

+Rechteckige oder rautenförmige Flächen können, wie in Abschnitt 6.5.1.4

+beschrieben, schnell gefüllt werden. Für beliebig geformte Flächen kann das

+Kommando 

+ 

+                         #ib(1)#<ESC> |#ie(1)#<n>    (Hex 1B 7C <n>) 

+ 

+benutzt werden. Dies ist ein relatives Kommando, da um die aktuelle Cursor-

+position herum gefüllt wird. <n> ist ein Byteparameter mit dem Wertebereich

+0 bis 15, der die Nummer des Musters für die Füllung angibt. Der Fill-Befehl

+arbeitet auf der aktuellen Arbeitsseite und füllt eine sichtbar begrenzte

+Fläche mit einem angegebenen Muster aus. 

+ 

+Ist die Bitverknüpfung OR eingestellt darf der Cursor nicht auf einem weißen

+Punkt stehen und die Fläche muß von einer durchgehenden weißen Linie be-

+grenzt sein. 

+Ist die Bitverknüpfung AND eingestellt, darf der Cursor nicht auf einem

+schwarzen Punkt stehen und die Fläche muß von einer durchgehenden schwarzen

+Linie begrenzt sein. 

+ 

+Außer den Parametern Bitverknüpfung und Helligkeit/Farbe werden keine be-

+rücksichtigt. 

+ 

+Bei sehr komplex geformten Figuren kann der Fall eintreten, daß die Fläche

+nicht ganz gefüllt ist. Dies liegt daran, daß intern ein zu größer Spei-

+cherplatz zum Merken von Rücksprungcursorpositionen benötigt wird (Stack-

+Überlauf). In diesem Fall sollte man den Cursor nocheinmal auf die nicht

+gefüllte Fläche setzen und das Kommando erneut geben. 

+ 

+<n> kann folgende Werte annehmen (Werte Hexadezimal angegeben 0..F): 

+<n>  Bedeutung 

+#linie ("16.2")# 

+ 0   Fläche ganz gefüllt 

+ 1   Fläche halb gefüllt (grau) 

+ 2   Jede 4. Zeile wird durchgezogen 

+ 3   Jede 2. Zeile wird durchgezogen 

+ 4   Jede 4. Spalte wird durchgezogen 

+ 5   Jede 2. Spalte wird durchgezogen 

+ 6   Jede 4. Zeile und jede 4. Spalte wird durchgezogen (grobes Raster) 

+ 7   Jede 2. zeile und jede 2. Spalte wird durchgezogen (feines Raster) 

+ 8   Schraffur von links unten nach rechts oben 

+ 9   Schraffur von links oben nach rechts unten 

+ A   Schräges Raster (Links- und Rechtsschraffur) 

+ B   Feines Funktraster(jeder 2.Punkt in x- und y-Richtung wird gesetzt) 

+ C   Mauerwerk 

+ D   Feines Netzgeflecht 

+ E   Feine Zickzacklinie 

+ F   Benutzerdefinierbares Muster. Default: Grobe Zickzacklinie 

+ 

+Ist die AND-Bitverknüpfung eingeschaltet, dann sind die Punkte schwarz und

+weiß in den Mustern vertauscht und in der obigen Tabelle sind die Bezeich-

+nungen 'gefüllt' und 'gelöscht' auszutauschen. 

+ 

+ 

+#k("6.6.2.4.1", "Definition des Musters")# 

+ 

+Das benutzerdefinierbare Muster des Fill-Befehls (Muster 15) kann mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> O :#ie(1)# <b1..b8>   (Hex 1B 4F 3A <b1..b8>) 

+ 

+eingestellt werden. Das Defaultmuster wird dabei überschrieben, das neu

+eingestellte Muster allerdings nicht beim Setup mitgesichert. 

+<b1..b1> sind 8 Byteparameter mit dem gesamten Wertebereich 0 bis 255. Das

+erste Byte wird im Füllmuster in Richtung der niedrigeren y-Positionen dar-

+gestellt, das niederwertigste Bit jedes Bytes in Richtung der niedrigeren

+x-Positionen. 

+ 

+ 

+#k("6.7", "Graphikdaten zum Host")# 

+ 

+Bisher wurden nur Kommandos beschrieben, die der Host an das Terminal sen-

+den kann. Damit der Host über den Status des Terminals informiert werden

+kann, sind auch Kommandos vorhanden, die Daten an den Host senden. Der Host

+kann auch ganze Graphikseiten anfordern, so daß die auf dem Terminal er-

+zeugten Graphiken nach dem Ausschalten nicht verloren sind, sondern vom Host

+gespeichert werden können. 

+ 

+ 

+#k("6.7.1", "Graphikseiten zum Host")# 

+ 

+Graphikseiten können ganz oder teilweise übertragen werden. Da ein angefor-

+dertes Datenpaket immer ganz übertragen wird, sollte der Host, wenn keine

+Flußkontrolle eingeschaltet ist, nur so große Blöcke anfordern, die er puf-

+fern kann (z.B. 256 Bytes). Selektives Lesen von Graphikseiten kann auch

+verwendet werden, um Teile einer Graphik vom Host (und nicht vom Terminal)

+verändern zu lassen. Mit dem Kommando <ESC> / ... kann der modifizierte Teil

+dann wieder an das Terminal zurückgesendet werden. Zum Aufbau der Graphik-

+seite findet man in Kapitel 6.4.2 Informationen. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> \#ie(1)# <ll> <lh> <al> <ah>   (Hex 1B 5C ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in an den Host gesendet werden.

+<lh>, <ll>, <ah> und <al> sind Byteparameter (8 Bits). <ll> und <lh> bilden

+zusammen die binäre Länge, d.h. die Anzahl der Datenbytes, die zum Host

+gesendet werden. Die Länge kann von 0 bis Hex 2000 (dezimal 8192) reichen.

+Die Adresse durch <al> und <ah> gebildet, darf von 0 bis Hex 1FFF reichen.

+Zusätzlich gilt, daß die Summe von Länge und Adresse nicht größer als Hex

+2000 sein darf, da sich die Endadresse dann ausserhalb der Graphikseite

+befindet. In diesem Fehlerfall werden keine Daten gesendet. 

+ 

+ 

+#k("6.7.2", "Cursorposition zum Host")# 

+ 

+Da die Graphikcursorposition einen anderen Wertebereich überstreicht als die

+Position des Textcursors, wurde zum Senden der Graphikcursorposition ein

+weiteres Kommando eingeführt. Pro Koordinate werden dabei 2 Bytes, zusammen

+also 4 Bytes, gesendet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ;#ie(1)#    (Hex 1B 3B) 

+ 

+kann der Host diese 4 Bytes anfordern. Die Reihenfolge der Bytes ist <xlow>

+<xhigh> <ylow> <yhigh>. Im Gegensatz zu <ESC> ? (für die Textcursorposi-

+tion) wird auch kein abschließendes <CR> gesendet. 

+ 

+ 

+#k("6.7.3", "Einzelne Bits zum Host")# 

+ 

+Außer ganzen Graphikseiten oder Blöcken daraus, kann der Host auch einzelne

+Bytes oder Bits selektieren und empfangen. Dazu stehen zwei Kommandos zur

+Verfügung. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> _#ie(1)#    (Hex 1B 5F) 

+ 

+kann das Byte angefordert werden, in dem sich der Graphikcursor gerade be-

+findet. Das Bit 7 ist das Farb- oder Helligkeitsbit, das Bit (xpos MOD 7)

+ist das Bit, das durch den Graphikcursor addressiert wird. Wenn der Cursor

+außerhalb des sichtbaren Bereichs ist, wird ein Byte Hex 00 geliefert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> -#ie(1)#    (Hex 1B 2D) 

+ 

+kann das Bit, daß durch die Graphikcursorposition addressiert wird, abge-

+fragt werden. Dieses Kommando liefert ein Byte, in dem die Bits folgende

+Bedeutung haben: 

+ 

+#on("u")#Bit 0 Dezimal   Bedeutung                            #off("u")# 

+  0      0      Das adressierte Bit ist nicht gesetzt 

+  1      1      Das adressierte Bit ist gesetzt 

+ 

+#on("u")#Bit 1 Dezimal   Bedeutung                   #off("u")# 

+  0      0      Die Farbe ist violett/dunkel 

+  1      2      Die Farbe ist gelb/hell 

+ 

+Bit 2 Dezimal   Bedeutung 

+#linie ("16.2")# 

+  0      0      Der Graphikcursor ist innerhalb des sichtabren Bereichs 

+  1      4      Der Graphikcursor ist außerhalb des sichtbaren Bereichs. 

+                Bit 0 und Bit 1 sind dann 0. 

+ 

+Bit 4 und Bit 5 sind immer 1. Es werden also die ASCII-Ziffern "0" bis "4"

+geliefert. 

+ 

+ 

+#k("6.7.4", "Parameter zum Host")# 

+ 

+Die eingestellten Draw-Parameter können auch abgefragt werden. Dazu exi-

+stieren zwei Kommandos. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 4#ie(1)#    (Hex 1B 34) 

+ 

+können die Nummer der sichtbaren und der Arbeitsseite, im gleichen Format

+wie zum Einstellen der Seiten mit dem Kommando #ib(1)#<ESC> O 7#ie(1)# <n>, angefordert

+werden. Es werden ASCII-Zeichen von "0" bis "?" geliefert. Die Bits 0 bis 2

+sind folgendermaßen zugeordnet: 

+ 

+#on("u")#Bit 0  Bedeutung                #off("u")# 

+  0    Sichtbar ist Seite 0 

+  1    Sichtbar ist Seite 1 

+ 

+#on("u")#Bit 1  Bedeutung               #off("u")# 

+  0    Arbeitsseite ist Seite 0 

+  1    Arbeitsseite ist Seite 1 

+ 

+#on("u")#Bit 2  Bedeutung               #off("u")# 

+  0    Nur Graphik eingeschaltet 

+  1    In den letzten 32 Graphikzeilen 

+       sind 4 Textzeilen eingeblendet 

+ 

+#on("u")#Bit 3  Bedeutung                         #off("u")# 

+  0    Der Graphikmodus ist eingeschaltet 

+  1    Der Textmodus ist eingeschaltet 

+ 

+Sinnvoll sind die Werte der Bits 0 bis 2 nur dann, wenn Bit 3 = 0 ist. 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 5#ie(1)#    (Hex 1B 35) 

+ 

+können die Linienparameter abgefragt werden. Es wird ein Byte mit dem Wer-

+tebereich von 1 bis 127 geliefert. Die einzelnen Bits sind folgendermaßen

+zugeordnet: 

+ 

+Bit        Bedeutung 

+#linie("16.2")# 

+Bit 0..3 : Strichdicke 

+Bit 4..5 : Bitverknüpfung (0 = OR, 16 = AND, 32 = XOR, 48 = COPY) 

+Bit 6    : Aktuelle Farbe (0 = Violett/dunkel, 1 = Gelb/hell) 

+ 

+Die Bitbelegung entspricht der des Parameters des Kommandos #ib(1)#<ESC> O 5#ie(1)# <n>. 

+ 

+ 

+#k("6.8", "Graphikhardcopy")# 

+ 

+Wie von der Textseite kann auch von den Graphikseiten ein Ausdruck angefer-

+tigt werden. Dabei können keine verschiedene Helligkeitsstufen oder Farben

+dargestellt werden. 

+ 

+ 

+#k("6.8.1", "Der Druckertreiber")# 

+ 

+Da das Ein- und Ausschalten des Graphikmodus nicht auf allen Druckern durch

+gleiche Kommandos erreicht werden kann, muß das Terminal an den vorhandenen

+Drucker angepaßt werden. Defaultmäßig werden die Epson-Modelle ab RX80 auf-

+wärts, sowie kompatible (IBM, Panasonic etc.) unterstützt. Die Anpassung

+wird in diesem Abschnitt beschrieben. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ~#ie(1)# <n> <p...>    (Hex 1B 7E <n> <p...>) 

+ 

+können Kommandosequenzen eingestellt werden, die folgende Aufgaben haben: 

+ 

+<n> Default (Hex)   Aufgabe 

+#linie ("16.2")# 

+ 0  0D              Einleiten der gesamten Hardcopy (Waagenrücklauf) 

+ 1  1B 2A 04 18 01  Einschalten des Graphikmodus. Es folgen 280 Graphikby-

+                    tes (jeweils 8 Bit) 

+ 2  0D 1B 4A 17     Ausschalten des Graphikmodus. Zeilenvorschub ohne Zwi-

+                    schenraum (Zeilenabstand ca. 8 Punkte) und Waagenrück-

+                    lauf. 

+ 3     Nichts       Dieses Kommando wird nach der kompletten Hardcopy zum

+                    Drucker gesendet. 

+ 

+Wenn doppelte Punktbreite eingeschaltet ist, oder zwei Seiten nebeneinander

+gedruckt werden, wird die Kommandosequenz 1 auch mehrmals in einer Zeile

+gegeben. 

+ 

+<n> ist dabei ein Byteparameter mit dem Wertebereich von 0 bis 3. <p...> ist

+eine Folge von bis zu 16 Bytes. Das erste dieser 16 Bytes ist ein Längenby-

+te, das die Länge der Kommandosequenz (oder die Anzahl der noch folgenden

+Bytes) angibt. Für die nach dem Längenbyte folgenden Bytes sind alle Werte

+von 0 bis 255 erlaubt. 

+ 

+Die Druckertreiberstrings (Kommandosequenzen) werden beim Setup in der Kom-

+mandozeile auch mit abgespeichert, so daß sie nur einmal (wenn überhaupt)

+und dann nie wieder eingestellt werden müßen. 

+ 

+ 

+#k("6.8.2", "Die Hardcopyparameter")# 

+ 

+Im Gegensatz zur Hardcopy einer Textseite kann das Aussehen einer Graphik

+beim Ausdruck noch verändert werden. Das Kommando 

+ 

+                         #ib(1)#<ESC> ^#ie(1)# <n>    (Hex 1B 5E <n>) 

+ 

+druckt eine Hardcopy mit dem Parameter <n>. <n> ist ein Byteparameter mit

+dem Wertebereich von 0 bis 15. Jedes Bit in <n> legt eine Darstellungsweise

+fest. Die Bits haben folgende Bedeutung: 

+ 

+Invertieren: 

+Bit 0 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Helle Punkte auf dem Bildschirm werden auf dem Drucker schwarz

+              gedruckt, dunkle Punkte bleiben beim Ausdruck weiß. 

+  1      1    Die Graphik wird invertiert, d.h. Ein dunkler Bildhintergrund

+              bleibt auf dem Drucker dunkel (schwarz). 

+ 

+Doppelte Breite: 

+Bit 1 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Breite gedruckt. Es

+              werden also 280 Punkte nebeneinander gedruckt. 

+  1      2    Jeder Bildschirmpunkt wird in doppelter Breite gedruckt. In

+              diesem Fall werden auf dem Drucker 560 Punkte nebeneinander

+              gedruckt. 

+ 

+Doppelte Höhe: 

+Bit 2 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Höhe gedruckt. Es wer-

+              den also 192 Punkte untereinander gedruckt. 

+  1      4    Jeder Bildschirmpunkt wird in doppelter Höhe gedruckt. In

+              diesem Fall werden also 384 Punkte untereinander gedruckt. 

+ 

+Zwei Seiten nebeneinander drucken: 

+Bit 3 Dezimal Bedeutung 

+#linie("16.2")# 

+  0      0    Es wird nur eine Graphikseite (linksbündig) gedruckt. 

+  1      8    Die aktuelle (mit #ib(1)#<ESC> O 7#ie(1)# <n> eingestellte) Graphikseite

+              wird linksbündig und die andere Graphikseite nahtlos rechts

+              daneben gedruckt. 

+ 

+Zur Kombination von Möglichkeiten (mehrere Bits sind gesetzt): 

+ 

+- Eine Graphik mit doppelter Höhe und doppelter Breite hat ungefähr das

+  Format des Bildschirms. Ein Ausdruck besteht dann aus 560 x 384 = 215040

+  Punkten. Zusätzliches Invertieren macht die Graphik dem Bildschirmausse-

+  hen noch ähnlicher. 

+ 

+- Werden zwei Seiten mit doppelter Breite nebeneinander gedruckt, dann re-

+  icht die Anzahl der Graphikspalten auf dem Drucker mit dem Defaultgra-

+  phikmodus nicht mehr aus. In diesem Fall sollte man die Druckertreiber

+  Kommandosequenz 1 temporär auf eine hohe (4-fache) Dichte umschalten.

+  Solange kein Setup ausgeführt wird, ist diese Dichte nur solange gültig,

+  bis das Terminal ausgeschaltet wird. 

+ 

+#page# 

+#h("7.", "Die Parameter der seriellen Schnittstelle")# 

+ 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host durch Escape-

+Sequenzen gändert werden. Die Änderung der Parameter wird erst durchgeführt,

+wenn die Parameterübergabe komplett ist (d.h das letzte Byte wurde übertra-

+gen). Alle Übertragungsparameter wie Stopbits, Datenbits, Parität und Bau-

+drate werden zusammen in einem 'Rutsch' eingestellt. Die Art der Flußkon-

+trolle wird mit separaten Escape-Sequenzen eingestellt. 

+Die Einstellung in der Kommandozeile ist im Kapitel 3 beschrieben. 

+ 

+ 

+#k("7.1", "Das Übertragungsformat")# 

+ 

+Das Übertragunsformat eines Datenbytes sieht folgendermaßen aus: 

+(Beispiel für 8 Datenbits, 1 Paritätsbit und 1 Stopbit) 

+ 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+    ... |"0"| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | P |"1"| ... 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+       Start-  ----  D a t e n b i t s ---- Pari- Stop- 

+        bit                                 täts- bit 

+                                            bit 

+     --------> Zeit 

+ 

+Bei 7 Datenbits ist das Bit 7 "0". P bezeichnet das Paritätsbit. Wenn zwei

+Stopbits übertragen werden steht an dieser Stelle das 1. Stopbit ("1"). 

+ 

+ 

+#k("7.2", "Die Übertragungsparameter")# 

+ 

+Alle vier Parameter werden zugleich verändert. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> <SPACE> <SPACE>#ie(1)# <x>    (Hex 1B 20 20 <x>) 

+ 

+<x> ist dabei ein Datenbyte, das wie folgt festgelegt wird: 

+ 

+   Bit     7       6       5       4       3       2       1       0 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+       |Parity |Parity | Stop- | Daten-|            Baudrate           | 

+       | even/ |on/off | bits  | bits  |       |       |       |       | 

+       | odd   |       |       |       |       |       |       |       | 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+ 

+ 

+#k("7.2.1", "Baudrate")# 

+ 

+Baudrate = Anzahl der pro Sekunde übertragenen Bits (Übertragungsgeschwin-

+digkeit) . 

+ 

+         Bits 

+#on("u")#Dezimal 3 2 1 0    Neue Baudrate#off("u")# 

+  0     0 0 0 0    Alte Baudrate (nicht verändern) 

+  1     0 0 0 1      50 Baud 

+  2     0 0 1 0      75 Baud 

+  3     0 0 1 1     109.9 Baud 

+  4     0 1 0 0     134.58 Baud 

+  5     0 1 0 1     150 Baud 

+  6     0 1 1 0     300 Baud 

+  7     0 1 1 1     600 Baud 

+  8     1 0 0 0    1200 Baud 

+  9     1 0 0 1    1800 Baud 

+ 10     1 0 1 0    2400 Baud 

+ 11     1 0 1 1    3600 Baud 

+ 12     1 1 0 0    4800 Baud 

+ 13     1 1 0 1    7200 Baud 

+ 14     1 1 1 0    9600 Baud 

+ 15     1 1 1 1   19200 Baud 

+ 

+Der Wert 0 kann gebraucht werden, wenn nur Datenbits, Stopbits und Pari-

+tätsbit verändert werden sollen. 

+ 

+ 

+#k("7.2.2", "Datenbits")# 

+ 

+Bit 4 legt die Anzahl der gesendeten und empfangenen Datenbits fest. 

+ 

+#on("u")#Dezimal Bit 4              #off("u")# 

+   0      0     8 Datenbits 

+  16      1     7 Datenbits 

+ 

+Mit einem anschliessenden Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 6#ie(1)#    (Hex 1B 20 36) 

+ 

+kann das 8. Datenbit ausmaskiert (d.h auf "0" gesetzt) werden. Dies kann

+notwendig sein, wenn der Host nur 7 Bit ASCII verarbeitet und auf ein ge-

+setztes 8. Datenbit falsch reagiert (Steuerbit oder ähnliches). 

+ 

+Mit 

+ 

+                         #ib(1)#<ESC> <SPACE> 7#ie(1)#    (Hex 1B 20 37) 

+ 

+kann die Maskierung wieder aufgehoben werden. 

+Zu beachten ist, daß bei 7 Bit Datentransfer zum Beispiel das Farbbit bei

+Download einer Graphikseite nicht übertragen wird. 

+ 

+ 

+#k("7.2.3", "Stopbits")# 

+ 

+Bit 5 legt die Anzahl der Stopbits fest. 

+ 

+#on("u")#Dezimal Bit 5            #off("u")# 

+   0      0    1 Stopbit 

+  32      1    2 Stopbits 

+ 

+Zu beachten ist, daß bei eingeschaltetem Paritycheck und 8 Datenbits immer

+ein Stopbit übertragen wird, auch wenn 2 Stopbits programmiert wurden. (Es

+können maximal 11 Bits/Daten"byte" übertragen werden.) 

+ 

+ 

+#k("7.2.4", "Paritätsbit")# 

+ 

+Bit 6 legt fest, ob Paritätskontrolle erfolgen soll und ob ein Paritätsbit

+vorhanden ist. 

+ 

+Dezimal Bit 6 

+#linie("16.2")# 

+   0      0     Keine Paritätskontrolle/Kein Paritätsbit 

+  64      1     Paritätskontrolle eingeschaltet. Parität mit Bit 7 gewählt 

+ 

+Wenn Bit 6 = 1 ist legt Bit 7 fest, ob gerade oder ungerade Parität geprüft

+werden soll. 

+ 

+#on("u")#Dezimal Bit 7                   #off("u")# 

+   0      0     Ungerade Parität 

+ 128      1     Gerade Parität 

+ 

+ 

+#k("7.2.5", "Übertragungsfehler")# 

+ 

+Wird ein Rahmenfehler (Stopbit fehlt) oder ein Paritätsfehler (mindestens

+ein Bit verfälscht) entdeckt, dann wird statt des empfangenen Mülls ein Byte

+Hex FF vom Terminal interpretiert. Steht dies im Text, kann man es als in-

+vertiertes Punktraster erkennen. Dieses Zeichen richtet wenig Schaden an,

+wenn es mitten in einer Escape-Sequenz empfangen wird. 

+ 

+ 

+#k("7.3", "Die Flußkontrolle")# 

+ 

+Damit keine Daten verloren gehen, wenn der Host oder das Terminal keine

+solchen mehr empfangen kann, sollte eine Flußkontrolle eingeschaltet wer-

+den. Das Terminal hat zwar einen Empfangspuffer von 4K Byte (4096 Zeichen),

+aber auch dieser kann einmal voll sein. Der Sendepuffer von 2K Byte (2048

+Zeichen) wird in Anspruch genommen, wenn der Host dem Terminal per Flußkon-

+trolle mitgeteilt hat, daß er keine Zeichen mehr empfangen kann. Das Termi-

+nal wartet dann nicht aktiv auf Freigabe vom Host, sondern kann weiter ar-

+beiten (Spooler, Bildschirmausgabe, Localmodus etc.). 

+ 

+Wenn das Terminal den Host "gestoppt" hat, kann man das an einem "B U S Y"

+in der Statuszeile erkennen, sonst steht dort "R E A D Y". 

+Wenn der Host das Terminal "gestoppt" hat, kann man das an einem "T X O F F"

+in der Statuszeile erkennen, sonst steht dort "T X   O N". 

+ 

+Da dieses Terminal einen großen Empfangspuffer hat, sollte man allerdings im

+Notfall auch ohne Flußkontrolle auskommen, wenn nicht gerade umfangreiche

+Graphikoperationen ausgeführt werden sollen, bei denen der Puffer nicht

+schnell genug geleert werden kann. 

+ 

+ 

+#k("7.3.1", "XON/XOFF")# 

+ 

+XON/XOFF ist eine Softwareflußkontrolle. Als Stopzeichen wird 

+ 

+                         #ib(1)#XOFF#ie(1)#    (#ib(1)#<CTRL S>#ie(1)# Hex 13) 

+ 

+verwendet. Als Startzeichen wird 

+ 

+                         #ib(1)#XON#ie(1)#    (#ib(1)#<CTRL Q>#ie(1)# Hex 11) 

+ 

+verwendet. Diese Flußkontrolle sollte nur im Textmodus verwendet werden, da

+Binärdaten möglicherweise Hex 11 oder Hex 13 enthalten, die dann nicht als

+Protokollzeichen verwendet werden sollen. Der Vorteil dieser Art der Fluß-

+kontrolle ist, daß man mit 3 Leitungen (Masse, TXD, RXD) an der seriellen

+Schnittstelle auskommt. 

+ 

+Das Terminal reagiert auf empfangene XON/XOFF-Zeichen sofort, d.h diese

+Zeichen werden nicht in den Empfangspuffer gestellt. Diese beiden Zeichen

+werden auch dann interpretiert, wenn das Terminal im Local-Modus ist. 

+ 

+Die XON/XOFF Flußkontrolle kann in der 2. Kommandozeile ein- und ausgeschal-

+tet werden, sowie mit dem Kommando 

+ 

+                         #ib(1)#<CTRL O>#ie(1)#    (Hex 0F) 

+ 

+eingeschaltet und mit 

+ 

+                         #ib(1)#<CTRL N>#ie(1)#    (Hex 0E) 

+ 

+ausgeschaltet werden. 

+ 

+Zu beachten ist, daß der Sender vor dem Ausschalten noch im "TX OFF"-

+Zustand sein kann. Man sollte deshalb direkt vor <CTRL N> noch <CTRL Q> (Hex

+11), also XON senden, um den Sender wieder einzuschalten. Dies wird vom

+Terminal nicht automatisch gemacht, da sonst ein <CTRL N> das im Datenstrom

+vorkommt, auch noch ein Zeichen für Flußkontrolle wäre. 

+ 

+ 

+#k("7.3.2", "DTR/DSR")# 

+ 

+DTR/DSR ist eine Hardwareflußkontrolle bei der die Leitungen Pin 20 (DTR)

+und Pin 6 (DSR) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+DTR (Data Terminal Ready)/DSR (DataSet Ready) Flußkontrolle kann in der 2.

+Kommandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE>#ie(1)# <n>    (Hex 1B 20 <n>) 

+ 

+erreichen. Die Werte von <n> sind 

+ 

+#on("u")#<n>  Hex    Bedeutung                                              #off("u")# 

+ 2    32    Weder RTS/CTS noch DSR/DTR Flußkontrolle 

+ 3    33    RTS/CTS Flußkontrolle, aber keine DSR/DTR Flußkontrolle 

+ 4    34    DSR/DTR Flußkontrolle, aber keine RTS/CTS Fluskontrolle 

+ 5    35    DSR/DTR und RTS/CTS Flußkontrolle 

+ 

+DTR/DSR Flußkontrolle wird empfohlen, da hier alle Zeichen ohne Veränderung

+empfangen werden können. RTS/CTS Flußkontrolle kann, hardwaremäßig bedingt,

+beim Einschalten von RTS ein Bit "umkippen". 

+ 

+ 

+#k("7.3.3", "RTS/CTS")# 

+ 

+RTS/CTS ist eine Hardwareflußkontrolle bei der die Leitungen Pin 4 (RTS) und

+Pin 5 (CTS) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+RTS (Ready To Send)/CTS (Clear To Send) Flußkontrolle kann in der 2. Kom-

+mandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem Kom-

+mando <ESC> <SPACE> <n> erreichen. Die Werte von <n> sind im letzten Ab-

+schnitt (7.3.2 DTR/DSR) angegeben. 

+ 

+ 

+#k("7.4", "Echo und Local/Online")# 

+ 

+In einigen Fällen verlangt der Host, daß das vom Terminal empfangene Zei-

+chen zurückgesendet (geechoed) wird, um eventuelle Übertragungsfehler zu

+erkennen. Dieser Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D E#ie(1)#    (Hex 1B 44 45) 

+ 

+eingeschaltet. Zusätzlich wird hiermit der Localmodus ausgeschaltet (d.h der

+Online-Modus eingeschaltet), falls das Kommando am Terminal im Local-Modus

+gegeben wurde. 

+ 

+Der Echo-Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D O#ie(1)#    (Hex 1B 44 4F) 

+ 

+ausgeschaltet. Das Terminal befindet sich dann im Fullduplex Online-Modus.

+Der Local-Modus wird auch hierbei verlassen. 

+ 

+Der Local-Modus kann vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D L#ie(1)#    (Hex 1B 44 4C) 

+ 

+eingeschaltet werden. Dabei ist zu beachten, daß der Host den Local-Modus

+nicht ausschalten kann. Der Local-Modus kann vom Benutzer durch Drücken von

+#ib(1)#<SHIFT CTRL HOME>#ie(1)# am Keyboard verlassen werden. 

+ 

+Im Local-Modus werden Keyboardeingabe nicht mehr an den Host geschickt,

+sondern auf dem Bildschirm angezeigt bzw. durch das Terminal interpretiert.

+Funktionstastensequenzen werden auch nicht an den Host geschickt. Escape-

+Sequenzen die allerdings Daten senden (z.B Download von Text und Graphik

+oder die Abfrage der Cursorposition), werden wie im Online-Modus ausgeführt,

+d.h. die Daten werden zum Host geschickt. 

+ 

+#page# 

+#h("8.", "Spezielle Kommandos im Textmodus")# 

+ 

+ 

+In diesem Kapitel werden weitere Kommandos, die im Textmodus wirksam sind

+und thematisch nicht in die anderen Kapitel passen, beschrieben. 

+ 

+ 

+#k("8.1", "Weitere Cursorpositionierungskommandos")# 

+ 

+Zusätzlich zu den im Graphikmodus und im Textmodus gültigen Cursorpositio-

+nierungskommandos gibt es noch einige weitere. Die fünf Kommandos Zeile

+löschen, Zeile einfügen, Zeichen löschen, Zeichen einfügen und Rückwärtsta-

+bulator sind schon in Kapitel 5 beschrieben worden. 

+ 

+Hier nur noch einmal die entsprechenden Kommandos: 

+ 

+Funktion            Escape-Sequenz 

+#linie("16.2")# 

+Zeile einfügen      #ib(1)#<ESC> E#ie(1)#     oder #ib(1)#<ESC> L#ie(1)# 

+Zeile löschen       #ib(1)#<ESC> R#ie(1)#     oder #ib(1)#<ESC> M#ie(1)# 

+Zeichen einfügen    #ib(1)#<ESC> Q#ie(1)# 

+Zeichen löschen     #ib(1)#<ESC> W#ie(1)# 

+Rückwärtstabulator  #ib(1)#<ESC> I#ie(1)# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> j#ie(1)#    (Hex 1B 6A) 

+ 

+kann ein umgekehrter Zeilenvorschub erreicht werden. Steht der Cursor in

+Zeile 2 bis Zeile 24, dann wirkt dieses Kommando wie <UP>. Steht der Cursor

+in Zeile 1, dann wird der Bildschirminhalt nach unten gescrollt und die

+erste Bildschirmzeile gelöscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> =#ie(1)# <y+32> <x+32>    (Hex 1B 3D ...) 

+ 

+kann der Cursor auf eine bestimmte Position auf dem Bildschirm gesetzt wer-

+den. <x+32> und <y+32> sind dabei Byteparameter. <x+32> hat den Wertebe-

+reich 32 (<SPACE>) bis 110 ("o"), <y+32> hat den Wertebereich 32 (<SPACE>)

+bis 55 ("7"). <x+32> ist dabei die gewünschte x-Position + 32 (gezählt wird

+von 0 bis 79), <y+32> ist die gewünschte y-Position + 32 (gezählt wird von 0

+bis 23). Die Zuordnungen der ASCII-Zeichen zu den Cursorpositionen kann man

+auch im Anhang A unter "Cursor" nachlesen. 

+ 

+Dieser Befehl hat im Graphikmodus die gleiche Wirkung! 

+ 

+ 

+#k("8.2", "Cursormodus")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> .#ie(1)# <n>    (Hex 1B 2E <n>) 

+ 

+kann die Darstellung des Cursors verändert werden. Für <n> sind ASCII-Zei-

+chen "0", "1" und "2" zugelassen. <n> hat folgende Bedeutung: 

+ 

+#on("u")#<n>   Bedeutung                             #off("u")# 

+ 0    Cursor blinkt nicht und ist unsichtbar 

+ 1    Cursor blinkt und ist sichtbar 

+ 2    Cursor blinkt nicht und ist sichtbar 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> Z#ie(1)#    (Hex 1B 5A) 

+ 

+kann der Zustand des Cursors von sichtbar auf unsichtbar und umgekehrt umge-

+schaltet werden. 

+ 

+ 

+#k("8.3", "Zeichensatz einstellen")# 

+ 

+Da die Zeichensätze von Basis und Apple unterschiedlich sind, muß hier bei

+den Parametern unterschieden werden. Das Kommando zur Einstellung des Zei-

+chensatzes lautet in beiden Fällen 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+wobei <n> ein Byteparameter ist. Beim Apple hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#linie("16.2")# 

+ 1    Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zei-

+ chen 

+ 4    Ascii: 128 Zeichen, ASCII, normale und blinkende Zeichen 

+ 

+Beim Basis hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#linie("16.2")# 

+ 0 = Apple II: 64 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 1 = Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 2 = Deutsch: 128 Zeichen, deutsch, normale und inverse Zeichen 

+ 4 = Ascii: 128 Zeichen, ASCII, normale und inverse Zeichen 

+ 6 = APL: 128 Zeichen, APL, normale und inverse Zeichen 

+ 

+     Und mit blinkenden statt inversen Zeichen: 

+ 8 = Apple II: 64 Zeichen, ASCII, normale, blinkende und inverse Zeichen (!) 

+ 9 = Full Ascii: 128 Zeichen, ASCII, normale, blinkende und inv. Zeichen (!) 

+10 = Deutsch: 128 Zeichen, deutsch, normale und blinkende Zeichen 

+12 = Ascii: 128 zeichen, ASCII, normale und blinkende Zeichen 

+14 = APL: 128 Zeichen, APL, normale und blinkende Zeichen 

+ 

+Einige ausgewählte Zeichensätze können auch in der Kommandozeile eingestellt

+werden. 

+ 

+ 

+#k("8.4", "Texthardcopy")# 

+ 

+Einen Ausdruck des Textbildschirminhaltes auf dem Drucker kann man mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> P#ie(1)#   (Hex 1B 50) 

+ 

+erreichen. Der auf dem Drucker eingestellte Schrifttyp wird nicht verän-

+dert. Es werden 24 Zeilen gedruckt, die Statuszeile wird nicht gedruckt,

+sondern die "darunterliegende" 24. Textzeile. Nach jeder Zeile wird <CR> und

+<LF> gedruckt, der Drucker sollte deshalb kein Autolinefeed bei <CR> durch-

+führen. 

+ 

+Inverse Bildschirmzeichen (80..FF) werden durch Doppeldruck (dunkler) her-

+vorgehoben, Controlcharacter (00..1F und 80..9F) werden unterstrichen dar-

+gestellt, das Punktraster (7F und FF) wird als unterstrichenes # darge-

+stellt. 

+ 

+ 

+#k("8.5", "Zeichen-Attribute")# 

+ 

+Die Zeichenattribute werden mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter, der folgende Werte annehmen kann: 

+ 

+#on("u")#<n>   Attribute                                                      #off("u")# 

+ 0    Sichtbare, normale Zeichen 

+ 1    Unsichtbare Zeichen, es werden Leerzeichen dargestellt 

+ 4    Sichtbare, inverse Zeichen 

+ 5    Unsichtbare Zeichen, es werden inverse Leerzeichen dargestellt. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#    (Hex 1B 28) 

+ 

+kann auf normale Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 0,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#    (Hex 1B 29) 

+ 

+kann auf inverse Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 4,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+ 

+#k("8.6", "Bildhintergrund hell/dunkel")# 

+ 

+Die Bildschirmdarstellung kann von heller Schrift auf dunklem Grund (be-

+züglich eines gelöschten Bildschirms) umgeschaltet werden auf dunkle Schrift

+auf hellem Grund. Die Darstellung "schwarz auf weiß" ist auf einigen Monito-

+ren augenfreundlicher. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> b#ie(1)#    (Hex 1B 62) 

+ 

+kann die dunkle Schrift auf weißem Grund eingeschaltet werden. Die Darstel-

+lung von inverser und normaler Schrift wird vertauscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> d#ie(1)#    (Hex 1B 64) 

+ 

+kann helle Schrift auf dunklem Grund eingeschaltet werden. 

+ 

+ 

+#k("8.7", "Zeichentransfer zum Host")# 

+ 

+Der Host kann Teile oder den ganzen Bildschirm vom Terminal lesen. Alle

+Zeichen werden als Bytes gesendet, bei denen ein gesetztes Bit 7 Invers-

+schrift anzeigt. 

+ 

+ 

+#k("8.7.1", "Ein Zeichen senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 8#ie(1)#    (Hex 1B 38) 

+ 

+wird nur das Zeichen an der Cursorposition gesendet. Die Cursorposition

+ändert sich nicht. Der Cursor muß nicht sichtbar sein. 

+ 

+ 

+#k("8.7.2", "Eine Zeile senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 6#ie(1)#    (Hex 1B 36) 

+ 

+wird die Zeile, in der der Cursor steht (genauer: die Zeile der Cursorrow,

+falls der Cursor unsichtbar ist) an den Host gesendet. Falls der Cursor in

+Zeile 24 steht, wird nicht die Stauszeile, sondern die 24. Textzeile gesen-

+det. Im Anschluß an die Zeile werden eventuell ein oder zwei eingestellte

+Zeilenbegrenzer gesendet (Lineterminator). Die Programmierung der Begrenzer

+ist in Abschnitt 8.7.4 beschrieben. Es werden also 80 bis 82 Zeichen gesen-

+det. Die Cursorposition ändert sich durch das Kommando nicht. 

+ 

+ 

+#k("8.7.3", "Eine Seite senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 7#ie(1)#    (Hex 1B 37) 

+ 

+wird die gesamte Bildschirmseite an den Host gesendet. Im Anschluß an jede

+Zeile werden (falls eingestellt) Zeilenbegrenzer gesendet. Im Anschluß an

+die gesamte Seite wird ein (eingestellter) Seitenbegrenzer (Pageterminator)

+gesendet. Es werden also je nach Zeilen- und Seitenbegrenzer 1920 bis 1969

+Zeichen gesendet. Die Statuszeile wird nicht gesendet, sondern die "darun-

+terliegende" 24. Textzeile. Die Programmierung der Zeilen- und Seitenbe-

+grenzer ist in Abschnitt 8.7.4 beschrieben. Die Cursorposition ändert sich

+durch dieses Kommando nicht. 

+ 

+ 

+#k("8.7.4", "Terminatorzeichen definieren")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 1#ie(1)# <l1> <l2>    (Hex 1B 78 31 <l1><l2>) 

+ 

+können die Zeilenbegrenzer der Sendekommandos festgelegt werden. <l1> und

+<l2> sind dabei Byteparameter, die den Wertebereich 0 bis 255 überstrei-

+chen. Ist ein Parameter Hex 00, dann wird dieses Zeichen nicht gesendet.

+Wenn man also das Kommando (Hex) 1B 78 31 00 00 sendet, wird kein Begren-

+zerzeichen nach der Zeile gesendet. 

+Voreingestellt ist ein Begrenzerzeichen; und zwar US (Hex 1F). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 4#ie(1)# <p>    (Hex 1B 78 34 <p>) 

+ 

+kann der Seitenbegrenzer des Kommandos #ib(1)#<ESC> 7#ie(1)# festgelegt werden. <p> ist

+ein Byteparameter, der den Wertebereich von 0 bis 255 überstreicht. Ist <p>

+Hex 00, dann wird kein Seitenbegrenzer gesendet. 

+Voreingestellt ist <p> = <CR> (Hex 0D). 

+ 

+ 

+#k("8.7.5", "Cursorposition senden")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ?#ie(1)#    (Hex 1B 3F) 

+ 

+kann der Host die Position des Textcursors abfragen. Es wird eine Folge von

+3 Bytes gesendet: <y+32> <x+32> <CR> 

+ 

+<y+32> ist die y-Position + 32, <x+32> die x-Position + 32. Beide Parameter

+können für den Befehl #ib(1)#<ESC> =#ie(1)# <y+32> <x+32> verwendet werden, da Sie den

+gleichen Wertebereich überstreichen. 

+ 

+ 

+#k("8.8", "Textseite auf Diskette speichern/laden")# 

+ 

+Genau wie Graphikseiten kann auch die Textseite auf Diskette geschrieben und

+zu einem späteren Zeitpunkt wieder zurückgeladen werden. Bei der Textseite

+wird außerdem noch die aktuelle Cursorposition geladen/geschrieben. Man kann

+sich zum Beispiel eine Datei Seitenweise auf dem Bildschirm anzeigen lassen

+und diese Seiten auf Diskette abspeichern. Später kann man die Datei Offline

+(im Localmodus) Seitenweise ansehen. 

+ 

+Bis zu 8 Textseite lassen sich auf Diskette speichern und wieder abrufen.

+Die "Fächer" für die Textseiten sind unabhängig von denen für die Graphik-

+seiten. 

+Die Seiten werden unabhängig von REVVID (Schwarz auf Weiß) immer NORVID

+(also Weiß auf Schwarz) abgespeichert. Beim Laden der Seite wird sie je nach

+REVVID/NORVID dargestellt. 

+ 

+Das Kommando für diese Operationen lautet 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 31, wobei die Bits

+folgendermaßen belegt sind: 

+Bit 0..2 : "Fachnummer" der Textseite auf der Diskette (0 bis 7) 

+Bit 3    : Bei Textseiten immer 0 (Bei Graphikseiten immer 1) 

+Bit 4    : 0 heißt: die Textseite wird von der Diskette gelesen, 

+           1 heißt: die Textseite wird auf die Diskette geschrieben. 

+ 

+Wird die Textseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Textseite überschrieben. 

+ 

+Für Insider: Jede Textseite belegt einen halben Track (2k). Die 8 Textseiten

+             befindenden auf den Tracks 6 bis 9 in aufsteigender Reihenfol-

+             ge. 

+ 

+ 

+#page# 

+#h("9.", "Verschiedene Steuerkommandos")# 

+ 

+ 

+#k("9.1", "Signalton")# 

+ 

+Mit 

+                         #ib(1)#<CTRL G>#ie(1)#   (Hex 07) 

+ 

+wird ein kurzer Signalton ausgegeben. Ein Warnton des Terminals ist schär-

+fer (heller). 

+ 

+ 

+#k("9.2", "Keyboardclick")# 

+ 

+Der Tastaturclick wird für fast alle Tasten erzeugt. Ausnahmen sind die

+<SHIFT> und die <CTRL> Tasten, sowie beim Apple die Apfeltasten. Der Tasta-

+turclick kann in der ersten Kommandozeile abgeschaltet werden (CLK OFF) oder

+mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <#ie(1)#    (Hex 1B 3C) 

+ 

+vom Host. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> >#ie(1)#    (Hex 1B 3E) 

+ 

+kann der Keyboardclick wieder eingeschaltet werden. 

+ 

+ 

+#k("9.3", "Bildschirmausgabe/Druckerausgabe")# 

+ 

+Die Bildschirmausgabe, die ja normalerweise eingeschaltet ist, kann in der

+Kommandozeile abgeschaltet werden (SCRNOFF) oder vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> `#ie(1)#    (Hex 1B 60) 

+ 

+abgeschaltet werden. Bis auf das Kommando 

+ 

+                         #ib(1)#<ESC> a#ie(1)#    (Hex 1B 61) 

+ 

+werden keine Escape-Squenzen oder Control-Codes interpretiert. Mit <ESC> a

+wird die Bildschirmausgabe wieder zugelassen. 

+ 

+Die Druckerausgabe kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> @#ie(1)#    (Hex 1B 40) 

+ 

+eingeschaltet werden. Man kann dann Texte parallel auf Drucker und Bild-

+schirm ausgeben. In der ersten Kommandozeile kann die Druckerausgabe auch

+ein- und ausgeschaltet werden. 

+Man kann zum Beispiel den Schrifttyp des Druckers im Local-Modus umschal-

+ten, wenn man in der Kommandozeile die Druckerausgabe (PRT ON) einschaltet.

+Dazu kann man sich auch eine Funktionstaste belegen, die Bildschirmausgabe

+abschaltet, Druckerausgabe einschaltet, den Schrifttyp umschaltet, Drucker-

+ausgabe wieder ausschaltet und Bildschirmausgabe wieder einschaltet. 

+ 

+Abgeschaltet wird die Druckerausgabe mit dem Kommando 

+ 

+                         #ib(1)#<ESC> A#ie(1)#    (Hex 1B 41) 

+ 

+ 

+#k("9.4", "Scroll/Page-Modus")# 

+ 

+Steht der Cursor in der letzten Zeile und soll er in die nächst tiefere

+gebracht werden (<DOWN>, <TAB>, <NEWLINE> etc.), dann gibt es entweder die

+Möglichkeit, daß der Bildschirm nach oben gescrollt wird, d.h. die 1. Zeile

+verschwindet und die 24. Zeile wird gelöscht, oder daß der Cursor in der

+ersten Bildschirmzeile wieder auftaucht, ohne daß der Bildschirminhalt ver-

+ändert wird. Die erste Möglichkeit heißt SCROLL-Modus, die zweite PAGE-

+Modus. Die Umschaltung kann entweder in der ersten Kommandozeile erfolgen

+oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> H#ie(1)#    (Hex 1B 48). 

+ 

+In der Kommandozeile hat man die Informationsmöglichkeit, welcher Modus

+gerade aktiv ist. 

+ 

+ 

+#k("9.5", "Belegung der Funktionstasten")# 

+ 

+Eine nützliche Angelegenheit sind die programmierbaren Funktionstasten. Die

+Codes der Funktionstasten sind unter anderem in Anhang A zu finden. Funk-

+tionstasten können im Local-Modus aufgerufen werden, zum Beispiel für häu-

+fig gebrauchte Terminalkommandos oder längere Kommandosequenzen (Graphikmo-

+dus). Im Online-Modus kann man z.B. Betriebssystemkommandos auf Funktion-

+stasten legen. 

+ 

+Die Länge der Zeichen auf allen Funktionstasten darf zusammen nicht 4095

+Zeichen überschreiten. Ein akustisches Warnsignal ertönt, wenn die Funk-

+tionstastentabelle voll ist. Soll die Funktionstastendefinition auch noch

+nach dem Abschalten des Terminals erhalten bleiben, dann muß in der Komman-

+dozeile <SHIFT S> gegeben werden, damit der Setup samt Funktionstastende-

+finitionen auf die Diskette geschrieben wird. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+wird eine Taste belegt. <d...> und <t> sind Byteparameter. <d...> ist eine

+Folge von Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funk-

+tionstaste (Bit 7 = 1), auf die die Sequenz gelegt werden soll. Durch diese

+Einschränkung sind keine rekursiven (sich selbst aufrufenden) Tastenkomman-

+dos möglich, man kann allerdings z.B. auch nicht alle binären Parameter auf

+Tasten legen (Man sollte dezimale Parameter benutzen). Die Cursortasten etc.

+können nicht belegt werden. 

+Um die Original-Tastencodes wieder zu benutzen, gibt es drei Möglichkeiten: 

+ 

+- Die Tabelle der Tastendefinitionen wird ganz gelöscht (Abschnitt 9.6). 

+- Die Definition auf einzelnen Tasten wird durch <ESC> e <t> gelöscht. <t>

+  ist dabei der Code einer zu löschenden Taste. 

+- In der ersten Kommandozeile wird F CODE eingeschaltet oder das Kommando 

+ 

+                         #ib(1)#<ESC> c#ie(1)#    (Hex 1B 63) 

+ 

+  gegeben. Dieses Kommando schaltet um, ob immer Tastencodes (A1..EF) oder,

+  bei belegten Tasten, die programmierte Sequenz geliefert werden soll. Im

+  Graphikmodus möchte man eventuell die griechischen Sonderzeichen auf den

+  Funktionstasten benutzen (F CODE) und nicht die programmierten Tasten-

+  strings (F STRG). 

+ 

+ 

+#k("9.5.1", "Local-Escape")# 

+ 

+Um Funktionstasten mit Terminalkommandos auch im Online-Modus benutzen zu

+können (zum Beispiel ein Bildschirm Hardcopy) wird ein spezielles ESC-Zei-

+chen statt <ESC> (Hex 1B) verwendet. 

+Das Zeichen 

+ 

+                         #ib(1)#<LOCESC>#ie(1)#    (Hex 9B) 

+ 

+teilt dem Terminal mit, daß die nun folgende Escape-Sequenz nicht an den

+Host gesendet wird (was bei <ESC> der Fall wäre), sondern vom Terminal in-

+terpretiert werden muß. 

+Im Local-Modus wirkt ein <LOCESC> wie ein normales <ESC>, d.h. das Kommando

+wird sowieso vom Terminal interpretiert. 

+ 

+ 

+#k("9.5.2", "Makrokommandos")# 

+ 

+Ein Makrokommando hat (mindestens) drei Aufgaben: 

+- Der Host kann dem Terminal neue ESC-Sequenzen (mit Parametern) definieren,

+  z.B. um andere Terminals zu emulieren. 

+- Nicht nur das Terminal kann Funktionstasten aufrufen, sondern auch der

+  Host, wenn die Funkionstaste als Makro aufgerufen wird. 

+- Der Datentransfer vom Host zum Terminal kann durch Makros als Abkürzungen

+  häufig benutzter Zeichenfolgen beschleunigt werden. 

+ 

+Ein Makro wird wie eine Funktionstaste mit dem Kommando 

+ 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+definiert. <d...> und <t> sind Byteparameter. <d...> ist eine Folge von

+Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funktionstaste

+(Bit 7 = 1) oder mit anderen Worten der Makroname. 

+Es sind alle Codes für <t> zugelassen, die auch bei der Funktionstastende-

+finition zugelassen sind. 

+ 

+Ein Makro kann sowohl vom Terminal (auch im F CODE-Modus) als auch vom Host

+mit 

+ 

+                         #ib(1)#<ESC> <Macrocode>#ie(1)#    (Hex 1B <Makrocode>) 

+ 

+aufgerufen werden. Dem Terminal wird die Zeichensequenz des Makros so vorge-

+setzt, als käme sie von der Tastatur im Local-Modus. Wird das Makro also

+bereits im Local-Modus aufgerufen, hat das immer noch den Vorteil, daß man

+im F CODE-Modus weiterhin programmierte Funktionstasten benutzen kann. 

+Anmerkung: Wird das <ESC> vor dem <Makrocode> weggelassen, dann wird der

+           Code <Makrocode> ohne Makroausführung an das Terminal gesendet

+           und i.d.R. als inverses Zeichen dargestellt. 

+ 

+Sollen Byteparameter in die Zeichensequenz des Makros übernommen werden, die

+zur Zeit der Makrodefinition noch nicht feststehen, dann kann man einen

+Platzhalter mit dem Code Hex 81 an der Stelle einsetzen. Der Code Hex 81

+kann auf der Tastatur durch <SHIFT DELETE> erzeugt werden. 

+Wird bei der Makroausführung ein solcher Code gefunden, wartet das Terminal

+auf ein Byte von Tastatur, wenn das Makro im Local-Modus aufgerufen wurde,

+oder vom Host, wenn das Makro vom Host aufgerufen wurde. Es dürfen beliebig

+viele Codes 81 in der Makrozeichensequenz vorhanden sein. Jeder Code wird

+durch ein weiteres Zeichen von Host oder Tastatur ersetzt. 

+ 

+ 

+#k("9.5.3", "Startup-Makro")# 

+ 

+Ein besonderes Makro hat den Code Hex EF. Dieser Code kann auf der Tastatur

+durch <SHIFT BOTTOMRIGHT> (beim Apple <OA RIGHT>) erzeugt werden. 

+ 

+Dieses Makro wird bei einem RESET des Terminals (Hardwarereset oder <ESC> 0)

+oder beim Einschalten des Terminals aufgerufen. Der Bildschirm und die Gra-

+phikseiten werden vorher gelöscht. 

+

+

+#k("9.6", "Tabellen und Puffer löschen")# 

+ 

+Das Terminal enthält den Empfangspuffer, den Sendepuffer, den Druckerspoo-

+ler und die Tabelle der Tastendefinitionen. Um einen der Puffer oder die

+Tabelle zu löschen, kann das Kommando 

+ 

+                         #ib(1)#<ESC> <DEL>#ie(1)# <n>    (Hex 1B 7F <n>) 

+ 

+verwendet werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 15

+und hat folgende Bedeutung: 

+ 

+#on("u")#<n>    Gelöschte Tabelle oder Puffer#off("u")# 

+ 0     Keine 

+ 1     Tastendefinitionen 

+ 2     Druckerspooler 

+ 3     Empfangspuffer 

+ 4     Sendepuffer 

+ 

+Zu beachten ist, daß zwar der Sendepuffer gelöscht wird, aber eine eventu-

+ell gestoppte Übertragung (TX OFF) nicht wider gestartet wird. 

+ 

+ 

+#k("9.7", "Zeitverzögerung")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 9#ie(1)# <n>    (Hex 1B 39 <n>) 

+ 

+kann eine Zeitverzögerung aufgerufen werden. Man kann zum Beispiel ein Fa-

+denkreuz darstellen, die Zeitverzögerung aufrufen und das Fadenkreuz wieder

+löschen. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 255. Die

+Verzögerung beträgt ca. <n> * 2 ms. 

+ 

+ 

+#k("9.8", "Transparentmodi")# 

+ 

+Der Monitor- und der Hexadezimalmodus sind zum Test von unbekannten Emp-

+fangsdaten oder zum Analysieren der Steuerzeichenausgabe von unbekannten

+Programmen gedacht. 

+ 

+ 

+#k("9.8.1", "Monitor-Modus")# 

+ 

+Im Monitor-Modus werden druckbare Zeichen wie normal dargestellt. Control-

+zeichen (Hex 00..1F und 80..9F) werden invertiert dargestellt. Im APL-Zei-

+chensatz kann man diese inversen Controlzeichen von den Zeichen mit Code Hex

+A0..FF unterscheiden, die auch invers dargestellt werden. 

+Der Monitormode kann in der ersten Kommandozeile ein- und ausgeschaltet

+werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> U#ie(1)#    (Hex 1B 55) 

+ 

+kann der Monitormode eingeschaltet werden. Alle Zeichen werden ohne Inter-

+pretation ausgegeben, Ausnahmen sind 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58) 

+ 

+die den Monitormodus ausschalten. 

+ 

+ 

+#k("9.8.2", "Hexadezimal-Modus")# 

+ 

+In diesem Modus werden nicht die Zeichen auf dem Bildschirm gedruckt, son-

+dern ihr ASCII-Code in hexadezimaler Schreibweise mit zwei nachfolgenden

+Blanks. Der Hexmode kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+ein- und ausgeschaltet werden. Alle Zeichen werden ohne Interpretation aus-

+gegeben, außer #ib(1)#<ESC> u#ie(1)# und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58), 

+ 

+die den Hexmodus wieder ausschalten. Auch der Hexmode kann in der ersten

+Kommandozeile ein- und ausgeschaltet werden. 

+ 

+ 

+#k("9.8.3", "Einzelne Control-Zeichen anzeigen")# 

+ 

+Um nur einzelne Controlzeichen auf dem Bildschirm darzustellen, z.B. für den

+unteren Teil des APL-Zeichensatzes (Codes 0 bis 31 oder 128 bis 159), gibt

+es das Kommando 

+ 

+                         #ib(1)#<ESC> F#ie(1)# <z>    (Hex 1B 46 <z>). 

+ 

+<z> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 255, vorzugswei-

+se 0 bis 31. <z> wir mit invertiertem Bit 7 (normal/invers) in den Bild-

+schirmspeicher an der aktuellen Cursorposition geschrieben. 

diff --git a/system/ruc-terminal/unknown/doc/TDOCP.PRT b/system/ruc-terminal/unknown/doc/TDOCP.PRT
new file mode 100644
index 0000000..1c2b6f1
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TDOCP.PRT
@@ -0,0 +1,4008 @@
+#type ("elite")##limit (16.2)##block# 

+#page##--------------------------------- Ende der Seite 0 -----------#

+#text begin# 

+ 

+#type ("8")##center##on("b")##on("u")#Bedienungshandbuch zum ruc - Graphikterminal#off("u")##off("b")##type ("elite")# 

+ 

+#center#Version 1.1 

+ 

+#center#Oktober 1986 

+#free (16.0)# 

+ruc - Rolf Uhlig Computer 

+GmbH & Co Kommanditgesellschaft 

+Sendenhorster Straße 82 

+D - 4406 Drensteinfurt 1 

+Telefon 02508/8500 

+ 

+Michael Staubermann 

+Moränenstraße 29 

+D - 4400 Münster-Hiltrup 

+Telefon 02501/4320 

+#pagenr (""224"", 1)#

+#text end#

+#free(2.2225)#

+#page##--------------------------------- Ende der Seite 1 -----------#

+#center##on("b")#1.  Einige Worte zuvor#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin#

+#type("8")##center##on("i")##on("u")##ib(3)#1.  Einige Worte zuvor#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Dieses Terminalprogramm wird in zwei Versionen (für den Basis 108 und den

+Apple IIe) geliefert. Die Version ist in der Kommandozeile erkenntlich

+(BASIS oder APPLE). 

+ 

+Eigenschaften des Terminals: 

+ 

+- Kommandozeilen für schnelle Offline Parametereinstellung 

+- Statuszeile für spezielle Betriebzustände 

+- Über 70 programmierbare Funktionstasten 

+- Druckerspooler 32k (4 ganze Graphikhardcopys und noch mehr) 

+- 7935 Zeichen Empfangspuffer 

+- Verschiedene Hardcopy Modi für Text und Graphik 

+- 192x280 Punkte auflösender Graphikmodus mit zwei Helligkeitsstufen 

+- Zwei Graphikseiten mit getrennter Anzeige/Bearbeitung 

+- Viele Graphikroutinen (Bogen, Flächenfüllung, Kreis, Rechteck...) 

+- Graphikmodus für Texte in verschieden Richtungen, Dicken, Grössen 

+- Griechische Graphikzeichen und Kursivschrift 

+- Graphikseiten Scrollen, Mischen, vom Host laden, zum Host schicken 

+ 

+ 

+Zum Handbuch 

+ 

+Tasten werden durch Angabe ihres Aufdruckes in Grossbuchstaben angegeben und

+in spitze Klammern gesetzt (z.B. <TAB>) in einigen Fällen auch durch ihren

+Namen (z.B. <DOWN> oder <TOPLEFT>). Eine zusätzlich zu betätigende Umschalt-

+taste, wie SHIFT, CTRL, OPEN APPLE (kurz: OA) oder beide zusammen, wird in

+der Klammer davorgestellt (z.B. <SHIFT RETURN>). 

+ 

+Nicht druckbare Ascii-Codes (z.B. <ESC> oder <SPACE>), sowie Kommandopara-

+meter (z.B. <n>) werden ebenfalls in spitze Klammern gesetzt. Komandopara-

+meter werden mit Kleinbuchstaben bezeichnet. 

+ 

+#text end#

+#free(7.220185)#

+ 

+ 

+ 1 

+#page##--------------------------------- Ende der Seite 1 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#2.  Die Hardware#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Unterstützt wird eine 80-Zeichen Textanzeige, ein Basiskeyboard oder ein

+Applekeyboard mit Open-Apple Taste. Am Basis kann ein Drucker angeschlossen

+werden. 

+ 

+ 

+#type("8")##center##ib(3)#2.1  Die serielle Schnittstelle#ie(3)##type("elite")# 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host oder vom Terminal

+(LOCAL) eingestellt werden (Siehe Kommando <ESC> <SPACE> <SPACE>). Es wer-

+den alle 15 gängigen Baudrates zwischen 50 und 19200 Baud unterstützt. Pari-

+tycheck kann mit gerader oder ungerader Parität durchgeführt werden. Fluß-

+kontrolle ist in allen Kombinationen aus RTS/CTS, DTR/DSR, XON/XOFF möglich.

+Empfohlen wird DTR/DSR oder XON/XOFF. 

+ 

+             Benötigte Verdrahtung der seriellen Schnittstelle 

+ 

+            Pin                                        Priorität 

+              2 : TXD Sendedaten    zum Host (RXD)         1 

+              3 : RXD Empfangsdaten vom Host (TXD)         1 

+              4 : RTS Ready To Send zum Host (CTS)         3 

+              5 : CTS Clear To Send vom Host (RTS)         3 

+              6 : DSR DataSet Ready vom Host (DTR)         2 

+              7 : Masse an Host Masse                      1 

+              8 : DCD Eingang, nicht benötigt 

+             20 : DTR Data Terminal Ready zum Host (DSR)   2 

+ 

+Priorität: 

+ 1 : Muß verdrahtet werden 

+ 2 : Ist bei DSR/DTR Flußkontrolle zu verdrahten 

+ 3 : Ist bei RTS/CTS Flußkontrolle zu verdrahten 

+ 

+Der Datentransfer geschieht in der Regel mit 8 Datenbits. Sollte der Host

+nur über 7 Bit Datentransfer verfügen, müssen einige Einschränkungen bei der

+Parameterübergabe von Uploads/Downloads gemacht werden (Kein Farbbit). Die

+Anzahl der Datenbits kann auch in der Kommandozeile verändert werden. 

+ 

+ 

+#type("8")##center##ib(3)#2.2  Der Reset#ie(3)##type("elite")# 

+ 

+Ein Reset bringt das Terminal in einen definierten Zustand. Alle Bildschirm-

+seiten und Puffer, sowie der Druckerspooler werden gelöscht. Der Reset kann

+vom Host durch 

+ 

+                         #ib(1)#<ESC> 0#ie(1)#    (Hex 1B 30) 

+ 

+initiiert werden, vom Basiskeyboard aus durch <SHIFT SHIFT CTRL>. Die Para-

+meter in der Kommandozeile werden dem Setup entnommen. Nach dem Löschen

+aller Bildschirmseiten, wird das Makro mit dem Code Hex EF aufgerufen. Dies

+ist die Funktionstaste <SHIFT BOTRIGHT>. 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#2 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 2 -----------#

+#center##on("b")#3.  Die Kommandozeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#3.  Die Kommandozeile#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Die wichtigsten Parameter des Terminals können im laufenden Betrieb in den

+beiden Kommandozeilen geändert werden. Die erste Kommandozeile erscheint

+beim Basiskeyboard durch Drücken von <SHIFT CE> und beim Apple durch <OA

+CTRL X>. 

+ 

+Im Graphikmodus ersetzt die Kommandozeile die untersten 32 Graphikzeilen

+(entspricht vier Textzeilen). Man hat also auch im Graphikmodus die Mög-

+lichkeit wichtige Parameter in der Kommandozeile zu ändern. 

+ 

+Die angezeigten Einstellungen bieten außerdem eine Informationsmöglichkeit

+über die aktuellen Parameter der seriellen Schnittstelle u.s.w. Die zweite

+Kommandozeile enthält die Parameter der seriellen Schnittstelle. 

+ 

+Alle in den Kommandozeilen angezeigten Parameter (bis auf BELL ON/BELL OFF)

+können auch durch ESC-Kommandos vom Host oder im Localmodus geändert wer-

+den. 

+Ein laufender Druckvorgang wird unterbrochen, solange die Kommandozeilen

+sichtbar sind. 

+ 

+ 

+#type("8")##center##ib(3)#3.1  Tastenfunktionen in der Kommandozeile#ie(3)##type("elite")# 

+ 

+Folgende Tasten haben in der Kommandozeile eine Wirkung: 

+ 

+Taste              Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+<UP> oder <DOWN>   Wechselt in die jeweils andere Kommandozeile 

+ 

+<LEFT>             Springt zum vorherigen (linken) Parameter ohne etwas zu

+                   verändern. 

+ 

+<RIGHT>            Springt zum nächsten (rechten) Parameter ohne etwas zu

+                   verändern. 

+ 

+<SPACE>            Ändert das selektierte Parameterfeld. Das selektierte

+                   Parameterfeld ist durch Invertierung hervorgehoben. Die

+                   möglichen Parameter wiederholen sich zyklisch. 

+ 

+<ESC>              Die Kommandozeile wird verlassen. Es werden keine Ände-

+                   rungen durchgeführt. 

+ 

+<SHIFT S>          Die Kommandozeile wird verlassen. Vorher werden alle

+                   Änderungen permanent auf die Diskette geschrieben. Wei-

+                   tere Einzelheiten s.u. (Setup) 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 3 

+#page##--------------------------------- Ende der Seite 3 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")#

+#text begin# 

+<SHIFT R>          Alle Parameter werden auf ihre Defaultwerte zurückge-

+                   setzt. Die Kommandozeile wird noch nicht verlassen, daher

+                   kann dieser 'Reset' durch <ESC> wieder aufgehoben werden. 

+                   <CE> oder <CTRL X> Die Kommandozeile wird verlassen. Die

+                   Änderungen werden nur im Speicher vermerkt. Nach dem

+                   Ein-/Ausschalten des Rechners werden die alten Parameter

+                   von der Diskette gelesen. Wird allerdings ein Hardware-

+                   reset (s.o.) durchgeführt, sind diese Änderungen nicht

+                   verloren. 

+ 

+ 

+#type("8")##center##ib(3)#3.2  Setup#ie(3)##type("elite")# 

+ 

+Beim Setup, der in der Kommandozeile durch <SHIFT S> ausgelöst werden kann,

+werden wichtige Parameter auf die Diskette geschrieben. Sie werden dann

+'permanent' und müssen nach dem Einschalten des Terminals nicht neu einge-

+stellt werden. Diese Parameter sind die 

+- Parameter der seriellen Schnittstelle (2. Kommandozeile) 

+- anderen Parameter der Kommandozeilen 

+- vom Benutzer programmierte Belegung der Funktionstasten 

+- Druckerspezifischen Hardcopyparameter 

+ 

+Vor dem Setup ist zu prüfen, ob der Diskettenschreibschutz entfernt wurde

+(Klebeschildchen an der Diskettenseite entfernen). Der Schreibschutz sollte

+nach dem Setup wieder angebracht werden. Wurde der Schreibschutz nicht ent-

+fernt, wird eine Meldung 'Diskettenschreibschutz entfernen !' angezeigt. In

+diesem Falle erscheint nach dem Drücken einer Taste wieder die Kommando-

+zeile. 

+Wenn keine Diskette einliegt oder ein harter Schreibfehler auftritt, er-

+scheint die Meldung 'Setup kann nicht geschrieben werden (Diskettenfeh-

+ler)!'. Weitere Schreibversuche sind möglicherweise erfolgreich. 

+ 

+ 

+#type("8")##center##ib(3)#3.3  Die zweite Kommandozeile#ie(3)##type("elite")# 

+ 

+Beim Basis (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+GER|BASIS|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+USA  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+APL       HEX ON                                                  CUR OFF 

+UNI 

+#type ("elite")# 

+ 

+Beim Apple (erste Zeile zeigt Defaultwerte für <SHIFT R>) 

+ 

+#type ("micron")# 

+USA|APPLE|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG 

+FLH  TVI  MON ON  PRT ON  SCRN OFF CLK OFF REVVID  PAGE  BELL OFF CUR STD F CODE 

+          HEX ON                                                  CUR OFF 

+#type ("elite")# 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#4 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 4 -----------#

+#center##on("b")#3.  Die Kommandozeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")#

+#text begin# 

+Default Andere   Funktion 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+Basis 

+ GER    USA      Die Zeichensatzeinstellung ist für die gebräuchlichsten 

+        APL      vier Zeichensätze in der Kommandozeile möglich. 

+        UNI      GER = Deutsch Ascii, USA = US Ascii, APL = APL-Zeichensatz

+                 UNI = Deutscher Zeichensatz mit inversen APL Zeichen. Der

+                 APL-Zeichensatz entählt auch die Zeichen [\]{|}~. Über

+                 ESC-Kommandos lassen weitere Möglichkeiten einstellen. 

+ 

+ BASIS  TVI      Keyboard Emulation. BASIS sendet die Funktionstastencodes

+                 mit Bit 7 = 1. TVI sendet für jede Funktionstaste eine

+                 Zeichenfolge <SOH> x <CR>. Die Cursortasten sowie DEL CHAR,

+                 INS CHAR, DEL LINE, INS LINE werden wie bei TVI üblich

+                 gesendet. Weiter Einzelheiten s.u. (TVI-Emulation) 

+ 

+Apple 

+ USA    FLH      USA = US Ascii, FLH = Voller Ascii Zeichensatz mit Blinken

+                 und Invers. 

+ 

+ APPLE  TVI      Keyboard Emulation. APPLE führt keine Codeumsetzung durch.

+                 Wird allerdings die <OPEN APPLE>-Taste mit einer anderen

+                 Taste zusammen gedrückt, wird das Bit 7 im Code auf 1 ge-

+                 setzt. Zur TVI-Emulation siehe oben. 

+ 

+MON OFF MON ON   Der Monitor Modus wird mit MON ON eingeschaltet. In diesem 

+        HEX ON   Modus werden alle Steuerzeichen auf dem Bildschirm mar-

+                 kiert ausgegeben. Bis auf die Kommandos <ESC> u oder <ESC>

+                 X (um den Monitormodus auszuschalten) werden keine Komman-

+                 dos interpretiert. Alle anderen Zeichen werden unverändert

+                 dargestellt. Der Monitormodus kann auch durch MON OFF aus-

+                 geschaltet werden. 

+                 Im Hexmodus werden keine Zeichen, sondern deren Ascii-

+                 Codes in Hexadezimaldarstellung ausgegeben. 

+ 

+PRT OFF PRT ON   Parallele Druckerausgabe. Ist PRT ON eingeschaltet, werden

+                 alle Zeichen die von der seriellen Schnittstelle kommen,

+                 auf dem Drucker ausgegeben bzw. in den Druckerspooler ge-

+                 schrieben. Die Bildschirmausgabe wird hiervon nicht beein-

+                 flußt. 

+ 

+SCRN ON SCR OFF  Bildschirmausgabe an/aus. Ist SCRN ON eingeschaltet, wer-

+                 den alle Zeichen die von der seriellen Schnittstelle kom-

+                 men, auf dem Bildschirm ausgegeben. SCR OFF und PRT ON kann

+                 zum Beispiel benutzt werden, um Daten nur an den Drucker zu

+                 schicken, ohne daß diese auch auf dem Bildschirm erschei-

+                 nen. 

+ 

+KEY CLK CLK OFF  Tastaturklick an/aus. Ist KEY CLK eingeschaltet, gibt jede

+                 Taste (bis auf SHIFT, CTRL) bei ihrer Betätigung einen Ton

+                 (Klick) von sich. CLK OFF schaltet dies ab. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 5 

+#page##--------------------------------- Ende der Seite 5 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+NORVID  REVVID   Bildschirmdarstellung. NORVID stellt hellen Text auf

+                 schwarzem Grund dar, REVVID stellt schwarzen Text auf hel-

+                 lem Grund dar (Möglicherweise angenehmer für die Augen). 

+ 

+SCROLL  PAGE     Ist SCROLL eingeschaltet, wird der Bildschirm um eine Zeile

+                 nach oben geschoben, sobald der Cursor in der letzten Bild-

+                 schirmzeile steht und ein Zeilenvorschub <LF> ausgeführt

+                 werden soll. Die erste Bildschirmzeile verschwindet. Ist

+                 PAGE eingeschaltet, springt der Cursor in einer solchen

+                 Situation in die erste Bildschirmzeile. Die Cursorspalte

+                 wird dabei nicht verändert. 

+ 

+BELL ON BELL OFF Normalerweise erzeugt jedes empfangene <CTRL G> einen kur-

+                 zen Signalton. Wenn das stört, kann die Tonausgabe mit BELL

+                 OFF abgeschaltet werden. 

+ 

+CUR FLH CUR STD  Cursordarstellung. CUR FLH zeigt einen blinkenden CUR OFF

+                 Cursorblock. CUR STD zeigt einen nichtblinkenden Cursor-

+                 block. CUR OFF schaltet den Cursor ab (unsichtbar). 

+ 

+F STRG  F CODE   Funktionstastenbelegung. Ist F STRG eingeschaltet, erzeugt

+                 eine programmierte (belegte) Funktionstaste keinen Tasten-

+                 code, sondern sendet die programmierten Zeichen. Eine unbe-

+                 legte Funktionstaste sendet ihren Tastencode. Ist F CODE

+                 eingeschaltet, erzeugen auch belegte Funktionstasten einen

+                 Tastencode und senden keine programmierten Zeichen. 

+ 

+ 

+#type("8")##center##ib(3)#3.4  Die zweite Kommandozeile#ie(3)##type("elite")# 

+ 

+Die erste Zeile zeigt Defaultwerte für <SHIFT R>: 

+ 

+#type ("micron")# 

+STATOFF|TXT| 9600|STOP 1|DATA 8|NO  PAR|NO XONOFF|NO RTSCTS|NO DTRDSR 

+STAT ON GFX 19200 STOP 2 DATA 7 EVN PAR  XON/XOFF  RTS/CTS   DTR/DSR 

+               50               ODD PAR 

+               75 

+            109.9 

+            134.6 

+              150 

+              300 

+              600 

+             1200 

+             1800 

+             2400 

+             3600 

+             4800 

+             7200 

+#type ("elite")# 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+#right#6 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 6 -----------#

+#center##on("b")#3.  Die Kommandozeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Default Andere   Funktion 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+STATOFF STAT ON  Anzeige der Statuszeile. Der Arbeitsbereich des Bildschirms

+                 beträgt zwar immer 24 Zeilen, allerdings ist bei STAT ON

+                 anstelle der 24. Textzeile die Statuszeile sichtbar. Bei

+                 STATOFF wird der aktuelle Inhalt der 24. Textzeile sicht-

+                 bar. Einzelheiten s.u. (Die Statuszeile) 

+ 

+TXT     GFX      Textmodus/Graphikmodus. TXT schaltet in die 80x24 Zeichen

+                 Textdarstellung um. GFX schaltet auf die aktuelle Graphik-

+                 seite um. 

+ 

+9600    19200    Wählt die Baudrate für die serielle Schnittstelle. 

+           50    Die Angabe erfolgt in Bits/Sekunde (Baud) 

+           75 

+          109.9 

+          134.6 

+          150 

+          300 

+          600 

+         1200 

+         1800 

+         2400 

+         3600 

+         4800 

+         7200 

+ 

+STOP 1  STOP 2   Wählt die Anzahl der Stopbits für die serielle Schnitt-

+                 stelle. 

+ 

+DATA 8  DATA 7   Wählt die Anzahl der Datenbits für die serielle Schnitt-

+                 stelle. 

+ 

+NO PAR  EVN PAR  Wählt Parity Check Art. NO PAR = Kein Paritätsbit, keine 

+        ODD PAR  Paritätsprüfung. EVN PAR = Gerade Parität, ODD PAR = Unge-

+                 rade Parität. 

+ 

+NO XONOFF        Wählt XON (CTRL Q) und XOFF (CTRL S) als Protokoll für die 

+        XON/XOFF serielle Schnittstelle. Wird XOFF vom Host gesendet, kann

+                 das Terminal noch 255 Zeichen empfangen, bis der Empfangs-

+                 puffer überläuft. Mit NO XONXOFF wird dieses Protokoll

+                 ausgeschaltet. 

+ 

+NO RTSCTS        Wählt RTS/CTS als Protokoll für die serielle Schnittstel-

+        RTS/CTS  le. Mit NO RTSCTS wird dieses Protokoll ausgeschaltet. 

+ 

+NO DTRDSR        Wählt DTR/DSR als Protokoll für die serielle Schnittstel-

+        DTR/DSR  le. Mit NO DTRDSR wird dieses Protokoll ausgeschaltet. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+ 7 

+#page##--------------------------------- Ende der Seite 7 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#4.  Die Statuszeile#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Die Statuszeile enthält 5 Felder, die über die wichtigsten Betriebszustände

+des Terminals Auskunft geben. Die Statuszeile ersetzt die (dann in den 'Hin-

+tergrund' verlegte) 24. Zeile. Die Statuszeile kann in der Kommandozeile mit

+STAT ON oder vom Host oder im Local Modus mit 

+ 

+                         #ib(1)#<ESC> }#ie(1)#   (Hex 1B 7D) 

+ 

+eingeschaltet werden. Ausschalten ebenso mit STATOFF oder 

+ 

+                         #ib(1)#<ESC> {#ie(1)#   (Hex 1B 7B) 

+ 

+Die Zuordnung der Felder: 

+ 

+#type ("micron")# 

+Spooler | Empfängerpuffer | Senderpuffer | Bereit/Beschäftigt | Local/Online

+#type ("elite")# 

+ 

+Kritische Zustände werden invers markiert. Dies sind alle Fälle, in denen

+ein Puffer überläuft. 

+Ist dies beim Empfangspuffer der Fall (RX FULL), gehen Daten verloren. 

+Sollte der Druckerpuffer voll sein (PR FULL) und das Terminal keine Eingabe

+mehr annehmen, kann man durch längeres Drücken von <SHIFT ESC> Zeichen aus

+dem Druckerpuffer entfernen, damit wieder Platz frei wird. 

+Sollte der Senderpuffer voll sein (TX FULL), so liegt das wahrscheinlich

+daran, daß der Host kein XON gesendet hat oder dieses falsch übertragen

+wurde. Durch Drücken von <SHIFT ESC> kann man den Transmitter wieder star-

+ten. 

+ 

+ 

+#type("8")##center##ib(3)#4.1  Spoolerstatus#ie(3)##type("elite")# 

+ 

+- Ein leeres Feld bedeutet: Der Spooler (Druckerpuffer) ist leer, es ist

+  nichts zum Drucken im Puffer. 

+ 

+- PRINT zeigt an: Der Spooler ist gefüllt. Das Terminal ist druckwillig oder

+  der Drucker druckt. 

+ 

+- PR FULL bedeutet: Der Druckerpuffer ist voll. Da das Terminal keine wei-

+  teren Zeichen annimmt bis wieder Platz im Druckerpuffer ist, kann man

+  einzelne Zeichen mit <SHIFT ESC> aus dem Druckerpuffer entfernen bis PRINT

+  im Feld erscheint. 

+ 

+ 

+#type("8")##center##ib(3)#4.2  Empfängerstatus#ie(3)##type("elite")# 

+ 

+- Ein leeres Feld bedeutet: Im Empfängerpuffer ist noch Platz. 

+ 

+- RX FULL zeigt an: Es gehen Empfangsdaten verloren, da der Empfängerpuffer

+  voll ist. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#8 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 8 -----------#

+#center##on("b")#4.  Die Statuszeile#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#4.3  Senderstatus#ie(3)##type("elite")# 

+ 

+- TX ON bedeutet: Der Sender ist eingeschaltet. Wenn jetzt ein Zeichen ge-

+  sendet werden muß, wird es sofort auf die serielle Schnittstelle ge-

+  schickt. 

+  Ein > vor TX ON zeigt an, daß das Terminal auf Freiwerden der seriellen

+  Schnittstelle wartet. 

+ 

+- TX OFF bedeutet: Der Host hat entweder XOFF gesendet oder die Hardware-

+  flußkontrolle aktiviert, um das Terminal zu stoppen. 

+ 

+- TX FULL zeigt an: Der Senderpuffer ist voll. Das Terminal nimmt keine

+  Eingaben mehr an bis der Puffer wieder frei ist. Dies kann mit <SHIFT ESC>

+  erzwungen werden. 

+ 

+ 

+#type("8")##center##ib(3)#4.4  Busy - Anzeige#ie(3)##type("elite")# 

+ 

+- READY bedeutet: Der Empfänger ist empfangsbereit, d.h. im Empfangspuffer

+  sind noch mindestens 256 Zeichen frei und das Terminal hat den Host nicht

+  per Flußkontrolle gestoppt. 

+ 

+- BUSY bedeutet: Der Empfänger hat dem Host per Flußkontrolle angezeigt, daß

+  nicht mehr genügend Platz im Empfangspuffer war. Die Flußkontrolle wird

+  wieder freigegeben, wenn nur noch 256 Bytes im Empfangspuffer sind. 

+  (Warnung: Wenn BUSY angezeigt wird, eine Taste gedrückt wird und der Host

+  #on("u")#nicht#off("u")# empfangsbereit ist, gerät das Terminal in eine

+  "Deadlock-Situation", die (mit Datenverlust) nur durch einen Hardwarereset

+  abgebrochen werden kann.) 

+ 

+ 

+#type("8")##center##ib(3)#4.5  Online/Local - Anzeige#ie(3)##type("elite")# 

+ 

+- ONLINE bedeutet: Das Terminal sendet Tasteneingaben an den Host und emp-

+  fängt Zeichen und Kommandos vom Host. 

+ 

+- LOCAL bedeutet: Keyboardeingaben erscheinen auf dem Bildschirm bzw. blei-

+  ben innerhalb des Terminals. Escape-Kommandos wirken direkt auf das Ter-

+  minal. 

+ 

+#text end#

+#clear pos# 

+#free(5.103519)#

+ 

+ 

+ 9 

+#page##--------------------------------- Ende der Seite 9 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#5.  Die Bedeutung der Tasten#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Zusätzlich zu den normalerweise von der Tastatur gesendeten Tastencodes sind

+einige weitere zur Verfügung gestellt worden. Beim Apple senden fast alle

+Tasten mit Open-Apple zusammen einen Code mit Bit 7 = 1. Diese werden vom

+Terminal als Funktions- oder Steuertasten interpretiert. Beim Basis wurden

+einige bisher nur einfach belegte Tasten wie <RETURN>, <TAB>, <ESC>, <CE>

+und der Zehnerblock mit Doppelfunktionen über <SHIFT> versehen. 

+ 

+ 

+#type("8")##center##ib(3)#5.1  Die Funktions- und Steuertasten#ie(3)##type("elite")# 

+ 

+Zuerst werden die Tastenfunktionen erläutert für ein nicht emulierendes

+Terminal. Die TVI-Emulation kann in der Kommandozeile abgeschaltet werden

+(1. Zeile, 2. Feld) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 0#ie(1)#    (Hex 1B 20 30) 

+ 

+Die Cursortasten liefern beim Basiskeyboard andere Tastencodes als beim

+Applekeyboard. Wird das Bit 7 ignoriert (ausgeblendet), stimmen die Codes

+überein. <TOPLEFT> bezeichnet beim Basiskeyboard die linke obere Eckposi-

+tion des Cursorblocks, <TOPRIGHT> die rechte obere etc. 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+<TAB>            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten. Also 1, 9, 17, 25, 33, 41, 49,

+                                       57, 65, 73. War der Cursor in Spalte

+                                       73 bis 79, dann wird er in die erste

+                                       Spalte der nächst tieferen Bild-

+                                       schirmzeile gesetzt. War der Cursor

+                                       vorher auch noch in Zeile 24, dann

+                                       wird der Bildschirminhalt entweder

+                                       nach oben gescrollt (SCROLL) oder in

+                                       Homeposition gebracht (PAGE). 

+ 

+<SHIFT TAB>      <OA TAB>      89      Back-Tab (Rückwärtstabulator). Der

+                                       Cursor wird in die nächste links vom

+                                       Cursor befindliche Tabulatorposition

+                                       gebracht. War der Cursor in Spalte 1,

+                                       dann steht er jetzt in Spalte 73 der

+                                       darüberliegenden Zeile. War der Cur-

+                                       sor in Homeposition, dann ändert sich

+                                       seine Position nicht. 

+ 

+<SHIFT CE>       <OA CTRL X>    -      Kommandozeile aktivieren. Einzelhei-

+                                       ten zur Kommandozeile siehe Abschnitt

+                                       3.: Die Kommandozeilen. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#10 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 10 -----------#

+#center##on("b")#5.  Die Bedeutung der Tasten#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<CE>             <CTRL X>      18      U.a. Kommandozeile verlassen. 

+ 

+<RETURN>         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub.

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+<SHIFT RETURN>   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten (24.) Bild-

+                                       schirmzeile war, wird der Bildschir-

+                                       minhalt entweder nach oben gescrollt

+                                       (SCROLL) oder in Homeposition ge-

+                                       bracht (PAGE). 

+ 

+<UP>             <UP>       8B/0B      Cursor eine Zeile höher. War der

+                                       Cursor in der ersten Bildschirmzei-

+                                       le, ändert sich seine Position nicht. 

+ 

+<DOWN>           <DOWN>     8A/0A      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann wird der

+                                       Bildschirminhalt entweder nach oben

+                                       gescrollt (SCROLL) oder der Cursor in

+                                       die erste Bildschirmzeile gesetzt

+                                       (PAGE). 

+ 

+<CTRL V>         <CTRL V>      16      Cursor eine Zeile tiefer. War der

+                                       Cursor in Zeile 24, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+<LEFT>           <LEFT>     88/08      Cursor eine Spalte nach links. War

+                                       der Cursor in der ersten Bildschirm-

+                                       spalte, dann steht er jetzt in der

+                                       letzten Spalte der darüberliegenden

+                                       Bildschirmspalte. War der Cursor

+                                       allerdings in Homeposition, ändert

+                                       sich seine Position nicht. 

+ 

+<RIGHT>             -          95      Cursor eine Spalte nach rechts. War

+                                       der Cursor in Spalte 79, dann steht

+                                       er jetzt in der ersten Spalte der

+                                       folgenden Zeile. War der Cursor in

+                                       der letzten Zeile, dann wird der

+                                       Bildschirminhalt um eine Zeile nach

+                                       oben gescrollt (SCROLL) oder der

+                                       Cursor in Homeposition gebracht

+                                       (PAGE). 

+ 

+<HOME>           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+<SHIFT HOME>     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 11 

+#page##--------------------------------- Ende der Seite 11 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<DELETE>         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm als Punktraster dargestellt.

+                                       Der Host interpretiert es in der

+                                       Regel als Zeichenlöschbefehl. 

+ 

+<TOPLEFT>        <OA CTRL N>   8E      Zeichen bei Cursorposition einfügen.

+                                       Der Cursor ändert seine Position

+                                       nicht. Unter dem Cursor steht dann

+                                       ein Leerzeichen. Das Zeichen in Spal-

+                                       te 79 geht verloren. 

+ 

+<SHIFT TOPLEFT>  <OA CTRL B>   82      Zeichen unter Cursorposition löschen.

+                                       In Spalte 79 steht dann ein Leerzei-

+                                       chen. 

+ 

+<TOPRIGHT>       <OA CTRL O>   8F      Zeile bei Cursorposition einfügen.

+                                       Die Cursorposition ändert sich nicht.

+                                       Der Inhalt der letzten Bildschirmzei-

+                                       le ist verloren. Die Zeile in der der

+                                       Cursor steht wird mit Leerzeichen

+                                       gefüllt. 

+ 

+<SHIFT TOPRIGHT> <OA CTRL C>   83      Zeile in der der Cursor steht lö-

+                                       schen. Die Cursorposition ändert sich

+                                       nicht. Der Inhalt der gelöschten

+                                       Zeile ist verloren. Die letzte Bild-

+                                       schirmzeile wird mit Leerzeichen

+                                       aufgefüllt. 

+ 

+<BOTTOMLEFT>     <BACKSPACE>   08      Cursor eine Spalte nach links. Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+<BOTTOMRIGHT>    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts. Die Funktion ist mit der von

+                                       <RIGHT> identisch. 

+ 

+<SHIFT BOTTOMRIGHT> <OA RIGHT> EF      Diese Taste ist eine programmierbare

+                                       Funktionstaste (siehe <ESC> e). 

+ 

+<SHIFT DELETE>   <OA DELETE>   81      Diese das liefert den

+                                       Makroparametercode (siehe <ESC> e). 

+ 

+<ESC>            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+<SHIFT ESC>      <OA ESC>      9B      Während der Funktionstastedefinition

+                                       wirkt diese Taste wie ein Local

+                                       Escape, sonst liefert sie den Code 9B.

+                                       (siehe <ESC> e). 

+                                       

+<SHIFT CTRL HOME><OA 0>         -      Local/Online umschalten. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#12 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 12 -----------#

+#center##on("b")#5.  Die Bedeutung der Tasten#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<CTRL HOME>      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...    <OA a> ...    E1 ...  programmierbare Funktionstasten 

+<SHIFT 9>        <OA i>        E9             "               " 

+<SHIFT 0>        <OA j>        EA             "               " 

+<SHIFT .>        <OA k>        EB             "               " 

+<SHIFT +>        <OA l>        EC             "               " 

+<SHIFT ->        <OA m>        ED             "               " 

+ 

+<SHIFT BOTRIGHT> <OA RIGHT>    EF             "               " 

+ (Dieser Code wird beim RESET des 

+ Terminals ausgeführt. Der Benut- 

+ zer kann damit das Terminal nach 

+ seinen Wünschen konfigurieren.) 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+<F1> ...         <OA A> ...    C1             "               " 

+<F15>            <OA O>        CF             "               " 

+<SHIFT F1> ...   <OA Q> ...    D1             "               " 

+<SHIFT F15>      <OA _>        DF             "               " 

+<CTRL F1> ...    <OA !> ...    A1             "               " 

+<CTRL F15>       <OA />        AF             "               " 

+<SHIFT CTRL F1>..<OA 1> ...    B1             "               " 

+<SHIFT CTRL F15> <OA ?>        BF             "               " 

+ 

+Die Programmierung der Funktionstasten geschieht mit #ib(1)#<ESC> e#ie(1)#. 

+ 

+ 

+#type("8")##center##ib(3)#5.2  Die TVI-Emulation#ie(3)##type("elite")# 

+ 

+Wird das Terminal in den TVI-Emulationsmode gebracht, dann senden einige

+Tasten andere Tastencodes oder Codesequenzen. Die Bedeutung der Escape-

+Sequenzen ändert sich dadurch nicht. 

+Der TVI-Modus kann in der Kommandozeile eingeschaltet werden (1. Zeile, 2.

+Feld) oder durch 

+ 

+                         #ib(1)#<ESC> <SPACE> 1#ie(1)#    (Hex 1B 20 31) 

+ 

+An dieser Stelle erscheinen nur noch die Tastenbezeichnungen des Basiskey-

+boards. Die entsprechenden Tasten, die beim Applekeyboard zu drücken sind,

+kann man im letzten Abschnitt nachlesen. 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 13 

+#page##--------------------------------- Ende der Seite 13 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Folgende Tasten senden andere Tastencodes: 

+ 

+Taste       TVI-Code(sequenz)       Bemerkung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+<RIGHT>     0C    #ib(1)#<CTRL L>#ie(1)#          Cursor nach rechts 

+ 

+<HOME>      1E    #ib(1)#<CTRL SHIFT ^>#ie(1)#    Cursor in Homeposition 

+ 

+<CLEAR>     1A    #ib(1)#<CTRL Z>#ie(1)#          Durch Drücken von <SHIFT HOME> 

+                                    Bildschirm löschen und Cursor Home 

+ 

+<DEL CHAR>  1B 57 #ib(1)#<ESC> W#ie(1)#           Durch Drücken von <SHIFT TOPLEFT> 

+                                    Zeichen löschen 

+ 

+<DEL LINE>  1B 52 #ib(1)#<ESC> R#ie(1)#           Durch Drücken von <SHIFT TOPRIGHT> 

+                                    Zeile löschen 

+ 

+<INS CHAR>  1B 51 #ib(1)#<ESC> Q#ie(1)#           Durch Drücken von <TOPLEFT> 

+                                    Zeichen einfügen 

+ 

+<INS LINE>  1B 45 #ib(1)#<ESC> E#ie(1)#           Durch Drücken von <TOPRIGHT> 

+                                    Zeile einfügen 

+ 

+<LEFT>      08    #ib(1)#<BACKSPACE>#ie(1)#       Cursor nach links 

+ 

+<BACK TAB>  1B 49 #ib(1)#<ESC> I#ie(1)#           Durch Drücken von <SHIFT TAB> 

+                                    Rückwärtstabulator 

+ 

+<DOWN>      0A    #ib(1)#<LF>#ie(1)#              Cursor nach unten 

+ 

+<UP>        0B    #ib(1)#<CTRL K>#ie(1)#          Cursor nach oben 

+ 

+<NEWLINE>   1F    #ib(1)#<CTRL SHIFT _>#ie(1)#    Durch Drücken von <SHIFT RETURN> 

+                                    Waagenrücklauf und Zeilenvorschub 

+ 

+ 

+#on("u")#Funktionstasten:#off("u")# 

+ 

+Für jede Funktionstaste, die nicht belegt wurde wird eine Codesequenz der

+Form <CTRL A> <code> <CR> also 01 <code> 0D gesendet. Für <code> gilt: 

+ 

+Taste             <code>    Hex-Code 

+<F1> ...            @ ...      40 ...   Diese Tasten sind auf fast allen 

+<F11>               J          4A       TVI-Terminals vorhanden. 

+<F12> ...           ` ...      60 ... 

+<F15>               c          63 

+ 

+<SHIFT F1> ...      K ...      4B ... 

+<SHIFT F15>         Y          59 

+ 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+#right#14 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 14 -----------#

+#center##on("b")#5.  Die Bedeutung der Tasten#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#on("u")#Zehnerblock:#off("u")# 

+ 

+<SHIFT 1> ...       d ...      64 ... 

+<SHIFT 9>           l          6C 

+<SHIFT 0>           m          6D 

+<SHIFT .>           n          6E 

+<SHIFT +>           o          6F 

+<SHIFT ->           p          70 

+ 

+<SHIFT BOTRIGHT>    r          72 

+ 

+Alle nicht in dieser Tabelle aufgeführten Funktionstasten senden den Basis-

+tastencode. 

+ 

+#text end#

+#clear pos# 

+#free(16.11019)#

+ 

+ 

+ 15 

+#page##--------------------------------- Ende der Seite 15 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#6.  Der Graphikmodus#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+#type("8")##center##ib(3)#6.1  Allgemeines#ie(3)##type("elite")# 

+ 

+Der Graphikmodus kann in der 2. Kommandozeile ein- und ausgeschaltet (Gra-

+phik: GFX, Text: TXT) oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> $#ie(1)#    (Hex 1B 24) 

+ 

+eingeschaltet und mit dem Kommando 

+ 

+                         #ib(1)#<ESC> %#ie(1)#    (Hex 1B 25) 

+ 

+ausgeschaltet. 

+ 

+Die Auflösung beträgt in y-Richtung 280 Punkte und in x-Richtung 192 Punk-

+te, das sind 53760 Punkte. 

+ 

+ 

+#type("8")##center##ib(3)#6.2  Koordinaten und Parameterübergabe#ie(3)##type("elite")# 

+ 

+Die Koordinaten für die Graphikkommandos dürfen den Bereich von -32768 bis

+32767 überstreichen. Der sichtbare Bereich ist für die X-Koordinate 0..279

+und für die Y-Koordinate von 0..191. Der Ursprung (d.h. der Punkt (0,0) )

+des Koordinatensystems ist die linke untere Ecke. Die Graphikroutinen zeic-

+hnen nur innerhalb des sichtbaren Bereichs (Clipping). 

+ 

+ 

+#type("8")##center##ib(3)#6.2.1  Cursorposition/Fadenkreuz#ie(3)##type("elite")# 

+ 

+Der Graphikcursor ist ein gedachter unsichtbarer Punkt, der sich im gesam-

+ten (auch unsichtbaren) Bereich des Koordinatensystems befinden kann. Wenn

+sich der Cursor im sichtbaren Bereich befindet, dann kann man an der Posi-

+tion ein Fadenkreuz darstellen. Das Fadenkreuz kann mit 

+ 

+                         #ib(1)#<CTRL X>#ie(1)# oder #ib(1)#<CE>#ie(1)#    (Hex 18) 

+ 

+ein- und ausgeschaltet werden. Das Fadenkreuz wird Exklusiv-Oder (XOR) ge-

+zeichnet. Das heißt, daß die Punkte an der Stelle des Fadenkreuzes inver-

+tiert (umgedreht) werden. Das hat wiederum zur Folge, daß an der Graphik-

+seite nichts verändert wird, wenn zweimal <CTRL X> gesendet wird. Solange

+der Bereich oder die Position des Fadenkreuzes nicht verändert wird, können

+zwischen den beiden <CTRL X> Kommandos auch andere Graphikkommandos ausge-

+führt werden. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.140185)#

+ 

+ 

+#right#16 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 16 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.2.2  Binäre oder dezimale Parameter#ie(3)##type("elite")# 

+ 

+Die Übergabe der x/y Koordinaten, eines Radius oder relativer Koordinaten

+und in einigen Fällen auch anderer Parameter, kann auf zwei verschiedene

+Arten erfolgen. Das Terminal erkennt die Übergabeart am ersten Parameterby-

+te: 

+Bei dezimalen Parametern ist dies entweder <SPACE>, +, - oder eine Zahl. Bei

+Binären Parametern liegt das Höherwertige Byte (das erste!) im Bereich von

+00..1F oder 3A..FF. Die Festlegung auf dezimale oder binäre Parameter gilt

+für beide (X und Y) Koordinaten. 

+ 

+ 

+#type("8")##center##ib(3)#6.2.2.1  Binäre Parameter#ie(3)##type("elite")# 

+ 

+Binäre Parameter sind eine Folge von vier Bytes (mit 8 Bits). Die ersten

+beiden Bytes stellen die X-Koordinate dar, die anderen beiden Bytes die

+Y-Koordinate. Negative Koordinaten oder negative relative Koordinaten wer-

+den durch Bilden des Zweierkomplements dargestellt. 

+Zu beachten ist, daß zuerst das höherwertige (Highbyte) und dann das nie-

+derwertige (Lowbyte) gesendet werden muß. 

+ 

+Der Vorteil der binären Parameter ist, daß die Parameterübergabe schneller

+ist als bei dezimalen Parametern, da weder Host noch Terminal eine Konver-

+tierung vornehmen müssen und die Anzahl der Parameterbytes in der Regel

+geringer ist als bei dezimaler Parameterübergabe. 

+ 

+Der Nachteil ist, daß bei XON/XOFF Flußkontrolle einige Zahlen als XON oder

+XOFF interpretiert werden können und daß diese Parameter nicht auf Funk-

+tionstasten gelegt werden können, wenn sie Zeichen > Hex 7F enthalten. 

+ 

+ 

+#type("8")##center##ib(3)#6.2.2.2  Dezimale Parameter#ie(3)##type("elite")# 

+ 

+Dezimale Parameter bestehen aus einer Folge von ASCII-Zeichen. Die beiden

+Koordinaten werden durch einen Separator (Komma, CR, Semikolon o.ä.) ge-

+trennt. Nach dem 2. Parameter steht ein weiterer Separator. An beliebiger

+Stelle in und vor den Zahlen dürfen Leerzeichen (<SPACE>) oder Pluszeichen

+(+) stehen, die keine Änderung des Ergebnisses bewirken. Ein Minuszeichen

+vor einer Zahl negiert sie. 

+ 

+Der Vorteil der dezimalen Parameter ist, daß sie in höheren Programmier-

+sprachen bequem und lesbar in ein Programm geschrieben werden können und daß

+keine Steuerzeichen vorkommen, die die XON/XOFF - Flußkontrolle stören könn-

+ten. Außerdem können diese Parameter immer auf Funktionstasten gelegt wer-

+den, da sie keine Codes > Hex 7F enthalten. 

+ 

+Der Nachteil ist wie unter 6.2.2.1 geschrieben, die Zeitdauer der zweima-

+liegen Konvertierung (Host, Terminal) und die in der Regel längeren Parame-

+ter. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+ 17 

+#page##--------------------------------- Ende der Seite 17 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.2.3  Absolute oder relative Koordinaten#ie(3)##type("elite")# 

+ 

+Bei den Move- und Drawbefehlen hat man die Wahl zwischen relativen und abso-

+luten Koordinaten. 

+ 

+Absolute Koordinaten setzen den Graphikcursor direkt auf die als Parameter

+angegebene Position. Z.B. <ESC> v 200, 100; setzt den Cursor direkt auf die

+Position X=200, Y=100. Die meisten Programme unterstützen nur absolute Koor-

+dinaten. 

+ 

+Relative Koordinaten werden zur aktuellen Position des Graphikcursors ad-

+diert. Das hat den Vorteil, daß eine Routine nicht zu wissen braucht, wo der

+Graphikcursor gerade steht. Man kann sich zum Beispiel Folgen von relativen

+Move's und Draw's auf Funktionstasten legen, die dann im Localmodus an der

+aktuellen Cursorposition irgendwelche Symbole oder Sonderzeichen zeichnen.

+Z.B. <ESC> q -4, 3; bewegt den Graphikcursor 4 Punkte nach links und 3 Punk-

+te nach oben. 

+ 

+ 

+#type("8")##center##ib(3)#6.2.4  Byteparameter#ie(3)##type("elite")# 

+ 

+Byteparameter sind solche, die nur aus einem Byte bestehen. Die Werte kön-

+nen also normalerweise von 0 bis 255 oder Hex 00 bis Hex FF. In den Fällen,

+in denen nicht der ganze Wertebereich genutzt wird, werden nur die nieder-

+wertigsten Bits ausaskiert, die höherwertigen werden ignoriert, wenn nicht

+ausdrücklich etwas anderes angegeben ist. Im Bereich von 0 bis 7 sind Wert

+und ASCII-Ziffer identisch. Bei Werten großer als 9 geht das allerdings

+nicht mehr. Sind zum Beispiel die Werte von 0 bis 15 erlaubt, dann kann man

+folgende Tabelle benutzen: 

+ 

+#on("u")#Wert   ASCII (Hex) oder Binär#off("u")# 

+  0      0     30        00 

+  1      1     31        01 

+  2      2     32        02 

+  3      3     33        03 

+  4      4     34        04 

+  5      5     35        05 

+  6      6     36        06 

+  7      7     37        07 

+  8      8     38        08 

+  9      9     39        09 

+ 10      :     3A        0A 

+ 11      ;     3B        0B 

+ 12      <     3C        0C 

+ 13      =     3D        0D 

+ 14      >     3E        0E 

+ 15      ?     3F        0F 

+ 

+Für Werte zwischen 0 und 31 benutzt man dann besser die Buchstaben (Groß-

+buchstaben und [\]^_ oder Kleinbuchstaben und {|}~ und <DEL>). Die Zuord-

+nung entnimmt man der ASCII-Tabelle in Anhang A. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#18 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 18 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3  Die Graphikparameter#ie(3)##type("elite")# 

+ 

+Für die Linien und Zeichen in der Graphik gibt es verschiedene Darstellungs-

+weisen. Man kann die Strichdicke, die Farbe (auf einem Monochrommonitor die

+Helligkeit), den Linientyp (durchgehend, gepunktet, gestrichelt etc.) und

+die Bitverknüpfungen (löschen, invertieren...) festlegen. Diese Parameter

+werden mit einem Kommando <ESC> O <n> ... verändert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden all diese Parameter auf Defaultwerte zurückgesetzt. Diese Default-

+werte sind: Strichdicke 1, durchgehende Linie, OR-Bitverknüpfung (Punkte

+setzen), helle Farbe (gelb). Ausserdem wird die Seite 0 als sichtbare und

+als Arbeitsseite gewählt. Es wird auf ganzseitige Graphik geschaltet (falls

+im Graphikmodus). 

+ 

+ 

+#type("8")##center##ib(3)#6.3.1  Strichdicke#ie(3)##type("elite")# 

+ 

+Die Strichdicke einer Linie ist normalerweise 1. Die Strichdicke 2 zeichnet

+parallel zur ursprünglichen Linie auf beiden Seiten jeweils eine weitere

+Linie der gleichen Länge. Die Strichdicke 3 zeichnet dann auf beiden Seiten

+jeweils zwei parallele Linien usw. Die Strichdicke kann von 1 bis 15 ge-

+wählt werden. Sie wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 1#ie(1)# <dicke>   (Hex 1B 4F 31 <dicke>) 

+ 

+eingestellt. <dicke> ist ein Byteparameter (Kapitel 6.2.4) mit dem Wertebe-

+reich 1 bis 15. 

+ 

+ 

+#type("8")##center##ib(3)#6.3.2  Farbe/Helligkeit#ie(3)##type("elite")# 

+ 

+Normalerweise ist Gelb (hell) eingestellt. Die Alternative ist Violett (dun-

+kel). Jeweils 7 nebeneinanderliegene Graphikpunkte haben die gleiche Farbe.

+Auf einem Farbmonitor kann die Farbe auch noch durch den Inhalt dieser 7

+Graphikpunkte bestimmt werden. Der Farbmodus wird von diesem Terminalpro-

+gramm allerdings nicht unterstützt, da sich dann die Auflösung in X-Richtung

+halbiert (also nur noch 140 x 192 Punkte). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 2#ie(1)# <n>    (Hex 1B 4F 32 <n>) 

+ 

+kann die Helligkeit eingestellt werden. <n> ist ein Byteparameter bei dem

+nur das Bit 0 wichtig ist: 

+ 

+Bit 0   Bedeutung 

+  0     dunkel/Violett     <n> ist eine gerade Zahl 

+  1     hell/Gelb          <n> ist eine ungerade Zahl 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 19 

+#page##--------------------------------- Ende der Seite 19 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3.3  Linientyp#ie(3)##type("elite")# 

+ 

+Der Linientyp ist das "Muster" der Striche. Es gibt 7 vordefinierte Strich-

+muster und ein vom Benutzer definiertes. Der Linientyp (im folgenden auch

+Pattern genannt) wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 3#ie(1)# <n>    (Hex 1B 4F 33 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 7. Die

+Strichtypen sind <n> folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bitmuster (16 Bit)  Name                    #off("u")# 

+ 0                       unsichtbare Linie 

+ 1   ----------------    durchgehende Linie 

+ 2   - - - - - - - -     gepunktete Linie 

+ 3   ----    ----        kurz gestrichelte Linie 

+ 4   --------            lang gestrichelte Linie 

+ 5   --------    -       Strichpunktlinie 

+ 6   -   -   -----       Strich-Punkt-Punkt Linie 

+ 7   - - - -  - - - -    Benutzerdefinierte Linie 

+                         (Hier Defaultangabe) 

+ 

+Die Bitmuster sind immer 16 Bit lang. Nach einem Movebefehl startet der

+nächste Draw-Befehl mit dem linkesten (niederwertigsten!) Bit des Bitmu-

+sters. Das Muster wiederholt sich bei längeren Linien zyklisch. Wird zwi-

+schen zwei Draw-Befehlen kein Move-Befehl gegeben, dann setzt der zweite

+Draw-Befehl im Bitmuster nach der gleichen Stelle fort, an der der erste

+Draw-Befehl aufgehört hat. Auch dicke Linien behalten das Linienmuster bei,

+man sollte dann allerdings von gepunkteter auf lang gestrichelte Linie über-

+gehen, wenn man eine gepunktete dicke Linie haben will. 

+ 

+ 

+#type("8")##center##ib(3)#6.3.3.1  Selbstdefinierte Linientypen (Pattern)#ie(3)##type("elite")# 

+ 

+Wie in 6.3.3 angemerkt kann ein Linientyp auch vom Benutzer selbst definiert

+werden. Da die Länge 16 Bit ist, kann man mit den relativen Move's und

+Draw's zusammen gut kleine Bildchen (Icons) zusammenstellen. Eine Hilfe ist

+dabei auch die Bitverknüpfung COPY, die im nächsten Abschnitt erläutert

+wird. Man legt dazu zuerst das 16 Bit-Pattern als jeweils eine Zeile des

+Icons fest und zieht dann von links nach rechts eine 16 Punkte lange Linie

+mit dem benutzerdefinierten Pattern. Nach einem relativen Move (-16, -1)

+kann der Vorgang für die nächste Zeile fortgesetzt werden. 

+ 

+Das benutzerdefinierbare Pattern wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 6#ie(1)# <l> <h>    (Hex 1B 4F 36 <l> <h>) 

+ 

+festgelegt. <l> ist dabei das niederwertige (Lowbyte) des Bitmusters, <h>

+ist das höherwertige (Highbyte) des Bitmusters. Wenn das Pattern als Muster

+für Linien (und nicht für Icons) benutzt wird, dann sollte man darauf ach-

+ten, daß das Bit 0 im Lowbyte 1 ist, damit man bei kurzen Linien, denen ein

+Move vorangegangen ist, zumindestes einen Punkt sieht. 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#20 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 20 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3.4  Bitverknüpfungen#ie(3)##type("elite")# 

+ 

+Über Bitverknüpfungen werden die Punkte auf der Graphikseite verändert. Das

+Linienmuster wird dazu zyklisch punktweise abgetastet und jenachdem ob das

+aktuelle Bit im Linienbitmuster 0 oder 1 ist eine Veränderung der Graphik-

+seite durchgeführt. 

+Bis auf die COPY-Funktion wirken die Bitverknüpfungen nur auf die Graphik-

+seite, wenn der aktuelle Punkt im Linientyp-Bitmuster 1 ist. 

+ 

+- Das Zeichnen einer sichtbaren Linie mit weißen Punkten geschieht zum Bei-

+  spiel durch eine OR- (Oder-) Verknüpfung. 

+ 

+- Das Löschen einer Linie (also das Zeichnen von "schwarzen" Punkten) ge-

+  schieht mit einer AND- (Und-) Verknüpfung (Genau genommen eine NAND-, d.h.

+  negierte AND-Verknüpfung). 

+ 

+- Das Invertieren (d.h. Weißer Punkt wird schwarz, schwarzer Punkt wird

+  weiß) kann man mit einer XOR- (Exklusiv-Oder-) Verknüpfung erreichen. 

+ 

+- Für Icons (siehe 6.3.3.1) und andere Zwecke, gibt es noch die COPY-Funk-

+  tion, die eigentlich keine einzelne Bitverknüpfung ist. Ist im Linientyp

+  das aktuelle Bit 0, dann wird in der Graphikseite eine AND-Verknüpfung

+  durchgeführt (d.h. der Punkt wird gelöscht) ist das aktuelle Bit im Li-

+  nientyp 1, dann wird eine OR-Verknüpfung durchgeführt (d.h. der Punkt wird

+  gelöscht). Der Effekt ist, daß genau das Bitmuster des Linientyps in der

+  Graphikseite erscheint ("kopiert" wird), egal was vorher da stand, wo die

+  Linie gezeichnet wurde. 

+ 

+Die Bitverknüpfung kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 4#ie(1)# <n>    (Hex 1B 4F 34 <n>) 

+ 

+festgelegt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+<n> hat folgende Bedeutung: 

+ 

+<n>  Bitverknüpfung         Verwendung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0   OR (Oder)              Weiß (auf schwarzem Grund) zeichnen 

+ 1   AND (Und)              Schwarz (auf weißem Grund) zeichnen 

+ 2   XOR (Exklusiv Oder)    Schwarze und Weiße Punkte umdrehen (invertie-

+ ren) 

+ 3   COPY (kopieren)        Icons zeichnen oder Bilduntergrund überschrei-

+ ben 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+ 21 

+#page##--------------------------------- Ende der Seite 21 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.3.5  Multiparametereinstellung#ie(3)##type("elite")# 

+ 

+Die obigen Parameter (bis auf Linientyp) können alle zugleich mit einem

+Kommando gesetzt werden. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> O 5#ie(1)# <n>    (Hex 1B 4F 35 <n>) 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 127. Die Bits sind

+folgendermaßen zugeordnet: 

+ 

+   Bit     Bedeutung        Werte 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0 .. 3  : Strickdicke      1 .. 15 

+ 4 .. 5  : Bitverknüpfung   0 = OR, 16 = AND, 32 = XOR, 48 = COPY 

+      6  : Farbe/Helligkeit 0 = Violett (dunkel), 64 = Gelb (hell) 

+ 

+Standardeinstellung ist also '<ESC> O 5 A'. 

+ 

+ 

+#type("8")##center##ib(3)#6.4  Graphikseiten#ie(3)##type("elite")# 

+ 

+Das Terminal verwaltet zwei Graphikseiten mit einer Größe von jeweils 8k

+Byte (d.h. 8192 Bytes). 

+ 

+ 

+#type("8")##center##ib(3)#6.4.1  Die sichtbare Seite und die Arbeitsseite#ie(3)##type("elite")# 

+ 

+Die beiden Graphikseiten können (müssen aber nicht) getrennt voneinander

+angezeigt und bearbeitet werden. Das kann sinnvoll sein, wenn eine Seite "im

+Hintergrund" aufbereitet werden soll, während die andere (schon aufbereite-

+te) Seite angezeigt wird. Man kann auch die 80-Zeichen Textseite anzeigen

+und eine oder beide Graphikseiten im Hintergrund aufbereiten. Durch abwec-

+hselndes Umschalten der Arbeits- und Anzeigeseite kann dann der Eindruck

+eines bewegten Bildes erzeugt werden. Um diesen Vorgang zu beschleunigen,

+kann man die Graphikseiten auch auf dem Host vorbereiten und (im Hinter-

+grund) an das Terminal senden (bei 19200 Baud dauert das pro Seite ca. 4.7

+Sekunden). 

+ 

+Die sichtbare und die Arbeitsseite können mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 7#ie(1)# <n>    (Hex 1B 4F 37 <n>) 

+ 

+gewählt werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 7. 

+ 

+Bit 0 von <n> : Sichtbare Seite (0 oder 1) 

+Bit 1 von <n> : Arbeitsseite (0 oder 1) 

+Bit 2 von <n> : 1 = 80 Zeichen Textseite wird in den untersten 32 Graphik-

+                zeilen eingeblendet. 0 = Nur Graphikmode. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#22 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 22 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#on("u")#<n>     Sichtbar Arbeitsseite  Inhalt der untersten 32 Graphikzeilen#off("u")# 

+ 0      Seite 0  Seite 0       Graphik (Seite 0) 

+ 1      Seite 1  Seite 0       Graphik (Seite 1) 

+ 2      Seite 0  Seite 1       Graphik (Seite 0) 

+ 3      Seite 1  Seite 1       Graphik (Seite 1) 

+ 4      Seite 0  Seite 0       Text 

+ 5      Seite 1  Seite 0       Müll 

+ 6      Seite 0  Seite 1       Text 

+ 7      Seite 1  Seite 1       Müll 

+ 

+ 

+#type("8")##center##ib(3)#6.4.1.1  80-Zeichen Text und Graphik#ie(3)##type("elite")# 

+ 

+Mit dem in 6.4.1 beschriebenen Kommando können, wie beschrieben, die unter-

+sten 4 Zeilen der Textzeile (d.h. ggf. auch die Statuszeile) statt der un-

+tersten 32 Graphikzeilen dargestellt werden. Da es nur eine Textseite gibt

+und jeder Graphikseite eine eigene Textseite zugeordnet ist, ist die Mi-

+schung von Text und Graphik in der Graphikseite 1 auf diese Weise nicht

+sinnvoll, da dann in den unstersten 32 Graphikzeilen nur Müll erscheint. Das

+Einblenden wird vom Terminal z.B. genutzt, wenn die Kommandozeile aktiviert

+wird. Man kann zum Beispiel Benutzerhinweise in die untersten 4 Zeilen der

+Textseite schreiben. Zeichenbefehle arbeiten in dem unsichtbaren (ausgeblen-

+deten) Teil der Graphikseite weiter. Das Ergebnis kann man sich beim Wieder-

+-Einblenden ansehen. 

+ 

+ 

+#type("8")##center##ib(3)#6.4.2  Aufbau einer Graphikseite#ie(3)##type("elite")# 

+ 

+Eine Graphikseite besteht aus 8192 Bytes, von denen 7680 genutzt werden, 512

+sind somit (in der Graphikseite verstreut) ungenutzt. Jedes Byte besteht aus

+einem Farbbit (Bit 7) und 7 angezeigten Graphikbits. Ein gesetztes Bit ent-

+spricht einem sichtbaren Punkt auf dem Bildschirm. Das niederwertigste Bit

+eines Bytes wird am weitesten links angezeigt. 

+Jede der 192 Graphikzeilen besteht also aus 40 Bytes. Jeweils 8 Graphikzei-

+len sind zu Reihen zusammengefaßt. Es gibt also 24 Reihen. Jede erste Gra-

+phikzeile einer Reihe hat eine Anfangsadresse, die in folgender Tabelle

+aufgelistet ist: 

+ 

+#on("u")#Reihe  Adresse  Hex  |  Reihe  Adresse  Hex  |  Reihe  Adresse  Hex#off("u")# 

+  0        0    000  |    8      40     028  |   16      80     050 

+  1      128    080  |    9     168     0A8  |   17     208     0D0 

+  2      256    100  |   10     296     128  |   18     336     150 

+  3      384    180  |   11     424     1A8  |   19     464     1D0 

+  4      512    200  |   12     552     228  |   20     592     250 

+  5      640    280  |   13     680     2A8  |   21     720     2D0 

+  6      768    300  |   14     808     328  |   22     848     350 

+  7      896    380  |   15     936     3A8  |   23     976     3D0 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 23 

+#page##--------------------------------- Ende der Seite 23 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Um den Offset den n. Graphikzeile in einer Reihe zu finden kann man folgen-

+de Tabelle benutzen: 

+ 

+#on("u")#n  Offset (Hex)#off("u")# 

+0      0   0000 

+1   1024   0400 

+2   2048   0800 

+3   3072   0C00 

+4   4096   1000 

+5   5120   1400 

+6   6144   1800 

+7   7168   1C00 

+ 

+Beispiel: 

+  Die Adresse des Punktes (123, 45) soll bestimmt werden. 

+  45 DIV 8 = 5, d.h. Y liegt in Reihe 5 mit Adresse 640 (Dezimal). 45 MOD 8

+                = 5, d.h. Y liegt in der n=5. Graphikzeile von Reihe 5. Der

+                Y-Offset also 5120. 

+  123 DIV 7 = 17 d.h. X liegt im Byte mit X-Offset 17. 

+  Die Adresse des Punktes ist also im Byte 17 + 5120 + 640 = 5777. 

+  123 MOD 7 = 4  d.h. Bit 4 in Byte 5777 ist der gesuchte Punkt. 

+ 

+ 

+#type("8")##center##ib(3)#6.4.3  Operationen auf den Graphikseiten#ie(3)##type("elite")# 

+ 

+Hier sollen nur die Operationen erläutert werden, die nicht in andere Kate-

+gorien (z.B. Löschen, Linien zeichnen etc.) passen. 

+ 

+Es gibt ein universelles Kommando, mit dem zwei Graphikseiten invertiert,

+kopiert, gemischt und miteinander logisch verknüpft werden können. Verän-

+dert wird bei diesem Kommando nur die Arbeitsseite. 

+ 

+Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> !#ie(1)# <n>    (Hex 1B 21 <n>) 

+ 

+#text end#

+#clear pos# 

+#free(6.796852)#

+ 

+ 

+#right#24 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 24 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+<n> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 15 und hat fol-

+gende Bedeutung: 

+ 

+<n>   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0    Keine Veränderung. Kopiert die Arbeitsseite in sich selbst (Färbt die

+      Arbeitsseite allerdings mit der aktuellen Farbe/Helligkeit). 

+ 1    Die Arbeitsseite wird invertiert. 

+ 2    Mischt beide Seiten zusammen (OR Verknüpfung). 

+ 3    Mischt beide Seiten zusammen (OR) und invertiert das Ergebnis. 

+ 6    Bildet den Durchschnitt beider Seiten (AND Verknüpfung). 

+ 7    Bildet den Durchschnitt beider Seite (AND) und invertiert das Ergebnis

+10    Es sind die Punkte gesetzt, die in beiden Seiten verschieden sind (XOR

+      Verknüpfung). 

+11    Es sind die Punkte gesetzt, die in beiden Seiten gleich sind (d.h. das

+      Inverse von <n>=10). 

+14    Kopiert die andere Seite in die Arbeitsseite. 

+15    Kopiert das Inverse von der anderen Seite in die Arbeitsseite. 

+ 

+Andere Werte für <n> wiederholen sich in der Tabelle. Die ganze Arbeitssei-

+te hat nach der Operation die gewählte Farbe/Helligkeit. 

+ 

+ 

+#type("8")##center##ib(3)#6.4.4  Laden einer Graphikseite vom Host#ie(3)##type("elite")# 

+ 

+Graphikseiten können ganz oder teilweise vom Host geladen werden. Das kön-

+nen auf dem Terminal erstellte und dann an den Host gesendete (Teil-)

+Graphiken sein, aber auch auf dem Host erstellte. In diesem Fall ist das

+Kapitel 6.4.2 (Aufbau einer Graphikseite) interessant. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> /#ie(1)# <ll> <lh> <al> <ah> <b...> 

+                                                    (Hex 1B 2F ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in die Arbeitsseite geladen wer-

+den. <lh>, <ll>, <ah>, <al> und <p...> sind Byteparameter (8 Bits). <ll> und

+<lh> bilden zusammen die binäre Länge, d.h. die Anzahl der Datenbytes

+<p...>, die die Graphik enthalten. Die Länge kann von 0 bis Hex 2000 (dezi-

+mal 8192) reichen. Die Adresse, durch <al> und <ah> gebildet, darf von 0 bis

+Hex 1FFF reichen. Zusätzlich gilt, daß die Summe von Länge und Adresse nicht

+größer als Hex 2000 sein darf, da sonst außerhalb der Graphikseite geladen

+würde. In einem dieser Fehlerfälle werden die folgenden Graphikdatenbytes

+ignoriert. Die Datenbytes werden dann als Kommandos interpretiert, was zu

+unvorhersehbaren Reaktionen des Terminals führt. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.140185)#

+ 

+ 

+ 25 

+#page##--------------------------------- Ende der Seite 25 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.4.5  Graphik auf Diskette speichern/laden#ie(3)##type("elite")# 

+ 

+Um Graphikseiten, zum Besipiel für Präsentationen, unabhängig vom Host auf

+dem Bildschirm darstellen zu können, benutzt man das Kommando 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+Man kann bis zu 8 verschiedene Graphikseiten vorbereiten, auf Diskette spei-

+chern und zu einem späteren Zeitpunkt wieder in das Terminal zurückladen.

+Dieses Kommando wird auch verwendet, um eine Textseite auf Diskette zu

+schreiben oder von Diskette zu lesen. <n> ist ein Byteparameter mit dem

+Wertebereich 0 bis 31, wobei die Bits folgendermaßen belegt sind: 

+ 

+Bit 0..2 : "Fachnummer" der Graphikseite auf der Diskette (0 bs 7) 

+Bit 3    : Bei Graphikseiten immer 1 (Bei Textseiten 0) 

+Bit 4    : 0 heißt: die Graphikseite wird von der Diskette gelesen, 

+           1 heißt: die Graphikseite wird auf die Diskette geschrieben. 

+ 

+Wird die Graphikseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Graphikseite überschrieben. 

+ 

+Wie bei allen Graphikkommandos, bezieht sich dieses Kommando nicht unbedingt

+auf die sichtbare Graphikseite, sondern auf die Arbeitsseite. 

+ 

+Beispiele: 

+    <ESC> S <CTRL H> liest die Graphikseite in Fach 0 in die Arbeitsseite. 

+    <ESC> S <CTRL X> schreibt die Arbeitsseite in Fach 0 der Diskette. 

+ 

+Da das Lesen einer Graphikseite von Diskette mit ca. 1.1 Sekunden, um eini-

+ges schneller als der Datentransfer vom Host ist, sollte man bewegte Graphi-

+ken auf Diskette vorbereiten und sie dann mit verschränkter Arbeits- und

+Sichtbarkeitsseite anzeigen. 

+Z.B.: Seite 1 als Arbeitsseite wählen, Seite 0 als sichtbare Seite. Graphik

+      von Diskette laden (wird in Seite 1 (= Arbeitsseite) geladen) Seite 1

+      als sichtbare Seite wählen, Seite 0 jetzt als Arbeitsseite wählen. Die

+      nächste Graphikseite wird von der Diskette in die Seite 1 geladen etc. 

+      Bei dieser Vorgehensweise scheinen Übergänge kontinuierlich zu sein. 

+ 

+Für Insider: Eine Graphikseite belegt zwei Tracks (8k). Die 8 Graphikseiten

+             befinden sich auf den Tracks 10 bis 25 in aufsteigender Reihen-

+             folge. 

+ 

+ 

+#type("8")##center##ib(3)#6.5  Textdarstellung im Graphikmodus#ie(3)##type("elite")# 

+ 

+Nicht nur auf der 80-Zeichen Textseite können Buchstaben und Zeichen darge-

+stellt werden, sondern auch auf den Graphikseiten. Die Auflösung ist zwar

+nicht so groß wie auf der reinen Textseite, aber die Anzahl der verschiede-

+nen Darstellungsmöglichkeiten ist sehr viel größer. Fast alle Kommandos, die

+in der Textseite angewandt werden können, haben in der Graphikseite die

+gleiche Funktion. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#26 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 26 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Textdarstellung in der Graphikseite ist hauptsächlich zum Beschriften von

+Graphiken oder zum Drucken von Überschriften etc. vorgesehen. Da aber fast

+alle Textkommandos (Delete/Insert Line/Character fehlt) auch im Graphikmo-

+dus zur Verfügung stehen, kann man auch im Graphikmodus Textverarbeitung

+oder Editor benutzen. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1  Zeichendarstellung#ie(3)##type("elite")# 

+ 

+Die normale Größe eines Zeichens ist 6 x 10 Punkte (x * y), damit lassen

+sich 46 x 19 Zeichen (874 Zeichen) voll auf dem Bildschirm darstellen. Wenn

+die Größe mit einem Kommando auf 5 x 8 Punkte verringert wird, dann lassen

+sich 56 x 24 Zeichen (1344 Zeichen) auf dem Bildschirm darstellen. Komfor-

+table Textverarbeitung läßt sich damit natürlich nicht machen, zumal die

+Geschwindigkeit, mit der die Zeichen auf den Bildschirm geschrieben werden

+gegenüber der der reinen Textseite langsamer ist. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.1  Zeichengröße und Schreibrichtung#ie(3)##type("elite")# 

+ 

+Die Zeichen können in verschiedenen Größen und unter verschiedenen Winkeln

+auf den Bildschirm geschrieben werden. Damit ist auch ein Schreiben von

+rechts nach links mit auf dem Kopf stehenden Zeichen möglich. 

+Bei normaler Schreibrichtung (waagerecht von links nach rechts) befindet

+sich die linke untere Ecke eines Zeichens an der Position des Graphikcur-

+sors. Nach dem Zeichnen des Zeichens befindet sich der Graphikcursor hinter

+der rechten unteren Ecke des Zeichens. Da sich die Zeichen aus Vektoren

+(Linien) zusammensetzen und nicht aus einer festen Punktmatrix, können sie

+schnell beliebig gedreht und vergrössert (und verkleinert) werden. Der Dreh-

+winkel ist wie bei allen Graphikwinkelangaben in 5 Grad Schritten anzugeben.

+Die Zuordnung der Winkel zu den Parameterwerten oder ASCII-Zeichen ist im

+Anhang A angegeben. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> N#ie(1)# <b> <h> <w>    (Hex 1B 4E <b><h><w>) 

+ 

+stellt Breite, Höhe und Drehwinkel der Zeichen ein. Alle Parameter sind

+Byteparameter mit dem Wertebereich 0 bis 255. Mit einem Parameter Hex 00

+kann der Defaultwert (Standardwert) für den jeweiligen Parameter eingestellt

+werden. 

+<b> bezeichnet die Zeichenbreite in Punkten. Standardwert ist 6. 

+<h> bezeichnet die Zeichenhöhe in Punkten. Standardwert ist 10. 

+<w> bezeichnet den Drehwinkel in 5 Grad Schritten. Standardwert ist 0. 

+ 

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+ 27 

+#page##--------------------------------- Ende der Seite 27 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Einige ausgezeichnet Werte für <w> sind: 

+<w>    Richtung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0     Waagerecht von links nach rechts (Ost) 

+ 9     Schräg nach unten rechts         (Süd-Ost) 

+18     Senkrecht von oben nach unten    (Süd) 

+27     Schräg nach unten links          (Süd-West) 

+36     Waagerecht (auf dem Kopf stehend) von rechts nach links (West) 

+45     Schräg nach oben links           (Nord-West) 

+54     Senkrecht von unten nach oben    (Nord) 

+63     Schräg von nach oben rechts (Aufwärts) (Nord-Ost) 

+72...  Wie 0 ... 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.2  Dicke, Farbe etc.#ie(3)##type("elite")# 

+ 

+Buchstaben werden mit Vektoren (Linien) gezeichnet. Die gleichen Parameter,

+die für Striche eingestellt werden, wirken dann auch auf die Zeichen. Mög-

+liche Parameter sind Farbe, Linientyp, Strichdicke und Bitverknüpfung. Mit

+dem Kommando 

+ 

+                         #ib(1)#<ESC> O 0#ie(1)#    (Hex 1B 4F 30) 

+ 

+werden alle diese Parameter auf Standardwerte zurückgesetzt. Die Standard-

+werte sind in Kapitel 6.3 erläutert. Die Beschreibung des Kommandos zur

+Einstellung der Zeichenfarbe ist in Kapitel 6.3.2 beschrieben, das Einstel-

+len der Zeichendicke in Kapitel 6.3.1, das Einstellen des Linientyps in

+Kapitel 6.3.3 und das Einstellen der Bitverknüpfung ist in Kapitel 6.3.4

+beschrieben. Auch für die Zeichendarstellung können mehrere dieser Parame-

+ter zugleich mit einem Kommando eingestellt werden. Das Multiparameterkom-

+mando ist in Kapitel 6.3.5 beschrieben. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.3  Zeichensätze und Attribute#ie(3)##type("elite")# 

+ 

+Ähnlich wie bei der 80-Zeichen Textdarstellung können Zeichensatz und Text-

+attribute eingestellt werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+kann einer der beiden Zeichensätze USA oder GER (ASCII und Deutsch) gewählt

+werden. Ein griechischer Zeichensatz ist unabhängig von beiden immer vor-

+handen. 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 15, im Graphikmodus

+sind aber nur die beiden folgende Werte sinnvoll: 

+ 

+#on("u")#<n>  Zeichensatz  Abweichende Zeichen#off("u")# 

+ 2   Deutsch      Ä Ö Ü ä ö ü ß 

+ 4   Ascii        [ \ ] { | } ~ 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+#right#28 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 28 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Außerdem kann der Zeichensatz im ersten Feld der ersten Kommandozeile ein-

+gestellt werden. Im amerikanischen Zeichensatz treten die deutschen Buch-

+staben außerdem im Bereich von 214 bis 219 und 251 auf. Der Graphikzeichen-

+satz ist im Anhang abgebildet. 

+ 

+Wie im Textmodus können Attribute mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt werden. <n> ist ein Byteparameter mit dem Wertebereich 0, 1, 4

+und 5. Die Werte von <n> sind folgendermaßen zugeordnet: 

+ 

+#on("u")#<n>  Bedeutung                                       #off("u")#

+ 0   Normaler Text (sichtbar und aufrecht) 

+ 1   Unsichtbarer Text (Nur der Cursor wird bewegt) 

+ 4   Kursivschrift, die Zeichen werden schräggestellt 

+ 5   Wie 1 (unsichtbarer Text) 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#   (Hex 1B 29) 

+ 

+hat wie im Textmodus die gleiche Bedeutung wie <ESC> G 4. Damit wird im

+Graphikmodus die Kursivschrift eingeschaltet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#   (hex 1B 28) 

+ 

+wird die Kursivschrift wieder ausgeschaltet. Im Textmodus invers hervorge-

+hobene Textstellen werden im Graphikmodus also durch Kursivschrift hervor-

+gehoben. 

+Steht rechts neben der Zeichenspalte mit einem Kursivzeichen ein nicht kur-

+sives Zeichen, dann wird das rechte Zeichen möglicherweise etwas überschrie-

+ben, da es in den oberen Teil des Kursivzeichens hineinragt. Das kann ver-

+mieden werden, wenn nach dem Ausschalten der Kursivschrift ein Leerzeichen

+ausgegeben wird. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.1.4  Zeichen überschreiben#ie(3)##type("elite")# 

+ 

+Im 80-Zeichen Textmodus kann man Zeichen einfach übereinandertippen, das

+zweite Zeichen ersetzt dann das erste. Im Graphikmodus sollen Texte auch mit

+in eine Zeichnung geschrieben werden können, ohne daß Teile von Linien even-

+tuell gelöscht werden. Dieser Modus bringt außerdem eine etwas größere

+Schreibgeschwindigkeit mit sich. Es ist aber auch möglich, daß die Fläche,

+in die das Zeichen geschrieben werden soll, vorher gelöscht wird, um ein

+sauberes Schriftbild zu erzielen. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> &#ie(1)#   (Hex 1B 26) 

+ 

+kann man das vorherige Löschen einschalten, mit dem Kommando 

+ 

+                         #ib(1)#<ESC> '#ie(1)#   (Hex 1B 27) 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 29 

+#page##--------------------------------- Ende der Seite 29 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+wird der Modus des Überschreibens ausgeschaltet. 

+ 

+Bei Kursivzeichen wird eine rautenförmige Fläche gelöscht oder gefüllt (wenn

+Bitverknüpfung AND eingeschaltet ist). Bei normalen Zeichen wird eine re-

+chteckige Fläche, der mit #ib(1)#<ESC> N#ie(1)# eingestellten Breite und Höhe, gelöscht

+oder gefüllt. Zu beachten ist, daß das Löschen/Füllen nur bei waagerechter

+Schreibrichtung von links nach rechts funktioniert. 

+ 

+Da die Größe der Zeichen in weiten Grenzen mit <ESC> N eingestellt werden

+kann, ist es auch möglich mit dem durch <ESC> & eingeschalteten Ersetzungs-

+modus schnell rechteckige Flächen zu füllen oder zu löschen, wenn nicht auf

+das später beschriebene Füllkommando für beliebige Flächen zurückgegriffen

+werden soll. Dazu schaltet man mit dem Kommando <ESC> O 4 1 die Bitverknü-

+pfung AND (für Füllen) ein und gibt dann einfach ein Leerzeichen aus, das

+dann invertiert dargestellt wird. 

+ 

+ 

+#type("8")##center##ib(3)#6.5.2  Textkommandos im Graphikmodus#ie(3)##type("elite")# 

+ 

+Fast alle Textkommandos des 80-Zeichen Textmodus wirken auch im Graphikmo-

+dus. Einige Kommandos, wie Zeichen senden, Zeile senden, Cursorposition

+senden, haben im Graphikmodus andere Funktionen und haben deshalb andere

+Escape-Sequenzen. Textkommandos, die nicht im Graphikmodus vorhanden sind:

+<ESC> I (Backtab), <ESC> j (Reverse Linefeed), <ESC> E (Insert Line), <ESC>

+Q (Insert Character), <ESC> R (Delete Line), <ESC> W (Delete Character). 

+ 

+ 

+#type("8")##center##ib(3)#6.5.2.1  Die Cursorpositionierung#ie(3)##type("elite")# 

+ 

+Die Cursorpositionierungskommandos (UP, DOWN, LEFT, RIGHT) wirken im Gra-

+phikmodus in die aktuelle Schreibrichtung. Beispiel: Wenn als Schreibwinkel

+180 Grad eingestellt wurde (Winkel 36, also von rechts nach links auf dem

+Kopf schreiben), dann muß man, um einen Backspace (d.h. ein Zeichen zurück)

+auszuführen, nicht <RIGHT> sondern wie bei normaler Schreibrichtung üblich,

+<LEFT> drücken. Die vier Cursorsteuertasten funktionieren für beliebige

+Schreibrichtungen. Alle anderen Steuertasten beziehen sich immer auf waage-

+rechte Schreibrichtung von links nach rechts. 

+ 

+Alle Steuertasten berücksichtigen die Zeichengröße (Breite und Höhe). Auch

+die Graphikseite wird am Ende der letzten Zeile um soviele Graphikzeilen

+gescrollt, wie ein Zeichen hoch ist. 

+ 

+#text end#

+#clear pos# 

+#free(4.256852)#

+ 

+ 

+#right#30 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 30 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Folgende Steuerkommandos/Tasten wirken im Graphikmodus: 

+ 

+Basis-Taste    Apple-Taste  Hex-Code   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#ib(1)#<TAB>#ie(1)#            <TAB>         09      Der Cursor wird an die nächste (re-

+                                       chte) Tabulatorposition gesetzt.

+                                       Tabulatorpositionen sind alle 8 Spal-

+                                       ten (wie im Textmodus). Liegt die

+                                       nächste Tabulatorposition außerhalb

+                                       des sichtbaren Bereichs, dann steht

+                                       der Cursor jetzt da. 

+ 

+#ib(1)#<SHIFT CE>#ie(1)#       <OA CTRL X>    -      Kommandozeile aktivieren. 

+                                       Einzelheiten zur Kommandozeile siehe

+                                       Abschnitt 3.: Die Kommandozeilen. 

+ 

+#ib(1)#<CE>#ie(1)#             <CTRL X>      18      u.a. Kommandozeile verlassen. 

+ 

+#ib(1)#<RETURN>#ie(1)#         <RETURN>      0D      Zum Zeilenanfang ohne Zeilenvorschub. 

+                                       Der Cursor steht dann in der ersten

+                                       Spalte der Zeile. 

+ 

+#ib(1)#<SHIFT RETURN>#ie(1)#   <OA RETURN>   8D      Zum Anfang der nächsten Zeile. Falls

+                                       der Cursor in der letzten sichtbaren

+                                       Bildschirmzeile war, wird der Bild-

+                                       schirminhalt entweder nach oben ge-

+                                       scrollt (SCROLL) oder in Homeposition

+                                       gebracht (PAGE). 

+ 

+#ib(1)#<UP>#ie(1)#             <UP>       8B/0B      Cursor eine Zeile höher (bzw. über

+                                       die Zeile). War der Cursor in der

+                                       ersten sichtbaren Bildschirmzeile,

+                                       dann steht er jetzt im unsichtbaren

+                                       Bereich. 

+ 

+#ib(1)#<DOWN>#ie(1)#           <DOWN>     8A/0A      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten sichtbaren Zeile, dann

+                                       wird der Inhalt des Graphikbild-

+                                       schirms nach oben gescrollt, d.h. die

+                                       obersten Zeilen werden gelöscht (im

+                                       SCROLL-Modus) oder der Cursor in die

+                                       erste Zeile gesetzt (im PAGE-Modus). 

+ 

+#ib(1)#<CTRL V>#ie(1)#         <CTRL V>      16      Cursor eine Zeile tiefer (bzw. "un-

+                                       ter" die Zeile). War der Cursor in

+                                       der letzten Zeile, dann ändert er

+                                       seine Position nicht. Die Spalte

+                                       ändert sich nicht. 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 31 

+#page##--------------------------------- Ende der Seite 31 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#ib(1)#<LEFT>#ie(1)#           <LEFT>     88/08      Cursor eine Spalte nach links (bzw.

+                                       entegegen der Schreibrichtung). War

+                                       der Cursor in der ersten sichtbaren

+                                       Bildschirmspalte, dann ist er jetzt

+                                       unsichtbar "links" davon. 

+ 

+#ib(1)#<RIGHT>#ie(1)#             -          95      Cursor eine Spalte nach rechts (bzw.

+                                       in Schreibrichtung). War der Cursor

+                                       in der letzten sichtbaren Spalte,

+                                       dann befindet er sich jetzt außer-

+                                       halb des Bildschirms. Im Gegensatz

+                                       zum Textmodus wird kein Linefeed oder

+                                       Scroll ausgeführt. 

+ 

+#ib(1)#<HOME>#ie(1)#           <OA @>        C0      Der Cursor wird in die linke obere

+                                       Bildschirmecke gebracht (Homeposi-

+                                       tion). 

+ 

+#ib(1)#<SHIFT HOME>#ie(1)#     <OA P>        D0      Bildschirm löschen und Cursor Home. 

+ 

+#ib(1)#<DELETE>#ie(1)#         <DELETE>      7F      Dieses Zeichen wird auf dem Bild-

+                                       schirm nicht dargestellt. Der Host

+                                       interpretiert es in der Regel als

+                                       Zeichenlöschbefehl. 

+ 

+#ib(1)#<BOTTOMLEFT>#ie(1)#     <BACKSPACE>   08      Cursor eine Spalte nach links (bzw.

+                                       entgegen der Schreibrichtung). Die

+                                       Funktion ist mit der von <LEFT> iden-

+                                       tisch. 

+ 

+#ib(1)#<BOTTOMRIGHT>#ie(1)#    <RIGHT>       15      Apple: Cursor eine Spalte nach re-

+                                       chts (bzw. in Schreibrichtung). Die

+                                       Funktion ist mit der von <RIGHT>

+                                       identisch. 

+ 

+#ib(1)#<ESC>#ie(1)#            <ESC>         1B      Leitet eine Escape-Sequenz ein. 

+ 

+#ib(1)#<SHIFT CTRL HOME>#ie(1)#<OA 0>         -      Local/Online umschalten 

+ 

+#ib(1)#<CTRL HOME>#ie(1)#      <OA SPACE>   '00'     Sendet V24-Break (Hexcode 00 mit

+                                       Rahmenfehler). Als Rahmenfehler wird

+                                       das Fehlen des oder der Stopbits

+                                       bezeichnet (Stopbitpegel ist norma-

+                                       lerweise 1, bei Break dagegen 0). 

+ 

+Unbelegte Funktionstasten erzeugen Graphikzeichen, die im Anhang A nachge-

+sehen werden können. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#32 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 32 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.5.2.2  Löschbefehle#ie(3)##type("elite")# 

+ 

+Das Kommando (Clear to End Of Line) 

+ 

+                         #ib(1)#<ESC> T#ie(1)#    (Hex 1B 54) 

+ 

+löscht ab der aktuellen Cursorposition bis zum Zeilenende. Die Höhe des

+gelöschten Balkens entspricht der Buchstabenhöhe. Der Balken wird unabhän-

+gig von der Bitverknüpfung immer gelöscht. Der Balken wird unabhängig von

+der Schreibrichtung immer waagerecht gelöscht. 

+ 

+Das Kommando (Clear to End Of Page) 

+ 

+                         #ib(1)#<ESC> Y#ie(1)#    (Hex 1B 59) 

+ 

+löscht den Graphikbildschirm von der aktuellen Cursorposition an bis zum

+Bildschirmende. Auch dieses Kommando löscht unabhängig von der gewählten

+Bitverknüpfung und Schreibrichtung immer waagerecht. 

+ 

+Die Kommandos 

+ 

+                         #ib(1)#<ESC> *#ie(1)#    (Hex 1B 2A) 

+                         #ib(1)#<ESC> ,#ie(1)#    (Hex 1B 2C) 

+                         #ib(1)#<ESC> +#ie(1)#    (Hex 1B 2B) 

+                         #ib(1)#<ESC> :#ie(1)#    (Hex 1B 3A) 

+                         #ib(1)#<CTRL Z>#ie(1)#   (Hex 1A) 

+ 

+löschen den Bildschirm und bringen den Graphikcursor in Homeposition, d.h.

+eine Buchstabenhöhe unter dem oberen Bildschirmrand. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> y#ie(1)#    (Hex 1B 79) 

+ 

+löscht den Bildschirm und bringt den Graphikcursor in die linke untere Ecke,

+d.h. den Ursprung des Koordinatensystems. 

+ 

+ 

+#type("8")##center##ib(3)#6.6  Die Graphikkommandos#ie(3)##type("elite")# 

+ 

+ 

+#type("8")##center##ib(3)#6.6.1  Draw's und Move's#ie(3)##type("elite")# 

+ 

+Draw's sind Zeichenbefehle, die eine Linie zeichnen und den Cursor an den

+Endpunkt der Linie positionieren. Move's positionieren nur den Cursor und

+zeichnen nicht. Bei allen Draw's ist der Anfangspunkt der Linie die aktuel-

+le Cursorposition. Die Endposition kann relativ, absolut oder mit einem

+relativen Winkel angegeben werden. Der Befehl zum Setzen/Löschen eines Punk-

+tes wurde mit in diese Befehlskategorie aufgenommen. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+ 33 

+#page##--------------------------------- Ende der Seite 33 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.6.1.1  Punkt setzen#ie(3)##type("elite")# 

+ 

+Der Befehl zum Setzen eines Graphikpunktes ist ein absoluter Befehl, d.h.

+die Koordinaten des Punktes folgen dem Kommando. Die Position des Graphik-

+cursors wird durch diesen Befehl nicht verändert. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> m#ie(1)# <x, y;>    (Hex 1B 6D <x, y;>) 

+ 

+setzt einen Punkt an die Position x/y, wenn diese innerhalb des sichtbaren

+Bereichs liegt. <x, y;> sind dezimale oder binäre Koordinaten. Das Aussehen

+des Punktes kann durch Farbe/Helligkeit oder Bitverknüpfung festgelegt wer-

+den. Mit einer AND-Bitverknüpfung wird der angegebene Punkt gelöscht, mit

+einer OR oder COPY Bitverknüpfung wird der angegebene Punkt gesetzt, mit

+einer XOR Bitverknüpfung wird sein Zustand umgedreht (invertiert). 

+Soll ein dicker Punkt gezeichnet werden, dann kann man den (relativen)

+Draw-Befehl <ESC> r 0, 0; benutzen, der an die Position des Graphikcursors,

+einen Punkt der eingestellten Dicke zeichnet. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.1.2  Move-Befehle#ie(3)##type("elite")# 

+ 

+Den Move-Befehl gibt es in zwei Versionen, einer relativen und einer abso-

+luten. Das Kommando für einen absoluten Move lautet 

+ 

+                         #ib(1)#<ESC> v#ie(1)# <x, y;>    (Hex 1B 76 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die neue Position

+des Graphikcursors bezeichnen. Diese Position muß nicht im sichtbaren Be-

+reich liegen, sondern kann auch außerhalb des Fensters liegen. Der Wertebe-

+reich von <x> und <y> ist -32768 bis 32767. 

+ 

+Das Kommando für den relativen Move-Befehl lautet 

+ 

+                         #ib(1)#<ESC> q#ie(1)# <x, y;>    (Hex 1B 71 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert. Auch hier darf die neue Position des Graphik-

+cursors außerhalb des sichtbaren Bereichs liegen. 

+ 

+Die Move-Befehle setzen außerdem das Bitmuster für den Linientyp wieder auf

+den Startwert zurück, damit der nächste Draw-Befehl auch mit einem Punkt

+beginnt. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.140185)#

+ 

+ 

+#right#34 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 34 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.6.1.3  Draw-Befehle#ie(3)##type("elite")# 

+ 

+Ebenso wie den Move-Befehl gibt es auch den Draw-Befehl in zwei Versionen,

+einer relativen und einer absoluten. Das Kommando für einen absoluten Draw

+lautet 

+ 

+                         #ib(1)#<ESC> w#ie(1)# <x, y;>    (Hex 1B 77 <x, y;>) 

+ 

+Dabei sind <x, y;> dezimale oder binäre Koordinaten, die die Endposition der

+Linie bezeichnen. Diese Position muß nicht im sichtbaren Bereich liegen,

+sondern kann auch außerhalb des Fensters liegen. Der unsichtbare Teil der

+Linie wird dann "geclippt". Der Wertebereich von <x> und <y> ist -32768 bis

+32767. 

+ 

+Das Kommando für den relativen Draw-Befehl lautet 

+ 

+                         #ib(1)#<ESC> r#ie(1)# <x, y;>    (Hex 1B 72 <x, y;>) 

+ 

+Bei diesem Befehl werden die Werte von <x> und <y>, die auch den gesamten

+Wertebereich von -32768 bis 32767 überstreichen dürfen, zu den Koordinaten

+des Graphikcursors addiert, die dann die Endposition der Linie bilden. Auch

+hier darf die Endposition der Linie außerhalb des sichtbaren Bereichs lie-

+gen. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.1.4  Turtle-Graphik#ie(3)##type("elite")# 

+ 

+Turtle-Graphik (Schildkröten-Graphik, obwohl hier keine Schildkröte sicht-

+bar ist) wird zur Erzeugung von "rekursiven" Graphiken, die mit Längen und

+Winkelangaben, statt mit x/y-Koordinaten, arbeiten benötigt. Man stellt sich

+dazu eine Schildkröte vor, die auf ihrem Weg über den Bildschirm eine sicht-

+bare Spur zurücklassen kann (aber nicht muß). Die Schildkröte kann einen Weg

+bestimmter Länge in ihre Blickrichtung gehen und bleibt dann stehen. Außer-

+dem kann sie sich nach links oder rechts drehen, d.h. ihre Blickrichtung

+ändert sich. Alles was man dazu braucht, ist ein Befehl, der die Richtung

+der Schildkröte verändern kann und dann einen Weg bestimmter Länge in dieser

+Richtung zurücklegt. Außerdem wird noch ein Befehl benötigt, der das "Spur-

+verhalten" der Schildkröte ändert, also von "Spur sichtbar" auf "Spur un-

+sichtbar" umschaltet und umgekehrt. Natürlich ist die Zeichengeschwindigkeit

+nicht mit der Fortbewegungsgeschwindigkeit von Schildkröten zu vergleichen.

+Das erste Kommando lautet 

+ 

+                         #ib(1)#<ESC> n#ie(1)# <l, w;>    (Hex 1B 6E <l, w;>) 

+ 

+<l> und <w> sind dezimale oder binäre Parameter. <l> ist die Länge der Spur

+mit einem Wertebereich von 0 bis 511. <w> ist der relative Drehwinkel der

+Schildkröte, also die Änderung von der ursprünglichen Blickrichtung aus. <w>

+überstreicht den positiven und negativen Winkelbereich (0..71 entsprechen 0

+bis 355 in 5 Grad Schritten. -1 entspricht z.B. 355 Grad). 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 35 

+#page##--------------------------------- Ende der Seite 35 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> o#ie(1)#    (Hex 1B 6F) 

+ 

+kann von 'Draw' einer Spur auf 'Move' umgeschaltet werden und umgekehrt. 

+ 

+Um die Sichtbarkeit der Spur am Programmamfang auf einen definierten Wert zu

+setzen, kann man das Kommando 

+ 

+                         #ib(1)#<ESC> O 8#ie(1)# <n>    (Hex 1B 4F 38 <n>) 

+ 

+benutzen. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 3. 

+ 

+#on("u")#Bit 0 hat folgende Bedeutung:                                    #off("u")# 

+  0       Pendown. Die Schildkröte hinterläßt eine sichtbare Spur 

+  1       Penup. Die Schildkröte hinterläßt keine Spur 

+ 

+#on("u")#Bit 1 hat folgende Bedeutung:                                    #off("u")# 

+  0       Drawer. Es wird eine weiße Linie gezeichnet. 

+  1       Eraser. Es wird eine schwarze Linie gezeichnet (gelöscht) 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> O 9#ie(1)#    (Hex 1B 4F 39) 

+ 

+wird die Turtle-Graphik initialisiert. Dieses Kommando muß nicht aufgerufen

+werden bevor die Turtle-Graphik benutzt wird, sollte aber nach Möglichkeit

+am Anfang eines Turtle-Graphik-Programmes benutzt werden. Das Kommando setzt

+die Schildkröte in die Mitte des Bildschirms (140, 96) mit Blickrichtung

+nach oben. Der Drawer wird eingeschaltet (zeichnen) und eine sichtbare Linie

+wird voreingestellt (Pendown). 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2  Komplexere Zeichenkommandos#ie(3)##type("elite")# 

+ 

+Außer den Kommandos zum Zeichnen von Linien und zum Bewegen des Graphikcur-

+sors gibt es noch verschiedene andere Zeichenkommandos. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.1  Kreise und Kreissegmente#ie(3)##type("elite")# 

+ 

+Der Mittelpunkt eines Kreises liegt immer an der aktuellen Cursorposition.

+Der Radius eines Kreises ist in weiten Grenzen von 0 bis über 30000 Punkten

+wählbar. Clipping wird ausserhalb des Bildschirmrandes durchgeführt. Ein

+Kreis kann in 8 Segmente unterteilt werden, von denen alle oder nur einzel-

+ne gezeichnet werden können. Damit ist es dann auch möglich, Halb- oder

+Viertelkreise zu Zeichnen. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#36 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 36 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> K#ie(1)# <r, s;>   (Hex 1B 4B <r, s;>) 

+ 

+wird ein Kreis mit dem Radius <r> um die aktuelle Cursorposition gezeichnet

+(relative Kreise). <s> legt fest, welche Segmente gezeichnet werden sollen.

+<r, s;> sind dezimale oder binäre Parameter. <s> hat den Wertebereich von 0

+bis 255. 

+Jedes Bit in <s> ist einem Kreissegment zugeordnet. Ist das Bit gesetzt (1),

+dann wird das zugehörige Segment gezeichnet. Der Wert 0 entspricht dem Wert

+255 (der ganze Kreis wird gezeichnet), ist aber etwas schneller, da keine

+Abfrage der einzelnen Bits durchgeführt wird. 

+ 

+Die Segmente sind folgendermaßen numeriert: 

+ 

+                                  7  0 

+                                6      1 

+                                5      2 

+                                  4  3 

+ 

+Beispiele für <n> : 

+ 

+#on("u")#<n>  Bedeutung                               #off("u")#

+  0  Zeichnet einen ganzen Kreis 

+ 15  Zeichnet einen links offenen Halbkreis 

+240  Zeichnet einen rechts offenen Halbkreis 

+195  Zeichnet einen unten offenen Halbkreis 

+ 60  Zeichnet einen oben offenen Halbkreis 

+  3  Zeichnet ein Kreisviertel rechts oben 

+ 12  Zeichnet ein Kreisviertel rechts unten 

+ 48  Zeichnet ein Kreisviertel links unten 

+192  Zeichnet ein Kreisviertel links oben 

+etc. 

+ 

+Das Aussehen von Kreisen kann durch die Parameter Farbe/Helligkeit und die

+Bitverknüpfung verändert werden. Der Linientyp (Punkt-, Strichlinie) und die

+Strickdicke haben keinen Einfluß, d.h. der Kreis wird immer mit durchgehen-

+der Linie und einfacher Dicke gezeichnet. Sollen diese beiden Parameter auch

+verändert werden, sollte man den Befehl <ESC> s für Ellipsenbögen verwenden. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.2  Rechtecke#ie(3)##type("elite")# 

+ 

+Rechtecke werden ebenso wie Kreise relativ gezeichnet, d.h. die aktuelle

+Cursorposition bildet eine Ecke des Rechtecks. Die Seiten des Rechtecks

+liegen parallel zur X- und Y-Achse, gedrehte Rechtecke können aber aus 4

+relativen Draw-Befehlen zusammengesetzt werden. 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 37 

+#page##--------------------------------- Ende der Seite 37 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> J#ie(1)# <b, h;>    (Hex 1B 4A <b, h;>) 

+ 

+zeichnet ein leeres Rechteck (Rahmen) an der aktuellen Cursorposition. <b,

+h;> sind dezimale oder binäre Parameter. <b> ist die Breite des Rechtecks

+und kann den ganzen Wertebereich von -32768 bis 32767 überstreichen, <h> ist

+die Höhe des Rechtecks und kann ebenfalls diesen Wertebereich überstreichen.

+Je nach Vorzeichen von <b> und <h> wird das Rechteck links/ rechts und

+oben/unten von der aktuelle Cursorposition gezeichnet. 

+ 

+<b> <h>  Cursorposition bildet die Ecke 

+ +   +   unten links 

+ +   -   oben links 

+ -   +   unten rechts 

+ -   -   oben rechts 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.3  Bögen und Ellipsen#ie(3)##type("elite")# 

+ 

+Um die Zeichengeschwindigkeit eines Kreises zu vergrößern, wurde ein sepa-

+rater Befehl für Kreise eingeführt (6.6.2.1). Da der Kreis ein Sonderfall

+der Ellipse ist, kann man das in diesem Abschnitt beschriebene Kommando auch

+benutzen, um Kreise mit anderen als den unter 6.6.2.1 beschriebenen Segmen-

+ten oder Parametern (Dicke, Strichtyp) zu Zeichnen. 

+ 

+Das Kommando 

+ 

+                         #ib(1)#<ESC> s#ie(1)# <xr, yr,> <aw, ew;>    (Hex 1B 73 ...) 

+ 

+zeichnet um die aktuelle Cursorposition (also relativ) einen Ellipsenbogen

+mit Radius <xr> in X-Richtung und Radius <yr> in Y-Richtung, ausgehend vom

+Anfangswinkel <aw> im Uhrzeigersinn, bis zum Endwinkel <ew>. Der Winkel 0

+Grad ist dabei oben (Norden). 

+ 

+Alle Parameter sind dezimale oder binäre Parameter. <aw> und <ew> haben den

+Wertebereich von 0 bis 255, wobei eine ganze Ellipse einem Anfangswinkel von

+0 und einem Endwinkel von 72 entspricht. Die Winkelangaben sind in 5 Grad

+Schritten und können Anhang A entnommen werden.. <xr> und <yr> dürfen den

+vollen Wertebereich von -32768 bis 32767 überstreichen. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(4.256852)#

+ 

+ 

+#right#38 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 38 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#6.6.2.4  Gefüllte Flächen#ie(3)##type("elite")# 

+ 

+Rechteckige oder rautenförmige Flächen können, wie in Abschnitt 6.5.1.4

+beschrieben, schnell gefüllt werden. Für beliebig geformte Flächen kann das

+Kommando 

+ 

+                         #ib(1)#<ESC> |#ie(1)#<n>    (Hex 1B 7C <n>) 

+ 

+benutzt werden. Dies ist ein relatives Kommando, da um die aktuelle Cursor-

+position herum gefüllt wird. <n> ist ein Byteparameter mit dem Wertebereich

+0 bis 15, der die Nummer des Musters für die Füllung angibt. Der Fill-Befehl

+arbeitet auf der aktuellen Arbeitsseite und füllt eine sichtbar begrenzte

+Fläche mit einem angegebenen Muster aus. 

+ 

+Ist die Bitverknüpfung OR eingestellt darf der Cursor nicht auf einem weißen

+Punkt stehen und die Fläche muß von einer durchgehenden weißen Linie be-

+grenzt sein. 

+Ist die Bitverknüpfung AND eingestellt, darf der Cursor nicht auf einem

+schwarzen Punkt stehen und die Fläche muß von einer durchgehenden schwarzen

+Linie begrenzt sein. 

+ 

+Außer den Parametern Bitverknüpfung und Helligkeit/Farbe werden keine be-

+rücksichtigt. 

+ 

+Bei sehr komplex geformten Figuren kann der Fall eintreten, daß die Fläche

+nicht ganz gefüllt ist. Dies liegt daran, daß intern ein zu größer Spei-

+cherplatz zum Merken von Rücksprungcursorpositionen benötigt wird (Stack-

+Überlauf). In diesem Fall sollte man den Cursor nocheinmal auf die nicht

+gefüllte Fläche setzen und das Kommando erneut geben. 

+ 

+<n> kann folgende Werte annehmen (Werte Hexadezimal angegeben 0..F): 

+<n>  Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0   Fläche ganz gefüllt 

+ 1   Fläche halb gefüllt (grau) 

+ 2   Jede 4. Zeile wird durchgezogen 

+ 3   Jede 2. Zeile wird durchgezogen 

+ 4   Jede 4. Spalte wird durchgezogen 

+ 5   Jede 2. Spalte wird durchgezogen 

+ 6   Jede 4. Zeile und jede 4. Spalte wird durchgezogen (grobes Raster) 

+ 7   Jede 2. zeile und jede 2. Spalte wird durchgezogen (feines Raster) 

+ 8   Schraffur von links unten nach rechts oben 

+ 9   Schraffur von links oben nach rechts unten 

+ A   Schräges Raster (Links- und Rechtsschraffur) 

+ B   Feines Funktraster(jeder 2.Punkt in x- und y-Richtung wird gesetzt) 

+ C   Mauerwerk 

+ D   Feines Netzgeflecht 

+ E   Feine Zickzacklinie 

+ F   Benutzerdefinierbares Muster. Default: Grobe Zickzacklinie 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+ 39 

+#page##--------------------------------- Ende der Seite 39 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Ist die AND-Bitverknüpfung eingeschaltet, dann sind die Punkte schwarz und

+weiß in den Mustern vertauscht und in der obigen Tabelle sind die Bezeich-

+nungen 'gefüllt' und 'gelöscht' auszutauschen. 

+ 

+ 

+#type("8")##center##ib(3)#6.6.2.4.1  Definition des Musters#ie(3)##type("elite")# 

+ 

+Das benutzerdefinierbare Muster des Fill-Befehls (Muster 15) kann mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> O :#ie(1)# <b1..b8>   (Hex 1B 4F 3A <b1..b8>) 

+ 

+eingestellt werden. Das Defaultmuster wird dabei überschrieben, das neu

+eingestellte Muster allerdings nicht beim Setup mitgesichert. 

+<b1..b1> sind 8 Byteparameter mit dem gesamten Wertebereich 0 bis 255. Das

+erste Byte wird im Füllmuster in Richtung der niedrigeren y-Positionen dar-

+gestellt, das niederwertigste Bit jedes Bytes in Richtung der niedrigeren

+x-Positionen. 

+ 

+ 

+#type("8")##center##ib(3)#6.7  Graphikdaten zum Host#ie(3)##type("elite")# 

+ 

+Bisher wurden nur Kommandos beschrieben, die der Host an das Terminal sen-

+den kann. Damit der Host über den Status des Terminals informiert werden

+kann, sind auch Kommandos vorhanden, die Daten an den Host senden. Der Host

+kann auch ganze Graphikseiten anfordern, so daß die auf dem Terminal er-

+zeugten Graphiken nach dem Ausschalten nicht verloren sind, sondern vom Host

+gespeichert werden können. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.1  Graphikseiten zum Host#ie(3)##type("elite")# 

+ 

+Graphikseiten können ganz oder teilweise übertragen werden. Da ein angefor-

+dertes Datenpaket immer ganz übertragen wird, sollte der Host, wenn keine

+Flußkontrolle eingeschaltet ist, nur so große Blöcke anfordern, die er puf-

+fern kann (z.B. 256 Bytes). Selektives Lesen von Graphikseiten kann auch

+verwendet werden, um Teile einer Graphik vom Host (und nicht vom Terminal)

+verändern zu lassen. Mit dem Kommando <ESC> / ... kann der modifizierte Teil

+dann wieder an das Terminal zurückgesendet werden. Zum Aufbau der Graphik-

+seite findet man in Kapitel 6.4.2 Informationen. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> \#ie(1)# <ll> <lh> <al> <ah>   (Hex 1B 5C ...) 

+ 

+kann eine Seite oder ein Teil einer Seite in an den Host gesendet werden.

+<lh>, <ll>, <ah> und <al> sind Byteparameter (8 Bits). <ll> und <lh> bilden

+zusammen die binäre Länge, d.h. die Anzahl der Datenbytes, die zum Host

+gesendet werden. Die Länge kann von 0 bis Hex 2000 (dezimal 8192) reichen.

+Die Adresse durch <al> und <ah> gebildet, darf von 0 bis Hex 1FFF reichen.

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+#right#40 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 40 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin#

+Zusätzlich gilt, daß die Summe von Länge und Adresse nicht größer als Hex

+2000 sein darf, da sich die Endadresse dann ausserhalb der Graphikseite

+befindet. In diesem Fehlerfall werden keine Daten gesendet. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.2  Cursorposition zum Host#ie(3)##type("elite")# 

+ 

+Da die Graphikcursorposition einen anderen Wertebereich überstreicht als die

+Position des Textcursors, wurde zum Senden der Graphikcursorposition ein

+weiteres Kommando eingeführt. Pro Koordinate werden dabei 2 Bytes, zusammen

+also 4 Bytes, gesendet. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ;#ie(1)#    (Hex 1B 3B) 

+ 

+kann der Host diese 4 Bytes anfordern. Die Reihenfolge der Bytes ist <xlow>

+<xhigh> <ylow> <yhigh>. Im Gegensatz zu <ESC> ? (für die Textcursorposi-

+tion) wird auch kein abschließendes <CR> gesendet. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.3  Einzelne Bits zum Host#ie(3)##type("elite")# 

+ 

+Außer ganzen Graphikseiten oder Blöcken daraus, kann der Host auch einzelne

+Bytes oder Bits selektieren und empfangen. Dazu stehen zwei Kommandos zur

+Verfügung. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> _#ie(1)#    (Hex 1B 5F) 

+ 

+kann das Byte angefordert werden, in dem sich der Graphikcursor gerade be-

+findet. Das Bit 7 ist das Farb- oder Helligkeitsbit, das Bit (xpos MOD 7)

+ist das Bit, das durch den Graphikcursor addressiert wird. Wenn der Cursor

+außerhalb des sichtbaren Bereichs ist, wird ein Byte Hex 00 geliefert. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> -#ie(1)#    (Hex 1B 2D) 

+ 

+kann das Bit, daß durch die Graphikcursorposition addressiert wird, abge-

+fragt werden. Dieses Kommando liefert ein Byte, in dem die Bits folgende

+Bedeutung haben: 

+ 

+#on("u")#Bit 0 Dezimal   Bedeutung                            #off("u")# 

+  0      0      Das adressierte Bit ist nicht gesetzt 

+  1      1      Das adressierte Bit ist gesetzt 

+ 

+#on("u")#Bit 1 Dezimal   Bedeutung                   #off("u")# 

+  0      0      Die Farbe ist violett/dunkel 

+  1      2      Die Farbe ist gelb/hell 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 41 

+#page##--------------------------------- Ende der Seite 41 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Bit 2 Dezimal   Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0      Der Graphikcursor ist innerhalb des sichtabren Bereichs 

+  1      4      Der Graphikcursor ist außerhalb des sichtbaren Bereichs. 

+                Bit 0 und Bit 1 sind dann 0. 

+ 

+Bit 4 und Bit 5 sind immer 1. Es werden also die ASCII-Ziffern "0" bis "4"

+geliefert. 

+ 

+ 

+#type("8")##center##ib(3)#6.7.4  Parameter zum Host#ie(3)##type("elite")# 

+ 

+Die eingestellten Draw-Parameter können auch abgefragt werden. Dazu exi-

+stieren zwei Kommandos. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 4#ie(1)#    (Hex 1B 34) 

+ 

+können die Nummer der sichtbaren und der Arbeitsseite, im gleichen Format

+wie zum Einstellen der Seiten mit dem Kommando #ib(1)#<ESC> O 7#ie(1)# <n>, angefordert

+werden. Es werden ASCII-Zeichen von "0" bis "?" geliefert. Die Bits 0 bis 2

+sind folgendermaßen zugeordnet: 

+ 

+#on("u")#Bit 0  Bedeutung                #off("u")# 

+  0    Sichtbar ist Seite 0 

+  1    Sichtbar ist Seite 1 

+ 

+#on("u")#Bit 1  Bedeutung               #off("u")# 

+  0    Arbeitsseite ist Seite 0 

+  1    Arbeitsseite ist Seite 1 

+ 

+#on("u")#Bit 2  Bedeutung               #off("u")# 

+  0    Nur Graphik eingeschaltet 

+  1    In den letzten 32 Graphikzeilen 

+       sind 4 Textzeilen eingeblendet 

+ 

+#on("u")#Bit 3  Bedeutung                         #off("u")# 

+  0    Der Graphikmodus ist eingeschaltet 

+  1    Der Textmodus ist eingeschaltet 

+ 

+Sinnvoll sind die Werte der Bits 0 bis 2 nur dann, wenn Bit 3 = 0 ist. 

+ 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 5#ie(1)#    (Hex 1B 35) 

+ 

+können die Linienparameter abgefragt werden. Es wird ein Byte mit dem Wer-

+tebereich von 1 bis 127 geliefert. Die einzelnen Bits sind folgendermaßen

+zugeordnet: 

+ 

+#text end#

+#clear pos# 

+#free(08.701852e-1)#

+ 

+ 

+#right#42 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 42 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Bit        Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+Bit 0..3 : Strichdicke 

+Bit 4..5 : Bitverknüpfung (0 = OR, 16 = AND, 32 = XOR, 48 = COPY) 

+Bit 6    : Aktuelle Farbe (0 = Violett/dunkel, 1 = Gelb/hell) 

+ 

+Die Bitbelegung entspricht der des Parameters des Kommandos #ib(1)#<ESC> O 5#ie(1)# <n>. 

+ 

+ 

+#type("8")##center##ib(3)#6.8  Graphikhardcopy#ie(3)##type("elite")# 

+ 

+Wie von der Textseite kann auch von den Graphikseiten ein Ausdruck angefer-

+tigt werden. Dabei können keine verschiedene Helligkeitsstufen oder Farben

+dargestellt werden. 

+ 

+ 

+#type("8")##center##ib(3)#6.8.1  Der Druckertreiber#ie(3)##type("elite")# 

+ 

+Da das Ein- und Ausschalten des Graphikmodus nicht auf allen Druckern durch

+gleiche Kommandos erreicht werden kann, muß das Terminal an den vorhandenen

+Drucker angepaßt werden. Defaultmäßig werden die Epson-Modelle ab RX80 auf-

+wärts, sowie kompatible (IBM, Panasonic etc.) unterstützt. Die Anpassung

+wird in diesem Abschnitt beschrieben. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ~#ie(1)# <n> <p...>    (Hex 1B 7E <n> <p...>) 

+ 

+können Kommandosequenzen eingestellt werden, die folgende Aufgaben haben: 

+ 

+<n> Default (Hex)   Aufgabe 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0  0D              Einleiten der gesamten Hardcopy (Waagenrücklauf) 

+ 1  1B 2A 04 18 01  Einschalten des Graphikmodus. Es folgen 280 Graphikby-

+                    tes (jeweils 8 Bit) 

+ 2  0D 1B 4A 17     Ausschalten des Graphikmodus. Zeilenvorschub ohne Zwi-

+                    schenraum (Zeilenabstand ca. 8 Punkte) und Waagenrück-

+                    lauf. 

+ 3     Nichts       Dieses Kommando wird nach der kompletten Hardcopy zum

+                    Drucker gesendet. 

+ 

+Wenn doppelte Punktbreite eingeschaltet ist, oder zwei Seiten nebeneinander

+gedruckt werden, wird die Kommandosequenz 1 auch mehrmals in einer Zeile

+gegeben. 

+ 

+<n> ist dabei ein Byteparameter mit dem Wertebereich von 0 bis 3. <p...> ist

+eine Folge von bis zu 16 Bytes. Das erste dieser 16 Bytes ist ein Längenby-

+te, das die Länge der Kommandosequenz (oder die Anzahl der noch folgenden

+Bytes) angibt. Für die nach dem Längenbyte folgenden Bytes sind alle Werte

+von 0 bis 255 erlaubt. 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+ 43 

+#page##--------------------------------- Ende der Seite 43 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Die Druckertreiberstrings (Kommandosequenzen) werden beim Setup in der Kom-

+mandozeile auch mit abgespeichert, so daß sie nur einmal (wenn überhaupt)

+und dann nie wieder eingestellt werden müßen. 

+ 

+ 

+#type("8")##center##ib(3)#6.8.2  Die Hardcopyparameter#ie(3)##type("elite")# 

+ 

+Im Gegensatz zur Hardcopy einer Textseite kann das Aussehen einer Graphik

+beim Ausdruck noch verändert werden. Das Kommando 

+ 

+                         #ib(1)#<ESC> ^#ie(1)# <n>    (Hex 1B 5E <n>) 

+ 

+druckt eine Hardcopy mit dem Parameter <n>. <n> ist ein Byteparameter mit

+dem Wertebereich von 0 bis 15. Jedes Bit in <n> legt eine Darstellungsweise

+fest. Die Bits haben folgende Bedeutung: 

+ 

+Invertieren: 

+Bit 0 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Helle Punkte auf dem Bildschirm werden auf dem Drucker schwarz

+              gedruckt, dunkle Punkte bleiben beim Ausdruck weiß. 

+  1      1    Die Graphik wird invertiert, d.h. Ein dunkler Bildhintergrund

+              bleibt auf dem Drucker dunkel (schwarz). 

+ 

+Doppelte Breite: 

+Bit 1 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Breite gedruckt. Es

+              werden also 280 Punkte nebeneinander gedruckt. 

+  1      2    Jeder Bildschirmpunkt wird in doppelter Breite gedruckt. In

+              diesem Fall werden auf dem Drucker 560 Punkte nebeneinander

+              gedruckt. 

+ 

+Doppelte Höhe: 

+Bit 2 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Jeder Bildschirmpunkt wird in normaler Höhe gedruckt. Es wer-

+              den also 192 Punkte untereinander gedruckt. 

+  1      4    Jeder Bildschirmpunkt wird in doppelter Höhe gedruckt. In

+              diesem Fall werden also 384 Punkte untereinander gedruckt. 

+ 

+Zwei Seiten nebeneinander drucken: 

+Bit 3 Dezimal Bedeutung 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+  0      0    Es wird nur eine Graphikseite (linksbündig) gedruckt. 

+  1      8    Die aktuelle (mit #ib(1)#<ESC> O 7#ie(1)# <n> eingestellte) Graphikseite

+              wird linksbündig und die andere Graphikseite nahtlos rechts

+              daneben gedruckt. 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#44 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 44 -----------#

+#center##on("b")#6.  Der Graphikmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Zur Kombination von Möglichkeiten (mehrere Bits sind gesetzt): 

+ 

+- Eine Graphik mit doppelter Höhe und doppelter Breite hat ungefähr das

+  Format des Bildschirms. Ein Ausdruck besteht dann aus 560 x 384 = 215040

+  Punkten. Zusätzliches Invertieren macht die Graphik dem Bildschirmausse-

+  hen noch ähnlicher. 

+ 

+- Werden zwei Seiten mit doppelter Breite nebeneinander gedruckt, dann re-

+  icht die Anzahl der Graphikspalten auf dem Drucker mit dem Defaultgra-

+  phikmodus nicht mehr aus. In diesem Fall sollte man die Druckertreiber

+  Kommandosequenz 1 temporär auf eine hohe (4-fache) Dichte umschalten.

+  Solange kein Setup ausgeführt wird, ist diese Dichte nur solange gültig,

+  bis das Terminal ausgeschaltet wird. 

+ 

+#text end#

+#clear pos# 

+#free(16.11019)#

+ 

+ 

+ 45 

+#page##--------------------------------- Ende der Seite 45 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#7.  Die Parameter der seriellen Schnittstelle#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Die Parameter der seriellen Schnittstelle können vom Host durch Escape-

+Sequenzen gändert werden. Die Änderung der Parameter wird erst durchgeführt,

+wenn die Parameterübergabe komplett ist (d.h das letzte Byte wurde übertra-

+gen). Alle Übertragungsparameter wie Stopbits, Datenbits, Parität und Bau-

+drate werden zusammen in einem 'Rutsch' eingestellt. Die Art der Flußkon-

+trolle wird mit separaten Escape-Sequenzen eingestellt. 

+Die Einstellung in der Kommandozeile ist im Kapitel 3 beschrieben. 

+ 

+ 

+#type("8")##center##ib(3)#7.1  Das Übertragungsformat#ie(3)##type("elite")# 

+ 

+Das Übertragunsformat eines Datenbytes sieht folgendermaßen aus: 

+(Beispiel für 8 Datenbits, 1 Paritätsbit und 1 Stopbit) 

+ 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+    ... |"0"| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | P |"1"| ... 

+        +---+---+---+---+---+---+---+---+---+---+---+ 

+       Start-  ----  D a t e n b i t s ---- Pari- Stop- 

+        bit                                 täts- bit 

+                                            bit 

+     --------> Zeit 

+ 

+Bei 7 Datenbits ist das Bit 7 "0". P bezeichnet das Paritätsbit. Wenn zwei

+Stopbits übertragen werden steht an dieser Stelle das 1. Stopbit ("1"). 

+ 

+ 

+#type("8")##center##ib(3)#7.2  Die Übertragungsparameter#ie(3)##type("elite")# 

+ 

+Alle vier Parameter werden zugleich verändert. Das Kommando lautet 

+ 

+                         #ib(1)#<ESC> <SPACE> <SPACE>#ie(1)# <x>    (Hex 1B 20 20 <x>) 

+ 

+<x> ist dabei ein Datenbyte, das wie folgt festgelegt wird: 

+ 

+   Bit     7       6       5       4       3       2       1       0 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+       |Parity |Parity | Stop- | Daten-|            Baudrate           | 

+       | even/ |on/off | bits  | bits  |       |       |       |       | 

+       | odd   |       |       |       |       |       |       |       | 

+       +-------+-------+-------+-------+-------+-------+-------+-------+ 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+#right#46 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 46 -----------#

+#center##on("b")#7.  Die Parameter der seriellen Schnittstelle#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.2.1  Baudrate#ie(3)##type("elite")# 

+ 

+Baudrate = Anzahl der pro Sekunde übertragenen Bits (Übertragungsgeschwin-

+digkeit) . 

+ 

+         Bits 

+#on("u")#Dezimal 3 2 1 0    Neue Baudrate#off("u")# 

+  0     0 0 0 0    Alte Baudrate (nicht verändern) 

+  1     0 0 0 1      50 Baud 

+  2     0 0 1 0      75 Baud 

+  3     0 0 1 1     109.9 Baud 

+  4     0 1 0 0     134.58 Baud 

+  5     0 1 0 1     150 Baud 

+  6     0 1 1 0     300 Baud 

+  7     0 1 1 1     600 Baud 

+  8     1 0 0 0    1200 Baud 

+  9     1 0 0 1    1800 Baud 

+ 10     1 0 1 0    2400 Baud 

+ 11     1 0 1 1    3600 Baud 

+ 12     1 1 0 0    4800 Baud 

+ 13     1 1 0 1    7200 Baud 

+ 14     1 1 1 0    9600 Baud 

+ 15     1 1 1 1   19200 Baud 

+ 

+Der Wert 0 kann gebraucht werden, wenn nur Datenbits, Stopbits und Pari-

+tätsbit verändert werden sollen. 

+ 

+ 

+#type("8")##center##ib(3)#7.2.2  Datenbits#ie(3)##type("elite")# 

+ 

+Bit 4 legt die Anzahl der gesendeten und empfangenen Datenbits fest. 

+ 

+#on("u")#Dezimal Bit 4              #off("u")# 

+   0      0     8 Datenbits 

+  16      1     7 Datenbits 

+ 

+Mit einem anschliessenden Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE> 6#ie(1)#    (Hex 1B 20 36) 

+ 

+kann das 8. Datenbit ausmaskiert (d.h auf "0" gesetzt) werden. Dies kann

+notwendig sein, wenn der Host nur 7 Bit ASCII verarbeitet und auf ein ge-

+setztes 8. Datenbit falsch reagiert (Steuerbit oder ähnliches). 

+ 

+Mit 

+ 

+                         #ib(1)#<ESC> <SPACE> 7#ie(1)#    (Hex 1B 20 37) 

+ 

+kann die Maskierung wieder aufgehoben werden. 

+Zu beachten ist, daß bei 7 Bit Datentransfer zum Beispiel das Farbbit bei

+Download einer Graphikseite nicht übertragen wird. 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+ 47 

+#page##--------------------------------- Ende der Seite 47 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.2.3  Stopbits#ie(3)##type("elite")# 

+ 

+Bit 5 legt die Anzahl der Stopbits fest. 

+ 

+#on("u")#Dezimal Bit 5            #off("u")# 

+   0      0    1 Stopbit 

+  32      1    2 Stopbits 

+ 

+Zu beachten ist, daß bei eingeschaltetem Paritycheck und 8 Datenbits immer

+ein Stopbit übertragen wird, auch wenn 2 Stopbits programmiert wurden. (Es

+können maximal 11 Bits/Daten"byte" übertragen werden.) 

+ 

+ 

+#type("8")##center##ib(3)#7.2.4  Paritätsbit#ie(3)##type("elite")# 

+ 

+Bit 6 legt fest, ob Paritätskontrolle erfolgen soll und ob ein Paritätsbit

+vorhanden ist. 

+ 

+Dezimal Bit 6 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+   0      0     Keine Paritätskontrolle/Kein Paritätsbit 

+  64      1     Paritätskontrolle eingeschaltet. Parität mit Bit 7 gewählt 

+ 

+Wenn Bit 6 = 1 ist legt Bit 7 fest, ob gerade oder ungerade Parität geprüft

+werden soll. 

+ 

+#on("u")#Dezimal Bit 7                   #off("u")# 

+   0      0     Ungerade Parität 

+ 128      1     Gerade Parität 

+ 

+ 

+#type("8")##center##ib(3)#7.2.5  Übertragungsfehler#ie(3)##type("elite")# 

+ 

+Wird ein Rahmenfehler (Stopbit fehlt) oder ein Paritätsfehler (mindestens

+ein Bit verfälscht) entdeckt, dann wird statt des empfangenen Mülls ein Byte

+Hex FF vom Terminal interpretiert. Steht dies im Text, kann man es als in-

+vertiertes Punktraster erkennen. Dieses Zeichen richtet wenig Schaden an,

+wenn es mitten in einer Escape-Sequenz empfangen wird. 

+ 

+ 

+#type("8")##center##ib(3)#7.3  Die Flußkontrolle#ie(3)##type("elite")# 

+ 

+Damit keine Daten verloren gehen, wenn der Host oder das Terminal keine

+solchen mehr empfangen kann, sollte eine Flußkontrolle eingeschaltet wer-

+den. Das Terminal hat zwar einen Empfangspuffer von 4K Byte (4096 Zeichen),

+aber auch dieser kann einmal voll sein. Der Sendepuffer von 2K Byte (2048

+Zeichen) wird in Anspruch genommen, wenn der Host dem Terminal per Flußkon-

+trolle mitgeteilt hat, daß er keine Zeichen mehr empfangen kann. Das Termi-

+nal wartet dann nicht aktiv auf Freigabe vom Host, sondern kann weiter ar-

+beiten (Spooler, Bildschirmausgabe, Localmodus etc.). 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+#right#48 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 48 -----------#

+#center##on("b")#7.  Die Parameter der seriellen Schnittstelle#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Wenn das Terminal den Host "gestoppt" hat, kann man das an einem "B U S Y"

+in der Statuszeile erkennen, sonst steht dort "R E A D Y". 

+Wenn der Host das Terminal "gestoppt" hat, kann man das an einem "T X O F F"

+in der Statuszeile erkennen, sonst steht dort "T X   O N". 

+ 

+Da dieses Terminal einen großen Empfangspuffer hat, sollte man allerdings im

+Notfall auch ohne Flußkontrolle auskommen, wenn nicht gerade umfangreiche

+Graphikoperationen ausgeführt werden sollen, bei denen der Puffer nicht

+schnell genug geleert werden kann. 

+ 

+ 

+#type("8")##center##ib(3)#7.3.1  XON/XOFF#ie(3)##type("elite")# 

+ 

+XON/XOFF ist eine Softwareflußkontrolle. Als Stopzeichen wird 

+ 

+                         #ib(1)#XOFF#ie(1)#    (#ib(1)#<CTRL S>#ie(1)# Hex 13) 

+ 

+verwendet. Als Startzeichen wird 

+ 

+                         #ib(1)#XON#ie(1)#    (#ib(1)#<CTRL Q>#ie(1)# Hex 11) 

+ 

+verwendet. Diese Flußkontrolle sollte nur im Textmodus verwendet werden, da

+Binärdaten möglicherweise Hex 11 oder Hex 13 enthalten, die dann nicht als

+Protokollzeichen verwendet werden sollen. Der Vorteil dieser Art der Fluß-

+kontrolle ist, daß man mit 3 Leitungen (Masse, TXD, RXD) an der seriellen

+Schnittstelle auskommt. 

+ 

+Das Terminal reagiert auf empfangene XON/XOFF-Zeichen sofort, d.h diese

+Zeichen werden nicht in den Empfangspuffer gestellt. Diese beiden Zeichen

+werden auch dann interpretiert, wenn das Terminal im Local-Modus ist. 

+ 

+Die XON/XOFF Flußkontrolle kann in der 2. Kommandozeile ein- und ausgeschal-

+tet werden, sowie mit dem Kommando 

+ 

+                         #ib(1)#<CTRL O>#ie(1)#    (Hex 0F) 

+ 

+eingeschaltet und mit 

+ 

+                         #ib(1)#<CTRL N>#ie(1)#    (Hex 0E) 

+ 

+ausgeschaltet werden. 

+ 

+Zu beachten ist, daß der Sender vor dem Ausschalten noch im "TX OFF"-

+Zustand sein kann. Man sollte deshalb direkt vor <CTRL N> noch <CTRL Q> (Hex

+11), also XON senden, um den Sender wieder einzuschalten. Dies wird vom

+Terminal nicht automatisch gemacht, da sonst ein <CTRL N> das im Datenstrom

+vorkommt, auch noch ein Zeichen für Flußkontrolle wäre. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+ 49 

+#page##--------------------------------- Ende der Seite 49 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.3.2  DTR/DSR#ie(3)##type("elite")# 

+ 

+DTR/DSR ist eine Hardwareflußkontrolle bei der die Leitungen Pin 20 (DTR)

+und Pin 6 (DSR) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+DTR (Data Terminal Ready)/DSR (DataSet Ready) Flußkontrolle kann in der 2.

+Kommandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> <SPACE>#ie(1)# <n>    (Hex 1B 20 <n>) 

+ 

+erreichen. Die Werte von <n> sind 

+ 

+#on("u")#<n>  Hex    Bedeutung                                              #off("u")# 

+ 2    32    Weder RTS/CTS noch DSR/DTR Flußkontrolle 

+ 3    33    RTS/CTS Flußkontrolle, aber keine DSR/DTR Flußkontrolle 

+ 4    34    DSR/DTR Flußkontrolle, aber keine RTS/CTS Fluskontrolle 

+ 5    35    DSR/DTR und RTS/CTS Flußkontrolle 

+ 

+DTR/DSR Flußkontrolle wird empfohlen, da hier alle Zeichen ohne Veränderung

+empfangen werden können. RTS/CTS Flußkontrolle kann, hardwaremäßig bedingt,

+beim Einschalten von RTS ein Bit "umkippen". 

+ 

+ 

+#type("8")##center##ib(3)#7.3.3  RTS/CTS#ie(3)##type("elite")# 

+ 

+RTS/CTS ist eine Hardwareflußkontrolle bei der die Leitungen Pin 4 (RTS) und

+Pin 5 (CTS) (in der Regel überkreuzt) angeschloßen sein müssen. 

+Bei dieser Art der Flußkontrolle dürfen alle Zeichen übertragen werden, ohne

+daß eines die Flußkontrolle steuert. Ausnahme: Wenn zusätzlich XON/ XOFF

+Flußkontrolle eingeschaltet ist werden natürlich XON/XOFF als Steuerzeichen

+interpretiert. 

+ 

+RTS (Ready To Send)/CTS (Clear To Send) Flußkontrolle kann in der 2. Kom-

+mandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem Kom-

+mando <ESC> <SPACE> <n> erreichen. Die Werte von <n> sind im letzten Ab-

+schnitt (7.3.2 DTR/DSR) angegeben. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(3.833519)#

+ 

+ 

+#right#50 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 50 -----------#

+#center##on("b")#7.  Die Parameter der seriellen Schnittstelle#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#7.4  Echo und Local/Online#ie(3)##type("elite")# 

+ 

+In einigen Fällen verlangt der Host, daß das vom Terminal empfangene Zei-

+chen zurückgesendet (geechoed) wird, um eventuelle Übertragungsfehler zu

+erkennen. Dieser Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D E#ie(1)#    (Hex 1B 44 45) 

+ 

+eingeschaltet. Zusätzlich wird hiermit der Localmodus ausgeschaltet (d.h der

+Online-Modus eingeschaltet), falls das Kommando am Terminal im Local-Modus

+gegeben wurde. 

+ 

+Der Echo-Modus wird mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D O#ie(1)#    (Hex 1B 44 4F) 

+ 

+ausgeschaltet. Das Terminal befindet sich dann im Fullduplex Online-Modus.

+Der Local-Modus wird auch hierbei verlassen. 

+ 

+Der Local-Modus kann vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> D L#ie(1)#    (Hex 1B 44 4C) 

+ 

+eingeschaltet werden. Dabei ist zu beachten, daß der Host den Local-Modus

+nicht ausschalten kann. Der Local-Modus kann vom Benutzer durch Drücken von

+#ib(1)#<SHIFT CTRL HOME>#ie(1)# am Keyboard verlassen werden. 

+ 

+Im Local-Modus werden Keyboardeingabe nicht mehr an den Host geschickt,

+sondern auf dem Bildschirm angezeigt bzw. durch das Terminal interpretiert.

+Funktionstastensequenzen werden auch nicht an den Host geschickt. Escape-

+Sequenzen die allerdings Daten senden (z.B Download von Text und Graphik

+oder die Abfrage der Cursorposition), werden wie im Online-Modus ausgeführt,

+d.h. die Daten werden zum Host geschickt. 

+ 

+#text end#

+#clear pos# 

+#free(7.643519)#

+ 

+ 

+ 51 

+#page##--------------------------------- Ende der Seite 51 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#8.  Spezielle Kommandos im Textmodus#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+In diesem Kapitel werden weitere Kommandos, die im Textmodus wirksam sind

+und thematisch nicht in die anderen Kapitel passen, beschrieben. 

+ 

+ 

+#type("8")##center##ib(3)#8.1  Weitere Cursorpositionierungskommandos#ie(3)##type("elite")# 

+ 

+Zusätzlich zu den im Graphikmodus und im Textmodus gültigen Cursorpositio-

+nierungskommandos gibt es noch einige weitere. Die fünf Kommandos Zeile

+löschen, Zeile einfügen, Zeichen löschen, Zeichen einfügen und Rückwärtsta-

+bulator sind schon in Kapitel 5 beschrieben worden. 

+ 

+Hier nur noch einmal die entsprechenden Kommandos: 

+ 

+Funktion            Escape-Sequenz 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+Zeile einfügen      #ib(1)#<ESC> E#ie(1)#     oder #ib(1)#<ESC> L#ie(1)# 

+Zeile löschen       #ib(1)#<ESC> R#ie(1)#     oder #ib(1)#<ESC> M#ie(1)# 

+Zeichen einfügen    #ib(1)#<ESC> Q#ie(1)# 

+Zeichen löschen     #ib(1)#<ESC> W#ie(1)# 

+Rückwärtstabulator  #ib(1)#<ESC> I#ie(1)# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> j#ie(1)#    (Hex 1B 6A) 

+ 

+kann ein umgekehrter Zeilenvorschub erreicht werden. Steht der Cursor in

+Zeile 2 bis Zeile 24, dann wirkt dieses Kommando wie <UP>. Steht der Cursor

+in Zeile 1, dann wird der Bildschirminhalt nach unten gescrollt und die

+erste Bildschirmzeile gelöscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> =#ie(1)# <y+32> <x+32>    (Hex 1B 3D ...) 

+ 

+kann der Cursor auf eine bestimmte Position auf dem Bildschirm gesetzt wer-

+den. <x+32> und <y+32> sind dabei Byteparameter. <x+32> hat den Wertebe-

+reich 32 (<SPACE>) bis 110 ("o"), <y+32> hat den Wertebereich 32 (<SPACE>)

+bis 55 ("7"). <x+32> ist dabei die gewünschte x-Position + 32 (gezählt wird

+von 0 bis 79), <y+32> ist die gewünschte y-Position + 32 (gezählt wird von 0

+bis 23). Die Zuordnungen der ASCII-Zeichen zu den Cursorpositionen kann man

+auch im Anhang A unter "Cursor" nachlesen. 

+ 

+Dieser Befehl hat im Graphikmodus die gleiche Wirkung! 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+#right#52 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 52 -----------#

+#center##on("b")#8.  Spezielle Kommandos im Textmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#8.2  Cursormodus#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> .#ie(1)# <n>    (Hex 1B 2E <n>) 

+ 

+kann die Darstellung des Cursors verändert werden. Für <n> sind ASCII-Zei-

+chen "0", "1" und "2" zugelassen. <n> hat folgende Bedeutung: 

+ 

+#on("u")#<n>   Bedeutung                             #off("u")# 

+ 0    Cursor blinkt nicht und ist unsichtbar 

+ 1    Cursor blinkt und ist sichtbar 

+ 2    Cursor blinkt nicht und ist sichtbar 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> Z#ie(1)#    (Hex 1B 5A) 

+ 

+kann der Zustand des Cursors von sichtbar auf unsichtbar und umgekehrt umge-

+schaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#8.3  Zeichensatz einstellen#ie(3)##type("elite")# 

+ 

+Da die Zeichensätze von Basis und Apple unterschiedlich sind, muß hier bei

+den Parametern unterschieden werden. Das Kommando zur Einstellung des Zei-

+chensatzes lautet in beiden Fällen 

+ 

+                         #ib(1)#<ESC> z#ie(1)# <n>    (Hex 1B 7A <n>) 

+ 

+wobei <n> ein Byteparameter ist. Beim Apple hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 1    Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zei-

+ chen 

+ 4    Ascii: 128 Zeichen, ASCII, normale und blinkende Zeichen 

+ 

+Beim Basis hat <n> folgende Bedeutung: 

+ 

+<n>   Zeichensatz 

+#rpos(16.2)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+ 0 = Apple II: 64 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 1 = Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zeichen 

+ 2 = Deutsch: 128 Zeichen, deutsch, normale und inverse Zeichen 

+ 4 = Ascii: 128 Zeichen, ASCII, normale und inverse Zeichen 

+ 6 = APL: 128 Zeichen, APL, normale und inverse Zeichen 

+ 

+#text end#

+#clear pos# 

+#free(1.716852)#

+ 

+ 

+ 53 

+#page##--------------------------------- Ende der Seite 53 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+     Und mit blinkenden statt inversen Zeichen: 

+ 8 = Apple II: 64 Zeichen, ASCII, normale, blinkende und inverse Zeichen (!) 

+ 9 = Full Ascii: 128 Zeichen, ASCII, normale, blinkende und inv. Zeichen (!) 

+10 = Deutsch: 128 Zeichen, deutsch, normale und blinkende Zeichen 

+12 = Ascii: 128 zeichen, ASCII, normale und blinkende Zeichen 

+14 = APL: 128 Zeichen, APL, normale und blinkende Zeichen 

+ 

+Einige ausgewählte Zeichensätze können auch in der Kommandozeile eingestellt

+werden. 

+ 

+ 

+#type("8")##center##ib(3)#8.4  Texthardcopy#ie(3)##type("elite")# 

+ 

+Einen Ausdruck des Textbildschirminhaltes auf dem Drucker kann man mit dem

+Kommando 

+ 

+                         #ib(1)#<ESC> P#ie(1)#   (Hex 1B 50) 

+ 

+erreichen. Der auf dem Drucker eingestellte Schrifttyp wird nicht verän-

+dert. Es werden 24 Zeilen gedruckt, die Statuszeile wird nicht gedruckt,

+sondern die "darunterliegende" 24. Textzeile. Nach jeder Zeile wird <CR> und

+<LF> gedruckt, der Drucker sollte deshalb kein Autolinefeed bei <CR> durch-

+führen. 

+ 

+Inverse Bildschirmzeichen (80..FF) werden durch Doppeldruck (dunkler) her-

+vorgehoben, Controlcharacter (00..1F und 80..9F) werden unterstrichen dar-

+gestellt, das Punktraster (7F und FF) wird als unterstrichenes # darge-

+stellt. 

+ 

+ 

+#type("8")##center##ib(3)#8.5  Zeichen-Attribute#ie(3)##type("elite")# 

+ 

+Die Zeichenattribute werden mit dem Kommando 

+ 

+                         #ib(1)#<ESC> G#ie(1)# <n>    (Hex 1B 47 <n>) 

+ 

+eingestellt. <n> ist ein Byteparameter, der folgende Werte annehmen kann: 

+ 

+#on("u")#<n>   Attribute                                                      #off("u")# 

+ 0    Sichtbare, normale Zeichen 

+ 1    Unsichtbare Zeichen, es werden Leerzeichen dargestellt 

+ 4    Sichtbare, inverse Zeichen 

+ 5    Unsichtbare Zeichen, es werden inverse Leerzeichen dargestellt. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> (#ie(1)#    (Hex 1B 28) 

+ 

+kann auf normale Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 0,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+#text end#

+#clear pos# 

+#free(04.468519e-1)#

+ 

+ 

+#right#54 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 54 -----------#

+#center##on("b")#8.  Spezielle Kommandos im Textmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> )#ie(1)#    (Hex 1B 29) 

+ 

+kann auf inverse Darstellung umgeschaltet werden (wirkt ähnlich <ESC> G 4,

+schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). 

+ 

+ 

+#type("8")##center##ib(3)#8.6  Bildhintergrund hell/dunkel#ie(3)##type("elite")# 

+ 

+Die Bildschirmdarstellung kann von heller Schrift auf dunklem Grund (be-

+züglich eines gelöschten Bildschirms) umgeschaltet werden auf dunkle Schrift

+auf hellem Grund. Die Darstellung "schwarz auf weiß" ist auf einigen Monito-

+ren augenfreundlicher. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> b#ie(1)#    (Hex 1B 62) 

+ 

+kann die dunkle Schrift auf weißem Grund eingeschaltet werden. Die Darstel-

+lung von inverser und normaler Schrift wird vertauscht. 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> d#ie(1)#    (Hex 1B 64) 

+ 

+kann helle Schrift auf dunklem Grund eingeschaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#8.7  Zeichentransfer zum Host#ie(3)##type("elite")# 

+ 

+Der Host kann Teile oder den ganzen Bildschirm vom Terminal lesen. Alle

+Zeichen werden als Bytes gesendet, bei denen ein gesetztes Bit 7 Invers-

+schrift anzeigt. 

+ 

+ 

+#type("8")##center##ib(3)#8.7.1  Ein Zeichen senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 8#ie(1)#    (Hex 1B 38) 

+ 

+wird nur das Zeichen an der Cursorposition gesendet. Die Cursorposition

+ändert sich nicht. Der Cursor muß nicht sichtbar sein. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(2.563519)#

+ 

+ 

+ 55 

+#page##--------------------------------- Ende der Seite 55 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#8.7.2  Eine Zeile senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 6#ie(1)#    (Hex 1B 36) 

+ 

+wird die Zeile, in der der Cursor steht (genauer: die Zeile der Cursorrow,

+falls der Cursor unsichtbar ist) an den Host gesendet. Falls der Cursor in

+Zeile 24 steht, wird nicht die Stauszeile, sondern die 24. Textzeile gesen-

+det. Im Anschluß an die Zeile werden eventuell ein oder zwei eingestellte

+Zeilenbegrenzer gesendet (Lineterminator). Die Programmierung der Begrenzer

+ist in Abschnitt 8.7.4 beschrieben. Es werden also 80 bis 82 Zeichen gesen-

+det. Die Cursorposition ändert sich durch das Kommando nicht. 

+ 

+ 

+#type("8")##center##ib(3)#8.7.3  Eine Seite senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 7#ie(1)#    (Hex 1B 37) 

+ 

+wird die gesamte Bildschirmseite an den Host gesendet. Im Anschluß an jede

+Zeile werden (falls eingestellt) Zeilenbegrenzer gesendet. Im Anschluß an

+die gesamte Seite wird ein (eingestellter) Seitenbegrenzer (Pageterminator)

+gesendet. Es werden also je nach Zeilen- und Seitenbegrenzer 1920 bis 1969

+Zeichen gesendet. Die Statuszeile wird nicht gesendet, sondern die "darun-

+terliegende" 24. Textzeile. Die Programmierung der Zeilen- und Seitenbe-

+grenzer ist in Abschnitt 8.7.4 beschrieben. Die Cursorposition ändert sich

+durch dieses Kommando nicht. 

+ 

+ 

+#type("8")##center##ib(3)#8.7.4  Terminatorzeichen definieren#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 1#ie(1)# <l1> <l2>    (Hex 1B 78 31 <l1><l2>) 

+ 

+können die Zeilenbegrenzer der Sendekommandos festgelegt werden. <l1> und

+<l2> sind dabei Byteparameter, die den Wertebereich 0 bis 255 überstrei-

+chen. Ist ein Parameter Hex 00, dann wird dieses Zeichen nicht gesendet.

+Wenn man also das Kommando (Hex) 1B 78 31 00 00 sendet, wird kein Begren-

+zerzeichen nach der Zeile gesendet. 

+Voreingestellt ist ein Begrenzerzeichen; und zwar US (Hex 1F). 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> x 4#ie(1)# <p>    (Hex 1B 78 34 <p>) 

+ 

+kann der Seitenbegrenzer des Kommandos #ib(1)#<ESC> 7#ie(1)# festgelegt werden. <p> ist

+ein Byteparameter, der den Wertebereich von 0 bis 255 überstreicht. Ist <p>

+Hex 00, dann wird kein Seitenbegrenzer gesendet. 

+Voreingestellt ist <p> = <CR> (Hex 0D). 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#56 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 56 -----------#

+#center##on("b")#8.  Spezielle Kommandos im Textmodus#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##ib(3)#8.7.5  Cursorposition senden#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> ?#ie(1)#    (Hex 1B 3F) 

+ 

+kann der Host die Position des Textcursors abfragen. Es wird eine Folge von

+3 Bytes gesendet: <y+32> <x+32> <CR> 

+ 

+<y+32> ist die y-Position + 32, <x+32> die x-Position + 32. Beide Parameter

+können für den Befehl #ib(1)#<ESC> =#ie(1)# <y+32> <x+32> verwendet werden, da Sie den

+gleichen Wertebereich überstreichen. 

+ 

+ 

+#type("8")##center##ib(3)#8.8  Textseite auf Diskette speichern/laden#ie(3)##type("elite")# 

+ 

+Genau wie Graphikseiten kann auch die Textseite auf Diskette geschrieben und

+zu einem späteren Zeitpunkt wieder zurückgeladen werden. Bei der Textseite

+wird außerdem noch die aktuelle Cursorposition geladen/geschrieben. Man kann

+sich zum Beispiel eine Datei Seitenweise auf dem Bildschirm anzeigen lassen

+und diese Seiten auf Diskette abspeichern. Später kann man die Datei Offline

+(im Localmodus) Seitenweise ansehen. 

+ 

+Bis zu 8 Textseite lassen sich auf Diskette speichern und wieder abrufen.

+Die "Fächer" für die Textseiten sind unabhängig von denen für die Graphik-

+seiten. 

+Die Seiten werden unabhängig von REVVID (Schwarz auf Weiß) immer NORVID

+(also Weiß auf Schwarz) abgespeichert. Beim Laden der Seite wird sie je nach

+REVVID/NORVID dargestellt. 

+ 

+Das Kommando für diese Operationen lautet 

+ 

+                         #ib(1)#<ESC> S#ie(1)# <n>    (Hex 1B 53 <n>). 

+ 

+<n> ist ein Byteparameter mit dem Wertebereich 0 bis 31, wobei die Bits

+folgendermaßen belegt sind: 

+Bit 0..2 : "Fachnummer" der Textseite auf der Diskette (0 bis 7) 

+Bit 3    : Bei Textseiten immer 0 (Bei Graphikseiten immer 1) 

+Bit 4    : 0 heißt: die Textseite wird von der Diskette gelesen, 

+           1 heißt: die Textseite wird auf die Diskette geschrieben. 

+ 

+Wird die Textseite auf die Diskette geschrieben, dann wird eine eventuell

+schon in diesem "Fach" vorhandene Textseite überschrieben. 

+ 

+Für Insider: Jede Textseite belegt einen halben Track (2k). Die 8 Textseiten

+             befindenden auf den Tracks 6 bis 9 in aufsteigender Reihenfol-

+             ge. 

+ 

+ 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+ 57 

+#page##--------------------------------- Ende der Seite 57 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#9.  Verschiedene Steuerkommandos#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+#type("8")##center##ib(3)#9.1  Signalton#ie(3)##type("elite")# 

+ 

+Mit 

+                         #ib(1)#<CTRL G>#ie(1)#   (Hex 07) 

+ 

+wird ein kurzer Signalton ausgegeben. Ein Warnton des Terminals ist schär-

+fer (heller). 

+ 

+ 

+#type("8")##center##ib(3)#9.2  Keyboardclick#ie(3)##type("elite")# 

+ 

+Der Tastaturclick wird für fast alle Tasten erzeugt. Ausnahmen sind die

+<SHIFT> und die <CTRL> Tasten, sowie beim Apple die Apfeltasten. Der Tasta-

+turclick kann in der ersten Kommandozeile abgeschaltet werden (CLK OFF) oder

+mit dem Kommando 

+ 

+                         #ib(1)#<ESC> <#ie(1)#    (Hex 1B 3C) 

+ 

+vom Host. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> >#ie(1)#    (Hex 1B 3E) 

+ 

+kann der Keyboardclick wieder eingeschaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#9.3  Bildschirmausgabe/Druckerausgabe#ie(3)##type("elite")# 

+ 

+Die Bildschirmausgabe, die ja normalerweise eingeschaltet ist, kann in der

+Kommandozeile abgeschaltet werden (SCRNOFF) oder vom Host mit dem Kommando 

+ 

+                         #ib(1)#<ESC> `#ie(1)#    (Hex 1B 60) 

+ 

+abgeschaltet werden. Bis auf das Kommando 

+ 

+                         #ib(1)#<ESC> a#ie(1)#    (Hex 1B 61) 

+ 

+werden keine Escape-Squenzen oder Control-Codes interpretiert. Mit <ESC> a

+wird die Bildschirmausgabe wieder zugelassen. 

+ 

+Die Druckerausgabe kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> @#ie(1)#    (Hex 1B 40) 

+ 

+eingeschaltet werden. Man kann dann Texte parallel auf Drucker und Bild-

+schirm ausgeben. In der ersten Kommandozeile kann die Druckerausgabe auch

+ein- und ausgeschaltet werden. 

+#text end#

+#clear pos# 

+#free(1.293519)#

+ 

+ 

+#right#58 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 58 -----------#

+#center##on("b")#9.  Verschiedene Steuerkommandos#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Man kann zum Beispiel den Schrifttyp des Druckers im Local-Modus umschal-

+ten, wenn man in der Kommandozeile die Druckerausgabe (PRT ON) einschaltet.

+Dazu kann man sich auch eine Funktionstaste belegen, die Bildschirmausgabe

+abschaltet, Druckerausgabe einschaltet, den Schrifttyp umschaltet, Drucker-

+ausgabe wieder ausschaltet und Bildschirmausgabe wieder einschaltet. 

+ 

+Abgeschaltet wird die Druckerausgabe mit dem Kommando 

+ 

+                         #ib(1)#<ESC> A#ie(1)#    (Hex 1B 41) 

+ 

+ 

+#type("8")##center##ib(3)#9.4  Scroll/Page-Modus#ie(3)##type("elite")# 

+ 

+Steht der Cursor in der letzten Zeile und soll er in die nächst tiefere

+gebracht werden (<DOWN>, <TAB>, <NEWLINE> etc.), dann gibt es entweder die

+Möglichkeit, daß der Bildschirm nach oben gescrollt wird, d.h. die 1. Zeile

+verschwindet und die 24. Zeile wird gelöscht, oder daß der Cursor in der

+ersten Bildschirmzeile wieder auftaucht, ohne daß der Bildschirminhalt ver-

+ändert wird. Die erste Möglichkeit heißt SCROLL-Modus, die zweite PAGE-

+Modus. Die Umschaltung kann entweder in der ersten Kommandozeile erfolgen

+oder mit dem Kommando 

+ 

+                         #ib(1)#<ESC> H#ie(1)#    (Hex 1B 48). 

+ 

+In der Kommandozeile hat man die Informationsmöglichkeit, welcher Modus

+gerade aktiv ist. 

+ 

+ 

+#type("8")##center##ib(3)#9.5  Belegung der Funktionstasten#ie(3)##type("elite")# 

+ 

+Eine nützliche Angelegenheit sind die programmierbaren Funktionstasten. Die

+Codes der Funktionstasten sind unter anderem in Anhang A zu finden. Funk-

+tionstasten können im Local-Modus aufgerufen werden, zum Beispiel für häu-

+fig gebrauchte Terminalkommandos oder längere Kommandosequenzen (Graphikmo-

+dus). Im Online-Modus kann man z.B. Betriebssystemkommandos auf Funktion-

+stasten legen. 

+ 

+Die Länge der Zeichen auf allen Funktionstasten darf zusammen nicht 4095

+Zeichen überschreiten. Ein akustisches Warnsignal ertönt, wenn die Funk-

+tionstastentabelle voll ist. Soll die Funktionstastendefinition auch noch

+nach dem Abschalten des Terminals erhalten bleiben, dann muß in der Komman-

+dozeile <SHIFT S> gegeben werden, damit der Setup samt Funktionstastende-

+finitionen auf die Diskette geschrieben wird. 

+ 

+#text end#

+#clear pos# 

+#free(3.410185)#

+ 

+ 

+ 59 

+#page##--------------------------------- Ende der Seite 59 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+wird eine Taste belegt. <d...> und <t> sind Byteparameter. <d...> ist eine

+Folge von Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funk-

+tionstaste (Bit 7 = 1), auf die die Sequenz gelegt werden soll. Durch diese

+Einschränkung sind keine rekursiven (sich selbst aufrufenden) Tastenkomman-

+dos möglich, man kann allerdings z.B. auch nicht alle binären Parameter auf

+Tasten legen (Man sollte dezimale Parameter benutzen). Die Cursortasten etc.

+können nicht belegt werden. 

+Um die Original-Tastencodes wieder zu benutzen, gibt es drei Möglichkeiten: 

+ 

+- Die Tabelle der Tastendefinitionen wird ganz gelöscht (Abschnitt 9.6). 

+- Die Definition auf einzelnen Tasten wird durch <ESC> e <t> gelöscht. <t>

+  ist dabei der Code einer zu löschenden Taste. 

+- In der ersten Kommandozeile wird F CODE eingeschaltet oder das Kommando 

+ 

+                         #ib(1)#<ESC> c#ie(1)#    (Hex 1B 63) 

+ 

+  gegeben. Dieses Kommando schaltet um, ob immer Tastencodes (A1..EF) oder,

+  bei belegten Tasten, die programmierte Sequenz geliefert werden soll. Im

+  Graphikmodus möchte man eventuell die griechischen Sonderzeichen auf den

+  Funktionstasten benutzen (F CODE) und nicht die programmierten Tasten-

+  strings (F STRG). 

+ 

+ 

+#type("8")##center##ib(3)#9.5.1  Local-Escape#ie(3)##type("elite")# 

+ 

+Um Funktionstasten mit Terminalkommandos auch im Online-Modus benutzen zu

+können (zum Beispiel ein Bildschirm Hardcopy) wird ein spezielles ESC-Zei-

+chen statt <ESC> (Hex 1B) verwendet. 

+Das Zeichen 

+ 

+                         #ib(1)#<LOCESC>#ie(1)#    (Hex 9B) 

+ 

+teilt dem Terminal mit, daß die nun folgende Escape-Sequenz nicht an den

+Host gesendet wird (was bei <ESC> der Fall wäre), sondern vom Terminal in-

+terpretiert werden muß. 

+Im Local-Modus wirkt ein <LOCESC> wie ein normales <ESC>, d.h. das Kommando

+wird sowieso vom Terminal interpretiert. 

+ 

+ 

+#type("8")##center##ib(3)#9.5.2  Makrokommandos#ie(3)##type("elite")# 

+ 

+Ein Makrokommando hat (mindestens) drei Aufgaben: 

+- Der Host kann dem Terminal neue ESC-Sequenzen (mit Parametern) definieren,

+  z.B. um andere Terminals zu emulieren. 

+- Nicht nur das Terminal kann Funktionstasten aufrufen, sondern auch der

+  Host, wenn die Funkionstaste als Makro aufgerufen wird. 

+- Der Datentransfer vom Host zum Terminal kann durch Makros als Abkürzungen

+  häufig benutzter Zeichenfolgen beschleunigt werden. 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#60 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 60 -----------#

+#center##on("b")#9.  Verschiedene Steuerkommandos#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+Ein Makro wird wie eine Funktionstaste mit dem Kommando 

+ 

+ 

+                         #ib(1)#<ESC> e#ie(1)# <d...> <t>    (Hex 1B 65 <d...><t>) 

+ 

+definiert. <d...> und <t> sind Byteparameter. <d...> ist eine Folge von

+Datenbytes, deren Bit 7 = 0 sein muß. <t> ist der Code der Funktionstaste

+(Bit 7 = 1) oder mit anderen Worten der Makroname. 

+Es sind alle Codes für <t> zugelassen, die auch bei der Funktionstastende-

+finition zugelassen sind. 

+ 

+Ein Makro kann sowohl vom Terminal (auch im F CODE-Modus) als auch vom Host

+mit 

+ 

+                         #ib(1)#<ESC> <Macrocode>#ie(1)#    (Hex 1B <Makrocode>) 

+ 

+aufgerufen werden. Dem Terminal wird die Zeichensequenz des Makros so vorge-

+setzt, als käme sie von der Tastatur im Local-Modus. Wird das Makro also

+bereits im Local-Modus aufgerufen, hat das immer noch den Vorteil, daß man

+im F CODE-Modus weiterhin programmierte Funktionstasten benutzen kann. 

+Anmerkung: Wird das <ESC> vor dem <Makrocode> weggelassen, dann wird der

+           Code <Makrocode> ohne Makroausführung an das Terminal gesendet

+           und i.d.R. als inverses Zeichen dargestellt. 

+ 

+Sollen Byteparameter in die Zeichensequenz des Makros übernommen werden, die

+zur Zeit der Makrodefinition noch nicht feststehen, dann kann man einen

+Platzhalter mit dem Code Hex 81 an der Stelle einsetzen. Der Code Hex 81

+kann auf der Tastatur durch <SHIFT DELETE> erzeugt werden. 

+Wird bei der Makroausführung ein solcher Code gefunden, wartet das Terminal

+auf ein Byte von Tastatur, wenn das Makro im Local-Modus aufgerufen wurde,

+oder vom Host, wenn das Makro vom Host aufgerufen wurde. Es dürfen beliebig

+viele Codes 81 in der Makrozeichensequenz vorhanden sein. Jeder Code wird

+durch ein weiteres Zeichen von Host oder Tastatur ersetzt. 

+ 

+ 

+#type("8")##center##ib(3)#9.5.3  Startup-Makro#ie(3)##type("elite")# 

+ 

+Ein besonderes Makro hat den Code Hex EF. Dieser Code kann auf der Tastatur

+durch <SHIFT BOTTOMRIGHT> (beim Apple <OA RIGHT>) erzeugt werden. 

+ 

+Dieses Makro wird bei einem RESET des Terminals (Hardwarereset oder <ESC> 0)

+oder beim Einschalten des Terminals aufgerufen. Der Bildschirm und die Gra-

+phikseiten werden vorher gelöscht. 

+

+

+#text end#

+#clear pos# 

+#free(2.986852)#

+ 

+ 

+ 61 

+#page##--------------------------------- Ende der Seite 61 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin#

+#type("8")##center##ib(3)#9.6  Tabellen und Puffer löschen#ie(3)##type("elite")# 

+ 

+Das Terminal enthält den Empfangspuffer, den Sendepuffer, den Druckerspoo-

+ler und die Tabelle der Tastendefinitionen. Um einen der Puffer oder die

+Tabelle zu löschen, kann das Kommando 

+ 

+                         #ib(1)#<ESC> <DEL>#ie(1)# <n>    (Hex 1B 7F <n>) 

+ 

+verwendet werden. <n> ist ein Byteparameter mit dem Wertebereich 0 bis 15

+und hat folgende Bedeutung: 

+ 

+#on("u")#<n>    Gelöschte Tabelle oder Puffer#off("u")# 

+ 0     Keine 

+ 1     Tastendefinitionen 

+ 2     Druckerspooler 

+ 3     Empfangspuffer 

+ 4     Sendepuffer 

+ 

+Zu beachten ist, daß zwar der Sendepuffer gelöscht wird, aber eine eventu-

+ell gestoppte Übertragung (TX OFF) nicht wider gestartet wird. 

+ 

+ 

+#type("8")##center##ib(3)#9.7  Zeitverzögerung#ie(3)##type("elite")# 

+ 

+Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> 9#ie(1)# <n>    (Hex 1B 39 <n>) 

+ 

+kann eine Zeitverzögerung aufgerufen werden. Man kann zum Beispiel ein Fa-

+denkreuz darstellen, die Zeitverzögerung aufrufen und das Fadenkreuz wieder

+löschen. <n> ist ein Byteparameter mit dem Wertebereich von 0 bis 255. Die

+Verzögerung beträgt ca. <n> * 2 ms. 

+ 

+ 

+#type("8")##center##ib(3)#9.8  Transparentmodi#ie(3)##type("elite")# 

+ 

+Der Monitor- und der Hexadezimalmodus sind zum Test von unbekannten Emp-

+fangsdaten oder zum Analysieren der Steuerzeichenausgabe von unbekannten

+Programmen gedacht. 

+ 

+ 

+#type("8")##center##ib(3)#9.8.1  Monitor-Modus#ie(3)##type("elite")# 

+ 

+Im Monitor-Modus werden druckbare Zeichen wie normal dargestellt. Control-

+zeichen (Hex 00..1F und 80..9F) werden invertiert dargestellt. Im APL-Zei-

+chensatz kann man diese inversen Controlzeichen von den Zeichen mit Code Hex

+A0..FF unterscheiden, die auch invers dargestellt werden. 

+Der Monitormode kann in der ersten Kommandozeile ein- und ausgeschaltet

+werden. Mit dem Kommando 

+ 

+                         #ib(1)#<ESC> U#ie(1)#    (Hex 1B 55) 

+ 

+#text end#

+#clear pos# 

+#free(02.351852e-2)#

+ 

+ 

+#right#62 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 62 -----------#

+#center##on("b")#9.  Verschiedene Steuerkommandos#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#clearpos#

+#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")#

+#text begin# 

+kann der Monitormode eingeschaltet werden. Alle Zeichen werden ohne Inter-

+pretation ausgegeben, Ausnahmen sind 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58) 

+ 

+die den Monitormodus ausschalten. 

+ 

+ 

+#type("8")##center##ib(3)#9.8.2  Hexadezimal-Modus#ie(3)##type("elite")# 

+ 

+In diesem Modus werden nicht die Zeichen auf dem Bildschirm gedruckt, son-

+dern ihr ASCII-Code in hexadezimaler Schreibweise mit zwei nachfolgenden

+Blanks. Der Hexmode kann mit dem Kommando 

+ 

+                         #ib(1)#<ESC> u#ie(1)#    (Hex 1B 75) 

+ 

+ein- und ausgeschaltet werden. Alle Zeichen werden ohne Interpretation aus-

+gegeben, außer #ib(1)#<ESC> u#ie(1)# und 

+ 

+                         #ib(1)#<ESC> X#ie(1)#    (Hex 1B 58), 

+ 

+die den Hexmodus wieder ausschalten. Auch der Hexmode kann in der ersten

+Kommandozeile ein- und ausgeschaltet werden. 

+ 

+ 

+#type("8")##center##ib(3)#9.8.3  Einzelne Control-Zeichen anzeigen#ie(3)##type("elite")# 

+ 

+Um nur einzelne Controlzeichen auf dem Bildschirm darzustellen, z.B. für den

+unteren Teil des APL-Zeichensatzes (Codes 0 bis 31 oder 128 bis 159), gibt

+es das Kommando 

+ 

+                         #ib(1)#<ESC> F#ie(1)# <z>    (Hex 1B 46 <z>). 

+ 

+<z> ist dabei ein Byteparameter mit dem Wertebereich 0 bis 255, vorzugswei-

+se 0 bis 31. <z> wir mit invertiertem Bit 7 (normal/invers) in den Bild-

+schirmspeicher an der aktuellen Cursorposition geschrieben. 

+#text end#

+#clear pos# 

+#free(5.103519)#

+ 

+ 

+ 63 

+#page##--------------------------------- Ende der Seite 63 -----------#

diff --git a/system/ruc-terminal/unknown/doc/TINHALT.PRT b/system/ruc-terminal/unknown/doc/TINHALT.PRT
new file mode 100644
index 0000000..e8e7435
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TINHALT.PRT
@@ -0,0 +1,120 @@
+#type ("elite")##limit (16.2)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("", "Inhalt  ")# 

+ 

+1.  Einige Worte zuvor ...........................  1 

+2.  Die Hardware .................................  2 

+2.1  Die serielle Schnittstelle ..................  2 

+2.2  Der Reset ...................................  2 

+3.  Die Kommandozeile ............................  3 

+3.1  Tastenfunktionen in der Kommandozeile .......  3 

+3.2  Setup .......................................  4 

+3.3  Die zweite Kommandozeile ....................  4 

+3.4  Die zweite Kommandozeile ....................  6 

+4.  Die Statuszeile ..............................  8 

+4.1  Spoolerstatus ...............................  8 

+4.2  Empfängerstatus .............................  8 

+4.3  Senderstatus ................................  9 

+4.4  Busy - Anzeige ..............................  9 

+4.5  Online/Local - Anzeige ......................  9 

+5.  Die Bedeutung der Tasten .....................  10 

+5.1  Die Funktions- und Steuertasten .............  10 

+5.2  Die TVI-Emulation ...........................  13 

+6.  Der Graphikmodus .............................  16 

+6.1  Allgemeines .................................  16 

+6.2  Koordinaten und Parameterübergabe ...........  16 

+6.2.1  Cursorposition/Fadenkreuz .................  16 

+6.2.2  Binäre oder dezimale Parameter ............  17 

+6.2.2.1  Binäre Parameter ........................  17 

+6.2.2.2  Dezimale Parameter ......................  17 

+6.2.3  Absolute oder relative Koordinaten ........  18 

+6.2.4  Byteparameter .............................  18 

+6.3  Die Graphikparameter ........................  19 

+6.3.1  Strichdicke ...............................  19 

+6.3.2  Farbe/Helligkeit ..........................  19 

+6.3.3  Linientyp .................................  20 

+6.3.3.1  Selbstdefinierte Linientypen (Pattern) ..  20 

+6.3.4  Bitverknüpfungen ..........................  21 

+6.3.5  Multiparametereinstellung .................  22 

+6.4  Graphikseiten ...............................  22 

+6.4.1  Die sichtbare Seite und die Arbeitsseite ..  22 

+6.4.1.1  80-Zeichen Text und Graphik .............  23 

+6.4.2  Aufbau einer Graphikseite .................  23 

+6.4.3  Operationen auf den Graphikseiten .........  24 

+6.4.4  Laden einer Graphikseite vom Host .........  25 

+6.4.5  Graphik auf Diskette speichern/laden ......  26 

+6.5  Textdarstellung im Graphikmodus .............  26 

+6.5.1  Zeichendarstellung ........................  27 

+6.5.1.1  Zeichengröße und Schreibrichtung ........  27 

+6.5.1.2  Dicke, Farbe etc. .......................  28 

+6.5.1.3  Zeichensätze und Attribute ..............  28 

+6.5.1.4  Zeichen überschreiben ...................  29 

+6.5.2  Textkommandos im Graphikmodus .............  30 

+6.5.2.1  Die Cursorpositionierung ................  30 

+6.5.2.2  Löschbefehle ............................  33 

+6.6  Die Graphikkommandos ........................  33 

+6.6.1  Draw's und Move's .........................  33 

+6.6.1.1  Punkt setzen ............................  34 

+6.6.1.2  Move-Befehle ............................  34 

+6.6.1.3  Draw-Befehle ............................  35 

+6.6.1.4  Turtle-Graphik ..........................  35 

+6.6.2  Komplexere Zeichenkommandos ...............  36 

+6.6.2.1  Kreise und Kreissegmente ................  36 

+6.6.2.2  Rechtecke ...............................  37 

+6.6.2.3  Bögen und Ellipsen ......................  38 

+6.6.2.4  Gefüllte Flächen ........................  39 

+6.6.2.4.1  Definition des Musters ................  40 

+6.7  Graphikdaten zum Host .......................  40 

+6.7.1  Graphikseiten zum Host ....................  40 

+6.7.2  Cursorposition zum Host ...................  41 

+6.7.3  Einzelne Bits zum Host ....................  41 

+6.7.4  Parameter zum Host ........................  42 

+6.8  Graphikhardcopy .............................  43 

+6.8.1  Der Druckertreiber ........................  43 

+6.8.2  Die Hardcopyparameter .....................  44 

+7.  Die Parameter der seriellen Schnittstelle ....  46 

+7.1  Das Übertragungsformat ......................  46 

+7.2  Die Übertragungsparameter ...................  46 

+7.2.1  Baudrate ..................................  47 

+7.2.2  Datenbits .................................  47 

+7.2.3  Stopbits ..................................  48 

+7.2.4  Paritätsbit ...............................  48 

+7.2.5  Übertragungsfehler ........................  48 

+7.3  Die Flußkontrolle ...........................  48 

+7.3.1  XON/XOFF ..................................  49 

+7.3.2  DTR/DSR ...................................  50 

+7.3.3  RTS/CTS ...................................  50 

+7.4  Echo und Local/Online .......................  51 

+8.  Spezielle Kommandos im Textmodus .............  52 

+8.1  Weitere Cursorpositionierungskommandos ......  52 

+8.2  Cursormodus .................................  53 

+8.3  Zeichensatz einstellen ......................  53 

+8.4  Texthardcopy ................................  54 

+8.5  Zeichen-Attribute ...........................  54 

+8.6  Bildhintergrund hell/dunkel .................  55 

+8.7  Zeichentransfer zum Host ....................  55 

+8.7.1  Ein Zeichen senden ........................  55 

+8.7.2  Eine Zeile senden .........................  56 

+8.7.3  Eine Seite senden .........................  56 

+8.7.4  Terminatorzeichen definieren ..............  56 

+8.7.5  Cursorposition senden .....................  57 

+8.8  Textseite auf Diskette speichern/laden ......  57 

+9.  Verschiedene Steuerkommandos .................  58 

+9.1  Signalton ...................................  58 

+9.2  Keyboardclick ...............................  58 

+9.3  Bildschirmausgabe/Druckerausgabe ............  58 

+9.4  Scroll/Page-Modus ...........................  59 

+9.5  Belegung der Funktionstasten ................  59 

+9.5.1  Local-Escape ..............................  60 

+9.5.2  Makrokommandos ............................  60 

+9.5.3  Startup-Makro .............................  61 

+9.6  Tabellen und Puffer löschen .................  62 

+9.7  Zeitverzögerung .............................  62 

+9.8  Transparentmodi .............................  62 

+9.8.1  Monitor-Modus .............................  62 

+9.8.2  Hexadezimal-Modus .........................  63 

+9.8.3  Einzelne Control-Zeichen anzeigen .........  63 

+Anhang A - ASCII Tabelle, Zeichensätze, Parameter.  64 

+Anhang B - Befehlsübersicht ......................  70 

+Anhang C - Default Funktionstastenbelegungen .....  74 

+Stichwortverzeichnis .............................  75 

diff --git a/system/ruc-terminal/unknown/doc/TINHALTP.PRT b/system/ruc-terminal/unknown/doc/TINHALTP.PRT
new file mode 100644
index 0000000..22b1d0a
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TINHALTP.PRT
@@ -0,0 +1,157 @@
+#type ("elite")##limit (16.2)# 

+#page##--------------------------------- Ende der Seite 0 -----------#

+#center##on("b")#  Inhalt  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#  Inhalt  #ie(3)##off("u")##off("i")##type("elite")# 

+ 

+1.  Einige Worte zuvor ...........................  1 

+2.  Die Hardware .................................  2 

+2.1  Die serielle Schnittstelle ..................  2 

+2.2  Der Reset ...................................  2 

+3.  Die Kommandozeile ............................  3 

+3.1  Tastenfunktionen in der Kommandozeile .......  3 

+3.2  Setup .......................................  4 

+3.3  Die zweite Kommandozeile ....................  4 

+3.4  Die zweite Kommandozeile ....................  6 

+4.  Die Statuszeile ..............................  8 

+4.1  Spoolerstatus ...............................  8 

+4.2  Empfängerstatus .............................  8 

+4.3  Senderstatus ................................  9 

+4.4  Busy - Anzeige ..............................  9 

+4.5  Online/Local - Anzeige ......................  9 

+5.  Die Bedeutung der Tasten .....................  10 

+5.1  Die Funktions- und Steuertasten .............  10 

+5.2  Die TVI-Emulation ...........................  13 

+6.  Der Graphikmodus .............................  16 

+6.1  Allgemeines .................................  16 

+6.2  Koordinaten und Parameterübergabe ...........  16 

+6.2.1  Cursorposition/Fadenkreuz .................  16 

+6.2.2  Binäre oder dezimale Parameter ............  17 

+6.2.2.1  Binäre Parameter ........................  17 

+6.2.2.2  Dezimale Parameter ......................  17 

+6.2.3  Absolute oder relative Koordinaten ........  18 

+6.2.4  Byteparameter .............................  18 

+6.3  Die Graphikparameter ........................  19 

+6.3.1  Strichdicke ...............................  19 

+6.3.2  Farbe/Helligkeit ..........................  19 

+6.3.3  Linientyp .................................  20 

+6.3.3.1  Selbstdefinierte Linientypen (Pattern) ..  20 

+6.3.4  Bitverknüpfungen ..........................  21 

+6.3.5  Multiparametereinstellung .................  22 

+6.4  Graphikseiten ...............................  22 

+6.4.1  Die sichtbare Seite und die Arbeitsseite ..  22 

+6.4.1.1  80-Zeichen Text und Graphik .............  23 

+6.4.2  Aufbau einer Graphikseite .................  23 

+6.4.3  Operationen auf den Graphikseiten .........  24 

+6.4.4  Laden einer Graphikseite vom Host .........  25 

+6.4.5  Graphik auf Diskette speichern/laden ......  26 

+6.5  Textdarstellung im Graphikmodus .............  26 

+6.5.1  Zeichendarstellung ........................  27 

+6.5.1.1  Zeichengröße und Schreibrichtung ........  27 

+6.5.1.2  Dicke, Farbe etc. .......................  28 

+6.5.1.3  Zeichensätze und Attribute ..............  28 

+6.5.1.4  Zeichen überschreiben ...................  29 

+6.5.2  Textkommandos im Graphikmodus .............  30 

+6.5.2.1  Die Cursorpositionierung ................  30 

+6.5.2.2  Löschbefehle ............................  33 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ i 

+#page##--------------------------------- Ende der Seite 1 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+6.6  Die Graphikkommandos ........................  33 

+6.6.1  Draw's und Move's .........................  33 

+6.6.1.1  Punkt setzen ............................  34 

+6.6.1.2  Move-Befehle ............................  34 

+6.6.1.3  Draw-Befehle ............................  35 

+6.6.1.4  Turtle-Graphik ..........................  35 

+6.6.2  Komplexere Zeichenkommandos ...............  36 

+6.6.2.1  Kreise und Kreissegmente ................  36 

+6.6.2.2  Rechtecke ...............................  37 

+6.6.2.3  Bögen und Ellipsen ......................  38 

+6.6.2.4  Gefüllte Flächen ........................  39 

+6.6.2.4.1  Definition des Musters ................  40 

+6.7  Graphikdaten zum Host .......................  40 

+6.7.1  Graphikseiten zum Host ....................  40 

+6.7.2  Cursorposition zum Host ...................  41 

+6.7.3  Einzelne Bits zum Host ....................  41 

+6.7.4  Parameter zum Host ........................  42 

+6.8  Graphikhardcopy .............................  43 

+6.8.1  Der Druckertreiber ........................  43 

+6.8.2  Die Hardcopyparameter .....................  44 

+7.  Die Parameter der seriellen Schnittstelle ....  46 

+7.1  Das Übertragungsformat ......................  46 

+7.2  Die Übertragungsparameter ...................  46 

+7.2.1  Baudrate ..................................  47 

+7.2.2  Datenbits .................................  47 

+7.2.3  Stopbits ..................................  48 

+7.2.4  Paritätsbit ...............................  48 

+7.2.5  Übertragungsfehler ........................  48 

+7.3  Die Flußkontrolle ...........................  48 

+7.3.1  XON/XOFF ..................................  49 

+7.3.2  DTR/DSR ...................................  50 

+7.3.3  RTS/CTS ...................................  50 

+7.4  Echo und Local/Online .......................  51 

+8.  Spezielle Kommandos im Textmodus .............  52 

+8.1  Weitere Cursorpositionierungskommandos ......  52 

+8.2  Cursormodus .................................  53 

+8.3  Zeichensatz einstellen ......................  53 

+8.4  Texthardcopy ................................  54 

+8.5  Zeichen-Attribute ...........................  54 

+8.6  Bildhintergrund hell/dunkel .................  55 

+8.7  Zeichentransfer zum Host ....................  55 

+8.7.1  Ein Zeichen senden ........................  55 

+8.7.2  Eine Zeile senden .........................  56 

+8.7.3  Eine Seite senden .........................  56 

+8.7.4  Terminatorzeichen definieren ..............  56 

+8.7.5  Cursorposition senden .....................  57 

+8.8  Textseite auf Diskette speichern/laden ......  57 

+9.  Verschiedene Steuerkommandos .................  58 

+9.1  Signalton ...................................  58 

+9.2  Keyboardclick ...............................  58 

+9.3  Bildschirmausgabe/Druckerausgabe ............  58 

+9.4  Scroll/Page-Modus ...........................  59 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#ii 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 2 -----------#

+#center##on("b")#  Inhalt  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+9.5  Belegung der Funktionstasten ................  59 

+9.5.1  Local-Escape ..............................  60 

+9.5.2  Makrokommandos ............................  60 

+9.5.3  Startup-Makro .............................  61 

+9.6  Tabellen und Puffer löschen .................  62 

+9.7  Zeitverzögerung .............................  62 

+9.8  Transparentmodi .............................  62 

+9.8.1  Monitor-Modus .............................  62 

+9.8.2  Hexadezimal-Modus .........................  63 

+9.8.3  Einzelne Control-Zeichen anzeigen .........  63 

+Anhang A - ASCII Tabelle, Zeichensätze, Parameter.  64 

+Anhang B - Befehlsübersicht ......................  70 

+Anhang C - Default Funktionstastenbelegungen .....  74 

+Stichwortverzeichnis .............................  75 

+#text end#

+#free(16.11019)#

+ 

+ 

+ iii

+#page##--------------------------------- Ende der Seite 3 -----------#

diff --git a/system/ruc-terminal/unknown/doc/TSTICHP.PRT b/system/ruc-terminal/unknown/doc/TSTICHP.PRT
new file mode 100644
index 0000000..4f2a3e8
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TSTICHP.PRT
@@ -0,0 +1,211 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 75)#

+#page##--------------------------------- Ende der Seite 0 -----------#

+#center##on("b")#  Stichwortverzeichnis  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#  Stichwortverzeichnis  #ie(3)##off("u")##off("i")##type("elite")# 

+ 

+<BACKSPACE> ......................................  14 

+<BOTTOMLEFT> .....................................  32 

+<BOTTOMRIGHT> ....................................  32 

+<CE> .............................................  16 

+<CE> .............................................  31 

+<CTRL G> .........................................  58 

+<CTRL HOME> ......................................  32 

+<CTRL K> .........................................  14 

+<CTRL L> .........................................  14 

+<CTRL N> .........................................  49 

+<CTRL O> .........................................  49 

+<CTRL SHIFT ^> ...................................  14 

+<CTRL SHIFT _> ...................................  14 

+<CTRL V> .........................................  31 

+<CTRL X> .........................................  16 

+<CTRL Z> .........................................  14 

+<CTRL Z> .........................................  33 

+<CTRL Q> .........................................  49 

+<CTRL S> .........................................  49 

+<DELETE> .........................................  32 

+<DOWN> ...........................................  31 

+<ESC> ! ..........................................  24 

+<ESC> $ ..........................................  16 

+<ESC> % ..........................................  16 

+<ESC> & ..........................................  29 

+<ESC> ' ..........................................  29 

+<ESC> ( ..........................................  29 

+<ESC> ( ..........................................  54 

+<ESC> ) ..........................................  29 

+<ESC> ) ..........................................  55 

+<ESC> * ..........................................  33 

+<ESC> + ..........................................  33 

+<ESC> , ..........................................  33 

+<ESC> - ..........................................  41 

+<ESC> . ..........................................  53 

+<ESC> ............................................  32 

+<ESC> / ..........................................  25 

+<ESC> 0 ..........................................  2 

+<ESC> 4 ..........................................  42 

+<ESC> 5 ..........................................  42 

+<ESC> 6 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 8 ..........................................  55 

+<ESC> 9 ..........................................  62 

+<ESC> : ..........................................  33 

+<ESC> ; ..........................................  41 

+<ESC> < ..........................................  58 

+<ESC> <DEL> ......................................  62 

+<ESC> <Macrocode> ................................  61 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 75 

+#page##--------------------------------- Ende der Seite 75 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+<ESC> <SPACE> ....................................  50 

+<ESC> <SPACE> 0 ..................................  10 

+<ESC> <SPACE> 1 ..................................  13 

+<ESC> <SPACE> 6 ..................................  47 

+<ESC> <SPACE> 7 ..................................  47 

+<ESC> <SPACE> <SPACE> ............................  46 

+<ESC> = ..........................................  52 

+<ESC> = ..........................................  57 

+<ESC> > ..........................................  58 

+<ESC> ? ..........................................  57 

+<ESC> @ ..........................................  58 

+<ESC> A ..........................................  59 

+<ESC> D E ........................................  51 

+<ESC> D L ........................................  51 

+<ESC> D O ........................................  51 

+<ESC> E ..........................................  14 

+<ESC> E ..........................................  52 

+<ESC> F ..........................................  63 

+<ESC> G ..........................................  29 

+<ESC> G ..........................................  54 

+<ESC> H ..........................................  59 

+<ESC> I ..........................................  14 

+<ESC> I ..........................................  52 

+<ESC> J ..........................................  38 

+<ESC> K ..........................................  37 

+<ESC> L ..........................................  52 

+<ESC> M ..........................................  52 

+<ESC> N ..........................................  27 

+<ESC> N ..........................................  30 

+<ESC> O 0 ........................................  19 

+<ESC> O 0 ........................................  28 

+<ESC> O 1 ........................................  19 

+<ESC> O 2 ........................................  19 

+<ESC> O 3 ........................................  20 

+<ESC> O 4 ........................................  21 

+<ESC> O 5 ........................................  22 

+<ESC> O 5 ........................................  43 

+<ESC> O 6 ........................................  20 

+<ESC> O 7 ........................................  22 

+<ESC> O 7 ........................................  42 

+<ESC> O 7 ........................................  44 

+<ESC> O 8 ........................................  36 

+<ESC> O 9 ........................................  36 

+<ESC> O : ........................................  40 

+<ESC> P ..........................................  54 

+<ESC> Q ..........................................  14 

+<ESC> Q ..........................................  52 

+<ESC> R ..........................................  14 

+<ESC> R ..........................................  52 

+<ESC> S ..........................................  26 

+<ESC> S ..........................................  57 

+<ESC> T ..........................................  33 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#76 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 76 -----------#

+#center##on("b")#  Stichwortverzeichnis  #off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+<ESC> U ..........................................  62 

+<ESC> W ..........................................  14 

+<ESC> W ..........................................  52 

+<ESC> X ..........................................  63 

+<ESC> X ..........................................  63 

+<ESC> Y ..........................................  33 

+<ESC> Z ..........................................  53 

+<ESC> \ ..........................................  40 

+<ESC> ^ ..........................................  44 

+<ESC> _ ..........................................  41 

+<ESC> ` ..........................................  58 

+<ESC> a ..........................................  58 

+<ESC> b ..........................................  55 

+<ESC> c ..........................................  60 

+<ESC> d ..........................................  55 

+<ESC> e ..........................................  13 

+<ESC> e ..........................................  60 

+<ESC> e ..........................................  61 

+<ESC> j ..........................................  52 

+<ESC> m ..........................................  34 

+<ESC> n ..........................................  35 

+<ESC> o ..........................................  36 

+<ESC> q ..........................................  34 

+<ESC> r ..........................................  35 

+<ESC> s ..........................................  38 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> v ..........................................  34 

+<ESC> w ..........................................  35 

+<ESC> x 1 ........................................  56 

+<ESC> x 4 ........................................  56 

+<ESC> y ..........................................  33 

+<ESC> z ..........................................  28 

+<ESC> z ..........................................  53 

+<ESC> { ..........................................  8 

+<ESC> | ..........................................  39 

+<ESC> } ..........................................  8 

+<ESC> ~ ..........................................  43 

+<HOME> ...........................................  32 

+<LEFT> ...........................................  32 

+<LF> .............................................  14 

+<LOCESC> .........................................  60 

+<RETURN> .........................................  31 

+<RIGHT> ..........................................  32 

+<SHIFT CE> .......................................  31 

+<SHIFT CTRL HOME> ................................  32 

+<SHIFT CTRL HOME> ................................  51 

+<SHIFT HOME> .....................................  32 

+<SHIFT RETURN> ...................................  31 

+<TAB> ............................................  31 

+<UP> .............................................  31 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 77 

+#page##--------------------------------- Ende der Seite 77 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+XOFF .............................................  49 

+XON ..............................................  49 

+#text end#

+#free(21.19019)#

+ 

+ 

+#right#78 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 78 -----------#

diff --git a/system/ruc-terminal/unknown/doc/TSTICHWO.PRT b/system/ruc-terminal/unknown/doc/TSTICHWO.PRT
new file mode 100644
index 0000000..ac6f011
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TSTICHWO.PRT
@@ -0,0 +1,161 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 75)##page (75)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("", "Stichwortverzeichnis  ")# 

+ 

+<BACKSPACE> ......................................  14 

+<BOTTOMLEFT> .....................................  32 

+<BOTTOMRIGHT> ....................................  32 

+<CE> .............................................  16 

+<CE> .............................................  31 

+<CTRL G> .........................................  58 

+<CTRL HOME> ......................................  32 

+<CTRL K> .........................................  14 

+<CTRL L> .........................................  14 

+<CTRL N> .........................................  49 

+<CTRL O> .........................................  49 

+<CTRL SHIFT ^> ...................................  14 

+<CTRL SHIFT _> ...................................  14 

+<CTRL V> .........................................  31 

+<CTRL X> .........................................  16 

+<CTRL Z> .........................................  14 

+<CTRL Z> .........................................  33 

+<CTRL Q> .........................................  49 

+<CTRL S> .........................................  49 

+<DELETE> .........................................  32 

+<DOWN> ...........................................  31 

+<ESC> ! ..........................................  24 

+<ESC> $ ..........................................  16 

+<ESC> % ..........................................  16 

+<ESC> & ..........................................  29 

+<ESC> ' ..........................................  29 

+<ESC> ( ..........................................  29 

+<ESC> ( ..........................................  54 

+<ESC> ) ..........................................  29 

+<ESC> ) ..........................................  55 

+<ESC> * ..........................................  33 

+<ESC> + ..........................................  33 

+<ESC> , ..........................................  33 

+<ESC> - ..........................................  41 

+<ESC> . ..........................................  53 

+<ESC> ............................................  32 

+<ESC> / ..........................................  25 

+<ESC> 0 ..........................................  2 

+<ESC> 4 ..........................................  42 

+<ESC> 5 ..........................................  42 

+<ESC> 6 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 7 ..........................................  56 

+<ESC> 8 ..........................................  55 

+<ESC> 9 ..........................................  62 

+<ESC> : ..........................................  33 

+<ESC> ; ..........................................  41 

+<ESC> < ..........................................  58 

+<ESC> <DEL> ......................................  62 

+<ESC> <Macrocode> ................................  61 

+<ESC> <SPACE> ....................................  50 

+<ESC> <SPACE> 0 ..................................  10 

+<ESC> <SPACE> 1 ..................................  13 

+<ESC> <SPACE> 6 ..................................  47 

+<ESC> <SPACE> 7 ..................................  47 

+<ESC> <SPACE> <SPACE> ............................  46 

+<ESC> = ..........................................  52 

+<ESC> = ..........................................  57 

+<ESC> > ..........................................  58 

+<ESC> ? ..........................................  57 

+<ESC> @ ..........................................  58 

+<ESC> A ..........................................  59 

+<ESC> D E ........................................  51 

+<ESC> D L ........................................  51 

+<ESC> D O ........................................  51 

+<ESC> E ..........................................  14 

+<ESC> E ..........................................  52 

+<ESC> F ..........................................  63 

+<ESC> G ..........................................  29 

+<ESC> G ..........................................  54 

+<ESC> H ..........................................  59 

+<ESC> I ..........................................  14 

+<ESC> I ..........................................  52 

+<ESC> J ..........................................  38 

+<ESC> K ..........................................  37 

+<ESC> L ..........................................  52 

+<ESC> M ..........................................  52 

+<ESC> N ..........................................  27 

+<ESC> N ..........................................  30 

+<ESC> O 0 ........................................  19 

+<ESC> O 0 ........................................  28 

+<ESC> O 1 ........................................  19 

+<ESC> O 2 ........................................  19 

+<ESC> O 3 ........................................  20 

+<ESC> O 4 ........................................  21 

+<ESC> O 5 ........................................  22 

+<ESC> O 5 ........................................  43 

+<ESC> O 6 ........................................  20 

+<ESC> O 7 ........................................  22 

+<ESC> O 7 ........................................  42 

+<ESC> O 7 ........................................  44 

+<ESC> O 8 ........................................  36 

+<ESC> O 9 ........................................  36 

+<ESC> O : ........................................  40 

+<ESC> P ..........................................  54 

+<ESC> Q ..........................................  14 

+<ESC> Q ..........................................  52 

+<ESC> R ..........................................  14 

+<ESC> R ..........................................  52 

+<ESC> S ..........................................  26 

+<ESC> S ..........................................  57 

+<ESC> T ..........................................  33 

+<ESC> U ..........................................  62 

+<ESC> W ..........................................  14 

+<ESC> W ..........................................  52 

+<ESC> X ..........................................  63 

+<ESC> X ..........................................  63 

+<ESC> Y ..........................................  33 

+<ESC> Z ..........................................  53 

+<ESC> \ ..........................................  40 

+<ESC> ^ ..........................................  44 

+<ESC> _ ..........................................  41 

+<ESC> ` ..........................................  58 

+<ESC> a ..........................................  58 

+<ESC> b ..........................................  55 

+<ESC> c ..........................................  60 

+<ESC> d ..........................................  55 

+<ESC> e ..........................................  13 

+<ESC> e ..........................................  60 

+<ESC> e ..........................................  61 

+<ESC> j ..........................................  52 

+<ESC> m ..........................................  34 

+<ESC> n ..........................................  35 

+<ESC> o ..........................................  36 

+<ESC> q ..........................................  34 

+<ESC> r ..........................................  35 

+<ESC> s ..........................................  38 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> u ..........................................  63 

+<ESC> v ..........................................  34 

+<ESC> w ..........................................  35 

+<ESC> x 1 ........................................  56 

+<ESC> x 4 ........................................  56 

+<ESC> y ..........................................  33 

+<ESC> z ..........................................  28 

+<ESC> z ..........................................  53 

+<ESC> { ..........................................  8 

+<ESC> | ..........................................  39 

+<ESC> } ..........................................  8 

+<ESC> ~ ..........................................  43 

+<HOME> ...........................................  32 

+<LEFT> ...........................................  32 

+<LF> .............................................  14 

+<LOCESC> .........................................  60 

+<RETURN> .........................................  31 

+<RIGHT> ..........................................  32 

+<SHIFT CE> .......................................  31 

+<SHIFT CTRL HOME> ................................  32 

+<SHIFT CTRL HOME> ................................  51 

+<SHIFT HOME> .....................................  32 

+<SHIFT RETURN> ...................................  31 

+<TAB> ............................................  31 

+<UP> .............................................  31 

+XOFF .............................................  49 

+XON ..............................................  49 

diff --git a/system/ruc-terminal/unknown/doc/TTAB.PRT b/system/ruc-terminal/unknown/doc/TTAB.PRT
new file mode 100644
index 0000000..e8333d5
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TTAB.PRT
@@ -0,0 +1,510 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 64)##type ("elite")# 

+#page (64)# 

+#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# 

+#h("A.", "Anhang A - ASCII Tabelle, Zeichensätze, Parameter")# 

+ 

+ 

+              Winkel Cur- Byteparameter 

+Dez Hex ASCII  Grad  sor  4    5    6 Taste(n)             Graphikzeichen 

+#linie ("16.0")# 

+  0 00  NUL       0       0    0    0  <SHIFT CTRL @> 

+  1 01  SOH       5       1    1    1  <CTRL A> 

+  2 02  STX      10       2    2    2  <CTRL B> 

+  3 03  ETX      15       3    3    3  <CTRL C> 

+  4 04  EOT      20       4    4    4  <CTRL D> 

+  5 05  ENQ      25       5    5    5  <CTRL E> 

+  6 06  ACK      30       6    6    6  <CTRL F> 

+  7 07  BEL      35       7    7    7  <CTRL G> 

+  8 08  BS       40       8    8    8  <BACKSPACE>  <== 

+  9 09  HT       45       9    9    9  <TAB> 

+ 10 0A  LF       50      10   10   10  <CTRL J> Apple: <DOWN> 

+ 11 0B  VT       55      11   11   11  <CTRL K> Apple: <UP> 

+ 12 0C  FF       60      12   12   12  <CTRL L> TVI: <RIGHT> 

+ 13 0D  CR       65      13   13   13  <RETURN> 

+ 14 0E  SO       70      14   14   14  <CTRL N> 

+ 15 0F  SI       75      15   15   15  <CTRL O> 

+ 16 10  DLE      80       0   16   16  <CTRL P> 

+ 17 11  DC1 XON  85       1   17   17  <CTRL Q> 

+ 18 12  DC2      90       2   18   18  <CTRL R> 

+ 19 13  DC3 XOFF 95       3   19   19  <CTRL S> 

+ 20 14  DC4     100       4   20   20  <CTRL T> 

+ 21 15  NAK     105       5   21   21  ==>   Apple: <RIGHT> 

+ 22 16  SYN     110       6   22   22  <CTRL V> 

+ 23 17  ETB     115       7   23   23  <CTRL W> 

+ 24 18  CAN     120       8   24   24  <CTRL X> <CE> 

+ 25 19  EM      125       9   25   25  <CTRL Y> 

+ 26 1A  SUB     130      10   26   26  <CTRL Z> TVI: <CLEAR> 

+ 27 1B  ESC     135      11   27   27  <ESC> 

+ 28 1C  FS      140      12   28   28  <CTRL \> 

+ 29 1D  GS      145      13   29   29  <CTRL ]> 

+ 30 1E  RS      150      14   30   30  <CTRL ^> TVI: <HOME> 

+ 31 1F  US      155      15   31   31  <CTRL _> TVI: <SHIFT RETURN> 

+ 32 20  SPACE   160   0   0    0   32  <SPACE> 

+ 33 21  !       165   1   1    1   33  ! 

+ 34 22  "       170   2   2    2   34  " 

+ 35 23  #       175   3   3    3   35  # 

+ 36 24  $       180   4   4    4   36  $ 

+ 37 25  %       185   5   5    5   37  % 

+ 38 26  &       190   6   6    6   38  & 

+ 39 27  '       195   7   7    7   39  ' 

+ 40 28  (       200   8   8    8   40  ( 

+ 41 29  )       205   9   9    9   41  ) 

+ 42 2A  *       210  10  10   10   42  * 

+ 43 2B  +       215  11  11   11   43  + 

+ 44 2C  ,       220  12  12   12   44  , 

+ 45 2D  -       225  13  13   13   45  - 

+ 46 2E  .       230  14  14   14   46  . 

+ 47 2F  /       235  15  15   15   47  / 

+ 48 30  0       240  16   0   16   48  0 

+ 49 31  1       245  17   1   17   49  1 

+ 50 32  2       250  18   2   18   50  2 

+ 51 33  3       255  19   3   19   51  3 

+ 52 34  4       260  20   4   20   52  4 

+ 53 35  5       265  21   5   21   53  5 

+ 54 36  6       270  22   6   22   54  6 

+ 55 37  7       275  23   7   23   55  7 

+ 56 38  8       280  24   8   24   56  8 

+ 57 39  9       285  25   9   25   57  9 

+ 58 3A  :       290  26  10   26   58  : 

+ 59 3B  ;       295  27  11   27   59  ; 

+ 60 3C  <       300  28  12   28   60  < 

+ 61 3D  =       305  29  13   29   61  = 

+ 62 3E  >       310  30  14   30   62  > 

+ 63 3F  ?       315  31  15   31   63  ? 

+ 64 40  @       320  32   0    0    0  @ 

+ 65 41  A       325  33   1    1    1  A 

+ 66 42  B       330  34   2    2    2  B 

+ 67 43  C       335  35   3    3    3  C 

+ 68 44  D       340  36   4    4    4  D 

+ 69 45  E       345  37   5    5    5  E 

+ 70 46  F       350  38   6    6    6  F 

+ 71 47  G       355  39   7    7    7  G 

+ 72 48  H         0  40   8    8    8  H 

+ 73 49  I         5  41   9    9    9  I 

+ 74 4A  J        10  42  10   10   10  J 

+ 75 4B  K        15  43  11   11   11  K 

+ 76 4C  L        20  44  12   12   12  L 

+ 77 4D  M        25  45  13   13   13  M 

+ 78 4E  N        30  46  14   14   14  N 

+ 79 4F  O        35  47  15   15   15  O 

+ 80 50  P        40  48   0   16   16  P 

+ 81 51  Q        45  49   1   17   17  Q 

+ 82 52  R        50  50   2   18   18  R 

+ 83 53  S        55  51   3   19   19  S 

+ 84 54  T        60  52   4   20   20  T 

+ 85 55  U        65  53   5   21   21  U 

+ 86 56  V        70  54   6   22   22  V 

+ 87 57  W        75  55   7   23   23  W 

+ 88 58  X        80  56   8   24   24  X 

+ 89 59  Y        85  57   9   25   25  Y 

+ 90 5A  Z        90  58  10   26   26  Z 

+ 91 5B  [   Ä    95  59  11   27   27  [ 

+ 92 5C  \   Ö   100  60  12   28   28  \ 

+ 93 5D  ]   Ü   105  61  13   29   29  ] 

+ 94 5E  ^       110  62  14   30   30  ^ 

+ 95 5F  _       115  63  15   31   31  _ 

+ 96 60  `       120  64   0    0   32  ` 

+ 97 61  a       125  65   1    1   33  a 

+ 98 62  b       130  66   2    2   34  b 

+ 99 63  c       135  67   3    3   35  c 

+100 64  d       140  68   4    4   36  d 

+101 65  e       145  69   5    5   37  e 

+102 66  f       150  70   6    6   38  f 

+103 67  g       155  71   7    7   39  g 

+104 68  h       160  72   8    8   40  h 

+105 69  i       165  73   9    9   41  i 

+106 6A  j       170  74  10   10   42  j 

+107 6B  k       175  75  11   11   43  k 

+108 6C  l       180  76  12   12   44  l 

+109 6D  m       185  77  13   13   45  m 

+110 6E  n       190  78  14   14   46  n 

+111 6F  o       195  79  15   15   47  o 

+112 70  p       200       0   16   48  p 

+113 71  q       205       1   17   49  q 

+114 72  r       210       2   18   50  r 

+115 73  s       215       3   19   51  s 

+116 74  t       220       4   20   52  t 

+117 75  u       225       5   21   53  u 

+118 76  v       230       6   22   54  v 

+119 77  w       235       7   23   55  w 

+120 78  x       240       8   24   56  x 

+121 79  y       245       9   25   57  y 

+122 7A  z       250      10   26   58  z 

+123 7B  {   ä   255      11   27   59  { 

+124 7C  |   ö   260      12   28   60  | 

+125 7D  }   ü   265      13   29   61  } 

+126 7E  ~   ß   270      14   30   62  ~ 

+127 7F  DEL     275      15   31   63  <DELETE> 

+128 80  * NUL   280       0    0    0 

+129 81  * SOH   285       1    1    1  <SHIFT DELETE> 

+130 82  * STX   290       2    2    2  <SHIFT TOPLEFT> # 

+131 83  * ETX   295       3    3    3  <SHIFT TOPRIGHT> # 

+132 84  * EOT   300       4    4    4 

+133 85  * ENQ   305       5    5    5 

+134 86  * ACK   310       6    6    6 

+135 87  * BEL   315       7    7    7 

+136 88  * BS    320       8    8    8  <LEFT> # 

+137 89  * HT    325       9    9    9  <SHIFT TAB> # 

+138 8A  * LF    330      10   10   10  <DOWN> # 

+139 8B  * VT    335      11   11   11  <UP> # 

+140 8C  * FF    340      12   12   12 

+141 8D  * CR    345      13   13   13  <SHIFT RETURN> # 

+142 8E  * SO    350      14   14   14  <TOPLEFT> # 

+143 8F  * SI    355      15   15   15  <TOPRIGHT> # 

+144 90  * DLE     0       0   16   16 

+145 91  * DC1     5       1   17   17 

+146 92  * DC2    10       2   18   18 

+147 93  * DC3    15       3   19   19 

+148 94  * DC4    20       4   20   20 

+149 95  * NAK    25       5   21   21  <RIGHT> # 

+150 96  * SYN    30       6   22   22 

+151 97  * ETB    35       7   23   23 

+152 98  * CAN    40       8   24   24 

+153 99  * EM     45       9   25   25 

+154 9A  * SUB    50      10   26   26 

+155 9B  * ESC    55      11   27   27  <SHIFT ESC> 

+156 9C  * FS     60      12   28   28 

+157 9D  * GS     65      13   29   29 

+158 9E  * RS     70      14   30   30 

+159 9F  * US     75      15   31   31 

+160 A0  * SPACE  80       0    0   32 

+161 A1  * !      85       1    1   33  <CTRL F1> 

+162 A2  * "      90       2    2   34  <CTRL F2> 

+163 A3  * #      95       3    3   35  <CTRL F3> 

+164 A4  * $     100       4    4   36  <CTRL F4> 

+165 A5  * %     105       5    5   37  <CTRL F5> 

+166 A6  * &     110       6    6   38  <CTRL F6> 

+167 A7  * '     115       7    7   39  <CTRL F7> 

+168 A8  * (     120       8    8   40  <CTRL F8> 

+169 A9  * )     125       9    9   41  <CTRL F9> 

+170 AA  * *     130      10   10   42  <CTRL F10> 

+171 AB  * +     135      11   11   43  <CTRL F11> 

+172 AC  * ,     140      12   12   44  <CTRL F12> 

+173 AD  * -     145      13   13   45  <CTRL F13> 

+174 AE  * .     150      14   14   46  <CTRL F14> 

+175 AF  * /     155      15   15   47  <CTRL F15> 

+176 B0  * 0     160       0   16   48 

+177 B1  * 1     165       1   17   49  <SHIFT CTRL F1> 

+178 B2  * 2     170       2   18   50  <SHIFT CTRL F2> 

+179 B3  * 3     175       3   19   51  <SHIFT CTRL F3> 

+180 B4  * 4     180       4   20   52  <SHIFT CTRL F4> 

+181 B5  * 5     185       5   21   53  <SHIFT CTRL F5> 

+182 B6  * 6     190       6   22   54  <SHIFT CTRL F6> 

+183 B7  * 7     195       7   23   55  <SHIFT CTRL F7> 

+184 B8  * 8     200       8   24   56  <SHIFT CTRL F8> 

+185 B9  * 9     205       9   25   57  <SHIFT CTRL F9> 

+186 BA  * :     210      10   26   58  <SHIFT CTRL F10> 

+187 BB  * ;     215      11   27   59  <SHIFT CTRL F11> 

+188 BC  * <     220      12   28   60  <SHIFT CTRL F12> 

+189 BD  * =     225      13   29   61  <SHIFT CTRL F13> 

+190 BE  * >     230      14   30   62  <SHIFT CTRL F14> 

+191 BF  * ?     235      15   31   63  <SHIFT CTRL F15> 

+192 C0  * @     240       0    0    0 

+193 C1  * A     245       1    1    1  <F1> # 

+194 C2  * B     250       2    2    2  <F2> # 

+195 C3  * C     255       3    3    3  <F3> # 

+196 C4  * D     260       4    4    4  <F4> # 

+197 C5  * E     265       5    5    5  <F5> # 

+198 C6  * F     270       6    6    6  <F6> # 

+199 C7  * G     275       7    7    7  <F7> # 

+200 C8  * H     280       8    8    8  <F8> # 

+201 C9  * I     285       9    9    9  <F9> # 

+202 CA  * J     290      10   10   10  <F10> # 

+203 CB  * K     295      11   11   11  <F11> # 

+204 CC  * L     300      12   12   12  <F12> # 

+205 CD  * M     305      13   13   13  <F13> # 

+206 CE  * N     310      14   14   14  <F14> # 

+207 CF  * O     315      15   15   15  <F15> # 

+208 D0  * P     320       0   16   16  <SHIFT HOME> # 

+209 D1  * Q     325       1   17   17  <SHIFT F1> # 

+210 D2  * R     330       2   18   18  <SHIFT F2> # 

+211 D3  * S     335       3   19   19  <SHIFT F3> # 

+212 D4  * T     340       4   20   20  <SHIFT F4> # 

+213 D5  * U     345       5   21   21  <SHIFT F5> # 

+214 D6  * V     350       6   22   22  <SHIFT F6> # 

+215 D7  * W     355       7   23   23  <SHIFT F7> # 

+216 D8  * X       0       8   24   24  <SHIFT F8> # 

+217 D9  * Y       5       9   25   25  <SHIFT F9> # 

+218 DA  * Z      10      10   26   26  <SHIFT F10> # 

+219 DB  * [ * Ä  15      11   27   27  <SHIFT F11> # 

+220 DC  * \ * Ö  20      12   28   28  <SHIFT F12> # 

+221 DD  * ] * Ü  25      13   29   29  <SHIFT F13> # 

+222 DE  * ^      30      14   30   30  <SHIFT F14> # 

+223 DF  * _      35      15   31   31  <SHIFT F15> # 

+224 E0  * `      40       0    0   32 

+225 E1  * a      45       1    1   33  <SHIFT NUM1> # 

+226 E2  * b      50       2    2   34  <SHIFT NUM2> # 

+227 E3  * c      55       3    3   35  <SHIFT NUM3> # 

+228 E4  * d      60       4    4   36  <SHIFT NUM4> # 

+229 E5  * e      65       5    5   37  <SHIFT NUM5> # 

+230 E6  * f      70       6    6   38  <SHIFT NUM6> # 

+231 E7  * g      75       7    7   39  <SHIFT NUM7> # 

+232 E8  * h      80       8    8   40  <SHIFT NUM8> # 

+233 E9  * i      85       9    9   41  <SHIFT NUM9> # 

+234 EA  * j      90      10   10   42  <SHIFT NUM0> # 

+235 EB  * k      95      11   11   43  <SHIFT NUM.> # 

+236 EC  * l     100      12   12   44  <SHIFT NUM+> # 

+237 ED  * m     105      13   13   45  <SHIFT NUM-> # 

+238 EE  * n     110      14   14   46 

+239 EF  * o     115      15   15   47  <SHIFT BOTRIGHT> # 

+240 F0  * p     120       0   16   48 

+241 F1  * q     125       1   17   49 

+242 F2  * r     130       2   18   50 

+243 F3  * s     135       3   19   51 

+244 F4  * t     140       4   20   52 

+245 F5  * u     145       5   21   53 

+246 F6  * v     150       6   22   54 

+247 F7  * w     155       7   23   55 

+248 F8  * x     160       8   24   56 

+249 F9  * y     165       9   25   57 

+250 FA  * z     170      10   26   58 

+251 FB  * { * ä 175      11   27   59 

+252 FC  * | * ö 180      12   28   60 

+253 FD  * } * ü 185      13   29   61 

+254 FE  * ~ * ß 190      14   30   62 

+255 FF  * DEL   195      15   31   63 

+ 

+Beim Apple-Keyboard können alle Codes > 127 auch mit der Open-Apple Taste

+und einem ASCII-Zeichen zusammen erzeugt werden. 

+Die mit # gekennzeichneten Tasten erzeugen im TVI-Modus nicht diesen Code. 

+Die mit * gekennzeichneten ASCII-Zeichen werden auf dem Bildschirm invers

+dargestellt. 

+ 

+#page# 

+#h("B.", "Anhang B - Befehlsübersicht")# 

+ 

+ 

+#on("u")#Controlkommandos:#off("u")# 

+ 

+Hex ASCII Taste(n)                      Funktion 

+#linie ("16.0")# 

+07  BEL  <CTRL G>                       Signalton 

+08  BS   <BACKSPACE>  <==               Backspace, Cursor Left 

+09  HT   <TAB>                          Tabulator, 8 Spalten 

+0A  LF   <CTRL J> Apple: <DOWN>         Zeilenvorschub, ggf. Scroll/Page 

+0B  VT   <CTRL K> Apple: <UP>           Cursor hoch 

+0C  FF   <CTRL L> TVI: <RIGHT>          Cursor rechts 

+0D  CR   <RETURN>                       Waagenrücklauf, ohne Linefeed 

+0E  SO   <CTRL N>                       XON/XOFF Protokoll ausschalten 

+0F  SI   <CTRL O>                       XON/XOFF Protokoll einschalten 

+11  DC1  <CTRL Q>                       XON 

+13  DC3  <CTRL S>                       XOFF 

+15  NAK  <CTRL U> ==> Apple: <RIGHT>    Cursor rechts 

+16  SYN  <CTRL V>                       Cursor runter (ohne Scroll/Page) 

+17  CAN  <CTRL X> <CE>                  Graphikmodus: Fadenkreuz an/aus 

+1A  SUB  <CTRL Z> TVI: <CLEAR>          Bildschirm löschen & Cursor Home 

+1B  ESC  <ESC>                          Escape-Sequenz einleiten 

+1E  RS   <CTRL ^> TVI: <HOME>           Cursor Home 

+1F  US   <CTRL _> TVI: <SHIFT RETURN>   Zum nächsten Zeilenanfang, ggf.

+                                        Scroll/Page 

+ 

+ 

+Escape-Sequenzen, thematisch sortiert 

+------------------------------------- 

+ 

+a.) Betriebsmodi: 

+ 

+ESC $                 Graphikmodus einschalten 

+ESC %                 Textmodus einschalten 

+ESC H                 Autoscroll/Pagemode 

+ESC U                 Monitormode einschalten 

+ESC X                 Monitormode/Hexmode ausschalten 

+ESC c                 Funktionstastencode/Funktionstastenstring 

+ESC u                 Hexmode ein-/ausschalten, Monitormode ausschalten 

+ 

+ 

+b.) Editkommandos 

+ 

+ESC *                 Text oder Graphikbildschirm löschen und Cursor Home 

+ESC +                                        " 

+ESC ,                                        " 

+ESC :                                        " 

+ESC E                 Zeile einfügen (im Textmodus) 

+ESC I                 Rückwärtstabulator (8 Spalten, im Textmodus) 

+ESC L                 Zeile einfügen (im Textmodus) 

+ESC M                 Zeile löschen (im Textmodus) 

+ESC Q                 Zeichen einfügen (im Textmodus) 

+ESC R                 Zeile löschen (im Textmodus) 

+ESC T                 Zeile ab Cursorposition bis zum Zeilenende löschen 

+ESC W                 Zeichen löschen (im Textmodus) 

+ESC Y                 Seite ab Cursorposition bis zum Seitenende löschen 

+ESC j                 Umgekehrter Zeilenvorschub 

+ESC t                 Zeile ab Cursor bis Zeilenende löschen (im Textmodus) 

+ 

+ 

+c.) Sendekommandos 

+ 

+ESC -                 Farbe, Zustand, In-Window-Bit bei Cursorpos senden 

+ESC 4                 Nummer der sichtbaren und der Arbeitsseite senden 

+ESC 5                 Graphikparameter (Dicke,Farbe,Bitverknüpfung) senden 

+ESC 6                 Aktuelle Textzeile senden 

+ESC 7                 Ganze Textseite senden 

+ESC 8                 Zeichen an der Cursorposition senden 

+ESC \ <ll><lh><al><ah>Aktuelle Graphikseite senden (oder Teile) 

+ESC ;                 Position des Graphikcursors senden 

+ESC ?                 Position des Textcursors senden 

+ESC _                 Graphikbyte bei Graphikcursorposition senden 

+ESC x 1 <l><m>        Zeilenbegrenzer für <ESC> 6 und <ESC> 7 einstellen 

+ESC x 4 <p>           Seitenbegrenzer für <ESC> 7 einstellen 

+ 

+ 

+d.) Übertragungskommandos 

+ 

+ESC SPACE SPACE <p>   Baudrate, Stopbits, Datenbits, Parity einstellen 

+ESC SPACE 0           Basis/Apple Keyboardcodes, keine Emulation 

+ESC SPACE 1           TVI - Emulation 

+ESC SPACE 2           Keine Hardware Flußkontrolle 

+ESC SPACE 3           RTS/CTS Flußkontrolle 

+ESC SPACE 4           DTR/DSR Flußkontrolle 

+ESC SPACE 5           RTS/CTS und DTR/DSR Flußkontrolle 

+ESC SPACE 6           8. Datenbit ist 0 

+ESC SPACE 7           8. Datenbit vorhanden 

+ESC D L               Local-Modus 

+ESC D E               Online-Modus mit Echo 

+ESC D O               Online-Modus ohne Echo 

+ 

+ 

+e.) Bildschirm/Druckerausgabe 

+ 

+ESC @                 Empfangsdaten auf Drucker ausgeben 

+ESC A                 Empfangsdaten nicht auf Drucker ausgeben 

+ESC P                 Hardcopy der Textseite 

+ESC ^ <p>             Hardcopy der aktuellen Graphikseite 

+ESC `                 Empfangsdaten nicht auf dem Bildschirm anzeigen 

+ESC a                 Empfangsdaten auf dem Bildschirm anzeigen 

+ESC ~ <n><l><p.>      Definition d.Druckertreiberstrings f.Graphikhardcopy 

+ 

+ 

+f.) Cursor/Cursor Adressierung 

+ 

+ESC . 0               Cursor aus 

+ESC . 1               Cursor blinkend 

+ESC . 2               Cursor an, nicht blinkend 

+ESC = <y+32><x+32>    Cursor auf Adresse positionieren 

+ESC Z                 Cursor an/aus 

+ 

+ 

+g.) Attribute 

+ 

+ESC (                 Normale Zeichen 

+ESC )                 Textmodus: Inversschrift, Graphik: Kursivschrift 

+ESC G 0               Normale Schrift 

+ESC G 1               Unsichtbare Schrift, Leerzeichen 

+ESC G 4               Inverse Schrift 

+ESC G 5               Unsichtbare Schrift, inverse Leerzeichen 

+ESC b                 Schwarze Schrift auf hellem Grund (nur im Textmodus) 

+ESC d                 Helle Schrift auf dunklem Grund, (nur im Textmodus) 

+ESC z <n>             Zeichensatz einstellen 

+ 

+ 

+h.) Text in Graphiken 

+ 

+ESC &                 Graphikzeichen ersetzen darunterliegende 

+ESC '                 Graphikzeichen überschreiben darunterliegende 

+ESC N <b><h><w>       Zeichenbreite, -höhe und Schreibrichtung einstellen 

+ 

+ 

+i.) Graphikzeichenkommandos 

+ 

+ESC J <b, h;>         Relatives Rechteck zeichnen 

+ESC K <r, s;>         Kreis(segmente) mit dem Radius <r> zeichnen 

+ESC m <x, y;>         Absoluten Punkt bei (x, y) zeichnen 

+ESC n <l, w;>         Turtle Draw/Move <l> ist Länge, <w> ist Winkel 

+ESC o                 Turtle Penup/Pendown 

+ESC q <x, y;>         Relativer Move 

+ESC r <x, y;>         Relativer Draw 

+ESC s <xr,yr,aw,ew;>  Ellipsenbogen(Radien xr,yr) v.<aw> bis <ew> zeichnen 

+ESC v <x, y;>         Absoluter Move nach (x, y) 

+ESC w <x, y;>         Absoluter Draw nach (x, y) 

+ 

+ 

+j.) Verschiede Graphikkommandos 

+ 

+ESC ! <p>             Graphikseiten mischen, kopieren, trennen, invertieren 

+ESC / <ll><lh><al><ah><p...> Graphikseite vom Host laden 

+ESC O 0               Graphikparameter auf Default 

+ESC O 1 <d>           Strichdicke setzen 

+ESC O 2 <f>           Farbe/Helligkeit einstellen 

+ESC O 3 <p>           Linientyp (Punkt/Strichmuster) einstellen 

+ESC O 4 <p>           Bitverknüpfung setzen (0=OR, 1=AND, 2=XOR, 3=COPY) 

+ESC O 5 <p>           Farbe, Dicke, Bitverknüpfung zusammen einstellen 

+ESC O 6 <pl><ph>      Benutzerdefinierbares Linienmuster einstellen 

+ESC O 7 <p>           Arbeitsseite, sichtbare Seite u.Mixedmode einstellen 

+ESC O 8 <p>           Turtle Penup/Pendown und Eraser/Drawer einstellen 

+ESC O 9               Turtle Bildmitte, Richtung nach oben, Pendown, Drawer 

+ESC O : <b1..b8>      Benutzerdefinierbares Füllmuster einstellen 

+ESC y                 Graphikseite löschen und Cursor nach (0, 0) 

+ESC | <n>             Fläche füllen/löschen mit dem Muster Nummer <n> 

+ 

+ 

+k.) Verschiedene und spezielle Funktionen 

+ 

+ESC 0                 Terminalprogramm initialisieren (Softwarereset) 

+ESC 9 <d>             Zeitverzögerung ca. <d> * 2 ms 

+ESC <                 Keyboardclick ausschalten 

+ESC >                 Keyboardclick einschalten 

+ESC F <c>             Controlcharacter darstellen 

+ESC e <d...><t>       Funktionstaste <t> mit Daten <d...> belegen 

+ESC {                 Statuszeile aus (24. Textzeile sichtbar) 

+ESC }                 Statuszeile an (24. Textzeile unsichtbar) 

+ESC S <n>             Graphik/Textseite von/auf Diskette laden/speichern 

+ESC DEL 1             Tastenbelegungen löschen 

+ESC DEL 2             Druckerpuffer löschen 

+ESC DEL 3             Empfangspuffer löschen 

+ESC DEL 4             Sendepuffer löschen 

+ 

+#page# 

+#h("C.", "Anhang C - Default Funktionstastenbelegungen")# 

+ 

+ 

+Bemerkung zur Schreibweise: 

+<#40> bezeichnet den ASCII-Code für '(', also den ASCII-Code 40 (dezimal). 

+<LESC> bezeichnet den Code Hex 9B für Local Escape, damit diese Tastenfunk-

+tionen sowohl im Local- als auch im Onlinemodus ausgeführt werden können. 

+ 

+a.) Zehnerblock mit <SHIFT> 

+ 

+Die Anordnung der Zifferntasten entspricht einem "Cursorblock" mit acht

+Richtungen. Die Taste <SHIFT 5> zeigt nur das Fadenkreuz, d.h. die Position

+des Graphikcursors bleibt unverändert. Bei allen anderen Zifferntasten än-

+dert sich die Position des Graphikcursors und das Fadenkreuz wird kurz

+sichtbar. Bis auf die Help-Taste <SHIFT F4> können alle Tasten auch im On-

+line-Modus aufgerufen werden. 

+ 

+Die Tastenbelegungen im einzelnen: 

+ 

+Taste    Hex-Code Code-Sequenz 

+#linie ("16.0")# 

+<SHIFT 1>  E1  <LESC> q-1,-1; <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 2>  E2  <LESC> q0,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 3>  E3  <LESC> q1,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 4>  E4  <LESC> q-1,0;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 5>  E5  <LESC> <CTRL X><LESC> 9 <#127> <LESC> <CTRL X> 

+<SHIFT 6>  E6  <LESC> q1,0;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 7>  E7  <LESC> q-1,1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 8>  E8  <LESC> q0,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 9>  E9  <LESC> q1,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+ 

+Terminalinitialisierung mit <SHIFT BOTTOMRIGHT>: 

+            EF  (Cursorpositionierung und Einschaltmeldung) 

+ 

+ 

+b.) Die Funktionstasten mit <SHIFT> 

+ 

+Taste    Hex-Code Code-Sequenz                     Bedeutung 

+#linie ("16.0")# 

+<SHIFT F1>  D1  <LESC> $ <LESC> O70                Graphikseite 1 

+<SHIFT F2>  D2  <LESC> $ <LESC> O73                Graphikseite 2 

+<SHIFT F3>  D3  <LESC> %                           Textseite 

+<SHIFT F4>  D4  <ESC>SW<#26> H e l p s c r e e n (a..f): <ESC>S<#81> 

+                <ESC>9<#81> <ESC>SG                Help-Bilschirm anzeigen 

+<SHIFT F8>  D8  <LESC> O41                         Linien schwarz (löschen) 

+<SHIFT F9>  D9  <LESC> O40                         Linien weiß (sichtbar) 

+<SHIFT F10> DA  <LESC> O12 <LESC> N <#12><#20><#0> Große und dicke Schrift 

+<SHIFT F11> DB  <LESC> O11 <LESC> N <#0><#0><#0>   Normal dünne Schrift 

+<SHIFT F12> DC  <LESC> G4                          Kursiv/Invers an 

+<SHIFT F13> DD  <LESC> G0                          Kursiv/Invers aus 

+<SHIFT F14> DE  <LESC> ^0                          Graphikhardcopy 

+<SHIFT F15> DF  <LESC> P                           Texthardcopy 

+ 

diff --git a/system/ruc-terminal/unknown/doc/TTABP.PRT b/system/ruc-terminal/unknown/doc/TTABP.PRT
new file mode 100644
index 0000000..f5b9b57
--- /dev/null
+++ b/system/ruc-terminal/unknown/doc/TTABP.PRT
@@ -0,0 +1,666 @@
+#type ("elite")##limit (16.2)# 

+#pagenr (""224"", 64)##type ("elite")# 

+#page##--------------------------------- Ende der Seite 0 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+              Winkel Cur- Byteparameter 

+Dez Hex ASCII  Grad  sor  4    5    6 Taste(n)             Graphikzeichen 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+  0 00  NUL       0       0    0    0  <SHIFT CTRL @> 

+  1 01  SOH       5       1    1    1  <CTRL A> 

+  2 02  STX      10       2    2    2  <CTRL B> 

+  3 03  ETX      15       3    3    3  <CTRL C> 

+  4 04  EOT      20       4    4    4  <CTRL D> 

+  5 05  ENQ      25       5    5    5  <CTRL E> 

+  6 06  ACK      30       6    6    6  <CTRL F> 

+  7 07  BEL      35       7    7    7  <CTRL G> 

+  8 08  BS       40       8    8    8  <BACKSPACE>  <== 

+  9 09  HT       45       9    9    9  <TAB> 

+ 10 0A  LF       50      10   10   10  <CTRL J> Apple: <DOWN> 

+ 11 0B  VT       55      11   11   11  <CTRL K> Apple: <UP> 

+ 12 0C  FF       60      12   12   12  <CTRL L> TVI: <RIGHT> 

+ 13 0D  CR       65      13   13   13  <RETURN> 

+ 14 0E  SO       70      14   14   14  <CTRL N> 

+ 15 0F  SI       75      15   15   15  <CTRL O> 

+ 16 10  DLE      80       0   16   16  <CTRL P> 

+ 17 11  DC1 XON  85       1   17   17  <CTRL Q> 

+ 18 12  DC2      90       2   18   18  <CTRL R> 

+ 19 13  DC3 XOFF 95       3   19   19  <CTRL S> 

+ 20 14  DC4     100       4   20   20  <CTRL T> 

+ 21 15  NAK     105       5   21   21  ==>   Apple: <RIGHT> 

+ 22 16  SYN     110       6   22   22  <CTRL V> 

+ 23 17  ETB     115       7   23   23  <CTRL W> 

+ 24 18  CAN     120       8   24   24  <CTRL X> <CE> 

+ 25 19  EM      125       9   25   25  <CTRL Y> 

+ 26 1A  SUB     130      10   26   26  <CTRL Z> TVI: <CLEAR> 

+ 27 1B  ESC     135      11   27   27  <ESC> 

+ 28 1C  FS      140      12   28   28  <CTRL \> 

+ 29 1D  GS      145      13   29   29  <CTRL ]> 

+ 30 1E  RS      150      14   30   30  <CTRL ^> TVI: <HOME> 

+ 31 1F  US      155      15   31   31  <CTRL _> TVI: <SHIFT RETURN> 

+ 32 20  SPACE   160   0   0    0   32  <SPACE> 

+ 33 21  !       165   1   1    1   33  ! 

+ 34 22  "       170   2   2    2   34  " 

+ 35 23  #       175   3   3    3   35  # 

+ 36 24  $       180   4   4    4   36  $ 

+ 37 25  %       185   5   5    5   37  % 

+ 38 26  &       190   6   6    6   38  & 

+ 39 27  '       195   7   7    7   39  ' 

+ 40 28  (       200   8   8    8   40  ( 

+ 41 29  )       205   9   9    9   41  ) 

+ 42 2A  *       210  10  10   10   42  * 

+ 43 2B  +       215  11  11   11   43  + 

+ 44 2C  ,       220  12  12   12   44  , 

+ 45 2D  -       225  13  13   13   45  - 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#64 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 64 -----------#

+#center##on("b")#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+ 46 2E  .       230  14  14   14   46  . 

+ 47 2F  /       235  15  15   15   47  / 

+ 48 30  0       240  16   0   16   48  0 

+ 49 31  1       245  17   1   17   49  1 

+ 50 32  2       250  18   2   18   50  2 

+ 51 33  3       255  19   3   19   51  3 

+ 52 34  4       260  20   4   20   52  4 

+ 53 35  5       265  21   5   21   53  5 

+ 54 36  6       270  22   6   22   54  6 

+ 55 37  7       275  23   7   23   55  7 

+ 56 38  8       280  24   8   24   56  8 

+ 57 39  9       285  25   9   25   57  9 

+ 58 3A  :       290  26  10   26   58  : 

+ 59 3B  ;       295  27  11   27   59  ; 

+ 60 3C  <       300  28  12   28   60  < 

+ 61 3D  =       305  29  13   29   61  = 

+ 62 3E  >       310  30  14   30   62  > 

+ 63 3F  ?       315  31  15   31   63  ? 

+ 64 40  @       320  32   0    0    0  @ 

+ 65 41  A       325  33   1    1    1  A 

+ 66 42  B       330  34   2    2    2  B 

+ 67 43  C       335  35   3    3    3  C 

+ 68 44  D       340  36   4    4    4  D 

+ 69 45  E       345  37   5    5    5  E 

+ 70 46  F       350  38   6    6    6  F 

+ 71 47  G       355  39   7    7    7  G 

+ 72 48  H         0  40   8    8    8  H 

+ 73 49  I         5  41   9    9    9  I 

+ 74 4A  J        10  42  10   10   10  J 

+ 75 4B  K        15  43  11   11   11  K 

+ 76 4C  L        20  44  12   12   12  L 

+ 77 4D  M        25  45  13   13   13  M 

+ 78 4E  N        30  46  14   14   14  N 

+ 79 4F  O        35  47  15   15   15  O 

+ 80 50  P        40  48   0   16   16  P 

+ 81 51  Q        45  49   1   17   17  Q 

+ 82 52  R        50  50   2   18   18  R 

+ 83 53  S        55  51   3   19   19  S 

+ 84 54  T        60  52   4   20   20  T 

+ 85 55  U        65  53   5   21   21  U 

+ 86 56  V        70  54   6   22   22  V 

+ 87 57  W        75  55   7   23   23  W 

+ 88 58  X        80  56   8   24   24  X 

+ 89 59  Y        85  57   9   25   25  Y 

+ 90 5A  Z        90  58  10   26   26  Z 

+ 91 5B  [   Ä    95  59  11   27   27  [ 

+ 92 5C  \   Ö   100  60  12   28   28  \ 

+ 93 5D  ]   Ü   105  61  13   29   29  ] 

+ 94 5E  ^       110  62  14   30   30  ^ 

+ 95 5F  _       115  63  15   31   31  _ 

+ 96 60  `       120  64   0    0   32  ` 

+ 97 61  a       125  65   1    1   33  a 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 65 

+#page##--------------------------------- Ende der Seite 65 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+ 98 62  b       130  66   2    2   34  b 

+ 99 63  c       135  67   3    3   35  c 

+100 64  d       140  68   4    4   36  d 

+101 65  e       145  69   5    5   37  e 

+102 66  f       150  70   6    6   38  f 

+103 67  g       155  71   7    7   39  g 

+104 68  h       160  72   8    8   40  h 

+105 69  i       165  73   9    9   41  i 

+106 6A  j       170  74  10   10   42  j 

+107 6B  k       175  75  11   11   43  k 

+108 6C  l       180  76  12   12   44  l 

+109 6D  m       185  77  13   13   45  m 

+110 6E  n       190  78  14   14   46  n 

+111 6F  o       195  79  15   15   47  o 

+112 70  p       200       0   16   48  p 

+113 71  q       205       1   17   49  q 

+114 72  r       210       2   18   50  r 

+115 73  s       215       3   19   51  s 

+116 74  t       220       4   20   52  t 

+117 75  u       225       5   21   53  u 

+118 76  v       230       6   22   54  v 

+119 77  w       235       7   23   55  w 

+120 78  x       240       8   24   56  x 

+121 79  y       245       9   25   57  y 

+122 7A  z       250      10   26   58  z 

+123 7B  {   ä   255      11   27   59  { 

+124 7C  |   ö   260      12   28   60  | 

+125 7D  }   ü   265      13   29   61  } 

+126 7E  ~   ß   270      14   30   62  ~ 

+127 7F  DEL     275      15   31   63  <DELETE> 

+128 80  * NUL   280       0    0    0 

+129 81  * SOH   285       1    1    1  <SHIFT DELETE> 

+130 82  * STX   290       2    2    2  <SHIFT TOPLEFT> # 

+131 83  * ETX   295       3    3    3  <SHIFT TOPRIGHT> # 

+132 84  * EOT   300       4    4    4 

+133 85  * ENQ   305       5    5    5 

+134 86  * ACK   310       6    6    6 

+135 87  * BEL   315       7    7    7 

+136 88  * BS    320       8    8    8  <LEFT> # 

+137 89  * HT    325       9    9    9  <SHIFT TAB> # 

+138 8A  * LF    330      10   10   10  <DOWN> # 

+139 8B  * VT    335      11   11   11  <UP> # 

+140 8C  * FF    340      12   12   12 

+141 8D  * CR    345      13   13   13  <SHIFT RETURN> # 

+142 8E  * SO    350      14   14   14  <TOPLEFT> # 

+143 8F  * SI    355      15   15   15  <TOPRIGHT> # 

+144 90  * DLE     0       0   16   16 

+145 91  * DC1     5       1   17   17 

+146 92  * DC2    10       2   18   18 

+147 93  * DC3    15       3   19   19 

+148 94  * DC4    20       4   20   20 

+149 95  * NAK    25       5   21   21  <RIGHT> # 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#66 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 66 -----------#

+#center##on("b")#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+150 96  * SYN    30       6   22   22 

+151 97  * ETB    35       7   23   23 

+152 98  * CAN    40       8   24   24 

+153 99  * EM     45       9   25   25 

+154 9A  * SUB    50      10   26   26 

+155 9B  * ESC    55      11   27   27  <SHIFT ESC> 

+156 9C  * FS     60      12   28   28 

+157 9D  * GS     65      13   29   29 

+158 9E  * RS     70      14   30   30 

+159 9F  * US     75      15   31   31 

+160 A0  * SPACE  80       0    0   32 

+161 A1  * !      85       1    1   33  <CTRL F1> 

+162 A2  * "      90       2    2   34  <CTRL F2> 

+163 A3  * #      95       3    3   35  <CTRL F3> 

+164 A4  * $     100       4    4   36  <CTRL F4> 

+165 A5  * %     105       5    5   37  <CTRL F5> 

+166 A6  * &     110       6    6   38  <CTRL F6> 

+167 A7  * '     115       7    7   39  <CTRL F7> 

+168 A8  * (     120       8    8   40  <CTRL F8> 

+169 A9  * )     125       9    9   41  <CTRL F9> 

+170 AA  * *     130      10   10   42  <CTRL F10> 

+171 AB  * +     135      11   11   43  <CTRL F11> 

+172 AC  * ,     140      12   12   44  <CTRL F12> 

+173 AD  * -     145      13   13   45  <CTRL F13> 

+174 AE  * .     150      14   14   46  <CTRL F14> 

+175 AF  * /     155      15   15   47  <CTRL F15> 

+176 B0  * 0     160       0   16   48 

+177 B1  * 1     165       1   17   49  <SHIFT CTRL F1> 

+178 B2  * 2     170       2   18   50  <SHIFT CTRL F2> 

+179 B3  * 3     175       3   19   51  <SHIFT CTRL F3> 

+180 B4  * 4     180       4   20   52  <SHIFT CTRL F4> 

+181 B5  * 5     185       5   21   53  <SHIFT CTRL F5> 

+182 B6  * 6     190       6   22   54  <SHIFT CTRL F6> 

+183 B7  * 7     195       7   23   55  <SHIFT CTRL F7> 

+184 B8  * 8     200       8   24   56  <SHIFT CTRL F8> 

+185 B9  * 9     205       9   25   57  <SHIFT CTRL F9> 

+186 BA  * :     210      10   26   58  <SHIFT CTRL F10> 

+187 BB  * ;     215      11   27   59  <SHIFT CTRL F11> 

+188 BC  * <     220      12   28   60  <SHIFT CTRL F12> 

+189 BD  * =     225      13   29   61  <SHIFT CTRL F13> 

+190 BE  * >     230      14   30   62  <SHIFT CTRL F14> 

+191 BF  * ?     235      15   31   63  <SHIFT CTRL F15> 

+192 C0  * @     240       0    0    0 

+193 C1  * A     245       1    1    1  <F1> # 

+194 C2  * B     250       2    2    2  <F2> # 

+195 C3  * C     255       3    3    3  <F3> # 

+196 C4  * D     260       4    4    4  <F4> # 

+197 C5  * E     265       5    5    5  <F5> # 

+198 C6  * F     270       6    6    6  <F6> # 

+199 C7  * G     275       7    7    7  <F7> # 

+200 C8  * H     280       8    8    8  <F8> # 

+201 C9  * I     285       9    9    9  <F9> # 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+ 67 

+#page##--------------------------------- Ende der Seite 67 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+202 CA  * J     290      10   10   10  <F10> # 

+203 CB  * K     295      11   11   11  <F11> # 

+204 CC  * L     300      12   12   12  <F12> # 

+205 CD  * M     305      13   13   13  <F13> # 

+206 CE  * N     310      14   14   14  <F14> # 

+207 CF  * O     315      15   15   15  <F15> # 

+208 D0  * P     320       0   16   16  <SHIFT HOME> # 

+209 D1  * Q     325       1   17   17  <SHIFT F1> # 

+210 D2  * R     330       2   18   18  <SHIFT F2> # 

+211 D3  * S     335       3   19   19  <SHIFT F3> # 

+212 D4  * T     340       4   20   20  <SHIFT F4> # 

+213 D5  * U     345       5   21   21  <SHIFT F5> # 

+214 D6  * V     350       6   22   22  <SHIFT F6> # 

+215 D7  * W     355       7   23   23  <SHIFT F7> # 

+216 D8  * X       0       8   24   24  <SHIFT F8> # 

+217 D9  * Y       5       9   25   25  <SHIFT F9> # 

+218 DA  * Z      10      10   26   26  <SHIFT F10> # 

+219 DB  * [ * Ä  15      11   27   27  <SHIFT F11> # 

+220 DC  * \ * Ö  20      12   28   28  <SHIFT F12> # 

+221 DD  * ] * Ü  25      13   29   29  <SHIFT F13> # 

+222 DE  * ^      30      14   30   30  <SHIFT F14> # 

+223 DF  * _      35      15   31   31  <SHIFT F15> # 

+224 E0  * `      40       0    0   32 

+225 E1  * a      45       1    1   33  <SHIFT NUM1> # 

+226 E2  * b      50       2    2   34  <SHIFT NUM2> # 

+227 E3  * c      55       3    3   35  <SHIFT NUM3> # 

+228 E4  * d      60       4    4   36  <SHIFT NUM4> # 

+229 E5  * e      65       5    5   37  <SHIFT NUM5> # 

+230 E6  * f      70       6    6   38  <SHIFT NUM6> # 

+231 E7  * g      75       7    7   39  <SHIFT NUM7> # 

+232 E8  * h      80       8    8   40  <SHIFT NUM8> # 

+233 E9  * i      85       9    9   41  <SHIFT NUM9> # 

+234 EA  * j      90      10   10   42  <SHIFT NUM0> # 

+235 EB  * k      95      11   11   43  <SHIFT NUM.> # 

+236 EC  * l     100      12   12   44  <SHIFT NUM+> # 

+237 ED  * m     105      13   13   45  <SHIFT NUM-> # 

+238 EE  * n     110      14   14   46 

+239 EF  * o     115      15   15   47  <SHIFT BOTRIGHT> # 

+240 F0  * p     120       0   16   48 

+241 F1  * q     125       1   17   49 

+242 F2  * r     130       2   18   50 

+243 F3  * s     135       3   19   51 

+244 F4  * t     140       4   20   52 

+245 F5  * u     145       5   21   53 

+246 F6  * v     150       6   22   54 

+247 F7  * w     155       7   23   55 

+248 F8  * x     160       8   24   56 

+249 F9  * y     165       9   25   57 

+250 FA  * z     170      10   26   58 

+251 FB  * { * ä 175      11   27   59 

+252 FC  * | * ö 180      12   28   60 

+253 FD  * } * ü 185      13   29   61 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#68 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 68 -----------#

+#center##on("b")#A.  Anhang A - ASCII Tabelle, Zeichensätze, Parameter#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+254 FE  * ~ * ß 190      14   30   62 

+255 FF  * DEL   195      15   31   63 

+ 

+Beim Apple-Keyboard können alle Codes > 127 auch mit der Open-Apple Taste

+und einem ASCII-Zeichen zusammen erzeugt werden. 

+Die mit # gekennzeichneten Tasten erzeugen im TVI-Modus nicht diesen Code. 

+Die mit * gekennzeichneten ASCII-Zeichen werden auf dem Bildschirm invers

+dargestellt. 

+ 

+#text end#

+#free(18.22685)#

+ 

+ 

+ 69 

+#page##--------------------------------- Ende der Seite 69 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#B.  Anhang B - Befehlsübersicht#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+#on("u")#Controlkommandos:#off("u")# 

+ 

+Hex ASCII Taste(n)                      Funktion 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+07  BEL  <CTRL G>                       Signalton 

+08  BS   <BACKSPACE>  <==               Backspace, Cursor Left 

+09  HT   <TAB>                          Tabulator, 8 Spalten 

+0A  LF   <CTRL J> Apple: <DOWN>         Zeilenvorschub, ggf. Scroll/Page 

+0B  VT   <CTRL K> Apple: <UP>           Cursor hoch 

+0C  FF   <CTRL L> TVI: <RIGHT>          Cursor rechts 

+0D  CR   <RETURN>                       Waagenrücklauf, ohne Linefeed 

+0E  SO   <CTRL N>                       XON/XOFF Protokoll ausschalten 

+0F  SI   <CTRL O>                       XON/XOFF Protokoll einschalten 

+11  DC1  <CTRL Q>                       XON 

+13  DC3  <CTRL S>                       XOFF 

+15  NAK  <CTRL U> ==> Apple: <RIGHT>    Cursor rechts 

+16  SYN  <CTRL V>                       Cursor runter (ohne Scroll/Page) 

+17  CAN  <CTRL X> <CE>                  Graphikmodus: Fadenkreuz an/aus 

+1A  SUB  <CTRL Z> TVI: <CLEAR>          Bildschirm löschen & Cursor Home 

+1B  ESC  <ESC>                          Escape-Sequenz einleiten 

+1E  RS   <CTRL ^> TVI: <HOME>           Cursor Home 

+1F  US   <CTRL _> TVI: <SHIFT RETURN>   Zum nächsten Zeilenanfang, ggf.

+                                        Scroll/Page 

+ 

+ 

+Escape-Sequenzen, thematisch sortiert 

+------------------------------------- 

+ 

+a.) Betriebsmodi: 

+ 

+ESC $                 Graphikmodus einschalten 

+ESC %                 Textmodus einschalten 

+ESC H                 Autoscroll/Pagemode 

+ESC U                 Monitormode einschalten 

+ESC X                 Monitormode/Hexmode ausschalten 

+ESC c                 Funktionstastencode/Funktionstastenstring 

+ESC u                 Hexmode ein-/ausschalten, Monitormode ausschalten 

+ 

+ 

+#text end#

+#free(4.256852)#

+ 

+ 

+#right#70 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 70 -----------#

+#center##on("b")#B.  Anhang B - Befehlsübersicht#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+b.) Editkommandos 

+ 

+ESC *                 Text oder Graphikbildschirm löschen und Cursor Home 

+ESC +                                        " 

+ESC ,                                        " 

+ESC :                                        " 

+ESC E                 Zeile einfügen (im Textmodus) 

+ESC I                 Rückwärtstabulator (8 Spalten, im Textmodus) 

+ESC L                 Zeile einfügen (im Textmodus) 

+ESC M                 Zeile löschen (im Textmodus) 

+ESC Q                 Zeichen einfügen (im Textmodus) 

+ESC R                 Zeile löschen (im Textmodus) 

+ESC T                 Zeile ab Cursorposition bis zum Zeilenende löschen 

+ESC W                 Zeichen löschen (im Textmodus) 

+ESC Y                 Seite ab Cursorposition bis zum Seitenende löschen 

+ESC j                 Umgekehrter Zeilenvorschub 

+ESC t                 Zeile ab Cursor bis Zeilenende löschen (im Textmodus) 

+ 

+ 

+c.) Sendekommandos 

+ 

+ESC -                 Farbe, Zustand, In-Window-Bit bei Cursorpos senden 

+ESC 4                 Nummer der sichtbaren und der Arbeitsseite senden 

+ESC 5                 Graphikparameter (Dicke,Farbe,Bitverknüpfung) senden 

+ESC 6                 Aktuelle Textzeile senden 

+ESC 7                 Ganze Textseite senden 

+ESC 8                 Zeichen an der Cursorposition senden 

+ESC \ <ll><lh><al><ah>Aktuelle Graphikseite senden (oder Teile) 

+ESC ;                 Position des Graphikcursors senden 

+ESC ?                 Position des Textcursors senden 

+ESC _                 Graphikbyte bei Graphikcursorposition senden 

+ESC x 1 <l><m>        Zeilenbegrenzer für <ESC> 6 und <ESC> 7 einstellen 

+ESC x 4 <p>           Seitenbegrenzer für <ESC> 7 einstellen 

+ 

+ 

+d.) Übertragungskommandos 

+ 

+ESC SPACE SPACE <p>   Baudrate, Stopbits, Datenbits, Parity einstellen 

+ESC SPACE 0           Basis/Apple Keyboardcodes, keine Emulation 

+ESC SPACE 1           TVI - Emulation 

+ESC SPACE 2           Keine Hardware Flußkontrolle 

+ESC SPACE 3           RTS/CTS Flußkontrolle 

+ESC SPACE 4           DTR/DSR Flußkontrolle 

+ESC SPACE 5           RTS/CTS und DTR/DSR Flußkontrolle 

+ESC SPACE 6           8. Datenbit ist 0 

+ESC SPACE 7           8. Datenbit vorhanden 

+ESC D L               Local-Modus 

+ESC D E               Online-Modus mit Echo 

+ESC D O               Online-Modus ohne Echo 

+ 

+ 

+#text end#

+#free(04.468519e-1)#

+ 

+ 

+ 71 

+#page##--------------------------------- Ende der Seite 71 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+e.) Bildschirm/Druckerausgabe 

+ 

+ESC @                 Empfangsdaten auf Drucker ausgeben 

+ESC A                 Empfangsdaten nicht auf Drucker ausgeben 

+ESC P                 Hardcopy der Textseite 

+ESC ^ <p>             Hardcopy der aktuellen Graphikseite 

+ESC `                 Empfangsdaten nicht auf dem Bildschirm anzeigen 

+ESC a                 Empfangsdaten auf dem Bildschirm anzeigen 

+ESC ~ <n><l><p.>      Definition d.Druckertreiberstrings f.Graphikhardcopy 

+ 

+ 

+f.) Cursor/Cursor Adressierung 

+ 

+ESC . 0               Cursor aus 

+ESC . 1               Cursor blinkend 

+ESC . 2               Cursor an, nicht blinkend 

+ESC = <y+32><x+32>    Cursor auf Adresse positionieren 

+ESC Z                 Cursor an/aus 

+ 

+ 

+g.) Attribute 

+ 

+ESC (                 Normale Zeichen 

+ESC )                 Textmodus: Inversschrift, Graphik: Kursivschrift 

+ESC G 0               Normale Schrift 

+ESC G 1               Unsichtbare Schrift, Leerzeichen 

+ESC G 4               Inverse Schrift 

+ESC G 5               Unsichtbare Schrift, inverse Leerzeichen 

+ESC b                 Schwarze Schrift auf hellem Grund (nur im Textmodus) 

+ESC d                 Helle Schrift auf dunklem Grund, (nur im Textmodus) 

+ESC z <n>             Zeichensatz einstellen 

+ 

+ 

+h.) Text in Graphiken 

+ 

+ESC &                 Graphikzeichen ersetzen darunterliegende 

+ESC '                 Graphikzeichen überschreiben darunterliegende 

+ESC N <b><h><w>       Zeichenbreite, -höhe und Schreibrichtung einstellen 

+ 

+ 

+i.) Graphikzeichenkommandos 

+ 

+ESC J <b, h;>         Relatives Rechteck zeichnen 

+ESC K <r, s;>         Kreis(segmente) mit dem Radius <r> zeichnen 

+ESC m <x, y;>         Absoluten Punkt bei (x, y) zeichnen 

+ESC n <l, w;>         Turtle Draw/Move <l> ist Länge, <w> ist Winkel 

+ESC o                 Turtle Penup/Pendown 

+ESC q <x, y;>         Relativer Move 

+ESC r <x, y;>         Relativer Draw 

+ESC s <xr,yr,aw,ew;>  Ellipsenbogen(Radien xr,yr) v.<aw> bis <ew> zeichnen 

+ESC v <x, y;>         Absoluter Move nach (x, y) 

+ESC w <x, y;>         Absoluter Draw nach (x, y) 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#72 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 72 -----------#

+#center##on("b")#B.  Anhang B - Befehlsübersicht#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+j.) Verschiede Graphikkommandos 

+ 

+ESC ! <p>             Graphikseiten mischen, kopieren, trennen, invertieren 

+ESC / <ll><lh><al><ah><p...> Graphikseite vom Host laden 

+ESC O 0               Graphikparameter auf Default 

+ESC O 1 <d>           Strichdicke setzen 

+ESC O 2 <f>           Farbe/Helligkeit einstellen 

+ESC O 3 <p>           Linientyp (Punkt/Strichmuster) einstellen 

+ESC O 4 <p>           Bitverknüpfung setzen (0=OR, 1=AND, 2=XOR, 3=COPY) 

+ESC O 5 <p>           Farbe, Dicke, Bitverknüpfung zusammen einstellen 

+ESC O 6 <pl><ph>      Benutzerdefinierbares Linienmuster einstellen 

+ESC O 7 <p>           Arbeitsseite, sichtbare Seite u.Mixedmode einstellen 

+ESC O 8 <p>           Turtle Penup/Pendown und Eraser/Drawer einstellen 

+ESC O 9               Turtle Bildmitte, Richtung nach oben, Pendown, Drawer 

+ESC O : <b1..b8>      Benutzerdefinierbares Füllmuster einstellen 

+ESC y                 Graphikseite löschen und Cursor nach (0, 0) 

+ESC | <n>             Fläche füllen/löschen mit dem Muster Nummer <n> 

+ 

+ 

+k.) Verschiedene und spezielle Funktionen 

+ 

+ESC 0                 Terminalprogramm initialisieren (Softwarereset) 

+ESC 9 <d>             Zeitverzögerung ca. <d> * 2 ms 

+ESC <                 Keyboardclick ausschalten 

+ESC >                 Keyboardclick einschalten 

+ESC F <c>             Controlcharacter darstellen 

+ESC e <d...><t>       Funktionstaste <t> mit Daten <d...> belegen 

+ESC {                 Statuszeile aus (24. Textzeile sichtbar) 

+ESC }                 Statuszeile an (24. Textzeile unsichtbar) 

+ESC S <n>             Graphik/Textseite von/auf Diskette laden/speichern 

+ESC DEL 1             Tastenbelegungen löschen 

+ESC DEL 2             Druckerpuffer löschen 

+ESC DEL 3             Empfangspuffer löschen 

+ESC DEL 4             Sendepuffer löschen 

+ 

+#text end#

+#free(7.220185)#

+ 

+ 

+ 73 

+#page##--------------------------------- Ende der Seite 73 -----------#

+#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#type("8")##center##on("i")##on("u")##ib(3)#C.  Anhang C - Default Funktionstastenbelegungen#ie(3)##off("u")##off("i")##type("elite")# 

+ 

+ 

+Bemerkung zur Schreibweise: 

+<#40> bezeichnet den ASCII-Code für '(', also den ASCII-Code 40 (dezimal). 

+<LESC> bezeichnet den Code Hex 9B für Local Escape, damit diese Tastenfunk-

+tionen sowohl im Local- als auch im Onlinemodus ausgeführt werden können. 

+ 

+a.) Zehnerblock mit <SHIFT> 

+ 

+Die Anordnung der Zifferntasten entspricht einem "Cursorblock" mit acht

+Richtungen. Die Taste <SHIFT 5> zeigt nur das Fadenkreuz, d.h. die Position

+des Graphikcursors bleibt unverändert. Bei allen anderen Zifferntasten än-

+dert sich die Position des Graphikcursors und das Fadenkreuz wird kurz

+sichtbar. Bis auf die Help-Taste <SHIFT F4> können alle Tasten auch im On-

+line-Modus aufgerufen werden. 

+ 

+Die Tastenbelegungen im einzelnen: 

+ 

+Taste    Hex-Code Code-Sequenz 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+<SHIFT 1>  E1  <LESC> q-1,-1; <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 2>  E2  <LESC> q0,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 3>  E3  <LESC> q1,-1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 4>  E4  <LESC> q-1,0;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 5>  E5  <LESC> <CTRL X><LESC> 9 <#127> <LESC> <CTRL X> 

+<SHIFT 6>  E6  <LESC> q1,0;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 7>  E7  <LESC> q-1,1;  <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 8>  E8  <LESC> q0,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+<SHIFT 9>  E9  <LESC> q1,1;   <LESC><CTRL X><LESC> 9 <#40><LESC><CTRL X> 

+ 

+Terminalinitialisierung mit <SHIFT BOTTOMRIGHT>: 

+            EF  (Cursorpositionierung und Einschaltmeldung) 

+ 

+ 

+b.) Die Funktionstasten mit <SHIFT> 

+ 

+Taste    Hex-Code Code-Sequenz                     Bedeutung 

+#rpos(16.0)##fillchar(" ")##table# 

+#on("u")# #off("u")# 

+#table end# 

+#clearpos# 

+<SHIFT F1>  D1  <LESC> $ <LESC> O70                Graphikseite 1 

+<SHIFT F2>  D2  <LESC> $ <LESC> O73                Graphikseite 2 

+<SHIFT F3>  D3  <LESC> %                           Textseite 

+<SHIFT F4>  D4  <ESC>SW<#26> H e l p s c r e e n (a..f): <ESC>S<#81> 

+                <ESC>9<#81> <ESC>SG                Help-Bilschirm anzeigen 

+<SHIFT F8>  D8  <LESC> O41                         Linien schwarz (löschen) 

+<SHIFT F9>  D9  <LESC> O40                         Linien weiß (sichtbar) 

+<SHIFT F10> DA  <LESC> O12 <LESC> N <#12><#20><#0> Große und dicke Schrift 

+<SHIFT F11> DB  <LESC> O11 <LESC> N <#0><#0><#0>   Normal dünne Schrift 

+<SHIFT F12> DC  <LESC> G4                          Kursiv/Invers an 

+<SHIFT F13> DD  <LESC> G0                          Kursiv/Invers aus 

+<SHIFT F14> DE  <LESC> ^0                          Graphikhardcopy 

+<SHIFT F15> DF  <LESC> P                           Texthardcopy 

+#text end#

+#free(02.351852e-2)#

+ 

+ 

+#right#74 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#page##--------------------------------- Ende der Seite 74 -----------#

+#center##on("b")#C.  Anhang C - Default Funktionstastenbelegungen#off("b")# 

+ 

+ 

+ 

+#type("elite")##limit(16.2)##linefeed(01.0)# 

+#text begin# 

+#text end#

+#free(22.03685)#

+ 

+ 

+ 75 

+#page##--------------------------------- Ende der Seite 75 -----------#

diff --git a/system/ruc-terminal/unknown/src/SCCPARAM.ELA b/system/ruc-terminal/unknown/src/SCCPARAM.ELA
new file mode 100644
index 0000000..ab59518
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/SCCPARAM.ELA
@@ -0,0 +1,144 @@
+(* Uebertragungsparameter fuer Kanal 2 und 3 (SCC) setzen *) 

+(* Vers. 1.2 : 'setup'-Prozedur / 03.02.86, M.Staubermann *) 

+ 

+PACKET scc DEFINES baudrate, 

+                   setup ,

+ 

+                   channel a, 

+                   channel b, 

+                   no parity, 

+                   even parity, 

+                   odd parity, 

+ 

+                   read port, 

+                   write port, 

+                   register, 

+                   quartz :

+ 

+BOOL CONSTchannel a   :: TRUE , 

+          channel b   :: FALSE ; 

+INT CONST no parity   :: 0, 

+          even parity :: 3, 

+          odd parity  :: 1; 

+ 

+REAL VAR clk frequency := 12288000.0 ; (* Oszillatorfrequenz *) 

+LET offset        = 0 ; 

+ 

+PROC quartz (REAL CONST wert) : 

+ clk frequency := wert 

+ENDPROC quartz ; 

+ 

+REAL PROC quartz : 

+ clk frequency 

+ENDPROC quartz ; 

+ 

+PROC setup (BOOL CONST channel, INT CONST parity, 

+            REAL CONST stopbits, INT CONST bits, 

+            BOOL CONST dtr, rts, auto dtr, auto cts) :

+ 

+(* Parameter müssen zusammen gesetzt werden, da die Register keine 

+   Read-Register sind. Alte Werte müssen ausserhalb des SCC's gespeichert 

+   werden. *) 

+ 

+ INT VAR value := 64 ; 

+ value INCR parity value ; 

+ value INCR stopbit value ; 

+ 

+ register (channel, 3, 0) ; 

+ register (channel, 5, 32 * bits value) ;

+ register (channel,14, 2) ; 

+ 

+ register (channel, 4, value) ; 

+ register (channel, 5, 8 + dtr value + rts value + 32 * bits value) ;

+ register (channel,14, 3 + auto dtr value) ;

+ register (channel, 3, 1 + 64 * bits value + auto cts value) .

+ 

+bits value : 

+ IF bits <= 5 THEN 0 

+ ELIF bits >= 8 THEN 3 

+ ELIF bits = 6 THEN 2 

+ ELSE 1

+ FI .

+ 

+parity value : 

+ IF parity >= 0 AND parity <= 3 THEN parity ELSE 0 FI . 

+ 

+stopbit value : 

+ IF stopbits = 1.0 THEN 4 

+ ELIF stopbits = 1.5 THEN 8 

+ ELIF stopbits = 2.0 THEN 12 

+ ELSE 4 

+ FI . 

+ 

+dtr value : 

+ IF dtr THEN 128 ELSE 0 FI . 

+ 

+rts value : 

+ IF rts THEN 2 ELSE 0 FI . 

+ 

+auto cts value :

+ IF auto cts THEN 32 ELSE 0 FI . 

+ 

+auto dtr value : 

+ IF auto dtr THEN 4 ELSE 0 FI . 

+ 

+ENDPROC setup ;

+ 

+PROC baudrate (BOOL CONST channel, REAL CONST rate) :

+ INT CONST time constant :: int (clk frequency / (64.0 * rate) + 0.5) - 2 ;

+ register (channel, 13, time constant DIV 256) ; 

+ register (channel, 12, time constant AND 255)

+ENDPROC baudrate ; 

+ 

+REAL PROC baudrate (BOOL CONST channel) : 

+ INT CONST time constant :: 

+     register (channel, 12) + 256 * register (channel, 13) ;

+ round (clk frequency / (real (time constant + 2) * 64.0), 1)

+ENDPROC baudrate ; 

+ 

+ 

+(*********************************************************************) 

+(********* S C C    -     Z u g r i f f s p r o z e d u r e n ********)

+(*********************************************************************) 

+ 

+ 

+INT PROC read port (INT CONST port) : 

+ INT VAR value ; 

+ control (-1, offset + port, -1, value) ; 

+ IF value = -1 THEN errorstop ("SCC - Read failed") ; 0 

+ ELSE value 

+FI . 

+ 

+ENDPROC read port ;

+ 

+PROC write port (INT CONST port, value) : 

+ INT VAR rcode, my channel := channel ; 

+ continue (32) ; 

+ control (-1, offset + port, value, r code) ; 

+ continue (my channel) ; 

+ IF r code = -1 THEN errorstop ("SCC - Write failed") FI 

+ENDPROC write port ; 

+ 

+INT PROC register (BOOL CONST is channel a, INT CONST register x) : 

+ INT VAR value ; 

+ IF is channel a 

+    THEN write port (1, registerx) ; 

+         read port (1) 

+    ELSE write port (0, registerx) ; 

+         read port (0) 

+ FI 

+ENDPROC register ; 

+ 

+ 

+PROC register (BOOL CONST is channel a, INT CONST register x, wert): 

+ IF is channel a 

+    THEN write port (1, register x) ;

+         write port (1, wert) 

+    ELSE write port (0, register x) ;

+         write port (0, wert)

+ FI 

+ENDPROC register ; 

+ 

+ENDPACKET scc ; 

+ 

+

diff --git a/system/ruc-terminal/unknown/src/SETUP.ELA b/system/ruc-terminal/unknown/src/SETUP.ELA
new file mode 100644
index 0000000..ade2118
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/SETUP.ELA
@@ -0,0 +1,257 @@
+PACKET setup DEFINES setup :         (* 02.03.86, M.Staubermann *) 

+ 

+LET separator  = "|" , 

+    old option mark = " " , (* ""16"" , *)

+    choice mark = ""15"" , 

+    end mark   = ""14"" , 

+    left       = ""8"" , 

+    right      = ""2"" , 

+    bottom     = ""6""21""0"" , 

+    clr line   = ""13""5"" ,

+    home       = ""1"" ;

+ 

+PROC selektor (TEXT CONST options, INT VAR option number,BOOL CONST warten) :

+ TEXT VAR zeichen ;

+ INT VAR i , 

+         last separator pos , 

+         new separator pos := 0 ,

+         old option := option number , 

+         max options := 0 ;

+ REP 

+  new separator pos := pos (options, separator, new separator pos +1) ; 

+  max options INCR 1 

+ UNTIL new separator pos = 0 PER ;

+ out (""13"") ; 

+ REP 

+  i := 0 ; 

+  last separator pos := 0 ;

+  REP 

+   i INCR 1 ;

+   new separator pos := pos (options, separator, last separator pos + 1) ; 

+   IF new separator pos = 0 

+      THEN new separator pos := LENGTH options + 1 

+   FI ;

+   IF i = option number

+      THEN out (choice mark) 

+   ELIF i = old option 

+      THEN out (old option mark) 

+   ELSE out (end mark) 

+   FI ; 

+   out subtext (options, last separator pos + 1, new separator pos - 1) ; 

+   out (end mark) ;

+   last separator pos := new separator pos 

+  UNTIL last separator pos = LENGTH options + 1 PER ;

+  out (""13"") ;

+  IF warten 

+     THEN inchar (zeichen) ; 

+          IF zeichen = ""27"" 

+             THEN option number := old option 

+          ELIF zeichen = left AND option number = 1 

+             THEN option number := max options 

+          ELIF zeichen = left 

+             THEN option number DECR 1 

+          ELIF zeichen = right AND option number = max options 

+             THEN option number := 1 

+          ELIF zeichen = right 

+             THEN option number INCR 1 

+          FI 

+  ELSE zeichen := ""13"" 

+  FI

+ UNTIL zeichen = ""13"" OR zeichen = ""27"" PER 

+ENDPROC selektor ; 

+ 

+LET std datenbits = 4 , (* 8 *) 

+    std stopbits  = 1 , (* 1.0 *) 

+    std flowmode  = 1 , (* xon/xoff *) 

+    std parity    = 1 , (* no parity *) 

+    std fixed     = 4 , (* RTS ON, DTR ON *) 

+ 

+    setup text    = "Ende|Kanal|Baudrate|Datenbits|Stopbits|Parity|Flußkontrolle", 

+    ende text     = "Ändern|Abbruch" , 

+    kanal text    = "2|3" , 

+    datenbits text= "5|6|7|8" , 

+    stopbits text = "1.0|1.5|2.0" , 

+    parity text   = "no|even|odd" , 

+    fixed text    = "DTR OFF/RTS OFF|DTR OFF/RTS ON|DTR ON/RTS OFF|DTR ON/RTS ON" , 

+    flowmode text = "xon/xoff|dtr|rts/cts|dtr/rts/cts|fixed" ; 

+ 

+INT VAR old session := 0 ; 

+ROW 2 INT VAR datenbits, stopbits, parity, flowmode , fixed ; 

+ROW 2 REAL VAR baudrates ; 

+ 

+PROC init params : 

+ datenbits := ROW 2 INT:(std datenbits , std datenbits) ; 

+ stopbits  := ROW 2 INT:(std stopbits , std stopbits) ; 

+ parity    := ROW 2 INT:(std parity , std parity) ; 

+ flowmode  := ROW 2 INT:(std flowmode , std flowmode) ; 

+ fixed     := ROW 2 INT:(std fixed, std fixed) ; 

+ baudrates := ROW 2REAL:(baudrate (channelb), baudrate (channela)) ;

+ENDPROC init params ; 

+ 

+PROC setup :

+ INT VAR kanal := aktueller kanal , 

+         setup choice := 1 ; 

+ BOOL VAR x dtr, x rts, x auto dtr, x cts ; 

+ page ;

+ init setup (kanal, setup choice) ; 

+ select setup choice ; 

+ cursor (1, 19) ; 

+ setup choice := 2 ; 

+ selektor (ende text, setup choice, TRUE) ; 

+ out (bottom) ;

+ IF setup choice = 1 

+    THEN kanal := 1 ; 

+         x flowmode ; 

+         setup (kanal bool, x parity, x stopbits, x datenbits, 

+                x dtr, x rts, x auto dtr, x cts) ; 

+         baudrate (kanal bool, baudrates (kanal)) ; 

+         kanal := 2 ; 

+         x flowmode ; 

+         setup (kanal bool, x parity, x stopbits, x datenbits, 

+                x dtr, x rts, x auto dtr, x cts) ; 

+         baudrate (kanal bool, baudrates (kanal)) 

+ FI . 

+ 

+x flowmode : 

+ x dtr := FALSE ; 

+ x rts := FALSE ; 

+ SELECT flowmode (kanal) OF 

+  CASE 1 : x auto dtr := FALSE ; (* XON/XOFF *) 

+           x cts      := FALSE 

+  CASE 2 : x auto dtr := TRUE ;  (* DTR *)

+           x cts      := FALSE 

+  CASE 3 : x auto dtr := FALSE ; (* RTS/CTS *)

+           x cts      := TRUE 

+  CASE 4 : x auto dtr := TRUE  ; (* RTS/CTS/DTR *) 

+           x cts      := TRUE 

+  CASE 5 : x auto dtr := FALSE ; (* fixed *) 

+           x cts      := FALSE ; 

+           SELECT fixed (kanal) OF 

+            CASE 1 : x dtr := FALSE ; (* wie XON/XOFF *)

+                     x rts := FALSE 

+            CASE 2 : x dtr := FALSE ; (* RTS=1 *) 

+                     x rts := TRUE 

+            CASE 3 : x dtr := TRUE ;  (* DTR=1 *)

+                     x rts := FALSE 

+            CASE 4 : x dtr := TRUE ;  (* RTS=1,DTR=1 *) 

+                     x rts := TRUE 

+           ENDSELECT 

+ENDSELECT. 

+ 

+x parity : 

+ SELECT parity (kanal) OF 

+  CASE 2 : even parity 

+  CASE 3 : odd parity 

+  OTHERWISE no parity 

+ ENDSELECT. 

+ 

+x stopbits : 

+ SELECT stopbits (kanal) OF 

+  CASE 2 : 1.5 

+  CASE 3 : 2.0 

+  OTHERWISE 1.0 

+ ENDSELECT. 

+ 

+x datenbits : 

+ datenbits (kanal) + 4. 

+ 

+select setup choice : 

+ REP 

+  cursor (1, 5) ; 

+  selektor (setup text, setup choice, TRUE) ; 

+  SELECT setup choice OF 

+   CASE 1 : LEAVE select setup choice 

+   CASE 2 : select kanal choice 

+   CASE 3 : select baudrate choice 

+   CASE 4 : select datenbits choice 

+   CASE 5 : select stopbits choice 

+   CASE 6 : select parity choice 

+   CASE 7 : select flowmode choice 

+  ENDSELECT 

+ PER . 

+ 

+select kanal choice : 

+ INT VAR save kanal := kanal ; 

+ cursor (1, 7) ; 

+ selektor (kanal text, kanal, TRUE) ; 

+ init setup (kanal, setup choice) .

+ 

+select baudrate choice : 

+ cursor (1, 9) ; 

+ TEXT VAR t := text (baudrates (kanal)) + "    " ; 

+ out (" ") ;

+ editget (t) ; 

+ baudrates (kanal) := real (t) . 

+ 

+select datenbits choice : 

+ cursor (1, 11) ; 

+ selektor (datenbits text, datenbits (kanal), TRUE) . 

+ 

+select stopbits choice : 

+ cursor (1, 13) ; 

+ selektor (stopbits text, stopbits (kanal), TRUE) . 

+ 

+select parity choice : 

+ cursor (1, 15) ; 

+ selektor (parity text, parity (kanal), TRUE).

+ 

+select flowmode choice : 

+ cursor (1, 17) ; 

+ selektor (flowmode text, flowmode (kanal), TRUE) ; 

+ IF flowmode (kanal) = 5 

+    THEN cursor (1, 19) ; 

+         selektor (fixed text, fixed (kanal), TRUE) ; 

+         out (clr line) 

+ FI . 

+ 

+aktueller kanal : 

+ IF channel = 2 THEN 1 

+ ELIF channel = 3 THEN 2 

+ ELSE 1 

+ FI . 

+ 

+kanal bool : 

+ IF kanal = 1 THEN channel b ELSE channel a FI . 

+ 

+ENDPROC setup ; 

+ 

+PROC init setup (INT VAR kanal, setup choice) :

+ IF session <> old session 

+    THEN init params ; 

+         old session := session 

+ FI ;

+ out (home) ; 

+ putline (" ----------------------------- V 2 4 - S E T U P ---------------------------") ; 

+ line ; 

+ putline (" Verlassen 'ESC', Aussuchen 'LEFT' und 'RIGHT', Einstellen 'RETURN'") ; 

+ line ; 

+ selektor (setup text, setup choice, FALSE) ; 

+ line ; 

+ line ; 

+ selektor (kanal text, kanal, FALSE) ; 

+ line ; 

+ line ; 

+ out (" ") ; put (baudrates (kanal)) ; out ("     ") ;

+ line ; 

+ line ; 

+ selektor (datenbits text, datenbits (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ selektor (stopbits text, stopbits (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ selektor (parity text, parity (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ selektor (flowmode text, flowmode (kanal), FALSE) ; 

+ line ; 

+ line ; 

+ line ; 

+ line ;

+ putline (" --------------------------------------------------------------------------") ; 

+ out (home) . 

+ENDPROC init setup ;

+ 

+ENDPACKET setup ; 

+ 

+

diff --git a/system/ruc-terminal/unknown/src/Terminal108(ascii) b/system/ruc-terminal/unknown/src/Terminal108(ascii)
new file mode 100644
index 0000000..f06755e
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/Terminal108(ascii)
@@ -0,0 +1,121 @@
+                                      (* Terminaltyp: Terminal108 *) 

+                                      (* Keyboard   : Deutsch     *) 

+                                      (* Zeichensatz: ASCII       *) 

+                                      (* Stand      : 28.04.86    *) 

+ 

+forget  ("Terminal108(ascii)", quiet) ; 

+new type ("Terminal108(ascii)") ; 

+ 

+cursor logic  (32, ""30"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode ( 1, 25) ;                (* Cursor Home *) 

+enter outcode ( 2, 28) ;                (* Cursor right *)

+enter outcode ( 3, 31) ;                (* Cursor up *) 

+enter outcode ( 4, 11) ;                (* Clear EOP *) 

+enter outcode ( 5, 29) ;                (* Clear EOL *) 

+enter outcode ( 7,  7) ;                (* Bell      *) 

+enter outcode (14, 0, " "14"") ;        (* Norm Vid  *) 

+enter outcode (15, 0, ""15" ") ;        (* Inv  Vid  *) 

+

+enter outcode (214, 193) ;  (* Inv A *)

+enter outcode (215, 207) ;  (* Inv O *)

+enter outcode (216, 213) ;  (* Inv U *)

+enter outcode (217, 225) ;  (* Inv a *)

+enter outcode (218, 239) ;  (* Inv o *)

+enter outcode (219, 245) ;  (* Inv u *)

+enter outcode (220, 235) ;  (* Inv k *)

+enter outcode (221, 173) ;  (* Inv - *)

+enter outcode (222, 163) ;  (* Inv # *)

+enter outcode (223, 160) ;  (* Inv Blank *)

+enter outcode (251, 194) ;  (* Inv B *)

+ 

+enter outcode (64, 0, ""1"B"64"") ; (* ""1"B" = ASCII *)

+enter outcode (91, 0, ""1"B"91"") ; 

+enter outcode (92, 0, ""1"B"92"") ; 

+enter outcode (93, 0, ""1"B"93"") ; 

+enter outcode (123,0, ""1"B"123"") ; 

+enter outcode (124,0, ""1"B"124"") ; 

+enter outcode (125,0, ""1"B"125"") ; 

+enter outcode (126,0, ""1"B"126"") ; 

+(* 

+enter outcode (12, 12) ;              (* CLR SCRN *) 

+enter outcode (16, 2) ;               (* Cursor Mode <mode> *) 

+enter outcode (17, 1) ;               (* Zeichensatz <switch> : Bit 0..3 *)

+enter outcode (18, 18) ;              (* Insert Line *) 

+enter outcode (19, 26) ;              (* Erase (nicht Delete) Line *) 

+enter outcode (20, 5) ;               (* xpos := 80 *) 

+enter outcode (22, 22) ;              (* Select Screen <nr> : Bit 0 *) 

+enter outcode (23, 23) ; (*SetWindow <left><top><right+1><bottom+1>  (+128)*) 

+*)

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *)

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode (4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = ß *) 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ;

diff --git a/system/ruc-terminal/unknown/src/Terminal108(deutsch) b/system/ruc-terminal/unknown/src/Terminal108(deutsch)
new file mode 100644
index 0000000..24ad9e7
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/Terminal108(deutsch)
@@ -0,0 +1,122 @@
+                                      (* Terminaltyp: Terminal108 *) 

+                                      (* Keyboard   : Deutsch     *) 

+                                      (* Zeichensatz: Deutsch     *) 

+                                      (* Stand      : 28.04.86    *) 

+ 

+forget  ("Terminal108(deutsch)", quiet) ; 

+new type ("Terminal108(deutsch)") ; 

+ 

+cursor logic  (32, ""30"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (91,  0, ""15"("14"") ; 

+enter outcode (92,  0, ""15"/"14"") ; 

+enter outcode (93,  0, ""15")"14"") ; 

+enter outcode (123, 0, ""15"<"14"") ; 

+enter outcode (124, 0, ""15"!"14"") ; 

+enter outcode (125, 0, ""15">"14"") ; 

+enter outcode (126, 0, ""15"`"14"") ; 

+ 

+enter outcode (214, 0, ""1"D"91"") ; (* ""1"D" = Deutsch *)

+enter outcode (215, 0, ""1"D"92"") ; 

+enter outcode (216, 0, ""1"D"93"") ; 

+enter outcode (217, 0, ""1"D"123"") ; 

+enter outcode (218, 0, ""1"D"124"") ; 

+enter outcode (219, 0, ""1"D"125"") ; 

+enter outcode (220, 235) ;           (* Inv k *)

+enter outcode (221, 173) ;           (* Inv - *)

+enter outcode (222, 163) ;           (* Inv # *)

+enter outcode (223, 160) ;           (* Inv Blank *)

+enter outcode (251, 0, ""1"D"126"") ; 

+ 

+enter outcode ( 1, 25) ;                (* Cursor Home *) 

+enter outcode ( 2, 28) ;                (* Cursor right *)

+enter outcode ( 3, 31) ;                (* Cursor up *) 

+enter outcode ( 4, 11) ;                (* Clear EOP *) 

+enter outcode ( 5, 29) ;                (* Clear EOL *) 

+enter outcode ( 7,  7) ;                (* Bell      *) 

+enter outcode (14, 0, " "14"") ;        (* Norm Vid  *) 

+enter outcode (15, 0, ""15" ") ;        (* Inv  Vid  *) 

+(* 

+enter outcode (12, 12) ;              (* CLR SCRN *) 

+enter outcode (16, 2) ;               (* Cursor Mode <mode> *) 

+enter outcode (17, 1) ;               (* Zeichensatz <switch> : Bit 0..3 *)

+enter outcode (18, 18) ;              (* Insert Line *) 

+enter outcode (19, 26) ;              (* Erase (nicht Delete) Line *) 

+enter outcode (20, 5) ;               (* xpos := 80 *) 

+enter outcode (22, 22) ;              (* Select Screen <nr> : Bit 0 *) 

+enter outcode (23, 23) ; (*SetWindow <left><top><right+1><bottom+1>  (+128)*) 

+*)

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *)

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode (4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = ß *) 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ;

+ 

+ 

diff --git a/system/ruc-terminal/unknown/src/ructerm.apl-german b/system/ruc-terminal/unknown/src/ructerm.apl-german
new file mode 100644
index 0000000..c381c6b
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/ructerm.apl-german
@@ -0,0 +1,125 @@
+                                      (* Terminaltyp: ructerm  *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Universal*) 

+                                      (* Stand      : 08.10.86 *) 

+                                      (* Mit 'info'-Taste auf => *) 

+ 

+forget  ("ructerm.apl/german", quiet) ; 

+new type ("ructerm.apl/german") ; 

+ 

+enter outcode (11, 253) ;              (* links Pfeil *) 

+enter outcode (12, 221) ;              (* rechts Pfeil *) 

+enter outcode (16, 240) ; 

+enter outcode (17, 241) ; 

+enter outcode (18, 242) ; 

+enter outcode (19, 243) ; 

+enter outcode (20, 244) ; 

+enter outcode (21, 245) ; 

+enter outcode (22, 246) ; 

+enter outcode (23, 247) ; 

+enter outcode (24, 248) ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y"27"z7") ; (* CLEOP und Zeichensatz : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14,  175) ;       (* END MARK    : Spitz. Klammer zu *)

+enter outcode ( 15,  192) ;       (* BEGIN MARK  : Spitz. Klammer auf *)

+ 

+enter outcode (214, 91) ;               (* Ae *) 

+enter outcode (215, 92) ;               (* Oe *) 

+enter outcode (216, 93) ;               (* Ue *) 

+enter outcode (217, 123) ;              (* ae *) 

+enter outcode (218, 124) ;              (* oe *) 

+enter outcode (219, 125) ;              (* ue *)

+enter outcode (220, 235) ;              (* Trenn-k *) 

+enter outcode (221, 191) ;              (* Trennstrich *) 

+enter outcode (222, 188) ;              (* Fest-# = Raute *)

+enter outcode (223, 160) ;              (* Fest-Blank *) 

+enter outcode (251, 126) ;              (* sz *) 

+enter outcode (252, 64) ;               (* paragraph *)

+ 

+enter outcode (64, 131) ;               (* At-Sign *) 

+enter outcode (91, 252) ;               (* Eck. Klammer auf *) 

+enter outcode (92, 223) ;               (* Backslash *) 

+enter outcode (93, 251) ;               (* Eck. Klammer zu *) 

+enter outcode (123, 167) ;              (* Geschw. Klammer auf *) 

+enter outcode (124, 205) ;              (* Senkr. Strich *) 

+enter outcode (125, 163) ;              (* Geschw. Klammer zu *) 

+enter outcode (126, 212) ;              (* Tilde *) 

+

+enter outcode (144, 214) ;              (* Zeichen mit Umlautcodes *)

+enter outcode (145, 215) ;              (* verlegen *)

+enter outcode (146, 216) ; 

+enter outcode (147, 217) ; 

+enter outcode (148, 218) ; 

+enter outcode (149, 219) ; 

+enter outcode (150, 220) ; 

+enter outcode (151, 221) ; 

+enter outcode (152, 222) ;

+

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+enter incode (  4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts   *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 Insert Line *)

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

diff --git a/system/ruc-terminal/unknown/src/ructerm.ascii b/system/ruc-terminal/unknown/src/ructerm.ascii
new file mode 100644
index 0000000..b06df7c
--- /dev/null
+++ b/system/ruc-terminal/unknown/src/ructerm.ascii
@@ -0,0 +1,94 @@
+                                      (* Terminaltyp: ructerm  *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Ascii    *) 

+                                      (* Stand      : 08.10.86 *) 

+                                      (* Mit 'info'-Taste auf => *) 

+ 

+forget  ("ructerm.ascii", quiet) ; 

+new type ("ructerm.ascii") ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y") ; (* CLEOP       : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14,  0, " "27"(") ;   (* END MARK    : <ESC> ( *)

+enter outcode ( 15,  0, ""27") ") ;   (* BEGIN MARK  : <ESC> ) *)

+ 

+enter outcode (214, 193) ;              (* Ae *) 

+enter outcode (215, 207) ;              (* Oe *) 

+enter outcode (216, 213) ;              (* Ue *) 

+enter outcode (217, 225) ;              (* ae *) 

+enter outcode (218, 239) ;              (* oe *) 

+enter outcode (219, 245) ;              (* ue *)

+enter outcode (220, 235) ;              (* Trenn-k *) 

+enter outcode (221, 173) ;              (* Trennstrich *) 

+enter outcode (222, 163) ;              (* Fest-# *)

+enter outcode (223, 160) ;              (* Fest-Blank *) 

+enter outcode (251, 194) ;              (* sz *) 

+enter outcode (252, 192) ;              (* paragraph *)

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+enter incode (  4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts   *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 Insert Line *)

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

diff --git a/system/setup/3.1/source-disk b/system/setup/3.1/source-disk
new file mode 100644
index 0000000..1421205
--- /dev/null
+++ b/system/setup/3.1/source-disk
@@ -0,0 +1 @@
+setup/setup-src-3.1_shard-4.9_1989-04-18.img
diff --git a/system/setup/3.1/src/AT-4.x b/system/setup/3.1/src/AT-4.x
new file mode 100644
index 0000000..86962e3
--- /dev/null
+++ b/system/setup/3.1/src/AT-4.x
diff --git a/system/setup/3.1/src/SHARD b/system/setup/3.1/src/SHARD
new file mode 100644
index 0000000..c1619b3
--- /dev/null
+++ b/system/setup/3.1/src/SHARD
diff --git a/system/setup/3.1/src/SHard Basis b/system/setup/3.1/src/SHard Basis
new file mode 100644
index 0000000..60800a1
--- /dev/null
+++ b/system/setup/3.1/src/SHard Basis
diff --git a/system/setup/3.1/src/bootblock b/system/setup/3.1/src/bootblock
new file mode 100644
index 0000000..00b56a2
--- /dev/null
+++ b/system/setup/3.1/src/bootblock
diff --git a/system/setup/3.1/src/configuration b/system/setup/3.1/src/configuration
new file mode 100644
index 0000000..139597f
--- /dev/null
+++ b/system/setup/3.1/src/configuration
@@ -0,0 +1,2 @@
+
+
diff --git a/system/setup/3.1/src/neu b/system/setup/3.1/src/neu
new file mode 100644
index 0000000..a89779c
--- /dev/null
+++ b/system/setup/3.1/src/neu
@@ -0,0 +1,34 @@
+TEXT VAR t1 :: "SHardmodul Floppy", t2 :: "FLOPPY.EXE"; 
+reserve ("ds", /"DOS"); 
+IF yes("init",FALSE)
+  THEN init modules list; 
+FI;
+THESAURUS VAR th1 :: all modules, th2 :: empty thesaurus; 
+WHILE yes ("noch Module holen", TRUE) REP 
+t2 := ONE /"DOS"; 
+t1 := ONE (th1); 
+editget (t1); line; 
+forget (t1); 
+fetch (t2, /"DOS"); 
+copy (t2, t1);  last param (t1); 
+th2 := th2 + t1
+PER;
+WHILE yes ("jetzt noch andere holen", FALSE) REP 
+  t2 := ONE /"DOS";
+  t1 := ONE all;
+editget (t1); line; 
+forget (t1); 
+fetch (t2, /"DOS"); 
+copy (t2, t1);  last param (t1); 
+PER;
+release (/"DOS");
+
+linkshard module (th2);
+ 
+
+
+
+
+
+
+
diff --git a/system/setup/3.1/src/setup eumel -1: mini eumel dummies b/system/setup/3.1/src/setup eumel -1: mini eumel dummies
new file mode 100644
index 0000000..a1fa2b5
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel -1: mini eumel dummies
@@ -0,0 +1,28 @@
+ 
+PACKET setup eumel mini eumel dummies    (* Stand : 08.04.88 *)
+DEFINES FILE, 
+        sequentialfile, 
+        output, 
+        putline, 
+        :=,
+        run : 
+ 
+TYPE FILE = INT;
+ 
+INT CONST output :: 0; 
+
+OP := (FILE VAR a, FILE CONST b):
+
+END OP :=;
+FILE PROC sequentialfile (INT CONST a, TEXT CONST b) : 
+  FILE : (0).
+END PROC sequentialfile; 
+ 
+PROC putline (FILE CONST a, TEXT CONST b): 
+END PROC putline; 
+ 
+PROC run (TEXT CONST a): 
+END PROC run; 
+ 
+END PACKET setup eumel mini eumel dummies;
+
diff --git a/system/setup/3.1/src/setup eumel 0: -M b/system/setup/3.1/src/setup eumel 0: -M
new file mode 100644
index 0000000..bad5028
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 0: -M
@@ -0,0 +1,32 @@
+PACKET setup eumel multiuserspecials       (* Copyright (C) 1985, 1988 *)
+DEFINES terminal setup,                    (* Martin Schönbeck, Spenge *)
+        indirect list,                     (* Lutz Prechelt, Karlsruhe *)
+        setup testing :                    (* Stand: 07.05.88   2.1    *)
+
+LET sysout file = "sysout";
+
+BOOL VAR setup test version :: FALSE;
+
+PROC terminal setup: 
+  (* It took about 2 manmonths to debug this procedure ! *)
+END PROC terminal setup; 
+ 
+PROC indirect list (BOOL CONST make indirection) :
+  IF make indirection
+  THEN sysout (sysout file);
+  ELSE sysout ("");
+       print (sysout file);
+       forget (sysout file, quiet)
+  FI.
+END PROC indirect list;
+
+PROC setup testing (BOOL CONST new ):
+   setup test version := new;
+END PROC setup testing;
+
+BOOL PROC setup testing :
+  setup test version.
+END PROC setup testing;
+
+END PACKET setup eumel multiuserspecials;
+
diff --git a/system/setup/3.1/src/setup eumel 0: -S b/system/setup/3.1/src/setup eumel 0: -S
new file mode 100644
index 0000000..50a8330
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 0: -S
@@ -0,0 +1,35 @@
+PACKET setup eumel singleuserspecials      (* Copyright (C) 1985, 1988 *)
+DEFINES terminal setup,                    (* Martin Schönbeck, Spenge *)
+        break,                             (* Lutz Prechelt, Karlsruhe *)
+        indirect list,                     (* Stand: 07.05.88   2.1    *)
+        setup testing :
+
+LET printer channel  = 15,
+    screen  channel  =  1;
+
+ 
+PROC break (QUIET CONST quiet): 
+END PROC break; 
+ 
+PROC terminal setup:
+  setup
+END PROC terminal setup;
+
+PROC indirect list (BOOL CONST make indirection) :
+  (* Man beachte, daß es nicht besonders sinnvoll ist, auf einem Drucker
+     cout zu machen...
+  *)
+  IF make indirection
+  THEN continue (printer channel)
+  ELSE continue (screen channel)  FI.
+END PROC indirect list;
+
+PROC setup testing (BOOL CONST new):
+END PROC setup testing;
+
+BOOL PROC setup testing :
+  FALSE.
+END PROC setup testing;
+
+END PACKET setup eumel singleuserspecials;
+
diff --git a/system/setup/3.1/src/setup eumel 1: basisoperationen b/system/setup/3.1/src/setup eumel 1: basisoperationen
new file mode 100644
index 0000000..a705ff4
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 1: basisoperationen
@@ -0,0 +1,1071 @@
+
+(**************************************************************************)
+(***** Grundoperationen für den Setup-Eumel (Modul-SHard) *****************)
+(***** Copyright (c) 1985 - 1988 by                       *****************)
+(***** Martin Schönbeck, Spenge / Lutz Prechelt, Karlsruhe ****************)
+(**************************************************************************)
+
+(* Fünf Pakete :
+   1. setup eumel basisoperationen
+         Handhabung von 16-Bit unsigned Werten in INTs und Editierfunktionen
+   2. splitting
+         Worttrennung von REALs und Bytetrennung von INTs
+   3. basic block io
+         blockin und blockout auf Datenräume mit retrys und Fehlermeldungen
+   4. write file
+         Direktes Schreiben/Lesen eines Datenraums in/aus eine(r) Partition
+   5. thesaurus utilities
+         ONE,CERTAIN,certain  zum Aussuchen aus Thesauri ohne Editor
+*)
+
+
+PACKET setup eumel basisoperationen   (* (C) 1987 Lutz Prechelt, Karlsruhe *)
+DEFINES editget, editgetchar,         (* Stand: 08.04.88   Version 1.1     *)
+        yes, no,                      (* Eumel 1.8.0                       *)
+        direction, reset direction,
+        data error, write head,
+        LIST, list, CAT, emptylist,
+        (*UNSIGNED,*) unsigned, int, text,
+        RANGE, range, everywhere,
+        ANDXOR, andxor,
+        dec, hex, bin,
+        IN,
+        := ,
+        put :
+ 
+(* Dieses Paket stellt die Basisfunktionen für den Elanteil des Setup-SHard 
+   zur Verfügung. 
+   Es ist dies im Wesentlichen die Handhabung von INT-Werten auch in Binär- 
+   und Hexdarstellung, sowie die Plausibilitätsprüfung mit Fehleranzeigen. 
+*) 
+ 
+TYPE    LIST     = TEXT,    (* TEXT aus mehreren UNSIGNEDen (replace/ISUB) *)
+        RANGE    = STRUCT (UNSIGNED low, high), 
+        ANDXOR   = STRUCT (UNSIGNED and mask, xor mask);
+
+LET     UNSIGNED   = INT;     (* 16 bit *)
+
+TYPE    REPRESENTATION = INT;
+
+REPRESENTATION CONST dec :: REPRESENTATION : (10),
+                     hex :: REPRESENTATION : (16), 
+                     bin :: REPRESENTATION :  (2);
+
+(* Diese Typen dienen zur Wertprüfung bei der Eingabe. *) 
+ 
+LET    up      = ""3"",
+       down    = ""10"",
+       right   = ""2"",
+       error   = ""0"";  (* fuer current direction *)
+
+TEXT VAR current direction :: ""; (* enthaelt up oder down oder "" *)
+BOOL VAR direction valid :: FALSE;
+
+TEXT CONST hex digits :: "0123456789abcdef"; 
+ 
+(********************* Zuweisungen *************************************) 
+
+OP := (LIST VAR a, LIST CONST b) : 
+  CONCR (a) := CONCR (b) 
+END OP := ; 
+ 
+OP := (RANGE VAR a, RANGE CONST b) : 
+  a.low  := b.low; 
+  a.high := b.high
+END OP := ; 
+
+OP := (ANDXOR VAR a, ANDXOR CONST b) : 
+  a.and mask := b.and mask;
+  a.xor mask := b.xor mask
+END OP := ; 
+ 
+OP := (REPRESENTATION VAR a, REPRESENTATION CONST b) : 
+  CONCR (a) := CONCR (b) 
+END OP := ; 
+ 
+(************************** IN ******************************************) 
+ 
+BOOL OP IN (UNSIGNED CONST a, LIST CONST l) : 
+  INT CONST p :: pos (CONCR (l), textform (a)); 
+  p > 0 AND p MOD 2 = 1  (* enthalten und word-aligned *) 
+END OP IN; 
+ 
+BOOL OP IN (UNSIGNED CONST a, RANGE CONST b) : 
+  (* RANGES sind inklusiv ihrer Grenzen *)
+  reverse (textform (a)) <= reverse (textform (b.high)) AND 
+  reverse (textform (a)) >= reverse (textform (b.low)) 
+END OP IN;
+ 
+BOOL OP IN (UNSIGNED CONST a, ANDXOR CONST mask) : 
+  (* Es muss (Bitweise) (a AND andmask) XOR xormask = 0 sein *)
+  ((a AND mask.and mask) XOR mask.xor mask) = 0 
+END OP IN;
+
+(************************* Konstruktoren ********************************) 
+ 
+LIST CONST emptylist :: LIST : (""); 
+ 
+LIST PROC list (TEXT CONST list text) :
+  (* Konstruiert aus einer in Textform gegebenen Liste von Unsigneds eine
+     LIST. Die einzelnen Werte sind durch Komma getrennt und dürfen in
+     dezimaler, sedezimaler oder binärer Darstellung notiert sein. 
+  *)
+  TEXT VAR t :: compress (list text);
+  IF t = "" THEN emptylist
+  ELSE TEXT VAR result :: ""; 
+       REPEAT 
+         INT VAR first comma pos :: pos (t, ","); 
+         IF first comma pos = 0 THEN first comma pos := LENGTH t + 1  FI; 
+         result CAT textform (unsigned (subtext (t, 1, first comma pos - 1)));
+         t := subtext (t, first comma pos + 1) 
+       UNTIL t = ""  PER;
+       LIST : (result)
+  FI 
+END PROC list;
+
+(*UNSIGNED PROC unsigned (INT CONST sixteen bits) :
+  sixteen bits
+END PROC unsigned;*)
+
+UNSIGNED PROC unsigned (TEXT CONST number) : 
+  INT  VAR result :: 0, i;
+  TEXT VAR t :: compress (to lower (number)), type :: t SUB LENGTH t; 
+  IF pos ("hb" + hex digits, type) = 0 
+  THEN set conversion (FALSE); 
+       LEAVE unsigned WITH 0 
+  FI; 
+  IF type = "h" 
+  THEN convert hex 
+  ELIF type = "b" 
+  THEN convert binary
+  ELSE convert decimal  FI;
+  result. 
+ 
+convert hex : 
+  FOR i FROM 1 UPTO LENGTH t - 1 REP
+    TEXT CONST c :: t SUB i;
+    IF pos (hex digits, c) = 0
+    THEN set conversion (FALSE);
+         LEAVE unsigned WITH 0
+    FI;
+    rotate (result, 4);
+    result INCR pos (hex digits, c) - 1
+  PER.
+
+convert binary :
+  FOR i FROM 1 UPTO LENGTH t - 1 REP
+    TEXT CONST bit :: t SUB i;
+    IF bit <> "0" AND bit <> "1"
+    THEN set conversion (FALSE);
+         LEAVE unsigned WITH 0
+    FI;
+    rotate (result, 1);
+    result INCR int (bit)
+  PER.
+
+convert decimal :
+  REAL VAR x :: real (t);
+  IF NOT last conversion ok THEN LEAVE unsigned WITH 0  FI;
+  IF x < 32768.0
+  THEN result := int (x)
+  ELSE result := int (x - 65536.0)  FI.
+END PROC unsigned; 
+ 
+RANGE CONST everywhere :: RANGE : (0, -1); 
+ 
+RANGE PROC range (UNSIGNED CONST low, high) : 
+  RANGE : (low, high) 
+END PROC range; 
+ 
+ANDXOR PROC andxor (UNSIGNED CONST and mask, xor mask) : 
+  ANDXOR : (and mask, xor mask) 
+ENDPROC andxor; 
+ 
+
+(******* weitere Operationen für UNSIGNED, LIST, RANGE, ANDXOR **************)
+ 
+INT PROC int (UNSIGNED CONST a) : 
+  (* falls jemand noch exotische Dinge damit tun will *)
+  a 
+END PROC int;
+
+OP CAT (LIST VAR l, UNSIGNED CONST a) : 
+  (* Liste nachtraeglich erweitern *)
+  CONCR (l) CAT textform (a) 
+END OP CAT; 
+ 
+(********************* editget(char), yes, no *****************************) 
+
+PROC editget (INT CONST spalte, zeile, TEXT CONST prompt, INT VAR i) : 
+  cursor (spalte, zeile);
+  editget (prompt, i)
+END PROC editget; 
+ 
+PROC editget (INT CONST spalte, zeile, TEXT CONST prompt, UNSIGNED VAR a,
+              REPRESENTATION CONST r) :
+  cursor (spalte, zeile);
+  editget (prompt, a, r)
+END PROC editget; 
+ 
+PROC editget (TEXT CONST prompt, INT VAR i) : 
+  TEXT VAR t :: text (i);
+  test up or down (prompt, t);
+  IF current direction <> "" THEN LEAVE editget  FI;
+  editget (t,7,7);
+  i := int (t);
+  IF NOT last conversion ok
+  THEN data error ("Eingabe unerlaubt als Zahl")  FI
+END PROC editget; 
+ 
+PROC editget (TEXT CONST prompt, UNSIGNED VAR a, REPRESENTATION CONST r) : 
+  TEXT VAR t :: text (a, r);
+  test up or down (prompt, t);
+  IF current direction <> "" THEN LEAVE editget  FI;
+  editget (t,18,18);
+  a := unsigned (t);
+  IF NOT last conversion ok
+  THEN data error ("Eingabe unerlaubt")  FI
+END PROC editget; 
+ 
+BOOL PROC yes (TEXT CONST frage, BOOL CONST std antwort) : 
+  (* Achtung: hierdrin kann nicht die alte "yes" Prozedur benutzt werden, da
+              diese kein getchar benutzt.
+     Die alten yes/no werden unten durch Resultatlose ueberdeckt.
+  *)
+  LET allowed = "NnJj";
+  INT VAR x,y; get cursor (x,y);
+  IF NOT command dialogue THEN LEAVE yes WITH std antwort  FI;
+  REP UNTIL getcharety = "" PER;
+  REP
+    cursor (x,y);
+    test up or down (frage + " ? (j/n)", standard antwort text);
+    IF current direction <> "" THEN LEAVE yes WITH std antwort  FI;
+    TEXT VAR t;
+    getchar (t);
+    IF t = ""13""
+    THEN t := standard antwort text  FI;
+    IF pos (allowed, t) = 0
+    THEN out (""7"") ELSE out (t); out (""13""10"")  FI
+  UNTIL pos (allowed, t) <> 0  PER;
+  t = "j" OR t = "J".
+
+standard antwort text:
+  IF std antwort
+    THEN "j"
+    ELSE "n"
+  FI.
+END PROC yes; 
+
+BOOL PROC yes (INT CONST spalte, zeile, TEXT CONST frage,
+               BOOL CONST std antwort) :
+  cursor (spalte, zeile);
+  yes (frage, std antwort).
+END PROC yes;
+
+PROC yes (TEXT CONST dummy): END PROC yes;
+
+PROC no  (TEXT CONST dummy): END PROC no;
+
+PROC editgetchar (INT CONST spalte, zeile,  TEXT CONST prompt, allowed,
+                  UNSIGNED VAR a) :
+  cursor (spalte, zeile);
+  editgetchar (prompt, allowed, a)
+END PROC editgetchar;
+
+PROC editgetchar (TEXT CONST prompt, allowed, UNSIGNED VAR a) :
+  (* Bietet Zeichen an (nehmen mit RETURN), nimmt nur die in allowed.
+     obere 8 Bit der Vorbesetzung werden abgeschnitten.
+  *)
+  TEXT VAR t;
+  test up or down (prompt, perhaps a);
+  a := a MOD 256;
+  IF current direction <> "" THEN LEAVE editgetchar  FI;
+  getchar (t);
+  IF t = ""13""
+  THEN (* Vorbesetzung behalten *)
+       out (right)
+  ELIF pos (allowed, t) <> 0
+  THEN a := code (t);
+       out (t)
+  ELSE out (t);
+       data error ("unzulässiges Zeichen")
+  FI.
+
+perhaps a:
+  IF a > 31 THEN code (a) ELSE ""  FI.
+END PROC editgetchar;
+
+(********* data error, write head, (reset) direction *********************)
+
+PROC data error (TEXT CONST fehlermeldung) :
+  cursor (1, 24);
+  out (""7"Fehler : " + fehlermeldung + "    (Bitte Taste) ");
+  REP UNTIL incharety (2) = "" PER; pause;
+  cursor (1, 24); out (""4"");
+  current direction := error
+END PROC data error;
+
+PROC write head (TEXT CONST headtext) :
+  TEXT CONST text :: subtext (headtext, 1, 77);
+  INT CONST luecke :: (79 - LENGTH text) DIV 2 - 1;
+  out (""1""4""15"");
+  luecke TIMESOUT " ";
+  out (text);
+  luecke TIMESOUT " ";
+  out (""14""13""10""10"").
+END PROC write head;
+
+TEXT PROC direction :
+  current direction
+END PROC direction;
+
+PROC reset direction (BOOL CONST manouvres possible) :
+  (* Hiermit kann die letzte Manövrierbewegung nach der Auswertung gelöscht
+     werden. Mit NOT manouvres possible wird der ganze Manövriermechanismus
+     außer Betrieb gesetzt.
+  *)
+  direction valid := manouvres possible;
+  current direction := ""
+END PROC reset direction;
+
+(*********************** put *******************************************) 
+ 
+PROC put (INT CONST spalte, zeile, UNSIGNED CONST a, REPRESENTATION CONST r):
+  cursor (spalte, zeile);
+  put (a, r)
+END PROC put;
+
+PROC put (INT CONST spalte, zeile, LIST CONST l, REPRESENTATION CONST r):
+  cursor (spalte, zeile);
+  put (l, r)
+END PROC put;
+
+PROC put (INT CONST spalte, zeile, RANGE CONST a, REPRESENTATION CONST r):
+  cursor (spalte, zeile);
+  put (a, r)
+END PROC put;
+
+PROC put (UNSIGNED CONST a, REPRESENTATION CONST r) : 
+  put (text (a, r)) 
+END PROC put; 
+ 
+PROC put (LIST CONST a, REPRESENTATION CONST r) : 
+  INT VAR i, l :: LENGTH CONCR (a) DIV 2;
+  write ("(");
+  FOR i FROM 1 UPTO l REP 
+    put (text (CONCR (a) ISUB i, r)); 
+    IF i < l THEN put (",")  FI
+  PER; 
+  IF l > 0 THEN out (""8"")  FI;
+  put (")")
+END PROC put;
+
+PROC put (RANGE CONST a, REPRESENTATION CONST r) : 
+  write (text (a.low, r));
+  write ("...");
+  write (text (a.high, r))
+END PROC put;
+(*** ist put auf RANGE in dieser Weise sinnvoll ?
+     vielleicht lieber die Maske bitweise mit x, 1, 0 darstellen ?
+***)
+
+PROC put (BOOL CONST b):
+  IF b
+    THEN put ("Ja  ");
+    ELSE put ("Nein");
+  FI
+END PROC put;
+
+
+(********************* interne Hilfsprozeduren ****************************) 
+ 
+TEXT PROC text (UNSIGNED CONST a, REPRESENTATION CONST r) : 
+  TEXT VAR result :: "";
+  INT  VAR i;
+  set conversion (TRUE);
+  IF CONCR (r) = 10   THEN decimal form
+  ELIF CONCR (r) = 2  THEN binary form 
+  ELSE hex form  FI. 
+ 
+decimal form :
+  IF bit (a, 15)  (* dann kriegt man im Eumel negatives Vorzeichen *)
+  THEN result := text (real (text (a)) + 65536.0); (* Der Umweg ueber
+       Text ist noetig, wegen (1.8.0) real (-32767-1) --> stack overflow *)
+       subtext (result, 1, pos (result, ".") - 1) (* Dezimalpunkt weghauen *)
+  ELSE text (a)  FI. 
+
+binary form : 
+  FOR i FROM 15 DOWNTO 0 REP
+    IF bit (a, i) THEN result CAT "1" ELSE result CAT "0"  FI 
+  PER; 
+  result + "b". 
+ 
+hex form : 
+  INT VAR help :: a; 
+  FOR i FROM 1 UPTO 4 REP 
+    rotate (help, 4);    (* oberste 4 bit zu untersten 4 machen *)
+    result CAT (hex digits SUB nibble + 1);  (* oberste 4 bit darstellen *) 
+  PER; 
+  result + "h". 
+ 
+nibble : 
+  help MOD 16.   (* unterste 4 bit *) 
+END PROC text; 
+
+TEXT PROC textform (UNSIGNED CONST a) : 
+  (* speichert das INT in einen TEXT (mit ISUB lesbar) *) 
+  TEXT VAR ta :: "  ";
+  replace (ta, 1, a);
+  ta 
+END PROC textform; 
+ 
+TEXT PROC reverse (TEXT CONST a) : 
+  (* Text umdrehen. Das braucht man, um die ISUBS direkt vergleichen zu
+     koennen. 
+  *)
+  IF LENGTH a <= 1 THEN a 
+  ELSE reverse (subtext (a, 2)) + (a SUB 1)  FI 
+END PROC reverse;
+
+PROC test up or down (TEXT CONST prompt, data) :
+  IF current direction <> "" AND NOT direction valid
+  THEN current direction := "";
+       LEAVE test up or down
+  FI;
+  out (prompt);
+  out ("       "8""8""8""8""8""8"");  (* nächste 6 Zeichen Löschen *)
+  out (data); LENGTH data TIMESOUT ""8"";
+  IF NOT direction valid THEN LEAVE test up or down  FI;
+  getchar (current direction);
+  IF current direction = up OR current direction = down
+  THEN (* verschlucken, spaeter auswerten *)
+  ELSE push (current direction);
+       current direction := ""
+  FI
+END PROC test up or down;
+
+TEXT PROC to lower (TEXT CONST text) :
+  TEXT VAR t :: text;
+  INT  VAR i;
+  FOR i FROM 1 UPTO LENGTH t REP
+    IF (t SUB i) >= ""65"" AND (t SUB i) <= ""90""
+    THEN replace (t, i, code (code (t SUB i) + 32))  FI
+  PER;
+  t
+END PROC to lower;
+
+END PACKET setup eumel basisoperationen;
+
+
+
+PACKET splitting DEFINES  low byte,     (* Copyright (C) 1985       *)
+                          high byte,    (* Martin Schönbeck, Spenge *)
+                          low word,     (* Stand: 13.09.85          *)
+                          high word: 
+ 
+INT PROC high byte (INT CONST value):
+ 
+    TEXT VAR x := "  ";
+    replace (x, 1, value);
+    code (x SUB 2)
+
+END PROC high byte;
+
+INT PROC low byte (INT CONST value):
+ 
+    TEXT VAR x := "  ";
+    replace (x, 1, value);
+    code (x SUB 1)
+
+END PROC low byte; 
+ 
+INT PROC high word (REAL CONST double precission int):
+
+    int (double precission int / 65536.0)
+
+END PROC high word;
+
+INT PROC low word (REAL CONST double precission int): 
+ 
+    string of low bytes ISUB 1.
+
+string of low bytes:
+    code (int (double precission int MOD 256.0)) +
+    code (int ((double precission int MOD 65536.0) / 256.0)). 
+ 
+END PROC low word; 
+ 
+END PACKET splitting;
+
+
+
+PACKET basic block io DEFINES
+  verify track, 
+  read block,
+  write block:
+
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code):
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, 0, block no, return code).
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 INT CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, 0, block no, return code).
+ 
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block; 
+
+PROC read block (DATASPACE VAR ds, INT CONST ds page,
+                 REAL CONST archive block):
+
+   enable stop;
+   read block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht gelesen werden");
+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+
+END PROC read block;
+
+PROC write block (DATASPACE CONST ds, INT CONST ds page,
+                  REAL CONST archive block):
+
+   enable stop;
+   write block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht geschrieben werden");
+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+
+END PROC write block;
+
+PROC read block (DATASPACE VAR ds,
+                 INT CONST ds page no, 
+                 REAL CONST block no,
+                 INT VAR return code):
+  read block; 
+  retry if read error.
+ 
+read block: 
+  block in (ds, ds page no, high word (block no) OR -512,
+                             low word (block no), return code).
+ 
+retry if read error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    read block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN block in (ds, ds page no, 0, 0, return code) 
+  FI. 
+ 
+END PROC read block;
+ 
+PROC write block (DATASPACE CONST ds,
+                 INT CONST ds page no, 
+                 REAL CONST block no,
+                 INT VAR return code):
+  write block; 
+  retry if write error. 
+ 
+write block: 
+  block out (ds, ds page no, high word (block no) OR -512,
+                              low word (block no), return code).
+ 
+retry if write error: 
+  INT VAR retry;
+  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
+    reset to block 0 if fifth try; 
+    write block 
+  PER. 
+ 
+reset to block 0 if fifth try: 
+  IF retry = 5 
+    THEN disable stop;
+         DATASPACE VAR dummy ds := nilspace;
+         block in (dummy ds, 2, 0, 0, return code);
+         forget (dummy ds);
+         enable stop
+  FI. 
+ 
+END PROC write block; 
+
+PROC verify track (DATASPACE VAR ds, INT CONST ds page no,
+                   REAL CONST startblock no, INT VAR return code):
+  block in (ds, ds page no, high word (startblock no) OR -256,
+                   low word (startblock no), return code);
+END PROC verify track;
+
+END PACKET basic block io;
+
+
+
+PACKET write file DEFINES write file,   (* Copyright (C) 1985, 1987 *)
+                          read file :   (* Martin Schönbeck, Spenge *)
+                                        (* Lutz Prechelt, Karlsruhe *)
+                                        (* Stand: 07.06.87          *)
+
+PROC write file (TEXT CONST file name, REAL CONST start block,
+                 INT CONST number of blocks): 
+ 
+    INT VAR count;
+    disable stop; 
+    DATASPACE VAR ds := old (file name);
+    FOR count FROM 0 UPTO (number of blocks - 1) REP 
+        write block (ds, count + 3, start block + real (count)) 
+    UNTIL is error PER; 
+    forget (ds). 
+ 
+END PROC write file; 
+ 
+PROC write file (TEXT CONST file name, REAL CONST start block,
+                 INT CONST number of blocks, write channel): 
+ 
+    enable stop; 
+    INT VAR old channel := channel;
+    IF old channel <> write channel THEN continue (write channel)  FI;
+    disable stop;
+    write file (file name, start block, number of blocks);
+    IF old channel <> write channel
+    THEN break (quiet);
+         continue (old channel)
+    FI.
+END PROC write file;
+
+PROC read file (DATASPACE VAR file, REAL CONST start block,
+                 INT CONST number of blocks): 
+    INT VAR count;
+    disable stop; 
+    forget (file); file := nilspace;
+    FOR count FROM 0 UPTO (number of blocks - 1) REP 
+        read block (file, count + 3, start block + real (count)) 
+    UNTIL is error PER.
+END PROC read file; 
+ 
+PROC read file (DATASPACE VAR file, REAL CONST start block,
+                INT CONST number of blocks, read channel): 
+    enable stop; 
+    INT VAR old channel := channel;
+    IF old channel <> read channel THEN continue (read channel)  FI;
+    disable stop;
+    read file (file, start block, number of blocks);
+    IF old channel <> channel
+    THEN break (quiet);
+         continue (old channel)
+    FI.
+END PROC read file;
+
+END PACKET write file;
+
+PACKET thesaurus utilities
+DEFINES ONE, certain :                     (* Stand: 21.03.88 *)
+                                           (* Korr : Lutz Prechelt *)
+LET  max entries = 200; 
+ 
+LET oben unten rubout return = ""3""10""12""13"";
+ 
+INT  VAR anzahl, 
+         firstline, size,  (* erste Bildschirmz./Anz. Zeilen für Vorgang *)
+         realc, virtc;     (* akt. Zeile in Fenster/Eintragsnummer *)
+ 
+TEXT VAR string; 
+ 
+THESAURUS PROC certain (THESAURUS CONST in, pre) :
+  einzelne (in, pre, TRUE).
+END PROC certain;
+
+TEXT OP ONE (THESAURUS CONST t): 
+  name (einzelne (t, empty thesaurus, FALSE),1) 
+END OP ONE; 
+ 
+THESAURUS PROC einzelne (THESAURUS CONST thes, preselections, 
+                         BOOL CONST viele): 
+  (* Benutzt nur den Rest des Bildschirms ab der aktuellen Zeile nach unten. 
+     Die in preselections enthaltenen Namen aus t sind bereits zu Beginn 
+     angekreuzt. 
+     Ein Aufruf mit NOT viele und preselections/t <> empty thesaurus ist
+     nicht sinnvoll.
+     Die Cursorposition nach Verlassen ist wieder in der "aktuellen" Zeile 
+     auf Position 1, so daß mit out (""4"") der Kram selektiv gelöscht
+     werden kann.
+  *)
+  ROW maxentries TEXT VAR eintrag;
+  THESAURUS VAR ausgabe :: empty thesaurus,
+                t :: empty thesaurus + thes;  (* Leereinträge entfernen! *)
+  INT VAR i; 
+  initialisiere ankreuzen;
+  IF anzahl = 0 THEN LEAVE einzelne WITH empty thesaurus FI;
+  bildschirm vorbereiten;
+  bild (1, eintrag); 
+  virtc := 1; 
+  realc := 1; 
+  realcursor setzen; 
+  kreuze an (viele, eintrag);
+  ausgabe erzeugen; 
+  cursor (1, firstline - 2); out (""4"");
+  ausgabe. 
+ 
+initialisiere ankreuzen:
+  anzahl := highest entry (t);
+  string := "";
+  (* t enthält keine Leereinträge mehr ! *)
+  FOR i FROM 1 UPTO anzahl REP 
+     eintrag [i] := name (t,i)
+  PER;
+  FOR i FROM 1 UPTO highest entry (preselections) REP 
+    INT CONST preselection link :: link (t, name (preselections, i));
+    IF preselection link > 0
+    THEN string CAT textstr (preselection link)  FI
+  PER.
+
+bildschirm vorbereiten: 
+  get cursor (i, firstline); 
+  out (""13""4"");  (* Restbildschirm löschen *)
+  IF viele
+  THEN putline ("Wählen <CR>  Löschen <RUBOUT>  " + 
+                "alle Löschen <HOP><RUBOUT>  Beenden <ESC>q") 
+  ELSE putline ("Auswählen <CR>")  FI;
+  putline ("Marke bewegen  <RUNTER>  <RAUF>  <HOP><RUNTER>  <HOP><RAUF>"); 
+  firstline INCR 2; 
+  size := 24 - firstline + 1.
+
+ausgabe erzeugen: 
+  WHILE string <> "" REP 
+    insert (ausgabe, eintrag [string ISUB 1]);
+    string := subtext (string, 3); 
+ PER 
+END PROC einzelne; 
+ 
+PROC realcursor setzen: 
+  TEXT CONST mark :: marke (virtc, TRUE);
+  cursor (1, firstline + realc - 1); 
+  out (mark + LENGTH mark * ""8"").
+END PROC real cursor setzen; 
+ 
+TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor): 
+  INT VAR pl :: nr (zeiger); 
+  IF pl = 0 
+     THEN leer
+     ELSE mit zahl
+  FI. 
+ 
+mit zahl: 
+  IF mit cursor 
+     THEN (3 - length (text (pl))) * "-" + text (pl) + "-> " 
+     ELSE text (pl, 3) + " > " 
+  FI. 
+ 
+leer: 
+  IF mit cursor 
+     THEN ">>>>> " 
+     ELSE "      "
+  FI 
+END PROC marke; 
+ 
+PROC bild (INT CONST anfang, ROW maxentries TEXT CONST eintrag): 
+  cursor (1, firstline);
+  out (""4""3"");    (* Restschirm löschen, 1 Zeile rauf *)
+  INT VAR i; 
+  FOR i FROM anfang UPTO grenze REP 
+     out (""13""10"");
+     out (marke (i, FALSE)); 
+     out (eintrag [i]) 
+  PER. 
+ 
+grenze: 
+  min (anzahl, anfang + size - 1)
+END PROC bild; 
+ 
+PROC kreuze an (BOOL CONST viele, ROW maxentries TEXT CONST eintrag) :
+  REP zeichen lesen; 
+      zeichen interpretieren 
+  PER. 
+ 
+zeichen lesen: 
+  TEXT VAR zeichen; 
+  inchar (zeichen, ""1""27""3""10""13"1Xx+"11""12"Oo0-"). 
+ 
+zeichen interpretieren: 
+  SELECT code (zeichen) OF 
+    CASE   1 (* hop *)    : hoppen (eintrag)
+    CASE  27 (* ESC *)    : IF incharety (600) = "q" THEN LEAVE kreuze an  FI
+    CASE   3 (* rauf *)   : nach oben (eintrag)
+    CASE  10 (* runter *) : nach unten (eintrag)
+    CASE  13 (* Return *) : ankreuzen (eintrag, TRUE); evtl aufhoeren
+    CASE  49,(* 1 *)
+          88,(* X *)
+         120,(* x *)
+          43,(* + *)
+          11 (* Rubin *)  : ankreuzen (eintrag, FALSE); evtl aufhoeren 
+    CASE  12,(* Rubout *)
+          79,(* O *)
+         111,(* o *)
+          48,(* 0 *)
+          45 (* - *)      : auskreuzen (eintrag)
+  END SELECT. 
+ 
+evtl aufhoeren: 
+  IF NOT viele THEN LEAVE kreuze an FI. 
+ 
+END PROC kreuze an; 
+ 
+PROC hoppen (ROW maxentries TEXT CONST eintrag) :
+  zweites zeichen lesen; 
+  zeichen interpretieren. 
+ 
+zweites zeichen lesen: 
+  TEXT VAR zz; 
+  inchar (zz).
+ 
+zeichen interpretieren: 
+  SELECT pos (oben unten rubout return, zz) OF 
+    CASE 1 : hop nach oben 
+    CASE 2 : hop nach unten 
+    CASE 3 : alles loeschen 
+    CASE 4 : rest ankreuzen
+    OTHERWISE out (""7"")
+  END SELECT. 
+ 
+rest ankreuzen:
+  INT VAR i;
+  FOR i FROM 1 UPTO anzahl REP     (* alles *)
+    IF nr (i) = 0                  (* was noch nicht angekreuzt ist *)
+       THEN string CAT textstr (i) (* ankreuzen *)
+    FI
+  PER;
+  bild aktualisieren.
+
+alles loeschen: 
+  string := ""; 
+  bild aktualisieren.
+ 
+hop nach oben: 
+  IF   ganz oben 
+       THEN out (""7"") 
+  ELIF oben im fenster    
+       THEN raufblaettern 
+       ELSE top of page 
+  FI. 
+ 
+ganz oben: 
+  virtc = 1. 
+ 
+oben im fenster: 
+  realc = 1. 
+ 
+raufblaettern: 
+  virtc DECR size;
+  virtc := max (virtc, 1); 
+  bild (virtc, eintrag); 
+  realcursor setzen. 
+ 
+top of page: 
+  loesche marke; 
+  virtc DECR (realc - 1); 
+  realc := 1; 
+  realcursor setzen. 
+ 
+hop nach unten: 
+  IF   ganz unten 
+       THEN out (""7"") 
+  ELIF unten im fenster 
+       THEN runterblaettern 
+       ELSE bottom of page 
+  FI. 
+ 
+ganz unten: 
+  virtc = anzahl. 
+ 
+unten im fenster: 
+  firstline + realc > 24. 
+ 
+runterblaettern: 
+  INT VAR alter virtc :: virtc; 
+  virtc INCR size;
+  virtc := min (virtc, anzahl); 
+  realc := virtc - alter virtc; 
+  bild (alter virtc + 1, eintrag);
+  realcursor setzen. 
+ 
+bottom of page: 
+  loesche marke; 
+  alter virtc := virtc; 
+  virtc INCR (size - realc); 
+  virtc := min (anzahl, virtc); 
+  realc INCR (virtc - alter virtc); 
+  realcursor setzen 
+END PROC hoppen; 
+ 
+PROC ankreuzen (ROW maxentries TEXT CONST eintrag, BOOL CONST ggf auskreuzen):
+  (* bei ggf auskreuzen wird der Eintrag, falls er schon angekreuzt ist,
+     ausgekreuzt, andernfalls normal angekreuzt.
+  *)
+  INT VAR pl :: nr (virtc); 
+  IF pl <> 0 
+     THEN schon angekreuzt
+  FI; 
+  string CAT textstr (virtc); 
+  IF virtc < anzahl THEN nach unten (eintrag) ELSE realcursor setzen  FI.
+
+schon angekreuzt :
+  IF ggf auskreuzen THEN auskreuzen (eintrag) ELSE out (""7"")  FI;
+  LEAVE ankreuzen.
+END PROC ankreuzen; 
+ 
+PROC auskreuzen (ROW maxentries TEXT CONST eintrag) :
+  INT VAR posi :: nr (virtc); 
+  IF posi = 0 
+     THEN out (""7""); LEAVE auskreuzen 
+  FI; 
+  rausschmeissen; 
+  loesche marke; 
+  bild aktualisieren; 
+  IF virtc < anzahl THEN nach unten (eintrag) FI.
+ 
+rausschmeissen: 
+  string := subtext (string,1, 2*posi-2) + subtext (string,2*posi+1) 
+END PROC auskreuzen; 
+ 
+PROC bild aktualisieren: 
+  INT VAR ob, un, i; 
+  ob := virtc - realc + 1; 
+  un := min (ob + size - 1, anzahl); 
+  cursor (1, firstline - 1); 
+  FOR i FROM ob UPTO un REP 
+    out (""13""10""); out (marke (i, FALSE))
+  PER;
+  realcursor setzen.
+END PROC bild aktualisieren; 
+ 
+PROC nach oben (ROW maxentries TEXT CONST eintrag) :
+  IF noch nicht oben   (* virtuell *) 
+     THEN gehe nach oben 
+     ELSE out (""7"") 
+  FI;
+  realcursor setzen.
+ 
+noch nicht oben: 
+  virtc > 1. 
+ 
+gehe nach oben: 
+  IF realc = 1 
+     THEN scroll down 
+     ELSE cursor up 
+  FI. 
+ 
+scroll down: 
+  virtc DECR 1; 
+  bild (virtc, eintrag).
+ 
+cursor up: 
+  loesche marke; 
+  virtc DECR 1; 
+  realc DECR 1.
+END PROC nach oben; 
+ 
+PROC nach unten (ROW maxentries TEXT CONST eintrag) :
+  IF noch nicht unten  (* virtuell *) 
+     THEN gehe nach unten
+     ELSE out (""7"")
+  FI. 
+ 
+noch nicht unten: 
+  virtc < anzahl. 
+ 
+gehe nach unten:
+  IF realc > size - 1 
+     THEN scroll up 
+     ELSE cursor down 
+  FI. 
+ 
+scroll up: 
+  virtc INCR 1; 
+  bild (virtc - size + 1, eintrag); 
+  realcursor setzen. 
+ 
+cursor down: 
+  loesche marke; 
+  virtc INCR 1; 
+  realc INCR 1; 
+  realcursor setzen 
+END PROC nach unten; 
+ 
+PROC loesche marke: 
+  out (marke (virtc, FALSE)) 
+END PROC loesche marke; 
+ 
+TEXT PROC textstr (INT CONST nr): 
+  TEXT VAR help :: "  "; 
+  replace (help, 1, nr); 
+  help.
+END PROC textstr; 
+ 
+INT PROC nr (INT CONST zeiger): 
+  IF pos (string, textstr (zeiger)) = 0 (* haut hin, da zeiger < 255 *)
+     THEN 0 
+     ELSE (pos (string,textstr (zeiger)) DIV 2) + 1 
+  FI 
+END PROC nr;
+
+PROC inchar (TEXT VAR t, TEXT CONST allowed) : 
+  REP 
+    getchar (t); 
+    IF pos (allowed, t) = 0 THEN out (""7"")  FI 
+  UNTIL pos (allowed, t) > 0  PER. 
+END PROC inchar; 
+ 
+END PACKET thesaurus utilities;
+
diff --git a/system/setup/3.1/src/setup eumel 2: modulzugriffe b/system/setup/3.1/src/setup eumel 2: modulzugriffe
new file mode 100644
index 0000000..42163f4
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 2: modulzugriffe
@@ -0,0 +1,441 @@
+
+(* Pakete:
+ 1. setup eumel modulzugriffe
+       Abstrakter Datentyp MODUL : Typ, Datenraumtyp, Zugriffsoperationen
+ 2. setup eumel modul und shard zugriffe
+       Zugriffe in Module und SHards (Datentyp MODUL) mit Strukturwissen
+*)
+ 
+(**************************************************************************)
+(***** Datentyp MODUL und Zugriffsoperationen dafür        ****************)
+(***** Copyright (c) 1987, 1988 by                         ****************)
+(***** Lutz Prechelt, Karlsruhe                            ****************)
+(**************************************************************************)
+
+PACKET setup eumel modulzugriffe            (* Copyright (c) 1987 by    *)
+DEFINES int, byte, text, unsigned,          (* Lutz Prechelt, Karlsruhe *)
+        dtcb abfragen,    ccb abfragen,     (* Stand : 12.03.88   1.1   *)
+        dtcb refinements, ccb refinements,  (* Eumel 1.8.1              *)
+        info,
+        page,
+        copy,
+        datenraumtyp modul,
+        MODUL :
+
+
+(* Dies Paket realisiert gezielte Zugriffe in einen Struct vom Typ MODUL.
+   Dies ist das Format eines SHard Moduls. Der Typ wird auch verwendet, um
+   das SHard-Hauptmodul oder einzelne ccbs zu handhaben!
+   Für die Adressierung der Bytes werden REAL-Werte verwendet, damit die
+   Größe nicht auf maxint beschränkt ist. Dies ist normalerweise sicher
+   (wegen der BCD-Arithmetik des Eumel), jedoch sind sinnlose nichtganzzahlige
+   Adressen dadurch möglich. Das wird aus Effizienzgründen nicht abgefangen,
+   die korrekte Benutzung liegt in der Verantwortung des Aufrufers.
+   Es sollen alle Zugriffe auf Module nur mit den Prozeduren dieses Pakets
+   abgewickelt werden.
+*) 
+ 
+ 
+INT CONST high only ::-256,
+          low  only :: 255;
+
+LET  max page = 128;
+
+TYPE MODUL =   STRUCT (ALIGN dummy, ROW 256 INT header,
+                      ROW max page ROW 256 INT b, 
+                      INT dtcb abfragen, ccb abfragen, 
+                      TEXT dtcb ref, ccb ref, info);
+
+(* Der Typ kann wegen des ALIGN direkt auf einen Datenraum (für ein Modul)
+   gelegt werden. Der Teil b fasst 64kB Daten und kann direkt für blockout
+   verwendet werden. Die restlichen Teile sind nur für Module relevant. 
+*) 
+ 
+INT CONST datenraumtyp modul :: 5687;  (* Typ eines MODUL als Datenraum *)
+
+(*********************** INT ********************************************)
+
+INT PROC int (MODUL CONST m, REAL CONST byte nr) : 
+  (* liefert das INT aus dem Modul m, das bei Byte "byte nr" beginnt *)
+  INT VAR   page :: int (byte nr DIV 512.0) + 1,
+            nr   :: int (byte nr MOD 512.0) DIV 2 + 1;
+  INT VAR   whole int :: m.b[page][nr];
+  IF byte nr MOD 2.0 <> 0.0 
+  THEN rotate (whole int, 8); (* high und low byte vertauschen *)
+       (whole int AND low only) + next byte in high
+  ELSE whole int  FI.
+
+next byte in high :
+  IF nr = 256 THEN nr := 1; page INCR 1 ELSE nr INCR 1  FI;
+  INT VAR help :: m.b[page][nr] AND low only;
+  rotate (help, 8);
+  help.
+END PROC int;
+
+INT PROC int (MODUL CONST m, INT CONST byte nr) :
+  int (m, real (byte nr))
+END PROC int;
+
+PROC int (MODUL VAR m, REAL CONST byte nr, INT CONST new) :
+  (* schreibt den neuen 16-Bit Wert new ab dem Byte "byte nr" in den Teil b
+     des Moduls m. Hier kommt es nicht sehr aufs Tempo an, deshalb benutzen
+     wir hier einfach "byte".
+  *)
+  INT VAR value :: new;
+  rotate (value, 8); (* high byte zu low byte machen *)
+  byte (m, byte nr,       new   AND low only);
+  byte (m, byte nr + 1.0, value AND low only);
+END PROC int;
+
+PROC int (MODUL VAR m, INT CONST byte nr, INT CONST new) :
+  int (m, real (byte nr), new)
+END PROC int;
+
+(************************** BYTE *******************************************)
+
+INT PROC byte (MODUL CONST m, REAL CONST byte nr) : 
+  (* liefert das Byte mit der Nummer "byte nr" aus dem Teil b des Moduls m.
+     Das erste Byte hat die Nummer 0
+  *)
+  INT CONST page :: int (byte nr DIV 512.0) + 1,
+            nr   :: int (byte nr MOD 512.0) DIV 2 + 1;
+  INT VAR   whole int :: m.b[page][nr];
+  IF byte nr MOD 2.0 <> 0.0 
+  THEN rotate (whole int, 8); (* high und low byte vertauschen *)  FI; 
+  whole int AND low only. 
+END PROC byte; 
+ 
+INT PROC byte (MODUL CONST m, INT CONST byte nr) :
+  byte (m, real (byte nr))
+END PROC byte;
+
+PROC byte (MODUL VAR m, REAL CONST byte nr, INT CONST new) :
+  (* Schreibt die unteren 8 bit von new an das Byte der Stelle byte nr im
+     Modul m
+  *)
+  INT CONST page :: int (byte nr DIV 512.0) + 1,
+            nr   :: int (byte nr MOD 512.0) DIV 2 + 1;
+  INT VAR   new byte  :: new AND low only,
+            whole int :: m.b[page][nr];
+  m.b[page][nr] := new int.
+
+new int :
+  IF byte nr MOD 2.0 = 0.0  (* low byte ändern ? *)
+  THEN (whole int AND high only) + new byte
+  ELSE rotate (new byte, 8); (* new nach high rotieren *)
+       new byte + (whole int AND low only)
+  FI.
+END PROC byte;
+
+PROC byte (MODUL VAR m, INT CONST byte nr, INT CONST new) :
+  byte (m, real (byte nr), new)
+END PROC byte;
+
+(*********************** TEXT ********************************************)
+
+TEXT PROC text (MODUL CONST m, REAL CONST first byte nr, INT CONST length) : 
+  (* Extrahiert die naechsten length bytes aus m ab byte nr als TEXT *) 
+  REAL VAR i :: first byte nr;
+  TEXT VAR result :: ""; 
+  WHILE i < first byte nr + real (length) REP
+    result CAT code (byte (m, i)); 
+    i INCR 1.0
+  PER; 
+  result. 
+END PROC text; 
+ 
+TEXT PROC text (MODUL CONST m, INT CONST first byte nr, INT CONST length) : 
+  text (m, real (first byte nr), length)
+END PROC text;
+
+(* Ein schreibendes Analogon zu "text" gibt es nicht. *)
+
+(*********************** unsigned *****************************************)
+
+REAL PROC unsigned (INT CONST sixteen bits) :
+  (* hiermit kann man die Vorzeichenprobleme umschiffen, die der Eumel bei
+     INTs über maxint macht.
+     Liefert das INT als 16-Bit unsigned Wert interpretiert im REAL-Format.
+  *)
+  real (text (sixteen bits, dec))
+END PROC unsigned;
+
+INT PROC unsigned (REAL CONST sixteen bit value) :
+  (* Umkehrung des obigen : REAL 0..65536 rein, passenden 16 bit unsigned
+     Wert raus
+  *)
+  TEXT CONST t :: text (sixteen bit value);
+  int (unsigned (value text)).
+
+value text :
+  IF pos (t, ".") <> 0
+  THEN subtext (t, 1, pos (t, ".") - 1)
+  ELSE t
+  FI.
+END PROC unsigned;
+
+(******************** dtcb, ccb, info **************************************)
+
+INT PROC dtcb abfragen (MODUL CONST m) :
+  m.dtcb abfragen
+END PROC dtcb abfragen;
+
+PROC dtcb abfragen (MODUL VAR m, INT CONST neu) :
+  m.dtcb abfragen := neu
+END PROC dtcb abfragen;
+
+TEXT PROC dtcb refinements (MODUL CONST m) :
+  m.dtcb ref
+END PROC dtcb refinements;
+
+PROC dtcb refinements (MODUL VAR m, TEXT CONST neu) :
+  m.dtcb ref := neu
+END PROC dtcb refinements;
+
+INT PROC ccb abfragen (MODUL CONST m) :
+  m.ccb abfragen
+END PROC ccb abfragen;
+
+PROC ccb abfragen (MODUL VAR m, INT CONST neu) :
+  m.ccb abfragen := neu
+END PROC ccb abfragen;
+
+TEXT PROC ccb refinements (MODUL CONST m) :
+  m.ccb ref
+END PROC ccb refinements;
+
+PROC ccb refinements (MODUL VAR m, TEXT CONST neu) :
+  m.ccb ref := neu
+END PROC ccb refinements;
+
+TEXT PROC info (MODUL CONST m) :
+  m.info
+END PROC info;
+
+PROC info (MODUL VAR m, TEXT CONST neu) :
+  m.info := neu
+END PROC info;
+
+(********************* page **********************************************)
+
+(* Die Prozedur page dient dazu, aus dem Datenbereich b eines MODULs
+   einzelne Seiten (512 Byte Blöcke) in Form eines ROW 256 INT anzusprechen
+   um damit blockin/blockout zu machen.
+   Die Seitennummern gehen von 1 bis max page
+*)
+
+ROW 256 INT PROC page (MODUL CONST m, INT CONST page nr) :
+  m.b[page nr]
+END PROC page;
+
+PROC page (MODUL VAR m, INT CONST page nr, ROW 256 INT CONST new page) :
+  m.b[page nr] := new page
+END PROC page;
+
+(*********************** copy ********************************************)
+
+PROC copy (MODUL CONST from, REAL CONST origin,
+           MODUL VAR   to,   REAL CONST destination, INT CONST length) :
+  (* Kopiert schnell eine Anzahl von Bytes aus einem Modul in ein anderes
+     die Optimierung klappt nur, wenn von einer geraden Adresse an eine
+     gerade Adresse kopiert wird oder von ungerade nach ungerade.
+     Macht cout.
+  *)
+  INT  VAR i, interval :: cout interval;
+  REAL VAR offset :: 0.0;
+  IF length < 0 THEN errorstop ("copy : length = " + text (length))  FI;
+  IF origin MOD 2.0 <> destination MOD 2.0
+  THEN copy slow
+  ELSE copy fast  FI;
+  cout (length).
+
+cout interval :
+  IF   length > 1024   THEN 32
+  ELIF length >   64   THEN  8
+  ELSE                       1  FI.
+
+copy slow :
+  FOR i FROM 1 UPTO length REP
+    IF i MOD 2*interval = 0 THEN cout (i)  FI;
+    byte (to, destination + offset, byte (from, origin + offset));
+    offset INCR 1.0
+  PER.
+
+copy fast :
+  IF origin MOD 2.0 <> 0.0 AND length > 0
+  THEN byte (to, destination, byte (from, origin));
+       offset := 1.0
+  FI;
+  FOR i FROM 1 UPTO (length - int (origin MOD 2.0))  DIV 2 REP
+    INT CONST page1 :: int ((origin+offset) DIV 512.0) + 1,
+              nr1   :: int ((origin+offset) MOD 512.0) DIV 2 + 1,
+              page2 :: int ((destination+offset) DIV 512.0) + 1,
+              nr2   :: int ((destination+offset) MOD 512.0) DIV 2 + 1;
+    to.b[page2][nr2] := from.b[page1][nr1];
+    IF i MOD interval = 0 THEN cout (2*i)  FI;
+    offset INCR 2.0
+  PER;
+  IF length - int (offset) = 1
+  THEN byte (to, destination + offset, byte (from, origin + offset))  FI.
+END PROC copy;
+
+(************************ Hilfsprozeduren ********************************)
+
+REAL OP DIV (REAL CONST a, b) :
+  floor (a/b)
+END OP DIV;
+
+END PACKET setup eumel modulzugriffe;
+
+ 
+(**************************************************************************)
+(***** Zugriffe in Module mit Strukturwissen               ****************)
+(***** Copyright (c) 1988 by                               ****************)
+(***** Lutz Prechelt, Karlsruhe                            ****************)
+(**************************************************************************)
+
+PACKET setup eumel modul und shard zugriffe (* Copyright (c) 1988 by    *)
+DEFINES sh dtcb offset,                     (* Lutz Prechelt, Karlsruhe *)
+        sh ccb offset,                      (* Stand : 23.04.88   1.2   *)
+        get new channel table,              (* Eumel 1.8.1              *)
+        init modules list,
+        all modules,
+        module type,
+        module name:
+
+(* Dieses Paket definiert Operationen zum Zugriff auf bestimmte Daten in 
+   SHardmodulen und SHards. Es ist hierin Wissen über die Struktur dieser 
+   Teile enthalten. 
+   Beschreibung des SHardformats siehe setup eumel 4: modulkonfiguration
+*) 
+
+LET nr of channels total          = 40,
+    offset channel table pointer  = 10;
+
+THESAURUS VAR all the beautiful modules we know :: emptythesaurus;
+ 
+(******************* Kanaltabelle lesen/schreiben **************************)
+
+(* Hier geht schöne Struktur (und damit zugleich einfache Programmierung)
+   über gute Performance. (Wir lesen einiges mehrfach)
+*)
+
+REAL PROC sh dtcb offset (MODUL CONST shard, INT CONST kanal) :
+  unsigned (int (shard, ct + 4 * kanal)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh dtcb offset;
+
+REAL PROC sh ccb offset (MODUL CONST shard, INT CONST kanal) :
+  unsigned (int (shard, ct + 4 * kanal + 2)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh ccb offset;
+
+PROC sh dtcb offset (MODUL VAR shard, INT CONST kanal, REAL CONST value) :
+  int (shard, ct + 4 * kanal, unsigned (value)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh dtcb offset;
+
+PROC sh ccb offset (MODUL VAR shard, INT CONST kanal, REAL CONST value) :
+  int (shard, ct + 4 * kanal + 2, unsigned (value)).
+
+ct :
+  int (shard, offset channel table pointer).
+END PROC sh ccb offset;
+
+PROC get new channel table (MODUL CONST new shard,
+                            ROW 256 INT VAR channel table of new shard) :
+  (* Kopiert die Kanaltabelle aus new shard nach
+     channel table of new shard
+  *)
+  INT VAR offset :: int (new shard, offset channel table pointer);
+  INT VAR  i;
+  FOR i FROM 1 UPTO 2 * nr of channels total REP
+    channel table of new shard [i] := int (new shard, offset);
+    offset INCR 2
+  PER.
+END PROC get new channel table;
+
+(********************* modules list handling *****************************)
+
+TEXT VAR m list;
+
+PROC init modules list :
+  (* Baut in der Variablen m list einen "Assoziativspeicher" für
+     Modulnamen <--> Modultyp auf und erstellt eine Liste aller
+     Shardmoduldateinamen für "all modules"
+     Der Text m list enthält für jede Datei, die ein SHardmodul enthält,
+     einen Eintrag folgender Form :
+     ""0"", modultyp, ""0"", Dateiname, ""0""
+     Dabei ist modultyp genau 4 Byte lang.
+     Diese Eintragsform ermöglicht ein (auf dem Eumel) sehr effizientes
+     Suchen, sowohl von Modultypen zu Modulnamen als auch umgekehrt.
+     Die Prozedur macht cout (dateinummer)
+  *)
+  INT VAR i;
+  TEXT VAR t;
+  m list := ""; all the beautiful modules we know := empty thesaurus;
+  FOR i FROM 1 UPTO highest entry (all) REP
+     cout (i);
+     t := name (all, i);
+     IF t <> "" CAND type (old (t)) = datenraumtyp modul
+     THEN add t  FI
+  PER.
+
+add t :
+  insert (all the beautiful modules we know, t);
+  TEXT CONST typ :: read module type (t);
+  m list cat typmarker;
+  m list CAT t;
+  m list CAT ""0"".
+
+m list cat typmarker :
+  m list CAT ""0"";
+  m list CAT typ;
+  m list CAT ""0"".
+END PROC init modules list;
+
+THESAURUS PROC all modules :
+  all the beautiful modules we know.
+END PROC all modules;
+
+TEXT PROC read module type (TEXT CONST datei) : 
+  (* Liefert den 4-Byte Modultyp des in der Datei datei enthaltenen 
+     SHardmoduls, falls möglich, andernfalls "" 
+  *) 
+  IF NOT exists (datei) COR type (old (datei)) <> datenraumtyp modul 
+  THEN ""
+  ELSE BOUND MODUL CONST m :: old (datei); 
+       text (m, int (m, 8), 4)
+  FI.
+END PROC read module type; 
+ 
+TEXT PROC module type (TEXT CONST module name) :
+  (* Liefert den 4-Byte Modultyp zu module name aus m list, sofern vorhanden
+     andernfalls ""
+  *)
+  INT CONST p :: pos (m list, ""0"" + module name + ""0"");
+  IF p = 0
+  THEN ""
+  ELSE subtext (m list, p - 4, p - 1)  FI.
+END PROC module type;
+
+TEXT PROC module name (TEXT CONST module type) :
+  (* Liefert den Moduldateinamen zum 4-Byte Modultyp module type, oder
+     "" falls kein solches Modul vorhanden.
+  *)
+  INT VAR p :: pos (m list, ""0"" + module type + ""0"");
+  IF p = 0
+  THEN ""
+  ELSE p INCR 6;
+       subtext (m list, p, pos (m list, ""0"", p) - 1)
+  FI.
+END PROC module name;
+
+END PACKET setup eumel modul und shard zugriffe;
+
diff --git a/system/setup/3.1/src/setup eumel 3: modulkonfiguration b/system/setup/3.1/src/setup eumel 3: modulkonfiguration
new file mode 100644
index 0000000..529d0de
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 3: modulkonfiguration
@@ -0,0 +1,854 @@
+
+(**************************************************************************)
+(***** Ergänzung des SHards um ein Modul (mit Dialog)     *****************)
+(***** Copyright (c) 1987, 1988 by                        *****************)
+(***** Lutz Prechelt, Karlsruhe                           *****************)
+(**************************************************************************)
+
+PACKET setup eumel modulkonfiguration     (* Copyright (c) by         *)
+DEFINES configurate module,               (* Lutz Prechelt, Karlsruhe *)
+        print configuration,              (* Eumel 1.8.1              *)
+        give me, take you,                (* Stand : 12.07.88   3.2   *)
+        new index,                        
+        perform dtcb dialogue,
+        perform ccb  dialogue,
+        (* für Modulprogrammierer : *)
+        write info,
+        channel free,
+        reserve channel,
+        channels of this module,
+        buffer address :
+
+(* Dieses Modul führt den kompletten Dialog mit dem Benutzer durch, der
+   nötig ist, um alle Kanäle, die mit demselben Modul laufen sollen, zu 
+   konfigurieren. 
+   Verfahren : 
+      im alten SHard den dtcb suchen 
+      dtcb und Modul im neuen SHard eintragen
+      dtcb mit oder ohne Vorbild konfigurieren 
+      alle ccbs zu dem Modul im alten SHard suchen und Kanalnummern merken
+      Auswahl einer Kanalmenge durch Benutzer mit alten als Vorschlag
+      ccbs in neuen SHard kopieren
+      ccbs mit oder ohne Vorbild konfigurieren
+      Kanaltabelle auf den neuen Stand bringen
+      neuen Shard und seine geänderte Länge zurückgeben 
+
+   Dabei kann der "Dialog" bei geeigneten Rahmenbedingungen durch bloßes
+   Übertragen der Werte aus einem Vorlage-SHard ersetzt werden, wenn der
+   Benutzer dies wünscht (want automatic mode). Dann geht alles von selbst.
+   (....kaufen Sie Setup-Eumel und es geht alles wie von selbst !)
+
+Format des SHard-Hauptmoduls : 
+   1. (Byte 0-2)     jmp boot (3 Byte)
+   2. (Byte 3)       reserviert
+   3. (Byte 4)       SHard-Version
+   4. (Byte 5)       SHard-Release
+   5. (Byte 6/7)     SHardlänge (2 Byte)
+   6. (Byte 8/9)     Verweis auf Bad-Block Tabelle (2 Byte)
+   7. (Byte 10/11)   Verweis auf Kanaltabelle
+   8. (Byte 16-175)  Eumelleiste
+   9. (Byte 176-299) SHardleiste
+  10. (ab Byte 300)  Shardhauptmodulroutinen und -daten
+  11. (danach)       Rumpf des Hauptmoduls mit Bad-Block-Tabelle,
+                     Kanaltabelle, Routinen und Daten
+  12. (danach)       Folge der Module (bis Byte SHardlänge - 1)
+
+Kanaltabelle:
+        feste Länge 40 Einträge "nr of channels total" (Kanal 0 bis Kanal 39)
+        jeder Eintrag besteht aus : (alles 2 Byte) 
+        offset dtcb, offset ccb 
+ 
+Achtung : Dieses Programm schmiert bei SHards über 32767 Byte Länge
+          eventuell ab (es hat noch niemand probiert) !
+
+Abkürzungen: cb steht für control block und meint entweder ccb oder dtcb 
+ 
+Implementationsanmerkung :
+Bei der Verwendung von THESAURUS wird von dem Wissen über die Art der
+Implementation derselben Gebrauch gemacht, indem folgende Annahmen in den
+Code eingehen:
+1. Bei einem THESAURUS, in dem nicht gelöscht wurde, ist highest entry gleich
+   der Kardinalität
+2. außerdem entspricht dann die Nummer (link) eines Eintrags seinem
+   Eintragszeitpunkt, d.h. der Position in der Eintragsfolge
+3. + und - liefert THESAURi, in denen nicht gelöscht wurde und die Eintrags-
+   reihenfolge ist wie von den Parametern vorgegeben (bei + links zuerst)
+4. certain und ONE liefern THESAURi, in denen nicht gelöscht wurde.
+*)
+
+(************************* Daten ********************************)
+
+LET    nr of channels total          = 40,  (* SHard Tabellenlänge *)
+       mdts                          = 40,  (* max dialogtable size in INTs *)
+       mchm                          = 20,  (* max channels for module *)
+       offset sh version             = 4,
+       offset sh structureversion    = 5,
+       offset shardlength            = 6,
+
+       do name = "PrOgRaM tO Do";
+
+LET  UNSIGNED  = INT,
+     VARIABLES = ROW mdts ROW mchm INT;
+TEXT CONST variables var xxv :: "ROW " + text (mdts) + " ROW "+
+                                text (mchm) + " INT VARxxv;";
+
+VARIABLES VAR v;             (* siehe give me / take you *)
+
+INT  VAR max index;          (* Information für new index *)
+
+INT  VAR channels of module; (* Information für channels of this module *)
+
+TEXT VAR actual info;        (* fuer write info *)
+
+ROW 256 INT VAR channel table of new shard;  (* für channel free *)
+
+DATASPACE VAR dummy ds;      (* für print configuration *)
+
+REAL VAR new shard length;
+
+(***************************************************************************)
+(************* Hier geht's los...... ***************************************)
+(***************************************************************************)
+
+(******************** configurate module **********************************)
+
+PROC configurate module (MODUL VAR  new shard, MODUL CONST old shard,
+                         BOOL CONST old shard valid, want automatic mode,
+                         TEXT CONST modulname) :
+  do configurate module (new shard, old shard, old shard valid,
+                      want automatic mode, modulname, FALSE)
+END PROC configurate module;
+
+(********************** print configuration *******************************)
+
+PROC print configuration (MODUL CONST old shard, TEXT CONST modulname) :
+  (* Es ist hier schon sichergestellt, daß old shard valid ist und das Modul
+     auch im SHard enthalten
+  *)
+  forget (dummy ds); dummy ds := nilspace;
+  BOUND MODUL VAR dummy :: dummy ds;
+  do configurate module (dummy, old shard, TRUE, FALSE, modulname, TRUE);
+  forget (dummy ds).
+END PROC print configuration;
+
+
+(******************* do configurate module *********************************)
+
+PROC do configurate module (MODUL VAR  new shard, MODUL CONST old shard,
+                            BOOL CONST old shard valid, want automatic mode,
+                            TEXT CONST modulname,
+                            BOOL CONST print configuration only):
+  (* In dieser Prozedur ist die Beschränkung auf Module mit unter 32kB
+     Länge ausgenutzt.
+     Ist kein alter SHard vorhanden, so muss ein leerer SHard übergeben
+     werden (d.h. alle Einträge in der Kanaltabelle sind 0).
+     Ein alter SHard darf keinesfalls unterschiedliche releases desselben
+     Modultyps enthalten.
+     Resultierende SHardgesamtlängen von über 32k sind noch nicht getestet.
+  *)
+  BOUND MODUL VAR m;
+  INT VAR  (***** Daten über das neue Modul *****)
+           sh version, sh structure version, release,
+           max ccb, nr of ccbs,
+           dtcb table entries, offset dtcb table, (* Variablentabellen *)
+           ccb  table entries, offset ccb  table,
+           muster ccb length, offset muster ccb, (* Muster-ccb im Modul *)
+           module body length,  (* Länge des zu kopierenden Modulrumpfs *)
+           offset module body, offset dtcb;
+  TEXT VAR modultyp; (* 4 Byte *)
+  INT VAR  (***** Daten über den alten SHard *****)
+           old release :: -2;  (* garantiert inkompatibel *)
+  REAL VAR offset old dtcb :: 0.0;
+  ROW nr of channels total REAL VAR offset old ccb;
+  BOOL VAR old cbs valid :: FALSE;
+  THESAURUS VAR old channels :: empty thesaurus;
+  (***** Daten über den neuen SHard *****)
+  REAL VAR dtcb location;
+  ROW nr of channels total REAL VAR ccb location;
+  (***** Sonstige Daten *****)
+  INT  VAR i, k, kanal, ccb count;
+  BOOL VAR automatic mode, configurate :: NOT print configuration only;
+  reset direction (FALSE); (* zur Sicherheit *)
+  IF configurate
+  THEN new shard length := unsigned (int (new shard, offset shard length)) FI;
+  connect module;
+  get module data;
+  test sh version compatibility;      (* ggf. LEAVE *)
+  (* Bisher wurde nur gelesen, ab jetzt darf nicht mehr abgebrochen werden *)
+  search old shard for module and find all old ccbs;
+  test release compatibility;         (* ggf. LEAVE *)
+  IF configurate
+  THEN write module with dtcb to shard;
+       perhaps set automatic mode;
+  FI;
+  configurate dtcb;
+  IF configurate
+  THEN kopf;
+       select channels;
+       write ccbs to shard;
+  ELSE nr of ccbs := highest entry (old channels)
+  FI;
+  configurate ccbs;
+  IF configurate
+  THEN make entries in channeltable of new shard;
+       int (new shard, offset shardlength, unsigned (new shard length))
+  FI.
+
+connect module :
+  m := old (modulname);
+  actual info := info (m);
+  IF configurate
+  THEN kopf
+  ELSE put ("-----"); put (modulname); putline ("-----")
+  FI.
+
+get module data :
+  (* Format des Moduls in den ersten Bytes:
+     Byte    Entry
+     0/1     offset dtcb variablen tabelle
+     2/3     offset ccb  variablen tabelle
+     4/5     offset muster-ccb
+     6/7     offset modulrumpf
+     8/9     offset dtcb
+     10/11   max anzahl ccbs
+     die tabellen enthalten im ersten Wort die Anzahl ihrer Einträge
+     der modulrumpf und der ccb ihre Länge in Byte
+     die Länge der Tabellen ergibt sich aus den offset-Differenzen.
+     dtcb-Format : Modultyp (4 Byte)
+                   SHardversion (1 Byte)
+                   SHardstrukturversion (1 Byte)
+                   Modulrelease (2 Byte)     ....
+  *)
+  max ccb := int (m, 10);
+  offset dtcb table  := int (m, 0);
+  dtcb table entries := int (m, offset dtcb table);
+  offset ccb table   := int (m, 2);
+  ccb  table entries := int (m, offset ccb table);
+  offset muster ccb  := int (m, 4);
+  muster ccb length  := int (m, offset muster ccb);
+  offset module body := int (m, 6);
+  module body length := int (m, offset module body);
+  offset dtcb        := int (m, 8);
+(*****
+put ("  offset dtcb table:"); put(       offset dtcb table); line;
+put ("  dtcb table entrie:"); put(      dtcb table entries); line;
+put ("  offset ccb table :"); put(       offset ccb table);  line;
+put ("  ccb  table entrie:"); put(      ccb  table entries); line;
+put ("  offset muster ccb:"); put(       offset muster ccb); line;
+put ("  muster ccb length:"); put(       muster ccb length); line;
+put ("  offset module bod:"); put(      offset module body); line;
+put ("  module body lengt:"); put(      module body length); line;
+put ("  offset dtcb      :"); put(       offset dtcb);       line;*****)
+  modultyp            := text (m, offset dtcb, 4);
+  sh version          := byte (m, offset dtcb + 4);
+  sh structureversion := byte (m, offset dtcb + 5);
+  release             := int  (m, offset dtcb + 6).
+
+test sh version compatibility :
+  IF configurate AND NOT version is compatible
+  THEN putline ("Das Modul ist mit dieser SHard-Version nicht mehr verträglich.");
+       putline (""10""10""15"  Installation des Moduls wird abgebrochen.  "14""7""13""10"");
+       go on;
+       LEAVE do configurate module
+  FI.
+
+version is compatible:
+  (* Kompatibel, wenn das Modul eine ältere oder gleiche sh version verlangt
+     und die gleiche sh structureversion
+  *)
+  sh version <= byte (new shard, offset sh version) CAND
+  sh structure version = byte (new shard, offset sh structureversion).
+
+search old shard for module and find all old ccbs :
+  (* Es werden alle Kanäle des alten SHard untersucht, ob der dortige Treiber
+     den gleichen Modultyp hat und in diesem Fall die Kanalnummer in
+     "old channels" gesammelt, sowie offset old ccb gemerkt, im Nichterfolgs-
+     falle wird offset old ccb auf diesem Kanal 0 gesetzt.
+     Es werden auch alle verketteten Treiber untersucht.
+     Auch old cbs valid und offset old dtcb werden ggf. gesetzt.
+  *)
+  IF NOT old shard valid
+  THEN LEAVE search old shard for module and find all old ccbs  FI;
+  IF configurate THEN put ("Ich untersuche den alten SHard :")  FI;
+  FOR kanal FROM 0 UPTO nr of channels total - 1 REP
+    IF configurate THEN cout (kanal)  FI;
+    collect ccbs on this channel
+  PER;
+  IF configurate THEN put (""13""5"")  FI.  (* Zeile löschen *)
+
+collect ccbs on this channel :
+  REAL VAR p dtcb :: sh dtcb offset (old shard, kanal),
+           p ccb  :: sh ccb offset (old shard, kanal);
+  WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP
+    BOOL CONST success :: text (old shard, p dtcb, 4) = modultyp;
+    IF success
+    THEN offset old dtcb := p dtcb;
+         old release     := int (old shard, p dtcb + 6.0);
+         insert (old channels, text (kanal));
+         offset old ccb [kanal+1] := p ccb
+    ELSE p dtcb := unsigned (int (old shard, p ccb + 2.0));  (* verkettet *)
+         p ccb  := unsigned (int (old shard, p ccb + 4.0))
+    FI
+  UNTIL success  PER;
+  old cbs valid := old shard valid AND offset old dtcb <> 0.0 AND
+                   (release = old release + 1 OR release = old release).
+
+test release compatibility:
+  IF print configuration only AND NOT old cbs valid
+  THEN putline ("Kein Zugriff auf die Konfigurationsdaten möglich");
+       LEAVE do configurate module
+  FI.
+
+write module with dtcb to shard :
+  put ("Modul """ + modulname + """ wird in den SHard eingetragen :");
+  IF int (new shard length MOD 2.0) <> offset module body MOD 2
+  THEN new shard length INCR 1.0  FI;   (* kopiert so schneller *)
+  dtcb location := new shard length +
+                      real (offset dtcb - offset module body);
+  copy (m, real (offset module body), new shard, new shard length,
+        module body length);
+  new shard length INCR real (module body length).
+
+perhaps set automatic mode :
+  IF old cbs valid AND old release = release
+  THEN automatic mode := want automatic mode
+  ELSE automatic mode := FALSE  FI.
+
+configurate dtcb :
+  IF configurate
+  THEN kopf;
+       putline ("Konfiguration des Treibers :");
+       get new channel table (new shard, channel table of new shard);
+  FI;
+  perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries,
+                         new shard, dtcb location,
+                         old shard, offset old dtcb,
+                         old cbs valid, release = old release,
+                         dtcb refinements (m), dtcb abfragen (m),
+                         automatic mode, print configuration only).
+
+select channels :
+  ccb count := highest entry (old channels);
+  k := min (ccb count, max ccb); (* .... Mutter der Porzellankiste *)
+  nr of ccbs := max (k, 1);
+  IF automatic mode THEN LEAVE select channels  FI;
+  IF max ccb > 1
+  THEN REP
+         editget ("Wieviele Kanäle mit diesem Treiber (1 bis " +
+                  text (max ccb) + ") : ", nr of ccbs);
+         out (""13"")
+       UNTIL nr of ccbs IN range (1, max ccb)  PER;
+       out (""10""10"")
+  ELSE nr of ccbs := 1  FI;
+  IF nr of ccbs < ccb count  (* weniger als früher *)
+  THEN put ("Wählen Sie mindestens"); putline (x kanäle aus deren);
+       putline ("Werte nicht als Vorbesetzung angeboten werden sollen"10"");
+       REP
+         THESAURUS CONST help :: certain (old channels, empty thesaurus);
+         IF NOT enough refused THEN out (""7"")  FI
+       UNTIL enough refused  PER;
+       old channels := old channels - help;
+       out (""3""3""3""4"")  (* clear screen from incl. "Wählen..." on *)
+  FI.
+
+x kanäle aus deren :
+  IF ccb count - nr of ccbs > 1
+  THEN text (ccb count - nr of ccbs) + " Kanäle aus, deren"
+  ELSE "einen Kanal aus, dessen"  FI.
+
+enough refused :
+  highest entry (help) >= ccb count - nr of ccbs.
+
+write ccbs to shard :
+  (* Ausserdem wird hier ccb location vorbereitet *)
+  out ("Die Kanäle werden in den neuen SHard eingetragen : ");
+  FOR i FROM 1 UPTO nr of ccbs REP
+    ccb location [i] := new shard length;
+    copy (m, real (offset muster ccb + 2), new shard, new shard length,
+         muster ccb length);
+    new shard length INCR real (muster ccb length)
+  PER.
+
+configurate ccbs :
+  (*put (old shard valid); put ("Release:"); put (release); put ("  old release:"); put (old release);
+    put (old cbs valid); pause;*)
+  IF configurate
+  THEN out (""13""10"Konfiguration der Kanäle:"13""10"");
+       get new channel table (new shard, channel table of new shard)  
+  FI;
+  ccb count := 0;
+  FOR kanal FROM 0 UPTO nr of channels total REP
+    IF old channels CONTAINS text (kanal)
+    THEN ccb count INCR 1;
+         offset old ccb [ccb count] := offset old ccb [kanal+1]
+    FI
+  PER;
+  FOR i FROM ccb count + 1 UPTO nr of ccbs REP
+    offset old ccb [i] := 0.0
+  PER;
+  perform ccb dialogue (m, real (offset ccb table+2), ccb table entries,
+                        new shard, ccb location,
+                        old shard, offset old ccb,
+                        nr of ccbs,
+                        offset old dtcb <> 0.0, release = old release,
+                        ccb refinements (m), ccb abfragen (m),
+                        automatic mode, print configuration only).
+
+make entries in channeltable of new shard :
+  kopf;
+  out ("Konfigurationsdaten werden in den neuen SHard eingetragen : ");
+  FOR i FROM 1 UPTO nr of ccbs REP
+    cout (i);
+    kanal := (*v[1][i]falsch???!!!*) byte (new shard, ccb location [i]);
+    make entry in channeltable of new shard
+  PER.
+
+make entry in channeltable of new shard :
+  IF NOT channel free (kanal)
+  THEN (* dtcb/ccb Adresse aus channel table nach neuem ccb umtragen. *)
+       int (new shard, ccb location [i] + 2.0,
+            unsigned (sh dtcb offset (new shard, kanal)));
+       int (new shard, ccb location [i] + 4.0,
+            unsigned (sh ccb offset (new shard, kanal)));
+  ELSE (* Folge-dtcb/ccb Adresse auf 0 setzen *)
+       int (new shard, ccb location [i] + 2.0, 0);
+       int (new shard, ccb location [i] + 4.0, 0);
+  FI;
+  (* Jetzt neue Adresse in channel table eintragen *)
+  sh dtcb offset (new shard, kanal, dtcb location);
+  sh ccb  offset (new shard, kanal, ccb location [i]);
+  k := byte (new shard, ccb location [i] + 1.0);  (* Zusatzkanalnummer *)
+  IF k <> 255  (* 255 = kein Zusatzkanal vorhanden *)
+  THEN (* IF NOT channel free (k) THEN alter eintrag futsch !!! *)
+       sh dtcb offset (new shard, k, dtcb location);
+       sh ccb  offset (new shard, k, ccb location [i])
+  FI.
+
+kopf :
+  write head ("""" + modulname + """ in den SHard aufnehmen");
+  out (actual info);
+  out (""13""10"").
+END PROC do configurate module;
+
+
+(********************* perform dialogue ************************************)
+
+PROC perform dtcb dialogue
+   (MODUL VAR m,          REAL CONST offset dialogue table, 
+    INT CONST dialogue table entries,
+    MODUL VAR   dtcb,     REAL CONST offset dtcb,
+    MODUL CONST old dtcb, REAL CONST offset old dtcb,
+    BOOL CONST old dtcb valid, same release,
+    TEXT CONST refinements, INT CONST count,
+    BOOL CONST automatic mode, print configuration only):
+  ROW nr of channels total REAL VAR offset cb, offset old cb;
+  offset cb [1]     := offset dtcb;
+  offset old cb [1] := offset old dtcb;
+  perform dialogue (TRUE, m, offset dialogue table, dialogue table entries,
+                    dtcb, offset cb, old dtcb, offset old cb, 1,
+                    old dtcb valid, same release, refinements, count,
+                    automatic mode, print configuration only).
+END PROC perform dtcb dialogue;
+
+PROC perform ccb dialogue
+   (MODUL VAR m,         REAL CONST offset dialogue table, 
+    INT CONST dialogue table entries,
+    MODUL VAR   ccb,     ROW nr of channels total REAL CONST offset ccb,
+    MODUL CONST old ccb, ROW nr of channels total REAL CONST offset old ccb,
+    INT CONST nr of ccbs, BOOL CONST old ccbs valid, same release,
+    TEXT CONST refinements, INT CONST count,
+    BOOL CONST automatic mode, print configuration only) : 
+  perform dialogue (FALSE, m, offset dialogue table, dialogue table entries,
+                    ccb, offset ccb, old ccb, offset old ccb, nr of ccbs,
+                    old ccbs valid, same release, refinements, count,
+                    automatic mode, print configuration only).
+END PROC perform ccb dialogue;
+
+
+PROC perform dialogue
+  (BOOL CONST is dtcb,
+  MODUL VAR m,       REAL CONST offset dialogue table, 
+  INT CONST dialogue table entries,
+  MODUL VAR   cb,     ROW nr of channels total REAL CONST offset cb,
+  MODUL CONST old cb, ROW nr of channels total REAL CONST offset old cb,
+  INT CONST nr of cbs, BOOL CONST old cb valid, same release,
+  TEXT CONST refinements, INT CONST refinement count,
+  BOOL CONST automatic mode, print configuration only) : 
+  (* Konfigurationsdialog für einen (Satz von) Kontrollblock(s) oder bloßes
+     Anzeigen der Konfigurationsdaten derselben.
+
+  1. bei NOT print configuration only:
+     Führt den Dialog für eine Tabelle (also ccb oder dtcb Variablentabelle) 
+     durch und bestückt den controlblock entsprechend. 
+     Es wird gleich eine ganze Tabelle von controlblocks (max. mchm Stück)
+     abgearbeitet und zwar nr of cbs Stück; im Falle is dtcb wird natürlich
+     nur der Eintrag 1 der Tabellen benutzt (vom Aufrufer).
+     Das Eingabemodul ist m mit der zu bearbeitenden Tabelle an der Stelle
+     offset dialogue table. Die Tabelle enthält dialogue table entries
+     Einträge (max. mdts Stück !)
+     Die Ausgabe des Prozesses landet im Modul cb ab den Stellen offset cb.
+     cb ist dabei jeweils der neue SHard, damit man nicht das Modul ändert.
+     Die Vorlagen zum Abgucken liefert, falls old cb valid ist, das
+     Modul old cb (der alte SHard) ab offset old cb, dabei ist die Struktur
+     gleich der neuen, wenn same release gilt, andernfalls sind die
+     Vorversionsoffsets zu benutzen (Versionsnummer um genau 1 erhöht).
+     Bei automatic mode werden nur still diese Vorgabewerte übernommen.
+     Die Elan-Teile für den Dialog liefert schliesslich der Text refinements,
+     er enthält refinement count Abfragen der Namen r1, r2, .....
+     Wenn refinent count = 0 ist, passiert hier eigentlich nichts,
+     deshalb sollte dann
+     für eine korrekte Initialisierung auch die Variablentabelle leer sein;
+     ist sie es allerdings doch nicht, werden hier noch die Standardwerte in
+     die ccbs eingetragen und nur der leere Dialog unterdrückt.
+     Vor Beginn/Nach Ende des gesamten Dialogs wird das refinement
+     dialoguestart/dialogueend aufgerufen; bei NOT is dtcb vor/nach dem Dialog
+     jedes Kanals auch noch channelstart/channelend.
+
+  2. bei print configuration only:
+     Die Daten zum new shard werden überhaupt nicht benutzt, von den
+     refinements wird nur für jeden Kanal einmal "print configuration"
+     aufgerufen.
+  *)
+  REAL VAR table byte :: offset dialogue table;
+  ROW mdts INT VAR offset, old offset, length;
+  INT  VAR i, k;
+  BOOL VAR configurate :: NOT print configuration only;
+  TEXT VAR program, t;
+  IF print configuration only       (* Hier wird evtl. schon verlassen *)
+  THEN startup for print
+  ELSE startup for dialogue  FI;
+  IF refinement count > 0 THEN build program  FI;
+  build data in v;
+  IF refinement count > 0 THEN do program  FI;
+  IF configurate THEN put values in cb  FI.
+
+startup for print :
+  IF refinement count = 0 OR dialogue table entries = 0
+  THEN LEAVE perform dialogue  FI.
+
+startup for dialogue:
+  IF refinement count = 0
+  THEN putline ("Keine Konfiguration notwendig.");
+       IF dialogue table entries = 0
+       THEN pause (20); LEAVE perform dialogue  FI
+  ELSE putline ("Die Konfiguration wird vorbereitet.")  FI.
+
+build program:
+  max index := refinement count;  (* damit new index bescheid weiss *)
+  program := variables var xxv;
+  program cat main part;
+  perhaps program cat data refinements;
+  program CAT refinements.
+
+program cat main part :
+  program CAT "LET UNSIGNED=INT;giveme(xxv);INT VARxxi::1,actchannel;";
+  IF print configuration only OR automatic mode
+  THEN program cat main part for print or automatic mode
+  ELSE program cat main part for dialogue  FI.
+
+program cat main part for print or automatic mode:
+  (* Leider muss man, wenn man den Modulprogrammierer bei den .ccb und .dtcb
+     Teilen nicht zu stark reglementieren will, einiges mitübersetzen, was
+     dann gar nicht benutzt wird (z.B. alle Refinements).
+           Und der Gedanke macht ihn blaß,
+           wenn er fragt: was kostet das ?
+                                     Wilhelm Busch
+  *)
+  program CAT "FORactchannelFROM 1 UPTOchannelsofthismoduleREP";
+  IF print configuration only
+  THEN program CAT "printconfigurationPER."
+  ELSE (* automatic mode: *) program CAT "automaticPER;takeyou(xxv)."
+  FI;
+  program CAT " xxa:actchannel. thischannel:";
+  IF NOT is dtcb THEN program CAT "channelstart;"  FI;
+  FOR i FROM 1 UPTO refinement count REP
+    program CAT "r";         (* Alle in this channel aufrufen, damit  *)
+    program CAT text (i);    (* "LEAVE this channel" kein Fehler ist. *)
+    program CAT ";"
+  PER;
+  IF NOT is dtcb
+  THEN program CAT "channelend"  FI;
+  program CAT ". ".
+
+program cat main part for dialogue:
+  program CAT "dialoguestart;FORactchannelFROM 1 UPTOchannelsofthismoduleREP";
+  program CAT "thischannelPER;dialogueend;takeyou(xxv). ";
+  program CAT "xxa:actchannel. thischannel:";
+  IF NOT is dtcb THEN program CAT "channelstart;"  FI;
+  program CAT "REP SELECTxxiOF ";
+  FOR i FROM 1 UPTO refinement count REP
+    program CAT "CASE ";
+    program CAT text (i);
+    program CAT ":r";
+    program CAT text (i);
+    program CAT " "
+  PER;
+  program CAT "ENDSELECT UNTIL NOTnewindex(xxi)PER";
+  IF NOT is dtcb
+  THEN program CAT ";channelend;reservechannel(xxv[1][xxa])"  FI;
+  program CAT ". ".
+
+perhaps program cat data refinements :
+  FOR i FROM 1 UPTO dialogue table entries REP
+    IF configurate THEN cout (i)  FI;
+    read start of next table entry; (* must be done in autom. mode, too,  *)
+    t := next variable name;        (* to get offset/oldoffset/length [i] *)
+    program CAT t;
+    program CAT ":xxv[";
+    program CAT text (i);
+    program CAT "][xxa]. ";  (* Das war der normale Eintrag "varname" *)
+    program CAT t;           (* Jetzt der für alle Kanäle "varname k" *)
+    program CAT "k:xxv[";
+    program CAT text (i);
+    program CAT "]. "
+  PER.
+
+read start of next table entry :
+  (* Format der Einträge in den Variablentabellen:
+     dw offset in cb
+     dw offset in old cb (oder ffffh falls neu)
+     db Typ (d.h. Länge und ist 1 oder 2)
+     db Namenslänge
+     db ...(Name)...
+  *)
+  INT CONST length of variable :: byte (m, table byte + 4.0),
+            length of name     :: byte (m, table byte + 5.0);
+  old offset [i] := int (m, table byte + 2.0);  (* Diese Sammlung *)
+  offset [i]     := int (m, table byte);  (* bereitet das Datenholen vor *)
+  length [i]     := length of variable;
+  IF length of variable < 1 OR length of variable > 2
+  THEN errorstop ("invalid variablelength : " + text (length of variable))
+  FI;
+  table byte INCR 6.0.
+
+next variable name:
+  table byte INCR real (length of name);
+  text (m, table byte - real (length of name), length of name).
+
+build data in v :
+  FOR k FROM 1 UPTO nr of cbs REP  (* Kanäle *)
+    IF configurate THEN cout (k)  FI;
+    FOR i FROM 1 UPTO dialogue table entries REP  (* Variablen *)
+      v[i][k] := next init value
+    PER
+  PER.
+
+next init value :
+  IF old cb valid CAND old cb present CAND value accessible
+  THEN value from old cb
+  ELSE value from new cb  FI.
+
+old cb present :
+  offset old cb [k] > 0.0.
+
+value accessible :
+  same release OR
+  (* Ein release zuvor und Variable gibts schon: *) old offset [i] <> -1.
+
+value from old cb :
+  IF length [i] = 1
+  THEN byte (old cb, offset old cb [k] + real (offset of old value))
+  ELSE int  (old cb, offset old cb [k] + real (offset of old value))
+  FI.
+
+value from new cb :
+  IF length [i] = 1
+  THEN byte (cb, offset cb [k] + real (offset [i]))
+  ELSE int  (cb, offset cb [k] + real (offset [i]))  FI.
+
+offset of old value :
+  IF same release
+  THEN offset [i]
+  ELSE old offset [i]  FI.
+
+do program :
+  reset direction (TRUE);
+  channels of module := nr of cbs;
+  IF setup testing
+    THEN (* für diesen THEN-Teil beim abgespeckten Eumel
+            setup eummel mini eumel dummies insertieren *)
+         forget (do name, quiet);
+         FILE VAR f := sequentialfile (output, do name);
+         putline (f, program);
+         (*edit (do name);*)
+         run (do name);
+         forget(do name, quiet);
+    ELSE do (program);
+  FI;
+  program := "";  (* Platz sparen *)
+  reset direction (FALSE).
+
+put values in cb :
+  FOR k FROM 1 UPTO nr of cbs REP
+    cout (k);
+    FOR i FROM 1 UPTO dialogue table entries REP
+      IF length [i] = 1 THEN put byte ELSE put int  FI
+    PER;
+  PER.
+
+put byte :
+  byte (cb, offset cb [k] + real (offset [i]), v[i][k]).
+
+put int :
+  int  (cb, offset cb [k] + real (offset [i]), v[i][k]).
+END PROC perform dialogue;
+
+(****************** give me, take you, new index ***************************)
+
+(* Diese Prozeduren werden aus dem do beim perform dialogue heraus aufgerufen
+   Sie dienen zur Kommunikation mit den Paketdaten dieses Pakets (give me,
+   take you) oder zur Verkleinerung des do-Programms (new index)
+*)
+
+PROC give me (VARIABLES VAR variables) :
+  (* Der Sinn dieser Prozedur besteht in Folgendem :
+     bei perform dialogue wird in dem do, das die refinements des
+     SHard-Moduls ausführt, eine Datenstruktur vom Typ VARIABLES aufgebaut,
+     die alle in den Variablentabellen des Moduls aufgeführten Variablen
+     enthält und einzeln über passend benannte refinements zugänglich macht.
+     Diese Datenstruktur wird zuvor in diesem Paket hier initialisiert mit
+     Initwerten aus der Variablentabelle oder wenn möglich mit den
+     entsprechenden Werten aus dem alten SHard. Mit give me fordert das
+     do-Programm die initialisierte Datenstruktur aus diesem Paket hier an.
+     Im do wird am Schluss mit take you diese Datenstruktur an dieses Paket
+     (und damit an perform dialogue) zurückgegeben, damit die durch den
+     Dialog gesetzten Werte in den neuen SHard eingetragen werden können.
+     Eine alternative Methode, diese Kommunikation zu realisieren, wäre die
+     Benutzung von BOUND VARIABLES VARs mit demselben Datenraum.
+   *)
+  variables := v
+END PROC give me;
+
+PROC take you (VARIABLES CONST variables) :
+  (* Gegenstück zu give me, siehe dort *)
+  v := variables
+END PROC take you;
+
+BOOL PROC new index (INT VAR index) :
+  (* Verändert den Index je nach der direction und fragt bei down am Ende,
+     ob fertig. Liefert, ob es noch weitergehen soll (falls nein: index = 1)
+  *)
+  LET up     = ""3"",
+      down   = ""10"",
+      error  = ""0"";
+  TEXT CONST old direction :: direction;
+  reset direction (TRUE);
+  IF old direction = error   (* Bei Fehlern immer stehenbleiben *)
+  THEN TRUE
+  ELIF index = max index     (* am Schluss aufhören oder nach 1 springen *)
+  THEN perhaps end
+  ELIF index = 1 AND old direction = up  (* bei 1 und up an den Schluss *)
+  THEN index := max index; TRUE
+  ELSE normal new index     (* sonst je nach direction up oder down *)
+  FI.
+
+perhaps end :  (* index = max index *)
+  IF old direction = up AND max index > 1    (* hoch vom Ende *)
+  THEN index DECR 1;
+       TRUE
+  ELIF old direction = up
+  THEN TRUE
+  ELIF old direction = down                  (* runter am Ende *)
+  THEN index := 1;
+       TRUE
+  ELSE reset direction (FALSE);          (* normal oder runter ans Ende *)
+       index := 1;
+       BOOL CONST ready :: yes (1, 23, "Fertig", FALSE);
+       reset direction (TRUE);
+       NOT ready
+  FI.
+
+normal new index :
+  IF old direction = up
+  THEN index DECR 1; TRUE
+  ELSE index INCR 1; TRUE  FI.
+END PROC new index;
+
+(******************** channel (table) handling *****************************)
+
+BOOL PROC channel free (INT CONST nr,
+                        ROW 256 INT CONST channel table of shard) :
+  IF nr < 0 OR nr > nr of channels total
+  THEN FALSE
+  ELSE channel table of shard [index ccb offset] = 0  FI.
+
+index ccb offset :
+  2 * nr + 1 + 1.
+END PROC channel free;
+
+BOOL PROC channel free (INT CONST nr) :
+  channel free (nr, channel table of new shard).
+END PROC channel free;
+
+PROC reserve channel (INT CONST nr,
+                      ROW 256 INT VAR channel table of shard) :
+  IF nr >= 0 AND nr < nr of channels total
+  THEN channel table of shard [index ccb offset] := 1  (* nichtnull *)  FI.
+
+index ccb offset :
+  2 * nr + 1 + 1.  (* Start nicht bei 0 und ccb hinter dtcb *)
+END PROC reserve channel;
+
+PROC reserve channel (INT CONST nr) :
+  reserve channel (nr, channel table of new shard).
+END PROC reserve channel;
+
+(*THESAURUS PROC free channels (ROW 256 INT VAR channel table of shard):
+  (* Liefert einen THESAURUS, der die Klartextform genau aller in
+     channel table of shard als frei angegebenen Kanäle enthält.
+  *)
+  INT VAR i;
+  THESAURUS VAR result :: empty thesaurus;
+  FOR i FROM 1 UPTO nr of channels total REP
+    IF channel free (i, channel table of shard)
+    THEN insert (result, text (i))  FI
+  PER;
+  result.
+END PROC free channels;*)
+
+INT PROC channels of this module :
+  channels of module.
+END PROC channels of this module;
+
+(********************* write info, buffer adress **************************)
+
+PROC write info :
+  putline (actual info)
+END PROC write info;
+
+INT PROC buffer address (INT CONST buffer size):
+  IF new shard length MOD 2.0 <> 0.0 THEN new shard length INCR 1.0 FI;
+  INT CONST buf adr := unsigned (new shard length);
+  new shard length INCR real (buffer size);
+  IF new shard length >= 65536.0 OR buffer size > 1024
+    THEN errorstop ("zu großer Puffer verlangt")
+  FI;
+  buf adr
+END PROC buffer address;
+
+(************************* Hilfsprozeduren *******************************)
+
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line,
+           INT VAR start module nr, BOOL CONST new init, ins, dump, lst,
+           sys, coder, rt check, sermon) :
+  EXTERNAL 256
+END PROC elan;
+
+PROC do (TEXT CONST long line) :
+  DATASPACE VAR ds;
+  INT VAR module nr :: 0;
+  elan (2, ds, long line, module nr, FALSE, FALSE, FALSE, FALSE,
+        FALSE, FALSE, FALSE, FALSE);
+  forget (ds);
+  no do again
+END PROC do;
+
+PROC go on :
+  put ("   >>>>> Taste drücken zum Weitermachen  ");
+  REPEAT UNTIL incharety (2) = ""  PER;
+  pause;
+  line.
+END PROC go on;
+
+END PACKET setup eumel modulkonfiguration;
+
diff --git a/system/setup/3.1/src/setup eumel 4: dienstprogramme b/system/setup/3.1/src/setup eumel 4: dienstprogramme
new file mode 100644
index 0000000..9ce9ca3
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 4: dienstprogramme
@@ -0,0 +1,218 @@
+ 
+(**************************************************************************)
+(***** Dienstprogramme für Modulprogrammierer             *****************)
+(***** Copyright (c) 1987, 1988                           *****************)
+(***** Lutz Prechelt, Karlsruhe                           *****************)
+(**************************************************************************)
+
+PACKET setup eumel dienstprogramme            (* Copyright (c) 1987 by    *)
+DEFINES                                       (* Lutz Prechelt, Karlsruhe *)
+   file as one text,                          (* Stand : 07.05.88   1.4   *)
+   ich schreibe jetzt ein neues shard modul,  (* Eumel 1.8.1              *)
+   link shard module,
+   all modules:
+
+(* Dies sind Dienstprogramme, die der Modul-Programmierer braucht *) 
+
+(* Das Format der Refinementdateien für den dtcb- und ccb-Setupdialog ist wie
+   folgt:
+   1. Zeile: INT-Denoter für die Anzahl von Abfragerefinements, die drin sind
+             Rest der Zeile muß leer sein.
+   Danach  : lauter ELAN-Refinements mit den Namen r1, r2 usw.
+             evtl. weitere Refinements zur Hilfe mit beliebigen Namen (es
+             gibt ein paar Ausnahmen, über die man beim ersten Test dann aber
+             stolpert.)
+   In den Refinements dürfen Variablen vereinbart werden. Vor dem ersten
+   refinement der Datei darf KEIN Punkt sein (es ist sowieso schlechter
+   Stil, die Punkte nicht hinter die vorherige Zeile zu setzen, sondern
+   vor den refinementnamen.), hingegen MUSS nach dem letzten Refinement der
+   Datei ein Punkt stehen.
+   Wer das für nötig hält, kann auch Prozeduren definieren und verwenden,
+   was allerdings nicht geht, sind Pakete.
+   Wenn man mit Kommentaren und sonstigen Bytefressern sparsam
+   umgeht, läuft der Dialog beim Setup später etwas schneller an.
+*)
+
+LET modul namentyp         = "SHardmodul *";
+
+DATASPACE VAR ds;
+
+(***************************************************************************)
+
+THESAURUS PROC all modules (THESAURUS CONST th):
+  (* Hier wird schlabberig nach Namen ausgewählt, während der Setup Eumel
+     im Betrieb die Datenraumtypen als Auswahlkriterium verwendet.
+     Die Schwierigkeiten, die bei Nichteinhalten der Namenskonventionen
+     entstehen, veranlassen hoffentlich jeden zur nötigen Disziplin...
+  *)
+  (th LIKE "SHardmodul *") - (th LIKE "SHardmodul *.ccb")
+  - (th LIKE "SHardmodul *.dtcb") - (th LIKE "SHardmodul *.info")
+END PROC all modules;
+
+(*****THESAURUS PROC all modules:        wird sauber in Teil 2 realisiert
+  all modules (all)
+END PROC all modules;
+*****)
+
+(********************* link shard module *********************************) 
+
+PROC link shard module:
+  TEXT VAR module :: std;
+  REPEAT 
+    page; 
+    putline ("          L I N K   S H A R D - M O D U L E"); line (2);
+    put ("Modulname:"); editget (module); line (2); 
+    link shard module (module); line;
+  UNTIL NOT yes ("noch ein Modul linken", FALSE)  PER 
+END PROC link shard module;
+
+PROC link shard module (THESAURUS CONST th):
+   do (PROC (TEXT CONST) link shard module, th);
+END PROC link shard module;
+
+PROC link shard module (TEXT CONST module): 
+  (* Ruft link shard module (modul, dtcb, ccb, info) unter Anwendung von
+     Namenskonventionen (nämlich entsprechende Suffixe ".dtcb" etc.) auf.
+  *)
+  TEXT VAR dtcb, ccb, info;
+  BOOL VAR elan neu;
+  dtcb := module + ".dtcb"; 
+  ccb  := module + ".ccb"; 
+  info := module + ".info"; 
+  perhaps change filenames;
+  elan neu := yes (module + ": neue Elan Teile machen", FALSE);
+  IF elan neu THEN neue elan teile machen  FI;
+  link shard module (module, dtcb, ccb, info);
+  IF elan neu THEN check syntax FI.
+
+neue elan teile machen:
+  edit (dtcb); line (2);
+  edit (ccb);  line (2);
+  edit (info); page.
+
+perhaps change filenames:
+(*put ("Datei mit dtcb-refinements :"); editget (dtcb); line;
+  put ("Datei mit  ccb-refinements :"); editget (ccb);  line;
+  put ("Datei mit Infotext         :"); editget (info); line (2)*) .
+
+check syntax :
+  line (2); put (module); putline (": Syntax-Check");
+  forget (ds);
+  ds := nilspace;
+  BOUND MODUL VAR m :: old (module), old shard :: ds, new shard :: ds;
+  INT VAR  offset dtcb table  :: int (m, 0),
+           dtcb table entries :: int (m, offset dtcb table),
+           offset ccb table   :: int (m, 2),
+           ccb  table entries :: int (m, offset ccb table);
+  (* Jetzt einen total verkrüppelten automatischen "perform dialogue" für
+     die Probeübersetzung der .dtcb und .ccb refinements aufrufen.
+  *)
+  perform dtcb dialogue (m, real (offset dtcb table+2), dtcb table entries,
+                         new shard, 0.0,
+                         old shard, 0.0,
+                         FALSE, FALSE,
+                         dtcb refinements (m), dtcb abfragen (m),
+                         TRUE, FALSE);
+  putline ("dtcb refinements O.K.");
+  ROW 40 REAL VAR x :: ROW 40 REAL : (0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+   0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+   0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
+   0.0, 0.0);
+  perform ccb dialogue (m, real (offset ccb table+2), ccb table entries,
+                        new shard, x,
+                        old shard, x,
+                        1,
+                        FALSE, FALSE,
+                        ccb refinements (m), ccb abfragen (m),
+                        TRUE, FALSE);
+  putline ("ccb refinements O.K.");
+  forget (ds).
+END PROC link shard module;
+
+PROC link shard module (TEXT CONST module, dtcb, ccb, infofile) : 
+  IF type (old (module)) <> datenraumtyp modul CAND NOT typ aendern 
+  THEN LEAVE link shard module
+  ELSE type (old (module), datenraumtyp modul)  FI;
+  IF NOT (module LIKE modul namentyp)
+  THEN errorstop ("Module MÜSSEN Namen der Art """ + modul namentyp +
+                   """ haben")
+  FI;
+  line;
+  BOUND MODUL VAR m :: old (module); 
+  TEXT VAR dtcb ref :: file as one text (dtcb, FALSE), 
+           ccb  ref :: file as one text (ccb,  FALSE),
+           info text:: file as one text (infofile, TRUE); 
+  INT CONST pos dtcb :: pos (dtcb ref, " "), (* Ende der ersten Zeile, die *)
+            pos ccb  :: pos (ccb ref,  " "); (* die Abfragezahl enthält *)
+  INT VAR   dtcb count, ccb count;
+  dtcb count := int (subtext (dtcb ref, 1, pos dtcb)); 
+  IF NOT last conversion ok OR dtcb count < 0 OR dtcb count > 1000 
+  THEN errorstop ("keine vernünftige Zahl von dtcb Abfragen gefunden")  FI;
+  ccb count := int (subtext (ccb ref, 1, pos ccb)); 
+  IF NOT last conversion ok OR ccb count < 0 OR ccb count > 1000 
+  THEN errorstop ("keine vernünftige Zahl von ccb Abfragen gefunden")  FI;
+  (* JETZT PASSIERTS : *) 
+  dtcb abfragen (m, dtcb count); 
+  dtcb refinements (m, subtext (dtcb ref, pos dtcb + 1)); 
+  ccb abfragen (m, ccb count); 
+  ccb refinements (m, subtext (ccb ref, pos ccb + 1)); 
+  info (m, infotext);
+  line;
+  putline (""""+module+""" gelinkt. " + text (storage (old (module))) +
+           " K Datenraumgröße.").
+
+typ aendern :
+  IF type (old (module)) = 1003 (* file type *)
+  THEN putline ("(""" + module + """ hat den Typ FILE)")  FI;
+  putline ("Achtung: """ + module + """ ist nicht vom Typ eines SHard-Moduls");
+  yes ("Soll es dazu gemacht werden (Typ aufprägen)", FALSE).
+END PROC link shard module;
+
+(******************** file as one text ************************************) 
+ 
+TEXT PROC file as one text (TEXT CONST filename, BOOL CONST verbatim) : 
+  FILE VAR f :: sequential file (input, filename); 
+  TEXT VAR result :: "", t; 
+  put ("Lese """ + filename + """ :");
+  WHILE NOT eof (f) REP 
+    cout (line no (f));
+    getline (f, t);
+    work on t;
+    result CAT t
+  PER;
+  line;
+  result.
+
+work on t :
+  IF verbatim
+  THEN t CAT ""13""10""
+  ELSE t := compress (t); t CAT " "  FI.
+END PROC file as one text;
+
+(****** ich schreibe jetzt ein neues shard modul ***************************)
+
+PROC ich schreibe jetzt ein neues shard modul :
+  line (2);
+  putline ("So so, Sie wollen also ein neues SHard-Modul schreiben."); line;
+  pause (20);
+  putline ("Mir kommt es so vor, als sei heute der " + date +
+           " und im Moment gerade " + time of day + " Uhr"); line;
+  IF NOT yes ("Stimmt das ungefähr (auf 5 Minuten kommt's nicht an)", TRUE)
+  THEN do ("set date"); line (2) FI;
+  putline ("Also gut. Schreiben Sie Ihr verdammtes Modul.");
+  putline ("Aber merken Sie sich die folgenden 4 Bytes als ihren Modultyp");
+  put (""15"   ");
+  REAL VAR x :: floor (clock (1) - date ("05.05.79") - time ("10:00:00"));
+  INT VAR i;
+  FOR i FROM 1 UPTO 4 REP
+    put (int (x MOD 256.0));
+    x := floor (x / 256.0)
+  PER;
+  put ("  "14""); line (2);
+  putline ("Also : die Dinger merken (schreiben Sie sie auf, sonst vergessen Sie");
+  putline ("       sie ja doch) und NICHT MEHR ÄNDERN !");
+  line (3)
+END PROC ich schreibe jetzt ein neues shard modul;
+
+END PACKET setup eumel dienstprogramme;
+
diff --git a/system/setup/3.1/src/setup eumel 5: partitionierung b/system/setup/3.1/src/setup eumel 5: partitionierung
new file mode 100644
index 0000000..705f26d
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 5: partitionierung
@@ -0,0 +1,435 @@
+PACKET setup eumel partitionierung         (* Copyright (C) 1985       *)
+                                           (* Martin Schönbeck, Spenge *)
+DEFINES             tracks,                (* Lutz Prechelt, Karlsruhe *)
+                    sectors,               (* Änderungen: Ley    ms    *)
+                    heads,                 (* Stand: 07.04.89          *)
+                    first track,
+                    last track,
+                    partition start,
+                    partition type,
+                    partition active,
+                    partition size,
+                    partition word 0,
+
+                    get boot block,
+                    put boot block,
+                    clear partition,
+
+                  (*get bad track table,*)
+                    get bad sector table,
+                    clear partition table,
+                    setup channel,
+                    start of partition:
+
+    LET bst size             = 1024;  (* nr of bad sector table entrys *)
+
+ROW 256 INT VAR boot block;
+INT VAR boot block session := session - 1;
+INT VAR fd channel         := 28;    (* Festplatten-Setupkanal *)
+
+INT PROC setup channel:
+   fd channel
+END PROC setup channel;
+
+PROC setup channel (INT CONST new channel):
+    enable stop;
+    teste kanal typ;
+    boot block session DECR 1;
+    wirf altes pac raus;
+    fd channel := new channel;
+    sorge dafuer dass kanal uptodate ist.
+
+teste kanal typ:
+    IF (get value (1, new channel) AND 12) <> 12
+       THEN errorstop ("Hier gibt es leider keine Platte")
+    FI.
+
+wirf altes pac raus:
+    IF new channel <> fd channel
+        THEN INT VAR raus := get value (-13, fd channel);
+    FI.
+
+sorge dafuer dass kanal uptodate ist:
+   INT VAR old channel := channel; 
+   ROW 256 INT VAR dummy; INT VAR i;
+   continue (new channel);
+   disable stop;
+   blockin (dummy, -1, -1, i);
+   break (quiet);
+   continue (old channel).
+
+END PROC setup channel;
+
+PROC get bad sector table (ROW bst size REAL VAR bb tab,
+                           INT VAR bad sect, INT CONST eumel type):
+    initialisiere tabelle;
+    suche schlechte sectoren.
+
+initialisiere tabelle:
+    INT VAR i;
+    FOR i FROM 1 UPTO bst size REP
+      bb tab [i] := -1.0;
+    PER.
+
+suche schlechte sectoren:
+    INT VAR  my channel := channel;
+    REAL VAR sector := start of partition (eumel type),
+             end := sector + partition size (partition number (eumel type)),
+             track mode restart :: 0.0;
+    INT VAR  akt track := 0,
+             fehler code;
+    bad sect := 1;  (* Eintragsnr. des NÄCHSTEN schlechten Sektors *)
+    continue (fd channel);
+    disable stop;
+    DATASPACE VAR ds := nilspace;
+    REAL CONST cylinder size :: real (sectors * heads),
+               track size    :: real (sectors);
+    track mode restart := sector + track size -
+                              (sector MOD track size);
+     (* wenn sector nicht erster der spur, dann die erste einzeln *)
+    WHILE sector < end REP
+         IF sector MOD cylinder size = 0.0
+         THEN melde naechste spur  FI;
+         IF sector >= track mode restart
+         THEN check track
+         ELSE check sector  FI
+    UNTIL bad sect > bst size OR is error PER;
+    continue (my channel);
+    forget (ds);
+    enable stop;
+    IF bad sect > bst size 
+        THEN errorstop ("Zu viele schlechte Sektoren"); 
+    FI;
+    lass nicht zu dass ein ersatzsektor ein schlechter ist;
+    bad sect DECR 1.  (* ANZAHL schlechter Sektoren *)
+
+melde naechste spur:
+   break (quiet);
+   continue (my channel);
+   akt track INCR 1;
+   cout (akt track);
+   continue (fd channel).
+
+check track :
+  verify track (ds, 2, sector, fehler code);
+  IF schlechten sektor gefunden
+  THEN track mode restart := sector + tracksize
+  ELSE sector INCR track size  FI.
+
+check sector :
+  read block (ds, 2, sector, fehler code);
+  IF schlechten sektor gefunden 
+  THEN eintragen  FI;
+  sector INCR 1.0.
+
+schlechten sektor gefunden:
+    SELECT fehler code OF
+       CASE 0: FALSE
+       CASE 1: error stop ("Platte kann nicht gelesen werden"); FALSE
+       CASE 2: TRUE
+       CASE 3: error stop ("Versorgungsfehler beim Plattentest"); FALSE
+       OTHERWISE error stop ("unbekannter Fehler auf Platte"); FALSE
+    END SELECT.
+
+eintragen:
+    bb tab [bad sect] := sector;
+    bad sect INCR 1.
+
+lass nicht zu dass ein ersatzsektor ein schlechter ist:
+    REAL VAR aktueller ersatz := end - real (bad sect - 1);
+    INT VAR akt b sect;
+    FOR akt b sect FROM 1 UPTO bad sect - 1 REP
+        IF aktueller ersatz ist in tabelle
+            THEN vertausche aktuell zu ersetzenden mit ihm
+        FI;
+    PER.
+
+aktueller ersatz ist in tabelle:
+    INT VAR such index;
+    FOR such index FROM 1 UPTO bad sect REP
+       IF aktueller ersatz = bb tab (such index)
+           THEN LEAVE aktueller ersatz ist in tabelle WITH TRUE
+       FI;
+    PER;
+    FALSE.
+
+vertausche aktuell zu ersetzenden mit ihm:
+    bb tab ( such index ) := bb tab ( akt b sect );
+    bb tab (akt b sect)   := aktueller ersatz.
+END PROC get bad sector table;
+
+INT PROC cyl and head (REAL CONST sector):
+     cylinder code (int (sector / real (sectors)) DIV heads) OR head.
+
+head :
+  (int (sector / real (sectors)) MOD heads).
+END PROC cyl and head;
+
+PROC get boot block:
+    IF boot block session <> session
+       THEN hole aktuellen boot block
+    FI.
+
+hole aktuellen bootblock :
+    disable stop;
+    DATASPACE VAR dummy ds := nilspace;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table := dummy ds; 
+    get external block (dummy ds, 2, 0, fd channel); 
+    IF NOT is error
+        THEN transfer data to boot block
+    FI; 
+    forget (dummy ds). 
+ 
+transfer data to boot block:
+    IF not valid boot block
+        THEN try to get valid boot block from file
+    FI;
+    boot block := partition table. block;
+    boot block session := session.
+
+not valid boot block:
+    partition table. block [256] <> boot indicator OR
+    it is an old boot block of eumel.
+
+boot indicator: -21931.
+
+it is an old boot block of eumel:
+    partition table. block [1] = 1514.
+
+try to get valid boot block from file:
+    forget (dummy ds);
+    partition table := old ("bootblock");
+    IF is error THEN LEAVE transfer data to boot block FI.
+END PROC get boot block;
+
+PROC clear partition table (INT CONST sicherung):
+    IF sicherung = -3475 
+       THEN neuen boot block;
+            put boot block
+    FI.
+
+neuen boot block:
+    enable stop;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table;
+    partition table := old ("bootblock");
+    boot block := partition table. block;
+    boot block session := session.
+END PROC clear partition table;
+
+PROC put boot block:
+    IF boot block ist uptodate
+        THEN schreibe block auf platte
+        ELSE errorstop ("boot block nicht uptodate")
+    FI.
+
+boot block ist uptodate:
+    boot block session = session.
+
+schreibe block auf platte:
+    disable stop;
+    DATASPACE VAR dummy ds := nilspace;
+    BOUND STRUCT (ALIGN dummy, 
+                  ROW 256 INT block) VAR partition table := dummy ds; 
+    transfer data to dataspace;
+    put external block (dummy ds, 2, 0, fd channel); 
+    forget (dummy ds). 
+ 
+transfer data to dataspace:
+    partition table. block := boot block.
+END PROC put boot block;
+
+INT PROC partition number (INT CONST part type):
+    INT VAR partition;
+    FOR partition FROM 1 UPTO 4 REP
+         IF partition type (partition) = part type
+              THEN LEAVE partition number WITH partition
+         FI
+    PER;
+    errorstop ("Partitiontyp gibt es nicht");
+    7.
+END PROC partition number;
+
+INT PROC partition word 0 (INT CONST partition):
+   boot block (entry (partition))
+END PROC partition word 0;
+
+PROC partition word 0 (INT CONST partition, word):
+   boot block (entry (partition)) := word
+END PROC partition word 0;
+
+REAL PROC start of partition (INT CONST partition type):
+    partition start (partition number (partition type))
+END PROC start of partition;
+ 
+
+INT PROC first track (INT CONST partition):
+    high byte (boot block [entry (partition) + 1]) 
+       + 4 * (low byte (boot block [entry (partition) + 1]) AND (128 + 64)) 
+END PROC first track;
+
+INT PROC last track (INT CONST partition):
+    high byte (boot block [entry (partition) + 3]) 
+       + 4 * (low byte (boot block [entry (partition) + 3]) AND (128 + 64)) 
+END PROC last track;
+
+INT PROC partition type (INT CONST partition):
+    low byte (boot block [entry (partition) + 2])
+END PROC partition type;
+
+BOOL PROC partition active (INT CONST partition):
+    low byte (boot block [entry (partition)]) = 128
+END PROC partition active;
+
+(****************** neu eingefügt ******************************)
+PROC partition active (INT CONST partition, BOOL CONST active):
+   IF active THEN activate this partition
+             ELSE deactivate this partition
+   FI.
+
+deactivate this partition:
+    set bit (boot block [entry (partition)], 7);
+    (* first setting needed, because reset bit does xor *)
+    reset bit (boot block [entry (partition)], 7).
+
+activate this partition:
+    set bit (boot block [entry (partition)], 7).
+END PROC partition active;
+
+(****************** neu eingefügt ******************************)
+ 
+PROC first track (INT CONST partition, cylinder):
+    boot block [entry (partition) + 1]
+            := cylinder code (cylinder) OR start sector.
+
+start sector:
+    IF cylinder = 0
+        THEN 2
+        ELSE 1
+    FI.
+END PROC first track;
+
+PROC last track (INT CONST partition, cylinder):
+    boot block [entry (partition) + 3] := cylinder code (cylinder).
+END PROC last track;
+
+PROC partition type (INT CONST partition, type):
+    boot block [entry (partition) + 2] := type.
+END PROC partition type;
+
+REAL PROC partition start (INT CONST partition):
+    unsigned low word + high word.
+
+unsigned low word:
+    real (low byte (boot block [entry (partition) + 4])) +
+    real (high byte (boot block [entry (partition) + 4])) * 256.0.
+
+high word:
+    real (boot block [entry (partition) + 5]) * 65536.0.
+END PROC partition start;
+
+PROC partition start (INT CONST partition, REAL CONST sector offset):
+    boot block [entry (partition) + 4] := low word (sector offset);
+    boot block [entry (partition) + 5] := high word (sector offset)
+END PROC partition start;
+
+REAL PROC partition size (INT CONST partition):
+    unsigned low word + high word.
+
+unsigned low word:
+    real (low byte (boot block [entry (partition) + 6])) +
+    real (high byte (boot block [entry (partition) + 6])) * 256.0.
+
+high word:
+    real (boot block [entry (partition) + 7]) * 65536.0.
+END PROC partition size;
+
+PROC partition size (INT CONST partition, REAL CONST number of blocks):
+    boot block [entry (partition) + 6] := low word (number of blocks);
+    boot block [entry (partition) + 7] := high word (number of blocks)
+END PROC partition size;
+ 
+PROC clear partition (INT CONST partition):
+    INT VAR i;
+    FOR i FROM 0 UPTO 7 REP
+        boot block [entry (partition) + i] := 0
+    PER
+END PROC clear partition;
+
+INT PROC entry (INT CONST partition):
+    get boot block;
+    256 - 5 * 8 + (partition * 8)
+END PROC entry;
+
+INT PROC cylinder code (INT CONST cylinder):
+    cylinder text ISUB 1.
+
+cylinder text:
+    high cylinder bits + low cylinder bits.
+
+high cylinder bits:
+    code ((cylinder AND (256 + 512)) DIV 4).
+
+low cylinder bits:
+    code (cylinder AND (128 + 64 + 32 + 16 + 8 + 4 + 2 + 1)).
+END PROC cylinder code;
+
+INT PROC tracks: 
+   get value (-10, fd channel) 
+END PROC tracks; 
+ 
+INT PROC sectors: 
+   get value (-11, fd channel) 
+END PROC sectors; 
+ 
+INT PROC heads: 
+   get value (-12, fd channel) 
+END PROC heads;
+ 
+INT PROC get value (INT CONST control code, channel for value): 
+    enable stop; 
+    INT VAR old channel := channel;
+    IF channel for value <> old channel THEN continue (channel for value)  FI;
+    INT VAR value; 
+    control (control code, 0, 0, value); 
+    IF channel for value <> old channel THEN continue (old channel)  FI;
+    value 
+END PROC get value; 
+ 
+PROC get external block (DATASPACE VAR ds, INT CONST ds page,
+                                             archive block, get channel):
+   INT VAR old channel := channel; 
+   continue (get channel);
+   disable stop;
+   read block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht gelesen werden");
+      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+   continue (old channel).
+END PROC get external block;
+
+PROC put external block (DATASPACE CONST ds, INT CONST ds page,
+                                             archive block, get channel):
+   INT VAR old channel := channel; 
+   continue (get channel);
+   disable stop;
+   write block (ds, ds page, archive block, error);
+   INT VAR error;
+   SELECT error OF
+      CASE 0:
+      CASE 1: error stop ("Platte kann nicht geschrieben werden");
+      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
+      CASE 3: error stop ("Versorgungsfehler Archiv");
+      OTHERWISE error stop ("unbekannter Fehler auf Platte");
+   END SELECT;
+   continue (old channel).
+END PROC put external block;
+
+END PACKET setup eumel partitionierung;
+
diff --git a/system/setup/3.1/src/setup eumel 6: shardmontage b/system/setup/3.1/src/setup eumel 6: shardmontage
new file mode 100644
index 0000000..cc0d475
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 6: shardmontage
@@ -0,0 +1,389 @@
+
+(**************************************************************************)
+(***** Zusammenbau eines SHards aus Modulen mit Dialog    *****************)
+(***** Copyright (c) 1987, 1988 by                        *****************)
+(***** Lutz Prechelt, Karlsruhe                           *****************)
+(**************************************************************************)
+
+PACKET setup eumel shardmontage        (* Copyright (c) 1987 by    *)
+DEFINES build shard,                   (* Lutz Prechelt, Karlsruhe *)
+        add bad sector table to shard, (* Stand : 08.04.88   3.2   *)
+        installation nr,               (* Eumel 1.8.1              *)
+        print configuration :
+
+(* Beschreibung des SHard-Hauptmodulformats siehe "modulkonfiguration" *)
+
+(* In diesem Paket sind viele Namenskonventionen verankert. 
+   Das leere SHard-Hauptmodul hat den Namen "SHard leer", teilaufgebaute
+   SHards heissen normalerweise in der Form "SHard 07.07.87 14:34" (andere
+   Namen sind möglich, wenn sie mit "SHard " beginnen.)
+   Die Prozedur build shard bastelt in Dialogsteuerung durch den Benutzer
+   aus Modulen und einem leeren oder teilaufgebauten SHard-Hauptmodul einen 
+   neuen SHard zusammen und schreibt ihn in die Datei SHARD 
+   Die Prozedur add bad block table to shard fügt einem so zusammengebauten
+   SHard eine bad block tabelle gemäß dem Zustand der Partition hinzu oder
+   ändert die vorhandene.
+   Dann ist der SHard komplett fertig zum auf-die-Partition-schleudern.
+   (einschliesslich Installationsnummer)
+*) 
+ 
+LET hauptmodul namentyp    = "SHard *", 
+  (*modul namentyp         = "SHardmodul *",*)
+    shard name             = "SHARD";
+
+LET bad sector table size            = 1024,   (* Entries *)
+    max sh length                    =   60,   (* Blocks, vorläufig !!! *)
+    nr of channels total             =   40,
+    offset shard length              =    6,
+    offset bad sector table pointer  =    8,
+    offset verbal identification     =  176,   (* Start Shardleiste *)
+    offset id 4                      =  196;   (* 176 + 14h *)
+
+INT VAR actual installation nr :: id (5);
+DATASPACE VAR ds :: nilspace;
+ 
+PROC build shard (DATASPACE CONST old shard ds) :
+  (* Der Aufrufer muß hinterher nachsehen, ob es die Datei SHARD auch
+     wirklich gibt. Falls nicht, ist "Aufbau des SHards war nicht möglich"
+     zu melden.
+  *)
+  BOUND MODUL VAR old shard :: old shard ds, new shard;
+  TEXT VAR t;
+  INT  VAR i;
+  THESAURUS VAR th, modules, automatic mode modules,
+                modules in old shard, modules in new shard;
+  BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND
+                                  verbal identification ok;
+  perhaps take old shard;  (* ggf. LEAVE *) 
+  get main module name in t;
+  copy (t, shard name);
+  new shard := old (shard name);
+  enable stop;
+  eliminate bad sector table from shard (new shard);
+  get module names; 
+  configurate modules and build shard;
+  add ids.
+ 
+verbal identification ok :
+  text (old shard, offset verbal identification, 16) =
+  "SHard Schoenbeck".
+
+perhaps take old shard : 
+  kopf; 
+  forget (shard name, quiet); 
+  IF old shard valid CAND 
+     yes ("Wollen Sie den SHard genauso wie beim letzten Setup", FALSE) 
+  THEN copy (old shard ds, shard name); LEAVE build shard
+  ELSE out (""10"")  FI.
+ 
+get main module name in t : 
+  putline ("   A u s w a h l   d e s   S H a r d - H a u p t m o d u l s "10"");
+  th := all LIKE hauptmodul namentyp;
+  IF highestentry (th) > 1
+  THEN let the user select one
+  ELSE take the only one  FI.
+
+let the user select one :
+  putline ("Wählen Sie jetzt bitte, welches SHard-Hauptmodul Sie als"); 
+  putline ("Ausgangspunkt der Konfiguration benutzen möchten."); 
+  putline ("(Namen durch Zeiger auswählen dann RETURN-Taste drücken)"); 
+  t := ONE th;
+  out (""4""13""10""10""10""). 
+
+take the only one :
+  t := name (th, 1);
+  putline ("Das einzige verfügbare SHard Hauptmodul ist");
+  putline (t);
+  pause (30).
+
+get module names :
+  (* Besorgt die Listen 1. vorhandene Module   2. Module im alten SHard
+     und 3. Module im SHard Hauptmodul
+     Liefert in modules eine Auswahl von 1. ohne 3. mit 2. als Vorschläge
+     und in automatic mode modules eine Auswahl von 2. (alles vorgeschlagen)
+     Die Liste 2. ist dabei so sortiert, daß stets eingekettete Module in der
+     richtigen Reihenfolge auftauchen.
+  *)
+  kopf;
+  put ("Ich untersuche den SHard: ");
+  get modules in shard (new shard, modules in new shard);
+  IF old shard valid
+  THEN get modules in shard (old shard, modules in old shard)
+  ELSE modules in old shard := empty thesaurus  FI;
+  kopf;
+  putline ("Wählen Sie jetzt bitte mit RETURN/rauf/runter, welche Module Sie");
+  putline ("mit in den SHard aufnehmen möchten.");
+  putline ("(Zum Verlassen ESC q)");
+  modules := certain (all modules - modules in new shard,
+                      modules in old shard);
+  IF old shard valid
+  THEN kopf;
+       putline ("Wählen Sie jetzt, welche der Module vollautomatisch wie im");
+       putline ("Vorlage-SHard konfiguriert werden sollen (Reihenfolge egal)");
+       automatic mode modules := certain (modules / modules in old shard,
+                                          modules in old shard)
+  ELSE automatic mode modules := empty thesaurus  FI.
+
+configurate modules and build shard :
+  FOR i FROM 1 UPTO highest entry (modules) REP
+    page; cout (i); collect heap garbage;
+    t := name (modules, i);
+    configurate module (new shard, old shard,
+                        modules in old shard CONTAINS t,
+                        automatic mode modules CONTAINS t, t)
+  PER;
+  IF highest entry (automatic mode modules) < highest entry (modules)
+  THEN perhaps keep copy of partly build shard  FI;
+  collect heap garbage.
+
+perhaps keep copy of partly build shard :
+  kopf;
+  storage info;
+  out (""10"Möchten Sie eine zusätzliche Kopie des SHard in dieser Version"13""10"");
+  IF yes ("aufheben", FALSE)
+  THEN TEXT CONST start :: subtext (hauptmodul namentyp, 1,
+                                    LENGTH hauptmodul namentyp - 1);
+       t := date;
+       put ("Gewünschter Name :"); out (start); editget (t); out (""13""10"");
+       t := start + t;
+       IF NOT exists (t) COR overwrite THEN copy (shard name, t)  FI
+  FI.
+
+add ids :
+  int (new shard, offset id 4 + 2  (* ID5 *), actual installation nr);
+  int (new shard, offset id 4 + 4  (* ID6 *), id (6));
+  int (new shard, offset id 4 + 6  (* ID7 *), id (7)).
+
+overwrite :
+  IF yes ("Existierende Datei """ + t + """ überschreiben", FALSE)
+  THEN forget (t, quiet);
+       TRUE
+  ELSE FALSE  FI.
+END PROC build shard;
+
+(******************** print configuration **********************************)
+
+PROC print configuration (DATASPACE CONST old shard ds, BOOL CONST on screen):
+  (* Ruft für alle Module, die in old shard ds und als Datei vorhanden sind
+     print configuration aus dem Paket modulkonfiguration auf.
+     Macht bei on screen nach jedem Modul eine Pause, andernfalls wird die
+     Ausgabe in einem Rutsch gemacht und mit indirect list auf den Drucker
+     umgeleitet.
+  *)
+  BOUND MODUL VAR old shard :: old shard ds;
+  THESAURUS VAR modules in old shard;
+  BOOL CONST old shard valid :: int (old shard, offset id 4) = id (4) AND
+                                  verbal identification ok;
+  enable stop;
+  IF NOT old shard valid
+  THEN errorstop ("Der SHard ist ungültig");
+       LEAVE print configuration
+  FI;
+  write head ("Anzeigen der Konfiguration des SHard");
+  put ("Bitte fassen Sie sich in Geduld");
+  get modules in shard (old shard, modules in old shard);
+  out (""4""13""10"");  (* clear cout, line *)
+  IF on screen
+  THEN putline ("Nach jedem Modul eine Taste drücken.")
+  ELSE putline ("Die Ausgabe geht zum Drucker");
+       indirect list (TRUE);
+       putline ("***** SHardkonfiguration *****"); line;
+  FI;
+  disable stop;
+  do print configuration (old shard, modules in old shard, on screen);
+  IF is error THEN put error; pause; clear error  FI;
+  enable stop;
+  IF NOT on screen THEN indirect list (FALSE)  FI.
+
+verbal identification ok :
+  text (old shard, offset verbal identification, 16) =
+  "SHard Schoenbeck".
+END PROC print configuration;
+
+PROC do print configuration (MODUL CONST old shard,
+                            THESAURUS CONST modules in old shard,
+                            BOOL CONST on screen) :
+  INT  VAR i;
+  TEXT VAR t;
+  enable stop;
+  FOR i FROM 1 UPTO highest entry (modules in old shard) REP
+    t := name (modules in old shard, i);
+    print configuration (old shard, t);
+    collect heap garbage;
+    IF on screen THEN pause  FI
+  PER.
+END PROC do print configuration;
+
+(********************** modules in shard **********************************)
+
+PROC get modules in shard (MODUL CONST old shard,
+                           THESAURUS VAR modules in old shard) :
+  (* Stellt einem THESAURUS zusammen, der aus den Namen aller in old shard
+     enthaltenen Module besteht (ohne Duplikate).
+     Dabei sind diejenigen Modulnamen, deren Treiber in old SHard nicht als
+     eingekettete Treiber vorkommen, im Resultat VOR den eingeketteten
+     (d.h. mit kleineren link-Nummern) zu finden, um die richtige
+     Konfigurationsreihenfolge vorschlagen zu können.
+     Es muß zuvor bereits einmal init modules list aufgerufen worden sein !
+  *)
+  INT  VAR kanal;
+  REAL VAR p dtcb, p ccb;
+  TEXT VAR type, m name;
+  THESAURUS VAR simple :: empty thesaurus, chained :: empty thesaurus;
+  FOR kanal FROM 0 UPTO nr of channels total - 1 REP
+    cout (kanal);
+    p dtcb := sh dtcb offset (old shard, kanal);
+    p ccb  := sh ccb  offset (old shard, kanal);
+    look at this chain
+  PER;
+  invert chained thesaurus;
+  modules in old shard := what comes out when i let nameset do all the hard
+           work for me with a little trick and knowledge of implementation.
+
+look at this chain :
+  (* Das Verfahren ist auf den ersten Blick etwas kompliziert, spart aber
+     einiges an Kodeduplikation
+  *)
+  m name :=  "";
+  WHILE p dtcb <> 0.0 AND p ccb <> 0.0 REP
+    IF m name <> "" AND NOT (chained CONTAINS m name)
+    THEN insert (chained, m name)  FI;
+    type   := text (old shard, p dtcb, 4);
+    m name := module name (type);
+    p dtcb := unsigned (int (old shard, p ccb + 2.0));  (* verkettet *)
+    p ccb  := unsigned (int (old shard, p ccb + 4.0));
+  PER;
+  IF m name <> "" THEN insert (simple, m name)  FI.
+
+invert chained thesaurus :
+  (* bis jetzt sind bei mehrfachen Verkettungen die zuletzt eingeketteten
+     Treiber als erstes eingetragen, das darf jedoch nicht so bleiben
+  *)
+  INT VAR i;
+  THESAURUS VAR help :: empty thesaurus;
+  FOR i FROM highest entry (chained) DOWNTO 1 REP
+    insert (help, name (chained, i))
+  PER;
+  chained := help.
+
+what comes out when i let nameset do all the hard
+work for me with a little trick and knowledge of implementation :
+  (* Beware of false algebraic identities !   These are neither numbers nor
+     sets but lists (ordered and not duplicate-free)
+  *)
+  empty thesaurus + (simple - chained) + chained.
+END PROC get modules in shard;
+
+(*************** add bad sector table to shard ****************************)
+
+PROC add bad sector table to shard (INT CONST eumel type,
+                                    DATASPACE CONST shard ds,
+                                    BOOL CONST take from partition,
+                                    INT VAR bad sector count) :
+  (* Fügt einem SHard eine bad sector table hinzu oder ändert sie.
+     Ist noch keine vorhanden, so sollte der Zeiger 0 sein.
+  *)
+  ROW bad sector table size REAL VAR bst;
+  BOUND MODUL VAR new shard :: shard ds;
+  REAL VAR new shard length, offset bst;
+  INT  VAR i;
+  enable stop;
+  IF take from partition
+  THEN put ("kopiere Tabelle :");
+       find bst in shard on partition
+  ELSE put ("Spur :");
+       get bad sector table (bst, bad sector count, eumel type);
+  FI;
+  eliminate bad sector table from shard (new shard);
+  new shard length := unsigned (int (new shard, offset shard length));
+  int (new shard, new shard length, bad sector count);
+  int (new shard, offset bad sector table pointer, unsigned (new shard length));
+  new shard length INCR 2.0;
+  IF take from partition
+  THEN copy bst from old to new shard
+  ELSE write bst to new shard  FI;
+  int (new shard, offset shard length, unsigned (new shard length)).
+
+copy bst from old to new shard :
+  copy (old shard, offset bst + 2.0, new shard, new shard length,
+        bad sector count * 4);
+  cout (bad sector count * 4);
+  new shard length INCR real (bad sector count * 4).
+
+write bst to new shard :
+  FOR i FROM 1 UPTO bad sector count REP
+    cout (i);
+    enter bad sector low word
+  PER;
+  FOR i FROM 1 UPTO bad sector count REP
+    cout (i);
+    enter bad sector high word;
+  PER.
+
+find bst in shard on partition :
+  cout (0);
+  read file (ds, start of partition (eumel type) + 1.0, max sh length,
+             setup channel);
+  BOUND MODUL CONST old shard :: ds;
+  IF int (old shard, offset id 4) <> id (4)
+  THEN errorstop ("SHard auf Partition unbrauchbar")  FI;
+  offset bst := unsigned (int (old shard, offset bad sector table pointer));
+  bad sector count := int (old shard, unsigned (offset bst)).
+
+enter bad sector low word :
+  int (new shard, new shard length, low word (bst [i]));
+  new shard length INCR 2.0.
+
+enter bad sector high word :
+  int (new shard, new shard length, high word (bst [i]));
+  new shard length INCR 2.0.
+END PROC add bad sector table to shard;
+
+(************ eliminate bad sector table from shard ****************)
+
+PROC eliminate bad sector table from shard (MODUL VAR shard) :
+  (* Entfernt die bad sector table (bst) aus dem shard falls sie sich am Ende
+     desselben befindet. Trägt korrekte neue Werte für den bst pointer und
+     shard laenge ein.
+  *)
+  REAL VAR shard length :: unsigned (int (shard, offset shard length)),
+           bst offset   :: unsigned (int (shard, offset bad sector table pointer));
+  LET bst entry length  =  4.0;  (* bst entries sind Wort-Paare *)
+  IF bst offset = 0.0
+  THEN (* ist gar keine bst vorhanden, also schon prima eliminiert *)
+  ELIF bst ist am ende
+  THEN bst entfernen  FI;
+  bst austragen.
+
+bst ist am ende :
+  bst offset + bst entry length * nr of bst entries + 2.0 =
+  shard length.
+
+nr of bst entries :
+  unsigned (int (shard, bst offset)).
+
+bst entfernen :
+  int (shard, offset shard length, unsigned (bst offset)).
+
+bst austragen :
+  int (shard, offset bad sector table pointer, 0).
+END PROC eliminate bad sector table from shard;
+
+(******************* installation nr *************************************)
+
+INT PROC installation nr :
+  actual installation nr
+END PROC installation nr;
+
+PROC installation nr (INT CONST new) :
+  actual installation nr := new
+END PROC installation nr;
+
+(*********************** Hilfsprozeduren **********************************)
+
+PROC kopf :
+  write head ("M o d u l - S H a r d     Zusammenbau eines SHard").
+END PROC kopf;
+
+END PACKET setup eumel shardmontage;
+
diff --git a/system/setup/3.1/src/setup eumel 7: setupeumel b/system/setup/3.1/src/setup eumel 7: setupeumel
new file mode 100644
index 0000000..0504e97
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel 7: setupeumel
@@ -0,0 +1,1238 @@
+(*************************************************************************)
+(*** Hauptprogramm des setup-Eumel:Einstellen der EUMEL - Partitionen  ***)
+(*** und SHard-Installation auf einer Festplatte.                      ***)
+(***                                                                   ***)
+(*** Autor : W. Sauerwein                          Stand   : 07.04.89  ***)
+(***         I. Ley                                Version : 2.3       ***)
+(*** Anpassung an Modul-SHard : Lutz Prechelt, Karlsruhe               ***)
+(***           -"-            : Werner Metterhausen                    ***)
+(***           -"-            : Martin Schönbeck                       ***)
+(*************************************************************************)
+(*** V 3.1   14.04.89  shard wird immer mit 'max sh size' geschriegen  ***)
+(***                   da mit 'ds pages' ggf teile fehlten, wenn innen ***)
+(***                   unbenutzte pages (buffer) waren                 ***)
+(*** V 3.0   10.04.89  support fuer mehrere Laufwerke eingebaut        ***)
+(***                   ausgabe der module vor loeschen etc. entfernt   ***)
+
+PACKET setup eumel DEFINES setup eumel, setup eumel endlos, version,
+show partition table:
+
+LET setup version = "Version 3.1";
+
+TEXT VAR stand :: "Stand : 18.04.89    (mit Modul-SHard Version 4.9)";
+
+PROC version (TEXT CONST vers): stand := vers END PROC version;
+
+PROC version: editget (stand) END PROC version;
+
+LET    max partitions           =   4,
+       max sh size              =  128, (* Anzahl Bloecke *)
+       return                   = ""13"",
+       escape                   = ""27"";
+
+LET hauptmodul namentyp    = "SHard *", 
+    modul namentyp         = "SHardmodul *",
+    sh name                = "SHARD",
+    sh backup              = "SHARD Sicherungskopie";
+
+ROW max partitions INT  VAR   part list;
+ROW max partitions INT  VAR   part type, part active,
+                              part first track, part last track;
+ROW max partitions REAL VAR   part start,
+                              part size;
+
+ INT  VAR   zylinder,
+            startzeile tabelle      ::   1,
+            startzeile menu         ::  12,
+            active partition,
+            partitions,
+            partition, i, j, cx, cy, help;
+ TEXT VAR   retchar,
+            meldung := "";
+ BOOL VAR   testausgabe,
+            mit schreibzugriff := TRUE,
+            meldung eingetroffen := FALSE,
+            endlos :: FALSE,
+            at version;
+THESAURUS VAR minimum modulkollektion := empty thesaurus;
+DATASPACE VAR ds := nilspace;
+
+(************************* setup eumel endlos *****************************)
+                                 
+PROC setup eumel endlos (BOOL CONST b) :
+  endlos := b;
+  IF endlos
+  THEN line;
+       putline ("Bitte geben Sie nun alle die Dateien an, die der Benutzer auf");
+       putline ("keinen Fall löschen darf.  (Taste drücken)");
+       minimum modulkollektion := certain (all, emptythesaurus);
+       line (3);
+       putline ("Der setup eumel kann nun nach dem nächsten Aufruf nicht mehr ");
+       putline ("verlassen werden. ")
+  FI.
+END PROC setup eumel endlos;
+
+(******************** get/put actual partition data ************************)
+
+PROC get actual partition data :
+   get boot block;
+   zylinder := tracks;
+   FOR i FROM 1 UPTO max partitions REP
+      part type        (i) := partition type (i);
+      part first track (i) := first track (i);
+      part last track  (i) := last track (i);
+      part start       (i) := partition start (i);
+      part size        (i) := partition size (i);
+      part active      (i) := partition word 0 (i);
+      IF partition active (i) THEN active partition := i FI
+   PER;
+   get number of installed partitions;
+   generate part list.
+
+get number of installed partitions :
+   partitions := 0;
+   FOR i FROM 1 UPTO max partitions REP
+     IF part type (i) <> 0 THEN partitions INCR 1 FI
+   PER.
+
+generate part list :
+   FOR i FROM 1 UPTO max partitions REP
+      IF part type (i) <> 0 THEN part list (i) := i
+                            ELSE part list (i) := 0
+      FI;
+   PER;
+   schiebe nullen nach hinten;
+   sort part list.
+
+schiebe nullen nach hinten :
+   i := 1; INT VAR k := 0;
+   REP k INCR 1;
+       IF part list (i) = 0 THEN circle
+                            ELSE i INCR 1
+       FI
+   UNTIL k = max partitions - 1 PER.
+
+circle :
+   FOR j FROM i UPTO max partitions - 1 REP
+      part list (j) := part list (j + 1)
+   PER;
+   part list (max partitions) := 0.
+
+sort part list :
+   FOR i FROM 2 UPTO partitions REP
+      FOR j FROM 1 UPTO i - 1 REP
+          IF part first track (part list (i)) < part first track (part list (j))
+             THEN tausche FI
+      PER
+   PER.
+
+tausche :
+   help := part list (i);
+   part list (i) := part list (j);
+   part list (j) := help.
+
+END PROC get actual partition data;
+
+PROC put actual partition data :
+   FOR i FROM 1 UPTO max partitions REP
+      IF partition exists (i) THEN put partition
+                              ELSE clear partition (i)
+      FI;
+   PER;
+   IF mit schreibzugriff THEN put boot block FI.
+  
+put partition :
+   IF is eumel (i) THEN partition type   (i, part type        (i));
+                        first track      (i, part first track (i));
+                        last track       (i, part last track  (i));
+                        partition start  (i, part start       (i));
+                        partition size   (i, part size        (i))
+   FI;
+   partition word 0    (i, part active      (i));
+   IF active partition = i
+      THEN partition active (i, TRUE)
+      ELSE partition active (i, FALSE)
+   FI.
+
+END PROC put actual partition data;
+
+(*************************** setup eumel ********************************)
+
+PROC setup eumel :
+   line; command dialogue (TRUE);
+   at version := yes ("System für AT", TRUE);
+   testausgabe := FALSE; (*yes ("Testversion", FALSE); *)
+   pruefe ob notwendige dateien vorhanden;
+   init modules list;
+   IF  yes ("Leere Floppy für Systemsicherung eingelegt", FALSE)
+   THEN command dialogue (FALSE); save system; command dialogue (TRUE)  FI;
+   IF NOT endlos THEN putline ("Verlassen mit ESC."); pause (40)  FI;
+   terminal setup;
+   logo;
+   generate eumel.
+
+pruefe ob notwendige dateien vorhanden:
+   BOUND INT VAR y;
+   IF mit schreibzugriff THEN y := old (sh name);
+                              y := old ("shget.exe");
+                              y := old ("bootblock");
+                              y := old ("configuration");
+                              y := old ("AT-4.x")
+   FI.
+
+END PROC setup eumel;
+
+PROC generate eumel :
+   disable stop;
+   show partition table;
+   REP update table;
+       main menu;
+       action;
+       IF is error THEN fehler;
+                        put line (error message);
+                        put line ("Bitte betätigen Sie eine Taste !");
+                        clear error;
+                        pause;
+                        IF mit schreibzugriff THEN terminal setup FI
+       FI
+   PER.
+
+action :
+   INT VAR choice;
+   clear error;
+   REP
+      cursor (cx, cy);
+      IF partitions < max partitions
+      THEN choice := get choice (0, max, retchar)
+      ELSE choice := get choice (2, max, 0, retchar)
+      FI;
+      IF escaped CAND NOT endlos THEN LEAVE generate eumel FI;
+   UNTIL retchar = return PER;
+   cl eop (1, startzeile menu - 1);
+   INT VAR unser kanal := channel;
+   SELECT choice OF
+      CASE 0 : programm ende
+      CASE 1 : create partition (TRUE)
+      CASE 2 : create partition (FALSE)
+      CASE 3 : activate partition
+      CASE 4 : delete partition
+      CASE 5 : delete partition table
+      CASE 6 : konfiguration anzeigen
+      CASE 7 : shard zusammenbauen
+      CASE 8 : modulkollektion aendern
+      CASE 9 : change drive
+
+  END SELECT;
+  continue (unser kanal).
+
+max :
+  9.
+
+change drive:
+   cursor (1, startzeile menu);
+   put ("Bitte Laufwerksnummer angeben:");
+   get cursor (cx, cy);
+   put ("   0 - 3");
+   REP cursor (cx, cy);
+     INT VAR drive := get choice (0, 3, retchar);
+     IF sure escaped THEN LEAVE change drive FI;
+   UNTIL NOT escaped PER;
+   setup channel (28-drive);
+   show partition table.
+
+
+programm ende :
+   cursor (1, startzeile menu);
+   IF keine partition aktiv
+      THEN IF trotz warnung beenden THEN eumel beenden FI
+      ELSE IF yes ("Wollen Sie die Partitionierung Ihrer Festplatte beenden", FALSE)
+              THEN eumel beenden
+   FI FI.
+
+keine partition aktiv : active partition = 0.
+
+trotz warnung beenden :
+   put line ("ACHTUNG : Es ist keine Partition aktiv gesetzt !");
+   put line ("          Sie können daher nicht von der Festplatte booten !");
+   line;
+   yes ("Wollen Sie trotzdem die Partitionierung der Festplatte beenden", FALSE).
+
+eumel beenden :
+   cl eop (1, startzeile menu - 1);
+   cursor (1, startzeile menu + 3);
+   shutup; terminal setup;
+   logo;
+   show partition table.
+   
+shard zusammenbauen :
+  cl eop (1, startzeile menu);
+  IF yes ("Wollen Sie Ihren SHard neu konfigurieren", FALSE)
+    THEN shard sichern und vorlage beschaffen;
+
+       IF NOT is error THEN build shard (ds)  FI;
+       IF is error OR NOT exists (sh name)
+
+       THEN forget (sh name, quiet); rename (sh backup, sh name);
+            putline ("Zusammenbau fehlgeschlagen. Alter SHard erhalten.");
+            pause (300);
+       FI;
+       forget (sh backup, quiet); forget (ds);
+       show partition table
+  FI.
+
+shard sichern und vorlage beschaffen :
+  forget (sh backup, quiet);
+  IF exists (shname)
+     THEN copy (sh name, sh backup);
+  FI;
+  forget (ds);
+  line;
+  IF yes (""3"Ist in einer existierenden Eumel-Partition ein SHard installiert,
+"13""10"der als Vorlage dienen soll", FALSE)
+  THEN INT VAR vorlage :: 69;
+       editget (1, startzeile menu + 4, "Partitiontyp: ", vorlage);
+       (* Das sollte man mal noch schöner machen !!! *)
+       read file (ds, start of partition (vorlage) + 1.0, max sh size,
+                  setup channel)
+  ELSE ds := old (sh name)  FI.
+
+
+konfiguration anzeigen :
+  hole anzuzeigenden ds;
+  line;
+  print configuration (ds, NOT yes ("Auf dem Drucker ausgeben", FALSE));
+  show partition table.
+
+hole anzuzeigenden ds:
+  forget (ds);
+  line;
+  IF yes ("Soll ein SHard aus einer Partition angezeigt werden", TRUE)
+  THEN INT VAR anzeige :: 69;
+       editget (1, startzeile menu + 4, "Partitiontyp: ", anzeige);
+       (* Das sollte man mal noch schöner machen !!! *)
+       read file (ds, start of partition (anzeige) + 1.0, max sh size,
+                  setup channel)
+  ELSE ds := old (ONE ((all LIKE hauptmodul namentyp) + "SHARD")) FI.
+
+
+modulkollektion aendern :
+  THESAURUS VAR th;
+  TEXT VAR x :: "SHard";
+  INT VAR i ;
+  page;
+  th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) +
+             (all LIKE sh name) ;
+  (* Diese Ausgabe macht leider den Bildschirmaufbau kaputt *)
+  (* mit dem Erfolg, daß man dann nicht mehr sieht, was man *)
+  (* ankreuzt, deshalb auskommentiert *)
+  (*******
+  putline(" Alle SHards :");
+  line;
+  FOR i FROM 1 UPTO highest entry(th)
+  REP
+     putline(name(th,i))
+  PER;
+  *******)
+  putline("      Modulkollektion ändern");
+  line;
+  IF yes ("Wollen Sie irgendwelche Module löschen", FALSE)
+  THEN th := (all LIKE hauptmodul namentyp) + (all LIKE modul namentyp) +
+             (all LIKE sh name) - minimum modulkollektion;
+       forget (certain (th, emptythesaurus));
+  ELIF yes ("Wollen Sie Module vom Archiv holen", FALSE)
+  THEN put ("Archivname:"); editget (x); line;
+       archive (x);
+       th := ALL archive LIKE modul namentyp;
+       fetch (certain (th, emptythesaurus), archive);
+       release (archive)
+  FI;
+  init modules list;
+  show partition table.
+
+
+END PROC generate eumel;
+
+
+PROC show partition table :
+   IF NOT mit schreibzugriff THEN get actual partition data FI;
+   headline;
+   devide table;
+   columns;
+   underlines;
+   rows;
+   downline.
+
+head line :
+   cl eop (1, startzeile tabelle);
+   put center (startzeile tabelle, "Aktuelle Partitions - Tabelle", TRUE).
+
+devide table :
+   FOR i FROM 1 UPTO 8
+   REP
+      cursor (45, startzeile tabelle + i); out (inverse (""))
+   PER.
+
+columns :
+   cursor ( 1, startzeile tabelle + 2);
+   out ("Nr. System   Typ Zustand Grösse Anfang Ende");
+   cursor (48, startzeile tabelle + 2);
+   out ("Platte    :   Zyl. / KB").
+
+underlines :
+   cursor ( 1, startzeile tabelle + 3);
+   out ("--------------------------------------------");
+   cursor (47, startzeile tabelle + 3);
+   out ("------------------------------").
+
+rows :
+   FOR i FROM 1 UPTO max partitions
+   REP cursor (2, startzeile tabelle + 3 + i);
+       put (text (i) + " :")
+   PER.
+
+downline :
+   put center (startzeile menu - 3, " EUMEL Installationssystem " + setup version
+                     + " (IBM PC/" + rechner typ
+                     + " und kompatible Rechner) ", TRUE);
+   put center (startzeile menu - 2, stand, TRUE).
+
+rechner typ :
+   IF at version THEN "AT"
+                 ELSE "XT"
+   FI.
+
+END PROC show partition table;
+
+PROC main menu :
+   biete auswahl an;
+   IF meldung eingetroffen THEN melde FI;
+   IF testausgabe THEN ausgabe fuer test FI.
+
+ausgabe fuer test :
+   testrahmen;
+   test out.
+
+testrahmen :
+   FOR i FROM startzeile menu - 1 UPTO startzeile menu + 9
+   REP
+      cl eol (45, i);
+      put (inverse (""))
+   PER;
+   cursor (52, startzeile menu);
+   put ("Ecke für Test-Output");
+   cursor (52, startzeile menu).
+
+test out :
+   FOR i FROM 1 UPTO max partitions
+   REP
+      cursor (52, startzeile menu + 1 + i);
+      put (text (i) + ":");
+      put (part type (i)); 
+      put (part first track (i));
+      put (part last track (i));
+      IF active partition = i THEN put ("aktiv")
+                             ELSE put ("inaktiv")
+      FI;
+   PER.
+
+melde :
+   cursor (1, 24);
+   put (inverse ("Meldung :"));
+   put (meldung);
+   meldung eingetroffen := FALSE.
+
+biete auswahl an :
+    cl eop (1, startzeile menu - 1); line;
+    IF partitions < max partitions
+    THEN putline (" EUMEL - Partition einrichten .............. 1")
+    ELSE line;
+         putline (" EUMEL - Partition")
+    FI;
+    cursor (20, startzeile menu + 1);
+    putline                    ("erneuern (Neuer SHard) .. 2");
+    putline ("                   aktivieren .............. 3");
+    putline ("                   löschen ................. 4");
+    putline (" Partitionstabelle löschen ................. 5");
+    putline (" SHard-Konfiguration anzeigen .............. 6");
+    putline (" SHard konfigurieren ....................... 7");
+    putline (" SHardmodule laden oder löschen ............ 8");
+    putline (" Bearbeitetes Laufwerk wechseln ............ 9");
+    putline (" SETUP-EUMEL beenden ....................... 0");
+    putline ("-----------------------------------------------");
+    put     (" Ihre Wahl                                >>");
+    get cursor (cx, cy).
+
+END PROC main menu;
+
+PROC update table :
+   IF mit schreibzugriff THEN get actual partition data FI;
+   FOR i FROM 1 UPTO partitions REP update partition PER;
+   FOR i FROM partitions + 1 UPTO max partitions REP rubout partition PER;
+   zeige plattengroesse;
+   IF active partition = 0 THEN meldung := "ACHTUNG : Es ist keine Partition aktiv gesetzt !";
+                                meldung eingetroffen := TRUE
+   FI.
+
+update partition :
+   partition := part list (i);
+   show partition.
+
+rubout partition :
+   cursor (5, startzeile tabelle + 3 + i);
+   out ("                                       ").
+
+show partition :
+   cursor (5, startzeile tabelle + 3 + i);
+   put (name + type + zustand  + groesse + startspur + endspur).
+
+name : subtext (subtext (part name, 1, 7)
+              + "     ", 1, 8).
+
+type : text (part type (partition), 5) + "  ".
+
+zustand   : IF active partition = partition THEN (" aktiv ")
+                                            ELSE ("       ")
+            FI.
+
+startspur : " " + text (part first track (partition), 5).
+endspur   :       text (part last track   (partition), 6).
+groesse   :       text (part groesse, 5).
+
+zeige plattengroesse :
+   put gesamt;
+   put noch freie;
+   put maximaler zwischenraum.
+
+put maximaler zwischenraum :
+   cursor (48, startzeile tabelle + 6);
+   put ("gr. Lücke : " + text (maximaler zwischenraum, 5) + "  / "
+   + kilobyte(maximaler zwischenraum)).
+
+put gesamt :
+   cursor (48, startzeile tabelle + 4);
+   put ("Gesamt    : " + text (zylinder, 5) + "  / "
+   + kilobyte(zylinder)).
+
+put noch freie :
+   cursor (48, startzeile tabelle + 5);
+   put ("Frei      : " + text (freie zylinder, 5) + "  / "
+   + kilobyte( freie zylinder)).
+
+END PROC update table;
+
+
+TEXT PROC kilobyte (INT CONST zylinderzahl):
+     TEXT VAR kb;
+     kb := text(round(real(zylinderzahl) * real(heads) * real(sectors) * 0.512,0));
+     subtext(kb,1,length(kb)-2)
+
+END PROC kilobyte;
+
+
+PROC create partition (BOOL CONST partition is new) :
+   IF NOT partition is new
+   THEN renew partition
+   ELIF freie part number gefunden CAND noch platz uebrig
+   THEN new partition
+   ELSE kein platz mehr  FI.
+
+kein platz mehr :
+   fehler;
+   put ("Es kann keine neue Partition mehr eingerichtet werden.");
+   pause (300).
+
+noch platz uebrig : freie zylinder > 0.
+
+freie part number gefunden :
+   IF partitions < max partitions THEN suche nummer;
+                                       TRUE
+                                  ELSE FALSE
+   FI.
+
+suche nummer :
+   partition := 0;
+   REP partition INCR 1 UNTIL part type (partition) = 0 PER.
+
+new partition :
+   cl eop (1, startzeile menu);
+   IF yes ("Neue EUMEL - Partition einrichten", FALSE)
+      THEN INT VAR alte aktive partition := active partition;
+           IF NOT partition exists (partition)
+              THEN IF enter partition spezifikations
+                      THEN IF mit schreibzugriff THEN check part and install FI
+                   FI;
+              ELSE keine freie partition
+   FI FI.
+
+renew partition :
+   cl eop (1, startzeile menu);
+   IF yes ("Neuen SHard auf bestehende EUMEL - Partition schreiben", FALSE)
+      THEN enter part number;
+           IF mit schreibzugriff THEN check part and install FI
+   FI.
+
+enter part number :
+   put ("Welche Partition wollen Sie erneuern :");
+   get cursor (cx, cy);
+   put ("   Abbruch mit <ESC>");
+   REP
+      REP cursor (cx, cy);
+          partition := get choice (1, 4, retchar);
+          IF sure escaped THEN LEAVE create partition FI;
+          partition := part list (partition)
+      UNTIL NOT escaped PER;
+      IF NOT (partition exists (partition) AND is eumel (partition))
+      THEN fehler; put ("Keine EUMEL - Partition");
+           pause (300); cl eop (1, 20);
+      FI
+   UNTIL partition exists (partition) AND is eumel (partition) PER.
+
+check part and install:
+   IF partition is new THEN put actual partition data  FI;
+   IF testausgabe THEN put ("Keine Überprüfung schlechter Sektoren, da Testversion !")
+                  ELSE trage schlechte sektoren ein;
+   FI;
+   IF is error AND partition is new
+               THEN active partition := alte aktive partition;
+                    rubout partition;
+                    LEAVE check part and install
+               ELIF NOT is error
+               THEN line;
+                    put ("Shard wird auf die Partition geschrieben..."); line (2);
+                    bringe shard auf platte (part type (partition));
+               ELSE line;
+                    putline ("Fehler aufgetreten. Partition unverändert")
+               FI;
+   put ("Bitte betätigen Sie eine Taste !");
+   loesche eingabepuffer;
+   pause.
+
+trage schlechte sektoren ein:
+   INT VAR anzahl schlechter sektoren;
+   line (2);
+   putline ("Überprüfen der Partition nach schlechten Sektoren.");
+   add bad sector table to shard (part type (partition), old (sh name),
+             NOT partition is new, anzahl schlechter sektoren);
+   line;
+   IF NOT is error THEN put ("Ich habe " + bs zahl + " gefunden.") FI.
+
+bs zahl:
+   IF anzahl schlechter sektoren = 0 
+      THEN "keine schlechten Sektoren"
+   ELIF anzahl schlechter sektoren > 1
+      THEN text (anzahl schlechter sektoren) + " schlechte Sektoren" 
+      ELSE "einen schlechten Sektor"
+   FI.
+
+keine freie partition :
+   fehler;
+   put line ("Sie können nur auf freien Partitionen 'EUMEL' einrichten.");
+   put      ("Die Partition " + text (partition) + " ist bereits mit einem System belegt !");
+   pause (300).
+
+END PROC create partition;
+
+BOOL PROC enter partition spezifikations :
+   cl eol (60, startzeile menu); put ("Abbruch mit <ESC>");
+   cl eol (1, startzeile menu + 2);
+   put ("Typ : EUMEL,");
+   INT VAR old end             := part last track (partition);
+   enter part size;
+   enter part first track;
+   put end track;
+   cl eol (60, startzeile menu);
+   IF NOT eingaben ok THEN LEAVE enter partition spezifikations WITH FALSE FI;
+   cl eol (1, startzeile menu + 4);
+   part first track (partition) := int (start);
+   part last track  (partition) := int (start) + int (size) - 1;
+   part start       (partition) := first usable sector;
+   part size        (partition) := first sector behind partition -
+                                               part start (partition);
+   active partition             := partition;
+   part type        (partition) := kleinste freie eumel nummer;
+   add to part list;
+   TRUE.
+
+eingaben ok :
+   cl eop (1, startzeile menu + 4);
+   yes ("Sind die Partitionsangaben korrekt", FALSE).
+
+enter part size :
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          put ("Welche Grösse :");
+          TEXT VAR size := groessenvorschlag;
+          loesche eingabepuffer;
+          editget (size, escape, "", retchar);
+          IF sure escaped
+             THEN LEAVE enter partition spezifikations WITH FALSE
+          FI
+      UNTIL NOT escaped PER;
+      IF NOT size ok THEN falsche groesse FI
+   UNTIL size ok  AND not too big PER;
+   cl eol (1, y + 1);
+   cl eol (1, y + 2);
+   cl eol (cx, cy);
+   put ("Grösse : " + size + ";").
+
+size ok :
+        NOT size greater maxint
+   CAND size positiv
+    AND desired size <= maximaler zwischenraum.
+
+not too big:
+  INT VAR x,y;
+  get cursor(x,y);
+  IF real(kilobyte(int(size))) >= 16196.0
+   THEN line;
+        putline("Eine Partition grösser 16 MB ist nur bei einer + Version sinnvoll !");
+        yes("Eingabe korrekt",FALSE)
+   ELSE TRUE
+  FI.
+
+size greater maxint :
+   length (size) >= 5.
+
+size positiv :
+   desired size > 0.
+   
+falsche groesse :
+   fehler;
+   put line ("Es kann keine Partition mit " + size + " Zylindern eingerichtet werden !");
+   IF NOT size greater maxint CAND size positiv
+      THEN put ("Die grösste zusammenhängende Anzahl Zylinder ist "
+              + text (maximaler zwischenraum) + ".")
+      ELSE put ("Bitte eine positive Grösse angeben !")
+   FI.
+
+groessenvorschlag :
+   text (maximaler zwischenraum).
+
+enter part first track :
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          put ("Start - Zylinder der Partition :");
+          TEXT VAR start := startvorschlag;
+          loesche eingabepuffer;
+          editget (start, escape, "", retchar);
+          IF sure escaped THEN part last track (partition) := old end;
+                               LEAVE enter partition spezifikations WITH FALSE
+          FI
+      UNTIL NOT escaped PER;
+      IF NOT start ok THEN falscher start FI
+   UNTIL start ok PER;
+   cl eol (cx, cy);
+   put ("Start : " + start + ";").
+
+put end track :
+   put ("Ende : " + text (int (start) + int (size) - 1)).
+
+start ok :
+        length (start) < 5
+   CAND enough room
+    AND NOT in existing partition
+    AND NOT out of volume.
+
+out of volume : desired start > zylinder OR desired start < 0.
+
+in existing partition :
+   IF partitions = 0 THEN FALSE
+                     ELSE i := 0;
+                          REP
+                             i INCR 1
+                          UNTIL start of part i > desired start
+                             OR last partition
+                             OR error found PER;
+                          IF error found THEN TRUE ELSE FALSE FI
+   FI.
+
+error found :
+   part index <> i AND
+   (start of part i <= desired start AND end spur i >= desired start).
+
+part index :
+   0.
+
+desired start : int (start).
+
+start of part i : part first track (part list (i)).
+
+last partition : i = partitions.
+
+enough room :
+   desired start + desired size <= begin of next partition.
+
+desired size : int (size).
+
+begin of next partition :
+   IF partitions = 0 THEN zylinder
+                     ELSE i := 0;
+                          REP
+                             i INCR 1;
+                          UNTIL start of part i > desired start
+                             OR last partition PER;
+                          IF start of part i > desired start THEN start of part i
+                                                             ELSE zylinder
+                          FI
+   FI.
+
+falscher start :
+   fehler;
+   put ("Auf Zylinder " + start);
+   put ("kann keine Partition der Grösse " + size);
+   put ("beginnen !").
+
+startvorschlag :
+   text (best start position).
+
+best start position :
+   IF partitions = 0 THEN 0
+                     ELSE best start spur vor und zwischen den partitionen
+   FI.
+
+best start spur vor und zwischen den partitionen :
+   INT VAR best start := 0, min size := zylinder;
+   FOR i FROM 0 UPTO partitions
+   REP
+      IF platz genug zwischen i und i plus 1 AND kleiner min size
+         THEN min size   := platz zwischen i und i plus 1;
+              best start := start des zwischenraums
+      FI
+   PER;
+   best start.
+
+start des zwischenraums :
+   end spur i + 1.
+
+end spur i :
+   IF i = 0 THEN -1
+            ELSE part last track (part list (i))
+   FI.
+
+platz zwischen i und i plus 1 :
+   part first track i plus 1 - (end spur i + 1).
+
+part first track i plus 1 :
+   IF i = partitions THEN zylinder
+                     ELSE part first track (part list (i + 1))
+   FI.
+
+platz genug zwischen i und i plus 1 :
+   platz zwischen i und i plus 1 >= int (size).
+
+kleiner min size : platz zwischen  i und i plus 1 < min size.
+
+first usable sector:
+   IF int (start) = 0
+      THEN 1.0
+      ELSE real (heads * sectors) * real (start)
+   FI.
+
+first sector behind partition:
+   real (heads * sectors) * (real(start) + real (size)).
+
+kleinste freie eumel nummer :
+   IF partitions = 0 THEN 69
+                     ELSE search for part type (69)
+   FI.
+   
+END PROC enter partition spezifikations;
+
+INT PROC search for part type (INT CONST minimum) :
+   IF minimum exists THEN search for part type (minimum + 1)
+                     ELSE minimum
+   FI.
+
+minimum exists :
+   BOOL VAR exists := FALSE;
+   INT VAR i;
+   FOR i FROM 1 UPTO partitions REP
+      IF part type (part list (i)) = minimum THEN exists := TRUE FI
+   PER;
+   exists.
+
+END PROC search for part type;
+
+PROC bringe shard auf platte (INT CONST eumel type):
+   IF mit schreibzugriff THEN
+      enable stop;
+      INT CONST old session :: session;
+      fixpoint;
+      IF session <> old session
+      THEN errorstop ("SHard auf Platte schreiben im RERUN !")  FI;
+      write file ("shget.exe", start der eumel partition, 1, setup channel);
+      write file (sh name, start der eumel partition + 1.0,
+                  max sh size, setup channel)
+   FI.
+
+start der eumel partition:
+   start of partition (eumel type).
+END PROC bringe shard auf platte;
+
+
+PROC add to part list :
+   IF part list leer THEN part list (1) := partition
+   ELIF neuer start vor letzter partition THEN fuege ein
+                                          ELSE haenge an
+   FI;
+   partitions INCR 1.
+
+part list leer : partitions = 0.
+
+neuer start vor letzter partition :
+   part first track (partition) < part first track (part list (partitions)).
+
+haenge an : part list (partitions + 1) := partition.
+
+fuege ein :
+   suche erste partition die spaeter startet;
+   schiebe restliste auf;
+   setze partition ein.
+
+suche erste partition die spaeter startet :
+   i := 0;
+   REP i INCR 1
+   UNTIL part first track (part list (i)) > part first track (partition) PER.
+
+schiebe restliste auf :
+   FOR j FROM partitions DOWNTO i
+   REP
+      part list (j + 1) := part list (j)
+   PER.
+
+setze partition ein :
+   part list (i) := partition.
+
+END PROC add to part list ;
+
+INT PROC maximaler zwischenraum :
+   IF partitions = 0 THEN zylinder
+                     ELSE max (maximaler platz vor und zwischen den partitionen,
+                               platz hinter letzter partition)
+   FI.
+
+maximaler platz vor und zwischen den partitionen :
+   help := platz vor erster partition;
+   FOR i FROM 1 UPTO partitions - 1
+   REP
+      help := max (help, begin of part i plus 1 - end of part i - 1)
+   PER;
+   help.
+
+platz vor erster partition :
+   part first track (part list (1)).
+
+platz hinter letzter partition :
+   zylinder - part last track (part list (partitions)) - 1.
+
+begin of part i plus 1 :
+   part first track (part list (i + 1)).
+
+end of part i :
+   part last track (part list (i)).
+
+END PROC maximaler zwischenraum;
+
+PROC activate partition :
+   enter part number;
+   IF NOT escaped THEN set partition active  FI.
+
+set partition active :
+   IF yes ("Partition mit Typnummer " + text (part type (partition)) + " aktivieren", FALSE)
+   THEN active partition := partition;
+        put actual partition data
+   FI.
+
+enter part number :
+   cursor (60, startzeile menu); put ("Abbruch mit <ESC>");
+   cursor ( 1, startzeile menu);
+   put ("Welche Partition wollen Sie aktivieren :");
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          partition := get choice (1, 4, retchar);
+          IF sure escaped THEN LEAVE activate partition FI;
+          partition := part list (partition)
+      UNTIL NOT escaped PER;
+      IF NOT partition exists (partition) THEN fehler melden FI
+   UNTIL partition exists (partition) PER;
+   cl eol (60, startzeile menu);
+   cl eop (1, cy + 2).
+
+fehler melden :
+   partition gibt es nicht.
+
+partition gibt es nicht :
+   fehler;
+   put ("Diese Partition gibt es nicht.").
+
+END PROC activate partition;
+
+PROC delete partition :
+   enter part number;
+   IF NOT escaped THEN
+      IF yes ("Partition mit Typnummer " + text (part type (partition)) + " löschen", FALSE)
+      AND ganz sicher
+          THEN rubout partition
+   FI FI.
+
+enter part number :
+   cursor (60, startzeile menu); put ("Abbruch mit <ESC>");
+   cursor ( 1, startzeile menu);
+   put ("Welche Partition wollen Sie löschen :");
+   get cursor (cx, cy);
+   REP
+      REP cursor (cx, cy);
+          partition := get choice (1, 4, retchar);
+          IF sure escaped THEN LEAVE delete partition FI;
+          partition := part list (partition)
+      UNTIL NOT escaped PER;
+   IF NOT (partition exists (partition) AND is eumel (partition)) THEN fehler melden FI
+   UNTIL partition gueltig AND is eumel (partition) PER;
+   cl eol (60, startzeile menu);
+   cl eop (1, cy + 2).
+   
+fehler melden :
+   IF NOT partition exists (partition) THEN partition gibt es nicht
+                                       ELSE keine eumel partition
+   FI.
+
+partition gibt es nicht :
+   fehler;
+   put ("Diese Partition gibt es nicht.").
+
+ganz sicher :
+   line;
+   yes ("Sind Sie sich ganz sicher", FALSE).
+   
+END PROC delete partition;
+
+PROC delete partition table :
+   cursor ( 1, startzeile menu + 1);
+   put ("Es gehen ALLE Daten verloren, die sich auf Ihrer Platte befinden !");
+   line (2);
+   IF yes ("Wollen Sie wirklich die ganze Partitionstabelle löschen", FALSE)
+      THEN line;
+           IF yes ("Sind Sie sich ganz sicher", FALSE)
+              THEN loesche ganze tabelle
+   FI FI.
+
+loesche ganze tabelle :
+   FOR i FROM 1 UPTO max partitions
+   REP part type  (i) := 0;
+       part first track (i) := 0;
+       part last track   (i) := 0;
+       part start (i) := 0.0;
+       part size (i) := 0.0;
+       part list  (i) := 0
+   PER;
+   partitions := 0;
+   active partition := 0;
+   IF mit schreibzugriff THEN clear partition table (-3475) FI.
+
+END PROC delete partition table;
+
+PROC rubout partition :
+   part type  (partition) := 0;
+   part first track (partition) := 0;
+   part last track   (partition) := 0;
+   IF active partition = partition THEN active partition := 0 FI;
+   del from part list;
+   put actual partition data.
+
+del from part list :
+   search for partition in part list;
+   delete it and set highest to 0;
+   partitions DECR 1.
+
+search for partition in part list :
+   i := 0;
+   REP i INCR 1 UNTIL part list (i) = partition PER.
+
+delete it and set highest to 0 :
+   FOR j FROM i UPTO partitions - 1
+   REP
+      part list (j) := part list (j + 1)
+   PER;
+   part list (partitions) := 0.
+
+END PROC rubout partition;
+
+INT PROC get choice (INT CONST von, bis, TEXT VAR retchar):
+  get choice (von, bis, von, retchar)
+END PROC get choice;
+
+INT PROC get choice (INT CONST von, bis, zusatz, TEXT VAR retchar):
+   LET return  = ""13"",
+       escape  = ""27"",
+       left    = ""8"";
+   TEXT VAR buffer; 
+   INT VAR cx, cy;
+   get cursor (cx, cy); out (" " + left);
+   REP
+      REP 
+         cursor (cx, cy); buffer := incharety;
+      UNTIL input ok OR buffer = escape PER; 
+      IF buffer = escape THEN retchar := escape;
+                              LEAVE get choice WITH 0
+      FI;
+      out (buffer); 
+      leseschleife bis left or ret;
+      IF retchar = left   THEN out (left + " ") FI;
+      IF retchar = escape THEN LEAVE get choice WITH 0 FI
+   UNTIL retchar = return OR retchar = escape PER;
+   int (buffer). 
+ 
+input ok : (buffer >= text (von) AND buffer <= text (bis)) OR buffer = text (zusatz).
+
+leseschleife bis left or ret:
+   REP 
+     inchar (retchar) 
+   UNTIL retchar = return OR retchar = left OR retchar = escape PER.
+
+END PROC get choice;
+
+TEXT PROC inverse (TEXT CONST t):
+  ""15"" + t + " " + ""14""
+END PROC inverse;
+
+PROC put center (TEXT CONST t):
+   put center (t, 80)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, BOOL CONST inverse):
+   put center (zeile, t, 80, inverse);
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t):
+   put center (zeile, t, 80)
+END PROC put center;
+
+PROC put center (TEXT CONST t, INT CONST gesamtbreite):
+   INT VAR cy;
+   get cursor (cy, cy);
+   put center (cy, t, gesamtbreite)
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):
+   put center (zeile, t, gesamtbreite, FALSE);
+END PROC put center;
+
+PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite,
+                   BOOL CONST inverse):
+   IF inverse
+     THEN cursor (1, zeile);
+          out (""15"");
+          gesamtbreite - 2 TIMESOUT " ";
+   FI;
+   cursor ((gesamtbreite - length (t)) DIV 2, zeile);
+   put (t);
+   IF inverse
+     THEN cursor (gesamtbreite - 1, zeile);
+          out (""14"");
+   FI
+END PROC put center;
+
+PROC cl eol: 
+  out (""5"") 
+END PROC cl eol;
+
+PROC cl eop: 
+  out (""4"") 
+END PROC cl eop; 
+ 
+PROC cl eol (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eol 
+END PROC cl eol; 
+ 
+PROC cl eop (INT CONST cx, cy): 
+   cursor (cx, cy); 
+   cl eop 
+END PROC cl eop; 
+
+INT PROC partition groesse (INT CONST part) :
+   part last track (part) - part first track (part) + 1
+END PROC partition groesse;
+
+BOOL PROC is eumel (INT CONST partition) :
+   part type (partition) >= 69 AND part type (partition) <= 72
+END PROC is eumel;
+
+BOOL PROC partition exists (INT CONST partition) :
+   IF partition > 0 AND partition <= max partitions
+      THEN part type (partition) <> 0
+      ELSE FALSE
+   FI
+END PROC partition exists;.
+
+part groesse : partition groesse (partition).
+
+part name :
+   SELECT part type (partition) OF
+     CASE 1, 4           : "DOS"
+     CASE 69, 70, 71, 72 : "EUMEL"
+     OTHERWISE text (part type (partition))
+   END SELECT.
+
+escaped : retchar = escape.
+
+sure escaped :
+   IF escaped THEN cl eop (1, 20); cursor (1, 22);
+                   yes ("Vorgang abbrechen", TRUE)
+              ELSE FALSE
+   FI.
+
+partition gueltig :
+       partition > 0
+   AND partition <= max partitions.
+
+freie zylinder :
+   zylinder - belegte zylinder.
+
+belegte zylinder :
+   help := 0;
+   FOR i FROM 1 UPTO partitions REP
+      help INCR partition groesse (part list (i))
+   PER;
+   help.
+
+keine eumel partition :
+   fehler;
+   put line ("Sie dürfen mit diesem System nur 'EUMEL' - Partitionen manipulieren.");
+   put      ("Die Partition " + text (partition) + " ist nicht vom Typ 'EUMEL' !").
+
+fehler :
+   cl eop (1, 20);
+   put (""7"" + inverse ("FEHLER :")); line (2).
+
+loesche eingabepuffer :
+   REP UNTIL incharety = "" PER. ;
+
+PROC logo :
+  page;
+  put center (3, "S E T U P - E U M E L   "+ setup version);
+  put center (5, "für");
+  put center (7, "M O D U L - S H A R D");
+  put center (13, "======================================================");
+  put center (15, "(für IBM " + typ + " und Kompatible)");
+  put center (20, stand);
+  pause (50);
+  collect heap garbage.
+
+typ :
+  IF at version THEN "AT" ELSE "XT"  FI.
+END PROC logo;
+
+END PACKET setup eumel;
+
+setup eumel
+
+
+
+
+
+
+
diff --git a/system/setup/3.1/src/setup eumel erzeugen b/system/setup/3.1/src/setup eumel erzeugen
new file mode 100644
index 0000000..7a50898
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel erzeugen
@@ -0,0 +1,15 @@
+check off;
+insert("setup eumel -1: mini eumel dummies");
+insert("setup eumel 0: /S");
+insert("setup eumel 1: basisoperationen");
+insert("setup eumel 2: modulzugriffe");
+insert("setup eumel 3: modulkonfiguration");
+insert("setup eumel 5: partitionierung");
+insert("setup eumel 6: shardmontage");
+insert("setup eumel 7: setupeumel");
+putline("Jetzt 'setup eumel endlos' nicht vergessen");
+ 
+
+
+
+
diff --git a/system/setup/3.1/src/setup eumel erzeugen-M b/system/setup/3.1/src/setup eumel erzeugen-M
new file mode 100644
index 0000000..ad85301
--- /dev/null
+++ b/system/setup/3.1/src/setup eumel erzeugen-M
@@ -0,0 +1,14 @@
+check off;
+insert("setup eumel 0: /M");
+insert("setup eumel 1: basisoperationen");
+insert("setup eumel 2: modulzugriffe");
+insert("setup eumel 3: modulkonfiguration");
+insert("setup eumel 5: partitionierung");
+insert("setup eumel 6: shardmontage");
+insert("setup eumel 7: setupeumel");
+putline("Jetzt 'setup eumel endlos' nicht vergessen");
+ 
+
+
+
+
diff --git a/system/setup/3.1/src/shget.exe b/system/setup/3.1/src/shget.exe
new file mode 100644
index 0000000..902d697
--- /dev/null
+++ b/system/setup/3.1/src/shget.exe
diff --git a/system/shard-x86-at/7/README.rst b/system/shard-x86-at/7/README.rst
new file mode 100644
index 0000000..5d62c2e
--- /dev/null
+++ b/system/shard-x86-at/7/README.rst
@@ -0,0 +1,5 @@
+AT SHard 7
+==========
+
+SHard for PC AT on 8086, version 7 (SHDVER) for Hintergrund 1.7.4.2 (hgver).
+
diff --git a/system/shard-x86-at/7/data/EXEMOD.EXE b/system/shard-x86-at/7/data/EXEMOD.EXE
new file mode 100644
index 0000000..c52538b
--- /dev/null
+++ b/system/shard-x86-at/7/data/EXEMOD.EXE
diff --git a/system/shard-x86-at/7/data/EXEPACK.EXE b/system/shard-x86-at/7/data/EXEPACK.EXE
new file mode 100644
index 0000000..794b562
--- /dev/null
+++ b/system/shard-x86-at/7/data/EXEPACK.EXE
diff --git a/system/shard-x86-at/7/data/FSHARD.EXE b/system/shard-x86-at/7/data/FSHARD.EXE
new file mode 100644
index 0000000..61b0eb6
--- /dev/null
+++ b/system/shard-x86-at/7/data/FSHARD.EXE
diff --git a/system/shard-x86-at/7/data/FSHGET.EXE b/system/shard-x86-at/7/data/FSHGET.EXE
new file mode 100644
index 0000000..1f678ed
--- /dev/null
+++ b/system/shard-x86-at/7/data/FSHGET.EXE
diff --git a/system/shard-x86-at/7/data/GENBOOT.EXE b/system/shard-x86-at/7/data/GENBOOT.EXE
new file mode 100644
index 0000000..077be93
--- /dev/null
+++ b/system/shard-x86-at/7/data/GENBOOT.EXE
diff --git a/system/shard-x86-at/7/doc/8039.PRT b/system/shard-x86-at/7/doc/8039.PRT
new file mode 100644
index 0000000..c7f20e5
--- /dev/null
+++ b/system/shard-x86-at/7/doc/8039.PRT
@@ -0,0 +1,569 @@
+0.ope ("12")##limit (15.5)# 

+#right#20.01.88 

+ 

+#center##ub#Beschreibung der Single-Chip-uP 8031/5/9/40/8/9/50#ue# 

+ 

+1.) Pinning MCS-48, UPI-41, UPI-42 

+ 

+                          +----__----+ 

+              T0          |  1    40 | Vcc +5V

+              Xtal1       |  2    39 | T1 (In) 

+              Xtal2       |  3    38 | P27       -DACK =8x41/2

+              -Reset (In) |  4    37 | P26       DRQ   =8x41/2

+              -SS (In)    |  5    36 | P25       -IBF  =8x41/2

+              -Int (In)   |  6    35 | P24       -OBF  =8x41/2

+              EA (In)     |  7    34 | P17 

+              -RD (Out)   |  8    33 | P16 

+ 8x41/2=A0    -PSEN (Out) |  9    32 | P15 

+              -WR (Out)   | 10    31 | P14 

+ 8x41/2=SYNC  ALE (Out)   | 11    30 | P13 

+              D0          | 12    29 | P12 

+              D1          | 13    28 | P11 

+              D2          | 14    27 | P10 

+              D3          | 15    26 | Vdd/Vpp +5V/+21V bzw. 25V         

+              D4          | 16    25 | PROG (O=8243 ioExpander,I=pulse)  

+              D5          | 17    24 | P23 

+              D6          | 18    23 | P22 

+              D7          | 19    22 | P21 

+              GND         | 20    21 | P20 

+                          +----------+ 

+-SS   : Single Step (zusammen mit ALE-Output) 

+-RESET: 10uF Kondensator nach GND

+-INT  : muss mind. 3 Zyklen lang low sein 

+PROG  : Programmierpuls (+18V, +23V) bzw. 

+        bzw. Output fuer 8243 I/O Expander 

+SYNC  : Output Clock wie ALE 

+A0    : Input from Host: 0 = Datatransfer, 1 = Commandtransfer (kann in F1 

+        gelesen werden) 

+-IBF  : Input buffer full 

+OBF   : Outputbuffer full 

+-DACK : DMA Acknowledge 

+DRQ   : DMA request 

+ 

+ 

+- Pinning MCS-51 

+ 

+                          +----__----+ 

+8x32/52=T2    P10         |  1    40 | Vcc +5V

+8x32/52=T2EX  P11         |  2    39 | P00/AD0 

+              P12         |  3    38 | P01/AD1

+              P13         |  4    37 | P02/AD2

+              P14         |  5    36 | P03/AD3

+              P15         |  6    35 | P04/AD4

+              P16         |  7    34 | P05/AD5

+              P17         |  8    33 | P06/AD6

+              Reset/Vpd   |  9    32 | P07/AD7

+              P30/RXD     | 10    31 | -EA 

+              P31/TXD     | 11    30 | ALE 

+              P32/-INT0   | 12    29 | -PSEN

+              P33/-INT1   | 13    28 | P27/A15

+              P34/T0      | 14    27 | P26/A14

+              P35/T1      | 15    26 | P25/A13                           

+              P36/-WR     | 16    25 | P24/A12                           

+              P37/-RD     | 17    24 | P23/A11

+              Xtal2       | 18    23 | P22/A10

+              Xtal1       | 19    22 | P21/A9

+              GND         | 20    21 | P20/A8

+                          +----------+ 

+ 

+T2 = Timer 2 counter trigger input 

+T2EX = Timer 2 external input clock 

+

+-Vdd     : +5V im Betrieb, 

+           0V fuer Low Power Standby 

+           +21V/+25V fuer Programmierspannung 

+-T0      : Test Input 0 bzw. 

+           Clock-Output des Timers falls ENT0 CLK Befehl gegeben wurde. 

+-T1      : Test Input 1 bzw. 

+           Counter/Timer Input if STRT CNT Befehl gegeben wurde 

+XTAL1    : Quartz, bzw. CLock Input 

+XTAL2    : Quartz 

+ALE      : Adresse Latch enable output (einmal pro Zyklus aktiviert, d.h.

+           als Clockoutput zu gebrauchen) 

+           Negative Flanke uebernimmt Adressen auf dem Bus in ext. Latch 

+-RD      : Output-Strobe to read Data from the BUS into the CPU 

+-WR      : Output-Strobe indicating a write into external Memory 

+-PSEN    : Low if a fetch to external memory occurs (ROM -CE)

+P10..P17 : I/O Port 1 quasi-bidirektional 

+P20..P27 : I/O Port 2 " 

+           P20..P23 dienen als A8..A11 bei Programstore fetches bzw. 

+           mit PROG & 8243 als 4Bit I/O Expander Adresse 

+EA       : External Access input, If high, all internal Programm Memory 

+           fetches reference external memory (debugging mode) 

+D0..D7   : Datenbus, I/O zus. mit -RD, -WR, ALE 

+           Enthaelt A0..A7 zusammen mit PSEN fuer ext. Prog.mem.References  

+            "       A0..A7 "       mit ALE, -RD, -WR fuer ext.RAM-References 

+ 

+ 

+2.) Vergleich der Single-Chip-CPUs 

+ 

+UPI-41      : 8041, 8641, 8741 

+UPI-42      : 8042, 8742 

+MCS-48 Serie: 8035, 8039, 8040, 8048, 8049, 8050, 8748, 8749, (8243) 

+MCS-51 Serie: 8031, 8032, 8044, 8344, 8744, 8051, 8052 

+ 

+E = EPROM - Version 

+R = (Mask)-ROM Version 

+- = Kein ROM 

+X = External PROM 

+Buf=Buffered Port, Buffer-Full über Pins rausgeführt. 

+ 

+ CPU  | RAM | ROM |E|Ports|Serial |Timer |INTs| Sonstiges 

+------+-----+-----+-+-----+-------+------+----+-------------------------- 

+ 8031 |  64 |  -  |-| 4(3)|1 Async| 2x16 | 2  | 128k ext.mem., boolean-cpu 

+ 8032 | 256 |  -  |-| 4(3)|1 Async| 3x16 | 2  | 128k ext.mem., boolean-cpu 

+ 8035 |  64 |  -  |-| 2   |   -   | 1x 8 | 1  | Timer/Counter 

+ 8039 | 128 |  -  |-| 2   |   -   | 1x 8 | 1  | " 

+ 8040 | 256 |  -  |-| 2   |   -   | 1x 8 | 1  | " 

+ 8041 |  64 | 1k  |R|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8042 | 128 | 2k  |R|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8044 | 192 | 4k  |R| 4(3)|H/SDLC | 2x16 | 2  | 128k ext.,b-cpu,375kbaud-pll 

+ 8048 |  64 | 1k  |R| 2   |   -   | 1x 8 | 1  | Timer/Counter 

+ 8049 | 128 | 2k  |R| 2   |   -   | 1x 8 | 1  | " 

+ 8050 | 256 | 4k  |R| 2   |   -   | 1x 8 | 1  | " 

+ 8051 | 128 | 4k  |R| 4(3)|1 Async| 2x16 | 2  | 128k ext., boolean-cpu 

+ 8052 | 256 | 8k  |R| 4(3)|1 Async| 3x16 | 2  | 128k ext., boolean-cpu 

+ 8243 |   - |  -  |-|4x4B |   -   |  -   | -  | I/O Expander f.MCS-48 Serie 

+ 8344 | 192 | 4k  |X| 4(3)|H/SDLC | 2x16 | 2  | 128k ext.,b-cpu,375kbaud-pll 

+ 8741 |  64 | 1k  |E|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8742 | 128 | 2k  |E|2xBuf|  DMA  | 1x 8 | -  | 4 I/O Bits gempxt. 

+ 8744 ! 192 | 4k  |E| 4(3)|H/SDLC | 2x16 | 2  | 128k ext.,b-cpu,375kbaud-pll 

+ 8748 |  64 | 1k  |E| 2   |   -   | 1x 8 | 1  | Timer/Counter 

+ 8749 | 128 | 2k  |E| 2   |   -   | 1x 8 | 1  | " 

+ 8751 | 128 | 4k  |E| 4(3)|1 Async| 2x16 | 2  | 128k ext., boolean-cpu 

+ 8752 | 256 | 4k  |E| 4(3)|1 Async| 3x16 | 2  | 128k ext., boolean-cpu 

+ 

+ 

+- Programmieren des 8748: 

+ 

+ 1.) Vdd = 5V, XTAL angeschlossen, -RESET = 0V, T0=5V, EA=5V 

+ 2.) 8748 in Sockel setzen 

+ 3.) T0=0V (* Program Mode select *) 

+ 4.) EA=23V (* Program Mode activate *) 

+ 5.) BUS (0..7) und P2.0..P2.3 (8..B) mit Adresse belegen 

+ 6.) -RESET=5V (* Latch Adress *) 

+ 7.) BUS := Databyte 

+ 8.) Vdd=25V (* Programmierspannung *) 

+ 9.) PROG=0V, dann 50ms PROG=23V (* Programmieren *) 

+10.) Vdd=5V (* Programmierspannung weg *) 

+11.) T0=5V (* Verify mode *) 

+12.) Read Data on BUS and compare (* Verify *) 

+13.) T0=0V (* Select Program Mode *) 

+14.) -RESET=0V, GOTO Step 5 (* Floating BUS *) 

+15.) Vdd=5V, -RESET=0V, EA=5V, 8748 aus Sockel nehmen 

+ 

+3.) Memory-Map des 8039 

+ 

+RAM 

+Adresse  Funktion 

+00..07   Registerbank 0 (r0..r7) 

+08..17   Stack (8 Ebenen) 

+18..1F   Registerbank 1 (r0..r7) 

+20..7F   Frei belegbar 

+ 

+ROM 

+Adresse 

+000..0FF ROM-Page 0, Bank 0 (Bank 0 ist mb0) 

+... 

+700..7FF ROM-Page 7, Bank 0 

+800..8FF ROM Page 0, Bank 1 (Adressen 800..FFF treten im Code nur 

+...                          als 000..7FF auf!) 

+F00..FFF ROM Page 7, Bank 1 (Bank 1 ist mb1) 

+ 

+Bei Reset erfolgt ein Sprung nach 000 

+Bei (Timer-)Interrupt erfolgt ein Sprung nach 007 

+ 

+Register 

+Bezeichn. Name 

+a         Akkumulator (8 Bit) 

+r0..r7    Register 0 bis 7 (Im internen RAM) (je 8 Bit) 

+t         Timer (8 Bit) 

+p1        Port 1 (8 Bit) 

+p2        Port 2 (8 Bit) 

+ 

+Bits 

+i         Interrupt-Leitung INT (1 Bit) 

+t0        Test-Eingang T0 (1 Bit) 

+t1        Test-Eingang T1 (91 Bit) 

+f0        Internes Flag 0 

+f1        Internes Flag 1 

+ 

+Jump-Conditions 

+jtf        Jump if Timer finished (Nulldurchgang) 

+jntf       Jump if Timer not finished (zählt noch) 

+jb0..jb7   Jump if Bit 0..7 in a is set 

+jt0        Jump if T0-Input is high 

+jnt0       Jump if T0-Input is low 

+jt1        Jump if T1-Input is high 

+jnt1       Jump if T1-Input is low 

+jf0        Jump if Flag 0 is set 

+jnf0       Jump if Flag 0 is cleared 

+jf1        Jump if Flag 1 is set 

+jnf1       Jump if Flag 1 is cleared 

+jz         Jump if a is zero 

+jnz        Jump if a is not zero 

+jc         Jump if carry is set 

+jnc        Jump if carry is cleared 

+jni        Jump if Interrupt-Pin INT is low 

+ 

+4.) Befehlssatz nach Opcode sortiert 

+ 

+Symbolik (Beispiele) 

+ 

+@r0   Inhalt der Speicherstelle, deren Adresse in Register 0 steht. 

+#xx   Die (Byte-)Konstante xx 

+2xx   Die Adressen 200..2FF (je nach xx), xx ist ein Offset zur Seite 2. 

+mb1   ROM-Bank 1 ('800..FFF') 

+ 

+00             nop 

+01 

+02 

+03 xx          add  a,#xx 

+04 xx          jmp  0xx 

+05 

+06 xx          jntf xx 

+07             dec  a 

+08 

+09             in   a,p1 

+0A             in   a,p2 

+0B 

+0C 

+0D 

+0E 

+0F 

+ 

+10             inc  @r0       Memoryvalue incrementieren 

+11             inc  @r1 

+12 xx          jb0  xx        Jump if Bit 0 in a is high 

+13 

+14 xx          call 0xx 

+15             dis  i         Disable Interrupts 

+16 xx          jtf  xx 

+17             inc  a 

+18             inc  r0 

+19             inc  r1 

+1A             inc  r2 

+1B             inc  r3 

+1C             inc  r4 

+1D             inc  r5 

+1E             inc  r6 

+1F             inc  r7 

+ 

+20             xch  a,@r0     a und Memoryinhalt bei @r0 austauschen 

+21             xch  a,@r1 

+22 

+23 xx          mov  a,#xx     a mit Konstante laden 

+24 xx          jmp  1xx 

+25             en   tcnti     Enable Timer/Counter Interrupt 

+26 xx          jnt0 xx 

+27             clr  a         a := 0 

+28             xch  a,r0      a und Register vertauschen 

+29             xch  a,r1 

+2A             xch  a,r2 

+2B             xch  a,r3 

+2C             xch  a,r4 

+2D             xch  a,r5 

+2E             xch  a,r6 

+2F             xch  a,r7 

+ 

+30 

+31 

+32 xx          jb1  xx 

+33 

+34 xx          call 1xx 

+35             dis  tcnti     Disable Timer/Counter Interrupt 

+36 xx          jt0  xx 

+37             cpl  a         a := NOT a 

+38 

+39 

+3A 

+3B 

+3C 

+3D 

+3E 

+3F 

+ 

+40             orl  a,@r0 

+41             orl  a,@r1 

+42             mov  a,t       Timervalue lesen nach a 

+43 xx          orl  a,#xx     Logisches Oder 

+44 xx          jmp  2xx 

+45             strt cnt       Counter starten, Timer aus 

+46 xx          jnt1 xx 

+47 

+48             orl  a,r0 

+49             orl  a,r1 

+4A             orl  a,r2 

+4B             orl  a,r3 

+4C             orl  a,r4 

+4D             orl  a,r5 

+4E             orl  a,r6 

+4F             orl  a,r7 

+ 

+50             anl  a,@r0 

+51             anl  a,@r1 

+52 xx          jb2  xx 

+53 xx          anl  a,#xx     Logisches Und 

+54 xx          call 2xx 

+55             strt t         Timer starten, Counter aus 

+56 xx          jt1  xx 

+57 

+58             anl  a,r0 

+59             anl  a,r1 

+5A             anl  a,r2 

+5B             anl  a,r3 

+5C             anl  a,r4 

+5D             anl  a,r5 

+5E             anl  a,r6 

+5F             anl  a,r7 

+ 

+60             add  a,@r0 

+61             add  a,@r1 

+62             mov  t,a       Timervalue mit a laden 

+63 

+64 xx          jmp  3xx 

+65             stop tcnt      Timer/Counter stoppen 

+66 xx          jnf1 xx 

+67             rrc  a         a rechts rotieren (durchs Carry) 

+68             add  a,r0      a := a + r0 

+69             add  a,r1 

+6A             add  a,r2 

+6B             add  a,r3 

+6C             add  a,r4 

+6D             add  a,r5 

+6E             add  a,r6 

+6F             add  a,r7 

+ 

+70 

+71 

+72 xx          jb3  xx 

+73 

+74 xx          call 3xx 

+75 

+76 xx          jf1  xx 

+77             rr   a         a rechts rotieren (ohne Carry) 

+78 

+79 

+7A 

+7B 

+7C 

+7D 

+7E 

+7F 

+ 

+80                  

+81 

+82 

+83             ret            Unterprogrammruecksprung 

+84 xx          jmp  4xx 

+85             clr  f0        Flag 0 loeschen 

+86 xx          jni  xx 

+87 

+88 

+89 xx          orl  p1,#xx    Bits im Outputport 1 setzen 

+8A xx          orl  p2,#xx    dto. Port 2 

+8B 

+8C 

+8D 

+8E 

+8F 

+ 

+90             movx @r0,a     Port (@r0) mit a beschreiben 

+91             movx @r1,a 

+92 xx          jb4  xx 

+93             retr           Return from Interrupt

+94 xx          call 4xx 

+95             cpl  f0        Flag 0 umdrehen 

+96 xx          jnz  xx 

+97             clr  c         Carry loeschen 

+98 

+99 xx          anl  p1,#xx    Bit im Outputport 1 loeschen (mit NOT xx) 

+9A xx          anl  p2,#xx    dto. Port 2 

+9B 

+9C 

+9D 

+9E 

+9F 

+ 

+A0             mov  @r0,a     Memory mit a beschreiben 

+A1             mov  @r1,a 

+A2 

+A3             movp a,@a      a mit ROMinhalt (a) laden (aktuelle Page) 

+A4 xx          jmp  5xx 

+A5             clr  f1 

+A6 

+A7             cpl  c         Carry umdrehen 

+A8             mov  r0,a 

+A9             mov  r1,a 

+AA             mov  r2,a 

+AB             mov  r3,a 

+AC             mov  r4,a 

+AD             mov  r5,a 

+AE             mov  r6,a 

+AF             mov  r7,a 

+ 

+B0 xx          mov  @r0,#xx   Memoryzelle mit Konstante laden 

+B1 xx          mov  @r1,#xx 

+B2 xx          jb5  xx 

+B3 

+B4 xx          call 5xx 

+B5             cpl  f1 

+B6 

+B7 

+B8 xx          mov  r0,#xx    Register mit Konstante laden 

+B9 xx          mov  r1,#xx 

+BA xx          mov  r2,#xx 

+BB xx          mov  r3,#xx 

+BC xx          mov  r4,#xx 

+BD xx          mov  r5,#xx 

+BE xx          mov  r6,#xx 

+BF xx          mov  r7,#xx 

+ 

+C0             dec  @r0 

+C1             dec  @r1 

+C2 

+C3 

+C4 xx          jmp  6xx 

+C5             sel  rb0       Registerbank 0 waehlen (RAM 00..07) 

+C6 xx          jz   xx 

+C7 

+C8             dec  r0 

+C9             dec  r1 

+CA             dec  r2 

+CB             dec  r3 

+CC             dec  r4 

+CD             dec  r5 

+CE             dec  r6 

+CF             dec  r7 

+  

+D0             xrl  a,@r0 

+D1             xrl  a,@r1 

+D2 xx          jb6  xx 

+D3 xx          xrl  a,#xx     Logisches Exklusiv-Oder 

+D4 xx          call 6xx 

+D5             sel  rb1       Registerbank 1 waehlen (RAM 18..1F) 

+D6 

+D7 

+D8             xrl  a,r0 

+D9             xrl  a,r1 

+DA             xrl  a,r2 

+DB             xrl  a,r3 

+DC             xrl  a,r4 

+DD             xrl  a,r5 

+DE             xrl  a,r6 

+DF             xrl  a,r7 

+ 

+E0 xx          djnz @r0,xx    

+E1 xx          djnz @r1,xx 

+E2 

+E3             movp3 a,@a     a mit Inhalt von (3aa) laden, aa = (a)

+E4 xx          jmp  7xx 

+E5             sel  mb0       Memorybank 0 (ROM 000..7FF) waehlen 

+E6 xx          jnc  xx 

+E7             rl   a         a nicht durch c links rotieren 

+E8 xx          djnz r0,xx     Decrement r0, jump to xx if r0 is not zero 

+E9 xx          djnz r1,xx 

+EA xx          djnz r2,xx 

+EB xx          djnz r3,xx 

+EC xx          djnz r4,xx 

+ED xx          djnz r5,xx 

+EE xx          djnz r6,xx 

+EF xx          djnz r7,xx 

+ 

+F0             mov  a,@r0 

+F1             mov  a,@r1 

+F2 xx          jb7  xx 

+F3 

+F4 xx          call 7xx 

+F5             sel  mb1       Memorybank 1 (ROM 800..FFF) waehlen 

+F6 xx          jc   x 

+F7             rlc  a         a durch carry links rotieren 

+F8             mov  a,r0 

+F9             mov  a,r1 

+FA             mov  a,r2 

+FB             mov  a,r3 

+FC             mov  a,r4 

+FD             mov  a,r5 

+FE             mov  a,r6 

+FF             mov  a,r7 

+ 

+5.) Befehlssatz nach Funktionsgruppen 

+ 

+- Arithmetik 

+            @r0 @r1 -   #xx -   -   -   a   r0..r7 

+dec         c0  c1      -               07  C8..CF 

+inc         10  11      -               17  18..1F 

+clr         -   -       -               27  - 

+cpl         -   -       -               37  - 

+orl a,..    40  41      43              -   48..4F 

+anl a,..    50  51      53              -   58..5F 

+add a,..    60  61      03              -   68..6F 

+rrc         -   -       -               67  - 

+rr          -   -       -               77  - 

+xrl a,..    D0  D1      D3              -   D8..DF 

+rl          -   -       -               E7  - 

+rlc         -   -       -               F7  - 

+ 

+- Flags 

+                                f0  f1  c 

+clr                             85  A5  97 

+cpl                             95  B5  A7 

+ 

+- Transfer 

+            @r0 @r1 -   #xx -   -   -   a   r0..r7 

+xch a,..    20  21      -                   28..2F 

+mov a,..    F0  F1      23                  F8..FF 

+mov ..,a    A0  A1      -                   A8..AF 

+mov ..,#xx  B0  B1      23                  B8..BF 

+ 

+swap a

+movp a,@a               A3  

+movp3 a,@a              E3 

+ 

+ 

+- I/O 

+                                                  i= 1   2 

+in   a,pi                                            09   0A 

+orl  pi,#xx                                          89   8A 

+anl  pi,#xx                                          99   9A 

+outl pi,a 

+ 

+movx ..,a   90  91 

+movx a,xx 

+ 

+ 

+- Timer 

+                                i  tcnti 

+en                              05  25 

+dis                             15  35 

+ 

+                                cnt t 

+strt                            45  55 

+stop                              65 

+ 

+mov a,t             42 

+mov t,a             62 

+ 

+ 

+- Programmsteuerung 

+ 

+ret                     83 

+retr                    93 

+ 

+     rr=   @r0 @r1                          r0..r7 

+djnz rr,xx (E0  E1)                         E8..EF 

+ 

+      i=   0   1   2   3   4   5   6   7 

+jmp  $ixx  04  24  44  64  84  A4  C4  E4 

+call $ixx  14  34  54  74  94  B4  D4  F4 

+ 

+      i=   0   1   2   3   4   5   6   7 

+jbi,xx     12  32  52  72  92  B2  D2  F2 

+ 

+      cc=  ntf tf  nt0 t0  nt1 t1  nf1 f1  ni  nz  z   nc  c 

+jcc,xx     06  16  26  36  46  56  66  76  86  96  C6  E6  F6 

+ 

+- Sonstiges 

+                                rb0 rb1 mb0 mb1 

+sel                             C5  D5  E5  F5 

+nop        00 

diff --git a/system/shard-x86-at/7/doc/BIOSINT.TXT b/system/shard-x86-at/7/doc/BIOSINT.TXT
new file mode 100644
index 0000000..c55b064
--- /dev/null
+++ b/system/shard-x86-at/7/doc/BIOSINT.TXT
@@ -0,0 +1,305 @@
+#type ("17.klein")# 

+Interrupts/Traps/Exeptions (Bios)                                 03.06.87

+ 

+Interrupt: IRQn (Durch Hardware ausgelöst, werden auf Traps umgelenkt) 

+Trap     : INTn (Durch Software ausgelöst) 

+Exeption : INTn (Im Protected Mode vom Prozessor ausgelöst) 

+ 

+Traps   | Funktion 

+--------+------------------------------------------------------------------ 

+INT 00H : Abort Program

+INT 01H : 

+INT 02H : NMI-Routine (Parity-Check & Power-Fail & Redirected from INT 75H) 

+INT 03H : INT3 - Break

+INT 04H : INTO - Overflow

+INT 05H : Print Screen 

+INT 06H : 

+INT 07H : 

+INT 08H : IRQ0 System Interrupt 

+INT 09H : IRQ1 Keyboard Buffer full

+INT 0AH : Software redirected from IRQ9 

+INT 0BH : IRQ3 Serial Port 2 

+INT 0CH : IRQ4 Serial Port 1 

+INT 0DH : IRQ5 Parallel Port 2 

+INT 0EH : IRQ6 Diskette Interrupt 

+INT 0FH : IRQ7 Parallel Port 1 

+ 

+INT 10H : Video Trap 

+  ah = 00H : set mode (al = mode) 

+             (Videoram: Herkules: B0000 

+                        EGA     : B8000)

+             al | Tx/Gr| Pixel | Zeichen | Monitor | Farbe | Seiten 

+             ---+------+-------+---------+---------+-------+-------- 

+             00 | Text |640x200| 40 x 25 | Mono/Col| 16/64*|   8 

+             01 | Text |640x200| 40 x 25 | Color   | 16/64*|   8 

+             02 | Text |640x200| 80 x 25 | Mono/Col| 16/64*|   8 

+             03 | Text |640x200| 80 x 25 | Color   | 16/64*|   8 

+             04 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             05 | Graf |320x200| 40 x 25 | Mono/Col|   4   |   1 

+             06 | Graf |640x200| 80 x 25 | Mono/Col|   2   |   1 

+             07 | Text |720x348| 80 x 25 | Mono    |   4   |   8 

+             08 | Graf |720x348| 90 x 48 | Mono    |   2   |   1

+       --------- ab hier nicht implementiert, nur EGA ------------------ 

+             VideoRAM-Adresse A0000

+             0D | Graf |320x200| 40 x 25 | Color   |  16   |   8 

+             0E | Graf |640x350| 80 x 25 | Color   |  16   |   4 

+             0F | Graf |640x350| 80 x 25 | Mono    |   4   |   2 

+             10 | Graf |640x350| 80 x 25 | Enhanced| 16/64*|   2 

+                                                           * mit EGA-Monitor 

+  ah = 01H : set cursor type (Eingang: CH, CL Werte 0..31) 

+             CH=Startzeile des Cursorblocks, CL=Endzeile des Cursorblocks 

+  ah = 02H : set cursor pos (BH = Page, DL = Spalte, DH = Zeile)

+  ah = 03H : read cursor 

+             Ausgang: BH=Page, DL=Spalte, DH=Zeile, CL=Starzeile des 

+                      Cursorblocks, CH=Endzeile des Cursorblocks

+  ah = 04H : read lightpen 

+             Ausgang: AH=1 : Register sind gültig, AH=0: Taste nicht gedrückt

+                      DH = Zeile, DL = Spalte des Lightpens

+                      CH=Rasterlinie (1..199), CX=Rasterlinie (1..349) 

+                      BX = Rasterspalte (1..319/1..639) 

+  ah = 05H : set actual display (AL = Neue Seite)

+  ah = 06H : scroll up 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 07H : scroll down 

+             AL = 0: Fenster löschen, sonst Anzahl Zeilen zu scrollen 

+             CH, CL = linke obere Ecke des Scroll-Windows 

+             DH, DL = rechte untere Ecke des Scroll-Windows 

+             BH = Attribut fuer die Leerzeilen 

+  ah = 08H : read current attribute and char

+             Ausgang: BH=Anzeigeseite, AL=Zeichen, AH=Attribut (nur Alpha) 

+  ah = 09H : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen, BL=Attribut/Farbe

+  ah = 0AH : write current attribute and char 

+             BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen 

+  ah = 0BH : set color (BH=Palettenfarbe 0..127, BH=Farbwert) 

+  ah = 0CH : write dot 

+             BH=Seite, DX=Zeile, CX=Spalte, AL=Farbwert (falls Bit 7=1, wird

+             alte Farbe mit neuer Farbe geXORed)

+  ah = 0DH : read dot (BH=Seite, DX=Zeile, CX=Spalte, AL=Punktfarbwert)

+  ah = 0EH : write tty (Zeichen schreiben, AL=Zeichen, BL=Farbe) 

+  ah = 0FH : video state (Ausgang: AL=Video-Mode (0..8), AH=Anzahl

+                                   Zeichenspalten, BH=Seite)

+  ah = 10H : reserved (EGA-Bios: Write Palette/Overscan/Intensity/Flash) 

+  ax = 1142H: draw line (EGA-Bios: 12 Routinen für den Charactergenerator) 

+             CX=X-pos-from, DX= Y-pos-from, BP=X-pos-to, DI=Y-pos-to

+  ah = 12H : reserved (EGA-Bios: Alternate Characterset) 

+  ah = 13H : write string

+             Allgemein: 

+               ES:BP = Stringanfang 

+               CX = Stringlänge

+               DL, DH = Cursorposition (Stringanfang) 

+               BH = Seite 

+       al = 0: BL=Attribut, String: CHAR, CHAR, CHAR,...,Cursor wird nicht 

+               bewegt.

+       al = 1: BL=Attribut, String: CHAR, CHAR, CHAR,..., Cursor wird bewegt.

+       al = 2: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird nicht bewegt. 

+       al = 3: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird bewegt. 

+ 

+INT 11H : Equipment Trap (Ausgang: AX = Equipment Flag) 

+          AX : 

+             Bit 1 : 80287 installiert

+             Bit 3 : Herkules installiert

+             Bit 4/5   : 0 = No Primary Display set 

+                         1 = Monochrome 

+                         2 = Color 80 * 25 

+                         3 = EGA

+             Bit 6     : Drive B installiert

+             Bit 9..12 : Anzahl RS232

+             Bit 14/15 : Anzahl Printer

+ 

+INT 12H : Memory Size Trap (Ausgang: AX = Memorysize in KB) 

+ 

+INT 13H : Hardisk Trap 

+          Allgemein: 

+          DL = Drive (0, 1...) 

+          AL = Sector count 

+          CX = Bit 0... Bit 5 = Sector 

+               Bit 6... Bit 15 = Cylinder 

+          Exit: AH = 0 ok, <> 0 Fehler (z.b. in hf_error nachsehen) 

+  ah = 0 reset diskette, wd1010, hdisks 

+  ah = 1 return status 

+  ah = 2 read 

+  ah = 3 write 

+  ah = 4 verify 

+  ah = 5 format 

+  ah = 8 drive params 

+  ah = 9 init drive 

+  ah = A read long 

+  ah = B write long 

+  ah = C seek 

+  ah = D reset wd1010 (DL = Drive) 

+  ah =10 ready test

+  ah =11 reclibrate 

+  ah =14 check controller  

+  ah =15 read dasd (stacktop 2 words: anzahl sektoren der platte) 

+ 

+INT 14H : RS232C Trap 

+  Allgemein: dx = port (>= 1FE0H : SCC = 8530) 

+  ah = 0 : Init

+           al : Bit 5..7 = Baudrate 

+                    000 = 110,

+                    001 = 150, 

+                    010 = 300, 

+                    011 = 600, 

+                    100 = 1200, 

+                    101 = 2400, 

+                    110 = 4800, 

+                    111 = 9600, 

+                Bit 3..4 = Parity    (no, odd, even) 

+                Bit 2    = Stopbits  (1, 2)

+                Bit 0..1 = Datenbits (5, 6, 7, 8)

+  ah = 1 : Send (al = Zeichen, Ausgang: ah=80H Timeout, Zeichen dann in al) 

+  ah = 2 : Read (Ausgang: ah=80H:Timeout, sonst ah=Statusregister,al=Zeichen)

+  ah = 3 : Status (Ausgang: Nur 8250: al = Modemstatus) 

+           ah : Bit 0 = 1 : Data available 

+                Bit 1 = 1 : Receiver overrun 

+                Bit 2 = 1 : Parity Error 

+                Bit 3 = 1 : Framing Error 

+                Bit 4 = 1 : Transmitter empty 

+                Bit 5 = 1 : Break received 

+ 

+INT 15H : Utility Trap 

+  ah = 80H open device (nicht implementiert) 

+  ah = 81H close device (nicht implementiert)

+  ah = 82H prog term (nicht implementiert)

+  ah = 83H event wait (Eingang: CX=RTCtmr high, DX=RTCtmr high, ES:BX=userflag) 

+           Ausgang: CY=0, Event wait wurde aktiviert 

+                    CY=1, Noch kein RTC-Event aufgetreten 

+                          (INT 15H periodisch aufrufen zum pollen)

+  ah = 84H joy stick (Eingang: DX)

+       DX = 0: Ausgang: AL (Bits 4..7) = Buttons 

+       DX = 1: Ausgang: AX=Xa, BX=Ya, CX=Xb, DX=Yb

+  ah = 85H sys request (nicht implementiert) 

+  ah = 86H wait a moment (CX=RTCtimer high, DX=RTCtimer low) 

+  ah = 87H block move (extended memory) (Eingang: CX: Words, ES:SI = Block

+           Descriptoren: 8 Bytes Source, 8 Bytes Destination)

+  ah = 88H extended memory (Ausgang: AX= KB extended Memory) 

+  ah = 89H enter protected mode

+  ax = 8A42H run setup 

+  ax = 8B42H error beep

+  ax = 8C42H usr-powerfail-shutdown-routine

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS abgelegt werden) 

+  ax = 8D42H usr-powerfail-resume-routine 

+             (Benutzerdaten können von ES:0 bis ES:BACK_SYS geholt werden) 

+  ax = 8E42H set timer (Eingang: BL = Timer (0, 1, 2), CX = Countervalue 

+                                 BH: Bit 0 = BCD, Bit 1..3 = Mode, 

+                                     Bit 4..5 Write CMD, Bit 6/7 unused) 

+                       (Timer wird bei Resume wieder so initialisert)

+  ax = 8F42H hardcopy (Grafik & Mono)

+  ah = 90H device busy (nicht implementiert)

+  ah = 91H set int complete (nicht implementiert)

+  ah = 9242H backup memory (CX=Anzahl Bytes, DS:SI = Sourceadr, E000H:DI 

+                              = Destinationadr.)

+  ah = 9342H restore memory (CX=Anzahl Bytes, E000H:SI = Sourceadr, ES:DI = 

+                                Destinationadr.)

+INT 16H : Keyboard Trap 

+  ah = 00 Ascii read (Ausgnag: AX=Zeichen CY=1, sonst CY=0)

+  ah = 01 Ascii status (Ausgang: ZF = 0 : Zeichen in Queue)

+  ah = 02 Shift status (Ausgang: AL = KB_flag) 

+  ax = 0342 set typematic (Ausgang: BL = Rate, BH = Delay) 

+  ax = 0442 soft power down 

+ 

+INT 17H : Printer Trap

+  Allgemein: dx = port 

+  ah = 0 : print char (Eingang: al = Char, Ausgang: ah = Printer Status) 

+  ah = 1 : init printer port 

+  ah = 2 : ah = Status 

+ 

+INT 18H : Basic (nicht implementiert) 

+ 

+INT 19H : Bootstrap Trap 

+  Block 0 von Harddisk oder Floppy --> ES:BX laden und starten (Booting...) 

+  Der Block hat in Bytes 510/511 das Kennzeichen AA55H. 

+ 

+INT 1AH : Time of day Trap

+  ah = 0 : Read Timer (Ausgang: CX=Timer low, DX=Timer high, AL<>0:Overflow)

+  ah = 1 : Set Timer (CS=Timer low, DX=Timer high)  

+  ah = 2 : Read Clock (Ausgang: DH = Sec, CL = Min, CH = Std) 

+  ah = 3 : Set Clock  (DL=Sommerzeit (01), DH=sec, CL=Min, CH=Std)

+  ah = 4 : Read Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 5 : Set Date (DL=Day, DH=Month, CL=Year, CH=Century) 

+  ah = 6 : Set Alarm (DH=Sec, CL=Min, CH=Std)

+  ah = 7 : Reset Alarm 

+ 

+INT 1BH : Dummy Return 

+ 

+INT 1CH : User Timer Tic, wird einmal pro Sekunde aufgerufen.

+ 

+INT 1DH : Zeigt auf die Video Parameter

+INT 1EH : Zeigt auf Disk_base (DF, 02, 25, 02, 0F, 1B, FF, 54, F6, 0F, 08) 

+INT 1FH : Pointer auf Zeichensatz mit Zeichen 128..255

+

+INT 20H ... INT 3FH sind für das Betriebssystem reserviert.

+ 

+INT 20H : DOS: Terminate Program

+INT 21H : DOS: Function Call

+INT 22H : DOS:

+INT 23H : DOS:

+INT 24H : DOS: 

+INT 25H : DOS: 

+ 

+INT 40H : Diskette Trap 

+  AH = 0 disk reset 

+  AH = 1 disk status (ret) 

+  AH = 2 disk read (ES:BP = Pointer auf Buffer, DI = Anzahl Sektoren,

+                    DH = Head, DL = Drive, CL = Sektor, CH = Cylinder)

+  AH = 3 disk write           "

+  AH = 4 disk verify          "

+  AH = 5 disk format          "

+  AH = 21 disk type  (Ausgang: BL (Bit 0..3) 0=360K, 1/2 = 1.2MB) 

+  AH = 22 disk change 

+  AH = 23 format set 

+ 

+INT 41H : Hardfile Table Vector 

+INT 44H : Pointer auf weiteren Zeichensatz (Nur von EGA-Bios unterstützt)

+INT 46H : Hardfile 1 Table Vector 

+ 

+INT 4AH : Für User software redirected from RTC-IRQ (Alarm, periodic) 

+ 

+INT 60H 

+  ...     User 

+INT 6FH

+ 

+Hardware-Interrupts 8..15:

+INT 70H : IRQ 8 RTC-Interrupt

+INT 71H : IRQ 9 Software Redirected to INT 0AH 

+INT 72H : IRQ10 Frei

+INT 73H : IRQ11 Frei 

+INT 74H : IRQ12 Frei 

+INT 75H : IRQ13 Coprozessor, Software Redirected to NMI (INT 02H) 

+INT 76H : IRQ14 Harddisk Interrupt

+INT 77H : IRQ15 Frei

+ 

+INT 78H : User 0

+INT 79H : User 1

+INT 7AH : User 2

+INT 7BH : User 3

+INT 7CH : User 4

+INT 7DH : User 5 

+INT 7EH : User 6

+INT 7FH : User 7 

+ 

+ 

+Exception | Bezeichnung                         | E-Code | Restart| Instr.

+----------+-------------------------------------+--------+--------+----------

+    0     | Divide Error                        |   -    | Ja     | DIV, IDIV

+    1     | Single Step                         |   -    | Ja     | Alle

+    2     | NMI                                 |   -    | Ja     | Alle

+    3     | Breakpoint                          |   -    | Ja     | INT3

+    4     | INTO Overflow                       |   -    | Ja     | INTO

+    5     | BOUND Range                         |   -    | Ja     | BOUND

+    6     | Invalid Opcode                      |   -    | Ja     | undef.Opc.

+    7     | Processor Extension Not Available   |   -    | Ja     | ESC, WAIT

+    8     | Double Exception / IDTL too small   |   0    | Nein   | LIDT

+    9     | Processor Extension Segment Overrun |   -    | Nein   | ESC

+   10     | Invalid Task State Segment          |  Ja    | Ja     | TaskSwitch

+   11     | Segment Not Present                 |  Ja    | Ja     | Alle Mem.

+   12     | Stack Segment Overrun or Not Present|  Ja    | Ja     | Stackopc.

+   13     | General Protection                  |  Ja    | Ja     | Alle Mem.

+   14     | -                                   |   -    |   -    | -

+   15     | -                                   |   -    |   -    | -

+   16     | Processor Extension Interrupt       |   -    |   -    | ESC, WAIT

+

diff --git a/system/shard-x86-at/7/doc/CONTROLS.ELA b/system/shard-x86-at/7/doc/CONTROLS.ELA
new file mode 100644
index 0000000..1ea4978
--- /dev/null
+++ b/system/shard-x86-at/7/doc/CONTROLS.ELA
@@ -0,0 +1,76 @@
+SHard-Spezifische 'control'-Funktionen (V2.7, AT-SHard)

+

+Kanal 32: 

+  control (-3, x, mcr*256+kanal, r) : Modem-Control-Register setzen

+                          mcr: Bit 0: DTR 

+                               Bit 1: RTS 

+                               Bit 2: OUT1 

+                               Bit 3: OUT2 (Interrupt enable) muss 1 sein

+                               Bit 4: Diagnostic-Mode (muss 0 sein) 

+                               Bit 5: -

+                               Bit 6: -

+                               Bit 7: -

+  control (-5, x, x, r)     : Anforderung nach 'shutup' Systemreset. 

+  blockin (clock, -4, x, r) : HW-Clock auslesen 

+           clock (1) = jahrhundert

+           clock (2) = jahr 

+           clock (3) = monat 

+           clock (4) = tag 

+           clock (5) = stunden 

+           clock (6) = minuten 

+           clock (7) = sekunden 

+

+Kanal 2..13 (sofern vorhanden) : 

+  control (-3, x, x, r) : 8250 Linestatusregister/Modemstatusregister lesen 

+          Bit  1: 1 = Receiver overrun detected 

+               2: 1 = Parity Error detected 

+               3: 1 = Framing Error detected 

+               4: 1 = Break Interrupt Detected 

+          Bit 8..15 nicht im Standard-SHard 

+         (Bit  8: 1 = CTS changed

+               9: 1 = DSR changed 

+              10: 1 = RI changed to inactive 

+              11: 1 = DCD changed 

+              12: CTS input 

+              13: DSR input 

+              14: RI input 

+              15: DCD input)

+  control (-4, x, x, r) ; r = Anzahl Eingabezeichen, seit letzter Abfrage 

+  control (-5, x, x, r) ; r = Anzahl Ausgabezeichen, seit letzter Abfrage 

+  control (-6, x, x, r) ; Break senden 

+  control (-10, x, x, r) ; DTR+RTS inactive setzen (stop!) 

+  control (-11, x, x, r) ; DTR+RTS active setzen (weiter)

+ 

+Kanal 14..16 (falls vorhanden): 

+  control (-3, x, x, r) ; Printeroutput nicht mehr ueber SHard sondern BIOS 

+  control (-4, 256 * retry + wartezeit, x, r) ; 

+                          Setzt fuer langsame Drucker retrys und Wartezeit 

+                          zwischen den Zeichen.

+ 

+Kanal 1 : 

+  control (-3, attribut, x, r) ; Textattribut fuer Bildschirmausgaben setzen 

+  control (-4, x, palette, r) ; Colorpalette fuer Farbkarte setzen. 

+  control (-5, 256 * karte + mode, x, r) ; Videomodus einschalten 

+                     karte: 1 = tecmar(mode=0..5), 2 = hercules (mode=0)

+                     karte: 0 = Bios (mode=0, 7, 8=graphik)

+  control (-6, xpos, ypos, r) ; Draw line to (xpos, ypos) 

+  control (-7, xpos, ypos, r) ; Move to (xpos, ypos)

+  control (-8, maske, linetype, r) ; Set pen 

+  control (-9, p1, p2, r) ; Set color pen 1 

+  control (-10, p1, p2, r) ; Set color pen 2 

+  control (-11, new mask count, mode, old mask count) ; Set Mask Mode 

+                             mode = 0 : Kein Mask mode 

+                             mode = 1 : Mask Mode einschalten. 

+Kanal 28, 29 (Harddisk): 

+  control (-10, x, x, r) : r = Anzahl Cylinder-1 (Gesamte Platte) 

+  control (-11, x, x, r) : r = Anzahl Sektoren

+  control (-12, x, x, r) : r = Anzahl Heads

+ 

+Kanal 30, 31 (Floppy) :

+  - 

+ 

+

+

+

+

+

diff --git a/system/shard-x86-at/7/doc/PORTS.PRT b/system/shard-x86-at/7/doc/PORTS.PRT
new file mode 100644
index 0000000..f11e760
--- /dev/null
+++ b/system/shard-x86-at/7/doc/PORTS.PRT
@@ -0,0 +1,658 @@
+#type ("17.klein")# 

+System-Ports: 

+ 

+Port | Funktion

+-----+-------------------------------------------------------------------- 

+     | DMA Controller 1 (8237A-5) für Bytetransfers (Kanal 0..3) 

+ 00  | Byteadresse (start/current) Kanal 0 (frei für Memory-Memory Transfer)

+ 01  | Bytecount Kanal 0            (Pageregister 87H) (Sourcechannel)

+ 02  | Byteadresse (start/current) Kanal 1 (reserviert für SDLC) 

+ 03  | Bytecount Kanal 1            (Pageregister 83H) (Destinationchannel)

+ 04  | Byteadresse (start/current) Kanal 2 (Diskette) 

+ 05  | Bytecount Kanal 2            (Pageregister 81H) 

+ 06  | Byteadresse (start/current) Kanal 3 (XT: Harddisk) 

+ 07  | Bytecount Kanal 3            (Pageregister 82H) 

+ 08  | Read: DMA-Status (D4..D7:1 = DREQ liegt an, D0..D3:0 = Kanal Busy) 

+     | Write: DMA-Command: 

+     |  D0 1 = memory<-->memory transfer enabled 

+     |  D1 Falls D0 = 1: 1 = Kanal 0 Adresse INCR/DECR, 0 = Adr. unverändert

+     |  D2 1 = DMA-Control enabled

+     |  D3 1 = R/W-Signal verkürzt 

+     |  D4 0 = Feste Kanalprios, 1 = Kanalprios rotieren 

+     |  D5 Falls D3 = 0, 1 = verzögertes R/W-Signal, 0 = verlängertes R/W 

+     |  D6 1 = DREQ active-low, 0 = DREQ active-high 

+     |  D7 1 = DACK active-high, 1 = DACK active-low 

+  09 | Read/Write: Anforderungsregister 

+     |  D1, D0 = Nummer des aktiven DMA-Kanals 

+     |  D2 1 = DMA-Transfer anstossen, (D0/D1 = Kanalnummer) 

+     |     0 = DMA-Transfer wurde per Hardware angestossen 

+  0A | Read/Write : Single Mask Register Bit 

+     | D0..D3 für jeden Kanal: 1 =  DREQ gesperrt, 0 = DREQ freigegeben 

+  0B | Write: Mode-Register

+     | D1, D0 bestimmen den Kanal auf den sich D2..D7 beziehen (0..3) 

+     | D3, D2 (falls D6=D7=1 (Kaskade) ohne Bedeutung) 

+     |  0   0 Prüfzyklen 

+     |  0   1 Write in Memory 

+     |  1   0 Read aus Memory 

+     |  1   1 Illegal 

+     | D4 1 = Autorepeat 

+     | D5 1 = DECR Adressen, 0 = INCR Adressen 

+     | D7, D6 

+     |  0   0 Polling

+     |  0   1 Cycle Steal 

+     |  1   0 Burst Mode 

+     |  1   1 Kaskadierter Controller

+  0C | Clear Byte Pointer Flip-Flop 

+  0D | Read: Temporary-Register, Write: Master Clear 

+  0E | Clear Mask Register 

+  0F | Write: All Mask Register 

+     | 

+     | Interrupt-Controller 1 (Master) 8259, siehe Datenblatt 

+  20 | Write: ICW1, OCW2, OCW3, Read: ISR, IRQ-Level (Je nach Zustand) 

+  21 | Write: ICW2, ICW3, ICW4, OCW1, Read: IMR (Je Nach Zustand)

+     | 

+     | Intervall-Timer 8254.2 

+  40 | Channel 0 Timeconstant (System Interrupt IRQ 0) 

+  41 | Channel 1 Timeconstant (Refesh Request) 

+  42 | Channel 2 Timeconstant (Speaker Output) 

+  43 | Control (Channel 0..2) 

+     |

+     | KEYBOARD

+  60 | Keyboard Data Read/Write 

+  61 | System Control Port (In/Out Port) 

+     | Write:

+     |  D0 = Speaker Gate

+     |  D1 = Speaker Data

+     |  D2 = Base Parity Check (<512k), 0 = Parity Check erlaubt

+     |  D3 = Channel Parity Check (>=512k), 0 = Parity Check erlaubt  

+     | Read:

+     |  D4 = 1 = Refresh Detected

+     |  D5 = 1 = Output Timer 2 

+     |  D6 = 1 = IO-RAM Parity Error 

+     |  D7 = 1 = Base-RAM Parity Error 

+  64 | Keyboard Command/Status Port

+     | Write (Command): 

+     | Command C0H liest Input Port, Byte im Datenregister ist dann: 

+     | D4 : 0 = 2nd 256k Board-RAM disabled 

+     | D5 : 0 = Manufacturing Jumper installed 

+     | D6 : 1 = Primary Display is Monochrome, 0 = Color 

+     | D7 : 0 = Keyboard is inhibited

+     | Command D0H liest Output Port, Byte im Datenregister ist dann:

+     | D0 : 0 = System Reset 

+     | D1 : Gate A20 (AND-Verknüpfung mit A20-Adressleitung)

+     | D4 : Output-Buffer full 

+     | D5 : Input-Buffer empty 

+     | D6 : Keyboard clock (output) 

+     | D7 : Keyboard data (output)

+     | D1H schreibt Output Port, sonst wie D0H 

+     | Read (Status): 

+     | D0 : 1 = Outputbuffer is filled (Keyboard --> Computer) 

+     | D1 : 0 = Inputbuffer is empty

+     | D2 : System-Flag

+     | D3 : Last Write: 1 = Command, 0 = Data

+     | D4 : 0 = keyboard is inhibited 

+     | D5 : 1 = Transmit-Timeout Error

+     | D6 : 1 = Receive-Timeout Error

+     | D7 : 1 = Parity Error (Receive)

+     | 

+     | RTC/RAM

+ 70  | CMOS-Adresse, NMI-Mask 

+     | D0..D5 = CMOS-Adresse (0..63) 

+     | D7 : 0 = NMI enabled, 1 = NMI disabled (Power-Fail, Parity-Check, NP)

+     | RTC-Adressen:

+     | 00 : Seconds 

+     | 01 : Alarm Seconds 

+     | 02 : Minutes 

+     | 03 : Alarm Minutes 

+     | 04 : Hours 

+     | 05 : Alarm Hours 

+     | 06 : Day of week (1..7) 

+     | 07 : Date of Month 

+     | 08 : Month 

+     | 09 : Year     (32H = Century) 

+     | 0A : Status Register A : Bit 7 = 1 Update in progress 

+     | 0B : Status Register B : Bit 5 = 1 Alarm Interrupt enabled 

+     |                          Bit 0 = 1 Sommerzeit (Ende Mai..Ende Okt.!) 

+     | 0C : Status register C : Bit 7 = 1 Interrupt occured 

+     | 0D : (Read!) Bit 7 = 1 Power Good 

+     | RAM-Adressen: 

+     | 0E : Diagnostic Status Byte 

+     |  D7 : 1 = RTC lost power 

+     |  D6 : 1 = CMOS Checksum wrong 

+     |  D5 : 1 = Primary Display not set/No Diskette attached 

+     |  D4 : 1 = Memory Size miscompare (Vorhanden <> Setup-angegeben) 

+     |  D3 : 1 = Fixed Disk (Drive C) not ok 

+     |  D2 : 1 = RTC Time/Status nicht gültig 

+     | 0F : Shutdown Status Byte (Restart Code) 

+     |  0 = Power on Reset

+     |  9 = Enter Real Mode: 

+     |      TESTPORT = 32, Stack (SS=0469,SP=0467) RET-Adr., PUSHA, ES, DS 

+     | 10 : Diskette configuration: 

+     |    D4..D7 : 0 = Not installed 

+     |             1 = 48 tpi (double sided)        Drive A

+     |             2 = 96 tpi (high capacity)

+     |    D0..D3 : 0 = Not installed 

+     |             1 = 48 tpi (double sided)        Drive B 

+     |             2 = 96 tpi (high capacity)

+     | 12 : Fixed Disk configuration: 

+     |    D4..D7 : 0 = Not installed 

+     |             1..14 Tabelle                    Drive C 

+     |             15 = Typ 16..47 spezifiziert 

+     |    D0..D3 : 0 = Not installed 

+     |             1..14 Tabelle                    Drive D 

+     |             15 = Typ 16..47 spezifiziert 

+     | 

+     | 

+     | 14 : Equipment Byte (only for Power on Diagnostics) 

+     |    D6/D7 :  0 = 1 Floppy 

+     |             1 = 2 Floppys

+     |    D4/D5 :  0 = No Primary Display 

+     |             1 = Color 40 Zeichen 

+     |             2 = Color 80 Zeichen 

+     |             3 = Monochrome 

+     |    D1    :  1 = Mathe Coprozessor installed 

+     |    D0    :  1 = Disk drives are installed

+     | 

+     | 15/16 : Base Memory Size (in KB) 

+     | 15 = low, 16 = high 

+     | 

+     | 17/18 : Expansion Memory Size (in KB) 

+     | 17 = low, 18 = high 

+     | 

+     | 2E/2D Checksum der Adressen 10..20 

+     | 2E = high, 2F = low

+     | 

+     | 30/31 : Expansion Memory Size (in KB über ersten 1MB) 

+     | 30 = low, 31 = high 

+     |

+     | 32 : Date Century Byte (19) 

+     | 

+     | 33 : Information Flag 

+     | 

+ 71  | CMOS-Daten (Read/Write) 

+     | 

+     | Memory Mapper 74LS612

+ 80  | Test-Port (Read/Write) Fehlerstatus der letzten Testoperation 

+ 81  | Channel 2 DMA-Pageregister

+ 82  | Channel 3 DMA-Pageregister

+ 83  | Channel 1 DMA-Pageregister

+ 84  | frei 

+ 85  | frei 

+ 86  | frei 

+ 87  | Channel 0 DMA-Pageregister

+ 88  | frei 

+ 89  | Channel 6 DMA-Pageregister

+ 8A  | Channel 7 DMA-Pageregister

+ 8B  | Channel 5 DMA-Pageregister

+ 8C  | frei 

+ 8D  | frei 

+ 8E  | frei

+ 8F  | Refresh Register

+     | 

+     | Interrupt-Controller 2 (Slave) 8259, siehe Datenblatt 

+ A0  | Write: ICW1, OCW2, OCW3, Read: ISR, IRQ-Level (Je nach Zustand) 

+ A1  | Write: ICW2, ICW3, ICW4, OCW1, Read: IMR (Je Nach Zustand)

+     | 

+     | DMA Controller 2 (8237A-5) für Wordtransfers (Kanal 5..7) 

+ C0  | Wordadresse (start/current) Kanal 4 (Kaskade für Controller 1)

+ C2  | Wordcount Kanal 4

+ C4  | Wordadresse (start/current) Kanal 5 (frei) 

+ C6  | Wordcount Kanal 5            (Pageregister 8BH)

+ C8  | Wordadresse (start/current) Kanal 6 (frei) 

+ CA  | Wordcount Kanal 6            (Pageregister 89H) 

+ CC  | Wordadresse (start/current) Kanal 7 (frei) 

+ CE  | Wordcount Kanal 7            (Pageregister 8AH) 

+ D0  | Read: DMA-Status (D4..D7:1 = DREQ liegt an, D0..D3:0 = Kanal Busy) 

+     | Write: DMA-Command: 

+     |  D0 1 = memory<-->memory transfer enabled 

+     |  D1 Falls D0 = 1: 1 = Kanal 4 Adresse INCR/DECR, 0 = Adr. unverändert

+     |  D2 1 = DMA-Control enabled

+     |  D3 1 = R/W-Signal verkürzt 

+     |  D4 0 = Feste Kanalprios, 1 = Kanalprios rotieren 

+     |  D5 Falls D3 = 0, 1 = verzögertes R/W-Signal, 0 = verlängertes R/W 

+     |  D6 1 = DREQ active-low, 0 = DREQ active-high 

+     |  D7 1 = DACK active-high, 1 = DACK active-low 

+  D2 | Read/Write: Anforderungsregister 

+     |  D1, D0 = Nummer des aktiven DMA-Kanals 

+     |  D2 1 = DMA-Transfer anstossen, (D0/D1 = Kanalnummer) 

+     |     0 = DMA-Transfer wurde per Hardware angestossen 

+  D4 | Read/Write : Single Mask Register Bit 

+     | D0..D3 für jeden Kanal: 1 =  DREQ gesperrt, 0 = DREQ freigegeben 

+  D6 | Write: Mode-Register

+     | D1, D0 bestimmen den Kanal auf den sich D2..D7 beziehen (4..7) 

+     | D3, D2 (falls D6=D7=1 (Kaskade) ohne Bedeutung) 

+     |  0   0 Prüfzyklen 

+     |  0   1 Write in Memory 

+     |  1   0 Read aus Memory 

+     |  1   1 Illegal 

+     | D4 1 = Autorepeat 

+     | D5 1 = DECR Adressen, 0 = INCR Adressen 

+     | D7, D6 

+     |  0   0 Polling

+     |  0   1 Cycle Steal 

+     |  1   0 Burst Mode 

+     |  1   1 Kaskadierter Controller

+  D8 | Clear Byte Pointer Flip-Flop 

+  DA | Read: Temporary-Register, Write: Master Clear 

+  DC | Clear Mask Register 

+  DE | Write: All Mask Register 

+     | 

+     | Coprozessor 

+  F0 | Clear Coprozessor Busy 

+  F1 | Reset Coprozessor (mit D0..D7 = 0) und in Real Mode bringen) 

+     | 

+  F8 | Coprozessor Ports (vom 80286 vorgegeben) 

+  ...| 

+  FF |

+     | 

+-----+---------------------------------------------------------------------

+     |

+     | Harddisk WD1010 

+01F0 | Read/Write: Daten (am besten per DMA uebertragen)

+01F1 | Write: Taskfile Byte 1 (Write Precomp DIV 4, 6 Bit)

+     | Read : Error Register

+     | D0..D7 <> 1 : Fehler aufgetreten

+01F2 | Write: Taskfile Byte 2 (Sector Count 8 Bit)

+01F3 | Write: Taskfile Byte 3 (Sector Number 6 Bit)

+01F4 | Write: Taskfile Byte 4 (Cylinder low 8 Bit)

+01F5 | Write: Taskfile Byte 5 (Cylinder high 2 Bit D6,D7) 

+01F6 | Write: Taskfile Byte 6 

+     | D0..D3 = Head 

+     | D4 : 0 = Drive C, 1 = Drive D 

+     | D5 : 1 = 512 Bytes/Sektor, 0 = 256 Bytes/Sektor 

+     | D6 : 

+     | D7 : 1 = ECC versuchen

+01F7 | Write: Taskfile Byte 7 (Commandbyte, Retries)

+     | D0 : 1 = No Retries 

+     | D1 : 1 = 4 ECC Bytes uebrtragen

+     | D2 : 

+     | D3 :

+     | CMD: 7654 Funktion

+     |      0000

+     |      0001 Recalibrate

+     |      0010 Read

+     |      0011 Write

+     |      0100 Verify

+     |      0101 Format Taskfile Byte 3: Gap

+     |      0110

+     |      0111 Seek

+     |      1000

+     |      1001 D0 = 1: Set Parameters, D0 = 0 : Diagnostics

+     |      1010

+     |      1011

+     |      1100 

+     |      1101

+     |      1110

+     |      1111

+     | Read : Status Register

+     | D7 : 1 = BUSY 

+     | D6 : 1 = Not ready 

+     | D5 : Write fault 

+     | D4 : Seek not complete 

+     | D3 : 1 = Request Data

+     | D2 : 1 = Data corrected 

+     | D1 : 1 = 

+     | D0 : 1 =

+01F8 | Datenport Read/Write 

+01F9 | Write: Reset 

+     | Read: Statusport 

+01FA | Write: Select 

+01FB | Write: DMA/IRQ Maskenregister 

+     | 

+     | Game Connector

+0200 | 

+0201 | Write: Start Monoflops 

+     | Read: 

+     | D0..D3 : Ausgänge der 4 Monoflops Zeit = (24.2 + 0.011 * R(kOhm))us. 

+     | D4..D7 : Auslösetasten (nicht entprellt) 

+0202 | Nicht verwendet, aber ausdekodiert

+ ... | 

+0207 |

+     | 

+     | Printer 2 (LPT2)

+0278 | Write: Daten (Read latched write data) 

+0279 | Read/Write: 

+     | D3 : -ERROR 

+     | D4 : -SLCT in

+     | D5 : PE 

+     | D6 : -ACK 

+     | D7 : BUSY 

+027A | D0 : -STROBE

+     | D1 : -AUTOFEED 

+     | D2 : INIT 

+     | D3 : -SLCT out

+     | D4 : IRQ Mask 

+027B | N.C. 

+ ... | 

+027F |

+     |

+02F8 | RS232C Adapter (COM2) wie COM1 (03F8..03FF) 

+...  | Generiert IRQ 3

+02FF | 

+     | 

+0300 | Prototype Card 

+ ... | 

+031F | 

+     |

+     | Printer 1 (LPT1, wie 03B8..03BA) 

+0378 | Write: Daten (Read latched write data) 

+0379 | Read/Write: 

+     | D3 : -ERROR 

+     | D4 : -SLCT in

+     | D5 : PE 

+     | D6 : -ACK 

+     | D7 : BUSY 

+037A | D0 : -STROBE

+     | D1 : -AUTOFEED 

+     | D2 : INIT 

+     | D3 : -SLCT out

+     | D4 : IRQ Mask 

+037B | N.C. 

+ ... | 

+037F |

+     |

+     | SDLC, bisync 2 

+     | 0380..0383 = 8255 : Parallel Ports

+0380 | Port A - Read

+     | D0 : 0 = Rufzeichen liegt an (RI)

+     | D1 : 0 = Trägerfrequenzkennung liegt an (DCD)

+     | D2 : TXCLK (Diagnostic)

+     | D3 : 0 = Sendebereitschaft liegt an (CTS)

+     | D4 : RXCLK (Diagnostic)

+     | D5 : 1 = Modemstatusänderung (DSR changed) 

+     | D6 : 1 = Timer 2 Output active

+     | D7 : 1 = Timer 1 Output active

+0381 | Port B - Write 

+     | D0 : 0 = Baudrateselektor ein

+     | D1 : 0 = Auswahlbereitschaft ein 

+     | D2 : 0 = Prüfung einschalten 

+     | D3 : 1 = Reset Modemstatusänderungs Flip-Flop 

+     | D4 : 1 = Reset 8273 

+     | D5 : 1 = Timer 2 durchschalten 

+     | D6 : 1 = Timer 1 durchschalten 

+     | D7 : 1 = IRQ 4 aktivieren 

+0382 | Port C - D0..D3 Write, D4..D6 Read, D7 N.C. 

+     | D0 : 1 = Internen Takt durchschalten 

+     | D1 : 1 = Externen Takt durchschalten 

+     | D2 : 1 = Elektronischer Test 

+     | D3 : 0 = IRQ 3 + 4 durchschalten 

+     | D4 : RX Daten 

+     | D5 : Timer 0 Output 

+     | D6 : 0 = Prüfanzeige aktiv

+0383 | 8255 Modussteuerregister 

+     |

+     | 0384..0387 = 8253: Timer

+0384 | Timer 0 low/high. Ausgang ist Eingang von Timer 2 (Bit 5 in 0382) 

+0385 | Timer 1 low/high. Timeout Counter 

+0386 | Timer 2 low/high. Timeout Counter 

+0387 | 8254 Modusregister 

+     | 

+     | 0388..038C = 8273 SDLC Controller 

+0388 | Read: Statusregister 

+     | Write: Befehlsregister 

+0389 | Read: Ergebnisregister 

+     | Write: Parameterregister

+038A | DMA/Interrupt Register für Empfangen 

+038B | DMA/Interrupt Register für Senden 

+038C | Datenport Read/Write 

+     | 8273 Registerbeschreibung: 

+     | Moderegister (Bit D6..D7 wählt Counter auf den sich D0..D5 beziehen) 

+     | D0 : 0 = Counter 16 Bit Binär 

+     |      1 = Counter  4 Dekad. BCD

+     | D1..D3 : Modus 0..5 (D7 = 1) 

+     | D4..D5 : D54

+     |           00 = Counter stop 

+     |           01 = read/write highbyte 

+     |           10 = read/write lowbyte 

+     |           11 = erst low, dann highbyte read/write 

+     | D6..D7 : Counter auswählen (00=0, 01=1, 10=2, 11=3) 

+     | 

+     | Betriebsarten Register

+     | D0 : 1 = Kennzeichenmodus 

+     | D1 : 1 = Sync für 2. Header

+     | D2 : 1 = Buffer Modus 

+     | D3 : 1 = Vorzeitigen Sendeinterrupt aktivieren 

+     | D4 : 1 = EOP IRQ aktivieren 

+     | D5 : 1 = MDLC Abbruch aktivieren 

+     | 

+     | Serial I/O Moderegister 

+     | D0 = 1 : NRZI Modus 

+     | D1 = 1 : Clock Loopback 

+     | D2 = 1 : Data Loopback 

+     | 

+     | Transmit Moderegister 

+     | D0 = 1 : Datenübertragung unterbrechen 

+     | 

+     | Singlebit Delay Modusregister 

+     | D7 = 1 : Singlebit delay aktivieren 

+     | 

+038D | N.C.

+ ... |

+038F |

+     |

+     |

+03A0 | bisync 1 

+ ... | wie 0380..038F

+03AF |

+     | 

+     | Hercules komp. Mono/Graphik Karte

+     | Mit * gekennzeichnete Bits sind nicht auf allen Karten verfügbar.

+03B4 | Indexport 6845 (Videocontroller) 

+     | Write: Register Nummer 0..17 

+03B5 | Datenport 6845 : Register (Write only, sofern nichts anderes vermerkt)

+     |  0: D0..D7 = Anzahl Zeichen pro Zeile -1 (Horizontalfreq.) 

+     |  1: D0..D7 = Anzahl dargestellte Zeichen pro Zeile 

+     |  2: D0..D7 = Zeichenposition-1 des HSYNC Signals 

+     |  3: D0..D3 = Breite-1 des HSYNC Signals in Zeichen 

+     |  4: D0..D6 = Anzahl Zeichenzeilen (Vertikalfreq. 50/60 Hz) 

+     |  5: D0..D4 = Bilddurchlauf Abgleich in Mikrozeilen 

+     |  6: D0..D6 = Anzahl dargestellte Zeichenzeilen 

+     |  7: D0..D6 = Zeichenzeile, bei der VSYNC Signal beginnt 

+     |  8: D0 = 0 : Kein Zeilensprungverfahren 

+     |        = 1 und D1 = 0 : Zeilensprungverfahren, normale Dichte 

+     |        =1  und D1 = 1 : Zeilensprungverfahren, doppelte Dichte 

+     |  9: D0..D4 = Mikrozeilen/Zeichen-1 

+     | 10: D0..D4 = Startmikrozeile des Cursors 

+     |     D5/D6  = 0 : Cursor normal, blinkend 

+     |              1 : Cursor unsichtbar 

+     |              2 : Cursor blinkt mit 1/16 der Vertikalfrequenz 

+     |              3 : Cursor blinkt mit 1/32 der Vertikalfrequenz 

+     | 11: D0..D4 = Endmikrozeile des Cursors 

+     | 12: D0..D5 = Highbits der Speicherstartadresse 

+     | 13: D0..D7 = Lowbits der Speicherstartadresse 

+     | 14: D0..D5 = Highbits der aktuellen Cursorspeicheradresse (Read/Write)

+     | 15: D0..D7 = Lowbits der aktuellen Cursorspeicheradresse (Read/Write)

+     | 16: D0..D5 = Highbits der Speicherstelle, bei der LPSTB ausgelöst 

+     | 17: D0..D7 = Lowbits der Speicherstelle, bei der LPSTB ausgelöst 

+03B8 | Write: Display Mode Control Port 

+     | D1: 6845 muss nach einer Änderung dieses Bits neu initialisiert werdem

+     |     0 : Text Mode    (Zeichen 9 x 14, 0.5625us/Zeichen)

+     |     1 : Graphik Mode (Zeichen 4 x 16, 1us/Zeichen Horizontal)

+     | D3: 0 : Screen blanked (Bei Init 6845 auf 0 setzen) 

+     |     1 : Screen activated 

+     | D5: 0 : Textblinker (Attributbit 7 = 1) ausgeschaltet 

+     |     1 : Textblinker angeschaltet 

+     |*D6: 0 : 80 Spalten Modus (nur CT6040S)

+     | D7: 0 : Graphikpage 0 (B0000..B7FFF) 

+     |     1 : Graphikpage 1 (B8000..BFFFF) 

+03B9 |*Write: Set Lightpen Flip-Flop (Eingang zum 6845 LPSTB) 

+03BA | Read: Display Status Port 

+     | D0: 1 : HSYNC (Horizontal Retrace) läuft gerade 

+     |*D1: Ausgang des Lightpen Flip-Flop (LPSTB-Eingang 6845) 

+     |*D2: 1 : Lightpen Taster gedrückt (Pin 3 des LP-Steckers) 

+     | D3: Ausgang VIDEO zum Monitor (Dots on/off) 

+     | D7: 1 : VSYNC (Vertical Retrace) läuft gerade 

+03BB |*Write: Reset Lightpen Flip-Flop 

+03BC | Read: Latched Write Data 

+     | Write: Printer Data D0..D7 (pin 2..9)

+03BD | Read: Printer Status Port 

+     | D3:0 : Printer Error (ERROR, pin 15) 

+     | D4:0 : Printer deselected (SLCT, pin 13)

+     | D5:1 : Paper end (PE, pin 12) 

+     | D6:1 : Ready for more (ACK, pin 10) 

+     | D7:0 : Printer is busy (BUSY, pin 11) 

+03BE | Read (Latched Write Data) 

+     | Write: Printer Control Port 

+     | D0: Printer Strobe (0 = Strobe to Printer, 1 = Release Strobe) pin 1

+     | D1: 0 = Autolinefeed after CR, 1 = CR, LF (Programm) pin 14

+     | D2: 0 = Init Printer (pin 16), 1 = Release Init 

+     | D3: 0 = Deselect Printer (SLCT, pin 17), 1 = Select Printer 

+     | D4: 0 = Mask IRQ7 off, 1 = IRQ7 (ACK Flanke) mask on 

+03BF |*Read LPSTB extension Adress (Im Graphikmodus) 

+     |*D0..D3 = xpos Dots MOD 16

+     |*D4: Dotclk 74112 (U58) 

+     |*D5..D6 = ypos Dots MOD 4 

+     |*D7: Aktive Graphikseite 

+     | Write: Configuration Switch 

+     | D0: Bit 1 03B8 AND-Mask (0: Kein Graphikmode einschaltbar) 

+     | D1: Bit 7 03B8 AND-Mask (0: Keine Graphikseite 1 einschaltbar) 

+     |     (falls 0: B8000..BFFFF auf Graphikkarte abgeschaltet)

+     | 

+     | 

+     | CGA (Color Graphics Adapter) 

+03D4 | 6845 Index Register (siehe 03B4)

+03D5 | 6845 Data Register (siehe 03B5)

+03D8 | 

+     | D0 : 1 = 80x25 

+     |      0 = 40x25 

+     | D1 : 1 = 320x200 Graphikmodus 

+     |      0 = Alphanumerisch Text 

+     | D2 : 1 = S/W 

+     |      0 = Color 

+     | D3 : 0 = Screen blanked

+     | D4 : 1 = 640x200 S/W Modus 

+     | D5 : 1 = Blinken statt Intensitätsbit (Bit 3) 

+     |      0 = Intensitätsbit für 16 statt 8 Farben (2 Helligkeiten)

+03D9 | Write: Paletteregister 

+     | D0 : Blau 

+     | D1 : Grün 

+     | D2 : Rot 

+     | D3 : Intensity 

+     | D4 : 1 = Intensivfarbsatz im Graphikmodus 

+     | D5 : 1 = Farbsatz 320x200 Modus aktivieren

+03DA | Read: Statusregister 

+     | D0 = HSYNC (Anzeige aktiviert) 

+     | D1 = Lightpen Strobe Flip-Flop Ausgang 

+     | D2 = Lightpentaster gedrückt 

+     | D3 = VSYNC 

+03DB | Write: Reset Lightpen Flip-Flop 

+03DC | Write: Set Lightpen Flip-Flop

+     | 

+     | 

+     | Diskettencontroller uPD 765 

+03F2 | DIGOR (Digital Output Register) - Write

+     | D0..D1 : Laufwerk 00 = A, 01 = B, 10 = C, 11 = D 

+     | D2 : 0 = RESET Signal aktiviert, 1 = RESET aus

+     | D3 : 1 = DMA und IRQ aktivieren 

+     | D4..D7 : 1 = Motor für Laufwerk A..D einschalten 

+03F4 | Hauptstatusregister - Read

+     | D0..D3 : Laufwerk A..D seeked noch 

+     | D4 : 1 = BUSY 

+     | D5 : 1 = DMA nicht aktiv 

+     | D6 : 1 = Prozessor liest Datenregister, 0 = Prozessor schreibt Datenr. 

+     | D7 : 1 = Register bereit für Datentransfer

+03F5 | Diskettensteuerungsdatenregister - Write 

+     | D0..D7 : Command 

+     |     C5 = write (hd+drv.b,cyl.b,frst_sec.b,byte_p_sec.b,last_sec.b, 

+     |                 gap.b, dtl.b)

+     |     E6 = read (hd+drv.b,cyl.b,frst_sec.b,byte_p_sec.b,last_sec.b, 

+     |                gap.b, dtl.b)

+     |     4D = format (byte_p_sec.b, last_sec.b, gap.b, dtl.b)

+     |          hd+drv.b : D5..D2 = Head, D1..D0 = Drive

+     |     Nach jedem Kommando kann solange BUSY=1 ist, ein Statusbyte bei 

+     |     03F5 abgeholt werden (warten bis D6=1 und D7=1 in 03F4). 

+     |     Status: 

+     |     D7 = rnf, timeout

+     |     D6

+     |     D5 = crc error

+     |     D4 = dma error

+     |     D3

+     |     D2 = rnf 

+     |     D1 = write protected 

+     |     D0 = bad addr mark

+     |

+03F6 | Harddisk Control Register

+     | D7 : 1 = Disable Retries 

+     | D6 : 1 = Kein ECC bei Fehler 

+     | D5 :

+     | D4 :

+     | D3 : 1 = Falls anz. Heads > 8 

+     | D2 : 1 = RESET KONGO CARD (wieder auf 0 setzen) 

+     | D1 : 

+     | D0 :

+     | 

+03F7 | DIGIR (Digital Input Register) - Read 

+     | D7 : 1 = Media changed

+     | 

+     | 

+     | RS232C Adapter 8250 (COM1) Generiert IRQ 4

+03F8 | DLAB = 0

+     |       Read: Receivebuffer (RBR = receive buffer register)

+     |      Write: Transmitbuffer (THR = transmit holding register)

+     | DLAB = 1 : Read/Write: Divisor Latch LSB   Read/Write

+03F9 | DLAB = 1 : Read/Write: Divisor Latch MSB   Read/Write

+     |            Baud = 115200/divisor (clk = 1.8432 MHz DIV 16) 

+     | DLAB = 0 : Interrupt Enable Register (IER) Read/Write 

+     |     Bit = 1: Interrupt enabled, Bit=0: Interrupt disabled  

+     | D0: Receive Char Interrupt 

+     | D1: Transmitter empty Interrupt 

+     | D2: Receiver Line Status Interrupt (Framing, Parity, Overrun, Break)

+     | D3: Modem Status Interrupt (CTS, DSR, RI, DCD changed)

+     | D4..D7 = 0

+03FA | Interrupt Identification Register (IIR) Read/Write

+     | Prios: 1=Receiver Line Status, RX available, THR empty, 4=Modem Status 

+     | D0 = 0: Interrupt pending 

+     | D1..D2: Interrupt source (falls D0 = 0) 

+     |   Prio D21 Source                            Cleared by

+     |      1  01 Overrun, Parity, Framing, Break   Read LSR 

+     |      2  10 Receive data available            Read RBR 

+     |      3  11 THR empty                         Read IIR oder Write THR 

+     |      4  00 CTS, DSR, RI, RLSD changed        Read MSR 

+03FB | Line Control Register (LCR) Read/Write

+     | D0..D1 : Wordlength (00=5, 01=6, 10=7, 11=8 Datenbits) 

+     | D2 : 0 = 1 Stopbit 

+     |      1 = 1.5 Stopbits, falls 5 Datenbits, 2 Stopbits sonst 

+     | D3 : 1 = Parity generate & check enabled 

+     | D4 : Falls D3 = 1 : 0 = Odd Parity, 1 = Even Parity 

+     | D5 : Falls D3 = 1 und D5 = 1: 0 = Parity Mark, 1 = Parity Space

+     |     D543 Funktion

+     |      000 Kein Parity

+     |      001 Odd Parity

+     |      010 Kein Parity 

+     |      011 Even Parity

+     |      100 Kein Parity

+     |      101 Parity stuck on (1 = Mark) 

+     |      110 Kein Parity

+     |      111 Parity stuck off (0 = Space) 

+     | D6 : 1 = Send Break (Muss wieder auf 0 gesetzt werden)

+     | D7 : DLAB = 1 : Baudrate Divisor Latch Access ueber 0XF8/0XF9 

+03FC | Modem Control Register (MCR) 

+     | D0: 1 = DTR aktiv

+     | D1: 1 = RTS aktiv 

+     | D2: 1 = OUT1 aktiv (Pin 34) 

+     | D3: 1 = OUT2 aktiv (Pin 31)

+     | D4: 1 = Diagnostic Mode: 

+     |         TX-Out --> RX-In (Local Loopback) 

+     |         RTS->CTS, DTR->DSR, OUT1->DCD, OUT2->RI internally connected 

+     |         Interupts lassen sich mit D0..D3 des MCR, bzw. D0..D5 des LSR 

+     |         auslösen (dann Bits wieder auf 0 und MCR auf 0). 

+03FD | Line Status Register (LSR) Read/Write 

+     | D0: 1 = Character Received                 Interrupt 2

+     | D1: 1 = Receiver Overrun Error             Interrupt 1

+     | D2: 1 = Parity Error                       Interrupt 1

+     | D3: 1 = Framing Error                      Interrupt 1

+     | D4: 1 = Break detected                     Interrupt 1

+     | D5: 1 = Transmitter Holding register empty Interrupt 3

+     | D6: 1 = Transmitter complete cleared (THR & TSR empty) 

+     | D7: 0 

+03FE | Modem Status Register (MSR) Read/Write 

+     | D0: 1 = CTS changed since last MSR read    Interrupt 4

+     | D1: 1 = DSR changed since last MSR read    Interrupt 4

+     | D2: 1 = RI changed from active to inactive Interrupt 4

+     | D3: 1 = DCD changed since last MSR read    Interrupt 4

+     | D4: CTS input (Diagnostic: RTS) 

+     | D5: DSR input (Diagnostic: DTR) 

+     | D6: RI  input (Diagnostic: OUT1) 

+     | D7: DCD input (Diagnostic: OUT2)

+03FF | Reserviert 

+     | 

diff --git a/system/shard-x86-at/7/src/ATSHARD.ASM b/system/shard-x86-at/7/src/ATSHARD.ASM
new file mode 100644
index 0000000..fcc5c50
--- /dev/null
+++ b/system/shard-x86-at/7/src/ATSHARD.ASM
@@ -0,0 +1,157 @@
+  page 80,132

+title AT-SHard, Copyright (C) 1985, 86 Martin Schoenbeck, Spenge  

+;******************************************************************************

+;*                                                                            *

+;*       S H A R D   -   M O D U L                                            *

+;*                                                                            *

+;*       fuer EUMEL auf 80286 Systemen                                        *

+;*                                                                            *

+;*       SHard Version 7-PC/AT                                                *

+;*                                                                            *

+;*       Copyright (C) 1985, 86 Martin Schoenbeck, Spenge                     *

+;*                                                                            *

+;******************************************************************************

+

+at equ 1

+gensys equ 0

+ramsys equ 0

+pcxt equ 0

+pcd equ 0

+kompatible equ 0

+romharddisk equ 0

+romfloppy equ 0

+limited_to_360 equ 0

+boot_size equ 0

+

+hdsystem equ 1

+withhd equ 1

+

+setup_channel equ 28

+dos_channel equ 29

+

+shard group code

+code segment word public 'code'

+ assume cs:shard, ds:shard, es:nothing, ss:nothing

+

+shstart:

+     jmp los_gehts

+

+     even

+

+     include MACROS.ASM

+     include MAC286.ASM

+     include DEVICE.ASM

+     include EUCONECT.ASM

+     org 0a0h			;bei wort 80 beginnen

+     include PATCHARE.ASM

+

+     include SHMAIN.ASM

+

+IBMat equ 0fch

+com1base equ 03f8h

+com1irq  equ 4

+com2base equ 02f8h

+com2irq  equ 3

+com3base equ 03e8h

+com3irq  equ 3

+com4base equ 82f8h

+com4irq  equ 7

+com4_1base equ 02c0h

+com4_1irq  equ 3

+com4_2base equ 02c8h

+com4_2irq  equ 3

+com4_3base equ 02d0h

+com4_3irq  equ 3

+com4_4base equ 02d8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 02e8h

+com8_2irq  equ 3

+com8_3base equ 02f0h

+com8_3irq  equ 3

+com8_4base equ 02f8h

+com8_4irq  equ 3

+para1base equ 3bch

+para1irq equ 7

+

+int_ctlr equ 20h

+first_ictlr_int equ 8

+

+channel macro number,dev,ccb

+channels = channels+1

+selectentry = 5

+     db number

+     dw offset ccb

+     if2

+     dwb paramstart_,%&dev

+     else

+     dw 0                ;;weil in pass eins device evtl. unbekannt

+     endif 

+     endm

+

+selecttable:

+     db channels       ;anzahl kanaele hier setzen

+channels = -1         ;nilchannel vorab abziehen

+     channel 32,shardchannel,0

+     channel 0,fixdisk,hgccb0

+alterable_channels:

+     channel 1,pc,0 

+     channel 2,i8250,com1ccb

+     channel 3,i8250,com2ccb

+     channel 4,i8250,com4_1ccb

+     channel 5,i8250,com4_2ccb

+     channel 6,i8250,com4_3ccb

+     channel 7,i8250,com4_4ccb

+     channel 8,i8250,com8_1ccb

+     channel 9,i8250,com8_2ccb

+     channel 10,i8250,com8_3ccb

+     channel 12,parallel,para1ccb

+     channel 28,fixdisk,hgccb1

+     channel 29,fixdisk,hgccb2

+     channel 31,archive,archive_0

+     channel 30,archive,archive_1

+     channel -1,nilchannel,0

+ 

+     include I8250.ASM

+     include PCPAR.ASM

+     include STREAM.ASM

+     include NILCHAN.ASM

+     include PCSCREEN.ASM

+     include PCPLOT.ASM

+     include PCSYS.ASM

+     include FIXDISK.ASM

+     include FLOPPY.ASM

+     include CLOCK.ASM

+     include WAIT.ASM

+     include HARDWARE.ASM

+     include BLOCKERR.ASM

+ 

+     i8250_ccb com1,2

+     i8250_ccb com2,3

+     i8250_ccb com4_1,4

+     i8250_ccb com4_2,5

+     i8250_ccb com4_3,6

+     i8250_ccb com4_4,7

+     i8250_ccb com8_1,8

+     i8250_ccb com8_2,9

+     i8250_ccb com8_3,10

+     para_ccb para1,12

+ ;erlaubt drivetypen: highdensity, drive720

+     archive_ccb 0,highdensity

+     archive_ccb 1,0

+     fix_ccb 0

+     fix_ccb 1

+     fix_ccb 2

+

+sysmove:

+     rep movsw

+     jmp systemstart

+

+     include BOOT.ASM

+

+code ends

+

+     end los_gehts

+

+

diff --git a/system/shard-x86-at/7/src/BLOCKERR.ASM b/system/shard-x86-at/7/src/BLOCKERR.ASM
new file mode 100644
index 0000000..fb5b137
--- /dev/null
+++ b/system/shard-x86-at/7/src/BLOCKERR.ASM
@@ -0,0 +1,81 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Dieses Modul enthaelt Routinen zur Uebergabe von Fehlermeldungen       *

+;*   nach Blockin/Blockout                                                  *

+;*                                                                          *

+;*   blockerr erwartet dabei folgende codes in ah:                          *

+sense_fail      equ     0ffh            ; sense operation

+blnrhigh        equ     0feh            ; block number to high

+write_fault     equ     0cch            ; 

+not_rdy         equ     0aah            ; drive not ready

+undef_err       equ     0bbf            ; undefined error occurred

+time_out        equ     80h             ; attachment failed to respond

+bad_seek        equ     40h             ; seek operation failed

+bad_cntlr       equ     20h             ; controller has failed

+data_corrected  equ     11h             ; ecc corrected data error

+bad_ecc         equ     10h             ; bad ecc on disk read

+bad_crc         equ     10h             ; crc error on sector

+bad_track       equ     0bh             ; bad track flag detected

+bad_sect        equ     0ah             ; sector marked bad

+dma_boundary    equ     9               ; attempt to dma across 64k

+bad_dma         equ     8               ; dma failed

+init_fail       equ     7               ; drive parameter activity failed

+bad_reset       equ     5               ; reset failed

+record_not_fnd  equ     4               ; requested sector not found

+write_protect   equ     3               ; disk write protected

+bad_addr_mark   equ     2               ; address mark not found

+bad_cmd         equ     1               ; bad command passed to disk i/o

+;*                                                                          *

+;****************************************************************************

+

+blockerr:

+     pop bp                      ;return adresse holen

+     pop dx                      ;ds:bx vom stack putzen

+     pop dx

+     mov bx,offset messagetable  ;tabelle mit meldungen holen

+     mov dh,0                    ;laengenangaben sind nur ein byte

+err_loop:

+     mov al,byte ptr [bx]        ;fehlerschluessel holen

+     inc bx

+     cmp al,ah                   ;war das der gesuchte

+     jz err_found                ;ja

+     inc al                      ;oder ende der tabelle

+     jz err_found                ;ja

+     inc bx                      ;auf laengenbyte

+     mov dl,byte ptr [bx]        ;laenge holen

+     add bx,dx                   ;adresse des naechsten textes

+     inc bx                      ;und ueber laengenbyte rueber

+     jmp err_loop

+

+err_found:

+     mov cl,byte ptr [bx]

+     mov ch,0                    ;nur ein byte fehlercodes

+     inc bx                      ;auf textlaenge gehen

+     push cs                     ;adresse fehlermeldung drauf

+     push bx

+     jmp bp

+

+highblock:

+     mov ah,blnrhigh             ;meldung blocknummer zu hoch

+     jmp blockerr

+

+err_mess macro code,eucode,mess

+local m_end

+     db code,eucode,m_end-$-1,mess

+m_end:

+     endm

+

+messagetable:

+     err_mess blnrhigh,3,'blocknummer zu hoch'

+     err_mess not_rdy,1,'not ready'

+     err_mess bad_crc,2,'crc err'

+     err_mess bad_sect,2,'bad sect'

+     err_mess record_not_fnd,2,'rec not fnd'

+     err_mess dma_boundary,1,'dma boundary'

+     err_mess time_out,2,'timeout'

+     err_mess 0ffh,2,'undef_err_code'

+

+

+

+

diff --git a/system/shard-x86-at/7/src/BOOT.ASM b/system/shard-x86-at/7/src/BOOT.ASM
new file mode 100644
index 0000000..c26f1df
--- /dev/null
+++ b/system/shard-x86-at/7/src/BOOT.ASM
@@ -0,0 +1,425 @@
+;*****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ===================*

+;*                                                                           *

+;*        Laden des EUMEL - Restsystems vom Archiv oder HG                   *

+;*                                                                           *

+;*****************************************************************************

+

+; Versionsschluessel:

+;2.2 enthaelt mehrere Partition, Floppy size = 0 bei start und fehler

+;2.3 enhaelt Floppy mit Block 0 lesen immer erlaubt

+;2.4 Drucker geht ueber rom, wenn adresse nicht ibmlike

+;    mehrere Drucker moeglich

+;    busy Abfrage kann verzoegert werden (Problem LQ1000)

+;    es werden nur die vorhandenen Schnittstellen angezeigt

+;    Lesezugriffe bis Block 6 auf Floppy werden immer erlaubt

+;2.5 Hercules Karte wird unterstuetzt

+;    Bei AT werden schlechte sectoren statt spuren behandelt

+;2.6 Fehler in Plattengröße bei behoben (meldete immer al <> 0)

+;2.7 Floppylogik fuer 1.7.3 restauriert, Floppy steht jetzt immer

+;    auf 360k, wenn keine Floppy erkannt wird, und der Urlader die

+;    HG-Version 1742 hat.

+;    die Schnittstellen der Addonics-Karte sind jetzt immer mit drin,

+;    wenn COM4 generiert sind.

+;    Die Druckerkanäle liegen auf 15,14,16

+;    Die Baudrateabfrage verneint auch 0

+

+los_gehts:

+     cli

+; achtung: es und si muessen bis zum einstellen der Festplatte

+; unveraendert bleiben !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

+     mov ax,cs

+     mov ds,ax

+; cs in vorlaeufige EUMEL Tabelle eintragen

+     mov bx,offset systemstart+2

+     mov cx,eumel_cs_init_length

+self_cs_init_loop:

+     mov word ptr [bx],ax

+     add bx,4

+     loop self_cs_init_loop

+; cs in SHard - Tabelle eintragen

+     mov bx,offset first_shard_cs_to_alter

+     mov cx,shard_cs_alter_length

+shard_cs_init_loop:

+     mov word ptr [bx],cs     ;put in my code segment

+     add bx,4

+     loop shard_cs_init_loop 

+; berechnen, wohin der EUMEL spaeter soll

+     mov bx,offset lastbootbyte  ;relativen paragraph ausrechnen

+     mov cl,4

+     shr bx,cl

+     inc bx

+     add ax,bx                ;hier soll spaeter der EUMEL hin

+     mov ss,ax

+     mov sp,0

+     push si                  ;werte fuer plattensetup merken

+     push es

+; warte routine fuer Platten und Floppytreiber eintragen

+     call device_init           ;int 15 eintragen

+; alle Kanaele initialisieren

+     mov dh,33

+     mov al,0

+inilop:

+     mov cx,-2

+     push ax

+     call control32

+     pop ax

+     cli

+     inc al

+     dec dh

+     jnz inilop

+     sti                      ;interrupts sind erlaubt

+     mov bx,offset signon     ;sag ihm, wer wir sind

+     call print

+; alle kanaele fuer festplatte einstellen (falls vorhanden)

+     pop es

+     pop si                   ;zeiger auf partitiontabelle wiederholen

+     call setup_fix_disk

+; EUMEL 0 laden

+getagain:

+   ife gensys

+     mov al,31      ;zuerst von kanal 31 versuchen

+     mov bx,offset archtext

+     call geteumel

+   endif

+     mov al,0

+     mov bx,offset hgtext

+     call geteumel

+     mov bx,offset noeutext

+     call print

+     call waitchar

+     jmp getagain

+

+geteumel:	;EUMEL 0 laden und bei Erfolg starten

+     push ax

+     mov cx,5       ;size

+     call cs:iocontrol

+     pop ax

+     push bx        ;text fuer medium merken

+     mov cx,ss      ;ausrechnen, wohin der urlader muss (ss:0)

+     add cx,31                ;damit wir nicht rueckwaerts gehen

+     and cx,0ffe0h  ;auf 512 byte boundary

+     mov ds,cx      ;segment nach ds

+     mov bx,0       ;bei 0 im segment laden wir zuerst

+     mov cx,0       ;auftrag

+     mov dx,10      ;erster urlader block ist 10

+     mov ah,1       ;nur ein versuch 

+     cmp al,0

+     ifz <mov ah,3> ;hintergrund muss lesbar sein

+     push bx 

+     push ds

+     call getblock

+     pop ds

+     pop bx

+     or cx,cx       ;fehlerfrei?

+     jz firstok

+     pop bx         ;text fuer medium vergessen

+     ret

+firstok:

+     push ax

+     mov cx,5       ;text EUMEL hat 5 buchstaben

+     mov si,offset eutext     ;text EUMEL

+     mov di,bx                ;puffer

+textloop: 

+     lods byte ptr cs:[si]

+     cmp al,byte ptr ds:[di]

+     jz charok

+     pop ax         ;stack saeubern

+     pop bx

+     ret            ;nicht gleich, kein eumel urlader

+charok:

+     inc di

+     loop textloop

+     pop ax         ;kanal fuer urlader wiederholen

+     pop bx         ;text fuer medium holen

+     call print     ;ausgeben

+     mov bx,0       ;bx ist zerstoert, aber wir wissen, wohin

+     mov ah,8       ;ab hier mit acht versuchen

+euloop:

+     mov cx,0

+     inc dx

+     add bx,512     ;auf naechsten block schalten

+     push bx

+     push ds

+     call getblock

+     or cx,cx

+     jnz booterr

+     pop ds

+     pop bx

+     cmp dx,10+100  ;schon kompletten urlader gelesen

+     jnz euloop

+; Sprungleiste vom EUMEL abholen

+     push cs

+     pop es                   ;ziel ist codesegment

+     mov si,0

+     mov di,offset eumel0id

+     mov cx,eumel_leisten_laenge 

+     cli

+     cld

+     rep movsb

+     mov ax,ds                ;eumel codesegment nach ax

+     push cs                  ;datensegment wieder auf shard

+     pop ds

+; und passendes cs eintragen

+     mov bx,offset systemstart+2

+     mov cx,eumel_cs_init_length

+eumel_cs_init_loop:

+     mov word ptr [bx],ax

+     add bx,4

+     loop eumel_cs_init_loop 

+     call paragraphs

+     sub dx,ax                ;rest fuer eumel ausrechnen

+    if ramsys

+     urram equ 1000h

+

+     sub dx,urram             ;64k fuer urlader und paging

+     mov M3SIZE,dx

+     mov M0SIZE,urram

+     mov M0START,ax

+     add ax,urram

+     mov M3START,ax

+    else

+     mov M0SIZE,dx

+     mov M0START,ax           ;eumel codesegment eintragen

+    endif

+     mov ax,31           ;allen floppies die chance geben

+i173lop:                 ;sich auf 173 einzustellen

+     mov cx,-173

+     push ax

+     call control32

+     pop ax

+     dec al

+     jnz i173lop

+     mov bx,offset SHard_leiste

+     jmp systemstart

+ 

+

+booterr:

+     push ds

+     push bx

+     mov bx,offset booterrtext

+     call print

+     pop bx

+     pop ds

+     call dsprint

+     jmp $

+ 

+getblock:

+     push ax        ;original ax merken

+getloop:

+     push bx

+     push ds 

+     push ax        ;ax mit retry zaehler

+     mov cx,0

+     call cs:blockin

+     pop ax

+     or cx,cx

+     jnz geterr

+     pop ds

+     pop bx

+     pop ax

+     ret

+geterr:

+     dec ah         ;genuegend retries

+     jnz getcontinue

+     pop ax         ;kill ds

+     pop ax         ;kill bx

+     pop ax         ;altes ax holen

+     ret

+getcontinue:

+     pop ds

+     pop bx

+     jmp getloop

+

+waitchar:

+     sti

+     mov byte ptr cs:waschar,0

+waitcloop:

+     cmp byte ptr cs:waschar,0

+     jz waitcloop

+     ret

+

+iint proc far

+     cmp al,1                 ;nur kanal 1 ist interessant

+     ifnz <ret>

+     mov byte ptr cs:waschar,1

+     ret

+iint endp

+

+waschar db 0

+

+print:

+     push ds

+     push cs

+     pop ds

+     call dsprint

+     pop ds

+     ret

+

+dsprint:

+     push cx

+     push ax

+     mov cl,byte ptr [bx]     ;laenge holen

+     inc bx                   ;auf text schalten

+     mov ch,0

+     mov al,1                 ;auf terminal 1

+     call cs:output

+     pop ax

+     pop cx

+     ret

+

+setup_fix_disk:

+  if hdsystem

+     mov di,si                ;si retten

+     mov dl,4

+eumel_partition_search_loop:

+     test byte ptr es:[si],80h  ;aktivierte Partition

+     jnz eu_found

+     add si,10h

+     dec dl

+     jnz eumel_partition_search_loop

+; keine EUMEL Partition, Sauerei

+no_eu_part:

+     mov bx,offset no_eumel_partition_text

+     call print

+     sti

+     jmp $

+

+eu_found:

+     cmp byte ptr es:[si+4],'E' ;EUMEL partition

+     jc no_eu_part

+     mov dx,es:[si+8]    ;low word partition start holen

+     mov bx,es:[si+10]   ;high word partition start holen

+     add dx,68           ;50k fuer shard etc. frei lassen

+     adc bl,0

+     mov cx,-101         ;partition start einstellen

+     mov al,0            ;fuer HG

+     call control32

+     mov cx,-100         ;dasselbe als groesse fuer Setup Kanal

+     mov al,setup_channel

+     call control32

+     mov dx,es:[si+12]   ;low word partition size holen

+     mov bx,es:[si+14]   ;high word partition size holen

+     

+    if at

+     sub dx,68           ;platz fuer SHard

+     sbb bl,0

+     sub dx,[bb_anz]     ;platz fuer schlechte sectoren lassen

+     sbb bl,0

+    else

+     sub dx,68+(2*68)    ;das, was wir fuers SHard lassen, abziehen

+                         ;und das, was fuer schlechte spuren bleiben muss

+     sbb bl,0

+    endif

+

+     mov cx,-100         ;size einstellen

+     mov al,0            ;fuer hg

+     call control32

+; DOS partition suchen

+     mov si,di           ;si wieder holen

+     mov dl,4

+dos_partition_search_loop:

+     cmp byte ptr es:[si+4],1 ;DOS partition

+     jz dos_found

+     add si,10h

+     dec dl

+     jnz dos_partition_search_loop

+     xor dx,dx

+     mov bx,dx           ;DOS Partition existiert nicht

+     jmp short dos_size

+dos_found:

+     mov dx,es:[si+8]    ;low word partition start holen

+     mov bx,es:[si+10]   ;high word partition start holen

+     mov cx,-101         ;partition start einstellen

+     mov al,dos_channel  ;fuer DOS

+     call control32

+     mov dx,es:[si+12]   ;low word partition size holen

+     mov bx,es:[si+14]   ;high word partition size holen

+dos_size:

+     mov cx,-100         ;size einstellen

+     mov al,dos_channel  ;fuer DOS

+     call control32

+  endif

+     ret

+

+ if 0

+     mov ax,0

+     mov cx,5

+     call cs:iocontrol           ;get size of harddisk

+  if mit_msdos

+     mov bx,17068

+  else

+     mov bx,100               ;50k freilassen

+  endif

+     sub cx,bx                ;von size abziehen

+     cmp cx,0fd00h shr 1      ;bei mehr legt sich eumel auf den bauch

+     ifnc <mov cx,0fcfeh shr 1> ;dann nur soviel, wie er kann

+     mov dx,cx                ;in dx melden

+     mov cx,-100              ;set size

+     call control32

+     ret

+ endif

+

+eutext:

+     db 'EUMEL'

+

+signon:

+     db booterrtext-$-1

+  if pcd

+     db 1bh,5bh,'H',1bh,5bh,'2J'

+     db 13,10,10 

+     db 'Demo - SHard f',129,'r EUMEL auf Siemens PC-D, V 2.1'

+     db 13,10

+     db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge'

+     db 13,10

+   else

+     if gensys

+        db 13,10,10

+        db 'Setup - SHard f',129,'r EUMEL'

+        db ' auf IBM PC,AT,XT und Kompatiblen V 2.7'

+        db 13,10

+        db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge'

+        db 13,10

+     else

+       if at

+          db 13,10,10

+          db 'SHard f',129,'r EUMEL auf IBM PC/AT, V 2.7'

+          db 13,10

+          db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge'

+          db 13,10

+       else

+          db 13,10,10

+          db 'ModSoft - SHard f',129,'r EUMEL'

+          db ' auf IBM-PC und Kompatiblen, Version 2.7'

+          db 13,10

+          db 'Copyright (C) 1985,86 ModSoft, Martin Sch',148,'nbeck'

+          db 13,10

+       endif

+     endif

+  endif

+

+booterrtext:

+     db archtext-$-1

+     db 'Fehler beim Laden des Systems: '

+     db 7

+archtext:

+     db hgtext-$-1

+     db 'EUMEL wird vom Archiv geladen'

+     db 13,10

+hgtext:

+     db noeutext-$-1

+     db 'EUMEL wird vom Hintergrund geladen'

+     db 13,10

+noeutext:

+     db no_eumel_partition_text-$-1

+     db 'Kein EUMEL - System gefunden'

+     db 13,10

+     db 'Bitte einlegen und Taste dr',129,'cken! '

+no_eumel_partition_text:

+     db endtext-$-1

+     db 'Keine EUMEL Partition auf der Platte'

+     db 13,10

+     db 'Bitte benutzen Sie Ihre Setup-Floppy zum Anlegen'

+endtext:

+

+lastbootbyte:

diff --git a/system/shard-x86-at/7/src/CLOCK.ASM b/system/shard-x86-at/7/src/CLOCK.ASM
new file mode 100644
index 0000000..1f0e395
--- /dev/null
+++ b/system/shard-x86-at/7/src/CLOCK.ASM
@@ -0,0 +1,55 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Lesen der Echtzeituhr des IBM PC-AT                                    *

+;*   Schreiben dummy routine	                                            *

+;*        Aufruf: blockin/blockout mit code -4 ueber kanal 32               *

+;*        Puffer: ROW 7 INT VAR                                             *

+;*                                                                          *

+;****************************************************************************

+

+clockread:

+     call hardware

+     cmp al,IBMat                ;haben wir den IBM PC-AT

+     jnz no_clock

+     mov ah,4                    ;read date

+     int 1ah

+     jc no_clock

+     mov al,ch                   ;jahrhundert

+     call putbcd                 ;ueber bx wegschreiben

+     mov al,cl                   ;jahr

+     call putbcd

+     mov al,dh                   ;monat

+     call putbcd

+     mov al,dl                   ;tag

+     call putbcd

+     mov ah,2                    ;read time

+     int 1ah

+     jc no_clock

+     mov al,ch                   ;stunden

+     call putbcd

+     mov al,cl                   ;minuten

+     call putbcd

+     mov al,dh                   ;sekunden

+     call putbcd

+     mov cx,0                    ;keine fehler

+     ret

+

+no_clock:

+     mov cx,-1                   ;geht nicht

+     ret

+

+clockwrite:

+     mov cx,-1

+     ret

+

+putbcd:

+     mov ah,al

+     and ah,0fh                  ;in al niedrige nibble behalten

+     ib shr al,4                 ;rueberschieben

+     or ax,3030h                 ;ziffern draus machen

+     mov word ptr es:[bx],ax     ;eintragen

+     inc bx

+     inc bx                      ;zum naechsten

+     ret

+

diff --git a/system/shard-x86-at/7/src/DEVICE.ASM b/system/shard-x86-at/7/src/DEVICE.ASM
new file mode 100644
index 0000000..68eb129
--- /dev/null
+++ b/system/shard-x86-at/7/src/DEVICE.ASM
@@ -0,0 +1,91 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Macros zur Definition von devicetypecontrolblocks und                 *

+;*   bestimmten channelcontrolblock Eintraegen                             *

+;*                                                                         *

+;***************************************************************************

+ .xlist

+

+actualdevice = 0

+

+device macro type

+     if1

+     ifdef type

+     .printx * device type doppelt definiert *

+     endif

+     endif

+actualdevice = actualdevice+1

+type = actualdevice

+ 

+     endm

+

+routine macro code,execut

+     db code

+     dw offset execut

+     endm

+

+dtcbroutines macro type

+     ifidn <type>,<blockin>

+      buildlabel blockin_,%actualdevice

+     else

+     ifidn <type>,<blockout>

+      buildlabel blockout_,%actualdevice

+     else

+     ifidn <type>,<iocontrol>

+      buildlabel iocontrol_,%actualdevice

+     else

+     ifidn <type>,<control32>

+      buildlabel control32_,%actualdevice

+     else

+      .printx * unbekannter routinentyp: '&type' in dctbroutine *

+     endif

+     endif

+     endif

+     endif

+     endm

+

+dtcbparams macro output,typ

+     buildlabel paramstart_,%actualdevice

+     dw offset output

+     dbbp blockin_,%actualdevice

+     dbbp blockout_,%actualdevice

+     dbbp iocontrol_,%actualdevice

+     dbbp control32_,%actualdevice

+dtcbentry devtype

+     db typ

+     endm

+

+dtcbentry macro entry

+     xequat entry,%actualdevice

+     endm

+

+dwb macro first,second

+     dw offset first&second

+     endm

+

+dbbp macro first,second

+     db first&second-paramstart_&second

+     endm

+

+xequat macro entry,dev

+entry = $-paramstart_&dev

+     endm

+

+buildlabel macro first,second

+first&second:

+     endm

+

+startccb macro name,kanal

+name:

+actccb = $

+ccbentry channel_no

+     db kanal

+     endm

+

+ccbentry macro entry

+entry = $-actccb

+     endm

+

+ .list

+

diff --git a/system/shard-x86-at/7/src/EUCONECT.ASM b/system/shard-x86-at/7/src/EUCONECT.ASM
new file mode 100644
index 0000000..7bc0aa2
--- /dev/null
+++ b/system/shard-x86-at/7/src/EUCONECT.ASM
@@ -0,0 +1,79 @@
+;======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =============

+;---------------------------------------------------------------------

+   even

+

+eumel0id                       db 'EUMEL           '

+eumel0blocks                   dw 100

+hgver                          dw 1742

+cputype                        dw 3            ; 8086

+urver                          dw 100

+                               dw 0

+shdvermin                      dw 7

+shdvermax                      dw 7

+                               dw 0

+systemstart                    dd dummy_ret

+inputinterrupt                 dd iint

+timerinterrupt                 dd dummy_ret

+warte                          dd dummy_ret

+grab                           dd dummy_ret

+free                           dd dummy_ret

+shutup                         dd dummy_ret

+info                           dd dummy_ret

+eumel_cs_init_length equ ($-systemstart)/4

+eumel_leisten_laenge equ $-eumel0id

+

+;---------------------------------------------------------------------

+;

+;                  SHard-Leiste

+;

+;---------------------------------------------------------------------

+

+SHard_leiste:

+SHDID                          db 'SHard Schoenbeck'

+SHDVER                         dw 7

+ if withhd or at

+MODE                           dw 0

+ else

+MODE                           dw 1 ;freieumel0

+ endif

+ID4                            dw 4711

+ID5                            dw 4712

+ID6                            dw 0

+ID7                            dw 0

+                               dw 0

+                               dw 0

+output label dword

+                               dw offset i_output

+first_shard_cs_to_alter:

+                               dw 0

+blockin label dword

+                               dw offset i_blockin

+                               dw 0

+blockout label dword

+                               dw offset i_blockout

+                               dw 0

+iocontrol label dword

+                               dw offset i_iocontrol

+                               dw 0

+sysend label dword

+                               dw offset i_sysend

+                               dw 0

+                               dd 0

+                               dd 0

+                               dd 0

+shard_cs_alter_length equ ($-first_shard_cs_to_alter)/4

+M0START                        dw 0

+M0SIZE                         dw 0

+M1START                        dw 0

+M1SIZE                         dw 0

+M2START                        dw 0

+M2SIZE                         dw 0

+M3START                        dw 0

+M3SIZE                         dw 0

+

+shdveclen equ offset shdid-offset m3size+2

+

+dummy_ret proc far

+  sti

+  ret

+dummy_ret endp 

diff --git a/system/shard-x86-at/7/src/FDISK.ASM b/system/shard-x86-at/7/src/FDISK.ASM
new file mode 100644
index 0000000..1ada045
--- /dev/null
+++ b/system/shard-x86-at/7/src/FDISK.ASM
@@ -0,0 +1,839 @@
+;-----------------------------------------------------------------------

+;       Disketten I/O                                           

+;       Input:

+;       (ah)=0  Reset Diskette System

+;               hard reset to nec, prepare command, recal rquired

+;               on all drives

+;       (ah)=1  read the status of the system into (al)

+;               diskette_status from last operation is used

+;

+;       Registers for read/write/verify/format

+;       (dl)    drive number (0-3 allowed, vlue checked)

+;       (dh)    head number (0-1 allowed, not value checked)

+;       (ch)    track number (0-39, not value checked)

+;       (cl)    sektor number (1-8, not value checked,

+;                       not used for format)

+;       (al)    number of sektors ( max = 8, not value checked,

+;                       not used for format

+;       (es:bx) address of buffer (not required for verify)

+;       (ah)=2  read the desired sektors into memory

+;                       =3      write

+;                       =4      verify

+;                       =5      format

+;               for the format operation, the buffer pointer (es,bx)

+;               must point to the collektion of desired address fields

+;               for the track. Each field is composed of 4 Bytes,

+;               (c,h,r,n) where c = track number, h=head number,

+;               r = sektor number, n = number of bytes per sektor

+;               (00=128, 01=256, 02=512, 03=1024). There must be one

+;               entry for every sektor on the track. This information

+;               is used to find the requested sektor during read/write

+;               access.

+;

+;       Data Variable -- disk_pointer

+;       double word pointer to the current set of diskette parameters

+;       Output

+;       ah = status of Operation

+;               Status bits are defined in the equates for

+;               Diskette_status variable in the data segment of this

+;               module.

+;       cy = 0  successful operation (ah = 0 on return)

+;       cy = 1  failed operation (ah has error reason)

+;       for read/write/verify

+;               ds,bx,dx,ch,cl  reserved

+;               al = number of sektors actually read

+;               ***** al may not be correkt if time out error occurs

+;       note:   if an error is reported by the diskette code, the

+;               appropriate action is to reset the diskette, then retry

+;               the operation, on read access, no motor start delay

+;               is taken, so that three retries are required on reads

+;               to ensure that the problem is not due to motor

+;               start-up.

+;-----------------------------------------------------------------------

+

+        data segment at 40h

+        org 3eh

+seek_status     db ?

+int_flag        equ 80h

+motor_status    db ?

+motor_count     db ?

+motor_wait      equ 37

+diskette_status db ?

+nec_status      db 7 dup(?)

+

+        data ends

+

+        assume ds:data

+

+ ife withhd

+dma             equ     0               ; dma address

+dma_high        equ     82h             ; port for high 4 bits of dma

+ endif

+

+

+diskette_io     proc near

+        sti

+        push    bx

+        push    cx

+        push    ds

+        push    si

+        push    di

+        push    bp

+        push    dx

+        mov     bp,sp                   ; set up pointer to head parm

+        mov     si,data

+        mov     ds,si

+        call    j1                      ; call the rest to ensure ds restored

+        mov     bx,4                    ; get the motor wait parameter

+        call    get_parm 

+        mov     motor_count,ah          ; set the timer count for the motor

+        mov     ah,diskette_status      ; get status of operation

+        cmp     ah,1                    ; set the carry flag to indicate

+        cmc                             ;        success or failure

+        pop     dx

+        pop     bp

+        pop     di

+        pop     si

+        pop     ds

+        pop     cx

+        pop     bx

+        ret

+diskette_io     endp

+

+j1      proc near

+        mov     dh,al

+        and     motor_status,07fh

+        or      ah,ah

+        jz      disk_reset

+        dec     ah

+        jz      fdisk_status

+        mov     diskette_status,0

+        cmp     dl,4

+        jae     j3

+        dec     ah

+        jz      fdisk_read

+        dec     ah

+        jnz     j2

+        jmp     fdisk_write

+j2:

+        dec     ah

+        jz      disk_verf

+        dec     ah

+        jz      disk_format

+j3:

+        mov     diskette_status,bad_cmd

+        ret

+j1      endp

+

+;----- reset the diskette system

+

+disk_reset      proc near

+        mov     dx,03f2h

+        cli

+        mov     al,motor_status

+        mov     cl,4

+        sal     al,cl

+        test    al,20h

+        jnz     j5

+        test    al,40h

+        jnz     j4

+        test    al,80h

+        jz      j6

+        inc     al

+j4:

+        inc     al

+j5:

+        inc     al

+j6:

+        or      al,8

+        out     dx,al

+        mov     seek_status,0

+        mov     diskette_status,0

+        or      al,4

+        out     dx,al

+        sti

+        call    chk_stat_2

+

+        mov     al,nec_status

+        cmp     al,0c0h

+        jz      j7

+        or      diskette_status,bad_cntlr

+        ret

+

+;----- send specific command to nec

+

+j7:

+        mov     ah,3

+        call    nec_output

+        mov     bx,1

+        call    get_parm

+        mov     bx,3

+        call    get_parm

+j8:

+        ret

+disk_reset      endp

+

+

+;-----diskette status routine

+

+fdisk_status    proc near

+        mov     al,diskette_status

+        ret

+fdisk_status    endp

+

+

+;-----diskette read

+

+fdisk_read      proc near

+        mov     al,046h

+j9:

+        call    dma_setup

+        mov     ah,0e6h

+        jmp     short rw_opn

+fdisk_read      endp

+

+

+;----- diskette verify

+

+disk_verf       proc near

+        mov     al,042h

+        jmp     j9

+disk_verf       endp

+

+

+;----- diskette format

+

+disk_format     proc near

+        or      motor_status,80h

+        mov     al,04ah

+        call    dma_setup

+        mov     ah,04dh

+        jmp     short rw_opn

+j10:

+        mov     bx,7

+        call    get_parm

+        mov     bx,9

+        call    get_parm

+        mov     bx,15

+        call    get_parm

+        mov     bx,17

+        jmp     j16

+disk_format     endp

+

+

+;-----diskette write routine

+

+fdisk_write     proc near

+        or      motor_status,80h

+        mov     al,04ah

+        call    dma_setup

+        mov     ah,0c5h

+fdisk_write     endp

+

+;-----allow write routine to fall into rw_opn

+

+;-----------------------------------------------------------------------

+; rw_opn

+;       this routine performs the read/write/verify operation

+;-----------------------------------------------------------------------

+

+rw_opn  proc    near

+        jnc     j11

+        mov     diskette_status,dma_boundary

+        mov     al,0

+        ret

+j11:

+        push    ax

+

+;----- turn on the motor and select the drive

+

+        push    cx

+        mov     cl,dl

+        mov     al,1

+        sal     al,cl

+        cli

+

+        mov     motor_count,0ffh

+        test    al,motor_status

+        jnz     j14

+        and     motor_status,0f0h

+        or      motor_status,al

+        sti

+        mov     al,10h

+        sal     al,cl

+        or      al,dl

+        or      al,0ch

+        push    dx

+        mov     dx,03f2h

+        out     dx,al

+        pop     dx

+

+;----- wait for motor if write operation

+

+        test    motor_status,80h

+        jz      j14

+

+        clc

+        mov     ax,090fdh

+        int     15h

+        jc      j14

+

+

+        mov     bx,20

+        call    get_parm

+        or      ah,ah

+j12:

+        jz      j14

+        sub     cx,cx

+j13:

+        loop    j13

+        dec     ah

+        jmp     j12

+j14:

+        sti

+        pop     cx

+

+;----- do the seek operation

+

+        call    seek

+        pop     ax

+        mov     bh,ah

+        mov     dh,0

+        jc      j17

+        mov     si,offset j17

+        push    si

+

+;----- send out the parameters to the controller

+

+        call    nec_output

+        mov     ah,[bp+1]

+        sal     ah,1

+        sal     ah,1

+        and     ah,4

+        or      ah,dl

+        call    nec_output

+

+;----- test for format command

+

+        cmp     bh,04dh

+        jne     j15

+        jmp     j10

+j15:

+        mov     ah,ch

+        call    nec_output

+        mov     ah,[bp+1]

+        call    nec_output

+        mov     ah,cl

+        call    nec_output

+        mov     bx,7

+        call    get_parm

+        mov     bx,9

+        call    get_parm

+        mov     bx,11

+        call    get_parm

+        mov     bx,13

+j16:

+        call    get_parm

+        pop     si

+

+;----- let the operation happen

+

+        call    wait_int

+j17:

+        jc      j21

+        call    results

+        jc      j20

+

+;----- check the results returned by the controller

+

+        cld

+        mov     si,offset nec_status

+        lods    nec_status

+        and     al,0c0h

+        jz      j22

+        cmp     al,040h

+        jnz     j18

+

+;----- abnormal termination, find out wy

+

+        lods    nec_status

+        sal     al,1

+        mov     ah,record_not_fnd

+        jc      j19

+        sal     al,1

+        sal     al,1

+        mov     ah,bad_crc

+        jc      j19

+        sal     al,1

+        mov     ah,bad_dma

+        jc      j19

+        sal     al,1

+        sal     al,1

+        mov     ah,record_not_fnd

+        jc      j19

+        sal     al,1

+        mov     ah,write_protect

+        jc      j19

+        sal     al,1

+        mov     ah,bad_addr_mark

+        jc      j19

+

+;----- nec must have failed

+

+j18:

+        mov     ah,bad_cntlr

+j19:

+        or      diskette_status,ah

+        call    num_trans               ; how many were really transferred

+j20:

+        ret

+j21:

+        call    results

+        ret

+

+;----- operation was successfull

+

+j22:

+        call    num_trans

+        xor     ah,ah

+        ret

+rw_opn  endp

+

+;-----------------------------------------------------------------------

+;       nec_output

+;       This routine sends a byte to the nec controller after testing

+;       for correct direction and controller ready. This routine will

+;       time out if the byte is not accepted within a reasonable

+;       amount of time, setting the diskette status on completion.

+; Input

+;       (ah)    byte to be output

+; Output

+;       cy=0    success

+;       cy=1    failure -- diskette status updated

+;               If a failure has occured, the return is made one level

+;               higher than the caller of nec_output. (!Schweinkram)

+;               This removes the requirement of testing after every

+;               call of nec_output

+;       (al)    destroyed

+;-----------------------------------------------------------------------

+

+nec_output      proc near

+        push    dx

+        push    cx

+        mov     dx,03f4h

+        xor     cx,cx

+j23:

+        in      al,dx

+        test    al,040h

+        jz      j25

+        loop    j23

+j24:

+        or      diskette_status,time_out

+        pop     cx

+        pop     dx

+        pop     ax              ; discard the return address

+        stc

+        ret

+j25:

+        xor     cx,cx

+j26:

+        in      al,dx

+        test    al,080h

+        jnz     j27

+        loop    j26

+        jmp     j24

+j27:

+        mov     al,ah

+        mov     dl,0f5h

+        out     dx,al

+        pop     cx

+        pop     dx

+        ret

+nec_output      endp

+

+;-----------------------------------------------------------------------

+; get_parm

+;       This routine fetches the indext pointer from the disk_bas

+;       block pointed at by the data variable disk_pointer. A byte from

+;       that table is then moved into ah, the index of that byte being

+;       the parm in bx

+; Input:

+;       bx      index of byte to be fetched *2

+;               if the low bit of bx is on, the byte is immediately output

+;               to the nec controller

+; Exit

+;       am      that byte from block

+;-----------------------------------------------------------------------

+

+disk_pointer    equ 1eh * 4

+

+get_parm        proc near

+        push    ds

+        push    si

+        sub     ax,ax

+        mov     ds,ax

+

+        lds     si,dword ptr ds:disk_pointer

+        shr     bx,1

+

+        mov     ah,[si+bx]

+        pop     si

+        pop     ds

+        jc      nec_output

+        ret

+get_parm        endp

+

+;-----------------------------------------------------------------------

+; seek

+;       Thi routine will move the head on the named drive to the

+;       named track. If the drive has not been accessed since the

+;       drive reset command was issued, the drive will be recalibrated.

+; Input:

+;       (dl) = Drive to seek on

+;       (ch) = track t seek to

+; Output:

+;       cy = 0 success

+;       cy = 1 failure -- diskette_status set accordingly

+;       (ax) destroyed

+;-----------------------------------------------------------------------

+

+seek    proc near

+        mov     al,1

+        push    cx

+        mov     cl,dl

+        rol     al,cl

+        pop     cx

+        test    al,seek_status

+        jnz     j28

+        or      seek_status,al

+        mov     ah,07h

+        call    nec_output

+        mov     ah,dl

+        call    nec_output

+        call    chk_stat_2

+        jc      j32

+

+;----- drive is in synch with controller, seek to track

+

+j28:

+        mov     ah,0fh

+        call    nec_output

+        mov     ah,dl

+        call    nec_output

+        mov     ah,ch

+        call    nec_output

+        call    chk_stat_2

+

+;----- wait for head settle

+

+        pushf

+        mov     bx,18

+        call    get_parm

+        push    cx

+j29:

+        mov     cx,550

+        or      ah,ah

+        jz      j31

+j30:

+        loop    j30

+        dec     ah

+        jmp     j29

+j31:

+        pop     cx

+        popf

+j32:

+        ret

+seek    endp

+

+;-----------------------------------------------------------------------

+; dma_setup

+;       this routine sets up the dma for read/write/verify operations

+; input:

+;       (al) = mode byte for the dma

+;       (es:bx) - address to read/write the data

+; output:

+;       (ax) destroyed

+;-----------------------------------------------------------------------

+

+dma_setup       proc near

+        push    cx

+        cli

+        out     dma+12,al

+        push    ax

+        pop     ax

+        out     dma+11,al

+        mov     ax,es

+        mov     cl,4

+        rol     ax,cl

+        mov     ch,al

+        and     al,0f0h

+        add     ax,bx

+        jnc     jj33

+        inc     ch

+jj33:

+        push    ax

+        out     dma+4,al

+        mov     al,ah

+        out     dma+4,al

+        mov     al,ch

+        and     al,0fh

+        out     081h,al

+

+;----- determine count

+

+        mov     ah,dh

+        sub     al,al

+        shr     ax,1

+        push    ax

+        mov     bx,6

+        call    get_parm

+        mov     cl,ah

+        pop     ax

+        shl     ax,cl

+        dec     ax

+        push    ax

+        out     dma+5,al

+        mov     al,ah

+        out     dma+5,al

+        sti

+        pop     cx

+        pop     ax

+        add     ax,cx

+        pop     cx

+        mov     al,2

+        out     dma+10,al

+        ret

+dma_setup       endp

+

+;-----------------------------------------------------------------------

+; chk_stat_2

+;       This routine handles the interrupt received after a

+;       recalibrate, seek, or reset to the adapter.

+;       The interrupt is waited for, the interrupt sensed,

+;       and the result returned to the caller.

+; input:

+;       none

+; output:

+;       cy = 0  success

+;       cy = 1  failure -- error is in diskette_status

+;       (ax)            destroyed

+;-----------------------------------------------------------------------

+

+chk_stat_2      proc near

+        call    wait_int

+        jc      j34

+        mov     ah,08h

+        call    nec_output

+        call    results

+        jc      j34

+        mov     al,nec_status

+        and     al,060h

+        cmp     al,060h

+        jz      j35

+        clc

+j34:

+        ret

+j35:

+        or      diskette_status,bad_seek

+        stc

+        ret

+chk_stat_2      endp

+

+;-----------------------------------------------------------------------

+; wait_int

+;       This routine waits for an interrupt to occur. A time out

+;       routine takes place during the wait, so that an error may be

+;       returned if the drive is not ready.

+; input:

+;       none

+; output:

+;       cy = 0 success

+;       cy = 1 failure -- diskette_status is set accordingly

+;       (ax) destroyed

+;-----------------------------------------------------------------------

+

+wait_int        proc near

+        sti

+        push    ax

+        push    bx

+        push    cx

+        clc

+        mov     ax,09001h

+        int     15h

+        sti

+        jc      j36a

+;

+        mov     bl,2

+        xor     cx,cx

+j36:

+        test    seek_status,int_flag

+        jnz     j37

+;       push cx

+;       push bx

+;       push ds

+;       push es

+;       push ax

+;       push dx

+;       push si

+;       push di

+;       push bp

+;       call cs:warte

+;       pop bp

+;       pop di

+;       pop si

+;       pop dx

+;       pop ax

+;       pop es

+;       pop ds

+;       pop bx

+;       pop cx

+        loop    j36

+        dec     bl

+        jnz     j36

+

+j36a:   or      diskette_status, time_out

+        stc

+j37:

+        pushf

+        and     seek_status, not int_flag

+        popf

+        pop     cx

+        pop     bx

+        pop     ax

+        ret

+wait_int        endp

+

+;-----------------------------------------------------------------------

+; disk_int

+;       This routine handles the diskette interrupt

+; Input

+;       none

+; output:

+;       The interrupt flag is set is seek_status

+;-----------------------------------------------------------------------

+

+;**************

+;org    0ef57h

+;**************

+disk_int        proc far

+        sti

+        push    ds

+        push    ax

+        push si

+        mov     si,data

+        mov     ds,si

+        or      seek_status, int_flag

+        mov     al,20h

+        out     20h,al

+        mov     ax,09101h

+        int     15h

+        pop si

+        pop     ax

+        pop     ds

+        iret

+disk_int        endp

+

+;-----------------------------------------------------------------------

+; results

+;       This routine will read anything that the nec controller has

+;       to say following an interrupt.

+; input:

+;       none

+; output:

+;       cy = 0  successful transfer

+;       cy = 1  failure -- time out in waiting for status

+;       nec_status area has status byte loaded into it

+;       (ah) destroyed

+;-----------------------------------------------------------------------

+

+results proc near

+        cld

+        mov     di,offset nec_status

+        push    cx

+        push    dx

+        push    bx

+        mov     bl,7

+

+;-----wait for request for master

+

+j38:

+        xor     cx,cx

+        mov     dx,03f4h

+j39:

+        in      al,dx

+        test    al,80h

+        jnz     j40a

+        loop    j39

+        or      diskette_status, time_out

+j40:

+        stc

+        pop     bx

+        pop     dx

+        pop     cx

+        ret

+

+;----- test the direction bit

+

+j40a:

+        in      al,dx

+        test    al,40h

+        jnz     j42

+j41:

+        or      diskette_status,bad_cntlr

+        jmp     j40

+

+;-----read in the status

+

+j42:

+        inc     dx

+        in      al,dx

+        mov     [di],al

+        inc     di

+        mov     cx,10

+j43:    loop    j43

+        dec     dx

+        in      al,dx

+        test    al,10h

+        jz      j44

+        dec     bl

+        jnz     j38

+        jmp     j41

+

+;----- result operation is done

+

+j44:

+        pop     bx

+        pop     dx

+        pop     cx

+        ret

+

+;-----------------------------------------------------------------------

+; num_trans

+;       This routine calculates the number of sectors that were

+;       actually transferred to/from the diskette

+; input

+;       (ch) = cylinder of operation

+;       (cl) = start sector of operation

+; output

+;       (al) = number actually transferred

+;       no other registers modified

+;-----------------------------------------------------------------------

+

+num_trans       proc near

+        mov     al,nec_status+3

+        cmp     al,ch

+        mov     al,nec_status+5

+        jz      j45

+        mov     bx,8

+        call    get_parm

+        mov     al,ah

+        inc     al

+j45:

+        sub     al,cl

+        ret

+num_trans       endp

+results         endp

+

+        assume ds:shard

+

+
\ No newline at end of file
diff --git a/system/shard-x86-at/7/src/FIXDISK.ASM b/system/shard-x86-at/7/src/FIXDISK.ASM
new file mode 100644
index 0000000..0b18fdd
--- /dev/null
+++ b/system/shard-x86-at/7/src/FIXDISK.ASM
@@ -0,0 +1,306 @@
+;************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==============*

+;*                                                                      *

+;*   Harddisk routinen                                                  *

+;*                                                                      *

+;************************************************************************

+

+     device fixdisk

+

+     dtcbroutines iocontrol

+          routine 5,fixed_size

+          routine -10,fixed_tracks

+          routine -11,fixed_sects

+          routine -12,fixed_heads

+          routine 1,devicetype

+          routine -1,unknowncontrol

+     dtcbroutines control32

+          routine -2,fixed_init

+          routine -100,fixed_size_set

+          routine -101,fixed_start_set

+          routine -102,fixed_landing_zone

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+          routine -1,fixed_read

+     dtcbroutines blockout

+          routine -1,fixed_write

+     dtcbparams nil_output,0ch     ;kein output, blockio device

+

+

+heads equ 4

+sects equ 17

+

+ if pcxt

+  if at

+   bitte nicht at und pcxt gleichzeitig

+  endif

+ endif

+

+ if pcd

+romhd equ 1

+ else

+ if at

+romhd equ 1

+ else

+romhd equ romharddisk

+  endif

+  endif

+

+fix_ccb macro kanal

+startccb hgccb&kanal,kanal

+ccbentry fix_size

+    dw 0

+    db 0

+ccbentry fix_firstblock

+    dw 0

+    db 0

+ccbentry fix_sects

+    db 0

+ccbentry fix_cylsize

+    dw 0

+    endm

+

+fixed_size_set:

+     mov [di+fix_size],dx

+     mov [di+fix_size+2],bl

+     ret

+ 

+fixed_start_set:

+     mov [di+fix_firstblock],dx

+     mov [di+fix_firstblock+2],bl

+     ret

+

+fixed_init:

+     mov ax,0801h                      ;return drive type

+     mov dl,80h                        ;drive 0

+     int 13h

+     mov al,cl                         ;anzahl sects holen

+     and al,3fh                        ;nur sector anzahl

+     mov [di+fix_sects],al             ;eintragen

+     inc dh                            ;anzahl koepfe (statt hoechste nummer)

+     mul dh                            ;sects pro cylinder

+     mov [di+fix_cylsize],ax           ;eintragen

+     mov dl,cl                         ;cylinder anzahl nach dx packen

+     shl dx,1

+     shl dx,1

+     and dh,3                          ;nur unterste zwei bits behalten

+     mov dl,ch                         ;rest cylindernummer holen

+     inc dx                            ;anzahl draus machen

+     mul dx                            ;anzahl bloecke ausrechnen

+     mov [di+fix_size],ax

+     mov [di+fix_size+2],dl

+     ret

+

+fixed_tracks:

+     call fix_drive

+     rol cl,1                          ;trackzahl in cx melden

+     rol cl,1

+     and cl,3                          ;nur zwei bits sind noch track

+     xchg cl,ch

+     inc cx                            ;meldet hoechste nummer, anzahl draus

+     ret

+

+fixed_sects:

+     call fix_drive

+     and cl,03fh                       ;nur sectorenzahl behalten

+     mov ch,0                          ;high byte 0

+     ret

+

+fixed_heads:

+     call fix_drive

+     mov cl,dh

+     mov ch,0

+     inc cx                            ;hoechsten head -> anzahl umrechnen

+     ret

+

+fix_drive:

+     mov ax,0801h                      ;return drive type

+     mov dl,80h                        ;drive 0

+     int 13h

+     ret

+

+fixed_landing_zone:

+     mov bx,0

+     call device_free              ;auf freigabe warten

+     call hardware                 ;pruefen, ob at

+     cmp al,IBMat

+     jz fixed_at_landing

+     call fix_drive

+     mov ax,0c01h                  ;seek

+     mov dl,80h                    ;immer auf erstem drive

+     inc ch                        ;auf naechste spur

+     ifz <add cl,40h>              ;hoeherwertigen bits auch zaehlen

+     int 13h

+     ret

+

+fixed_at_landing:

+     sub ax,ax

+     mov ds,ax

+     les bx,dword ptr ds:[(41h*4)]

+     mov ax,es:[bx+12]             ;landing zone

+     mov ch,al                     ;unterste byte der cylinder number

+     and ax,0300h                  ;obersten zwei bits

+     shr ax,1

+     shr ax,1

+     or al,1                       ;immer sector 1

+     mov cl,al

+     mov dx,80h                    ;drive und head 0

+     mov ax,0c01h                  ;seek

+     int 13h

+     ret                           ;device nicht wieder freigeben

+                                   ;aendern, wenn zwei laufwerke

+

+fix_highblock:

+     pop bx

+     jmp highblock

+

+fixed_write:

+    push bx

+ if romhd

+    mov bl,3

+ else

+    mov bl,0               ;auftrag schreiben nach bl

+ endif

+    jmp short fixed_rw

+fixed_read:

+     push bx

+  if romhd

+     mov bl,2              ;lesen nach bl

+  else

+     mov bl,1

+  endif

+fixed_rw:

+     cmp ch,0                 ;wirklich read oder write

+     ifnz <jmp unknowncontrol>

+     cmp cl,[di+fix_size+2]

+     ifz <cmp dx,[di+fix_size]> ;blocknummer zu hoch?

+     jnc fix_highblock

+     push bx

+     mov bx,0

+     call device_free

+

+     pop bx

+     mov ax,dx               ;blocknummer nach ax

+     add ax,[di+fix_firstblock] ;offset fuer ersten block dazu

+     adc cl,[di+fix_firstblock+2]

+     mov dx,cx                ;high byte muss nach dx

+

+     if at                    ;translate bad blocks if at

+; jetzt erstmal schlechte sectoren suchen

+     push es

+     push ds

+     pop es

+     push di

+     mov di,offset bb_table

+     cld

+     mov cx,[bb_anz]          ;anzahl schlechte sectoren

+fix_search_bb:

+     jcxz fix_no_translate

+     repnz scasw              ;sieh mal nach

+     jnz fix_no_translate

+     cmp dl,byte ptr [di+max_bb*2-2] ;obere byte ebenfalls pruefen

+     jnz fix_search_bb

+; schlechten sector gefunden

+     pop di

+     mov ax,[di+fix_firstblock]        ;direkt hinter letzten block

+     mov dl,[di+fix_firstblock+2]

+     add ax,[di+fix_size]

+     adc dl,[di+fix_size+2]

+     add ax,cx

+     adc dl,0

+     push di

+fix_no_translate:

+     pop di

+     pop es

+     endif

+

+     div word ptr (di+fix_cylsize)    ;dxax / sectoren pro zylinder

+                             ;der rest passt immer in 32 bit

+     mov ch,al               ;low byte tracknummer nach ch

+     ror ah,1

+     ror ah,1

+     mov cl,ah               ;high bits der cylindernummer nach cl 

+     mov ax,dx               ;rest nach ax

+     div byte ptr (di+fix_sects)

+

+     if at

+     mov dh,al                ;kopf nach dh

+     else

+; jetzt erstmal schlechte spuren suchen

+     or cl,al                 ;kopf zur spur dazu

+     push ax                  ;retten

+     mov ax,cx                ;zum suchen da rueber

+     push di

+     push es

+     push ds

+     pop es

+     mov di,offset bt_table

+     mov cx,8                 ;8 moegliche schlechte spuren

+     cld

+     repnz scasw              ;sieh mal nach

+     ifz <mov ax,word ptr [di+14]> ersatzwert holen

+     pop es

+     pop di

+     mov cx,ax                ;zurueckgeben

+     and cl,0c0h              ;nur cylinderbits behalten

+     and al,03fh              ;nur kopf bits

+     mov dh,al               ;head nach dh

+     pop ax

+     endif

+

+     mov dl,080h   ;drive nach dl

+     or cl,ah                ;sector nach cl reinbasteln

+     mov al,1                ;einen sector

+     mov ah,bl               ;auftrag nach ah

+     pop bx

+ if romhd

+     inc cl

+     push es

+     int 13h

+     pop es

+     jc diskerr

+ else

+     push bx

+     mov bx,0

+     call device_lock

+     pop bx

+     mov byte ptr [cmd_block+1],dh ;kopfnummer

+     mov byte ptr [cmd_block+2],cl ;cylinder + sect

+     mov byte ptr [cmd_block+3],ch ;cylinder

+     push es

+     call hard_dsk

+     pop es

+     xor bx,bx     ;device 0 freigeben

+     call device_unlock

+     mov ah,byte ptr [disk_status]  ;haben wir fehler

+     or ah,ah

+     jnz diskerr

+ endif

+     mov byte ptr fix_err,0       ;ein aufruf war ohne fehler

+     mov cx,0

+     ret

+

+diskerr:

+  inc byte ptr fix_err

+  cmp byte ptr fix_err,4 ;schon viermal hintereinander fehler

+  jnz fix_blockerr

+  mov byte ptr fix_err,0

+  push ax

+  mov ah,13               ;nur harddisk zuruecksetzen

+  mov dl,80h    ;disk reset

+  int 13h

+  pop ax

+fix_blockerr:

+  jmp blockerr

+

+fixed_size:

+        mov al,[di+fix_size+2]

+        mov cx,[di+fix_size]

+        ret

+

+fix_err db 0

+

+

+   ife romhd

+     include HDISK.ASM

+   endif

diff --git a/system/shard-x86-at/7/src/FLOPPY.ASM b/system/shard-x86-at/7/src/FLOPPY.ASM
new file mode 100644
index 0000000..07145ce
--- /dev/null
+++ b/system/shard-x86-at/7/src/FLOPPY.ASM
@@ -0,0 +1,453 @@
+;************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==============*

+;*                                                                      *

+;*   Floppydisk archiv routinen                                         *

+;*                                                                      *

+;************************************************************************

+

+     device archive

+

+     dtcbroutines iocontrol

+          routine 5,archive_size

+          routine 1,devicetype

+          routine 7,archive_format

+          routine -1,unknowncontrol

+     dtcbroutines control32

+     ife pcd

+          routine -2,archive_init

+     endif

+          routine -173,set173size

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+          routine 0,archive_read

+     dtcbroutines blockout

+          routine 0,archive_write

+          routine -1,unknowncontrol

+     if pcd

+     dtcbparams nil_output,0ch     ;kein output, blockio device

+     else

+     dtcbparams nil_output,1ch     ;kein output, blockio device, format erlaubt

+     endif

+

+IBM equ 0

+OLI equ 1

+IBM_BIG equ 2

+IBMsize equ 360*2

+OLIsize equ 400*2

+IBM_BIGsize equ 15*80*2

+

+if pcd

+romfd equ 1

+ else

+ if at

+romfd equ 1

+ else

+romfd equ romfloppy

+  endif

+  endif 

+

+floppyio macro

+     if romfd

+       if withhd

+        int 40h

+       else

+        int 13h                 ;disketten routine aufrufen

+       endif

+     else

+       call diskette_io

+     endif

+ endm

+

+archive_ccb macro drive,drive_type

+     startccb archive_&drive,0 ;kanalnummer ist uninterressant

+ccbentry arch_typ

+     db IBM                   ;standardmaessig IBM annehmen

+ccbentry arch_size

+     dw 0

+ccbentry arch_drive

+     db drive

+ccbentry arch_drive_type

+     db drive_type

+ccbentry arch_default_format

+     if drive_type eq highdensity

+       db 3

+     else

+      if drive_type eq drive720

+       db 2

+      else

+       db 1

+      endif

+     endif

+     endm

+

+highdensity equ 1             ;bit 0 ist highdensity bit

+with_boot_on_it equ 2 	      ;bit 1 sagt, dass boot auf der floppy ist (fuer hg)

+drive720 equ 4                ;bit 2 sagt, dass 80 track double density

+eighty_tracks equ 8           ;bit 3 sagt, wir formatieren gerade 80 spuren

+no_floppy equ 16              ;bit 4 sagt, hier ist kein laufwerk

+

+diskvector equ 01eh*4

+diskinterrupt equ 0eh*4

+

+archive_init:

+     mov ax,0

+     mov es,ax                ;auf int vektoren zeigen

+     mov word ptr es:[diskvector],offset nineblockvector

+     mov word ptr es:[diskvector+2],cs

+   ife romfd                  ;wenn nicht at

+     mov word ptr es:[diskinterrupt],offset disk_int

+     mov word ptr es:[diskinterrupt+2],cs

+   endif

+     ret

+

+oliinout:

+  mov ax,dx               ;blocknummer nach ax

+  mov dl,20               ;20 sectoren pro cylinder

+  div dl                  ;ax/dl

+  mov ch,al               ;track nach ch

+  mov al,ah               ;rest nach al

+  mov ah,0                ;obere haelfte loeschen

+  mov dl,10               ;10 sects pro spur

+  div dl

+  mov dh,al               ;head nach dh

+  mov dl,(di+arch_drive)  ;drive nach dl

+  mov cl,ah               ;sector nach cl

+  inc cl                  ;beginnt mit eins

+  mov al,1                ;einen sector

+  mov ah,bl               ;auftrag nach ah

+  pop bx

+  push es

+  floppyio

+  pop es

+  jc archive_diskerr

+  mov cx,0

+  ret

+

+

+archive_write:

+ push bx

+ mov bl,3               ;auftrag schreiben nach bl

+ jmp short archive_rw

+

+archive_read:

+  push bx

+  mov bl,2              ;lesen nach bl

+

+archive_rw:

+  push bx

+  mov bx,1                    ;floppy ist device 1

+  call device_free            ;warten, bis frei

+  pop bx

+  test byte ptr (di+arch_drive_type),with_boot_on_it ;ist der boot mit drauf

+  ifnz <add dx,boot_size>

+  jc archive_highblock

+  cmp dx,word ptr (di+arch_size) ;blocknummer zu hoch

+  jnc archive_highblock

+  cmp byte ptr (di+arch_typ),OLI       ;haben wir ein olivetti archiv

+  jz oliinout

+  mov ax,dx

+  mov dh,0              ;erste seite annehmen

+  mov cx,(di+arch_size)       ;gesamtgroesse

+  shr cx,1                    ;halbieren

+  cmp ax,cx            ;schon zweite seite

+  jc notsecond

+  mov dh,1              ;zweiten kopf

+  sub ax,cx 

+notsecond:

+  mov dl,9

+  cmp byte ptr (di+arch_typ),IBM_BIG

+  ifz <mov dl,15>        ;15 sectoren pro spur

+  div dl                  ;9 sectoren pro spur

+  mov ch,al               ;track nach ch

+  mov dl,(di+arch_drive)  ;drive nach dl

+  mov cl,ah               ;sector nach cl

+  inc cl                  ;beginnt mit eins

+  mov al,1                ;einen sector

+  mov ah,bl               ;auftrag nach ah

+  pop bx

+  push es

+  floppyio

+  pop es

+  jc archive_diskerr

+  mov cx,0

+  ret

+

+archive_diskerr:

+   push ax

+   mov ah,0

+   floppyio                   ;reset disk system

+   pop ax

+  jmp blockerr

+archive_highblock:

+     pop bx

+     jmp highblock

+

+set173size:

+     cmp word ptr [hgver],1742

+     ifz <mov word ptr (di+arch_size),IBMsize>

+     ret

+

+;************************************************************************

+;* archive_size liefert die groesse einer aktuell eingelegten floppy

+;*

+;* und zwar wird unterschieden zwischen IBM-Format (9 Sectoren pro Spur)

+;* und Olivetti (M20) Format mit 10 Sectoren pro Spur sowie IBM Format mit

+;* 15 Sectoren pro Spur

+archive_size:

+     mov bx,1              ;floppy ist device 1

+     call device_free

+     mov word ptr (di+arch_size),0  ;annehmen, dass keine floppy da

+; falls noch version 1.7.3, dann in diesem Fall 360K annehmen

+     cmp word ptr [hgver],1742

+     ifz <mov word ptr (di+arch_size),IBMsize>

+    if pcd

+     and byte ptr (di+arch_drive),0ffh-20h ;96 tpi ausschalten

+    endif

+

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,1        ;track 0, sector 1 

+     mov ax,0401h    ;verify, ein sector

+     floppyio        ;ist ueberhaupt ne floppy da

+     jnc arch_det_size

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,1        ;track 0, sector 1 

+     mov ax,0401h    ;verify, ein sector

+     floppyio        ;ist ueberhaupt ne floppy da

+     jc arch_size_end ;fertig

+arch_det_size:

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,14       ;track 0, sector 14

+     mov ax,0401h    ;verify, ein sector

+     floppyio

+     mov byte ptr (di+arch_typ),IBM_BIG

+     mov word ptr (di+arch_size),IBM_BIGsize

+     jnc arch_size_end ;wir sind fertig

+

+     mov dl,(di+arch_drive) ;drive nummer holen

+     mov dh,0        ;head 0

+     mov cx,10       ;track 0, sector 10

+     mov ax,0401h    ;verify, ein sector

+     floppyio

+     mov byte ptr (di+arch_typ),OLI

+     mov word ptr (di+arch_size),OLIsize

+     jnc arch_is_oli

+     mov byte ptr (di+arch_typ),IBM ;konnten nicht finden, dann IBM Format 

+     mov word ptr (di+arch_size),IBMsize

+arch_is_oli:

+     mov dl,(di+arch_drive) ;drive nummer holen

+  if pcd

+     or dl,20h             ;96 tpi floppy?

+  endif

+     test byte ptr (di+arch_drive_type),highdensity ;high density laufwerk

+     jnz arch_test_720k

+  ife limited_to_360

+     mov dh,0        ;head 0

+     mov cx,2901h      ;track 41, sector 1

+     mov ax,0401h    ;verify, ein sector

+     floppyio

+     jc arch_size_end

+     mov bx,word ptr (di+arch_size)

+     add bx,bx             ;doppelte kapazitaet

+     mov word ptr (di+arch_size),bx

+    if pcd

+     or byte ptr (di+arch_drive),20h  ;96 tpi einstellen

+    endif

+    endif

+arch_size_end:

+     mov al,0

+     mov cx,word ptr (di+arch_size)

+     test byte ptr (di+arch_drive_type),with_boot_on_it ;ist der boot mit drauf

+     ifnz <sub cx,boot_size>

+     ret

+

+arch_test_720k:

+     mov dh,0  ;head 0

+     mov cx,0201h   ;spur 2, sector 1

+     mov ax,0401h

+     floppyio

+     mov al,0       ;annehmen, muss nicht gewechselt werden

+     jnc arch_skip_flip  ;erkannt, groesse setzen

+     mov dl,(di+arch_drive)

+     mov dh,0  ;zurueck auf spur 0

+     mov cx,1       ;spur 0, sector 1

+     mov ax,0401h

+     floppyio

+     mov al,20h     ;muss gewechselt werden

+arch_skip_flip:

+     mov bx,40h     ;auf datensegment gehen

+     mov es,bx

+     mov bx,90h

+     add bl,byte ptr (di+arch_drive)

+     xor byte ptr es:[bx],al            ;ggf. flag flippen

+     test byte ptr es:[bx],20h		;wenn double step stimmt groesse

+     jnz arch_size_end

+     mov bx,word ptr (di+arch_size)

+     add bx,bx             ;doppelte kapazitaet

+     mov word ptr (di+arch_size),bx

+     jmp arch_size_end

+

+

+arch_form_unallowed:

+     mov cx,3

+     ret

+

+;*********************************************************************

+; formatieren einer floppy mit 9 oder 15 sects pro spur

+archive_format:

+     mov bx,1                 ;floppy ist device 1

+     call device_free

+     and byte ptr (di+arch_drive_type),0ffh-eighty_tracks

+     cmp dx,0

+     ifz <mov dl,byte ptr (di+arch_default_format)>

+     cmp dx,1

+     jz arch_form_1

+     or byte ptr (di+arch_drive_type),eighty_tracks

+     cmp dx,2

+     jz arch_form_2

+     cmp dx,3

+     jnz arch_form_unallowed

+;format 3

+     test byte ptr (di+arch_drive_type),highdensity ;high density laufwerk 

+     jz arch_form_unallowed   ;nur bei highdensity geht 3

+     mov ax,1703h             ;1.2M in 1.2M laufwerk

+     mov dl,(di+arch_drive)

+     floppyio

+     mov dx,offset fifteenblockvector

+     mov bx,offset archive_format_buffer15

+     jmp short arch_form_go

+

+;format 2

+arch_form_2:

+     test byte ptr (di+arch_drive_type),drive720+highdensity ;kann es 720k

+     jz arch_form_unallowed     ;weder highdensity noch 720k, da geht nur 1

+     test byte ptr (di+arch_drive_type),highdensity

+     jz arch_form_1           ;wie 1, 80 track bit steht schon

+     mov ax,1702h             ;low density in high density drive

+     mov dl,(di+arch_drive)

+     floppyio

+     mov bx,40h     ;auf datensegment gehen

+     mov es,bx

+     mov bx,90h                    ;zur state variablen

+     add bl,byte ptr (di+arch_drive)

+     and byte ptr es:[bx],0ffh-20h      ;double step flag loeschen

+     jmp short arch_form_low_density

+

+;format 1

+arch_form_1:

+     mov ax,1701h             ;normal drive

+     mov dl,(di+arch_drive)

+     floppyio

+     test byte ptr (di+arch_drive_type),highdensity 

+     jz arch_form_low_density ;kein highdensity laufwerk, einstellung bleibt

+     mov ax,1702h             ;low density in high density drive

+     mov dl,(di+arch_drive)

+     floppyio

+     

+arch_form_low_density:

+     mov dx,offset nineblockvector

+     mov bx,offset archive_format_buffer

+arch_form_go:

+     push es

+     mov ax,0

+     mov es,ax                ;auf int vektoren zeigen

+     mov word ptr es:[diskvector],dx

+     mov word ptr es:[diskvector+2],cs

+     pop es

+     mov dl,(di+arch_drive)                  ;drive nummer holen

+     mov ch,0                                ;bei track 0 anfangen

+archive_form_track_loop:

+     mov dh,0

+archive_form_head_loop:

+     push cs

+     pop es         ;buffer liegt in cs

+     mov al,15

+     mov bp,bx      ;wir muessen was eintragen

+arch_track_set_loop:

+     mov byte ptr cs:[bp],ch       ;track

+     inc bp

+     mov byte ptr cs:[bp],dh       ;head

+     inc bp

+     inc bp

+     inc bp

+     dec al

+     jnz arch_track_set_loop

+     mov ax,0501h                  ;format

+     floppyio

+     jnc arch_form_cont

+     mov cx,2                 ;fehler melden

+     ret

+arch_form_cont:

+  if romfd

+     push bx

+     push cx

+     push dx

+     push di

+     push si

+     call warte

+     call warte

+     pop si

+     pop di

+     pop dx

+     pop cx

+     pop bx

+   endif

+     inc dh         ;naechste kopf

+     cmp dh,2       ;fertig

+     jnz archive_form_head_loop

+     inc ch         ;naechste track

+     cmp ch,40

+     jc archive_form_track_loop

+     test byte ptr (di+arch_drive_type),eighty_tracks ;80 spuren ?

+     jz arch_form_end

+     cmp ch,80

+     jnz archive_form_track_loop

+arch_form_end:

+     mov cx,0       ;ok

+     ret

+

+archive_format_buffer:

+     irp x,<1,6,2,7,3,8,4,9,5,10>

+     db 0,0,x,2          ;;track und head wird per programm eingetragen

+     endm

+;;achtung: hier nichts einfuegen, da beim initialisieren vom ersten buffer

+;;auch ein teil vom zweiten initialisiert wird

+archive_format_buffer15:

+     irp x,<1,9,2,10,3,11,4,12,5,13,6,14,7,15,8>

+     db 0,0,x,2          ;;track und head wird per programm eingetragen

+     endm

+

+nineblockvector:

+     db 11011111b                ;step rate und hut

+     db 2                        ;hd load = 1

+     db 37                       ;let motor run 37 seconds

+     db 2                        ;512 byte per sector

+     db 9                        ;last sector is 9

+     db 42                       ;gap length

+     db 0ffh                     ;dtl

+     db 80                       ;gap length format

+     db 0f6h                     ;fill byte fuer format

+     db 15                       ;head settle time

+     db 2                        ;motor start time

+

+fifteenblockvector:

+     db 11011111b                ;step rate und hut

+     db 2                        ;hd load = 1

+     db 37                       ;let motor run 37 seconds

+     db 2                        ;512 byte per sector

+     db 15                       ;last sector is 15

+     db 01bh                     ;gap length

+     db 0ffh                     ;dtl

+     db 054h                     ;gap length format

+     db 0f6h                     ;fill byte fuer format

+     db 15                       ;head settle time

+     db 8                        ;motor start time (1/8 sekunden)

+

+

+ ife romfd

+     include FDISK.ASM

+ endif

+

+

diff --git a/system/shard-x86-at/7/src/FSHARD.ASM b/system/shard-x86-at/7/src/FSHARD.ASM
new file mode 100644
index 0000000..83c0c21
--- /dev/null
+++ b/system/shard-x86-at/7/src/FSHARD.ASM
@@ -0,0 +1,225 @@
+  page 80,132

+;******************************************************************************

+;*                                                                            *

+;*       S H A R D   -   M O D U L                                            *

+;*                                                                            *

+;*       fuer EUMEL auf 8086/8088 Systemen                                    *

+;*                                                                            *

+;*       SHard Version 6-PC/Floppy                                            *

+;*                                                                            *

+;*       Copyright (C) Martin Schoenbeck, Spenge                              *

+;*                                                                            *

+;******************************************************************************

+

+com2wrongirq equ 0

+add4 equ 0

+ast equ 0

+

+at equ 0 

+pcxt equ 1

+pcd equ 0

+romfloppy equ 0

+ramsys equ 0

+limited_to_360 equ 0

+mit_msdos equ 0

+withhd equ 0

+hdsystem equ 0

+boot_size equ 0

+gensys equ 0

+

+shard group code

+code segment word public 'code'

+ assume cs:shard, ds:shard, es:nothing, ss:nothing

+     org 100h

+shstart:

+     jmp los_gehts

+

+     include MACROS.ASM

+     include MAC286.ASM

+     include DEVICE.ASM

+     include EUCONECT.ASM

+     include SHMAIN.ASM

+

+IBMat equ 0fch

+com1base equ 03f8h

+com1irq  equ 4

+com2base equ 02f8h

+ if com2wrongirq

+   com2irq equ 5

+ else

+   com2irq  equ 3

+ endif

+ if add4

+com4_1base equ 03e8h

+com4_1irq  equ 3

+com4_2base equ 03e0h

+com4_2irq  equ 3

+com4_3base equ 02f0h

+com4_3irq  equ 3

+com4_4base equ 02e8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 0260h

+com8_2irq  equ 3

+com8_3base equ 02d8h

+com8_3irq  equ 3

+ else

+com4_1base equ 02c0h

+com4_1irq  equ 3

+com4_2base equ 02c8h

+com4_2irq  equ 3

+com4_3base equ 02d0h

+com4_3irq  equ 3

+com4_4base equ 02d8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 02e8h

+com8_2irq  equ 3

+com8_3base equ 02f0h

+com8_3irq  equ 3

+com8_4base equ 02f8h

+com8_4irq  equ 3

+add4_3base equ 03e8h

+add4_3irq  equ 3

+add4_4base equ 03e0h

+add4_4irq  equ 3

+add4_8base equ 0260h

+add4_8irq  equ 3

+ endif

+ast0_1base equ 01a0h

+ast0_1irq  equ 5

+ast0_2base equ 01a8h

+ast0_2irq  equ 5

+ast0_3base equ 01b0h

+ast0_3irq  equ 5

+ast0_4base equ 01b8h

+ast0_4irq  equ 5

+ast1_1base equ 02a0h

+ast1_1irq  equ 5

+ast1_2base equ 02a8h

+ast1_2irq  equ 5

+ast1_3base equ 02b0h

+ast1_3irq  equ 5

+ast1_4base equ 02b8h

+ast1_4irq  equ 5

+

+

+int_ctlr equ 20h

+first_ictlr_int equ 8

+ 

+channel macro number,dev,ccb

+channels = channels+1

+selectentry = 5

+     db number

+     dw offset ccb

+     if2

+     dwb paramstart_,%&dev

+     else

+     dw 0                ;;weil in pass eins device evtl. unbekannt

+     endif 

+     endm

+

+selecttable:

+     db channels       ;anzahl kanaele hier setzen

+channels = -1         ;nilchannel vorab abziehen

+     channel 32,shardchannel,0

+   if at

+     channel 0,archive,archive_0

+   else

+     channel 0,archive,archive_1

+   endif

+alterable_channels:

+     channel 1,pc,0 

+     channel 2,i8250,com1ccb

+     channel 3,i8250,com2ccb

+    if ast

+     channel 4,i8250,ast0_1ccb

+     channel 5,i8250,ast0_2ccb

+     channel 6,i8250,ast0_3ccb

+     channel 7,i8250,ast0_4ccb

+     channel 8,i8250,ast1_1ccb

+     channel 9,i8250,ast1_2ccb

+     channel 10,i8250,ast1_3ccb

+     channel 11,i8250,ast1_4ccb

+    else

+     channel 4,i8250,com4_1ccb

+     channel 5,i8250,com4_2ccb

+     channel 6,i8250,com4_3ccb

+     channel 7,i8250,com4_4ccb

+     channel 8,i8250,com8_1ccb

+     channel 9,i8250,com8_2ccb

+     channel 10,i8250,com8_3ccb

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     channel 11,i8250,add4_3ccb

+     channel 12,i8250,add4_4ccb

+     channel 13,i8250,add4_8ccb

+     endif

+    endif

+     channel 15,parallel,para0ccb

+     channel 14,parallel,para1ccb

+     channel 16,parallel,para2ccb

+   if at and not ramsys

+     channel 31,archive,archive_1

+   else

+     channel 31,archive,archive_0

+   endif

+     channel -1,nilchannel,0

+ 

+

+     include I8250.ASM

+     include PCPAR.ASM

+     include STREAM.ASM

+     include NILCHAN.ASM

+     include PCSCREEN.ASM

+     include PCPLOT.ASM

+     include PCSYS.ASM

+;    include FIXDISK.ASM

+     include FLOPPY.ASM

+     include CLOCK.ASM

+     include WAIT.ASM

+     include HARDWARE.ASM

+     include BLOCKERR.ASM

+ 

+     i8250_ccb com1,2

+     i8250_ccb com2,3

+    if ast

+     i8250_ccb ast0_1,4

+     i8250_ccb ast0_2,5

+     i8250_ccb ast0_3,6

+     i8250_ccb ast0_4,7

+     i8250_ccb ast1_1,8

+     i8250_ccb ast1_2,9

+     i8250_ccb ast1_3,10

+     i8250_ccb ast1_4,11

+    else

+     i8250_ccb com4_1,4

+     i8250_ccb com4_2,5

+     i8250_ccb com4_3,6

+     i8250_ccb com4_4,7

+     i8250_ccb com8_1,8

+     i8250_ccb com8_2,9

+     i8250_ccb com8_3,10

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     i8250_ccb add4_3,11

+     i8250_ccb add4_4,12

+     i8250_ccb add4_8,13

+     endif

+    endif

+     para_ccb 0,15

+     para_ccb 1,14

+     para_ccb 2,16

+     archive_ccb 0,0

+     archive_ccb 1,0

+sysmove:

+     rep movsw

+     jmp systemstart

+

+     include BOOT.ASM

+

+code ends

+

+     end los_gehts

+

+

diff --git a/system/shard-x86-at/7/src/HARDWARE.ASM b/system/shard-x86-at/7/src/HARDWARE.ASM
new file mode 100644
index 0000000..88b66dd
--- /dev/null
+++ b/system/shard-x86-at/7/src/HARDWARE.ASM
@@ -0,0 +1,16 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Lesen des Hardware Kennzeichen-Bytes                                   *

+;*                                                                          *

+;****************************************************************************

+

+hardware:

+     push es

+     mov ax,0ffffh

+     mov es,ax

+     mov al,byte ptr es:14          ;hardware byte holen

+     pop es

+     ret

+

+

diff --git a/system/shard-x86-at/7/src/HDISK.ASM b/system/shard-x86-at/7/src/HDISK.ASM
new file mode 100644
index 0000000..67044d4
--- /dev/null
+++ b/system/shard-x86-at/7/src/HDISK.ASM
@@ -0,0 +1,482 @@
+;shard  segment

+;       assume cs: shard

+;       assume ds: shard, es:nothing, ss:nothing

+

+;================================================================

+;       modul hdisk.asm

+;       hard - disk - treiber

+;

+;  Status:

+;       0.0     13.11.84        erste Testversion

+;================================================================

+

+TIMEOUT1        equ     20h             ; warten auf Disk-Interrupt

+                                        ; (20.0000h  Tests)

+

+;-------------------------------------------------------;

+;       Fehlercodes

+;       Bem: 11h ist eigentlich  k e i n  Fehler !

+;-------------------------------------------------------;

+

+;sense_fail      equ     0ffh            ; sense operation

+;undef_err       equ     0bbf            ; undefined error occurred

+;time_out        equ     80h             ; attachment failed to respond

+;bad_seek        equ     40h             ; seek operation failed

+;bad_cntlr       equ     20h             ; controller has failed

+;data_corrected  equ     11h             ; ecc corrected data error

+;bad_ecc         equ     10h             ; bad ecc on disk read

+;bad_track       equ     0bh             ; bad track flag detected

+;dma_boundary    equ     9               ; attempt to dma across 64k

+;init_fail       equ     7               ; drive parameter activity failed

+;bad_reset       equ     5               ; reset failed

+;record_not_fnd  equ     4               ; requested sector not found

+;bad_addr_mark   equ     2               ; address mark not found

+;bad_cmd         equ     1               ; bad command passed to disk i/o

+

+;-------------------------------------------------------;

+;       interrrupt and status area                      ;

+;-------------------------------------------------------;

+

+dummy           segment at 0

+

+                org 0dh *4

+hdisk_int       label dword

+                

+                org 13h * 4

+org_vector      label dword

+                org 19h *4

+hf_tbl_vec      label dword

+dummy           ends

+

+;-----------------------------------------------------------------------;

+;       cmd_block

+;

+;  +0   Kommando

+;  +1   Kopfnummer                              Aufrufparameter 1

+;  +2   2-Bit Zylinder  & Rest Sektor           Aufrufparameter 2

+;  +3   Zylinder                                Aufrufparameter 3

+;  +4   Block - Count   (ist immer 1 )

+;  +5   Control-Byte (Step - Option)

+;-----------------------------------------------------------------------;

+

+cmd_block       label byte

+hd_error        db 7 dup(?)

+disk_status     db ?

+

+;-------------------------------------------------------;

+;       hardware specific values                        ;

+;                                                       ;

+; - Controller i/o port                                 ;

+;   > when ready from:                                  ;

+;       hf_port+0 - read data (from controller to cpu   ;

+;       hf_port+1 - read controller hardware status     ;

+;               (controller to cpu)                     ;

+;       hf_port+2 - read configuration switches         ;

+;       hf_port+3 - not used                            ;

+;  < when written to:                                   ;

+;       hf_port+0 - write data (from cpu to controller) ;

+;       hf_port+1 - controller reset                    ;

+;       hf_port+2 - generate controller select pulse    ;

+;       hf_port+3 - write pattern to dma and interrupt  ;

+;                   mask register                       ;

+;-------------------------------------------------------;

+

+hf_port         equ     320h            ; disk port

+r1_busy         equ     00001000b       ; disk port 1 busy bit

+r1_bus          equ     00000100b       ;       command/data bit

+r1_iomode       equ     00000010b       ;       mode bit

+r1_req          equ     00000001b       ;       request bit

+

+dma_read        equ     01000111b       ; channel 3 (47h)

+dma_write       equ     01001011b       ; channel 3 (4bh)

+dma             equ     0               ; dma address

+dma_high        equ     82h             ; port for high 4 bits of dma

+

+tst_rdy_cmd     equ     0               ; cntrl ready (00h)

+recal_cmd       equ     00000001b       ;       recal (01h)

+sense_cmd       equ     00000011b       ;       sense (03h)

+fmtdrv_cmd      equ     00000100b       ;       drive (04h)

+chk_trk_cmd     equ     00000101b       ;       t chk (05h)

+fmttrk_cmd      equ     00000110b       ;       track (06h)

+fmtbad_cmd      equ     00000111b       ;       bad   (07h)

+read_cmd        equ     00001000b       ;       read  (08h)

+write_cmd       equ     00001010b       ;       write (0ah)

+seek_cmd        equ     00001011b       ;       seek  (0bh)

+init_drv_cmd    equ     00001100b       ;       init  (0ch)

+rd_ecc_cmd      equ     00001101b       ;       burst (00h)

+rd_buff_cmd     equ     00001110b       ;       buffr (0eh)

+wr_buff_cmd     equ     00001111b       ;       buffr (0fh)

+ram_diag_cmd    equ     11100000b       ;       ram   (e0h)

+chk_drv_cmd     equ     11100011b       ;       drv   (e3h)

+cntrl_diag_cmd  equ     11100100b       ;       cntlr (e4h)

+rd_long_cmd     equ     11100101b       ;       rlong (e5h)

+wr_long_cmd     equ     11100110b       ;       wlong (e6h)

+

+int_ctl_port    equ     20h             ; 8259 control port

+eoi             equ     20h             ; end of interrupt command

+

+        page

+

+;===============================================================;

+;       MAIN - Routine

+; Input:

+;       ah      -       0 write disk

+;               -       1 read disk

+;       (es:bx) -       Datenadresse

+;       cmd_block

+; Output:

+;       disk_status     0 - alles OK

+;===============================================================;

+

+hard_dsk        proc

+;       mov     ax,0                    ; interrupt initiieren

+;       mov     es,ax

+;       mov     word ptr es:[hdisk_int+2],cs

+;       mov     word ptr es:[hdisk_int],offset hd_int

+

+        sti                             ; enable interrupts

+        mov     disk_status,0           ; noch alles ok !

+        mov     cmd_block+5,5           ; 70 ysec steprate

+        cmp     ah,0                    ; ah = 0  --> write disk

+        jz      a4                      ; ah <> 0 --> read disk

+        call    disk_read

+        jmp     short   dsbl

+a4:     call    disk_write

+

+;-------------------------------------------------------;

+;       dsbl

+;       make shure that all housekeeping is done

+;       before exit

+;-------------------------------------------------------;

+

+dsbl:

+        mov     dx,hf_port+3

+        sub     al,al

+        out     dx,al                   ; reset int/dma mask

+        mov     al,7

+        out     dma+10,al               ; set dma - mode to disable

+        cli                             ; disable interrupts

+        in      al,21h

+        or      al,20h

+        out     21h,al                  ; disable interrupt 5

+        sti                             ; enable interrupts

+        ret

+

+hard_dsk        endp

+

+;========================================================

+;       disk read routine

+; Input:

+;       (es:bx) -       Datenadresse

+;       cmd_block

+;========================================================

+

+disk_read       proc    near

+        mov     al,dma_read             ; mode byte for dma read

+        mov     cmd_block+0,read_cmd

+        jmp     do_io

+disk_read       endp

+

+;========================================================

+;       disk write routine

+; Input:

+;       (es:bx) -       Datenadresse

+;       cmd_block

+;========================================================

+

+disk_write      proc    near

+        mov     al,dma_write            ; mode byte for dma write

+        mov     cmd_block+0, write_cmd

+        jmp     do_io

+disk_write      endp

+        page

+;========================================================

+;       do_io

+;       gemeinsame Routine fuer alle Kommandos

+; Input:

+;       (es:bx) -       Datenadresse

+;       al      -       mode (dma_read/dma_write)

+;       cmd_block

+;========================================================

+

+do_io   proc near

+

+        mov     cmd_block+4,1           ; Blockzahl immer 1

+

+;-------------------------------------------------------;

+;       DMA_SETUP

+;       diese Routine dressiert den DMA

+;-------------------------------------------------------;

+

+        cli                             ; keine Interrupts mehr

+        out     dma+12,al               ; first/last ff setzen

+        push    ax                      ; warten ?

+        pop     ax

+        out     dma+11,al               ; mode setzen

+

+;-----phys. Adresse zum DMA ausgeben:

+

+        mov     ax,es

+        mov     cl,4

+        rol     ax,cl                   ; h - nibble von es nach al

+        mov     ch,al

+        and     al,0f0h

+        add     ax,bx

+        jnc     j33

+        inc     ch                      ; Uebertrag notieren

+j33:    out     dma+6,al                ; a0 - a7 ausgeben

+        push    ax                      ; fuer Ueberlauftest merken

+        mov     al,ah

+        out     dma+6,al                ; a8 - a15 ausgeben

+        mov     al,ch

+        and     al,0fh

+        out     dma_high,al             ; a16 - a19 ausgeben

+

+;-----Blocklaenge zum DMA ausgeben:

+

+        mov     ax,511                  ; Blocklaenge

+        out     dma+7,al                ; Blocklaenge ausgeben

+        mov     al,ah

+        out     dma+7,al

+        sti                             ; Interrupts scharfmachen

+        pop     ax

+        add     ax,511                  ; 64k Overflow testen

+        jnc     gx                      ; wenn kein Overflow

+        mov     disk_status, dma_boundary

+        ret

+

+gx:     call command

+        jc      error_chk               ; wenn was schiefgelaufen ist

+

+        mov     al,3                    ; controller dma/interrupt register mask

+        out     dma+10,al               ; initialize the disk channel

+g3:

+        in      al,21h

+        and     al,0dfh

+        out     21h,al

+

+;-------------------------------------------------------;

+;       wait_int

+;       this routine waits for the fixed disk

+;       controller to signal, that an interrupt

+;       has occured

+;-------------------------------------------------------;

+

+        sti                             ; muss das nochmal sein ???

+        push    es

+        push    si

+

+;----- set timeout values

+        sub     bh,bh

+        mov     bl,TIMEOUT1             ; timout Zaehler setzen (high word)

+        sub     cx,cx

+

+;----- wait for interrupt

+w1:

+        push    ds

+        push    bx

+        push    cx

+        call    cs:warte                   ; nicht dumm rumloopen, sondern

+        pop     cx                      ;    arbeiten !!

+        pop     bx

+        pop     ds

+

+        mov     dx,hf_port+1

+        in      al,dx

+        and     al,20h

+        cmp     al,20h

+        jz      w2

+        loop    w1

+        dec     bx

+        jnz     w1

+        mov     disk_status,time_out

+

+w2:     mov     dx, hf_port

+        in      al,dx

+        and     al,2

+        or      disk_status,al          ; Fehler merken

+        mov     dx,hf_port+3

+        xor     al,al

+        out     dx,al

+        pop     si

+        pop     es

+

+;-----------------------------------------------;

+;       error_chk                               ;

+;-----------------------------------------------;

+

+error_chk:

+        ret                             ; zunaechst keine Fehler- Auswertung

+        mov     al,disk_status

+        or      al,al

+        jnz     g21

+        ret

+

+;-----perform sense status

+

+g21:    mov     ax, shard

+        mov     es,ax

+        sub     ax,ax

+        mov     di,ax

+        mov     cmd_block+0, sense_cmd

+        sub     al,al

+        call    command

+        jc      sense_abort

+        mov     cx,4

+g22:

+        call    hd_wait_req

+        jc      g24

+        mov     dx,hf_port

+        in      al,dx

+        mov     hd_error[di],al

+        inc     di

+        mov     dx,hf_port+1

+        loop    g22

+        call    hd_wait_req

+        jc      g24

+        mov     dx,hf_port

+        in      al,dx

+        test    al,2

+        jz      stat_err

+sense_abort:

+        mov     disk_status, sense_fail

+g24:

+        stc

+        ret

+do_io   endp

+

+;========================================================

+;       command

+;       erklaert dem controller, was zu tun ist

+;   input

+;       cmd_block

+;========================================================

+

+command proc    near

+

+        mov     dx,hf_port+2

+        out     dx,al                   ; controller select pulse ausgeben

+        mov     dx,hf_port+3

+        mov     al,3            ; controller dma/interrupt register mask

+        out     dx,al                   ; DMA und Interrupt-Maske setzen

+

+; eigentlich ist es nicht normal, wenn der Controller an dieser

+; Stelle beschaeftigt ist, aber wer weiss ...

+

+        sub     cx,cx                   ; timeout - Zaehler setzen

+        mov     dx,hf_port+1

+wait_busy:

+        in      al,dx                   ; status lesen

+        and     al,0fh

+        cmp     al,r1_busy or r1_bus or r1_req

+        je      weiter_gehts            ; weiter, wenn controller frei

+        loop    wait_busy               ; warten...

+        mov     disk_status, time_out   ; is nix

+        stc

+        ret

+

+weiter_gehts:

+        cld                             ; clear direction flag

+        mov     cx,6                    ; Blocklaenge fuer move

+        mov     si, offset cmd_block

+

+cm3:    mov     dx,hf_port              ; Command-Block ausgeben

+        lodsb                           ; 

+        out     dx,al

+        loop    cm3

+

+        inc     dx                      ; weiter nach hf_port+1

+        in      al,dx                   ; status lesen

+        test    al,r1_req

+        jz      cm7                     ; wenn alles ok

+        mov     disk_status, bad_cntlr  ; war nix

+        stc

+cm7:

+        ret

+command endp

+

+

+;================================================================

+;       hd_int

+;================================================================

+

+hd_int  proc    near

+        push    ax

+        mov     al,eoi                  ; end of interrupt

+        out     int_ctl_port,al

+        mov     al,7                    ; set dma mode to disable

+        out     dma+10,al

+        in      al,21h

+        or      al,20h

+        out     21h,al

+        pop     ax

+        iret

+hd_int  endp

+

+

+t_0     dw      type_0

+t_1     dw      type_1

+t_2     dw      type_2

+t_3     dw      type_3

+

+

+stat_err:

+        mov     bl,es:hd_error          ; get error byte

+        mov     al,bl

+        and     al,0fh

+        and     bl,00110000b

+        sub     bh,bh

+        mov     cl,3

+        shr     bx,cl

+        jmp     word ptr cs:[bx + offset t_0]

+

+type0_table     label byte

+        db      0, bad_cntlr, bad_seek, bad_cntlr, time_out, 0, bad_cntlr

+        db      0, bad_seek

+type0_len       equ     $-type0_table

+

+type1_table     label   byte

+        db      bad_ecc, bad_ecc, bad_addr_mark, 0, record_not_fnd

+        db      bad_seek, 0, 0, data_corrected, bad_track

+type1_len       equ     $-type1_table

+

+type2_table     label byte

+        db      bad_cmd, bad_addr_mark

+type2_len       equ     $-type2_table

+

+type3_table     label   byte

+        db      bad_cntlr, bad_cntlr, bad_ecc

+type3_len       equ     $-type3_table

+

+type_0:

+                ret

+type_1:

+                ret

+type_2:

+                ret

+type_3:

+                ret

+

+;================================================================

+;       hd_wait_req

+;================================================================

+

+hd_wait_req     proc near

+        push    cx

+        sub     cx,cx                   ; timeout - Zaehler setzen

+        mov     dx,hf_port + 1

+l1:

+        in      al,dx

+        test    al,r1_req

+        jnz     l2                      ; wenn ok

+        loop    l1

+        mov     disk_status, time_out

+        stc

+l2:

+        pop     cx

+        ret

+hd_wait_req     endp

+

+

+;       end

+
\ No newline at end of file
diff --git a/system/shard-x86-at/7/src/HSHARD.ASM b/system/shard-x86-at/7/src/HSHARD.ASM
new file mode 100644
index 0000000..1a2100a
--- /dev/null
+++ b/system/shard-x86-at/7/src/HSHARD.ASM
@@ -0,0 +1,245 @@
+  page 80,132

+;******************************************************************************

+;*                                                                            *

+;*       S H A R D   -   M O D U L                                            *

+;*                                                                            *

+;*       fuer EUMEL auf 80286, 8086, 8088 Systemen                            *

+;*                                                                            *

+;*       SHard Version 7-PC/XT, PC/AT                                         *

+;*                                                                            *

+;*       Copyright (C) 1985, 86 Martin Schoenbeck, Spenge                     *

+;*                                                                            *

+;******************************************************************************

+

+

+com2wrongirq equ 0

+add4 equ 0

+ast equ 0

+

+at equ 0 

+gensys equ 0

+ramsys equ 0

+pcxt equ 1

+pcd equ 0

+romharddisk equ 0

+romfloppy equ 0

+limited_to_360 equ 0

+boot_size equ 0

+

+hdsystem equ 1

+withhd equ 1

+

+setup_channel equ 28

+dos_channel equ 29

+

+shard group code

+code segment word public 'code'

+ assume cs:shard, ds:shard, es:nothing, ss:nothing

+

+shstart:

+     jmp los_gehts

+

+     even

+

+     include MACROS.ASM

+     include MAC286.ASM

+     include DEVICE.ASM

+     include EUCONECT.ASM

+     org 0a0h			;bei wort 80 beginnen

+     include PATCHARE.ASM

+

+     include SHMAIN.ASM

+

+IBMat equ 0fch

+com1base equ 03f8h

+com1irq  equ 4

+com2base equ 02f8h

+ if com2wrongirq

+   com2irq equ 5

+ else

+   com2irq  equ 3

+ endif

+ if add4

+com4_1base equ 03e8h

+com4_1irq  equ 3

+com4_2base equ 03e0h

+com4_2irq  equ 3

+com4_3base equ 02f0h

+com4_3irq  equ 3

+com4_4base equ 02e8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 0260h

+com8_2irq  equ 3

+com8_3base equ 02d8h

+com8_3irq  equ 3

+ else

+com4_1base equ 02c0h

+com4_1irq  equ 3

+com4_2base equ 02c8h

+com4_2irq  equ 3

+com4_3base equ 02d0h

+com4_3irq  equ 3

+com4_4base equ 02d8h

+com4_4irq  equ 3

+com8_1base equ 02e0h

+com8_1irq  equ 3

+com8_2base equ 02e8h

+com8_2irq  equ 3

+com8_3base equ 02f0h

+com8_3irq  equ 3

+com8_4base equ 02f8h

+com8_4irq  equ 3

+add4_3base equ 03e8h

+add4_3irq  equ 3

+add4_4base equ 03e0h

+add4_4irq  equ 3

+add4_8base equ 0260h

+add4_8irq  equ 3

+ endif

+ast0_1base equ 01a0h

+ast0_1irq  equ 5

+ast0_2base equ 01a8h

+ast0_2irq  equ 5

+ast0_3base equ 01b0h

+ast0_3irq  equ 5

+ast0_4base equ 01b8h

+ast0_4irq  equ 5

+ast1_1base equ 02a0h

+ast1_1irq  equ 5

+ast1_2base equ 02a8h

+ast1_2irq  equ 5

+ast1_3base equ 02b0h

+ast1_3irq  equ 5

+ast1_4base equ 02b8h

+ast1_4irq  equ 5

+

+int_ctlr equ 20h

+first_ictlr_int equ 8

+

+channel macro number,dev,ccb

+channels = channels+1

+selectentry = 5

+     db number

+     dw offset ccb

+     if2

+     dwb paramstart_,%&dev

+     else

+     dw 0                ;;weil in pass eins device evtl. unbekannt

+     endif 

+     endm

+

+selecttable:

+     db channels       ;anzahl kanaele hier setzen

+channels = -1         ;nilchannel vorab abziehen

+     channel 32,shardchannel,0

+     channel 0,fixdisk,hgccb0

+alterable_channels:

+     channel 1,pc,0 

+     channel 2,i8250,com1ccb

+     channel 3,i8250,com2ccb

+    if ast

+     channel 4,i8250,ast0_1ccb

+     channel 5,i8250,ast0_2ccb

+     channel 6,i8250,ast0_3ccb

+     channel 7,i8250,ast0_4ccb

+     channel 8,i8250,ast1_1ccb

+     channel 9,i8250,ast1_2ccb

+     channel 10,i8250,ast1_3ccb

+     channel 11,i8250,ast1_4ccb

+    else

+     channel 4,i8250,com4_1ccb

+     channel 5,i8250,com4_2ccb

+     channel 6,i8250,com4_3ccb

+     channel 7,i8250,com4_4ccb

+     channel 8,i8250,com8_1ccb

+     channel 9,i8250,com8_2ccb

+     channel 10,i8250,com8_3ccb

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     channel 11,i8250,add4_3ccb

+     channel 12,i8250,add4_4ccb

+     channel 13,i8250,add4_8ccb

+     endif

+    endif

+;    channel 4,i8250,com3ccb

+;    channel 5,i8250,com4ccb

+     channel 15,parallel,para0ccb

+     channel 14,parallel,para1ccb

+     channel 16,parallel,para2ccb

+     channel 28,fixdisk,hgccb1

+     channel 29,fixdisk,hgccb2

+  if 0 

+     channel 30,archive,archive_0

+     channel 31,archive,archive_1

+  else

+     channel 31,archive,archive_0

+     channel 30,archive,archive_1

+  endif

+     channel -1,nilchannel,0

+ 

+     include I8250.ASM

+     include PCPAR.ASM

+     include STREAM.ASM

+     include NILCHAN.ASM

+     include PCSCREEN.ASM

+     include PCPLOT.ASM

+     include PCSYS.ASM

+     include FIXDISK.ASM

+     include FLOPPY.ASM

+     include CLOCK.ASM

+     include WAIT.ASM

+     include HARDWARE.ASM

+     include BLOCKERR.ASM

+ 

+     i8250_ccb com1,2

+     i8250_ccb com2,3

+    if ast

+     i8250_ccb ast0_1,4

+     i8250_ccb ast0_2,5

+     i8250_ccb ast0_3,6

+     i8250_ccb ast0_4,7

+     i8250_ccb ast1_1,8

+     i8250_ccb ast1_2,9

+     i8250_ccb ast1_3,10

+     i8250_ccb ast1_4,11

+    else

+     i8250_ccb com4_1,4

+     i8250_ccb com4_2,5

+     i8250_ccb com4_3,6

+     i8250_ccb com4_4,7

+     i8250_ccb com8_1,8

+     i8250_ccb com8_2,9

+     i8250_ccb com8_3,10

+     ife add4  ;wenn nicht extra fuer add4, trotzdem vorsehen

+     i8250_ccb add4_3,11

+     i8250_ccb add4_4,12

+     i8250_ccb add4_8,13

+     endif

+    endif

+     para_ccb 0,15

+     para_ccb 1,14

+     para_ccb 2,16

+ ;erlaubt drivetypen: highdensity, drive720

+    if at

+     archive_ccb 0,highdensity

+     archive_ccb 1,0 ;drive720

+    else

+     archive_ccb 0,0

+     archive_ccb 1,0

+    endif 

+     fix_ccb 0

+     fix_ccb 1

+     fix_ccb 2

+

+sysmove:

+     rep movsw

+     jmp systemstart

+

+     include BOOT.ASM

+

+code ends

+

+     end los_gehts

+

+

diff --git a/system/shard-x86-at/7/src/I8250.ASM b/system/shard-x86-at/7/src/I8250.ASM
new file mode 100644
index 0000000..cb69233
--- /dev/null
+++ b/system/shard-x86-at/7/src/I8250.ASM
@@ -0,0 +1,436 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Routinen fuer 8250 UART im EUMEL - System                             *

+;*                                                                         *

+;*                                                                         *

+;***************************************************************************

+

+i8250_data equ 0

+i8250_ier  equ 1                 ;interrupt enable register

+i8250_iir  equ 2                 ;interrupt indicator register

+i8250_lcr  equ 3                 ;line control register

+i8250_mcr  equ 4                 ;modem control register

+i8250_lsr  equ 5                 ;line status register

+i8250_msr  equ 6                 ;modem status register

+

+     device i8250

+

+     dtcbroutines iocontrol

+     routine 1,i8250_devicetype

+     routine 2,frout

+     routine 3,i8250_stop

+     routine 4,i8250_weiter

+     routine 5,nil_size

+     routine 6,priv_op_question

+     routine 8,priv_op_question

+     routine 9,priv_op_question

+     routine -2,frout

+     routine -3,i8250_status

+     routine -4,stream_in_count

+     routine -5,stream_out_count

+     routine -6,i8250_sendbreak

+     routine -10,i8250_i_stop

+     routine -11,i8250_i_weiter

+     routine -1,unknowncontrol

+

+     dtcbroutines control32

+     routine 6,i8250_flow

+     routine 8,i8250_baud

+     routine 9,i8250_bits

+     routine -2,i8250_init

+     routine -3,i8250_test

+     routine -1,no_channel_setup

+

+     dtcbroutines blockin

+     dtcbroutines blockout

+     routine -1,unknowncontrol

+

+     dtcbparams i8250_output,3   ;typ = nur stream io

+

+

+;******************************************************************

+;*   der macro i8250_ccb muss fuer jeden 8250 im system einmal

+;*   aufgerufen werden

+;*

+;*   parameter: 

+

+i8250_ccb macro i8250,kanal

+i8250&buf db 100 DUP (0ffh)

+     startccb i8250&ccb,kanal

+     stream 100,i8250&buf        ;;die 8250 routinen benutzen stream routinen

+ccbentry i8250_stat

+     db 0

+ccbentry i8250_statusandmask

+     db 0                        ;;keine statusleitungen abfragen

+ccbentry i8250_statusxormask

+     db 0

+ccbentry i8250_errmask

+     db 0                        ;;keine fehler auswerten

+ccbentry i8250_errflags

+     db 0

+ccbentry i8250_irq_line

+     db i8250&irq

+ccbentry i8250_base

+     dw i8250&base

+ccbentry i8250_next_ccb

+     dw 0

+ccbentry i8250_int_entry

+     call i8250_interrupt

+     endm

+

+;*** bits in i8250_stat:

+i8250_rtscts equ 1

+i8250_exists equ 2

+

+i8250_baud_table:

+     dw 2304                     ;50 

+     dw 1536                     ;75

+     dw 1047                     ;110

+     dw 857                      ;134.5

+     dw 768                      ;150

+     dw 384                      ;300

+     dw 192                      ;600

+     dw 96                       ;1200

+     dw 64                       ;1800

+     dw 48                       ;2400

+     dw 32                       ;3600

+     dw 24                       ;4800

+     dw 16                       ;7200

+     dw 12                       ;9600

+

+

+i8250_devicetype:

+     mov cx,0                      ;erstmal 0 setzen

+     test byte ptr [di+i8250_stat],i8250_exists ;ist da einer

+     ifnz <mov cl,shard:(si+devtype)>     ;type dazu

+     ret

+

+

+

+

+i8250_test:

+     cmp bh,0                    ;abfrage

+     ifnz <int 0bh>

+     mov dx,(di+i8250_base)

+     add dx,i8250_iir            ;auf interrupt indicator register

+     in al,(dx)

+     mov cl,al

+     mov ch,1

+     ret

+

+i8250_init:

+     mov ax,0

+     mov es,ax

+; pruefen, ob ueberhaupt vorhanden

+     mov dx,(di+i8250_base)

+     add dx,i8250_iir         ;interrupt indicate register holen

+     jmp short $+2

+     in al,dx

+     nop                      ;der in befehl erwischt einen von diesen

+     nop                      ;codes, wenn auf der adresse kein port ist

+     nop

+     nop

+     nop

+     test al,0f8h             ;alle bits weg, die nicht da sein koennen

+     ifnz <ret>               ;keine schnittstelle da

+     or byte ptr [di+i8250_stat],i8250_exists ;da ist einer

+

+     mov bx,first_ictlr_int

+     add bl,(di+i8250_irq_line)  ;an welchem pin des controllers haengt er

+                                 ;carry kann hier nicht auftreten

+     mov byte ptr i8250_initint,bl ;fuer passenden initialisierungsint basteln

+     add bx,bx                   ;*2 als wortadresse

+     mov dx,word ptr (i8250_i_tab-((3+first_ictlr_int)*2))[bx] ;letzten ccb holen

+     mov word ptr (i8250_i_tab-((3+first_ictlr_int)*2))[bx],di ;neuen eintragen

+     mov (di+i8250_next_ccb),dx  ;alten selbst merken

+     add bx,bx                   ;*4

+     mov word ptr es:[bx+2],cs

+     mov dx,di                   ;adresse ccb holen

+     add dx,i8250_int_entry      ;adresse interrupt routine errechnen

+     mov word ptr es:[bx],dx     ;eintragen

+     mov cl,(di+i8250_irq_line)  ;nochmal bit im controller

+     inc cl                      ;mindestens einmal shiften

+     stc

+     mov ch,0                    ;mit nichts anfangen

+     rcl ch,cl

+     in al,int_ctlr+1            ;interrupt enable register holen

+     or al,ch                    ;bit fuer i8250 setzen 

+     xor al,ch                   ;und freigeben

+     out int_ctlr+1,al

+     mov dx,(di+i8250_base)

+     add dx,i8250_ier            ;auf interrupt enable register

+     mov al,0fh                  ;alle interrupts an

+     out dx,al                   ;interrupt enable

+     add dx,i8250_mcr-i8250_ier  ;auf modem control register

+     mov al,0bh                  ;rts, dtr, int enable

+     out dx,al

+;    ret

+i8250_initint = $+1

+     int 12

+     ret

+

+i8250_i_tab:

+     dw 0                        ;int 3

+     dw 0                        ;int 4

+     dw 0                        ;int 5

+     dw 0                        ;int 6

+     dw 0                        ;int 7

+

+i8250_interrupt:

+     push ds

+     push cx

+     push di

+     push bx

+     push dx

+     push ax

+     mov ax,cs

+     mov ds,ax                   ;ds = cs setzen

+     mov bx,sp                   ;auf stack zeigen

+     mov di,ss:[bx+12]           ;return adresse im ccb holen

+     sub di,i8250_int_entry+3    ;auf anfang ccb rechnen

+i8250_to_first_ccb:

+     push di                     ;ersten ccb merken

+     mov ah,1                    ;bis jetzt keinen port gefunden

+i8250_check_same_int:

+     mov dx,(di+i8250_base)

+     add dx,i8250_iir            ;interrupt indicate register lesen

+     in al,(dx)

+     test al,1                   ;war interrupt auf diesem kanal

+     jnz i8250_int_end

+     mov ah,0                    ;ax als index, gleichzeitig ah loeschen

+     push ax

+     mov bx,ax

+     call word ptr i8250_int_table[bx]    ;passende service routine aufrufen

+     pop ax

+     jmp i8250_check_same_int

+

+i8250_int_end:

+     mov di,(di+i8250_next_ccb)  ;naechsten port fuer diesen vektor holen

+     or di,di                    ;ende eintrag?

+     jnz i8250_check_same_int

+     pop di                      ;ersten ccb holen

+     or ah,ah                    ;haben wir im letzten durchlauf einen gefunden

+     jz i8250_to_first_ccb       ;ja, dann weiter suchen

+     mov al,20h                  ;end of interrupt

+     out int_ctlr,al

+     pop ax

+     pop dx

+     pop bx

+     pop di

+     pop cx

+     pop ds

+     pop cs:[i8250_ret_dummy]    ;return adresse im ccb vergessen

+     iret                        ;fertig

+

+i8250_ret_dummy dw 0

+

+i8250_int_table:

+     dw offset i8250_out_restart ;bei ext. status wechsel oder bei tx empty

+     dw offset i8250_out_restart ;nur output ggf. neu starten

+     dw offset i8250_rec_int

+     dw offset i8250_error_int

+

+

+i8250_baud:

+     cmp bh,15                   ;negativer wert oder > 15

+     jnc i8250_not_ok

+     cmp bh,0

+     jz i8250_not_ok

+     test bl,1                   ;abfage?

+     jnz i8250_ok                ;ja, wir koennen alles

+     mov dx,(di+i8250_base)

+     add dx,i8250_lcr            ;line control register

+     cli                         ;nichts dazwischen lassen

+     in al,dx                    ;alten wert holen

+     push ax

+     mov al,80h

+     out dx,al                   ;auf baudrate register schalten

+     sub dx,i8250_lcr            ;wieder auf base

+     mov bl,bh                   ;baudrate schluessel nach bx ausdehnen

+     mov bh,0

+     sal bx,1                    ;ein baudrate eintrag ist zwei byte

+     mov ax,word ptr i8250_baud_table-2[bx] ;passenden baudrate eintrag holen

+     out dx,al                   ;low byte raus

+     mov al,ah

+     inc dx

+     out dx,al                   ;high byte raus

+     pop ax

+     add dx,i8250_lcr-1          ;wieder auf lcr

+     out dx,al                   ;alte lcr wieder setzen

+     sti                         ;jetzt darf er wieder

+     jmp short i8250_ok          ;alles klar

+     ret

+

+i8250_bits:

+     test bh,0a0h                ;negativer wert oder 1.5 Stopbits

+     jnz i8250_not_ok

+     test bh,4                   ;bitzahl >= 5

+     jz i8250_not_ok             ;nein, muss aber

+     test bl,1                   ;abfrage

+     jnz i8250_ok

+     mov al,bh                   ;anfoderung nach al

+     test al,10h                 ;gerade paritaet?

+     jz i8250_not_even

+     or al,8                     ;dann paritaet auch enablen

+i8250_not_even:

+     test al,40h                 ;2 stopbits

+     jnz i8250_not_two           ;nein, das bit steht schon

+     and al,0ffh-4               ;bit ausknipsen

+i8250_not_two:

+     and al,1fh                  ;alle unbenutzten loeschen

+     mov dx,(di+i8250_base)

+     add dx,i8250_lcr            ;auf line control register

+     out dx,al

+     mov cl,bh                   ;anzahl bits nach cl

+     and cl,7                    ;ausblenden

+     inc cl                      ;aus 0-7 1-8 machen

+     mov dx,0ffh                 ;von 0 bits ausgehen

+     shl dl,cl                   ;bits anzahl nullen reinziehen

+     xor dl,0ffh                 ;und 1 und 0 tauschen

+     call set_out_mask

+     call set_inp_mask

+     call set_inp_errmask

+i8250_ok:

+     mov cx,0

+     ret

+

+i8250_not_ok:

+     mov cx,1

+     ret

+

+i8250_flow:

+     test bh,80h                 ;negativer wert?

+     jnz i8250_not_ok

+     cmp bh,3

+     jnc i8250_not_ok            ;oder > 2

+     test bl,1                   ;abfrage

+     jnz i8250_ok                ;ja

+   cli

+     mov byte ptr (di+i8250_statusxormask),0 ;beim status nichts abfragen

+     mov byte ptr (di+i8250_statusandmask),0

+     and byte ptr (di+i8250_stat),0ffh-i8250_rtscts ;handshake ausschalten

+     dec bh

+     jnz i8250_not_xonxoff

+     call enablexon

+     jmp i8250_flow_end

+i8250_not_xonxoff:

+     call disablexon

+     dec bh

+     jnz i8250_flow_end

+     mov byte ptr (di+i8250_statusandmask),10h ;cts abfragen

+     mov byte ptr (di+i8250_statusxormask),10h ;auf gesetzt

+     or byte ptr (di+i8250_stat),i8250_rtscts

+i8250_flow_end:

+     call i8250_out_restart      ;immer probieren, ob jetzt output moeglich

+     sti

+     jmp i8250_ok

+

+i8250_output:

+     call fillbuffer

+     pushf

+     jz i8250_no_orest

+     call i8250_out_restart

+i8250_no_orest:

+     popf

+     ret

+

+;* out_restart kann jederzeit aufgerufen werden, da der status jedesmal

+;* abgefragt wird

+i8250_out_restart:

+     mov dx,(di+i8250_base)      ;commandport laden

+     add dx,i8250_lsr            ;adresse line status register

+    cli

+     in al,(dx)                  ;status holen

+     test al,20h                 ;tx buffer empty

+     lahf                        ;modem status register immer lesen

+     inc dx                      ;auf modem status register

+     in al,(dx)                  ;holen

+     sahf

+     jz i8250_stiret             ;nein, sti und zurueck

+     and al,(di+i8250_statusandmask) ;gewuenschte bits ausblenden

+     xor al,(di+i8250_statusxormask)

+     jnz i8250_stiret

+     call getnextchar            ;zeichen holen, xon/xoff etc. abhandeln

+     mov dx,(di+i8250_base)      ;port holen

+     ifnz <out (dx),al>          ;wenn was da, ausgeben

+i8250_stiret:

+    sti

+     ret                         ;fertig

+

+i8250_rec_int:

+     mov dx,(di+i8250_base)

+     in al,(dx)                  ;zeichen holen

+     call input                  ;zeichen uebergeben, xon/xoff etc. abhandeln

+     jz i8250_out_restart        ;ggf. output neu starten

+     ret

+

+i8250_error_int:

+     mov dx,(di+i8250_base)

+     add dx,i8250_lsr            ;line status register holen

+     in al,(dx)

+     or (di+i8250_errflags),al   ;alte errorflags dazu

+     test al,10h                 ;break detected

+     jnz i8250_break

+     and al,(di+i8250_errmask)   ;welche fehlerbits sollen behandelt werden

+     jz i8250_rec_int            ;keine, normal einlesen

+     mov dx,(di+i8250_base)

+     in al,(dx)                  ;zeichen holen

+     call errorinput             ;uebergeben

+     jz i8250_out_restart

+     ret

+

+i8250_break:

+     call breakinput             ;break zeichen uebergeben

+     jz i8250_out_restart

+     ret

+

+i8250_stop:

+     call stream_stop

+     ifnz <call i8250_out_restart> ;output ggf neu starten

+     test byte ptr (di+i8250_stat),i8250_rtscts

+     jz i8250_stop_end

+i8250_i_stop:

+     mov dx,(di+i8250_base)

+     add dx,i8250_mcr            ;auf modem control register

+     mov al,9                    ;rts wegnehmen

+     out (dx),al

+i8250_stop_end:

+     ret

+

+i8250_weiter:

+     call stream_weiter

+     ifnz <call i8250_out_restart> ;output ggf. neu starten

+     test byte ptr (di+i8250_stat),i8250_rtscts

+     jz i8250_stop_end

+i8250_i_weiter:

+     mov dx,(di+i8250_base)

+     add dx,i8250_mcr            ;auf modem control register

+     mov al,0bh                  ;rts wieder setzen

+     out (dx),al

+     ret

+

+i8250_status:

+     cli

+     mov cl,(di+i8250_errflags)    ;fehler holen

+     mov byte ptr (di+i8250_errflags),0 ;loeschen

+     mov dx,(di+i8250_base)

+     add dx,i8250_lsr

+     in al,dx

+     mov ch,al

+     sti

+     ret

+

+i8250_sendbreak:

+     cli

+     mov dx,(di+i8250_base)

+     add dx,i8250_lcr

+     in al,dx

+     and al,10111111b            ;switch breakbit off

+     and bl,1                    ;nur ein bit behalten

+     ror bl,1

+     ror bl,1                    ;auf bit 6 position

+     or al,bl                    ;send break or not

+     out dx,al

+     sti

+     ret

diff --git a/system/shard-x86-at/7/src/MAC286.ASM b/system/shard-x86-at/7/src/MAC286.ASM
new file mode 100644
index 0000000..3a1f164
--- /dev/null
+++ b/system/shard-x86-at/7/src/MAC286.ASM
@@ -0,0 +1,23 @@
+iw macro op,reg,count

+ local fbyte,cbyte

+fbyte:

+     op reg,1

+cbyte:

+     org cs:fbyte

+     db 0c1h

+     org cs:cbyte

+     db count

+     endm

+

+ib macro op,reg,count

+ local fbyte,cbyte

+fbyte:

+     op reg,1

+cbyte:

+     org cs:fbyte

+     db 0c0h

+     org cs:cbyte

+     db count

+     endm

+

+
\ No newline at end of file
diff --git a/system/shard-x86-at/7/src/MACROS.ASM b/system/shard-x86-at/7/src/MACROS.ASM
new file mode 100644
index 0000000..c2f8b3a
--- /dev/null
+++ b/system/shard-x86-at/7/src/MACROS.ASM
@@ -0,0 +1,79 @@
+;*************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ===============*

+;*                                                                       *

+;*         M A C R O s   fuer   E U M E L   -   U R L A D E R            *

+;*                                                                       *

+;*************************************************************************

+

+   .XLIST

+on  equ  0ffh

+off  equ  0

+

+test  equ  off

+

+deft macro text 

+local textend

+ db (textend-$-1)

+ db &text

+textend label byte

+ endm

+

+ke  macro text

+  local teend

+  call info

+  jmp teend

+  db '&text'

+teend:

+  endm

+

+trcpas  macro  name

+  local trcfield,endtrc

+  if trcswitch

+  push hl

+  ld hl,(trcfield)

+  inc hl

+  ld (trcfield),hl

+  pop hl

+  jr endtrc

+  db '&name'

+trcfield:

+  dw 0

+endtrc:

+  endif

+  endm

+

+

+ifz macro op

+local false

+     jnz false

+     op

+false:

+     endm

+

+ifnz macro op

+local false

+     jz false

+     op

+false:

+     endm

+

+ifc macro op

+local false

+     jnc false

+     op

+false:

+     endm

+

+ifnc macro op

+local false

+     jc false

+     op

+false:

+     endm

+

+popff macro

+     push cs

+     call x_iret

+     endm

+

+  .LIST

diff --git a/system/shard-x86-at/7/src/NILCHAN.ASM b/system/shard-x86-at/7/src/NILCHAN.ASM
new file mode 100644
index 0000000..1ff0108
--- /dev/null
+++ b/system/shard-x86-at/7/src/NILCHAN.ASM
@@ -0,0 +1,53 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Dieses Modul definiert alle Routinen, die benoetigt werden, wenn      *

+;*   ein Kanal nicht existiert oder bestimmte Funktionen nicht durch-      *

+;*   fuehren kann.                                                         *

+;*                                                                         *

+;***************************************************************************

+

+     device nilchannel

+

+     dtcbroutines iocontrol

+          routine 1,devicetype

+          routine 2,frout_ok

+          routine 5,nil_size

+          routine -1,unknowncontrol

+     dtcbroutines control32

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+     dtcbroutines blockout

+          routine -1,no_blockinout

+     dtcbparams nil_output,0            ;output; niltype

+

+nil_size:

+     mov al,0

+     mov cx,0

+     ret

+

+unknowncontrol:

+no_blockinout:

+     mov cx,-1

+     ret

+

+frout_ok:

+     mov cx,200                    ;200 bytes frei

+     stc                           ;puffer leer

+     ret

+

+no_baud:

+no_bits:

+no_flow:

+no_channel_setup:

+     mov cx,1

+     ret

+

+nil_output:

+     stc

+     ret                           ;alle zeichen uebernommen

+

+devicetype:

+     mov ch,0                      ;hoeherwertige teil immer null

+     mov cl,shard:(si+devtype)     ;type dazu

+     ret

diff --git a/system/shard-x86-at/7/src/PATCH.ELA b/system/shard-x86-at/7/src/PATCH.ELA
new file mode 100644
index 0000000..c3f34f1
--- /dev/null
+++ b/system/shard-x86-at/7/src/PATCH.ELA
@@ -0,0 +1,500 @@
+(* SHard-Patcher fuer Schoenbeck AT-Shard V2.7: 

+   - Vortest/Speichertest 

+   - Keyboard Repeatfrequenz 

+   - Baudrates 19200/38400 werden angeboten 

+   - Refresh-Intervall änderbar (bis zu 5% mehr Leistung) 

+   - control (-3,,,r) liefert im Highbyte das Modemstatusregister (RI etc.) 

+   - control (-5,8,,r) geht in ruc-Bios-Graphikmodus (mit Textausgabe: 

+     Text mit 'out', 'put' etc. schreiben, cursor (x, y) mit y:1..43, 

+     Codes ""4"", ""5"", Scroll löschen jetzt vernünftig (Attribut von 7 auf

+     0 geändert), 

+     Achtung: getcursor (x, y) im 'begin plot' einbauen. 

+              cursor (x,y) im 'end plot' einbauen, wegen y<25 im Textmodus!) 

+   - Kanal 30 (Archiv 1) jetzt für MF-Laufwerke (5.25" bzw. 3.5"), Default- 

+              Size ist 1.2MB (Achtung bei Formatieren von 3.5"-Floppys!) 

+   - Mit control (-10/-11,...) ("stop", "weiter") wird an den RS232-Kanälen 

+     jetzt nicht nur RTS active/inactive gesetzt sondern auch DTR (Modem). 

+   - An Kanal 32: 

+     Mit control (-3, x, mcr*32+kanal, r) (mcr ist Modemcontrolregister Wert,

+     x egal) können RTS, DTR explizit gesetzt werden.

+   - id (6) > 0 : SHard wurde gepatcht.

+ 

+   Michael Staubermann, Version 2:   09.10.87, Keyboardrepeat, Baudrates

+                        Version 3:   04.11.87, Graphikcursor & Graphikmodi

+                        Version 3.1: 20.11.87, >32MB Partitionen f. M+ 

+                        Version 4:   04.12.87, TX-Interrupt restart

+                        Version 4.1: 10.01.88, Refresh-Intervall änderbar 

+                        Version 5:   21.02.88, Kanal 30 1.2MB-Format (3.5") 

+                        Version 5.1: 22.02.88,

+*) 

+ 

+LET setup channel = 28 ; 

+ 

+LET max partitions = 4 , 

+    patch version  = 5 ,

+    shard bloecke  = 18 ; 

+ 

+   

+patch shard ; 

+

+ROW shard bloecke ROW 256 INT VAR block ; 

+ROW shard bloecke BOOL VAR modified ; 

+INT VAR old session := 0 ; 

+REAL VAR partition size := 0.0, partition start 1 := 256.0 * 65536.0 -1.0 ; 

+INT VAR i ; 

+FOR i FROM 1 UPTO shard bloecke REP 

+ modified (i) := FALSE 

+PER ; 

+ 

+ROW 256 INT VAR partition table ; 

+ 

+ 

+INT OP & (TEXT CONST hex) : 

+ INT VAR i, h := 0 ; 

+ IF LENGTH hex > 4 THEN errorstop ("OP &: LENGTH > 4") FI ; 

+ FOR i FROM 1 UPTO LENGTH hex REP 

+  rotate (h, 4) ;

+  INT CONST c :: code (hex SUB i) ; 

+  IF c >= 97 AND c <= 102 

+     THEN h := h OR (c-87)

+  ELIF c >= 65 AND c <= 70 

+     THEN h := h OR (c-55)

+  ELIF c >= 48 AND c <= 57 

+     THEN h := h OR (c-48) 

+  ELSE errorstop ("OP &: ungültiges Hexdigit ("+code(c)+")") 

+  FI ; 

+ PER ; 

+ h 

+ENDOP & ; 

+ 

+TEXT OP % (INT CONST int) : 

+ LET hex = "0123456789ABCDEF" ; 

+ TEXT VAR t := "" ; 

+ INT VAR i, r := int ; 

+ FOR i FROM 1 UPTO 4 REP 

+  rotate (r, 4) ; 

+  t CAT (hex SUB ((r AND 15)+1)) ; 

+ PER ; 

+ t 

+ENDOP % ; 

+ 

+PROC poke (INT CONST shard adr, INT CONST byte) : 

+ (* Der Shard beginnt bei 1280 d.h. 0500H, EUCONECT bei 504H (='EUMEL') *) 

+ INT VAR block no, block offset ; 

+ IF shard adr < 256 

+    THEN errorstop ("poke: Adresse < 256") ; 

+         LEAVE poke 

+ FI ; 

+ block offset := shard adr-256 ; 

+ rotate (block offset, -1) ; 

+ block offset := (block offset AND 255) + 1 ;

+ block no := shard adr - 256 ; 

+ rotate (block no, -9) ; 

+ block no := (block no AND 63) + 1 ; 

+ IF block no < 1 OR block no > shard bloecke 

+    THEN errorstop ("poke: falsche Adresse") ; 

+         LEAVE poke 

+ FI ; 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, block (block no)(block offset)) ; 

+ replace (t, (shard adr AND 1) + 1, code (byte AND 255)) ; 

+ modified (block no) := TRUE ; 

+ block (block no)(block offset) := t ISUB 1 ; 

+ENDPROC poke ; 

+ 

+PROC poke2 (INT CONST shard adr, INT CONST word) : 

+ INT VAR r := word ; 

+ poke (shard adr, r) ; 

+ rotate (r, 8) ; 

+ poke (shard adr+1, r) ; 

+ENDPROC poke2 ; 

+ 

+PROC poken (INT CONST shard adr, TEXT CONST str) : 

+ INT VAR i, adr := shard adr ; 

+ i := 1 ; 

+ WHILE i <= LENGTH str REP 

+  IF (str SUB i+2) = " " OR (str SUB i+2) = ""

+     THEN poke (adr, &subtext (str, i, i+1)) ; 

+          i INCR 3 ; 

+          adr INCR 1 

+  ELIF (str SUB i+4) = " " OR (str SUB i+4) = "" 

+     THEN poke2 (adr, &subtext (str, i, i+3)) ; 

+          i INCR 5 ; 

+          adr INCR 2 

+  ELSE errorstop ("poken: Zuviele zusammenhängende Bytes") 

+  FI ; 

+ PER ; 

+ENDPROC poken ; 

+ 

+INT PROC peek (INT CONST shard adr) : 

+ INT VAR block no, block offset ; 

+ block offset := shard adr ; 

+ IF shard adr < 256 

+    THEN errorstop ("peek: Adresse < 256") ; 

+         LEAVE peek WITH 0 

+ FI ; 

+ block offset := shard adr-256 ; 

+ rotate (block offset, -1) ; 

+ block offset := (block offset AND 255) + 1 ;

+ block no := shard adr-256 ; 

+ rotate (block no, -9) ; 

+ block no := (block no AND 63) + 1 ;

+ IF block no < 1 OR block no > shard bloecke 

+    THEN errorstop ("peek: falsche Adresse") ; 

+         LEAVE peek WITH 0

+ FI ; 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, block (block no)(block offset)) ; 

+ code (t SUB ((shard adr AND 1) + 1))  

+ENDPROC peek ; 

+ 

+ 

+INT PROC peek2 (INT CONST shard adr) : 

+ INT VAR r := peek (shard adr + 1) ; 

+ rotate (r, 8) ; 

+ r + peek (shard adr) 

+ENDPROC peek2 ; 

+ 

+ 

+PROC get partition : 

+ INT VAR partition, cyls, heads, secs ; 

+ get media size (setup channel, cyls, heads, secs) ; 

+ get partition table ; 

+ get partition number from user ; 

+ line ; 

+ IF (partition size  high AND -256) <> 0 OR 

+    (partition start high AND -256) <> 0

+    THEN errorstop ("Sorry, Partitionsangaben zu hoch") 

+ FI ; 

+ line ; 

+ partition start1 := real24 (partition start high, partition start low)-1.0; 

+ partition size  := real24 (partition size high, partition size low) ; 

+ putline ("Platte hat " + text (cyls) + " Cylinder, " + text (heads) + 

+          " Heads, " + text (secs) + " Sektoren = " + 

+          text (real(cyls)*real(heads)*real(secs)/2048.0, 5, 1) + " MB") ;

+ putline ("Partionsanfang: " + 

+           text ((partition start 1+1.0)/2.0, 6, 0) + " KB = Cylinder " + 

+           text (int ((partition start 1+1.0)/real(secs)/real(heads)))) ; 

+ putline ("Partionsgrösse: " + text (partition size/2.0, 6, 0) + " KB = " + 

+           text (int (partition size/real(secs)/real(heads))) + " Cylinder"); 

+ put ("Diese Partition ist") ; 

+ IF NOT partition active 

+    THEN put (""15"nicht"14"")

+ FI ; 

+ putline ("aktiviert.") ;

+ line . 

+ 

+get partition table : 

+ blockin (setup channel, partition table, 0.0) . 

+ 

+get partition number from user : 

+ FOR partition FROM 1 UPTO max partitions REP 

+  IF eumel partition CAND yes ("EUMEL-Partiton " + 

+                          text (partition type) + " patchen") 

+     THEN LEAVE get partition number from user 

+  FI 

+ PER ; 

+ partition := 0 ; 

+ errorstop ("Keine EUMEL Partition gefunden") . 

+ 

+ 

+eumel partition : 

+ partition type >= 69 AND partition type <= 72 . 

+ 

+entry               : 216 + partition * 8 . 

+partition active    : bit (partition table (entry), 7) . 

+partition type      : partition table (entry + 2) AND 255 . 

+partition start low : partition table (entry + 4) .

+partition start high: partition table (entry + 5) . 

+partition size  low : partition table (entry + 6) . 

+partition size  high: partition table (entry + 7) . 

+ 

+ENDPROC get partition ; 

+ 

+PROC read shard : 

+ INT VAR i ; 

+ old session := session ; 

+ FOR i FROM 1 UPTO shard bloecke REP 

+  cout (i) ; 

+  modified (i) := FALSE ; 

+  blockin (setup channel, block (i), partition start1 + real(i-1)) 

+ PER ; 

+ENDPROC read shard ; 

+ 

+ 

+PROC write shard : 

+ INT VAR i ; 

+ FOR i FROM 1 UPTO shard bloecke REP 

+  IF modified (i) 

+     THEN IF session <> old session 

+             THEN errorstop ("RERUN während patch") 

+          FI ; 

+          blockout (setup channel, block (i), partition start1+real(i-1)) ; 

+          modified (i) := FALSE 

+  FI ; 

+  cout (i)

+ PER 

+ENDPROC write shard ; 

+ 

+REAL PROC real24 (INT CONST high, low) : 

+ real (high) * 65536.0 + low real . 

+ 

+low real : 

+ IF low < 0 

+    THEN real (low) + 65536.0 

+    ELSE real (low) 

+ FI 

+ENDPROC real24 ;

+ 

+PROC split real24 (REAL CONST r, INT VAR high, low) : 

+ high := int (r/65536.0) ; 

+ low := (code (int (r MOD 256.0)) + 

+         code (int ((r MOD 65536.0)/256.0))) ISUB1

+ENDPROC split real24 ; 

+

+PROC patch shard : 

+ get partition ; 

+ read shard ; 

+ check if patch possible ; 

+ patch baudrate ;

+ patch id and mode ; 

+ patch typematic ;

+ patch refresh ; 

+ patch modem status ; 

+ patch cursor maxima ; 

+ patch attribute bytes ; 

+ patch out restart ; 

+ patch dtr inactive ; 

+ patch mcr set routine ; 

+ patch archive 1 format ; 

+ IF yes ("Änderungen permanent machen") 

+    THEN write shard ; 

+         putline ("Änderungen durchgeführt, System neu booten.") ;

+    ELSE putline ("Keine Änderungen durchgeführt.") ; 

+ FI . 

+ 

+check if patch possible : 

+ IF peek2 (&"0300") <> &"05EA" 

+    THEN errorstop ("Partition enthaelt keinen SHard") 

+    ELSE IF peek2 (shard ver) <> 7 

+            THEN errorstop ("Dies ist die falsche SHard-Version")

+         ELIF peek2 (id6) = patch version 

+            THEN putline ("Hinweis: Dieser SHard wurde bereits gepatcht") 

+         ELIF peek2 (id6) <> 0 

+            THEN putline ("Der SHard-Patch wird upgedated") 

+         FI 

+ FI . 

+ 

+shard ver: &"0554" . 

+mode:      &"0556" . 

+id 6:      &"055C" . 

+ 

+patch baudrate :

+ putline ("Baudrates 50, 75 entfernt, 19200, 38400 eingefügt.") ; 

+ poke2 (&"07E8", 1047) ; (*  3:   110 *) 

+ poke2 (&"07EA",  857) ; (*  4:   134.5 *) 

+ poke2 (&"07EC",  768) ; (*  5:   150 *) 

+ poke2 (&"07EE",  384) ; (*  6:   300 *) 

+ poke2 (&"07F0",  192) ; (*  7:   600 *) 

+ poke2 (&"07F2",   96) ; (*  8:  1200 *) 

+ poke2 (&"07F4",   64) ; (*  9:  1800 *) 

+ poke2 (&"07F6",   48) ; (* 10:  2400 *) 

+ poke2 (&"07F8",   32) ; (* 11:  3600 *) 

+ poke2 (&"07FA",   24) ; (* 12:  4800 *) 

+ poke2 (&"07FC",   16) ; (* 13:  7200 *) 

+ poke2 (&"07FE",   12) ; (* 14:  9600 *) 

+ poke2 (&"0800",    6) ; (* 15: 19200 *) 

+ poke2 (&"0802",    3) ; (* 16: 38400 *) 

+   

+ (* Korrektur der Adressoffsetberechnung auf Baudtable *) 

+ (* Maschinencode nicht veraendern! 

+    08F4: 

+    i8250_baud: 

+      CMP BH,17 

+      JNC i8250_not_ok 

+      CMP BH,3 

+      JC  i8250_not_ok 

+      .... 

+    0918:

+      MOV AX,WORD PTR i8250_baud_table-6[BX] 

+*) 

+ poken (&"08F4", "17 73 75 80 FF 03 72 70") ; 

+ poken (&"0918", "87 E2") . 

+ 

+patch id and mode : 

+ poke2 (id6, patch version) ; (* Update Patch Version *)

+ IF yes ("Soll ein Vortest durchgeführt werden") 

+    THEN IF yes ("Soll ein Speichertest durchgefuehrt werden") 

+            THEN poke2 (mode, 0) 

+            ELSE poke2 (mode, 256) 

+         FI

+    ELSE poke2 (mode, 512) 

+ FI . 

+ 

+patch modem status: 

+  poke (&"0A5D", 6) . (* Modem Status Register Offset = 6 *) 

+ 

+patch typematic: (* Nur mit ruc-Bios *) 

+ INT VAR typematic ; 

+ IF yes ("Schneller Keyboardrepeat") 

+    THEN typematic := 4 (* Fast *) 

+    ELSE typematic := 2 * 256 + 12 (* Standard *) 

+ FI ; 

+ (* Maschinencode, nicht veraendern! 

+ 0E20: 

+   XOR  AX,AX           ; Set Default Video Mode 

+   INT  10H 

+    MOV  AX,0342        ; Set Typematic + Marwin 

+    MOV  BX,typematic   ; BH = Delay (0..3), BL = Rate (0..31) 

+    INT  16H             

+ 0E2C: 

+     MOV  AL,54H        ; Ab hier in 'patch refresh' 

+     OUT  [43H],AL      ; 

+     JMP  $+2           ;

+     MOV  AL,interval   ; interval = 1.19 * us 

+     OUT  [41H],AL      ;

+   RET                  ; End pc_init

+*) 

+ poken (&"0E20", "33 C0 CD 10 B8 42 03 BB " + %typematic + " CD 16 C3") . 

+ (* RET wird ueberschrieben von Refresh *) 

+ 

+patch refresh: 

+ INT VAR refresh ; 

+ TEXT VAR ref := "15.126" ;

+ line ; 

+ putline ("215us Refresh-Intervall bringen 5% mehr RAM-Performance.") ; 

+ putline ("Achtung: Nicht bei allen RAMs moeglich (z.B. 120ns Toshiba nicht).") ;

+ put ("RAM-Refresh Intervall (in us):") ; 

+ editget (ref) ; line ; 

+ refresh := int (1.19 * real (ref) + 0.5) ; 

+ IF refresh < 1 

+    THEN refresh := 1 

+ ELIF refresh > 255 

+    THEN refresh := 256 

+ FI ; 

+ put (real (refresh) / 1.19) ; 

+ putline ("us Refresh-Intervall eingestellt.") ;

+ IF refresh = 256 THEN refresh := 0 FI ; 

+ poken (&"0E2C", "B0 54 E6 43 EB 00 B0 " + subtext (%refresh, 3, 4) + 

+                " E6 41 C3") . 

+ 

+patch cursor maxima: 

+(* Es werden nur die Maxima bei CURSOR(,) veraendert, CLEOL, CLEOP,SCROLL 

+    etc. arbeiten weiter mit 24 Zeilen, 80 Spalten *) 

+ (* CURSOR y:0..43, x:0..89 EUMEL lässt allerdings nur 0..79 zu *)

+ poke (&"0EFF", 43) ; 

+ poke (&"0F16", 89) . 

+ 

+patch attribute bytes: 

+ poke (&"0FD4", 0) ; poke (&"0FE8", 0) ; (* CLEOP *) 

+ poke (&"1002", 0) ; (* CLREOL *) 

+ poke (&"1027", 0) . (* SCROLL *) 

+ 

+patch out restart : 

+ poke (&"09BA", 0) . (* out_restart immer: JP $+0 *) 

+ 

+patch dtr inactive : 

+ poke (&"0A30", 8) . (* RTS + DTR inaktiv, OUT2 muss an bleiben *) 

+ 

+patch mcr set routine :

+ (* 

+  0812: 20 Bytes zur Verfügung

+   MOV  DX,(DI+i8250_base) 

+   ADD  DX,i8250_mcr 

+   MOV  AL,BH        ; Highbyte 2. IOCONTROL Parameter 

+   OUT  [DX],AL 

+   MOV  CX,0 

+   RET 

+  *) 

+ poken (&"0812", "8B 95 1B 00 83 C2 04 88 F8 EE B9 00 00 C3") . 

+ 

+patch archive 1 format :

+ line ; 

+ putline ("Archiv-Kanal 30-Laufwerk (bitte Typnummer angeben):") ; 

+ putline ("  0: Nicht vorhanden") ; 

+ putline ("  1: 360K (Standard/Doublestep)") ; 

+ putline ("  2: 720K (Standard/Singlestep)") ; 

+ putline ("  3: 1.2MB (Multifunction)") ; 

+ putline ("ESC: Nichts verändern") ; 

+ put ("Typ:") ; 

+ TEXT VAR t ; 

+ REP inchar (t) UNTIL t >= "0" AND t <= "3" OR t = ""27"" PER ; 

+ putline (t) ; 

+ line ;

+ IF t = "0" OR t = "1" 

+    THEN poken (&"21DE", "00 01") 

+ ELIF t = "2" 

+    THEN poken (&"21DE", "04 02")

+ ELIF t = "3" 

+    THEN poken (&"21DE", "01 03") 

+ FI . 

+ 

+ENDPROC patch shard ; 

+ 

+PROC blockin (INT CONST kanal, ROW 256 INT VAR block, REAL CONST blockno) :

+ INT VAR r, my channel :: channel, high, low ; 

+ split real24 (blockno, high, low) ; 

+ continue (kanal) ; 

+ blockin (block, high AND 255, low, r) ; 

+ continue (my channel) ; 

+ SELECT r OF 

+   CASE 0 :

+   CASE 1 : errorstop ("Harddisk kann nicht gelesen werden")

+   CASE 2 : errorstop ("Lesefehler bei Block " + text (blockno))

+   CASE 3 : errorstop ("Block " + text(blockno) + " zu hoch")

+  OTHERWISE errorstop ("unbekannter Lesefehler auf Harddisk")

+ ENDSELECT .

+ 

+ENDPROC blockin ; 

+

+PROC blockout (INT CONST kanal, ROW 256 INT VAR block, REAL CONST blockno):

+ INT VAR r, my channel :: channel, high, low ; 

+ split real24 (blockno, high, low) ; 

+ continue (kanal) ; 

+ blockout (block, high AND 255, low, r) ; 

+ continue (my channel) ; 

+ SELECT r OF 

+   CASE 0 :

+   CASE 1 : errorstop ("Harddisk kann nicht beschrieben werden")

+   CASE 2 : errorstop ("Schreibfehler bei Block " + text (blockno))

+   CASE 3 : errorstop ("Block " + text (blockno) + " zu hoch")

+  OTHERWISE errorstop ("unbekannter Schreibfehler auf Harddisk")

+ ENDSELECT .

+ 

+ENDPROC blockout ; 

+

+PROC get media size (INT CONST kanal, INT VAR cyls, heads, secs) : 

+ INT CONST old channel :: channel ; 

+ continue (kanal) ;

+ control (-10, 0, 0, cyls) ; cyls INCR 1 ; 

+ control (-11, 0, 0, secs) ;

+ control (-12, 0, 0, heads) ; 

+ continue (old channel)

+ENDPROC get media size ; 

+(*

+PROC dump block (INT CONST adr) : 

+TEXT VAR t ; 

+FOR i FROM adr UPTO adr+511 REP 

+ IF (i AND 15) = 0 

+    THEN line ; 

+         put (%i+":") ; 

+         t := "" ; 

+ FI ;

+ INT CONST j :: peek (i) ; 

+ IF j < 32 OR j > 126 THEN t CAT "." 

+ ELSE t CAT code (j) FI ; 

+ outsubtext (%j, 3, 4) ;

+ out (" ") ; 

+ IF (i AND 15) = 15 

+    THEN out (t)

+ FI 

+PER ; 

+line 

+ENDPROC dump block ; 

+ 

+putline ("Partitionstabelle lesen...") ; 

+get partition ; 

+putline ("SHard lesen...") ; 

+read shard ; 

+put (%peek (1364)) ; 

+*)

diff --git a/system/shard-x86-at/7/src/PATCHARE.ASM b/system/shard-x86-at/7/src/PATCHARE.ASM
new file mode 100644
index 0000000..c62ffdb
--- /dev/null
+++ b/system/shard-x86-at/7/src/PATCHARE.ASM
@@ -0,0 +1,16 @@
+;********************************************************

+;*==== Copyright (C) 1985,86 Martin Schoenbeck, Spenge =*

+;*                                                      *

+;* Bereich, der vom setup-Programm gepatcht wird        *

+;*                                                      *

+;********************************************************

+

+     if at

+bb_table dw 32 DUP (-1)

+         dw 32 DUP (-1)

+max_bb equ 32

+bb_anz dw 0

+     else

+bt_table dw 8 DUP (-1)   ;diese kopf/spur Kombination ist unmoeglich

+bt_replace dw 8 DUP (-1) ;ersatz

+     endif

diff --git a/system/shard-x86-at/7/src/PCPAR.ASM b/system/shard-x86-at/7/src/PCPAR.ASM
new file mode 100644
index 0000000..0bca2c5
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCPAR.ASM
@@ -0,0 +1,225 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Routinen fuer IBM - PC Parallel - Schnittstelle im EUMEL - System     *

+;*                                                                         *

+;*                                                                         *

+;***************************************************************************

+

+     device parallel

+

+     dtcbroutines iocontrol

+     routine 1,para_devicetype

+     routine 2,para_frout

+     routine 5,nil_size

+     routine -3,para_force_rom_output

+     routine -4,para_set_wait

+     routine -1,no_channel_setup

+

+     dtcbroutines control32

+     routine -2,para_init

+     routine -1,no_channel_setup

+

+     dtcbroutines blockin

+     dtcbroutines blockout

+     routine -1,unknowncontrol

+

+     dtcbparams para_output,3   ;typ = nur stream io

+

+

+;******************************************************************

+;*   der macro para_ccb muss fuer jede parallelschnittstelle im system

+;*   einmal aufgerufen werden

+;*

+;*   parameter: 

+

+para_ccb macro par,kanal

+     startccb para&par&ccb,kanal

+ccbentry para_number

+     dw par

+ccbentry para_stat

+     db 0

+ccbentry para_statusandmask

+     db 80h                        ;;busy abfragen

+ccbentry para_statusxormask

+     db 80h                        ;;active high

+ccbentry para_wait                 ;;wie lange vor busy warten

+     db 1

+ccbentry para_retry

+     db 30                         ;;> 100 usec minimum

+     endm

+

+para_rom_mode equ 1

+

+para_devicetype:

+     mov cx,0                      ;erstmal 0 setzen

+     call para_get_port

+     ifnz <mov cl,shard:(si+devtype)>     ;type dazu

+     ret

+

+para_init:

+     call para_get_port

+     ifz <ret>

+     test dx,0fc03h                ;ist die adresse ibm like

+     jnz para_rom_init

+     inc dx

+     inc dx                        ;auf status ausgabe zeigen

+     mov al,8                      ;init leitung aktivieren

+     out (dx),al

+     mov ax,4000

+para_ini_loop:

+     dec ax

+     jnz para_ini_loop             ;warte ein weilchen

+     mov al,0ch                    ;kein auto lf, init high

+     out (dx),al

+     ret

+

+para_rom_init:

+     mov ah,1

+     mov dx,[di+para_number]

+     int 17h

+     ;es passt noch

+     mov bx,dx                     ;nummer nach bx

+     mov byte ptr es:[078h+bx],1 ;timeout wert,falls er doch mal busy kriegt

+     ret

+

+para_set_wait:

+     inc dl

+     mov [di+para_wait],dl

+     inc dh

+     mov [di+para_retry],dh

+     ret

+

+para_force_rom_output:

+     or byte ptr [di+para_stat],para_rom_mode

+     ret

+

+para_output:

+     jcxz para_all

+     push es

+     push bx

+     call para_get_port

+     pop bx

+     pop es

+     jz para_all                   ;kein port, dann wegwerfen

+     test dx,0fc03h                ;ist die adresse ibm like

+     jnz para_rom_output           ;nein, ueber rom raus

+     test byte ptr [di+para_stat],para_rom_mode

+     jnz para_rom_output

+     push cx

+     inc dx                   ;auf status gehen

+para_out_loop:

+     push cx

+     mov cl,[di+para_wait]

+     sub ch,ch                ;0 nach ch

+     loop $                   ;pause fuer langsame drucker

+     mov cl,[di+para_retry]

+     ;ch ist 0

+para_ow_loop:                 ;warten, bis output erlaubt

+     in al,dx                 ;status holen

+     and al,(di+para_statusandmask) ;welche bits interessieren uns

+     xor al,(di+para_statusxormask) ;und wie sollen sie stehen

+     jz para_ready            ;passt, ausgeben

+     loop para_ow_loop

+     pop dx                   ;restlaenge holen

+     pop cx                   ;gesamtlaenge holen

+     sub cx,dx                ;uebernommene laenge melden

+                              ;carry ist geloescht

+     ret

+

+para_ready:

+     pop cx                   ;zeichenzaehler zurueckholen

+     dec dx                   ;auf port direkt gehen

+     mov al,byte ptr es:[bx]  ;zeichen holen

+     inc bx                   ;auf naechstes zeichen

+     out (dx),al              ;zeichen ausgeben

+     inc dx

+     inc dx                   ;auf port fuer strobe zeigen

+     mov al,0dh               ;strobe ist bit 0

+     out (dx),al

+     jmp short $+2

+     mov al,0ch               ;und strobe zuruecknehmen

+     out (dx),al

+     dec dx                   ;auf status port gehen

+     loop para_out_loop       ;naechstes ausgeben

+     pop cx                   ;alles ausgegeben

+para_all:

+     stc

+     ret

+

+para_rom_output:

+     push cx

+     mov dx,[di+para_number]

+para_rom_out_loop:

+     push cx

+     mov cl,[di+para_wait]

+     sub ch,ch

+     loop $                   ;pause fuer langsame drucker

+     mov cl,[di+para_retry]

+     shr cl,1                 ;durch 16

+     shr cl,1

+     shr cl,1

+     shr cl,1                 

+     inc cl                   ;aber nie 65000 mal     

+para_rom_ow_loop:             ;warten, bis output erlaubt

+     mov ah,2                 ;status holen

+     int 17h

+     and ah,(di+para_statusandmask) ;welche bits interessieren uns

+     xor ah,(di+para_statusxormask) ;und wie sollen sie stehen

+     jz para_rom_ready            ;passt, ausgeben

+     loop para_rom_ow_loop

+     pop dx                   ;restlaenge holen

+     pop cx                   ;gesamtlaenge holen

+     sub cx,dx                ;uebernommene laenge melden

+                              ;carry ist geloescht

+     ret

+

+para_rom_ready:

+     pop cx                   ;zeichenzaehler zurueckholen

+     mov al,byte ptr es:[bx]  ;zeichen holen

+     inc bx                   ;auf naechstes zeichen

+     mov ah,0                 ;zeichen ausgeben

+     int 17h

+     loop para_rom_out_loop   ;naechstes ausgeben

+     pop cx                   ;alles ausgegeben

+     stc

+     ret

+

+para_frout:

+     call para_get_port

+     jz para_frout_ok

+     test dx,0fc03h                ;ist die adresse ibm like

+     jnz para_rom_frout            ;nein, ueber rom fragen

+     test byte ptr [di+para_stat],para_rom_mode

+     jnz para_rom_frout

+     inc dx                   ;auf status gehen

+     in al,dx                 ;status holen

+     and al,(di+para_statusandmask) ;welche bits interessieren uns

+     xor al,(di+para_statusxormask) ;und wie sollen sie stehen

+     jnz para_frout_not_ok    ;passt nicht, melden

+para_frout_ok:

+     mov cx,50                ;kann ausgeben

+     stc                      ;puffer leer

+     ret

+

+para_rom_frout:

+     mov dx,[di+para_number]

+     mov ah,2                 ;status holen

+     int 17h

+     and ah,(di+para_statusandmask) ;welche bits interessieren uns

+     xor ah,(di+para_statusxormask) ;und wie sollen sie stehen

+     jz para_frout_ok         ;passt, melden

+para_frout_not_ok:

+     mov cx,0                 ;nichts passt

+     clc                      ;puffer nicht leer

+     ret

+

+para_get_port:

+     ;setzt zero flag, wenn port = 0

+     mov ax,40h                    ;ins pc datensegment

+     mov es,ax

+     mov bx,[di+para_number]       ;welcher printer

+     shl bx,1                      ;fuer basis adresse passend

+     mov dx,es:[8+bx]              ;printer basis adresse holen

+     or dx,dx                      ;0?

+     ret

diff --git a/system/shard-x86-at/7/src/PCPLOT.ASM b/system/shard-x86-at/7/src/PCPLOT.ASM
new file mode 100644
index 0000000..a922bd7
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCPLOT.ASM
@@ -0,0 +1,429 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Graphikroutinen fuer IBM - PC                                          *

+;*                                                                          *

+;*                                                                          *

+;****************************************************************************

+

+gr_base dw 03d0h                 ;default grahpic adress

+

+gr_pointer equ 4                 ;pointer register of 6845

+gr_data equ 5                    ;data register of 6845

+gr_msr equ 8                     ;mode select register

+gr_csr equ 9                     ;color select register

+gr_status equ 10                 ;status register

+gr_xmsr equ 10                   ;extended mode select register

+gr_cfgswitch equ 15              ;hercules config switch

+

+switch_mode:

+     cmp dh,1

+     jz gm_switch                ;tecmar graphics master

+     cmp dh,2                    ;hercules

+     jz herc_switch

+     push dx

+     push ax

+     mov dx,[gr_base]

+     add dx,gr_xmsr              ;tecmar auf normal mode setzen

+     mov al,0

+     out (dx),al

+     jmp short $+2               ;io pause machen

+     add dx,gr_cfgswitch-gr_xmsr ;hercules configswitch

+     out (dx),al

+     pop ax

+     pop dx

+     mov byte ptr [plot_mode],0  ;kein mode, den wir direkt auswerten

+     mov al,dl

+     mov ah,0

+     int 10h                     ;auf gewuenschten mode schalten

+     mov cx,0

+     jnc mode_ok

+unallowed_mode:

+     mov cx,-1

+mode_ok:

+     ret

+

+herc_switch:

+     mov word ptr [gr_base],03b0h

+     cmp dl,1                    ;mode 0 ist erlaubt

+     jnc unallowed_mode

+     add dl,6                    ;da steht der erste herculesmode

+     jmp short all_allowed

+gm_switch:                       ;tecmar graphics master

+     cmp dl,6                    ;werte 0 bis 5 erlaubt

+     jnc unallowed_mode

+     push dx

+     mov dx,[gr_base]

+     add dx,gr_status            ;statusregister holen

+     in al,dx

+     pop dx

+     test al,80h                 ;schalter auf monochrom

+     jnz all_allowed             ;nein, alle modi erlaubt

+     cmp dh,2                    ;nur 0 und 1

+     jnc unallowed_mode

+all_allowed:

+     mov byte ptr [plot_mode],1  ;merken, dass in erweitertem mode

+     mov dh,0

+     mov ax,offset mod_tb_length ;laenge einer tabelle

+     mul dx                      ;auf passende tabelle zeigen

+     mov bx,ax

+     add bx,offset mod_tables    ;auf erstes byte der tabelle

+;

+     mov ah,13                   ;vierzehn register muessen ausgegeben werden

+     mov dx,[gr_base]

+     add dx,gr_msr               ;da ist mode select register unserer graphik

+     mov al,0                    ;disable screen output

+     out (dx),al

+     jmp short $+2

+     add dx,gr_cfgswitch-gr_msr  ;hercules einschalten (wenn da)

+     mov al,3

+     out (dx),al

+     sub dx,gr_cfgswitch-gr_pointer

+

+set_6845:

+     mov al,ah

+     out (dx),al                 ;in dieses register wollen wir schreiben

+     inc dx                      ;und hier muss der wert hin

+     mov al,byte ptr [bx]

+     inc bx                      ;auf naechstes feld

+     out (dx),al

+     dec dx                      ;wieder auf zeiger_register

+     dec ah

+     jns set_6845                ;bis nummer negativ

+;

+     cld

+     mov cx,08000h               ;fill 64k

+     mov ax,0a000h

+     mov es,ax

+     xor ax,ax                   ;fill with 0

+     xor di,di                   ;start at 0 in area

+     rep stosw

+     mov cx,08000h

+     mov ax,0b000h               ;next 64k

+     mov es,ax

+     xor ax,ax                   ;fill with 0

+     xor di,di                   ;start at 0 in area

+     rep stosw

+;

+     mov al,byte ptr[bx]         ;csr wert holen

+     inc bx

+     add dx,gr_csr-gr_pointer

+     out (dx),al

+;

+     inc dx                      ;to xmsr

+     mov al,byte ptr [bx]

+     inc bx

+     out (dx),al

+;

+     sub dx,gr_xmsr-gr_msr       ;to msr

+     mov al,byte ptr [bx]

+     inc bx

+     out (dx),al

+;

+     mov ax,word ptr [bx]        ;laenge einer graphik zeile

+     inc bx

+     inc bx

+     mov word ptr [gr_linelength],ax

+;

+     mov al,byte ptr [bx]        ;maske, um ein pixel zu behalten

+     push ds

+     pop es

+     mov cx,16

+     mov di,offset color_tab

+     rep stosb                   ;farbtabelle auf 3 initalisieren

+     mov ah,0

+     inc bx

+     mov word ptr [gr_pixel_mask],ax

+     xor al,0ffh                 ;maske erzeugen, die ein pixel loescht

+     mov byte ptr [gr_pixel_inv_mask],al

+;

+     mov word ptr [first_shift],9090h ;ersten shift wegnoppen

+     test byte ptr [bx],1        ;vier segmente ?

+     ifnz <mov word ptr [first_shift],0ebd1h> ;shift wieder eintragen

+     inc bx

+;

+     mov al,byte ptr [bx]        ;mask fuer pixel_pro_byte holen

+     inc bx

+     mov byte ptr [gr_pixel_per_byte_mask],al

+     mov word ptr [shift_count_shift],0c902h ;volles shift annehmen

+     mov word ptr [shift_count_shift+2],0c902h ;add cl,cl

+     mov ah,1                    ;anzahl shifts, um byteoffset zu kriegen

+     shr al,1                    ;bei mehr als zwei pixel ein shift weniger

+     jz shifts_nopped

+     inc ah

+     mov word ptr [shift_count_shift],09090h ;nops

+     shr al,1                    ;bei acht pixel gar kein shift

+     jz shifts_nopped

+     inc ah

+     mov word ptr [shift_count_shift+2],09090h ;nops

+shifts_nopped:

+     mov byte ptr [gr_byte_calc_shift],ah

+;

+     mov si,bx

+     mov di,offset gr_segtable

+     mov cx,4

+     rep movsw                   ;segmentwerte uebertragen

+     add bx,8

+     mov cx,0

+     ret

+

+pen:

+     mov word ptr [maske],dx

+     mov byte ptr [linetype],bl

+     ret

+

+new_pen1:

+     mov cx,bx                   ;bx merken

+     mov bx,offset color_tab

+     call set4

+     mov cx,dx

+     call set4

+     ret

+

+new_pen2:

+     mov cx,bx                   ;bx merken

+     mov bx,offset color_tab+8   ;zweite haelfte der tabelle

+     call set4

+     mov cx,dx

+     call set4

+     ret

+

+set4:

+     call set2

+     mov cl,ch

+set2:

+     mov al,cl

+     and al,15                   ;nur untersten 4 bits behalten

+     mov byte ptr [bx],al

+     inc bx

+     mov al,cl

+     mov cl,4

+     shr al,cl                   ;obersten 4 bits

+     mov byte ptr [bx],al

+     inc bx

+     ret

+

+mask_mode:

+     mov word ptr [jmp_or_not],9090h ;set mask mode

+     mov cx,word ptr [mask_count] ;alten mask_count zurueckliefern

+     mov word ptr [mask_count],bx

+     cmp dx,0                    ;wirklich mask_mode gewuenscht

+     ifz <mov word ptr [jmp_or_not],07ebh> ;nein, sprung wieder einbauen

+     ret

+

+move:

+     mov word ptr [altx],dx      ;neuen x wert

+     mov word ptr [alty],bx      ;und y wert setzen

+     ret

+

+draw:

+     mov byte ptr [stepx],46h ;inc si

+     mov byte ptr [stepy],47h ;inc di

+     mov cx,dx                   ;in welche richtung wie weit gehen

+     sub cx,word ptr [altx]

+     jns positiv_x

+     neg cx                      ;negative richtung, positiv machen und

+     mov byte ptr [stepx],4eh ;dec si zum ausgleich

+positiv_x:

+     mov dx,bx                   ;y wert holen

+     sub dx,word ptr [alty]      ;wie weit und welche richtung

+     jns positiv_y

+     neg dx                      ;negative richtung, positiv rechnen und

+     mov byte ptr [stepy],4fh ;dec di zur korrektur

+positiv_y:

+     cmp dx,cx                   ;hauptrichtung entlang des groesseren

+                                 ;offsets

+     jc direction_ok             ;hauptrichtung war entlang si

+     mov bx,word ptr [stepy]  ;richtungen tauschen

+     xchg bh,bl

+     mov word ptr [stepy],bx

+     xchg cx,dx                  ;und richtungslaengen tauschen

+                                 ;hauptrichtung ist jetzt entlang di

+direction_ok:

+                                 ;der wert fuer die hauptrichtung ist

+                                 ;in cx, fuer die nebenrichtung in dx

+                                 ;der fehlerwert der nebenrichtung in

+                                 ;1/abs(hauptrichtung) - einheiten ist in bx

+     mov bx,0                    ;fehlerwert ist im moment 0

+     mov word ptr [delta_x],cx   ;wert fuer hauptrichtung merken

+     mov si,word ptr [altx]      ;alte werte holen

+     mov di,word ptr [alty]

+paint:

+     jcxz paint_done             ;fertig, letzten punkt noch malen

+     sub bx,dx                   ;ist gerader fehler schon negativ

+     jns stepx                   ;nur hauptrichtung nehmen

+     mov ax,bx                   ;geraden fehler nach ax

+     add ax,ax                   ;

+     add ax,word ptr [delta_x]   ;

+     jns stepx                   ;nur hauptrichtung

+     add bx,word ptr [delta_x]

+stepy:

+     inc di

+stepx:

+     inc si

+

+; errechneten punkt setzen

+

+     call punkt

+

+     loop paint

+

+paint_done:

+     call punkt                  ;letzten punkt setzen

+     mov word ptr [alty],di

+     mov word ptr [altx],si

+     ret

+

+

+punkt:

+     test byte ptr [plot_mode],0ffh

+     jnz new_punkt

+     push cx

+     push dx

+     mov dx,di

+     mov cx,si

+     ror word ptr maske,1

+linetype equ $+1

+     mov ax,0c01h                ;write dot

+     and al,byte ptr [maske]      ;linie einbauen

+     int 10h

+     pop dx

+     pop cx

+     ret

+

+new_punkt:

+     push ax

+     push bx

+     push cx

+     push dx

+     push es

+     mov bx,di

+     and bx,3

+     add bx,bx                   ; *2

+     mov es,[bx+gr_segtable]     ;in diesem segment liegt unser punkt

+gr_linelength equ $+1

+     mov ax,720/4                ;bytes pro zeile horizontal

+     mov bx,di                   ;y wert wieder holen

+first_shift:                     ;dieser shift faellt bei zwei segmenten aus

+     shr bx,1

+     shr bx,1                    ;di / 4

+     mul bx                      ;mal anzahl bytes pro graphikzeile

+     mov bx,si                   ;byte in zeile ausrechnen

+gr_byte_calc_shift equ $+1

+     mov cl,2                    ;so oft si shiften, fuer byte in zeile

+     shr bx,cl

+     add bx,ax                   ;dies byte enthaelt unseren punkt

+     mov cx,si                   ;untersten bits geben shiftfaktor an

+     inc cx                      ;einmal mehr shiften (oder gar nicht)

+gr_pixel_per_byte_mask equ $+2

+     and cl,3                    ;vier pixel pro byte (15 fuer zwei pixel etc

+shift_count_shift:

+     add cl,cl                   ;shiftfaktor verdoppeln

+     add cl,cl                   ;oder vervierfachen

+     mov al,byte ptr es:[bx]     ;byte holen

+     rol al,cl                   ;pixel nach 0 holen

+     mov bp,ax                   ;evtl. wird pixelwert als index benutzt

+gr_pixel_mask equ $+2

+     and bp,3                    ;die pixel bits behalten

+jmp_or_not:

+     jmp short punkt_no_mask

+mask_count equ $+1               ;zaehler fuer maske

+     mov bp,0

+     and bp,15                   ;maskenzaehler MOD 16 nehmen

+punkt_no_mask:

+gr_pixel_inv_mask equ $+1

+     and al,0fch                 ;rest behalten

+     or al,byte ptr ds:[bp+color_tab] ;pixel setzen

+     ror al,cl                   ;zurueckdrehen

+     mov byte ptr es:[bx],al     ;wieder eintragen

+     inc word ptr ds:[mask_count]

+     pop es

+     pop dx

+     pop cx

+     pop bx

+     pop ax

+     ret

+

+ even

+

+maske dw 0ffffh

+altx dw 0

+alty dw 0

+delta_x dw 0

+;gr_pixel_mask dw 3               ;maske, welche bits zum pixel gehoeren

+;mask_count dw 0                  ;zaehler fuer maskiertes schreiben

+

+gr_segtable dw 0a000h            ;tabelle der graphik segmente

+            dw 0a800h

+            dw 0b000h

+            dw 0b800h

+

+

+;gr_linelength dw 720/4           ;laenge einer graphikzeile

+;mask_mod db 0                    ;nicht 0, wenn mit maske

+color_tab db 16 DUP (3)          ;farbtabelle

+

+plot_mode db 0

+

+;gr_pixel_inv_mask db 0fch        ;invertiert, nur byte

+

+

+

+mod_tables equ $

+;mode 0

+; 6845 regs 13       -                     0,csr,xmsr,msr

+     db 0,0,0,32,3,2,88,86,1,91,14,90,90,109,  0, 191, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+mod_tb_length equ $-mod_tables

+;mode 1

+; 6845 regs 13       -                     0,csr,xmsr,msr

+     db 0,0,0,32,3,3,88,86,1,91,14,90,90,109,  0, 191, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+;mode 2

+; 6845 regs 13       -                          0,csr,xmsr,msr

+     db 0,0,0,32,1,2,112,100,6,127,15,184,160,227,  0,  31, 24

+     dw 640/2                    ;laenge einer graphikzeile

+     db 15                       ;maske, um ein pixel zu behalten

+     db 0                        ;1 = 4 segmente, 0 = 2 segmente

+     db 1                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0a000h,0a800h ;die vier segmente

+;mode 3

+; 6845 regs 13       -                       0,csr,xmsr,msr

+     db 0,0,0,32,3,3,56,50,1,64,15,184,160,227,  0,  31, 24

+     dw 640/2                    ;laenge einer graphikzeile

+     db 15                       ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 1                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+;mode 4

+; 6845 regs 13       -                        0,csr,xmsr,msr

+     db 0,0,0,32,1,2,112,100,7,127,15,98,90,128,  0,  63, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 0                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0a000h,0a800h ;die vier segmente

+;mode 5

+; 6845 regs 13       -                     0,csr,xmsr,msr

+     db 0,0,0,32,3,3,56,50,3,64,15,98,90,128,  0,  63, 11

+     dw 720/4                    ;laenge einer graphikzeile

+     db 3                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 3                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente

+;mode 6 (hercules)

+; 6845 regs 13       -                  0,csr,xmsr,msr

+     db 0,0,0,0,3,2,87,87,2,91,7,46,45,53,  0,  0, 10

+     dw 720/8                    ;laenge einer graphikzeile

+     db 1                        ;maske, um ein pixel zu behalten

+     db 1                        ;1 = 4 segmente, 0 = 2 segmente

+     db 7                        ;maske, um si MOD pixel_pro_byte zu machen

+     dw 0b000h,0b200h,0b400h,0b600h ;die vier segmente

diff --git a/system/shard-x86-at/7/src/PCSCREEN.ASM b/system/shard-x86-at/7/src/PCSCREEN.ASM
new file mode 100644
index 0000000..62d37eb
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCSCREEN.ASM
@@ -0,0 +1,437 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Behandlung des PC Bildschirms und der Tastatur                        *

+;*                                                                         *

+;***************************************************************************

+

+     device pc

+

+     dtcbroutines iocontrol

+     routine 1,devicetype

+     routine 2,frout_ok

+     routine 5,nil_size

+     routine 6,priv_op_question

+     routine 8,priv_op_question

+     routine 9,priv_op_question

+     routine -3,set_attribute

+     routine -4,set_palette

+     routine -5,switch_mode

+     routine -6,draw

+     routine -7,move

+     routine -8,pen

+     routine -9,new_pen1

+     routine -10,new_pen2

+     routine -11,mask_mode

+

+     routine -1,unknowncontrol

+

+     dtcbroutines control32

+     routine -2,pc_init

+     routine -1,no_channel_setup

+

+     dtcbroutines blockin

+     dtcbroutines blockout

+     routine -1,unknowncontrol

+

+     dtcbparams pc_output,3   ;typ = nur stream io

+

+

+;***************************************************************************

+

+pc_init:

+breakaddress    equ     01bh*4  ;tastatur break adresse 

+     mov bx,0

+     mov es,bx                ;in die interrupt vektoren zeigen

+     mov word ptr es:[breakaddress+2],cs

+     mov word ptr es:[breakaddress],offset breakint

+     mov dx,0                 ;cursor in die obere ecke 

+     mov bh,0

+     mov ah,2                 ;cursor setzen

+     int 10h

+     mov ax,0600h             ;clear entire window

+     mov cx,0                 ;von oben

+     mov dx,25*256+80         ;bis unten

+     mov bh,7                 ;attribut

+     int 10h 

+     ret

+

+;

+breakint:

+                push cx

+                push ax

+                push ds

+                push cs

+                pop ds

+;               mov al,1

+;               mov ch,'i'

+;               call inputinterrupt

+                mov al,1

+                mov ch,2            ;sv

+                call inputinterrupt

+                pop ds

+                pop ax

+                pop cx

+                iret

+;

+;

+;

+REVERS          EQU     01110000B       ;ATTRIBUT FUER REVERS-VIDEO

+NORMAL          EQU     00000111B       ;ATTRIBUT FUER NORMAL-VIDEO

+HOME            EQU     1 

+RECHTS          EQU     2

+OBEN            EQU     3

+CLEOP           EQU     4               ;CLEAR TO END OF PAGE

+CLEOL           EQU     5               ;CLEAR TO END OF LINE

+CPOS            EQU     6               ;CURSOR-POSITIONIERUNG

+;                                        ES FOLGEN X- UND Y-KOORDINATE

+BELL            EQU     7 

+LINKS           EQU     8

+UNTEN           EQU     10

+RETURN          EQU     13

+BEGMARK         EQU     15

+ENDMARK         EQU     14

+MAXCOLS         EQU     79

+MAXLINES        EQU     23

+ATTRIBUT        DB      NORMAL

+CURFLAG         DB      0

+YPOS            DB      0

+;

+;***********************************************************************

+;*   output auf bildschirm des pc

+;*

+pc_output:

+       PUSH    CX     ;RETTE ORIGINALLAENGE DES STRINGS

+       CLD            ;DIRECTION FLAG : INCREM. SI

+       MOV     SI,BX

+OUT:   mov al,es:[si]    ;HOLE ZEICHEN

+       inc si

+       MOV     AH,CURFLAG

+       CMP     AH,0

+       JNZ     s0

+       CMP     AL,HOME

+       JZ      s1     ;CURSOR HOME VERLANGT ?

+       CMP     AL,RECHTS 

+       JZ      s2     ;CURSOR NACH RECHTS ?

+       CMP     AL,OBEN 

+       JZ      s3     ;CURSOR NACH OBEN ?

+       CMP     AL,CLEOP 

+       JZ      s4     ;LOESCHEN BIS BILDSCHIRMENDE ?

+       CMP     AL,CLEOL

+       JZ      s5     ;LOESCHEN BIS ZEILENENDE ?

+       CMP     AL,CPOS 

+       JZ      s6     ;CURSOR POSITIONIEREN ?

+       CMP     AL,LINKS

+       JZ      s7     ;CURSOR NACH LINKS?

+       CMP     AL,UNTEN

+       JZ      s8     ;CURSOR NACH UNTEN ?

+       CMP     AL,RETURN 

+       JZ      s9     ;CURSOR AN DEN ANFANG DER AKT. ZEILE ?

+       CMP     AL,BEGMARK 

+       JZ      s10    ;AB JETZT REVERS ?

+       CMP     AL,ENDMARK 

+       JZ      s11    ;WIEDER NORMALE VIDEO-DARSTELLUNG ?

+       CMP     AL,BELL

+       JZ      s12    ;KLINGELN ?

+;

+       PUSH    CX

+       PUSH    BX

+       PUSH    SI 

+       PUSH    AX     ;AKTUELLES ATTRIBUT

+       MOV     AL,ATTRIBUT

+       MOV     BL,AL

+       POP     AX

+       MOV     AH,9   ;SCHREIBEN MIT ATTRIBUT

+       MOV     BH,0   ;PAGE #

+       MOV     CX,1

+       INT     010H   ;CALL BIOS

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       INC     DL     ;COL = COL + 1

+       CMP     DL,MAXCOLS+1

+       JNZ     SAME_LINE

+       MOV     DL,0

+       CMP     DH,MAXLINES 

+       JZ      SCROLL_UP

+       INC     DH

+SAME_LINE:      MOV     AH,2

+       mov bh,0     ;page number 

+       INT     010H

+       POP     SI

+       POP     BX

+       POP     CX

+       JMP     DONE

+;

+SCROLL_UP:      CALL    SCROLL

+       JMP     SAME_LINE 

+;

+DONE:  DEC     CX     ;ANZAHL ZEICHEN = ANZAHL ZEICHEN - 1

+       JNZ     OUT    ;WEITER ?

+       POP     CX     ;ANZAHL UEBERNOMMENE ZEICHEN (S.O.)

+       RET

+; 

+s0:    JMP     CUR1

+s1:    JMP     CURHOME

+s2:    JMP     RIGHT

+s3:    JMP     UP

+s4:    JMP     CLEAREOP

+s5:    JMP     CLEAREOL

+s6:    JMP     CURPOS

+s7:    JMP     LEFT

+s8:    JMP     DOWN

+s9:    JMP     ENTER

+s10:   JMP     MARK

+s11:   JMP     UNMARK

+s12:   JMP     KLINGELN

+;

+;

+CURPOS:MOV     AL,2

+       MOV     CURFLAG,AL

+       JMP     DONE

+;

+CUR1:  CMP     AH,1

+       JZ      CURX

+     cmp al,maxlines

+     jc  cur1ok

+     mov al,maxlines

+cur1ok:

+       MOV     YPOS,AL

+       DEC     CURFLAG

+       JMP     DONE

+

+CURX:  DEC     CURFLAG

+       MOV     DH,YPOS;Y-KOORDINATE

+     cmp  al,maxcols

+     jc   curxok

+     mov  al,maxcols

+curxok:

+       MOV     DL,AL  ;X-KOORDINATE

+       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     BH,0   ;PAGE #

+       MOV     AH,2   ;SET CURSOR POSITION

+       INT     010H   ;CALL BIOS

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+CURHOME:        PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     BH,0   ;PAGE #

+       MOV     DX,0000H        ;POSITION (0,0)

+       MOV     AH,2

+       INT     010H   ;CALL BIOS

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+RIGHT: PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       CMP     DL,MAXCOLS      ;X-POSITION DES CURSOR ZU GROSS?

+       JZ      RUNTER

+       INC     DL     ;COL = COL + 1

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+RUNTER:MOV     DL,0

+       MOV     BH,0

+     mov  ah,2

+       INT     010H

+       JMP     down1

+; 

+LEFT:  PUSH    BX     ;KOMMENTARE : S.O.

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       DEC     DL

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+UP:    PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       DEC     DH

+       MOV     AH,2 

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+DOWN:  PUSH    BX

+       PUSH    CX

+       PUSH    SI

+down1:       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       CMP     DH,MAXLINES

+       JZ      SCRL

+       INC     DH

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+SCRL:  CALL    SCROLL

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+;

+ENTER: PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3

+       MOV     BH,0

+       INT     010H

+       MOV     DL,0

+       MOV     AH,2

+       INT     010H

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+;

+CLEAREOP:       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       MOV     CX,DX  ;CURRENT CURS.POS = UPPER LEFT CORNER

+       MOV     DL,maxcols      ;END OF LINE

+       MOV     AX,600H;AH=6 : SCROLL AL=0 : BLANK WINDOW

+       MOV     BH,7   ;ATTRIBUTE FOR CLS

+       INT     010H   ;CLEAR TO END OF LINE

+       MOV     CL,0

+       CMP     DH,MAXLINES

+       JZ      FERTIG

+       INC     CH

+       MOV     DH,MAXLINES     ;NEW LOWER RIGHT CORNER 

+       MOV     DL,MAXCOLS

+       MOV     AX,600H

+       MOV     BH,7   ;ATTRIBUTE FOR CLS

+       INT     010H

+FERTIG:POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+CLEAREOL:       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,3   ;GET CURRENT CURSOR-POSITION

+       MOV     BH,0   ;PAGE #

+       INT     010H   ;CALL BIOS

+       MOV     CX,DX  ;CURRENT CURS.POS = UPPER LEFT CORNER

+       MOV     DL,maxcols      ;END OF LINE

+       MOV     AX,600H;AH=6 : SCROLL AL=0 : BLANK WINDOW

+       MOV     BH,7   ;ATTRIBUTE FOR CLS

+       INT     010H   ;CLEAR TO END OF LINE

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+MARK:

+       MOV     ATTRIBUT,revers

+       JMP     DONE

+;

+UNMARK:

+       MOV     ATTRIBUT,normal 

+       JMP     DONE

+;

+SCROLL:MOV     AH,6

+       MOV     AL,1   ;SCROLL WINDOW ONE LINE UP

+       MOV     CX,0000H        ;UPPER LEFT CORNER : (0,0)

+       MOV     DH,MAXLINES

+       MOV     DL,MAXCOLS

+       mov bh,7          ;attribute for scroll

+       INT     010H

+       MOV     DH,MAXLINES

+       MOV     DL,0

+       MOV     BH,0   ;PAGE #

+       RET

+;

+;

+KLINGELN:       PUSH    BX

+       PUSH    CX

+       PUSH    SI

+       MOV     AH,14

+       MOV     BH,0

+       INT     010H   ;PIEEPS

+       POP     SI

+       POP     CX

+       POP     BX

+       JMP     DONE

+;

+set_attribute:

+     mov attribut,dl

+     ret

+

+set_palette:

+     mov ah,11                ;set color palette

+     int 10h

+     ret

+

+;

+;

+;

+;**********************************************************************

+;*

+;*   checkkey prueft ob ein zeichen auf der tastatur eingegeben wurde

+;*   und uebergibt dies ggf. dem EUMEL;

+;*   muss regelmaessig (z.B. aus timerinterrupt aufgerufen werden

+; 

+checkkey:

+     push ax

+checkagain:

+     MOV     AH,1    ;Z-FLAG GESETZT : ZEICHEN !

+   cli

+     INT     016H    ;INPUT FROM KEYBOARD

+     JZ      NO_KEY  ;NEIN,KEINE TASTE GEDRUECKT

+     MOV     AH,0

+     INT     016H    ;JA, ZEICHEN ABHOLEN

+     cmp ax,0        ;kommt von 'break'

+     jz no_key

+     cmp al,0        ;extended code

+     jnz normal_key

+     mov al,ah       ;mit bit acht kennzeichnen

+     or  al,80h

+normal_key:

+     push cx

+     MOV     CH,AL

+     MOV     AL,1    ;KANAL-NUMMER

+     CALL    inputinterrupt

+     pop cx

+   sti

+     jmp checkagain

+NO_KEY:

+   sti

+     pop ax

+     ret

+;

diff --git a/system/shard-x86-at/7/src/PCSYS.ASM b/system/shard-x86-at/7/src/PCSYS.ASM
new file mode 100644
index 0000000..6ae6b0a
--- /dev/null
+++ b/system/shard-x86-at/7/src/PCSYS.ASM
@@ -0,0 +1,130 @@
+;**************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ================*

+;*                                                                        *

+;*   PC spezifische, deviceunabhaengige routinen                          *

+;*                                                                        *

+;************************************************************************** 

+

+limit:

+        mov dx,0FFFh

+        push ax

+        push cx

+        int 12h      ;Speichergroesse abholen

+        mov cl,6h

+        shl ax,cl

+        dec ax

+        mov dx,ax

+        mov ax,cs

+        sub dx,ax                        ;must be relativ to cs

+        pop cx

+        pop ax

+        ret

+

+paragraphs:

+        mov dx,0FFFh

+        push ax

+        push cx

+        int 12h      ;Speichergroesse abholen

+        mov cl,6h

+        shl ax,cl

+        dec ax

+        mov dx,ax

+        pop cx

+        pop ax

+        ret

+ 

+

+;**************************************************************************

+timerint equ 08*4

+timercont equ 018h*4	;resident basic ist ueberfluessig

+timer_init:

+     mov ax,0

+     mov es,ax

+     mov bx,word ptr es:[timerint+2]

+     mov word ptr es:[timercont+2],bx

+     mov bx,word ptr es:[timerint]

+     mov word ptr es:[timercont],bx

+     mov word ptr es:[timerint+2],cs

+     mov word ptr es:[timerint],offset timer_tick

+     ret

+; 

+timer_tick:

+     int 18h 

+     push ax

+     push ds

+     push cs                  ;ds := cs

+     pop ds

+   sti

+     call checkkey            ;keybord abfragen

+   if pcd

+     mov al,50

+   else

+     mov al,55                ;ungefaehr 55 millisekunden

+   endif

+   cli

+     call timerinterrupt

+     inc tickcount

+     cmp tickcount,1000/55    ;schon eine sekunde um

+     jnc sec_tick

+     pop ds

+     pop ax

+     iret

+;

+;**************************************************************************

+;*

+;*   Die Initialisierung der einzelnen Kanaele kann in der Zelle sec_entry

+;*   eine Routine eintragen, die im Sekundentack (ungefaehr) aufgerufen

+;*   werden soll. Diese Routine muss dann die vorher dort eingetragene 

+;*   Routine aufrufen. Ebenfalls kann ein di und si registerinhalt

+;*   eingetragen werden, der beim aufruf gegeben sein soll. Dann ist dafuer

+;*   Sorge zu tragen, dass die nachfolgenden Routine den jeweils vorher

+;*   dort eingetragenen Wert erhaelt. Alle Register ausser di, si und !!ds!!

+;*   duerfen beliebig zerstoert werden.

+;*   ds ist immer auf das datensegment (momentan = cs) gesetzt.

+sec_tick:

+     mov tickcount,0          ;wieder vorn anfangen zu zaehlen

+     push si

+     push di

+     push bp

+     push bx

+     push cx

+     push dx

+     push es

+     mov di,word ptr sec_di

+     mov si,word ptr sec_si

+     jmp word ptr sec_entry

+sec_cont:

+     pop es

+     pop dx

+     pop cx

+     pop bx

+     pop bp

+     pop di

+     pop si

+     pop ds

+     pop ax

+     iret

+

+sec_entry dw offset sec_cont

+sec_di    dw 0                ;hier koennen routinen das di und das si

+sec_si    dw 0                ;ablegen, mit dem sie aufgerufen werden wollen

+

+tickcount db 0

+

+;****************************************************************************

+;* neuen bootvorgang einleiten

+reboot:

+   if hdsystem

+     mov ax,0401h             ;sector verify

+     mov cx,1                 ;spur 0, sector 1

+     mov dx,80h               ;drive 0, head 0

+     int 13h

+   endif

+     mov ax,40h

+     mov ds,ax                ;auf datensegment

+     mov word ptr ds:[0072h],1234h ;reset flag

+     db 0eah                  ;jmp 0ffffh:0

+     dw 0 

+     dw 0ffffh

+

+

diff --git a/system/shard-x86-at/7/src/SHMAIN.ASM b/system/shard-x86-at/7/src/SHMAIN.ASM
new file mode 100644
index 0000000..8c584c5
--- /dev/null
+++ b/system/shard-x86-at/7/src/SHMAIN.ASM
@@ -0,0 +1,240 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Routinen zur Verteilung der Auftraege auf verschiedene Kanaele         *

+;*   und Kanal 32                                                           *

+;*                                                                          *

+;****************************************************************************

+

+;******************************************************************************

+; routinen, die das restsystem vom SHard erwartet

+;******************************************************************************

+; routinen im restsystem, die SHard benutzen kann

+;systemstart    = cs:1e10h

+;inputinterrupt = cs:1e13h

+;timerinterrupt = cs:1e16h

+;warte          = cs:1e19h

+;freieumel0     = cs:1e1ch

+;info           = cs:1e1fh

+;

+;******************************************************************************

+;******************************************************************************

+; kanalspezifische funktionen

+i_output proc far

+     push bp

+     push si

+     push di

+     push bx

+     push dx

+     push ax

+     push es

+     push ds                  ;bis hierhin nach funktion restaurieren

+     mov si,ds                ;wir brauchen den alten wert von ds in es

+     mov es,si

+     mov si,cs                ;wir brauchen ds = cs

+     mov ds,si

+     push bx             ;fuer versorgung der funktion sichern

+     call select

+     pop bx

+     call shard:[si]     ;routine anspringen

+     pop ds                   ;register wieder herstellen

+     pop es

+     pop ax

+     pop dx

+     pop bx

+     pop di

+     pop si

+     pop bp

+     ret

+i_output endp

+

+i_blockin label far

+     push bp

+     mov bp,2            ;kennung blockin

+     jmp short dispatch

+

+i_blockout label far

+     push bp

+     mov bp,3            ;kennung blockout

+     jmp short dispatch

+

+i_iocontrol label far

+     push bp

+     mov bp,4            ;kennung iocontrol

+     jmp short dispatch

+

+control32:               ;spezialaufrufe indirekt ueber kanal 32 gekommen

+     push cs

+     call i_control32

+     ret

+

+i_control32:

+     push bp

+     mov bp,5            ;kennung control32

+     jmp short dispatch

+

+;******************************************************************************

+; dispatch routine um aufrufe auf die kanalspezifischen treiber zu verteilen

+;

+; in: al = kanal

+;     bp auf dem stack

+;     bp = 2 bei blockin

+;          3 bei blockout

+;          4 bei iocontrol

+;          5 bei control ueber kanal 32

+;     aufruf mit jmp dispatch

+;

+; funktion: aufruf der entsprechenden funktion des kanaltreibers mit

+;      si = devicetypecontrolblock

+;      di = channelcontrolblock

+;      auf dem stack: bp, si, di, dx, es, ds, bx, returnadresse

+;

+;      die routinen muessen deshalb keine register sichern.

+;      soll in ds:bx etwas zurueckgeliefert werden, so ist dies ueber den

+;      stack zu tun.

+;

+; out: die gewuenschte funktion wurde ausgefuehrt

+;      bp, si, di, dx, bx unveraendert, ausnahme: bx in bestimmten faellen wo dies

+;      ausdruecklich verlangt wird. flags, cx (ggf. bx) wie von der funktion geliefert.

+dispatch proc far

+     push si                  ;register sichern um sie nach ende der Funktion

+     push di

+     push dx                  ;zu restaurieren

+     push es

+     push ds

+     push bx

+     mov si,ds                ;wir brauchen den alten wert von ds in es

+     mov es,si

+     mov si,cs                ;wir brauchen ds = cs

+     mov ds,si

+     call dispexecute         ;fuehre dispatch aus

+     pop bx                   ;register wieder herstellen

+     pop ds

+     pop es

+     pop dx

+     pop di

+     pop si

+     pop bp

+     ret                      ;fertig, funktion ausgefuehrt

+dispatch endp

+

+dispexecute:

+     push bx                  ;sichern, um versorgung der funktion durchfuehren

+     push dx                  ;zu koennen

+     call select         ;adressen fuer diesen kanal laden 

+     add bp,si           ;adresse fuer offset der funktionstabelle in dtcb ausrechnen

+     mov bl,shard:[bp]        ;offset nach bl

+     mov bh,0ffh              ;maximal 255 byte grosse tabelle

+;bx enthaelt jetzt negativen offset

+     add bx,si           ;start der tabelle fuer funktionswerte ausrechnen

+;

+; als funktionswert wird derzeit nur der bereich von -128 bis +127 akzeptiert.

+; -1 dient dabei als tabellenendekennzeichnung und wird fuer alle undefinierten 

+; funktionswerte aufgerufen

+; 

+; die tabelle besteht aus jeweils einem byte funktionsschluessel

+; im bereich -128 - +127 und zwei byte funktionsadresse. 

+     mov dl,cl                ;niederwertigen teil nach dl

+     mov al,ch                ;hoeheren bits von cx muessen 0 oder 0ffh sein

+     or al,al                 ;ist es 0

+     jz dispfunctloop         ;ja, ok

+     inc al                   ;oder -1

+     ifnz <mov dl,0ffh>       ;nein, dann -1 als funktionswert

+dispfunctloop:

+     mov al,shard:[bx]        ;aktuellen tabelleneintrag suchen

+     inc bx                   ;und auf dazugehoerige adresse

+     cmp al,dl                ;gefunden

+     jz dispfuncfound         ;ja

+     inc al                   ;oder -1

+     jz dispfuncfound

+     inc bx              ;adresse ueberspringen

+     inc bx

+     jmp dispfunctloop

+dispfuncfound:

+     mov bp,bx           ;adresse der routine nach bp

+     pop dx              ;dx wieder herstellen

+     pop bx              ;bx wiederherstellen

+     jmp shard:[bp]      ;jmp funktion

+

+;***************************************************************************

+; select routine, um die tabellen eines bestimmten kanals zu adressieren

+;

+; in:  al  = kanalnummer

+;

+; out: si = dtcb adresse

+;      di = ccb adresse

+;      bx, dx zerstoert

+select:

+     push cx

+     mov dx,offset selectentry ;laenge eines eintrags in selecttabelle

+     mov bx,offset selecttable

+     mov cl,shard:[bx]        ;anzahl kanaele laden

+     mov ch,0

+     inc bx                   ;auf eigentliche tabelle

+selectloop:

+     cmp al,shard:[bx]        ;kanal gefunden

+     jz selectfound

+     add bx,dx                ;auf naechsten kanal

+     loop selectloop

+; hier haben wir einen unbekannten kanal

+; bx zeigt jetzt auf den 'nilkanal'

+selectfound:

+; hier wurde der passende kanal gefunden

+     mov di,shard:[bx]+1      ;adresse channelcontrolblock

+     mov si,shard:[bx]+3      ;adresse devicetypecontrolblock

+     pop cx

+     ret

+

+;********************************************************************************

+;* definition des typs 'shardkanal' fuer operation ueber kanal 32

+     device shardchannel

+

+     dtcbroutines iocontrol

+          routine 1,devicetype

+          routine 2,frout_ok

+          routine 5,nil_size

+          routine 6,priv_operation

+          routine 8,priv_operation

+          routine 9,priv_operation

+          routine -3,priv_operation

+          routine -4,priv_operation

+          routine -5,reboot_request

+          routine -1,unknowncontrol

+     dtcbroutines control32

+          routine -2,timer_init

+          routine -1,no_channel_setup

+     dtcbroutines blockin

+          routine -4,clockread

+     dtcbroutines blockout

+          routine -4,clockwrite

+          routine -1,no_blockinout

+     dtcbparams nil_output,0            ;output,no in_out

+

+priv_operation:

+     mov al,bl                ;kanalnummer nach al

+     mov bl,0                 ;vermerken: privilegiert

+     jmp control32

+

+priv_op_question:

+     mov al,bl                ;kanalnummer nach al

+     mov bl,1                 ;vermerken: abfrage

+     jmp control32

+

+reboot_request:

+     mov byte ptr reboot_byte,1

+     ret

+

+reboot_byte db 0

+

+longmove:

+     rep movsw

+     ret

+

+i_sysend proc far

+     cmp byte ptr cs:reboot_byte,1

+     ifz <jmp reboot>

+     mov al,0

+     mov cx,-102

+     call control32           ;laufwerk parken, wenn implementiert

+     ret

+i_sysend endp

diff --git a/system/shard-x86-at/7/src/STREAM.ASM b/system/shard-x86-at/7/src/STREAM.ASM
new file mode 100644
index 0000000..87c3547
--- /dev/null
+++ b/system/shard-x86-at/7/src/STREAM.ASM
@@ -0,0 +1,289 @@
+;***************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================*

+;*                                                                         *

+;*   Pufferverwaltung fuer Stream-I/O-Kanaele                              *

+;*   und allgemeine Stream-I/O-Routinen                                    *

+;*                                                                         *

+;***************************************************************************

+

+;******************************************************************************

+; macro zur definition der fuer 'stream' notwendigen daten im ccb

+stream macro bufsiz,bufadr

+ccbentry stream_stat 

+;;definition der bits in stream_stat

+outrestart   = 1    ;;output war fertig, muss neu gestartet werden

+wasxon       = 2    ;;es wurde bereits xon empfangen

+out_xon_xoff = 4    ;;ausgabeseitig findet xon/xoff handshake statt

+in_xon_xoff  = 8    ;;eingabeseitig findet xon/xoff handshake statt

+sendxon_xoff = 10h  ;;xon oder xoff muss gesendet werden

+sendxon      = 20h  ;;xon senden (in verbindung mit sendxon_xoff verwendet)

+in_xoff_send = 40h  ;;xoff wurde ausgesendet -> nur dann xon senden

+     db outrestart + wasxon + in_xoff_send

+ccbentry buffersize

+     db bufsiz

+ccbentry content

+     db 0           ;;puffer ist anfangs leer

+ccbentry inpointer

+     db 0           ;;wir fuellen den puffer vom anfang an

+ccbentry outpointer

+     db 0           ;;und leeren ihn auch von da

+ccbentry buffer

+     dw offset bufadr      ;;pufferadresse

+ccbentry andmask

+     db 0ffh        ;;high bit loeschen

+ccbentry xormask

+     db 0           ;;keine bits kippen

+ccbentry errorandmask

+     db 0ffh        ;;high bit loeschen

+ccbentry errorxormask

+     db 0           ;;keine bits kippen

+ccbentry outandmask

+     db 0ffh        ;;high bit loeschen

+ccbentry outxormask

+     db 0           ;;keine bits kippen

+ccbentry breakchar

+     db '?'         ;;nach ? umsetzen

+ccbentry xoffchar

+     db 'S'-40h     ;;ctrl-s ist xoff

+ccbentry xonchar

+     db 'Q'-40h     ;;ctrl-q ist xon

+ccbentry stream_icount

+     dw 0

+ccbentry stream_ocount

+     dw 0

+     endm

+

+

+fillbuffer:

+; di zeigt auf ccb

+; das z-flag ist rueckgesetzt, wenn der output neu gestartet werden muss

+     or cx,cx                      ;falls laenge null: alles uebernommen melden

+     jnz fillit

+     stc                           ;'alles uebernommen' setzen

+     ret                           ;war null, nichts zu tun

+fillit:

+     push cx                       ;gewuenschte laenge merken fuer rueckmeldung

+fillagain:

+     mov al,shard:(di+buffersize)  ;puffergroesse holen

+     sub al,shard:(di+content)     ;belegte abziehen

+     jz bufferfull                 ;nichts mehr frei

+     push cx                       ;noch zu uebernehmende merken

+     or ch,ch                      ;nachsehen, ob laenge > 255

+     ifnz <mov cl,0ffh>            ;nein, dann bis zu 255 byte uebernehmen

+     cmp al,cl                     ;kleinere von freien und gewuenschten nehmen

+     ifc <mov cl,al>               ;anzahl freie ist kleiner

+     mov al,shard:(di+buffersize)  ;groesse holen

+     sub al,shard:(di+inpointer)   ;zeiger abziehen -> abstand vom pufferende

+     jnz takeminimum

+     mov byte ptr shard:(di+inpointer),0 ;ist am ende, vorne anfangen

+     mov al,cl                     ;von daher volle groesse

+takeminimum:                       ;minimum (abstand vom ende, max moegliche) -> c

+     cmp al,cl                     ;welches ist groesser

+     ifc <mov cl,al>               ;a ist kleiner, nehmen wir das

+     mov ch,0                      ;laenge fuer movsb

+     push cx                       ;merken

+     mov dx,shard:(di+buffer)

+     add dl,shard:(di+inpointer)

+     ifc <inc dh>                  ;zielstartadresse nach dx

+;es:bx enthaelt quellenstart

+;ds:dx enthaelt zieladresse

+     push es

+     push ds

+     pop es                        ;es / ds vertauschen

+     pop ds

+     xchg bx,si                    ;bx als source

+     xchg dx,di                    ;dx als destination

+     cld

+     rep movsb                     ;uebertragen

+     xchg bx,si                    ;register zuruecktauschen

+     xchg dx,di

+     push es

+     push ds

+     pop es

+     pop ds

+     pop cx                        ;uebernommene laenge nach cx

+     add shard:(di+inpointer),cl   ;neuen inpointer errechnen

+     add shard:(di+content),cl     ;neuen inhalt

+     pop bp                        ;gewuenschte laenge nach bp

+     sub bp,cx                     ;restlaenge ausrechnen

+     mov cx,bp                     ;restlaenge nach cx

+     jnz fillagain                 ;ok, fertig

+     pop cx                        ;alles uebernommen

+     test byte ptr shard:(di+stream_stat),outrestart ;output neu starten? 

+     stc                           ;carry setzen

+     ret

+

+bufferfull:                        ;nicht alles uebernommen

+     pop bx                        ;gewuenschte laenge vom stack holen

+     sub bx,cx                     ;uebernommene laenge errechnen

+     mov cx,bx                     ;uebernommene nach bc

+     test byte ptr shard:(di+stream_stat),outrestart ;output neu starten? 

+     ret                           ;carry ist geloescht

+

+frout:

+;* meldet anzahl freie im puffer und carry, wenn puffer leer

+     mov al,shard:(di+buffersize)  ;groesse

+     mov ch,al                     ;merken

+     sub al,shard:(di+content)     ;minus inhalt gibt freie

+     cmp al,ch                     ;volle puffergroesse?

+     cmc                           ;carry ist genau dann gesetzt, wenn bl>al

+     mov ch,0 

+     mov cl,al                     ;laenge melden

+     ret

+

+getnextchar:

+;* diese routine muss im disable interrupt aufgerufen werden und wird so verlassen

+;* z-flag -> kein zeichen mehr gefunden

+;* dx,ax,f werden zerstoert

+     test byte ptr (di+stream_stat),sendxon_xoff ;muessen wir xon/xoff senden

+     jnz getxon_xoff

+     test byte ptr shard:(di+stream_stat),wasxon ;war schon xon

+     jz getret                     ;nein, z sagt: kein zeichen mehr da

+     or byte ptr shard:(di+stream_stat),outrestart ;puffer leer, neustart erforderlich

+     cmp byte ptr shard:(di+content),0      ;noch was im puffer

+     jz getret                     ;ja

+     and byte ptr shard:(di+stream_stat),not outrestart ;kein neustart erforderlich

+     dec byte ptr shard:(di+content) ;einen vom inhalt abziehen

+     mov dx,shard:(di+buffer)      ;buffer adresse + outpointer nach cx

+     mov al,shard:(di+outpointer)

+     cmp al,shard:(di+buffersize)  ;sind wir am ende angelangt

+     ifz <mov al,0>                ;ja, dann auf den anfang setzen

+     inc al                        ;auf naechstes zeigen

+     mov shard:(di+outpointer),al  ;neuen outpointer setzen

+     dec al                        ;alten outpointer wiederherstellen

+     xor ah,ah                     ;ah loeschen

+     add dx,ax                     ;byte im puffer errechnen

+     xchg bx,dx

+     mov al,shard:[bx]             ;zeichen holen

+     xchg bx,dx

+     and al,(di+outandmask)        ;unerwuenschte bits blenden

+     xor al,(di+outxormask)        ;andere evtl. kippen

+     inc word ptr (di+stream_ocount) ;zeichen zaehlen

+     inc dx                        ;puffer steht nie auf 0

+                                   ;nz => zeigt an, dass zeichen da

+getret:

+     ret

+

+getxon_xoff:

+     and byte ptr (di+stream_stat),not sendxon_xoff ;jetzt senden wirs

+     test byte ptr (di+stream_stat),sendxon ;sollen wir xon senden

+     jz getxoff                    ;nein, dann wars xoff

+     and byte ptr (di+stream_stat),not sendxon ;muss jetzt auch weg

+     or al,1                       ;nz => zeichen da

+     mov al,(di+xonchar)           ;xon holen

+     ret 

+

+getxoff:

+     or al,1                       ;nz => zeichen

+     mov al,(di+xoffchar)          ;xoff holen

+     ret

+

+xonfound:

+     test byte ptr shard:(di+stream_stat),wasxon ;warten wir auf xon

+     lahf

+     or byte ptr shard:(di+stream_stat),wasxon ;jetzt war auf jeden fall eins da

+     sahf

+     ret                                ;z => output wieder starten

+

+xofffound:

+     and byte ptr shard:(di+stream_stat),not wasxon  ;ab sofort auf xon warten

+     ret                                ;nz => output nicht wieder starten

+

+input:

+     and al,shard:(di+andmask)          ;evtl. bits ausblenden

+     xor al,shard:(di+xormask)          ;oder kippen

+allinput:

+     test byte ptr shard:(di+stream_stat),out_xon_xoff

+     jz directinput

+     cmp al,shard:(di+xonchar)

+     jz xonfound

+     cmp al,shard:(di+xoffchar)

+     jz xofffound

+directinput:                       ;input ohne xon/xoff

+     mov ch,al                     ;zeichen nach ch

+     mov al,shard:(di+channel_no)  ;kanal nach al

+     inc word ptr shard:(di+stream_icount) ;zeichen zaehlen

+     call inputinterrupt

+     or al,1                       ;nz => kein output restart

+     ret

+

+errorinput:

+     and al,shard:(di+errorandmask) ;evtl. bits ausblenden

+     xor al,shard:(di+errorxormask) ;oder kippen

+     jmp allinput

+

+breakinput:

+     mov al,shard:(di+breakchar)

+     jmp allinput

+

+stream_weiter:

+   cli

+     mov al,(di+stream_stat)       ;aktuellen status holen

+     test al,in_xon_xoff           ;ueberhaupt xon_xoff handshake

+     jz stream_weiter_end          ;nein, ei und zurueck

+     test al,in_xoff_send          ;habe ich ein xoff gesendet

+     jz stream_weiter_end          ;nichts liefern 

+     or al,sendxon+sendxon_xoff    ;bitte schick ein xon

+     and al,0ffh-in_xoff_send      ;das xoff ist erledigt

+     mov (di+stream_stat),al       ;neuen status setzen

+     test byte ptr (di+stream_stat),outrestart ;nz => output neu starten

+stream_weiter_end:

+   sti

+     ret

+

+stream_stop:

+   cli

+     mov al,(di+stream_stat)       ;aktuellen status holen

+     test al,in_xon_xoff           ;ueberhaupt xon_xoff handshake

+     jz stream_stop_end            ;nein, ei und zurueck

+     or al,in_xoff_send+sendxon_xoff    ;bitte schick ein xoff und merk dirs

+     and al,0ffh-sendxon           ;auf keinen fall mehr xon schicken

+     mov (di+stream_stat),al       ;neuen status setzen

+     test byte ptr (di+stream_stat),outrestart ;nz => output neu starten

+stream_stop_end:

+   sti

+     ret

+

+enablexon:

+     or byte ptr shard:(di+stream_stat),in_xon_xoff ;ab sofort xon/xoff handshake

+enableoutxon:

+     or byte ptr (di+stream_stat),out_xon_xoff ;auch ausgabe seitig

+     ret

+

+

+disablexon:

+     and byte ptr (di+stream_stat),not in_xon_xoff ;ab sofort eingabe und

+disablexoff:

+     and byte ptr (di+stream_stat),not out_xon_xoff ;ausgabe wieder ohne xon/xoff

+     test byte ptr shard:(di+stream_stat),wasxon   ;warten wir noch auf xon

+     lahf 

+     or byte ptr shard:(di+stream_stat),wasxon     ;dann haben wir jetzt eins

+     sahf

+     ret                                           ;z => outputrestart

+

+set_out_mask:

+     mov (di+outandmask),dx

+     ret

+

+set_inp_mask:

+     mov (di+andmask),dx

+     ret

+

+set_inp_errmask:

+     mov (di+errorandmask),dx

+     ret

+

+stream_in_count:

+   cli

+     mov cx,(di+stream_icount)

+     mov word ptr (di+stream_icount),0

+   sti

+     ret

+

+stream_out_count:

+   cli

+     mov cx,(di+stream_ocount)

+     mov word ptr (di+stream_ocount),0

+   sti

+     ret

+

diff --git a/system/shard-x86-at/7/src/WAIT.ASM b/system/shard-x86-at/7/src/WAIT.ASM
new file mode 100644
index 0000000..80ff838
--- /dev/null
+++ b/system/shard-x86-at/7/src/WAIT.ASM
@@ -0,0 +1,175 @@
+;****************************************************************************

+;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================*

+;*                                                                          *

+;*   Support fuer die Wartelogik des IBM PC-AT ueber int 15h                *

+;*                                                                          *

+;*                                                                          *

+;****************************************************************************

+

+int15 proc far

+     sti

+     push ax

+     cmp ah,90h                  ;hat ein treiber nichts zu tun

+     jz device_is_busy

+     cmp ah,91h                  ;oder ist er gerade fertig

+     jz device_ready

+not_for_me:                      ;hab ich nichts mit am hut

+     pop ax

+     jmp dword ptr cs:[int15_cont]

+

+device_ready:

+     cmp al,2                    ;0 (platte) oder 1 (floppy)

+     jnc not_for_me

+     mov ah,0

+     push bx

+     mov bx,ax

+     mov byte ptr cs:device_busy[bx],2  ;device ist fertig geworden

+     pop bx

+     pop ax

+     iret

+

+device_is_busy:

+     mov ah,8                    ;annahme: 6 sekunden fuer platte

+     cmp al,0                    ;ist es platte

+     jz device_wait              ;ja

+     mov ah,3                    ;annahme: 2 sekunden fuer floppy

+     cmp al,1

+     jz device_wait              ;ist floppy

+     cmp al,0fdh                 ;warten auf floppy_motor 

+     jnz not_for_me              ;mit allem anderen haben wir nichts am hut

+     mov ax,0301h                ;zwei sekunden warten; device floppy

+device_wait:

+     push bx                     ;den ganzen ramsch sichern

+     push cx

+     push dx

+     push bp

+     push di

+     push si

+     push es

+     push ds

+     mov bl,al

+     mov bh,0

+   cli

+     mov byte ptr cs:device_table[bx],1          ;device busy setzen

+     mov byte ptr cs:device_timeout_table[bx],ah ;anzahl sekunden eintragen

+   sti

+device_wait_loop:

+     cmp byte ptr cs:device_busy[bx],0  ;noch kein interrupt gekommen

+     jnz device_wait_end

+     push bx

+     call cs:warte

+     pop bx

+     jmp device_wait_loop

+device_wait_end:

+     cmp byte ptr cs:device_busy[bx],2 ;normales ende

+     ifnz <stc>                         ;nicht normal, war timeout

+     mov byte ptr cs:device_table[bx],0 ;device ist wieder frei

+     mov byte ptr cs:device_busy[bx],0 ;device kann wieder auf int warten

+;    jnc devcont

+;    call cs:info

+;    jmp short devcont

+;    db ' timeout'

+devcont:

+     pop ds

+     pop es

+     pop si

+     pop di

+     pop bp

+     pop dx

+     pop cx

+     pop bx

+     pop ax

+     ret 2                       ;kill flags on stack

+

+int15 endp

+

+device_timing:

+     mov bx,-1                   ;mit 0 fangen wir an

+     mov cx,2                    ;zwei durchlaeufe

+device_timing_loop:

+     inc bx

+     mov al,byte ptr device_timeout_table[bx] ;timeout zaehler holen

+     cmp al,0ffh                 ;schon fertig mit zaehlen

+     jz device_timing_end

+     dec al

+     mov byte ptr device_timeout_table[bx],al ;timeout zaehler neu setzen

+     jns device_timing_end

+     cmp byte ptr device_table[bx],1 ;noch aktiv?

+     ifz <cmp byte ptr device_busy[bx],0> ;und noch kein endeinterrupt

+     ifz <mov byte ptr device_busy[bx],3> ;timeout aufgetreten

+device_timing_end:

+     loop device_timing_loop

+     jmp word ptr device_cont

+

+;***********************************************************************

+;* warten, bis das in bx uebergebene device frei ist

+;* ds = cs ist bedingung, alle register (ausser flags) bleiben erhalten

+  db 'device free'

+device_free:

+     cmp byte ptr device_table[bx],0 ;ist das device frei 

+     jnz device_not_free

+     mov byte ptr device_busy[bx],0 ;evtl. nachgeklapperte ints loeschen

+     ret                         ;device kann benutzt werden

+device_not_free:

+     push ax

+     push bx

+     push cx

+     push dx

+     push si

+     push di

+     push bp

+     push ds

+     push es

+     call warte

+     pop es

+     pop ds

+     pop bp

+     pop di

+     pop si

+     pop dx

+     pop cx

+     pop bx

+     pop ax

+     jmp device_free

+

+device_lock:

+     mov byte ptr device_table[bx],1 ;device sperren 

+     ret

+

+device_unlock:

+     mov byte ptr device_table[bx],0 ;device freigeben 

+     ret

+

+device_init:

+     mov ax,0

+     mov es,ax

+     mov bx,word ptr es:[15h*4]         ;int routine holen

+     mov cx,word ptr es:[15h*4+2]       ;int segment holen

+     mov word ptr es:[15h*4],offset int15

+     mov word ptr es:[15h*4+2],cs

+     mov word ptr [int15_cont],bx

+     mov word ptr [int15_cont+2],cx

+     mov ax,word ptr [sec_entry]       ;alte adresse fuer sec_tick holen

+     mov word ptr [device_cont],ax     ;eintragen fuer weitergabe

+     mov word ptr [sec_entry],offset device_timing ;unseren aufruf eintragen 

+     ret

+

+int15_cont:

+     dw 0

+     dw 0

+

+device_cont:

+     dw 0

+

+device_table:

+     db 0

+     db 0

+

+device_busy:

+     db 0

+     db 0

+

+device_timeout_table:

+     db 0

+     db 0

+

diff --git a/system/shard-z80-altos/6/src/ALTOSSHD.ASM b/system/shard-z80-altos/6/src/ALTOSSHD.ASM
new file mode 100644
index 0000000..5df69fb
--- /dev/null
+++ b/system/shard-z80-altos/6/src/ALTOSSHD.ASM
@@ -0,0 +1,1786 @@
+ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER  COMMENT

+0100 C3 F9 01    ...   JP    01F9       ; Init Shard + Start EUMEL0

+0103 C3 8C 0B    ...   JP    0B8C       ; LIMIT

+0106 C3 2A 01    .*.   JP    012A       ; OUTPUT

+0109 C3 4B 01    .K.   JP    014B       ; BLOCKIN

+010C C3 53 01    .S.   JP    0153       ; BLOCKOUT

+010F C3 5B 01    .[.   JP    015B       ; IOCONTROL

+0112 C3 AC 0B    ...   JP    0BAC       ; SYSEND

+0115 C3 90 0B    ...   JP    0B90       ; SCHINF

+0118 C3 94 0B    ...   JP    0B94       ; SCHACC

+011B C3 89 0B    ...   JP    0B89       ; LONGMOVE

+011E 06                                 ; SHDVER = 6 

+011F 00 00                              ; ID 4

+0121 00 00                              ; ID 5

+0123 00 00                              ; ID 6

+0125 00 00                              ; ID 7

+0127 C3 63 01    .c.   JP    0163       ; I/O-Setzen fuer 'putboot' 

+012A DD E5       ..    PUSH  IX         ; OUTPUT (Kanal A, Length BC, 

+012C FD E5       ..    PUSH  IY         ;         Addr HL, Ausgegeben BC, 

+012E E5          .     PUSH  HL         ;         Carry SET : Alles raus)

+012F D5          .     PUSH  DE

+0130 F5          .     PUSH  AF 

+0131 E5          .     PUSH  HL 

+0132 CD A6 01    ...   CALL  01A6       ; Zugriff auf Kanaltabelle --> IY/DE

+0135 D5          .     PUSH  DE         ; DE --> IX (Addr. von Startaddr.) 

+0136 DD E1       ..    POP   IX 

+0138 EB          .     EX    DE,HL 

+0139 5E          ^     LD    E,(HL)     ; (Startaddresse) --> DE 

+013A 23          #     INC   HL 

+013B 56          V     LD    D,(HL) 

+013C E1          .     POP   HL         ; Textstartaddresse 

+013D CD 49 01    .I.   CALL  0149       ; = JP (DE) Routine starten 

+0140 D1          .     POP   DE         ; ehem. Returnaddresse loeschen

+0141 7A          z     LD    A,D 

+0142 D1          .     POP   DE 

+0143 E1          .     POP   HL 

+0144 FD E1       ..    POP   IY 

+0146 DD E1       ..    POP   IX 

+0148 C9          .     RET 

+0149 D5          .     PUSH  DE 

+014A C9          .     RET              ;----------------------------------- 

+014B DD E5       ..    PUSH  IX         ; BLOCKIN 

+014D DD 21 02 00 .!..  LD    IX,0002    ; Aufgabe 2

+0151 18 18       ..    JR    016B       ;----------------------------------

+0153 DD E5       ..    PUSH  IX         ; BLOCKOUT

+0155 DD 21 03 00 .!..  LD    IX,0003    ; Aufgabe 3

+0159 18 10       ..    JR    016B       ;---------------------------------- 

+015B DD E5       ..    PUSH  IX         ; IOCONTROL

+015D DD 21 04 00 .!..  LD    IX,0004    ; Aufgabe 4

+0161 18 08       ..    JR    016B       ;---------putboot Aufg. 5---------- 

+0163 DD E5       ..    PUSH  IX         ; 

+0165 DD 21 05 00 .!..  LD    IX,0005    ; Aufgabe 5

+0169 18 00       ..    JR    016B       ;--------------------------------- 

+016B FD E5       ..    PUSH  IY         ; Je nach IX Kanal-Aufgabe (I/O)

+016D D5          .     PUSH  DE 

+016E E5          .     PUSH  HL 

+016F CD 79 01    .y.   CALL  0179       ; Register wurden gerettet

+0172 E1          .     POP   HL 

+0173 D1          .     POP   DE 

+0174 FD E1       ..    POP   IY 

+0176 DD E1       ..    POP   IX 

+0178 C9          .     RET              ;----------------------------------- 

+0179 E5          .     PUSH  HL 

+017A D5          .     PUSH  DE 

+017B CD A6 01    ...   CALL  01A6       ; Kanaladdr --> DE, IY

+017E DD 19       ..    ADD   IX,DE      ; DE = 4. + 5. Byte + Aufgabennummer

+0180 DD 6E 00    .n.   LD    L,(IX+00)  ; Byte zur Aufgabe 

+0183 26 FF       &.    LD    H,FF 

+0185 D5          .     PUSH  DE 

+0186 DD E1       ..    POP   IX         ; IX = Addresse des tabellenentries

+0188 19          .     ADD   HL,DE      ; 

+0189 59          Y     LD    E,C        ; BC = code1

+018A 78          x     LD    A,B 

+018B B7          .     OR    A 

+018C 28 05       (.    JR    Z,0193     ; EUMEL-Funktion 0<=code1<256

+018E 3C          <     INC   A 

+018F 28 02       (.    JR    Z,0193     ; Shard-Funktion -256<=code1<0

+0191 1E FF       ..    LD    E,FF       ; -1 = Illegale Funktion

+0193 7E          ~     LD    A,(HL) 

+0194 23          #     INC   HL 

+0195 BB          .     CP    E          ; Addresse mit der Funktionsnummer 

+0196 28 07       (.    JR    Z,019F     ; suchen 

+0198 3C          <     INC   A          ; FF=Tabellenende 

+0199 28 04       (.    JR    Z,019F 

+019B 23          #     INC   HL 

+019C 23          #     INC   HL 

+019D 18 F4       ..    JR    0193       ; naechste Funktionsnummer 

+019F 5E          ^     LD    E,(HL) 

+01A0 23          #     INC   HL 

+01A1 56          V     LD    D,(HL)     ; Sprung zur Addresse, die in der 

+01A2 EB          .     EX    DE,HL      ; Tabelle steht 

+01A3 D1          .     POP   DE         ; DE= code2 (Eingang HL)

+01A4 E3          .     EX    (SP),HL 

+01A5 C9          .     RET              ; --------------------------------- 

+01A6 C5          .     PUSH  BC         ;   Kanalinfos aus Tabelle --> IY/DE

+01A7 11 05 00    ...   LD    DE,0005    ; Entrylaenge in der Tabelle

+01AA 21 12 02    !..   LD    HL,0212    ; Tabellenanfang (Kanaele)

+01AD 46          F     LD    B,(HL)     ; Erstes Byte ist Tabellenlaenge

+01AE 23          #     INC   HL 

+01AF BE          .     CP    (HL)       ; Erstes Entrybyte ist Kanalnummer

+01B0 28 03       (.    JR    Z,01B5     ; Bis Kanal gefunden

+01B2 19          .     ADD   HL,DE 

+01B3 10 FA       ..    DJNZ  01AF 

+01B5 23          #     INC   HL         ; 2. u. 3. Byte --> DE

+01B6 5E          ^     LD    E,(HL) 

+01B7 23          #     INC   HL 

+01B8 56          V     LD    D,(HL) 

+01B9 D5          .     PUSH  DE         ; 2. u. 3. Byte --> IY 

+01BA FD E1       ..    POP   IY 

+01BC 23          #     INC   HL         ; 4. u. 5. Byte --> DE

+01BD 5E          ^     LD    E,(HL) 

+01BE 23          #     INC   HL 

+01BF 56          V     LD    D,(HL) 

+01C0 C1          .     POP   BC         ; gerettetes BC zurueck

+01C1 C9          .     RET              ;----------------------------------

+;============================= Parameterkanal ============================== 

+01C2 01 5F 06                           ; 1, IOCONTROL "typ"

+01C5 02 50 06                           ; 2, IOCONTROL "frout"

+01C8 05 46 06                           ; 5, IOCONTROL "size"

+01CB 06 ED 01                           ; 6, IOCONTROL "flow"

+01CE 08 ED 01                           ; 8, IOCONTROL "baud"

+01D1 09 ED 01                           ; 9, IOCONTROL "bits"

+01D4 E2 ED 01                           ; -30, IOCONTROL maske f. busystatus

+01D7 E1 ED 01                           ; -31, IOCONTROL maske f. strobe setz.

+01DA FF 4C 06                           ; -1, IOCONTROL ill.

+01DD FE 86 0B                           ; -2, Aufg. 5 : kanal init

+01E0 FF 55 06                           ; -1, Aufg. 5 : BC = 1

+01E3 FF 4C 06                           ; BLOCKIO ill.

+01E6 59                                 ; Parameterkanal : OUTPUT: 0659 ill. 

+01E7 06                                 ; 

+01E8 FD                                 ; BLOCKIN : 01E3

+01E9 FD                                 ; BLOCKOUT : 01E3

+01EA DC                                 ; IOCONTROL : 01C2

+01EB F7                                 ; Aufg. 5 : 01DD

+01EC 00                                 ; Keine I/O moeglich

+                                        ; ----- set "flow","bits","baud" --- 

+01ED 7D          }     LD    A,L        ; Kanal = addressierter kanal

+01EE 2E 00       ..    LD    L,00       ; 0 = Parameter setzen (code2) 

+01F0 C3 63 01    .c.   JP    0163       ; Aufgabe 5, L = 0 

+01F3 7D          }     LD    A,L        ; kanal = addressierter Kanal

+01F4 2E 01       ..    LD    L,01       ; 1 = Parameter lesen (code2) 

+01F6 C3 63 01    .c.   JP    0163       ; Aufgabe 5, L = 1

+01F9 F3          .     DI               ;---------- Init Shard -------------

+01FA 3E 00       >.    LD    A,00       ; Page 0 = Interruptvektoren

+01FC ED 47       .G    LD    I,A 

+01FE 31 00 B0    1..   LD    SP,B000 

+0201 3E 21       >!    LD    A,21       ; Kanal 0..32 

+0203 01 FE FF    ...   LD    BC,FFFE    ; Funktion -2 = Kanalinit 

+0206 3D          =     DEC   A 

+0207 F5          .     PUSH  AF 

+0208 CD 63 01    .c.   CALL  0163       ; Kanaele initialisieren (IRQ's) 

+020B F1          .     POP   AF 

+020C B7          .     OR    A 

+020D 20 F4        .    JR    NZ,0203 

+020F C3 10 1E    ...   JP    1E10       ; Systemstart EUMEL0 bzw. 'putboot' 

+     -----------------------------------  Entry : Kanal, Puffer, ROUTINETBL 

+0212 0C                                 ; Tabelle mit 12 Kanaelen

+0213 20 00 00 E6 01                     ; Parameterkanal, Kein Puffer 

+0218 00 64 0C 0C 07                     ; Hintergrund 

+021D 01 CD 0C 7B 02                     ; Kanal 1 .. 6 = seriell

+0222 02 5B 0D 7B 02                     ; 

+0227 03 E9 0D 7B 02 

+022C 04 77 0E 7B 02

+0231 05 05 0F 7B 02

+0236 06 93 0F 7B 02 

+023B 07 BD 0F EA 0A                     ; printer

+0240 08 C3 0F EA 0A                     ; parallel 1

+0245 09 C9 0F EA 0A                     ; parallel 2

+024A 1F CF 0F 7D 06                     ; floppy

+024F FF 00 00 3F 06                     ; illegal Kanal

+;======================== Serielle Kanaele =================================

+0254 01 5F 06                           ; 1, IOCONTROL "typ"

+0257 02 36 05                           ; 2, IOCONTROL "frout" 

+025A 05 46 06                           ; 5, IOCONTROL "size"

+025D 06 F3 01                           ; 6, IOCONTROL "flow"

+0260 08 F3 01                           ; 8, IOCONTROL "baud"

+0263 09 F3 01                           ; 9, IOCONTROL "bits"

+0266 FD D6 02                           ; -3, IOCONTROL "portinfo" 

+0269 FF 4C 06                           ; -1 ill. 

+026C 06 2A 03                           ; 6, Aufg .5 : "flow" setzen/info 

+026F 08 F2 02                           ; 8, Aufg. 5 : "baud" setzen/info

+0272 09 AA 03                           ; 9, Aufg. 5 : "bits" setzen/info 

+0275 FE A2 02                           ; -2, Aufg. 5 : Kanal init

+0278 FF 4C 06                           ; BLOCKIN/BLOCKOUT ill.

+027B 31                                 ; Seriell : 0431 = OUTPUT 

+027C 04 

+027D FD                                 ; BLOCKIN : 0278

+027E FD                                 ; BLOCKOUT : 0278

+027F D9                                 ; IOCONTROL : 0251

+0280 F1                                 ; Aufg. 5 : 026C

+0281 03                                 ; Typ : Stream I/O 

+    ; Baudratetabelle : 1. Byte: Bit 7+6 = Vorteiler (Register4) 

+    ;                      Bit 4 = DIV 256, DIV 16,Bit 5 : Mode (CTC) 

+    ;                   2. Byte: CTC-Zeitkonstante 

+0282 40 9C                              ; 50 Baud 

+0284 40 68                              ; 75 Baud 

+0286 40 47                              ; 110 baud 

+0288 E0 E8                              ; 134.5 Baud 

+028A E0 D0                              ; 150 Baud 

+028C A0 D0                              ; 300 Baud 

+028E 60 D0                              ; 600 Baud 

+0290 60 68                              ; 1200 baud 

+0292 60 45                              ; 1800 Baud 

+0294 60 34                              ; 2400 Baud 

+0296 60 23                              ; 3600 Baud 

+0298 60 1A                              ; 4800 Baud 

+029A 60 11                              ; 7200 Baud 

+029C 60 0D                              ; 9600 Baud 

+029E 60 07                              ; 19200 Baud 

+02A0 60 03                              ; 38400 Baud

+02A2 FD 4E 1A    .N.   LD    C,(IY+1A)  ;------------- "kanal init" -------- 

+02A5 06 0D       ..    LD    B,0D       ; Commandport in (IY+1A) 

+02A7 21 C9 02    !..   LD    HL,02C9    ; 13 Bytes ausgeben 

+02AA ED B3       ..    OTIR             ; An den Commandport schicken

+02AC FD 5E 1D    .^.   LD    E,(IY+1D)  ; Interruptvektor des Kanals 

+02AF ED 57       .W    LD    A,I        ; Vektortabellenaddresse High

+02B1 57          W     LD    D,A 

+02B2 ED 59       .Y    OUT   (C),E      ; Interruptvektor fuer Kanal 

+02B4 0E 1E       ..    LD    C,1E       ; Serviceroutine am Pufferende 

+02B6 06 00       ..    LD    B,00       ; (IY+1E)

+02B8 FD E5       ..    PUSH  IY 

+02BA E1          .     POP   HL 

+02BB 09          .     ADD   HL,BC 

+02BC 06 04       ..    LD    B,04       ; 4 Interrupt (Vector+Status) 

+02BE EB          .     EX    DE,HL      ; DE= Serviceroutinenaddresse 

+02BF 73          s     LD    (HL),E     ; HL = Interruptvektoraddresse 

+02C0 23          #     INC   HL         ; Serviceroutine eintragen

+02C1 72          r     LD    (HL),D 

+02C2 23          #     INC   HL         ; Fuer alle 4 Interrupts einen 

+02C3 13          .     INC   DE         ; Interrupthandler 

+02C4 13          .     INC   DE 

+02C5 13          .     INC   DE 

+02C6 10 F7       ..    DJNZ  02BF 

+02C8 C9          .     RET              ;-------- Inittabelle Serielle ----- 

+02C9 14 44             ; reset ext status IRQs, Clock x16, 1 Stopbit,noparity

+02CB 03 61             ; Rx 7 Bits, Autoenables (CTS), Receiver enable 

+02CD 05 EA             ; Tx 8 Bits, DTR = 1, RTS = 1, Transmitter enable 

+02CF 11 1F             ; kein WAIT/RDY, Vektor incl. Status, alle IRQs an 

+02D1 03 C1             ; Rx 8 Bits, Keine Autoenables, Receiver enable 

+02D3 11 1F             ; s.o. 

+02D5 02                ; Interruptvektor folgt als naechstes Byte

+02D6 FD 4E 1A    .N.   LD    C,(IY+1A)  ;------"IOCONTROL portinfo -3"------ 

+02D9 06 01       ..    LD    B,01       ; ^ Status/Commandport

+02DB 3E 30       >0    LD    A,30 

+02DD F3          .     DI 

+02DE ED 41       .A    OUT   (C),B      ; Read-Register 1 waehlen

+02E0 ED 40       .@    IN    B,(C)      ; Einlesen

+02E2 ED 79       .y    OUT   (C),A      ; Error Reset = 30H

+02E4 ED 78       .x    IN    A,(C)      ; Statusregister (0) lesen

+02E6 FB          .     EI 

+02E7 E6 AC       ..    AND   AC         ; DCD,CTS,... durchlassen 

+02E9 4F          O     LD    C,A        ; Lowbyte = Read-Register 1 Bits 

+02EA 78          x     LD    A,B        ; Highbyte = Read-Register 0 Bits 

+02EB E6 70       .p    AND   70         ; Nur Error-Bits durchlassen 

+02ED DD B6 15    ...   OR    (IX+15)    ; Schon vorhandene Fehler dazu

+02F0 47          G     LD    B,A 

+02F1 C9          .     RET              ;----------- "baud" -------------- 

+02F2 01 01 00    ...   LD    BC,0001    ; Rueckmeldung "nicht moeglich" 

+02F5 CB 7C       .|    BIT   7,H        ; Keine Shard-spezifischen Baudrates 

+02F7 C0          .     RET   NZ 

+02F8 7C          |     LD    A,H        ; Schluessel --> A

+02F9 B7          .     OR    A 

+02FA C8          .     RET   Z          ; 0 ist ungueltiger Schluessel

+02FB FD CB 11 4E ...N  BIT   1,(IY+11)  ; Baudrateeinstellung moeglich ? 

+02FF C8          .     RET   Z          ; nein 

+0300 0E 00       ..    LD    C,00       ; Rueckmeldung "ok" 

+0302 CB 45       .E    BIT   0,L        ; 0 = Lesen, 1 = parameter setzen 

+0304 C0          .     RET   NZ         ; Nur Information, dann fertig 

+0305 11 80 02    ...   LD    DE,0280    ; Tabelle der Baudrates/Timeconsts 

+0308 6C          l     LD    L,H 

+0309 CB 25       .%    SLA   L 

+030B 26 00       &.    LD    H,00       ; Schluessel * 2 + Tabellenanfang 

+030D 19          .     ADD   HL,DE 

+030E 7E          ~     LD    A,(HL)     ; Timeconst 

+030F E6 C0       ..    AND   C0         ; Taktvorteiler (1,16,32,64) waehlen 

+0311 4F          O     LD    C,A        ; fuer SIO/DART-Register 4

+0312 3E 3F       >?    LD    A,3F       ; Nur Clock-Bits (6,7) veraendern 

+0314 CD 1E 04    ...   CALL  041E       ; Clock x1, x16

+0317 7E          ~     LD    A,(HL)     ; 

+0318 E6 30       .0    AND   30         ; CTC Vorteiler (DIV16,DIV256) 

+031A 07          .     RLCA 

+031B F6 05       ..    OR    05         ; Modus = Timer, Kein IRQ, Timeconst

+031D FD 4E 1C    .N.   LD    C,(IY+1C)  ; CTC-Port fuer Baudrategenerator 

+0320 ED 79       .y    OUT   (C),A      ; An CTC ausgeben 

+0322 23          #     INC   HL 

+0323 7E          ~     LD    A,(HL)     ; Timeconst fuer CTC 

+0324 ED 79       .y    OUT   (C),A 

+0326 01 00 00    ...   LD    BC,0000    ; "ok"

+0329 C9          .     RET              ;-------------- "flow" ------------- 

+032A CB 7C       .|    BIT   7,H        ; Keine Shard-spezifischen "flow"s 

+032C C2 55 06    .U.   JP    NZ,0655    ; BC = 1 liefern

+032F CB 45       .E    BIT   0,L        ; NZ, wenn nur Information 

+0331 C2 5B 06    .[.   JP    NZ,065B    ; "alles moeglich" melden 

+0334 CD 07 06    ...   CALL  0607       ; Flowmodebits loeschen

+0337 F3          .     DI 

+0338 FD CB 11 86 ....  RES   0,(IY+11)  ; Kein RTS/CTS 

+033C FD CB 17 AE ....  RES   5,(IY+17)  ; Autoenables (CTS) loeschen

+0340 FD 36 12 04 .6..  LD    (IY+12),04 ; AND-maske Statusport Tx-Full 

+0344 FD 36 13 04 .6..  LD    (IY+13),04 ; XOR-maske Statusport Tx-Full

+0348 25          %     DEC   H          ; H=0, oder H>1 

+0349 20 03        .    JR    NZ,034E 

+034B CD FE 05    ...   CALL  05FE       ; H=1 : XON/XOFF setzen

+034E 25          %     DEC   H 

+034F 20 14        .    JR    NZ,0365    ; H=0 : keine Flusskontrolle

+0351 FD CB 11 C6 ....  SET   0,(IY+11)  ; H=2 : RTS/CTS

+0355 FD CB 17 EE ....  SET   5,(IY+17)  ; Autoenables (CTS) moeglich 

+0359 FD 36 12 2C .6.,  LD    (IY+12),2C ; TxDfull, CTS on, DCD on

+035D FD 36 13 2C .6.,  LD    (IY+13),2C ; Alle obigen Bits invertieren 

+0361 FD 36 14 82 .6..  LD    (IY+14),82 ; ? 

+0365 FD 7E 17    .~.   LD    A,(IY+17)  ; Writeregister 3

+0368 06 03       ..    LD    B,03       ; Register 3

+036A FD 4E 1A    .N.   LD    C,(IY+1A)  ; Commanndport

+036D ED 41       .A    OUT   (C),B      ; Neuen Autoenableswert ausgeben

+036F ED 79       .y    OUT   (C),A 

+0371 FB          .     EI 

+0372 CD 3C 04    .<.   CALL  043C       ; ggf. XON/XOFF je nach Status ausg.

+0375 01 00 00    ...   LD    BC,0000    ; "ok"

+0378 C9          .     RET              ;----- RTS/DTR o.XON/XOFF set/reset 

+0379 CD E9 05    ...   CALL  05E9       ; testet BIT 0 (IY0+0)

+037C C4 3C 04    .<.   CALL  NZ,043C    ; ggf XON/XOFF ausgeben

+037F FD CB 11 46 ...F  BIT   0,(IY+11)  ; NZ, wenn RTS/CTS eingestellt 

+0383 C8          .     RET   Z 

+0384 F3          .     DI               ; RTS/CTS ist eingestellt 

+0385 FD 7E 14    .~.   LD    A,(IY+14)  ; Bits, die bei RTS/CTS veraendert 

+0388 4F          O     LD    C,A        ; werden: RTS/DTR 

+0389 FD B6 19    ...   OR    (IY+19)    ; Register 5 Wert

+038C A9          .     XOR   C          ; RTS/DTR ggf loeschen

+038D FD 77 19    .w.   LD    (IY+19),A  ; Wieder zurueckschreiben

+0390 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Commandport

+0393 06 05       ..    LD    B,05       ; Register 5 beschreiben 

+0395 ED 41       .A    OUT   (C),B 

+0397 ED 79       .y    OUT   (C),A      ; Neuen Wert laden

+0399 FB          .     EI 

+039A C9          .     RET              ;----------------------------------- 

+039B CD D6 05    ...   CALL  05D6       ; Wenn XON/XOFF,

+039E C4 3C 04    .<.   CALL  NZ,043C    ; XON oder XOFF ausgeben

+03A1 F3          .     DI 

+03A2 FD 7E 14    .~.   LD    A,(IY+14)  ; RTS/DTR ggf. setzen 

+03A5 FD B6 19    ...   OR    (IY+19)    ; weiter wie oben

+03A8 18 E3       ..    JR    038D       ;------------ "bits" -------------- 

+03AA CB 7C       .|    BIT   7,H        ; Keine Shard-Spezifischen "bits" 

+03AC C2 55 06    .U.   JP    NZ,0655 

+03AF CB 45       .E    BIT   0,L        ; Info: "alles moeglich" melden 

+03B1 C2 5B 06    .[.   JP    NZ,065B 

+03B4 7C          |     LD    A,H        ; H = stop * 32 + par * 8 + (bit-1)

+03B5 C6 20       .     ADD   A,20       ; Stopbits + 1 : 1..3, parity

+03B7 1F          .     RRA              ; Bit 0,1 = parity

+03B8 1F          .     RRA              ; Bit 2,3 = stopbits

+03B9 1F          .     RRA 

+03BA E6 0F       ..    AND   0F         ; restregister ausblenden 

+03BC CB 4F       .O    BIT   1,A        ; 

+03BE 28 02       (.    JR    Z,03C2     ; Wenn gerader Parity: 

+03C0 CB C7       ..    SET   0,A        ; Parity enablen 

+03C2 4F          O     LD    C,A        ; C enthaelt OR-Wert fuer Register 4

+03C3 3E F0       >.    LD    A,F0       ; Nur Stopbits und Parity veraendern 

+03C5 CD 1E 04    ...   CALL  041E       ; SIO-Register 4 veraendern

+03C8 7C          |     LD    A,H        ; Datenbits ausblenden 

+03C9 E6 07       ..    AND   07 

+03CB 47          G     LD    B,A        ; + 1 = Anzahl Datenbits 

+03CC 04          .     INC   B 

+03CD 3E 00       >.    LD    A,00 

+03CF 16 F8       ..    LD    D,F8       ; 11111000

+03D1 37          7     SCF              ; Maskenbits "AND" fuer ungueltige 

+03D2 17          .     RLA              ; Datenbits links reinrotieren 

+03D3 CB 22       ."    SLA   D          ; Bei weniger als 5 Bits zusaetzl. 1

+03D5 10 FA       ..    DJNZ  03D1 

+03D7 5F          _     LD    E,A 

+03D8 CD 18 06    ...   CALL  0618       ; Datenbitsmasken setzen 

+03DB 16 00       ..    LD    D,00       ; Keine Bits invertieren 

+03DD CD 1F 06    ...   CALL  061F       ; Datenbitmasken setzen AND/XOR

+03E0 CD 26 06    .&.   CALL  0626 

+03E3 06 00       ..    LD    B,00 

+03E5 CB 54       .T    BIT   2,H 

+03E7 28 0C       (.    JR    Z,03F5     ; 1,2,3,4,5 datenbits : 00

+03E9 CB 44       .D    BIT   0,H        ; 6 datenbits : 80H

+03EB 28 02       (.    JR    Z,03EF     ; 7 datenbits : 40H

+03ED CB F8       ..    SET   7,B        ; 8 datenbits : C0H

+03EF CB 4C       .L    BIT   1,H 

+03F1 28 02       (.    JR    Z,03F5 

+03F3 CB F0       ..    SET   6,B 

+03F5 FD 7E 17    .~.   LD    A,(IY+17)  ; Register 3 Wert

+03F8 E6 3F       .?    AND   3F         ; Bits, die nicht veraendert werden 

+03FA B0          .     OR    B 

+03FB FD 77 17    .w.   LD    (IY+17),A  ; Register 3 Wert setzen

+03FE 16 03       ..    LD    D,03 

+0400 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Command-Port 

+0403 F3          .     DI 

+0404 ED 51       .Q    OUT   (C),D      ; Register 3 selektieren

+0406 ED 79       .y    OUT   (C),A      ; Neuen Register 3 Wert

+0408 CB 38       .8    SLR   B          ; Register 5 Bits "tiefer"

+040A FD 7E 19    .~.   LD    A,(IY+19)  ; Alten Registerwert 

+040D E6 9F       ..    AND   9F         ; unbenoetigte Bits ausblenden 

+040F B0          .     OR    B 

+0410 FD 77 19    .w.   LD    (IY+19),A  ; abspeichern 

+0413 16 05       ..    LD    D,05       ;

+0415 ED 51       .Q    OUT   (C),D      ; Register 5 selektieren

+0417 ED 79       .y    OUT   (C),A      ; Wert in das Register schreiben

+0419 FB          .     EI 

+041A 01 00 00    ...   LD    BC,0000    ; "ok"

+041D C9          .     RET              ;---------- Register 4 setzen -----

+041E F3          .     DI               ; A enthaelt Maske fuer alte Bits

+041F FD A6 18    ...   AND   (IY+18)    ; Register 4 Maske 

+0422 B1          .     OR    C          ; Neuer Clock/Parity/Stopbit Wert

+0423 FD 77 18    .w.   LD    (IY+18),A  ; In der Tabelle setzen

+0426 06 04       ..    LD    B,04       ; 

+0428 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Am Kommandoport ausgeben

+042B ED 41       .A    OUT   (C),B      ; Register 4 waehlen 

+042D ED 79       .y    OUT   (C),A      ; Neuen Wert des Registers setzen

+042F FB          .     EI 

+0430 C9          .     RET              ; ---------------------------------- 

+0431 CD CD 04    ...   CALL  04CD       ; Serieller OUTPUT:String in Puffer

+0434 F5          .     PUSH  AF         ; schreiben fuer IRQ-Ausgabe

+0435 C5          .     PUSH  BC 

+0436 C4 3C 04    .<.   CALL  NZ,043C    ; NZ, wenn Puffer gefuellt

+0439 C1          .     POP   BC 

+043A F1          .     POP   AF 

+043B C9          .     RET              ;--------- ggf. XON/XOFF ausgeben-- 

+043C FD 4E 1A    .N.   LD    C,(IY+1A)  ; Statusportaddresse

+043F F3          .     DI 

+0440 ED 78       .x    IN    A,(C)      ; Statusbyte

+0442 FD A6 12    ...   AND   (IY+12)    ;"Transmitter full"-Bit ausmaskieren

+0445 FD AE 13    ...   XOR   (IY+13)    ; Umdrehen, falls high-Aktiv

+0448 20 0A        .    JR    NZ,0454    ; NZ=Puffer noch voll

+044A CD 45 05    .E.   CALL  0545       ; Flusskontrolle pruefen(XON/XOFF-->A

+044D FD 4E 1B    .N.   LD    C,(IY+1B)  ; Addresse des Datenports seriell

+0450 28 02       (.    JR    Z,0454     ; Nichtausgeben, weil Flusskontrolle

+0452 ED 79       .y    OUT   (C),A      ; Zeichen aus Akku ausgeben

+0454 FB          .     EI 

+0455 C9          .     RET              ;--------Transmitbuffer empty IRQ- 

+0456 FD E3       ..    EX    (SP),IY    ; Ruecksprungaddresse -31

+0458 C5          .     PUSH  BC         ; = Anfang der Kanalinfotabelle 

+0459 F5          .     PUSH  AF 

+045A 01 DF FF    ...   LD    BC,FFDF    ; -31

+045D FD 09       ..    ADD   IY,BC 

+045F FD 4E 1A    .N.   LD    C,(IY+1A)  ; Kommandoport des Kanals

+0462 3E 28       >(    LD    A,28       ; reset interrupt pending 

+0464 ED 79       .y    OUT   (C),A      ; Kommando ausgeben 

+0466 CD 3F 04    .?.   CALL  043F       ; Flusskontrolle durchfuehren

+0469 18 48       .H    JR    04B3       ; Interruptende

+046B FD E3       ..    EX    (SP),IY    ;------- External/Status Change IRQ 

+046D C5          .     PUSH  BC 

+046E F5          .     PUSH  AF 

+046F 01 DC FF    ...   LD    BC,FFDC    ; IY := Kanaltabelleninfo

+0472 FD 09       ..    ADD   IY,BC 

+0474 FD 4E 1A    .N.   LD    C,(IY+1A)  ; Statusportaddresse 

+0477 ED 78       .x    IN    A,(C)      ; Status einlesen 

+0479 06 10       ..    LD    B,10       ; reset Ext/Status Interrupts 

+047B ED 41       .A    OUT   (C),B 

+047D FC D1 05    ...   CALL  M,05D1     ; break empfangen : bit 7 = 1

+0480 CD 3C 04    .<.   CALL  043C       ; Flusskontrolle durchfuehren

+0483 18 2E       ..    JR    04B3       ; interrupt ende

+0485 FD E3       ..    EX    (SP),IY    ;--------special receive cond. IRQ 

+0487 C5          .     PUSH  BC 

+0488 F5          .     PUSH  AF 

+0489 01 D6 FF    ...   LD    BC,FFD6    ; IY := Kanaltabelleninfo 

+048C FD 09       ..    ADD   IY,BC 

+048E FD 4E 1A    .N.   LD    C,(IY+1A)  ; Status- u. Kommandoport 

+0491 3E 01       >.    LD    A,01       ; Read-Register 1

+0493 06 30       .0    LD    B,30 

+0495 ED 79       .y    OUT   (C),A      ; Reg.selekt

+0497 ED 78       .x    IN    A,(C)      ; Status einlesen

+0499 ED 41       .A    OUT   (C),B      ; Error-reset

+049B 47          G     LD    B,A 

+049C FD B6 15    ...   OR    (IY+15) 

+049F FD 77 15    .w.   LD    (IY+15),A  ; Fehler vermerken

+04A2 78          x     LD    A,B 

+04A3 FD A6 16    ...   AND   (IY+16)    ; Zulaessige Fehler maskieren

+04A6 28 1B       (.    JR    Z,04C3     ; keine Fehler, normale Eingabe 

+04A8 FD 4E 1B    .N.   LD    C,(IY+1B)  ; Zeichen vom Datenport einlesen

+04AB ED 78       .x    IN    A,(C) 

+04AD CD C9 05    ...   CALL  05C9       ; Zeichen per Inputinterrupt melden 

+04B0 CC 3C 04    .<.   CALL  Z,043C     ; Flusskontrolle durchfuehren

+04B3 F1          .     POP   AF 

+04B4 C1          .     POP   BC 

+04B5 FD E1       ..    POP   IY 

+04B7 FB          .     EI 

+04B8 ED 4D       .M    RETI             ;-------Receive Character avil. IRQ 

+04BA FD E3       ..    EX    (SP),IY 

+04BC C5          .     PUSH  BC 

+04BD F5          .     PUSH  AF 

+04BE 01 D9 FF    ...   LD    BC,FFD9    ; IY := Pufferanfang

+04C1 FD 09       ..    ADD   IY,BC 

+04C3 FD 4E 1B    .N.   LD    C,(IY+1B)  ; Datenport

+04C6 ED 78       .x    IN    A,(C)      ; Zeichen einlesen 

+04C8 CD A9 05    ...   CALL  05A9       ; Zeichen per inputinterrupt melden 

+04CB 18 E3       ..    JR    04B0       ; Interrupt mit Flusskontroller ende 

+04CD 78          x     LD    A,B        ;--------String in Puffer schreiben 

+04CE B1          .     OR    C          ; Nichts Auszugeben --> SCF RET

+04CF 37          7     SCF 

+04D0 C8          .     RET   Z 

+04D1 C5          .     PUSH  BC         ; String (HL/BC) in Puffer schreiben 

+04D2 FD 7E 02    .~.   LD    A,(IY+02)  ; IY - Kanaldescriptor

+04D5 FD 96 03    ...   SUB   (IY+03)    ; Puffergroesse - Pufferzeigerwrite 

+04D8 28 51       (Q    JR    Z,052B     ; puffer ist voll 

+04DA C5          .     PUSH  BC 

+04DB 5F          _     LD    E,A        ; freier Platz

+04DC 78          x     LD    A,B        ; Highbyte > 0 ? Laenge 

+04DD B7          .     OR    A 

+04DE 28 02       (.    JR    Z,04E2 

+04E0 0E FF       ..    LD    C,FF       ; Mehr als 255 Bytes Laenge

+04E2 7B          {     LD    A,E        ; 

+04E3 B9          .     CP    C 

+04E4 30 01       0.    JR    NC,04E7    ; Nicht genuegend Platz ?

+04E6 4F          O     LD    C,A 

+04E7 FD 7E 02    .~.   LD    A,(IY+02)  ; Puffergroesse- Pufferreadzeiger 

+04EA FD 96 04    ...   SUB   (IY+04) 

+04ED 20 05        .    JR    NZ,04F4    ; Noch Platz

+04EF FD 36 04 00 .6..  LD    (IY+04),00 ; Lesezeiger auf Anfang

+04F3 79          y     LD    A,C 

+04F4 B9          .     CP    C 

+04F5 30 01       0.    JR    NC,04F8 

+04F7 4F          O     LD    C,A 

+04F8 06 00       ..    LD    B,00 

+04FA C5          .     PUSH  BC 

+04FB FD 56 07    .V.   LD    D,(IY+07)  ; Pufferanfang + Pufferzeiger

+04FE FD 7E 06    .~.   LD    A,(IY+06) 

+0501 FD 86 04    ...   ADD   (IY+04) 

+0504 30 01       0.    JR    NC,0507 

+0506 14          .     INC   D          ; -->  DE bringen

+0507 5F          _     LD    E,A        ; und String von HL --> DE bringen 

+0508 ED B0       ..    LDIR 

+050A C1          .     POP   BC 

+050B FD 7E 04    .~.   LD    A,(IY+04) 

+050E 81          .     ADD   C          ; Pufferzeiger erhoehen

+050F FD 77 04    .w.   LD    (IY+04),A 

+0512 F3          .     DI 

+0513 FD 7E 03    .~.   LD    A,(IY+03)  ; Pufferzeigerwrite erhoehen

+0516 81          .     ADD   C          ; darf kein IRQ auftreten

+0517 FD 77 03    .w.   LD    (IY+03),A 

+051A FB          .     EI 

+051B E3          .     EX    (SP),HL    ; Stringlaenge (auf Stack) --> HL

+051C B7          .     OR    A 

+051D ED 42       .B    SBC   HL,BC      ; Reststringlaenge

+051F 44          D     LD    B,H 

+0520 4D          M     LD    C,L 

+0521 E1          .     POP   HL 

+0522 20 AE        .    JR    NZ,04D2    ; Reststring ggf. ausgeben

+0524 C1          .     POP   BC         ; Alle Zeichen uebernommen 

+0525 37          7     SCF 

+0526 FD CB 01 46 ...F  BIT   0,(IY+01) 

+052A C9          .     RET              ;----------------------------------

+052B E1          .     POP   HL 

+052C B7          .     OR    A 

+052D ED 42       .B    SBC   HL,BC 

+052F 44          D     LD    B,H 

+0530 4D          M     LD    C,L 

+0531 FD CB 01 46 ...F  BIT   0,(IY+01) 

+0535 C9          .     RET              ;----------- "frout" -------------- 

+0536 F3          .     DI               ; keine zeichen annehmen 

+0537 FD 7E 02    .~.   LD    A,(IY+02)  ; Puffergroesse - Pufferzeigerwrite 

+053A 47          G     LD    B,A        ; Pufferzeiger Write = anzahl Z. 

+053B FD 96 03    ...   SUB   (IY+03) 

+053E FB          .     EI 

+053F B8          .     CP    B          ; SCF, wenn Puffer leer

+0540 3F          ?     CCF 

+0541 06 00       ..    LD    B,00 

+0543 4F          O     LD    C,A 

+0544 C9          .     RET              ;---------------------------------- 

+0545 FD CB 01 66 ...f  BIT   4,(IY+01)  ; Flusskontrolle ?

+0549 20 37        7    JR    NZ,0582    ; ja 

+054B FD CB 01 4E ...N  BIT   1,(IY+01) 

+054F C8          .     RET   Z 

+0550 FD CB 01 C6 ....  SET   0,(IY+01)  ; Zeichen aus Puffer lesen (IY+05)

+0554 FD 7E 03    .~.   LD    A,(IY+03) 

+0557 B7          .     OR    A          ; Writezeiger am Anfang (leer)

+0558 C8          .     RET   Z          ; Zurueck

+0559 FD CB 01 86 ....  RES   0,(IY+01) 

+055D FD 35       .5    DEC   (IY+03)    ; Writezeiger DEC 1

+055F 03          .     INC   BC 

+0560 FD 46 07    .F.   LD    B,(IY+07)  ; Pufferanfang High

+0563 FD 7E 05    .~.   LD    A,(IY+05) 

+0566 FD BE 02    ...   CP    (IY+02) 

+0569 20 02        .    JR    NZ,056D 

+056B 3E 00       >.    LD    A,00 

+056D 3C          <     INC   A 

+056E FD 77 05    .w.   LD    (IY+05),A 

+0571 3D          =     DEC   A 

+0572 FD 86 06    ...   ADD   (IY+06)    ; Pufferanfang low

+0575 30 01       0.    JR    NC,0578 

+0577 04          .     INC   B          ; BC = Pufferzeiger

+0578 4F          O     LD    C,A 

+0579 0A          .     LD    A,(BC)     ; Zeichen aus Puffer (zeiger)

+057A FD A6 0C    ...   AND   (IY+0C)    ; Bit 8 ggf ausblenden

+057D FD AE 0D    ...   XOR   (IY+0D)    ;

+0580 04          .     INC   B 

+0581 C9          .     RET              ; Flusskontrolle

+0582 FD CB 01 A6 ....  RES   4,(IY+01) 

+0586 FD CB 01 6E ...n  BIT   5,(IY+01)  ; XON oder XOFF ?

+058A 28 08       (.    JR    Z,0594 

+058C FD CB 01 AE ....  RES   5,(IY+01) 

+0590 FD 7E 10    .~.   LD    A,(IY+10)  ; XON (CTRL-Q) stattdessen ausgeben

+0593 C9          .     RET              ;-----------------------------------

+0594 F6 01       ..    OR    01 

+0596 FD 7E 0F    .~.   LD    A,(IY+0F)  ; XOFF stattdessen ausgeben

+0599 C9          .     RET              ;----------------------------------

+059A FD CB 01 4E ...N  BIT   1,(IY+01)  ; XON empfangen

+059E FD CB 01 CE ....  SET   1,(IY+01) 

+05A2 C9          .     RET              ;--------------------------------- 

+05A3 FD CB 01 8E ....  RES   1,(IY+01)  ; XOFF-empfangen

+05A7 18 1D       ..    JR    05C6 

+05A9 FD A6 08    ...   AND   (IY+08)    ;------- Zeichen per 'inputinterrupt'

+05AC FD AE 09    ...   XOR   (IY+09)    ; masken fuer fehlerfreien receive 

+05AF FD CB 01 56 ...V  BIT   2,(IY+01)  ; XON/XOFF ? 

+05B3 28 0A       (.    JR    Z,05BF 

+05B5 FD BE 10    ...   CP    (IY+10)    ; XON-Zeichen ?

+05B8 28 E0       (.    JR    Z,059A 

+05BA FD BE 0F    ...   CP    (IY+0F)    ; XOFF-Zeichen ?

+05BD 28 E4       (.    JR    Z,05A3 

+05BF 47          G     LD    B,A        ; Zeichen in B verlangt

+05C0 FD 7E 00    .~.   LD    A,(IY+00)  ; Kanalnummer 

+05C3 CD 13 1E    ...   CALL  1E13       ; Inputinterrupt aufrufen

+05C6 F6 01       ..    OR    01 

+05C8 C9          .     RET              ;-------- fehlerhafter receive

+05C9 FD A6 0A    ...   AND   (IY+0A)    ; masken fuer fehlerhaften receive 

+05CC FD AE 0B    ...   XOR   (IY+0B) 

+05CF 18 DE       ..    JR    05AF       ; weiter wie normal 

+05D1 FD 7E 0E    .~.   LD    A,(IY+0E)  ;--------- fehlerhafter receive ---- 

+05D4 18 D9       ..    JR    05AF       ; '?' ausgeben 

+05D6 F3          .     DI               ;---------------------------------- 

+05D7 FD 7E 01    .~.   LD    A,(IY+01) 

+05DA CB 5F       ._    BIT   3,A 

+05DC 28 09       (.    JR    Z,05E7 

+05DE F6 30       .0    OR    30         ; Bit 4 + 5 setzen (XON/XOFF) 

+05E0 FD 77 01    .w.   LD    (IY+01),A 

+05E3 FD CB 01 46 ...F  BIT   0,(IY+01) 

+05E7 FB          .     EI 

+05E8 C9          .     RET              ;---------------------------------- 

+05E9 F3          .     DI               ; von RTS/DTR - XON/XOFF Routine 

+05EA FD 7E 01    .~.   LD    A,(IY+01)  ; aufgerufen

+05ED CB 5F       ._    BIT   3,A 

+05EF 28 0B       (.    JR    Z,05FC     ; Unbekannte Flusskontrolle

+05F1 F6 10       ..    OR    10 

+05F3 E6 DF       ..    AND   DF 

+05F5 FD 77 01    .w.   LD    (IY+01),A 

+05F8 FD CB 01 46 ...F  BIT   0,(IY+01) 

+05FC FB          .     EI 

+05FD C9          .     RET              ;----------- XON/XOFF setzen --------

+05FE FD CB 01 DE ....  SET   3,(IY+01) 

+0602 FD CB 01 D6 ....  SET   2,(IY+01) 

+0606 C9          .     RET              ;--------- IO-Stop d. Flow loeschen 

+0607 FD CB 01 9E ....  RES   3,(IY+01)  ; XON/XOFF loeschen

+060B FD CB 01 96 ....  RES   2,(IY+01) 

+060F FD CB 01 4E ...N  BIT   1,(IY+01)  ; XON Modus ?

+0613 FD CB 01 CE ....  SET   1,(IY+01)  ; XON-setzen

+0617 C9          .     RET              ;--------- Datenbitmasken --------- 

+0618 FD 73 0C    .s.   LD    (IY+0C),E  ; AND-maske fuer Datenbits setzen 

+061B FD 72 0D    .r.   LD    (IY+0D),D  ; Bei weniger als 5 Bits links 1er

+061E C9          .     RET              ;--------- Datenbitmasken setzen-- 

+061F FD 73 08    .s.   LD    (IY+08),E  ; AND  fuer fehlerfreien reiceive

+0622 FD 72 09    .r.   LD    (IY+09),D  ; XOR

+0625 C9          .     RET              ;--------- Datenbitmasken setzen 

+0626 FD 73 0A    .s.   LD    (IY+0A),E  ; AND fuer fehlerhaften receive

+0629 FD 72 0B    .r.   LD    (IY+0B),D  ; XOR

+062C C9          .     RET              ;-----------------------------------

+;======================== Illegaler Kanal ================================= 

+062D 01 5F 06                           ; 1, IOCONTROL "typ"

+0630 02 50 06                           ; 2, IOCONTROL "frout"

+0633 05 46 06                           ; 5, IOCONTROL "size"

+0636 FF 4C 06                           ; -1, IOCONTROL ill.

+0639 FF 55 06                           ; -1, Aufg. 5 Nicht moeglich

+063C FF 4C 06                           ; -1, BLOCKIN/BLOCKOUT nicht moegl. 

+063F 59 06                              ; Illegaler Kanal : OUTPUT 0659 

+0641 FD                                 ; BLOCKIN : 063C

+0642 FD                                 ; BLOCKOUT : 063C

+0643 EE                                 ; IOCONTROL : 062D

+0644 FA                                 ; Aufg. 5 : 0636

+0645 00                                 ; Keine I/O moeglich

+0646 3E 00       >.    LD    A,00       ; ---------- "size" --------------

+0648 01 00 00    ...   LD    BC,0000    ; Null Bloecke

+064B C9          .     RET              ;----------- "illegal" -1 ---------

+064C 01 FF FF    ...   LD    BC,FFFF    ; Kann nicht ausgefuehrt werden

+064F C9          .     RET              ;------------ "frout" -------------

+0650 01 C8 00    ...   LD    BC,00C8    ; kann 200 zeichen uebernehmen 

+0653 37          7     SCF              ; Puffer leer

+0654 C9          .     RET              ;---------- "nicht moegl" ----------

+0655 01 01 00    ...   LD    BC,0001    ; Liefert 1

+0658 C9          .     RET              ;---------- "OUTPUT" --------------

+0659 37          7     SCF              ; Alle Zeichen uebernommen 

+065A C9          .     RET              ;------------- "ok" ---------------- 

+065B 01 00 00    ...   LD    BC,0000 

+065E C9          .     RET              ; -------- "typ" ------------------ 

+065F 06 00       ..    LD    B,00       ; Type aus Parameterblock d. Kanals

+0661 DD 4E 06    .N.   LD    C,(IX+06) 

+0664 C9          .     RET              ;---------------------------------- 

+;=========================== Floppykanal ================================== 

+0665 05 95 06                           ; 5, IOCONTROL "size"

+0668 01 5F 06                           ; 1, IOCONTROL "typ"

+066B FF 4C 06                           ; -1, IOCONTROL ill.

+066E FE 85 06                           ; -2, Aufg. 5 : Kanal init

+0671 FF 55 06                           ; -1, Aufg. 5 : Geht nicht

+0674 00 9D 06                           ; 0, BLOCKIN : 069D

+0677 00 99 06                           ; 0, BLOCKOUT : 0699

+067A FF 4C 06                           ; -1, BLOCKOUT ill.

+067D 59 06                              ; Floppy: OUTPUT 0659 

+067F F7                                 ; BLOCKIN : 0674

+0680 FA                                 ; BLOCKOUT : 0677

+0681 E8                                 ; IOCONTROL : 0665

+0682 F1                                 ; Aufg. 5 : 066E

+0683 0C                                 ; Typ : BLOCKIO ohne format

+0684 04 

+0685 3E 70       >p    LD    A,70       ; ----------- Floppyinit ----------- 

+0687 D3 0A       ..    OUT   (0A),A     ; Interruptvektor PIOA Floppy = $70

+0689 11 58 09    .X.   LD    DE,0958    ; Interruptroutine FDC

+068C ED 57       .W    LD    A,I        ; In die Interruptvektortabelle 

+068E 67          g     LD    H,A        ; eintragen

+068F 2E 70       .p    LD    L,70 

+0691 73          s     LD    (HL),E 

+0692 23          #     INC   HL 

+0693 72          r     LD    (HL),D 

+0694 C9          .     RET              ;------------ "size" ---------------

+0695 01 D0 04    ...   LD    BC,04D0    ; 1232 Bloecke = 616K

+0698 C9          .     RET              ;----------- "BLOCKOUT" ----------- 

+0699 3E 01       >.    LD    A,01       ; A=1 : Write

+069B 18 01       ..    JR    069E       ; BLOCKIO

+069D AF          .     XOR   A          ;------------ "BLOCKIN" ---------- 

+069E E5          .     PUSH  HL         ; Hauptspeicheraddresse

+069F 21 CF 04    !..   LD    HL,04CF    ; Mit Max. Blocknummer

+06A2 B7          .     OR    A 

+06A3 ED 52       .R    SBC   HL,DE 

+06A5 E1          .     POP   HL 

+06A6 DA C9 0B    ...   JP    C,0BC9     ; Block zu hoch = 3

+06A9 E5          .     PUSH  HL 

+06AA 21 11 08    !..   LD    HL,0811    ; Floppysemaphor reservieren

+06AD CD 47 0C    .G.   CALL  0C47 

+06B0 E1          .     POP   HL 

+06B1 EB          .     EX    DE,HL      ; DE = Hauptspeicheraddresse

+06B2 4F          O     LD    C,A        ; A= Read/Write,HL = Blocknummer

+06B3 7D          }     LD    A,L 

+06B4 E6 0F       ..    AND   0F         ; A = Sektornummer 0..15

+06B6 CB 25       .%    SLA   L 

+06B8 CB 14       ..    RL    H          ; HL = Tracknummer 

+06BA CB 25       .%    SLA   L          ; Track = (Blocknr * 16) DIV 256

+06BC CB 14       ..    RL    H          ;       = Blocknr DIV 16

+06BE CB 25       .%    SLA   L 

+06C0 CB 14       ..    RL    H 

+06C2 CB 25       .%    SLA   L 

+06C4 CB 14       ..    RL    H 

+06C6 6F          o     LD    L,A        ; L = Sektor, H = Track

+06C7 79          y     LD    A,C        ; A = Read/Write

+06C8 B7          .     OR    A 

+06C9 FD 7E 08    .~.   LD    A,(IY+08) 

+06CC 28 05       (.    JR    Z,06D3     ; Z, wenn Read

+06CE CD CA 09    ...   CALL  09CA       ; Write Floppy (Interrupt anstossen)

+06D1 18 03       ..    JR    06D6       ; Skip

+06D3 CD BE 09    ...   CALL  09BE       ; Read Floppy (Interrupt anstossen)

+06D6 FD E5       ..    PUSH  IY 

+06D8 CD 19 1E    ...   CALL  1E19       ; Zur Sicherheit einmal 'warte'

+06DB FD E1       ..    POP   IY 

+06DD FD 7E 05    .~.   LD    A,(IY+05)  ; Return von Floppy-IRQ-Routine

+06E0 3C          <     INC   A 

+06E1 28 F3       (.    JR    Z,06D6     ; FF = Busy, IRQ noch nicht beendet

+06E3 21 11 08    !..   LD    HL,0811    ; Semaphor wieder freigeben

+06E6 CD 61 0C    .a.   CALL  0C61 

+06E9 3D          =     DEC   A          ; Muss = 0 sein, sonst fehler

+06EA C2 AE 0B    ...   JP    NZ,0BAE    ; Fehler ggf. melden

+06ED 01 00 00    ...   LD    BC,0000    ; Return: ok

+06F0 C9          .     RET              ;-----------------------------------

+;========================= Hintergrundkanal (Harddisk) ===================== 

+06F1 05 34 07                           ; 5, IOCONTROL "size"

+06F4 01 5F 06                           ; 1, IOCONTROL "typ"

+06F7 FF 4C 06                           ; -1, IOCONTROL ill.

+06FA FE 19 07                           ; -2, Aufg. 5 : kanal Init

+06FD 9C 3C 07                           ; -100, Aufg.5:Anz.HG-Bloecke setzen

+0700 FF 55 06                           ; -1, Aufg. 5 : BC = 1

+0703 00 4D 07                           ; 0, BLOCKIN

+0706 00 49 07                           ; 0, BLOCKOUT

+0709 FF 4C 06                           ; -1, BLOCKIO illg. 

+070C 59                                 ; Hintergrund : OUTPUT 0659

+070D 06 

+070E F7                                 ; BLOCKIN : 0703

+070F FA                                 ; BLOCKOUT : 0706

+0710 E5                                 ; IOCONTROL : 06F1

+0711 EE                                 ; Aufg. 5 : 06FA

+0712 0C                                 ; Typ : BLOCKIN/BLOCKOUT

+0713 00          .     NOP 

+0714 01 00 00    ...   LD    BC,0000 

+0717 00          .     NOP 

+0718 FF          .     RST   38         ;----------"HD-Init" --------------- 

+0719 21 DA 0F    !..   LD    HL,0FDA    ; Bei Floppy (0FDA) = 46H

+071C 22 0F 08    "..   LD    (080F),HL  ; Harddisktransferbufferaddresse

+071F DD 7E 0A    .~.   LD    A,(IX+0A)  ; New Cylinder Number

+0722 D3 22       ."    OUT   (22),A 

+0724 3E 70       >p    LD    A,70       ; Interruptvektor FDC+HDC

+0726 D3 0A       ..    OUT   (0A),A 

+0728 11 58 09    .X.   LD    DE,0958    ; Interruptserviceroutinenaddresse

+072B ED 57       .W    LD    A,I 

+072D 67          g     LD    H,A 

+072E 2E 70       .p    LD    L,70 

+0730 73          s     LD    (HL),E 

+0731 23          #     INC   HL 

+0732 72          r     LD    (HL),D 

+0733 C9          .     RET              ;------------ "size" --------------- 

+0734 FD 4E 01    .N.   LD    C,(IY+01)  ; HG-Maxblock Low

+0737 FD 46 02    .F.   LD    B,(IY+02)  ; High

+073A 03          .     INC   BC         ; +1 = Anzahl Bloecke

+073B C9          .     RET              ;------ Anzahl-HG-Bloecke setzen ---

+073C FD 75 01    .u.   LD    (IY+01),L  ; Letzter HD-Block 

+073F FD 74 02    .t.   LD    (IY+02),H 

+0742 FD 73 03    .s.   LD    (IY+03),E  ; Erster HD-Block

+0745 FD 72 04    .r.   LD    (IY+04),D 

+0748 C9          .     RET              ;-------- Hintergrund-Write --------- 

+0749 3E 01       >.    LD    A,01       ; 

+074B 18 01       ..    JR    074E       ;--------- Hintergrund-Read -------- 

+074D AF          .     XOR   A 

+074E E5          .     PUSH  HL         ; Blocknummer in DE

+074F FD 6E 01    .n.   LD    L,(IY+01)  ; Anzahl Hintergrundbloecke

+0752 FD 66 02    .f.   LD    H,(IY+02) 

+0755 B7          .     OR    A 

+0756 ED 52       .R    SBC   HL,DE 

+0758 E1          .     POP   HL 

+0759 DA C9 0B    ...   JP    C,0BC9     ; Block zu hoch

+075C E5          .     PUSH  HL 

+075D 21 11 08    !..   LD    HL,0811    ; Harddisksemaphor reservieren

+0760 CD 47 0C    .G.   CALL  0C47 

+0763 FD 6E 03    .n.   LD    L,(IY+03)  ; Erster Harddiskblock

+0766 FD 66 04    .f.   LD    H,(IY+04) 

+0769 19          .     ADD   HL,DE      ; + Blocknummer

+076A EB          .     EX    DE,HL 

+076B E1          .     POP   HL         ; DE=Blocknummer neu

+076C E5          .     PUSH  HL         ; HL=Hauptspeicherzieladdresse

+076D F5          .     PUSH  AF         ; Wird spaeter als BC gepopt

+076E B7          .     OR    A 

+076F 20 03        .    JR    NZ,0774    ; NZ=Write

+0771 2A 0F 08    *..   LD    HL,(080F)  ; Harddiskbufferaddresse

+0774 CD A5 07    ...   CALL  07A5       ; HDC fuer Transfer anstossen

+0777 DD E5       ..    PUSH  IX 

+0779 CD 19 1E    ...   CALL  1E19       ; 'warte' EUMEL0 aufrufen

+077C DD E1       ..    POP   IX 

+077E DD 7E 07    .~.   LD    A,(IX+07)  ; Harddisk ready ?

+0781 3C          <     INC   A          ; FF = not ready

+0782 28 F3       (.    JR    Z,0777     ; weiter warten

+0784 21 11 08    !..   LD    HL,0811    ; Semaphor freigeben

+0787 CD 61 0C    .a.   CALL  0C61 

+078A 3D          =     DEC   A          ; Fehlercode

+078B C1          .     POP   BC 

+078C E1          .     POP   HL 

+078D C2 AE 0B    ...   JP    NZ,0BAE    ; Bei Fehler melden 

+0790 78          x     LD    A,B        ; A=1 : Write

+0791 B7          .     OR    A 

+0792 20 0C        .    JR    NZ,07A0    ; Bei Write kein Transfer mehr

+0794 EB          .     EX    DE,HL      ; DE = Hauptspeicherzieladdresse

+0795 2A 0F 08    *..   LD    HL,(080F)  ; Hauptspeicher fuer HD-Transfer

+0798 23          #     INC   HL         ; Vorweg Status etc.

+0799 23          #     INC   HL 

+079A 23          #     INC   HL 

+079B 01 00 02    ...   LD    BC,0200    ; Vom HD-Buffer --> EUMEL-Block

+079E ED B0       ..    LDIR 

+07A0 01 00 00    ...   LD    BC,0000    ; "ok"

+07A3 C9          .     RET              ;----------------------------------

+07A4 C9          .     RET 

+07A5 E5          .     PUSH  HL         ;----------- HD-Transfer anstoss. --

+07A6 F5          .     PUSH  AF         ; A=1:Write,0=Read,HL=Mem.Addresse

+07A7 D5          .     PUSH  DE         ; DE=Blocknummer

+07A8 06 00       ..    LD    B,00       ; Cachesize = 21 max.

+07AA 3A 05 00    :..   LD    A,(0005)   ; (5) = Cachegroesse

+07AD B7          .     OR    A 

+07AE 28 26       (&    JR    Z,07D6     ; Nicht in Cache, neu berechnen

+07B0 4F          O     LD    C,A 

+07B1 7A          z     LD    A,D        ; D = Blocknummer High zum suchen

+07B2 21 05 00    !..   LD    HL,0005    ; Tabellenanfang = 6

+07B5 09          .     ADD   HL,BC      ; + Cachegroesse

+07B6 ED B9       ..    CPDR             ; Blocknummerhigh suchen 

+07B8 20 1C        .    JR    NZ,07D6    ; Nicht gefunden, Tabelle durch

+07BA F5          .     PUSH  AF         ; gefunden, test, ob Blocknummerlow 

+07BB E5          .     PUSH  HL         ; auch stimmt

+07BC 21 1A 00    !..   LD    HL,001A    ; Tabellenanfang = 27

+07BF 09          .     ADD   HL,BC 

+07C0 7B          {     LD    A,E        ; Blocknummer Low

+07C1 BE          .     CP    (HL) 

+07C2 28 07       (.    JR    Z,07CB     ; Ja, Block gefunden in Cache

+07C4 E1          .     POP   HL 

+07C5 F1          .     POP   AF 

+07C6 EA B6 07    ...   JP    PE,07B6    ; Noch nicht die ganze Tabelle durch

+07C9 18 0B       ..    JR    07D6       ; Ganz durch, neu berechnen 

+07CB E1          .     POP   HL         ; Aus Cache entnehmen

+07CC F1          .     POP   AF 

+07CD 21 44 00    !D.   LD    HL,0044 

+07D0 09          .     ADD   HL,BC 

+07D1 C1          .     POP   BC 

+07D2 EB          .     EX    DE,HL 

+07D3 C3 A7 07    ...   JP    07A7       ;---------------------------------- 

+07D6 E1          .     POP   HL 

+07D7 F1          .     POP   AF 

+07D8 D1          .     POP   DE 

+07D9 01 40 04    .@.   LD    BC,0440    ; 1088 Bloecke subtrahieren

+07DC F5          .     PUSH  AF         ; fuer Cylindernrhigh

+07DD AF          .     XOR   A 

+07DE ED 42       .B    SBC   HL,BC      ; 1088 = 17(sektoren)*4(heads)*16

+07E0 3C          <     INC   A 

+07E1 30 FB       0.    JR    NC,07DE    ; cylindernrh = blocknr DIV 1088

+07E3 09          .     ADD   HL,BC 

+07E4 3D          =     DEC   A          ; restbloecke in HL

+07E5 07          .     RLCA             ; ins hoeherwertige Nibble bringen 

+07E6 07          .     RLCA             ; (*16)

+07E7 07          .     RLCA 

+07E8 07          .     RLCA 

+07E9 F5          .     PUSH  AF 

+07EA 01 44 00    .D.   LD    BC,0044    ; Cylindernummerlow

+07ED AF          .     XOR   A          ; restblocknr DIV 68 = cylindernrl

+07EE ED 42       .B    SBC   HL,BC 

+07F0 3C          <     INC   A 

+07F1 30 FB       0.    JR    NC,07EE 

+07F3 09          .     ADD   HL,BC 

+07F4 3D          =     DEC   A 

+07F5 67          g     LD    H,A       ; Cylinder = cylinderl*16+cylinderh

+07F6 F1          .     POP   AF 

+07F7 B4          .     OR    H 

+07F8 67          g     LD    H,A       ; H = Cylinder

+07F9 7D          }     LD    A,L       ; Head = Blocknr MOD 4

+07FA E6 03       ..    AND   03 

+07FC 07          .     RLCA            ; Head ins Highnibble bringen

+07FD 07          .     RLCA 

+07FE 07          .     RLCA 

+07FF 07          .     RLCA 

+0800 CB 3D       .=    SLR   L         ; Sektor = restblocknr DIV 4

+0802 CB 3D       .=    SLR   L         ; 17. Sektor ist ungenutzt

+0804 4F          O     LD    C,A 

+0805 F1          .     POP   AF 

+0806 FE 01       ..    CP    01 

+0808 79          y     LD    A,C 

+0809 CA 6B 08    .k.   JP    Z,086B     ; Z, wenn Write

+080C C3 5C 08    .\.   JP    085C       ; Read

+080F 00          .     NOP              ; HD-Transferpuffer

+0810 00          .     NOP 

+0811 00          .     NOP 

+;=============================== Timerinterrupt ===========================

+0812 11 2D 08    .-.   LD    DE,082D    ;-------- Timer Init ----------------

+0815 ED 57       .W    LD    A,I 

+0817 67          g     LD    H,A 

+0818 2E C6       ..    LD    L,C6       ; HL = 00C6 Interruptserviceroutine 

+081A 3E 33       >3    LD    A,33       ; Fuer alle Kanaele einen programm. 

+081C E6 FC       ..    AND   FC         ; C0=0, C2=1, C4=2, C6=3(timer)

+081E 4F          O     LD    C,A 

+081F ED 69       .i    OUT   (C),L      ; Interruptvektor setzen

+0821 73          s     LD    (HL),E     ; Addresse der Serviceroutine 

+0822 23          #     INC   HL         ; --> (00C6) fuer CTC-Kanal 3 

+0823 72          r     LD    (HL),D 

+0824 3E B5       >.    LD    A,B5       ; IRQ,Timer,DIV256,pos.flanke,kein

+0826 D3 33       .3    OUT   (33),A     ; externer trigger, timeconst folgt

+0828 3E FA       >.    LD    A,FA       ; 250 = Zeitkonstante: 

+082A D3 33       .3    OUT   (33),A     ; Hz=4000000/256/250=62.5 ^ 16ms

+082C C9          .     RET              ;------ Timer-Service-IRQ --------- 

+082D F5          .     PUSH  AF 

+082E 3E 10       >.    LD    A,10       ; Alle 16ms Interrupt 

+0830 CD 16 1E    ...   CALL  1E16       ; "timerinterrupt" 

+0833 3A 5B 08    :[.   LD    A,(085B) 

+0836 3C          <     INC   A 

+0837 FE 3E       .>    CP    3E         ; Alle 62 Timerdurchlaeufe ~ 1s 

+0839 28 07       (.    JR    Z,0842 

+083B 32 5B 08    2[.   LD    (085B),A   ; Zaehler INCR 1

+083E F1          .     POP   AF 

+083F FB          .     EI 

+0840 ED 4D       .M    RETI             ;-------------IRQ-Ende-------------- 

+0842 AF          .     XOR   A          ; Sekundenzaehler auf 0

+0843 32 5B 08    2[.   LD    (085B),A 

+0846 DD E5       ..    PUSH  IX 

+0848 FD E5       ..    PUSH  IY 

+084A E5          .     PUSH  HL 

+084B D5          .     PUSH  DE 

+084C C5          .     PUSH  BC 

+084D C3 50 08    .P.   JP    0850       ; Wird jede Sekunde aufgerufen 

+0850 C1          .     POP   BC 

+0851 D1          .     POP   DE 

+0852 E1          .     POP   HL 

+0853 FD E1       ..    POP   IY 

+0855 DD E1       ..    POP   IX 

+0857 F1          .     POP   AF 

+0858 FB          .     EI 

+0859 ED 4D       .M    RETI             ;-----------IRQ-Ende---------------- 

+085B 00          .     NOP              ; Sekundenzaehler

+;============================= Harddisk I/O ===============================

+085C 0E 01       ..    LD    C,01       ;----------- HD-Read-Routine-------- 

+085E DD 36 09 01 .6..  LD    (IX+09),01 ; Read-Kommando fuer HDC

+0862 ED 53 AB 09 .S..  LD    (09AB),DE  ; Zieladdresse

+0866 11 02 02    ...   LD    DE,0202    ; 515 Bytes

+0869 18 0D       ..    JR    0878 

+086B 0E 05       ..    LD    C,05       ;---------- HD-Write-Routine ------- 

+086D DD 36 09 02 .6..  LD    (IX+09),02 ; (09BA) = Track(High),Sektor(Low)

+0871 ED 53 AB 09 .S..  LD    (09AB),DE  ; Sourceaddresse, 02 = WriteCMD HDC

+0875 11 FF 01    ...   LD    DE,01FF    ; 512 Bytes

+0878 DD 22 BC 09 ."..  LD    (09BC),IX  ; IX retten

+087C ED 53 AD 09 .S..  LD    (09AD),DE  ; Anzahl Bytes zu uebertragen

+0880 DD 36 0C 05 .6..  LD    (IX+0C),05 

+0884 22 BA 09    "..   LD    (09BA),HL 

+0887 DD 36 07 FF .6..  LD    (IX+07),FF 

+088B 2A BA 09    *..   LD    HL,(09BA) 

+088E F6 01       ..    OR    01         ; HD-Drive 1 auswaehlen

+0890 D3 20       .     OUT   (20),A     ; Head und Drive selektieren

+0892 57          W     LD    D,A 

+0893 79          y     LD    A,C 

+0894 32 B7 09    2..   LD    (09B7),A   ; Read or Write 01/05

+0897 DB 23       .#    IN    A,(23)     ; Status einlesen

+0899 CB 77       .w    BIT   6,A 

+089B 28 07       (.    JR    Z,08A4 

+089D 3E 02       >.    LD    A,02       ; NZ = "write fault"

+089F D3 20       .     OUT   (20),A     ; Drive 2 selektieren

+08A1 7A          z     LD    A,D        ; Headnummer setzen

+08A2 D3 20       .     OUT   (20),A 

+08A4 7C          |     LD    A,H        ; Cylindernummer

+08A5 DD BE 0A    ...   CP    (IX+0A)    ; = Alter Cylinder

+08A8 CA C4 08    ...   JP    Z,08C4     ; ja, kein neuer Cylinderseek

+08AB DD 7E 0A    .~.   LD    A,(IX+0A)  ; alten Cylinder holen --> HDC

+08AE D3 21       .!    OUT   (21),A     ; last significant Bits of CYL

+08B0 AF          .     XOR   A          ; most significant Bits of CYL = 0

+08B1 D3 21       .!    OUT   (21),A 

+08B3 7C          |     LD    A,H        ; Neue Cylindernummer

+08B4 D3 22       ."    OUT   (22),A     ; ausgeben und 

+08B6 DD 77 0A    .w.   LD    (IX+0A),A  ; vermerken

+08B9 AF          .     XOR   A          ; Most significant Bits = 0

+08BA D3 22       ."    OUT   (22),A 

+08BC 3E 10       >.    LD    A,10       ; Seek-Kommando an HDC

+08BE CD 5B 09    .[.   CALL  095B 

+08C1 2A BA 09    *..   LD    HL,(09BA)  ; Sektornummer

+08C4 7D          }     LD    A,L        ; ausgeben

+08C5 D3 21       .!    OUT   (21),A 

+08C7 21 A9 09    !..   LD    HL,09A9    ; DMA-Init-Tabelle

+08CA C5          .     PUSH  BC 

+08CB 01 00 11    ...   LD    BC,1100    ; DMA-Transfer vorbereiten

+08CE ED B3       ..    OTIR             ; 17 Bytes an DMA-Controller

+08D0 C1          .     POP   BC 

+08D1 DD 7E 09    .~.   LD    A,(IX+09)  ; 01=Read, 02=Write

+08D4 CD 5B 09    .[.   CALL  095B       ; An HDC-Controller schicken

+08D7 DD 36 0C FF .6..  LD    (IX+0C),FF ; Status in A

+08DB 21 40 09    !@.   LD    HL,0940    ; Fehlernummer (in L) --> IX+07 

+08DE E5          .     PUSH  HL 

+08DF 21 58 09    !X.   LD    HL,0958    ; HD-IRQ-Serviceroutine

+08E2 22 70 00    "p.   LD    (0070),HL  ; in Vektortabelle eintragen

+08E5 2E 00       ..    LD    L,00 

+08E7 E6 5D       .]    AND   5D         ; HD-Status in A

+08E9 CA 46 09    .F.   JP    Z,0946     ; "ok"

+08EC CB 5F       ._    BIT   3,A        ; NZ, wenn "Record not found"

+08EE C2 11 09    ...   JP    NZ,0911    ; 

+08F1 CB 67       .g    BIT   4,A        ; NZ, wenn "CRC error"

+08F3 28 03       (.    JR    Z,08F8 

+08F5 2E 02       ..    LD    L,02       ; 2 = "crc err"

+08F7 C9          .     RET              ;------------------------------- 

+08F8 CB 57       .W    BIT   2,A        ; NZ, wenn "bad sector"

+08FA 28 03       (.    JR    Z,08FF 

+08FC 2E 03       ..    LD    L,03       ; "bad sect"

+08FE C9          .     RET              ;-------------------------------

+08FF CB 77       .w    BIT   6,A        ; NZ, wenn "write fault"

+0901 28 0B       (.    JR    Z,090E 

+0903 2E 04       ..    LD    L,04       ; "write fault"

+0905 3E 02       >.    LD    A,02       ; Drive 2 selektieren

+0907 D3 20       .     OUT   (20),A 

+0909 E6 3F       .?    AND   3F 

+090B D3 20       .     OUT   (20),A     ; Heads 4..15 gibt es nicht

+090D C9          .     RET              ;-------------------------------

+090E 2E 05       ..    LD    L,05       ; "write fault" 

+0910 C9          .     RET              ;------------------------------ 

+0911 2E 07       ..    LD    L,07       ; "rec not fnd"

+0913 DD 35       .5    DEC   (IX+08)    ; Noch einmal

+0915 08          .     EX    AF,AF' 

+0916 C0          .     RET   NZ         ; Nach 8 Versuchen:

+0917 E1          .     POP   HL 

+0918 DD 36 0B 07 .6..  LD    (IX+0B),07 ; Register fuer Cylinderpos etc. 

+091C DD 36 08 08 .6..  LD    (IX+08),08 

+0920 DD 36 07 FF .6..  LD    (IX+07),FF 

+0924 DD 36 0C FF .6..  LD    (IX+0C),FF 

+0928 DD 36 0A 00 .6..  LD    (IX+0A),00 

+092C 3E 20       >     LD    A,20       ; Recalibrate Head

+092E CD 5B 09    .[.   CALL  095B       ; Kommando ausgeben

+0931 DD 7E 0B    .~.   LD    A,(IX+0B) 

+0934 DD 77 07    .w.   LD    (IX+07),A 

+0937 21 58 09    !X.   LD    HL,0958    ; Dummy-IRQ-Vektor (EI, RETI)

+093A 22 70 00    "p.   LD    (0070),HL 

+093D C3 A4 07    ...   JP    07A4       ; RET

+0940 DD 75 07    .u.   LD    (IX+07),L 

+0943 C3 A4 07    ...   JP    07A4       ; NOP oder RET (i.d.R RET)

+0946 3E BB       >.    LD    A,BB       ; Lesemaske setzen 

+0948 D3 00       ..    OUT   (00),A     ; DMA-Kommando

+094A 3E 01       >.    LD    A,01       ; BIT0 = Register 0 wird gelesen

+094C D3 00       ..    OUT   (00),A     ; Register 0 ist Statusregister

+094E DB 00       ..    IN    A,(00)     ; DMA-Status einlesen (Readregister0)

+0950 E6 21       .!    AND   21         ; Test, ob DMA laeuft

+0952 EE 01       ..    XOR   01         ; Kein Blockende und DMA erhielt BCK

+0954 C8          .     RET   Z          ; DMA- angestossen = 0

+0955 36 06       6.    LD    (HL),06    ; DMA-failed

+0957 C9          .     RET 

+0958 FB          .     EI 

+0959 ED 4D       .M    RETI             ;--------- Kommando an HDC -------- 

+095B E1          .     POP   HL         ; in A

+095C 22 7F 09    "..   LD    (097F),HL  ; Returnaddresse --> CALL Fehler 

+095F 21 68 09    !h.   LD    HL,0968    ; Interruptserviceroutine

+0962 22 70 00    "p.   LD    (0070),HL 

+0965 D3 23       .#    OUT   (23),A     ; Kommando ausgeben

+0967 C9          .     RET              ;-------- IRQ-Serviceroutine HDC-----

+0968 F5          .     PUSH  AF 

+0969 DD E5       ..    PUSH  IX 

+096B DD 2A BC 09 .*..  LD    IX,(09BC) 

+096F E5          .     PUSH  HL 

+0970 DB 08       ..    IN    A,(08)     ; HDC-IRQ ?

+0972 CB 7F       ..    BIT   7,A 

+0974 F5          .     PUSH  AF 

+0975 DB 23       .#    IN    A,(23)     ; Status lesen (wird geloescht)

+0977 67          g     LD    H,A 

+0978 3E 00       >.    LD    A,00 

+097A D3 23       .#    OUT   (23),A     ; Null (quiescent state) Kommando

+097C F1          .     POP   AF 

+097D 7C          |     LD    A,H 

+097E C4 67 09    .g.   CALL  NZ,0967   ; Fehler --> L bringen

+0981 DB 04       ..    IN    A,(04)    ; Drive/Controller Status FDC 

+0983 E1          .     POP   HL 

+0984 DD E1       ..    POP   IX 

+0986 F1          .     POP   AF 

+0987 FB          .     EI 

+0988 ED 4D       .M    RETI             ;----------------------------------- 

+098A F5          .     PUSH  AF 

+098B E5          .     PUSH  HL 

+098C DD E5       ..    PUSH  IX 

+098E DB 23       .#    IN    A,(23)     ; Status einlesen (dummy)

+0990 DD 2A BC 09 .*..  LD    IX,(09BC) 

+0994 3E 40       >@    LD    A,40       ; Welches Kommando ist das ???!!!

+0996 D3 23       .#    OUT   (23),A 

+0998 DB 04       ..    IN    A,(04)     ; FDC-Status einlesen

+099A DD 36 07 08 .6..  LD    (IX+07),08 

+099E 21 58 09    !X.   LD    HL,0958    ; Dummy-IRQ-Vektor

+09A1 22 70 00    "p.   LD    (0070),HL 

+09A4 DD E1       ..    POP   IX 

+09A6 E1          .     POP   HL 

+09A7 F1          .     POP   AF 

+09A8 C9          .     RET              ; DMA-Initialisierungstabelle -HDC-

+                            ;-DMA-Register 6 (Kommandoregister) "RESET"

+09A9 C3                                 ; Softreset an DMA-Controller

+                            ;-DMA-Register 0 (Port A Addressregister) 

+09AA 7D                                 ; A --> B uebertragen, BL & Adr folgt

+09AB 00 00                              ; Startaddresse Port A 

+09AD FF 01                              ; Anzahl Bytes -1 (Bytecount) 

+                            ;-DMA-Register 1 (Port A Modus)

+09AF 14                                 ; Port A ist Speicher, INCR Adress

+                            ;-DMA-Register 2 (Port B Modus) 

+09B0 28                                 ; Port B ist IO-Port, Adr. konstant 

+                            ;-DMA-Register 4 (Betriebsart & Port B Adr.reg.)

+09B1 A5                                 ; Blockmodus, IO-Port B folgt 

+09B2 21                                 ; 21 = Data I/O-Port fuer HDC

+                            ;-DMA-Register 5 (Pin-Control)

+09B3 8A                                 ; Stop am Blockende,Pin16=-CE,RDYakt1

+                            ;-DMA-Register 6 (Kommando) "LOAD"

+09B4 CF                                 ; Adresse & BL aus WR0/WR4 laden 

+09B5 01                                 ; Wegen Maskenfehler: Direction umk. 

+09B6 CF                                 ;        "         Kommando "LOAD"

+09B7 01                                 ; 01 : B-->A, 05 : A-->B

+09B8 CF                                 ; Kommando : "LOAD"

+09B9 87                                 ; DMA-Freigabe       ------ bis hier

+09BA 00          .     NOP              ; Bereich fuer IX (retten) 

+09BB 00          .     NOP 

+09BC 00          .     NOP              ; Sektornummer, 09BD = Tracknummer 

+09BD 00          .     NOP              ;------- Floppy-Read anstoss.------ 

+;============================= Floppy I/O ==================================

+09BE FD 36 01 9F .6..  LD    (IY+01),9F ; AND-Maske fuer FDC-Status-ready

+09C2 0E 01       ..    LD    C,01       ; DMA-Read-Kommando

+09C4 FD 36 02 88 .6..  LD    (IY+02),88 ; FDC-Kommando read

+09C8 18 0A       ..    JR    09D4 

+09CA FD 36 01 FF .6..  LD    (IY+01),FF ;------- Floppy-Write anstoss.------ 

+09CE 0E 05       ..    LD    C,05       ; AND-Maske fuer FDC-Status-ready

+09D0 FD 36 02 A8 .6..  LD    (IY+02),A8 ; ^ DMA-Write-Kommando,FDC-Kommandowrite 

+09D4 FD 22 B1 0A ."..  LD    (0AB1),IY  ; IY retten

+09D8 FB          .     EI 

+09D9 E5          .     PUSH  HL 

+09DA 21 C1 0A    !..   LD    HL,0AC1    ; DMA-Direction-Byte

+09DD 71          q     LD    (HL),C 

+09DE E1          .     POP   HL 

+09DF FD 36 0A 46 .6.F  LD    (IY+0A),46 

+09E3 ED 53 B5 0A .S..  LD    (0AB5),DE  ; Zieladdresse fuer DMA 

+09E7 FD 36 05 FF .6..  LD    (IY+05),FF 

+09EB CB BF       ..    RES   7,A 

+09ED DD BE 07    ...   CP    (IX+07) 

+09F0 28 1C       (.    JR    Z,0A0E 

+09F2 DD 77 07    .w.   LD    (IX+07),A 

+09F5 22 C4 0A    "..   LD    (0AC4),HL  ; track/sektor retten

+09F8 FD 7E 06    .~.   LD    A,(IY+06) 

+09FB D3 05       ..    OUT   (05),A     ;  Tracknummer

+09FD D3 07       ..    OUT   (07),A     ;  Output to FDC

+09FF 3E 12       >.    LD    A,12       ; FDC-Kommando

+0A01 CD 76 0A    .v.   CALL  0A76 

+0A04 FD 7E 09    .~.   LD    A,(IY+09)  ; Floppydrive (Headselect)

+0A07 CB C7       ..    SET   0,A        ; Single Density

+0A09 D3 08       ..    OUT   (08),A     ; Floppy Format + Headselect

+0A0B 2A C4 0A    *..   LD    HL,(0AC4)  ; geretteter Sektor 

+0A0E 7D          }     LD    A,L        ; Sektornumber

+0A0F D3 06       ..    OUT   (06),A 

+0A11 7C          |     LD    A,H        ; Tracknummer

+0A12 FD BE 06    ...   CP    (IY+06) 

+0A15 28 0A       (.    JR    Z,0A21 

+0A17 FD 77 06    .w.   LD    (IY+06),A 

+0A1A D3 07       ..    OUT   (07),A     ; Outputdatabyte Track setzen

+0A1C 3E 1A       >.    LD    A,1A       ; FDC-Kommando

+0A1E CD 76 0A    .v.   CALL  0A76 

+0A21 DB 08       ..    IN    A,(08)     ; Headloadinput testen

+0A23 CB 4F       .O    BIT   1,A 

+0A25 FD 7E 02    .~.   LD    A,(IY+02)  ; Read/Write-Kommando an FDC

+0A28 20 02        .    JR    NZ,0A2C    ; Head ist auf der Floppy

+0A2A CB D7       ..    SET   2,A        ; Head muss noch auf Floppy

+0A2C 21 B3 0A    !..   LD    HL,0AB3    ; DMA-Tabelle 

+0A2F 01 00 11    ...   LD    BC,1100    ; 17 Bytes in DMA schreiben

+0A32 ED B3       ..    OTIR 

+0A34 CD 76 0A    .v.   CALL  0A76       ; FDC-Kommando ausgeben (starten)

+0A37 FD 36 0A FF .6..  LD    (IY+0A),FF 

+0A3B 21 AE 0A    !..   LD    HL,0AAE 

+0A3E 22 70 00    "p.   LD    (0070),HL 

+0A41 DB 04       ..    IN    A,(04)     ; FDC - Status

+0A43 FD A6 01    ...   AND   (IY+01)    ; maske fuer 'fehler'

+0A46 CB 7F       ..    BIT   7,A 

+0A48 20 11        .    JR    NZ,0A5B    ; ist noch busy

+0A4A B7          .     OR    A          ; Irgendwelche Fehler ?

+0A4B 20 05        .    JR    NZ,0A52 

+0A4D FD 36 05 00 .6..  LD    (IY+05),00 ; Kein Fehler, "ok"

+0A51 C9          .     RET 

+0A52 CB 67       .g    BIT   4,A        ; CRC ?

+0A54 20 0A        .    JR    NZ,0A60 

+0A56 FD 36 05 02 .6..  LD    (IY+05),02 ; Fehler "crc err"

+0A5A C9          .     RET 

+0A5B FD 36 05 01 .6..  LD    (IY+05),01 ; Fehler 1 : "busy"

+0A5F C9          .     RET 

+0A60 FD 36 05 FF .6..  LD    (IY+05),FF ; Interrupt noch nicht beendet setz.

+0A64 3E 0A       >.    LD    A,0A       ; Kommando 10 an FDC

+0A66 CD 76 0A    .v.   CALL  0A76 

+0A69 FD 36 05 02 .6..  LD    (IY+05),02 ; Fehler 2 : "crc err"

+0A6D DB 04       ..    IN    A,(04)     ; FDC-Status

+0A6F 21 AE 0A    !..   LD    HL,0AAE    ; Dummy-IRQ Vektor (EI, RETI)

+0A72 22 70 00    "p.   LD    (0070),HL  ; eintragen

+0A75 C9          .     RET              ;----------FDC Kommandoausgeben----

+0A76 E1          .     POP   HL         ; Returnaddresse = Fehlernr.laden

+0A77 22 A5 0A    "..   LD    (0AA5),HL 

+0A7A 21 96 0A    !..   LD    HL,0A96 

+0A7D 22 70 00    "p.   LD    (0070),HL  ; Floppy IRQ-Vektor setzen

+0A80 D3 04       ..    OUT   (04),A     ; 1797 FDC Command

+0A82 C9          .     RET              ;----------------------------------

+0A83 F5          .     PUSH  AF 

+0A84 FD 2A B1 0A .*..  LD    IY,(0AB1)  ; geretteter IY

+0A88 FD 36 05 02 .6..  LD    (IY+05),02 ; "crc err"

+0A8C E5          .     PUSH  HL 

+0A8D 21 AE 0A    !..   LD    HL,0AAE    ; Dummy-Interrupt-Vektor

+0A90 22 70 00    "p.   LD    (0070),HL 

+0A93 E1          .     POP   HL 

+0A94 F1          .     POP   AF 

+0A95 C9          .     RET              ;----- IRQ-Service-Routine ---------

+0A96 FB          .     EI               ; 

+0A97 FD E5       ..    PUSH  IY 

+0A99 E5          .     PUSH  HL 

+0A9A C5          .     PUSH  BC 

+0A9B F5          .     PUSH  AF 

+0A9C FD 2A B1 0A .*..  LD    IY,(0AB1)  ; geretteter IY

+0AA0 DB 08       ..    IN    A,(08)     ; IRQ-Anford.Register

+0AA2 CB 77       .w    BIT   6,A        ; BIT6=FDC IRQ aufgetreten

+0AA4 C4 82 0A    ...   CALL  NZ,0A82    ; Returnaddresse in CALL-Addresse

+0AA7 DB 23       .#    IN    A,(23)     ; Statusbyte Harddisk loeschen

+0AA9 F1          .     POP   AF 

+0AAA C1          .     POP   BC 

+0AAB E1          .     POP   HL 

+0AAC FD E1       ..    POP   IY 

+0AAE FB          .     EI 

+0AAF ED 4D       .M    RETI             ;-----------------------------------

+0AB1 00          .     NOP              ; Platz zum retten von IY 

+0AB2 00          .     NOP              ;- DMA-Initialisierung fuer FDC --- 

+0AB3 C3                                 ; Softreset an DMA-Controller

+                            ;-DMA-Register 0 (Port A Addressregister) 

+0AB4 7D                                 ; A --> B uebertragen, BL & Adr folgt

+0AB5 00 00                              ; Startaddresse Port A 

+0AB7 FF 01                              ; Anzahl Bytes -1 (Bytecount) 

+                            ;-DMA-Register 1 (Port A Modus)

+0AB9 14                                 ; Port A ist Speicher, INCR Adress

+                            ;-DMA-Register 2 (Port B Modus) 

+0ABA 28                                 ; Port B ist IO-Port, Adr. konstant 

+                            ;-DMA-Register 4 (Betriebsart & Port B Adr.reg.)

+0ABB 85                                 ; Einzelbytemodus(!) IO-Port B folgt 

+0ABC 07                                 ; 01 = Data I/O-Port fuer FDC

+                            ;-DMA-Register 5 (Pin-Control)

+0ABD 8A                                 ; Stop am Blockende,Pin16=-CE,RDYakt1

+                            ;-DMA-Register 6 (Kommando) "LOAD"

+0ABE CF                                 ; Adresse & BL aus WR0/WR4 laden 

+0ABF 01                                 ; Wegen Maskenfehler: Direction umk. 

+0AC0 CF                                 ;        "         Kommando "LOAD"

+0AC1 01                                 ; 01 : B-->A, 05 : A-->B

+0AC2 CF                                 ; Kommando : "LOAD"

+0AC3 87                                 ; DMA-Freigabe       ------ bis hier

+0AC4 00 00                              ;---------------------------------- 

+;=========================== Parallel Kanaele =============================

+0AC6 01 5F 06                           ; 1 IOCONTROL "typ"

+0AC9 02 7B 0B                           ; 2 IOCONTROL "frout"

+0ACC 05 46 06                           ; 5 IOCONTROL "size"

+0ACF FD 07 0B                           ; -3 IOCONTROL "Printerstat --> BC" 

+0AD2 FC FF 0A                           ; -4 IOCONTROL"code2 --> Printerport" 

+0AD5 FB 03 0B                           ; -5 IOCONTROL"code2 --> Pstatusport"

+0AD8 FF 4C 06                           ; -1 IOCONTROL ill.

+0ADB E2 0D 0B                           ; -30 Aufg. 5, Maske fuer Busy-Status

+0ADE E1 14 0B                           ; -31 Aufg. 5, Maske fuer Printerstb.

+0AE1 FE F1 0A                           ; -2  Aufg. 5 = Kanal init

+0AE4 FF 55 06                           ; -1, Aufg. 5 --> BC = 1 

+0AE7 FF 4C 06                           ; -1, BLOCKIN, BLOCKOUT ill.

+0AEA 1E                                 ; Parallel 0B1E = OUTPUT

+0AEB 0B          .     DEC   BC 

+0AEC FD          .                      ; BLOCKIN : 0AE7

+0AED FD          .                      ; BLOCKOUT : 0AE7

+0AEE DC                                 ; IOCONTROL : 0AC6

+0AEF F1                                 ; Aufg. 5 : 0ADB

+0AF0 03                                 ; Typ : Input/Ouput (Stream)

+0AF1 DB 10       ..    IN    A,(10)     ;-------- Kanal Init --------------- 

+0AF3 FD A6 03    ...   AND   (IY+03)    ; Printer selektieren

+0AF6 FD AE 04    ...   XOR   (IY+04) 

+0AF9 FD AE 05    ...   XOR   (IY+05) 

+0AFC D3 10       ..    OUT   (10),A     ; Ausgabe an Printerstatusport

+0AFE C9          .     RET              ;----------- "IOCONTROL -4" --------

+0AFF 7B          {     LD    A,E        ; Printerdata direkt ausgeben 

+0B00 D3 11       ..    OUT   (11),A 

+0B02 C9          .     RET              ;---------- "IOCONTROL -5"- --------

+0B03 7B          {     LD    A,E        ; datastrobe, input prime, control 

+0B04 D3 10       ..    OUT   (10),A     ; An Statusport (printer) ausgeben 

+0B06 C9          .     RET              ;-------- "IOCONTROL -3" -----------

+0B07 DB 10       ..    IN    A,(10)     ; Liest der Printerstatus ein 

+0B09 4F          O     LD    C,A 

+0B0A 06 00       ..    LD    B,00 

+0B0C C9          .     RET              ;----- Aufg. 5, "-14" -------------- 

+0B0D FD 73 01    .s.   LD    (IY+01),E  ; code2 --> AND/XOR Masken "Busy"

+0B10 FD 72 02    .r.   LD    (IY+02),D 

+0B13 C9          .     RET              ;----- Aufg. 5, "-15" ------------- 

+0B14 FD 73 03    .s.   LD    (IY+03),E  ; code2, code3 --> Maske "selekt" 

+0B17 FD 72 04    .r.   LD    (IY+04),D 

+0B1A FD 74 05    .t.   LD    (IY+05),H 

+0B1D C9          .     RET              ;--------- "OUTPUT" --------------- 

+0B1E 78          x     LD    A,B        ; Nichts auszugeben ? 

+0B1F B1          .     OR    C 

+0B20 37          7     SCF 

+0B21 C8          .     RET   Z 

+0B22 C5          .     PUSH  BC 

+0B23 DB 10       ..    IN    A,(10)     ; Status einelsen

+0B25 FD A6 03    ...   AND   (IY+03)    ; Printerselekt.

+0B28 FD AE 04    ...   XOR   (IY+04) 

+0B2B 57          W     LD    D,A 

+0B2C FD AE 05    ...   XOR   (IY+05) 

+0B2F 5F          _     LD    E,A 

+0B30 E5          .     PUSH  HL 

+0B31 09          .     ADD   HL,BC      ; Ende des Textes

+0B32 E3          .     EX    (SP),HL 

+0B33 41          A     LD    B,C        ; Textlaenge Low (Pbuffersize < 256)

+0B34 0E 11       ..    LD    C,11       ; Dataport = 11H

+0B36 DB 10       ..    IN    A,(10)     ; Printer busy ?

+0B38 FD A6 01    ...   AND   (IY+01) 

+0B3B FD AE 02    ...   XOR   (IY+02) 

+0B3E 20 1B        .    JR    NZ,0B5B    ; testen, ob printer da

+0B40 ED A3       ..    OUTI             ; Ein Zeichen ausgeben

+0B42 7A          z     LD    A,D 

+0B43 D3 10       ..    OUT   (10),A     ; Printer Strobe an

+0B45 7B          {     LD    A,E 

+0B46 D3 10       ..    OUT   (10),A     ; printer Strobe aus

+0B48 20 EC        .    JR    NZ,0B36    ; Naechstes Zeichen

+0B4A 44          D     LD    B,H 

+0B4B 4D          M     LD    C,L 

+0B4C E1          .     POP   HL 

+0B4D E5          .     PUSH  HL 

+0B4E B7          .     OR    A          ; Anzahl Restzeichen --> BC

+0B4F ED 42       .B    SBC   HL,BC 

+0B51 E5          .     PUSH  HL 

+0B52 C5          .     PUSH  BC 

+0B53 E1          .     POP   HL 

+0B54 C1          .     POP   BC 

+0B55 20 DC        .    JR    NZ,0B33    ; Nochmal mit dem rest aufrufen

+0B57 E1          .     POP   HL 

+0B58 C1          .     POP   BC 

+0B59 37          7     SCF              ; Alles uebernommen 

+0B5A C9          .     RET              ;----------

+0B5B CD 72 0B    .r.   CALL  0B72       ; test,. ob printer bereit

+0B5E 28 E0       (.    JR    Z,0B40 

+0B60 CD 72 0B    .r.   CALL  0B72 

+0B63 28 DB       (.    JR    Z,0B40     

+0B65 54          T     LD    D,H 

+0B66 5D          ]     LD    E,L        

+0B67 E1          .     POP   HL 

+0B68 B7          .     OR    A 

+0B69 ED 52       .R    SBC   HL,DE 

+0B6B EB          .     EX    DE,HL 

+0B6C E1          .     POP   HL         

+0B6D ED 52       .R    SBC   HL,DE      ; Nicht alles uebernommen

+0B6F 44          D     LD    B,H 

+0B70 4D          M     LD    C,L 

+0B71 C9          .     RET              ; ----------- "printerstatus" ----- 

+0B72 DB 10       ..    IN    A,(10)     ; Status einlesen

+0B74 FD A6 01    ...   AND   (IY+01)    ; Maskieren 

+0B77 FD AE 02    ...   XOR   (IY+02)    ; Kanal 7..9 selektieren 

+0B7A C9          .     RET              ;-------------- "frout" ------------ 

+0B7B CD 72 0B    .r.   CALL  0B72       ; Puffer voll ?

+0B7E CA 50 06    .P.   JP    Z,0650     ; Nein, kann 200 Zeichen uebernehmen 

+0B81 B7          .     OR    A 

+0B82 01 00 00    ...   LD    BC,0000    ; Druckerpuffer voll --> 0 Zeichen 

+0B85 C9          .     RET              ;--------- Aufg. 5 -2 ------------- 

+;================== Sonstige Shard-Routinen (Non I/O) =====================

+0B86 C3 12 08    ...   JP    0812       ; Init Parameterkanal = Timerinit 

+0B89 ED B0       ..    LDIR             ;------------ "LONGMOVE" ----------- 

+0B8B C9          .     RET              ;------------- "LIMIT" ------------- 

+0B8C 11 FF FF    ...   LD    DE,FFFF    ; Geht bis zum RAM-Ende

+0B8F C9          .     RET              ;------------ "SCHINF" ------------- 

+0B90 01 00 00    ...   LD    BC,0000    ; Kein Schattenspeicher vorhanden ? 

+0B93 C9          .     RET              ;------------ "SCHACC" --------------

+0B94 F5          .     PUSH  AF 

+0B95 E5          .     PUSH  HL 

+0B96 CB 2C       .,    SRA   H 

+0B98 CB 1D       ..    RR    L 

+0B9A 7D          }     LD    A,L 

+0B9B CD AD 0B    ...   CALL  0BAD 

+0B9E E1          .     POP   HL                           ?

+0B9F 7D          }     LD    A,L 

+0BA0 21 00 FC    !..   LD    HL,FC00 

+0BA3 CB 47       .G    BIT   0,A 

+0BA5 28 03       (.    JR    Z,0BAA 

+0BA7 21 00 FE    !..   LD    HL,FE00 

+0BAA F1          .     POP   AF 

+0BAB C9          .     RET 

+0BAC C9          .     RET              ; -----------"SYSEND"-------------- 

+0BAD C9          .     RET              ; ----- SHARD-fehler melden ------ 

+0BAE E1          .     POP   HL         ; Ruecksprungaddresse 

+0BAF E3          .     EX    (SP),HL 

+0BB0 21 CD 0B    !..   LD    HL,0BCD    ; Tabellenanfang Fehlernummer + text

+0BB3 16 00       ..    LD    D,00 

+0BB5 4E          N     LD    C,(HL)     ; Textnummer aus Tabelle 

+0BB6 23          #     INC   HL 

+0BB7 B9          .     CP    C          ; gesucht und gefunden ?

+0BB8 28 09       (.    JR    Z,0BC3     ; Ja, gefunden. Nummer melden

+0BBA 0C          .     INC   C          ; Naechste Fehlernummer

+0BBB 28 06       (.    JR    Z,0BC3 

+0BBD 23          #     INC   HL 

+0BBE 5E          ^     LD    E,(HL) 

+0BBF 23          #     INC   HL 

+0BC0 19          .     ADD   HL,DE 

+0BC1 18 F2       ..    JR    0BB5       ; Naechsten nehmen

+0BC3 4E          N     LD    C,(HL)     ; Fehlernummer in BC

+0BC4 06 00       ..    LD    B,00 

+0BC6 23          #     INC   HL 

+0BC7 E3          .     EX    (SP),HL    ; Zur Rueckspungaddresse

+0BC8 E9          .     JP    (HL) 

+0BC9 3E 09       >.    LD    A,09       ; Block zu hoch

+0BCB 18 E1       ..    JR    0BAE       ; melden ------------------------

+0BCD 01 01 09    ...   LD    BC,0901    ; #1 : "not ready", Typ 1

+0BD0 6E          n     LD    L,(HL) 

+0BD1 6F          o     LD    L,A 

+0BD2 74          t     LD    (HL),H 

+0BD3 20 72        r    JR    NZ,0C47 

+0BD5 65          e     LD    H,L 

+0BD6 61          a     LD    H,C        

+0BD7 64          d     LD    H,H 

+0BD8 79          y     LD    A,C 

+0BD9 02          .     LD    (BC),A     ; #2 : "crc err". Typ 2

+0BDA 02          .     LD    (BC),A 

+0BDB 07          .     RLCA 

+0BDC 63          c     LD    H,E 

+0BDD 72          r     LD    (HL),D 

+0BDE 63          c     LD    H,E        

+0BDF 20 65        e    JR    NZ,0C46 

+0BE1 72          r     LD    (HL),D     

+0BE2 72          r     LD    (HL),D 

+0BE3 03          .     INC   BC         ; #3 : "bad sect". Typ 2

+0BE4 02          .     LD    (BC),A 

+0BE5 08          .     EX    AF,AF' 

+0BE6 62          b     LD    H,D 

+0BE7 61          a     LD    H,C 

+0BE8 64          d     LD    H,H 

+0BE9 20 73        s    JR    NZ,0C5E 

+0BEB 65          e     LD    H,L 

+0BEC 63          c     LD    H,E 

+0BED 74          t     LD    (HL),H 

+0BEE 04          .     INC   B          ; #4 : "write fault". Typ 2

+0BEF 02          .     LD    (BC),A 

+0BF0 0B          .     DEC   BC 

+0BF1 77          w     LD    (HL),A 

+0BF2 72          r     LD    (HL),D 

+0BF3 69          i     LD    L,C 

+0BF4 74          t     LD    (HL),H 

+0BF5 65          e     LD    H,L 

+0BF6 20 66        f    JR    NZ,0C5E    

+0BF8 61          a     LD    H,C 

+0BF9 75          u     LD    (HL),L 

+0BFA 6C          l     LD    L,H 

+0BFB 74          t     LD    (HL),H 

+0BFC 05          .     DEC   B          ; #5 : "busy". Typ 2

+0BFD 02          .     LD    (BC),A 

+0BFE 04          .     INC   B 

+0BFF 62          b     LD    H,D        

+0C00 75          u     LD    (HL),L 

+0C01 73          s     LD    (HL),E     

+0C02 79          y     LD    A,C        

+0C03 06 02       ..    LD    B,02       ; #6 : "dma failed". Typ 2

+0C05 0A          .     LD    A,(BC) 

+0C06 64          d     LD    H,H 

+0C07 6D          m     LD    L,L 

+0C08 61          a     LD    H,C        

+0C09 20 66        f    JR    NZ,0C71 

+0C0B 61          a     LD    H,C        

+0C0C 69          i     LD    L,C 

+0C0D 6C          l     LD    L,H 

+0C0E 65          e     LD    H,L 

+0C0F 64          d     LD    H,H 

+0C10 07          .     RLCA             ; #7 : "rec not fnd". Typ 2

+0C11 02          .     LD    (BC),A 

+0C12 0B          .     DEC   BC 

+0C13 72          r     LD    (HL),D     

+0C14 65          e     LD    H,L 

+0C15 63          c     LD    H,E 

+0C16 20 6E        n    JR    NZ,0C86 

+0C18 6F          o     LD    L,A 

+0C19 74          t     LD    (HL),H     

+0C1A 20 66        f    JR    NZ,0C82 

+0C1C 6E          n     LD    L,(HL) 

+0C1D 64          d     LD    H,H 

+0C1E 08          .     EX    AF,AF'     ; #8 : "timeout". Typ 2

+0C1F 02          .     LD    (BC),A 

+0C20 07          .     RLCA 

+0C21 74          t     LD    (HL),H 

+0C22 69          i     LD    L,C 

+0C23 6D          m     LD    L,L        

+0C24 65          e     LD    H,L 

+0C25 6F          o     LD    L,A 

+0C26 75          u     LD    (HL),L 

+0C27 74          t     LD    (HL),H 

+0C28 09          .     ADD   HL,BC      ; #9 : "block zu hoch". Typ 3

+0C29 03          .     INC   BC 

+0C2A 0D          .     DEC   C 

+0C2B 62          b     LD    H,D 

+0C2C 6C          l     LD    L,H 

+0C2D 6F          o     LD    L,A 

+0C2E 63          c     LD    H,E 

+0C2F 6B          k     LD    L,E 

+0C30 20 7A        z    JR    NZ,0CAC 

+0C32 75          u     LD    (HL),L 

+0C33 20 68        h    JR    NZ,0C9D 

+0C35 6F          o     LD    L,A        

+0C36 63          c     LD    H,E 

+0C37 68          h     LD    L,B 

+0C38 FF          .     RST   38         ; #255 : "wrg err code". Typ 1 

+0C39 01 0C 77    ..w   LD    BC,770C 

+0C3C 72          r     LD    (HL),D 

+0C3D 67          g     LD    H,A 

+0C3E 20 65        e    JR    NZ,0CA5 

+0C40 72          r     LD    (HL),D 

+0C41 72          r     LD    (HL),D 

+0C42 20 63        c    JR    NZ,0CA7 

+0C44 6F          o     LD    L,A 

+0C45 64          d     LD    H,H 

+0C46 65          e     LD    H,L 

+;=============================== Semaphorhandler =========================== 

+0C47 35          5     DEC   (HL)       ; --- Semaphor (HL) testen, warte -- 

+0C48 34          4     INC   (HL) 

+0C49 36 01       6.    LD    (HL),01    ; Semaphor belegen 

+0C4B C8          .     RET   Z          ; unbeleget, return

+0C4C E5          .     PUSH  HL         ; Register fuer 'warte' retten

+0C4D DD E5       ..    PUSH  IX 

+0C4F FD E5       ..    PUSH  IY 

+0C51 C5          .     PUSH  BC 

+0C52 D5          .     PUSH  DE 

+0C53 F5          .     PUSH  AF 

+0C54 CD 19 1E    ...   CALL  1E19       ; "warte" bis Semaphor frei

+0C57 F1          .     POP   AF 

+0C58 D1          .     POP   DE 

+0C59 C1          .     POP   BC 

+0C5A FD E1       ..    POP   IY 

+0C5C DD E1       ..    POP   IX 

+0C5E E1          .     POP   HL 

+0C5F 18 E6       ..    JR    0C47      ; Semaphor jetzt frei ? 

+0C61 36 00       6.    LD    (HL),00    ; -------- Sempahor freigeben ------ 

+0C63 C9          .     RET 

+;=========================== Kanalpuffer + Kanalstatusbytes ================ 

+ 

+;----------------------------- Hintergrund Kanal 0 ------------------------

+0C64 00                                 ; Hintergrund 

+0C65 FF 43                              ; letzter EUMEL-Block (8,5MB)

+0C67 00 00                              ; erster EUMEL-Block

+ 

+;----------------------------- Serieller Kanal 1 ------------------------- 

+0C69 FF                                 ; 100 Bytes Puffer fuer Kanal 1

+     ... 

+0CCC FF 

+0CCD 01                           IY+00 ; Kanal 1 

+0CCE 03                              01 ; Flusskontrollen Bits 

+                                          BIT 0 : 

+                                          BIT 1 : 0 = XOFF-Status, 1=XON

+                                          BIT 2 : XON/XOFF bei receive

+                                          BIT 3 : XON/XOFF bei transmit

+0CCF 64                              02 ; Puffergroesse = 100 

+0CD0 00                              03 ; Pufferzeiger Write

+0CD1 00                              04 ; Pufferzeiger Read 

+0CD2 00                              05 ; 

+0CD3 69 0C                           06 ; 0C69 = Pufferanfang 

+0CD5 7F                              08 ; AND-maske f. fehlerfreien receive 

+0CD6 00                              09 ; Datenbitmaske XOR   "

+0CD7 7F                              0A ; AND-maske f. fehlerhaften reiceive 

+0CD8 00                              0B ; Datenbitmaske XOR  "

+0CD9 7F                              0C ; Maske fuer Read aus Puffer AND

+0CDA 00                              0D ;    "                       XOR

+0CDB 3F        ?                     0E ; Zeichen fuer Fehlerhaften Receive 

+0CDC 13                              0F ; 19 = Stop (XOFF)

+0CDD 11                              10 ; 17 = Weiter (XON)

+0CDE 02                              11 ; BIT 1 = 1 : Baudrateeinst. moegl. 

+                                        ; BIT 0 = 1 : RTS/CTS 

+0CDF 04                              12 ; AND-Maske Test Statusport (TxDfull)

+0CE0 04                              13 ; XOR-Maske f. TxDfull (ggf invert.)

+0CE1 00                              14 ; DTR/RTS - Bits im Register 5 (82H)

+0CE2 00                              15 ; OR-Register fuer V24-Errors

+0CE3 00                              16 ; AND-Maske fuer zulaessige Fehler

+0CE4 C1                              17 ; Register 3 (Rxbits, Autoenables) 

+0CE5 44                              18 ; Register 4 (Stopb., Clock, parity) 

+0CE6 EA                              19 ; Register 5 (Txbits, RTS, DTR)

+0CE7 1D                              1A ; Port Kanal 1 Status/Command

+0CE8 1C                              1B ; Datenport Kanal 1 : DART Channel A

+0CE9 0C                              1C ; BR-Generatorport: CTC1 - Kanal 0

+0CEA 88                              1D ; Interruptvektor Kanal 1 

+0CEB CD 56 04          CALL  0456       ; Transmitbuffer empty IRQ 

+0CEE CD 6B 04          CALL  046B       ; External/Status Change IRQ 

+0CF1 CD BA 04          CALL  04BA       ; Receive Character available IRQ 

+0CF4 CD 85 04          CALL  0485       ; Special Receive condition IRQ

+ 

+;----------------------------- Serieller Kanal 2 -------------------------- 

+0CF7 FF                                 ; 100 Bytes Puffer Kanal 2 

+     ...

+0D5A FF 

+0D5B 02                                 ; Kanal 2 

+0D5C 03                                 ; Flusskontrollenbits

+0D5D 64                                 ; 100 = Puffergroesse

+0D5E 00 00 00                           ; Pufferzeiger

+0D61 F7 0C                              ; 0CF7 = Pufferanfang Kanal 2

+0D63 7F 00                              ; Masken fuer fehlerfreiene Receive

+0D65 7F 00                              ;          "  fehlerhaften Receive 

+0D67 7F 00                              ; Masken fuer read aus Puffer 

+0D69 3F          ?                      ; Zeichen fuer fehlerhaften receive 

+0D6A 13 11                              ; XOFF/XON Zeichen 

+0D6C 02                                 ; Baudrateeinstellung moeglich 

+0D6D 04 04                              ; Masken fuer Test Statusport:TxDfull

+0D6F 00                                 ; DTR/RTS Bits in Register 5

+0D70 00 00                              ; Masken fuer zulaessige Fehler 

+0D72 C1 44 EA                           ; Register 3, 4, 5 Werte

+0D75 1F                                 ; Port Kanal 2 Status / Command 

+0D76 1E                                 ; Datenport Kanal 2 : DART Channel B 

+0D77 0E                                 ; BR-Generatorport: CTC1 - Kanal 1

+0D78 80                                 ; Interruptvektor Kanal 2

+0D79 CD 56 04          CALL  0456       ; Interruptroutinen

+0D7C CD 6B 04          CALL  046B 

+0D7F CD BA 04          CALL  04BA 

+0D82 CD 85 04          CALL  0485 

+ 

+;------------------------------ Serieller kanal 3 -------------------------

+0D85 FF                                 ; 100 Byte Datenpuffer (Senden)

+     ... 

+0DE8 FF 

+0DE9 03                                 ; Kanal 3 

+0DEA 03                                 ; Flusskontrollenbits 

+0DEB 64                                 ; Puffergroesse 

+0DEC 00 00 00                           ; Pufferzeiger

+0DEF 85 0D                              ; Pufferanfang Kanal 3 : 0D85 

+0DF1 7F 00                              ; Datenbitsmasken s.o

+0DF3 7F 00                              ;   "

+0DF5 7F 00                              ;   "

+0DF7 3F        ?                        ; Zeichen bei fehlerhaftem Receive

+0DF8 13 11                              ; XOFF/XON Zeichen 

+0DFA 02                                 ; Baudrateeinstellung moeglich 

+0DFB 04 04                              ; Masken fuer Test Statusport:TxDfull 

+0DFD 00                                 ; DTR/RTS Bits in register 5 (82H) 

+0DFE 00 00                              ; Masken fuer zulaessige Fehler 

+0E00 C1 44 EA                           ; Register 3, 4, 5 Werte 

+0E03 29                                 ; Port Kanal 3 Status / Command 

+0E04 28                                 ; Datenport Kanal 3 : SIO 1 Channel A

+0E05 32                                 ; BR-generatorport: CTC2 - Kanal 2 

+0E06 98                                 ; Interruptvektor Kanal 3

+0E07 CD 56 04          CALL  0456       ; Interruptroutinen

+0E0A CD 6B 04          CALL  046B 

+0E0D CD BA 04          CALL  04BA 

+0E10 CD 85 04          CALL  0485 

+ 

+;--------------------------------- Serieller Kanal 4 ----------------------- 

+0E13 FF                                 ; 100 Bytes Kanalpuffer 

+     ... 

+0E76 FF 

+0E77 04                                 ; Kanal 4 

+0E78 03                                 ; Flusskontrollenbits 

+0E79 64                                 ; Puffergroesse 

+0E7A 00 00 00                           ; Pufferzeiger 

+0E7D 13 0E                              ; Pufferanfang Kanal 4 : 0E13

+0E7F 7F 00                              ; Datenbitmasken s.o. 

+0E81 7F 00 

+0E83 7F 00 

+0E85 3F          ?                      ; Zeichen bei fehlerhaften Receive 

+0E86 13 11                              ; XOFF/XON Zeichen 

+0E88 02                                 ; Baudrateeinstellung moeglich 

+0E89 04 04                              ; Masken fuer TxDfull Status 

+0E8B 00                                 ; RTS/DTR Bits (82H) 

+0E8C 00 00                              ; Masken fuer zulaessige Fehler 

+0E8E C1 44 EA                           ; Register 3, 4, 5 Werter 

+0E91 2B                                 ; Port Kanal 4 Status/Command 

+0E92 2A                                 ; Datenport kanal 4 : SIO 1 Channel B

+0E93 31                                 ; BR-Generatorport: CTC2 - Kanal 1

+0E94 90                                 ; Interruptvektor Kanal 4

+0E95 CD 56 04          CALL  0456       ; Interruptroutinen 

+0E98 CD 6B 04          CALL  046B 

+0E9B CD BA 04          CALL  04BA 

+0E9E CD 85 04          CALL  0485 

+ 

+;-------------------------------- Serieller Kanal 5 -----------------------

+0EA1 FF                                 ; 100 Bytes Ausgabepuffer

+     ... 

+0F04 FF 

+0F05 05                                 ; Kanal 5 

+0F06 03                                 ; Flusskontrollenbits 

+0F07 64                                 ; Puffergroesse 

+0F08 00 00 00                           ; Pufferzeiger 

+0F0B A1 0E                              ; Pufferanfang : 0EA1 

+0F0D 7F 00                              ; Datenbitmasken s.o. 

+0F0F 7F 00                              ;   "

+0F11 7F 00                              ;   " 

+0F13 3F          ?                      ; Zeichen fuer fehlerhaften Receive

+0F14 13 11                              ; XOFF/XON Zeichen 

+0F16 02                                 ; Baudrateeinstellung moeglich 

+0F17 04 04                              ; Maskenbits fuer Status TxDfull

+0F19 00                                 ; RTS/DTR Bits (82H) 

+0F1A 00 00                              ; Masken fuer zulaessige fehler 

+0F1C C1 44 EA                           ; Register 3, 4, 5 Werte 

+0F1F 2D                                 ; Port Kanal 5 Status / Command 

+0F20 2C                                 ; Datenport kanal 5 : SIO 2 Channel A

+0F21 30                                 ; BR-Generatorport: CTC2 - Kanal 0

+0F22 A8                                 ; Interruptvektor Kanal 5 

+0F23 CD 56 04          CALL  0456       ; Interruptroutinen

+0F26 CD 6B 04          CALL  046B 

+0F29 CD BA 04          CALL  04BA 

+0F2C CD 85 04          CALL  0485 

+ 

+;--------------------------- Serieller kanal 6 ---------------------------- 

+0F2F FF                                 ; 100 Bytes ausgabepuffer 

+     ... 

+0F92 FF 

+0F93 06                                 ; Kanal 6 

+0F94 03                                 ; Flusskontrollenbits

+0F95 64                                 ; Puffergroesse

+0F96 00 00 00                           ; Pufferzeiger 

+0F99 2F 0F                              ; Pufferanfang Kanal 6 : 0F2F 

+0F9B 7F 00                              ; Datenbitmasken s.o. 

+0F9D 7F 00                              ;      " 

+0F9F 7F 00                              ;      " 

+0FA1 3F          ?                      ; Zeichen fuer fehlerhaften Receive

+0FA2 13 11                              ; XOFF/XON Zeichen 

+0FA4 02                                 ; Baudrateeinstellung moeglich 

+0FA5 04 04                              ; Maskenbits Status TxDfull 

+0FA7 00                                 ; RTS/DTR Bits in Register 5 

+0FA8 00 00                              ; Masken fuer zulaessige Fehler 

+0FAA C1 44 EA                           ; Register 3, 4, 5 Werte 

+0FAD 2F                                 ; Port Kanal 6 : Status / Command 

+0FAE 2E                                 ; Datenport kanal 6 : SIO 2 Channel B

+0FAF 31                                 ; BR-Generatorport : CTC2 - Kanal 1 

+0FB0 A0                                 ; Interruptvektor kanal 6 

+0FB1 CD 56 04          CALL  0456       ; Interruptroutinen

+0FB4 CD 6B 04          CALL  046B 

+0FB7 CD BA 04          CALL  04BA 

+0FBA CD 85 04          CALL  0485 

+ 

+;------------------------------- Parallelkanal 7 --------------------------

+0FBD 07                                 ; Kanal 7 

+0FBE 20                                 ; AND-Maske fuer Printerbusy

+0FBF 00                                 ; XOR-Maske f. Printer 0 busy

+0FC0 FE                                 ; AND-Maske fuer Printerstrobe

+0FC1 00                                 ; XOR-Maske1 fuer Printerstrobe an

+0FC2 01                                 ; XOR-Maske2 fuer Printerstrobe aus

+ 

+;------------------------------- Parallel Kanal 8 ------------------------- 

+0FC3 08                                 ; Kanal 8 

+0FC4 40                                 ; AND-Maske fuer Printerbusy

+0FC5 00                                 ; XOR-Maske fuer Printer 1 busy

+0FC6 FD                                 ; AND-Maske fuer Printerstrobe

+0FC7 00                                 ; XOR-Maske1 fuer Printerstrobe an

+0FC8 02                                 ; XOR-Maske2 fuer Printerstrobe aus

+ 

+;------------------------------ Parallel kanal 9 -------------------------- 

+0FC9 09                                 ; Kanal 9 

+0FCA 80                                 ; AND-Maske f. Printerbusy

+0FCB 00                                 ; XOR-Maske f. Printer 2 busy

+0FCC FB                                 ; AND-Maske fuer Printerstrobe

+0FCD 00                                 ; XOR-Maske1 fuer Printerstrobe an

+0FCE 04                                 ; XOR-maske2 fuer Printerstrobe aus

+ 

+;----------------------------- Floppy Kanal 31 ---------------------------- 

+0FCF 1F                                 ; Kanal 31 

+0FD0 00                                 ; IY+00

+0FD1 00                                 ; IY+01 FDC-AND-Maske Status-ready

+0FD2 00                                 ; 02 FDC-Kommando Read/Write

+0FD3 00                                 ; 03

+0FD4 00                                 ; 04 

+0FD5 00                                 ; 05 : Returncode aus Floppy-IRQ

+0FD6 00                                 ; 06 : Alter Sektor 

+0FD7 00                                 ; 07

+0FD8 04                                 ; 08

+0FD9 FF                                 ; 09 Floppydrive (f. Headselect)

+0FDA 00                                 ; 0A  - 46H = "F"

+;============================== SHARD ENDE ================================= 

diff --git a/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT b/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT
new file mode 100644
index 0000000..a698b27
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT
@@ -0,0 +1,584 @@
+#type ("12")##limit (16.0)##block##pageblock# 

+#head# 

+#center#Dokumentation zum EUMEL-SHard 

+ 

+ 

+#end# 

+#bottom# 

+ 

+ 

+#center#- % - 

+#end# 

+************************************************************************ 

+*                                                                      * 

+*             D o k u m e n t a t i o n    z u m   S H a r d  (8)      * 

+*                                                                      * 

+*             Stand der Dokumentation:  26.06.87                       * 

+*             Stand der Implementation: 26.06.87, Version 1.5          * 

+*                                                                      * 

+*                                                  Michael Staubermann * 

+*                                                  Moränenstraße 29    * 

+*                                                  44 Münster-Hiltrup  * 

+************************************************************************ 

+ 

+ 

+ 

+1.   Allgemeines 

+1.1    Neuheiten 

+1.2    Logische und physische Kanäle 

+ 

+2.   Block I/O 

+2.1    Harddisk (Kanal 0) 

+2.2    SCSI-Floppy (Kanal 31) 

+2.3    Harddisk-Volume (Kanal 28) 

+2.4    160k/640k-Floppys (Kanal 29, 30) 

+2.5    Graphikmemory (Kanal 1) 

+ 

+3.   Stream I/O 

+3.1    Konsole (Kanal 1) 

+3.2    6551-Seriell (Kanal 5) 

+3.3    SCCs (Kanal 2, 3) 

+3.4    CIO-Drucker (Kanal 4) 

+3.5    Motherboard-Drucker (Kanal 6) 

+ 

+4.   Graphik 

+4.1    CTRL 

+4.2    MOVE 

+4.3    DRAW 

+4.4    TEST 

+4.5    CLR 

+4.6    FILL 

+4.7    TRANS 

+ 

+5.   Hardware 

+5.1    Zugriff auf die Hardware-Uhr 

+5.2    Zugriff auf die Analog-Ports 

+5.3    Zugriff auf die I/O-Ports 

+5.4    ID-Felder 

+ 

+6.   Installation 

+6.1    Vortest/Speichertest 

+6.2    Konsole 

+6.3    SCSI-Floppy 

+6.4    Harddisk Volume 

+6.5    Logische Kanäle zuordnen 

+6.6    Installation auf Harddisk 

+6.7    Installation auf Floppy 

+ 

+#page# 

+#ub#1  Allgemeines#ue# 

+ 

+#ub#1.1  Neuheiten#ue# 

+ 

+Neu in Version 1.2: 40% höherer CPU-Durchsatz. 

+ 

+Neu in Version 1.4: Texthardcopy mit SHIFT CTRL F12. 

+ 

+Neu in Version 1.5: Beide Printer-Spooler löschbar mit control (-10,...). 

+Korrektur in   1.5: Kanal 4 - Printer darf auch während des Betriebs aus-

+                    und eingeschaltet werden (läuft automatisch wieder an). 

+ 

+ 

+#ub#1.2  Logische und physische Kanäle#ue# 

+ 

+Die Unterscheidung zwischen logischen und physischen Kanälen bringt Vortei-

+le: 

+ 

+- Der Systemstart muß nicht mehr an der Konsole erfolgen (jetzt z.B. an

+  einem externen Terminal). 

+- Systemfehler/Hardwarefehler und Info werden damit auch an einem anderen

+  physischen Kanal ausgegeben. 

+- Das Hintergrundmedium muß nicht mehr unbedingt die Harddisk sein. Eine

+  SCSI-Floppy (720k) wäre denkbar, oder ein anderes Harddisk-Volume. 

+- Das Archivmedium muß nicht mehr unbedingt die SCSI-Floppy sein. Ein Hard-

+  diskvolume oder eine 640k-Floppy wären denkbar. 

+- Für einen anderen SHard geschriebene Software (z.B. alter Druckertrei-

+  ber/Graphiktreiber) muß nicht geändert werden. 

+ 

+#page#

+#ub#2.  Block I/O#ue# 

+ 

+#ub#2.1  Harddisk (Kanal 0)#ue# 

+ 

+Keine Recalibrates (wg. Timeout/DMA-Fehler) mehr! 

+Das beste Sektor-Interleave ist 5. 

+ 

+ 

+#ub#2.2  SCSI-Floppy (Kanal 31)#ue# 

+ 

+- Falls keine Floppy im Schacht liegt, werden keine Retries mehr gemacht.

+  Bei Write-Protect auch nicht. 

+- Harddisk und Floppy arbeiten jetzt auch bei intensiver Benutzung gut

+  nebeneinander. 

+- Mit 'size (schluessel)' kann vom EUMEL aus das Format eingestellt werden.

+  Interpretiert wird 0 und 2 als 720k-Format und 1 als 360k-Format, sowie

+  der analytische Schlüssel (lt. Portierungshandbuch). 

+- 'format (schluessel)' formatiert eine Floppy im 720k-Format. Der Control-

+  ler wird allerdings wie bei 'size (schluessel)' vorher initialisiert, da

+  EUMEL das nicht macht. 

+- Falls gewünscht kann auch SCSI-Floppy #1 über Kanal 31 angesprochen wer-

+  den. Die entsprechende Frage wird im Installationsprogramm gestellt. 

+ 

+ 

+#ub#2.3  Harddisk-Volume (Kanal 28)#ue# 

+ 

+Mit diesem Kanal ist es möglich, ein anderes Harddisk-Volume, dessen Anfang

+und Größe auf der Platte mit dem Installationsprogramm ausgewählt wurde,

+anzusprechen. Ein CP/M-Volume kann z.B. auch durch EUMEL genutzt werden

+oder das Harddisk-Volume wird als Archiv-Kanal genutzt. 

+ 

+ 

+#ub#2.4  160k/640k Floppys (Kanal 29, 30)#ue# 

+ 

+- Kanal 29 spricht Disk #1 in Slot 6 an, 

+- Kanal 30 spricht Disk #0 in Slot 6 an. 

+- Da sich beide Disks einen Controller und Datenbereich (4k-Cache) teilen,

+  kann Block I/O nicht auf beiden Kanen parallel ablaufen. Blockweise Ab-

+  wechslung ist allerdings möglich (Wird durch Semaphor geregelt). 

+- Formatieren ist auf diesen Kanälen nicht möglich. 

+- Das Format (160k/640k) wird mit 'size (schluessel)' im EUMEL eingestellt.

+  Außer dem analytischen Schlüssel wird noch 0 und 2 für 2 * 80 Tracks

+  (640k) und 1 für 1 * 40 Tracks (160k) interpretiert. 

+- Ein (CP/M-) Interleave von 3 Sektoren ist eingestellt. 

+- Daten werden jeweils Trackweise in einen Puffer gelesen und in 512-Byte

+  Blöcken an EUMEL übergeben. Bei 'blockout' wird der Block (512-Bytes)

+  sofort auf die Floppy geschrieben. 

+- Writeprotection wird erkannt. 

+- Media-Mangel wird nicht erkannt, sondern als Lesefehler interpretiert bei

+  dem Retries versucht werden. (SHard führt von sich aus 1 Recalibrate aus,

+  den Rest muß EUMEL machen). 

+ 

+ 

+#ub#2.5  Graphikmemory (Kanal 1)#ue# 

+ 

+- Dieser flüchtige Speicher hat eine Größe von 32KB (64 Blöcke) 

+- 4 Graphikseiten zu jeweils 8KB sind linear angeordnet. 

+- Seiten 0 und 1 können als Grahikbitmap angezeigt werden 

+- Seiten 2 und 3 können dienen als Hilfsspeicherseiten 

+ 

+#page#

+#ub#3. Stream I/O#ue# 

+ 

+#ub#3.1  Konsole (Kanal 1)#ue# 

+ 

+- Die Blinkfrequenz des Cursors kann nicht mehr mit 'control' eingestellt

+  werden, sondern vor dem Systemstart mit dem Installationsprogramm. 

+- Zusätzlich kann die Tonhöhe des Steuercodes ""7"" bestimmt werden (Im

+  Installationsprogramm). 

+- Der Zeichensatz wird nicht mehr mit 'control' eingestellt. Da jetzt Steu-

+  ercodes benutzt werden, kann der Zeichensatz in der Typtabelle festgelegt

+  werden. 

+- Zeichencodes 128..255 werden ohne Umsetzung auf den Bildschirm geschrie-

+  ben. 

+- Folgenden Steuercodes sind definiert: 

+   0 - Keine Aktion 

+   1 - Cursor Home 

+   2 - Cursor right 

+   3 - Cursor up 

+   4 - Clear to end of Page 

+   5 - Clear to end of Line 

+   6 - Cursor Positionierung (Row, Column) (ohne Offset!) 

+   7 - Bell 

+   8 - Cursor left 

+   9 - Clear Screen 

+  10 - Cursor down 

+  11 - Insert Line 

+  12 - Delete Line 

+  13 - Carriage Return 

+  14 - End Mark 

+  15 - Begin Mark 

+  16 - Deutscher Zeichensatz (German ASCII) 

+  17 - ASCII Zeichensatz 

+  18 - APL Zeichensatz 

+  19 - Universal Zeichensatz (German ASCII + APL) 

+  20 - Mode einschalten: Inverse Zeichen blinken nicht 

+  21 - Mode einschalten: Inverse Zeichen blinken 

+ 

+- Es werden keine Eingabeumcodierungen gemacht, dies soll in der Typtabelle

+  geschehen. 

+- Falls EUMEL keine Eingabezeichen mehr puffern kann, werden diese im Ta-

+  staturpuffer gespeichert. Damit ist es möglich bis zu 270 Tastendrücke im

+  voraus zu tippen. Werden noch mehr Tasten gedrückt, ertönt ein Signal, da

+  weitere Tastendrücke verlorengehen. EUMEL wird beim nächsten Inputinter-

+  rupt ein Overrun-Error gemeldet. 

+ 

+- Einige Funktionstasten haben eine besondere Bedeutung: 

+  F2 = SV-Call: Diese Taste wird auch dann weitergeleitet, wenn EUMEL keine

+                weiteren Zeichen puffern kann, damit Tasks, die nicht auf

+                Eingabe warten, abgebrochen werden können. 

+  SHIFT CTRL F12 = Texthardcopy: Durch Drücken dieser Tasten wird der In-

+                halt des Textbildschirms auf einem Drucker an der paralle-

+                len Basisschnittstelle ausgedruckt. Achtung: Dies funktio-

+                niert nur, wenn der Spooler leer ist. Falls ein Druckauf-

+                trag läuft, sollte keine Hardcopy gemacht werden (Falls der

+                Spooler nämlich kurzfristig leer ist, wird die Hardcopy

+                gedruckt den Druckauftrag ruinieren.) 

+  SHIFT CTRL F13 = Weiter: Durch Drücken dieser Tasten wird der Tastatur-

+                puffer ohne Rücksicht darauf, ob EUMEL noch Zeichen puffern

+                kann, zeichenweise entleert. (Wird wohl kaum benutzt werden

+                müßen). 

+  SHIFT CTRL F14 = Shutup: Durch Drücken dieser Tasten wird das System

+                kontrolliert heruntergefahren. 

+  SHIFT CTRL F15 = Reset:  Falls verdrahtet löst die Software einen Hard-

+                warereset aus. 

+ 

+ 

+#ub#3.2  6551-Seriell (Kanal 5)#ue# 

+ 

+Dieser Kanal wurde erweitert: 

+- Außer Baudrate können jetzt auch Stopbits, Datenbits, Parity und Fluß-

+  kontrolle eingestellt werden (CTS, DSR/DTR, XON/XOFF). 

+- Ein Empfangspuffer von 2300 Zeichen wurde eingebaut und der Ausgabepuffer

+  auf 1k erweitert. 

+- Ein- und Ausgabe läuft jetzt Interruptgetrieben, kann also auch während

+  einer Floppyoperation stattfinden. 

+- Übertragungsfehler (Parity, Framing, Overrun) werden beim Inputinterrupt

+  an EUMEL gemeldet. Die Fehler werden in dem Moment, in dem sie bemerkt

+  werden gemeldet, d.h. i.d.R. nicht passend zum gleichzeitig übermittelten

+  Zeichen. 

+- Ein Break-Kommando wird interpretiert und ggf. an EUMEL gemeldet. Folgt

+  auf das Break-Kommando ('00' + Framing Error) ein 'Kommandozeichen', dann

+  wird dieses Remote-Kommando ausgeführt, anderenfalls wird das auf 'Break'

+  folgende Zeichen in den Empfangspuffer geschrieben und 'Break' an EUMEL

+  gemeldet. 

+- Folgende Break-Komandos werden interpretiert: 

+  <BREAK> <CTRL B> : SV-Call ohne Rücksicht auf Verluste an EUMEL leiten. 

+  <BREAK> W        : Wie SHIFT CTRL F13 bei Keyboard. 

+  <BREAK> S        : Shutup, System kontrolliert herunterfahren. 

+  <BREAK> R        : Software löst, falls verdrahtet, einen Hardarereset

+                     aus. 

+ 

+ 

+#ub#3.3  SCCs (Kanal 2, 3)#ue# 

+ 

+- Außer der Baudrate kann man jetzt auch Stopbits, Datenbits, Parity und

+  Flußkontrolle (RTS+DTR /CTS) einstellen. XON/XOFF wird nicht empfohlen. 

+- Übertragungsfehler (Overrun, Parity und Break) werden EUMEL gemeldet. 

+- Beide Kanäle besitzen einen Ausgabepuffer von jeweils 2KB. 

+ 

+ 

+#ub#3.4  CIO-Drucker (Kanal 4)#ue# 

+ 

+- Der Drucker wird mit Strobe/-ACK - Protokoll angeschloßen. 

+- Dieser Kanal besitzt einen Ausgabepuffer von 4KB (Interruptgetrieben). 

+- Der Druckerpuffer kann mit 'control (-10, 0, 0, r)' an Kanal 4 gelöscht

+  werden. 

+ 

+ 

+#ub#3.5  Motherboard-Drucker (Kanal 6)#ue# 

+ 

+- Der Drucker wird mit Strobe/-ACK - Protokoll angeschloßen. 

+- Dieser Kanal besitzt einen 4KB Ausgabepuffer (Polling). 

+- Der Druckerpuffer kann mit 'control (-10, 0, 0, r)' an Kanal 6 gelöscht

+  werden. 

+ 

+#page#

+#ub#4.  Graphik#ue# 

+ 

+#ub#4.1  CTRL#ue# 

+ 

+control (-8, flags, linienmuster, r) 

+Setzt verschiedene Graphikmodi. 

+ 

+Die Bits im Parameter 'flags' sind folgendermaßen zugeordnet: 

+ 

+Bit 0 : 

+     0 = Textmodus einschalten, Graphikmodus ausschalten 

+     1 = Graphikmodus einschalten, Textmodus ausschalten 

+ 

+Bit 1 : 

+     0 = Seite 0 als sichtbare Seite wählen 

+     1 = Seite 1 als sichtbare Seite wählen 

+ 

+Bit 2 : 

+     0 = Seite 0 als bearbeitete Seite wählen 

+     1 = Seite 1 als bearbeitete Seite wählen 

+ 

+Bit 3, 4 : Verknüpfung Patternbit: 0           1 

+    0           OR              setzen     unverändert 

+    1         NAND             löschen     unverändert 

+    2          XOR         invertieren     unverändert 

+    3         COPY             löschen     setzen 

+ 

+Bit 5 : 

+     0 = Der gesamte Bildschirm zeigt die Graphikseite ('full screen') 

+     1 = In den letzten 32 Graphikzeilen erscheint die Textseite ('mixed') 

+ 

+Bit 6 : 

+     0 = Das im zweiten Parameter übergebene Wort wird als 16-Bit 

+         Linienmuster eingestellt. Modus siehe Bit 3/4. 

+     1 = Das alte (bzw. voreingestellte) Linienmuster wird benutzt 

+ 

+Bit 7 : 

+     0 = Als Punkthelligkeit wird 'dunkel' (bzw. Violett) eingestellt 

+     1 = Als Punkthelligkeit word 'hell' (bzw. Gelb) eingestellt 

+ 

+Bit 8..11 : 

+     0 = Default-Strichdicke (1) 

+     1..15 = Strichdicke (Es werden 2*s-1 Linien parallel gezeichnet.) 

+ 

+Der zweite Parameter enthält das 16-Bit Linienmuster. Dieses wird beim

+Zeichnen einer Linie zyklisch Bitweise abgetastet. Je nach Status des Bits

+im Linienmuster wird eine Punktaktion ausgeführt, deren Wirkung in 'flags'

+mit den Bits 3 und 4 spezifiziert wird. 

+ 

+ 

+#ub#4.2  MOVE#ue# 

+ 

+control (-5, x pos, y pos, r) 

+Setzt den (unsichtbaren) Graphikcursor auf xpos/ypos. 

+ 

+Der nächste 'draw' zeichnet eine Linie beginnend bei xpos/ypos. 

+ 

+ 

+#ub#4.3  DRAW#ue# 

+ 

+control (-6, x pos, y pos, r) 

+Zeichnet eine Linie zur angegebenen Position xpos/ypos. 

+ 

+Die eingestellten Parameter Helligkeit, Linientyp, Bitverknüpfung und Dicke

+werden beachtet. Der nächste 'draw' zeichnet eine Linie beginnend bei

+xpos/ypos. 

+ 

+ 

+#ub#4.4  TEST#ue# 

+ 

+control (-7, x pos, y pos, result) 

+Testet den Status eines bestimmten Pixels. 

+ 

+Die Pixelposition wird mit xpos/ypos beschrieben. 

+Als 'result' wird zurückgeliefert: 

+    255, falls xpos/ypos außerhalb des sichtbaren Fensters liegt. 

+    Bit 0 = 1: Pixel sichtbar 

+    Bit 0 = 0: Pixel unsichtbar 

+    Bit 7 = 1: Pixelfarbe ist hell (gelb) 

+    Bit 7 = 0: Pixelfarbe ist dunkel (violett) 

+ 

+ 

+#ub#4.5  CLR#ue# 

+ 

+control (-3, seite, muster, r) 

+Füllt die angegebene Seite mit dem angegebenen Muster. 

+ 

+Bit 7 des Musters bestimmt die Farbe (0 = dunkel, 1 = hell). Das Muster

+wird zyklisch Spalten- und Zeilenweise wiederholt. muster=128 löscht z.B.

+die Graphikseite. 

+ 

+ 

+#ub#4.6  FILL#ue# 

+ 

+control (-4, muster nummer, 0, return) 

+Füllt eine beliebig durchgehend begrenzte Fläche mit dem angegebenen Mu-

+ster. 

+ 

+Das Muster ist eine 8 x 8 Matrix, die sich auf allen (pos MOD 8)-Pixel-

+adressen wiederholt. Im NAND-Modus wird mit dem inversen Muster gefüllt.

+Die Fläche muß dann aber mit unsichtbaren Pixeln begrenzt werden. 

+ 

+Folgende Muster sind möglich: 

+    0 = 'solid' (alles gefüllt) 

+    1 = 'lrs2'  (jeder zweite Punkt, Zeilenweise versetzt) 

+    2 = 'row4'  (jede 4. Zeile wird gefüllt) 

+    3 = 'row2'  (jede 2. Zeile wird gefüllt) 

+    4 = 'col4'  (jede 4. Spalte wird gefüllt) 

+    5 = 'col2'  (jede 2. Spalte wird gefüllt) 

+    6 = 'grid4' (jede 4. Spalte/Zeile wird gefüllt) 

+    7 = 'grid2' (jede 2. Spalte/Zeile wird gefüllt) 

+    8 = 'ls4'   (Schraffur links unten --> rechts oben, jede 4.) 

+    9 = 'rs4'   (Schraffur rechts unten --> links oben, jede 4.) 

+   10 = 'lrs4'  (Schräges Gitter wie 8 und 9 zusammen) 

+   11 = 'point2'(In jeder 2. Zeile jeder 2. Punkt) 

+   12 = 'wall4' (Mauer, ein Ziegelstein 4 Pixel hoch) 

+   13 = 'basket'(Korb/Netz) 

+   14 = 'wave4' (Wellenlinie 4 Pixel hoch) 

+   15 = 'wave8' (Wellenlinie 8 Pixel hoch) 

+ 

+Falls die zu füllende Fläche zu komplex wird, kann es vorkommen, daß der

+interne Stack überläuft. In diesem Fall wird nicht die gesamte Fläche ge-

+füllt. 

+ 

+ 

+#ub#4.7  TRANS#ue# 

+ 

+control (-9, from page, to page, r) 

+Kopiert den Inhalt der Graphikseite 'from page' in die Seite 'to page'. 

+ 

+Folgende Seitennummern sind möglich: 

+    0 : Seite 0 kann mit 'visible page (0)' angezeigt werden 

+    1 : Seite 1 kann mit 'visible page (1)' angezeigt werden 

+    2 : Seite 2 kann nicht sichtbar werden (Hilfsspeicher-Seite) 

+    3 : Ähnlich Seite 2, wird aber bei 'FILL' noch als Arbeitsseite benutzt

+    (wird dann überschrieben!) 

+ 

+#page#

+#ub#5.  Hardware#ue# 

+ 

+#ub#5.1  Zugriff auf die Hardware-Uhr#ue# 

+ 

+Mit 'TEXT PROC calendar (INT CONST feld)' kann in Söhnen von SYSUR die

+Hardware-Uhr gelesen werden. Für 'feld' sind folgende Werte zugeordnet: 

+ 

+ 0  Sekunden (0..59) 

+ 1  Minuten (0..59) 

+ 2  Stunden (0..23) 

+ 3  Tag des Monats (1..31) 

+ 4  Monat (1..12) 

+ 5  Jahr (87..99) 

+ 

+Ist die Uhr richtig gestellt (das ist aus CP/M mit 'date set' möglich),

+liefert jeder Aufruf von 'calendar' eine Zahl, anderenfalls wird immer

+'niltext' geliefert und EUMEL fragt nach dem Systemstart nach dem Datum.

+Dabei wird die Hardware-Uhr jedoch #ub#nicht#ue# gestellt. 

+In diesem Fall ist der Akku wahrscheinlich entladen (Abhilfe: Rechner eini-

+ge Stunden laufen lassen) oder die Uhr ist noch nicht gestellt worden (Ab-

+hilfe: 'date set' im CP/M). 

+ 

+In Tasks, die keine Söhne von SYSUR sind, kann die Hardware-Uhr mit 

+ 

+ TEXT PROC calendar (INT CONST feld) : 

+  INT VAR r ; 

+  control (10, feld, 0, r) ; 

+  text (r DIV 256 * 10 + (r AND 15)) 

+ ENDPROC calendar ; 

+ 

+abgefragt werden. 

+ 

+ 

+#ub#5.2  Zugriff auf die Analog-Ports#ue# 

+ 

+Die 4 Analog-Ports auf dem Motherboard können mit 

+ 

+  control (-2, port, 0, r) 

+ 

+abgefragt werden. 'port' kann 1..4 sein, in 'r' werden Werte von 1..255

+zurückgemeldet. Dieser Wert ist proportional dem Widerstandswert zwischen

++5V und Analogeingang. 

+ 

+Für Hardwarefreaks : 

+ 

+    Port  Connectorpin 

+    ------------------ 

+      1         6 

+      2        10 

+      3         7 

+      4        11 

+     +5V        1 

+ 

+Da der Meßwertaufnehmer ein 'LS123 mit C#d#t#e#=68nF, R#d#t#e#=0.27+R#d#x#e# kOhm ist, gilt:

+t#d#w#e#=0.45 * R#d#t#e# * C#d#t#e# = (30.6 * R#d#x#e# + 8.262) [us]. t#d#w#e# wird gemessen. (t#d#w#e# = 11

+Zyklen * r + 5 Zyklen bei 1.023 MHz) 

+ ==> 30.6 * R#d#x#e# + 8.262 = (11 * r + 5) / 1.023 [us] 

+<==> R#d#x#e# = ((11 * r - 5) / 1.023 -8.262) / 30.6 [kOhm] 

+(Damit ist auch klar, warum der Wert 0 nicht geliefert wird.) 

+ 

+R#d#x#e# [kOhm] = 0.351 * r + 0.43 

+r = 2.846 * R#d#x#e# + 1.221 

+ 

+ 

+#ub#5.3  Zugriff auf die I/O-Ports#ue# 

+ 

+Das Schreiben #ub#und#ue# Lesen der I/O-Ports der CPU ist jetzt nur an privilegier-

+ten Kanälen (25..32) möglich. 

+ 

+  control (-1, port, -1, r) 

+ 

+kann der angegebene Port 'port' (0..255) gelesen werden. Das Resultat (By-

+te) steht dann in 'r'. Falls der aufrufende Kanal ungültig war, wird -1

+geliefert. Mit 

+ 

+  control (-1, port, wert, r) 

+ 

+kann der angegebene Port 'port' (0..255) beschrieben werden. Der Bytewert

+steht in 'wert', die Erfolgsmeldung in 'r' (0 = ok). 

+ 

+ 

+#ub#5.4  ID-Felder#ue# 

+ 

+Mit 'INT PROC id (INT CONST feld nr)' können Systemkonstanten abgefragt

+werden. Für 'feld nr' sind folgende Werte zugeordnet: 

+ 

+0  Minimale Hintergrundversion (175) 

+1  Urladertyp (1 = Z80) 

+2  Urladerversion (101 = Version 1.1) 

+3  Reserviert 

+4  Lizenznummer des SHards 

+5  Installationsnummer 

+6  Reserviert 

+7  Versionsnummer des SHards: 1000 * Interfaceversion + SHard Version (ent-

+   hält z.Zt. 8105, d.h. Interface 8, Version 1.5) 

+ 

+#page#

+#ub#6.  Installation#ue# 

+ 

+#ub#6.1  Vortest/Speichertest#ue# 

+ 

+Vortest und Speichertest sollten normalerweise durchgeführt werden. (Beide

+Fragen mit 'j' beantworten). Wird kein Vortest gewünscht, wird automatisch

+auch kein Speichertest durchgeführt und es besteht keine Möglichkeit, das

+Hardwaretest-Menue aufzurufen. 

+ 

+ 

+#ub#6.2  Konsole#ue# 

+ 

+Die Blinkperiode des Cursor und die Tonhöhe des Steuercodes ""7"" kann

+verändert werden (Sekunden bzw. Hertz). Defaults sind 0.8s und 500Hz. 

+ 

+ 

+#ub#6.3  SCSI-Floppy#ue# 

+ 

+Falls nicht SCSI-Floppy #0 sondern, falls vorhanden, SCSI-Floppy #1 als

+Kanal 31 angesprochen werden soll, wird diese Frage mit 'n' beantwortet. 

+ 

+ 

+#ub#6.4  Harddisk Volume#ue# 

+ 

+Als Kanal 28 kann ein Harddisk-Volume angesprochen werden. Alle verfügbaren

+Volumes werden angeboten und ein ausgewähltes wird im SHard als Kanal 28

+installiert. Achtung: Sollte dieses Volume gelöscht, vergrößert oder ver-

+schoben werden (durch CP/M) dann weiß SHard noch nichts davon. Deshalb

+sollte der SHard nach einer solchen Aktion noch einmal installiert werden. 

+Aus Sicherheitsgründen wird empfohlen, ein spezielles Volume einzurichten,

+über das dann der Datenaustauch CP/M <--> EUMEL läuft. 

+ 

+ 

+#ub#6.5  Logische Kanäle zuordnen#ue# 

+ 

+Als logische Kanäle stehen Kanal 0..31 zur Verfügung, als physiche Kanäle

+0..6 und 28..31. Den logischen Kanälen können fast beliebig physische Kanä-

+le zugeordnet werden. 

+Ausnahmen: 

+- Der log. Kanal 0 (Hintergrund) muß als Blockkanal definiert werden (d.h.

+  die physischen Kanäle 0, 28, 29, 30, 31 können zugeordnet werden.) 

+- Der log. Kanal 1 (Systemkanal) muß als Stream-I/O-Kanal definiert werden

+  (d.h. die physischen Kanäle 1, 2, 3, 5 können zugeordnet werden.) 

+- Der log. Kanal 31 (Archiv) sollte definiert werden, dann aber als Block-

+  kanal (d.h. die physischen Kanäle 0, 28, 29, 30, 31) können zugeorndet

+  werden.) 

+- Nicht jeder physische Kanal muß zugeordnet werden. 

+- Jeder physische Kanal darf höchstens einmal zugeordnet werden. 

+ 

+Hinweis: 

+  EUMEL verwaltet Kanal 1..16 als (unprivilegierte) Stream-Kanäle, 

+                  Kanal 17..24 als unprivilegierte Block-Kanäle, 

+                  Kanal 25..31 als privillegierte Block-Kanäle. 

+ 

+ 

+#ub#6.6  Installation auf Harddisk#ue# 

+ 

+Wie früher kann der SHard auf einem Harddisk-Volume installiert werden.

+Dazu werden alle vorhandenen EUMEL-Volumes angeboten und das gewünschte

+ausgesucht. Falls kein EUMEL-Volume (mehr) vorhanden ist, werden alle ande-

+ren Volumes angeboten. Dadurch ist es möglich ein neues EUMEL-Volume einzu-

+richten (mit 'dmgr' unter CP/M). Der SHard belegt 2 Tracks (16k) auf der

+Harddisk. 

+ 

+ 

+#ub#6.7  Installation auf Floppy#ue# 

+ 

+Um ganz auf eine Harddisk verzichten zu können oder falls der Harddisk-

+SHard zerstört wurde, kann EUMEL jetzt auch über eine Boot-Diskette hochge-

+fahren werden. Eine Bootdiskette (160k oder 640k) enthält auf den ersten 4

+Tracks den SHard, kann deshalb nicht mehr als CP/M-Datendiskette verwendet

+werden. 

+Die Floppy kann mit dem Installationsprogramm bootfähig gemacht werden. 

+ 

diff --git a/system/shard-z80-ruc-64180/1.5/src/65.SUB b/system/shard-z80-ruc-64180/1.5/src/65.SUB
new file mode 100644
index 0000000..7dc9439
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/65.SUB
@@ -0,0 +1 @@
+M80=DISK/M

diff --git a/system/shard-z80-ruc-64180/1.5/src/BOOT.INC b/system/shard-z80-ruc-64180/1.5/src/BOOT.INC
new file mode 100644
index 0000000..b03a57c
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/BOOT.INC
@@ -0,0 +1,121 @@
+

+;

+;****************************************************************

+;

+;	EUMEL Initialisierung fuer 6502 Teil

+;

+;	Version 0.4 vom 25. 11. 1985

+;	Version	0.5 vom 24.12.86

+;	Version	0.6 vom 14.01.87

+;

+;****************************************************************

+;

+	  .6502

+

+          .radix    16

+

+main_ROM  equ      0C082

+lc_RAM    equ	   0C083

+lc_lock	  equ	   0C00F

+

+RESET	EQU	$FA62

+BREAK	EQU	$FA4C

+VECTBL	EQU	$FFFA

+

+;................................................................

+;

+init65:

+	sei

+	lda	lc_RAM

+	lda	lc_RAM		; LC-RAM write enable

+	lda	lc_lock		; verriegeln

+

+;

+	ldx	#0		; pointer initialisieren

+	stx	task

+	stx	INTPAR1	

+	stx	IFLG		; "Weiter" Kanal 5 Receiveinterrupt

+	stx	E_FLG		; Keine Eingabeflusskontrolle

+	stx	A_FLG		; Keine Ausgabeflusskontrolle

+	stx	SerFlg		; Kein Ausgabestop

+	stx	Wait_flg	; 64180 darf auf Pufferdescriptor zugreifen

+	stx	bus_locked	; Inteerupt an 64180 erlaubt, da kein Bus-Lock

+	stx	err1_bits

+	stx	err5_bits	; Keine Uebertragungs-Fehler aufgetreten

+	stx	KeyIn		; Tastaturpuffer leer

+	stx	KeyOut

+	stx	param1+1

+

+	dex			; X := FF

+	stx	param2

+	stx	param2+1

+	stx	last_track

+

+		lda	#0		; Physische Addresse der Sektoren

+		tax			; bestimmen (ueber Interleave)

+interlv_1:	

+		sta	ilv_tble,x

+		inx

+		clc

+		adc	#3		; interleave

+		and	#0F		; MOD 16

+		cpx	#10

+		bne	interlv_1

+

+	ldx	#80

+	stx	param1

+	jsr	GCTRL		; Grafik initialisieren

+

+	jsr	init_pbuf

+

+	ldx	#initab_len

+rloop:	lda	rbuf_ini,x

+	sta	rbuf,x

+	dex

+	bpl	rloop

+

+	ldx	#initab_len

+tloop:	lda	tbuf_ini,x

+	sta	tbuf,x

+	dex

+	bpl	tloop

+

+	ldx	#6

+vecloop:

+	lda	vector,x

+	sta	vectbl,x	; Vektoren ins RAM kopieren

+	dex

+	bne	vecloop

+

+	sta	KeyStr		; Tastatur ruecksetzen

+	sta	0C009		;   auf Interrupt schalten

+

+;	serielle Schnittstelle initialisieren

+;

+	lda	#1E		; 9600 Bd, 8 Bits/Char., 1 Stopbit

+	sta	SER_CTR

+	lda	#09		; no parity, rx/tx irq's enabled

+	sta	SER_COM

+

+	ldx	SLT180

+	stx	SLOT180

+	cli			; Interrupt enable

+

+	jmp	task_loop	; Jump in die Task_Loop_Routine

+

+vector:	

+	dw	resvec		; NMI

+	dw	resvec		; RESET

+	dw	irqvec		; IRQ & BRK

+

+tbuf_ini:

+	DW	(SBUFEND - SBUFBEG) * 100H, 0

+	DW	SBUFBEG * 100H, SBUFBEG * 100H

+	DB	SBUFBEG, SBUFEND

+

+rbuf_ini:

+	DW	(RBUFEND - RBUFBEG) * 100H, 0

+	DW	RBUFBEG * 100H, RBUFBEG * 100H

+	DB	RBUFBEG, RBUFEND

+	

+	ds	$100-(*-start)

diff --git a/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC b/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC
new file mode 100644
index 0000000..273c56e
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC
@@ -0,0 +1,123 @@
+	TITLE	Basis 108 Console Ausgabe

+;

+	INCLUDE HD64180.LIB

+;

+	.LIST

+;

+;****************************************************************

+;

+;	C O N O U T

+;

+;	Direkte BASIS 80 Zeichen Ausgabe

+;

+;	Version 1.0 - 16. 9. 1985

+;	Version 1.1 - 28. 10. 1985 (Invers korrigiert)

+;	Version 1.2 - 30.12.86 (Zeichensatzeinstellung, Stringausgabe)

+;

+;	Teil des EUMEL SHARD fuer RUC 64180

+;

+;****************************************************************

+;

+;	Globale Adressen

+;

+	GLOBAL	CRTOUT, SWICUR, STROUT

+;

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL  TO6502, ZGERL, BEEPFRQ

+;

+;----------------------------------------------------------------

+;

+;	Konstanten fuer MMU

+;

+BIOSBANK EQU	0F2H		;CBAR fuer 6502 Zugriff

+AR6502	EQU	5EH		;BBR-Wert fuer 6502 Zugriff

+BASE	EQU	2000H		;6502 Adressoffset

+;

+;	6502 Softswitches

+;

+STRAM1	EQU	BASE+0C00CH	;Umschalten auf Videobank 0

+STRAM2	EQU	STRAM1+1	;Umschalten auf Videobank 1

+

+SWINV	EQU	BASE+0C000H	; > 127: Invers

+SWFLSH	EQU	SWINV+1		; > 127: Flash

+SW2OFF	EQU	SWFLSH+1	; Zeichensatzswitch 2

+SW2ON	EQU	SW2OFF+1

+SW1OFF	EQU	SW2ON+1

+SW1ON	EQU	SW1OFF+1

+SW0OFF	EQU	SW1ON+1

+SW0ON	EQU	SW0OFF+1

+;

+;	andere 6502 Adressen

+;

+SCREEN	EQU	BASE+400H	;Anfang Video RAM

+;

+;----------------------------------------------------------------

+;

+	DSEG

+;

+;	lokale Daten

+;

+GOTOCNT: DEFB	0

+GOTOX:	DEFB	0		;Reihenfolge GOTOX, GOTOY festgelegt !!

+GOTOY:	DEFB	0

+SCRADR:	DEFW	SCREEN

+SCRXY:	DEFW	0

+INVMOD:	DEFB	80H

+CURCHR:	DEFB	0

+CURINV:	DEFB	80H

+;

+OLDCBAR: DEFB	0		;Zwischenspeicher fuer CBAR

+OLDBBR:	DEFB	0		;Zwischenspeicher fuer BBR

+STKSAV:	DEFW	0		;Stackpointer Zwischenspeicher

+	DEFS	20

+STACK:

+;

+;----------------------------------------------------------------

+;

+	CSEG

+;

+

+;----------------------------------------------------------------

+;

+;	S T R O U T

+;	Zeichenkette auf Masterconsole-Bildschirm ausgeben

+;

+;	Eingang: HL = Startadresse der Zeichenkette

+;		 BC = Laenge der Zeichenkette

+;	Ausgang: HL und Akku veraendert

+;

+STROUT:

+	PUSH	BC

+	PUSH	DE

+	PUSH	IX

+

+	PUSH	HL		; Stringadresse --> IX

+	POP	IX

+

+OUTLOOP:

+	LD	A,B

+	OR	C

+	JR	Z,POPRET

+

+	PUSH	BC

+	LD	C,(IX+0)

+	CALL	CRTOUT

+	POP	BC

+	INC	IX

+	DEC	BC

+	JR	OUTLOOP

+

+POPRET:

+	POP	IX

+	POP	DE

+	POP	BC

+	RET

+	

+;-----------------------------------------------------------------

+	

+	INCLUDE	CONOUT4.INC

+;

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC b/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC
new file mode 100644
index 0000000..9ffda13
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC
@@ -0,0 +1,466 @@
+

+;

+; CONOUT4.INC

+;

+; Character auf BASIS 108 80-Zeichen ausgeben

+;

+; Copyright (c) 1985 by Joerg Stattaus

+;

+; Modified for psi by R. Ellerbrake

+;

+; C=char

+;

+; Version 17.09.85

+;	Stand: 22.12.86, mit Zeichensatzeinstellung (M.St)

+;	       31.12.86, Mod. fuer 6502-Teil > 0C00

+;

+

+crtout:	

+	ld	hl,gotocnt	; GotoXY in Aktion ?

+	ld	a,(hl)

+	or	a

+	jr	z,crt2

+

+	dec	(hl)

+	ld	a,c

+	jr	z,crt1		; Get X-Value

+

+	ld	(gotoy),a	; Y storen

+	ret	

+

+crt1:	ld	(gotox),a

+

+	ld      b,7             ; Gotoxy is Function 7

+	jr      conq

+

+crt2:

+	ld      b,a

+	ld	a,c

+

+crt3:	cp	' '

+	jr      nc,conq		; normales Zeichen

+

+crt4:	ld      hl,scrfen       ; In Tabelle nach Zeichen suchen

+	ld      b,22            

+crt5:	cp	(hl)          

+	jr      z,crtfnd	; Sequenz erkannt

+

+	dec     hl              

+	djnz    crt5

+

+	ret			; nicht in der Tabelle enthalten

+

+crtfnd: ld      a,b		; Found

+	cp      7

+	jr      nz,conq       

+;

+	ld      a,2

+	ld      (gotocnt),a	; next 2 Bytes sind Koordinaten

+	RET

+

+SWICUR:

+	LD	B,23		; Cursor invertieren

+conq:

+	LD	A,I		; IEF2 retten

+	PUSH	AF

+	DI			; keine Interrupts zulassen

+;

+	in0	a,(cbar)	; Set CommonBaseAreaRegister for Video

+	ld	(oldcbar),a

+	ld	a,biosbank

+	out0	(cbar),a

+;

+	IN0	A,(BBR)		; Set Bank Base Register

+	LD	(OLDBBR),A

+	LD	A,AR6502

+	OUT0	(BBR),A

+;

+	LD	(STKSAV),SP	; alten SP retten (im umgeschalteten Bereich)

+	LD	SP,STACK

+;

+	CALL	CONQ1		; Print Char. on screen

+;

+	LD	SP,(STKSAV)	; alten Stack zurueckholen

+;

+	LD	A,(OLDBBR)	; restore old BBR

+	OUT0	(BBR),A

+	ld	a,(oldcbar)	; and CBAR

+	out0	(cbar),a

+	POP	AF		; IEF2 zurueckholen

+	RET	PO		; vorher kein EI ->

+;

+	EI			;reenable Interrupts

+	RET

+	

+; B=Sequenz / C=Char

+

+conq1:	ld      hl,(scradr)

+	ld      de,(scrxy)

+	ld      a,e

+	rra

+

+	CALL	ZGERL		; Zugriff erlaubt ?

+	ld	(stram1),a	; Dyn./Static RAM

+	jr	nc,conq2

+	ld	(stram2),a

+conq2:  

+	ld	a,b

+	or	a

+	jr	nz,scrfkt	; Screen-Function

+

+	ld	a,(invmod)	; schreibe Zeichen auf Bildschirm

+	or	c

+	ld	(hl),a

+adv0:   ex	de,hl

+	inc	hl

+	ld	a,l

+	cp	80

+	jp	c,onlinc

+

+	ld      l,0

+	inc     h

+	ld      a,h

+	cp      24

+	jp      c,calc

+

+	; scroll noetig

+

+	ld      l,0

+scroll: dec	h

+	push    hl

+	ld      d,0

+	call    del0		; delete Zeile 0

+

+	pop     hl

+calc:   ld      (scrxy),hl

+	ld      e,l

+	ld      a,h

+	call    basclc

+	ld      a,e     	; hl=lineadr / a=scrxyr

+	srl	a

+

+	ld      (stram1),a

+	jr      nc,calc3

+	ld      (stram2),a

+calc3:  

+	add     a,l

+	ld      l,a

+calc4:  ld      (scradr),hl

+calc5:  ld      a,(hl)  	; get char on cursor adr

+	ld      (curchr),a

+	ld      a,(curinv)

+	xor     (hl)

+	ld      (hl),a  	; invers zurueck

+	ld      (stram1),a

+

+crtret:	ret

+

+onlinc: ld      (scrxy),a	; normales increment des scr.poi.

+	ex      de,hl           ; HL wieder = scradr

+	rra

+

+	ld      (stram2),a

+	jr      c,calc5         ; selbe Adresse, 2. Seite

+	ld      (stram1),a

+	inc     hl

+	jr      calc4

+

+scrfkt: ld	a,(curchr)	; Restore Char on Screen

+	ld	(hl),a

+	ld	a,b

+	ld      hl,scrtab-2

+	add     a,a

+	add     a,l

+	ld      l,a

+	LD	A,H		; cross page boundary ?

+	ADC	A,0

+	LD	H,A

+	ld      a,(hl)

+	inc     hl

+	ld      h,(hl)

+	ld      l,a

+	jp      (hl)

+

+; Screen-Functions

+

+advanc: ld      hl,(scradr)

+	jr      adv0

+

+schome: ld      hl,0

+	jr      tocalc

+

+gotoxy: ld      hl,(gotox)	; H=Y / L=X

+got0:   ld      a,h

+	cp      24

+	jr      c,got1

+	

+	ld      h,0

+got1:   ld      a,l

+	cp      80

+	jr      c,tocalc

+

+got2:   ld      l,0

+	jr      tocalc

+

+up:     ex      de,hl

+	dec     h

+	jr      got0

+

+carret: ex      de,hl

+	jr      got2

+

+backsp: ex      de,hl

+	dec     hl

+	ld      a,l

+	cp      80

+	jr      c,tocalc

+

+	ld      l,79

+	jr      got0

+

+linefd: ex      de,hl

+	inc     h

+	ld      a,h

+	cp      24

+	jr      c,tocalc

+

+	jp      scroll

+

+erapag: push    de

+	call    erap0

+	pop     hl

+tocalc: jp      calc

+

+eralin: push    de

+	call    eral2

+	pop     hl

+	jr      tocalc

+

+insert: push    de

+	ld      a,d		; korrigiert

+	ld      de,SCREEN+003d0h ; Zeile 23

+	cp	23

+	jr      z,ins1          ; kein Verschieben

+

+	ld      b,23

+ins0:   dec     b

+	call    linmov

+	ld      a,(scrxy+1)	; Vertikal Adresse

+	cp      b

+	jr      nz,ins0

+

+ins1:   call    blank

+	pop     hl

+	jr      got2

+

+delete: push    de

+	call    del0

+	pop     hl

+	jr      got2

+

+normal: ld      a,80h

+	jr      inv1

+

+invers: xor     a

+inv1:   ld      (invmod),a

+;

+inv2:   ex      de,hl

+	jr      tocalc

+

+chacur: ld      hl,curinv

+	ld      a,(hl)

+	xor     80h

+	ld      (hl),a

+	jr      inv2

+

+clear:  call    schome

+	ld      de,0

+	push    de

+	call    erap0

+	pop     hl

+	jr      tocalc

+

+bell:   push	hl

+	ld	a,(BEEPFRQ)

+	ld	h,a

+	ld	l,2		; task beep

+	call	to6502

+	pop	hl		; transport scrxy to HL

+	ret

+

+eral2:  ld      hl,(scradr)

+	push    hl

+	ld      (stram1),a

+	ld      a,e

+	srl     a

+	jr      nc,eral3

+

+	inc     a

+	inc     hl

+eral3:  call    erablk

+	

+	ld      (stram2),a

+	pop     hl

+	ld      a,e

+	srl     a

+erablk: sub     41

+	cpl

+	ld      b,0a0h

+erabl1: or	a

+	ret	z

+	ld      (hl),b

+	inc     hl

+	dec     a

+	jr      erabl1

+

+erap0:  call    eral2

+	ld      a,(scrxy+1)

+erap1:  inc     a

+	cp      24

+	ret     nc

+

+	push    af

+	call    basclc

+	

+	ex      de,hl

+	call    blank

+	pop     af

+	jr      erap1

+

+del0:   ld      a,d

+	cp      23

+	ld      de,SCREEN+003d0h  ; Zeile 23

+	jr      z,blank

+

+	push    af

+	call    basclc

+	pop     bc              ; Vert. Adr. von D -> A -> B

+

+	ex      de,hl

+del1:   inc	b

+	call    linmov

+	ld      a,b

+	cp      23

+	jr      c,del1

+

+blank:  ld      (stram1),a

+	ld      a,' '+80h

+	push    de

+	call    blank1

+	pop     de

+	ld      (stram2),a

+

+blank1: ld      b,40

+blank2: ld      (de),a

+	inc     de

+	djnz    blank2

+

+	ret

+

+linmov: push    bc

+	ld      a,b

+	call    basclc

+	ld      (stram1),a

+	push    hl

+	push    de

+	ld      bc,40

+	ldir                    ; eine Zeile

+	pop     de

+	pop     hl

+	push    hl

+	ld      (stram2),a

+	ld      bc,40

+	ldir

+	pop     de              ; HL nun in DE = neues Ziel

+	pop     bc

+	ret

+

+basclc: ld      c,a

+	ld      l,0

+	rra

+	rr      l

+	and     3

+	add     a,HIGH SCREEN	; screen - start

+	ld      h,a

+	ld      a,c

+	and     18h

+	ld      c,a

+	add     a,a

+	add     a,a

+	add     a,c             ; * 5 = 40

+	add     a,l

+	ld      l,a

+	ret                     ; HL = Line adress

+

+ger:				; German ASCII

+	ld	(sw0off),a

+	ld	(sw1on),a

+	ld	(sw2off),a

+	ret

+

+usa:				; ASCII

+	ld	(sw0off),a

+	ld	(sw1off),a

+	ld	(sw2on),a

+	ret

+

+apl:				; APL

+	ld	(sw0off),a

+	ld	(sw1on),a

+	ld	(sw2on),a

+	ret

+

+uni:				; ASCII und Inv. APL

+	ld	(sw0on),a

+	ld	(sw1on),a

+	ld	(sw2on),a

+	ret

+

+invsw:

+	ld	(swinv),a

+	ret

+

+flshsw:

+	ld	(swflsh),a

+	ret

+

+; Screen-Command-Definition-Table

+

+;leadsf:db	1bh

+;	db	0aah,0d9h,0d4h,0a9h,0a8h,1eh,0bdh,0bh,0ch

+;	db	0ah,08h,0dh,0cch,0cdh,0dah,07h

+;

+;	EUMEL psi-Terminal Definition

+;

+	DEFB	9		;Clear Screen (bei psi undefiniert)

+	DEFB	4		;Clear to End of Page

+	DEFB	5		;Erase to End-of-Line

+	DEFB	14		;Endmark (Normal Video)

+	DEFB	15		;Beginmark (Invers Video)

+	DEFB	1		;Home

+	DEFB	6		;Cursor Positionierung

+	DEFB	3		;Cursor 1 Zeile nach oben

+	DEFB	2		;Cursor nach rechts

+	DEFB	10		;Line feed

+	DEFB	8		;Backspace

+	DEFB	13		;Carriage Return

+	DEFB	11		;Insert Line (bei psi undefiniert)

+	DEFB	12		;Delete Line (bei psi undefiniert)

+	DEFB	0		;NULL (nichts tun)

+	DEFB	7		;BELL

+	DEFB	16		;GER, Zeichensatz

+	DEFB	17		;USA,     "

+	DEFB	18		;APL,     "

+	DEFB	19		;UNI, 	  "

+	DEFB	20		;Invers > 127

+	DEFB	21		;Flash > 127

+

+scrfen	equ	$-1

+

+scrtab: dw      clear,erapag,eralin,normal,invers,schome,gotoxy,up,advanc

+	dw      linefd,backsp,carret,insert,delete,CRTRET,bell

+	dw	ger,usa,apl,uni,invsw,flshsw,chacur

+;

+;	CRTRET anstelle von chacur

+

+; Ende von CONOUT3.INC

diff --git a/system/shard-z80-ruc-64180/1.5/src/CREF.COM b/system/shard-z80-ruc-64180/1.5/src/CREF.COM
new file mode 100644
index 0000000..e449ce9
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/CREF.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/DB.COM b/system/shard-z80-ruc-64180/1.5/src/DB.COM
new file mode 100644
index 0000000..63b3afb
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DB.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/DISK.MAC b/system/shard-z80-ruc-64180/1.5/src/DISK.MAC
new file mode 100644
index 0000000..70f173c
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DISK.MAC
@@ -0,0 +1,1657 @@
+;

+	TITLE	EUMEL fuer RUC 64180, 6502 Teil & Diskroutinen

+;

+;****************************************************************

+;

+;	 EUMEL 1.8.0 with RUC180-Card on BASIS 108

+;

+;	 6502 DISK-Driver und Motherboard I/O

+;

+;	 Stand (1.8) : 14.01.87, mit neuem Puffer-Handling

+;		     : 27.05.87, mit Hardcopy auf SHIFT CTRL F12

+;		     : 26.06.87, Druckerspooler loeschen mit Task 8

+;	 Version 23.09.85 ./. 22.11.85

+;

+;****************************************************************

+;

+	  .6502

+          .radix    16 

+;

+;----------------------------------------------------------------

+;

+;	Globale Variable

+;

+	GLOBAL	DES6502, PRG6502, LEN65, ST6502

+;

+;----------------------------------------------------------------

+;

+;	Konstanten

+;

+XOFF	EQU	13		; CTRL-S

+XON	EQU	11		; CTRL-Q

+;

+;	Adressen

+;

+KeyBoard 	equ	0C000

+Keyext		equ	0C008

+KeyStr		equ	0C010

+

+VIDBNK		equ	0C00C

+

+prackn		equ	0C1C1

+prport		equ	0C090

+

+speaker		equ	0C030

+

+serial_stat	equ	0C099

+SER_DAT 	EQU	0C098H		;Serial Interface Data

+SER_COM 	EQU	0C09AH		;Serial Command Register

+SER_CTR		EQU	0C09BH		;Serial Control Register

+	

+analog_1	EQU	$C063

+analogreset	EQU	$C070

+

+; Floppy Hardware

+

+phase0    equ      0C080

+phase1    equ      0C082

+phase2    equ      0C084

+phase3    equ      0C086

+mtroff    equ      0C088

+mtron     equ      0C089

+drive0    equ      0C08A

+Q6off     equ      0C08C

+Q6on      equ      0C08D

+Rstate    equ      0C08E

+Wstate    equ      0C08F

+;

+	INCLUDE	ZPAGE.INC	;Zero Page Adressen

+;

+;	sonstiges

+;

+bit_z		equ	24

+

+fast_step equ	$0E	; etwas weniger als 3 ms Track-Wechselzeit

+

+pagerr	  macro	    adr

+	  if high(*-start) ne high(adr-start)

+	  .printx 'Page-Error'

+	  endif

+	  endm

+

+	  cseg

+PRG6502:

+	  .phase    0C00

+DES6502:			; 6502-Startadresse zum kopieren

+

+start:				; Label fuer Pageboundcheck

+nible1:				; Anfang des Nibble-Buffers

+	defm	'6502-Teil'

+

+ST6502:				; Startadresse 6502-Teil Initialisierung

+	include BOOT.INC

+

+	include NIBLE.INC	

+

+write_data

+          SEC

+          LDA       Q6on,X

+          LDA       Rstate,X

+          BMI       wrdat99

+          LDA       nible2

+          STA       temp2

+          LDA       #0FF

+          STA       Wstate,X    ;  5

+          ORA       Q6off,X     ;  4

+          PHA                   ;  3

+          PLA                   ;  4     [sta..sta[

+          NOP                   ;  2

+          LDY       #04         ;  2

+wrdat1    PHA                   ;  3             3

+          PLA                   ;  4             4

+          JSR       wrt_nibl1   ;+13        15  13

+          DEY                   ;---         2

+          BNE       wrdat1      ; 40       + 3

+                                ;          --- ---

+                                ;           20+ 20 = 40

+

+	  pagerr    wrdat1

+

+                                ;           -1

+          LDA       #0D5        ;            2

+          JSR       wrt_nibl     ; 15       +15

+          LDA       #0AA        ;  2       ---

+          JSR       wrt_nibl     ;+15        36

+          LDA       #0AD        ;---

+          JSR       wrt_nibl     ; 32        15

+          TYA                   ;            2

+          LDY       #56         ;            2

+wrdat11   BNE       wrdat3      ;            3

+wrdat2    LDA       nible2,Y    ;            0    4

+wrdat3    EOR       nible2-1,Y  ;            5    5

+          TAX                   ;            2    2

+          LDA       to_nibble,X ;            4    4

+          LDX       slot10z     ;            3    3

+                                       ;   ---  ---

+                                       ;    36   18

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          DEY                          ;     2

+          BNE       wrdat2             ;     3

+                                       ;   ---

+                                       ;    14 + 18 = 32

+                                       ;    -1

+          LDA       temp2              ;     3

+          NOP                          ;     2

+wrdat4    EOR       nible1,Y           ;     4    4

+          TAX                          ;     2    2

+          LDA       to_nibble,X        ;     4    4

+          LDX       slot10             ;     4    4

+                                       ;   ---  ---

+                                       ;    32   14

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          LDA       nible1,Y           ;     4

+          INY                          ;     2

+          BNE       wrdat4             ;     3

+                                       ;   ---

+                                       ;    18+ 14 = 32

+

+	  pagerr	    wrdat11

+

+          TAX                          ;     2

+          LDA       to_nibble,X        ;     4

+          LDX       slot10z            ;     3

+          JSR       wrt_nibl2          ;     6  15

+          LDA       #0DE               ;   ---   2

+          JSR       wrt_nibl            ;    32  15

+          LDA       #0AA               ;       ---

+          JSR       wrt_nibl            ;        32

+          LDA       #0EB

+          JSR       wrt_nibl

+          LDA       #0FF

+          JSR       wrt_nibl

+          LDA       Rstate,X

+wrdat99

+          LDA       Q6off,X

+wrdat999

+	  dey

+	  bne	   wrdat999		; PostErase-Delay 1 ms

+

+          RTS

+

+read_hdr

+          sei

+          LDY       #0FC

+          STY       temp2

+rdhdr0

+          INY

+          BNE       rdhdr1

+          INC       temp2

+          BEQ       fail

+rdhdr1

+          LDA       Q6off,X

+          BPL       rdhdr1

+rdhdr11   CMP       #0D5

+          BNE       rdhdr0

+

+          NOP

+rdhdr2    LDA       Q6off,X

+          BPL       rdhdr2

+          CMP       #0AA

+          BNE       rdhdr11

+

+          LDY       #03

+rdhdr3    LDA       Q6off,X

+          BPL       rdhdr3

+          CMP       #96

+          BNE       rdhdr11

+          

+	  pagerr    rdhdr1

+

+          

+          LDA       #00

+nxthByte  STA       chk_sum

+rdhdr4    LDA       Q6off,X

+          BPL       rdhdr4

+	  ROL	    A

+          STA       temp2

+rdhdr5    LDA       Q6off,X

+          BPL       rdhdr5

+          AND       temp2

+          STA       chk_in_hdr,Y

+          EOR       chk_sum

+          DEY

+          BPL       nxthbyte

+

+          TAY

+          BNE       fail

+

+rdhdr6    LDA       Q6off,X

+          bpl       rdhdr6

+          cmp       #0DE

+          BNE       fail

+

+          NOP

+rdhdr7    LDA       Q6off,X

+          BPL       rdhdr7

+          CMP       #0AA

+          BNE       fail

+

+          CLC

+          RTS

+fail

+          SEC

+          RTS

+

+moving

+          LDY       #0

+mov0      LDA       Q6off,X

+	  JSR	    mov1

+	  PHA			;  3

+ 	  PLA			;  4

+	  CMP	    Q6off,X	;  4

+	  BNE	    mov1	;----

+	  DEY			; 21 uS

+	  BNE	    mov0

+mov1	  RTS

+

+

+read_data

+	  TXA

+	  ORA	    #8C

+	  STA	    ld1+1

+	  STA	    ld2+1

+	  STA	    ld3+1

+	  STA	    ld4+1

+	  STA	    ld5+1

+	  LDA	    user_data

+	  LDY	    user_data+1

+	  STA	    st5+1

+	  STY	    st5+2

+	  SEC

+	  SBC	    #54

+	  BCS	    rddat1

+	  DEY

+	  SEC

+rddat1

+	  STA	    st3+1

+	  STY	    st3+2

+          SBC       #57

+          BCS       rddat2

+          DEY

+rddat2

+          STA       st2+1

+          STY       st2+2

+

+          LDY       #20

+nxt_begin

+          DEY

+          BEQ       fail

+wait_begin

+waitb0    LDA       Q6off,X

+          BPL       waitb0

+waitb00   EOR       #0D5

+          BNE       nxt_begin

+          NOP

+waitb1    LDA       Q6off,X

+          BPL       waitb1

+          CMP       #0AA

+          BNE       waitb00

+          NOP

+waitb2    LDA       Q6off,X

+          BPL       waitb2

+          CMP       #0AD

+          BNE       waitb00

+

+          LDY       #0AA

+          LDA       #0

+rloop1    STA       temp2

+ld1       LDX       Q6off+60  ; addr modified by read init !

+          BPL       ld1

+          LDA       to_bits-96,X

+          STA       nible2-0AA,Y

+          EOR       temp2

+          INY

+          BNE       rloop1

+          

+;

+; read nible from disk and convert to user data

+;

+          LDY       #0AA

+          BNE       ld2

+rloop2

+st2       STA       1000,Y

+ld2       LDX       Q6off+60  ; modified by read init

+          BPL       ld2

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+0,X

+          INY

+          BNE       rloop2

+

+          PHA

+          AND       #0FC

+          LDY       #0AA

+ld3       LDX       Q6off+60  ; modified by read init

+          BPL       ld3

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+1,X

+st3       STA       1000,Y

+          INY

+          BNE       ld3

+

+ld4       LDX       Q6off+60  ; modified by read init

+          BPL       ld4

+          AND       #0FC

+          LDY       #0AC

+rloop5    EOR       to_bits-96,X

+          LDX       nible2-0AC,Y

+          EOR       to_bytes+2,X

+st5       STA       1000,Y

+ld5       LDX       Q6off+60  ; modified by read init

+          BPL       ld5

+          INY

+          BNE       rloop5

+          AND       #0FC

+          EOR       to_bits-96,X

+          LDX       slot10z

+          TAY

+          BNE       chk_fail

+rloop6    LDA       Q6off,X

+          BPL       rloop6

+          CMP       #0DE

+          BEQ       read_ok

+

+          pagerr      wait_begin

+chk_fail

+          SEC

+          db     bit_z

+read_ok

+          clc

+          PLA

+          LDY       #55

+          STA       (user_data),Y

+          RTS

+

+seekT	  lda	    iob_trk          

+seekL

+	  jsr	    trk_to_ph

+          cmp       phase0,X

+          cmp       phase1,X

+          cmp       phase2,X

+          cmp       phase3,X

+          LDY       disk_no

+          LDA       head_table,y	; da steht der Kopf jetzt

+          STA       head_pos

+	  lda	    dest_phase

+	  sta	    head_table,y	; da soll er nachher stehen

+          

+seekH

+          cmp       head_pos

+          BEQ       seek_rts

+          LDA       #0

+          STA       temp2

+seekh0    LDA       head_pos

+          STA       phase

+          SEC

+          SBC       dest_phase

+          BEQ       seekh5

+          BCS       seekh1

+          EOR       #0FF

+          INC       head_pos

+          BCC       seekh2

+seekh1    ADC       #0FE

+          DEC       head_pos

+seekh2    CMP       temp2

+          BCC       seekh3

+          LDA       temp2

+seekh3    CMP       #8

+          BCS       seekh4

+          TAY

+seekh4    SEC

+          JSR       step

+          LDA       time0,Y

+          JSR       step_wait

+          LDA       phase

+          CLC

+          JSR       step1

+          LDA       time1,Y

+          JSR       step_wait

+          INC       temp2

+          BNE       seekh0

+

+seekh5    JSR       step_wait

+          CLC

+step      LDA       head_pos

+step1     AND       #3

+          ROL       A

+          ORA       slot10z

+          TAX

+          LDA       phase0,X

+          LDX       slot10z

+seek_rts  RTS

+

+;-------------------------------;

+

+make_nibl

+          LDY       #56

+          LDA       #0

+maken0    STA       nible2-1,Y

+          DEY

+          BNE       maken0

+maken1    LDX       #55

+maken2    LDA       (user_data),Y

+          AND       #0FC

+          STA       nible1,Y

+          EOR       (user_data),Y

+          INY

+          CMP       #02

+          ORA       nible2,X

+          ROR       A

+          ROR       A

+          STA       nible2,X

+          DEX

+          BPL       maken2

+          CPY       #02

+          BNE       maken1

+          RTS

+

+;	ds	10

+          

+Dsk_RW 

+	  ldx	    #0A9	; LDA #xx

+	  lda	    def_byte

+	  and	    #$20	; Bit 5 ?

+	  bne	    rw_0	; Fast Step - use abs. value

+

+				; Slow Step - use MotorOn/Off-Tables

+	  ldx	    #0C9	; CMP #xx

+rw_0:	  stx	    step_wait

+	

+	  lda	    #fast_step	; Set Step Rate

+	  bit	    def_byte

+	  bmi	    rw_1	; Bit7: Controller-Typ

+				; Bit7=0 => Ehring

+	  lsr	    a		; bei Ehring 2-fache Phases => halbe Steprate

+

+rw_1:	  sta	    step_wait+1		; Steprate

+

+          lda       disk_no

+          LSR       A

+          TAY

+          LDA       slotn,Y

+          STA       slot10

+          sta       slot10z

+          adc       #0

+          STA       iob_drv

+          

+ 	  include TRACK.INC 

+

+trk_to_ph:			; IN: A = track / OUT: A,dest_phase = phase

+	sta	dest_phase

+

+; Select Side 0

+

+	bit	def_byte	; Bit7: 1=Erphi-Controller

+				; Bit6: 1=Erphi-Format

+

+	bvc	ehring_format	; Bit6 = 0 => Ehring-Format

+

+	lsr	dest_phase	; Erphi-Format

+	bcc	side0

+

+; Select Side 1

+; Erphi:  mtroff, Q6on, mtron

+; Ehring: mtroff,mtron

+

+side1:	lda	mtroff,x

+	bit	def_byte

+	bpl	side1_2

+				; Erphi-Side-1-Select

+	lda	Q6on,x

+side1_2:

+	lda	mtron,x

+	jmp	ph_mult

+

+ehring_format:

+	cmp	#$50		; Track >= 80 ?

+	bcc	side0		; nein: Select Side 0

+

+	sbc	#$50

+	sta	dest_phase

+	jmp	side1

+

+; Select Side 0

+; Ehring: lda cn00,x

+; Erphi : mtroff, Q6off, mtron

+

+side0:	bit	def_byte

+	bmi	erphi_s0	; Bit7 = 1 => Erphi-Controller

+

+	txa			; Ehring-Side-0-Select

+	lsr	a

+	lsr	a

+	lsr	a

+	lsr	a

+	ora	#$C0

+	sta	ehr_sel+2

+

+ehr_sel:lda	$C600

+	jmp	ph_mult

+

+erphi_s0:			; Erphi-Side-0-Select

+	cmp	mtroff,x

+	cmp	Q6off,x

+	cmp	mtron,x

+

+ph_mult:

+	lda	def_byte	; Bit 0..1: 0 = 1 Step/Track

+	and	#03		;           1 = 2 Steps/Track

+	tay			;           2 = 4 Steps/Track

+	beq	ph_mult2

+

+ph_mult1:

+	asl	dest_phase

+	dey

+	bne	ph_mult1

+

+ph_mult2:

+	lda	dest_phase

+	rts

+

+;---------------------------------------------------------------------------

+;

+;	D I S K R W

+;	Eingang:	iob_trk, sektor, def_byte, disk_no, param, last_track

+;			dma, ilv_tbl, 

+;	Ausgang:	iob_err

+;	Daten:		x000..xFFF (Ein Track, Sektoren in log. Reihenfolge)

+;	64180 darf nicht auf den Applebus, Aufruf mit JSR

+;

+;---------------------------------------------------------------------------

+

+DISKRW:

+		jsr	lock_bus

+

+		lda	iob_trk		; Track fuer Read/Write		

+		bit	param		; 0 = Write, FF = Read

+		bpl	writecmd

+		cmp	last_track	; Muss auf neuen Track positioniert

+		bne	readtrack	; werden ?

+

+		ldy	sektor

+		ldx	ilv_tble,y

+		lda	sec_tble,x

+		beq	readtrack	; Sektor nicht ok

+		ldx	ilv_tble+1,y

+		lda	sec_tble,x

+		beq	readtrack

+

+		lda	#00		; Nein, somit auch kein Lesefehler

+		sta	iob_err

+		jmp	unlock_bus

+

+readtrack:

+		sei

+		lda	#10		; Track muss ganz neu gelesen werden

+		sta	sec_cnt		; das sind 16 Sektoren a 256 Byte

+		lda	#00		; Kennzeichen fuer Einlesen

+		ldx	#0F

+sec_1_loop:	sta	sec_tble,x	; Sektortabelle = Kennzeichen setzen

+		dex

+		bpl	sec_1_loop

+		bmi	readwrite

+

+writecmd:	

+		sei

+		ldx	#02		; Bei Write nur 512 Byte schreiben

+		stx	sec_cnt

+		ldx	#0F

+		lda	#$FF		; Kennzeichen fuer 'nicht Einlesen'

+sec_2_loop:	sta	sec_tble,x

+		dex

+		bpl	sec_2_loop

+

+		ldy	sektor		; gewuenschter 1. Sektor

+		ldx	ilv_tble,y	; logisch --> physisch umrechnen

+		lda	#00		; Kennzeichen 'Sektor schreiben'

+		sta	sec_tble,x

+		ldx	ilv_tble+1,y	; 2. Sektor logisch --> physisch

+		sta	sec_tble,x	; Auch schreiben

+

+		lda	last_track	

+		cmp	iob_trk		; Anderer Track als der letzte ?

+		beq	readwrite

+		jsr	readwrite	; Ja

+		lda	#$FF		; Muss bei Read neu eingelesen werden,

+					; da die anderen 14 Sektoren zum

+					; letzen Track gehoeren

+		sta	last_track

+		rts

+

+readwrite:	

+

+		lda	#00

+		tay

+		tax

+interlv_2:

+		ora	#dma_4k		; Cachebereich (4k) fuer Track

+		sty	dma,x

+		inx

+		sta	dma,x

+		inx

+		clc

+		adc	#0B		; Interleave 3

+		and	#0F		; MOD 16

+		cpx	#20		; 16 Sektoren

+		bne	interlv_2

+

+		lda	#0F		; Step Rate

+		sta	iob_err

+		jsr	dsk_rw		; Disk Operation

+		lda	iob_err		; Fehlerkennzeichen

+		beq	no_err

+

+		ldy	sektor

+		ldx	ilv_tble,y

+		lda	sec_tble,x

+		beq	is_err		; Fehler im 1. Teil des Blocks ?

+		ldx	ilv_tble+1,y

+		lda	sec_tble,x

+		beq	is_err		; Fehler im 2. Teil des Blocks ?

+					; nein,

+		lda	#0

+		sta	iob_err		; Zumindest dieser Block ok

+		beq	no_err		; Always

+

+is_err:

+		lda	#$FF		; Track muss neu gelesen werden

+		db	bit_a		; Skip 2 Bytes

+no_err:		lda	iob_trk		; last_track := track

+		sta	last_track

+		jmp	unlock_bus

+

+;----------------------------------------------------------------------------

+;

+;	A N A L 6 5

+;	Eingang:	param = 1..4 (Analogschalternummer)

+;	Ausgang:	analogwert = 0..255

+;

+;---------------------------------------------------------------------------

+

+ANAL65:

+		sei

+		jsr	lock_bus

+		ldx	param		; Nummer des Analogports

+		lda	analogreset	; Timer starten

+		ldy	#00

+		nop

+		nop

+readanalog:

+		lda	analog_1,x	; Analogwert lesen

+		bpl	anaready

+		iny

+		bne	readanalog	; Bis Bit 7 auf 0

+		pagerr	readanalog

+		dey			; Maximum 255

+

+anaready:	sty	analogwert

+		cli

+		jmp	unlock_bus

+

+;

+		INCLUDE GRAFIK65.MAC

+;

+irqvec:

+	sta	Asave		; Akku retten

+	pla

+	pha

+	and	#10		; BRK -Bit ?

+	bne	brkirq

+	lda	Asave

+	jmp	irq		; Interrupt ausfuehren

+

+brkirq:

+	lda	main_ROM

+	lda	Asave

+	jmp	BREAK		; Alte BREAK-Routine

+

+resvec:

+	lda	main_ROM	; ROM einschalten

+	jmp	RESET		; Alte RESET-Routine

+

+;****************************************************************

+;

+;	B E L L

+;

+; => Akustisches Signal

+

+beep	  sei

+	  jsr	    lock_bus

+	  lda	    #$32	; Laenge

+				; Frequenz = 5000/X Hz

+

+beep1	  ldx	    param	;  3

+beep2	  ldy	    #$12	; 	 2

+beep3	  dey			; 		   2

+	  bne	    beep3	; 		 + 3

+				;		----

+				;	89 = 	   5 * 18 - 1

+	  nop			;        2

+	  nop			;        2

+	  nop			;        2

+	  dex			; 	 2

+	  bne	    beep2	; 	 3

+				;	----

+				;	102 * X * 0.9775 us

+				;     = 99.7ms (f ~ 10kHz/X)

+				; -1 (Branch)

+	  bit	    speaker	;  4

+	  sec			;  2

+	  sbc	    #1		;  2

+	  bne	    beep1	;  3

+				; -----

+				; (14 + 102 * X) * A States Dauer

+				; 0.9775 * (14 + 102 * X) * A us

+	  cli

+	  jmp	    unlock_bus

+

+;*******************************************************************

+;

+;	Zugriffskontrolle fuer 64180 auf 6502-Bus

+;

+lock_bus:

+	lda	#$FF

+	sta	bus_locked

+	ldx	SLOT180

+	lda	wait180,x

+	rts

+

+unlock_bus:

+	lda	#$00

+	sta	bus_locked

+	ldx	SLOT180

+	lda	start180,x

+	rts

+

+;*******************************************************************

+;

+;	Input-Buffer Handler

+;

+;	Der Buffer darf nicht voll sein!

+;	Interrupts bei Receive-Buffer disabled

+;	Eingang: A = Zeichen

+;		 X = Bufferdescriptor Offset

+;	Ausgang: X intakt

+;		 A veraendert

+;		 SEC, wenn Puffer voll war

+putbuf:

+	sei

+putbuf0:

+	pha

+	lda	free,x		; Test, ob Puffer voll

+	ora	free+1,x

+	beq	putbuf4

+	pla

+

+	sta	(in,x)		; Zeichen in Puffer schreiben

+

+	inc	in,x		; Schreibzeiger erhoehen

+	bne	putbuf1

+	inc	in+1,x

+

+	lda	in+1,x		; Puffer-Ende ?

+	cmp	end,x

+	bcc	putbuf1

+	lda	beg,x		; Ringpuffer, wieder auf Pufferanfang setzen

+	sta	in+1,x

+

+putbuf1:

+	dec	wait_flg	; Warten, bis update vorbei

+	inc	full,x		; Belegten Platz vergroessern

+	bne	putbuf2

+	inc	full+1,x

+

+putbuf2:			; Dieser Wert wird auch von FROUT benutzt!

+	lda	free,x		; Freiplatz verringern

+	bne	putbuf3

+	dec	free+1,x

+putbuf3:

+	dec	free,x

+	inc	wait_flg	; Update gelaufen

+	clc			; Zeichen uebernommen

+	rts

+

+putbuf4:

+	pla

+	sec

+	rts			; Puffer war voll

+	

+;*******************************************************************

+;

+;	Output-Buffer Handler

+;

+;	Interrupts bei Transmit-Buffer disabled

+;	Der Buffer darf nicht leer sein!

+;	Eingang: X = Bufferdescriptor Offset

+;	Ausgang: X intakt

+;		 A = Zeichen

+;		 SEC, wenn Puffer leer war

+getbuf:

+	sei

+getbuf0:

+	sec

+	lda	full,x

+	ora	full+1,x

+	beq	getbuf4		; Test, ob Puffer leer ist

+

+	lda	(out,x)		; Zeichen aus Puffer lesen

+	pha

+

+	inc	out,x

+	bne	getbuf1

+	inc	out+1,x		; Lesezeiger erhoehen

+

+	lda	out+1,x

+	cmp	end,x

+	bne	getbuf1

+	lda	beg,x

+	sta	out+1,x		; Ringpuffer, Zeiger wieder auf Pufferanfang

+

+getbuf1:

+	dec	wait_flg	; Warten, bis Update vorbei

+	inc	free,x

+	bne	getbuf2

+	inc	free+1,x	; Freien Platz vergroessern

+getbuf2:

+

+	lda	full,x

+	bne	getbuf3

+	dec	full+1,x

+getbuf3:

+	dec	full,x		; Belegten Platz verringern

+	inc	wait_flg	; Update vorbei

+

+	pla

+	clc

+

+getbuf4:			; A enthaelt 00, wenn Puffer leer war

+	rts

+

+;****************************************************************

+;

+; => Drucker-Spooler

+;

+;------------------------------------------------------------------

+;

+;	Zeichen aus Druckerspooler an Drucker senden

+;

+spochc:	

+	lda	prackn

+	bmi	chcend		; Printer ready ?

+

+	ldx	#pbuf		; Printer Buffer

+	jsr	getbuf0		; Ohne SEI

+	bcs	chcend		; Nichts auszugeben, fertig

+

+	sta	prport		; Zeichen ausgeben

+	jmp	spochc		; Bis nichts mehr moeglich ist

+

+chcend:

+	rts

+

+;--------------------------------------------------------------------

+;

+;	Zeichen in Druckerpuffer schreiben

+

+bufin:	

+	ldx	#pbuf		; Zeichen geht verloren, wenn Puffer voll

+	jmp	putbuf0		; Zeichen in Puffer schreiben

+

+

+;****************************************************************

+;

+; => Ausgabe Spooler fuer serielle Schnittstelle

+;

+;-----------------------------------------------------------------

+;

+;	Zeichen aus dem Transmitbuffer senden

+;

+;spsero:	

+;	LDA	serial_stat

+;	AND	#10		; Transmit Data Register empty ?

+;	BEQ	schend		; serielles Interface nicht bereit

+

+spserok:			; Einsprung fuer Transmitinterrupt

+

+	LDA	SerFlg		; Ausgabe Stop ?

+	BMI	dis_tx		; Ja -> nichts ausgeben

+

+	ldx	#tbuf		; Transmitbuffer

+	jsr	getbuf		; Zeichen aus Puffer lesen

+	bcs	dis_tx		; Transmitter disabled, wenn Puffer leer

+

+	sta	SER_DAT		; Zeichen ausgeben

+schend:

+	rts

+

+dis_tx:

+	lda	ser_com

+	and	#$F3

+	ora	#$08		; Transmit Interrupt aus

+	sta	ser_com

+	rts

+

+;---------------------------------------------------------------------

+;

+;	Zeichen in den Transmitbuffer schreiben

+sbufin:	

+	ldx	#tbuf		; Zeichen in Transmitbuffer schreiben

+	jsr	putbuf		; Zeichen geht verloren, wenn Puffer voll

+	cli			; Wird nicht in Interruptrotinen aufgerufen

+

+	lda	ser_com

+	and	#$F3

+	cmp	#$04		; War Transmitinterrupt enabled ?

+	beq	sbufin1

+

+	ora	#$04		; Enable Transmit Interrupt

+	sta	ser_com

+sbufin1:

+	rts

+

+;****************************************************************

+;

+;	Eingabe Spooler fuer serielle Schnittstelle

+;

+;-----------------------------------------------------------------

+;

+;	Zeichen in A in den Receivebuffer schreiben

+rxser:

+	bit	A_FLG		; Ausgabeflusskontrolle

+	bpl	rxser3		; XON/XOFF interpretieren ?

+

+	cmp	#XON

+	bne	rxser4

+

+	lda	#$7F

+	and	SerFlg		; Transmitter starten

+	sta	SerFlg		; Bit 7 := 0

+

+	lda	ser_com

+	and	#$F3

+	ora	#$04

+	sta	ser_com

+	rts

+

+rxser4:

+	cmp	#XOFF

+	bne	rxser3		; war weder XON noch XOFF

+

+	lda	#80

+	ora	SerFlg		; Transmit-IRQ schaltet sich selbst aus

+	sta	SerFlg		; Bit 7 := 1

+	rts

+

+rxser3:

+	ldx	#rbuf

+	jsr	putbuf		; Zeichen geht verloren, wenn Puffer voll

+	bcs	rx_rts

+

+	lda	free+1+rbuf

+	bne	rx_rts		; Noch genug Platz

+	lda	free+rbuf

+	cmp	#10

+	bne	rx_rts		; Mehr als 16 Zeichen frei

+				; Flusskontrolle durchfuehren

+	bit	E_FLG		; Eingabeflusskontrolle

+	bpl	rxser1

+				; XOFF senden

+	lda	#XOFF

+	jsr	DSerOut

+	

+rxser1:

+	bit	E_FLG

+	bvc	rx_rts

+				; DTR low legen

+	lda	ser_com

+	and	#$FE

+	sta	ser_com

+

+rx_rts:	rts

+

+

+

+;--------------------------------------------------------------------

+;

+;	Zeichen aus Receivepuffer lesen an 64180 senden

+;

+rxout:

+	lda	INTPAR1

+	bne	rxout_rts	; Letzer Interrupt noch nicht quittiert

+

+	bit	bus_locked

+	bmi	rxout_rts	; 64180 darf nicht auf den Bus

+

+	bit	IFLG		; "stop" - Zustand

+	bmi	rxout_rts	; Kein Inputinterrupt

+

+	ldx	#rbuf

+	jsr	getbuf		; Zeichen lesen

+	bcs	rxout_rts	; Puffer ist leer

+

+	ldx	#5		; Kanal 5: serielle Schnittstelle

+	ldy	err5_bits	; Fehlerbits (passen nicht zum Zeichen)

+	jsr	TO180		; Zeichen im Akku

+

+	ldy	#0

+	sty	err5_bits	; loeschen

+

+	lda	full+1+rbuf

+	bne	rxout_rts	; Noch zuviel im Puffer

+	lda	full+rbuf

+	cmp	#10

+	bne	rxout_rts	; Noch mehr als 16 Zeichen im Puffer

+

+	bit	E_FLG

+	bpl	rxout2

+

+	lda	#XON		; XON senden

+	jsr	DSerOut

+

+rxout2:

+	bit	E_FLG

+	bvc	rxout_rts

+				; DTR high legen

+	lda	ser_com

+	ora	#01

+	sta	ser_com

+

+rxout_rts:

+	rts

+

+

+;-------------------------------------------------------------------

+;

+;	Direkte Ausgabe auf der seriellen Schnittstelle

+;

+DSerOut:

+	pha

+

+	lda	ser_com

+	and	#$F3

+	ora	#08		; Transmitter on, Tx_IRQ off

+	sta	ser_com

+

+Wai_empty:

+	LDA	serial_stat

+	AND	#10		; Transmit Data Register empty ?

+	BEQ	Wai_empty	; warten bis Transmitter empty ->

+

+	pla

+	STA	SER_DAT

+

+	lda	ser_com

+	and	#$F3

+	ora	#$04

+	sta	ser_com		; Transmitter on, TX_IRQ on

+

+	RTS

+

+

+;************************************************************************

+;

+; => Interrupt: Tastatur/V24

+;

+;-------------------------------------------------------------------------

+;

+;	Interrupt-Handler

+;

+IRQ:

+	sta	ASave

+	stx	XSave

+	sty	YSave

+

+	bit	keyboard	; Taste gedrueckt ?

+	bpl	irq_1

+

+	jsr	keyIRQ

+

+irq_1:

+	lda	serial_stat

+	bpl	irqret

+

+	pha

+	and	#08		; Receive Data Register full ?

+	beq	irq_2

+

+	pla

+	pha

+	jsr	receive_irq

+

+irq_2:

+	pla

+	pha

+	and	#10		; Transmit Data Register empty ?

+	beq	irq_3

+

+	jsr	spserok		; Zeichen aus Transmitbuffer senden

+

+irq_3:

+	pla

+	pha

+	and	#18

+	bne	irq_4

+				; External Status Change IRQ

+	pla

+	pha

+	jsr	status_irq

+	

+irq_4:

+	pla

+IRQret:

+	ldy	YSave

+	ldx	XSave

+	lda	ASave

+	rti			; Pull Old Status and Return

+

+;-------------------------------------------------------------------

+;

+;	Status Change - Interrupt

+;

+;	Eingang: A = serial_stat

+;

+status_irq:

+	bit	A_FLG		; Ausgabe Flusskontrolle (DSR beachten)

+	bvc	status1

+

+	and	#40		; DSR beobachten

+	beq	status2		; -DSR low, Transmitter starten

+

+	lda	#$7F		; Bit 7 := 0

+	and	SerFlg

+	sta	SerFlg

+

+	lda	ser_com

+	and	#$F3

+	ora	#$04		; Transmitter on, Tx_IRQ on

+	sta	ser_com

+status1:

+	rts

+

+status2:			; -DSR high, Transmitter stoppen

+	lda	#80

+	ora	SerFlg		; Transmitter stoppt sich selbst

+	sta	SerFlg

+	rts

+	

+;-------------------------------------------------------------------

+;

+;	Receiver - Interrupt

+;	Eingang: Y = ser_dat

+;		 A = serial_stat

+;

+receive_irq:

+	and	#7		; Fehlerbits ausmaskieren

+	ldy	ser_dat		; Zeichen einlesen

+

+	bit	SerFlg		; Letztes Zeichen war Break

+	bvc	receive1

+

+	pha

+	lda	#2		; Break

+	ora	err5_bits

+	sta	err5_bits	; Break empfangen

+

+	lda	#$BF

+	and	SerFlg		; Break Bit 6 := 0

+	sta	SerFlg

+	pla

+

+	cpy	#2		; SV-Call

+	beq	sv_call

+	cpy	#'W'		; BREAK - W = control ('weiter') simulieren

+	beq	weiter		; WEITER

+	cpy	#'R'		; BREAK - R = RESET

+	beq	reset_sys	; RESET

+	cpy	#'S'		; BREAK - S = Shutup

+	bne	receive1	; SHUTUP

+

+	pha

+	ldx	#'S'		; Shutup-Kennzeichen

+	tay

+	jsr	TO180		; Shutup - Interrupt

+	pla

+

+receive1:

+	cmp	#2		; Framing Error ?

+	bne	receive2

+	cpy	#0		; und Zeichen 00 = Break

+	bne	receive2

+

+	lda	#$40

+	ora	SerFlg		; Break vermerken

+	sta	SerFlg

+	rts

+

+sv_call:

+	jsr	weiter

+	ldy	#0

+	ldx	#5

+	lda	#2		; CTRL-B

+	jmp	TO180

+

+weiter:

+	lda	#0

+	sta	INTPAR1		; Interrupt als quittiert ansehen

+	lda	#7F

+	and	IFLG

+	sta	IFLG

+	rts

+

+receive2:

+	tax

+	lda	errbit_tab,x	; ACIA-Fehlerbits --> EUMEL Fehlerbits

+	ora	err5_bits

+	sta	err5_bits	; Fehler vermerken

+

+	tya			; Zeichen war in Y

+	jsr	rxser		; Zeichen in Receivepuffer schreiben

+

+	jmp	rxout		; Versuchen an 64180 zu senden

+

+;-------------------------------------------------------------------------

+;

+;	Fehlerbits

+;

+errbit_tab:

+	db	0, 4, 4, 4, 1, 5, 5, 5

+	; EUMEL: Bit 0= Overrun, Bit 1= Break, Bit 2= Parity/Framing

+

+;*******************************************************************

+;

+;	Remote - Reset

+;

+reset_sys:

+	sei

+	ldx	#rescodelen-1

+resetsysa:

+	lda	rescode,x

+	sta	0,x

+	dex

+	bpl	resetsysa

+

+	ldx	SLOT180

+	lda	stop180,x

+	nop

+	lda	start180,x

+	nop

+	lda	stop180,x

+	jmp	resvec

+

+rescode:

+	db	$AF, $F3, $ED, $39, $00, $ED, $39, $00, $ED, $76

+rescodelen	equ	$-rescode

+

+	; SYSEND:

+	; XOR A

+	; DI

+	; OUT0 (CNTLA0),A

+	; OUT0 (CNTLA0),A

+	; SLP

+

+;------------------------------------------------------------------

+;

+;	Keyboard - Interrupt

+;

+keyIRQ:

+	lda	KeyBoard

+	asl	a

+

+	tax			; X = 6543 210O

+	lda	KeyExt

+	asl	a		; Carry = Bit 7

+	txa

+	ror	a

+	sta	KeyStr		; Strobe loeschen

+

+	bit	bus_locked

+	bmi	readkey0	; Nur SHUTUP/RESET erlaubt

+

+	cmp	#$C2		; F2 = SV-CALL

+	bne	readkey0a

+	jsr	readkey0b

+

+	lda	#$C2

+	ldx	#1

+	jmp	TO180

+

+readkey0a:

+	cmp	#$BC		; SHIFT CTRL F12 = HCOPY-KEY

+	bne	readkey0c

+	jmp	HCOPY

+

+readkey0c:

+	cmp	#$BD		; SHIFT CTRL F13 = WEITER-KEY

+	bne	readkey0

+readkey0b:

+	lda	#0

+	sta	INTPAR1		; Interrupt als quittiert ansehen

+	lda	#$BF		; Bit 6 loeschen

+	and	IFLG

+	sta	IFLG

+	rts

+

+readkey0:

+	cmp	#$BE		; SHIFT CTRL F14 = SHUTUP-KEY

+	bne	readkey1

+	ldx	#'S'		; Kennzeichen fuer Shutup

+	jmp	TO180		; Shutup-Interrupt

+	

+readkey1:

+	cmp	#$BF		; SHIFT CTRL F15 = RESET-KEY

+	bne	readkey2

+	jmp	reset_sys	; Keine Rueckkehr

+

+readkey2:

+	ldx	KeyIn

+	inx

+	cpx	KeyOut

+	bne	readkey3

+				; Tastaturpuffer Overflow

+	lda	err1_bits	; Kanal 1 Fehlerbits

+	ora	#1

+	sta	err1_bits	; Overrun-Error

+

+	ldx	#$0A		; Kurzer Beep: Buffer full

+	ldy	#$10

+	jmp	beep1

+

+readkey3:

+	dex

+	sta	KeyBuf,x

+	inc	KeyIn

+				; Versuchen an 64180 zu senden

+

+;----------------------------------------------------------------

+;

+;	Zeichen aus Keyboard-Buffer holen

+;

+getkey:	

+	ldx	INTPAR1		; letzter Interrupt quittiert ?

+	bne	Getret

+

+	bit	bus_locked

+	bmi	Getret

+

+	bit	IFLG		; "stop" - Zustand ?

+	bvs	Getret		; Kein Inputinterrupt

+

+	sei

+	ldx	KeyOut

+	cpx	KeyIn

+	beq	GetRet		; Puffer leer

+

+	lda	KeyBuf,x

+	inc	KeyOut

+

+	ldx	#1		; Kanal 1, Zeichen muss da sein

+	ldy	err1_bits	; Overrun Bit

+	jsr	TO180		; 64180 Interrupt

+

+	ldy	#0

+	sty	err1_bits

+

+GetRet:	

+	rts

+

+;****************************************************************

+;

+;	Texthardcopy auf Basis-Parallel

+;	(Interrupt muessen disabled sein)

+;	(Nur moeglich, wenn Druckerspooler leer, 64180 wird gestoppt)

+;

+HCOPY:

+	lda	pbuf+full

+	ora	pbuf+full+1

+	bne	getret		; Kein Hardcopy, da Spooler nicht leer ist.

+	

+	jsr	lock_bus	; 64180 vom Dienst suspendieren

+	lda	#$0D

+	jsr	bufin		; CR an Drucker

+

+	ldx	#0

+hcopy2:

+	ldy	#0		; 1. Spalte

+hcopy1:

+	txa

+	pha

+	tya

+	pha

+	jsr	bascalc		; Zeichen an der Position lesen

+	and	#$7F		; Inversbit ausblenden

+	jsr	bufin		; Zeichen an Drucker

+	pla

+	tay

+	pla

+	tax

+

+	iny

+	cpy	#$50		; 80. Spalte ?

+	bne	hcopy1

+

+	txa

+	pha

+

+	lda	#$0D		; CRLF an Drucker

+	jsr	bufin

+	lda	#$0A

+	jsr	bufin

+	jsr	spochc		; Spooler erstmal leeren

+

+	pla

+	tax

+	inx

+	cpx	#$18		; 24. Zeile ?

+	bne	hcopy2

+

+	jmp	unlock_bus	; 64180 darf wieder arbeiten

+

+;------------------------------------------------------------------------

+;

+;	Berechnet Adresse der Bildschirmposition (A,X) nach basl/bash

+;	Holt Zeichen --> A

+;	Static/Dynamic - Switch ggf. veraendert

+;

+bascalc:

+	lsr	a

+	tay			; Y DIV 2

+	sta	VIDBNK		; default even Y

+	bcc	bascalc1

+	sta	VIDBNK+1	; odd Y

+bascalc1:

+	txa

+	lsr	a

+	and	#3

+	ora	#4		; Page 0400..0BFF

+	sta	bash 		; High

+	txa

+	and	#$18

+	bcc	bascalc2

+	ora	#$80

+bascalc2:

+	sta	basl 		; Low

+	asl	a

+	asl	a

+	ora	basl 

+	sta	basl 

+	lda	(basl),y

+	rts

+

+;****************************************************************

+;

+;	Interrupts zum 64180 (Inputinterrupts)

+;	moeglich von Tastatur (Kanal 1) und seriellem Interface (Kanal 5)

+;	Shutup-Interrupt mit X = 'S'

+;	Ausgang: X veraendert

+;

+TO180:	

+	php

+	sei

+	STA	intpar2		; Zeichen

+	STY	intpar3		; Fehlerbits

+	STX	intpar1		; Kanalnr.

+	LDX	SLOT180

+	LDA	INT180,X	; 64180 Interrupt erzeugen

+	LDA	intpar2

+	plp			; Interrupt Flag

+	RTS

+

+;****************************************************************

+;

+;	Drucker Spooler loeschen

+;

+init_pbuf:

+	ldx	#initab_len

+ploop:	lda	pbuf_ini,x

+	sta	pbuf,x

+	dex

+	bpl	ploop

+	rts

+

+pbuf_ini:

+	DW	(DBUFEND - DBUFBEG) * 100H, 0

+	DW	DBUFBEG * 100H, DBUFBEG * 100H

+	DB	DBUFBEG, DBUFEND

+initab_len	EQU	*-pbuf_ini-1	; Alle gleich Lang

+

+

+;****************************************************************

+;

+;	Puffer pollen

+;

+polling:

+	jsr	spochc		; Zeichen aus Printer Spooler ?

+

+;	lda	full+tbuf

+;	ora	full+tbuf+1

+;	beq	polling2

+

+;	jsr	spsero		; Zeichen aus Transmitbuffer senden

+;	cli

+

+;polling2:

+	lda	INTPAR1		; letzter Interrupt quittiert ?

+	bne	polling1	; Puffer garnicht erst testen

+				; Polling: Interrupts an 64180

+

+	jsr	getkey		; Zeichen aus Tastatur-Buffer 

+	cli

+

+	lda	full+rbuf

+	ora	full+rbuf+1

+	beq	polling1

+

+	jsr	rxout		; Zeichen aus Receive-Buffer 

+	cli

+

+polling1:

+	rts

+

+

+;****************************************************************

+; 

+;	Hauptschleife des 6502: wartet auf Tasks

+;

+;	Task	1 : Disk R/W

+;		2 : Bell

+;		3 : Char zum Drucker(spooler)

+;		4 : Char zum seriell Spooler

+;		5 : Direktausgabe auf serieller Schnittstelle

+;		6 : Analog I/O

+;		7 : Grafik

+;

+task_end:

+;		8 : Druckerspooler loeschen

+

+	lda	#0

+	sta	task

+	sta	bus_locked	; Nicht mehr gesperrt

+

+

+task_loop:

+	cli

+	jsr	polling		; Puffer pollen

+

+	lda	task

+	beq	task_loop

+

+	cmp	#1

+	bne	task_lp1

+

+	jsr	DISKRW		; Disk I/O

+	jmp	task_end

+

+task_lp1:

+	cmp	#2

+	bne	task_lp2

+

+	jsr	Beep

+	jmp	task_end

+

+task_lp2:

+	cmp	#3

+	bne	task_lp3

+

+	lda	param

+	jsr	bufin		; in Spooler-Buffer

+	jmp	task_end

+

+task_lp3:

+	cmp	#4

+	bne	task_lp4

+

+	lda	param

+	jsr	sbufin		; Output to serial Interface

+	jmp	task_end

+

+task_lp4:

+	cmp	#5

+	bne	task_lp5

+

+	lda	param

+	jsr	DSerOut		; direkte Ausgabe auf ser. Schnittstelle

+	jmp	task_end

+

+task_lp5:

+	cmp	#6

+	bne	task_lp6

+

+	jsr	ANAL65		; Analog I/O

+	jmp	task_end

+

+task_lp6:

+	cmp	#7

+	bne	task_lp7

+

+	JSR	GRAFIK		; Grafik I/O

+	jmp	task_end

+

+task_lp7:

+	cmp	#8

+	bne	task_end

+

+	jsr	init_pbuf	; Drucker Spooler loeschen

+	jmp	task_end

+

+

+	defm	'Ende vom SHard'

+LEN65	EQU	$-start

+	IF $ GE 2000

+	   .printx '6502-Modul in Grafikseite 1!'

+	ENDIF

+	end

diff --git a/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC b/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC
new file mode 100644
index 0000000..ecb4419
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC
@@ -0,0 +1,301 @@
+		TITLE	64180-Teil fuer EUMEL-SHard Apple-Disk Unterstuetzung

+

+;		24.05.86, M. Staubermann

+;		Ueberarbeitet: 04.01.87

+

+		INCLUDE	HD64180.LIB

+		.LIST

+		CSEG

+;

+;----------------------------------------------------------------

+;

+;		Globale Adressen

+;

+		GLOBAL	ANALOG, DISKBK, INIDISK

+;

+;----------------------------------------------------------------

+;

+;		Externe Adressen

+;

+		EXTERNAL TO6502, WTEND, TO65WA, ZGERL, RD6502

+		EXTERNAL HGOP, WARTE, MEMDMA

+

+;---------------------------------------------------------------------------

+;

+;	K O N S T A N T E

+;

+;---------------------------------------------------------------------------

+

+SEKTOR		EQU	0F00CH

+LASTTRACK	EQU	0F00DH

+ANALOGWERT	EQU	0F00FH

+TASK		EQU	0F080H

+PARAM		EQU	0F081H

+DEFBYTE		EQU	0F082H

+DISKNO		EQU	0F083H

+TRACK		EQU	0F084H

+DISKERR		EQU	0F086H

+

+BUFPAGE		EQU	0E0H		; Erste Page des Trackpuffers

+

+SEMA:		DEFB	0		; Semaphor fuer Apple-Disk

+LASTDISK:	DEFB	0FFH

+DEFBYTE0:	DEFB	0E0H		; Drive 0

+DEFBYTE1:	DEFB	0E0H		; Drive 1

+

+;---------------------------------------------------------------------------

+;

+;	A N A L O G

+;	Eingang:	E = Nummer des Analogschalters (1..4)

+;	Ausgang:	BC = Analogwert (0..255)

+;

+;---------------------------------------------------------------------------

+

+ANALOG:

+		LD	A,E		; An jedem Kanal moeglich

+		AND	A

+		JR	Z,ILLEGAL	; Nur Analogschalter 1..4

+

+		CP	5

+		JR	NC,ILLEGAL

+

+		LD	H,E		; Parameter ist Analogschalternr.

+		LD	L,6		; Analogport abfragen

+		CALL	TO6502		; Auf Taskende warten

+

+		CALL	WTEND		; Auf Ergebnis warten

+

+		LD	HL,LOW ANALOGWERT

+		CALL	RD6502

+		LD	C,A

+

+		LD	B,0		; Ergebnis in BC

+		POP	HL

+		RET

+

+ILLEGAL:

+		LD	BC,-1

+		POP	HL

+		RET

+

+;---------------------------------------------------------------------------

+;

+;	C H K A C C

+;	Semaphorhandler fuer Apple-Disks

+;

+;	Akku veraendert, warte wird aufgerufen

+;

+CHKACC:

+	LD	A,(SEMA)	; Disk-Zugriffssemaphor

+	AND	A		; 0=frei

+	JR	Z,ISFREE	; Ja ->

+	CALL	WARTE

+	JR	CHKACC

+

+ISFREE:

+	DEC	A

+	LD	(SEMA),A	;Semaphor sperren

+	RET

+

+;---------------------------------------------------------------------------

+;

+;	I N I D I S K

+;	Eingang:	A = Kanalnummer (29, 30)

+;			DE = Schluessel von control 'size'

+;	Ausgang:	BC = Anzahl 512-Byte Bloecke, die auf die Disk passen

+;

+;--------------------------------------------------------------------------

+

+INIDISK:

+		PUSH	HL

+		PUSH	AF

+

+		CALL	CHKACC

+

+		LD	A,0FFH		; Nach der naechsten Operation

+		LD	(LASTDISK),A	; Track neu laden

+

+		LD	C,081H

+		LD	A,D

+		AND	A

+		JR	Z,INIDISK3	; DE = 0, 1, 2

+					; Format ueber Schluessel

+		AND	10000010B	; Bit 7 und Bit 1 ausblenden

+		JR	Z,INIDISK4	; 0: Erphi, 160k

+

+		LD	C,0E0H

+		CP	10B		; 2: Erphi, 640k

+		JR	Z,INIDISK4

+

+		LD	C,0A1H

+		CP	10000000B	; 128: Ehring, 160k

+		JR	Z,INIDISK4

+

+		DEC	C		; 130: Ehring 640k

+		JR	INIDISK4

+

+INIDISK3:

+		LD	A,E		; Kein analytischer Schluessel

+		CP	1

+		JR	Z,INIDISK4	; 1: 40 Tracks

+

+		LD	C,0E0H		; 2 * 80 Tracks		

+INIDISK4:

+		POP	AF

+

+		LD	HL,DEFBYTE0

+		CP	30

+		JR	Z,INIDISK5

+		INC	HL

+INIDISK5:	LD	(HL),C		; Defbyte eintragen

+		LD	HL,SEMA

+		LD	(HL),0		; Semaphor freigeben

+		

+		POP	HL

+

+		BIT	0,C		; 160k oder 640k ?

+		LD	BC,640*2

+		RET	Z

+		LD	BC,160*2

+		RET

+

+;---------------------------------------------------------------------------

+;

+;	D I S K B K

+;	Blockio auf Apple-Drives

+;

+;	Eingang:	A = Kanal (29, 30)

+;			DE = Blocknummer

+;			HL = Hauptspeicheraddresse des Blocks

+;			(HGOP) : 1 = BLOCKOUT, 0 = BLOCKIN

+;	Ausgang:	BC = Fehlercode (0, 1, 2)

+;

+;--------------------------------------------------------------------------

+

+DISKBK:

+		PUSH	DE

+		PUSH	AF		; Kanal merken

+

+		CALL	CHKACC		; Auf freie Diskroutinen warten

+

+		XOR	A		; A := 0

+		LD	B,3

+DIVLOOP:	SRL	D		; DE DIV 8 (Blocks/Track)

+		RR	E

+		RRA

+		DJNZ	DIVLOOP		; E = Tracknummer

+					; D = 0

+		RRA

+		RRA

+		RRA

+		RRA			; A = Sektornummer

+		LD	D,E

+		LD	E,A		; DE = Track/Sektor

+

+		LD	A,(HGOP)	; BLOCKIN oder BLOCKOUT ?

+		DEC	A

+		CALL	Z,TRANSPORT	; BLOCKOUT: 180-RAM --> 6502-RAM

+

+		DI

+		IN0	B,(CBR)

+		LD	C,51H		; Zeropage 6502 einblenden

+		OUT0	(CBR),C

+

+		CALL	ZGERL

+

+		POP	AF		; Kanal zurueck

+		AND	1		; Diskno in A

+		LD	C,A

+		LD	A,(LASTDISK)

+		CP	C

+		JR	Z,DISKBK2

+		LD	A,0FFH

+		LD	(LASTTRACK),A	; Track muss neu geladen werden

+DISKBK2:

+		PUSH	HL

+

+		LD	HL,TRACK

+		LD	(HL),D		; Track

+

+		LD	A,C

+		LD	(LASTDISK),A

+		DEC	HL

+		LD	(HL),C

+

+		LD	A,(DEFBYTE0)

+		DEC	C

+		INC	C

+		JR	Z,DISKBK3

+		LD	A,(DEFBYTE1)

+DISKBK3:

+		DEC	HL

+		LD	(HL),A		; Defbyte

+

+		LD	A,(HGOP)

+		DEC	A		; Read/Write Param

+		DEC	HL

+		LD	(HL),A

+

+		LD	A,E		; Sektor

+		LD	(SEKTOR),A

+

+		DEC	HL

+		LD	(HL),1		; Task: Disk R/W starten

+

+		OUT0	(CBR),B

+		EI

+

+		CALL	TO65WA		; Auf Beendigung der Task warten

+					; EUMEL-'warte' wird aufgerufen!

+		LD	HL,LOW DISKERR

+		CALL	RD6502

+		POP	HL

+

+		PUSH	AF

+		LD	A,(HGOP)

+		DEC	A

+		CALL	NZ,TRANSPORT

+		POP	AF

+		LD	BC,2

+		DEC	A

+		JR	Z,DISKBK1	; 2 = Diskettenfehler

+		DEC	BC

+		DEC	A

+		JR	Z,DISKBK1	; 1 = Writeprotected

+		DEC	BC		; 0 = ok

+DISKBK1:

+		XOR	A

+		LD	(SEMA),A

+		POP	DE

+		RET

+

+

+;............................................................................

+;

+;	Falls HGOP = 0:

+;		2 Sektoren (E, E+1) aus Basisspeicher --> 64180 (HL)

+;	Falls HGOP = 1:

+;		2 Sektoren aus 64180-RAM (HL) --> Basisspeicher (E, E+1)

+;

+;	Eingang: E = Sektornummer (muss gerade sein)

+;		 HL = Hauptspeicheradresse

+;	Ausgang: A, BC, HL veraendert

+ 

+TRANSPORT:	PUSH	HL

+		PUSH	DE

+		LD	A,E		; Sektor

+		EX	DE,HL		; HL (log. Adr.) --> DE

+

+		AND	0FH		; 0..15

+		OR	BUFPAGE		; Highbyte des Trackbuffers 6502

+		LD	H,A		; phys. Adr. berechnen

+		LD	L,0

+		LD	BC,512		; 512 Bytes uebertragen

+		LD	A,(HGOP)	; Transferrichtung

+

+		CALL	MEMDMA		; DMA-Transfer

+		POP	DE

+		POP	HL

+		RET

+

+		END

diff --git a/system/shard-z80-ruc-64180/1.5/src/DUMP.COM b/system/shard-z80-ruc-64180/1.5/src/DUMP.COM
new file mode 100644
index 0000000..d425dbf
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/DUMP.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM b/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM
new file mode 100644
index 0000000..134ccc5
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC b/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC
new file mode 100644
index 0000000..bb365b4
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC
@@ -0,0 +1,338 @@
+	TITLE	EBOOT - Eumel Bootstrap Schreibprogramm

+;

+;****************************************************************

+;

+;	E B O O T

+;

+;	Version 1.3 - 29.12.1986

+;

+;	Copyright (C) 1985 by R. Ellerbrake

+;

+;****************************************************************

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+;

+BDOS	EQU	5

+EUMEL	EQU	6		;Volume Directory Typ

+BOTLNG	EQU	3FH		; Nicht 40H

+BOTPA1	EQU	10H

+BOTPA2	EQU	10H

+DEFFCB	EQU	5CH

+;

+	EXTERNAL INITS, HDIO, FDIO, SCSIIO

+	GLOBAL	EBOOT

+;

+	CSEG

+;

+;****************************************************************

+;

+;	Meldungen

+;

+STARTUP:

+	DEFB	0DH, 0AH

+	DEFM	'**** E U M E L  Harddisk Bootstrap Installationsprogramm ****'

+	DEFB	0DH, 0AH

+	DEFM	'   Version 1.3 - 29.12.1986 - (C) by R. Ellerbrake (RUC)$'

+;

+NOBOOT:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Datei EUMEL.COM nicht gefunden, leer oder fehlerhaft!$'

+; 

+ERRSTR:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Harddisk E/A Fehler: '

+ERRNR:	DEFM	'00$'

+;

+ENDMSG:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Kein (weiteres) EUMEL Volume vorhanden!$'

+;

+QSTR:

+	DEFB	0DH, 0AH

+	DEFM	'EUMEL Bootstrap Lader auf Harddisk Volume '

+QSTRN:

+	DEFM	'                $'

+;

+LSTR:

+	DEFB	' installieren (J/N): $'

+;

+ILLSTR:

+	DEFB	0DH, 0AH, 7

+	DEFM	'Unzulaessige Eingabe !!!$'

+;

+RDYSTR:

+	DEFB	0DH, 0AH

+	DEFM	'EUMEL Bootstraplader erfolgreich installiert.$'

+;

+;****************************************************************

+;

+EBOOT::

+	LD	SP,STACK

+;

+	LD	DE,STARTUP

+	LD	C,9

+	CALL	BDOS

+;

+	LD	A,(DEFFCB)

+	LD	DE,EUMELFI

+	LD	(DE),A		;ggf. Drive aus Kommandozeile verwenden

+	LD	C,15		;Open File

+	CALL	BDOS

+	INC	A		;Fehler ?

+	JR	NZ,FIOK		;Nein ->

+;

+ILLFI:

+	LD	DE,NOBOOT	;Bootstrap Lader Datei nicht gefunden

+	LD	C,9

+	CALL	BDOS

+	JP	0

+;

+FIOK:

+	LD	A,(EUMELFI+16)	;1. BLock vorhanden ?

+	AND	A

+	JR	Z,ILLFI		;Nein -> Fehler

+;

+	CALL	INITS

+	CALL	INITS

+;

+;	Warten bis Harddisk hochgelaufen ist

+;

+WRTHRD:

+	LD	DE,TESTRD

+	LD	BC,0

+	CALL	SCSIIO

+	CP	4		;Drive not Ready ?

+	JR	Z,WRTHRD	;Ja -> warten

+;

+	LD	HL,DATAR

+	LD	BC,PARBLK

+	LD	A,0		;Superdirectory lesen

+	LD	DE,0

+	CALL	HDIO

+	AND	A

+	JR	Z,SDOK

+;

+HDIOER:

+	LD	DE,ERRNR	; Fehlernummer in A

+	CALL	HEX1

+	LD	DE,ERRSTR

+	LD	C,9

+	CALL	BDOS

+	JP	0

+

+HEX1:

+	PUSH	AF

+	RRCA

+	RRCA

+	RRCA

+	RRCA

+	CALL	HEX2

+	POP	AF

+HEX2:

+	AND	0FH

+	CP	0AH

+	JR	C,HEX3

+	ADD	7

+HEX3:

+	ADD	30H

+	LD	(DE),A

+	INC	DE

+	RET

+;

+;	64180 Bootvolume mit EUMEL Kennung suchen

+;

+SDOK:

+	LD	HL,DATAR

+	LD	E,(HL)		;Byte 0 = Anfangsoffset

+	LD	D,0		;DE = Volume Eintrag Laenge

+	ADD	HL,DE

+	LD	A,(DATAR+20H)	;Volume Anzahl

+	LD	B,A

+;

+SRCLOP:

+	PUSH	HL

+	POP	IX

+	LD	A,(IX+23H)	;Directory Typ

+	CP	EUMEL		;EUMEL Diretory ?

+	JR	Z,ISEDIR	;Ja ->

+;

+NXVOL:

+	ADD	HL,DE

+	DJNZ	SRCLOP

+;

+;	Alle Volumes durchsucht

+;

+	LD	DE,ENDMSG

+	LD	C,9

+	CALL	BDOS

+	JP	0

+;

+;	EUMEL Volume gefunden

+;

+ISEDIR:

+	PUSH	HL

+	PUSH	DE

+	PUSH	BC

+	PUSH	IX

+	LD	B,0

+	LD	C,(IX+10H)	;Laenge des Volumenamens

+	LD	DE,11H

+	ADD	HL,DE		;auf Volumename

+	LD	DE,QSTRN

+	LDIR

+	LD	A,'$'

+	LD	(DE),A		;Stringende eintragen

+;

+	LD	DE,QSTR

+	LD	C,9

+	CALL	BDOS		;anfragen

+	LD	DE,LSTR

+	LD	C,9

+	CALL	BDOS

+;

+	LD	C,1		;1 Zeichen einlesen

+	CALL	BDOS

+	AND	05FH

+;

+	CP	'Y'		;Ja ->

+	JR	Z,PUTBOT

+;

+	CP	'J'		;Ja ->

+	JR	Z,PUTBOT

+;

+	CP	'N'		;Nein ->

+	JR	Z,NOBOT

+;

+;	Falsche Eingabe: nochmal anfragen

+;

+	LD	DE,ILLSTR

+	LD	C,9

+	CALL	BDOS

+;

+	POP	IX

+	POP	BC

+	POP	DE

+	POP	HL

+	JR	ISEDIR

+;

+NOBOT:

+	POP	IX

+	POP	BC

+	POP	DE

+	POP	HL

+	JR	NXVOL

+;

+;	Bootstrap installieren

+;

+

+PUTBOT:

+	XOR	A

+	LD	HL,BOTBUF

+	LD	(HL),A

+	LD	DE,BOTBUF+1

+	LD	B,BOTLNG

+	LD	C,0

+	LDIR			; Bereich loeschen

+

+	LD	HL,BOTBUF	;EUMEL Bootstrap Datei einlesen

+	LD	B,BOTLNG*2	;max. Recordanzahl

+	LD	DE,EUMELFI

+;

+RDLOP:

+	PUSH	BC

+	PUSH	DE

+	LD	C,26

+	EX	DE,HL

+	PUSH	DE

+	CALL	BDOS		;DMA-Adresse setzen

+	POP	HL

+	LD	DE,128		;und hochzaehlen

+	ADD	HL,DE

+	POP	DE

+	PUSH	HL

+	PUSH	DE

+	LD	C,20		;Read sequential

+	CALL	BDOS		;Record lesen

+	POP	DE

+	POP	HL

+	POP	BC

+	CP	1

+	JR	Z,READY

+	DJNZ	RDLOP		;Nicht fertig ->

+;

+;	Bootstrap Lader im Speicher

+;

+READY:

+	POP	IX

+	POP	BC

+	POP	DE

+	POP	HL

+

+	LD	(HL),40H	;EUMEL Bootkennung eintragen

+	LD	(IX+20H),BOTPA1	;EUMEL Bootparameter eintragen

+	LD	(IX+21H),BOTPA2

+	LD	(IX+22H),BOTLNG

+	INC	HL

+	PUSH	HL		;Bootvolume

+;

+	LD	HL,DATAR

+	LD	BC,PARBLK

+	LD	A,1		;Superdirectory schreiben

+	LD	DE,0

+	CALL	HDIO

+;

+;	Bootstrap Lader schreiben

+;

+	LD	HL,BOTBUF	;Datenbereich

+	LD	DE,0		;Blocknummer

+;

+WRLOP:

+	POP	BC

+	PUSH	BC

+	PUSH	DE

+	PUSH	HL

+	LD	A,1

+	CALL	HDIO

+;

+	JP	NZ,HDIOER

+;

+	POP	HL

+	LD	DE,512		;Adresse hochzaehlen

+	ADD	HL,DE

+	POP	DE

+	INC	DE

+	LD	A,E

+	CP	BOTLNG/2	;fertig ?

+	JR	NZ,WRLOP	;Nein ->

+;

+	POP	BC

+	LD	DE,RDYSTR

+	LD	C,9

+	CALL	BDOS

+	JP	0

+;

+;****************************************************************

+;

+EUMELFI:

+	DEFB	0		;auf Default Drive

+	DEFM	'EUMEL   COM'

+	DEFB	0,0,0,0,0

+	DEFB	0,0,0,0,0,0,0,0

+	DEFB	0,0,0,0,0,0,0,0,0

+;

+PARBLK:

+	DEFB	0,0,2,0

+;

+TESTRD:

+	DEFB	0,0,0,0,0,0	;Test Ready

+;

+	DEFS	200

+STACK:	DEFW	0

+;

+DATAR:	DEFS	512

+;

+BOTBUF:

+;

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB b/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB
new file mode 100644
index 0000000..b9736c7
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB
@@ -0,0 +1,2 @@
+SLR EBOOT

+L80 /P:0100, START, SCSI, EBOOT, EBOOT/N/E

diff --git a/system/shard-z80-ruc-64180/1.5/src/EINST.COM b/system/shard-z80-ruc-64180/1.5/src/EINST.COM
new file mode 100644
index 0000000..1fdd334
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EINST.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/EINST.PAS b/system/shard-z80-ruc-64180/1.5/src/EINST.PAS
new file mode 100644
index 0000000..312069f
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EINST.PAS
@@ -0,0 +1,509 @@
+PROGRAM installieren_des_eumel_shards ;

+{$U-}

+

+CONST vers        = '2.1 vom 22.01.87' ;

+      shard_file  = 'EUMEL.COM' ;

+      floppy_boot_file = 'FBOOT.COM' ;

+      conf_offset = $37 ;  { Anfang ohne LOAD-Modul (phys.-Adr $00000) }

+

+{ 2.1: 22.01.87 mit Pascal SCSI-Routinen & Konfiguration }

+

+{$I SCSI.PAS}

+

+TYPE SECTOR   = ARRAY[0..255] OF BYTE ;

+

+     FLAGTYPE = SET OF (x0, x1, x2, x3, autoboot, curvol, b64180, b6502) ;

+

+     IDTYPE   = (free, ucsd, dos, cpm, prodos, id5, eumel, id7,

+                 id8, id9, id10, id11, id12, id13, id14, spare) ;

+

+     STRING15 = STRING[15] ;

+

+     LUN      = RECORD

+                 drive, high, low : BYTE

+                END ;

+

+     DISKENTRYTYPE = RECORD

+               entrylength : BYTE ;

+               first_block : LUN ;

+               reserved    : BYTE ;

+               last_block  : LUN ;  { exclusiv }

+               params      : ARRAY [0..7] OF BYTE ;

+               name        : STRING15 ;

+               volumes     : BYTE ; { Anzahl Volumes }

+               autoboot    : CHAR ; { Volumekennzeichen fuer Autoboot }

+               waittime    : INTEGER ; { Wartezeit vor Autoboot in 1.46ms }

+              END ;

+

+     VOLUMEENTRYTYPE = RECORD

+               flags : FLAGTYPE ;

+               first : LUN ;

+               kz    : CHAR ; { Kennzeichen in der VOLTAB }

+               last  : LUN ; { Letzer Block exclusiv }

+               params: ARRAY[0..7] OF BYTE ;

+               name  : STRING15 ;

+               loadpage : BYTE ; { Highbyte Ladeadresse im 6502-Memory }

+               jumppage : BYTE ; { Highbyte Startadresse im 6502-Memory }

+               pages : BYTE ; { Anzahl zu ladender Seiten }

+               volid : IDTYPE ;

+              END ;

+

+VAR f          : FILE ;

+    floppy_version : BOOLEAN ;

+    shard_size, volume : INTEGER ;

+    volume_name, scsi_floppy : STRING15 ;

+    buffer     : ARRAY[0..$3F] OF SECTOR ;

+    boot_buffer: ARRAY[0..15] OF SECTOR ;

+    conf       : RECORD

+                  offset  : ARRAY[1..conf_offset] OF BYTE ;

+                  umsch   : ARRAY[1..8] OF BYTE ;

+                  blinkp  : BYTE ;    { Cursor Blinkfrequenz in 50ms }

+                  beepfreq: BYTE ;    { Kanal 1: Beepfrequenz }

+                  arc31   : LUN ;     { SCSI-Floppy LUN }

+                  mode    : INTEGER ; { EUMEL-MODE-Word }

+                  id4     : INTEGER ; { Lizenznummer des SHards }

+                  id5     : INTEGER ; { Installationsnummer des SHards }

+                  id6     : INTEGER ; { Reserviert fuer SHard }

+                  urlk1   : BYTE ;    { Primaerer Urladerkanal }

+                  urlk2   : BYTE ;    { Sekundaerer Urladerkanal }

+                  free    : BYTE ;

+                  irqvecs : ARRAY[1..$40] OF BYTE ; { Interruptvektoren }

+                  ikantab : ARRAY[0..7] OF BYTE ;   { phys. --> log. Kanalnr. }

+                  kantab  : ARRAY[0..32] OF BYTE ;  { log. --> phys. Kanalnr. }

+                  ioftb   : ARRAY[0..31] OF BYTE ;  { 'typ'-Bits der Kanaele }

+                  cpmofs  : LUN ; { LUN & Anfangs-Adr. eines CP/M-Volumes }

+                  cpmlast : LUN ; { LUN & Endadr. (excl.) eines CP/M-Volumes }

+                 END ABSOLUTE buffer ;

+

+    superdirectory :

+                 RECORD

+                  diskentry   : DISKENTRYTYPE ;

+                  volumeentry : ARRAY[1..26] OF VOLUMEENTRYTYPE ;

+                 END ;

+

+

+

+PROCEDURE errorstop (message : STRING77) ;

+ BEGIN

+  writeln ;

+  writeln (#7, 'FEHLER: ', message) ;

+  halt

+ END { errorstop } ;

+

+

+FUNCTION yes (question : STRING77) : BOOLEAN ;

+ VAR zeichen : CHAR ;

+ CONST answer : SET OF CHAR = ['y', 'Y', 'n', 'N', 'j', 'J'] ;

+ BEGIN

+  WHILE keypressed DO read (KBD, zeichen) ; { empty buffer }

+  write (question, ' (j/n) ? ') ;

+  REPEAT

+   read (KBD, zeichen) ;

+   IF zeichen = #27 THEN errorstop ('Abbruch mit ESC') ;

+   IF NOT (zeichen IN answer)

+      THEN write (#7)

+      ELSE writeln (zeichen)

+  UNTIL zeichen IN answer ;

+  yes := zeichen IN ['y', 'Y', 'j', 'J']

+ END { yes } ;

+

+

+FUNCTION txt (nr : INTEGER) : STRING15 ;

+ VAR result : STRING15 ;

+ BEGIN

+  str (nr, result) ;

+  txt := result

+ END { txt } ;

+

+

+PROCEDURE shard_lesen ;

+ BEGIN

+  fillchar (buffer, sizeof (buffer), 0) ;

+  assign (f, shard_file) ;

+  reset (f) ;

+  shard_size := filesize (f) ;

+  blockread (f, buffer, shard_size) ;

+  close (f) ;

+  IF (shard_size < 3) OR (shard_size > 2 * $3F)

+     THEN errorstop ('Die Datei ' + shard_file + ' ist inkonsistent!')

+ END { shard_lesen } ;

+

+

+PROCEDURE shard_schreiben ;

+ VAR eumel_track : INTEGER ;

+ BEGIN

+  WITH superdirectory.volumeentry[volume].first DO BEGIN

+   eumel_track := low DIV 32 + high * 8 + (drive AND $3F) * 2048

+  END ;

+  hd_write (buffer, eumel_track * 32, 32) ;

+  hd_write (buffer[32], succ (eumel_track) * 32, 32)

+ END { shard_schreiben } ;

+

+

+PROCEDURE eumel_volume_suchen ;

+ VAR name : STRING[255] ;

+ BEGIN

+  volume := 1 ;

+  WITH superdirectory DO BEGIN

+

+    WHILE volume <= diskentry.volumes DO BEGIN

+      IF volumeentry[volume].volid = eumel

+         THEN IF yes ('SHard auf Volume "' + volumeentry[volume].name +

+                      '" installieren')

+                 THEN exit ;

+      volume := succ (volume) ;

+    END { WHILE } ;

+    writeln ('Kein (weiteres) EUMEL-Volume gefunden.') ;

+

+    IF yes ('Soll ein anderes Volume zu einem EUMEL-Volume werden')

+       THEN BEGIN

+         volume := 1 ;

+         WHILE volume <= diskentry.volumes DO BEGIN

+           IF volumeentry[volume].volid <> spare

+              THEN IF yes ('SHard auf Volume "' + volumeentry[volume].name +

+                           '" installieren')

+                      THEN BEGIN

+                        IF yes ('Volumename aendern')

+                           THEN BEGIN

+                             write ('Neuer Volumename: ') ;

+                             REPEAT

+                               readln (name) ;

+                               IF length (name) > 15

+                                  THEN writeln ('Zu lang!')

+                             UNTIL (name <> '') AND (length (name) < 16) ;

+                             volumeentry[volume].name := name ;

+                        END ;

+                        exit ;

+                   END ;

+           volume := succ (volume)

+         END { WHILE } ;

+         writeln ('Kein (weiteres) Volume gefunden.') ;

+    END { IF } ;

+    writeln ('Installation abgebrochen.') ;

+    halt

+

+  END { WITH }

+ END { eumel_volume_suchen } ;

+

+

+PROCEDURE superdirectory_lesen ;

+ BEGIN

+  hd_read (superdirectory, 2, 4) ;

+ END { superdirectory_lesen } ;

+

+

+PROCEDURE superdirectory_schreiben ;

+ BEGIN

+  WITH superdirectory.volumeentry[volume] DO BEGIN

+   flags := [b64180] ; (* Boot in 64180-Code geschrieben *)

+   loadpage := $10 ;

+   jumppage := loadpage ;

+   pages    := $3F ; (* Da $40 nicht geht (Timeout auf Cylindergrenze) *)

+   volid    := eumel ;

+  END ;

+

+  hd_write (superdirectory, 2, 4)

+ END { superdirectory_schreiben } ;

+

+

+FUNCTION sector_write (trk, sec, adr : INTEGER) : BOOLEAN ;

+BEGIN

+  bios (9, trk) ;

+  bios (10, sec) ;

+  bios (11, adr) ;

+  sector_write := (bios (13, 0) = 0) ;

+END ;

+

+

+PROCEDURE shard_auf_floppy_schreiben ;

+ VAR trk, sec, curdrv, drive : INTEGER ;

+     zeichen : CHAR ;

+ BEGIN

+  fillchar (boot_buffer, sizeof (boot_buffer), 0) ;

+  assign (f, floppy_boot_file) ;

+  reset (f) ;

+  blockread (f, boot_buffer, filesize (f)) ; { max. 4k Boot }

+  close (f) ;

+

+  boot_buffer[0][$FF] := 0 ;

+  WHILE boot_buffer[0][$FF] = 0 DO BEGIN

+        IF yes ('2 * 80 Track (Erphi) Format') THEN boot_buffer[0][$FF] := $E0

+   ELSE IF yes ('1 * 35 Track (Apple) Format') THEN boot_buffer[0][$FF] := $81

+   ELSE IF yes ('2 * 80 Track (Ehring) Format')THEN boot_buffer[0][$FF] := $A0 ;

+  END ;

+

+  curdrv := bdos (25, 0) ; { current_drive }

+  drive := curdrv ;

+

+  write ('Floppy-Drive (Abbruch mit ESC): ', chr (drive + 65), #8) ;

+  REPEAT

+   read (KBD, zeichen) ;

+   IF zeichen = #27

+      THEN errorstop ('Abbruch mit ESC') ;

+   zeichen := upcase (zeichen) ;

+   IF NOT (zeichen IN ['A'..'P'])

+      THEN write (#7)

+      ELSE writeln (zeichen)

+  UNTIL zeichen IN ['A'..'P'] ;

+  drive := ord (zeichen) - 65 ;

+

+  IF drive = curdrv

+     THEN REPEAT UNTIL yes ('(Leere) Destinationdiskette eingelegt') ;

+

+  writeln ;

+  bios (8, drive) ; { Select Floppy Drive }

+

+  FOR sec := 0 TO 15 DO  { Floppy-Boot/Taskloop schreiben }

+   IF NOT sector_write (0, sec, addr (boot_buffer [sec]))

+      THEN BEGIN

+            bios (8, curdrv) ;

+            errorstop ('Schreibfehler auf Drive ' + zeichen +

+                       ':, Track 0, Sektor ' + txt (sec))

+           END ;

+  FOR trk := 1 TO 4 DO  { SHard schreiben }

+   FOR sec := 0 TO 15 DO

+    IF NOT sector_write (trk, sec, addr (buffer [sec + pred(trk) * 16]))

+       THEN BEGIN

+             bios (8, curdrv) ;

+             errorstop ('Schreibfehler auf Drive ' + zeichen + ':, Track ' +

+                        txt (trk) + ', Sektor ' + txt (sec))

+            END ;

+

+  bios (8, curdrv) ; { Select previous Drive }

+

+ END ;

+

+

+PROCEDURE cpm_volume_suchen ;

+ BEGIN

+  WITH superdirectory DO BEGIN

+   REPEAT

+    volume := 1 ;

+    WHILE volume < diskentry.volumes DO BEGIN

+     IF volumeentry[volume].volid = cpm

+        THEN IF yes (volumeentry[volume].name)

+                THEN exit ;

+     volume := succ (volume) ;

+    END

+   UNTIL yes ('Kein (weiteres) Volume gefunden, erstes Volume nehmen') ;

+   volume := 1 ;

+   writeln ('Volume "', volumeentry[volume].name, '" wird angenommen.') ;

+  END

+END { cpm_volume_suchen } ;

+

+

+PROCEDURE kanalzuordnungen ;

+ VAR i, j, channel : INTEGER ;

+     ok : BOOLEAN ;

+

+FUNCTION kanal_erfragen (log : INTEGER) : INTEGER ;

+ VAR channel : INTEGER ;

+ BEGIN

+  REPEAT

+   channel := 255 ;

+   write (' ':77, #13) ;

+   write ('Logischer Kanal ', log:2, ' ---> physischer Kanal: -'#8) ;

+   buflen := 2 ;

+   read (channel) ;

+   write (#13) ;

+  UNTIL ((channel >= 0) AND (channel < 7)) OR

+        ((channel >= 28) AND (channel < 32)) OR

+        (channel = 255) ;

+  kanal_erfragen := channel

+ END ;

+

+PROCEDURE message (msg : STRING77) ;

+ VAR zeichen : CHAR ;

+ BEGIN

+  write (#13, ' ', msg, ' - Taste -'#13) ;

+  read (KBD, zeichen)

+ END { message } ;

+

+ BEGIN { kanalzuordnungen }

+  REPEAT

+  clrscr ;

+  writeln ('--- Zuordnung der logischen/physischen Kanaele ---') ;

+  writeln ;

+  writeln ('Den logischen Kanaelen werden physische Kanaele zugeordnet,') ;

+  writeln ('dabei sind folgende Einschraenkungen zu beachten:') ;

+  writeln ('- Kanal 0 und 31 muessen als Blockkanal definiert werden.') ;

+  writeln ('- Kanal 1 muss als Streamkanal definiert werden (Systemstart).') ;

+  writeln ('- Kein physischer Kanal darf mehrfach zugeordnet werden.') ;

+  writeln ;

+  writeln ('Folgende physische Kanaele stehen zur Verfuegung:') ;

+  writeln ;

+  writeln ('Streamkanaele:                     Blockkanaele:') ;

+  writeln ('--------------                     -------------') ;

+  writeln ('1 ... Basis  - Konsole              0 ... SCSI  - Harddisk #0') ;

+  writeln ('2 ... ruc180 - Serielle B         ( 1 ... Basis - Graphikkonsole)') ;

+  writeln ('3 ... ruc180 - Serielle A          28 ... SCSI  - Volume "', volume_name, '"') ;

+  writeln ('4 ... ruc180 - Centronics          29 ... Basis - Diskdrive 1') ;

+  writeln ('5 ... Basis  - Serielle            30 ... Basis - Diskdrive 0') ;

+  writeln ('6 ... Basis  - Centronics          31 ... SCSI  - ', scsi_floppy) ;

+  writeln ;

+  conf.kantab[32] := 32 ; { Parameterkanal }

+  writeln ;

+   FOR i:= 0 TO 31 DO BEGIN

+    REPEAT

+     REPEAT

+      channel := kanal_erfragen (i) ;

+      ok := FALSE ;

+      IF channel = 255

+         THEN IF (i = 0) OR (i = 1) OR (i = 31)

+                 THEN message ('Kanal 0, 1 und 31 muessen definiert werden!')

+                 ELSE ok := TRUE

+         ELSE IF ((i = 0) OR (i = 31)) AND

+                 ((conf.ioftb[channel] AND 12) <> 12)

+                 THEN message ('Kanal ' + txt (i) + ' muss ein Blockkanal (0, 28..31) sein!')

+                 ELSE IF (i = 1) AND ((conf.ioftb[channel] AND 3) <> 3)

+                         THEN message ('Kanal 1 muss ein Stream I/O-Kanal sein!')

+                         ELSE ok := TRUE

+     UNTIL ok ;

+     IF channel <> 255

+        THEN BEGIN

+         j := 0 ;

+         WHILE (j < i) AND (conf.kantab[j] <> channel) DO j := succ (j) ;

+         IF j < i

+            THEN message ('Der phys. Kanal ' + txt(channel) +

+                          ' wurde schon dem log. Kanal ' + txt (j) +

+                          ' zugeordnet!') ;

+     END ;

+    UNTIL (j = i) OR (channel = 255) ;

+    conf.kantab[i] := channel ;         { Zuordnung log. --> phys. }

+    IF channel < 7

+       THEN conf.ikantab[channel] := i ; { Zuordnung phys. --> log. }

+   END ;

+

+   clrscr ;

+   writeln ('So sind die physischen Kanaele den logischen Kanaelen zugeordnet:') ;

+   FOR i:= 0 TO 31 DO BEGIN

+    gotoxy (succ ((i DIV 16) * 40), 3 + (i MOD 16)) ;

+    write (i:2, ': ') ;

+    CASE conf.kantab[i] OF

+      0 : write ('SCSI   - Harddisk #0') ;

+      1 : write ('Basis  - Konsole') ;

+      2 : write ('ruc180 - Serielle B') ;

+      3 : write ('ruc180 - Serielle A') ;

+      4 : write ('ruc180 - Centronics') ;

+      5 : write ('Basis  - Serielle') ;

+      6 : write ('Basis  - Centronics') ;

+     28 : write ('SCSI   - Volume "', volume_name, '"') ;

+     29 : write ('Basis  - Diskdrive 1') ;

+     30 : write ('Basis  - Diskdrive 0') ;

+     31 : write ('SCSI   - ', scsi_floppy) ;

+    255 : write ('       -')

+    END { CASE } ;

+   END ;

+   writeln ;

+   writeln ;

+

+  UNTIL yes ('Alle Kanal-Zuordnungen korrekt') ;

+END { kanalzuordnungen } ;

+

+

+PROCEDURE konfigurieren ;

+ VAR freq : REAL ;

+ BEGIN

+  writeln ;

+  writeln ('************************* Systemstart - Parameter ************************') ;

+  writeln ;

+

+  IF yes ('EUMEL-Vortest beim Systemstart')

+     THEN IF NOT yes ('Speichertest durchfuehren')

+             THEN conf.mode := $0100

+             ELSE conf.mode := 0

+     ELSE conf.mode := $0200 ;

+  writeln ;

+

+  conf.urlk1 := 31 ;

+  conf.urlk2 := 0 ;

+  IF NOT yes ('Soll der Urlader zuerst auf dem Archivkanal gesucht werden')

+     THEN BEGIN

+      conf.urlk1 := 0 ;

+      conf.urlk2 := 31

+  END ;

+  writeln ;

+

+  writeln ('**************** Parameter der Konsole (phys. Kanal 1) ******************') ;

+  writeln ;

+

+  freq := conf.blinkp * 0.1 ;

+  write ('Cursor Blinkperiode (s)  : ', freq:2:1, #8#8#8#8) ;

+  REPEAT

+    readln (freq)

+  UNTIL (freq >= 0.05) AND (freq <= 25.5) ;

+  conf.blinkp := round (freq * 10.0) ;

+  writeln ;

+

+  freq := int (5000.0/conf.beepfreq + 0.5) ;

+  write ('Tonfrequenz bei Bell (Hz): ', freq:4:0, #8#8#8#8) ;

+  REPEAT

+    readln (freq)

+  UNTIL freq >= 1.0 ;

+  conf.beepfreq := round (5000.0/freq) ;

+  writeln ;

+

+  IF NOT floppy_version

+     THEN BEGIN

+      writeln ('********** Parameter fuer Harddisk-Volume (phys. Kanal 28) **************') ;

+      writeln ;

+

+      writeln ('Welches CP/M-Volume soll angesprochen werden ?') ;

+      cpm_volume_suchen ;

+      conf.cpmofs  := superdirectory.volumeentry[volume].first ;

+      conf.cpmlast := superdirectory.volumeentry[volume].last ;

+      volume_name  := superdirectory.volumeentry[volume].name ;

+     END

+  ELSE volume_name := '(1. Volume)' ;

+

+  writeln ;

+  writeln ('************* Parameter fuer SCSI-Floppy (phys. Kanal 31) ****************') ;

+  writeln ;

+  conf.arc31.drive := $60 ;

+  scsi_floppy := 'Floppy #1' ;

+  IF yes ('SCSI-Floppy #0 statt SCSI-Floppy #1')

+     THEN BEGIN

+       conf.arc31.drive := $40 ;

+       scsi_floppy := 'Floppy #0'

+  END ;

+

+  writeln ;

+  IF yes ('Zuordnung der logischen/physischen Kanaele aendern')

+     THEN kanalzuordnungen ;

+

+  writeln ;

+  writeln ;

+ END { konfigurieren } ;

+

+

+BEGIN { MAIN }

+ clrscr ;

+ writeln ('                            EUMEL-SHard Installation') ;

+ writeln ('                            Version ', vers) ;

+ writeln ('                            (c) M. Staubermann (ruc)') ;

+ writeln ;

+ writeln ;

+

+ IF yes ('SHard auf der Harddisk installieren')

+    THEN BEGIN

+     floppy_version := FALSE ;

+     shard_lesen ;

+     superdirectory_lesen ;

+     IF yes ('SHard-Defaults aendern')

+        THEN konfigurieren ;

+     eumel_volume_suchen ;

+     shard_schreiben ;

+     superdirectory_schreiben ;

+     writeln ('SHard erfolgreich auf Harddisk installiert.')

+    END

+ ELSE IF yes ('SHard auf einer (CP/M-)Floppy installieren')

+    THEN BEGIN

+     floppy_version := TRUE ;

+     shard_lesen ;

+     IF yes ('SHard-Defaults aendern')

+        THEN konfigurieren ;

+     shard_auf_floppy_schreiben ;

+     writeln ('SHard erfolgreich auf Floppy installiert.')

+    END

+ ELSE writeln ('Kein SHard installiert.')

+END.

diff --git a/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM b/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM
new file mode 100644
index 0000000..3d0a00c
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM b/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM
new file mode 100644
index 0000000..6cddfa2
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC b/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC
new file mode 100644
index 0000000..d8c9a82
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC
@@ -0,0 +1,713 @@
+

+;---------------------------------------------------------------------------

+;

+;	SHard 1.8.0 - Schneller Boot von Floppy

+;	===========

+;

+;	(C) Copyright 1987, Michael Staubermann (ruc)

+;

+;	Version 0.2, 22.01.87

+;

+;---------------------------------------------------------------------------

+;

+		.6502

+		.RADIX	16

+		SUBTTL	Floppyboot

+

+slot      equ      6

+load_sec  equ	   $C65C

+p_data    equ      27

+sector    equ      3D

+ROM       equ      slot*100+0C000

+

+vpoint		EQU	$10		; Zeigt auf Volumetabelle

+VOLTAB		EQU	$B800

+

+DMA       equ	50		; 50..6F

+sec_tble  equ	70		; 70..7F

+task	  equ	80		; 80

+param	  equ	81

+def_byte  equ	82

+disk_no   equ	83

+iob_trk   equ	84

+sec_cnt   equ	85

+iob_err   equ	86

+

+; work space

+

+wait_Cnt   equ	87

+user_data equ	89

+dest_phase equ	8B

+chk_in_hdr equ	8C

+sec_in_hdr equ	8D

+trk_in_hdr equ	8E

+vol_in_hdr equ	8F

+slot10z   equ	90          ; slot #: s0

+iob_drv   equ	91

+phase     equ	92

+iob_sec   equ	93

+chk_sum   equ	94

+temp2     equ	95

+head_pos  equ	96

+tktry_cnt equ	97

+hdtry_cnt equ	98

+recal_cnt equ	99

+

+; Floppy Hardware

+

+phase0    equ      0C080

+phase1    equ      0C082

+phase2    equ      0C084

+phase3    equ      0C086

+mtroff    equ      0C088

+mtron     equ      0C089

+drive0    equ      0C08A

+Q6off     equ      0C08C

+Q6on      equ      0C08D

+Rstate    equ      0C08E

+Wstate    equ      0C08F

+

+bit_z     equ      24

+

+fast_step equ	$0E	; etwas weniger als 3 ms Track-Wechselzeit

+

+start180	EQU	$C087		; 64180 startet bei 0000

+

+;----------------------------------------------------------------------------

+

+pagerr	  macro	    adr

+	  if high(*-start) ne high(adr-start)

+	  .printx 'Page-Error'

+	  endif

+	  endm

+

+		.phase 0800

+

+start:

+nible1:

+

+		DB	0		; Nur einen Sektor

+		cpx	#60

+		beq	slotok

+		jmp	booterr

+slotok:

+		lda	sector

+		cmp	#8		; Alle Sektoren gewesen ?

+		beq	loader

+		cmp	#$0F

+		bne	next_sec

+		lda	#8

+		sta	p_data

+		lda	#0

+		sta	sector		; Mit Sektor 1 nach 0900 weiter

+next_sec:

+		inc	p_data

+		inc	sector

+		jmp	load_sec	; Sector laden und --> 0801 springen

+

+loader:

+		lda	$03F3

+		sta	$03F4		; Reboot

+

+		lda	def

+		sta	def_byte

+

+		jmp	load_shard

+

+booterr:

+		jsr	$FE84

+		jsr	$FB2F

+		jsr	$FE93

+		jsr	$FE89

+		jsr	$FC58		; Init Video, KBD, CLRSCR...

+		ldy	#0

+err1:		lda	errtxt,y

+		eor	#$80

+		jsr	$FDED		; Auf Bildschirm ausgeben

+		iny

+		cmp	#$8D		; RETURN als Abschluss

+		bne	err1

+		jmp	$FF65		; Sprung in Monitor

+		

+

+errtxt:		DB	'Boot error!', 0D

+

+

+          ds        $FF-(*-start)

+

+def:	  db	    $E0

+

+ 	  include NIBLE.INC

+

+write_data

+          SEC

+          LDA       Q6on,X

+          LDA       Rstate,X

+          BMI       wrdat99

+          LDA       nible2

+          STA       temp2

+          LDA       #0FF

+          STA       Wstate,X    ;  5

+          ORA       Q6off,X     ;  4

+          PHA                   ;  3

+          PLA                   ;  4     [sta..sta[

+          NOP                   ;  2

+          LDY       #04         ;  2

+wrdat1    PHA                   ;  3             3

+          PLA                   ;  4             4

+          JSR       wrt_nibl1   ;+13        15  13

+          DEY                   ;---         2

+          BNE       wrdat1      ; 40       + 3

+                                ;          --- ---

+                                ;           20+ 20 = 40

+

+	  pagerr    wrdat1

+

+                                ;           -1

+          LDA       #0D5        ;            2

+          JSR       wrt_nibl     ; 15       +15

+          LDA       #0AA        ;  2       ---

+          JSR       wrt_nibl     ;+15        36

+          LDA       #0AD        ;---

+          JSR       wrt_nibl     ; 32        15

+          TYA                   ;            2

+          LDY       #56         ;            2

+wrdat11   BNE       wrdat3      ;            3

+wrdat2    LDA       nible2,Y    ;            0    4

+wrdat3    EOR       nible2-1,Y  ;            5    5

+          TAX                   ;            2    2

+          LDA       to_nibble,X ;            4    4

+          LDX       slot10z     ;            3    3

+                                       ;   ---  ---

+                                       ;    36   18

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          DEY                          ;     2

+          BNE       wrdat2             ;     3

+                                       ;   ---

+                                       ;    14 + 18 = 32

+                                       ;    -1

+          LDA       temp2              ;     3

+          NOP                          ;     2

+wrdat4    EOR       nible1,Y           ;     4    4

+          TAX                          ;     2    2

+          LDA       to_nibble,X        ;     4    4

+          LDX       slot10             ;     4    4

+                                       ;   ---  ---

+                                       ;    32   14

+

+          STA       Q6on,X             ;     5

+          LDA       Q6off,X            ;     4

+          LDA       nible1,Y           ;     4

+          INY                          ;     2

+          BNE       wrdat4             ;     3

+                                       ;   ---

+                                       ;    18+ 14 = 32

+

+	  pagerr	    wrdat11

+

+          TAX                          ;     2

+          LDA       to_nibble,X        ;     4

+          LDX       slot10z            ;     3

+          JSR       wrt_nibl2          ;     6  15

+          LDA       #0DE               ;   ---   2

+          JSR       wrt_nibl            ;    32  15

+          LDA       #0AA               ;       ---

+          JSR       wrt_nibl            ;        32

+          LDA       #0EB

+          JSR       wrt_nibl

+          LDA       #0FF

+          JSR       wrt_nibl

+          LDA       Rstate,X

+wrdat99

+          LDA       Q6off,X

+wrdat999

+	  dey

+	  bne	   wrdat999		; PostErase-Delay 1 ms

+

+          RTS

+

+read_hdr

+          sei

+          LDY       #0FC

+          STY       temp2

+rdhdr0

+          INY

+          BNE       rdhdr1

+          INC       temp2

+          BEQ       fail

+rdhdr1

+          LDA       Q6off,X

+          BPL       rdhdr1

+rdhdr11   CMP       #0D5

+          BNE       rdhdr0

+

+          NOP

+rdhdr2    LDA       Q6off,X

+          BPL       rdhdr2

+          CMP       #0AA

+          BNE       rdhdr11

+

+          LDY       #03

+rdhdr3    LDA       Q6off,X

+          BPL       rdhdr3

+          CMP       #96

+          BNE       rdhdr11

+          

+	  pagerr    rdhdr1

+

+          

+          LDA       #00

+nxthByte  STA       chk_sum

+rdhdr4    LDA       Q6off,X

+          BPL       rdhdr4

+	  ROL	    A

+          STA       temp2

+rdhdr5    LDA       Q6off,X

+          BPL       rdhdr5

+          AND       temp2

+          STA       chk_in_hdr,Y

+          EOR       chk_sum

+          DEY

+          BPL       nxthbyte

+

+          TAY

+          BNE       fail

+

+rdhdr6    LDA       Q6off,X

+          bpl       rdhdr6

+          cmp       #0DE

+          BNE       fail

+

+          NOP

+rdhdr7    LDA       Q6off,X

+          BPL       rdhdr7

+          CMP       #0AA

+          BNE       fail

+

+          CLC

+          RTS

+fail

+          SEC

+          RTS

+

+moving

+          LDY       #0

+mov0      LDA       Q6off,X

+	  JSR	    mov1

+	  PHA			;  3

+ 	  PLA			;  4

+	  CMP	    Q6off,X	;  4

+	  BNE	    mov1	;----

+	  DEY			; 21 uS

+	  BNE	    mov0

+mov1	  RTS

+

+

+read_data

+	  TXA

+	  ORA	    #8C

+	  STA	    ld1+1

+	  STA	    ld2+1

+	  STA	    ld3+1

+	  STA	    ld4+1

+	  STA	    ld5+1

+	  LDA	    user_data

+	  LDY	    user_data+1

+	  STA	    st5+1

+	  STY	    st5+2

+	  SEC

+	  SBC	    #54

+	  BCS	    rddat1

+	  DEY

+	  SEC

+rddat1

+	  STA	    st3+1

+	  STY	    st3+2

+          SBC       #57

+          BCS       rddat2

+          DEY

+rddat2

+          STA       st2+1

+          STY       st2+2

+

+          LDY       #20

+nxt_begin

+          DEY

+          BEQ       fail

+wait_begin

+waitb0    LDA       Q6off,X

+          BPL       waitb0

+waitb00   EOR       #0D5

+          BNE       nxt_begin

+          NOP

+waitb1    LDA       Q6off,X

+          BPL       waitb1

+          CMP       #0AA

+          BNE       waitb00

+          NOP

+waitb2    LDA       Q6off,X

+          BPL       waitb2

+          CMP       #0AD

+          BNE       waitb00

+

+          LDY       #0AA

+          LDA       #0

+rloop1    STA       temp2

+ld1       LDX       Q6off+60  ; addr modified by read init !

+          BPL       ld1

+          LDA       to_bits-96,X

+          STA       nible2-0AA,Y

+          EOR       temp2

+          INY

+          BNE       rloop1

+          

+;

+; read nible from disk and convert to user data

+;

+          LDY       #0AA

+          BNE       ld2

+rloop2

+st2       STA       1000,Y

+ld2       LDX       Q6off+60  ; modified by read init

+          BPL       ld2

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+0,X

+          INY

+          BNE       rloop2

+

+          PHA

+          AND       #0FC

+          LDY       #0AA

+ld3       LDX       Q6off+60  ; modified by read init

+          BPL       ld3

+          EOR       to_bits-96,X

+          LDX       nible2-0AA,Y

+          EOR       to_bytes+1,X

+st3       STA       1000,Y

+          INY

+          BNE       ld3

+

+ld4       LDX       Q6off+60  ; modified by read init

+          BPL       ld4

+          AND       #0FC

+          LDY       #0AC

+rloop5    EOR       to_bits-96,X

+          LDX       nible2-0AC,Y

+          EOR       to_bytes+2,X

+st5       STA       1000,Y

+ld5       LDX       Q6off+60  ; modified by read init

+          BPL       ld5

+          INY

+          BNE       rloop5

+          AND       #0FC

+          EOR       to_bits-96,X

+          LDX       slot10z

+          TAY

+          BNE       chk_fail

+rloop6    LDA       Q6off,X

+          BPL       rloop6

+          CMP       #0DE

+          BEQ       read_ok

+

+          pagerr      wait_begin

+chk_fail

+          SEC

+          db     bit_z

+read_ok

+          clc

+          PLA

+          LDY       #55

+          STA       (user_data),Y

+          RTS

+

+seekT	  lda	    iob_trk          

+seekL

+	  jsr	    trk_to_ph

+          cmp       phase0,X

+          cmp       phase1,X

+          cmp       phase2,X

+          cmp       phase3,X

+          LDY       disk_no

+          LDA       head_table,y	; da steht der Kopf jetzt

+          STA       head_pos

+	  lda	    dest_phase

+	  sta	    head_table,y	; da soll er nachher stehen

+          

+seekH

+          cmp       head_pos

+          BEQ       seek_rts

+          LDA       #0

+          STA       temp2

+seekh0    LDA       head_pos

+          STA       phase

+          SEC

+          SBC       dest_phase

+          BEQ       seekh5

+          BCS       seekh1

+          EOR       #0FF

+          INC       head_pos

+          BCC       seekh2

+seekh1    ADC       #0FE

+          DEC       head_pos

+seekh2    CMP       temp2

+          BCC       seekh3

+          LDA       temp2

+seekh3    CMP       #8

+          BCS       seekh4

+          TAY

+seekh4    SEC

+          JSR       step

+          LDA       time0,Y

+          JSR       step_wait

+          LDA       phase

+          CLC

+          JSR       step1

+          LDA       time1,Y

+          JSR       step_wait

+          INC       temp2

+          BNE       seekh0

+

+seekh5    JSR       step_wait

+          CLC

+step      LDA       head_pos

+step1     AND       #3

+          ROL       A

+          ORA       slot10z

+          TAX

+          LDA       phase0,X

+          LDX       slot10z

+seek_rts  RTS

+

+;-------------------------------;

+

+make_nibl

+          LDY       #56

+          LDA       #0

+maken0    STA       nible2-1,Y

+          DEY

+          BNE       maken0

+maken1    LDX       #55

+maken2    LDA       (user_data),Y

+          AND       #0FC

+          STA       nible1,Y

+          EOR       (user_data),Y

+          INY

+          CMP       #02

+          ORA       nible2,X

+          ROR       A

+          ROR       A

+          STA       nible2,X

+          DEX

+          BPL       maken2

+          CPY       #02

+          BNE       maken1

+          RTS

+

+;	ds	10

+          

+Dsk_RW 

+	  ldx	    #0A9	; LDA #xx

+	  lda	    def_byte

+	  and	    #$20	; Bit 5 ?

+	  bne	    rw_0	; Fast Step - use abs. value

+

+				; Slow Step - use MotorOn/Off-Tables

+	  ldx	    #0C9	; CMP #xx

+rw_0:	  stx	    step_wait

+	

+	  lda	    #fast_step	; Set Step Rate

+	  bit	    def_byte

+	  bmi	    rw_1	; Bit7: Controller-Typ

+				; Bit7=0 => Ehring

+	  lsr	    a		; bei Ehring 2-fache Phases => halbe Steprate

+

+rw_1:	  sta	    step_wait+1		; Steprate

+

+          lda       disk_no

+          LSR       A

+          TAY

+          LDA       slotn,Y

+          STA       slot10

+          sta       slot10z

+          adc       #0

+          STA       iob_drv

+          

+ 	  include TRACK.INC 

+

+trk_to_ph:			; IN: A = track / OUT: A,dest_phase = phase

+	sta	dest_phase

+

+; Select Side 0

+

+	bit	def_byte	; Bit7: 1=Erphi-Controller

+				; Bit6: 1=Erphi-Format

+

+	bvc	ehring_format	; Bit6 = 0 => Ehring-Format

+

+	lsr	dest_phase	; Erphi-Format

+	bcc	side0

+

+; Select Side 1

+; Erphi:  mtroff, Q6on, mtron

+; Ehring: mtroff,mtron

+

+side1:	lda	mtroff,x

+	bit	def_byte

+	bpl	side1_2

+				; Erphi-Side-1-Select

+	lda	Q6on,x

+side1_2:

+	lda	mtron,x

+	jmp	ph_mult

+

+ehring_format:

+	cmp	#$50		; Track >= 80 ?

+	bcc	side0		; nein: Select Side 0

+

+	sbc	#$50

+	sta	dest_phase

+	jmp	side1

+

+; Select Side 0

+; Ehring: lda cn00,x

+; Erphi : mtroff, Q6off, mtron

+

+side0:	bit	def_byte

+	bmi	erphi_s0	; Bit7 = 1 => Erphi-Controller

+

+	txa			; Ehring-Side-0-Select

+	lsr	a

+	lsr	a

+	lsr	a

+	lsr	a

+	ora	#$C0

+	sta	ehr_sel+2

+

+ehr_sel:lda	$C600

+	jmp	ph_mult

+

+erphi_s0:			; Erphi-Side-0-Select

+	cmp	mtroff,x

+	cmp	Q6off,x

+	cmp	mtron,x

+

+ph_mult:

+	lda	def_byte	; Bit 0..1: 0 = 1 Step/Track

+	and	#03		;           1 = 2 Steps/Track

+	tay			;           2 = 4 Steps/Track

+	beq	ph_mult2

+

+ph_mult1:

+	asl	dest_phase

+	dey

+	bne	ph_mult1

+

+ph_mult2:

+	lda	dest_phase

+	rts

+

+load_shard:

+

+load_0:		lda	#$10

+		ldx	#1		; Track 1

+		jsr	loadtrack

+		bne	load_0

+

+load_1:		lda	#$20

+		ldx	#2		; Track 2

+		jsr	loadtrack

+		bne	load_1

+

+load_2:		lda	#$30

+		ldx	#3		; Track 3

+		jsr	loadtrack

+		bne	load_2

+

+load_3:		lda	#$40

+		ldx	#4		; Track 4

+		jsr	loadtrack

+		bne	load_3

+

+

+		lda	#HIGH VOLTAB

+		sta	vpoint+1

+		lda	#LOW VOLTAB

+		sta	vpoint

+		ldx	#8

+loop2:		lda	eumel_vol,x

+		sta	VOLTAB,x

+		dex

+		bpl	loop2

+

+		lda	#$C3

+		sta	0

+		lda	#$00

+		sta	1

+		lda	#$10

+		sta	2		; JP $1000 - 64180

+		lda	#0

+		sta	task

+		sei

+		ldx	#leng1-1

+lp1:

+		lda	codp,x

+		sta	8000,x

+		dex

+		bpl	lp1

+		jmp	8000

+

+codp:

+		ldx	#$70		; Karte in Slot 7

+		stx	$04F8

+		lda	start180,x	; Start 64180

+loop:

+		lda	task

+		cmp	#4

+		bne	loop		; Auf Adress-Task warten

+

+		jmp	(1)		; Neue Taskloop anspringen

+leng1	equ	$-codp

+	

+loadtrack:

+	stx	iob_trk

+	tax

+	dex

+	txa

+	ldx	#0

+	ldy	#0

+boot31:	pha

+	lda	#0

+	sta	sec_tble,y

+	sta	DMA,x

+	pla

+	clc

+	adc	#1

+	sta	DMA+1,x

+	inx

+	inx

+	iny

+	cpy	#10

+	bne	boot31

+;

+;	Steprate einstellen und andere Disk Voreinstellungen

+;          

+	sty	sec_cnt     ; := 10     read track, sector 0..F

+	ldx	#0f

+	stx	iob_err     ; StepRate

+	ldx	#0

+	stx	disk_no  	; :=  0

+        dex

+        stx	param    	; := FF (read)

+	jsr	dsk_rw

+	lda	iob_err

+	rts

+

+

+eumel_vol:

+		40H, 00H, 4AH, 60H, 00H, 00H, 0B3H, 00H, 0FFH

+		; Default, ggf. Aendern

+

+		END

diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM b/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM
new file mode 100644
index 0000000..d3f5a12
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM
@@ -0,0 +1 @@
+

diff --git a/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC b/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC
new file mode 100644
index 0000000..268cdbe
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC
@@ -0,0 +1,1635 @@
+;

+;****************************************************************

+;

+;	EUMEL-SHard Graphikroutinen fuer 6502-Teil.

+;	Anfang: 20.05.86, Michael Staubermann

+;	Version	1.2, Mit Incremental-Fill, dicke Striche, COPY-Modus

+;	Stand:	12.01.87

+;	

+		.printx	'GRAFIK65.MAC'

+

+;----------------------------------------------------------------------------

+;	V A R I A B L E

+;----------------------------------------------------------------------------

+;

+;	Konstante

+

+bit_a		EQU	2C	; Skip 2 Bytes

+

+;	Switches

+

+graphic_mode	EQU	$C050

+text_mode	EQU	$C051

+full_graphics	EQU	$C052

+page_1		EQU	$C054

+hires_mode	EQU	$C057

+lc_00		EQU	$C083

+lc_01		EQU	$C08B

+

+;----------------------------------------------------------------------------

+;

+;	G R A P H I K		Einsprung fuer alle Graphiksubtasks

+;

+;	Eingang:	$81 Subtasknummer

+;				0 = Move (x, y)

+;				1 = Draw (x, y)

+;				2 = Testbit (x, y) --> $81

+;				3 = Control (on/off, bank, page, or/and/xor, 

+;					     patternsource, colour, pattern)

+;				4 = Clear (page)

+;				5 = Fill (muster)

+;				6 = Trans (page a) to (page b)

+;

+;	Ausgang:	$81 (Nur bei Testbit)

+;

+;----------------------------------------------------------------------------

+

+GRAFIK:

+		lda	subtask		; 0 - 6

+		cmp	#7

+		bcc	grafik1

+		rts			; unerlaubt

+

+grafik1:

+		asl	a

+		tax

+		lda	gfunct,x

+		sta	1

+		lda	gfunct+1,x

+		sta	2		; 1/2 Sprungadressen

+		jmp	(1)		; Funktion aurufen

+

+gfunct:

+		dw	gmove, gdraw, gtest, gctrl, gclr, gfill, gtrans

+

+;---------------------------------------------------------------------

+;

+;	G M O V E

+;	Graphikcursor auf Position (x, y) setzen

+;

+;	Eingang: param1 = xpos

+;		 param2 = ypos

+;

+GMOVE:

+		lda	param1

+		sta	xpos		; LOW xpos

+		lda	param1+1

+		sta	xpos+1		; HIGH xpos

+		lda	param2

+		sta	ypos		; LOW ypos

+		lda	param2+1

+		sta	ypos+1		; HIGH ypos

+

+move_x:

+		lda	savepattern

+		sta	pattern

+		lda	savepattern+1

+		sta	pattern+1	; Linetypepattern auf Anfangswert

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G D R A W

+;	Linie zur Position (x, y) zeichen

+;

+;	Eingang: param1 = xpos

+;		 param2 = ypos

+;

+GDRAW:

+	IF 0

+		lda	param1

+		pha			; 'to' Parameter retten

+		lda	param1+1

+		pha

+		lda	param2

+		pha

+		lda	param2+1

+		pha

+	ENDIF

+		jsr	draw		; draw (xpos,ypos TO param1,param2)

+	IF 0

+		pla

+		sta	ypos+1

+		pla

+		sta	ypos

+		pla

+		sta	xpos+1

+		pla

+		sta	xpos

+	ENDIF

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G T E S T

+;	Punkt (x, y) testen

+;

+;	Eingang: param1 = xpos

+;		 param2 = ypos

+;	Ausgang: param = result = Flags

+;

+GTEST:

+		lda	param2+1	; HIGH y

+		bne	ytohigh		; Carry is set

+		lda	param1+1	; HIGH x

+		ldx	param1		; LOW x

+		ldy	param2		; LOW y

+		jsr	calcaddr	; Byteaddresse des Punktes berechnen

+ytohigh:	lda	#$FF		; 255 = Falsche Punktposition

+		bcs	testrts		; Return mit Ergebnis

+		ldy	#00

+		lda	(address),y

+		php			; Farbbit merken

+		and	bitmask,x	; Pixel ausmaskieren

+		beq	testcolor

+		lda	#01		; Bit 0 : Zustand des gesuchten Pixels

+testcolor:	plp

+		bpl	testrts

+		ora	#80		; Bit 7 : Farbe

+testrts:	sta	result

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G C T R L

+;	Verschiede Steuerfunktionen

+;

+;	Eingang: param1 s.u.

+; Steuerbits:

+; 0:	0 = graphik off

+;	1 = graphik on

+; 1:	0 = Sichtbare Seite 0

+;	1 = Sichtbare Seite 1

+; 2:	0 = Bearbeitete Seite 0 (2000..3FFF)

+;	1 = Bearbeitete Seite 1 (4000..5FFF)

+; 3,4:	0 = OR (Setzen)

+;	1 = AND (Loeschen)

+;	2 = XOR (Invertieren)

+;	3 = COPY (kopieren = loeschen/setzen)

+; 5:	0 = Full Graphics display

+;	1 = Mixed Graphics display (4 Zeilen Text)

+; 6:	0 = param2 ist Linetypepattern

+;	1 = savepattern ist Linetypepatt.

+; 7:	0 = Violett

+;	1 = Gelb

+; 8..11 = Strichdicke

+;

+; param2 ist 16Bit Pattern (falls Bit 6 = 0)

+;

+GCTRL:

+		lda	param1		; Steuerbits

+		and	#80		; Bit 7 = Farbe

+		sta	colormask

+

+		lsr	param1		; Bit 0 = Graphik on/off

+		bcs	graphon

+

+		lda	text_mode

+		lda	page_1

+		bcc	bit12

+

+graphon:	lda	graphic_mode

+		lda	hires_mode

+

+		lda	param1		; Bit 2 = Page

+		and	#01

+		tax

+		sta	page_1,x	; Page Select

+

+bit12:		lsr	param1		; Bit 1 ins Carry

+		lsr	param1		; Bit 2 ins Carry

+		bcs	page2sel

+		lda	#20

+		db	bit_a

+page2sel:	lda	#40

+		sta	pagebase

+

+		lda	param1

+		and	#03		; Bit 3,4 = Bitmode

+		sta	bitmode

+		lsr	param1		; Bit 3 ins Carry

+		lsr	param1		; Bit 4 ins Carry

+

+		lda	param1+1

+		and	#0F

+		bne	setthick

+		lda	#1		; Default 0: 1 Strich

+setthick:

+		sta	thick		; Strichdicke in 8..11

+

+		lda	param1		; Bit 5 = full (0) or mixed (1) Graph.

+		and	#01

+		tax

+		sta	full_graphics,x

+		lsr	param1		; Bit 5 ins Carry

+

+		lsr	param1		; Bit 6 ins Carry

+		bcs	saved

+

+		lda	param2		; Parameter 2 (Word) Pattern

+		sta	pattern		; in interne Linepattern kopieren

+		sta	savepattern

+		lda	param2+1

+		sta	pattern+1

+		sta	savepattern+1

+		bcc	ctrlret

+

+saved:

+		lda	pattern		; Internes Savepattern als Workpattern

+		sta	savepattern	; benutzen

+		lda	pattern+1

+		sta	savepattern+1

+

+ctrlret:	rts

+

+;---------------------------------------------------------------------

+;

+;	G C L R 

+;	Graphikseite loeschen, bzw. mit einem Bitmuster fuellen

+;

+;	Eingang: param1 = Seite (0..3)

+;		 param2 = Byte (0..255)

+;

+GCLR:

+		lda	param1

+		jsr	page_addr	; Anfangsaddresse der Page --> A

+					; y := 0

+		sta	address+1

+		sty	address

+		ldx	#20		; 32 Pages

+		lda	param2

+gclr1:

+		sta	(address),y

+		iny

+		bne	gclr1

+		inc	address+1

+		dex

+		bne	gclr1

+		rts

+

+page_addr:

+		and	#3

+		asl	a

+		asl	a

+		asl	a

+		asl	a

+		asl	a

+		adc	#20		; + Offset fuer erste Grafikseite

+		ldy	#0

+		rts

+

+;---------------------------------------------------------------------

+;

+;	G F I L L

+;	Umrandete Flaeche Fuellen

+;

+;	Eingang: param1 = Nummer des Fuellmusters

+;

+GFILL:

+		lda	lc_01

+		lda	lc_01		; Select Page 1 D000..DFFF (Stack)

+		lda	param1

+		jsr	fill

+		lda	lc_00

+		lda	lc_00		; Select Page 0 D000..DFFF (Spooler)

+		rts

+

+

+;---------------------------------------------------------------------

+;

+;	G T R A N S

+;	Graphikseite in eine andere Grafikseite kopieren

+;

+;	Eingang: param1 = 'from'-Page (0..3)

+;		 param2 = 'to'-Page (0..3)

+;

+GTRANS:

+		lda	param1

+		jsr	page_addr

+		sta	address+1		; 'from' - Pagebase

+		sty	address

+

+		lda	param2

+		jsr	page_addr

+		sta	param1+1

+		sty	param			; 'to' - Pagebase

+		ldx	#20			; 32 Pages

+

+gtrans1:

+		lda	(address),y

+		sta	(param1),y

+		iny

+		bne	gtrans1

+		inc	address+1

+		inc	param1+1

+		dex

+		bne	gtrans1

+		rts

+

+;--------------------------------------------------------------------------

+;	Umrandete Graphikflaeche (xpos, ypos) ausfuellen

+;	Musternummer in A

+

+FILL:

+		and	#0F		; 16 Muster a 64 Bit

+		asl	a		; *8 (8 Bytes pro Muster)

+		asl	a

+		asl	a		; Offset auf Muster

+		sta	olderror+1

+		lda	pagebase

+		sta	olderror	; Merken

+		lda	#wrkpage	; Workpage (alter Inhalt geloescht!)

+		sta	pagebase

+		jsr	fill1		; ggf POP Returnaddress

+		lda	olderror

+		sta	pagebase	; restoren

+		rts

+

+fill1:

+		lda	bitmode

+		and	#1

+		sta	creg

+

+

+		lda	#2

+		sta	areg+1		; stackpointer

+		lda	ypos+1

+		bne	fill1d		; Out of Window

+		ldx	xpos

+		stx	xa		; xpos low (fuer Muster)

+		lda	xpos+1

+		sta	xb

+		ldy	ypos

+		sty	ya		; yposlow (fuer Muster)

+		jsr	startxy

+		bcc	fill1c

+fill1d:		rts			; Ausserhalb oder auf Punkt

+

+fill1c:

+		ldx	#wrkpage

+		stx	address+1

+		ldx	olderror	; Echte Seite

+		stx	link+1

+		ldx	#20		; 8k

+		ldy	#0

+		sty	address

+		sty	link

+fill1b:		lda	(link),y	; Echte Seite in Arbeitsseite kopieren

+		sta	(address),y	; Arbeitsseite loeschen

+		iny

+		bne	fill1b

+		inc	address+1

+		inc	link+1

+		dex

+		bne	fill1b

+		lda	xpos+1

+		ldx	xpos

+		ldy	ypos

+		jsr	startxy

+

+fill2:

+		ldy	creg+1		; Byte Offset

+		ldx	breg+1		; Bit Offset

+		jsr	testquick	; Bei (x,y) Punkt gesetzt ?

+		bcc	fill2h		; Punkt gesetzt

+		jsr	poppos

+		jmp	fill2

+					; (x-1, y) testen

+fill2h:		lda	breg+1

+		sta	dx

+		lda	creg+1

+		sta	dx+1

+		lda	xa

+		sta	xa+1		; Save xpos

+		lda	xb

+		sta	xb+1

+

+		lda	xa

+		bne	fill2d2

+		dec	xb

+fill2d2:	dec	xa

+		jsr	decx		; x-1, y bleibt

+		bcs	fill2d

+		jsr	testquick

+		bcc	fill2h

+

+fill2d:		lda	dx		; Altes x wiederherstellen

+		sta	breg+1		; (Der letzte Punkt vorm linken

+		lda	dx+1		; Rand)

+		sta	creg+1

+		lda	xa+1

+		sta	xa

+		lda	xb+1

+		sta	xb

+

+fill4:					; (x, y-1) testen

+		lda	address		; ypos retten

+		sta	dy

+		lda	address+1

+		sta	dy+1

+		lda	breg

+		sta	yb	

+		lda	ya		; ypos low

+		sta	ya+1

+

+		dec	ya

+		jsr	decy		; y-1

+		bcs	fill2a

+		jsr	testquick

+		bcs	fill2a

+		jsr	clrstack	; Hier auch 'pushpos'

+

+fill2a:					; (x, y+1) testen

+		jsr	incy

+		bcs	fill2e

+		jsr	incy

+		bcs	fill2e

+		inc	ya

+		inc	ya

+		jsr	testquick

+		bcs	fill2e

+		jsr	clrstack	; Hier auch 'pushpos'

+fill2e:					; Altes y wiederherstellen

+		lda	dy

+		sta	address		; ypos widerherstellen

+		lda	dy+1

+		sta	address+1

+		lda	yb

+		sta	breg

+		lda	ya+1

+		sta	ya

+

+		jsr	pointquick

+

+		inc	xa

+		bne	fill2g

+		inc	xb

+fill2g:		jsr	incx

+		bcs	fill2i

+		jsr	testquick

+		bcc	fill4		; Punkt bei (x+1, y) ?

+fill2i:		jsr	poppos		; Gerettete x/y Pos vom Stack

+		jmp	fill2		; Damit nochmal (pseudorekursion)

+

+;--------------------------------------------------------------------------

+;	Hilfsroutinen fuer 'GFILL'

+

+testquick:

+		lda	(address),y

+		and	bitmask,x

+		beq	testquick1	; Kein Punkt gesetzt

+		lda	#1

+testquick1:	eor	creg		; umdrehen, falls AND/COPY

+		lsr	a		; SEC/CLC

+		rts

+

+pointquick:

+		lda	ya		; ypos low

+		and	#7

+		ora	olderror+1	; Offset auf Muster

+		tay

+		lda	xa

+		and	#7

+		tax

+		lda	bitmask,x	; xpos Bit

+		and	muster,y	; ypos Byte

+		sta	yb+1		; 0, wenn kein Punkt gesetzt

+

+		ldx	breg+1

+		ldy	creg+1

+		lda	(address),y

+		eor	bitmask,x	; Bei OR loeschen, bei AND setzen!

+		sta	(address),y	; Zum Merken in Workpage

+					; Test, ob auch in echter Seite Punkt

+		lda	yb+1

+		beq	pointquick1	; Nicht mehr in echter Seite setzen

+		lda	address+1

+		pha

+		and	#$1F		; Nur 8k Bits

+		ora	olderror	; Echte pagebase

+		sta	address+1

+		lda	(address),y

+		and	#$7F

+		ora	colormask

+		eor	bitmask,x

+		sta	(address),y	; In echter Seite setzen

+		pla

+		sta	address+1

+

+pointquick1:	rts

+

+poppos:					; x/y Pos vom Stack holen

+		ldx	areg+1		; stackpointer

+		cpx	#2

+		beq	poppos1

+		dex			; ? ggf beq poppos1

+		beq	poppos1

+

+		lda	stack+000,x	; xpos

+		sta	breg+1

+		lda	stack+100,x

+		sta	creg+1

+

+		lda	stack+200,x	; ypos

+		sta	address

+		lda	stack+300,x

+		sta	address+1

+		lda	stack+400,x

+		sta	breg

+

+		lda	stack+500,x	; xpos low

+		sta	xa

+		lda	stack+600,x	; xpos high

+		sta	xb

+		lda	stack+700,x	; ypos low

+		sta	ya

+		stx	areg+1		; stackpointer

+		rts

+poppos1:

+		pla

+		pla

+		rts			; Fill verlassen

+

+

+clrstack:				; Stack aufraeumen und pushpos

+		ldx	#$FE		; creg+1, da Neues startxy gegeben wird

+		stx	yb+1		; Flag, ob zweites mal clrstack

+		ldx	areg+1		; stackpointer

+clrstack4:	dex

+		lda	stack+700,x

+		cmp	ya

+		bne	clrstack3

+		lda	stack+600,x	; (stack)+1 --> temp (in A/Y)

+		ldy	stack+500,x

+		iny

+		bne	clrstack2

+		clc

+		adc	#1

+clrstack2:	cmp	xb		; Stacktop = xpos-1 ?

+		bne	clrstack3

+		cpy	xa

+		bne	clrstack3

+

+		lda	breg+1		; xpos replacen

+		sta	stack+000,x

+		lda	creg+1

+		sta	stack+100,x

+		lda	xa

+		sta	stack+500,x

+		lda	xb

+		sta	stack+600,x

+		rts

+

+clrstack3:	inc	yb+1		; Flag fuer 2. Durchlauf

+		bne	clrstack4

+

+pushpos:				; xpos/ypos auf Stack bringen

+		ldx	areg+1		; stackpointer

+		lda	breg+1

+		sta	stack+000,x

+		lda	creg+1

+		sta	stack+100,x

+		lda	address

+		sta	stack+200,x

+		lda	address+1

+		sta	stack+300,x

+		lda	breg

+		sta	stack+400,x

+		lda	xa

+		sta	stack+500,x

+		lda	xb

+		sta	stack+600,x

+		lda	ya

+		sta	stack+700,x

+		inx

+		beq	pushpos1	; Stackoverflow

+		stx	areg+1		; stackpointer

+pushpos1:	rts

+

+;===========================================================================

+;	Incremental Adresses

+;	Belegt breg = rowstartoffset, breg+1 = x-reg = bitoffset

+;	       creg+1 = y-reg = xbyte offset,

+;	       address/address+1 = Byteaddresse

+;

+;	Fuer jede Routine gilt:

+;	Ausgang: X = Bitoffset, Y = Byteoffset, SEC = Out of Window

+;	Trat SEC auf, ist die aktuelle Position unveraendert (!)

+;		 Beispiel: jsr	incy

+;			   bcs	fehler

+;			   lda	(address),y

+;			   and	bitmask,x

+

+;---------------------------------------------------------------------------

+;	Start Scan

+;

+;	Eingang:		A: HIGH xpos

+;				X: LOW xpos

+;				Y: LOW ypos

+

+STARTXY:

+		cmp	#02		; xpos >= 512 ?

+		bcc	startxy1

+startxy2:	rts			; Carry is Set

+startxy1:	cmp	#01

+		bne	startxy3	; xpos < 256

+		cpx	#18		; xpos >= 280 ?

+		bcs	startxy2	; Bereichsfehler

+startxy3:	cpy	#$C0		; ypos >= 192 ?

+		bcs	startxy2	

+

+		pha			; xpos (HIGH) retten

+		tya

+		pha

+

+; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7

+

+		lsr	a		; ypos DIV 8

+		lsr	a

+		lsr	a

+		asl	a		; Fuer Tabellenzugriff * 2 (Bit 0 = 0)

+		tay

+		sty	breg		; rowstart Offset

+		lda	rowstart,y	; Tabelle der Zeilenanfaenge

+		sta	address

+		lda	rowstart+1,y

+		clc

+		adc	pagebase

+		sta	address+1

+		pla			; ypos

+		and	#07		; MOD 8

+		eor	#07		; y = 0 ist unten links

+		asl	a		; * 4 (* 256)

+		asl			; Carry is cleared

+		adc	address+1	; Mikrozeile addieren

+		sta	address+1

+		pla			; xpos (HIGH) --> Y

+		tay

+		txa			; xpos (LOW) --> A

+		jsr	divide7		; A/Y --> A (Quotient), X (Remainder)

+		sta	creg+1

+		tay			; y-reg = Byteoffset

+		stx	breg+1		; Bitoffset

+		clc			; Carry cleared = ok

+		rts

+			

+;-------------------------------------------------------------------------

+;	Increment actual y

+

+INCY:

+		lda	address+1

+		and	#1C

+		beq	incy1		; naechste Mikrozeile

+		lda	address+1

+		sec

+		sbc	#4

+		sta	address+1

+		clc			; ok

+incy2:		ldy	creg+1

+		ldx	breg+1

+		rts

+

+incy1:		ldy	breg

+		iny

+		iny			; naechste Makrozeile

+		cpy	#30		; tabellenende ?

+		bcs	incy2		; Fehler, nichts veraendert

+		sty	breg

+		lda	rowstart,y

+		sta	address		; Carry war cleared

+		lda	rowstart+1,y

+		adc	pagebase

+		adc	#1C		; 7. Mikrozeile

+		sta	address+1

+		bcc	incy2		; Always

+

+;--------------------------------------------------------------------------

+;	Decrement actual y

+

+DECY:

+		lda	address+1

+		and	#1C

+		cmp	#1C		; 7. Mikrozeile ?

+		beq	decy1		; naechste Mikrozeile

+		lda	address+1

+		adc	#4

+		sta	address+1

+decy2:		ldy	creg+1

+		ldx	breg+1

+		rts

+

+decy1:		ldy	breg		; naechste Makrozeile

+		sec

+		beq	decy2		; Out of Window ?

+		dey

+		dey

+		sty	breg

+		lda	rowstart,y

+		sta	address

+		clc

+		lda	rowstart+1,y

+		adc	pagebase

+		sta	address+1

+		bcc	decy2		; Always

+

+;-------------------------------------------------------------------------

+;	Increment actual x

+

+INCX:

+		ldy	creg+1

+		ldx	breg+1

+		cpx	#6

+		bcs	incx1

+		inx

+		clc

+incx2:		stx	breg+1		; y schon = creg+1

+		rts

+

+incx1:		inc	creg+1

+		iny

+		ldx	creg+1

+		cpx	#28		; Out of Window ?

+		ldx	#0

+		bcc	incx2		; CLC: ok

+		dec	creg+1		; Wieder Rueckgaengig

+		rts

+

+;-----------------------------------------------------------------------

+;	Decrement actual x

+

+DECX:

+		ldy	creg+1

+		ldx	breg+1

+		beq	decx1

+		dex

+decx2:		stx	breg+1		; y schon creg+1

+		rts

+

+decx1:		ldx	#6

+		dec	creg+1

+		dey

+		clc

+		bpl	decx2		; < 0 ?

+		sec			; Out of Window !

+		inc	creg+1		; Alter Zustand

+		rts

+

+

+;==========================================================================

+;	Absolute Adresses

+

+;--------------------------------------------------------------------------

+;

+;		C A L C A D D R

+;		Berechnet die Addresse eines Pixels

+;

+;		Eingang:	A: HIGH xpos

+;				X: LOW xpos

+;				Y: ypos

+;		Ausgang:	address,address+1: Addresse des Bytes mit Pixel

+;				Carry: Set = Pixelpos ausserhalb des Fensters

+;				X: Bitnummer im addressierten Byte (0..6)

+;---------------------------------------------------------------------------

+

+CALCADDR:

+		cmp	#02		; xpos >= 512 ?

+		bcc	less512

+rangeerr:	rts			; Carry is Set

+less512:	cmp	#01

+		bne	xposok		; xpos < 256

+		cpx	#18		; xpos >= 280 ?

+		bcs	rangeerr	; Bereichsfehler

+xposok:		cpy	#$C0		; ypos >= 192 ?

+		bcs	rangeerr	

+

+		pha			; xpos (HIGH) retten

+		tya

+		pha

+

+; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7

+

+		lsr			; ypos DIV 8

+		lsr

+		lsr

+		asl			; Fuer Tabellenzugriff * 2 (Bit 0 = 0)

+		tay

+		lda	rowstart,y	; Tabelle der Zeilenanfaenge

+		sta	address

+		lda	rowstart+1,y

+		clc

+		adc	pagebase

+		sta	address+1

+		pla			; ypos

+		and	#07		; MOD 8

+		eor	#07		; y = 0 ist unten links

+		asl			; * 4 (* 256)

+		asl			; Carry is cleared

+		adc	address+1

+		sta	address+1

+		pla			; xpos (HIGH) --> Y

+		tay

+		txa			; xpos (LOW) --> A

+		jsr	divide7		; A/Y --> A (Quotient), X (Remainder)

+		clc

+		adc	address

+		sta	address

+		bcc	calcret

+		inc	address+1

+		clc			; Carry cleared = ok

+calcret:	rts

+

+;-----------------------------------------------------------------------------

+;

+;		N E G 

+;		Vorzeichenwechsel

+;		Eingang/Ausgang:	A/X (HIGH/LOW)

+;-----------------------------------------------------------------------------

+

+NEG:		pha

+		txa

+		eor	#$FF

+		clc

+		adc	#01

+		tax

+		pla

+		eor	#$FF

+		adc	#00

+		rts

+

+;---------------------------------------------------------------------------

+;

+;		D I V I D E 7

+;		Division durch 7 mit Rest

+;		Eingang:	A: Low, Y: High (Nur 0 oder 1)

+;		Ausgang:	A: Quotient (Auch in quotient)

+;				X: Rest

+;--------------------------------------------------------------------------

+

+DIVIDE7:

+		ldx	#00		; Quotient Schieberegister loeschen

+		stx	quotient

+		ldx	#$E0		; 224 = 7 * 2^5 als Startwert

+		stx	divmask

+		ldx	#06		; Anzahl Verschiebungen

+		cpy	#01		; Zahl > 255 ?

+		bne	shiftloop	; Carry is set

+		inc	quotient

+		adc	#1F		; (Zahl MOD 256) + 32

+		bne	shift2loop	; Erste Subtraktion ueberspringen

+

+shiftloop:	sec

+		sbc	divmask		; Probeweise subtrahieren

+		php			; Borrow merken

+		rol	quotient	; Borrow in quotient rotieren

+		plp

+		bcs	shift2loop

+		adc	divmask		; Falls zuviel subtrahiert wieder add.

+shift2loop:	lsr	divmask		; Dann nur noch die Haelfte subtr.

+		dex

+		bne	shiftloop

+		tax			; Rest der Division

+		lda	quotient	; Quotient

+		rts

+

+;----------------------------------------------------------------------------

+;

+;		P O I N T

+;		Setzt/Loescht Punkt an bestimmter Position

+;		Eingang:	Position in xpos/ypos

+;				Linepattern in pattern

+;				Farbmaske in colormask

+;				Bitmodus in bitmode

+;---------------------------------------------------------------------------

+

+;DOPOINT:

+;		ldy	bitmode

+;		bpl	patternres	; Always

+

+POINT:

+		ldy	bitmode

+		asl	pattern

+		rol	pattern+1

+		bcs	patternset

+		cpy	#03		; Copymodus

+		bne	pointret	; Keine Aktion

+		ldy	#01		; Loeschen

+		bne	patternres	; Always

+

+patternset:	inc	pattern		; 1 links im pattern setzen

+patternres:	sty	tempmode	

+		lda	ypos+1

+		bne	pointret

+		lda	xpos+1

+		ldx	xpos

+		ldy	ypos

+;MAKEDOT:	

+		jsr	calcaddr	; Punktaddresse berechnen

+		bcs	pointret	; Ausserhalb des Bildschirms

+		ldy	#00

+		lda	(address),y

+		ldy	tempmode	

+		bne	mode1

+

+mode0:		ora	bitmask,x	; Modus 0 = setzen

+		bcc	setcolor

+

+mode1:		dey

+		bne	mode2

+		and	notbitmask,x	; Modus 1 = loeschen

+		bcc	setcolor

+

+mode2:		dey

+		bne	mode0		; Modus 3 (copy) wie Modus 0

+		eor	bitmask,x	; Modus 2 = invertieren

+		bcc	setcolor

+

+setcolor:	ldy	#00

+		and	#7F		; Altes Farbbit loeschen

+		ora	colormask	; Farbbit neu setzen

+		sta	(address),y	; Graphikbyte zurueckschreiben

+pointret:	rts

+

+

+;-----------------------------------------------------------------------------

+;	Drawthick zeichnet eine dicke Linie

+

+drawthick:

+		lda	param1

+		pha

+		lda	param1+1

+		pha			; to-pos retten

+		lda	param2

+		pha

+		lda	param2+1

+		pha

+

+		lda	savepattern

+		pha

+		lda	savepattern+1

+		pha

+		lda	pattern		; Linetype auf Startwert

+		sta	savepattern

+		lda	pattern+1

+		sta	savepattern+1

+

+		dec	thick

+

+;	x- oder y- Richtung feststellen:

+;	x direction := abs (xto - xfrom) > abs (yto - yfrom)

+

+		lda	param1

+		sec

+		sbc	xpos

+		tax

+		lda	param1+1

+		sbc	xpos+1

+		bcs	drawthick1

+		jsr	NEG		; Absolutwert (A/X)

+drawthick1:	sta	dx+1

+		stx	dx

+

+		lda	param2

+		sec

+		sbc	ypos

+		tax

+		lda	param2+1

+		sbc	ypos+1

+		bcs	drawthick2

+		jsr	NEG		; Absolutwert (A/X)

+drawthick2:	pha

+		txa

+		sec

+		sbc	dx

+		pla

+		sbc	dx+1		; Nur das Vorzeichen wichtig

+		pha			; xdirection, wenn A < 0

+

+;	Start- und Endpunkt der mittleren Linie berechnen

+

+		bpl	drawthick3	; y direction

+

+; start.x := xfrom - thick x  ; to.x := xto + thick x

+; start.y := yfrom            ; to.y := yto

+; thick x : IF xto < xfrom THEN -thick ELSE +thick FI

+		

+		lda	param1

+		sec

+		sbc	xpos		; xto - xfrom 

+		lda	param1+1

+		sbc	xpos+1

+		bcs	drawthick4	; xto >= xfrom (xto-xfrom >= 0)

+					; xto < xfrom

+		lda	xpos		; Carry is cleared

+		adc	thick

+		sta	xa		; start.x

+		lda	xpos+1

+		adc	#0

+		sta	xa+1

+

+		lda	param1		; to.x

+		sec

+		sbc	thick

+		sta	xb

+		lda	param1+1

+		sbc	#0

+		sta	xb+1

+		jmp	drawthick5

+

+drawthick4:

+		lda	xpos		; Carry is set

+		sbc	thick

+		sta	xa

+		lda	xpos+1

+		sbc	#0

+		sta	xa+1

+

+		lda	param1

+		clc

+		adc	thick

+		sta	xb

+		lda	param1+1

+		adc	#0

+		sta	xb+1

+

+drawthick5:

+;	start.y := ypos ; to.y := param2

+		lda	ypos

+		sta	ya

+		lda	ypos+1

+		sta	ya+1

+		lda	param2

+		sta	yb

+		lda	param2+1

+		sta	yb+1

+		jmp	drawthick8

+

+drawthick3:				; x direction

+

+; start.x := xfrom           ; to.x := xto

+; start.y := yfrom - thick y ; to.y := yto + thick y

+; thick y : IF yto < yfrom THEN -thick ELSE +thick FI

+

+		lda	param2

+		sec

+		sbc	ypos		; yto - yfrom 

+		lda	param2+1

+		sbc	ypos+1

+		bcs	drawthick6	; yto >= yfrom (yto-yfrom >= 0)

+					; yto < yfrom

+		lda	ypos		; Carry is cleared

+		adc	thick

+		sta	ya		; start.y

+		lda	ypos+1

+		adc	#0

+		sta	ya+1

+

+		lda	param2		; to.y

+		sec

+		sbc	thick

+		sta	yb

+		lda	param2+1

+		sbc	#0

+		sta	yb+1

+		jmp	drawthick7

+

+drawthick6:

+		lda	ypos		; Carry is set

+		sbc	thick

+		sta	ya

+		lda	ypos+1

+		sbc	#0

+		sta	ya+1

+

+		lda	param2

+		clc

+		adc	thick

+		sta	yb

+		lda	param2+1

+		adc	#0

+		sta	yb+1

+

+drawthick7:

+;	start.x := xpos ; to.x := param1

+		lda	xpos

+		sta	xa

+		lda	xpos+1

+		sta	xa+1

+		lda	param1

+		sta	xb

+		lda	param1+1

+		sta	xb+1

+

+;------

+;	FOR diff FROM -thick TO thick REP drawsingl PER

+

+drawthick8:

+		ldx	thick

+		lda	#0

+		jsr	NEG		; -thick

+		sta	areg+1

+		stx	areg		; = diff

+

+drawthick11:

+		ldx	areg

+		lda	areg+1

+		bne	drawthick9

+		cpx	thick		; > +thick ?

+		beq	drawthick9

+		bcc	drawthick9

+		

+;	PER ; restore pattern

+

+		pla			; x direction

+		inc	thick

+		pla

+		sta	savepattern+1

+		sta	pattern+1

+		pla

+		sta	savepattern

+		sta	pattern

+		pla

+		sta	param2+1		; To-Pos restoren

+		pla

+		sta	param2

+		pla

+		sta	param1+1

+		pla

+		sta	param1

+		lda	param1

+		sta	xpos

+		lda	param1+1

+		sta	xpos+1

+		lda	param2

+		sta	ypos

+		lda	param2+1

+		sta	ypos+1

+		rts

+

+;	singlevector:

+

+drawthick9:

+		pla

+		pha			; xdirection ?

+		bpl	drawthick10	; y direction

+

+; move (start.x, start.y-diff) ;

+; draw (to.x, to.y-diff) ;

+

+		lda	xa

+		sta	xpos

+		lda	xa+1

+		sta	xpos+1		; xpos := start.x

+		lda	ya

+		sec

+		sbc	areg

+		sta	ypos

+		lda	ya+1

+		sbc	areg+1

+		sta	ypos+1		; ypos := start.y - diff

+		jsr	move_x

+		

+		lda	xb		; xto := to.x

+		sta	param1

+		lda	xb+1

+		sta	param1+1

+		lda	yb		; yto := to.y - diff

+		sec

+		sbc	areg

+		sta	param2

+		lda	yb+1

+		sbc	areg+1

+		sta	param2+1

+		jsr	drawsglvec	; Linie von x/ypos nach param1/2

+		jmp	drawthick12

+

+drawthick10:

+

+; move (start.x + diff, start.y) ;

+; draw (to.x + diff, to.y) ;

+

+		lda	xa

+		clc

+		adc	areg

+		sta	xpos		; xpos := start.x + diff

+		lda	xa+1

+		adc	areg+1

+		sta	xpos+1

+		lda	ya		; ypos := start.y

+		sta	ypos

+		lda	ya+1

+		sta	ypos+1

+		jsr	move_x

+

+		lda	xb

+		clc

+		adc	areg		; xto := to.x + diff

+		sta	param1

+		lda	xb+1

+		adc	areg+1

+		sta	param1+1

+

+		lda	yb

+		sta	param2

+		lda	yb+1		; yto := to.y

+		sta	param2+1

+		jsr	drawsglvec	; Linie von x/ypos nach param1/2

+

+;	NEXT diff

+

+drawthick12:	

+		inc	areg

+		bne	drawthick13

+		inc	areg+1

+drawthick13:	jmp	drawthick11	; diff INCR 1

+		

+		

+;-----------------------------------------------------------------------------

+;

+;		D R A W

+;		Linie zwischen zwei Punkten zeichnen

+;		Eingang:	FROM-Position in xpos/ypos

+;				TO-Position in param1/param2

+;				Attribute in bitmode,pattern,colormask

+;-----------------------------------------------------------------------------

+

+DRAW:

+

+;	X-Vektorrichtung bestimmen

+;	dx := xto - xfrom ; right := sign (dx) ; dx := ABS dx

+

+		lda	thick

+		bne	draw1

+		rts			; Unsichtbare Linie

+draw1:		

+		cmp	#1

+		beq	drawsglvec	; Eine Linie Zeichnen

+		jmp	drawthick

+

+drawsglvec:

+		ldy	#00		; Vorzeichen fuer right: positiv

+		lda	param1		; xto (LOW)

+		sec

+		sbc	xpos		; xfrom (LOW)

+		tax

+		lda	param1+1	; xto (HIGH)

+		sbc	xpos+1		; xfrom (HIGH)

+		bpl	dxpositiv

+		jsr	NEG		; dx := -dx

+		dey			; Vorzeichen fuer right: negativ

+dxpositiv:	sta	dx+1

+		stx	dx

+		sty	right

+

+;	Y-Vektorrichtung bestimmen

+;	dy := yto - yfrom ; up := sign (dy) ; dy := ABS dy

+

+		ldy	#00		; Vorzeichen fuer up: positiv	

+		lda	param2		; yto

+		sec

+		sbc	ypos		; yfrom

+		tax

+		lda	param2+1

+		sbc	ypos+1

+		bpl	dypositiv

+		jsr	NEG		; dy := -dy

+		dey			; Vorzeichen fuer up: negativ

+dypositiv:	sta	dy+1

+		stx	dy

+		sty	up

+

+; init vectorloop

+

+		ldx	#00

+		stx	olderror

+		stx	olderror+1	; olderror := 0

+		ldx	#xpos		; xpointer zeigt auf xpos

+		stx	xpointer

+		ldx	#ypos

+		stx	ypointer	; ypointer zeigt auf ypos

+

+;	dy > dx   ==>   dx - dy < 0   ==> Parameter vertauschen

+

+		lda	dx

+		sec

+		sbc	dy		; Ergebnis unwichtig, nur Carry

+		lda	dx+1		; dx (HIGH)

+		sbc	dy+1		; dy (HIGH)

+		bpl	dy_lsequal_dx

+

+;	Parameter vertauschen

+

+		lda	xpointer	; xpointer und ypointer vertauschen

+		ldx	ypointer

+		stx	xpointer

+		sta	ypointer

+

+		lda	up		; up und right vertauschen

+		ldx	right

+		stx	up

+		sta	right

+

+		lda	dx		; dx (LOW) und dy (LOW) vertauschen

+		ldx	dy

+		stx	dx

+		sta	dy

+

+		lda	dx+1		; dx (HIGH) und dy (HIGH) vertauschen

+		ldx	dy+1

+		stx	dx+1

+		sta	dy+1

+

+dy_lsequal_dx:				; vector(xpos, ypos, dx, dy, right, up)

+

+;	uprighterror := dy - dx ; righterror = dy

+

+		lda	dy

+		sec

+		sbc	dx

+		sta	uprighterror

+		lda	dy+1

+		sbc	dx+1

+		sta	uprighterror+1

+

+;	Schleife: dx DECR 1

+

+nextpixel:	jsr	POINT		; POINT (xpos, ypos)

+		lda	dx		; dx = counter = 0 ?

+		ora	dx+1

+		bne	do_one_step

+		rts			; Ende der Vektorloop

+

+do_one_step:	

+		ldx	xpointer	; Referenz auf xpos oder ypos

+		bit	right		; right < 0 ?

+		bpl	rightstep	; sonst leftstep

+;leftstep:

+		lda	0,x		; xpos-Referenz DEC 1

+		bne	xposdec1

+		dec	1,x		; Highbyte von xpos

+xposdec1:	dec	0,x		; Lowbyte von xpos

+		jmp	detdirection

+rightstep:

+		inc	0,x

+		bne	detdirection

+		inc	1,x

+

+detdirection:

+

+;	IF abs (olderror + righterror) < abs (olderror + uprighterror)

+;		THEN do_right_step ELSE do_upright_step FI

+

+;	abs (olderror + uprighterror) = abs1

+

+		lda	olderror

+		clc

+		adc	uprighterror

+		tax

+		lda	olderror+1

+		adc	uprighterror+1

+		bpl	abs1positiv

+		jsr	NEG		; abs1 := -abs1 (A=HIGH, Y=LOW)

+abs1positiv:	stx	temporary	; Fuer spaetere Subtraktion merken

+		sta	temporary+1

+		

+;	abs (olderror + righterror) = abs2

+

+		lda	olderror

+		clc

+		adc	righterror

+		tax

+		lda	olderror+1

+		adc	righterror+1

+		bpl	abs2positiv

+		jsr	NEG		; abs2 := -abs2 (A=HIGH, X=LOW)

+abs2positiv:

+		tay			; abs2 (HIGH) retten

+		txa			; abs2 (LOW) --> A

+		sec

+		sbc	temporary	; abs1 (LOW) 

+		tya			; Nur Carrybit wesentlich

+		sbc	temporary+1	; abs1 (HIGH) 

+		bmi	do_right_step

+

+;do_upright_step:

+

+;	ypos INCR up

+

+		ldx	ypointer

+		bit	up		; Vorzeichen von up

+		bpl	yposinc1

+

+		lda	0,x		; ypointer enthaelt Offset ab xpos

+		bne	yposdec1

+		dec	1,x

+yposdec1:	dec	0,x

+		jmp	xyerror

+

+yposinc1:	inc	0,x

+		bne	xyerror

+		inc	1,x

+

+xyerror:	

+

+;	olderror INCR uprighterror

+

+		lda	olderror

+		clc

+		adc	uprighterror

+		sta	olderror

+		lda	olderror+1

+		adc	uprighterror+1

+		sta	olderror+1

+		jmp	dxdec1

+

+do_right_step:

+

+;	olderror INCR righterror

+

+		lda	olderror

+		clc

+		adc	righterror

+		sta	olderror

+		lda	olderror+1

+		adc	righterror+1

+		sta	olderror+1

+

+dxdec1:

+		lda	dx

+		bne	dxdec

+		dec	dx+1

+dxdec:		dec	dx

+

+		jmp	nextpixel		; zum Schleifenanfang

+

+;--------------------------------------------------------------------------

+;	Muster fuer GFILL:

+

+muster:

+		.RADIX	2

+		DB	11111111	; 0: gefuellt

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+		DB	11111111	

+

+		DB	10101010	; 1: Halb

+		DB	01010101	

+		DB	10101010	

+		DB	01010101	

+		DB	10101010	

+		DB	01010101	

+		DB	10101010	

+		DB	01010101	

+

+		DB	11111111	; 2: Waagerecht (grob)

+		DB	00000000	

+		DB	00000000	

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+		DB	00000000	

+		DB	00000000	

+

+		DB	11111111	; 3: Waagerecht (fein)

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+		DB	11111111	

+		DB	00000000	

+

+		DB	10001000	; 4: Senkrecht (grob)

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+

+		DB	10101010	; 5: Senkrecht (fein)

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+		DB	10101010	

+

+		DB	11111111	; 6: Gerades Raster (grob)

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	11111111	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+

+		DB	11111111	; 7: Gerades Raster (fein)

+		DB	10101010	

+		DB	11111111	

+		DB	10101010	

+		DB	11111111	

+		DB	10101010	

+		DB	11111111	

+		DB	10101010	

+

+		DB	10001000	; 8: Links Schraffur

+		DB	00010001	

+		DB	00100010	

+		DB	01000100	

+		DB	10001000	

+		DB	00010001	

+		DB	00100010	

+		DB	01000100	

+

+		DB	10001000	; 9: Rechts Schraffur

+		DB	01000100	

+		DB	00100010	

+		DB	00010001	

+		DB	10001000	

+		DB	01000100	

+		DB	00100010	

+		DB	00010001	

+

+		DB	10001000	; 10: Schraeges Gitter

+		DB	01010101	

+		DB	00100010	

+		DB	01010101	

+		DB	10001000	

+		DB	01010101	

+		DB	00100010	

+		DB	01010101	

+

+		DB	10101010	; 11: Punktraster

+		DB	00000000	

+		DB	10101010	

+		DB	00000000	

+		DB	10101010	

+		DB	00000000	

+		DB	10101010	

+		DB	00000000	

+

+		DB	11111111	; 12: Mauer

+		DB	01000000	

+		DB	01000000	

+		DB	01000000	

+		DB	11111111	

+		DB	00000100	

+		DB	00000100	

+		DB	00000100	

+

+		DB	00100010	; 13: Korb

+		DB	01010101	

+		DB	10001000	

+		DB	10001000	

+		DB	10001000	

+		DB	01010101	

+		DB	00100010	

+		DB	00100010	

+

+		DB	00000000	; 14: Wellenlinie

+		DB	00100010	

+		DB	01010101	

+		DB	10001000	

+		DB	00000000	

+		DB	00100010	

+		DB	01010101	

+		DB	10001000	

+

+;usermuster:

+		DB	10000000	; 15: User (Default: Zickzack)

+		DB	01000001	

+		DB	00100010	

+		DB	00010100	

+		DB	00001000	

+		DB	00000000	

+		DB	00000000	

+		DB	00000000	

+

+		.RADIX	16

+

+;----------------------------------------------------------------------------

+;	T A B E L L E N

+;----------------------------------------------------------------------------

+

+bitmask:	db	$01, $02, $04, $08, $10, $20, $40, $80

+notbitmask:	db	$FE, $FD, $FB, $F7, $EF, $DF, $BF, $7F

+

+;	Graphikzeilenanfaenge, Ypos 0 ist unten

+

+rowstart:	

+		dw	03D0, 0350, 02D0, 0250

+		dw	01D0, 0150, 00D0, 0050

+

+		dw	03A8, 0328, 02A8, 0228

+		dw	01A8, 0128, 00A8, 0028

+

+		dw	0380, 0300, 0280, 0200

+		dw	0180, 0100, 0080, 0000

+

+		.printx 'Ende'

diff --git a/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC b/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC
new file mode 100644
index 0000000..b7f25f4
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC
@@ -0,0 +1,202 @@
+		TITLE	EUMEL-SHard Graphikroutinen, 64180-Teil

+

+;		RUC64180 auf Basis108

+;		19.05.86, Michael Staubermann

+;		Ueberarbeitet: 11.01.87

+

+		GLOBAL	GMOVE, GDRAW, GTEST, GCTRL

+		GLOBAL	GTRANS, GCLR, GFILL, GRAFIO

+;

+		EXTERNAL WTEND, MEMDMA, HGOP

+

+		INCLUDE HD64180.LIB

+		.LIST

+		CSEG

+

+CTRLMOVE	EQU	0

+CTRLDRAW	EQU	1

+CTRLTEST	EQU	2

+CTRLCTRL	EQU	3

+CTRLCLR		EQU	4

+CTRLFILL	EQU	5

+CTRLTRANS	EQU	6

+

+

+TASK		EQU	0F080H	; Task fuer 6502

+RESULT		EQU	0F081H	; Subtask und Ergebnis

+PARAM1		EQU	0F082H	; xpos oder Parameter

+PARAM2		EQU	0F084H	; ypos oder Linepattern

+

+;...........................................................................

+;

+;	M O V E

+;

+;	Startposition fuer DRAW setzen

+;	Es findet keine Bereichspruefung statt

+;

+;	Eingang: A = Terminalnummer (Kanal 1)

+;		 DE = xpos (0..279)

+;		 HL = ypos (0..191)

+;

+GMOVE:

+		LD	B,CTRLMOVE

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	D R A W

+;

+;	Linie von Startposition bis zur uebergebenen Position zeichnen

+;	Ausserhalb des Bildschirms wird nicht gezeichnet

+;

+;	Eingang: A = Terminalnummer (Kanal 1)

+;		 DE = xpos (0..279)

+;		 HL = ypos (0..191)

+;

+GDRAW:

+		LD	B,CTRLDRAW

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	T E S T B I T

+;

+;	Pruefen, ob Punkt gesetzt

+;

+;	Eingang: A = Terminalnummer (Kanal 1)

+;		 DE = xpos (0..279)

+;		 HL = ypos (0..191)

+;

+;	Ausgang: BC = 255 : Position ausserhalb des gueltigen Bereichs

+;		      sonst: Bit 0 = Zustand (0 = geloescht, 1 = gesetzt)

+;			     Bit 7 = Farbe (1 = Gelb, 0 = Violett)

+;

+GTEST:

+		LD	B,CTRLTEST

+		JR	GRAPHIK

+

+;...........................................................................

+;

+;	C T R L

+;

+;	Graphikparameter setzen

+;

+;	Eingang:  DE = Steuerbits:

+;			Bit 0: 0 = Textmode, 1 = Graphikmode

+;			Bit 1: 0 = Sichtbare Seite 0, 1 = Sichtbare Seite 1

+;			Bit 2: 0 = Bearbeitete Seite 0, 1 = Bearbeitete Seite 1

+;			Bit 3,4: 0 = OR, 1 = NAND, 2 = XOR Zeichnen

+;			Bit 5: 0 = Full Graphics, 1 = Mixed Graphics

+;			Bit 6: 0 = Pattern in HL, 1 = Letztes DRAW Pattern

+;					fuer Linetype benutzen

+;			Bit 7: 1 = Gelb, 0 = Violett

+;		 HL = Linetype Pattern, wenn Bit 6 = 0

+;

+GCTRL:

+		LD	B,CTRLCTRL

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	C L E A R

+;

+;	Graphikseite mit einem Fuellzeichen loeschen

+;

+;	Eingang: DE = Page (0..3)

+;		 HL = Fuellzeichen (Byte in L)

+;

+GCLR:

+		LD	B,CTRLCLR

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	F I L L

+;

+;	Umrandete Flaeche fuellen

+;

+;	Eingang: DE = xpos

+;		 HL = ypos

+GFILL:

+		LD	B,CTRLFILL

+		JR	GRAPHIK

+

+;............................................................................

+;

+;	T R A N S

+;

+;	Transportiert (kopiert) eine Graphikseite in eine andere

+;

+;	Eingang: DE = 'from'-Page (0..3)

+;		 HL = 'to'-Page (0..3)

+GTRANS:

+		LD	B,CTRLTRANS

+

+GRAPHIK:	

+		LD	A,B		; Subtasknummer

+		CALL	WTEND		; Busy warten, da in IOCONTROL

+		POP	HL

+		PUSH	HL		; Zweiter Parameter

+

+		DI

+		IN0	B,(CBR)		; Alte MMU-Einstellung merken

+		LD	C,51H		; Basisspeicher Page 0

+		OUT0	(CBR),C

+

+		LD	(PARAM1),DE	; 1. Parameter

+		LD	(PARAM2),HL	; 2. Parameter

+

+		LD	L,7		; 6502-Task: Graphik

+		LD	H,A		; Subtask

+		LD	(TASK),HL

+		LD	C,0		; Als 'ok' vorbesetzen

+		CP	CTRLTEST	; Muss auf Resultat gewartet werden ?

+		JR	NZ,TASKEND

+

+WAITTEND:	LD	A,(TASK)	; Darf intensiv auf Taskende warten

+		AND	A

+		JR	NZ,WAITTEND

+		LD	A,(RESULT)

+		LD	C,A

+

+TASKEND:	OUT0	(CBR),B		; Alte MMU-Einstellung wiederherstellen

+		EI

+		POP	HL

+		LD	B,0

+		RET

+

+;..............................................................................

+;

+;	G R A F I O 

+;	Blockin/Blockout fuer Graphikpage			

+;

+;	Eingang: DE = Blocknummer : 0..15= Page 0 (ggf. sichtbar)

+;				   16..31= Page 1 (ggf. sichtbar)

+;				   32..47= Page 2 (nur durch Transfer)

+;				   48..63= Page 3 (nur durch Transfer)

+;

+;		 HL = Hauptspeicheraddresse

+;		 (HGOP) = 1 : Graphikseite --> Hauptspeicher

+;		 (HGOP) = 0 : Hauptspeicher --> Graphikseite

+;

+GRAFIO:

+	PUSH	AF

+	PUSH	DE

+

+	EX	DE,HL		; DE = log. Hauptspeicheradresse

+	LD	A,L

+	ADD	A		; HL * 512 + 2000H

+	ADD	A,20H

+	LD	H,A

+	LD	L,0

+	LD	BC,512		; Blockgroesse

+	LD	A,(HGOP)	; Transferrichtung

+

+	CALL	MEMDMA		; Block tranportieren

+

+	POP	DE

+	POP	AF

+	LD	BC,0		; Transfer fehlerfrei

+	RET

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB b/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB
new file mode 100644
index 0000000..5d733e4
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB
@@ -0,0 +1,159 @@
+

+; HD64180-Macro-Library - 14.04.85

+

+	.z80

+	.xlist

+

+CNTLA0	equ	00h

+CNTLA1	equ	01h

+CNTLB0	equ	02h

+CNTLB1	equ	03h

+STAT0	equ	04h

+STAT1	equ	05h

+TDR0	equ	06h

+TDR1	equ	07h

+TSR0	equ	08h

+TSR1	equ	09h

+CNTR	equ	0ah

+TRDR	equ	0bh

+TMDROL	equ	0ch

+TMDROH	equ	0dh

+RLDROL	equ	0eh

+RLDROH	equ	0fh

+TCR	equ	10h

+TMDR1L	equ	14h

+TMDR1H	equ	15h

+RLDR1L	equ	16h

+RLDR1H	equ	17h

+SAR0L	equ	20h

+SAR0H	equ	21h

+SAR0B	equ	22h

+DAR0L	equ	23h

+DAR0H	equ	24h

+DAR0B	equ	25h

+BCR0L	equ	26h

+BCR0H	equ	27h

+MAR1L	equ	28h

+MAR1H	equ	29h

+MAR1B	equ	2ah

+IAR1L	equ	2bh

+IAR1H	equ	2ch

+BCR1L	equ	2eh

+BCR1H	equ	2fh

+DSTAT	equ	30h

+DMODE	equ	31h

+DCNTL	equ	32h

+IL	equ	33h

+ITC	equ	34h

+RCR	equ	36h

+CBR	equ	38h

+BBR	equ	39h

+CBAR	equ	3ah

+ICR	equ	3fh

+

+hdword	macro	x

+	if	'&X' eq 'BC'  or '&X' eq 'bc'

+ww	defl	0	; INIT mit 0, BC=0

+	else

+	if	'&X' eq 'DE'  or '&X' eq 'de'

+ww	defl	1

+	else

+	if	'&X' eq 'HL'  or '&X' eq 'hl'

+ww	defl	2

+	else

+	if	'&X' eq 'SP'  or '&X' eq 'sp'

+ww	defl	3

+	else

+	.printx 'HD-Word-Error'

+	endif

+	endif

+	endif

+	endif

+	endm

+

+

+hdreg	macro	x

+	ifidn	<X>,<(hl)>

+reg	defl	6

+	else

+	ifidn	<X>,<(HL)>

+reg	defl	6

+	else

+	if	'&X' eq 'B' or '&X' eq 'b'

+reg	defl	0

+	else 

+	if	'&X' eq 'C' or '&X' eq 'c'

+reg	defl	1

+	else 

+	if	'&X' eq 'D' or '&X' eq 'd'

+reg	defl	2

+	else 

+	if	'&X' eq 'E' or '&X' eq 'e'

+reg	defl	3

+	else 

+	if	'&X' eq 'H' or '&X' eq 'h'

+reg	defl	4

+	else 

+	if	'&X' eq 'L' or '&X' eq 'l'

+reg	defl	5

+	else 

+	if	'&X' eq 'A' or '&X' eq 'a'

+reg	defl	7

+	else

+	.printx	'HD-Reg Error'

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endif

+	endm

+

+mlt	macro	x

+	hdword	x

+	db	0edh,4ch+ww*10h

+	endm

+

+slp	macro

+	db	0edh,076h

+	endm

+

+in0	macro	x,y

+	hdreg	x

+	db	0edh,reg*8,y

+	endm

+

+out0	macro	y,x

+	hdreg	x

+	db	0edh,reg*8+1,y

+	endm

+

+tst	macro	x		; Test register

+	hdreg	x

+	db	0edh,reg*8+4

+	endm

+

+otim	macro

+	db	0edh,83h

+	endm

+

+otimr	macro

+	db	0edh,93h

+	endm

+

+otdm	macro

+	db	0edh,8bh

+	endm

+

+otdmr	macro

+	db	0edh,9bh

+	endm

+

+tstio	macro	x

+	db	0edh,074h,x

+	endm

+

+; ENDE der HD64180-Macros

diff --git a/system/shard-z80-ruc-64180/1.5/src/IINST.COM b/system/shard-z80-ruc-64180/1.5/src/IINST.COM
new file mode 100644
index 0000000..332f731
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/IINST.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/IINST.PAS b/system/shard-z80-ruc-64180/1.5/src/IINST.PAS
new file mode 100644
index 0000000..0bf5c91
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/IINST.PAS
@@ -0,0 +1,21 @@
+PROGRAM installationsnummer_setzen ;

+ { M. Staubermann, 8.2.87 }

+

+VAR f : FILE ;

+    buffer : ARRAY[0..63] OF INTEGER ;

+BEGIN

+ assign (f, 'EUMEL.COM') ;

+ reset (f) ;

+ blockread (f, buffer, 1) ;

+ writeln ;

+ write ('Lizenznummer (GMD) : ', buffer[$23], #13) ;

+ write ('Lizenznummer (GMD) : ') ;

+ readln (buffer[$23]) ;

+ buffer[$24] := succ (buffer[$24]) ;

+ write ('Installationsnummer: ', buffer[$24], #13) ;

+ write ('Installationsnummer: ') ;

+ readln (buffer[$24]) ;

+ seek (f, 0) ;

+ blockwrite (f, buffer, 1) ;

+ close (f) ;

+END.

diff --git a/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC b/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC
new file mode 100644
index 0000000..6c2cdf1
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC
@@ -0,0 +1,636 @@
+	TITLE	INIMOD - Hardwareinitialisierung fuer EUMEL 1.8 auf RUC 180

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+	CSEG

+;

+;****************************************************************

+;

+;	INIMOD: Initialisierung fuer  EUMEL 1.8 -> RUC 64180 Karte

+;

+;	Version 1.2 - 05.01.87 

+;		1.2 mit logischen und physischen Kanaelen

+;	Version 1.3 - 08.02.87

+;		1.4 - 27.05.87 Console-Texthardcopy m. SHIFT CTRl F12

+;		1.5 - CIO-Printer Haenger beseitigt

+vers	equ	105

+;

+;	Copyright (C) 1985, 86, 87 by ruc:

+;			1.7.3:Rainer Ellerbrake

+;			      Eggeberger Str. 12

+;			      4802 Halle (Westf.)

+;

+;			1.8.: Michael Staubermann

+;			      Moraenenstr. 29

+;			      4400 Muenster-Hiltrup

+;

+;****************************************************************

+;

+;	Globale Variable

+;

+	GLOBAL	START, ZZZZZZ, ZZZZZD

+;

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL SHEND, SHSINF, SHSACC, SHIOCNT, SHOUT, SHBIN, SHBOUT

+	EXTERNAL INITS, SCCINIT

+	EXTERNAL RTCOK, TRAP, MEMDMA, SENDMSG

+	EXTERNAL ADLEISTE, MODECONF, URLK1, URLK2

+	EXTERNAL HDOFS, HDLAST, HGBLKS, CPMOFS, CPMLAST, CPMBLKS

+	EXTERNAL DES6502, PRG6502, LEN65, ST6502

+	EXTERNAL TIMER, CENTR, I6502, ERROR

+	EXTERNAL SCCKA, SCCKB, SCCAER, SCCBER, SCCATX, SCCBTX

+;	

+;................................................................

+;

+;	Konstanten

+;

+;	Eumel Systemadressen

+;

+VECBASE	EQU	0A000H			; Basisadresse fuer JP-Vektoren

+;

+EU0BLKS	EQU	VECBASE+10H

+;

+ESTART	EQU	VECBASE+1EH		; EUMEL Systemstart

+;

+ELEISTE	EQU	VECBASE+21H

+;	

+ELLEN	EQU	VECBASE+36H-ELEISTE

+;

+;................................................................

+;

+;	andere Adressen

+;

+WINDOW	EQU	0F000H		; Anfangsadresse des 4K Windows

+LIMIT	EQU	WINDOW-1	; Obergrenze fuer EUMEL-Pufferbereich

+;SHUG	EQU	0100H		; SHard Code Anfang

+SHOG	EQU	1400H		; EUMEL 0 Anfang

+RESVEC	EQU	0F3F4H		; Pruefsumme Reset Vektor (CBR=51H)

+VPOINT	EQU	0F010H		; Pointer auf Hintergrund Volume

+;

+;	Adressen

+;

+BASE	EQU	WINDOW

+;

+STADR	EQU	BASE+01H

+TSK65	EQU	BASE+80H	;Task fuer 6502

+;

+;	Zeichen

+;

+CR	EQU	0DH		;Carriage Return

+LF	EQU	0AH		;Line Feed

+;

+;	sonstige Konstanten

+;

+CB1	EQU	0F0H		;Anfang Common Base 1 und Bank Base (log.)

+BOTLNG	EQU	40H		; Laenge des Bootstrapladers in Bloecken

+;

+CMN1T0	EQU	51H		;Common Area 1 auf 6502 Adr. 0

+CMN1T1	EQU	52H		;Common Area 1 auf 6502 Adr. $1000

+;

+	INCLUDE	PORTS.MAC

+;

+;-----------------------------------------------------------------------

+;	Bereich ab hier darf NACH dem Systemstart ueberschrieben werden

+;

+KANAL:	DEFB	0		; log. Kanal, der Systemstarturlader enthaelt

+

+SLEISTE:

+	DEFB	'SHARD           ' ; Identifikationstext

+	DEFW	8		; SHard-Interface-Version

+MODE:	DEFW	0		; Vortest-Modus, 	wird ueberschrieben

+ID4:	DEFW	0		; Lizenznummer des SHards,		"

+ID5:	DEFW	0		; Installationsnummer des SHards,	"

+ID6:	DEFW	0		; Reserviert f. SHard,			"

+ID7:	DEFW	8000+vers	; Frei f. SHard: SHard-Version

+	DEFW	0		; -

+	DEFW	0		; -

+	JP	SHOUT

+	JP	SHBIN

+	JP	SHBOUT

+	JP	SHIOCNT

+	JP	SHEND

+	JP	SHSINF

+	JP	SHSACC

+	DEFW	0		; -

+	DEFW	LIMIT		; obere Hauptspeicher-Grenze fuer EUMEL

+

+;----------------------------------------------------------------

+;

+;	System laden

+;

+SYSRD:

+	LD	HL,SHOG

+	LD	DE,10

+;

+RDSLOP:

+	PUSH	HL

+	PUSH	DE		;Adresse + Block retten

+;

+	LD	A,(KANAL)

+	CALL	SHBIN

+;

+	POP	DE

+	POP	HL

+	LD	A,C

+	AND	A

+	JR	NZ,RDSLOP	;Fehler -> Retry

+;

+	INC	H		;Adresse erhoehen

+	INC	H

+	INC	DE		;Blocknummer erhoehen

+	LD	A,(EU0BLKS)

+	ADD	10

+	CP	E		; Alle gelesen ?

+	JR	NC,RDSLOP	;Nein -> weiterlesen

+

+;	System wurde geladen

+;

+

+;	SHard muss sich die benoetigten Teile der EUMEL-Linkleiste retten

+;

+	DI

+

+	LD	HL,ELEISTE

+	LD	DE,ADLEISTE

+	LD	BC,ELLEN	; EUMEL-Linkleiste kopieren

+	LDIR

+;

+;	EUMEL starten

+;

+	LD	HL,SLEISTE	; SHard-Linkleiste

+	JP	ESTART		;EUMEL Lader starten

+;

+ZZZZZZ	EQU	$

+;

+;****************************************************************

+;

+;	S T A R T 

+;

+;	SHARD Initialisierung und Systemstart

+;

+;	1. Treiber initialisieren

+;	2. Startup Meldung ausgeben

+;	3. Interruptadressen setzen, Interrupt Modus setzen

+;	4. Urlader laden

+;	5. Systemstart

+;

+;	Bereich ab hier darf schon VOR dem Systemstart ueberschrieben werden

+;	(darf vom Urlader ueberschrieben werden)

+

+START:

+	DI

+	LD	SP,LIMIT	;obere Speichergrenze

+;

+;	Speicherkonfiguration setzen

+;

+	XOR	A		;Bank Area ab 0

+	OUT0	(BBR),A

+;

+	LD	A,CB1		;Common Area 1 ab log. F000, Bank Area ab 0

+	OUT0	(CBAR),A

+;

+	LD	A,83H		; Refresh Zyklus 2 Takte, alle 80 States

+	OUT0	(RCR),A

+;

+;	Startvektor deaktivieren

+;

+

+	LD	A,0C3H		; JP-Code

+	LD	(0),A		; JP-Code eintragen bei RESET/TRAP-Adr

+	LD	HL,TRAP		; Falls RESET oder TRAP: Info ' shard' 'TRAP'

+	LD	(1),HL		; Kein START, dieses Modul wird ueberschrieben

+

+	LD	A,51H		;Common Area 1 auf Apple Speicher setzen

+	OUT0	(CBR),A 

+;

+;	Durch Veraenderung der Pruefsumme des Reset-Vektors wird erreicht,

+;	dass bei Betaetigen von Reset immer ein Kaltstart ausgefuehrt wird

+;

+	LD	(RESVEC),A	;veraendert

+

+;

+;	Anfang und Ende des Harddisk Volumes (HG) eintragen

+;

+	LD	HL,(VPOINT)	;Pointer auf Tabelle

+	LD	A,H

+	AND	0F0H		;4K-Bereich bestimmen

+	RRCA

+	RRCA

+	RRCA

+	RRCA

+	ADD	A,51H		;Apple Speicher Anfangsoffset

+	OUT0	(CBR),A		;in MMU eintragen

+;

+	LD	A,H

+	OR	0F0H		;im 64180 Speicher ab F000H

+	LD	H,A

+;

+	LD	BC,3		;3 Byte kopieren

+	INC	HL

+	LD	DE,HDOFS

+	LDIR			;Anfang

+;

+;	Laenge des Bootstrapladers (SHARD) hinzuaddieren

+;

+	DEC	DE

+	LD	A,(DE)

+	ADD	A,BOTLNG	;Laenge in 256-Byte Pages

+	LD	(DE),A

+	DEC	DE

+	LD	A,(DE)

+	ADC	A,0

+	LD	(DE),A

+	DEC	DE

+	LD	A,(DE)

+	ADC	A,0

+	LD	(DE),A

+;

+	INC	HL

+	LD	C,3

+	LD	DE,HDLAST

+	LDIR			;Ende

+;

+	LD	A,51H

+	OUT0	(CBR),A

+;

+;	Hintergrund Blockanzahl bestimmen

+;

+	LD	HL,HDOFS+2

+	LD	DE,HDLAST+2	;Last-First ausrechnen

+	CALL	CALCSIZ

+	LD	(HGBLKS),HL	;Groesse eintragen, max. 32MB

+;

+;	CP/M-Volume Blockanzahl bestimmen

+;

+	LD	HL,CPMOFS+2

+	LD	DE,CPMLAST+2

+	CALL	CALCSIZ

+	LD	(CPMBLKS),HL

+;

+	CALL	INICIO		; CIO, incl. Interrupts initialisieren

+

+	CALL	INIINT		; Interrupt System starten

+

+	CALL	INITS		; SCSI-Controller initialisieren

+;

+	CALL	CHKRTC		; Flag fuer gueltige RTC-Werte setzen

+;

+;	Mode, ID laden

+;

+	LD	HL,MODECONF

+	LD	DE,MODE

+	LD	BC,8		; 3 ID-Felder, 1 Mode-Feld

+	LDIR

+

+	LD	HL,STARTUP	; Startupmeldung ausgeben

+	CALL	SENDMSG

+;

+;	Block 10 lesen (enthaelt EUMEL0-Linkleiste)

+;

+

+	LD	A,(URLK1)	; Kanal, auf dem der Urlader zuerst

+	CALL	NEXTKAN		; gesucht wird

+	JP	Z,SYSRD		; System von diesem Kanal laden

+

+	LD	A,(URLK2)	; Kanal, auf dem der Uralder dann gesucht

+	CALL	NEXTKAN		; wird

+	JP	Z,SYSRD		; von diesem Kanal laden

+

+	LD	HL,NOURL	;kein EUMEL Urlader

+	CALL	SENDMSG

+	DI

+	HALT

+

+NEXTKAN:

+	LD	(KANAL),A

+	LD	DE,0		; Default Typ

+	LD	BC,5		; IOCONTROL 'size'

+	CALL	SHIOCNT		; zum initialisieren

+	LD	A,B		; 0 Bloecke, Fehler

+	OR	C

+	JR	NZ,NEXTOK

+	INC	A		; NZ setzen, da vorher 0

+	RET

+

+NEXTOK:

+	LD	A,(KANAL)

+	LD	HL,VECBASE	; Hauptspeicher-Adresse

+	LD	DE,10		; Block 10 lesen

+	CALL	SHBIN

+

+	LD	A,C		; Fehlerrueckmeldung

+	AND	A		;erfolgreich ?

+	RET	NZ

+

+	JP	CKEUMEL		;Eumel Urlader ?

+

+;................................................................

+;

+;	Berechnung der Groesse eines Volumes

+;	Eingang: HL = Zeiger auf letztes der 3 Byte Anfangs LUN/Adresse

+;		 DE = Zeiger auf letztes der 3 Byte Ende+1 LUN/Adresse

+;	Ausgang: HL = Anzahl 512-Byte Bloecke dieses Volumes

+;		 DE und A werden veraendert!

+;

+CALCSIZ:

+	LD	A,(DE)

+	SUB	(HL)

+	LD	C,A

+;

+	DEC	DE

+	DEC	HL

+	LD	A,(DE)

+	SBC	A,(HL)

+	LD	H,A

+	LD	L,C

+	SRL	H		;256 -> 512 Byte Bloecke

+	RR	L

+	RET

+;

+;................................................................

+;

+;	Ueberpruefen ob Block 10 den Text EUMEL enthaelt

+;

+;	Exit:	B=0! bei F=Zero

+;

+CKEUMEL:

+	LD	HL,VECBASE

+	LD	DE,EUMTXT

+	LD	B,5

+;

+CKLP:

+	LD	A,(DE)

+	CP	(HL)

+	INC	HL

+	INC	DE

+	RET	NZ

+	DJNZ	CKLP

+

+	RET

+;

+;................................................................

+;

+STARTUP:

+	DEFB	STUPLEN, 9, CR, LF, LF

+	DEFB	'   EUMEL auf HD64180 & 6502', CR, LF

+	DEFB	'   SHard-Interfaceversion 8', CR, LF

+	DEFB	'   Version 1.5 vom 26.06.87', CR, LF

+	DEFB	'    (c) 1985, 86, 87 by ruc', CR, LF

+	DEFB	'   '

+STUPLEN	EQU	$-STARTUP-1

+;

+NOURL:

+	DEFB	NOURLEN, CR, LF

+	DEFB	'EUMEL-Urlader nicht gefunden', CR, LF

+NOURLEN	EQU	$-NOURL-1

+;

+EUMTXT:

+	DEFB	'EUMEL'

+;

+;-----------------------------------------------------------------

+;

+;	C H K R T C

+;

+;	RTC-Werte auf Gueltigkeit ueberpruefen

+;

+

+CHKRTC:

+	LD	A,20H		; 2 (programmierte) eff. 3 Uhrenwaitstates

+	OUT	(DCNTL),A

+

+				; Testen, ob vernuenftige Werte vorhanden

+				; (BCD, Uhr laeuft, 24h-Modus, Bereiche ok)

+	XOR	A

+	LD	(RTCOK),A	; 'Nicht ok' vorbesetzen

+

+	IN0	A,(RTCRA)	; Register A der Uhr

+	AND	7FH

+	CP	20H		; 

+	JR	NZ,CALEND	; falscher Wert

+

+	IN0	A,(RTCRB)	; Register B der Uhr

+	CP	2

+	JR	NZ,CALEND	; falscher Wert

+

+	IN0	A,(RTCYR)	; Jahr < 87 ?

+	CP	87H

+	JR	C,CALEND

+

+	IN0	A,(RTCDY)	; Tag > 31

+	CP	32H		; 

+	JR	NC,CALEND

+	LD	H,A

+

+	IN0	A,(RTCMO)	; Monat > 12 ?

+	CP	13H

+	JR	NC,CALEND

+

+ 	OR	H

+	JR	Z,CALEND	; Monat oder Tag = 0 ?

+

+	IN0	A,(RTCM)

+	CP	60H

+	JR	NC,CALEND	; Minuten > 59 ?

+	

+	IN0	A,(RTCH)

+	CP	24H

+	JR	NC,CALEND	; Stunden > 23 ?

+	

+	LD	A,0FFH

+	LD	(RTCOK),A

+	

+CALEND:

+	XOR	A

+	OUT0	(DCNTL),A	; 0 (prog.) I/O Waitstates, 0 Memory Waitst.

+	RET

+

+;................................................................

+;

+;	I N I C I O

+;

+INICIO:

+

+;	CIO initialisieren

+

+	IN0	C,(CIOCTL)	;Dummy Read

+	LD	B,INILNG

+	LD	HL,INITAB	;CIO Initialisierungstabelle

+

+INILOP:

+	LD	C,(HL)		;Wert holen

+	OUT0	(CIOCTL),C	;und ausgeben

+	INC	HL

+	DJNZ	INILOP

+	RET

+

+;......................................................................

+;

+;	I N I I N T

+;

+;	Interrupt System starten

+;

+INIINT:

+	CALL	SCCINIT		;SCC initialisieren

+;

+;	6502-Programmstueck verschieben

+;

+	LD	A,1		; Transferrichtung 64180 --> 6502

+	LD	BC,LEN65	; Laenge des Programmstuecks

+	LD	DE,PRG6502	; Startadresse im log. 64180-Speicher

+	LD	HL,DES6502	; Destinationadresse im Basisspeicher

+	CALL	MEMDMA		; Bytes transferieren

+;

+	LD	B,(CBR)		; CBR merken

+

+	LD	A,CMN1T0

+	OUT0	(CBR),A

+

+	LD	HL,ST6502	;Startadresse 6502-Routinen

+	LD	(STADR),HL

+	LD	A,4		;6502 Teil starten

+	LD	(TSK65),A

+;

+	OUT0	(CBR),B		;CBR wieder zuruecksetzen

+;

+	LD	HL,VECTAB	; Interrupttabelle

+	LD	DE,18H		; Destination

+	LD	BC,ITABLEN	; Transferlaenge

+	LDIR

+

+	XOR	A		;interne Interrupts ab Vektor 0040

+	LD	I,A		;externe Interrupts ab 0018H

+	LD	A,40H

+	OUT0	(IL),A

+;

+	IM	2		; Fuer INT0 Interrupt Modus 2 benutzen

+	LD	A,3		;Enable Interrupt 0 and 1

+	OUT0	(ITC),A

+;

+;

+;	6502 Interrupts hardwaremaessig freigeben

+;

+	LD	A,0B0H		;CIO PC2 auf Low setzen

+	OUT0	(CIOCD),A

+	LD	A,0B4H		;CIO PC2 auf High setzen

+	OUT0	(CIOCD),A

+

+	EI

+

+	RET

+

+;...........................................................................

+;

+;	CIO Initialisierungs Tabelle

+;

+

+INITAB:

+;*	DEFB	0,1		;Set Reset Bit (raus: kein Recalibrate mehr)

+	DEFB	0,0		;Reset Reset Bit

+	DEFB	1,0		;Master configuration control

+

+;	SCSI-Interface-Leitungen

+

+	DEFB    20H,00000010B	;Port A Mode Reg.

+	DEFB	22H,01000010B	;Port A Data Path Polarity Reg.

+	DEFB	23H,10111101B	;Port A Data Direction Reg.

+	DEFB	24H,0		;Port A Special I/O Control

+	DEFB	25H,10101100B	;Port A Pattern Polarity

+	DEFB	26H,0		;Port A Pattern Transition

+	DEFB	27H,10101100B	;Port A Pattern Mask

+	DEFB	0DH,0		;Port A Data

+	DEFB	02H,18H		;Port A Interrupt Vector (** TEST **)

+	DEFB	08H,11100000B	;Port A Command: Clear IE

+	DEFB	08H,00100000B	;Port A Command: Clear IUS & IP

+

+;	General Purpose Port (Centronics, SCSI, 6502-IRQ-Maske)

+

+	DEFB	06H,00000001B	;Port C Data Direction Reg.

+	DEFB	05H,00001000B	;Port C Data Path Polarity Reg.

+	DEFB	07H,0		;Port C Special I/O Control

+	DEFB	0FH,4		;Port C Data Register

+

+;	Centronics Interface

+

+	DEFB	28H,10010000B	;Port B Mode

+	DEFB	29H,01000000B	;Port B Handshake: Strobed

+	DEFB	09H,00100000B	;Port B Command: Clear IUS & IP

+	DEFB	2AH,0		;Port B Data Path Polarity

+	DEFB	2CH,0		;Port B Special I/O Control

+	DEFB	03H,30H		;Port B Interrupt Vektor

+

+;	Deskew Timer

+

+;	DEFB	1EH,00000010B	;Counter 3 Mode Specification

+;	DEFB	0CH,00100000B	;Counter 3 Command and Status

+;	DEFB	1AH,0		;Counter 3 Time Constant MSB

+;	DEFB	1BH,7		;Counter 3 Time Constant LSB (2,268 us)

+;	DEFB	0CH,11100100B	;Counter 3 Gate Enable

+

+;	Timer

+

+	DEFB	1CH,10000000B	;Counter/Timer 1 Mode Spec. Reg.

+	DEFB	1DH,10000000B   ;Counter/Timer 2 Mode Spec. Reg.

+	DEFB	0AH,00100000B	;Counter/Timer 1 Command: Clear IP & IUS

+	DEFB	0BH,00100000B	;Counter/Timer 2 Command: Clear IP & IUS

+	DEFB	16H,HIGH 38400  ;Time Constant 1 MSB

+	DEFB	17H,LOW 38400   ;Time Constant 1 LSB

+	DEFB	18H,0		;Time Constant 2 MSB, mit Timer 1 zus. 50ms

+	DEFB	19H,4		;Time Constant 2 LSB

+	DEFB	04H,18H		;Interrupt Vector Counters

+

+;	CIO-Interrupts freigeben

+

+	DEFB	01H,11110111B	;Master Config. Register

+	DEFB	00H,10000010B	;Master Interrupt Enable

+

+	DEFB	09H,11000000B	;Port B Command: Set IE

+

+	DEFB	0BH,11000110B	;Counter/Timer 2 Command: Set IE

+ 	DEFB	0AH,11100110B	;Counter/Timer 1 Command: Clear IE

+

+INILNG	EQU	$-INITAB

+

+;****************************************************************

+;

+;	Interrupt Vektor Tabelle, wird kopiert

+;

+VECTAB:

+	DEFW	TIMER	;18	Timer Interrupt (CIO Counter 2)

+	DEFW	ERROR	;1A

+	DEFW	ERROR	;1C

+	DEFW	ERROR	;1E

+	DEFW	SCCBTX	;20	SCC Transmitter Interrupt (Kanal B)

+	DEFW	ERROR	;22	SCC EXT/Status Interrupt (Kanal B) 

+	DEFW	SCCKB	;24	SCC Receive Char. available (Kanal B)

+	DEFW	SCCBER	;26	SCC Special Receive Condition (Kanal B)

+	DEFW	SCCATX	;28	SCC Transmitter Interrupt (Kanal A)

+	DEFW	ERROR	;2A	SCC EXT/Status Interrupt (Kanal A) 

+	DEFW	SCCKA	;2C	SCC Receive Char. available (Kanal A)

+	DEFW	SCCAER	;2E	SCC Special Receive Condition (Kanal A)

+	DEFW	CENTR	;30	Centronics Interface

+	DEFW	ERROR	;32

+	DEFW	ERROR	;34

+	DEFW	ERROR	;36

+	DEFW	ERROR	;38

+	DEFW	ERROR	;3A

+	DEFW	ERROR	;3C

+	DEFW	ERROR	;3E

+	DEFW	I6502	;40	INT1 = 6502 Interrupt

+	DEFW	ERROR	;42	INT2 = unbenutzt

+	DEFW	ERROR	;44	Timer Channel 0 = unbenutzt

+	DEFW	ERROR	;46	Timer Channel 1 = unbenutzt

+	DEFW	ERROR	;48	DMA Channel 0 = unbenutzt

+	DEFW	ERROR	;4A	DMA Channel 1 = unbenutzt

+	DEFW	ERROR	;4C	CSI/O = unbenutzt

+	DEFW	ERROR	;4E	ASCI Channel 0 = unbenutzt

+	DEFW	ERROR	;50	ASCI Channel 1 = unbenutzt

+

+ITABLEN	EQU	$-VECTAB

+;

+;.....................................................................

+

+ZZZZZD:	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/INT65.MAC b/system/shard-z80-ruc-64180/1.5/src/INT65.MAC
new file mode 100644
index 0000000..55efcf6
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/INT65.MAC
@@ -0,0 +1,411 @@
+	TITLE	INT65 - Interface 6502 <-> 64180

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+	CSEG

+;

+;****************************************************************

+;

+;	INT65: Interface BASIS 6502 <-> 64180, Einstellungen fuer

+;	serielle Schnittstelle im BASIS 108

+;

+;	Version 0.4 - 25.11.85 / 11:00

+;	Version 0.5 - 23.12.86, M.Staubermann

+;	Version 0.6 - 14.01.86, Kanal 5 Flusskontrolle durch 6502

+;

+;	Copyright (C) 1985 by Rainer Ellerbrake

+;			      Eggeberger Str. 12

+;			      4802 Halle (Westf.)

+;

+;****************************************************************

+;

+;	Globale Variable

+;

+	GLOBAL	ZGERL, TO6502, TO65WA, WTEND, RD6502

+	GLOBAL	BAUBAS, BITBAS, AFLOW5, EFLOW5, FRE65

+;

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL WARTE

+;

+;................................................................

+;

+;	Konstanten

+;

+P065	EQU	51H		;Page 0 des 6502 einblenden

+PC65	EQU	5DH		;I/O-Bereich des 6502

+;

+TASK	EQU	0F080H

+PARAM	EQU	TASK+1

+;

+AFLG	EQU	0F09AH		; XON/XOFF - Ausgabeseitig: Bit 7 = 1

+EFLG	EQU	0F09BH		; Ausgabeseitiger Stopzustand: Bit 7 = 1

+;SFLG	EQU	0F09CH		; Stopzustand des Transmitters

+WAITFLG	EQU	0F09DH		; 6502 - Update-Synchro

+;

+PFREE	EQU	0F0E0H		; Word: Anzahl freie Bytes im Druckerspooler

+TFREE	EQU	0F0F0H		; Word: Anzahl freie Bytes im Transmitbuffer

+;

+SER_CMD	EQU	0F09AH		; Command Register 6551 BASIS

+SER_CTR	EQU	0F09BH		; Control Register 6551 BASIS

+;

+;

+	INCLUDE	PORTS.MAC

+;

+;****************************************************************

+;

+;	T O 6 5 0 2

+;

+;	6502 Task Aufruf

+;

+;	Eingang: L - Task-Nummer

+;		 H - Parameter

+;

+TO6502:

+	PUSH	AF

+	LD	A,I

+	PUSH	AF

+	DI

+	IN0	A,(CBR)

+	PUSH	AF

+;

+	LD	A,P065

+	OUT0	(CBR),A

+;

+;	Warten bis vorherige Task beendet ist

+;

+WRTTAS:

+	CALL	ZGERL

+	LD	A,(TASK)	;Task = 0: beendet	

+	AND	A

+	JR	NZ,WRTTAS

+;

+	LD	A,H

+	LD	(PARAM),A

+;

+	LD	A,L

+	LD	(TASK),A	;Task aufrufen

+;

+;	auf Ende wird erst beim naechsten Aufruf gewartet

+;

+	POP	AF

+	OUT0	(CBR),A		;zurueckschalten

+	POP	AF

+	JP	PO,NOEI

+;

+	EI

+NOEI:

+	POP	AF

+	RET

+;

+;----------------------------------------------------------------

+;

+;	T O 6 5 W A

+;

+;	Warten auf Beendigung des Task Aufrufs

+;	(EUMEL WARTE wird aufgerufen!!)

+;

+TO65WA:

+	PUSH	AF

+;

+;	Warten bis Task beendet ist

+;

+	

+WTTAS:

+	IN0	A,(CIOAD)

+	BIT	0,A

+	JR	Z,WTTA1		;Zugriff nicht erlaubt -> warten

+;

+	PUSH	HL

+	LD	HL,LOW TASK

+	CALL	RD6502		; Task-Byte in A

+	POP	HL

+

+	AND	A

+	JR	NZ,WTTA1

+	POP	AF

+	RET

+

+WTTA1:

+	CALL	WARTE

+;

+	JR	WTTAS

+;

+;----------------------------------------------------------------

+;

+;	W T E N D

+;

+;	Warten auf Beendigung des Task Aufrufs

+;

+WTEND:

+	PUSH	AF

+;

+;	Warten bis Task beendet ist

+;

+WTTAS1:

+	CALL	ZGERL

+;

+	PUSH	HL

+	LD	HL,LOW TASK

+	CALL	RD6502

+	POP	HL

+

+	AND	A

+	JR	NZ,WTTAS1

+;

+	POP	AF

+	RET

+

+;

+;----------------------------------------------------------------

+;

+;	Z G E R L

+;

+;	Auf Zugriffserlaubnis warten

+;

+;	keine Register veraendert

+;

+;

+;	Zugriff auf 6502-Speicher zulaessig ?

+;

+ZGERL:

+	PUSH	AF

+WAI65:

+	IN0	A,(CIOAD)

+	BIT	0,A

+	JR	Z,WAI65		;nicht erlaubt -> warten

+;

+	POP	AF

+	RET

+;

+;---------------------------------------------------------------

+;

+;	R D 6 5 0 2

+;	Byte aus 6520-Memory Adresse HL nach A lesen

+;

+;	Eingang: HL = Zeropage- oder I/O-Page-Adresse im 6502-Memory

+;	Ausgang: In A steht der Inhalt der Adresse

+;

+RD6502:

+	PUSH	BC

+	LD	B,A

+	LD	A,I

+	DI

+	PUSH	AF

+

+	IN0	A,(CBR)

+	LD	C,P065		; Bit 7 nicht gesetzt: Zeropage

+	BIT	7,H

+	JR	Z,RD6502B

+	LD	C,PC65		; Bit 7 gesetzt: I/O-Adresse

+RD6502B:			; Achtung: Nicht eindeutig!

+	OUT0	(CBR),C

+

+	LD	C,H

+	LD	H,0F0H

+	LD	B,(HL)

+	LD	H,C	

+

+	OUT0	(CBR),A

+

+	POP	AF

+	JP	PO,RD6502A

+	EI

+RD6502A:

+	LD	A,B

+	POP	BC

+	RET

+

+;----------------------------------------------------------------

+;

+;	Baudrateneinstellung fuer BASIS serielle Schnittstelle

+;

+;	Eingang: A - Kanalnummer (immer 5)

+;		 HL - Schluessel (s. Tabelle) (1..15)

+;		 Es werden korrekte Parameter vorausgesetzt

+;

+;	Ausgang: Register duerfen nicht veraendert werden

+;

+BAUBAS:

+	PUSH	AF

+	DI

+				; Da nur I/O Zugriffe gemacht werden, braucht

+				; nicht auf Zugriffserlaubnis gewartet werden

+	IN0	A,(CBR)

+	PUSH	AF		;alte Einstellung retten

+	LD	A,PC65		;I/O-Bereich einblenden

+	OUT0	(CBR),A

+	LD	A,(SER_CTR)	;Control Register lesen

+	AND	0F0H		;Baudratenbits ausblenden

+	OR	L		;und neue Einstellung einfuegen

+	LD	(SER_CTR),A

+

+	POP	AF

+	OUT0	(CBR),A		;alten Bereich wieder einblenden

+EIRET:

+	EI

+	POP	AF

+	RET

+;

+;

+;------------------------------------------------------------------

+;

+;	F R E 6 5

+;	Freiplatz eines 6502-Ausgabepuffers erfragen

+;

+;	Eingang: A = Kanal (5, 6)

+;	Ausgang: HL veraendert, A veraendert

+;		 BC = Free Bytes

+;		 Carry set, Puffer leer

+;

+FRE65:

+	CP	5		; BASIS serielle Schnittstelle

+	LD	HL,TFREE	; Transmitbuffer

+	JR	Z,BASER

+	LD	HL,PFREE	; Druckerpuffer

+

+BASER:

+	DI

+	IN0	A,(CBR)

+	PUSH	AF

+	LD	A,51H

+	OUT0	(CBR),A		; Zeropage

+

+WAIUPD:

+	LD	A,(WAITFLG)

+	AND	A

+	JR	NZ,WAIUPD	; Warten, bis Update zuende

+

+	LD	C,(HL)		; Lowbyte Free

+	INC	HL

+	LD	B,(HL)		; Highbyte Free

+	INC	HL

+	LD	A,(HL)		; Lowbyte Size

+	INC	HL

+	OR	(HL)

+	LD	L,A

+

+	POP	AF

+	OUT0	(CBR),A

+	EI

+	LD	A,L

+	AND	A

+	RET	NZ		; Carry cleared, Puffer nicht leer

+	SCF			; Carry set, Puffer leer

+	RET

+

+;----------------------------------------------------------------

+;

+;	Stopbits, Datenbits, Parity fuer BASIS serielle Schnittstelle

+;

+;	Eingang: A - Kanalnummer (immer 5)

+;		 L - Schluessel

+;		 Es werden korrekte Parameter vorrausgesetzt

+;

+;	Ausgang: Register duerfen nicht veraendert werden

+;

+BITBAS:

+	PUSH	AF

+	DI

+				; Da nur I/O Zugriffe gemacht werden, braucht

+				; nicht auf Zugriffserlaubnis gewartet werden

+	PUSH	HL

+	IN0	H,(CBR)

+	LD	A,PC65		; I/O-Bereich einblenden

+	OUT0	(CBR),A

+				; Stopbits und Datenbits setzen

+	LD	A,(SER_CTR)	; Control Register lesen

+	AND	1FH		; Datenbits Stopbits ausblenden

+	BIT	6,L		; 2 Stopbits ?

+	JR	Z,BITBAS1

+	SET	7,A

+BITBAS1:

+	BIT	0,L		; Bit 0 = 0, wenn 7 Datenbits (7-1 = 6)

+	JR	NZ,BITBAS2

+	SET	5,A		; 01 = 7 Datenbits, 00 = 8 Datenbits

+BITBAS2:

+	LD	(SER_CTR),A

+				; Parity setzen

+	LD	A,L

+	RLCA

+	RLCA

+	AND	01100000B

+	BIT	6,A

+	JR	Z,BITBAS3	; 00 = No, 01 = Odd, 10 = Even

+	SET	5,A

+BITBAS3:			; 00 = No, 01 = Odd, 11 = Even

+	LD	L,A

+	LD	A,(SER_CMD)

+	AND	0FH

+	OR	L		; Neue Parity Bits

+	LD	(SER_CMD),A

+

+	OUT0	(CBR),H		;alten Bereich wieder einblenden

+	POP	HL

+	JR	EIRET

+;

+;-----------------------------------------------------------------

+;

+;	A F L O W 5

+;	Ausgabeflusskontrolle einstellen

+;

+;	Eingang: (HL) : Bit 0 = XON/XOFF, Bit 1 = DSR/DTR

+;

+AFLOW5:

+	PUSH	AF

+	PUSH	HL

+	XOR	A

+	BIT	2,(HL)		; Ausgabeflusskontrolle ?

+	JR	Z,AFLOW5A

+	CALL	CALCF

+AFLOW5A:

+	LD	HL,AFLG

+EAFLOW:

+	PUSH	BC

+	DI

+	IN0	B,(CBR)

+	LD	C,51H

+	OUT0	(CBR),C

+	LD	(HL),A

+	OUT0	(CBR),B

+	EI

+	POP	BC

+	POP	HL

+	POP	AF

+	RET

+	

+CALCF:

+	BIT	0,(HL)

+	JR	Z,CALCF1

+	SET	7,A		; XON/XOFF

+CALCF1:

+	BIT	1,(HL)

+	JR	Z,CALCF2

+	SET	6,A		; DSR/DTR

+CALCF2:

+	RET

+

+;-----------------------------------------------------------------

+;

+;	E F L O W 5

+;	Eingabeflusskontrolle einstellen

+;

+;	Eingang: (HL) : Bit 0 = XON/XOFF, Bit 1 = DSR/DTR

+;

+EFLOW5:

+	PUSH	AF

+	PUSH	HL

+	XOR	A

+	BIT	3,(HL)		; EIngabeflusskontrolle ?

+	JR	Z,EFLOW5A

+	CALL	CALCF		; EUMEL --> 6502 Format

+EFLOW5A:

+	LD	HL,EFLG

+	JR	EAFLOW

+

+;-------------------------------------------------------------------

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC b/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC
new file mode 100644
index 0000000..ebff654
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC
@@ -0,0 +1,1292 @@
+

+	TITLE	Interrrupts fuer SHARD

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+;

+;****************************************************************

+;

+;	Interruptmodul fuer EUMEL SHARD

+;

+;	Timer Handling, SCC Interrupts, 6502 Interrupts

+;	Buffer Manager

+;

+;	Version 0.9 vom 10.01.87 (Transmittinterrupts)

+;	Version 1.0, getestet (Ringpuffer korrigiert,

+;			20.01.87 - keine Interrupthaenger an Kanal 1/5 mehr)

+;		1.1 (27.05.87) Verlorener Timerinterrupt im Info/Vortest

+;			durch Korrektur von CHKINT (weniger oft aufgerufen)

+;               1.2 (26.06.87) Wieder rausgebaut, da bei mehr als 16 Zeichen im

+;			Eingabepuffer die Puffer-Auslesegeschwindigkeit stark

+;			sinkt.

+;

+;	Copyright (C) 1985 by R. Ellerbrake

+;			86/87, M. Staubermann

+;

+;****************************************************************

+;

+;	Globale Adressen

+;

+	GLOBAL	BAUSCC, BITSCC, SCCINIT, CLRCBUF 

+	GLOBAL	ESTOP, EGO, AFLOW

+	GLOBAL  I6502, TIMER, CENTR

+	GLOBAL	SCCKA, SCCKB, SCCAER, SCCBER, SCCATX, SCCBTX

+	GLOBAL	PUTBUF, FREEBUF, DRUCK, SCCATAB, SCCBTAB

+

+;

+;----------------------------------------------------------------

+;

+;	Externe Adressen

+;

+	EXTERNAL TIMEAD, IINTAD, SHUTUPAD

+	EXTERNAL IKANTAB, BLINKP, SWICUR, MEMDMA, FLWTYP

+	EXTERNAL AFLOW5, RD6502

+;

+;

+;----------------------------------------------------------------

+;

+	CSEG

+;

+;	Konstanten

+;

+CMN1T0	EQU	51H		;Common Area 1 auf 6502 Adr. 0

+CMN1T1	EQU	52H		;Common Area 1 auf 6502 Adr. $1000

+;

+XON	EQU	11H		; CTRL-Q

+XOFF	EQU	13H		; CTRL-S

+

+				; Bereich fuer Transmitbuffer im 6502-Speicher

+DBUF	EQU	0A000H

+SABUF	EQU	DBUF+1000H

+SBBUF	EQU	SABUF+0800H	; SABUF+SBBUF zusammen max. 4k in einem Window

+				; Offsets auf Kanal-Buffer-Tabellen

+SIZE	EQU	0		; aktuelle Groesse (Belegung) des Puffers

+BEG	EQU	2		; Pufferanfang (fest)

+READ	EQU	3		; Adresse des naechsten Out-Buffer-Zeichens

+WRITE	EQU	5		; Adresse des naechsten In-Buffer-Zeichens

+ENDE	EQU	7		; excl. Pufferende (fest)

+

+CPORT	EQU	8		; Controlport mit Statusregister

+XFLAG	EQU	9		; Bit 7 = 1: Transmitter stoppen

+				; Bit 6 = 1: XON/XOFF ausgabeseitig

+

+	INCLUDE	PORTS.MAC

+

+

+;----------------------------------------------------------------

+;

+;	6502-Adressen

+;

+

+BASE	EQU	0F000H		;Anfangsadresse 6502 Bereich

+IFLG	EQU	BASE+09EH	; Start/Stop Flag fuer 6502

+INTPAR1	EQU	BASE+0EAH	;Interrupt Parameter 1 (Kanal)

+INTPAR2	EQU	INTPAR1+1	;Interrupt Parameter 2 (Eingabezeichen)

+INTPAR3	EQU	INTPAR2+1	;Interrupt Parameter 3 (Fehlerbits)

+

+

+;-----------------------------------------------------------------

+;

+;	P H Y S L O G

+;	Umrechnung der physischen Kanalnummer in eine logische

+;

+;	Eingang: A = phys. Kanalnummer

+;	Ausgang: A = log. Kanalnummer

+;		 keine anderen Register veraendert

+;

+PHYSLOG:

+	PUSH	HL

+	ADD	A,IKANTAB	; Kanal phys. --> log. Umrechnen

+	LD	L,A

+	LD	H,0

+	LD	A,(HL)

+	POP	HL

+	RET

+

+;................................................................

+;

+;	Timer Interrupt Handler

+;

+;	wird durch CIO Timer 2 Interrupt aufgerufen

+;

+TIMER:

+	PUSH	AF

+;

+	LD	A,50		;50 ms pro Timerinterrupt

+	CALL	TIMEAD		;EUMEL timerinterrupt

+;

+	DI

+	LD	A,(CCOUNT)	;Cursor invertieren ?

+	DEC	A

+	JR	NZ,TIMER1

+;

+	IN0	A,(CIOAD)	; Cursor invertieren, wenn Zugriff erlaubt

+	BIT	0,A

+	JR	Z,TIMER2

+

+	PUSH	HL

+	PUSH	DE

+	PUSH	BC

+	CALL	SWICUR		; Cursor invertieren

+	POP	BC

+	POP	DE

+	POP	HL

+

+TIMER2:

+	LD	A,(BLINKP)

+TIMER1:

+	LD	(CCOUNT),A

+

+	LD	A,0BH

+	OUT0	(CIOCTL),A	;Counter/Timer 2 Command

+	LD 	A,00100100B 	;Clear IP & IUS

+	OUT0	(CIOCTL),A

+

+	PUSH	IX

+	LD	IX,DRUCK

+	CALL	TXHANDLER	; Testen, ob Drucker haengt

+	POP	IX

+

+EINT:

+	POP	AF

+EINT1:

+	EI

+	RETI

+;

+;................................................................

+;

+;	I 6 5 0 2

+;

+;	6502 Interrupt Handler

+;

+I6502:

+	PUSH	AF

+	PUSH	BC

+	CALL	INT6502

+	POP	BC

+	JR	EINT

+

+INT6502:

+	PUSH	DE

+

+	LD	A,0B0H		; Reset Interrupt FF (Keine IRQ's mehr)

+	OUT0	(CIOCD),A

+

+	IN0	A,(CBR)		;Common Area 1 retten

+	PUSH	AF

+

+	LD	A,CMN1T0

+	OUT0	(CBR),A

+;

+	LD	BC,(INTPAR1)	; C = Kanalnummer, B = Eingabezeichen

+	LD	DE,(INTPAR3)	; E = Fehlerbits

+

+	XOR	A		; Interrupt quitieren

+	LD	(INTPAR1),A

+

+	POP	AF

+	OUT0	(CBR),A		;Common Area 1 zurueckschalten

+

+	LD	A,C

+	AND	A		;kein Auftrag ->

+	JR	Z,RET6502I

+

+	CP	40H

+	JR	NC,BREAK	; Sonderbehandlung

+

+	LD	C,E		; Fehlerbits

+

+	PUSH	AF

+

+	CALL	PHYSLOG

+	CALL	IINTAD		; EUMEL Inputinterrupt

+	DI

+

+	POP	BC		; Kanal in B

+	CP	1

+	JR	NZ,RET6502I	; noch Platz im Puffer

+

+	LD	A,B

+	CALL	ESTOP		; Eingabestop, reagiert sofort

+

+RET6502I:

+	POP	DE

+RET6502J:

+	LD	C,0B4H		; Reseteingang des 6502-IRQ-FF wieder auf High

+	OUT0	(CIOCD),C

+	RET

+

+

+BREAK:

+	POP	DE

+	CALL	RET6502J

+

+	CP	'S'		; Shutup ? (53H)

+	RET	NZ

+

+	CALL	EINT1		; Interrupts freigeben

+	JP	SHUTUPAD

+

+;-------------------------------------------------------------------

+;

+;	E F L W 5

+;	Kanal 5 Interrupt an 64180 stoppen/starten

+;	Reagiert sofort

+;

+;	Eingang: Bit 7(HL) = 1: Stop, = 0: Start

+;	Ausgang: BC veraendert

+;

+EFLW5:

+	LD	BC,7F80H	; B = AND-resetmaske, C = OR-setmaske

+	JR	EFLW15		; Bit 7 ist Flag

+

+;-------------------------------------------------------------------

+;

+;	E F L W 1

+;	Kanal 1 Interrupt an 64180 stoppen/starten

+;	Reagiert sofort

+;

+;	Eingang: Bit 7(HL) = 1: Stop, = 0: Start

+;	Ausgang: BC veraendert

+;

+EFLW1:

+	LD	BC,0BF40H	; Bit 6 ist Flag

+

+EFLW15:

+	PUSH	AF

+	LD	A,I

+	DI

+	IN0	A,(CBR)

+	PUSH	AF

+

+	LD	A,51H

+	OUT0	(CBR),A

+

+	LD	A,(IFLG)

+	AND	B		; "weiter"

+	BIT	7,(HL)

+	JR	Z,EFLWA

+	OR	C		; "stop" setzen

+EFLWA:	LD	(IFLG),A	; Stop/Weiter an 6502 weitergeben

+

+	POP	AF

+	OUT0	(CBR),A

+	JP	PO,EFLWB

+	EI

+EFLWB:

+	POP	AF

+	RET

+

+;********************************************************************

+;

+;	Ringpuffer - Verwaltung

+;

+;----------------------------------------------------------------

+;

+;	F R E E B U F

+;	freien Platz im Puffer berechnen

+;	(dies ist nicht immer die Anzahl der uebernehmbaren Zeichen!)

+;

+;	Eingang: IX = Zeiger auf Kanal-Puffer-Tabelle

+;	Ausgang: BC = Anzahl Bytes, die noch in den Puffer passen

+;		 Carry gesetzt: Puffer leer, sonst Puffer gefuellt

+;		 A veraendert

+;

+FREEBUF:

+	PUSH	HL

+	LD	A,(IX+ENDE)		; Konstante

+	SUB	(IX+BEG)

+	LD	H,A

+	LD	L,0

+

+	DI

+	LD	B,(IX+SIZE+1)

+	LD	C,(IX+SIZE)

+	EI

+

+	LD	A,B

+	OR	C

+	SCF				; Set carry, Puffer leer

+	JR	Z,FREEBUF1

+	AND	A

+	SBC	HL,BC			; Carry is cleared

+FREEBUF1:

+	LD	B,H

+	LD	C,L

+	POP	HL

+	RET

+

+;----------------------------------------------------------------

+;

+;	P U T B U F

+;	Zeichenkette in Ausgabepuffer schreiben

+;

+;	Eingang: HL = Anfangsadresse der Zeichenkette

+;		 BC = Laenge der Zeichenkette

+;		 IX = Zeiger auf Kanal-Puffer-Tabelle

+;	Ausgang: BC = Anzahl der uebernommenen Zeichen

+;		 Carry set, alles uebernommen

+;		 HL, A veraendert

+;

+PUTBUF:

+	PUSH	BC

+	CALL	FREEBUF

+	DI

+	LD	A,B

+	OR	C

+	JR	NZ,PUTBUF1

+

+	PUSH	AF

+	CALL	TXHANDLER

+	POP	AF

+	EI

+

+	INC	SP		; POP BC, nichts uebernommen, Clear carry

+	INC	SP

+	RET

+

+PUTBUF1:

+	POP	BC

+

+	PUSH	DE

+	PUSH	HL		; Stringanfang im Hauptspeicher in HL

+

+	LD	H,(IX+READ+1)	; Lesezeiger in HL

+	LD	L,(IX+READ)

+	LD	D,(IX+WRITE+1)	; Schreibzeiger in DE

+	LD	E,(IX+WRITE)

+

+	LD	A,(IX+SIZE)	; Puffer leer ?

+	OR	(IX+SIZE+1)

+	JR	NZ,PUTBUF3

+

+	LD	D,(IX+BEG)

+	LD	E,0		; Beide Zeiger auf Pufferstart

+	LD	(IX+READ+1),D

+	LD	(IX+READ),E

+	LD	(IX+WRITE+1),D

+	LD	(IX+WRITE),E	; Weiter, ohne zu splitten

+	LD	L,E		; L := 0

+	LD	H,(IX+ENDE)

+

+PUTBUF3:

+				; DE, erste Position fuer String

+				; HL, letzte Position (excl.) fuer String

+	AND	A		; falls nicht HL = Pufferende

+	SBC	HL,DE

+	JR	C,PUTBUF2	; C, wenn Read < Write: String splitten

+				; Z kann nicht auftreten, da Puffer nicht voll

+

+PUTBUF9:			; BC := min (BC, HL)

+	LD	A,L		; HL enthaelt max. uebernehmbare Size

+	SUB	C		; BC enthaelt Eingangs-Stringlaenge

+	LD	A,H

+	SBC	B

+	JR	NC,PUTBUF4	; NC, alles uebernommen

+	LD	B,H		; C --> nur Puffersize uebernommen

+	LD	C,L

+

+PUTBUF4:

+	CCF			; Carry fuer EUMEL umdrehen

+

+	POP	HL		; Stringanfang in HL

+

+	PUSH	AF

+	CALL	PUTBUFA

+	CALL	TXHANDLER	; Ein Zeichen ausgeben, IP wird gesetzt

+	EI

+	POP	AF

+	POP	DE

+	RET

+

+PUTBUF2:			; String muss ggf. gesplittet werden

+	LD	H,(IX+ENDE)

+	XOR	A

+	LD	L,A

+	SBC	HL,DE		; HL enthaelt Size (immer > 0)

+	JR	PUTBUF9

+

+;----------------------------------------------------------------------

+;

+;	Teilstring in Puffer schreiben

+;	Eingang: Interrupts disabled

+;		 HL = Teilstringanfang

+;		 DE = Schreibzeiger

+;		 BC = Stringlaenge, die uebernommen werden soll

+;			(BC muss ok sein!)

+;	Ausgang: Nur BC ok

+;		 (DE = Schreibzeiger (korrigiert))

+;		 (HL = Teilstring + uebernommene Stringlaenge)

+;		 BC unveraendert

+;		

+PUTBUFA:

+	PUSH	HL

+	EX	DE,HL		; DE = Hauptspeicher, HL = 6502-Speicher

+	PUSH	BC		; merken fuer Ausgang

+	PUSH	HL		; Stringanfang in DE, Schreibzeiger in HL

+	LD	A,1		; Von DE (log.) nach HL(6502) kopieren

+	CALL	MEMDMA

+	POP	HL		; Schreibzeiger

+	POP	BC		; uebernommene Stringlaenge

+

+	ADD	HL,BC		; Stringlaenge addieren

+

+	LD	A,H

+	CP	(IX+ENDE)

+	JR	NZ,PUTBUFA2

+	LD	H,(IX+BEG)	; Schreibzeiger auf Pufferanfang setzen

+				; L war schon 0

+PUTBUFA2:

+	LD	(IX+WRITE+1),H

+	LD	(IX+WRITE),L	; Schreibzeiger neu setzen

+;	EX	DE,HL		; Schreibzeiger in DE

+

+	LD	L,(IX+SIZE)

+	LD	H,(IX+SIZE+1)

+	ADD	HL,BC		; Stringlaenge addieren

+	LD	(IX+SIZE+1),H	; eintragen

+	LD	(IX+SIZE),L

+

+	POP	HL		; Stringanfang

+	RET

+

+;................................................................

+;

+;	SCCA Output Interrupt

+;

+SCCATX:

+	PUSH	IX

+	LD	IX,SCCATAB

+	JR	TXCHAR

+

+;................................................................

+;

+;	SCCB Output Interrupt

+;

+SCCBTX:

+	PUSH	IX

+	LD	IX,SCCBTAB

+TXCHAR:

+	PUSH	AF

+	CALL	TXHANDLER

+

+	LD	A,00111000B	; Reset highest IUS

+	OUT0	(SCCBC),A

+

+	JR	EOFTX

+	

+

+;................................................................

+;

+;	Centronics Output Interrupt

+;

+CENTR:

+	PUSH	IX

+	LD	IX,DRUCK

+	PUSH	AF

+	CALL	TXHANDLER

+

+	LD	A,9		; Statusregister

+	OUT0	(CIOCTL),A

+	LD	A,00100000B	; Reset IP & IUS

+	OUT0	(CIOCTL),A

+EOFTX:

+	POP	AF

+	POP	IX

+	EI

+	RETI

+;

+;------------------------------------------------------------------------

+;	Output Interrupt Handler

+;	fuer Centronics und SCC

+;

+;	Eingang: IX = Zeiger auf Descriptortabelle des Kanals

+;		 Interrupts disabled

+;	Ausgang: Nur AF veraendert

+;

+TXHANDLER:

+	PUSH	HL

+	PUSH	DE

+	PUSH	BC

+

+	IN0	A,(CIOAD)	; Zugriff auf Puffer erlaubt ?

+	BIT	0,A

+	JP	Z,REGRET

+

+	PUSH	IX

+	POP	HL

+	LD	A,L

+	CP	LOW DRUCK

+	JR	Z,CENTRIRQ

+

+	LD	B,0

+

+	BIT	7,(IX+XFLAG)	; Transmitter gestoppt ?

+	JR	NZ,REGRET	; Keine Interruptbehandlung

+

+	LD	E,(IX+SIZE)

+	LD	D,(IX+SIZE+1)

+	LD	L,(IX+READ)

+	LD	H,(IX+READ+1)

+

+TX1:

+	LD	C,(IX+CPORT)

+

+	LD	A,D

+	OR	E

+	JR	Z,TX5		; Puffer ist leer

+	

+	TSTIO	0100B

+	JR	Z,TX4		; Output-Buffer voll

+

+	IN0	A,(CBR)

+	PUSH	AF

+

+	LD	A,51H+(SABUF/1000H); MMU-Wert fuer Pufferwindow (max. 4k)

+	OUT0	(CBR),A

+

+	PUSH	HL

+

+	LD	A,H

+	AND	0FH

+	OR	0F0H		; Ins Window F000H...

+	LD	H,A

+

+	LD	A,(HL)		; Zeichen ausgeben

+	INC	C		; Aus Controlport wird Datenport

+	INC	C

+	OUT	(C),A		; B bleibt 0!

+

+	POP	HL

+	INC	HL

+

+	POP	AF

+	OUT0	(CBR),A		; MMU zurueckschalten

+

+	LD	A,H

+	CP	(IX+ENDE)

+	JR	NZ,TX2		; Carry set: Lesezeiger < Pufferende, ok

+

+	LD	H,(IX+BEG)	; L war schon 0

+TX2:

+	DEC	DE		; Puffergroesse DECR 1

+	JR	TX1		; Falls moeglich naechstes Zeichen ausgeben

+

+TX5:

+	LD	A,00101000B	; Reset TxIP (B ist 0!)

+	OUT	(C),A

+

+TX4:

+	LD	(IX+SIZE),E

+	LD	(IX+SIZE+1),D

+	LD	(IX+READ),L

+	LD	(IX+READ+1),H

+

+REGRET:

+	POP	BC

+	POP	DE

+	POP	HL

+	RET

+

+CENTRIRQ:

+	LD	C,CIOCTL

+	LD	DE,(DRUCK+SIZE)

+	LD	HL,(DRUCK+READ)

+

+CENTR3:

+	LD	A,D

+	OR	E

+	JR	Z,TX4		; Puffer ist leer

+	

+	LD	A,9		; Statusregister

+	OUT0	(CIOCTL),A	; Statusregister

+	TSTIO	1000B

+	JR	Z,TX4		; Output-Buffer voll

+

+	IN0	B,(CBR)

+

+	LD	A,51H+(DBUF/1000H)	; MMU-Wert fuer Pufferwindow (max. 4k)

+	OUT0	(CBR),A

+

+	PUSH	HL

+

+	LD	A,H

+	AND	0FH

+	OR	0F0H		; Ins Window F000H...

+	LD	H,A

+

+	LD	A,(HL)		; Byte aus Puffer lesen

+	OUT0	(CIOBD),A	; und ausgeben

+

+	OUT0	(CBR),B		; MMU zurueckschalten

+

+	POP	HL

+	INC	HL

+

+	LD	A,H		; Pufferende ?

+	CP	(IX+ENDE)

+	JR	NZ,CENTR2

+

+	LD	H,(IX+BEG)	; L war schon 0

+CENTR2:

+

+	DEC	DE		; Puffergroesse DECR 1

+	JR	CENTR3		; Falls moeglich naechstes Zeichen ausgeben

+

+

+;*************************************************************************

+;

+;	CLRCBUF

+;

+;	64180-Centronics Buffer loeschen

+;	Ausgang: HL veraendert, Flags unveraendert

+;

+CLRCBUF:

+	LD	HL,DBUF

+	LD	(DRUCK+READ),HL

+	LD	(DRUCK+WRITE),HL

+	LD	HL,0

+	LD	(DRUCK+SIZE),HL

+	RET

+	

+;................................................................

+;

+;	SCC Input Interrupt Handler

+

+;--------------------------------------------------------------------

+;	Zeichen mit Fehler empfangen

+

+SCCAER:				; von SCC-Kanal A

+	PUSH	BC

+	LD	C,SCCAC

+	JR	SCCERR

+

+SCCBER:				; von SCC-Kanal B

+	PUSH	BC

+	LD	C,SCCBC

+

+SCCERR:

+	PUSH	AF

+

+	LD	B,0

+	LD	A,00010000B	; Reset EXT/Status Interrupts

+	OUT	(C),A

+	LD	A,00110000B	; Error Reset

+	OUT	(C),A

+

+	LD	A,1

+	OUT	(C),A		; Read-Register 1

+	IN	B,(C)

+

+	BIT	5,B		; Overrun Error ?

+	JR	Z,SCCER1

+	SET	0,A

+SCCER1:

+	BIT	4,B		; Parity Error ?

+	JR	Z,SCCER2

+	SET	2,A

+SCCER2:

+	BIT	6,B		; Framing Error (mit 0 = Break)

+	JR	Z,SCCER3

+	SET	1,A

+SCCER3:

+	JR	SCC1

+

+;-----------------------------------------------------------------------

+;	Zeichen ohne Fehler empfangen

+

+SCCKA:

+	PUSH	BC

+	LD	C,SCCAC

+	JR	SCCOK

+

+SCCKB:

+	PUSH	BC

+	LD	C,SCCBC

+

+SCCOK:

+	PUSH	AF

+	XOR	A		; Keine Fehler

+

+;	Interrupt weiterleiten und Flusskontrolle auswerten

+;	Eingang: A = Fehlerbits

+;		 C = Contollportadresse des Kanals

+

+SCC1:

+	LD	(ERRBIT),A

+	LD	A,C

+	SUB	A,3EH

+	LD	(KANAL),A

+

+	LD	B,0

+	PUSH	BC

+

+	TSTIO	1		; Statusregister

+	JR	Z,IRET		; Receive Character available ?

+

+	INC	C		; Aus Controlport wird Datenport

+	INC	C

+	IN	B,(C)		; Zeichen einlesen

+

+	LD	A,11111101B	; Maske zur XON/XOFF Erkennung

+	AND	B		; mit Eingabezeichen verknuepfen

+	CP	00010001B	; = XON oder XOFF ?

+	JR	NZ,SCC2		; Nein, normaler Inputinterrupt

+

+	PUSH	HL

+

+	LD	HL,XFLGB

+	LD	A,(KANAL)

+	CP	2

+	JR	Z,SCC3

+	LD	HL,XFLGA

+SCC3:	

+	BIT	6,(HL)		; Bit 6: Ausgabeseitig XON/XOFF

+	JR	Z,SCC5		; 0: An Inputinterrupt weiterleiten

+

+	BIT	1,B		; XOFF : Bit 1 = 1, XON: Bit 1 = 0

+	JR	Z,SCC4

+

+	SET	7,(HL)		; Transmitter stoppen

+	POP	HL

+	JR	IRET

+SCC4:

+	RES	7,(HL)		; Transmitter starten

+

+	POP	HL

+	POP	BC

+

+	CP	2		; Flag setzen

+

+	CALL	NZ,SCCATX	; Flags werden nicht veraendert!

+	CALL	Z,SCCBTX	; enthaelt u.a. EI und RETI

+				; und Reset highest IUS	

+	POP	AF

+	POP	BC

+	RET

+	

+SCC5:	

+	POP	HL

+SCC2:

+	LD	A,(ERRBIT)	; Fehlerbits

+	LD	C,A

+	LD	A,(KANAL)	; Kanalnummer

+	CALL	PHYSLOG		; phys. Kanalnummer --> log. Kanalnummer

+

+	CALL	IINTAD

+

+	CP	3		; Weniger als 3 Zeichen Platz ?

+	JR	NC,IRET

+

+	LD	A,(KANAL)

+	CALL	ESTOP		; Eingabestop fuer Kanal 2 oder 3

+

+IRET:

+	POP	BC

+

+	LD	A,00111000B	; Reset highest IUS

+	OUT	(C),A

+;

+	POP	AF

+	POP	BC

+	EI

+	RETI

+

+;................................................................

+;

+;	SCC Initialisierung

+;	HL, BC veraendert

+;

+SCCINIT:

+	LD	HL,SCCAINI		;SCC Kanal A initialisieren

+	LD	BC,(SCCALG+1)*100H+SCCAC+1

+INILP1:

+	DEC	C

+	OTIM

+	JR	NZ,INILP1

+;					; SCC Kanal B initialisieren

+	LD	BC,(SCCBLG+1)*100H+SCCBC+1

+INILP2:

+	DEC	C

+	OTIM

+	JR	NZ,INILP2

+;

+	RET

+;

+;.................................................................

+;

+;	B A U S C C

+;	Baudrateneinstellung fuer SCC-Kanaele

+;

+;	Eingang: A - Kanalnummer (2 oder 3)

+;		 HL - Schluessel (s. Tabelle) (1..16)

+;		 Es werden korrekte Parameter vorrausgesetzt

+;

+;	Ausgang: Register duerfen nicht veraendert werden

+;

+BAUSCC:

+	PUSH	AF

+	PUSH	HL

+	LD	BC,BDSCCA+1

+	CP	3		;Kanal A ?

+	JR	Z,CHABD		;Ja ->

+;

+	LD	BC,BDSCCB+1	;Tab. fuer Kanal B

+;

+CHABD:

+	PUSH	BC

+	LD	BC,BDTAB-2	;Tabelle mit Baudratenteilfaktoren

+	ADD	HL,HL		;Tab.-Offset

+	ADD	HL,BC

+	POP	BC		;Baudrate eintragen

+	LD	A,(HL)

+	LD	(BC),A		;LSB eintragen

+	INC	HL

+	INC	BC

+	INC	BC

+	LD	A,(HL)		;MSB eintragen

+	LD	(BC),A

+

+INISCC:

+	CALL	SCCINIT

+	POP	HL

+	POP	AF

+	RET	

+;

+;.................................................................

+;

+;	B I T S C C

+;	Stopbits, Parity, Datenbits fuer SCC-Kanaele einstellen

+;

+;	Eingang: A = Kanal (2 oder 3)

+;		 L = Schluessel : 

+;		     Bit 0..2 : Datenbits - 1 (Nur 7 oder 8 erlaubt)

+;		     Bit 3..4 : 00 = No Parity, 01 = Odd , 10 = Even

+;		     Bit 5..6 : 00 = 1 Stop, 01 = 1.5 Stop, 10 = 2 Stop

+;

+;	Es werden korrekte Parameter vorausgesetzt

+;

+;	Ausgang: Register unveraendert

+;

+BITSCC:

+	PUSH	AF

+	PUSH	HL

+	LD	BC,BTSCCA+1

+	CP	3		;Kanal A ?

+	JR	Z,CHABT		;Ja ->

+;

+	LD	BC,BTSCCB+1	;Tab. fuer Kanal B

+;

+CHABT:

+	LD	A,L

+	RRA

+	RRA

+	RRA			; Paritybits (0, 1), Stopbits (2, 3)

+	AND	0FH

+	ADD	4		; Stopbits korrigieren

+	BIT	1,A		; Wenn even Parity noch Bit 0 setzen

+	JR	Z,NOEVN		; 00 = No Parity, 01 = Odd, 11 = Even

+	SET	0,A

+NOEVN:	OR	01000000B	; Clock x16 Mode

+	LD	(BC),A		; eintragen

+	INC	BC		; Zeigt auf Register 3

+	INC	BC

+

+	LD	A,L

+	AND	7

+	CP	7-1

+	LD	A,01000001B	; Receiver Enable, 7 Datenbits

+	JR	Z,CHABT1

+	LD	A,11000001B	; dgl., 8 Datenbits

+CHABT1:

+	LD	(BC),A		; Eintragen

+	INC	BC		; Zeigt auf Register 5

+	INC	BC

+	LD	A,10101010B	; Enable Transmitter, 7 Datenbits

+	JR	Z,CHABT2	; Compare-Flag noch nicht veraendert!

+	LD	A,11101010B	; dgl. 8 Datenbits

+CHABT2:

+	LD	(BC),A		; eintragen

+	JR	INISCC

+

+;..................................................................

+;

+;	X F L W 2 3

+;	XON/XOFF - Eingabeflusskontrolle auf SCC-Kanaelen

+;

+;	Eingang: A = Kanal (2, 3)

+;		 BIT 7 (HL), Stop/Weiter

+;

+;	Ausgang: alle Register unveraendert

+;

+XFLW23:

+	PUSH	AF

+	PUSH	BC

+

+	LD	B,0

+	ADD	A,3EH		; Kanal --> Controlport

+	LD	C,A		; Transmitinterrupt kann nicht durchkommen

+

+XFLW23B:

+	TSTIO	0100B		; Transmitbuffer empty ?

+	JR	Z,XFLW23B

+

+	LD	A,XON

+	BIT	7,(HL)

+	JR	Z,XFLW23A

+	LD	A,XOFF

+XFLW23A:

+	INC	C		; Controlport --> Datenport

+	INC	C

+	OUT	(C),A

+

+	POP	BC

+	POP	AF

+	RET

+

+;.................................................................

+;

+;	C F L O W 2 3

+;	CTS - Ausgabeflusskontrolle auf SCC-Kanaelen

+;

+;	Eingang: A = Kanal (2, 3)

+;		 BIT 1(HL), BIT 2(HL) beide 1 : Mit CTS-Flusskontrolle

+;						sonst ohne Flusskontrolle

+;	Ausgang: Nur HL darf veraendert werden

+;

+CFLOW23:

+	PUSH	AF

+	PUSH	BC

+

+	LD	B,0

+

+	ADD	A,3EH		; Controlport

+	LD	C,A

+

+	CP	40H		; SCCA ?

+

+	LD	A,(HL)		; Bit 1 und 2 relevant

+

+	LD	HL,CTSA+1

+	JR	Z,CFLOW2

+	LD	HL,CTSB+1

+CFLOW2:

+	RES	5,(HL)		; erstmal keine Auto-Enables

+	AND	0110B		; Bit 1 und 2 ausblenden

+	CP	0110B

+	JR	NZ,CFLOW3

+

+	SET	5,(HL)		; Auto-Enables einschalten

+CFLOW3:	

+	LD	A,3

+	OUT	(C),A		; Write-Register 3

+	LD	A,(HL)

+	OUT	(C),A

+

+	POP	BC

+	POP	AF

+	RET

+

+	

+;......................................................................

+;

+;	R F L W 2 3

+;	RTS/DTR - Eingabeflusskontrolle auf SCC-Kanaelen

+;

+;	Eingang: A = Kanal (2, 3)

+;		 Bit 7 (HL), Stop/Weiter

+;

+;	Ausgang: Nur Register HL darf veraendert werden

+;

+RFLW23:

+	PUSH	AF

+	PUSH	BC

+

+	LD	B,0

+

+	ADD	A,3EH		; Controlport

+	LD	C,A

+

+	CP	40H		; SCCA ?

+	LD	A,(RTSA+1)

+	JR	Z,RFLW2

+	LD	A,(RTSB+1)

+RFLW2:

+	AND	01111101B	; RTS und DTR ausblenden

+	BIT	7,(HL)

+	JR	NZ,RFLW3	; Stop: RTS = 0 und DTR = 0

+	OR	10000010B	; Go : RTS = 1 und DTR = 1

+RFLW3:	

+	PUSH	AF

+

+	LD	A,5

+	OUT	(C),A		; Write-Register 5

+	POP	AF

+	OUT	(C),A

+

+	POP	BC

+	POP	AF

+	RET

+

+;........................................................................

+;

+;	X F L O W 2 3

+;	XON/XOFF - Ausgabeflusskontrolle fuer SCC-Kanaele

+;

+;	Eingang: A = Kanal (2, 3)

+;		 Bit 0, 2 (HL) = 1 : XON/XOFF gewuenscht sonst nicht

+;	Ausgang: Nur HL veraendert

+;

+XFLOW23:

+	PUSH	AF

+	LD	A,(HL)

+	AND	0101B

+	CP	0101B		; einstellen, wenn 0101

+	LD	L,0

+	JR	NZ,XFLOW2

+	SET	6,L		; Bit 6 = 1 : mit Flusskontrolle

+XFLOW2:

+	POP	AF

+	PUSH	AF

+	CP	2		; Kanal 2 = SCCB

+	LD	A,L

+	JR	Z,XFLOW1

+

+	LD	(XFLGA),A

+	POP	AF

+	RET

+

+XFLOW1:

+	LD	(XFLGB),A

+	POP	AF

+	RET

+

+;........................................................................

+;

+;	A F L O W

+;	Ausgabeflusskontrolle einstellen

+;

+;	Eingang: A = phys. Kanalnummer

+;		 Bit 0, 1, 2(HL) = Flusskontrolmodus

+;

+;	Ausgang: Nur HL darf veraendert werden

+;

+AFLOW:

+	CP	5

+	JP	Z,AFLOW5	; Kanal 5: Ausgabeseitig ist immer CTS

+				; Flusskontrolle eingestellt, Software-

+				; Flusskontrolle mit XON/XOFF ist einschalt-

+				; bar, zusaetzlich einstellbar DSR-Flussk.

+	CP	2

+	RET	C		; Kanal 1 hat keine Ausgabeflusskontrolle

+	CP	4

+	RET	NC		; > 3 : -->

+

+	PUSH	HL

+	CALL	XFLOW23		; XON/XOFF-Flusskontrolle einstellen

+	POP	HL

+	JP	CFLOW23		; Auto-Enables on, wenn Bit 1(HL)=1 und 2(HL)=1

+

+;..................................................................

+;

+;	Eingabestop

+;

+;	Eingang: A = phys. Kanalnummer (2, 3, 5)

+;

+ESTOP:

+	CP	7

+	RET	NC		; Nicht existenter Kanal

+

+	PUSH	HL

+	CALL	FLWTYP		; Zeiger auf Flowmode - Tabelle berechnen

+

+	BIT	3,(HL)

+	JR	Z,POPRET	; Keine Eingabeflusskontrolle erwuenscht

+

+	BIT	7,(HL)		; War der Kanal schon gestoppt ?

+	JR	NZ,POPRET

+

+	SET	7,(HL)		; Stopflag setzen

+

+ESTPGO:				; Ab hier Stop/Go identisch

+

+	CP	2

+	JR	Z,ESTOP23

+	CP	3

+	JR	Z,ESTOP23

+

+	PUSH	BC

+	CP	5

+	CALL	Z,EFLW5		; AF wird nicht veraendert

+	CP	1

+	CALL	Z,EFLW1

+	POP	BC

+

+POPRET:

+	POP	HL

+	RET

+

+ESTOP23:

+	BIT	0,(HL)		; XOFF senden ?

+	CALL	NZ,XFLW23	; Bit 7 unterscheidet XON/XOFF

+	BIT	1,(HL)		; DTR/RTS low setzen?

+	CALL	NZ,RFLW23	; Bit 7 unterscheidet 

+	JR	POPRET

+

+;..................................................................

+;

+;	Eingabe Weiter

+;

+;	Eingang: A = Kanalnummer (2, 3, 5)

+;

+EGO:

+	CP	7

+	RET	NC		; Nicht existenter Kanal

+

+	PUSH	HL

+

+	PUSH	AF

+	AND	1011B		; Kanal 1 oder 5

+	CP	1

+	CALL	Z,CHKINT

+	POP	AF

+

+	CALL	FLWTYP		; Zeiger auf Flowmode - Tabelle berechnen

+

+	BIT	3,(HL)

+	JR	Z,POPRET	; Keine Eingabeflusskontrolle erwuenscht

+

+	BIT	7,(HL)		; War der Kanal gestoppt ?

+	JR	Z,POPRET	; Nein, return

+

+	RES	7,(HL)		; Goflag setzen

+	JR	ESTPGO		; Wie Stop weiter

+

+;-----------------------------------------------------------------

+;

+;	C H K I N T

+;	ggf. Inputinterrupt aufrufen, falls 6502-IRQ nicht quittiert

+;

+;	HL, A veraendert

+;

+CHKINT:

+;	LD	HL,DCOUNT	; Nicht immer CHKINT

+;	DEC	(HL)		; Korr. 1.1

+;	RET	NZ

+;	LD	(HL),100

+

+	PUSH	BC

+	LD	HL,LOW INTPAR1

+	CALL	RD6502		; Byte aus Zeropage lesen

+	AND	A

+	CALL	NZ,INT6502

+	POP	BC

+	RET

+	

+;----------------------------------------------------------------

+;

+;	SCC Kanal A Initialisierung

+;

+SCCAINI:

+	DEFB	9,0C0H		; Force Hardware Reset (beide Kanaele)

+				; Master Interrupts disabled

+	DEFB	2,20H		; Interrupt Vektor (beide Kanaele)

+

+	DEFB	11,01010110B	; use Baudrategenerator Output

+BDSCCA:

+	DEFB	12,18		; Baud Rate Low, Default 9600 Baud

+	DEFB	13,0		; Baud Rate High

+	DEFB	14,00000010B	; Baud Rate Gen. Source = PCLK

+BTSCCA:

+	DEFB	4,01001100B	; No Parity, 2 Stopbits

+CTSA:

+	DEFB	3,11000001B	; Enable Receiver, Datenbits

+RTSA:

+	DEFB	5,11101010B	; Enable Transmitter, Datenbits

+;

+ 	DEFB	14,00000011B	; Enable Baudrategenerator

+	DEFB	17,00010110B	; Receive/Transmit Interrupts Enable

+				; Reset Ext./STatus-Interrupts

+

+SCCALG	EQU	$-SCCAINI

+;

+;	SCC Kanal B Initialisierung

+;

+SCCBINI:

+	DEFB	11,01010110B	; use Baudrategenerator Output

+BDSCCB:

+	DEFB	12,18		; Baud Rate Low, Default 9600 Baud

+	DEFB	13,0		; Baud Rate High

+	DEFB	14,00000010B	; Baud Rate Gen. Source = PCLK

+BTSCCB:

+	DEFB	4,01001100B	; No Parity, 2 Stopbits

+CTSB:

+	DEFB	3,11000001B	; Enable Receiver, Datenbits

+RTSB:

+	DEFB	5,11101010B	; Enable Transmitter, Datenbits

+;

+ 	DEFB	14,00000011B	; Enable Baudrategenerator

+	DEFB	17,00010110B	; Receive/Transmit Interrupts Enable

+				; Reset Ext./Status-Interrupts

+	DEFB	9,00001001B	; Master Interrupt Enable

+;

+SCCBLG	EQU	$-SCCBINI

+;

+;	Baudratentabelle fuer beide SCC-Kanaele

+;

+BDTAB:

+	DEFW	3838		;50 Baud

+	DEFW	2558		;75 Baud

+	DEFW	1743		;110 Baud

+	DEFW	1426		;134.5 Baud

+	DEFW	1278		;150 Baud

+	DEFW	638		;300 Baud

+	DEFW	318		;600 Baud

+	DEFW	158		;1200 Baud

+	DEFW	105		;1800 Baud

+	DEFW	78		;2400 Baud

+	DEFW	51		;3600 Baud

+	DEFW	38		;4800 Baud

+	DEFW	25		;7200 Baud

+	DEFW	18		;9600 Baud

+	DEFW	8		;19200 Baud

+	DEFW	3		;38400 Baud

+;

+;	Datenbereich

+;

+

+ERRBIT:	DEFB	0		; Fehlerbits

+KANAL:	DEFB	0		; Kanal mit Eingabezeichen

+

+CCOUNT:	DEFB	8		; Cursorinvertier Zaehler

+;DCOUNT: DEFB	0		; CHKINT - Weiter Zaehler

+

+DRUCK:	

+	DEFW	0		; aktuelle Groesse des Puffers

+	DEFB	HIGH DBUF	; Drucker-Pufferanfang

+	DEFW	DBUF		; Lesezeiger

+	DEFW	DBUF		; Schreibzeiger

+	DEFB	HIGH (DBUF+1000H); Druckerpufferende (excl.)

+

+SCCATAB:	

+	DEFW	0		; Aktuelle Groesse des Puffers

+	DEFB	HIGH SABUF	; SCCA-Transmitbuffer Anfang im Basisspeicher

+	DEFW	SABUF		; Lesezeiger

+	DEFW	SABUF		; Schreibzeiger

+	DEFB	HIGH (SABUF+0800H); SCCA-Transmitbufferende (excl.)

+	DEFB	SCCAC		; Controlport

+XFLGA:	DEFB	0		; XON/XOFF auf SCCA ausgabeseitig ?

+

+SCCBTAB:	

+	DEFW	0		; aktuelle Groesse des Puffers

+	DEFB	HIGH SBBUF	; SCCB-Transmitbuffer Anfang im Basispeicher

+	DEFW	SBBUF		; Lesezeiger

+	DEFW	SBBUF		; Schreibzeiger

+	DEFB	HIGH (SBBUF+0800H); SCCB-Transmitbufferende (excl.)

+	DEFB	SCCBC		; Controlport

+XFLGB:	DEFB	0		; XON/XOFF auf SCCB ausgabeseitig ?

+

+;****************************************************************

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/L80.COM b/system/shard-z80-ruc-64180/1.5/src/L80.COM
new file mode 100644
index 0000000..c9d5c84
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/L80.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC b/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC
new file mode 100644
index 0000000..e6fa7e2
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC
@@ -0,0 +1,169 @@
+	TITLE	LOADER - SHARD Loader fuer EUMEL System

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+;

+;****************************************************************

+;

+;	Lader fuer SHARD, wird vom Harddisk Boot aufgerufen

+;

+;	Version 1.0 - 22. 10. 1985 - R. Ellerbrake

+;	Version 1.2 - 09.01.1987 - M. Staubermann, Konfigurationsblock

+;

+;****************************************************************

+;

+

+;	Konstanten

+;

+BASE	EQU	1000H		;Lader-Startadresse

+	.PHASE	BASE

+DEST	EQU	8000H		;Zieladresse fuer SHARD

+BOTLNG	EQU	40H

+SHARD	EQU	100H		;SHARD Anfangsadresse

+;

+;

+;	Lader wird ab Adresse 1000H im Apple Speicher gestartet

+;	und kopiert den SHard in den 64180 Speicher

+;

+

+LOAD:

+	LD	A,080H		;0..7FFF:Apple, 8000..FFFF:64180 RAM

+	OUT0	(CBAR),A

+;

+;	Speicherverwaltung umschalten, log. Adr. 0..7FFFH im unteren

+;	Bereich des Apple Speichers liegen lassen, Adresse 8000..FFFFH

+;	auf phys. Adresse 00000H..07FFFH abbilden

+;

+	LD	A,0F8H

+	OUT0	(CBR),A		;F8+8=0! (00000... Phys. = 8000H log.)

+;

+	LD	A,60H		; Jetzt offiziell 60000... = 0000H log.

+	OUT0	(BBR),A		; Wird beim ersten Zugriff auf 180-Memory aktiv

+;

+;	Umschaltroutine kopieren

+;

+	LD	HL,UMSCH-LOAD+BASE

+	LD	DE,DEST

+	LD	BC,CONFLG	 ; Page bis zum Ende uebertragen

+	LDIR

+;

+	LD	A,2		; Burst Mode, Memory <--> Memory Transfer

+	OUT0	(DMODE),A

+

+	LD	BC,8*0100H+SAR0L; 8 Bytes in DMA-Register transportieren

+	LD	HL,DMATAB

+	OTIMR

+

+	LD	A,01000011B	; DMA Kanal 0 starten

+	OUT0	(DSTAT),A

+

+	JP	DEST		; im 64180-Memory starten (noch 8000H)

+

+DMATAB:	

+	DEFW	SHARD+BASE	; SHard liegt noch ab 1100H

+	DEFB	6		; im Basis-Speicher

+	DEFW	SHARD		; soll nach 0100H

+	DEFB	0		; im 64180-Speicher

+	DEFW	(BOTLNG-1)*100H	; Bis auf LOAD-Modul (dieses) alles kopieren

+;

+;	Programmstueck zur RAM-Umschaltung phys. 0 = log. 0

+;

+UMSCH:

+	XOR	A

+	OUT0	(BBR),A		; 0000.7FFF log. = 8000..FFFF log = 00000 phys.

+	JP	SHARD		; von 81xx --> 01xx springen 

+	NOP

+

+CONF:				; Konfigurationsblock

+

+;--------------------------------------------------------------------------

+NOVTST	EQU	200H		; Kein Vortest, kein Speichertest

+NOSTST	EQU	100H		; Vortest, aber kein Speichertest

+FREEU0	EQU	1		; EUMEL0 auf HG freigeben (loeschen!)

+VORTST	EQU	0		; Vortest, Speichertest, (Normalfall)

+

+BLINKP:	

+	DEFB	8		; Blinkdauer des Cursors

+BEEPFRQ:

+	DEFB	10		; Tonfrequenz bei Bell (f = 10kHz/beepfrq)

+ARC31:	

+	DEFB	40H, 0, 0	; LUN der SCSI-Floppy

+MODECONF:

+	DEFW	VORTST

+ID4:

+	DEFW	0		; Lizenznummer des SHards

+ID5:

+	DEFW	0		; Installationsnummer des SHards

+ID6:

+	DEFW	0		; reserviert

+URLK1:

+	DEFB	31		; Archiv

+URLK2:

+	DEFB	0		; HG

+

+	DEFS	1		; free

+

+;--------------------------------------------------------------------------

+

+	DEFS	40H		; Interrupttabelle

+	;ORG	BASE+UMSCH-LOAD+58H	; Nach der Interrupttabelle weiter

+

+

+IKANTAB:			; Zuordnungstabelle fuer phys. --> log.

+				; Kanaele mit Inputinterrupt

+	DEFB	0, 1, 2, 3, 4, 5, 6, 7

+

+KANTAB:				; Zuordnungstabelle fuer log. --> phys.

+				; fuer alle Kanaele

+	DEFB	0, 1, 2, 3, 4, 5, 6, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH

+	DEFB	0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH

+	DEFB	0FFH, 0FFH, 0FFH, 0FFH, 28, 29, 30, 31, 32

+

+IOFTB:				; Kan. def.Funktionen	 Beschreibung

+	DEFB	0CH		;  0  blockin/out	 Hintergrund

+	; Stream I/O & Block I/O

+	DEFB	0FH		;  1  blockin/out,iint/outvar Konsole-Terminal

+	DEFB	03H		;  2  iint/outvar	 SCCB-Terminal

+	DEFB	03H		;  3  iint/outvar	 SCCA-Terminal

+	DEFB	02H		;  4  outvar     	 Drucker 180-Card

+	DEFB	03H		;  5  iint/outvar	 Terminal Motherb.

+	DEFB	02H		;  6  outvar     	 Drucker Motherb.

+	DEFB	00H		;  7  -----------	 nicht definiert

+	DEFB	00H		;  8  -----------	 nicht definiert

+	DEFB	00H		;  9  -----------	 nicht definiert

+	DEFB	00H		; 10  -----------	 nicht definiert

+	DEFB	00H		; 11  -----------	 nicht definiert

+	DEFB	00H		; 12  -----------	 nicht definiert

+	DEFB	00H		; 13  -----------	 nicht definiert

+	DEFB	00H		; 14  -----------	 nicht definiert

+	DEFB	00H		; 15  -----------	 nicht definiert

+	DEFB	00H		; 16  -----------	 nicht definiert

+	; Block I/O

+	DEFB	00H		; 17  -----------	 nicht definiert

+	DEFB	00H		; 18  -----------	 nicht definiert

+	DEFB	00H		; 19  -----------	 nicht definiert

+	DEFB	00H		; 20  -----------	 nicht definiert

+	DEFB	00H		; 21  -----------	 nicht definiert

+	DEFB	00H		; 22  -----------	 nicht definiert

+	DEFB	00H		; 23  -----------	 nicht definiert

+	; Privilegierte Block I/O

+	DEFB	00H		; 24  -----------	 nicht definiert

+	DEFB	00H		; 25  -----------	 nicht definiert

+	DEFB	00H		; 26  -----------	 nicht definiert

+	DEFB	00H		; 27  -----------	 nicht definiert

+	DEFB	0CH		; 28  blockin/blockout	 CP/M-Harddisk-Volume

+	DEFB	0CH		; 29  blockin/blockout	 Apple-Drive 1

+	DEFB	0CH		; 30  blockin/blockout	 Apple-Drive 0

+	DEFB	1CH		; 31  format,blockin/out SCSI-Floppy

+

+CPMOFS:	DEFB	00H, 0AH, 60H	; Anfang eines CP/M Volumes

+CPMLAST:DEFB	00H, 2AH, 60H	; Ende+1 des CP/M Volumes

+

+CONFLG	EQU	$-UMSCH

+	.DEPHASE

+;

+;****************************************************************

+;

+	END

+

diff --git a/system/shard-z80-ruc-64180/1.5/src/M80.COM b/system/shard-z80-ruc-64180/1.5/src/M80.COM
new file mode 100644
index 0000000..d575728
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/M80.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC b/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC
new file mode 100644
index 0000000..f52f900
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC
@@ -0,0 +1,112 @@
+

+; NIBLE.INC for RUC180-Card on BASIS 108

+;

+; Version 08.09.85

+

+

+nible2    ds    57

+

+slot10    db     0

+

+iob_old_S db     60

+iob_old_D db     60

+

+head_table db    0,60,60,60,60,60

+

+slotn     db     60,50,40

+

+time0     db     01,30,28,24,20,1E,1D,1C

+time1     db     70,2C,26,22,1F,1E,1D,1C

+          

+

+step_wait:

+	lda	#00		; wird gepatcht

+wait

+          LDX       #11

+wait0     DEX

+          BNE       wait0

+          INC       wait_Cnt

+          BNE       wait1

+          INC       wait_Cnt+1

+wait1     SEC

+          SBC       #01

+          BNE       wait

+          RTS

+

+          ds	    96-low(*-start)		

+

+to_bits

+          db                             000,004

+          db     098,099,008,00C,09C,010,014,018

+          db     0A0,0A1,0A2,0A3,0A4,0A5,01C,020

+          db     0A8,0A9,0AA,024,028,02C,030,034

+          db     0B0,0B1,038,03C,040,044,048,04C

+          db     0B8,050,054,058,05C,060,064,068

+

+         ;LDA       #xx         2

+         ;JSR       wrtnibl     6   6

+wrt_nibl                    ;              len=10

+          CLC               ;     2

+wrt_nibl1

+          PHA               ;     3   3

+          PLA               ;     4   4

+wrt_nibl2

+          STA       Q6on,X  ;     5   5

+          ORA       Q6off,X ;     4   4

+          RTS               ;   + 6 + 6

+                            ;  ---- ---

+                            ;    32  28 uS

+          

+          db             0CA,06C,0CC,070,074,078

+          db     0D0,0D1,0D2,07C,0D4,0D5,080,084

+          db     0D8,088,08C,090,094,098,09C,0A0

+          db     0E0,0E1,0E2,0E3,0E4,0A4,0A8,0AC

+          db     0E8,0B0,0B4,0B8,0BC,0C0,0C4,0C8

+          db     0F0,0F1,0CC,0D0,0D4,0D8,0DC,0E0

+          db     0F8,0E4,0E8,0EC,0F0,0F4,0F8,0FC

+

+          if	low(*-start) ne 0 

+          .printx  'Missing bytes !'

+          endif

+

+to_bytes

+          db     000,000,000

+to_nibble

+          db                 096,002,000,000,097

+          db     001,000,000,09A,003,000,000,09B

+          db     000,002,000,09D,002,002,000,09E

+          db     001,002,000,09F,003,002,000,0A6

+          db     000,001,000,0A7,002,001,000,0AB

+          db     001,001,000,0AC,003,001,000,0AD

+          db     000,003,000,0AE,002,003,000,0AF

+          db     001,003,000,0B2,003,003,000,0B3

+          db     000,000,002,0B4,002,000,002,0B5

+          db     001,000,002,0B6,003,000,002,0B7

+          db     000,002,002,0B9,002,002,002,0BA

+          db     001,002,002,0BB,003,002,002,0BC

+          db     000,001,002,0BD,002,001,002,0BE

+          db     001,001,002,0BF,003,001,002,0CB

+          db     000,003,002,0CD,002,003,002,0CE

+          db     001,003,002,0CF,003,003,002,0D3

+          db     000,000,001,0D6,002,000,001,0D7

+          db     001,000,001,0D9,003,000,001,0DA

+          db     000,002,001,0DB,002,002,001,0DC

+          db     001,002,001,0DD,003,002,001,0DE

+          db     000,001,001,0DF,002,001,001,0E5

+          db     001,001,001,0E6,003,001,001,0E7

+          db     000,003,001,0E9,002,003,001,0EA

+          db     001,003,001,0EB,003,003,001,0EC

+          db     000,000,003,0ED,002,000,003,0EE

+          db     001,000,003,0EF,003,000,003,0F2

+          db     000,002,003,0F3,002,002,003,0F4

+          db     001,002,003,0F5,003,002,003,0F6

+          db     000,001,003,0F7,002,001,003,0F9

+          db     001,001,003,0FA,003,001,003,0FB

+          db     000,003,003,0FC,002,003,003,0FD

+          db     001,003,003,0FE,003,003,003,0FF

+

+          if       low (*-start) ne 0

+          .printx  'Missing bytes'

+          endif

+

+; Ende von NIBLE.INC

diff --git a/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC b/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC
new file mode 100644
index 0000000..d9a99f1
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC
@@ -0,0 +1,37 @@
+;

+;----------------------------------------------------------------

+;

+;	Port-Adressen

+;

+SCCAC	EQU	41H		;Z8530 (SCC) Kanal A Control

+SCCAD	EQU	43H		;Z8530 (SCC) Kanal A Daten

+SCCBC	EQU	40H		;Z8530 (SCC) Kanal B Control

+SCCBD	EQU	42H		;Z8530 (SCC) Kanal B Daten

+;

+CIOAD	EQU	52H		;Z8536 (CIO) Kanal A Daten

+CIOBD	EQU	51H		;Z8536 (CIO) Kanal B Daten

+CIOCD	EQU	50H		;Z8536 (CIO) Kanal C Daten

+CIOCTL	EQU	53H		;Z8536 (CIO) Control Register

+;

+SCSIP	EQU	80H		;SCSI-Daten-Port

+;

+RTCS	EQU	0C0H		; Sekunden RTC

+RTCSA	EQU	0C1H		; Sekunden Alarm

+RTCM	EQU	0C2H		; Minuten RTC

+RTCMA	EQU	0C3H		; Minuten Alarm

+RTCH	EQU	0C4H		; Stunden RTC

+RTCHA	EQU	0C5H		; Stunden Alarm

+

+RTCDW	EQU	0C6H		; Day of Week RTC 1..7

+RTCDY	EQU	0C7H		; Day of Month 1..31

+RTCMO	EQU	0C8H		; Month 1..12

+RTCYR	EQU	0C9H		; Year 0..99

+

+RTCRA	EQU	0CAH		; Register A, Devider...

+RTCRB	EQU	0CBH		; Register B, Mode-Flags

+RTCRC	EQU	0CCH		; Register C, Interrupt-Flags

+RTCRD	EQU	0CDH		; Register D, VRT-Bit

+

+RTCRAM	EQU	0CEH		; Ab hier bis 0FFH Batary-RAM

+;

+;----------------------------------------------------------------

diff --git a/system/shard-z80-ruc-64180/1.5/src/SC.COM b/system/shard-z80-ruc-64180/1.5/src/SC.COM
new file mode 100644
index 0000000..49872e0
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SC.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC b/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC
new file mode 100644
index 0000000..32c0583
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC
@@ -0,0 +1,1477 @@
+

+	TITLE	SCSI Interface fuer RUC 180 Karte

+

+	INCLUDE	HD64180.LIB

+

+	.LIST

+

+;****************************************************************

+;

+;	S C S I

+;

+;	Elementare Ein- und Ausgaben auf dem SCSI Interface

+;

+;	Version 0.7, R. Ellerbrake

+;	Version 0.8 vom 31.12.86, M.Staubermann

+;

+;	Copyright (C) 1985 by R. Ellerbrake

+;

+;	Vers. 0.2: Kommando Transfer per DMA wieder eingebaut

+;	Vers. 0.3: Reset Signal implementiert

+;	Vers. 0.4: automatische Erkennung 40/80 Spuren Archiv

+;

+;****************************************************************

+

+;	Conditional Switches

+

+FALSE	EQU	0

+TRUE	EQU	NOT FALSE

+

+DMA	EQU	TRUE		;-1 = Daten nur per DMA ausgeben

+EUMEL	EQU	TRUE		;EUMEL Version

+SEC8	EQU	FALSE		;-1 = 8 Sektor Floppy

+TRK40	EQU	FALSE		;-1 = Voreinst. 2x40 Spuren

+DEBUG	EQU	FALSE		; Retries bei DMA/Hardwarefehler

+

+;----------------------------------------------------------------

+

+;	Globale Adressen

+

+	GLOBAL	SCSIIO, PHYSADR, INITS

+	GLOBAL	HDIO, FDIO, INIFLP, INITS1, PARKHD

+;

+;----------------------------------------------------------------

+

+;	Externe Adressen

+

+	IF	EUMEL

+

+	EXTERNAL WARTE

+

+	ENDIF

+

+;----------------------------------------------------------------

+

+;	Port-Adressen

+

+CIOAD	EQU	52H		;Z8536 (CIO) Kanal A Daten

+CIOCD	EQU	50H		;Z8536 (CIO) Kanal C Daten

+CIOCTL	EQU	53H		;Z8536 (CIO) Control Register

+

+SCSIP	EQU	80H		;SCSI I/O Port

+

+;................................................................

+

+;	Masken und Bits fuer CIO

+

+MBUSY	EQU	08H		;BUSY-Signal von SCSI Schnittstelle

+MMSG	EQU	10H		;Message-Signal von SCSI Schnittstelle

+MDC	EQU	20H		;Data(0)/Command(1) Sig. von SCSI

+MREQ	EQU	80H		;REQ-Signal vom SCSI-Controller

+MIO	EQU	04H		;I/O Signal von SCSI (0=Tr. Host -> SCSI)

+MSELS	EQU	02H		;Select Signal zum SCSI Interface

+

+BSELS	EQU	1		;Bitnummern

+BIO	EQU	2

+BBUSY	EQU	3

+BMSG	EQU	4

+BDC	EQU	5

+BREQ	EQU	7

+

+BRESS	EQU	3		;Reset-Signal fuer SCSI Controller

+MRESS	EQU	78H		;Maske zum Bit setzen (Bit 3)

+

+PCOMA	EQU	8		;Port A Command and Status

+

+;................................................................

+

+;	SCSI-Kommandos

+

+TST_RDY		EQU	0	;Drive Ready pruefen

+RECALIBR	EQU	1	;Drive recalibrieren

+REQ_STAT	EQU	3	;Fehlerstatus holen

+FORMAT		EQU	4	;Diskette oder Harddisk formatieren

+CHK_FORM	EQU	5	;Harddisk Format kontrollieren

+FRM_TRKS	EQU	6	;Spuren formatieren

+SREAD		EQU	8	;Sektoren lesen (1 od. mehrere)

+SVREAD		EQU	9	;Read Verify

+SWRITE		EQU	10	;Sektoren schreiben (")

+SEEK		EQU	11	;Auf Block positionieren

+WBUFFER		EQU	15	;Write Controller Buffer

+INITDRV		EQU	17	;Disk Parameter setzen

+RINIT		EQU	18	;Disk Parameter lesen

+FD48TPI		EQU	6*32+4	;Floppy im Doppelstepmodus betreiben

+FD96TPI		EQU	6*32+3	;Floppy im Singlestepmodus betreiben

+

+FDDRIV		EQU	0	;Floppy Laufwerk Nr.

+

+;................................................................

+

+;	Werte fuer SCSIIO-Aufruf

+

+DMATRA	EQU	4000H		;Datentransfer per DMA

+;DMATRA	EQU	0		;** TEST **

+RDDAT	EQU	8000H		;Lesen vom Controller

+

+;................................................................

+

+;	DMA-Controller Werte

+

+ENABDMA	EQU	90H		;Enable Kanal 1 DMA (keine Interrupts)

+DISDMA	EQU	10H		;Disable Kanal 1 DMA (-> DSTAT)

+DE1	EQU	7		;Bitnummer in DSTAT

+

+CH1MSK	EQU	0F4H		;Nicht fuer Kanal 1 wichtige Bits maskieren

+CHGDIR	EQU	2		;Aenderung der Transferrichtung (-> DCNTL)

+

+;................................................................

+

+;	Fehlernummern

+

+WPROTE	EQU	13H		; Diskette Schreibgeschuetzt

+TSNF	EQU	14H		; Target Sector not found

+

+HARD	EQU	0F0H		;Kennung Hardware bzw. Kommandofehler

+

+NOCONT	EQU	0		;SCSI-Controller nicht angeschlossen

+TIMOUT	EQU	1		;Timeout Fehler bei SCSI I/O

+ENDERR	EQU	2		;Falsches Kommandoende

+ILLD	EQU	3		;Falsche Datenrichtung

+EARLYE	EQU	4		;vorzeitiges Kommandoende

+ILLCOM	EQU	5		;Fehler bei Kommandoausgabe

+STRERR	EQU	6		;Fehler beim Status lesen

+DMAERR	EQU	7		;Fehler beim DMA Transfer

+UNKNOWN	EQU	8		;undefinierte Fehlerfaelle

+MULCNT	EQU	10		; Reset nach 10 hardwarefehlern

+

+;----------------------------------------------------------------

+

+;	Lokale Daten

+

+	DSEG

+

+SCSIST:	DEFS	4		;4 Byte Stati

+CODALN:	DEFW	0		;Datenlaenge

+SEMA:	DEFB	0		;Zugriffs-Semaphor

+TOFLG:	DEFB	0		;Timeoutflag

+

+	IF DEBUG

+RETRCN:	DEFB	4		;Retry Flag

+HERCNT:	DEFB	10		;Hardwarefehlerzaehler

+	ENDIF

+

+	CSEG

+

+;****************************************************************

+;

+;	SCSIIO

+;

+;	Elementare Ausgabe auf SCSI-Interface

+;

+;	Entry:	HL = Zeiger auf Datenbereich (falls vorhanden)

+;		DE = Zeiger auf Kommandobereich (immer 6 Byte)

+;		BC = Groesse des Datenbereichs (0=nicht vorhanden)

+;		B Bit 7: 1 = Lesen vom SCSI-Controller

+;			 0 = Schreiben auf SCSI-Controller

+;		B Bit 6: 1 = Datentransfer per DMA

+;		         0 = Datentransfer per Programm

+;

+;	Exit:	A  = Status (0 = ok, <>0 = Fehlercode)

+;		alle anderen Register (ausser AF) unveraendert

+;

+SCSIIO:

+	IF DEBUG

+	LD	A,3		;Retries bei Unknown Error

+	ENDIF

+

+NRETSC:

+	IF DEBUG

+	LD	(RETRCN),A

+	ENDIF

+

+	PUSH	HL

+	PUSH	BC

+	PUSH	DE

+

+	CALL	SCSI2		;Kommando ausfuehren

+	LD	L,A

+	AND	9FH		;Drive Code ausmaskieren

+	JR	Z,EOCOM		;Kein Fehler ->

+

+	CP	2		;SCSI-Fehler ?

+	LD	A,L

+	JR	NZ,EOCOM	;Nein -> fertig

+

+	POP	HL		;Kommandotab.-Adr.

+	PUSH	HL

+	LD	A,(HL)		;altes Kommando retten

+	PUSH	AF

+	LD	A,HARD+STRERR	;Fehler beim Status lesen annehmen

+	LD	(SCSIST),A

+	LD	(HL),REQ_STAT	;Kommando 3: Request Status

+	EX	DE,HL

+	LD	BC,4+RDDAT	;4 Byte Status Informationen

+	LD	HL,SCSIST	;Statusbereich

+	CALL	SCSI2

+	POP	AF

+	POP	HL

+	LD	(HL),A		;altes Kommando zurueckschreiben

+	PUSH	HL

+	LD	A,(SCSIST)

+	RES	7,A

+	AND	A		;Meldung: kein Fehler ?

+	JR	NZ,EOCOM

+

+;	kein Fehler: falsche Meldung da vorher einer aufgetreten war !!

+

+	LD	A,HARD+UNKNOWN	;unbekannnter Fehler melden

+

+EOCOM:

+	POP	DE

+	POP	BC

+	POP	HL

+

+	IF DEBUG

+	CP	HARD+ENDERR

+	JR	C,RETSCSI

+

+	LD	A,(RETRCN)

+	DEC	A

+	JR	NZ,NRETSC	;Retries bei "Unknown Error"

+

+	LD	A,HARD+UNKNOWN

+RETSCSI:

+	PUSH	HL

+	LD	HL,HERCNT	;Hardware Fehler Zaehler

+	CP	HARD		;Hardware Fehler ?

+	JR	C,NOHER		;Nein ->

+

+	DEC	(HL)

+	JR	NZ,EOHER	;nicht mehrere Hardwarefehler hintereinander

+

+	LD	(HL),MULCNT

+	PUSH	AF

+	PUSH	DE

+	PUSH	BC

+	CALL	INITS1		;Schnittstelle neu initialisieren

+	POP	BC

+	POP	DE

+	POP	AF

+	JR	EOHER

+

+NOHER:

+	LD	(HL),MULCNT

+

+EOHER:

+	POP	HL

+	ENDIF

+

+	AND	A

+	RET

+

+;................................................................

+;

+;	SCSI2

+;

+;	Kommandoausgabe auf dem SCSI-Interface

+;

+;	Entry-Parameter wie SCSIIO

+;

+;	Exit:	A = 0: alles ok

+;		A = 2: Fehler ist aufgetreten

+;		A >= F0H: Hardware oder Bedienungsfehler

+;

+SCSI2:

+	PUSH	BC		;Laenge retten

+

+;	Pruefen ob letzter DMA beendet wurde

+

+	IN0	A,(DSTAT)	;DMA beendet ?

+	BIT	DE1,A

+	JR	Z,DMAOK		;Ja ->

+

+	LD	A,DISDMA	;Reset Kanal 1 DMA

+	OUT0	(DSTAT),A

+

+DMAOK:

+ 	LD	BC,CIOAD	;B=0 !

+	JR	TENDLP

+

+;	"Bus free", Controller selektieren

+

+BUSYOK:

+	IN	A,(C)

+	SET	BSELS,A		;Select Leitung aktivieren

+	OUT	(C),A

+	RES	BSELS,A		;und wieder zuruecknehmen

+	OUT	(C),A

+

+;	"Command Phase"

+

+	XOR	A

+

+WAIREQ:

+	PUSH	AF		;Auf Kommandoanforderung warten

+	IN	A,(C)

+	AND	MDC+MREQ+MIO+MMSG

+	CP	MDC+MREQ

+	JR	Z,RDYCOM	;Ok ->

+

+	POP	AF

+	DEC	A

+	JR	NZ,WAIREQ

+

+;	keine Reaktion der Schnittstelle: Versuchen Restbytes einzulesen  falls

+;	dies nicht der 2. Timeout ist.

+

+	LD	A,(TOFLG)	;Timeoutflag gesetzt ?

+	AND	A

+	LD	A,HARD+TIMOUT	;Timeout Fehler

+	JP	NZ,POPRET	;bereits gesetzt ->

+

+	LD	(TOFLG),A	;Timeoutflag setzen

+

+;	ggf. letztes Kommando abschliessen

+

+TENDLP:

+	IN0	A,(CIOAD)	;"Bus free" ?

+	BIT	BBUSY,A

+	JR	Z,BUSYOK	;Ja -> neu selektieren

+

+	CALL	CHKREQ

+	BIT	BIO,A

+	JR	NZ,INPU

+

+	XOR	A

+	OUT0	(SCSIP),A

+	JR	TENDLP

+

+INPU:

+	IN0	A,(SCSIP)

+	JR	TENDLP

+

+ILLMOD:

+	LD	A,HARD+ILLCOM	;Fehler bei Kommandoausgabe

+	JP	POPRET

+

+;	Kommando Ausgabe

+

+RDYCOM:

+	POP	AF		;Clear Stack

+	LD	BC,SCSIP+6*256	;6 Bytes ausgeben

+	EX	DE,HL

+

+CMNON:

+	CALL	CHKREQ

+	CP	MDC

+	JR	NZ,ILLMOD	;keine Kommandoausgabe -> Fehler

+

+	DI

+	OTIM			;Kommando ausgeben

+	EI

+	JR	NZ,CMNON	;Nicht fertig ->

+

+;	"Data Phase"

+

+	POP	HL		;B=0!

+	PUSH	HL

+	LD	A,H		;Datenlaenge = 0 ?

+	AND	3FH		;Bit 6 und 7 ausblenden

+	OR	L

+	JP	Z,NODAT		;Ja -> keine Datenphase

+

+	IF	NOT DMA

+

+	BIT	6,H		;Datentransfer per DMA ?

+	JR	Z,DTAPROG	;Nein -> per Programm

+

+	ENDIF

+

+;	CIO Pattern Match Logik aktivieren

+

+	DI

+	LD	C,CIOCTL	;CIO Control Register

+	LD	A,PCOMA		;Port A Command Register

+	OUT	(C),A

+	LD	A,20H		;Clear IP & IUS

+	OUT	(C),A

+	EI

+

+;*	IF	DMA AND EUMEL

+

+;*	BIT	7,H		;schreiben ?

+;*	JR	Z,POLWRIT

+

+;*	ENDIF

+

+;	DMA-Kanal 1 initialisieren (I/O Adresse wird in SCINIT gesetzt)

+

+	CALL	DMASTUP		;DMA-Adressen eintragen

+

+;*	IF	NOT EUMEL

+

+	BIT	7,H		;lesen ?

+	JR	Z,ISWRITE	;Nein ->

+

+;*	ENDIF

+

+	OR	CHGDIR		;Richtung aendern (I/O -> Memory)

+

+ISWRITE:

+	OUT0	(DCNTL),A

+	LD	A,ENABDMA	;DMA aktivieren

+	OUT0	(DSTAT),A

+

+;	Auf Kommandoende warten

+;	Die CIO ist so initialisiert dass der SCSI-Status "Status lesen"

+;	einen Pattern Match Zustand erzeugt

+

+WEND2:

+	LD	C,CIOCTL	;auf Pattern Match warten

+

+WAIEND:

+

+	IN0	L,(DSTAT)	;DMA Status pruefen

+	DI

+	LD	A,PCOMA		;Port A Command Register

+	OUT	(C),A

+	IN	A,(C)		;CIO Status lesen (Port A Statusregister)

+	BIT	5,A		;Interrupt pending ?

+	JR	NZ,DATRDY	;Ja -> Datentransfer beendet

+

+	EI

+	IN0	A,(CIOAD)

+	BIT	BBUSY,A		;steht Busy noch an ?

+	JR	Z,ILLEND

+

+	BIT	DE1,L		;DMA beendet ?

+	JR	Z,DMAEND

+

+NOEND:

+	IF	EUMEL

+	CALL	WARTE		;andere Tasks zulassen

+	ENDIF

+

+	JR	WAIEND

+

+;	Pruefen ob ein DMA-Fehler aufgetreten ist

+

+DMAEND:

+	IN0	A,(CIOAD)

+

+	BIT	BREQ,A		;Anforderung ?

+	JR	Z,NOEND		;Nein -> warten

+

+	AND	MDC+MIO+MMSG

+	CP	MDC+MIO		;Statusanforderung ?

+	JR	Z,CMNST		;Ja -> alles in Ordnung

+

+;	Fehler beim DMA-Transfer

+

+	LD	L,HARD+DMAERR

+	JR	WENDLP

+

+DATRDY:

+	IN	A,(C)		;Pattern match testen

+	EI

+	BIT	1,A

+	JR	Z,ENDKL		;Nein -> DMA hat Status geklaut

+

+CMNST:

+

+	IN0	L,(SCSIP)	;Status holen

+

+;	Letztes Statusbyte holen (Kommandoende)

+

+	CALL	CHKREQ

+	IN0	H,(SCSIP)	;letzten Status einlesen (Dummy Read)

+	CP	MDC+MIO+MMSG	;wirklich letzter Status ?

+	JR	Z,ENDOK		;Ja ->

+

+ILLEND:

+	LD	L,HARD+ENDERR

+

+ENDOK:

+	LD	A,L		;Status in A

+

+POPRET:

+	POP	BC

+

+;	Interrupt Daisy Chain der CIO freigeben

+

+	DI

+	LD	L,PCOMA		;Port A Command

+	OUT0	(CIOCTL),L

+	LD	L,20H		;Clear IP & IUS

+	OUT0	(CIOCTL),L

+	EI

+	RET

+

+ENDKL:

+

+;	DMA anhalten falls dieser nicht beendet wurde

+

+	LD	L,DISDMA	;Reset Kanal 1 DMA

+	OUT0	(DSTAT),L

+	LD	L,2		;Error Status

+

+WENDLP:

+	IN0	A,(CIOAD)	;"Bus free" ?

+	BIT	BBUSY,A

+	JR	Z,ENDOK		;Ja -> fertig

+

+	CALL	CHKREQ

+	BIT	BIO,A

+	JR	NZ,INPU2

+

+	XOR	A

+	OUT0	(SCSIP),A

+	JR	WENDLP

+

+INPU2:

+	IN0	A,(SCSIP)	;Dummy Read

+	JR	WENDLP

+

+	IF	NOT DMA

+

+;	Datentransfer bei Schreiben per Programm

+

+POLWRIT:

+	CALL	CHKREQ

+	JR	NZ,NODAT	;Kein Datentransfer -> Fehler

+

+	BIT	BIO,A		;Lesen von SCSI ?

+	JR	NZ,DIRERR	;Ja -> falsche Richtung

+

+	LD	A,(DE)		;Daten holen

+	OUT0	(SCSIP),A	;und ausgeben

+

+	INC	DE		;Datenadresse inkrementieren

+	DEC	HL		;Datenlaenge dekrementieren

+	LD	A,H		;Fertig ?

+	AND	3FH

+	OR	L

+	JR	NZ,POLWRIT	;Nein -> naechstes Byte holen

+

+	JP	WEND2

+

+;	Falsche Datenrichtung (falsches Kommando)

+

+DIRERR:

+	LD	A,HARD+ILLD

+	JR	POPRET

+

+;	Datentransfer per Programm

+

+DTAPROG:

+	CALL	CHKREQ

+	JR	NZ,NODAT	;Kein Datentransfer -> Fehler

+

+	BIT	BIO,A		;Lesen von SCSI ?

+	JR	NZ,RDSCSI	;Ja ->

+

+	BIT	7,H		;Schreiben definiert ?

+	JR	NZ,DIRERR	;Nein -> falsche Richtung !!

+

+	LD	A,(DE)		;Daten holen

+	OUT0	(SCSIP),A	;und ausgeben

+

+	JR	CMDIO

+

+RDSCSI:

+	BIT	7,H		;Lesen definiert ?

+	JR	NZ,RDSOK	;Ja ->

+

+;	Falsche Datenrichtung (falsches Kommando)

+

+DIRERR:

+	LD	A,HARD+ILLD

+	JR	POPRET

+

+RDSOK:

+	IN0	A,(SCSIP)	;Daten holen

+	LD	(DE),A

+

+CMDIO:

+	INC	DE		;Datenadresse inkrementieren

+	DEC	HL		;Datenlaenge dekrementieren

+	LD	A,H		;Fertig ?

+	AND	3FH

+	OR	L

+	JR	NZ,DTAPROG	;Nein -> naechstes Byte holen

+

+	ENDIF

+

+;	Status lesen

+

+NODAT:

+	CALL	CHKREQ

+	CP	MDC+MIO		;Status Anforderung ?

+	JR	NZ,ILLEND	;Nein -> Fehler

+	JR	CMNST

+

+;................................................................

+;

+;	Pruefen ob Busy und Request anstehen

+;

+;	Exit:	A = CIO Port A SCSI-Status Leitungen (ohne BUSY und REQ)

+;		F = Z: Datentransfer

+;

+CHKREQ:

+	IN0	A,(CIOAD)

+	BIT	BBUSY,A		;Busy aktiv ?

+	JR	Z,INCOMPL	;Nein -> vorzeitiges Kommandoende

+

+	BIT	BREQ,A		;Anforderung ?

+	JR	Z,CHKREQ	;Nein -> warten

+

+	AND	MDC+MIO+MMSG

+	BIT	BDC,A

+	RET

+

+INCOMPL:

+	POP	HL		;Skip Return Adresse

+	LD	A,HARD+EARLYE	;vorzeitiges Ende

+	JR	POPRET

+

+;................................................................

+;

+;	DMASTUP

+;

+;	Adressen des DMA-Kanals 1 eintragen

+;

+;	Entry:	DE = log. Adresse

+;		DE = 0: auf 6502 Bereich FC00 schalten

+;

+;	Exit:	A = (DCNTL) Kanal 1

+;

+DMASTUP:

+	DI

+	LD	A,D

+	OR	E

+	JR	NZ,DOCHG

+

+	LD	A,6

+	LD	D,0FDH		; 6FD00..6FEFF ist SCSI-Puffer

+	JR	NOCHG

+

+DOCHG:

+	CALL	PHYSADR		;Physikalische Adresse bestimmen (in ADE)

+

+NOCHG:

+	LD	C,MAR1L		;Adressen eintragen

+	OUT	(C),E		;Speicheradresse eintragen (LSB)

+	INC	C

+	OUT	(C),D		;mittleres Byte

+	INC	C

+	OUT	(C),A		;upper Byte

+	LD	C,BCR1L

+	OUT	(C),L		;Byte Zaehler (LSB)

+	INC	C

+	LD	A,H

+	AND	3FH

+	OUT	(C),A		;MSB

+

+	IN0	A,(DCNTL)	;DMA-Richtung setzen

+	AND	CH1MSK		;nur DMA-Kanal 1 Bits veraendern !

+	EI

+	RET

+

+;................................................................

+;

+;	P H Y S A D R

+;

+;	Umrechnung der logischen in eine physikalische Adresse

+;

+;	Entry:	DE = logische Adresse im 64K Adressraum

+;

+;	Exit:	DE = niederwertiger Teil der phys. Adr. im 512K Adr.-raum

+;		A  = hoechstwertiges Nibble der phys. Adr.

+;		alle anderen Register bleiben unveraendert

+;

+PHYSADR:

+	INC	D		;Fuer Vergleiche

+	IN0	A,(CBAR)	;Common Bank Area Register

+	PUSH	AF

+	AND	0F0H		;Common Area Teil ausmaskieren

+	CP	D		;D >= Common Area 1 Anfang ?

+	JR	C,COMA1		;Ja -> (Stack!!)

+

+	POP	AF

+	AND	0FH		;Bank Area Teil ausmaskieren

+	RLCA

+	RLCA

+	RLCA

+	RLCA			;und ins MSN schieben

+	CP	D		;D >= Bank Area Anfang ?

+	JR	C,BAR		;Ja ->

+

+;	Common Area 0 (unveraenderte Adresse)

+

+	DEC	D		;D wieder korrigieren

+	XOR	A

+	RET

+

+;	Bank Area

+

+BAR:

+	DEC	D

+	IN0	A,(BBR)		;Bank Base Register

+

+CMND:

+	PUSH	BC

+	LD	B,0

+	SLA	A

+	RL	B

+	SLA	A

+	RL	B

+	SLA	A

+	RL	B

+	SLA	A

+	RL	B		;B = MSN Phys. Adr., A = mittleres MSB

+

+	ADD	A,D		;+ Offset zum Area Anfang

+	LD	D,A		;wieder in D (mittleres MSB der phys. Adr.)

+	LD	A,B		;A = MSN

+	ADC	A,0		;ggf. 64K-Uebertrag beruecksichtigen

+	POP	BC

+	RET

+

+;	Common Area 1

+

+COMA1:

+	DEC	D		;D wieder korrigieren

+	POP	AF		;Clear Stack

+	IN0	A,(CBR)

+	JR	CMND

+

+	IF	EUMEL

+

+;................................................................

+;

+;	C H K A C C

+;

+;	Auf Freiwerden des SCSI-Controllers warten

+;

+CHKACC:

+	LD	A,(SEMA)	;SCSI-Zugriffssemaphor

+	AND	A		;0=frei

+	JR	Z,ISFREE	;Ja ->

+	CALL	WARTE

+	JR	CHKACC

+

+ISFREE:

+	DEC	A

+	LD	(SEMA),A	;Semaphor sperren

+	RET

+

+	ENDIF

+

+;................................................................

+;

+;	I N I T S

+;

+;	Initialisierung der SCSI-Schnittstelle

+;

+;	CIO und DMA Kanal 1 werden initialisiert

+;	Floppy Parameter werden gesetzt

+;

+;	Exit:	AF', BC, DE und HL werden veraendert

+;		AF = Status des Floppy Parameters setzens

+;

+INITS1:

+	IF 	NOT EUMEL

+	CALL	INICIO

+	ENDIF

+

+INITS:

+	IF	EUMEL

+	XOR	A

+	LD	(SEMA),A	;Semaphor initialisieren

+	ENDIF

+

+	LD	C,DISDMA

+	OUT0	(DSTAT),C	;Kanal 1 stoppen, beide Kanaele keine

+				; Interrupts zulassen

+

+;	DMA - Kanal 0 intialisieren (Memory <--> Memory Transfer)

+

+	LD	C,2		; Memory <--> Memory im Burst Mode

+	OUT0	(DMODE),C

+

+;	DMA - Kanal 1 initialisieren (Memory <--> SCSI I/O - Transfer)

+

+	LD	BC,SCSIP	;DMA-Kanal 1 I/O Adresse auf SCSI setzen

+	OUT0	(IAR1L),C

+	OUT0	(IAR1H),B

+

+;	Warten bis Harddisk hochgelaufen ist

+

+	IF NOT EUMEL

+WRTHRD:

+	LD	DE,TESTRD

+	LD	BC,0

+	CALL	SCSIIO

+	AND	A		;Drive not Ready ?

+	JR	NZ,WRTHRD	;Ja -> warten

+

+	ENDIF

+

+;	Teil der bei Controller RESET neu initialisert werden muss

+

+SCINIT:

+

+;	Floppy Parameter setzen

+

+	LD	DE,FLPINI	;Initialize Kommando

+	LD	HL,FLPDAT	;Parameter

+	LD	BC,PARALNG	;Anzahl der Parameter Bytes

+	CALL	SCSIIO

+

+	LD	L,A

+	LD	A,(FLPTRKS)

+	CP	40		;40 Tracks ?

+	LD	A,L

+	LD	BC,0

+	LD	DE,SGLSTEP	; Floppy im Doppelstep Modus

+	JR	NZ,NODBLS	;Nein -> kein Double Step

+	LD	DE,DBLSTEP

+NODBLS:

+	JP	SCSIIO

+

+;................................................................

+;

+;	I N I C I O

+;

+	IF NOT EUMEL

+INICIO:

+	DI

+

+;	CIO initialisieren

+

+	IN0	C,(CIOCTL)	;Dummy Read

+	LD	B,INILNG

+	LD	HL,INITAB	;CIO Initialisierungstabelle

+

+INILOP:

+	LD	C,(HL)		;Wert holen

+	OUT0	(CIOCTL),C	;und ausgeben

+	INC	HL

+	DJNZ	INILOP

+	RET

+	ENDIF

+

+;................................................................

+;

+;	P A R K H D

+;

+;	Harddisk in Parkposition fahren

+;

+PARKHD:

+

+	LD	BC,0

+	LD	DE,PARSEK	; seek (0)

+	CALL	SCSIIO

+	LD	DE,RECAL	; Recalibrate

+	JP	SCSIIO

+

+	IF	0

+	LD	HL,INIHDT

+	LD	DE,RDINI

+	LD	BC,RDDAT+PARALNG

+

+	CALL	SCSIIO		;Harddisk Konfiguration lesen

+

+	LD	HL,(INIHDT)	;Spuranzahl (H=LSB!)

+	PUSH	HL

+	INC	H		;um 1 erhoehen

+	JR	NZ,INCOK

+

+	INC	L

+INCOK:

+	LD	(INIHDT),HL

+	LD	HL,RDINI

+	LD	DE,INIHDT

+	LD	(HL),INITDRV	;Init-Schreibkommando eintragen

+	EX	DE,HL

+	LD	BC,PARALNG

+

+	CALL	SCSIIO		;neue, groessere, Konfiguration setzen

+

+	POP	HL

+

+	LD	D,L

+	LD	L,H

+	LD	H,D		;Spuranzahl richtig

+	LD	A,(INIHDT+2)	;Kopfanzahl

+	LD	E,L

+

+HDLOP:

+	DEC	A

+	JR	Z,HDAOK

+

+	ADD	HL,DE

+	JR	HDLOP

+

+HDAOK:

+	XOR	A

+	ADC	HL,HL

+	RLCA

+	ADC	HL,HL		;*4

+	RLCA

+	ADC	HL,HL		;*8

+	RLCA

+	ADC	HL,HL		;*16

+	RLCA

+	ADC	HL,HL		;*32

+	RLCA

+

+;	max. Blocknr. in AHL

+

+	DEC	HL		;-1: 1.Block hinter formatiertem Bereich

+

+	LD	(BKNR),A

+	LD	A,L

+	LD	L,H

+	LD	H,A

+

+	LD	(BKNR+1),HL	;Blocknr. eintragen

+	LD	BC,0		;keine Daten

+	LD	DE,PARSEK

+

+	JP	SCSIIO		;Drive parken

+

+	ENDIF

+

+;................................................................

+;

+;	H D I O

+;

+;	Lesen / Schreiben eines Blocks (512 Byte) auf der Harddisk

+;

+;	Entry:	A  = Kommandocode (0 = Lesen, 1 = Schreiben)

+;		HL = Hauptspeicheradresse 	

+;		BC = Pointer auf Drive und Offset (256 Byte Bloecke)

+;		DE = (512 Byte-) Blocknummer (ohne Offset)

+;

+;		BC + 2 -> Low (Block Offset)

+;		BC + 1 -> Middle (Block Offset)

+;		BC + 0 -> High (BLock Offset) + Drive * 32 

+;

+;	Exit:	A  = Status (0=ok, sonst SCSIIO-Fehlercode)

+;		BC, DE, HL, AF' = veraendert

+;

+FDIO:

+HDIO:

+	PUSH	AF

+	XOR	A

+	LD	(TOFLG),A	;Timeoutflag ruecksetzen

+

+	IF	EUMEL

+

+	CALL	CHKACC		;Pruefen ob SCSI-Controller bereits belegt ist

+

+	ENDIF

+

+	LD	A,(BC)

+	BIT	6,A		;Floppy Drive ?

+	JP	NZ,FDIO1	;Ja ->

+

+	POP	AF

+

+	CP	2

+	JR	C,COMOK1

+

+	LD	A,20H		;illegal Command Code

+	RET

+

+COMOK1:

+	PUSH	HL

+	PUSH	BC

+	CALL	CMSCOM		;Kommandonr. umrechnen

+	LD	(HDIOTB),A	;Kommando eintragen

+	POP	BC

+	LD	HL,(CODALN)	;Datenlaenge

+	PUSH	HL

+	LD	HL,HDIOTB+3	;Harddisk Read Command

+

+	SLA	E		;Blocknummer * 2 (256 Byte Bloecke)

+	RL	D

+

+CMFDIO:

+	INC	BC

+	INC	BC

+	LD	A,(BC)		;Low Offset

+	ADD	A,E		;+ Low Block No.

+	LD	(HL),A		;eintragen

+	DEC	HL

+	DEC	BC

+	LD	A,(BC)		;Middle Offset

+	ADC	A,D		;+ Block No.

+	LD	(HL),A

+	DEC	HL

+	DEC	BC

+	LD	A,(BC)

+	LD	(HL),A		;Drive + High Blocknr.

+	DEC	HL

+	EX	DE,HL		;DE = Read Command Adresse

+	POP	BC		;Datenlaenge

+	POP	HL		;Hauptspeicheradresse

+	CALL	SCSIIO

+

+	IF	EUMEL

+

+	PUSH	AF

+	XOR	A

+	LD	(SEMA),A	;Semaphor freigeben

+	POP	AF

+

+	ENDIF

+

+	RET

+

+;................................................................

+;

+;	I N I F L P

+;

+;	Blockanzahl der Floppy ermitteln (nur BC, A und HL veraendern !!)

+;

+;	Eingang:A = Anzahl Spuren, Voreinstellung (40 oder 80)

+;	Exit:	BC = Blockanzahl der Floppy (in 512 Byte Bloecken)

+;		A  = 0 = ok, <> 0 = SCSI-Fehlercode

+;

+INIFLP:

+	PUSH	AF		; Anzahl Spuren Voreinstellung (40, 80)

+

+	IF	EUMEL

+	CALL	CHKACC		;keine Doppelzugriffe !!

+	ENDIF

+

+	XOR	A

+	LD	(TOFLG),A	;Timeoutflag ruecksetzen

+	POP	AF

+

+	PUSH	HL

+	PUSH	DE

+

+	LD	(FLPTRKS),A	;Spuren eintragen

+	CALL	SCINIT		;Floppy Parameter setzen

+

+	LD	A,2		;Retry-Anzahl

+RETR1:

+	PUSH	AF

+

+	LD	DE,SEK18	; Auf Block 18 (Track 2)

+	LD	BC,RDDAT+512

+	LD	HL,0

+	LD	A,1

+	CALL	NRETSC		;Read ohne Retries 

+

+	AND	7FH

+	LD	C,A

+	JR	Z,OKA		; Format ok

+

+	CP	TSNF		; Target Sector not found ?

+	CALL	Z,TOB		; anderes Format (B) versuchen

+

+	POP	AF		; Anderer Floppy Fehler, Retries

+	DEC	A

+	JR	NZ,RETR1

+

+	XOR	A

+	LD	(SEMA),A

+

+	LD	A,C		; permanenter Fehler

+

+	LD	BC,0

+	POP	DE

+	POP	HL

+	RET

+

+;	auf B Spuren umschalten

+

+TOB:

+	LD	A,(FLPTRKS)

+	XOR	01111000B	; aus 40 wird 80, aus 80 wird 40

+	LD	(FLPTRKS),A

+	CALL	SCINIT		;Floppy Parameter setzen

+	LD	C,TSNF

+	RET

+

+OKA:

+	POP	AF

+	POP	DE

+	POP	HL

+

+	LD	BC,(FLPTRKS)

+

+	IF	SEC8

+	LD	B,8

+	ELSE

+	LD	B,9

+	ENDIF

+

+	MLT	BC

+	SLA	C		;*2: 2 Seiten

+	RL	B

+	XOR	A

+

+	IF	EUMEL

+	LD	(SEMA),A	;Sempahor wieder freigeben

+	ENDIF

+

+	RET	

+

+;................................................................

+;

+;	F D I O

+;

+;	Lesen oder Schreiben eines Blocks (512 Byte) auf der Floppy Disk

+;

+;	Entry:	A  = Kommandocode (0=Lesen, 1=Schreiben, 2=Formatieren)

+;		HL = Hauptspeicheradresse 	

+;		BC = Pointer auf Drive und Offset (512 Byte Bloecke)

+;		DE = (512 Byte-) Blocknummer (ohne Offset)

+;

+;		BC + 2 -> Low (Block Offset)

+;		BC + 1 -> Middle (Block Offset)

+;		BC + 0 -> High (BLock Offset) + Drive * 32 

+;

+;	Exit:	A  = Status (0=ok, sonst SCSIIO-Fehlercode)

+;		BC, DE, HL, AF' = veraendert

+;

+FDIO1:

+	POP	AF

+	CP	3

+	JR	C,COMOK

+

+	LD	A,20H		;illegal Command Code

+	RET

+

+COMOK:

+	PUSH	HL

+	PUSH	BC

+	CP	2

+

+	CALL	Z,SW80		;Beim Formatieren immer 2x80 Spuren 

+

+	CALL	CMSCOM		;Kommando und Datenlaenge best.

+	LD	(FDIOTB),A	;Kommandocode eintragen

+

+	LD	A,C

+	LD	(FDIOTB+4),A	;Block Count / Skew Faktor eintragen

+

+;	DE enthaelt Blocknummer x aus EUMEL-Sicht. 

+;	Block x meint die 512 Bytes ab 512*x auf Floppy.

+;

+;	Aus Blocknummer: Spur, Sector, Seite berechnen

+;

+;	EUMEL behandelt, im Gegensatz zum SCSI-Controller,

+;	zunaechst die Oberseite der Floppy und erst dann die Unterseite.

+ 

+	LD	H,D

+	LD	L,E

+	XOR	A

+

+	IF	SEC8

+	LD	DE,8

+	ELSE

+	LD	DE,9		;Anzahl der Sektoren pro Spur

+	ENDIF

+

+DIVLOP:

+	AND	A

+	SBC	HL,DE

+	JR	C,DIVDON

+	INC	A

+	JR	DIVLOP 

+

+DIVDON:

+	ADD	HL,DE

+

+;	A = Spurnummer; HL = sector/seite

+

+	LD	BC,(FLPTRKS)	;Spuren pro Seite (B undefiniert !)

+	CP	C		;Rueckseite ?

+	JR	C,NOBACK	;Nein -> alles ok

+

+;	Rueckseite: Spurnummer := Spurnummer - Spuranzahl

+;		    Sektornummer := Sektornummer + Sektoranzahl (9)

+

+	SUB	C		;tatsaechliche Spurnummer

+	ADD	HL,DE		;HL = sector (cylinder)

+

+;	SCSI Blocknummer aus Spur und Sektor ausrechnen

+

+NOBACK:

+	LD	D,A

+

+	IF	SEC8

+	LD	E,16

+	ELSE

+	LD	E,18

+	ENDIF

+

+	MLT	DE		;DE = Spur * 18

+	ADD	HL,DE		;HL = Spur * 18 + Sektor (cylinder)

+	EX	DE,HL

+

+;	SCSI Blocknummer in DE

+

+	POP	BC		;Offsetadresse wiederherstellen

+

+	LD	HL,(CODALN)

+	PUSH	HL

+	LD	HL,FDIOTB+3	;Floppy Read Command

+	JP	CMFDIO

+

+SW80:

+	PUSH	AF

+	PUSH	BC

+	PUSH	DE

+	PUSH	HL

+

+	LD	A,80		; 80 Tracks

+	LD	(FLPTRKS),A

+	CALL	SCINIT

+

+	POP	HL

+	POP	DE

+	POP	BC

+	POP	AF

+	RET

+

+;................................................................

+;

+;	C M S C O M

+;

+;	Entry:	A  = Funktionsnr.

+;

+;	Exit:	A  = SCSI-Kommandonr.

+;		C  = Block Count / Skew Faktor

+;		HL = veraendert

+;		B  = veraendert

+;		(CODALN) = Datenlaenge

+;

+CMSCOM:

+	LD	BC,LGTAB	;Datenlaenge ermitteln

+	LD	L,A

+	LD	H,0

+	ADD	HL,HL		;16 Bit Werte

+	ADD	HL,BC

+	LD	C,(HL)

+	INC	HL

+	LD	B,(HL)

+	LD	(CODALN),BC

+

+	LD	HL,COMTB	;Kommandonr. umrechnen

+	ADD	A,L

+	LD	L,A

+	LD	A,H

+	ADC	A,0

+	LD	H,A

+	LD	A,(HL)		;SCSI-Kommando holen

+

+	LD	BC,BCSKTB-COMTB

+	ADD	HL,BC

+	LD	C,(HL)		;Block Count ./. Skew Faktor holen

+

+	RET

+

+;****************************************************************

+;

+;	SCSI-Kommandotabellen

+;

+;	Achtung: Die Schreib- und Lesetabellen werden vom Programm

+;	         geaendert (muessen im RAM stehen)

+;

+COMTB:

+	DEFB	SREAD		;Lesekommando

+	DEFB	SWRITE		;Schreibkommando

+	DEFB	FORMAT		;Formatierkommando

+

+LGTAB:

+	DEFW	512+DMATRA+RDDAT ;Datenlaenge Lesen

+	DEFW	512+DMATRA	;Datenlaenge schreiben

+	DEFW	0		;Datenlaenge formatieren

+

+BCSKTB:

+	DEFB	1		;1 Block lesen (nur Floppy)

+	DEFB	1		;1 Block schreiben (")

+	DEFB	4		;Skew 4 (nur Floppy)

+

+;................................................................

+;

+	IF NOT EUMEL

+TESTRD:

+	DEFB	0,0,0,0,0,0	;Test Ready (Harddisk)

+	ENDIF

+

+

+FDIOTB:				;Lesen / Schreiben auf Floppy Disk

+	DEFB	SREAD		;Lesekommando (wird ueberschrieben)

+	DEFB	FDDRIV*32+40H	;Floppy Drive (wird ueberschrieben)

+	DEFB	0, 0		;Block Middle und Low (")

+	DEFB	1		;Block Count / Interleave (Format)

+	DEFB	80H		;keine Retries

+

+

+HDIOTB:				;Lesen / Schreiben auf Harddisk

+	DEFB	SREAD		;Lesekommando (wird ueberschrieben)

+	DEFB	0		;Harddisk Drive (wird ueberschrieben)

+	DEFB	0, 0		;Block Middle und Low (")

+	DEFB	2		;Block Count

+	DEFB	0H		;Retries

+

+	IF 0

+RDINI:

+	DEFB	RINIT		;Harddisk Konfiguration lesen

+	DEFB	0		;Harddisk Drive

+	DEFB	0,0,0,0

+INIHDT:

+	DEFB	0,0,0,0,0

+	DEFB	0,0,0,0,0

+	ENDIF

+

+

+RECAL:

+	DEFB	RECALIBR	;Drive recalibrieren

+	DEFB	0		; Harddisk

+	DEFB	0,0,0,80H	; keine Retries

+

+

+PARSEK:

+	DEFB	SEEK

+	DEFB	0		;Harddisk

+	DEFB	0,0,0

+	DEFB	80H		;keine Retries

+

+

+FLPINI:				;Setze Floppy Parameter

+	DEFB	INITDRV		;Initialize Kommando

+	DEFB	FDDRIV*32+40H	;Floppy Drive

+	DEFB	0, 0, 0, 0	;nicht benutzt

+FLPDAT:				;Floppy Disk Parameter zu INIFLP

+	DEFB	0

+FLPTRKS:

+	IF	TRK40

+	DEFB	40		;Spuranzahl

+	ELSE

+	DEFB	80

+	ENDIF

+

+	DEFB	2		;2 Koepfe (doppelseitig)

+	DEFB	1*16+3		;4 ms Steprate, MFM

+	DEFB	3		;512 Byte/Sektor

+	DEFB	15		;Head Unload Time (240ms)

+	DEFB	10		;Motor Start Time (0.1 s)

+	DEFB	23		;Head Load Time (46 ms)

+	DEFB	3		;Motor off time (3 s)

+	IF SEC8

+	DEFB	0		;8 Sektoren/Spur

+	ELSE

+	DEFB	1		;9 Sektoren/Spur

+	ENDIF

+

+PARALNG	EQU	$-FLPDAT

+

+

+DBLSTEP:

+	DEFB	FD48TPI		;Doppel Step aktivieren

+	DEFB	FDDRIV*32+40H	;Floppy Drive

+	DEFB	0, 0, 0, 0	;nicht benutzt

+

+

+SGLSTEP:

+	DEFB	FD96TPI		;auf Single Step zurueckschalten

+	DEFB	FDDRIV*32+40H

+	DEFB	0, 0, 0, 0	;nicht benutzt

+

+

+SEK18:

+	DEFB	SREAD		;auf Block positionieren

+	DEFB	FDDRIV*32+40H	;Floppy Drive

+	DEFB	0,18,1,80H	;Track 2, ein Block, keine Retries

+

+

+;...........................................................................

+;

+;	CIO Initialisierungs Tabelle

+;

+

+	IF	NOT EUMEL

+

+INITAB:

+;*	DEFB	0,1		;Set Reset Bit

+	DEFB	0,0		;Reset Reset Bit

+	DEFB	1,0		;Master configuration control

+

+;	SCSI-Interface-Leitungen

+

+	DEFB    20H,00000010B	;Port A Mode Reg.

+	DEFB	22H,01000010B	;Port A Data Path Polarity Reg.

+	DEFB	23H,10111101B	;Port A Data Direction Reg.

+	DEFB	24H,0		;Port A Special I/O Control

+	DEFB	25H,10101100B	;Port A Pattern Polarity

+	DEFB	26H,0		;Port A Pattern Transition

+	DEFB	27H,10101100B	;Port A Pattern Mask

+	DEFB	0DH,0		;Port A Data

+	DEFB	02H,18H		;Port A Interrupt Vector (** TEST **)

+	DEFB	PCOMA,11100000B	;Port A Command: Clear IE

+	DEFB	PCOMA,00100000B	;Port A Command: Clear IUS & IP

+

+;	General Purpose Port (Centronics, SCSI, 6502-IRQ-Maske)

+

+	DEFB	06H,00000001B	;Port C Data Direction Reg.

+	DEFB	05H,00001000B	;Port C Data Path Polarity Reg.

+	DEFB	07H,0		;Port C Special I/O Control

+	DEFB	0FH,4		;Port C Data Register

+

+;	Centronics Interface

+

+	DEFB	28H,10010000B	;Port B Mode

+	DEFB	29H,01000000B	;Port B Handshake: Strobed

+	DEFB	09H,00100000B	;Port B Command: Clear IUS & IP

+	DEFB	2AH,0		;Port B Data Path Polarity

+	DEFB	2CH,0		;Port B Special I/O Control

+	DEFB	03H,30H		;Port B Interrupt Vektor

+

+;	Deskew Timer

+

+	IF 0

+	DEFB	1EH,00000010B	;Counter 3 Mode Specification

+	DEFB	0CH,00100000B	;Counter 3 Command and Status

+	DEFB	1AH,0		;Counter 3 Time Constant MSB

+	DEFB	1BH,7		;Counter 3 Time Constant LSB (2,268 us)

+	DEFB	0CH,11100100B	;Counter 3 Gate Enable

+	ENDIF

+

+;	Timer

+

+	DEFB	1CH,10000000B	;Counter/Timer 1 Mode Spec. Reg.

+	DEFB	1DH,10000000B   ;Counter/Timer 2 Mode Spec. Reg.

+	DEFB	0AH,00100000B	;Counter/Timer 1 Command: Clear IP & IUS

+	DEFB	0BH,00100000B	;Counter/Timer 2 Command: Clear IP & IUS

+	DEFB	16H,HIGH 38400  ;Time Constant 1 MSB

+	DEFB	17H,LOW 38400   ;Time Constant 1 LSB

+	DEFB	18H,0		;Time Constant 2 MSB, mit Timer 1 zus. 50ms

+	DEFB	19H,4		;Time Constant 2 LSB

+	DEFB	04H,18H		;Interrupt Vector Counters

+

+;	CIO-Interrupts freigeben

+

+	DEFB	01H,11110111B	;Master Config. Register

+	DEFB	00H,10000010B	;Master Interrupt Enable

+

+	DEFB	09H,11000000B	;Port B Command: Set IE

+

+	DEFB	0BH,11000110B	;Counter/Timer 2 Command: Set IE

+ 	DEFB	0AH,11100110B	;Counter/Timer 1 Command: Clear IE

+

+INILNG	EQU	$-INITAB

+	ENDIF

+

+

+;****************************************************************

+

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS b/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS
new file mode 100644
index 0000000..7316dac
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS
@@ -0,0 +1,271 @@
+{---------------------- Include File fuer SCSI-Routinen ---------------------

+  Michael Staubermann, 27.06.86, Version 1.1, ohne DMA

+

+  Die CIO (Kanal A) muss fuer SCSI initialiert worden sein (BIOS macht das)

+

+  Prozeduren/Funktionen :

+

+  FUNCTION port0 (portnr : INTEGER) : BYTE ;

+    Liest des Port mit Addressbits A8..A15 = 0

+

+  PROCEDURE port0out (portnr, wert : INTEGER) ;

+   Schreibt den 'wert' in den Port mit A8..A15 = 0

+

+  PROCEDURE scsiio (VAR datenbereich ; kommando : KOMMANDOTYPE ;

+                    datenlaenge : INTEGER) ;

+   SCSI-Controller fuehrt das Kommando aus, Je nach Eingabe oder Ausgabe

+   wird der Datenbereich gelesen oder beschrieben. Es ist sichergestellt,

+   das nicht mehr als 'datenlaenge' Bytes in 'datenbereich' geschrieben

+   werden.

+

+ PROCEDURE floppy_init ;

+  Initialisiert den Controller fuer 512 Byte/Sektor, 9 Sektoren, 2*80 Track

+  Floppy-Format (720K, grosses IBM-Format)

+

+ PROCEDURE fd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Liest mehrere ('sektoren') 512-Byte Sektoren ab der (SCSI-) Blocknummer

+  von der Floppy. Der 'datenbereich' muss 512 * 'sektoren' Bytes fassen koennen.

+

+ PROCEDURE fd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Wie fd_read, schreibt aber auf die Floppy.

+

+ PROCEDURE hd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Wie fd_read, liest aber 256-Byte Sektoren von der Harddisk. Der

+  'datenbereich' muss 256 * 'sektoren' Bytes fassen koennen.

+

+ PROCEDURE hd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+  Wie hd_read, schreibt aber auf die Harddisk.

+

+ FUNCTION scsi_blocknummer (eumel_blocknummer : INTEGER) : INTEGER ;

+  Aus der EUMEL-Blocknummer wird die SCSI-Blocknummer berechnet. EUMEL

+  behandelt im Gegensatz zum SCSI-Controller, erst die Oberseite und dann

+  die Unterseite der Floppy. Da die EUMEL-Sektoren nicht SCSI-physisch

+  hintereinander zu liegen brauchen, sollte man mehrere Sektoren nicht

+  mit einer 'sektoren'-Angabe groesser '1' lesen, sondern in einer Schleife

+  jede Blocknummer neu berechnen und dann einlesen.

+

+

+-----------------------------------------------------------------------------}

+

+

+TYPE KOMMANDOTYPE = ARRAY[1..6] OF BYTE ;

+     STRING77 = STRING[77] ;

+

+FUNCTION port0 (portnr : INTEGER) : BYTE ;

+ BEGIN

+  INLINE (6/0) ; { B-Register 0 }

+  port0 := port[portnr]

+ END ;

+

+

+PROCEDURE port0out (portnr, wert : INTEGER) ;

+ BEGIN

+  INLINE (6/0) ;

+  port[portnr] := wert

+ END ;

+

+

+PROCEDURE scsiio (VAR datenbereich ; kommandobereich : KOMMANDOTYPE ;

+                  datenlaenge : INTEGER) ;

+ VAR i, status : INTEGER ;

+     statusbereich : ARRAY[1..4] OF BYTE ;

+     request_status : KOMMANDOTYPE ;

+

+

+PROCEDURE fehler (meldung : STRING77) ;

+ BEGIN

+  writeln ('SCSI-Fehler: ', meldung) ;

+  halt

+ END ;

+

+

+procedure writehex(b:byte);

+var b1:byte;

+procedure writenibble(b:byte);

+   begin

+     b:=b+$30;

+     if(b>$39) then b:=b+7;

+     write(chr(b))

+   end;

+begin

+  b1:=b shr 4;  writenibble(b1);

+  b1:=b and $0f;writenibble(b1);

+end;

+

+FUNCTION scsi2 (VAR datenbereich ; kommandobereich : KOMMANDOTYPE ;

+                 datenlaenge : INTEGER) : INTEGER ;

+CONST scsiport = $80 ;

+      cioad    = $52 ;

+      dstat    = $30 ;

+

+VAR addresse, ciowert : INTEGER ;

+

+

+ PROCEDURE check_request ; { Auf Busyende warten }

+  BEGIN

+   REPEAT

+    ciowert := port0 (cioad) ;

+{    IF (ciowert AND 8) = 0

+      THEN fehler ('vorzeitiges Ende') }

+   UNTIL (ciowert AND $80) = $80 ;

+   ciowert := ciowert AND $34

+  END ;

+

+

+PROCEDURE scsitrans (address,  datenlaenge : INTEGER) ;

+ BEGIN

+  INLINE($ED/$4B/datenlaenge/      { LD BC,(datenlaenge) }

+         $ED/$6B/address/          { LD HL,(address)     }

+         $ED/$38/$52/              { IN0 A,(CIOAD)       }

+         $CB/$7F/                  { BIT 7,A             }

+         $28/$F9/                  { JR Z,F9H            }

+         $E6/$34/                  { AND 34H             }

+         $CB/$6F/                  { BIT 5,A             }

+         $C0/                      { RET NZ              }

+         $CB/$57/                  { BIT 2,A             }

+         $20/$06/                  { JR NZ,rdscsi        }

+         $7E/                      { LD A,(HL)           }

+         $ED/$39/$80/              { OUT0 (SCSIP),A      }

+         $18/$04/                  { JR cmdio            }

+         $ED/$38/$80/              { rdscsi:IN0 A,(SCSIP)}

+         $77/                      { LD (HL),A           }

+         $ED/$A1/                  { cmdio: CPI   = DEC BC, INC HL PE:BC=0 }

+         $EA/*-$1D)                { JP PE,*-   }

+                                   { nodat: RET }

+ END { scsitrans } ;

+

+

+BEGIN { scsi2 }

+

+ { Controller selektieren }

+ ciowert := port0 (cioad) ;

+ port0out (cioad, ciowert OR 2) ;

+ port0out (cioad, ciowert AND $FB) ;

+

+ { Auf Kommandoanforderung warten }

+ WHILE (port0 (cioad) AND $B4) <> $A0 DO ; { warten, ggf Timeout testen }

+

+ { Kommando ausgeben }

+ FOR i := 1 TO 6 DO

+  BEGIN

+   check_request ;

+   port0out (scsiport, kommandobereich[i])

+  END ;

+

+ { Datenphase ohne DMA }

+ scsitrans (addr (datenbereich), datenlaenge) ;

+

+ { Status abholen }

+ check_request ;

+ IF ciowert <> $24

+    THEN BEGIN

+     REPEAT

+      ciowert := port0 (scsiport) ;

+      check_request ;

+     UNTIL ciowert <> $04 ;

+     scsi2 := $FF ; { SCSI-Fehler }

+     END

+    ELSE scsi2 := port0 (scsiport) ; { Status }

+ check_request ;

+ i := port0 (scsiport) ; { zweites Statusbyte immer 00 }

+

+END { scsi2 } ;

+

+

+ BEGIN { scsiio }

+  status := scsi2 (datenbereich, kommandobereich, datenlaenge) ;

+  IF (status AND $9F) = $02

+     THEN BEGIN

+      fillchar (request_status, sizeof(request_status), 0) ;

+      request_status [1] := 3 ;

+      request_status [2] := status AND $60 ;

+      status := scsi2 (statusbereich, request_status, sizeof (statusbereich)) ;

+      write ('SCSI-Fehler: ') ;

+      FOR i := 1 TO sizeof (statusbereich) DO

+       BEGIN

+        writehex (statusbereich[i]) ;

+        write (' ')

+       END ;

+      halt

+      END

+     ELSE IF (status AND $9F) <> 0

+           THEN fehler ('Daten nicht ganz uebertragen')

+ END ;

+

+

+TYPE INITDATATYPE = ARRAY[1..10] OF BYTE ;

+CONST floppy_write  : KOMMANDOTYPE = ($0A, $40, 0, 0, 0, 0) ;

+      floppy_read   : KOMMANDOTYPE = ($08, $40, 0, 0, 0, 0) ;

+      harddisk_write: KOMMANDOTYPE = ($0A, $00, 0, 0, 0, 0) ;

+      harddisk_read : KOMMANDOTYPE = ($08, $00, 0, 0, 0, 0) ;

+      fd_initialize : KOMMANDOTYPE = ($0B, $40, 0, 0, 0, 0) ;

+

+      floppy_daten :  INITDATATYPE = (0, 80, 2, $13, 3, 30, 50, 23, 50, 1) ;

+                      { 9 Sektoren/Track, 80 Tracks, 512 Byte/Sektor }

+

+PROCEDURE floppy_init ;

+ VAR init_daten : INITDATATYPE ;

+ BEGIN

+  init_daten := floppy_daten ;

+  scsiio (init_daten, fd_initialize, sizeof (init_daten))

+ END ;

+

+

+PROCEDURE fd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := floppy_write ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 512) ;

+ END ;

+

+

+PROCEDURE hd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := harddisk_write ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 256) ;

+ END ;

+

+

+PROCEDURE fd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := floppy_read ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 512)

+ END ;

+

+

+PROCEDURE hd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ;

+ VAR command : KOMMANDOTYPE ;

+ BEGIN

+  command := harddisk_read ;

+  command[3] := hi (blocknummer) ;

+  command[4] := lo (blocknummer) ;

+  command[5] := sektoren ;

+  scsiio (datenbereich, command, sektoren * 256)

+ END ;

+

+

+FUNCTION floppy_blocknummer (eumel_blocknummer : INTEGER) : INTEGER ;

+ VAR track, sektor : INTEGER ;

+ BEGIN

+  track := eumel_blocknummer DIV 9 ;

+  sektor := eumel_blocknummer MOD 9 ;

+  IF track >= 80 { Rueckseite }

+   THEN BEGIN

+    track := track - 80 ;

+    sektor := sektor + 9

+   END ;

+  floppy_blocknummer := track * 18 + sektor

+ END ;

+

+

diff --git a/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM b/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM
new file mode 100644
index 0000000..c198640
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX b/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX
new file mode 100644
index 0000000..061431a
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX
@@ -0,0 +1,15 @@
+SLR LOAD

+SLR SHARD

+SLR SCSI

+SLR CONOUT

+SLR DISK80

+SLR GRAFIK80

+SLR INTMOD

+SLR INT65

+SLR INIMOD

+M80=DISK/M

+L80 

+</P:0,LOAD,/P:0100,SHARD,SCSI,CONOUT,DISK80,GRAFIK80,INTMOD,INT65,INIMOD,DISK

+<EUMEL/N/E

+EBOOT

+<J

diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.MAC b/system/shard-z80-ruc-64180/1.5/src/SHARD.MAC
new file mode 100644
index 0000000..f84dd1a
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.MAC
@@ -0,0 +1,1433 @@
+	TITLE	SHARD - Hardwareinterface fuer EUMEL 1.8 auf RUC 180

+;

+	INCLUDE	HD64180.LIB

+;

+	.LIST

+	CSEG

+;

+;****************************************************************

+;

+;	SHARD: Interface EUMEL 1.8 -> RUC 64180 Karte

+;

+;	Version 1.3 - 05.01.87 

+;		1.3 mit log. und phys. Kanaelen

+;		1.4 - 26.06.87, Code gekuerzt, IOCONTROL clear_spooler

+;

+;	Copyright (C) 1985, 86, 87 by ruc:

+;			1.7.3:	Rainer Ellerbrake

+;				Eggeberger Str. 12

+;				4802 Halle (Westf.)

+;

+;			1.8:	Michael Staubermann

+;				Moraenenstr. 29

+;				4400 Muenster-Hiltrup

+;

+;****************************************************************

+;

+;	Globale Variable

+;

+	GLOBAL	SHEND, SHSINF, SHSACC, SHIOCNT, SHOUT, SHBIN, SHBOUT

+	GLOBAL	WARTE, SENDMSG, FLWTYP, MEMDMA

+	GLOBAL	RTCOK, HGOP

+	GLOBAL	HDOFS, HDLAST, CPMOFS, CPMLAST

+	GLOBAL	D0BLKS, D1BLKS, HGBLKS, CPMBLKS

+	GLOBAL	ADLEISTE, IINTAD, TIMEAD, INFOAD, SHUTUPAD, ERROR, TRAP

+	GLOBAL	MODECONF, ARC31, BEEPFRQ, BLINKP, IKANTAB, URLK1, URLK2

+

+;................................................................

+;

+;	Externe Variable

+;

+	EXTERNAL INIFLP, HDIO, PARKHD, PHYSADR, START, FRE65

+	EXTERNAL PUTBUF, FREEBUF, DRUCK, SCCATAB, SCCBTAB, EFLOW5

+	EXTERNAL BAUSCC, BAUBAS, TO6502, ZGERL, STROUT, AFLOW, CLRCBUF

+	EXTERNAL BITSCC, BITBAS, EGO, ESTOP, DISKBK, INIDISK, ANALOG

+	EXTERNAL GMOVE, GDRAW, GTEST, GCTRL, GCLR, GFILL, GTRANS, GRAFIO

+;	

+;................................................................

+;

+;	andere Adressen

+;

+WINDOW	EQU	0F000H		;Anfangsadresse des 4K Windows

+;

+;	Konstanten

+;

+SCHGR	EQU	196		;Groesse des Schattenspeichers in KByte

+MINFUN	EQU	-10		;iocontrol: unterste Funktionsnummer

+;

+;	Harddisk / Floppy Kommandos

+;

+SREAD	EQU	0

+SWRITE	EQU	1

+SFORMAT	EQU	2

+;

+	INCLUDE	PORTS.MAC

+;

+;*****************************************************************************

+;

+;	Konfigurationsblock, wird im Load-Modul festgelegt

+;

+BLINKP		EQU	8		; 1 Byte

+BEEPFRQ		EQU	9		; 1 Byte

+ARC31		EQU	10		; 3 Bytes SCSI-Floppy LUN

+MODECONF	EQU	13		; 4 Words: Mode, ID 4, 5, 6

+URLK1		EQU	21		; 1 Byte log. Kanal f.1.Urladertest

+URLK2		EQU	22		; 1 Byte log. Kanal f.2.Urladertest

+FREE		EQU	23		; 1 Byte

+;

+IKANTAB		EQU	58H		; 8 Bytes Kanalzuordung phys. --> log.

+KANTAB		EQU	60H		; 33 Bytes Kanalzuordnung log. --> phys

+IOFTB		EQU	81H		; 32 Bytes I/O 'typ'-Tabelle

+CPMOFS		EQU	0A1H		; Anfang eines CP/M-Volumes

+CPMLAST		EQU	0A4H		; Ende+1 des CP/M-Volumes

+

+;*****************************************************************************

+;

+;	EUMEL - Linkleiste

+;

+	JP	START		; Beginn der Initialisierung, starten

+

+ADLEISTE:			; Beginn der EUMEL-Linkleiste (kopiert)

+

+IINTAD:	JP	DEFRET		; Inputinterrupt

+

+TIMEAD:	JP	DEFRET		; Timerinterrupt

+

+WARTAD:	JP	DEFRET		; EUMEL 'warte'

+

+GRABAD:	JP	DEFRET		; (BC) 512-Byte Kacheln ab (HL) fuer SHard

+				; reservieren

+FREEAD:	JP	DEFRET		; (BC) 512-Byte Kacheln ab (HL) (wie bei

+				; 'grab'!) freigeben

+SHUTUPAD:

+	JP	DEFRET		; Shutup anfordern

+

+INFOAD:	JP	DEFRET		; Info ' shard'

+	

+DEFRET:	RET

+

+;----------------------------------------------------------------

+;

+;	W A R T E

+;

+;	Aufruf der EUMEL Warte Routine

+;

+WARTE:

+	PUSH	BC		;Register, ausser AF, retten

+	PUSH	DE

+	PUSH	HL

+	PUSH	IX

+	PUSH	IY

+;	EX	AF,AF'

+;	PUSH	AF

+;	EXX

+;	PUSH	BC

+;	PUSH	DE

+;	PUSH	HL

+;

+	CALL	WARTAD		;zunaechst auf RET-Befehl

+;

+;	POP	HL

+;	POP	DE

+;	POP	BC

+;	EXX

+;	POP	AF

+;	EX	AF,AF'

+	POP	IY

+	POP	IX

+	POP	HL

+	POP	DE

+	POP	BC

+	RET

+

+;................................................................

+;

+;	T R A P

+;

+;	Behandlung einer TRAP-Exception

+;	Einsprung bei JP 0

+

+TRAP:

+	LD	(SAVSTP),SP	; Stackpointer retten

+	PUSH	AF

+	PUSH	HL

+	PUSH	DE

+	IN0	A,(ITC)		; Trap ?

+	BIT	7,A

+	RES	7,A		; Auf jeden Fall loeschen

+	OUT0	(ITC),A

+	JR	Z,RESV		; War kein TRAP, sondern Reset: PC undefiniert

+	LD	HL,(SAVSTP)

+	LD	E,(HL)

+	INC	HL

+	LD	D,(HL)		; DE = PC bei Trapadresse

+	DEC	DE		; PC-1

+	BIT	6,A		; UFO ? (Undefined Fetch Object)

+	JR	Z,TRAP1

+	DEC	DE		; PC-2

+TRAP1:

+	LD	HL,TRPADR

+	CALL	HEXDEHL		; Nach Hex konvertieren

+

+RESV:

+	LD	HL,TRPTXT	; Vor Infoaufruf ausgeben (in Zeile 6)

+SENDERR:

+	CALL	SENDMSG

+	CALL	INFOAD

+	POP	DE

+	POP	HL

+	POP	AF

+	RET

+	

+TRPTXT:	DEFB	TRPLEN, 7, 6, 4, 1, 15, 'TRAP:'

+TRPADR:	DEFB	'RES ', 5, 14

+TRPLEN	EQU	$-TRPTXT-1

+

+;...................................................................

+;

+;	Falscher Interrupt

+;

+ERROR:	

+	PUSH	AF

+	PUSH	HL

+	PUSH	DE

+

+	LD	A,00111000B	; Reset SCC highest IUS

+	OUT0	(SCCAC),A

+	OUT0	(SCCBC),A

+	CALL	EIRET

+

+	LD	HL,INTTXT	; Message 'Ghost Interrupt'

+	JR	SENDERR

+

+INTTXT:	DEFB	INTXTLEN, 6, 4, 1, 15, 'Wrong Int', 5, 14

+INTXTLEN	EQU	$-INTTXT-1

+

+EIRET:

+	EI

+	RETI

+

+;----------------------------------------------------------------

+;

+;	S Y S E N D

+;

+;	Kaltstart ausfuehren

+;

+;	Eingang:  -

+;	Ausgang:  (Keine Rueckkehr)

+;

+SHEND:

+	CALL	PARKHD		; Harddisk in Parkposition fahren

+	DI

+	XOR	A

+	OUT0	(CNTLA0),A	; Falls verdrahtet, Hardwarereset (RTS-Pin)

+	OUT0	(CNTLA0),A	; sicherheitshalber

+	SLP			; Kein Refresh mehr, I/O bleibt aktiv

+

+;

+;----------------------------------------------------------------

+;

+;	S H S I N F

+;

+;	Groesse und Ansprechmodus des Schattenspeichers bestimmen

+;

+;	Ausgang:  BC = Groesse des Schattenspeichers in k (0..8191)

+;		       Bit 15: 1=Fenstermodus, Bit 14: 1=Transportmodus

+;

+;	In diesem SHARD werden die 1. 256 KByte RAM des HD 64180, soweit

+;	diese nicht vom SHARD und EUMEL0 belegt sind, als Schattenspeicher

+;	im Fenstermodus benutzt.

+;

+;	Der Speicher wird im einzelnen wie folgt verwendet:

+;

+;	00000 - 013FF	SHARD

+;	01400 - 0EFFF	EUMEL0 und Pagingbereich

+;	0F000 - 3FFFF	Schattenspeicher

+;	40000 - 5FFFF	reserviert fuer Grafikkarte (nicht benutzt)

+;	60000 - 6FFFF	BASIS bzw. Apple Hauptspeicher (6502 Treiber)

+;	70000 - 7FFFF	wie 60000 - 6FFFF

+;   

+SHSINF:

+	LD	BC,SCHGR+8000H	;Fenstermodus

+	RET

+;

+;----------------------------------------------------------------

+;

+;	S C H A C C

+;

+;	Ein-/ Ausgabe auf den Schattenspeicher

+;

+;	Eingang: HL = Nummer der 1/2K-Seite, die in das 4K Fenster

+;		      zu schalten ist.

+;

+;	Ausgang: HL = Anfangsadresse (im Normaladressraum) des aktuellen

+;		      Fensters

+;

+;	Das Fenster befindet sich innerhalb eines 4K Bereichs ab 0F000H

+;	in der Common Area 1

+;

+SHSACC:

+	PUSH	AF		;Akku retten

+

+	LD	A,L		;Offset im 4K Fenster berechnen

+	SLA	A		;auf 256 Byte Grenze (MSB)

+;	AND	0FH		;nicht noetig, da MSB=F 

+	OR	HIGH WINDOW	;MSB der Anfangsadresse im Fenster

+;

+	SRL	H		;512 Byte Block -> 4 K Offset (/8)

+	RR	L

+	SRL	H

+	RR	L

+	SRL	L		;nicht mehr als 512 K !!

+	OUT0	(CBR),L		;4K Blockanf. (- F000) in MMU eintragen

+

+	LD	H,A		;MSB der Anfangsadr. retten

+	LD	L,0		;HL = Anfangsadresse im log. Adr.-raum

+	POP	AF		;AF wieder herstellen

+	RET

+;

+;-------------------------------------------------------------------

+;

+;	L O G P H Y S

+;	Umrechnung der log. Kanalnummer in eine phys. Kanalnummer

+;

+;	Eingang: A = logische Kanalnummer (0..32)

+;	Ausgang: A = physische Kanalnummer (0..6, 28..32)

+;		 alle anderen Register bleiben unveraendert

+;

+LOGPHYS:

+	PUSH	HL

+	ADD	A,KANTAB

+	LD	L,A

+	LD	H,0

+	LD	A,(HL)

+	POP	HL

+	RET

+

+;----------------------------------------------------------------

+;

+;	B L O C K O U T

+;

+;	Block (512 Byte) Ausgabe

+;

+;	Der 512 Byte grosse in DE angegebene Block wird ab der in HL

+;	angegebenen Hauptspeicheradresse auf das durch Kanalnummer angewaehlte

+;	Geraet uebertragen.

+;

+;	Eingang:  A = Kanalnummer (log.)

+;		 BC = Funktionscode (immer 0)

+;		 HL = Adresse des Hauptspeicherbereichs

+;		 DE = 2. Funktionscode (Blocknummer)

+;

+;	Ausgang:  A = veraendert

+;		 BC = Rueckmeldecode (0=ok, -1=unzulaessiger Aufruf)

+;		 HL = Adresse des Rueckmeldetextes (1 Byte <Laenge>,

+;						    <Laenge> Bytes Text)

+;

+SHBOUT:

+	PUSH	AF

+	LD	A,SWRITE		;Schreiboperation

+	JR	BLKCOM

+;

+;----------------------------------------------------------------

+;

+;	B L O C K I N

+;

+;	Block (512 Byte) Eingabe

+;

+;	Der 512 Byte grosse in DE angegebene Block wird ab der in HL

+;	angegebenen Adresse vom durch Kanalnummer angewaehlten Geraet

+;	in den Hauptspeicher uebertragen.

+;

+;	Eingang:  A = Kanalnummer (log.)

+;		 BC = Funktionscode (immer 0)

+;		 HL = Adresse des Hauptspeicherbereichs

+;		 DE = 2. Funktionscode (Blocknummer)

+;

+;	Ausgang:  A = veraendert

+;		 BC = Rueckmeldecode (0=ok, -1=unzulaessiger Aufruf)

+;		 HL = Adresse des Rueckmeldetextes (1 Byte <Laenge>,

+;						    <Laenge> Bytes Text)

+;		 DE = unveraendert

+;

+;	Folgende physischen Kanaele sind fuer Block I/O definiert:

+;

+;	0 = Harddisk 0 am SCSI-Controller

+;	1 = Graphikmemory (Apple)

+;

+;	28 = Harddisk CP/M-Volume

+;	29 = Apple-Drive 1

+;	30 = Apple-Drive 0

+;	31 = Floppy 0 am SCSI-Controller

+;

+;................................................................

+

+SHBIN:

+	PUSH	AF

+	LD	A,SREAD

+BLKCOM:

+	LD	(HGOP),A	;0=lesen, 1=schreiben, 2=formatieren

+;

+	POP	AF

+	CALL	LOGPHYS		; Umrechnen log. --> phys.

+	PUSH	AF

+

+;FDHDIO:

+	CALL	BLOCKS		; Anzahl Blocks des Kanals erfragen

+

+	LD	A,B		; 0 Bloecke: Nochmal initialisieren

+	OR	C

+	JR	NZ,BLKCOM1

+

+	POP	AF

+	PUSH	AF

+

+	PUSH	DE

+	LD	D,B		; DE = 0 : Standardformat

+	LD	E,B

+	CALL	SIZEX

+	POP	DE

+

+BLKCOM1:

+	POP	AF		; A = Kanal

+

+	PUSH	HL

+	LD	H,D		; HL = Blocknummer

+	LD	L,E

+	AND	A

+	SBC	HL,BC		; Falls HL >= BC : Block zu hoch

+	POP	HL

+

+	JR	NC,TRKERR

+

+	LD	BC,HDOFS

+	AND	A

+	JR	Z,SCSIBK	; Hintergrund

+

+	LD	BC,ARC31

+	CP	31

+	JR	Z,SCSIBK	; SCSI-Floppy

+

+	LD	BC,CPMOFS

+	CP	28

+	JR	Z,SCSIBK	; CP/M-Volume auf der Harddisk

+

+				; Kein SCSI-blockio

+	JP	NC,DISKBK	; Kanal 29, 30 ist Apple-Drive

+

+	CP	1		; Grafikspeicher ?

+	JP	Z,GRAFIO

+				; Andere Kanaele nicht erlaubt

+	LD	BC,-1		; Falscher Kanal

+	RET

+

+

+SCSIBK:

+	LD	A,(HGOP)

+	PUSH	DE

+	CALL	HDIO		;I/O ausfuehren

+	POP	DE

+;

+	LD	BC,0

+	AND	A

+	RET	Z		; Transfer ok

+

+	INC	BC		; Fehler, bei dem Retries sinnlos sind

+	CP	13H		; Writeprotected (Floppy)

+	RET	Z

+	CP	14H		; Target sector not found (kein Medium)

+	RET	Z

+

+	INC	BC		; Retries sinnvoll

+	LD	HL,ERRNR	; Bufferaddress fuer Hexbyte-Fehlernummer

+	CALL	HEXAHL		; Konvertieren

+	LD	HL,BLKNR1	; Blocknr

+	CALL	HEXDEHL		; Blocknummer in Puffer schreiben

+

+	LD	HL,RWERR

+	RET

+;

+TRKERR:

+	LD	HL,BLKNR2	; Bufferadresse fuer Konvertierung

+	CALL	HEXDEHL		; DE ab HL schreiben

+	LD	BC,3		; Versorgungsfehler (Spur zu gross)

+	LD	HL,BLKZHOCH

+	RET

+;

+				; Word in DE als 4 Byte ASCII ab HL ablegen

+HEXDEHL:

+	LD	A,D		; Highbyte

+	CALL	HEXAHL

+	LD	A,E		; Lowbyte dahinter

+				; Byte in A als 2 ASCII-Zeichen ab HL ablegen

+HEXAHL:

+	PUSH	AF

+	RRCA

+	RRCA

+	RRCA

+	RRCA

+	CALL	HEXAHL1

+	POP	AF

+

+HEXAHL1:

+	AND	0FH

+	CP	0AH		; A..F ?

+	JR	C,HEXAHL2

+	ADD	A,7

+HEXAHL2:

+	ADD	A,30H

+	LD	(HL),A

+	INC	HL

+	RET

+;

+;	Fehlermeldungen, die mit 'noch ein Versuch ?' ausgegeben werden

+;

+RWERR:

+	DEFB	RWERRLN

+	DEFM	'Fehler '

+ERRNR:	DEFM	'00H auf Block '

+BLKNR1:	DEFM	'0000H,'

+RWERRLN	EQU	$-RWERR-1

+

+;

+BLKZHOCH:

+	DEFB	BLKZLN

+	DEFM	'Block '

+BLKNR2:	DEFM	'0000H zu hoch,'

+BLKZLN	EQU	$-BLKZHOCH-1

+

+;

+;----------------------------------------------------------------

+;

+;	M E M D M A

+;	DMA-Transfer zwischen 64180-Speicher (log.) und Basisspeicher

+;

+;	Darf auch in Interruptroutinen benutzt werden!

+;

+;	Eingang: BC = Anzahl der zu transportierenden Bytes

+;		 DE = log.Hauptspeicheradresse (64k)

+;		 HL = phys. Adresse im Basisspeicher

+;		 A  = 0 : Basis --> 64180

+;		 A  = 1 : 64180 --> Basis

+;	Ausgang: alle Register (A, BC, DE, HL) moeglicherweise veraendert

+;

+MEMDMA:

+	RRA			; Bit 0 (A) ins Carry

+	LD	A,I

+	DI

+	PUSH	AF		; Carry und IEF1 merken

+

+	OUT0	(BCR0L),C	; Transferlaenge programmieren

+	OUT0	(BCR0H),B

+

+	CALL	PHYSADR		; Bank in A

+	LD	B,6		; Basis Bank

+

+	POP	AF

+	PUSH	AF		; Carryflag holen: Set : 64180 --> Basis

+

+	JR	NC,MEMDMA1

+

+	EX	DE,HL		; Source <--> Dest vertauschen

+	LD	B,A		; Bank auch vertauschen

+	LD	A,6

+

+MEMDMA1:

+	OUT0	(SAR0L),L	; Source-Adresse

+	OUT0	(SAR0H),H

+	OUT0	(SAR0B),B

+	OUT0	(DAR0L),E	; Destination-Adresse

+	OUT0	(DAR0H),D

+	OUT0	(DAR0B),A

+

+	CALL	ZGERL		; Auf 6502-Speicher Zugriffserlaubnis warten

+

+	LD	A,01100011B	; DMA-Transfer starten

+	OUT0	(DSTAT),A

+

+	POP	AF

+	RET	PO

+	EI

+	RET

+

+;----------------------------------------------------------------

+;

+;	I O C O N T R O L

+;

+;	Steuerung und Zustandsabfragen fuer alle Kanaele

+;

+;	Eingang: A  = Kanalnummer (log.)

+;		 BC = Funktionsnummer

+;		      negative Codes siehe Funktionsadresstabelle

+;		      1 = 'typ' (fuer alle Kanaele (0..32))

+;		      2 = 'frout' (fuer Kanal 1..6)

+;		      3 = 'stop' (fuer Kanal 1..6)

+;		      4 = 'weiter' (fuer Kanal  1..6)

+;		      5 = 'size' (fuer Kanal 0, 1, 30, 31)

+;		      6 = 'flow' (fuer Kanal 1..6)

+;		      7 = 'format' (fuer Kanal 30, 31)

+;		      8 = 'baud' (fuer Kanal 2, 3, 5) 

+;		      9 = 'bits' (fuer Kanal 2, 3, 5)

+;		     10 = 'calendar' (1.8)

+;

+;		 DE = 2. Parameter

+;		 HL = 3. Parameter

+;

+;	Ausgang: s. Einzelfunktion

+;		 A, BC und Flags duerfen veraendert sein (manchmal definiert!)

+;

+SHIOCNT:

+	CALL	LOGPHYS		; Kanalnummer log. --> phys. umrechnen

+

+	PUSH	HL		;3. Funktionscode retten

+	LD	HL,-MINFUN	;unterste Funktionsnummer

+	AND	A

+	ADC	HL,BC		;auf 0 normierte Funktionsnummer

+	JP	M,ILLFUN	;unzulaessige Funktion ->

+

+	LD	B,H

+	LD	C,L

+	LD	HL,MAXFUN	;Funktionsanzahl

+	AND	A

+	SBC	HL,BC

+	JR	C,ILLFUN	;Funktionsnummer zu gross ->

+

+	LD	HL,FUNTAB	;Sprungadresstabelle fuer alle Funktionen

+	ADD	HL,BC

+	ADD	HL,BC		;+ Funktionsnummer * 2

+	PUSH	AF

+	LD	A,(HL)		;LSB (Funktionsadresse)

+	INC	HL

+	LD	H,(HL)		;MSB (Funktionsadresse)

+	LD	L,A

+	POP	AF

+	JP	(HL)		; (TOS)=(HL), Funktion anspringen

+;

+ILLFUN:

+	POP	HL

+	LD	BC,-2

+	RET

+;

+;................................................................

+;

+;	Funktionsadresstabelle

+;

+FUNTAB:

+	DEFW	CLRBUF		;-10 Printerspooler loeschen

+	DEFW	GTRANS		;-9  Grafik: Grafikseiten transportieren

+	DEFW	GCTRL		;-8  Grafik: Verschiedene Steuerfunktionen

+	DEFW	GTEST		;-7  Grafik: Test, ob Pixel (x, y) gesetzt

+	DEFW	GDRAW		;-6  Grafik: Draw Line to (x, y)

+	DEFW	GMOVE		;-5  Grafik: Move to (x, y)

+	DEFW	GFILL		;-4  Grafik: Umrandete Flaeche fuellen

+	DEFW	GCLR		;-3  Grafik: Seite loeschen (fuellen)

+	DEFW	ANALOG		;-2  Analog I/O

+	DEFW	IOACC		;-1  64180-Card I/O-Ports (privilegiert)

+	DEFW	ILLFUN		; 0  -

+	DEFW	TYP		; 1

+	DEFW	FROUT		; 2

+	DEFW	STOP		; 3

+	DEFW	WEITER		; 4

+	DEFW	SIZE		; 5

+	DEFW	FLOW		; 6

+	DEFW	FORMAT		; 7

+	DEFW	BAUD		; 8

+	DEFW	BITS		; 9

+	DEFW	CALENDAR	;10

+;

+MAXFUN	EQU	(($-FUNTAB)/2)-1	;FUNKTIONSANZAHL

+;

+;................................................................

+;

+;	T Y P

+;

+;	Information welche I/O fuer welchen Kanal sinnvoll ist liefern

+;

+;	Eingang: A = Kanalnummer (phys.)

+;

+;	Ausgang: Information in BC

+;		 C Bit 0 gesetzt: 'iint' kann kommen (Zeicheneingabe)

+;		 C Bit 1 gesetzt: 'output' ist sinnvoll (Zeichenausgabe)

+;		 C Bit 2 gesetzt: 'blockin' ist sinnvoll (Blockeingabe)

+;		 C Bit 3 gesetzt: 'blockout' ist sinnvoll (Blockausgabe)

+;		 C Bit 4 gesetzt: 'IOCONTROL format' ist sinnvoll

+;

+TYP:

+	LD	BC,0

+	CP	32

+	JR	NC,TYP1

+	LD	C,A		;BC = Kanalnummer

+	LD	HL,IOFTB

+	ADD	HL,BC

+	LD	C,(HL)		;Information aus IO-Funktionstab. holen

+TYP1:

+	POP	HL

+	RET

+;

+;................................................................

+;

+;	F R O U T

+;

+;	Information, wieviel Zeichen der naechst 'outvar' uebernehmen

+;	kann.

+;

+;	Eingang: A  = Kanalnummer (phys.)

+;

+;	Ausgang: BC = Anzahl Zeichen die der naechste 'outvar' uebernehmen

+;		      kann

+;		 C-Flag gesetzt: Puffer ist leer

+;

+FROUT:

+	CP	1		; Console ?

+	JR	Z,FROUTOK

+	CP	2		; SCCB

+	JR	Z,SCCBFROUT

+	CP	3		; SCCA

+	JR	Z,SCCAFROUT

+	CP	4

+	JR	Z,OBDRU		; 64180-Card Parallel

+

+	CP	7		; Basis-Schnittstellen ?

+	JR	NC,FROUTOK	; Nein -> falscher Kanal

+

+				; Basis serielle/parallele Schnittstellen

+	CALL	FRE65

+	JR	FRCORR		; BC korrigieren auf Bytewert

+;

+OBDRU:

+	PUSH	IX

+	LD	IX,DRUCK

+FREBUF:

+	CALL	FREEBUF

+	POP	IX

+

+FRCORR:

+	POP	HL

+

+	INC	B	; Carry unveraendert

+	DEC	B

+	RET	Z	; weniger als 256 Zeichen frei

+	LD	BC,255	; mehr als 255 frei, Korrektur wegen EUMEL0!

+	RET

+

+FROUTOK:

+	SCF

+	LD	BC,200

+	POP	HL

+	RET

+

+SCCAFROUT:

+	PUSH	IX

+	LD	IX,SCCATAB

+	JR	FREBUF

+

+SCCBFROUT:

+	PUSH	IX

+	LD	IX,SCCBTAB

+	JR	FREBUF

+

+	

+;................................................................

+;

+;	S T O P

+;

+;	Weitere Eingaben sperren

+;

+;	Eingang: A = Kanalnummer (phys.)

+;

+STOP:

+	CALL	ESTOP

+	POP	HL

+	RET

+;

+;................................................................

+;

+;	W E I T E R

+;

+;	Weitere Eingaben wieder zulassen

+;

+;	Eingang: A  = Kanalnummer (phys.)

+;

+WEITER:

+	CALL	EGO

+	POP	HL

+	RET

+;

+;................................................................

+;

+;	S I Z E

+;

+;	Groesse in Bloecken eines Block I/O Kanals erfragen

+;

+;	Eingang: A  = Kanalnummer (phys.)

+;		 DE = Schluessel:

+;			Alle Formate haben 512-Bytes/Sektor und 5.25 Zoll

+;			0 = Standardformat des Laufwerks

+;			1, 0101010110101001B = 55A9H = 360k, 2 * 40 Tracks

+;			2, 0101011110101001B = 57A9H = 720k, 2 * 80 Tracks

+;			   0101011110001111B = 578FH = 640k-Erphi, 2 * 80 Trks

+;			   1101011110001111B = D78FH = 640k-Ehring, 2 * 80 Trks

+;			   0100000110001111B = 418FH = 160k-Apple, 1 * 40 Trks

+;	Ausgang: BC = Blockanzahl low

+;		 A  = Blockanzahl high

+SIZEX:

+	PUSH	HL

+

+SIZE:

+	CP	31

+	JR	NZ,SIZE1

+

+	LD	B,80		; Default 80 Tracks

+	INC	D

+	DEC	D		; D = 0 ?

+	JR	NZ,SIZE3	; Nein, Schluessel auswerten

+	LD	A,E

+	CP	1

+	JR	C,SIZE2		; 0: Default 80 Tracks

+	JR	NZ,SIZE2	; > 1 : 80 Tracks

+SIZE4:

+	LD	B,40		; 1: 40 Tracks

+SIZE2:

+	LD	A,B

+	CALL	INIFLP		; Archivtyp bestimmen

+	LD	(ARBLKS),BC

+	JR	ZRET

+

+SIZE3:

+	BIT	1,D		; Bit 9 (DE) unterscheidet 40/80 Tracks

+	JR	Z,SIZE4

+	JR	SIZE2

+	

+SIZE1:

+	CP	29		; Apple-Drive 0 oder 1 ?

+	JR	C,BRET		; Keine Formaterkennung auf anderen Kanaelen

+	CP	32

+	JR	NC,BRET		; Kanal >= 32 ?

+

+	CALL	INIDISK

+

+	LD	HL,D0BLKS	; HL darf veraendert werden

+	CP	30

+	JR	Z,SIZE5

+	LD	HL,D1BLKS

+SIZE5:

+	LD	(HL),C		; Fuer Blockio eintragen

+	INC	HL

+	LD	(HL),B

+	JR	ZRET		; Groesse in BC

+	

+BRET:

+	CALL	BLOCKS		; Groesse erfragen

+

+ZRET:

+	XOR	A		; Immer weniger als 65536 Bloecke

+	POP	HL

+	RET

+

+;................................................................

+;

+;	B L O C K S

+;	Erfragt die Anzahl der 512-Byte Bloecke, die ein phys. Kanal

+;	fassen kann.

+;

+;	Eingang: A = Kanalnummer (0, 1, 27..31)

+;	Ausgang: BC = Anzahl 512-Byte Blocks

+;		 keine anderen Register veraendert

+;

+BLOCKS:

+	PUSH	AF

+	CP	28

+	JR	NC,BLOCKS1

+	ADD	A,32			; 0 --> 32, 1 --> 33

+BLOCKS1:

+	LD	BC,0

+

+	CP	34

+	JR	NC,BLOCKS2		; Kanal existiert nicht

+

+	SUB	28			; Auf 0 normieren

+

+	PUSH	HL

+	ADD	A			; * 2

+	LD	C,A

+	LD	HL,BLKTAB

+	ADD	HL,BC

+	LD	C,(HL)

+	INC	HL

+	LD	B,(HL)

+	POP	HL

+BLOCKS2:

+	POP	AF

+	RET

+

+;................................................................

+;

+;	B A U D

+;

+;	Einstellung der Baudrate fuer serielle Schnittstellen

+;	andere Funktionen nicht implementiert

+;

+;	Eingang: A  = eigener Kanal

+;		 DE = adressierter Kanal

+;		 TOS= Schluessel

+;

+;		

+; 	Ausgang: BC = 0=ok, 1=nicht moeglich

+;

+BAUD:

+	POP	HL

+	PUSH	AF

+	LD	A,H

+	OR	D

+	JR	NZ,BITERR

+

+	LD	A,E		; addressierter Kanal

+	CALL	LOGPHYS		; Kanalnummer umrechnen

+	LD	E,A

+

+	CP	5

+	JR	Z,BASSER

+	CP	2

+	JR	Z,ONBDSR

+	CP	3

+	JR	NZ,BITERR

+

+ONBDSR:

+	LD	A,L

+	CP	17

+	JR	NC,BITERR	; Keine SHardspezifischen Baudrates

+	POP	AF

+	PUSH	AF

+	CP	32

+	LD	A,E

+	CALL	Z,BAUSCC	;serielle Schnittstellen on board

+	JR	ISPO

+;

+BASSER:

+	LD	A,L		;serielle Schnittstelle BASIS	

+	CP	16		;38400 Baud nicht moeglich, kein SHardspez.

+	JR	NC,BITERR

+	POP	AF

+	PUSH	AF

+	CP	32		;einstellend ?

+	CALL	Z,BAUBAS	;Ja ->	

+	JR	ISPO

+;

+;................................................................

+;

+;	B I T S

+;

+;	Eingang: A  = eigener Kanal

+;		 DE = adressierter Kanal

+;		 TOS= Schluessel

+;

+;	Unterstuetzt: 	1, 1.5, 2 Stopbits

+;			7 oder 8 Datenbits

+;			No, Even, Odd Parity

+;

+; 	Ausgang: BC = 0=ok, 1=nicht moeglich

+;

+BITS:

+	POP	HL

+	PUSH	AF

+	LD	A,H

+	OR	D

+	JR	NZ,BITERR

+

+	LD	A,E		; addressierter Kanal

+	CALL	LOGPHYS		; umrechnen

+	LD	E,A

+

+	CP	5

+	JR	Z,TBASS

+	CP	2

+	JR	Z,TSSER

+	CP	3		;serielle Kanaele ?

+	JR	NZ,BITERR	;Nein ->

+

+TSSER:

+	LD	A,L

+	AND	7		; Weniger als 7 Datenbits ?

+	CP	7-1

+	JR	C,BITERR

+;

+	POP	AF

+	PUSH	AF

+	CP	32

+	LD	A,E

+	CALL	Z,BITSCC

+ISPO:

+	POP	AF

+	LD	BC,0		;sonst moeglich melden

+	RET

+;

+TBASS:

+	LD	A,L

+	AND	7

+	CP	7-1

+	JR	C,BITERR	; Weniger als 7 Datenbits

+	BIT	5,L		; 1.5 Stopbits nicht moeglich

+	JR	NZ,BITERR

+	LD	A,L

+	CP	00101111B	; 8 Datenbits, 2 Stopbits und Parity nicht

+	JR	Z,BITERR

+	CP	00110111B	; dgl. even Parity nicht moeglich

+	JR	Z,BITERR

+

+	POP	AF

+	PUSH	AF

+	CP	32		; Werte einstellen ?

+	CALL	Z,BITBAS

+	JR	ISPO

+;

+BITERR:

+	POP	AF

+	LD	BC,1		;nicht moeglich

+	RET

+;

+;................................................................

+;

+;	F L O W

+;

+;	Flusskontrolle einstellen

+;

+;	Eingang: A  = eigener Kanal

+;		 DE = adressierter Kanal

+;		 TOS= Schluessel

+;

+;		

+; 	Ausgang: BC = 0=ok, 1=nicht moeglich

+;		

+FLOW:

+	POP	HL

+	PUSH	AF

+	LD	A,D

+	OR	H		; Modus > 255 oder Kanal > 255 --> geht nicht

+	JR	NZ,BITERR

+

+	LD	A,E		; adressierter Kanal

+	CALL	LOGPHYS		; umrechnen

+	LD	E,A

+	CP	CHNUM

+	JR	NC,BITERR	;falscher Kanal -> nicht moeglich

+	CP	1

+	JR	Z,BITERR

+

+	LD	A,L

+	AND	A		; Keine Flusskontrolle ?

+	JR	Z,FLOW1		; ja, 0 eintragen

+

+	CP	11

+	JR	NC,BITERR	; Modus > 11 geht nicht

+

+	CP	4		; Eingabe-/Ausgabeseitig ? (1, 2, 3)

+	JR	NC,FLOW1	; nein, Bits bleiben so

+	OR	1100B		; Bit 2 und 3 setzen

+FLOW1:

+	LD	C,A

+	LD	HL,FLMOD

+	ADD	HL,DE

+	AND	(HL)		; Und-Verknuepfen

+	CP	C		; Immer noch gleich Modus ? ja, erlaubt

+	JR	NZ,BITERR	; sonst nicht erlaubt

+	

+	POP	AF

+	PUSH	AF

+	CP	32

+	JR	NZ,ISPO		; ok melden, wenn nicht einstellend

+

+;	Flusskontrolle einstellen

+

+	LD	A,E		; Adressierter Kanal in A 

+	CALL	EGO		; 'Weiter' aufrufen mit alter Einstellung

+

+	CALL	FLWTYP

+	LD	(HL),C		; gewuenschten Modus eintragen

+

+	CP	5

+	CALL	Z,EFLOW5	; Eingabeflusskontrolle fuer Kanal 5

+				; DTR, XON/XOFF einstellbar

+

+				; Da RTS-Fluskontrolle hardwaremaessig bedingt

+				; nicht wie gewuenscht arbeitet (Uebertragungs-

+				; fehler und Transmitter disabled), wird DTR-

+				; Flusskontrolle verwendet. ggf. muss die RTS-

+				; Leitung des Fremdrechners mit der DTR-

+				; Leitung (Pin 20) des Basis verbunden werden.

+	CALL	AFLOW		; Ausgabe-Flusskontrolle einstellen

+	JR	ISPO

+	

+;...........................................................................

+;	

+;	F L W T Y P

+;

+;	Zeiger auf Tabelle mit aktuellem Flusskontrollmodus berechnen

+;

+;	Eingang: A = gewuenschter Kanal (1..15)

+;

+;	Ausgang: HL = Zeiger auf Eintrag in der Flowtabelle

+;		 andere Register nicht veraendert

+;

+FLWTYP:

+	LD	HL,FLTAB

+	CP	CHNUM		; Zeigt auf Dummyeintrag

+	RET	NC

+

+	PUSH	DE

+	LD	D,0

+	LD	E,A

+	ADD	HL,DE

+	POP	DE

+	RET

+

+;

+;

+;	Flowtabelle

+;

+;	Bit 0 : 1 = XON/XOFF

+;	Bit 1 : 1 = RTS/CTS (bzw. DTR/CTS bei Basis)

+;	Bit 2 : 1 = Ausgabeseitige Flusskontrolle

+;	Bit 3 : 1 = Eingabeseitige Flusskontrolle

+;	Bit 7 : 1 = Eingabeseitig im Stopzustand

+;

+FLTAB::

+	DEFB	0		; -

+	DEFB	1000B		; Kanal 1, Eingabeflusskontrolle

+	DEFB	0		; Kanal 2

+	DEFB	0		; Kanal 3

+	DEFB	0		; Kanal 4

+	DEFB	0		; Kanal 5

+	DEFB	0		; Kanal 6

+;

+CHNUM	EQU	$-FLTAB		;Kanalanzahl

+

+;	Tabelle mit Flowmoeglichkeiten der Kanaele

+;	Bit 0 : 1 = XON/XOFF moeglich

+;	Bit 1 : 1 = RTS/CTS (bzw. DTR/CTS bei Basis) moeglich

+;	Bit 2 : 1 = Ausgabeseitige Flusskontrolle moeglich

+;	Bit 3 : 1 = Eingabeseitige Flusskontrolle moeglich

+;		Bit 2 und 3 duerfen gleichzeitig 1 sein.

+;		Bit 0 und 1 duerfen gleichzeitig 0 und 1 sein.

+

+FLMOD:

+	DEFB	0		; -

+	DEFB	0		; Kanal 1, nicht einstellbar

+	DEFB	1111B		; Kanal 2

+	DEFB	1111B		; Kanal	3

+	DEFB	0		; Kanal 4

+	DEFB	1111B		; Kanal 5

+	DEFB	0		; Kanal 6

+;

+;................................................................

+;

+;	F O R M A T

+;

+;	Archiv formatieren

+;

+;	Eingang:  A = Kanalnummer

+;		  DE = Schluessel, wie SIZE

+;	Ausgang:  BC = Rueckmeldung, wie BLOCKIO

+;

+FORMAT:

+	POP	HL

+	LD	BC,-1

+	CP	31		; SCSI-Floppy ?

+	RET	NZ		; Kein formatieren moeglich

+

+	PUSH	AF

+

+	CALL	SIZEX

+	LD	A,SFORMAT

+	LD	(HGOP),A

+	LD	BC,ARC31

+	CALL	SCSIBK

+	POP	AF

+	RET

+;

+;****************************************************************

+;

+;	C A L E N D A R

+;

+;	Entry:	DE = (1:Min, 2:Std, 3: Tag, 4:Mon, 5:Jahr)

+;	Ausgang:BC = Rueckmeldung

+;		     BC = -1 : Keine Uhr oder falsche Parameter

+;			sonst: gewuenschter BCD(!)-Wert

+;

+;

+

+CALENDAR:

+	PUSH	AF

+	DI

+	LD	BC,-1

+	LD	A,D	

+	JR	NZ,CALEND	; fehlerhafter Aufruf

+	LD	A,E

+	CP	6

+	JR	NC,CALEND	; ebenfalls

+	LD	A,(RTCOK)	; Flag fuer Time ok

+	AND	A

+	JR	Z,CALEND	; 0= Nicht ok

+

+	LD	A,20H		; 2 (programmierte) eff. 3 Uhrenwaitstates

+	OUT0	(DCNTL),A

+

+	LD	BC,RTCRA	; B=0 !

+

+CAL1:	TSTIO	80H		; UIP (Update in progress) testen

+	JR	NZ,CAL1		; warten bis beendet

+

+	LD	HL,CALPORTS	; Tabelle mit Registerzuordnung

+	ADD	HL,DE		; D ist 0, E ist Offset

+	LD	C,(HL)

+	IN	C,(C)		; BC = BCD-Wert

+	LD	B,C		; High-Digit ins Highbyte

+	SRL	B

+	SRL	B

+	SRL	B

+	SRL	B

+

+CALEND:

+	XOR	A

+	OUT0	(DCNTL),A	; 0 (prog.) I/O Waitstates

+	EI

+	POP	AF

+	POP	HL

+	RET

+

+CALPORTS:

+	DEFB	RTCS, RTCM, RTCH, RTCDY, RTCMO, RTCYR

+;		Sec,  Min,  Std,  Day,   Mon,   Year

+

+	

+;****************************************************************

+;

+;	I O A C C

+;

+;	Entry:	HL = -1 = Read, sonst Value

+;		DE = I/O-Addr. (0..FF) real + 40H

+;			(Prozessor I/O: C0..FF)

+;		A  = aufrufender Kanal (Write nur 32!)

+;

+;	Exit:	BC = -1 = Error

+;		sonst Value

+;

+;

+IOACC:

+	POP	HL

+	CP	25		; Nur an privilegierten Kanaelen

+	LD	BC,-1		; Kanal 25..32

+	RET	C

+	INC	B		; B := 0

+

+	LD	A,E

+	ADD	A,040H		; I/O-Adresse umrechnen

+	LD	C,A

+;

+;	2 zusaetzliche I/O Wait States einbauen (fuer Uhrenzugriff)

+;

+	CP	0C0H		; Uhrenzugriff ?

+	JR	C,NCLK		; Nein -> keine extra Wait States

+

+	DI

+

+	LD	A,20H

+	OUT0	(DCNTL),A

+;

+NCLK:

+	LD	A,L

+	AND	H

+	INC	A		; HL = -1 ? 

+	JR	Z,RDVAL		; Ja ->

+;

+	OUT	(C),L		; Wert eintragen

+	LD	C,B		; C := 0

+	JR	IOAEND

+;

+RDVAL:

+	IN	C,(C)

+;

+IOAEND:

+	XOR	A		; Keine Waitstates mehr

+	OUT0	(DCNTL),A

+	EI

+	RET

+

+;***********************************************************************

+;

+;	C L R B U F

+;

+;	Drucker-Spooler des Kanals loeschen

+;

+;	Eingang: A = Kanalnummer (4, 6)

+;

+CLRBUF:

+	CALL	LOGPHYS

+	LD	L,8			; Task 8 : Clear Spooler

+	CP	A,6

+	CALL	Z,TO6502		; A nicht veraendert

+	CP	A,4

+	CALL	Z,CLRCBUF

+	POP	HL

+	RET

+

+;----------------------------------------------------------------

+;

+;	O U T V A R

+;

+;	Ausgabe einer Zeichenkette

+;

+; 	Eingang:  A = Terminalnummer (1=Arbeitsconsole, 2=Drucker)

+;	          HL = Adresse der Zeichenkette

+;       	  BC = Anzahl der Zeichen

+;	Ausgang:  BC = Anzahl der uebernommenen Zeichen.

+;	          c-Flag gesetzt <=> alles uebernommem.

+;

+;	Hinweis: SHOUT darf auf keinen Fall WARTE aufrufen !!

+;

+SHOUT:

+	

+	CALL	LOGPHYS		; Kanalnummer log. --> phys. umrechnen

+	LD	(KANAL),A

+	LD	A,B

+	OR	C

+	JR	Z,OUTEA		; Nix auszugeben

+

+	PUSH	DE

+	PUSH	HL

+

+	LD	A,(KANAL)

+	CP	1

+	JR	Z,OUT1

+	CP	5

+	JR	Z,OUT5

+	CP	6

+	JR	C,OUT234

+	JR	Z,OUT6

+

+OVDON:

+	SCF			; Alles uebernommen

+RETREG:

+	POP	HL

+	POP	DE

+OUTEA:	LD	A,(KANAL)

+	RET

+

+OUT1:				; Master Console

+	CALL	STROUT

+	JR	OVDON		; Alles uebernommen

+;

+;

+OUT5:				; BASIS serielle Schnittstelle

+	LD	E,4

+	JR	OUT56

+

+OUT6:				; BASIS parallele Schnittstelle

+	LD	E,3

+OUT56:

+				; Anzahl uebernehmbarer Zeichen berechnen

+	PUSH	BC

+	CALL	FRE65		; Kanal in A, HL veraendert BC = Size-Free

+	LD	H,B

+	LD	L,C

+	POP	BC

+

+	LD	A,L

+	SUB	C

+	LD	A,H

+	SBC	B		; NC : HL (free) >= BC (length)

+	JR	NC,OUT56A	; NC: Alles uebernommen

+	LD	B,H

+	LD	C,L		; uebernommene Laenge

+OUT56A:

+	POP	HL

+	PUSH	HL

+	CCF			; Carry Flag, fuer "Alles uebernommen"

+	PUSH	BC

+	PUSH	AF

+				; fuer Ausgang merken

+OUT56B:

+	LD	A,B

+	OR	C

+	JR	Z,OUT56C	; fertig

+

+	PUSH	HL

+	LD	H,(HL)		; Zu sendendes Zeichen

+	LD	L,E		; Task 3 oder 4

+	CALL	TO6502

+	POP	HL

+

+	INC	HL

+	DEC	BC

+	JR	OUT56B

+

+OUT56C:

+	POP	AF		; Carry Flag

+	POP	BC

+	JR	RETREG

+

+OUT234:				; 64180-Card Kanaele (SCCA, SCCB, Centronics)

+	PUSH	IX

+	LD	IX,DRUCK	; Zeiger auf Centronics Kanaltabelle

+	CP	4

+	JR	Z,PUTBUFF

+	LD	IX,SCCATAB

+	CP	3

+	JR	Z,PUTBUFF

+	LD	IX,SCCBTAB

+

+PUTBUFF:

+	CALL	PUTBUF		; Falls Puffer voll, nichts uebernommen

+	POP	IX

+	JR	RETREG

+

+;

+;

+;****************************************************************

+;

+;	Meldungen ausgeben auf System-Kanal

+;	String beginnt mit Laengenbyte (!)

+;	Ausser HL keine Register verandert

+;

+SENDMSG:

+	PUSH	AF

+	PUSH	BC

+	LD	C,(HL)

+	INC	HL

+	LD	B,0

+	LD	A,1		; System-Kanal

+	CALL	SHOUT		; String ab HL an Kanal in A ausgeben

+	POP	BC

+	POP	AF

+	RET

+;

+;****************************************************************

+;

+;	Variable

+;

+HDOFS:	DEFB	0		;Harddisk 0

+	DEFB	30H, 00H

+HDLAST:	DEFB	0

+	DEFB	0B2H, 0

+;

+SAVSTP:	DEFW	0		; gesicherter Stackpointer bei TRAP-Interrupt

+RTCOK:	DEFB	0		; FF, wenn RTC-Werte gueltig

+HGOP:	DEFB	0

+KANAL:	DEFB	1		; Kanal merken

+

+;------------------------------------------------------------------------

+;	Anzahl 512-Byte Bloecke, die ein Blockkanal fassen kann

+;	Wird bei control-size abgefragt und vorher bestimmt

+

+BLKTAB:

+

+CPMBLKS:DEFW	0		; Kanal 28 CP/M-Harddisk-Volume

+D1BLKS:	DEFW	0		; Kanal 29 Apple-Floppy 1

+D0BLKS:	DEFW	0		; Kanal 30 Apple-Floppy 0

+ARBLKS:	DEFW	1440		; Kanal 31 SCSI-Floppy 0

+HGBLKS:	DEFW	0		; Kanal 0 (Hintergrund)

+CONBLKS:DEFW	2*4*8		; Kanal 1 (Graphikspeicher) 4 * 8k Seiten

+;

+;

+;****************************************************************

+;

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB b/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB
new file mode 100644
index 0000000..1438f05
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB
@@ -0,0 +1,7 @@
+L80

+</P:0,LOAD,/P:0100,SHARD,SCSI,CONOUT,DISK80,GRAFIK80,INTMOD,INT65,INIMOD,DISK

+</M

+<EUMEL/N/E

+<N

+EBOOT

+<J

diff --git a/system/shard-z80-ruc-64180/1.5/src/SLR.COM b/system/shard-z80-ruc-64180/1.5/src/SLR.COM
new file mode 100644
index 0000000..eb9b9a9
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SLR.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/START.MAC b/system/shard-z80-ruc-64180/1.5/src/START.MAC
new file mode 100644
index 0000000..ec199cd
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/START.MAC
@@ -0,0 +1,4 @@
+; Start zum EBOOT, 29.12.86

+	EXTRN	EBOOT

+	JP	EBOOT

+	END

diff --git a/system/shard-z80-ruc-64180/1.5/src/SUB.COM b/system/shard-z80-ruc-64180/1.5/src/SUB.COM
new file mode 100644
index 0000000..5cd90e3
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/SUB.COM
diff --git a/system/shard-z80-ruc-64180/1.5/src/TRACK.INC b/system/shard-z80-ruc-64180/1.5/src/TRACK.INC
new file mode 100644
index 0000000..162d1ae
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/TRACK.INC
@@ -0,0 +1,166 @@
+

+; TRACK.INC for RUC180 CP/M 3.0

+;

+; Version 13.09.85

+; Stand: 13.01.87, Retries fuer EUMEL entschaerft (ca. 1/8 der alten Zeit)

+

+	  .printx 'TRACK.INC'

+

+track_RW

+          ldy       #1			; 13.01.87, Michael

+          sty       recal_cnt

+          ldy       #02			; 13.01.87

+          sty       tktry_cnt

+          ldx       iob_old_S

+          cpx       slot10z

+          beq       sameSLt

+track0

+          JSR       moving

+          BNE       track0

+          LDX       slot10z

+          STX       iob_old_S

+sameSlt

+          JSR       moving

+          PHP

+          LDA       mtron,X

+          ldy       iob_drv

+          cpy       iob_old_D

+          BEQ       sameDrv

+          sty       iob_old_D

+          PLP

+          lda       #0

+          PHP

+sameDrv

+          CMP       drive0,Y

+          LDA       #0EF

+          STA       wait_cnt

+          LDA       #0D8

+          STA       wait_cnt+1

+          PLP

+          PHP

+          BNE       track2

+          LDY       #8

+track1    JSR       wait

+          DEY

+          BNE       track1

+

+          LDX       slot10z

+track2    JSR       seekT		; Step to Track

+

+          PLP

+          BNE       rotating

+;         bit       param		; wg. bescheuerten Philips-Drives

+;         bmi       no_wait           	; branch if read

+

+track3    LDY       #12

+track4    DEY

+          BNE       track4

+          INC       wait_cnt

+          BNE       track3

+          INC       wait_cnt+1

+          BNE       track3

+;no_wait

+          JSR       moving

+          BEQ       drive_err

+rotating

+          LDA       #0FF

+          STA       iob_sec

+search_hdr

+          LDY       #10			; 13.01.87

+          STY       hdtry_cnt

+nxt_sec

+          cli

+          dec       hdtry_cnt

+          BMI       no_sec

+

+          LDX       slot10z

+          JSR       read_hdr

+          BCS       nxt_sec

+          LDA       trk_in_hdr

+          CMP       iob_trk

+          BEQ       found_trk

+          cli

+	  jsr	    trk_to_ph		; Translate Track to Phase

+          LDY       disk_no

+          STA       head_table,Y	; Store it in Table

+          DEC       tktry_cnt

+          BNE       try_seek

+no_sec

+          DEC       recal_cnt

+          BEQ       drive_err

+          LDA       #02			; 13.01.87

+          STA       tktry_cnt

+	  lda	    #56

+	  bit	    def_byte

+	  bmi	    no_sec2		; Ehring-Controller ?

+

+	  asl	    a			; Ehring: *2

+no_sec2:  LDY       disk_no

+          STA       head_table,Y

+          LDA       #0

+          JSR       seekL		; Step von hinten bis 0

+try_seek

+          JSR       seekT

+          JMP       search_hdr

+drive_err

+          LDA       #1

+          JMP       track_fail

+

+found_trk

+          bit       param

+          bmi       found2

+          LDA       sec_in_hdr

+          CMP       iob_sec

+          BEQ       write_it

+          CLC                     ; next sector for write!

+          ADC       #01

+          AND       #0F

+          CMP       iob_sec

+          BEQ       nxt_sec

+          STA       sec_in_hdr

+found2

+          LDY       sec_in_hdr   ; if sec_in_hdr>=10 then crash...

+          LDA       sec_tble,Y

+          bne       nxt_sec

+;need_sec

+          TYA               	  ; physical sector #

+          ASL       A       	  ;

+          TAY

+          lda       DMA,y

+          sta       user_data

+          lda       DMA+1,y

+          STA       user_data+1    ; pointer to user's buffer

+          bit       param

+          bmi       read_it

+          JSR       make_nibl 

+          LDX       slot10z

+          LDA       sec_in_hdr

+          STA       iob_sec

+j_nxt_sec

+          JMP       nxt_sec

+read_it

+          JSR       read_data

+          BCS       j_nxt_sec

+mark_sec

+          LDY       sec_in_hdr

+          LDA       #0FF

+          STA       sec_tble,Y

+          STA       iob_sec

+          DEC       sec_cnt

+          BNE       j_nxt_sec

+;track_ok

+          lda       #0

+track_fail

+          sta       iob_err

+          lda       mtroff,X

+          cli

+          rts

+write_it

+          JSR       write_data

+          BCC       mark_sec

+          LDA       #2              ; write protected !

+          BCS       track_fail      ; bra

+

+	  .printx   'Ende'

+

+; Ende von NIBLE.INC

diff --git a/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC b/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC
new file mode 100644
index 0000000..a6edf3e
--- /dev/null
+++ b/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC
@@ -0,0 +1,154 @@
+	;		05..09  		GRAFIK

+basl		EQU	0A	;		DISK (HCOPY im IRQ)

+bash 		EQU	0B	;		DISK (HCOPY im IRQ)

+

+sektor		EQU	0C	;		DISK65

+last_track	EQU	0D	;		DISK65

+bus_locked	EQU	0E	;		DISK65	; Interrupt Flag

+analogwert	EQU	0F	;		DISK65

+

+rbuf		EQU	10	; 10 Bytes Receive-Buffer Descriptor

+

+keyin		EQU	1A	;		DISK

+keyout		EQU	1B	;		DISK

+

+err1_bits	EQU	1C	;		DISK

+err5_bits	EQU	1D	;		DISk

+

+quotient	EQU	1E	;		GRAFIK

+divmask		EQU	1F	;		GRAFIK

+

+temporary	EQU	1E	; +1F		GRAFIK

+

+;	Paket Variable (duerfen Global NICHT veraendert werden!)

+

+thick		EQU	05	;		GRAFIK

+colormask	EQU	06	;		GRAFIK 

+bitmode		EQU	07	;		GRAFIK

+savepattern	EQU	08	; +09		GRAFIK

+pattern		EQU	24	; +25		GRAFIK

+pagebase	EQU	2A	;		GRAFIK

+xpos		EQU	2B	; +2C		GRAFIK

+ypos		EQU	2D	; +2E		GRAFIK

+

+;	Workspace

+

+xpointer	EQU	26	;		GRAFIK

+ypointer	EQU	27	;		GRAFIK

+

+olderror	EQU	28	; +29		GRAFIK

+

+right		EQU	3D	;		GRAFIK

+up		EQU	3E	;		GRAFIK

+

+uprighterror	EQU	3F	; +40		GRAFIK

+;

+ASave		equ	45	;		DISK

+XSave		equ	46	;		DISK

+YSave		equ	47	;		DISK

+

+;

+				; Basis-Schnittstellen:

+KeyBuf		equ	0200	; Page 2 fuer KeyBuf

+wrkpage		EQU	080	; 8k Workpage fuer Fill-Routine

+dma_4k		EQU	0E0	;		DISK65

+DBUFBEG		EQU	0D0	;Printer Spooler Grenzen (4k)

+DBUFEND		EQU	0E0	;		DISK (LC00)

+stack		EQU	0D000	;		GRAFIK (LC01)

+SBUFBEG		EQU	0F0	;Seriell Ausgabe-Spooler Grenzen (1k)

+SBUFEND		EQU	0F4	;		DISK

+RBUFBEG		EQU	0F4	; Serieller Empfangspuffer (2.25k)

+RBUFEND		EQU	0FD	;		DISK

+

+				; Dummy-Block-Buffer fuer SCSI: FD00..FEFF

+				; 64180-Card-Schnittstellen:

+				; DBUF (Centronics): A000..AFFF

+				; SCCA : B000..B7FF

+				; SCCB : B800..BFFF

+

+

+; 64180 interface

+

+DMA       	equ	50	; 50..6F	DISK, DISK65	

+address		equ	50	; +51		GRAFIK

+dx		equ	52	; +53		GRAFIK

+dy		equ	54	; +55		GRAFIK

+righterror	equ	54	; +55		GRAFIK (wie dy!)

+tempmode	equ	56	;		GRAFIK

+

+sec_tble  	equ	70	; 70..7F	DISK, DISK65

+areg		equ	70	; +71		GRAFIK

+breg		equ	72	; +72		GRAFIK

+creg		equ	74	; +75		GRAFIK

+xa		equ	76	; +77		GRAFIK

+xb		equ	78	; +79		GRAFIK

+ya		equ	7A	; +7B		GRAFIK

+yb		equ	7C	; +7D		GRAFIK

+link		equ	7E	; +7F		GRAFIK

+

+task	  	equ	80	; 80		DISK, DISK65

+subtask		EQU	81	;		GRAFIK

+result		EQU	81	;		GRAFIK

+param	  	equ	81	;		DISK, DISK65

+param1		EQU	82	; +83		GRAFIK

+def_byte  	equ	82	;		DISK, DISK65

+disk_no   	equ	83	;		DISK, DISK65

+param2		EQU	84	; +85		GRAFIK

+iob_trk   	equ	84	;		DISK, DISK65

+sec_cnt   	equ	85	;		DISK, DISK65

+iob_err   	equ	86	;		DISK, DISK65

+

+; work space

+

+wait_Cnt   	equ	87	;		DISK

+user_data 	equ	89	;		DISK

+dest_phase 	equ	8B	;		DISK

+chk_in_hdr 	equ	8C	;		DISK

+sec_in_hdr 	equ	8D	;		DISK

+trk_in_hdr 	equ	8E	;		DISK

+vol_in_hdr 	equ	8F	;		DISK

+slot10z   	equ	90      ; slot #: s0	DISK

+iob_drv   	equ	91	;		DISK

+phase     	equ	92	;		DISK

+iob_sec   	equ	93	;		DISK

+chk_sum   	equ	94	;		DISK

+temp2     	equ	95	;		DISK

+head_pos  	equ	96	;		DISK

+tktry_cnt 	equ	97	;		DISK

+hdtry_cnt 	equ	98	;		DISK

+recal_cnt 	equ	99	;		DISK

+A_FLG	  	EQU	9A	; Flags fuer Ausgabeflusskontrolle

+E_FLG		EQU	9B	; Flags fuer Eingabeflusskontrolle

+SerFLG	  	EQU	9C	; Break/Ausgabestopflags

+Wait_Flg	EQU	9D	; 64180 muss auf Update warten

+IFLG		EQU	9E	; Bit 7 = 1: Keine Inputinterrupt Kanal 5

+SLOT180	  	EQU	9F	; Bootslot (Kopie)

+;

+ilv_tble	EQU	$A0	; A0..AF	DISK, DISK65

+	

+;	Offset auf Buffer-Descriptor

+

+free		equ	0	; Freiplatz in Bytes

+full		equ	2	; Anzahl Zeichen im Puffer

+in		equ	4	; Schreibzeiger

+out		equ	6	; Lesezeiger

+beg		equ	8	; Highbyte Pufferanfang

+end		equ	9	; Highbyte Pufferende

+

+pbuf		equ	0E0	; 10 Bytes Spooler Descriptor

+;

+; Interruptparameter zum 64180

+;

+INTPAR1		EQU	0EA	; Interrupt Kanalnr. und Sync.

+INTPAR2		EQU	0EB	;		DISK

+INTPAR3		EQU	0EC	; Fehlerbits	DISK

+

+tbuf		EQU	0F0	; 10 Bytes Transmit-Buffer Descrptor

+

+SLT180	  	EQU	04F8	; Bootslot	DISK

+

+start180 	equ	0C087	;		DISK

+wait180		equ	0C086	;		DISK

+STOP180		equ	0C084	;		DISK

+INT180		EQU	0C083	;		DISK	

+

diff --git a/system/spooler/1.7.5/source-disk b/system/spooler/1.7.5/source-disk
new file mode 100644
index 0000000..e24344a
--- /dev/null
+++ b/system/spooler/1.7.5/source-disk
@@ -0,0 +1,2 @@
+175_src/source-code-1.7.5m_0.img
+175_src/source-code-1.7.5m_1.img
diff --git a/system/spooler/1.7.5/src/spool manager b/system/spooler/1.7.5/src/spool manager
new file mode 100644
index 0000000..ac0295a
--- /dev/null
+++ b/system/spooler/1.7.5/src/spool manager
@@ -0,0 +1,887 @@
+PACKET spool manager DEFINES                        (* Autor: J. Liedtke *)
+                                                    (*        R. Nolting *) 
+                                                    (*        R. Ruland  *)
+                                                    (* Stand: 25.04.86   *)
+ 
+    spool manager ,
+ 
+    server channel ,
+    spool duty,
+    station only, 
+    spool control task :
+ 
+LET que size           = 101 ,
+
+    ack                = 0 ,
+    nak                = 1 ,
+    error nak          = 2 ,
+    message ack        = 3 , 
+    question ack       = 4 ,
+    second phase ack   = 5 ,
+
+    fetch code         = 11 ,
+    save code          = 12 ,
+    file save code old = 13 ,
+    erase code         = 14 ,
+    list code          = 15 ,
+    all code           = 17 ,
+    param fetch code   = 21 ,
+    file save code     = 22 ,
+    entry line code    = 23 ,
+    killer code        = 24 , 
+    first code         = 25 ,
+    start code         = 26 , 
+    stop code          = 27 ,
+    halt code          = 28 ,
+    wait for halt code = 29 ,
+ 
+    continue code      = 100 ,
+ 
+    file type          = 1003 ;
+
+LET begin char  =  ""0"",
+    end char    =  ""1"";
+
+LET PARAMS  =  STRUCT (TEXT name, userid, password, sendername, INT station),
+    ENTRY   =  STRUCT (PARAMS ds params, TEXT entry line, DATASPACE space);
+ 
+ROW que size ENTRY VAR que ;
+
+PARAMS CONST empty params := PARAMS : ("", "", "", "", -1);
+ 
+PARAMS VAR save params, file save params;
+ 
+ENTRY VAR fetch entry;
+ 
+FILE VAR file;
+ 
+INT VAR order, last order, phase, reply, old heap size, first, last, list index, 
+        begin pos, end pos, order task station, sp channel, counter;
+ 
+TEXT VAR order task name, buffer, sp duty, start time;
+ 
+BOOL VAR server is waiting, stop command pending, stat only, valid fetch entry;
+ 
+TASK VAR order task, last order task, server, calling parent, task in control; 
+ 
+INITFLAG VAR in this task := FALSE;
+ 
+DATASPACE VAR ds;
+
+BOUND STRUCT (TEXT name, userid, password) VAR msg;
+BOUND STRUCT (TEXT entry line, INT index) VAR control msg;
+BOUND PARAMS VAR fetch msg;
+BOUND THESAURUS VAR all msg;
+BOUND TEXT VAR error msg ;
+ 
+ 
+. first entry   :  que (first)
+. list  entry   :  que (list index)
+. last  entry   :  que (last)
+ 
+. que is empty  :  first = last 
+. que is full   :  first = next (last) 
+.; 
+ 
+sp channel      := 0;
+sp duty         := ""; 
+stat only       := FALSE;
+task in control := myself;
+ 
+PROC server channel (INT CONST channel nr) :
+     IF channel nr <= 0 OR channel nr >= 33
+        THEN errorstop ("falsche Kanalangabe") FI;
+     sp channel := channel nr;
+END PROC server channel;
+ 
+INT PROC server channel :
+     sp channel 
+END PROC server channel;
+ 
+ 
+PROC station only (BOOL CONST flag) :
+     stat only := flag
+END PROC station only;
+ 
+BOOL PROC station only : 
+     stat only 
+END PROC station only;
+ 
+ 
+PROC spool duty (TEXT CONST duty) :
+     sp duty := duty;
+END PROC spool duty;
+ 
+TEXT PROC spool duty :
+     sp duty
+END PROC spool duty;
+ 
+ 
+PROC spool control task (TASK CONST task id):
+     task in control := task id;
+END PROC spool control task;
+ 
+TASK PROC spool control task :
+     task in control
+END PROC spool control task;
+ 
+ 
+PROC spool manager (PROC server start) :
+ 
+  spool manager (PROC server start, TRUE) 
+ 
+END PROC spool manager;
+ 
+ 
+PROC spool manager (PROC server start, BOOL CONST with start) :
+
+  set autonom ;
+  break ;
+  disable stop ;
+  initialize spool manager ;
+  REP forget (ds) ;
+      wait (ds, order, order task) ;
+      IF   order <> second phase ack
+         THEN prepare first phase ;
+              spool (PROC server start); 
+      ELIF order task = last order task
+         THEN prepare second phase ;
+              spool (PROC server start); 
+         ELSE send nak
+      FI ;
+      send error if necessary ;
+      collect heap garbage if necessary
+  PER 
+ 
+  . initialize spool manager :
+      initialize if necessary;
+      stop;
+      erase fetch entry;
+      IF with start THEN start (PROC server start) FI;
+ 
+  . initialize if necessary :
+      IF NOT initialized (in this task)
+         THEN FOR list index FROM 1 UPTO que size 
+              REP list entry. space := nilspace PER;
+              fetch entry. space    := nilspace;
+              ds                    := nilspace;
+              last order task       := niltask;
+              server                := niltask; 
+              calling parent        := niltask;
+              server is waiting     := FALSE;
+              stop command pending  := FALSE;
+              old heap size         := 0;
+              clear spool;
+      FI;
+
+  . prepare first phase :
+      IF order = save code OR order = erase code OR order = stop code
+         THEN phase := 1 ;
+              last order := order ;
+              last order task := order task ;
+      FI;
+ 
+  . prepare second phase :
+      phase INCR 1 ;
+      order := last order 
+
+  . send nak :
+      forget (ds) ;
+      ds := nilspace ;
+      send (order task, nak, ds);
+ 
+  . send error if necessary :
+      IF is error
+         THEN forget (ds) ;
+              ds := nilspace ;
+              error msg := ds ;
+              CONCR (error msg) := error message;
+              clear error;
+              send (order task, error nak, ds) 
+     FI;
+ 
+  . collect heap garbage if necessary :
+      IF heap size > old heap size + 2
+         THEN collect heap garbage;
+              old heap size := heap size;
+      FI; 
+ 
+END PROC spool manager;
+ 
+ 
+PROC spool (PROC server start):
+ 
+  command dialogue (FALSE);
+  enable stop;
+  IF station only CAND station (ordertask) <> station (myself)
+     THEN errorstop ("kein Zugriffsrecht auf Task " + text (station(myself))
+                      + "/""" + name(myself) + """") 
+  FI;
+ 
+  SELECT order OF
+ 
+    CASE fetch code        :  out of que
+    CASE param fetch code  :  send fetch params
+    CASE save code         :  new que entry
+    CASE file save code, file save code old :
+                              new file que entry 
+    CASE erase code        :  erase que entry
+    CASE list code         :  send spool list
+    CASE all code          :  send owners ds names
+ 
+    OTHERWISE :
+ 
+       IF   order >= continue code AND order task = supervisor
+            THEN forget (ds);
+                 spool command (PROC server start)
+ 
+       ELIF spool control allowed by order task 
+            THEN SELECT order OF
+                   CASE entry line code    :  send next entry line 
+                   CASE killer code        :  kill entry 
+                   CASE first code         :  make to first
+                   CASE start code         :  start server 
+                   CASE stop code          :  stop server
+                   CASE halt code          :  halt server
+                   CASE wait for halt code :  wait for halt
+                   OTHERWISE : errorstop ("falscher Auftrag fuer Task """
+                                                      + name(myself) + """") 
+                 END SELECT
+ 
+            ELSE errorstop ("falscher Auftrag fuer Task """
+                                                      + name(myself) + """") 
+       FI;
+  END SELECT;
+ 
+ 
+. spool control allowed by order task :
+    (order task = spool control task OR order task < spool control task
+       OR spool control task = supervisor)
+         AND station (order task) = station (myself)
+. 
+  out of que :
+    IF   NOT (order task = server)
+         THEN errorstop ("keine Servertask")
+    ELIF stop command pending 
+         THEN forget (ds);
+              stop;
+              erase fetch entry;
+    ELIF que is empty
+         THEN forget (ds) ;
+              erase fetch entry;
+              server is waiting := TRUE;
+         ELSE send first entry;
+    FI;
+ 
+. 
+  send fetch params :
+    IF order task = server
+       THEN send params
+       ELSE errorstop ("keine Servertask")
+    FI;
+ 
+    . send params :
+        forget(ds); ds := nilspace; fetch msg := ds;
+        fetch msg := fetch entry. ds params;
+        send (order task, ack, ds);
+ 
+. 
+  new que entry :
+    IF phase = 1
+       THEN prepare into que
+       ELSE into que
+    FI;
+ 
+.
+  prepare into que :
+    msg := ds ;
+    save params. name       := msg.name;
+    save params. userid     := msg.userid;
+    save params. password   := msg.password;
+    save params. sendername := name (order task);
+    save params. station    := station (order task);
+    forget (ds); ds := nilspace;
+    send (order task, second phase ack, ds);
+ 
+. 
+  new file que entry :
+    IF type (ds) <> file type
+       THEN errorstop ("Datenraum hat falschen Typ");
+       ELSE get file params;
+            into que;
+    FI;
+ 
+    . get file params :
+        file := sequential file (input, ds);
+        end pos := 0;
+        next headline information (file save params. name); 
+        next headline information (file save params. userid); 
+        next headline information (file save params. password); 
+        next headline information (file save params. sendername); 
+        next headline information (buffer);
+        file save params. station := int (buffer);
+        IF NOT last conversion ok
+           THEN file save params. station    := station (order task) FI;
+        IF file save params. sendername = ""
+           THEN file save params. sendername := name    (order task) FI;
+        IF file save params. name = ""
+           THEN IF headline (file) <> ""
+                   THEN file save params. name := headline (file);
+                   ELSE errorstop ("Name unzulaessig")
+                FI;
+           ELSE headline (file, file save params. name);
+        FI;
+ 
+. 
+  erase que entry :
+    msg                := ds ;
+    order task name    := name (order task);
+    order task station := station (order task);
+    IF phase = 1
+       THEN ask for erase
+       ELSE erase entry from order task 
+    FI;
+ 
+    . ask for erase :
+        to first que entry; 
+        WHILE next que entry found 
+        REP IF is entry from order task (msg. name) 
+               THEN manager question ("""" + msg.name + """ loeschen"); 
+                    LEAVE erase que entry
+            FI;
+        PER ;
+        manager message ("""" + msg.name + """ existiert nicht");
+ 
+    . erase entry from order task :
+        IF is entry from order task (msg. name) 
+           THEN delete que entry; 
+                LEAVE erase que entry 
+           ELSE to first que entry; 
+                WHILE next que entry found 
+                REP IF is entry from order task (msg. name) 
+                       THEN delete que entry;
+                            LEAVE erase que entry 
+                    FI ;
+                PER ;
+                manager message ("""" + msg.name +  """ existiert nicht");
+        FI;
+ 
+        . delete que entry :
+            erase entry (list index) ;
+            send ack;
+ 
+.
+  send owners ds names:
+     order task name    := name (order task);
+     order task station := station (order task);
+     forget (ds); ds := nilspace; all msg := ds; 
+     all msg := empty thesaurus; 
+     to first que entry; 
+     WHILE next que entry found 
+     REP IF is entry from order task ("")
+            THEN insert (all msg, list entry. ds params. name) 
+         FI; 
+     PER;
+     send (order task, ack, ds) 
+ 
+. 
+  send spool list :
+     list spool;
+     send (order task, ack, ds);
+ 
+.
+  send next entry line :
+    control msg := ds;
+    get next entry line (control msg. entry line, control msg. index);
+    send (order task, ack, ds);
+ 
+. 
+  kill entry :
+    control msg := ds;
+    list index  := control msg. index;
+    IF is valid que entry (list index)
+       THEN erase entry (list index)
+    FI;
+    send (order task, ack, ds);
+ 
+.
+  make to first :
+    control msg := ds;
+    list index  := control msg. index;
+    IF is valid que entry (list index)
+       THEN new first (list entry);
+            erase entry (list index); 
+    FI;
+    send (order task, ack, ds);
+ 
+.
+  start server :
+    IF exists (server) THEN errorstop ("Spool muß zuerst gestoppt werden") FI;
+    start (PROC server start);
+    IF server channel <= 0 OR server channel >= 33
+       THEN manager message ("WARNUNG : Serverkanal nicht eingestellt");
+       ELSE send ack
+    FI;
+ 
+. 
+  stop server:
+    IF phase = 1
+       THEN stop;
+            IF valid fetch entry
+               THEN valid fetch entry := FALSE;
+                    manager question (""13""10"" +
+                          fetch entry. entry line + "   neu eintragen");
+               ELSE erase fetch entry;
+                    send ack;
+            FI;
+       ELSE IF fetch entry. entry line <> "" THEN new first (fetch entry) FI;
+            erase fetch entry; 
+            send ack;
+    FI;
+ 
+. 
+  halt server :
+    stop command pending := TRUE; 
+    IF NOT exists (server) OR server is waiting
+       THEN stop;
+            erase fetch entry;
+    FI;
+    send ack;
+
+.
+  wait for halt :
+    IF exists (calling parent)
+       THEN errorstop ("Task """ + name (calling parent) + """ wartet schon auf halt")
+       ELSE calling parent := order task;
+            stop command pending := TRUE;
+            forget (ds);
+            IF NOT exists (server) OR server is waiting
+            THEN stop;
+                 erase fetch entry;
+            FI;
+    FI;
+ 
+END PROC spool;
+ 
+
+PROC  send first entry :
+ 
+  forget (ds); ds := first entry. space;
+  send (server, ack, ds, reply) ;
+  IF reply = ack
+     THEN server is waiting := FALSE;
+          start time  := time of day;
+          start time CAT " am ";
+          start time CAT date;
+          erase fetch entry;
+          fetch entry := first entry;
+          erase entry (first);
+          valid fetch entry := TRUE;
+     ELSE forget (ds);
+  FI;
+ 
+END PROC  send first entry;
+
+ 
+PROC into que :
+ 
+  IF que is full
+     THEN errorstop ("Spool ist voll")
+     ELSE make new entry;
+          send ack;
+          awake server if necessary
+  FI;
+ 
+  . make new entry :
+      IF order = save code
+         THEN last entry. ds params  := save params;
+              save params := empty params;
+         ELSE last entry. ds params  := file save params;
+              file save params := empty params;
+      FI;
+      last entry. space :=  ds;
+      counter INCR 1;
+      build entry line;
+      last := next (last) ;
+ 
+      . build entry line :
+          IF LENGTH last entry. ds params. sender name > 16
+             THEN buffer := subtext (last entry. ds params. sender name, 1, 13); 
+                  buffer CAT "...""";
+             ELSE buffer := last entry. ds params. sender name;
+                  buffer CAT """";
+                  buffer := text (buffer, 17);
+          FI;
+          last entry. entry line :=  text (last entry. ds params. station, 2);
+          last entry. entry line CAT "/""";
+          last entry. entry line CAT buffer;
+          last entry. entry line CAT " : """ ;
+          last entry. entry line CAT last entry. ds params. name;
+          last entry. entry line CAT """  (" ;
+          last entry. entry line CAT text (storage (last entry. space));
+          last entry. entry line CAT " K)";
+ 
+  . awake server if necessary :
+      IF server is waiting THEN send first entry FI;
+ 
+END PROC into que;
+
+ 
+PROC list spool :
+ 
+  forget (ds); ds := nilspace;
+  file := sequential file (output, ds) ;
+  max line length (file, 1000);
+  headline(file, text (station(myself)) + "/""" + name (myself) + """");
+  put spool duty;
+  put current job;
+  put spool que;
+ 
+  . put spool duty :
+      IF spool duty <> ""
+         THEN write (file, "Aufgabe: ");
+              write (file, spool duty );
+              line (file, 2);
+      FI;
+ 
+  . put current job :
+      IF valid fetch entry AND exists (server)
+         THEN write (file, "In Bearbeitung seit ");
+              write (file, start time);
+              write (file, ":");
+              line (file, 2);
+              putline (file, fetch entry. entry line);
+              IF stop command pending
+                 THEN putline (file, "Spool wird nach diesem Auftrag deaktiviert");
+              FI;
+              line (file);
+         ELSE write (file, "kein Auftrag in Bearbeitung");
+              IF   NOT exists (server)
+                   THEN write (file, ", da Spool deaktiviert");
+              ELIF que is empty
+                   THEN write (file, ", da Warteschlange leer");
+                        LEAVE list spool;
+              FI;
+              line (file, 2);
+      FI;
+ 
+  . put spool que :
+      IF que is empty
+         THEN putline (file, "Warteschlange ist leer");
+         ELSE write (file, "Warteschlange (");
+              write (file, text (counter));
+              write (file, " Auftraege):");
+              line (file, 2);
+              to first que entry ;
+              WHILE next que entry found
+              REP putline (file, list entry. entry line) PER;
+      FI;
+ 
+END PROC list spool ;
+ 
+ 
+PROC clear spool :
+ 
+  first                := 1; 
+  last                 := 1;
+  counter              := 0;
+  FOR list index FROM 1 UPTO que size 
+  REP list entry. ds params  := empty params;
+      list entry. entry line := "";
+      forget (list entry. space)
+  PER;
+ 
+END PROC clear spool;
+ 
+(*********************************************************************) 
+(*  Hilfsprozeduren zum Spoolmanager                                 *)
+ 
+BOOL PROC is valid que entry (INT CONST index) :
+ 
+  que (index). entry line <> ""
+ 
+END PROC is valid que entry;
+ 
+ 
+INT PROC next (INT CONST index) :
+ 
+  IF index < que size
+     THEN index + 1
+     ELSE 1
+  FI
+ 
+END PROC next;
+ 
+ 
+PROC to first que entry :
+ 
+  list index := first - 1;
+ 
+ENDPROC to first que entry ;
+ 
+ 
+BOOL PROC next que entry found :
+ 
+  list index := next (list index);
+  WHILE is not last que entry
+  REP IF is valid que entry (list index) 
+         THEN LEAVE next que entry found WITH TRUE FI;
+      list index := next (list index);
+  PER;
+  FALSE
+ 
+  . is not last que entry :
+      list index <> last 
+ 
+ENDPROC next que entry found ;
+ 
+ 
+PROC get next entry line (TEXT VAR entry line, INT VAR index) :
+ 
+  IF index = 0
+     THEN list index := first - 1
+     ELSE list index := index
+  FI;
+  IF next que entry found
+     THEN entry line := list entry. entry line;
+          index      := list index;
+     ELSE entry line := "";
+          index      := 0;
+  FI;
+ 
+END PROC get next entry line;
+ 
+ 
+PROC new first (ENTRY VAR new first entry) :
+ 
+  IF que is full
+     THEN errorstop ("Spool ist voll")
+     ELSE first DECR 1 ;
+          IF first = 0 THEN first := que size FI;
+          first entry := new first entry;
+          counter INCR 1;
+  FI;
+ 
+END PROC new first;
+ 
+ 
+PROC erase entry (INT CONST index) :
+ 
+  entry. ds params  := empty params;
+  entry. entry line := "";
+  forget (entry.space) ;
+  counter DECR 1;
+  IF index = first
+     THEN inc first
+  FI ;
+
+  . entry : que (index) 
+ 
+  . inc first :
+      REP first := next (first)
+        UNTIL que is empty OR is valid que entry (first) PER
+ 
+END PROC erase entry;
+ 
+ 
+PROC erase fetch entry :
+ 
+  fetch entry. ds params  := empty params;
+  fetch entry. entry line := "";
+  forget (fetch entry. space);
+  valid fetch entry := FALSE;
+ 
+END PROC erase fetch entry;
+ 
+ 
+BOOL PROC is entry from order task (TEXT CONST file name) :
+ 
+  correct order task CAND correct filename
+ 
+  . correct order task :
+      order task name = list entry. ds params. sendername
+          AND order task station = list entry. ds params. station
+ 
+  . correct file name :
+      file name = "" OR file name = list entry. ds params. name
+ 
+END PROC is entry from order task; 
+ 
+ 
+PROC start (PROC server start):
+ 
+  begin (PROC server start, server);
+ 
+END PROC start;
+
+ 
+PROC stop :
+ 
+  stop server;
+  send calling parent reply if necessary;
+ 
+  . stop server:
+      IF exists (server) THEN end (server) FI;
+      server               := niltask;
+      server is waiting    := FALSE;
+      stop command pending := FALSE; 
+ 
+  . send calling parent reply if necessary :
+      IF exists (calling parent)
+         THEN forget (ds); ds := nilspace;
+              send (calling parent, ack, ds);
+              calling parent  := niltask;
+      FI;
+ 
+END PROC stop;
+ 
+ 
+PROC next headline information (TEXT VAR t):
+ 
+  begin pos := pos (headline (file), begin char, end pos + 1);
+  IF begin pos = 0
+     THEN begin pos := LENGTH headline (file) + 1;
+          t := "";
+     ELSE end pos := pos (headline (file), end char, begin pos + 1);
+          IF end pos = 0
+             THEN end pos := LENGTH headline (file) + 1; 
+                  t := "";
+             ELSE t := subtext (headline (file), begin pos+1, end pos-1)
+          FI
+  FI
+ 
+END PROC next headline information;
+ 
+ 
+PROC send ack :
+ 
+    forget (ds); ds := nilspace;
+    send (order task, ack, ds)
+ 
+END PROC send ack;
+ 
+ 
+PROC manager question (TEXT CONST question) :
+ 
+  forget (ds); ds := nilspace; error msg := ds ;
+  error msg := question ;
+  send (order task, question ack, ds)
+ 
+ENDPROC manager question ;
+ 
+
+PROC manager message (TEXT CONST message) :
+ 
+  forget (ds); ds := nilspace; error msg := ds ;
+  error msg := message ;
+  send (order task, message ack, ds)
+ 
+ENDPROC manager message ;
+ 
+(*********************************************************************) 
+(*  Spool - Kommandos                                                *)
+ 
+INT VAR command index , params ;
+TEXT VAR command line, param 1, param 2 ;
+ 
+LET spool command list =
+"break:1.0start:2.01stop:4.0halt:5.0first:6.0killer:7.0listspool:8.0
+clearspool:9.0spoolcontrolby:10.1";
+ 
+PROC spool command (PROC server start) :
+
+  enable stop ;
+  continue (order - continue code) ;
+  disable stop ;
+  REP command dialogue (TRUE) ;
+      get command ("gib Spool-Kommando:", command line);
+      analyze command (spool command list, command line, 3, command index,
+                       params, param1, param2);
+      execute command (PROC server start);
+  UNTIL NOT online PER;
+  command dialogue (FALSE);
+  break (quiet);
+  set autonom;
+ 
+END PROC spool command;
+ 
+ 
+PROC execute command (PROC server start) :
+ 
+ enable stop;
+ SELECT command index OF 
+   CASE 1  :  break
+   CASE 2  :  start server 
+   CASE 3  :  start server with new channel
+   CASE 4  :  stop server
+   CASE 5  :  halt server
+   CASE 6  :  first cmd
+   CASE 7  :  killer cmd
+   CASE 8  :  show spool list
+   CASE 9  :  clear spool
+   CASE 10 :  spool control task (task (param1))
+   OTHERWISE  do (command line)
+ END SELECT;
+ 
+  . start server :
+     IF server channel <= 0 OR server channel >= 33
+        THEN line;
+             putline ("WARNUNG : Serverkanal nicht eingestellt");
+     FI;
+     stop server;
+     start (PROC server start);
+ 
+  . start server with new channel:
+      INT VAR i := int (param1);
+      IF last conversion ok 
+         THEN server channel (i);
+              start server;
+         ELSE errorstop ("falsche Kanalangabe")
+      FI;
+ 
+  . stop server :
+      disable stop;
+      stop;
+      IF valid fetch entry CAND
+             yes (""13""10"" + fetch entry. entry line + "   neu eintragen")
+         THEN new first (fetch entry) FI;
+      erase fetch entry;
+      enable stop;
+ 
+  . halt server :
+      stop command pending := TRUE; 
+      IF NOT exists (server) OR server is waiting
+         THEN stop server;
+              erase fetch entry;
+      FI;
+ 
+  . first cmd :
+      line ;
+      to first que entry ;
+      WHILE next que entry found
+      REP say (list entry. entry line) ;
+          IF yes ("   als erstes")
+             THEN new first (list entry);
+                  erase entry (list index);
+                  LEAVE first cmd
+          FI ;
+      PER;
+ 
+  . killer cmd :
+      line ;
+      to first que entry ;
+      WHILE next que entry found
+      REP say (list entry. entry line) ;
+          IF yes ("   loeschen") THEN erase entry (list index) FI ;
+      PER;
+ 
+  . show spool list :
+      list spool;
+      disable stop;
+      show (file);
+      forget (ds);
+ 
+ENDPROC execute command ;
+ 
+ENDPACKET spool manager; 
+
diff --git a/system/spooler/1.8.7-net/source-disk b/system/spooler/1.8.7-net/source-disk
new file mode 100644
index 0000000..5a39f6c
--- /dev/null
+++ b/system/spooler/1.8.7-net/source-disk
@@ -0,0 +1 @@
+grundpaket/11_austausch.img
diff --git a/system/port server b/system/spooler/1.8.7-net/src/port server
index 46c647f..46c647f 100644
--- a/system/port server
+++ b/system/spooler/1.8.7-net/src/port server
diff --git a/system/printer server b/system/spooler/1.8.7-net/src/printer server
index b1a30bc..b1a30bc 100644
--- a/system/printer server
+++ b/system/spooler/1.8.7-net/src/printer server
diff --git a/system/spooler/1.8.7-net/src/spool cmd b/system/spooler/1.8.7-net/src/spool cmd
new file mode 100644
index 0000000..b44e799
--- /dev/null
+++ b/system/spooler/1.8.7-net/src/spool cmd
@@ -0,0 +1,112 @@
+PACKET spool cmd                                    (* Autor: R. Ruland  *)
+                                                    (* Stand: 01.04.86   *)
+       DEFINES killer,
+               first,
+               start,
+               stop,
+               halt,
+               wait for halt :
+ 
+LET error nak          = 2 ,
+
+    entry line code    = 23 ,
+    killer code        = 24 , 
+    first code         = 25 ,
+    start code         = 26 , 
+    stop code          = 27 ,
+    halt code          = 28 ,
+    wait for halt code = 29 ;
+ 
+DATASPACE VAR ds;
+
+BOUND STRUCT (TEXT entry line, INT index) VAR control msg;
+BOUND TEXT VAR error msg ;
+ 
+INT VAR reply;
+ 
+INITFLAG VAR in this task := FALSE;
+ 
+ 
+PROC control spool (TASK CONST spool, INT CONST control code,
+                    TEXT CONST question, BOOL CONST leave) :
+ 
+  enable stop;
+  initialize control msg;
+  WHILE valid spool entry
+    REP IF control question THEN control spool entry FI PER;
+ 
+  . initialize control msg :
+      IF NOT initialized (in this task) THEN ds := nilspace FI;
+      forget (ds); ds := nilspace; control msg := ds;
+      control msg. entry line := "";
+      control msg. index      := 0;
+      say (""13""10"");
+ 
+  . valid spool entry :
+      call (spool, entry line code, ds, reply);
+      IF reply = error nak
+         THEN error msg := ds;
+              errorstop (error msg);
+      FI;
+      control msg. index <> 0
+ 
+   . control question :
+       say (control msg. entry line);
+       yes (question) 
+ 
+  . control spool entry :
+      call (spool, control code, ds, reply);
+      IF reply = error nak
+         THEN error msg := ds;
+              errorstop (error msg);
+      FI;
+      IF leave THEN LEAVE control spool FI;
+ 
+END PROC control spool;
+ 
+ 
+PROC killer (TASK CONST spool) :
+ 
+  control spool (spool, killer code, "   loeschen", FALSE)
+ 
+END PROC killer;
+ 
+ 
+PROC first (TASK CONST spool) :
+ 
+  control spool (spool, first code, "   als erstes", TRUE)
+ 
+END PROC first;
+
+ 
+PROC start (TASK CONST spool) :
+ 
+  call (stop  code, "", spool);
+  call (start code, "", spool);
+ 
+END PROC start;
+ 
+ 
+PROC stop (TASK CONST spool) :
+ 
+  call (stop code, "", spool);
+ 
+END PROC stop;
+ 
+ 
+PROC halt (TASK CONST spool) :
+ 
+  call (halt code, "", spool);
+ 
+END PROC halt;
+ 
+ 
+PROC wait for halt (TASK CONST spool) :
+ 
+  call (wait for halt code, "", spool);
+ 
+END PROC wait for halt;
+ 
+ 
+END PACKET spool cmd;
+
diff --git a/system/spooler/1.8.7-net/src/spool manager b/system/spooler/1.8.7-net/src/spool manager
new file mode 100644
index 0000000..e711ab4
--- /dev/null
+++ b/system/spooler/1.8.7-net/src/spool manager
@@ -0,0 +1,915 @@
+PACKET spool manager DEFINES                        (* Autor: J. Liedtke *)
+                                                    (*        R. Nolting *) 
+                                                    (*        R. Ruland  *)
+                                                    (* Stand: 22.07.86   *)
+ 
+    spool manager ,
+ 
+    server channel ,
+    spool duty,
+    station only, 
+    spool control task :
+ 
+LET que size           = 101 ,
+
+    ack                = 0 ,
+    nak                = 1 ,
+    error nak          = 2 ,
+    message ack        = 3 , 
+    question ack       = 4 ,
+    second phase ack   = 5 ,
+    false code         = 6 ,
+
+    fetch code         = 11 ,
+    save code          = 12 ,
+    exists code        = 13 ,
+    erase code         = 14 ,
+    list code          = 15 ,
+    all code           = 17 ,
+    param fetch code   = 21 ,
+    file save code     = 22 ,
+    entry line code    = 23 ,
+    killer code        = 24 , 
+    first code         = 25 ,
+    start code         = 26 , 
+    stop code          = 27 ,
+    halt code          = 28 ,
+    wait for halt code = 29 ,
+ 
+    continue code      = 100 ,
+ 
+    file type          = 1003 ;
+
+LET begin char  =  ""0"",
+    end char    =  ""1"";
+
+LET PARAMS  =  STRUCT (TEXT name, userid, password, sendername, INT station),
+    ENTRY   =  STRUCT (PARAMS ds params, TEXT entry line, DATASPACE space);
+ 
+ROW que size ENTRY VAR que ;
+
+PARAMS CONST empty params := PARAMS : ("", "", "", "", -1);
+ 
+PARAMS VAR save params, file save params;
+ 
+ENTRY VAR fetch entry;
+ 
+FILE VAR file;
+ 
+INT VAR order, last order, phase, reply, old heap size, first, last, list index, 
+        begin pos, end pos, order task station, sp channel, counter;
+ 
+TEXT VAR order task name, buffer, sp duty, start time;
+ 
+BOOL VAR server is waiting, stop command pending, stat only, valid fetch entry;
+ 
+TASK VAR order task, last order task, server, calling parent, task in control; 
+ 
+INITFLAG VAR in this task := FALSE;
+ 
+DATASPACE VAR ds;
+
+BOUND STRUCT (TEXT name, userid, password) VAR msg;
+BOUND STRUCT (TEXT entry line, INT index) VAR control msg;
+BOUND PARAMS VAR fetch msg;
+BOUND THESAURUS VAR all msg;
+BOUND TEXT VAR error msg ;
+ 
+ 
+. first entry   :  que (first)
+. list  entry   :  que (list index)
+. last  entry   :  que (last)
+ 
+. que is empty  :  first = last 
+. que is full   :  first = next (last) 
+.; 
+ 
+sp channel      := 0;
+sp duty         := ""; 
+stat only       := FALSE;
+task in control := myself;
+ 
+PROC server channel (INT CONST channel nr) :
+     IF channel nr <= 0 OR channel nr >= 33
+        THEN errorstop ("falsche Kanalangabe") FI;
+     sp channel := channel nr;
+END PROC server channel;
+ 
+INT PROC server channel :
+     sp channel 
+END PROC server channel;
+ 
+ 
+PROC station only (BOOL CONST flag) :
+     stat only := flag
+END PROC station only;
+ 
+BOOL PROC station only : 
+     stat only 
+END PROC station only;
+ 
+ 
+PROC spool duty (TEXT CONST duty) :
+     sp duty := duty;
+END PROC spool duty;
+ 
+TEXT PROC spool duty :
+     sp duty
+END PROC spool duty;
+ 
+ 
+PROC spool control task (TASK CONST task id):
+     task in control := task id;
+END PROC spool control task;
+ 
+TASK PROC spool control task :
+     task in control
+END PROC spool control task;
+ 
+ 
+PROC spool manager (PROC server start) :
+ 
+  spool manager (PROC server start, TRUE) 
+ 
+END PROC spool manager;
+ 
+ 
+PROC spool manager (PROC server start, BOOL CONST with start) :
+
+  set autonom ;
+  break ;
+  disable stop ;
+  initialize spool manager ;
+  REP forget (ds) ;
+      wait (ds, order, order task) ;
+      IF   order <> second phase ack
+         THEN prepare first phase ;
+              spool (PROC server start); 
+      ELIF order task = last order task
+         THEN prepare second phase ;
+              spool (PROC server start); 
+         ELSE send nak
+      FI ;
+      send error if necessary ;
+      collect heap garbage if necessary
+  PER 
+ 
+  . initialize spool manager :
+      initialize if necessary;
+      stop;
+      erase fetch entry;
+      IF with start THEN start (PROC server start) FI;
+ 
+  . initialize if necessary :
+      IF NOT initialized (in this task)
+         THEN FOR list index FROM 1 UPTO que size 
+              REP list entry. space := nilspace PER;
+              fetch entry. space    := nilspace;
+              ds                    := nilspace;
+              last order task       := niltask;
+              server                := niltask; 
+              calling parent        := niltask;
+              server is waiting     := FALSE;
+              stop command pending  := FALSE;
+              old heap size         := 0;
+              clear spool;
+      FI;
+
+  . prepare first phase :
+      IF order = save code OR order = erase code OR order = stop code
+         THEN phase := 1 ;
+              last order := order ;
+              last order task := order task ;
+      FI;
+ 
+  . prepare second phase :
+      phase INCR 1 ;
+      order := last order 
+
+  . send nak :
+      forget (ds) ;
+      ds := nilspace ;
+      send (order task, nak, ds);
+ 
+  . send error if necessary :
+      IF is error
+         THEN forget (ds) ;
+              ds := nilspace ;
+              error msg := ds ;
+              CONCR (error msg) := error message;
+              clear error;
+              send (order task, error nak, ds) 
+     FI;
+ 
+  . collect heap garbage if necessary :
+      IF heap size > old heap size + 2
+         THEN collect heap garbage;
+              old heap size := heap size;
+      FI; 
+ 
+END PROC spool manager;
+ 
+ 
+PROC spool (PROC server start):
+ 
+  command dialogue (FALSE);
+  enable stop;
+  IF station only CAND station (ordertask) <> station (myself)
+     THEN errorstop ("kein Zugriffsrecht auf Task " + text (station(myself))
+                      + "/""" + name(myself) + """") 
+  FI;
+ 
+  SELECT order OF
+ 
+    CASE fetch code        :  out of que
+    CASE param fetch code  :  send fetch params
+    CASE save code         :  new que entry
+    CASE file save code    :  new file que entry 
+    CASE exists code       :  exists que entry
+    CASE erase code        :  erase que entry
+    CASE list code         :  send spool list
+    CASE all code          :  send owners ds names
+ 
+    OTHERWISE :
+ 
+       IF   order >= continue code AND order task = supervisor
+            THEN forget (ds);
+                 spool command (PROC server start)
+ 
+       ELIF spool control allowed by order task 
+            THEN SELECT order OF
+                   CASE entry line code    :  send next entry line 
+                   CASE killer code        :  kill entry 
+                   CASE first code         :  make to first
+                   CASE start code         :  start server 
+                   CASE stop code          :  stop server
+                   CASE halt code          :  halt server
+                   CASE wait for halt code :  wait for halt
+                   OTHERWISE : errorstop ("falscher Auftrag fuer Task """
+                                                      + name(myself) + """") 
+                 END SELECT
+ 
+            ELSE errorstop ("falscher Auftrag fuer Task """
+                                                      + name(myself) + """") 
+       FI;
+  END SELECT;
+ 
+ 
+. spool control allowed by order task :
+    (order task = spool control task OR order task < spool control task
+       OR spool control task = supervisor)
+         AND station (order task) = station (myself)
+. 
+  out of que :
+    IF   NOT (order task = server)
+         THEN errorstop ("keine Servertask")
+    ELIF stop command pending 
+         THEN forget (ds);
+              stop;
+              erase fetch entry;
+    ELIF que is empty
+         THEN forget (ds) ;
+              erase fetch entry;
+              server is waiting := TRUE;
+         ELSE send first entry;
+    FI;
+ 
+. 
+  send fetch params :
+    IF order task = server
+       THEN send params
+       ELSE errorstop ("keine Servertask")
+    FI;
+ 
+    . send params :
+        forget(ds); ds := nilspace; fetch msg := ds;
+        fetch msg := fetch entry. ds params;
+        send (order task, ack, ds);
+ 
+. 
+  new que entry :
+    IF phase = 1
+       THEN prepare into que
+       ELSE into que
+    FI;
+ 
+.
+  prepare into que :
+    msg := ds ;
+    save params. name       := msg.name;
+    save params. userid     := msg.userid;
+    save params. password   := msg.password;
+    save params. sendername := name (order task);
+    save params. station    := station (order task);
+    forget (ds); ds := nilspace;
+    send (order task, second phase ack, ds);
+ 
+. 
+  new file que entry :
+    IF type (ds) <> file type
+       THEN errorstop ("Datenraum hat falschen Typ");
+       ELSE get file params;
+            into que;
+    FI;
+ 
+    . get file params :
+        file := sequential file (input, ds);
+        end pos := 0;
+        next headline information (file save params. name); 
+        next headline information (file save params. userid); 
+        next headline information (file save params. password); 
+        next headline information (file save params. sendername); 
+        next headline information (buffer);
+        file save params. station := int (buffer);
+        IF NOT last conversion ok
+           THEN file save params. station    := station (order task) FI;
+        IF file save params. sendername = ""
+           THEN file save params. sendername := name    (order task) FI;
+        IF file save params. name = ""
+           THEN IF headline (file) <> ""
+                   THEN file save params. name := headline (file);
+                   ELSE errorstop ("Name unzulaessig")
+                FI;
+           ELSE headline (file, file save params. name);
+        FI;
+ 
+. 
+  exists que entry :
+    msg                := ds ;
+    order task name    := name (order task);
+    order task station := station (order task);
+    to first que entry; 
+    WHILE next que entry found 
+    REP IF is entry from order task (msg. name) 
+           THEN send ack;
+                LEAVE exists que entry
+        FI;
+    PER ;
+    forget (ds); ds := nilspace;
+    send (order task, false code, ds)
+ 
+. 
+  erase que entry :
+    msg                := ds ;
+    order task name    := name (order task);
+    order task station := station (order task);
+    IF phase = 1
+       THEN ask for erase
+       ELSE erase entry from order task 
+    FI;
+ 
+    . ask for erase :
+        to first que entry; 
+        WHILE next que entry found 
+        REP IF is entry from order task (msg. name) 
+               THEN manager question ("""" + msg.name + """ loeschen"); 
+                    LEAVE erase que entry
+            FI;
+        PER ;
+        manager message ("""" + msg.name + """ existiert nicht");
+ 
+    . erase entry from order task :
+        IF is entry from order task (msg. name) 
+           THEN delete que entry; 
+                LEAVE erase que entry 
+           ELSE to first que entry; 
+                WHILE next que entry found 
+                REP IF is entry from order task (msg. name) 
+                       THEN delete que entry;
+                            LEAVE erase que entry 
+                    FI ;
+                PER ;
+                manager message ("""" + msg.name +  """ existiert nicht");
+        FI;
+ 
+        . delete que entry :
+            erase entry (list index) ;
+            send ack;
+ 
+.
+  send owners ds names:
+     order task name    := name (order task);
+     order task station := station (order task);
+     forget (ds); ds := nilspace; all msg := ds; 
+     all msg := empty thesaurus; 
+     to first que entry; 
+     WHILE next que entry found 
+     REP IF is entry from order task ("")
+            THEN insert (all msg, list entry. ds params. name) 
+         FI; 
+     PER;
+     send (order task, ack, ds) 
+ 
+. 
+  send spool list :
+     list spool;
+     send (order task, ack, ds);
+ 
+.
+  send next entry line :
+    control msg := ds;
+    get next entry line (control msg. entry line, control msg. index);
+    send (order task, ack, ds);
+ 
+. 
+  kill entry :
+    control msg := ds;
+    list index  := control msg. index;
+    IF is valid que entry (list index)
+       THEN erase entry (list index)
+    FI;
+    send (order task, ack, ds);
+ 
+.
+  make to first :
+    control msg := ds;
+    list index  := control msg. index;
+    IF is valid que entry (list index)
+       THEN new first (list entry);
+            erase entry (list index); 
+    FI;
+    send (order task, ack, ds);
+ 
+.
+  start server :
+    IF exists (server) THEN errorstop ("Spool muß zuerst gestoppt werden") FI;
+    start (PROC server start);
+    IF server channel <= 0 OR server channel >= 33
+       THEN manager message ("WARNUNG : Serverkanal nicht eingestellt");
+       ELSE send ack
+    FI;
+ 
+. 
+  stop server:
+    IF phase = 1
+       THEN stop;
+            IF valid fetch entry
+               THEN valid fetch entry := FALSE;
+                    manager question (""13""10"" +
+                          fetch entry. entry line + "   neu eintragen");
+               ELSE erase fetch entry;
+                    send ack;
+            FI;
+       ELSE IF fetch entry. entry line <> "" THEN new first (fetch entry) FI;
+            erase fetch entry; 
+            send ack;
+    FI;
+ 
+. 
+  halt server :
+    stop command pending := TRUE; 
+    IF NOT exists (server) OR server is waiting
+       THEN stop;
+            erase fetch entry;
+    FI;
+    send ack;
+
+.
+  wait for halt :
+    IF exists (calling parent)
+       THEN errorstop ("Task """ + name (calling parent) + """ wartet schon auf halt")
+       ELSE calling parent := order task;
+            stop command pending := TRUE;
+            forget (ds);
+            IF NOT exists (server) OR server is waiting
+            THEN stop;
+                 erase fetch entry;
+            FI;
+    FI;
+ 
+END PROC spool;
+ 
+
+PROC  send first entry :
+ 
+  forget (ds); ds := first entry. space;
+  send (server, ack, ds, reply) ;
+  IF reply = ack
+     THEN server is waiting := FALSE;
+          start time  := time of day;
+          start time CAT " am ";
+          start time CAT date;
+          erase fetch entry;
+          fetch entry := first entry;
+          erase entry (first);
+          valid fetch entry := TRUE;
+     ELSE forget (ds);
+  FI;
+ 
+END PROC  send first entry;
+
+ 
+PROC into que :
+ 
+  IF que is full
+     THEN errorstop ("Spool ist voll")
+     ELSE make new entry;
+          send ack;
+          awake server if necessary
+  FI;
+ 
+  . make new entry :
+      IF order = save code
+         THEN last entry. ds params  := save params;
+              save params := empty params;
+         ELSE last entry. ds params  := file save params;
+              file save params := empty params;
+      FI;
+      last entry. space :=  ds;
+      counter INCR 1;
+      build entry line;
+      last := next (last) ;
+ 
+      . build entry line :
+          IF LENGTH last entry. ds params. sender name > 16
+             THEN buffer := subtext (last entry. ds params. sender name, 1, 13);
+                  buffer CAT "...""";
+             ELSE buffer := last entry. ds params. sender name;
+                  buffer CAT """";
+                  buffer := text (buffer, 17);
+          FI;
+          last entry. entry line := entry station text;
+          last entry. entry line CAT "/""";
+          last entry. entry line CAT buffer;
+          last entry. entry line CAT " : """ ;
+          last entry. entry line CAT last entry. ds params. name;
+          last entry. entry line CAT """  (" ;
+          last entry. entry line CAT text (storage (last entry. space));
+          last entry. entry line CAT " K)";
+
+          . entry station text :
+              IF last entry. ds params. station = 0
+                 THEN "   "
+                 ELSE text (last entry. ds params. station, 3)
+              FI
+ 
+  . awake server if necessary :
+      IF server is waiting THEN send first entry FI;
+ 
+END PROC into que;
+
+ 
+PROC list spool :
+ 
+  forget (ds); ds := nilspace;
+  file := sequential file (output, ds) ;
+  max line length (file, 1000);
+  headline(file, station text + "/""" + name (myself) + """");
+  put spool duty;
+  put current job;
+  put spool que;
+ 
+  . station text :
+      IF station(myself) = 0
+         THEN ""
+         ELSE text (station(myself))
+      FI
+
+  . put spool duty :
+      IF spool duty <> ""
+         THEN write (file, "Aufgabe: ");
+              write (file, spool duty );
+              line (file, 2);
+      FI;
+ 
+  . put current job :
+      IF valid fetch entry AND exists (server)
+         THEN write (file, "In Bearbeitung seit ");
+              write (file, start time);
+              write (file, ":");
+              line (file, 2);
+              putline (file, fetch entry. entry line);
+              IF stop command pending
+                 THEN putline (file, "Spool wird nach diesem Auftrag deaktiviert");
+              FI;
+              line (file);
+         ELSE write (file, "kein Auftrag in Bearbeitung");
+              IF   NOT exists (server)
+                   THEN write (file, ", da Spool deaktiviert");
+              ELIF que is empty
+                   THEN write (file, ", da Warteschlange leer");
+                        LEAVE list spool;
+              FI;
+              line (file, 2);
+      FI;
+ 
+  . put spool que :
+      IF que is empty
+         THEN putline (file, "Warteschlange ist leer");
+         ELSE write (file, "Warteschlange (");
+              write (file, text (counter));
+              write (file, " Auftraege):");
+              line (file, 2);
+              to first que entry ;
+              WHILE next que entry found
+              REP putline (file, list entry. entry line) PER;
+      FI;
+ 
+END PROC list spool ;
+ 
+ 
+PROC clear spool :
+ 
+  first                := 1; 
+  last                 := 1;
+  counter              := 0;
+  FOR list index FROM 1 UPTO que size 
+  REP list entry. ds params  := empty params;
+      list entry. entry line := "";
+      forget (list entry. space)
+  PER;
+ 
+END PROC clear spool;
+ 
+(*********************************************************************) 
+(*  Hilfsprozeduren zum Spoolmanager                                 *)
+ 
+BOOL PROC is valid que entry (INT CONST index) :
+ 
+  que (index). entry line <> ""
+ 
+END PROC is valid que entry;
+ 
+ 
+INT PROC next (INT CONST index) :
+ 
+  IF index < que size
+     THEN index + 1
+     ELSE 1
+  FI
+ 
+END PROC next;
+ 
+ 
+PROC to first que entry :
+ 
+  list index := first - 1;
+ 
+ENDPROC to first que entry ;
+ 
+ 
+BOOL PROC next que entry found :
+ 
+  list index := next (list index);
+  WHILE is not last que entry
+  REP IF is valid que entry (list index) 
+         THEN LEAVE next que entry found WITH TRUE FI;
+      list index := next (list index);
+  PER;
+  FALSE
+ 
+  . is not last que entry :
+      list index <> last 
+ 
+ENDPROC next que entry found ;
+ 
+ 
+PROC get next entry line (TEXT VAR entry line, INT VAR index) :
+ 
+  IF index = 0
+     THEN list index := first - 1
+     ELSE list index := index
+  FI;
+  IF next que entry found
+     THEN entry line := list entry. entry line;
+          index      := list index;
+     ELSE entry line := "";
+          index      := 0;
+  FI;
+ 
+END PROC get next entry line;
+ 
+ 
+PROC new first (ENTRY VAR new first entry) :
+ 
+  IF que is full
+     THEN errorstop ("Spool ist voll")
+     ELSE first DECR 1 ;
+          IF first = 0 THEN first := que size FI;
+          first entry := new first entry;
+          counter INCR 1;
+  FI;
+ 
+END PROC new first;
+ 
+ 
+PROC erase entry (INT CONST index) :
+ 
+  entry. ds params  := empty params;
+  entry. entry line := "";
+  forget (entry.space) ;
+  counter DECR 1;
+  IF index = first
+     THEN inc first
+  FI ;
+
+  . entry : que (index) 
+ 
+  . inc first :
+      REP first := next (first)
+        UNTIL que is empty OR is valid que entry (first) PER
+ 
+END PROC erase entry;
+ 
+ 
+PROC erase fetch entry :
+ 
+  fetch entry. ds params  := empty params;
+  fetch entry. entry line := "";
+  forget (fetch entry. space);
+  valid fetch entry := FALSE;
+ 
+END PROC erase fetch entry;
+ 
+ 
+BOOL PROC is entry from order task (TEXT CONST file name) :
+ 
+  correct order task CAND correct filename
+ 
+  . correct order task :
+      order task name = list entry. ds params. sendername
+          AND order task station = list entry. ds params. station
+ 
+  . correct file name :
+      file name = "" OR file name = list entry. ds params. name
+ 
+END PROC is entry from order task; 
+ 
+ 
+PROC start (PROC server start):
+ 
+  begin (PROC server start, server);
+ 
+END PROC start;
+
+ 
+PROC stop :
+ 
+  stop server;
+  send calling parent reply if necessary;
+ 
+  . stop server:
+      IF exists (server) THEN end (server) FI;
+      server               := niltask;
+      server is waiting    := FALSE;
+      stop command pending := FALSE; 
+ 
+  . send calling parent reply if necessary :
+      IF exists (calling parent)
+         THEN forget (ds); ds := nilspace;
+              send (calling parent, ack, ds);
+              calling parent  := niltask;
+      FI;
+ 
+END PROC stop;
+ 
+ 
+PROC next headline information (TEXT VAR t):
+ 
+  begin pos := pos (headline (file), begin char, end pos + 1);
+  IF begin pos = 0
+     THEN begin pos := LENGTH headline (file) + 1;
+          t := "";
+     ELSE end pos := pos (headline (file), end char, begin pos + 1);
+          IF end pos = 0
+             THEN end pos := LENGTH headline (file) + 1; 
+                  t := "";
+             ELSE t := subtext (headline (file), begin pos+1, end pos-1)
+          FI
+  FI
+ 
+END PROC next headline information;
+ 
+ 
+PROC send ack :
+ 
+    forget (ds); ds := nilspace;
+    send (order task, ack, ds)
+ 
+END PROC send ack;
+ 
+ 
+PROC manager question (TEXT CONST question) :
+ 
+  forget (ds); ds := nilspace; error msg := ds ;
+  error msg := question ;
+  send (order task, question ack, ds)
+ 
+ENDPROC manager question ;
+ 
+
+PROC manager message (TEXT CONST message) :
+ 
+  forget (ds); ds := nilspace; error msg := ds ;
+  error msg := message ;
+  send (order task, message ack, ds)
+ 
+ENDPROC manager message ;
+ 
+(*********************************************************************) 
+(*  Spool - Kommandos                                                *)
+ 
+INT VAR command index , params ;
+TEXT VAR command line, param 1, param 2 ;
+ 
+LET spool command list =
+"break:1.0start:2.01stop:4.0halt:5.0first:6.0killer:7.0listspool:8.0
+clearspool:9.0spoolcontrolby:10.1";
+ 
+PROC spool command (PROC server start) :
+
+  enable stop ;
+  continue (order - continue code) ;
+  disable stop ;
+  REP command dialogue (TRUE) ;
+      get command ("gib Spool-Kommando:", command line);
+      analyze command (spool command list, command line, 3, command index,
+                       params, param1, param2);
+      execute command (PROC server start);
+  UNTIL NOT online PER;
+  command dialogue (FALSE);
+  break (quiet);
+  set autonom;
+ 
+END PROC spool command;
+ 
+ 
+PROC execute command (PROC server start) :
+ 
+ enable stop;
+ SELECT command index OF 
+   CASE 1  :  break
+   CASE 2  :  start server 
+   CASE 3  :  start server with new channel
+   CASE 4  :  stop server
+   CASE 5  :  halt server
+   CASE 6  :  first cmd
+   CASE 7  :  killer cmd
+   CASE 8  :  show spool list
+   CASE 9  :  clear spool
+   CASE 10 :  spool control task (task (param1))
+   OTHERWISE  do (command line)
+ END SELECT;
+ 
+  . start server :
+     IF server channel <= 0 OR server channel >= 33
+        THEN line;
+             putline ("WARNUNG : Serverkanal nicht eingestellt");
+     FI;
+     stop server;
+     start (PROC server start);
+ 
+  . start server with new channel:
+      INT VAR i := int (param1);
+      IF last conversion ok 
+         THEN server channel (i);
+              start server;
+         ELSE errorstop ("falsche Kanalangabe")
+      FI;
+ 
+  . stop server :
+      disable stop;
+      stop;
+      IF valid fetch entry CAND
+             yes (""13""10"" + fetch entry. entry line + "   neu eintragen")
+         THEN new first (fetch entry) FI;
+      erase fetch entry;
+      enable stop;
+ 
+  . halt server :
+      stop command pending := TRUE; 
+      IF NOT exists (server) OR server is waiting
+         THEN stop server;
+              erase fetch entry;
+      FI;
+ 
+  . first cmd :
+      line ;
+      to first que entry ;
+      WHILE next que entry found
+      REP say (list entry. entry line) ;
+          IF yes ("   als erstes")
+             THEN new first (list entry);
+                  erase entry (list index);
+                  LEAVE first cmd
+          FI ;
+      PER;
+ 
+  . killer cmd :
+      line ;
+      to first que entry ;
+      WHILE next que entry found
+      REP say (list entry. entry line) ;
+          IF yes ("   loeschen") THEN erase entry (list index) FI ;
+      PER;
+ 
+  . show spool list :
+      list spool;
+      disable stop;
+      show (file);
+      forget (ds);
+ 
+ENDPROC execute command ;
+ 
+ENDPACKET spool manager; 
+
diff --git a/system/spooler/1.8.7-std.zusatz/source-disk b/system/spooler/1.8.7-std.zusatz/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/system/spooler/1.8.7-std.zusatz/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/system/spooler/1.8.7-std.zusatz/src/port server b/system/spooler/1.8.7-std.zusatz/src/port server
new file mode 100644
index 0000000..46c647f
--- /dev/null
+++ b/system/spooler/1.8.7-std.zusatz/src/port server
@@ -0,0 +1,164 @@
+PACKET port server:                                   (* Autor : R. Ruland *)
+                                                      (* Stand : 21.03.86  *)
+ 
+INT  VAR port station;
+TEXT VAR port := "PRINTER";
+ 
+put ("gib Name des Zielspools : "); editget (port); line;
+put ("gib Stationsnummer des Zielspools : "); get (port station);
+ 
+server channel (15);
+spool duty ("Verwalter fuer Task """ + port +
+                                    """ auf Station " + text (port station));
+ 
+LET max counter      = 10 ,
+    time slice       = 300 ,
+ 
+    ack              = 0 ,
+    fetch code       = 11 ,
+    param fetch code = 21 ,
+    file save code   = 22 , 
+    file type        = 1003 ,
+
+    begin char       = ""0"",
+    end char         = ""1"";
+ 
+
+INT VAR reply, old heap size;
+TEXT VAR file name, write pass, read pass, sendername, buffer;
+FILE VAR file;
+
+DATASPACE VAR ds, file ds, send ds;
+ 
+BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg;
+BOUND TEXT VAR error msg ;
+ 
+spool manager (PROC save file);
+ 
+PROC save file :
+
+  disable stop ;
+  command dialogue (FALSE);
+  ds := nilspace; file ds := nilspace; send ds := nil space;
+  old heap size := heap size;
+ 
+  REP 
+    execute save file;
+ 
+    IF is error THEN save error (error message) FI;
+ 
+    IF heap size > old heap size + 4
+      THEN collect heap garbage ;
+           old heap size := heap size
+    FI;
+ 
+  PER 
+ 
+ENDPROC save file;
+
+ 
+PROC execute save file :
+
+enable stop;
+forget (file ds) ; file ds := nilspace;
+call (father, fetch code, file ds, reply);
+IF reply <> ack
+   THEN error msg := ds; errorstop (error msg);
+   ELSE save file ds
+FI;
+ 
+. save file ds :
+    IF type (file ds) = file type 
+       THEN get file params;
+            insert file params;
+            call station (port station, port, file save code, file ds);
+       ELSE errorstop ("Datenraum hat falschen Typ")
+    FI; 
+ 
+. get file params :
+    forget (ds); ds := nilspace;
+    call (father, param fetch code, ds, reply);
+    IF reply <> ack
+       THEN error msg := ds; errorstop (error msg);
+       ELSE msg := ds;
+            file name  := msg. file name;
+            write pass := msg. write pass;
+            read pass  := msg. read pass;
+            sendername := msg. sender name;
+    FI;
+ 
+. insert file params :
+    buffer := "";
+    in headline (filename);
+    in headline (write pass);
+    in headline (read pass);
+    in headline (sendername);
+    file := sequential file (input, file ds) ;
+    headline (file, buffer);
+ 
+END PROC execute save file;
+ 
+ 
+PROC call station (INT CONST order task station, TEXT CONST order task name,
+                   INT CONST order code, DATASPACE VAR order ds) :
+ 
+     INT VAR counter := 0;
+     TASK VAR order task;
+     disable stop;
+     REP order task := order task station // order task name;
+         IF is error CAND pos (error message, "antwortet nicht") > 0
+            THEN clear error;
+                 counter := min (max counter, counter + 1);
+                 pause (counter * time slice);
+            ELSE enable stop;
+                 forget (send ds); send ds := order ds;
+                 call (order task, order code, send ds, reply);
+                 disable stop;
+                 IF reply = ack 
+                    THEN forget (order ds); order ds := send ds;
+                         forget (send ds);
+                         LEAVE call station
+                    ELSE error msg := send ds;
+                         errorstop (error msg);
+                 FI;
+         FI;
+     PER;
+ 
+END PROC call station;
+ 
+ 
+TASK OP // (INT CONST station, TEXT CONST name) :
+ 
+    enable stop;
+    station / name
+ 
+END OP //;
+ 
+ 
+PROC in headline (TEXT CONST information) :
+    IF pos (information, begin char) <> 0 
+         OR pos (information, end char) <> 0 
+       THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI;
+    buffer CAT begin char;
+    buffer CAT information;
+    buffer CAT end char;
+END PROC in headline;
+ 
+ 
+PROC save error (TEXT CONST message) :
+     clear error;
+     file name CAT ".";
+     file name CAT sender name;
+     file name CAT ".ERROR";
+     file := sequential file (output, file name);
+     putline (file, " ");
+     putline (file, "Uebertragung nicht korrekt beendet ");
+     putline (file, " ");
+     put (file, "ERROR :"); put (file, message);
+     save (file name, public);
+     clear error;
+     forget(file name, quiet);
+END PROC save error;
+ 
+ENDPACKET port server;
+
diff --git a/system/spooler/1.8.7-std.zusatz/src/printer server b/system/spooler/1.8.7-std.zusatz/src/printer server
new file mode 100644
index 0000000..b1a30bc
--- /dev/null
+++ b/system/spooler/1.8.7-std.zusatz/src/printer server
@@ -0,0 +1,99 @@
+PACKET multi user printer :                      (* Autor : Rudolf Ruland  *)
+                                                 (* Stand : 24.03.86       *)
+ 
+INT VAR c;
+put ("gib Druckerkanal : "); get (c);
+
+  server channel (c);
+  station only (FALSE) ;
+  spool duty ("Ausgabe mit dem Drucker");
+  spool control task (myself);
+ 
+LET ack              = 0 ,
+ 
+    fetch code       = 11 ,
+    param fetch code = 21 ,
+    file type        = 1003 ;
+
+INT VAR reply, old heap size, sender station;
+TEXT VAR file name, userid, password, sendername;
+FILE VAR file ;
+
+DATASPACE VAR ds, file ds;
+ 
+BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg;
+BOUND TEXT VAR error msg ;
+ 
+spool manager (PROC printer);
+ 
+PROC printer :
+
+  disable stop ;
+  command dialogue (FALSE);
+  ds := nilspace; file ds := nilspace; 
+  continue (server channel) ;
+    check error ("Kanal belegt");
+ 
+  old heap size := heap size ;
+  REP
+    execute print ;
+ 
+    IF is error
+      THEN put error;
+           clear error;
+    FI ;
+ 
+    IF heap size > old heap size + 4
+      THEN collect heap garbage ;
+           old heap size := heap size
+    FI
+  PER 
+ 
+ENDPROC printer ;
+
+ 
+PROC execute print :
+
+  enable stop ;
+  forget (file ds) ; file ds := nilspace ;
+  call (father, fetch code, file ds, reply) ;
+  IF reply = ack CAND type (file ds) = file type
+     THEN get file params;
+          print file
+  FI ;
+ 
+. get file params :
+    forget (ds); ds := nilspace;
+    call (father, param fetch code, ds, reply);
+    IF reply <> ack
+       THEN error msg := ds; errorstop (error msg);
+       ELSE msg := ds;
+            file name      := msg. file name;
+            userid         := msg. userid;
+            password       := msg. password;
+            sendername     := msg. sender name;
+            sender station := msg. station;
+    FI;
+ 
+. print file :
+    file := sequential file (input, file ds);
+    print (file,
+           PROC (INT CONST, INT VAR, INT VAR) open,
+           PROC (INT CONST, INT CONST) close,
+           PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
+ 
+ENDPROC execute print ;
+ 
+ 
+PROC check error (TEXT CONST message) :
+    IF is error
+       THEN clear error;
+            rename myself (message);
+            IF is error THEN clear error; end (myself) FI;
+            pause (18000);
+            end (myself);
+    FI;
+END PROC check error;
+ 
+ENDPACKET multi user printer ;
+
diff --git a/system/spool cmd b/system/spooler/1.8.7-std.zusatz/src/spool cmd
index 9b43d36..9b43d36 100644
--- a/system/spool cmd
+++ b/system/spooler/1.8.7-std.zusatz/src/spool cmd
diff --git a/system/spool manager b/system/spooler/1.8.7-std.zusatz/src/spool manager
index 6b4fe55..6b4fe55 100644
--- a/system/spool manager
+++ b/system/spooler/1.8.7-std.zusatz/src/spool manager
diff --git a/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik
new file mode 100644
index 0000000..36fa31e
--- /dev/null
+++ b/system/std.graphik/1.8.7/doc/Altes Handbuch - Teil 10 - Graphik
@@ -0,0 +1,831 @@
+#type ("trium10")##limit (13.5)# 
+#block##start(2.5,2.5)##pagelength(21.0)##pagenr("%",418)##setcount(22)# 
+#headeven# 
+%                       EUMEL-Benutzerhandbuch 
+ 
+ 
+ 
+#end# 
+#headodd# 
+                              TEIL 10: Graphik                       % 
+ 
+ 
+ 
+#end# 
+#type("triumb14")# 
+#ib(9)##center#TEIL 10: Graphik#ie(9)# 
+#type("trium10")# 
+#free(2.0)# 
+#on("bold")##ib(9)##type("triumb14")#1. Übersicht#ie(9)# 
+#type("trium10")# 
+ 
+       #limit(12.0)##on("italics")#Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik-
+       Möglichkeiten des EUMEL-Systems. Die Graphik-Pakete ge­
+       hören nicht zum EUMEL-Standard, sondern sind Anwender­
+       pakete, die im Quellcode ausgeliefert und von jeder Installation
+       in das System aufgenommen werden können. Unter Umständen
+       müssen Programme erstellt werden, die die Anpassungen für
+       spezielle graphische Geräte einer Installation vornehmen. 
+#limit(13.5)##off("italics")# 
+ 
+Das Graphik-System ermöglicht es, durch ELAN-Programme geräteunab­
+hängige Informationen für Zeichnungen ("#ib#Graphiken#ie#") zu erstellen. Die Graphik
+erzeugenden Programme brauchen dabei keine gerätespezifischen Größen sowie
+gerätespezifischen Unterprogramme zu enthalten. Sie befassen sich somit
+ausschließlich mit der Erzeugung der problemorientierten Information für die
+Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer
+Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. erst
+auf einem Terminal zur Kontrolle und dann auf einem Plotter). 
+ 
+Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Dabei
+entspricht die Y-Achse bei der zweidimensionalen Graphik der Z-Achse (Höhe)
+bei der dreidimensionalen Graphik. Im dreidimensionalen Fall sind perspektivi­
+sche, orthografische und schiefwinklige Projektionen mit beliebigen Betrach­
+tungswinkeln möglich. 
+ 
+Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von
+Graphiken (Bildern) auf der einen und Darstellung der erzeugten Bilder auf der
+anderen Seite unterschieden. Für die Erzeugung und Manipulation der Graphi­
+ken existiert der Typ PICTURE, für die Darstellung der Bilder gibt es den Typ
+PICFILE. Dabei müssen Ausschnitt, Maßstab, Betrachtungswinkel und Pro­
+jektionsart erst bei der Darstellung festgelegt werden. Diese Konstruktion des
+Graphik-Systems hat folgende Vorteile: 
+ 
+a) Programme, die Graphik-Informationen erzeugen, sind geräteunabhängig.
+   Das bedeutet, daß Programmierer sich ausschließlich mit einem logischen
+   Problem zu befassen brauchen und nicht mit gerätespezifischen Besonder­
+   heiten. 
+ 
+b) Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals
+   dargestellt werden, ohne daß das erzeugende Programm geändert oder neu
+   gestartet werden muß. Z.B. kann ein Programmierer eine Graphik erst auf
+   dem Terminal auf Richtigkeit und Größenverhältnisse überprüfen, bevor er die
+   Zeichnung auf einem Plotter zeichnen läßt. 
+ 
+c) Graphiken können leicht geändert (z.B. vergrößert oder in eine Richtung
+   gestreckt) werden, ohne daß das erzeugende Programm erneut durchlaufen
+   werden muß. Zudem können Graphiken aneinander oder übereinander gelegt
+   werden. 
+ 
+d) Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht erzeugt
+   werden. 
+ 
+e) Der Anschluß von neuen Graphik-Geräten durch Benutzer ist leicht möglich,
+   ohne daß die Graphik erzeugenden Programme modifiziert werden müssen. 
+ 
+f) Plotter können wie Drucker an einen SPOOLER gehängt werden. 
+ 
+g) Bilder können als PICFILEs gespeichert und versandt werden. 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Erzeugung von Bildern#ie(9)# 
+#type("trium10")# 
+ 
+Bilder entstehen in Objekten vom Datentyp 
+ 
+#type("modern12")# 
+     PICTURE 
+#type("trium10")# 
+ 
+Diese müssen mit der Prozedur 
+ 
+#type("modern12")# 
+     nilpicture 
+#type("trium10")# 
+ 
+initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension noch
+nicht festgelegt ist. Die Dimension eines PICTUREs wird mit dem ersten
+Schreibzugriff ('move' oder 'draw') festgelegt. Ein PICTURE kann immer nur
+entweder zwei- oder dreidimensional sein. Außerdem kann einem PICTURE mit
+der Prozedur 
+ 
+#type("modern12")# 
+     pen 
+#type("trium10")# 
+ 
+genau ein virtueller Stift zugeordnet oder der aktuelle Stift erfragt werden. 
+ 
+Die Erzeugung eines Bildes basiert auf dem Modell eines Plotters. Der (virtuelle)
+Zeichenstift kann mit 
+ 
+#type("modern12")# 
+     move 
+#type("trium10")# 
+ 
+ohne zu zeichnen an beliebige Stellen gefahren werden (reine Positionierung).
+Mit 
+ 
+#type("modern12")# 
+     draw 
+#type("trium10")# 
+ 
+wird der Stift veranlaßt, eine Linie von der aktuellen zur angegebenen Zielposi­
+tion zu zeichnen. 'move' löst also Bewegungen mit gehobenem, 'draw' solche mit
+gesenktem Stift aus. Um auch 'relatives' Zeichnen zu ermöglichen, existiert die
+Prozedur 
+ 
+#type("modern12")# 
+     where 
+#type("trium10")# 
+ 
+die die aktuelle Stiftposition liefert. 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Manipulation von Bildern#ie(9)# 
+#type("trium10")# 
+ 
+Erstellte Bilder können als Ganzes manipuliert werden. Die Prozeduren 
+ 
+#type("modern12")# 
+    translate            (* verschieben            *) 
+    stretch              (* strecken bzw. stauchen *) 
+    rotate               (* drehen                 *) 
+    reflect              (* spiegeln               *) 
+#type("trium10")# 
+ 
+verändern jeweils das ganze Bild. Es ist aber auch möglich, mehrere Bilder
+zusammenzufügen. Mit 
+ 
+#type("modern12")# 
+     CAT 
+#type("trium10")# 
+ 
+kann ein weiteres Bild angefügt werden. Dabei müssen allerdings beide
+PICTURE die gleiche Dimension haben. In solchen als ganzes manipulierten
+Bildern kann man ohne Einschränkung mit 'draw' und 'move' weiterzeichnen. 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Darstellung#ie(9)# 
+#type("trium10")# 
+ 
+Für die Darstellung der erzeugten Bilder existiert der Typ 
+ 
+#type("modern12")# 
+     PICFILE 
+#type("trium10")# 
+ 
+Dieser besteht aus max. 128 PICTUREs, die mit den Prozeduren 
+ 
+#type("modern12")# 
+     put 
+     get 
+#type("trium10")# 
+ 
+eingegeben bzw. ausgegeben werden können. PICFILE wird durch Datenräume
+realisiert, deshalb erfolgt die Assoziation an einen benannten Datenraum ähnlich
+wie beim FILE. Dafür wird die Prozedur 
+ 
+#type("modern12")# 
+     picture file 
+#type("trium10")# 
+ 
+verwandt. Ein neuer PICFILE enthält genau ein leeres PICTURE. Die Darstellung
+der PICFILEs auf Zeichengeräten erfolgt mit der Prozedur 
+ 
+#type("modern12")# 
+     plot 
+#type("trium10")# 
+ 
+Da die Graphiken aber in "Weltkoordinaten" erzeugt werden und die spätere
+Darstellung vollkommen unbeachtet bleibt, müssen gewisse Darstellungspara­
+meter für die Zeichnung gesetzt werden. Diese Parameter werden im PICFILE
+abgelegt und gelten jeweils für den gesamten PICFILE. Dadurch ist es möglich,
+einen PICFILE mit spezifizierter Darstellungsart über einen SPOOLER an einen
+Plotter zu senden oder die bei der letzten Betrachtung gewählte Darstellung mit
+in dem PICFILE gespeichert zu halten. Für die Darstellung können den virtuellen
+Stiften mit der Prozedur 
+ 
+#type("modern12")# 
+     select pen 
+#type("trium10")# 
+ 
+reale Stifte zugeordnet werden. Voreingestellt ist für alle virtuellen Stifte:
+Standardfarbe, Standardstärke, durchgängige Linie. 
+ 
+Indem man einigen virtuellen Stiften den leeren Stift als realen Stift zuordnet,
+kann man einzelne PICTUREs ausblenden. Sowohl bei der Darstellung von
+zwei- als auch dreidimensionaler Graphik kann die gewählte Zeichenfläche auf
+dem Endgerät mit der Prozedur 
+ 
+#type("modern12")# 
+     viewport 
+#type("trium10")# 
+ 
+festgelegt werden. Voreingestellt ist das Quadrat mit der größtmöglichen Seiten­
+länge, d.h. der kürzeren Seite der hardwaremäßigen Zeichenfläche. 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Darstellung zweidimensionaler Graphik#ie(9)# 
+#type("trium10")# 
+ 
+Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt
+(das 'Fenster') angegeben werden. Mit der Prozedur 
+ 
+#type("modern12")# 
+     window 
+#type("trium10")# 
+ 
+wird durch Angabe der minimalen und maximalen X- bzw. Y-Koordinaten ein
+Fenster definiert. Da das so definierte Fenster auf die ganze (mit 'viewport'
+definierbare) Zeichenfläche abgebildet wird, ist der Abbildungsmaßstab durch das
+Zusammenspiel von 'viewport' und 'window' bestimmt. Da bei 'viewport' stan­
+dardmäßig das maximale Zeichenquadrat voreingestellt ist, wird in diesem Fall
+durch gleiche X- und Y-Fenstergröße eine winkeltreue Darstellung erreicht. 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Darstellung dreidimensionaler Graphik#ie(9)# 
+#type("trium10")# 
+ 
+Im dreidimensionalen Fall wird das Fenster ebenfalls mit 
+ 
+#type("modern12")# 
+     window 
+#type("trium10")# 
+ 
+definiert, wobei dann allerdings auch der Bereich der dritten Dimension
+(Z-Koordinaten) zu berücksichtigen ist. Da die dreidimensionale Graphik auf
+eine zweidimensionale Fläche projiziert wird, können aber noch weitere Darstel­
+lungsparameter angegeben werden. Der Betrachtungswinkel wird mit Hilfe der
+Prozedur 
+ 
+#type("modern12")# 
+     view 
+#type("trium10")# 
+ 
+angegeben. Zur Spezifikation der gewünschten Projektionsart gibt es 
+ 
+#type("modern12")# 
+    orthographic          (* orthographische Projektion       *) 
+    perspective           (* perspektivische Projektion, 
+                             der Fluchtpunkt ist frei wählbar *) 
+    oblique               (* schiefwinklige Projektion        *) 
+#type("trium10")# 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Beispiel (Sinuskurve)#ie(9)# 
+#type("modern12")# 
+ 
+  funktion zeichnen; 
+  bild darstellen  . 
+ 
+funktion zeichen : 
+  PICTURE VAR pic :: nilpicture; 
+  REAL VAR x := -pi; 
+  move (pic, x, sin (x)); 
+  REP x INCR 0.1; 
+      draw (pic, x, sin (x)) 
+  UNTIL x >= pi PER  . 
+ 
+bild darstellen : 
+  PICFILE VAR p :: picture file ("sinus"); 
+  window (p, -pi, pi, -1.0, 1.0); 
+  put (p, pic); 
+  plot (p)  . 
+#type("trium10")# 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Beispiel (Würfel)#ie(9)# 
+#type("modern12")# 
+ 
+  wuerfel zeichen; 
+  wuerfel darstellen. 
+ 
+wuerfel zeichnen : 
+  zeichne vorderseite; 
+  zeichne rueckseite; 
+  zeichne verbindungskanten. 
+ 
+zeichne vorderseite : 
+  PICTURE VAR vorderseite :: nilpicture; 
+  move (vorderseite, 0.0, 0.0, 0.0); 
+  draw (vorderseite, 1.0, 0.0, 0.0); 
+  draw (vorderseite, 1.0, 0.0, 1.0); 
+  draw (vorderseite, 0.0, 0.0, 1.0); 
+  draw (vorderseite, 0.0, 0.0, 0.0). 
+ 
+zeichne rueckseite : 
+  PICTURE VAR rueckseite :: translate 
+                              (vorderseite, 0.0, 1.0, 0.0). 
+ 
+zeichne verbindungskanten : 
+  PICTURE VAR verbindungskanten :: nilpicture; 
+  move (verbindungskanten, 0.0, 0.0, 0.0); 
+  draw (verbindungskanten, 0.0, 1.0, 0.0); 
+ 
+  move (verbindungskanten, 1.0, 0.0, 0.0); 
+  draw (verbindungskanten, 1.0, 1.0, 0.0); 
+ 
+  move (verbindungskanten, 1.0, 0.0, 1.0); 
+  draw (verbindungskanten, 1.0, 1.0, 1.0); 
+ 
+  move (verbindungskanten, 0.0, 0.0, 1.0); 
+  draw (verbindungskanten, 0.0, 1.0, 1.0). 
+ 
+wuerfel darstellen : 
+  PICFILE VAR p := picture file ("wuerfel"); 
+  put (p, vorderseite); 
+  put (p, rueckseite); 
+  put (p, verbindungskanten); 
+  window (p, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0); 
+  view (p, 0.0, 40.0, 20.0); 
+  orthographic (p); 
+  plot (p). 
+#type("trium10")# 
+#free(2.0)# 
+#ib(9)##type("triumb14")#Beschreibung der Graphik-Prozeduren#ie(9)# 
+#type("trium10")# 
+ 
+       #limit(12.0)##on("italics")#Zweidimensionale PICTUREs brauchen weniger Speicherplatz
+       als dreidimensionale. Daher werden in einigen Fehlermeldun­
+       gen unterschiedliche Größen angegeben. 
+#limit(13.5)##off("italics")# 
+ 
+:= 
+    OP := (PICTURE VAR dest, PICTURE CONST source) 
+    Zweck: Zuweisung 
+ 
+    OP := (PICFILE VAR dest, DATASPACE CONST source) 
+    Zweck: Assoziiert die PICFILE Variable 'dest' mit der DATASPACE CONST
+           'source' und initialisiert die PICFILE Variable sofern nötig. 
+    Fehlerfall: 
+        * dataspace is no PICFILE 
+          Der anzukoppelnde Datenraum hat einen falschen Typ. 
+ 
+#ib#CAT#ie# 
+    OP CAT (PICTURE VAR dest, PICTURE CONST source) 
+    Zweck: Aneinanderfügen von zwei PICTURE's. 
+    Fehlerfälle: 
+        * OP CAT: left dimension <> right dimension 
+          Es können nur PICTUREs mit gleicher Dimension angefügt werden. 
+        * OP CAT: Picture overflow 
+          Die beiden PICTURE überschreiten die maximale Größe eines
+          Pictures. 
+ 
+#ib#act picture#ie# 
+    PICTURE PROC act picture (PICFILE VAR p) 
+    Zweck: Liefert das PICTURE des PICFILEs 'p', auf das mit 'backward' o.ä.
+           positioniert wurde. 
+ 
+#ib#backward#ie# 
+    PROC backward (PICFILE VAR p) 
+    Zweck: Positioniert den PICFILE 'p' um ein PICTURE zurück. 
+    Fehlerfall: 
+        * backward at begin of file 
+          Es wurde versucht vor den Anfang des PICFILEs zu positionieren. 
+ 
+#ib#draw#ie# 
+    PROC draw (PICTURE VAR pic, REAL CONST x, y) 
+    Zweck: Die Prozedur zeichnet in dem (zweidimensionalen) Bild 'pic' eine
+           Linie von der aktuellen Position zur Position (x, y). 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1927) 
+        * picture is three dimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC draw (PICTURE VAR pic, REAL CONST x, y, z) 
+    Zweck: Die Prozedur zeichnet in dem (dreidimensionalen) Bild 'pic' eine
+           gerade Linie von der aktuellen Position zur Position (x, y, z). 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) 
+        * picture is only two dimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC draw (PICTURE VAR pic, TEXT CONST text) 
+    Zweck: Der angegebene Text wird in das Bild 'pic' eingetragen. Der Anfang
+           ist dabei die aktuelle Stiftposition. Diese wird nicht verändert. 
+    Fehlerfall: 
+        * picture overflow 
+          Der Text paßt nicht mehr in das PICTURE. 
+ 
+    PROC draw (PICTURE VAR pic, TEXT CONST text, 
+               REAL CONST angle, height) 
+    Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der
+           Waagerechten und in der Größe 'height' in das PICTURE 'pic'
+           eingetragen. Der Anfang ist dabei die aktuelle Stiftposition. Diese
+           wird nicht verändert. 
+    Fehlerfall: 
+        * picture overflow 
+          Der Text paßt nicht mehr in das PICTURE. 
+ 
+    PROC draw (PICFILE VAR pic, REAL CONST x, y) 
+    Zweck: Die Prozedur zeichnet in dem aktuellen (zweidimensionalen)
+           PICTURE des PICFILEs 'p' eine gerade Linie. Der (virtuelle) Stift wird
+           von der aktuellen Position zur Position (x, y) gefahren. Falls das
+           aktuelle PICTURE zu voll ist, wird automatisch auf das nächste
+           umgeschaltet. 
+    Fehlerfälle: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128 PICTURE) 
+        * picture is threedimensional 
+          Das aktuelle PICTURE ist dreidimensional. 
+ 
+    PROC draw (PICTFILE VAR pic, REAL CONST x, y, z) 
+    Zweck: s. o. 
+    Fehlerfälle: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128) 
+        * picfile is only twodimensional 
+          Das aktuelle PICTURE ist zweidimensional. 
+ 
+    PROC draw (PICTFILE VAR pic, TEXT CONST text) 
+    Zweck: Der angegebene Text wird in das aktuelle PICTURE des PICFILEs 'p'
+           eingetragen. Falls das aktuelle PICTURE zu voll ist, wird automatisch
+           auf das nächste umgeschaltet. Der Anfang ist dabei die aktuelle
+           Stiftposition. Diese wird nicht verändert. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128) 
+ 
+    PROC draw (PICFILE VAR pic, TEXT CONST text, 
+               REAL CONST angle, height) 
+    Zweck: Der angegebene Text wird unter dem Winkel 'angle' gegenüber der
+           Waagerechten und in der Größe 'height' in das aktuelle PICTURE
+           des PICFILES 'p' eingetragen. Falls das aktuelle PICTURE zu voll ist,
+           wird automatisch auf das nächste umgeschaltet. Der Anfang ist
+           dabei die aktuelle Stiftposition. Diese wird nicht verändert. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128) 
+ 
+#ib#eof#ie# 
+    BOOL PROC eof (PICFILE CONST p) 
+    Zweck: Liefert 'TRUE' wenn hinter das Ende des PICFILEs positioniert
+           wurde. 
+ 
+#ib#extrema#ie# 
+    PROC extrema (PICTURE CONST p, 
+                  REAL VAR x min, x max, y min, y max) 
+    Zweck: Die Prozedur liefert die größten und kleinsten X- und Y-Koordi­
+           naten des PICTUREs 'p'. Diese werden in die Parameter 'x min', 'x
+           max', 'y min' und 'y max' eingetragen. 
+ 
+    PROC extrema (PICTURE CONST p, 
+                  REAL VAR x min, x max, y min, y max, z min, z max) 
+    Zweck: s.o. 
+ 
+    PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) 
+    Zweck: s.o. 
+ 
+    PROC extrema (PICFILE VAR p, 
+                  REAL VAR x min, x max, y min, y max, z min, z max) 
+    Zweck: s.o. 
+ 
+#ib#forward#ie# 
+    PROC forward (PICFILE VAR p) 
+    Zweck: Positioniert den PICFILE um ein PICTURE weiter. 
+    Fehlerfall: 
+        * picfile overflow 
+          Es sollte hinter das Ende des PICFILEs positioniert werden. 
+ 
+#ib#get#ie# 
+    PROC get (PICFILE VAR p, PICTURE VAR pic) 
+    Zweck: Liest ein PICTURE aus einem PICFILE und positioniert auf das
+           Nächste. 
+    Fehlerfall: 
+        * input after end of picfile 
+          Es sollte nach dem Ende des Picfiles gelesen werden. 
+ 
+#ib#move#ie# 
+    PROC move (PICTURE VAR pic, REAL CONST x, y) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1927 'moves') 
+        * picture is three dimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC move (PICTURE VAR pic, REAL CONST x, y, z) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. 
+    Fehlerfälle: 
+        * picture overflow 
+          Zu viele Befehle in einem PICTURE (z. Zeit max. 1310) 
+        * picture is only twodimensional 
+          Ein PICTURE kann nur entweder zwei- oder dreidimensional sein. 
+ 
+    PROC move (PICFILE VAR p, REAL CONST x, y) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y) gefahren. Falls das aktuelle
+           PICTURE des PICFILEs 'p' zu voll ist, wird automatisch auf das
+           nächste umgeschaltet. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) 
+ 
+    PROC move (PICFILE VAR p, REAL CONST x, y, z) 
+    Zweck: Der (virtuelle) Stift wird zur Position (x, y, z) gefahren. Falls das
+           aktuelle PICTURE des PICFILEs 'p' zu voll ist, wird automatisch auf
+           das nächste umgeschaltet. 
+    Fehlerfall: 
+        * picfile overflow 
+          Das letzte PICTURE ist voll (z. Zeit max. 128 PICTUREs) 
+ 
+#ib#nilpicture#ie# 
+    PICTURE PROC nilpicture 
+    Zweck: Die Prozedure liefert ein leeres PICTURE zur Initialisierung. 
+ 
+#ib#oblique#ie# 
+    PROC oblique (PICFILE VAR p, REAL CONST a, b) 
+    Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird 'schiefwinklig' als
+           gewünschte Projektionsart eingestellt. Dabei ist (a, b) der Punkt in
+           der X-Y-Ebene, auf den der Einheitsvector in Z-Richtung
+           abgebildet werden soll. 
+ 
+#ib#orthographic#ie# 
+    PROC orthographic (PICFILE VAR p) 
+    Zweck: Bei dem (dreidimensionalen!) Bild 'p' wird "orthografisch" als Pro­
+           jektionsart eingestellt. Bei der orthografischen Projektion wird ein
+           dreidimensionaler Körper mit parallelen Strahlen senkrecht auf die
+           Projektionsebene abgebildet. 
+ 
+#ib#pen#ie# 
+    INT PROC pen (PICTURE CONST pic) 
+    Zweck: Liefert die Nummer des 'virtuellen Stifts'. 
+ 
+    PICTURE PROC pen (PICTURE CONST pic, INT CONST pen) 
+    Zweck: Liefert ein PICTURE mit dem Inhalt 'pic' und dem 'virtuellen Stift' mit
+           der Nummer 'pen'. Möglich sind die Nummern 1 - 16. 
+    Fehlerfälle: 
+        * PROC pen: pen [No] < 1 
+          Der gewünschte Stift ist kleiner als 1. 
+        * PROC pen: pen [No] > 16 
+          Der gewünschte Stift ist größer als 16. 
+ 
+#ib#perspective#ie# 
+    PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) 
+    Zweck: Bei den dreidimensionalen PICTUREs des PICFILE's 'p' wird
+           "perspektivisch" als gewünschte Projektionsart eingestellt. Der Punkt
+           (cx, cy, cz) ist der Fluchtpunkt der Projektion, d.h. alle Parallelen zur
+           Blickrichtung schneiden sich in diesem Punkt. 
+ 
+#ib#pic no#ie# 
+    INT PROC pic no (PICFILE CONST p) 
+    Zweck: Liefert die Nummer des aktuellen PICTUREs. 
+ 
+#ib#picture file#ie# 
+    DATASPACE PROC picture file (TEXT CONST name) 
+    Zweck: Die Prozedur dient zur Assoziation eines benannten Datenraumes mit
+           einem PICFILE (s. Operator ':='). 
+ 
+#ib#plot#ie# 
+    PROC plot (TEXT CONST name) 
+    Zweck: Der PICFILE mit dem Namen 'name' wird entspechend der angege­
+           benen Darstellungsart gezeichnet. Diese Parameter ('perspective',
+           'orthographic', 'oblique', 'view', 'window' etc.) müssen vorher
+           eingestellt werden. 
+    Fehlerfall: 
+        * FILE does not exist 
+          Es existiert kein PICFILE mit dem Namen 'name' 
+ 
+    PROC plot (PICFILE VAR p) 
+    Zweck: Der PICFILE 'p' wird entspechend der angegebenen Darstellungsart
+           gezeichnet. Diese Parameter müssen vorher eingestellt werden. 
+ 
+           #on("bold")#Zweidimensional: 
+#off("bold")# 
+           obligat:      'window'     (zweidimensional) 
+           optional:     'view'       (zweidimensional) 
+                         'select pen' 
+                         'viewport' 
+ 
+           #on("bold")#Dreidimensional: 
+#off("bold")# 
+           obligat:      'window'     (dreidimensional) 
+           optional:     'view'       (dreidimensional) 
+                         'orthographic', 'perspective', 'oblique' 
+                         'viewport' 
+                         'select pen' 
+ 
+#ib#put#ie# 
+    PROC put (PICFILE VAR p, PICTURE CONST pic) 
+    Zweck: Schreibt ein PICTURE in einen PICFILE und positioniert um eins
+           vor. 
+    Fehlerfall: 
+        * picfile overflow 
+          Der PICFILE ist voll. (z. Z. max. 128 PICTURE) 
+ 
+#ib#reset#ie# 
+    PROC reset (PICFILE VAR p) 
+    Zweck: Positioniert auf den Anfang eines Picfiles. 
+ 
+#ib#rotate#ie# 
+    PICTURE PROC rotate (PICTURE CONST pic, REAL CONST alpha) 
+    Zweck: Das PICTURE 'pic' wird um den Punkt (0, 0) um den Winkel 'alpha'
+           (im Gradmaß) im mathematisch positiven Sinn gedreht. 
+ 
+    PICTURE PROC rotate (PICTURE CONST pic, 
+                         REAL CONST alpha, beta, gamma) 
+    Zweck: Das dreidimensionale PICTURE 'pic' wird um den Winkel 'alpha',
+           'beta' oder 'gamma' im mathematisch positiven Sinn gedreht. Der
+           Winkel 'alpha' dreht um die X-Achse, der Winkel 'beta' um die
+           Y-Achse und 'gamma' um die Z-Achse. Es darf dabei nur jeweils
+           ein Winkel von 0.0 verschieden sein. Alle Winkel werden im
+           Gradmaß angegeben. 
+ 
+#ib#select pen#ie# 
+    PROC select pen (PICFILE VAR p, 
+                     INT CONST pen, colour, thickness, linetype) 
+    Zweck: Für die Darstellung des Bildes 'p' soll dem "virtuellen Stift" 'pen' ein
+           realer Stift zugeordnet werden, der möglichst die Farbe 'colour' und
+           die Dicke 'thickness' hat und dabei Linien mit dem Typ 'line type'
+           zeichnet. Es wird die beste Annäherung für das Ausgabegerät für
+           diese Parameter genommen. Dabei gelten folgende Vereinbarun­
+           gen: 
+ 
+           Farbe: negative Farben setzten den Hintergrund, positive Farben
+                  zeichnen im Vordergrund. 
+ 
+                    0   Löschstift (falls vorhanden) 
+                    1   Standardfarbe des Endgeräts (schwarz oder weiß) 
+                    2   rot 
+                    3   blau 
+                    4   grün 
+                    5   schwarz 
+                    6   weiß > 20   nicht normierte Sonderfarben 
+ 
+           Dicke: 0 
+                  Standardstrichstärke des Endgerätes > 0 
+                  Strichstärke in 1/10 mm 
+ 
+           Typ: 
+                    0   keine sichtbare Linie 
+                    1   durchgängige Linie 
+                    2   gepunktete Linie 
+                    3   kurz gestrichelte Linie 
+                    4   lang gestrichelte Linie 
+                    5   Strichpunktlinie 
+ 
+           Die hier aufgeführten Möglichkeiten müssen nicht an allen grafischen
+           Endgeräten vorhanden sein. Der geräteabhängige Graphik-Treiber
+           wählt jeweils die für ihn bestmögliche Annäherung. 
+ 
+    Fehlerfälle: 
+        * pen < 1 
+        * pen > 16 
+ 
+#ib#size#ie# 
+    INT PROC size (PICFILE CONST p) 
+    Zweck: Liefert die aktuelle Größe eines PICFILEs in Bytes. 
+ 
+#ib#stretch#ie# 
+    PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc) 
+    Zweck: Das PICTURE 'pic' wird in X-Richtung um den Faktor 'xc', in
+           Y-Richtung um den Faktor 'yc' gestreckt (bzw. gestaucht). Dabei
+           bewirkt der Faktor 
+                   c > 1     eine Streckung 
+               0 < c < 1     eine Stauchung 
+                   c < 0     zusätzlich eine Achsenspiegelung 
+ 
+    PICTURE PROC stretch (PICTURE CONST pic, REAL CONST xc, yc, zc) 
+    Zweck: Das dreidimensionale PICTURE 'pic' wird entsprechend den
+           angegeben Faktoren 'xc', 'yc' und 'zc' gestreckt. Wirkung s.o. 
+ 
+#ib#translate#ie# 
+    PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy) 
+    Zweck: Das PICTURE 'pic' wird um 'dx' und 'dy' verschoben. 
+    Fehlerfall: 
+        * picture is threedimensional 
+          'pic' ist dreidimensional. 
+ 
+    PICTURE PROC translate (PICTURE CONST pic, REAL CONST dx, dy, dz) 
+    Zweck: Das PICTURE 'pic' wird um 'dx', 'dy' und 'dz' verschoben. 
+    Fehlerfall: 
+        * picture is twodimensional 
+          Das PICTURE 'pic' ist zweidimensional 
+ 
+#ib#two dimensional#ie# 
+    PROC two dimensional (PICFILE VAR p) 
+    Zweck: Setzt als Projektionsart zweidimensional. 
+ 
+#ib#view#ie# 
+    PROC view (PICFILE VAR p, REAL CONST alpha, phi, theta) 
+    Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne
+           dargestellt, sondern für die Betrachtung gedreht. Mit der Prozedur
+           'view' kann diese Betrachtungsrichtung durch die Polarwinkel 'phi'
+           und 'theta' angegeben werden. Mit dem Winkel 'alpha' kann dann
+           das Bild um den Mittelpunkt der Zeichenfläche gedreht werden.
+           Dadurch kann ein Bild auch auf einem Terminal hochkant gestellt
+           werden. Voreingestellt ist 'phi = 0, theta = 0 und alpha = 0', d.h.
+           direkt von oben. 
+ 
+           Im Gegensatz zu 'rotate' hat 'view' keine Wirkung auf das eigentli­
+           che Bild (PICFILE), sondern nur auf die gewählte Darstellung. So
+           addieren sich zwar aufeinanderfolgende "Rotationen", 'view' aber
+           geht immer von der Nullstellung aus. Auch kann das Bild durch eine
+           "Rotation" ganz oder teilweise aus oder in das Darstellungsfenster
+           ('window') gedreht werden. Bei 'view' verändern sich die Koordina­
+           ten der Punkte nicht, d.h. das Fenster wird mitgedreht. 
+ 
+#ib#viewport#ie# 
+    PROC viewport (PICFILE VAR p, 
+                   REAL CONST hormin, hormax, vertmin, vertmax) 
+    Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt
+           werden soll, wird spezifiziert. Dabei wird sowohl die Größe als auch
+           die relative Lage der Zeichenfläche definiert. Der linke untere
+           Eckpunkt der physikalischen Zeichenfläche des Gerätes hat die
+           Koordinaten (0.0, 0.0). Die definierte Zeichenfläche erstreckt sich 
+ 
+#type("modern12")# 
+                'hormin'  - 'hormax'     in der Horizontalen, 
+                'vertmin' - 'vertmax'    in der Vertikalen. 
+#type("trium10")# 
+ 
+           So liegt der linke untere Eckpunkt dann bei (hormin, vertmin), der
+           rechte obere bei (hormax, vertmax). 
+ 
+           Damit sowohl geräteunabhängige als auch maßstabsgerechte
+           Zeichnungen möglich sind, können die Koordinaten in zwei Arten
+           spezifiziert werden : 
+ 
+           a) Gerätekoordinaten 
+              Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei
+              hat die kürzere Seite der physikalischen Zeichenfläche defini­
+              tionsgemäß die Länge 1.0. 
+ 
+           b) absolute Koordinaten 
+              Die Werte werden in cm angegeben. Für die Maximalwerte sind
+              nur Werte größer als 2.0 möglich. 
+ 
+           Voreingestellt ist 
+ 
+#type("modern12")# 
+                viewport (0.0, 1.0, 0.0, 1.0), 
+#type("trium10")# 
+ 
+           d.h. das größtmöglichste Quadrat, beginnend in der linken unteren
+           Ecke der physikalischen Zeichenfläche. In vielen Fällen wird diese
+           Einstellung ausreichen, so daß der Anwender kein eigenes 'viewport'
+           definieren muß. 
+ 
+           Der Abbildungsmaßstab wird durch das Zusammenspiel von 'view­
+           port' und 'window' festgelegt (siehe dort). Dabei ist insbesondere
+           darauf zu achten, daß winkeltreue Darstellungen nur bei gleichem
+           X- und Y-Maßstab möglich sind. Da man oft quadratische Fenster
+           ('window') verwendet, wurde als Standardfall auch ein quadratisches
+           'viewport' gewählt. 
+ 
+#ib#where#ie# 
+    PROC where (PICTURE CONST pic, REAL VAR x, y) 
+    Zweck: Die aktuelle Stiftposition wird in 'x' und 'y' eingetragen. 
+    Fehlerfall: 
+        * picture is threedimensional 
+          Das PICTURE 'pic' ist dreidimensional 
+ 
+    PROC where (PICTURE CONST pic, REAL VAR x, y, z) 
+    Zweck: Die aktuelle Stiftposition wird in 'x', 'y' und 'z' eingetragen. 
+    Fehlerfall: 
+        * picture is twodimensional 
+          Das PICTURE 'pic' ist zweidimensional 
+ 
+#ib#window#ie# 
+    PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) 
+    Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das
+           darzustellende Fenster definiert. Alle Bildpunkte, deren X-Koordi­
+           naten im Intervall [x min, x max] und deren Y-Koordinaten im
+           Intervall [y min, y max] liegen, gehören zum definierten Fenster.
+           Vektoren, die über dieses Fenster hinausgehen, werden abge­
+           schnitten. Dieses Fenster wird auf die spezifizierte Zeichenfläche
+           abgebildet. (Das ist standardmäßig das größtmögliche Quadrat auf
+           dem ausgewählten Gerät). 
+ 
+           Der Darstellungsmaßstab ergibt sich als 
+ 
+#type("modern12")# 
+                                x max - x min 
+                  ----------------------------------------- 
+                  horizontale Seitenlänge der Zeichenfläche 
+ 
+                                y max - y min 
+                  ----------------------------------------- 
+                   vertikale Seitenlänge der Zeichenfläche 
+#type("trium10")# 
+ 
+            Für eine winkeltreue Darstellung müssen X- und Y-Maßstab
+            gleich sein! Einfach können winkeltreue Darstellung erreicht
+            werden, wenn das Fenster eine quadratische Form hat. Die
+            Zeichenfläche ('viewport') ist dementsprechend als Quadrat vorein­
+            gestellt. 
+ 
+    PROC window (PICFILE VAR p, 
+                 REAL CONST x min, x max, y min, y max, z min, z max) 
+    Zweck: Für die Darstellung eines dreidimensionalen Bildes wird das darzu­
+           stellende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im
+           Intervall [x min, x max] und deren Y-Koordinaten im Intervall [y min,
+           y max] und deren Z-Koordinaten im Intervall [z min, z max] liegen,
+           gehören zum definierten Fenster. Dieses dreidimensionale Fenster
+           (Quader) wird entsprechend der eingestellten Projektionsart (ortho­
+           grafisch, perspektivisch oder schiefwinklig) und den Betrachtungs­
+           winkeln (s. 'view') auf die spezifizierte Zeichenfläche abgebildet. (Das
+           ist standardmäßig das größtmögliche Quadrat auf dem ausgewählten
+           Gerät.) Linien, die außerhalb dieses Quadrates liegen, werden
+           abgeschnitten. 
+ 
+           Anders als im zweidimensionalen Fall ist das Problem der Maßstäbe
+           nicht mehr nur durch das Zusammenspiel von 'window' und 'view­
+           port' zu beschreiben. Hier spielen auch Projektionsart und Dar­
+           stellungswinkel eine Rolle. Falls alle Darstellungswinkel den Wert 0.0
+           haben, gilt das für den zweidimensionalen Fall gesagte für die Ebene
+           (y = 0.0) entsprechend. 
+ 
+#ib#write is possible#ie# 
+    BOOL PROC write is possible (PICTURE CONST pic, INT CONST space) 
+    Zweck: Liefert 'TRUE', falls 'space' Bytes Platz in 'pic' vorhanden ist. 
+ 
+ 
+ 
+ 
+ 
+
diff --git a/system/std.graphik/1.8.7/doc/GRAPHIK.book b/system/std.graphik/1.8.7/doc/GRAPHIK.book
new file mode 100644
index 0000000..435d9e4
--- /dev/null
+++ b/system/std.graphik/1.8.7/doc/GRAPHIK.book
@@ -0,0 +1,897 @@
+#type ("times8")##limit (11.0)##start (2.2, 1.5)##pagelength (17.4)##block# 
+ 
+#head# 
+#type ("triumb14")# 
+#center#EUMEL-Grafik-System 
+ 
+#type ("times8")# 
+#end# 
+#type ("triumb14")# Teil 10: Graphik#type ("times8")# 
+ 
+ 
+#type ("trium12")# 
+#on("b")#1. Übersicht#off("b")# 
+#type ("times8")# 
+ 
+#limit (7.0)##type("times6")# 
+            #on("i")#Dieser Teil des Benutzer-Handbuchs beschreibt die Graphik-
+            Fähigkeiten des EUMEL-Systems. Die Graphik-Pakete gehö­
+            ren nicht zum Eumel-Standard, sondern sind Anwenderpake­
+            te, die im Quellcode ausgeliefert und von jeder Installation in das
+            System aufgenommen werden können. #off("i")# 
+#limit (11.0)# 
+#foot#
+    Eventuell müssen Programme erstellt werden, die die Anpassungen für spezielle graphische Geräte einer Installation
+    vornehmen, soweit diese nicht von den EUMEL-Anbietern bezogen werden können. 
+#end# 
+ 
+#type("times8")# 
+    Das #on("b")#Graphik-System#off("b")# ermöglicht es, durch ELAN-Programme geräteunabhängige Infor­
+    mationen für Zeichnungen (#on("i")#Graphiken#off("i")#) zu erstellen. Die Graphik erzeugenden Programme
+    brauchen dabei keine geräteabhängigen Größen oder Unterprogramme zu enthalten. Sie
+    befassen sich somit ausschließlich mit der Erzeugung der problemorientierten Information
+    für die Konstruktion einer Zeichnung. Nach der geräteunabhängigen Erzeugung einer
+    Graphik kann diese auf unterschiedlichen Geräten ausgegeben werden (z.B. erst auf einem
+    Terminal zur Kontrolle und dann auf einem Plotter). 
+ 
+    Die EUMEL-Graphik umfaßt zwei- und dreidimensionale Graphik. Im dreidimensiona­
+    len Fall sind perspektivische, orthografische und schiefwinklige Projektionen mit beliebi­
+    gen Betrachtungswinkeln möglich. 
+ 
+    Bei der EUMEL-Graphik wird streng zwischen Erzeugung und Manipulation von Gra­
+    phiken auf der einen und der Darstellung der erzeugten Bilder auf der anderen Seite
+    unterschieden. Für die Erzeugung und Manipulation der Graphiken wird von den Paketen
+    #on("i")#picture#off("i")# und #on("i")#picfile#off("i")# der Datentype #on("b")#PICTURE#off("b")# bzw. #on("b")#PICFILE#off("b")# zur Verfügung gestellt. Dabei
+    müssen Ausschnitt, Maßstab, Betrachtungswinkel und Projektionsart erst bei der Darstel­
+    lung festgelegt werden. Diese Konstruktion des Graphik-Systems hat folgende Vorteile: 
+ 
+    a)  Programme, die Graphik-Information erzeugen, sind geräteunabhängig. Das bedeu­
+        tet, das der Programmierer sich ausschließlich mit einem logischen Problem befassen
+        muß und nicht mit gerätespezifischen Besonderheiten. 
+ 
+    b)  Graphiken können auf mehreren unterschiedlich gearteten Geräten mehrmals darge­
+        stellt werden, ohne daß das erzeugende Programm geändert oder neu gestartet werden
+        muß. Z.B. kann ein Programmierer eine Graphik erst auf dem Terminal überprüfen,
+        bevor er die Graphik auf einem Plotter zeichnen läßt. 
+ 
+    c)  Graphiken können leicht geändert (z. B. vergrößert oder in eine Richtung gestreckt
+        o.ä.) werden, ohne daß sie erneut erzeugt werden müssen. Zudem können Graphiken
+        aneinander oder übereinander gelegt werden. 
+ 
+    d)  Graphiken mit unterschiedlichen Farben, Strichen usw. können leicht erzeugt werden. 
+ 
+    e)  Der Anschluß von neuen Graphik.Geräten durch Benutzer ist leicht möglich, ohe daß
+        die Graphik-Programme geändert werden müssen. 
+ 
+    f)  Plotter können wie Drucker an einen Spooler gehängt werden. 
+ 
+    g)  Bilder können als PICFILEs gespeichert und versandt werden. 
+ 
+    h)  Es können auch auf Systemen ohne graphische Ausgabegeräte Graphiken erzeugt
+        werden. 
+ 
+    i)  Es können mit einfachen Mitteln universelle Unterprogrammpakete erstellt werden,
+        um die Standardzeichnungen (Darstellen einer Funktion, Balken oder Liniendiagram­
+        me, Achsen etc.) zu erstellen. 
+ 
+ 
+#type ("trium12")# 
+#on("b")#2. Erzeugung von Bildern#off("b")# 
+#type ("times8")# 
+ 
+    Bilder entstehen in Objektion vom Datentyp #on("b")#PICTURE#off("b")#. Diese müssen mit der Prozedur
+    #on("i")#nilpicture#off("i")# initialisiert werden. Sie enthalten dann ein leeres Bild, dessen Dimension noch
+    nicht festgelegt ist. Die Dimension eines #on("i")#PICTURE#off("i")#s wird mit dem ersten Schreibzugriff
+    (#on("i")#move, draw#off("i")# o.ä.) festgelegt. Ein #on("i")#PICTURE#off("i")# kann immer nur entweder zwei- oder
+    dreidimensional sein. 
+    Außerdem kann einem #on("i")#PICTURE#off("i")# mit der Prozedur #on("i")#pen#off("i")# genau ein virtueller Stift zugeord­
+    net oder der aktuelle Stift erfragt werden (Standardeinstellung: 1). 
+ 
+    Für Erzeugung eines Bildes wird ein virtueller Zeichenstift benutzt, dem bei der Darstel­
+    lung jeweils genau ein realer Stift zugeordnet wird. Dieser Stift kann mit der Prozedur
+    #on("b")#move#off("b")# oder #on("b")#move r #off("b")#auf eine bestimmte Stelle positioniert werden ohne zu zeichnen. Mit
+    #on("b")#draw#off("b")# oder #on("b")#draw r#off("b")# wird eine Linie von der letzten Position zur angegebene Position
+    gezeichnet. Die aktuelle Stiftposition kann dabei mit #on("b")#where#off("b")# abgefragt werden. 
+    Außerdem existiert noch die Prozedur #on("b")#draw#off("b")# die einen Text zur Beschriftung der Zeich­
+    nung darstellt, sowie #on("b")#bar#off("b")# zum Zeichnen eines Balkens für Balkendiagramme, #on("b")#circle#off("b")# zum
+    Zeichnen eines Kreisbogens für Kreisdiagramme und #on("b")#mark#off("b")# zum Markiern von Positionen.
+    Dabei wird die aktuelle Stiftposition aber nicht verändert. 
+ 
+#type ("trium12")# 
+#on("b")#3. Manipulation von PICTUREs#off("b")# 
+#type ("times8")# 
+ 
+    Erstellte PICTUREs können auch als Ganzes manipuliert werde. Dazu dienen die Prozedu­
+    ren #on("b")#translate, stretch#off("b")# und #on("b")#rotate#off("b")#. Es ist auch möglich mehrere PICTURE mit dem Opera­
+    tor #on("b")#CAT#off("b")# aneinanderzufügen, wenn beide PICTURE die gleiche Dimension haben. In
+    solcherart manipulierten Bildern kann ohne Einschränkung weitergezeichnet werden,
+    solange die maximale Größe nicht überschritten wird. 
+ 
+#type ("trium12")# 
+#on("b")#4. Darstellung und Speicherung #off("b")# 
+#type ("times8")# 
+ 
+    Für die Darstellung und Speicherung der erzeugten Bilder existiert der Typ #on("b")#PICFILE#off("b")#.
+    Dieser besteht aus eienm Datenraum mit max. 1024 PICTUREs, die mit den Prozeduren #on("b")#
+    delete picture, insert picture, read picture, write picture, get picture#off("b")# und #on("b")#put picture#off("b")# einge­
+    geben bzw. ausgegeben werden können. 
+    Für die Positionierung innerhalb eines PICFILES stehen die Prozeduren #on("b")#to pic, up, down,
+    eof, picture no, pictures#off("b")# zur Verfügung. 
+    Für die Assoziation mit einem benannten Datenraum existiert ähnlich wie beim Datentyp
+    FILE die Prozedur #on("b")#picture file#off("b")#; unbenannte Datenräume können mit dem Operator #on("b")#:=#off("b")#
+    assoziert werden. 
+    Die Darstellung des PICFILES auf einem Zeichengerät erfolgt mit der Prozdur #on("b")#plot#off("b")#. 
+    Da die Graphiken aber in #on("i")#Weltkoordinaten#off("i")# erzeugt werden und die spätere Darstellung
+    vollkommen unbeachtet bleibt, müssen gewisse Darstellungsparameter für die Zeichnung
+    gesetzt werden. Dies Parameter werden im PICFILE abgelegt und gelten jeweils für alle
+    darin enthaltenen PICTURE. Dadurch ist es möglich, einen PICFILE mit spezifierter
+    Darstellungsart über einen SPOOLER an einen Plotter zu senden oder die bei der letzten
+    Betrachtung gewählte Darstellung beizubehalten oder zu ändern. 
+    Für die Darstellung können den virtuellen Stiften mit der Prozedur #on("b")#select pen#off("b")# reale Stifte
+    zugeordnet werden. Voreingestellt ist für alle virtuellen Stifte die Standardfarbe, Standard­
+    stärke und durchgängige Linie. Mit #on("b")#background#off("b")# kann eine bestimmte Hintergrundfarbe
+    gewählt werden. 
+    Indem man einem PICTURE den Stift 0 zuordnet, kann man dieses auch Ausblenden
+    wenn es bei dieser Darstellung stört. 
+    Die Größe der realen Zeichenfläche kann mit #on("b")#viewport#off("b")# eingestellt werden, wobei die
+    gesamte Zeichenfäche voreingestellt ist. Dadurch können auch mehrere PICFILE auf ein
+    Blatt oder einen Bildschirm gezeichnet werden, wenn man durch Angabe von #on("i")#background
+     (0)#off("i")# das Löschen der Zeichenfläche unterdrückt. 
+ 
+ 
+#type ("trium12")# 
+#on("b")#5. Darstellung zweidimensionaler Graphik#off("b")# 
+#type ("times8")# 
+ 
+    Bei der Darstellung zweidimensionaler Bilder muß der zu zeichnende Ausschnitt (das
+    #on("i")#Fenster#off("i")#) angegeben werden. Mit der Prozedur #on("b")#window#off("b")# wird durch Angabe der minimalen
+    und maximalen X- bzw. Y-Koordinaten ein Fenster definiert. Linien, die über dieses
+    Fenster hinausgehen, werden abgeschnitten. Dadurch kann man einen beliebigen Detailaus­
+    schnitt eines Bildes ausgeben, ohne das Bild neu generieren zu müssen. 
+    Da das so definierte Fenster auf die mit #on("i")#viewport#off("i")# definierte Zeichenfläche abgebildet wird,
+    ist der Abbildungsmaßstab durch das Zusammenspiel von #on("i")#viewport#off("i")# und #on("i")#window#off("i")# bestimmt.
+    Wenn eine Winkeltreue Darstellung erreicht werdenn soll, muß das Verhältnis der durch
+    #on("i")#viewport#off("i")# eingestellten Breite und Höhe und das Verhältnis des durch #on("i")#window#off("i")# eingestellten
+    Ausschnitts gleich sein. 
+ 
+#type ("trium12")# 
+#on("b")#6. Darstellung dreidimensionaler Graphik#off("b")# 
+#type ("times8")# 
+ 
+    Bei dreidimensionalen Zeichnungen wird das Fenster ebenfalls mit #on("b")#window#off("b")# definiert,
+    wobei dann allerdings auch der Wertebereich der dritten Dimension (Z-Koordinaten) zu
+    berücksichtigen ist. Auch hierbei werden Linien, die über die spezifierte Darstellungs­
+    fläche hinausgehen abgeschnitten. Das Abschneiden erfolgt allerdings erst nach der Projek­
+    tion auf die Darstellungsfläche, so daß auch Vektoren zu sehen sind, die über das mit
+    #on("i")#window#off("i")# angegebene Quader hinausgehen, wenn ihre Projektion innerhalb der Zeichen­
+    fläche liegt. 
+    Da die dreidimensionale Graphik auf eine zweidimensionale Fläche projeziert wird,
+    können aber noch weitere Darstellungsparameter angegeben werden. Der Betrachtungswin­
+    kel wird mit Hilfe der Prozedur #on("b")#view#off("b")# angegeben. Ebenfalls kann mit #on("b")#view#off("b")# der Winkel der
+    Y-Achse zur Horizontalen angegeben werden. 
+    Zur Spezifikation der gewünschten Projektionsart existieren #on("b")#orthographic#off("b")# (orthographische
+    Projektion), #on("b")#perspective#off("b")# (perspektivische Projektion, der Fluchtpunkt ist frei wählbar) und
+    #on("b")#oblique#off("b")# (schiefwinklige Projektion). 
+ 
+#page# 
+#type ("trium12")# 
+#on("b")#7. Beispiele#off("b")# 
+#type ("times8")# 
+ 
+    #on("u")#Sinuskurve#off("u")# 
+ 
+#type("micro")# 
+initialisiere picfile; 
+zeichne überschrift; 
+zeichne achsen; 
+zeichne sinuskurve; 
+wähle darstellung; 
+plot (p)  . 
+ 
+initialisiere picfile: 
+  PICFILE VAR p :: picture file ("SINUS")  . 
+ 
+zeichne überschrift: 
+  PICTURE VAR überschrift :: nilpicture; 
+  move (überschrift, -pi/2.0, 1.0); 
+  draw (überschrift, "sinus (x)  [-pi, +pi]", 0.0, 1.0, 0.6); 
+  put picture (p, überschrift)  . 
+ 
+ zeichne achsen: 
+  PICTURE VAR achsen :: nilpicture; 
+  zeichne x achse; 
+  zeichne y achse; 
+  put picture (p, achsen)  . 
+ 
+  zeichne x achse: 
+  move (achsen, -pi, 0.0); 
+  draw (achsen,  pi, 0.0)  . 
+ 
+  zeichne y achse: 
+  move (achsen, 0.0, -1.0); 
+  draw (achsen, 0.0, +1.0)  . 
+ 
+  zeichne sinuskurve: 
+  PICTURE VAR sinus :: nilpicture; 
+  REAL VAR x :: -pi; 
+ 
+   move (sinus, x, sin (x)); 
+  REP x INCR 0.1; 
+      draw (sinus, x, sin (x)) 
+  UNTIL x >= pi PER; 
+ 
+    put picture (p, sinus)  . 
+ 
+  wähle darstellung: 
+  window (p, -pi, pi, -1.0, 1.3); 
+  viewport (p, 0.0, 0.0, 0.0, 0.0)  . 
+ 
+#page# 
+#type ("times8")# 
+    #on("u")#Achsenkreuz#off("u")# 
+ 
+#type("micro")# 
+initialisiere picfile; 
+zeichne die x achse; 
+zeichne die y achse; 
+zeichne die z achse; 
+stelle das achsenkreuz dar  . 
+ 
+initialisiere picfile: 
+  PICFILE VAR p :: picture file ("KREUZ")  . 
+ 
+ zeichne die x achse: 
+  PICTURE VAR x achse := nilpicture; 
+  move (x achse, -1.0, 0.0, 0.0); 
+  draw (x achse, "-X", 0.0, 0.0, 0.0); 
+  draw (x achse,  1.0, 0.0, 0.0); 
+  draw (x achse, "+X", 0.0, 0.0, 0.0); 
+  put picture (p, x achse)  . 
+ 
+ zeichne die y achse: 
+  PICTURE VAR y achse := nilpicture; 
+  move (y achse, 0. 0, -1.0, 0.0); 
+  draw (y achse, "-Y", 0.0, 0.0, 0.0); 
+  draw (y achse, 0.0, 1.0, 0.0); 
+  draw (y achse, "+Y", 0.0, 0.0, 0.0); 
+  put picture (p, y achse)  . 
+ 
+ zeichne die z achse: 
+  PICTURE VAR z achse := nilpicture; 
+  move (z achse, 0. 0, 0.0, -1.0); 
+  draw (z achse, "-Z", 0.0, 0.0, 0.0); 
+  draw (z achse,  0.0, 0.0, 1.0); 
+  draw (z achse, "+Z", 0.0, 0.0, 0.0); 
+  put picture (p, z achse)  . 
+ 
+ stelle das achsenkreuz dar: 
+  viewport (p, 0. 0, 1.0, 0.0, 1.0); 
+  window (p, -1.1, 1.1, -1.1, 1.1); 
+  oblique (p, 0.25, 0.15); 
+  plot (p)  . 
+ 
+#foot# 
+  #type("times6")# 
+  Diese beiden Beispielprogramme befinden sich ebenfalls auf dem STD-Archive unter dem Namen #on("i")#Beispiel.Sinus#off("i")# und
+  #on("i")#Beispiel.Kreuz#off("i")#. 
+#end# 
+ 
+#page# 
+#type ("triumb14")# Beschreibung der Graphik-Prozeduren 
+#type ("times8")# 
+ 
+ 
+#type ("trium12")# 
+#on("b")#1. PICTURE-Prozeduren#off("b")# 
+#type ("times8")# 
+ 
+#limit (7.0)##type("times6")# 
+             #on("i")#Zweidimensionale PICTURES brauchen weniger Speicherplatz
+             als dreidimensionale. Daher werden in einigen Fehlermeldungen
+             unterschiedliche Größen angegeben. 
+ 
+#limit (11.0)##type("times8")# 
+ 
+#type("times10")##on("b")#:=#off("b")##type("times8")# 
+   OP := (PICTURE VAR l, PICTURE CONST r) 
+   Zweck:  Zuweisung 
+ 
+#type("times10")##on("b")#CAT#off("b")##type("times8")# 
+   OP CAT (PICTURE VAR l, PICTURE CONST r) 
+   Zweck:  Aneinanderfügen von zwei PICTURE. 
+   Fehlerfälle: 
+       * left dimension <> right dimension 
+         Es können nur PICTURE mit gleicher Dimension angefügt werden. 
+       * Picture overflow 
+         Die beiden PICTURE überschreiten die maximale Größe eines PICTURE. 
+ 
+#type("times10")##on("b")#nilpicture#off("b")##type("times8")# 
+   PICTURE PROC nilpicture 
+   Zweck:  Die Prozedur liefert ein leeres PICTURE zur Initialisierung. 
+ 
+   PICTURE PROC nilpicture (INT CONST pen) 
+   Zweck:  Die Prozedur liefert ein leeres PICTURE mit dem Stift #on("i")#pen#off("i")# zur Initialisierung. 
+ 
+#type("times10")##on("b")#draw#off("b")##type("times8")# 
+   PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, ­
+              width) 
+   Zweck:  Der angegebene Text wird unter dem Winkel #on("i")#angle#off("i")# gegenüber der Waagerech­
+           ten mit der Zeichenhöhe #on("i")#hight#off("i")# und der Breite #on("i")#width#off("i")# gezeichnet. #on("i")#angle#off("i")# wird in
+           Winkelgrad angegeben. #on("i")#height#off("i")# und #on("i")#width#off("i")# werden in #on("i")#Prozenten#off("i")# der Breite bzw.
+           Höhe der Zeichenfläche angegeben, bei 0 wird 
+           die Standardhöhe- und breite angenommen. 
+           Der Anfang ist dabei die aktuelle Stiftposition, die nicht verändert wird. Es könne
+           auch die Steuerzeichen ""1"", ""2"", ""3"", ""10"", ""13"" benutzt werden,
+           wobei sie immer in der Richtung #on("i")#angle#off("i")# wirken. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Der Text paßt nicht mehr in das PICTURE. 
+ 
+#type("times10")##on("b")#draw#off("b")##type("times8")# 
+   PROC draw (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck:  Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z). 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC draw (PICTURE VAR p, REAL CONST x, y) 
+   Zweck:  Zeichnen einer Linie von der aktuellen Position zur Position (x, y). 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+#type("times10")##on("b")#draw r#off("b")##type("times8")# 
+   PROC draw r (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck:  Zeichnen einer Linie der Länge (x, y, z) relativ zur aktuellen Position. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC draw r (PICTURE VAR p, REAL CONST x, y) 
+   Zweck:  Zeichnen einer Linie der Länge (x, y) relativ zur aktuellen Position. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+#type("times10")##on("b")#move#off("b")##type("times8")# 
+   PROC move (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck:  Die aktuelle Position wird auf (x, y, z) gesetzt. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC move (PICTURE VAR p, REAL CONST x, y) 
+   Zweck:  Die aktuelle Position wird auf (x, y) gesetzt. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+#type("times10")##on("b")#move r#off("b")##type("times8")# 
+   PROC move r (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck:  Die aktuelle Position wird um (x, y, z) erhöht. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC move r (PICTURE VAR p, REAL CONST x, y) 
+   Zweck:  Die aktuelle Position wird um (x, y) erhöht. 
+           Position. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+ 
+#type("times10")##on("b")#bar#off("b")##type("times8")# 
+   PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST pattern): 
+   Zweck:  Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem Muster
+              #on("i")#pattern#off("i")#: 
+              0  =  Leerer Balken 
+              1  =  Gepunkteter Balken 
+              2  =  Gefüllter Balken 
+              3  =  Horizontale Linien 
+              4  =  Vertikale Linien 
+              5  =  Gekreuzte Linien 
+              6  =  Diagonale Linien von Links nach Rechts 
+              7  =  Diagonale Linien von Rechts nach Links 
+              8  =  Gekreuzte diagonale Linien 
+            > 8  =  nicht normiertes Sondermuster 
+          Die aktuelle Stiftposition wird dabei nicht verändert. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+   PROC bar (PICTURE VAR p, REAL CONST from, to, hight, INT CONST pattern): 
+   Zweck:  Die Prozedur zeichnet einen Balken von der Position #on("i")#from#off("i")# zur Position #on("i")#to#off("i")# und der
+           Höhe #on("i")#height#off("i")# mit dem Muster #on("i")#pattern#off("i")#. 
+           s.o. 
+ 
+#type("times10")##on("b")#circle#off("b")##type("times8")# 
+   PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern) 
+   Zweck:  Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom Winkel
+           #on("i")#from#off("i")# bis #on("i")#to#off("i")# (im Gradmaß) mit dem Muster #on("i")#pattern#off("i")# (s.o.). Der #on("i")#radius#off("i")# wird in
+           Prozenten der Diagonalen der Zeichenfläche angegeben. 
+           Die aktuelle Stiftposition wird dabei nicht verändert. Dieses Kreissegment ist in
+           jedem Fall 2-dimensional, so das es durch Drehungen nicht verändert wird. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+#type("times10")##on("b")#mark#off("b")##type("times8")# 
+   PROC mark (PICTURE VAR p, REAL CONST size, INT CONST no) 
+   Zweck:  Es wird ein Marker mit der Größe #on("i")#size#off("i")# in Prozenten der Diagonalen der Zeichen­
+           fläche an der aktuellen Stiftposition ausgegeben, ohne diese zu verändern. Es
+           sollten dabei mindestens 10 verschiedene Marker gewählt werden können. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+ 
+#type("times10")##on("b")#dim#off("b")##type("times8")# 
+   INT PROC dim (PICTURE CONST pic) 
+   Zweck:  Liefert die Dimension eines PICTURE. 
+ 
+#type("times10")##on("b")#pen#off("b")##type("times8")# 
+   INT PROC pen (PICTURE CONST p) 
+   Zweck:  Liefert den virtuellen Stift des PICTURE 
+ 
+   PICTURE PROC pen (PICTURE CONST p, INT CONST pen) 
+   Zweck:  Setzen des (virtuellen) Stiftes eines PICTURE. 
+           Bei #on("i")#pen#off("i")# = 0 wird das Picture nicht gezeichnet. 
+   Fehlerfälle: 
+       * pen out of range 
+         Der gewünschte Stift ist kleiner als 0 oder größer als 16. 
+ 
+#type("times10")##on("b")#extrema#off("b")##type("times8")# 
+   PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max) 
+   Zweck:  Die Prozedur liefert die größten und kleinsten Werte des PICTURE. 
+   Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+   PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max,  
+   z min, z max) 
+   Zweck:  Die Prozedur liefert die größten und kleinsten Werte des PICTURE. 
+   Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+#type("times10")##on("b")#where#off("b")##type("times8")# 
+   PROC where (PICTURE CONST p, REAL VAR x, y, z) 
+   Zweck:  Die Prozedur liefert die aktuelle Stiftposition. 
+   Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+   PROC where (PICTURE CONST p, REAL VAR x, y, z) 
+   Zweck:  Die Prozedur liefert die aktuelle Stiftposition. Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+#type("times10")##on("b")#rotate#off("b")##type("times8")# 
+   PROC rotate (PICTURE VAR p, REAL CONST angle) 
+   Zweck:  Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("i")#angle#off("i")# (im Gradmaß) im
+           mathematisch positiven Sinn gedreht. 
+ 
+   PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda) 
+   Zweck:  Das PICTURE wird um den Winkel #on("i")#lambda#off("i")# um die Drehachse #on("i")#(phi, theta)#off("i")# ge­
+           dreht. 
+ 
+#type("times10")##on("b")#stretch#off("b")##type("times8")# 
+   PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) 
+   Zweck:  Das PICTURE wird in X-Richtung um den Faktor #on("i")#sx#off("i")#, in Y-Richtung um den
+           Faktor #on("i")#sy#off("i")# gestreckt (bzw. gestaucht). Dabei bewirkt der Faktor 
+                 s   >  1    eine Streckung 
+           0  <  s   <  1    eine Stauchung 
+                 s   <  0    zusätzlich eine Achsenspiegelung. 
+   Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+   PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) 
+   Zweck:  s. o. 
+   Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+#type("times10")##on("b")#translate#off("b")##type("times8")# 
+   PROC translate (PICTURE VAR p, REAL CONST dx, dy) 
+   Zweck:  Das PICTURE wird um #on("i")#dx#off("i")# und #on("i")#dy#off("i")# verschoben. Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+   PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) 
+   Zweck:  Das PICTURE wird um #on("i")#dx, dy#off("i")# und #on("i")#dz#off("i")# verschoben. Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+ 
+#type ("trium12")# 
+#on("b")#2. PICFILE-Prozeduren#off("b")# 
+#type ("times8")# 
+ 
+#type("times10")##on("b")#plot#off("b")##type("times8")# 
+   PROC plot (TEXT CONST name) 
+   Zweck:  Der PICFILE mit dem Namen #on("i")#name#off("i")# wird entsprechend der angegebenen Dar­
+           stellungsart gezeichnet. Diese Parameter (#on("i")#perspective, orthographic, oblique, view,
+           window etc.#off("i")#) müssen vorher eingestellt werden. 
+   Fehlerfälle: 
+       * PICFILE does not exist 
+         Es existiert kein PICFILE mit dem Namen #on("i")#name#off("i")# 
+ 
+   PROC plot (PICFILE VAR p) 
+   Zweck:  Der PICFILE #on("i")#p#off("i")# wird entsprechend der angegebenen Darstellungsart gezeichnet.
+           Diese Parameter müssen vorher eingestellt werden: 
+ 
+           #on("b")#zweidimensional:#off("b")# 
+           obligat:        #on("i")#window#off("i")#            (zweidimensional) 
+           optional:       #on("i")#view#off("i")#              (zweidimensional) 
+                           #on("i")#viewport#off("i")# 
+                           #on("i")#select pen#off("i")# 
+ 
+           #on("b")#dreidimensional:#off("b")# 
+           obligat:        #on("i")#window#off("i")#            (dreidimensional) 
+           optional:       #on("i")#view#off("i")#              (dreidimensional) 
+                           #on("i")#orthographic | perspective | oblique#off("i")# 
+                           #on("i")#viewport#off("i")# 
+                           #on("i")#select pen#off("i")# 
+ 
+ 
+#type("times10")##on("b")#select pen#off("b")##type("times8")# 
+   PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type) 
+   Zweck:  Für die Darstellung des Bildes #on("i")#p#off("i")# soll dem #on("i")#virtuellen#off("i")# Stift #on("i")#pen#off("i")# ein realer Stift
+           zugeordnet werden, der möglichst die Farbe #on("i")#colour#off("i")# und die Dicke #on("i")#thickness#off("i")# hat
+           und dabei Linien mit dem Typ #on("i")#line type#off("i")# zeichnet. Es wird die beste Annäherung
+           für das Ausgabegerät genommen. 
+           Dabei gelten folgende Vereinbarungen: 
+ 
+           #on("b")#Farbe:#off("b")# Negative Farben werden XOR gezeichnet (dunkel wird hell und hell wird
+                  dunkel), Farbe 0 ist der Löschstift und positive Farben überschreiben
+                  (ersetzen) den alten Punkt mit folgenden Werten: 
+ 
+                  1      Standardfarbe des Endgerätes 
+                  2      rot 
+                  3      blau 
+                  4      grün 
+                  5      schwarz 
+                  6      weiß 
+                  >  6    nicht normierte Sonderfarben 
+ 
+ 
+           #on("b")#Dicke:#off("b")#  0   Standardstrichstärke des Endgerätes 
+                  > 0   Strichstärke in 1/10 mm. 
+ 
+ 
+           #on("b")#Linientyp:#off("b")# 
+                  0      keine sichtbare Linie 
+                  1      durchgängige Linie 
+                  2      gepunktete Linie 
+                  3      kurz gestrichelte Linie 
+                  4      lang gestrichelte Linie 
+                  5      Strichpunktlinie 
+                  > 5    nicht normierte Linie 
+ 
+ 
+           Die hier aufgeführten Möglichkeiten müssen nicht an allen graphischen Endge­
+           räten vorhanden sein. Der geräteabhängige Graphik-Treiber wählt jeweils die
+           bestmögliche Annäherung. 
+ 
+   Fehlerfälle: 
+       * pen out of range 
+         #on("i")#pen#off("i")# muss im Bereich 1-16 sein. 
+ 
+#type("times10")##on("b")#background#off("b")##type("times8")# 
+   PROC background (PICFILE VAR p, INT CONST colour) 
+   Zweck:  Der Hintergrund wird auf die Farbe #on("i")#colour#off("i")# (s.o.) gesetzt wenn möglich. 
+           Bei der Angabe #on("i")#background (p, 0)#off("i")# wird das Löschen des Bildschirms unterdrückt,
+           so daß das Zeichen mehrerer PICFILE auf einem Blatt möglich wird. 
+ 
+   INT PROC background (PICFILE CONST p): 
+   Zweck:  Liefert die eingestellte Hintergrundfarbe. 
+ 
+#type("times10")##on("b")#view#off("b")##type("times8")# 
+   PROC view (PICFILE VAR p, REAL CONST alpha) 
+   Zweck:  Setzt den Winkel der Y-Achse zur Senkrechten auf #on("i")#alpha#off("i")# Grad, falls diese nicht
+           senkrecht auf der Betrachtungsebene steht. 
+ 
+   PROC view (PICFILE VAR p, REAL CONST phi, theta) 
+   Zweck:  Dreidimensionale Bilder werden häufig nicht direkt von vorne dargestellt, son­
+           dern für die Betrachtung gedreht. Mit der Prozedur #on("i")#view#off("i")# kann die Betrachtungs­
+           richtung durch die Polarwinkel #on("i")#phi#off("i")# und #on("i")#theta#off("i")# (im Gradmass) angegeben werden.
+           Voreingestellt ist #on("i")#phi#off("i")# = 0 und #on("i")#theta#off("i")# = 0, d.h. senkrecht von oben (Die #on("i")#X-
+           Achse#off("i")# bildet die Horizontale und die #on("i")#Y-Achse#off("i")# bildet die Vertikale). 
+           Im Gegensatz zu #on("i")#rotate#off("i")# hat #on("i")#view#off("i")# keine Wirkung auf das eigentliche Bild (die
+           PICTURE werden nicht verändert), sondern nur auf die gewählte Darstellung. So
+           addieren sich zwar aufeinanderfolgende #on("i")#Rotationen#off("i")#, #on("i")#view#off("i")# aber geht immer von der
+           Nullstellung aus. Auch kann das Bild durch eine #on("i")#Rotation#off("i")# ganz oder teilweise aus
+           oder in das Darstellungsfenster (#on("i")#window#off("i")# gedreht werden. Bei #on("i")#view#off("i")# verändern sich
+           die Koordinaten der Punkte nicht, d. h. das Fenster wird mitgedreht. 
+ 
+   PROC view (PICFILE VAR p, REAL CONST x, y, z) 
+   Zweck:  Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben, sondern
+           es wird die Blickrichtung als Vektor in Karthesischen Koordinaten angegeben.
+           (Der Betrachtungsvektor muß nicht normiert sein). 
+ 
+#type("times10")##on("b")#viewport#off("b")##type("times8")# 
+   PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin, vertmax) 
+   Zweck:  Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt werden soll,
+           wird spezifiziert. Dabei wird sowohl die Größe als auch die relative Lage der
+           Zeichenfläche definiert. Der linke untere Eckpunkt der physikalischen Zeichen­
+           fläche des Gerätes hat die Koordinaten (0, 0). Die definierte Zeichenfläche er­
+           streckt sich 
+ 
+                  #on("i")#hormin   -  hormax#off("i")#        in der Horizontalen, 
+                  #on("i")#vertmin  -  vertmax#off("i")#       in der Vertikalen. 
+ 
+           So liegt der linke untere Eckpunkt dann bei (#on("i")#hormin, hormax#off("i")#), der rechte obere
+           Eckpunkt bei (#on("i")#hormax, vertmax#off("i")#). 
+ 
+           Damit sowohl geräteunabhängige als auch maßstabgetreue Zeichnungen möglich
+           sind, können die Koordinaten in drei Arten spezifiziert werden: 
+           a)  #on("b")#Gerätekoordinaten#off("b")# 
+               Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei hat die
+               kürzere Seite der physikalischen Zeichenfläche definitionsgemäß die Länge
+               1.0. 
+           b)  #on("b")#Absolute Koordinaten#off("b")# 
+               Die Werte werden in #on("i")#cm#off("i")# angegeben. Dabei müssen die Maximalwerte aber
+               größer als 2.0 sein, da sonst Fall a) angenommen wird. 
+           c)  #on("b")#Maximale Zeichenfläche#off("b")# Bei der Angabe (0.0, 0.0, 0.0, 0.0) wird die maxi­
+               male physikalische Zeichenfläche eingestellt. 
+ 
+           Voreingestellt ist 
+                  viewport (0.0, 0.0, 0.0, 0.0) 
+           d.h. die größtmögliche physikalische Zeichenfläche, beginnend mit der linken
+                unteren Ecke. 
+           Der Abbildungsmaßstab wird durch das Zusammenspiel von #on("i")#viewport#off("i")# und
+           #on("i")#window#off("i")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, daß winkel­
+           treue Darstellung nur bei gleichen Verhältnissen von X-Bereich und Breite bzw.
+           von Y-Bereich und Höhe möglich ist. 
+ 
+ 
+#type("times10")##on("b")#window#off("b")##type("times8")# 
+   PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) 
+   Zweck:  Für die Darstellung eines zweidimensionalen Bildes wird das darzustellende
+           Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("i")#x min, x
+           max#off("i")#] und deren Y-Koordinaten im Bereich [#on("i")#y min, y max#off("i")#] liegen, gehören zum
+           definierten Fenster.Vektoren, die außerhalb dieses Fensters liegen, gehen über die
+           durch #on("i")#viewport#off("i")# Fläche hinaus und werden abgeschnitten. 
+ 
+           Der Darstellungsmaßstab ergibt sich als 
+ 
+           #ub#               x max - x min               #ue# 
+            horizontale Seitenlänge der Zeichenfläche 
+ 
+ 
+           #ub#               y max - y min               #ue# 
+             vertikale Seitenlänge der Zeichenfläche 
+ 
+   PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max,  
+                                                        z min, z max) 
+ 
+   Zweck:  Für die darstellung eines dreidimensionalen Bildes wird das darzustellende Fenster
+           definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("i")#x min, x max#off("i")#],
+           deren Y-Koordinaten im Bereich [#on("i")#y min, y max#off("i")#] und deren Z-Koordinaten im
+           Bereich [#on("i")#z min, z max#off("i")#] liegen, gehören zum definierten Fenster. Dieses dreidi­
+           mensionale Fenster (#on("i")#Quader#off("i")#) wird entsprechend der eingestellten Projektionsart
+           (orthographisch, perspektivisch oder schiefwinklig) und den Betrachtungswinkeln
+           (s. #on("i")#view#off("i")#) auf die spezifizierte Zeichenfläche abgebildet. 
+           Anders als im zweidimensionalen Fall ist das Problem der Maßstaäbe nicht mehr
+           nur durch das Zusammenspiel von #on("i")#window#off("i")# und #on("i")#viewport#off("i")# zu beschreiben. Hier
+           spielen auch die Projektionsart und Darstellungswinkel herein. 
+ 
+#type("times10")##on("b")#oblique#off("b")##type("times8")# 
+   PROC oblique (PICFILE VAR p, REAL CONST a, b) 
+   Zweck:  Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#schiefwinklig#off("u")# als gewünschte Projek­
+           tionsart eingestellt. Dabei ist (#on("i")#a, b#off("i")#) der Punkt auf der X-Y-Ebene, auf den der
+           EinheitsVektor der Z-Richtung abgebildet werden soll. 
+ 
+#type("times10")##on("b")#orthographic#off("b")##type("times8")# 
+   PROC orthographic (PICFILE VAR p) 
+   Zweck:  Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#orthographisch#off("u")# als gewünschte Projek­
+           tionsart eingestellt. Bei der orthographischen Projektion wird ein dreidimensio­
+           naler Körper mit parallelen Strahlen senkrecht auf der Projektionsebene abge­
+           bildet. 
+ 
+#type("times10")##on("b")#perpective#off("b")##type("times8")# 
+   PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) 
+   Zweck:  Bei dem (dreidimensionalen) Bild #on("i")#p#off("i")# wird #on("u")#perspektivisch#off("u")# als gewünschte Projek­
+           tionsart eingestellt. Der Punkt (#on("i")#cx, 1/cy, cz#off("i")#) ist der Fluchtpunkt der Projektion,
+           d. h. alle Parallen zur Z-Achse schneiden sich in diesem Punkt. 
+ 
+#type("times10")##on("b")#extrema#off("b")##type("times8")# 
+   PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) 
+   Zweck:  Die Prozedur liefert die größten und kleinsten Werte des PICFILE. 
+ 
+   PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) 
+   Zweck:  Die Prozedur liefert die größten und kleinsten Werte des PICFILE. 
+ 
+#type ("trium12")# 
+#on("b")#3. Prozeduren zur Manipulation von PICFILE#off("b")# 
+#type("times 8")# 
+ 
+#type("times10")##on("b")#:=#off("b")##type("times8")# 
+   OP := (PICFILE VAR l, PICFILE CONST r) 
+   Zweck:  Zuweisung des PIFILEs #on("i")#r#off("i")# an das PICFILE #on("i")#l#off("i")# 
+ 
+   OP := (PICFILE VAR p, DATASPACE CONST d) 
+   Zweck:  Assoziert die PICFILE Variable #on("i")#p#off("i")# mit dem Datenraum #on("i")#d#off("i")# und initialisiert die
+           Variable, wenn nötig. 
+   Fehlerfälle: 
+       * dataspace is no PICFILE 
+         Der anzukoppelnde Datenraum hat einen unzulässigen Typ 
+ 
+#type("times10")##on("b")#picture file#off("b")##type("times8")# 
+   DATASPACE PROC picture file (TEXT CONST name) 
+   Zweck:  Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.). 
+ 
+#type("times10")##on("b")#to pic#off("b")##type("times8")# 
+   PROC to pic (PICFILE VAR p, INT CONST pos) 
+   Zweck:  Positioniert auf das PICTURE Nummer #on("i")#pos#off("i")#. 
+   Fehlerfälle: 
+       *  Position underflow 
+          Es wurde eine Position kleiner Null angegeben. 
+       *  Position after eof 
+          Es wurde versucht, hinter das Ende eines PICFILE zu positionieren. Die letzte
+          erlaubte Position ist #on("i")#pictures (p)+1#off("i")#. 
+ 
+#type("times10")##on("b")#up#off("b")##type("times8")# 
+   PROC up (PICFILE VAR p) 
+   Zweck:  Positioniert genau ein PICTURE zurück. 
+   Fehlerfall: 
+       *  Position underflow 
+          Es wurde versucht, vor das erste PICTURE zu positionieren 
+ 
+   PROC up (PICFILE VAR p, INT CONST n) 
+   Zweck:  Positioniert genau #on("i")#n#off("i")# Picture zurück. 
+   Fehlerfall: 
+       *  Position underflow 
+          Es wurde versucht, vor das erste PICTURE zu positionieren 
+ 
+#type("times10")##on("b")#down#off("b")##type("times8")# 
+   PROC down (PICFILE VAR p) 
+   Zweck:  Positioniert genau ein PICTURE vorwärts. 
+   Fehlerfall: 
+       *  Position after eof 
+          Es wurde versucht, hinter das Ende eines PICFILE zu positionieren. Die letzte
+          erlaubte Position ist #on("i")#pictures (p)+1#off("i")#. 
+ 
+   PROC down (PICFILE VAR p, INT CONST n) 
+   Zweck:  Positioniert genau #on("i")#n#off("i")# Picture vorwärts. 
+   Fehlerfall: 
+       *  Position after eof 
+          Es wurde versucht, hinter das Ende eines PICFILE zu positionieren Die letzte
+          erlaubte Position ist #on("i")#pictures (p)+1#off("i")#. 
+ 
+#type("times10")##on("b")#delete picture#off("b")##type("times8")# 
+   PROC delete picture (PICFILE VAR p) 
+   Zweck:  Löscht das aktuelle PICTURE 
+ 
+#type("times10")##on("b")#insert picture#off("b")##type("times8")# 
+   PROC insert picture (PICFILE VAR p) 
+   Zweck:  Fügt ein PICTURE #on("u")#vor#off("u")# der aktuellen Position ein. 
+ 
+#type("times10")##on("b")#read picture#off("b")##type("times8")# 
+   PROC read picture (PICFILE CONST p, PICTURE VAR pic) 
+   Zweck:  Liest das aktuelle PICTURE. 
+ 
+#type("times10")##on("b")#write picture#off("b")##type("times8")# 
+   PROC write picture (PICFILE VAR p, PICTURE CONST pic) 
+   Zweck:  Schreibt das PICTURE #on("i")#pic#off("i")# auf der aktuellen Position. 
+ 
+#type("times10")##on("b")#put picture#off("b")##type("times8")# 
+   PROC put picture (PICFILE VAR p, PICTURE CONST pic) 
+   Zweck:  Schreibt das PICTURE #on("i")#pic#off("i")# an die aktuelle Position und erhöht diese um 1. 
+ 
+#type("times10")##on("b")#get picture#off("b")##type("times8")# 
+   PROC get picture (PICFILE VAR p, PICTURE VAR pic) 
+   Zweck:  Liest das PICTURE #on("i")#pic#off("i")# an dir aktuellen Position und erhöht diese um 1. 
+ 
+#type("times10")##on("b")#eof#off("b")##type("times8")# 
+   BOOL PROC eof (PICFILE CONST p) 
+   Zweck:  Liefert genau dann #on("i")#TRUE#off("i")#, wenn das Ende eines PICFILE erreicht ist. 
+ 
+#type("times10")##on("b")#picture no#off("b")##type("times8")# 
+   INT PROC picture no (PICFILE CONST p) 
+   Zweck:  Liefert die Nummer des aktuellen PICTURE. 
+ 
+#type("times10")##on("b")#pictures#off("b")##type("times8")# 
+   INT PROC pictures (PICFILE CONST p) 
+    Zweck:  Liefert die Anzahl PICTURE eines PICFILE. 
+ 
+ 
+#page# 
+#type ("trium12")# 
+#on("b")#4. Auslieferungsumfang#off("b")# 
+#type ("times8")# 
+ 
+   Die EUMEL-GRAPHIK wird auf einer Diskette mit folgendem Inhalt ausgeliefert. 
+   Archive #on("i")#Graphik#off("i")#: 
+ 
+       "gen Graphik" 
+       "gen Plotter" 
+       "GRAPHIK.book" 
+       "GRAPHIK.Picfile" 
+       "GRAPHIK.Transform" 
+       "GRAPHIK.Plot" 
+       "GRAPHIK.Plotter" 
+       "GRAPHIK.Server" 
+       "GRAPHIK.vektor plot" 
+       "ZEICHENSATZ" 
+       "PC.plot" 
+       "HP7475.plot" 
+       "Beispiel.Kreuz" 
+       "Beispiel.Sinus" 
+ 
+ 
+ 
+    #on("u")#Dateiinhalte#off("u")# 
+ 
+    1. "gen Graphik"           Installationsprogramm für Terminals 
+    2. "gen Plotter"           Installationsprogramm für Plotter 
+    3. "GRAPHIK.book"          enthält diese Beschreibung. 
+    4. "GRAPHIK.Picfile"       enthält die Pakete #on("i")#picture#off("i")# und #on("i")#picfile#off("i")#. 
+    5. "GRAPHIK.Transform"     stellt das Paket #on("i")#transformation#off("i")# zur Verfügung, in dem
+                               interne Prozeduren zur Projektion definiert werden. 
+    6. "GRAPHIK.Plot"          definiert die Prozedur #on("i")#plot#off("i")# zur Darstellung eines
+                               PICFILES auf dem Terminal 
+    7. "GRAPHIK.Plotter"       definiert die Prozedur #on("i")#plotter#off("i")# zur Darstellung eines
+                               PICFILES auf dem Plotter 
+    8. "GRAPHIK.Server"        Server für einen Plotter-Spool 
+    9. "GRAPHIK.vektor plot"   enthält Hilfsprogramme, die bei der Erstellung einer
+                               eigenen Terminalanpassung benutzt werden können. 
+   10. "ZEICHENSATZ"           enthält einen Zeichensatz für Terminals die im Graphik
+                               Modus keinen Text ausgeben können. 
+   11. "PC.plot"               Terminalanpassung für IBM-PC und ähnliche. 
+   12. "HP7475.plot"           Terminalanpassung für HP7474-Plotter und Geräte mit
+                               HP-GL. 
+   13. "Beispiel.Kreuz"        Beispielprogramm 
+   14. "Beispiel.Sinus"        Beispielprogramm 
+ 
+#type ("trium12")# 
+#on("b")#5. Installation#off("b")# 
+#type ("times8")# 
+ 
+ 
+    In der Datei #on("i")#gen Graphik#off("i")# ist ein Installationspragramm enthalten. Nach dem Starten des
+    Programms mit #on("i")#run ("gen Graphik")#off("i")# fragt es nach dem Dateinamen der Terminalanpas­
+    sung. 
+    Steht keine Terminalanpassung für ein Endgerät zur Verfügung (und kann auch nicht
+    beschafft werden) so kann man durch Insertieren der Datei #on("i")#GRAPHIK.Picfile#off("i")# lediglich die
+    Leistungen der Pakete #on("i")#Picture#off("i")# und #on("i")#Picfile#off("i")# nutzen, ohne die erzeugten Graphiken darstellen
+    zu können. 
+    Zur Benutzung eines #on("i")#Plotters#off("i")# über einen Spooler wird die Datei #on("i")#gen Plotter#off("i")# gestartet. 
+ 
+ 
+    Beispiel: 
+    1.  archive ("Graphik") 
+    2.  fetch all (archive) 
+    3.  release (archive) 
+    4.  run ("gen Graphik") 
+            <--     PC.Plot 
+ 
+ 
+#type ("trium12")# 
+#on("b")#6. Besonderheiten der PC.plot-Anpassung#off("b")# 
+#type ("times8")# 
+ 
+ 
+  Da der IBM-PC verschiedene Graphik- und Text-Modi kennt, wird durch das Pro­
+  gramm #on("i")#PC.plot#off("i")# die Prozedur #on("i")#graphik#off("i")# zusätzlich zur Verfügung gestellt. Sie erlaubt es den
+  PC in verschiedenen Graphik-Modi zu betreiben. 
+ 
+  PROC graphik (INT CONST modus, pause) 
+ 
+  Modus:  0    ---    Keine Graphik (normaler Textmodus) 
+          1    ---    hochauflösende Graphik, 50 Zeilen, 
+                      640 * 400 Punkte, einfarbig 
+          2    ---    hochauflösende Graphik, 25 Zeilen, 
+                      640 * 400 Punkte, einfarbig 
+          3    ---    mittlere Auflösung, 640 * 200 Punkte, 3 Farben 
+          4    ---    IBM-PC Auflösung, 320 * 200 Punkte, 3 Farben. 
+ 
+  Pause:  Da der PC bei #on("i")#end plot#off("i")# wieder in den Normalmodus umschaltet und die Graphik
+          dann nicht mehr zu sehen ist, kann man eine #on("i")#pause#off("i")# angeben. Die hier eingestellte
+          Zeit ist aber nicht die Länge der Pause, sondern der Kehrwert der Blinkfrequenz
+          proportional. 
+ 
+
diff --git a/system/std.graphik/1.8.7/doc/graphik beschreibung b/system/std.graphik/1.8.7/doc/graphik beschreibung
new file mode 100644
index 0000000..53ebe49
--- /dev/null
+++ b/system/std.graphik/1.8.7/doc/graphik beschreibung
@@ -0,0 +1,661 @@
+#type ("basker12")##limit (16.0)##block# 
+ 
+#head# 
+#type ("triumb18")# 
+#center#EUMEL-Grafik-System 
+#type ("basker12")# 
+#end# 
+                                               #on("italics")#gescheit, gescheiter, 
+                                               gescheitert#off("italics")# 
+ 
+#type ("basker14")# 
+#on("bold")#Beschreibung der Graphik-Prozeduren#off("bold")# 
+#type ("basker12")# 
+ 
+      #on("italics")#Zweidimensionale PICTURE brauchen weniger Speicherplatz als dreidimen­
+      sionale. Daher werden in einigen Fehlermeldungen unterschiedliche Größen
+      angegeben.#off("italics")# 
+ 
+#on("underline")#Picture-Prozeduren#off("underline")# 
+PICTURE 
+ 
+ 
+:= 
+   OP := (PICTURE VAR l, PICTURE CONST r) 
+   Zweck: Zuweisung 
+ 
+CAT 
+   OP CAT (PICTURE VAR l, PICTURE CONST r) 
+   Zweck: Aneinanderfügen von zwei PICTURE. 
+   Fehlerfälle: 
+       * left dimension <> right dimension 
+         Es können nur PICTURE mit gleicher Dimension angefügt werden. 
+       * Picture overflow 
+         Die beiden PICTURE überschreiten die maximale Größe eines
+         PICTURE. 
+ 
+nilpicture 
+   PICTURE PROC nilpicture 
+   Zweck: Die Prozedur liefert ein leeres PICTURE zur Initialisierung. 
+ 
+draw 
+   PROC draw (PICTURE VAR p, TEXT CONST text) 
+   Zweck: Der angegebene Text wird gezeichnet. Der Anfang ist dabei die aktuelle
+          Stiftposition, die nicht verändert wird. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Der Text paßt nicht mehr in das PICTURE. 
+ 
+  PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle,
+  height, bright) 
+   Zweck: Der angegebene Text wird unter dem Winkel #on("italics")#angle#off("italics")# gegenüber der
+          Waagerechten mit der Zeichenhöhe #on("italics")#hight#off("italics")# und der Breite #on("italics")#bright#off("italics")# gezeich­
+          net. Der Anfang ist dabei die aktuelle Stiftposition, die nicht verändert
+          wird. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Der Text paßt nicht mehr in das PICTURE. 
+ 
+   PROC draw (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z). 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC draw (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y). 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+draw r PROC draw r (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck: Zeichnen einer Linie der Länge (x, y, z) relativ zur aktuellen Position. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC draw r (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Zeichnen einer Linie der Länge (x, y) relativ zur aktuellen Position. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+draw cm 
+  PROC draw cm (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y) cm.
+          Dabei werden die angegebenen Projektionsparameter nicht beachtet,
+          sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+ 
+draw cm r 
+   PROC draw cm r (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Zeichnen einer Linie der Länge (x, y) cm relativ zur aktuellen Position.
+          Dabei werden die angegebenen Projektionsparameter nicht beachtet,
+          sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+ 
+move 
+   PROC move (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck: Die aktuelle Position wird auf (x, y, z) gesetzt. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC move (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Die aktuelle Position wird auf (x, y) gesetzt. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+move r 
+   PROC move r (PICTURE VAR p, REAL CONST x, y, z) 
+   Zweck: Die aktuelle Position wird um (x, y, z) erhöht. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is two dimensional 
+ 
+   PROC move r (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Die aktuelle Position wird um (x, y) erhöht. 
+          Position. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+ 
+move cm 
+  PROC move cm (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Die aktuelle Position wird auf (x, y) cm gesetzt. Dabei werden die an­
+          gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")#
+          Zentimeter#off("bold")# berechnet. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+ 
+move cm r 
+   PROC move cm r (PICTURE VAR p, REAL CONST x, y) 
+   Zweck: Die aktuelle Position wird um (x, y) cm erhöht. Dabei werden die an­
+          gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")#
+          Zentimeter#off("bold")# berechnet. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+ 
+bar 
+   PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST
+   pattern): 
+   Zweck: Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem
+              Muster #on("italics")#pattern#off("italics")#: 0  =  Leerer Balken 
+              1  =  Gepunkteter Balken 
+              2  =  Gefüllter Balken 
+              3  =  Horizontale Linien 
+              4  =  Vertikale Linien 
+              5  =  Gekreuzte Linien 
+              6  =  Diagonale Linien von Links nach Rechts 
+              7  =  Diagonale Linien von Rechts nach Links 
+              8  =  Gekreuzte diagonale Linien. 
+          Die aktuelle Stiftposition wird dabei nicht verändert. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+       * Unknown pattern 
+         Das angegebene Muster liegt nicht im Bereich 0-8 
+ 
+circle 
+   PROC circle (PICTURE VAR p, REAL CONST from, to, INT CONST
+   pattern) 
+   Zweck: Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom
+          Winkel #on("italics")#from#off("italics")# bis #on("italics")#to#off("italics")# (im Gradmaß) mit dem Muster #on("italics")#pattern#off("italics")# (s.o.). Die
+          aktuelle Stiftposition wird dabei nicht verändert. 
+   Fehlerfälle: 
+       * Picture overflow 
+         Zu viele Befehle in einem PICTURE 
+       * Picture is three dimensional 
+       * Unknown pattern 
+         Das angegebene Muster liegt nicht im Bereich 0-8 
+ 
+dim 
+   INT PROC dim (PICTURE CONST pic) 
+   Zweck: Liefert die Dimension eines PICTURE. 
+ 
+pen 
+   INT PROC pen (PICTURE CONST p) 
+   Zweck: Liefert den virtuellen Stift des PICTURE 
+ 
+   PROC pen (PICTURE VAR p, INT CONST pen) 
+   Zweck: Setzen des (virtuellen) Stiftes eines PICTURE. Bei pen=0 wird das
+          Picture nicht gezeichnet. 
+   Fehlerfälle: 
+       * pen out of range 
+         Der gewünschte Stift ist kleiner als 0 oder größer als 16. 
+ 
+extrema 
+   PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y
+   max) 
+   Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. 
+   Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+   PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y
+                                           max, z min, z max) 
+   Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICTURE. 
+   Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+where 
+   PROC where (PICTURE CONST p, REAL VAR x, y, z) 
+   Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden
+          dabei nicht berücksichtigt). 
+   Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+   PROC where (PICTURE CONST p, REAL VAR x, y, z) 
+   Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden
+          dabei nicht berücksichtigt). 
+   Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+rotate: 
+   PROC rotate (PICTURE VAR p, REAL CONST angle) 
+   Zweck: Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("italics")#angle#off("italics")# (im
+          Gradmaß) im mathematisch positiven Sinn gedreht. 
+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+          verändert. 
+ 
+   PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda ) :
+   PICTURE 1-397 
+   Zweck: Das PICTURE wird um den Winkel #on("italics")#lambda#off("italics")# um die Drehachse #on("italics")#(phi,
+          theta)#off("italics")# gedreht. 
+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+          verändert. 
+ 
+stretch 
+   PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) 
+   Zweck: Das PICTURE wird in X-Richtung um den Faktor #on("italics")#sx#off("italics")#, in Y-Rich­
+          tung um den Faktor #on("italics")#sy#off("italics")# gestreckt (bzw. gestaucht). Dabei bewirkt der
+          Faktor 
+              s > 1    eine Streckung 
+          0 < s < 1    eine Stauchung 
+              s < 0    zusätzlich eine Achsenspiegelung. 
+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+          verändert. 
+   Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+   PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) 
+   Zweck: s. o. 
+   Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+translate 
+   PROC translate (PICTURE VAR p, REAL CONST dx, dy) 
+   Zweck: Das PICTURE wird um #on("italics")#dx#off("italics")# und #on("italics")#dy#off("italics")# verschoben. 
+          Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")#
+          verändert. 
+   Fehlerfälle: 
+       * Picture is three dimensional 
+ 
+   PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) 
+   Zweck: s. o. 
+   Fehlerfälle: 
+       * Picture is two dimensional 
+ 
+plot PROC plot (PICTURE CONST p) 
+   Zweck: Das Picfile wird gezeichnet. 
+          Achtung: Es wird kein #on("italics")#begin plot#off("italics")# oder #on("italics")#end plot#off("italics")# durchgeführt. Es wird
+                   auch kein Stift gsetzt und die Projektionsparameter bleiben
+                   unverändert. 
+ 
+ 
+#on("underline")#Graphische PICFILE-Prozeduren#off("underline")# 
+plot 
+  PROC plot (TEXT CONST name) 
+  Zweck: Der PICFILE mit dem Namen #on("italics")#name#off("italics")# wird entsprechend der angegebenen
+         Darstellungsart gezeichnet. Diese Parameter (#on("italics")#perspective, orthographic,
+         oblique, view, window etc.#off("italics")#) müssen vorher eingestellt werden. 
+  Fehlerfälle: 
+      * PICFILE does not exist 
+        Es existiert kein PICFILE mit dem Namen #on("italics")#name#off("underline")# 
+ 
+  PROC plot (PICFILE VAR p) 
+  Zweck: Der PICFILE #on("italics")#p#off("italics")# wird entsprechend der angegebenen Darstellungsart ge­
+         zeichnet. Diese Parameter müssen vorher eingestellt werden: 
+ 
+         #on("bold")#zweidimensional:#off("bold")# 
+         obligat:        #on("italics")#window#off("italics")#            (zweidimensional) 
+         optional:       #on("italics")#view#off("italics")#              (zweidimensional) 
+                         #on("italics")#viewport#off("italics")# 
+                         #on("italics")#select pen#off("italics")# 
+ 
+         #on("bold")#dreidimensional:#off("bold")# 
+         obligat:        #on("italics")#window#off("italics")#            (dreidimensional) 
+         optional:       #on("italics")#view#off("italics")#              (dreidimensional) 
+                         #on("italics")#orthographic | perspective | oblique#off("italics")# 
+                         #on("italics")#viewport#off("italics")# 
+                         #on("italics")#select pen#off("italics")# 
+ 
+ 
+select pen 
+  PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line
+  type, 
+                                  BOOL VAR hidden lines) Zweck: Für die
+         Darstellung des Bildes #on("italics")#p#off("italics")# soll dem #on("italics")#virtuellen#off("italics")# Stift #on("italics")#pen#off("italics")# ein realer Stift
+         zugeordnet werden, der möglichst die Farbe #on("italics")#colour#off("italics")# und die Dicke #on("italics")#thick­
+         ness#off("italics")# hat und dabei Linien mit dem Typ #on("italics")#line type#off("italics")# zeichnet. Es wird die
+         beste Annäherung für das Ausgabegerät genommen. 
+         Wenn #on("italics")#hidden lines#off("italics")# auf TRUE gesetzt wird, werden bei dreidimensionalen
+         Zeichnungen die verdeckten Linien mitgezeichnet, ansonsten werden sie
+         unterdrückt. Um sicherzustellen, das der Algorithmus auch funktioniert,
+         müssen die Linien allerdings von vorn nach hinten gezeichnet werden. Es
+         ist also nicht möglich, das Bild so zu drehen, das die hinteren Linien
+         zuerst gezeichnet werden. 
+         Dabei gelten folgende Vereinbarungen: 
+ 
+         #on("bold")#Farbe:#off("bold")# Negative Farben werden XOR gezeichnet (dunkel wird hell und
+                hell wird dunkel), Farbe 0 ist der Löschstift und positive Farben
+                überschreiben (ersetzen) den alten Punkt mit folgenden Werten: 
+ 
+                1      Standardfarbe des Endgerätes 
+                2      rot 
+                3      blau 
+                4      grün 
+                5      schwarz 
+                6      weiß 
+                > 6    nicht normierte Sonderfarben 
+ 
+ 
+         #on("bold")#Dicke:#off("bold")# 0 Standardstrichstärke des Endgerätes, ansonsten Strichstärke in
+                1/10 mm. 
+ 
+ 
+         #on("bold")#Linientyp:#off("bold")# 
+                0      keine sichtbare Linie 
+                1      durchgängige Linie 
+                2      gepunktete Linie 
+                3      kurz gestrichelte Linie 
+                4      lang gestrichelte Linie 
+                5      Strichpunktlinie 
+                > 5    nicht normierte Linie 
+ 
+         #on("bold")#Verdeckte Linien:#off("bold")# 
+                TRUE   Verdeckte Linien werden mitgezeichnet 
+                FALSE  Verdeckte Linien werden unterdrückt (nur bei drei­
+                       dimensionalen PICTURE) 
+ 
+         Die hier aufgeführten Möglichkeiten müssen nicht an allen graphischen
+         Endgeräten vorhanden sein. Der geräteabhängige Graphik-Treiber wählt
+         jeweils die bestmögliche Annäherung. 
+ 
+  Fehlerfälle: 
+      * pen out of range 
+        #on("italics")#pen#off("italics")# muss im Bereich 1-16 sein. 
+ 
+background 
+  PROC background (PICFILE VAR p, INT CONST colour) 
+  Zweck: Der Hintergrund wird auf die Farbe #on("italics")#colour#off("italics")# (s.o.) gesetzt wenn möglich. 
+ 
+  INT PROC background (PICFILE CONST p): 
+  Zweck: Liefert die eingestellte Hintergrundfarbe. 
+ 
+view 
+  PROC view (PICFILE VAR p, REAL CONST alpha) 
+  Zweck: Setzt den Winkel der Y-Achse zur Senkrechten auf #on("italics")#alpha#off("italics")# Grad, falls
+         diese nicht senkrecht zur Betrachtungsebene steht. 
+ 
+  PROC view (PICFILE VAR p, REAL CONST phi, theta) 
+  Zweck: Dreidimensionale Bilder werden häufig nicht direkt von vorne dargestellt,
+         sondern für die Betrachtung gedreht. Mit der Prozedur #on("italics")#view#off("italics")# kann die
+         Betrachtungsrichtung durch die Polarwinkel #on("italics")#phi#off("italics")# und #on("italics")#theta#off("italics")# (im Gradmass)
+         angegeben werden. Voreingestellt ist #on("italics")#phi#off("italics")# = 0 und #on("italics")#theta#off("bold")# = 0, d.h. senk­
+         recht von oben. 
+ 
+         Im Gegensatz zu #on("italics")#rotate#off("italics")# hat #on("italics")#view#off("italics")# keine Wirkung auf das eigentliche Bild
+         (PICFILE), sondern nur auf die gewählte Darstellung. So addieren sich
+         zwar aufeinanderfolgende #on("italics")#Rotationen#off("italics")#, #on("italics")#view#off("italics")# aber geht immer von der
+         Nullstellung aus. Auch kann das Bild durch eine #on("italics")#Rotation#off("italics")# ganz oder
+         teilweise aus oder in das Darstellungsfenster (#on("italics")#window#off("italics")# gedreht werden. Bei
+         #on("italics")#view#off("italics")# verändern sich die Koordinaten der Punkte nicht, d. h. das Fenster
+         wird mitgedreht. 
+ 
+  PROC view (PICFILE VAR p, REAL CONST x, y, z) 
+  Zweck: Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben,
+         sondern es wird die Blickrichtung als Vektor in Karthesischen Koordina­
+         ten angegeben. (Die Länge darf ungleich 1 sein). 
+ 
+viewport 
+  PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin,
+  vertmax) : 1-709 
+  Zweck: Die Zeichenfläche auf dem Endgerät, auf dem das Bild dargestellt werden
+         soll, wird spezifiziert. Dabei wird sowohl die Größe als auch die relative
+         Lage der Zeichenfläche definiert. Der linke untere Eckpunkt der physi­
+         kalischen Zeichenfläche des Gerätes hat die Koordinaten (0, 0). Die
+         definierte Zeichenfläche erstreckt sich 
+ 
+                #on("italics")#hormin   -  hormax#off("italics")#        in der Horizontalen, 
+                #on("italics")#vertmin  -  vertmax#off("italics")#       in der Vertikalen. 
+ 
+         So liegt der linke untere Eckpunkt dann bei (#on("italics")#hormin, hormax#off("italics")#), der rechte
+         obere Eckpunkt bei (#on("italics")#hormax, vertmax#off("italics")#). 
+ 
+         Damit sowohl geräteunabhängige als auch maßstabgetreue Zeichnungen
+         möglich sind, können die Koordinaten in zwei Arten spezifiziert werden: 
+         a)  #on("bold")#Gerätekoordinaten#off("bold")# 
+             Die Koordinaten können Werte von 0.0 bis 2.0 annehmen. Dabei
+             hat die kürzere Seite der physikalischen Zeichenfläche definitionsge­
+             mäß die Länge 1.0. 
+         b)  #on("bold")#Absolute Koordinaten#off("bold")# 
+             Die Werte werden in #on("italics")#cm#off("italics")# angegeben. Dabei müssen die Maximal­
+             werte aber größer als 2.0 sein, da sonst Fall a) angenommen wird. 
+ 
+         Voreingestellt ist 
+ 
+                viewport (0.0, 1.0, 0.0, 1.0) 
+ 
+         d.h. das größtmögliche Quadrat, beginnend mit der linken unteren Ecke
+         der physikalischen Zeichenfläche. In vielen Fällen wird diese Einstellung
+         ausreichen, so daß der Anwender kein eigenes #on("italics")#viewport#off("italics")# definieren muss. 
+ 
+         Der Abbildungsmaßstab wird durch das Zusammenspiel von #on("italics")#viewport#off("italics")# und
+         #on("italics")#window#off("italics")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, daß
+         winkeltreue Darstellung nur bei gleichen X- und Y-Maßstab möglich
+         ist. Da man oft quadratische Fenster (#on("italics")#window#off("italics")#) verwendet, wurde als
+         Standardeinstellung auch ein quadratisches #on("italics")#viewport#off("italics")# gewählt. 
+ 
+  Hinweis: Mit der Prozedur #on("italics")#check limit#off("italics")# aus dem PACKET #on("italics")#basis plot#off("italics")# kann die
+           Überprüfung der Grenzen des eingestellten #on("italics")#viewport#off("italics")#-Bereiches ein-
+           bzw. ausgeschaltet werden. Bei eingeschateter Überprüfung, werden
+           Linien, die den Bereich überschreiten, am Rand abgetrennt. 
+ 
+ 
+window 
+  PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) 
+  Zweck: Für die Darstellung eines zweidimensionalen Bildes wird das darzustel­
+         lende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im In-
+         tervall [#on("italics")#x min, x max#off("italics")#] und deren Y-Koordinaten im Bereich [#on("italics")#y min, y
+         max#off("italics")#] liegen, gehören zum definierten Fenster.Vektoren, die außerhalb
+         dieses Fensters liegen, gehen über die durch #on("italics")#viewport#off("italics")# Fläche hinaus
+         (s.dort). 
+ 
+         Der Darstellungsmaßstab ergibt sich als 
+ 
+         #ub#               x max - x min               #ue# 
+          horizontale Seitenlänge der Zeichenfläche 
+ 
+ 
+         #ub#               y max - y min               #ue# 
+           vertikale Seitenlänge der Zeichenfläche 
+ 
+  PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max,
+                                                       z min, z max) 
+ 
+  Zweck: Für die darstellung eines dreidimensionalen Bildes wird das darzustellende
+         Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("italics")#x
+         min, x max#off("italics")#], deren Y-Koordinaten im Bereich [#on("italics")#y min, y max#off("italics")#] und
+         deren Z-Koordinaten im Bereich [#on("italics")#z min, z max#off("italics")#] liegen, gehören zum
+         definierten Fenster. Dieses dreidimensionale Fenster (#on("italics")#Quader#off("italics")#) wird ent­
+         sprechend der eingestellten Projektionsart (orthographisch, perspektivisch
+         oder schiefwinklig) und den Betrachtungswinkeln (s. #on("italics")#view#off("italics")#) auf die spezi­
+         fizierte Zeichenfläche abgebildet. 
+         Anders als im zweidimensionalen Fall ist das Problem der Maßstaäbe
+         nicht mehr nur durch das Zusammenspiel von #on("italics")#window#off("italics")# und #on("italics")#viewport#off("italics")# zu
+         beschreiben. Hier spielen auch die Projektionsart und Darstellungswinkel
+         herein. 
+ 
+oblique: 
+  PROC oblique (PICFILE VAR p, REAL CONST a, b) 
+  Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#schiefwinklig#off("underline")# als gewünschte
+         Projektionsart eingestellt. Dabei ist (#on("italics")#a, b#off("italics")#) der Punkt auf der X-Y-
+         Ebene, auf den der Einheitsvektor der Z-Richtung abgebildet werden
+         soll. 
+ 
+orthographic 
+  PROC orthographic (PICFILE VAR p) 
+  Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#orthographisch#off("underline")# als gewünschte
+         Projektionsart eingestellt. Bei der orthographischen Projektion wird ein
+         dreidimensionaler Körper mit parallelen Strahlen senkrecht auf der Pro­
+         jektionsebene dabgebildet. 
+ 
+perpective 
+  PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) 
+  Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#perspectivisch#off("underline")# als gewünschte
+         Projektionsart eingestellt. Der Punkt (#on("italics")#cx, 1/cy, cz#off("underline")#) ist der Fluchtpunkt der
+         Projektion, d. h. alle Parallen zur Z-Achse schneiden sich in diesem
+         Punkt. 
+ 
+extrema 
+  PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) 
+  Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. 
+ 
+  PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z
+  min,z max) : 1-651 
+  Zweck: Die Prozedur liefert die größten und kleinsten Werte des PICFILE. 
+ 
+ 
+#on("underline")#Prozeduren zur Manipulation von PICFILE#off("underline")# 
+:= 
+  OP := (PICFILE VAR p, DATASPACE CONST d) 
+  Zweck: Assoziert die PICFILE Variable #on("italics")#p#off("italics")# mit dem Datenraum #on("italics")#d#off("italics")# und initialisiert
+         die Variable, wenn nötig. 
+  Fehlerfälle: 
+      * dataspace is no PICFILE 
+        Der anzukoppelnde Datenraum hat einen unzulässigen Typ 
+ 
+picture file 
+  DATASPACE PROC picture file (TEXT CONST name) 
+  Zweck: Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.). 
+ 
+put 
+  PROC put (FILE VAR f, PICFILE VAR p) 
+  Zweck: Schreibt den Inhalt eines PICFILE in ein FILE. Die Informationen
+         werden im internen Format abgelegt. 
+ 
+get 
+  PROC get (PICFILE VAR p, FILE VAR f) 
+  Zweck: Liest den Inhalt eines PICFILE aus einem FILE. Die Informationen
+         müssen mit #on("italics")#put#off("italics")# geschrieben worden sein. 
+  Fehlerfall: 
+      *  Picfile overflow 
+         Es können nur maximal 1024 Picture (Sätze) in einem PICFILE abgelegt
+         werden. 
+ 
+to first pic 
+  PROC to first pic (PICFILE VAR p) 
+  Zweck: Positioniert auf das erste PICTURE. 
+ 
+to eof 
+  PROC to last pic (PICFILE VAR p) 
+  Zweck: Positioniert hinter das letzte PICTURE. 
+ 
+to pic 
+  PROC to pic (PICFILE VAR p, INT CONST pos) 
+  Zweck: Positioniert auf das PICTURE Nummer #on("italics")#pos#off("italics")#. 
+  Fehlerfälle: 
+      *  Position underflow 
+         Es wurde eine Position kleiner Null angegeben. *  Position after
+         eof Es wurde versucht, hinter das Ende eines PICFILE zu positionieren 
+ 
+up 
+  PROC up (PICFILE VAR p) 
+  Zweck: Positioniert genau ein PICTURE zurück. 
+  Fehlerfall: 
+      *  Position underflow 
+         Es wurde versucht, vor das erste PICTURE zu positionieren 
+ 
+  PROC up (PICFILE VAR p, INT CONST n) 
+  Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture zurück. 
+  Fehlerfall: 
+      *  Position underflow 
+         Es wurde versucht, vor das erste PICTURE zu positionieren 
+ 
+down 
+  PROC down (PICFILE VAR p) 
+  Zweck: Positioniert genau ein PICTURE vorwärts. 
+  Fehlerfall: 
+      *  Position after eof 
+         Es wurde versucht, hinter das Ende eines PICFILE zu positionieren 
+ 
+  PROC down (PICFILE VAR p, INT CONST n) 
+  Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture vorwärts. 
+  Fehlerfall: 
+      *  Position after eof 
+         Es wurde versucht, hinter das Ende eines PICFILE zu positionieren 
+ 
+is first picture 
+  BOOL PROC is first picture (PICFILE CONST p) 
+  Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das erste PICTURE erreicht ist. 
+ 
+eof 
+  BOOL PROC eof (PICFILE CONST p) 
+  Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das Ende eines PICFILE erreicht ist. 
+ 
+picture no 
+  INT PROC picture no (PICFILE CONST p) 
+  Zweck: Liefert die Nummer des aktuellen PICTURE. 
+ 
+pictures 
+  INT PROC pictures (PICFILE CONST p) 
+  Zweck: Liefert die Anzahl PICTURE eines PICFILE. 
+ 
+delete picture 
+  PROC delete picture (PICFILE VAR p) 
+  Zweck: Löscht das aktuelle PICTURE 
+ 
+insert picture 
+  PROC insert picture (PICFILE VAR p) 
+  Zweck: Fügt ein PICTURE #on("underline")#vor#off("underline")# der aktuellen Position ein. 
+ 
+read picture 
+  PROC read picture (PICFILE CONST p, PICTURE VAR pic) 
+  Zweck: Liest das aktuelle PICTURE. 
+ 
+write picture 
+  PROC write picture (PICFILE VAR p, PICTURE CONST pic) 
+  Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# auf der aktuellen Position. 
+ 
+put picture 
+  PROC write picture (PICFILE VAR p, PICTURE CONST pic) 
+  Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# hinter das letzte PICTURE des PICFILE.
+         Die aktuelle Position wird nicht verändert. 
+ 
+#page# 
+                                    #on("italics")#Wo wir sind, da klappt nichts, 
+                                    aber wir können nicht überall sein !#off("italics")# 
+ 
+#type ("basker14")# 
+#on("bold")#Kurzbeschreibung des Graphik-Editors#off("bold")# 
+#type ("basker12")# 
+ 
+In der Kommondozeile werden folgende Informationen angezeigt: 
+ 
+#on("revers")#LEN nnnnn                <...Name...>      DIM n  PEN nn    Picture nnnn
+#off("revers")# 
+ 
+ 
+Folgende Kommandos stehen zur Verfügung: 
+ 
+  PICTURE PROC pic neu 
+  PICFILE PROC picfile neu 
+  PROC neu zeichnen 
+ 
+  OP UP n         (n PICTURE up) 
+  OP DOWN n       (n PICTURE down) 
+  OP T n          (to PICTURE n) 
+ 
+  PROC oblique (REAL CONST a, b) 
+  PROC orthographic 
+  PROC perspective (REAL CONST cx, cy, cz) 
+  PROC window (BOOL CONST dev) 
+  PROC window (REAL CONST x min, x max, y min, y max) 
+  PROC window (REAL CONST x min, x max, y min, y max, z min, z max) 
+  PROC viewport (REAL CONST h min, h max, v min, v max) 
+  PROC view (REAL CONST alpha) 
+  PROC view (REAL CONST phi, theta) 
+  PROC view (REAL CONST x, y, z) 
+ 
+  PROC pen (INT CONST n) 
+  PROC select pen (INT CONST pen, colour, thickness, line type, BOOL CONST
+  hidden) 
+  PROC background (INT CONST colour) 
+ 
+  PROC extrema pic 
+  PROC extrema picfile 
+  PROC selected pen 
+ 
+  PROC rotate (REAL CONST angle) 
+  PROC rotate (REAL CONST phi, theta, lambda ) 
+  PROC stretch (REAL CONST sx, sy) 
+  PROC stretch (REAL CONST sx, sy, sz) 
+  PROC translate (REAL CONST dx, dy) 
+  PROC translate (REAL CONST dx, dy, dz) 
+
diff --git a/system/std.graphik/1.8.7/source-disk b/system/std.graphik/1.8.7/source-disk
new file mode 100644
index 0000000..8e7ff34
--- /dev/null
+++ b/system/std.graphik/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/05_std.graphik.img
diff --git a/system/std.graphik/1.8.7/src/Beispiel.Kreuz b/system/std.graphik/1.8.7/src/Beispiel.Kreuz
new file mode 100644
index 0000000..e29f24a
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/Beispiel.Kreuz
@@ -0,0 +1,41 @@
+initialisiere picfile;
+zeichne die x achse;
+zeichne die y achse;
+zeichne die z achse;
+stelle das achsenkreuz dar  .
+
+initialisiere picfile:
+  PICFILE VAR p :: picture file ("KREUZ")  .
+
+zeichne die x achse:
+  PICTURE VAR x achse := nilpicture;
+  move (x achse, -1.0, 0.0, 0.0);
+  draw (x achse, "-X", 0.0, 0.0, 0.0);
+  draw (x achse,  1.0, 0.0, 0.0);
+  draw (x achse, "+X", 0.0, 0.0, 0.0);
+  put picture (p, x achse)  .
+
+zeichne die y achse:
+  PICTURE VAR y achse := nilpicture;
+  move (y achse, 0.0, -1.0, 0.0);
+  draw (y achse, "-Y", 0.0, 0.0, 0.0);
+  draw (y achse, 0.0, 1.0, 0.0);
+  draw (y achse, "+Y", 0.0, 0.0, 0.0);
+  put picture (p, y achse)  .
+
+zeichne die z achse:
+  PICTURE VAR z achse := nilpicture;
+  move (z achse, 0.0, 0.0, -1.0);
+  draw (z achse, "-Z", 0.0, 0.0, 0.0);
+  draw (z achse,  0.0, 0.0, 1.0);
+  draw (z achse, "+Z", 0.0, 0.0, 0.0);
+  put picture (p, z achse)  .
+
+stelle das achsenkreuz dar:
+  viewport (p, 0.0, 1.0, 0.0, 1.0);
+  window (p, -1.1, 1.1, -1.1, 1.1);
+  oblique (p, 0.25, 0.15);
+  plot (p)  .
+
+
+
diff --git a/system/std.graphik/1.8.7/src/Beispiel.Sinus b/system/std.graphik/1.8.7/src/Beispiel.Sinus
new file mode 100644
index 0000000..beac7cd
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/Beispiel.Sinus
@@ -0,0 +1,45 @@
+initialisiere picfile;
+zeichne überschrift;
+zeichne achsen;
+zeichne sinuskurve;
+wähle darstellung;
+plot (p)  .
+
+initialisiere picfile:
+  PICFILE VAR p :: picture file ("SINUS")  .
+
+zeichne überschrift:
+  PICTURE VAR überschrift :: nilpicture;
+  move (überschrift, -pi/2.0, 1.0);
+  draw (überschrift, "sinus (x)  [-pi, +pi]", 0.0, 1.0, 0.6);
+  put picture (p, überschrift)  .
+
+zeichne achsen:
+  PICTURE VAR achsen :: nilpicture;
+  zeichne x achse;
+  zeichne y achse;
+  put picture (p, achsen)  .
+
+zeichne x achse:
+  move (achsen, -pi, 0.0);
+  draw (achsen,  pi, 0.0)  .
+
+zeichne y achse:
+  move (achsen, 0.0, -1.0);
+  draw (achsen, 0.0, +1.0)  .
+
+zeichne sinuskurve:
+  PICTURE VAR sinus :: nilpicture;
+  REAL VAR x :: -pi;
+
+  move (sinus, x, sin (x));
+  REP x INCR 0.1;
+      draw (sinus, x, sin (x))
+  UNTIL x >= pi PER;
+
+  put picture (p, sinus)  .
+
+wähle darstellung:
+  window (p, -pi, pi, -1.0, 1.3);
+  viewport (p, 0.0, 0.0, 0.0, 0.0)  .
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Picfile b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile
new file mode 100644
index 0000000..3accf52
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Picfile
@@ -0,0 +1,738 @@
+PACKET picture DEFINES                        (*Autor: Heiko.Indenbirken *)
+               PICTURE,                       (*Stand:    12.03.1985     *)
+               :=, CAT, nilpicture,           (*Änderung: 20.08.85/10:38 *)
+               draw, draw r,                  (*Änderung: 05.08.86/12:21 *)
+               move, move r,
+               mark, bar, circle,
+               length, dim, pen, where,
+               extrema, rotate, stretch, translate,
+               picture:
+
+LET draw key      = 1,
+    move key      = 2,
+    text key      = 3,
+    move r key    = 4,
+    draw r key    = 5,
+    bar 2 key     = 6,
+    bar 3 key     = 7,
+    circle key    = 8,
+    mark key      = 9,
+    max length    = 31974;
+
+LET overflow  = "Picture overflow",
+    pen range = "pen out of range [0-16]",
+    dim 3     = "Picture is 3 dimensional",
+    dim 2     = "Picture is 2 dimensional",
+    dim init  = "Picture isn't initialized",
+    wrong key = "wrong key code",
+    nil       = "",
+    zero      = ""0"";
+
+TYPE PICTURE = STRUCT (INT dim, pen, TEXT points);
+
+
+INT VAR read pos;
+REAL VAR x, y, z;
+TEXT VAR r1 :: 8*zero, r2 :: 16*zero, r3 :: 24*zero, i1 :: 2*zero;
+
+OP := (PICTURE VAR l, PICTURE CONST r) :
+  CONCR (l) := CONCR (r)
+END OP :=;
+
+OP CAT (PICTURE VAR l, PICTURE CONST r) :
+  check dim (l, r.dim);
+  IF length (l.points) > max length - length (r.points)
+  THEN errorstop (overflow) FI;
+
+  l.points CAT r.points
+END OP CAT;
+
+PICTURE PROC nilpicture :
+  PICTURE : (0, 1, nil)
+END PROC nilpicture;
+
+PICTURE PROC nilpicture (INT CONST pen):
+  PICTURE : (0, pen, nil)
+END PROC nilpicture;
+
+PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright):
+  write (p.points, text, angle, height, bright, text key)
+END PROC draw;
+
+PROC draw (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p.points, x, y, z, draw key)
+END PROC draw;
+
+PROC draw (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p.points, x, y, draw key)
+END PROC draw;
+
+PROC draw r (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p.points, x, y, z, draw r key)
+END PROC draw r;
+
+PROC draw r (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p.points, x, y, draw r key)
+END PROC draw r;
+
+PROC move (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p.points, x, y, z, move key)
+END PROC move;
+
+PROC move (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p.points, x, y, move key)
+END PROC move;
+
+PROC move r (PICTURE VAR p, REAL CONST x, y, z) :
+  check dim (p, 3);
+  write (p.points, x, y, z, move r key)
+END PROC move r;
+
+PROC move r (PICTURE VAR p, REAL CONST x, y) :
+  check dim (p, 2);
+  write (p.points, x, y, move r key)
+END PROC move r;
+
+PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern):
+  check dim (p, 2);
+  write (p.points, width, height, pattern, bar 2 key)
+END PROC bar;
+
+PROC bar (PICTURE VAR p, REAL CONST from, to, height, INT CONST pattern):
+  check dim (p, 2);
+  write (p.points, from, to, height, pattern, bar 3 key)
+END PROC bar;
+
+PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern):
+  check dim (p, 2);
+  write (p.points, radius, from, to, pattern, circle key)
+END PROC circle;
+
+PROC mark (PICTURE VAR p, REAL CONST size, INT CONST no):
+  write (p.points, size, no, mark key)
+END PROC mark;
+
+PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST key) :
+  IF length (points) < max length
+  THEN points CAT code (key); 
+       replace (r3, 1, x);
+       replace (r3, 2, y);
+       replace (r3, 3, z);
+       points CAT r3
+  ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST x, y, INT CONST key) :
+  IF length (points) < max length
+  THEN points CAT code (key); 
+       replace (r2, 1, x);
+       replace (r2, 2, y);
+       points CAT r2
+  ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST x, y, INT CONST n, key) :
+  IF length (points) < max length
+  THEN points CAT code (key); 
+       replace (r2, 1, x);
+       replace (r2, 2, y);
+       points CAT r2;
+       replace (i1, 1, n);
+       points CAT i1
+  ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST x, y, z, INT CONST n, key) :
+  IF length (points) < max length
+  THEN points CAT code (key); 
+       replace (r3, 1, x);
+       replace (r3, 2, y);
+       replace (r3, 3, z);
+       points CAT r3;
+       replace (i1, 1, n);
+       points CAT i1 
+  ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC write (TEXT VAR points, TEXT CONST t, REAL CONST angle, height, bright,
+            INT CONST key) :
+  IF max length - length (points) >= length (t)
+  THEN points CAT code (key);
+       replace (i1, 1, length (t));
+       points CAT i1;
+       points CAT t;
+       replace (r3, 1, angle);
+       replace (r3, 2, height);
+       replace (r3, 3, bright);
+       points CAT r3
+  FI;
+END PROC write;
+
+PROC write (TEXT VAR points, REAL CONST size, INT CONST no, key) :
+  IF length (points) < max length
+  THEN points CAT code (key); 
+       replace (r1, 1, size);
+       points CAT r1;
+       replace (i1, 1, no);
+       points CAT i1;
+  ELSE errorstop (overflow) FI
+END PROC write;
+
+PROC check dim (PICTURE VAR p, INT CONST dim):
+  IF p.dim = dim
+  THEN
+  ELIF p.dim = 0
+  THEN p.dim := dim
+  ELSE errorstop (dimension) FI  .
+
+dimension:
+  IF p.dim = 2
+  THEN dim 2
+  ELIF p.dim = 3
+  THEN dim 3
+  ELSE dim init FI  .
+
+END PROC check dim;
+
+INT PROC length (PICTURE CONST p):
+  length (p.points)
+END PROC length;
+
+INT PROC dim (PICTURE CONST pic) :
+  pic.dim
+END PROC dim;
+
+PICTURE PROC pen (PICTURE CONST p, INT CONST pen) :
+  IF pen < 0 OR pen > 16
+  THEN errorstop (pen range) FI;
+
+  PICTURE:(p.dim, pen, p.points)
+END PROC pen;
+
+INT PROC pen (PICTURE CONST p) :
+  p.pen
+END PROC pen;
+
+PROC where (PICTURE CONST p, REAL VAR x, y) :
+  IF p.dim = 0
+  THEN x := 0.0;  y := 0.0
+  ELIF p.dim = 3
+  THEN errorstop (dim 3)
+  ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
+       y := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1
+  FI
+END PROC where;
+
+PROC where (PICTURE CONST p, REAL VAR x, y, z) :
+  IF p.dim = 0
+  THEN x := 0.0;  y := 0.0;  z := 0.0
+  ELIF p.dim = 2
+  THEN errorstop (dim 2)
+  ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1;
+       y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1;
+       z := subtext (p.points, length (p.points)-7,  length (p.points)) RSUB 1;
+  FI
+END PROC where;
+
+
+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) :
+  x min := max real;  x max :=-max real;
+  y min := max real;  y max :=-max real;
+  z min := max real;  z max :=-max real;
+  read pos := 0; 
+  INT CONST pic length := length (p.points);
+  WHILE read pos < pic length
+  REP check position PER  .
+
+check position :
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : calc extrema
+  CASE move key : calc extrema
+  CASE move r key : calc rel extrema
+  CASE draw r key : calc rel extrema
+  CASE text key : read pos INCR next int + 24
+  CASE bar 2 key : read pos INCR 18
+  CASE bar 3 key, circle key : read pos INCR 26
+  CASE mark key: read pos INCR 4 
+  OTHERWISE errorstop (wrong key) END SELECT  . 
+
+calc extrema :
+  x := next real;  y := next real;  z := next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y);
+  z min := min (z min, z);  z max := max (z max, z)  .
+
+calc rel extrema :
+  x INCR next real;  y INCR next real;  z INCR next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y);
+  z min := min (z min, z);  z max := max (z max, z)  .
+
+next real :
+  read pos INCR 8;
+  subtext (p.points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (p.points, read pos-1, read pos) ISUB 1  .
+
+END PROC extrema;
+
+PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max):
+  x min := max real;  x max :=-max real;
+  y min := max real;  y max :=-max real;
+  read pos := 0; 
+  INT CONST pic length := length (p.points);
+  WHILE read pos < pic length
+  REP check position PER  .
+
+check position :
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : calc extrema
+  CASE move key : calc extrema
+  CASE move r key : calc rel extrema
+  CASE draw r key : calc rel extrema
+  CASE text key : read pos INCR next int + 24
+  CASE bar 2 key : read pos INCR 18
+  CASE bar 3 key, circle key : read pos INCR 26
+  CASE mark key: read pos INCR 4 
+  OTHERWISE errorstop (wrong key) END SELECT  . 
+
+calc extrema :
+  x := next real;  y := next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y)  .
+
+calc rel extrema :
+  x INCR next real;  y INCR next real;
+  x min := min (x min, x);  x max := max (x max, x);
+  y min := min (y min, y);  y max := max (y max, y)  .
+
+next real :
+  read pos INCR 8;
+  subtext (p.points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (p.points, read pos-1, read pos) ISUB 1  .
+
+END PROC extrema;
+
+PROC rotate (PICTURE VAR p, REAL CONST angle) :
+  REAL CONST s :: sind( angle ), c := cosd( angle );
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : ( 1.0,  0.0,  0.0 ),
+                ROW 3 REAL : ( 0.0,   c ,   s  ),
+                ROW 3 REAL : ( 0.0,  -s ,   c  ),
+                ROW 3 REAL : ( 0.0,  0.0,  0.0 )))
+END PROC rotate;
+
+PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) :
+  REAL CONST s   :: sind ( theta ), c   :: cosd ( theta ),
+             s p :: sind (  phi  ), s l :: sind ( lambda ),
+             ga  :: cosd (  phi  ), c l :: cosd ( lambda ),
+             be  :: s p * s l,      al  :: s p * c l, c1 :: 1.0 - c;
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : ( al*al*c1 + c , be*al*c1+ga*s, ga*al*c1-be*s ),
+                ROW 3 REAL : ( al*be*c1-ga*s, be*be*c1 + c , ga*be*c1+al*s ),
+                ROW 3 REAL : ( al*ga*c1+be*s, be*ga*c1-al*s, ga*ga*c1 + c  ),
+                ROW 3 REAL : (      0.0     ,      0.0     ,      0.0    )))
+END PROC rotate; 
+ 
+PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : 
+  stretch (pic, sx, sy, 1.0) 
+END PROC stretch;
+
+PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) :
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : ( sx, 0.0, 0.0),
+                ROW 3 REAL : (0.0,  sy, 0.0),
+                ROW 3 REAL : (0.0, 0.0,  sz),
+                ROW 3 REAL : (0.0, 0.0, 0.0)))
+END PROC stretch;
+
+PROC translate (PICTURE VAR p, REAL CONST dx, dy) : 
+  translate (p, dx, dy, 0.0) 
+END PROC translate;
+
+PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) :
+  transform (p, ROW 4 ROW 3 REAL : 
+               (ROW 3 REAL : (1.0, 0.0, 0.0),
+                ROW 3 REAL : (0.0, 1.0, 0.0),
+                ROW 3 REAL : (0.0, 0.0, 1.0),
+                ROW 3 REAL : ( dx,  dy,  dz)))
+END PROC translate;
+
+PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) :
+  INT CONST pic length := length (p.points);
+  INT VAR begin pos;
+  read pos := 0; 
+  x := 0.0; y := 0.0; z := 0.0;
+  IF p.dim = 2
+  THEN transform 2 dim pic
+  ELSE transform 3 dim pic FI  .
+ 
+transform 2 dim pic:
+  WHILE read pos < pic length
+  REP transform 2 dim position PER  .
+
+transform 2 dim position:
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : transform 2 dim point 
+  CASE move key : transform 2 dim point 
+  CASE move r key : transform 2 dim point 
+  CASE draw r key : transform 2 dim point 
+  CASE text key : read pos INCR next int + 24
+  CASE bar 2 key : read pos INCR 18
+  CASE bar 3 key, circle key : read pos INCR 26
+  CASE mark key: read pos INCR 4 
+  OTHERWISE errorstop (wrong key) END SELECT  . 
+
+transform 2 dim point:
+  begin pos := read pos+1;
+  x := next real;  y := next real;
+  transform (a, x, y, z); 
+  replace (r2, 1, x);
+  replace (r2, 2, y);
+  replace (p.points, begin pos, r2)  .
+
+transform 3 dim pic:
+  WHILE read pos < pic length
+  REP transform 3 dim position PER  .
+
+transform 3 dim position :
+  read pos INCR 1;
+  SELECT code (p.points SUB read pos) OF
+  CASE draw key : transform 3 dim point 
+  CASE move key : transform 3 dim point 
+  CASE move r key : transform 3 dim point 
+  CASE draw r key : transform 3 dim point 
+  CASE text key : read pos INCR next int + 24
+  CASE bar 2 key : read pos INCR 18
+  CASE bar 3 key, circle key : read pos INCR 26
+  CASE mark key: read pos INCR 4
+  OTHERWISE errorstop (wrong key) END SELECT  . 
+
+transform 3 dim point:
+  begin pos := read pos+1;
+  x := next real;  y := next real; z := next real;
+  transform (a, x, y, z); 
+  replace (r3, 1, x);
+  replace (r3, 2, y);
+  replace (r3, 3, z);
+  replace (p.points, begin pos, r3)  .
+
+next real :
+  read pos INCR 8;
+  subtext (p.points, read pos-7, read pos) RSUB 1  .
+
+next int :
+  read pos INCR 2;
+  subtext (p.points, read pos-1, read pos) ISUB 1  .
+
+END PROC transform;
+
+PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) :
+  REAL CONST ox :: x, oy :: y, oz :: z;
+  x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1);
+  y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2);
+  z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3)
+END PROC transform;
+
+PROC picture (PICTURE CONST pic, TEXT VAR points, INT VAR dim, pen):
+  dim    := pic.dim;
+  pen    := pic.pen;
+  points := pic.points;
+END PROC picture;
+
+END PACKET picture;
+
+PACKET picfile DEFINES                        (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    23.02.1985     *)
+               PICFILE, :=, picture file,     (*Änderung: 13.10.89/23:11 *)
+               select pen, selected pen, background, 
+               set values, get values,
+               view, viewport, window,
+               oblique, orthographic, perspective,
+               extrema,
+
+               to pic, up, down,
+               eof, picture no, pictures,
+               delete picture, insert picture,
+               read picture, write picture,
+               get picture, put picture:
+
+
+LET no picfile = "dataspace is no PICFILE",
+    pen range  = "pen out of range",
+    pos under  = "Position underflow",
+    pos over   = "Position overflow",
+    pic over   = "PICFILE overflow";
+
+LET max pics = 1024,
+    pic dataspace = 1103;
+
+
+TYPE PICFILE = BOUND STRUCT (INT size, pos, background,
+                             ROW 16 ROW 3 INT pens,
+                             ROW 3 ROW 2 REAL sizes,
+                             ROW 2 ROW 2 REAL limits,
+                             ROW 4 REAL angles,
+                             ROW 2 REAL obliques,
+                             ROW 3 REAL perspectives
+                             ROW max pics PICTURE pic);
+
+INT VAR i;
+
+OP := (PICFILE VAR l, PICFILE CONST r):
+  EXTERNAL 260
+END OP :=;
+
+OP := (PICFILE VAR p, DATASPACE CONST d) :
+  IF type (d) = pic dataspace
+    THEN CONCR (p) := d
+  ELIF type (d) < 0
+    THEN type (d, pic dataspace) ;
+         CONCR (p) := d ;
+         init picfile dataspace ;
+  ELSE errorstop (no picfile) FI .
+ 
+init picfile dataspace :
+  r.size := 0;
+  r.pos  := 1;
+  r.background := 0;
+  r.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0),
+                                 ROW 2 REAL : (0.0, 1.0),
+                                 ROW 2 REAL : (0.0, 1.0));
+  r.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, 0.0),
+                                  ROW 2 REAL : (0.0, 0.0));
+  r.angles := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);
+  r.obliques := ROW 2 REAL : (0.0, 0.0);
+  r.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0);
+  FOR i FROM 1 UPTO 16
+  REP r.pens [i] := ROW 3 INT : (1, 0, 1) PER  .
+
+r : CONCR (CONCR (p)).
+END OP :=;
+ 
+DATASPACE PROC picture file (TEXT CONST name) :
+  IF exists (name)
+  THEN old (name)
+  ELSE new (name) FI 
+END PROC picture file;
+
+PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type):
+  IF pen < 1 OR pen > 16
+  THEN errorstop (pen range) FI;
+  p.pens   [pen] := ROW 3 INT : (colour, thickness, line type)
+END PROC select pen;
+
+PROC selected pen (PICFILE CONST p, INT CONST pen,
+                                    INT VAR colour, thickness, line type):
+  IF pen < 1 OR pen > 16
+  THEN errorstop (pen range) FI;
+  colour    := p.pens [pen][1];
+  thickness := p.pens [pen][2];
+  line type := p.pens [pen][3];
+END PROC selected pen;
+
+INT PROC background (PICFILE CONST p):
+  p.background
+END PROC background;
+
+PROC background (PICFILE VAR p, INT CONST colour):
+  p.background := colour
+END PROC background;
+
+PROC get values (PICFILE CONST p,
+                 ROW 3 ROW 2 REAL VAR size, 
+                 ROW 2 ROW 2 REAL VAR limits,
+                 ROW 4 REAL VAR angles,
+                 ROW 2 REAL VAR oblique,
+                 ROW 3 REAL VAR perspective) : 
+  size        := p.sizes;
+  limits      := p.limits;
+  angles      := p.angles;
+  oblique     := p.obliques;
+  perspective := p.perspectives;
+
+END PROC get values;
+ 
+PROC set values (PICFILE VAR p,
+                 ROW 3 ROW 2 REAL CONST size, 
+                 ROW 2 ROW 2 REAL CONST limits,
+                 ROW 4 REAL CONST angles,
+                 ROW 2 REAL CONST oblique,
+                 ROW 3 REAL CONST perspective) : 
+  p.sizes        := size;
+  p.limits       := limits;
+  p.angles       := angles;
+  p.obliques     := oblique;
+  p.perspectives := perspective;
+
+END PROC set values;
+ 
+PROC view (PICFILE VAR p, REAL CONST alpha):
+  p.angles [1] := alpha
+END PROC view;
+
+PROC view (PICFILE VAR p, REAL CONST phi, theta):
+  p.angles [2] := sind (theta) * cosd (phi);
+  p.angles [3] := sind (theta) * sind (phi);
+  p.angles [4] := cosd (theta);
+END PROC view;
+
+PROC view (PICFILE VAR p, REAL CONST x, y, z):
+  p.angles [2] := x;
+  p.angles [3] := y;
+  p.angles [4] := z
+END PROC view;
+
+PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) :
+  p.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (hor min, hor max),
+                                  ROW 2 REAL : (vert min, vert max))
+END PROC viewport;
+
+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) :
+  window (p, x min, x max, y min, y max, 0.0, 1.0)
+END PROC window;
+
+PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) :
+  p.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
+                                 ROW 2 REAL : (y min, y max),
+                                 ROW 2 REAL : (z min, z max))
+END PROC window;
+
+PROC oblique (PICFILE VAR p, REAL CONST a, b) :
+  p.obliques := ROW 2 REAL : (a, b);
+  p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)
+END PROC oblique;
+
+PROC orthographic (PICFILE VAR p) :
+  p.obliques := ROW 2 REAL : (0.0, 0.0);
+  p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0)
+END PROC orthographic;
+ 
+PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) :
+  p.obliques := ROW 2 REAL : (0.0, 0.0);
+  p.perspectives := ROW 3 REAL : (cx, cy, cz)
+END PROC perspective;
+ 
+PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) :
+  REAL VAR dummy;
+  extrema (p, x min, x max, y min, y max, dummy, dummy)
+END PROC extrema;
+
+PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) :
+  REAL VAR new x min, new x max, new y min, new y max, new z min, new z max;
+  x min := max real;  x max := - max real;
+  y min := max real;  y max := - max real;
+  z min := max real;  z max := - max real;
+  FOR i FROM 1 UPTO p.size
+  REP IF dim (p.pic [i]) = 2
+      THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) 
+      ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max,
+                               new z min, new z max)
+      FI;
+      x min := min (x min, new x min); x max := max (x max, new x max); 
+      y min := min (y min, new y min); y max := max (y max, new y max); 
+      z min := min (z min, new z min); z max := max (z max, new z max); 
+  PER
+END PROC extrema;
+
+PROC to pic (PICFILE VAR p, INT CONST n):
+  IF n < 1
+  THEN errorstop (pos under)
+  ELIF n <= p.size+1 AND n <= max pics
+  THEN p.pos := n
+  ELSE errorstop (pos over) FI
+END PROC to pic;
+
+PROC up (PICFILE VAR p):
+  to pic (p, p.pos-1)
+END PROC up;
+
+PROC up (PICFILE VAR p, INT CONST n):
+  to pic (p, p.pos-n)
+END PROC up;
+
+PROC down (PICFILE VAR p):
+  to pic (p, p.pos+1)
+END PROC down;
+
+PROC down (PICFILE VAR p, INT CONST n):
+  to pic (p, p.pos+n)
+END PROC down;
+
+BOOL PROC eof (PICFILE CONST p):
+  p.pos >= p.size
+END PROC eof;
+
+INT PROC picture no (PICFILE CONST p):
+  p.pos
+END PROC picture no;
+
+INT PROC pictures (PICFILE CONST p):
+  p.size
+END PROC pictures;
+
+PROC delete picture (PICFILE VAR p) :
+  INT VAR i;
+  FOR i FROM p.pos+1 UPTO p.size
+  REP p.pic [i-1] := p.pic [i] PER;
+
+  p.pic [p.size] := nilpicture;
+  IF p.size > 1
+  THEN p.size DECR 1 FI
+END PROC delete picture;
+
+PROC insert picture (PICFILE VAR p) :
+  INT VAR i;
+  IF p.size >= max pics
+  THEN errorstop (pic over)
+  ELSE p.size INCR 1;
+       FOR i FROM p.size DOWNTO p.pos+1
+       REP p.pic [i] := p.pic [i-1] PER;
+
+       p.pic [p.pos] := nilpicture;
+  FI
+END PROC insert picture;
+
+PROC read picture (PICFILE VAR p, PICTURE VAR pic) :
+  pic := p.pic (p.pos)  .
+END PROC read picture;
+ 
+PROC write picture (PICFILE VAR p, PICTURE CONST pic) :
+  p.pic (p.pos) := pic  .
+END PROC write picture;
+
+PROC get picture (PICFILE VAR p, PICTURE VAR pic) :
+  IF p.pos > p.size
+  THEN errorstop (pos over)
+  ELSE pic := p.pic [p.pos];
+       p.pos INCR 1;
+  FI 
+END PROC get picture;
+
+PROC put picture (PICFILE VAR p, PICTURE CONST pic) :
+  IF p.pos > max pics
+  THEN errorstop (pic over)
+  ELSE p.pic [p.pos] := pic;
+
+       IF p.pos > p.size
+       THEN p.size INCR 1 FI;
+       p.pos INCR 1
+  FI 
+END PROC put picture;
+
+END PACKET picfile
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Plot b/system/std.graphik/1.8.7/src/GRAPHIK.Plot
new file mode 100644
index 0000000..5087abb
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plot
@@ -0,0 +1,285 @@
+PACKET basis plot DEFINES                     (* Autor: Heiko Indenbirken*)
+                                              (* Stand: 12.04.85         *)
+                                              (*Änderung: 06.08.86/10:03 *)
+(*  ******************  Hardwareunabhängiger Teil  ********************* *)
+(*                                                                       *)
+(*                                                                       *)
+(*      Im Harwareunabhängigen Paket 'basis plot' werden folgende        *)
+(*      Prozeduren definiert:                                            *)
+(*      Procedure       :  Bedeutung                                     *)
+(*      ---------------------------------------------------------------- *)
+(*       move           :  Positioniert auf (x, y,[z]) in Weltkoordinaten*)
+(*       draw           :  Zeichnet eine Linie bis zum Punkt (x, y, [z]).*)
+(*       move r         :  Positioniert (x, y, [z]) weiter               *)
+(*       draw r         :  Zeichnet (x, y, [z]) weiter                   *)
+(*                                                                       *)
+(*       draw           :  Zeichnet einen Text                           *)
+(*                                                                       *)
+(*       mark           :  Marker mit (no, size)                         *)
+(*       bar            :  Balken mit (width, height, pattern)           *)
+(*       bar            :  Balken mit (from, to, width, pattern)         *)
+(*       circle         :  Kreis(segment) mit (radius, from, to, pattern)*)
+(*                                                                       *)
+(*       where          :  Gibt die aktuelle Stiftposition (x, y, [z])   *)
+(*                                                                       *)
+(*************************************************************************)
+
+       move, draw,
+       move r, draw r,
+       mark, bar, circle,
+       where:
+
+LET POS = STRUCT (REAL x, y, z);
+
+POS VAR pos :: POS : (0.0, 0.0, 0.0);
+INT VAR h :: 0, v :: 0;
+
+PROC move (REAL CONST x, y) :
+  transform (x, y, 0.0, h, v);
+  move (h, v);
+  pos := POS : (x, y, 0.0)
+END PROC move;
+
+PROC move (REAL CONST x, y, z) :
+  transform (x, y, z, h, v);
+  move (h, v);
+  pos := POS : (x, y, z)
+END PROC move;
+
+PROC draw (REAL CONST x, y) :
+  transform (x, y, 0.0, h, v);
+  draw (h, v);
+  pos := POS : (x, y, 0.0)
+END PROC draw;
+
+PROC draw (REAL CONST x, y, z) :
+  transform (x, y, z, h, v);
+  draw (h, v);
+  pos := POS : (x, y, z) 
+END PROC draw;
+
+PROC move r (REAL CONST x, y) :
+  transform (pos.x+x, pos.y+y, pos.z, h, v);
+  move (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC move r;
+
+PROC move r (REAL CONST x, y, z) :
+  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+  move (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC move r;
+
+PROC draw r (REAL CONST x, y) :
+  transform (pos.x+x, pos.y+y, pos.z, h, v); 
+  draw (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC draw r;
+
+PROC draw r (REAL CONST x, y, z) :
+  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+  draw (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC draw r;
+
+PROC where (REAL VAR x, y) :
+  x := pos.x;  y := pos.y
+END PROC where;
+
+PROC where (REAL VAR x, y, z) :
+  x := pos.x;  y := pos.y;  z := pos.z
+END PROC where;
+
+PROC draw (TEXT CONST msg, REAL CONST angle, height percent, width percent):
+  draw (msg, angle, height (height percent), width (width percent))  .
+END PROC draw;
+
+PROC mark (REAL CONST size, INT CONST no):
+  marker (h, v, no, diagonal (size))
+END PROC mark;
+
+PROC bar (REAL CONST width, height, INT CONST pattern):
+  INT VAR diff, up, zero x, zero y;
+  transform (0.0, 0.0, 0.0, zero x, zero y);
+  transform (width*0.5, height, 0.0, diff, up);
+  bar (h-(diff-zero x), v, h+(diff-zero x), v+(up-zero y), pattern);
+  move (h, v) 
+
+END PROC bar;
+
+PROC bar (REAL CONST from, to, height, INT CONST pattern):
+  INT VAR from h, to h, up;
+  transform (from, height, 0.0, from h, up);
+  transform (to,   height, 0.0, to h, up);
+  bar (from h, v, to h, up, pattern);
+  move (h, v) 
+
+END PROC bar;
+
+PROC circle (REAL CONST rad, from, to, INT CONST pattern):
+  circle (h, v, diagonal (rad), from, to, pattern)  .
+
+END PROC circle;
+
+ENDPACKET basis plot;
+
+PACKET plot DEFINES plot:                     (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    13.10.89/22:31 *)
+
+LET draw key      = 1,
+    move key      = 2,
+    text key      = 3,
+    move r key    = 4,
+    draw r key    = 5,
+    bar 2 key     = 6,
+    bar 3 key     = 7,
+    circle key    = 8,
+    mark key      = 9;
+
+LET dim error = "PICTURE not initialized",
+    key error = "wrong key code: ";
+
+TEXT VAR points;
+INT VAR pic length, pic pen, pic dim, read pos;
+PICTURE VAR pic;
+
+PROC plot (PICTURE CONST pic):
+  init plot;
+  IF pic dim = 2
+  THEN plot two dim pic
+  ELIF pic dim = 3
+  THEN plot three dim pic
+  ELIF NOT (pic dim = 0 AND pic length = 0)
+  THEN errorstop (dim error) FI;
+  points := ""  .
+
+init plot:
+  picture (pic, points, pic dim, pic pen);
+  pic length := length (points);
+  read pos := 0  .
+
+plot two dim pic:
+  WHILE read pos < pic length
+  REP plot two dim position PER  .
+
+plot two dim position :
+  read pos INCR 1;
+  SELECT key OF
+  CASE draw key:   draw (next real, next real)
+  CASE move key:   move (next real, next real)
+  CASE move r key: move r (next real, next real)
+  CASE draw r key: draw r (next real, next real)
+  CASE text key:   draw (next text, next real, next real, next real)
+  CASE bar 2 key:  bar (next real, next real, next int) 
+  CASE bar 3 key:  bar (next real, next real, next real, next int) 
+  CASE circle key: circle (next real, next real, next real, next int) 
+  CASE mark key:   mark (next real, next int) 
+  OTHERWISE errorstop (key error + text (key)) END SELECT  . 
+
+plot three dim pic:
+  WHILE read pos < pic length
+  REP plot three dim position  PER  .
+
+plot three dim position :
+  read pos INCR 1;
+  SELECT key OF
+  CASE draw key:   draw (next real, next real, next real)
+  CASE move key:   move (next real, next real, next real)
+  CASE move r key: move r (next real, next real, next real)
+  CASE draw r key: draw r (next real, next real, next real)
+  CASE text key:   draw (next text, next real, next real, next real)
+  CASE bar 2 key:  bar (next real, next real, next int) 
+  CASE bar 3 key:  bar (next real, next real, next real, next int)
+  CASE circle key: circle (next real, next real, next real, next int) 
+  CASE mark key:   mark (next real, next int) 
+  OTHERWISE errorstop (key error + text (key)) END SELECT  . 
+
+key:
+  code (points SUB read pos)  .
+
+END PROC plot;
+
+REAL PROC next real:
+  read pos INCR 8;
+  subtext (points, read pos-7, read pos) RSUB 1  .
+END PROC next real;
+
+INT PROC next int:
+  read pos INCR 2;
+  subtext (points, read pos-1, read pos) ISUB 1  .
+END PROC next int;
+
+TEXT PROC next text:
+  INT CONST text length :: next int;
+  read pos INCR text length;
+  subtext (points, read pos-text length+1, read pos)  .
+END PROC next text;
+
+PROC plot (TEXT CONST name) :
+  PICFILE VAR p :: old (name);
+  plot (p);
+END PROC plot;
+
+PROC plot (PICFILE VAR p) :
+  set projektion;
+  disable stop;
+  begin plot;
+  clear screen;
+  plot pictures (p);
+  errorcheck;
+  end plot  .
+
+set projektion:
+  ROW 3 ROW 2 REAL VAR size;
+  ROW 2 ROW 2 REAL VAR limit;
+  ROW 4 REAL VAR angles;
+  ROW 2 REAL VAR oblique;
+  ROW 3 REAL VAR perspective;
+
+  get values (p, size, limit, angles, oblique, perspective);
+  set values (size, limit, angles, oblique, perspective)  .
+
+clear screen:
+  INT VAR x0, y0, x1, y1, h max, v max;
+  REAL VAR x cm, y cm;
+
+  IF background (p) > -1
+  THEN clear
+  ELSE drawing area (x cm, y cm, h max, v max);
+       new values (x cm, y cm, h max, v max, x0, x1 , y0, y1);
+       set range (max (0, x0), max (0, y0), min (h max, x1), min (v max, y1))
+  FI  .
+
+errorcheck:
+  IF is error
+  THEN line;
+       put line ("Erorr at PICTURE No " + text (picture no (p)));
+  FI  .
+
+END PROC plot;
+
+PROC plot pictures (PICFILE VAR p):
+  INT VAR back :: abs (background (p)), no;
+  enable stop;
+  FOR no FROM 1 UPTO pictures (p)
+  REP to pic (p, no);
+      read picture (p, pic);
+
+      IF this picture is ok
+      THEN set pen of pic;
+           plot (pic)
+      FI
+  PER  .
+
+this picture is ok:
+  pen (pic) <> 0 AND length (pic) > 0  .
+
+set pen of pic:
+  INT VAR colour, thick, type;
+  selected pen (p, pen (pic), colour, thick, type);
+  set pen (back, colour, thick, type)  .
+
+END PROC plot pictures;
+
+END PACKET plot
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Plotter b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter
new file mode 100644
index 0000000..a55e515
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Plotter
@@ -0,0 +1,247 @@
+PACKET plotter DEFINES plotter:               (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    13.10.89/22:31 *)
+                                              (*Änderung: 08.09.86/15:47 *)
+
+LET POS = STRUCT (REAL x, y, z);
+
+POS VAR pos :: POS : (0.0, 0.0, 0.0);
+INT VAR h :: 0, v :: 0;
+
+PROC move (REAL CONST x, y) :
+  transform (x, y, 0.0, h, v);
+  move (h, v);
+  pos := POS : (x, y, 0.0)
+END PROC move;
+
+PROC move (REAL CONST x, y, z) :
+  transform (x, y, z, h, v);
+  move (h, v);
+  pos := POS : (x, y, z)
+END PROC move;
+
+PROC draw (REAL CONST x, y) :
+  transform (x, y, 0.0, h, v);
+  draw (h, v);
+  pos := POS : (x, y, 0.0)
+END PROC draw;
+
+PROC draw (REAL CONST x, y, z) :
+  transform (x, y, z, h, v);
+  draw (h, v);
+  pos := POS : (x, y, z) 
+END PROC draw;
+
+PROC move r (REAL CONST x, y) :
+  transform (pos.x+x, pos.y+y, pos.z, h, v);
+  move (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC move r;
+
+PROC move r (REAL CONST x, y, z) :
+  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+  move (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC move r;
+
+PROC draw r (REAL CONST x, y) :
+  transform (pos.x+x, pos.y+y, pos.z, h, v); 
+  draw (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z)
+END PROC draw r;
+
+PROC draw r (REAL CONST x, y, z) :
+  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
+  draw (h, v);
+  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
+END PROC draw r;
+
+PROC draw (TEXT CONST msg, REAL CONST angle, height percent, width percent):
+  draw (msg, angle, height (height percent), width (width percent))  .
+END PROC draw;
+
+PROC mark (REAL CONST size, INT CONST no):
+  marker (h, v, no, diagonal (size))
+END PROC mark;
+
+PROC bar (REAL CONST width, height, INT CONST pattern):
+  INT VAR diff, up, zero x, zero y;
+  transform (0.0, 0.0, 0.0, zero x, zero y);
+  transform (width*0.5, height, 0.0, diff, up);
+  bar (h-(diff-zero x), v, h+(diff-zero x), v+(up-zero y), pattern);
+  move (h, v) 
+
+END PROC bar;
+
+PROC bar (REAL CONST from, to, height, INT CONST pattern):
+  INT VAR from h, to h, up;
+  transform (from, height, 0.0, from h, up);
+  transform (to,   height, 0.0, to h, up);
+  bar (from h, v, to h, up, pattern);
+  move (h, v) 
+
+END PROC bar;
+
+PROC circle (REAL CONST rad, from, to, INT CONST pattern):
+  circle (h, v, diagonal (rad), from, to, pattern)  .
+
+END PROC circle;
+
+
+(*                                                                       *)
+LET draw key      = 1,
+    move key      = 2,
+    text key      = 3,
+    move r key    = 4,
+    draw r key    = 5,
+    bar 2 key     = 6,
+    bar 3 key     = 7,
+    circle key    = 8,
+    mark key      = 9;
+
+LET dim error = "PICTURE not initialized",
+    key error = "wrong key code: ";
+
+TEXT VAR points;
+INT VAR pic length, pic pen, pic dim, read pos;
+PICTURE VAR pic;
+
+PROC plot (PICTURE CONST pic):
+  init plot;
+  IF pic dim = 2
+  THEN plot two dim pic
+  ELIF pic dim = 3
+  THEN plot three dim pic
+  ELIF NOT (pic dim = 0 AND pic length = 0)
+  THEN errorstop (dim error) FI;
+  points := ""  .
+
+init plot:
+  picture (pic, points, pic dim, pic pen);
+  pic length := length (points);
+  read pos := 0  .
+
+plot two dim pic:
+  WHILE read pos < pic length
+  REP plot two dim position PER  .
+
+plot two dim position :
+  read pos INCR 1;
+  SELECT key OF
+  CASE draw key:   draw (next real, next real)
+  CASE move key:   move (next real, next real)
+  CASE move r key: move r (next real, next real)
+  CASE draw r key: draw r (next real, next real)
+  CASE text key:   draw (next text, next real, next real, next real)
+  CASE bar 2 key:  bar (next real, next real, next int) 
+  CASE bar 3 key:  bar (next real, next real, next real, next int) 
+  CASE circle key: circle (next real, next real, next real, next int) 
+  CASE mark key:   mark (next real, next int) 
+  OTHERWISE errorstop (key error + text (key)) END SELECT  . 
+
+plot three dim pic:
+  WHILE read pos < pic length
+  REP plot three dim position  PER  .
+
+plot three dim position :
+  read pos INCR 1;
+  SELECT key OF
+  CASE draw key:   draw (next real, next real, next real)
+  CASE move key:   move (next real, next real, next real)
+  CASE move r key: move r (next real, next real, next real)
+  CASE draw r key: draw r (next real, next real, next real)
+  CASE text key:   draw (next text, next real, next real, next real)
+  CASE bar 2 key:  bar (next real, next real, next int) 
+  CASE bar 3 key:  bar (next real, next real, next real, next int)
+  CASE circle key: circle (next real, next real, next real, next int) 
+  CASE mark key:   mark (next real, next int) 
+  OTHERWISE errorstop (key error + text (key)) END SELECT  . 
+
+key:
+  code (points SUB read pos)  .
+
+END PROC plot;
+
+REAL PROC next real:
+  read pos INCR 8;
+  subtext (points, read pos-7, read pos) RSUB 1  .
+END PROC next real;
+
+INT PROC next int:
+  read pos INCR 2;
+  subtext (points, read pos-1, read pos) ISUB 1  .
+END PROC next int;
+
+TEXT PROC next text:
+  INT CONST text length :: next int;
+  read pos INCR text length;
+  subtext (points, read pos-text length+1, read pos)  .
+END PROC next text;
+
+PROC plotter (TEXT CONST name) :
+  PICFILE VAR p :: old (name);
+  plotter (p);
+END PROC plotter;
+
+PROC plotter (PICFILE VAR p) :
+  set projektion;
+  disable stop;
+  begin plot;
+  clear screen;
+  plot pictures (p);
+  errorcheck;
+  end plot  .
+
+set projektion:
+  ROW 3 ROW 2 REAL VAR size;
+  ROW 2 ROW 2 REAL VAR limit;
+  ROW 4 REAL VAR angles;
+  ROW 2 REAL VAR oblique;
+  ROW 3 REAL VAR perspective;
+  get values (p, size, limit, angles, oblique, perspective);
+  set values (size, limit, angles, oblique, perspective)  .
+
+clear screen:
+  INT VAR x0, y0, x1, y1, h max, v max;
+  REAL VAR x cm, y cm;
+
+  IF background (p) > -1
+  THEN clear
+  ELSE drawing area (x cm, y cm, h max, v max);
+       new values (x cm, y cm, h max, v max, x0, x1 , y0, y1);
+       set range (max (0, x0), max (0, y0), min (h max, x1), min (v max, y1))
+  FI  .
+
+errorcheck:
+  IF is error
+  THEN line;
+       put line ("Erorr at PICTURE No " + text (picture no (p)));
+  FI  .
+
+END PROC plotter;
+
+PROC plot pictures (PICFILE VAR p):
+  INT VAR back :: abs (background (p)), no;
+  enable stop;
+  FOR no FROM 1 UPTO pictures (p)
+  REP to pic (p, no);
+      read picture (p, pic);
+
+      IF this picture is ok
+      THEN set pen of pic;
+           plot (pic)
+      FI
+  PER  .
+
+this picture is ok:
+  pen (pic) <> 0 AND length (pic) > 0  .
+
+set pen of pic:
+  INT VAR colour, thick, type;
+  selected pen (p, pen (pic), colour, thick, type);
+  set pen (back, colour, thick, type)  .
+
+END PROC plot pictures;
+
+END PACKET plotter
+
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Server b/system/std.graphik/1.8.7/src/GRAPHIK.Server
new file mode 100644
index 0000000..dfe5f62
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Server
@@ -0,0 +1,97 @@
+PACKET multi user plotter:                       (* Autor : Rudolf Ruland  *)
+                                                 (* Stand : 24.03.86       *)
+                                              (*Änderung: 09.09.86/15:32 *)
+ 
+INT VAR c;
+put ("gib Plotterkanal : "); get (c);
+
+  server channel (c);
+  station only (FALSE) ;
+  spool duty ("Ausgabe mit dem Plotter");
+  spool control task (myself);
+ 
+LET ack              = 0 ,
+ 
+    fetch code       = 11 ,
+    param fetch code = 21 ,
+    picfile type     = 1103 ;
+
+INT VAR reply, old heap size, sender station;
+TEXT VAR picfile name, userid, password, sendername;
+PICFILE VAR picfile ;
+
+DATASPACE VAR ds, picfile ds;
+ 
+BOUND STRUCT (TEXT picfile name, userid, password, sendername, INT station) VAR msg;
+BOUND TEXT VAR error msg ;
+ 
+spool manager (PROC plotter);
+ 
+PROC plotter :
+
+  disable stop ;
+  command dialogue (FALSE);
+  ds := nilspace; picfile ds := nilspace; 
+  continue (server channel) ;
+    check error ("Kanal belegt");
+ 
+  old heap size := heap size ;
+  REP
+    execute plot ;
+ 
+    IF is error
+      THEN put error;
+           clear error;
+    FI ;
+ 
+    IF heap size > old heap size + 4
+      THEN collect heap garbage ;
+           old heap size := heap size
+    FI
+  PER 
+ 
+ENDPROC plotter ;
+
+ 
+PROC execute plot :
+
+  enable stop ;
+  forget (picfile ds) ; picfile ds := nilspace ;
+  call (father, fetch code, picfile ds, reply) ;
+  IF reply = ack CAND type (picfile ds) = picfile type
+     THEN get picfile params;
+          plot picfile
+  FI ;
+ 
+. get picfile params :
+    forget (ds); ds := nilspace;
+    call (father, param fetch code, ds, reply);
+    IF reply <> ack
+       THEN error msg := ds; errorstop (error msg);
+       ELSE msg := ds;
+            picfile name   := msg. picfile name;
+            userid         := msg. userid;
+            password       := msg. password;
+            sendername     := msg. sender name;
+            sender station := msg. station;
+    FI;
+ 
+. plot picfile :
+    picfile := picfile ds;
+    plotter (picfile)  .
+
+ENDPROC execute plot ;
+ 
+ 
+PROC check error (TEXT CONST message) :
+    IF is error
+       THEN clear error;
+            rename myself (message);
+            IF is error THEN clear error; end (myself) FI;
+            pause (18000);
+            end (myself);
+    FI;
+END PROC check error;
+ 
+ENDPACKET multi user plotter ;
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.Transform b/system/std.graphik/1.8.7/src/GRAPHIK.Transform
new file mode 100644
index 0000000..54690cc
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.Transform
@@ -0,0 +1,366 @@
+PACKET transformation DEFINES transform,      (* Autor: Heiko Indenbirken*)
+                              diagonal,       (* Stand: 12.04.85         *)
+                              height, width,  (*Änderung: 05.08.86/13:14 *)
+                              set values,     (*Änderung: 17.09.86/19:57 *)
+                              get values,
+                              new values,
+                              projektion,
+                              window,
+                              viewport,
+                              view,
+                              oblique,
+                              orthographic,
+                              perspective:
+(* *******************  Hardwareunabhängiger Teil  ********************* *)
+(*     transform:   Die Prozedur projeziert einen 3-dimensionalen Vektor *)
+(*     ----------   (x, y, z) auf einen 2-dimensionalen (h, v)           *)
+(*     diagonal     Die Prozedur berechnet die Pixel als Prozent der     *)
+(*     ----------   Diagonalen der Zeichenfläche                         *)
+(*     height       Die Prozedur berechnet die Pixel als Prozent der     *)
+(*     ----------   Höhe der Zeichenfläche                               *)
+(*     width        Die Prozedur berechnet die Pixel als Prozent der     *)
+(*     ----------   Breite der Zeichenfläche                             *)
+(*                                                                       *)
+(*     set values:  Mit dieser Prozedur werden die Projektionsparameter  *)
+(*     -----------  gesetzt.                                             *)
+(*                  size:          Weltkoordinatenbereich                *)
+(*                           ((xmin,xmax),(ymin,ymax),(zmin,zmax))       *)
+(*                  limits:  Zeichenfläche                               *)
+(*                           ((h min, h max), (v min, v max))            *)
+(*                           Bei Werten < 2.0 werden die Werte als       *)
+(*                           Prozente interpretiert, ansonsten als       *)
+(*                           cm-Grössen.                                 *)
+(*     get values:  Übergibt die aktuellen Werte                         *)
+(*     -----------                                                       *)
+(*     new values:  Berechnet die neue Projektionsmatrix                 *)
+(*     -----------                                                       *)
+(*=======================================================================*)
+
+BOOL VAR perspective projektion :: FALSE;
+INT VAR hor pixel, vert pixel, i;
+REAL VAR  hor cm, vert cm,
+          h min limit, h max limit, v min limit, v max limit;
+ROW 5 ROW 5 REAL VAR p;
+ROW 3 ROW 2 REAL VAR size;
+ROW 2 ROW 2 REAL VAR limits;
+ROW 4 REAL VAR angles;
+ROW 2 REAL VAR obliques;
+ROW 3 REAL VAR perspectives;
+
+(*                 Initialisieren der Projektionsmatrizen                *)
+INT VAR d;
+window (0.0, 1.0, 0.0, 1.0, 0.0, 1.0);
+viewport (0.0, 0.0, 0.0, 0.0);
+view (0.0, 0.0, 1.0);
+view (0.0);
+orthographic;
+new values  (27.46, 19.21, 274, 192, d, d, d, d);
+
+PROC projektion (ROW 5 ROW 5 REAL VAR matrix):
+  matrix := p
+END PROC projektion;
+
+PROC oblique (REAL CONST a, b) :
+  set values (size, limits, angles, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) 
+END PROC oblique;
+
+PROC orthographic :
+  set values (size, limits, angles, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0))
+END PROC orthographic;
+
+PROC perspective (REAL CONST cx, cy, cz) :
+  set values (size, limits, angles, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy, cz))
+END PROC perspective;
+
+PROC window (REAL CONST x min, x max, y min, y max) :
+  window (x min, x max, y min, y max, 0.0, 1.0)
+END PROC window;
+
+PROC window (REAL CONST x min, x max, y min, y max, z min, z max) :
+  set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
+                                  ROW 2 REAL : (y min, y max),
+                                  ROW 2 REAL : (z min, z max)),
+              limits, angles, obliques, perspectives)
+END PROC window;
+
+PROC viewport (REAL CONST h min, h max, v min, v max) :
+  set values (size, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), 
+                                        ROW 2 REAL : (v min, v max)),
+              angles, obliques, perspectives)
+END PROC view port;
+
+PROC view (REAL CONST alpha) :
+  set values (size, limits, ROW 4 REAL : (alpha, angles(2), angles (3), angles (4)),
+              obliques, perspectives)
+END PROC view;
+
+PROC view (REAL CONST phi, theta):
+  set values (size, limits, ROW 4 REAL : (angles (1), sind (theta) * cosd (phi),
+                                          sind (theta) * sind (phi), cosd (theta)),
+              obliques, perspectives)
+END PROC view;
+
+PROC view (REAL CONST x, y, z) :
+  set values (size, limits, ROW 4 REAL : (angles (1), x, y, z), obliques, perspectives)
+END PROC view;
+
+PROC get values (ROW 3 ROW 2 REAL VAR act size, 
+                 ROW 2 ROW 2 REAL VAR act limits,
+                 ROW 4 REAL VAR act angles,
+                 ROW 2 REAL VAR act obliques,
+                 ROW 3 REAL VAR act perspectives) : 
+  act size        := size;
+  act limits      := limits;
+  act angles      := angles;
+  act obliques     := obliques;
+  act perspectives := perspectives;
+
+END PROC get values;
+
+PROC set values (ROW 3 ROW 2 REAL CONST new size, 
+                 ROW 2 ROW 2 REAL CONST new limits,
+                 ROW 4 REAL CONST new angles,
+                 ROW 2 REAL CONST new obliques,
+                 ROW 3 REAL CONST new perspectives) : 
+  size        := new size;
+  limits      := new limits;
+  angles      := new angles;
+  obliques     := new obliques;
+  perspectives := new perspectives
+
+END PROC set values;
+
+PROC new values (INT VAR h min range, h max range, v min range, v max range):
+  new values (hor cm, vert cm, hor pixel, vert pixel, 
+              h min range, h max range, v min range, v max range)
+END PROC new values;
+
+PROC new values (REAL CONST size hor, size vert,
+                 INT CONST pixel hor, pixel vert,
+                 INT VAR h min range, h max range,
+                         v min range, v max range):
+   remember screensize;
+   calc views;
+   calc projektion; 
+   calc limits;
+   calc projection frame;
+   normalize projektion;
+   set picture range;
+   set perspective mark  .
+
+remember screensize:
+  hor cm     := size hor;
+  vert cm    := size vert;
+  hor pixel  := pixel hor;
+  vert pixel := pixel vert  .
+
+calc views :
+  calc diagonale;
+  calc projektion;
+  calc angles;
+  calc normale;
+  calc matrix;
+  calc alpha angle  .
+
+calc diagonale:
+  REAL VAR diagonale := sqrt (angles [2] * angles [2] +
+                              angles [3] * angles [3] +
+                              angles [4] * angles [4])  .
+
+calc projektion:
+  REAL VAR projektion := sqrt (angles [2] * angles [2] +
+                               angles [4] * angles [4])  .
+
+calc angles:
+  REAL VAR sin p, cos p, sin t, cos t, sin a, cos a;
+
+  IF diagonale = 0.0
+  THEN sin p :=  0.0;  cos p :=  1.0;
+       sin t :=  0.0;  cos t :=  1.0
+  ELIF projektion = 0.0
+  THEN sin p :=  angles [3] / diagonale;
+       cos p :=  projektion / diagonale;
+       sin t :=  0.0;  cos t :=  1.0
+  ELSE sin p :=  angles [3] / diagonale;
+       cos p :=  projektion / diagonale;
+       sin t :=  angles [2] / projektion;
+       cos t :=  angles [4] / projektion
+  FI  .
+
+calc normale:
+  REAL VAR   sin p sin t := sin p * sin t,
+             sin p cos t := sin p * cos t,
+             cos p sin t := cos p * sin t,
+             cos p cos t := cos p * cos t,
+
+             dx          := size [1][2] - size [1][1],
+             dy          := size [2][2] - size [2][1],
+             dz          := size [3][2] - size [3][1],
+             norm az     := obliques [1] ,
+             norm bz     := obliques [2] ,
+             norm cx     := perspectives [1] / dx,
+             norm cy     := perspectives [2] / dy,
+             norm cz     := perspectives [3] / dz  .
+
+calc matrix:
+p :=  ROW 5 ROW 5 REAL :
+      (ROW 5 REAL : (  cos t       / dx - cos p sin t / dx * norm az ,
+                     - sin p sin t / dx - cos p sin t / dx * norm bz,
+                       0.0,
+                                        - cos p sin t / dx * norm cz,
+                       0.0 ),
+       ROW 5 REAL : (                   - sin p       / dy * norm az,
+                       cos p       / dy - sin p       / dy * norm bz,
+                       0.0, 
+                                        - sin p       / dy * norm cz,
+                       0.0 ),
+       ROW 5 REAL : (  sin t       / dz + cos p cos t / dz * norm az,
+                     + sin p cos t / dz + cos p cos t / dz * norm bz,
+                       0.0,
+                                        cos p cos t / dz * norm cz,
+                       0.0 ),
+       ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ),
+       ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0))  .
+
+calc alpha angle:
+  IF angles (1) = 0.0
+  THEN set alpha as y vertical
+  ELSE sin a := sind (angles (1));
+       cos a := cosd (angles (1))
+  FI  .
+ 
+set alpha as y vertical :
+  REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2);
+  IF r = 0.0
+  THEN sin a := 0.0;
+       cos a := 1.0
+  ELSE sin a :=-p(2)(1)/r;
+       cos a := p(2)(2)/r
+  FI  .
+
+calc limits :
+  IF limits as percent
+  THEN calc percent limits
+  ELSE calc centimeter limits FI  .
+
+limits as percent:
+  limits [1][2] < 2.0 AND limits [2][2] < 2.0  .
+
+max limits:
+  h min limit := 0.0;
+
+  v min limit := 0.0;
+  v max limit := real (pixel vert)  .
+
+calc percent limits:
+  h min limit := real (pixel hor) * limits (1)(1)*size vert / size hor;
+  v min limit := limits (2)(1) * real (pixel vert);
+
+  IF limits [1][2] = 0.0
+  THEN h max limit := real (pixel hor)
+  ELSE h max limit := real (pixel hor) * limits [1][2]*size vert / size hor FI;
+
+  IF limits [2][2] = 0.0
+  THEN v max limit := real (pixel vert)
+  ELSE v max limit := limits (2)(2) * real (pixel vert)  FI  .
+
+calc centimeter limits:
+  h min limit := real (pixel hor) * (limits (1)(1)/size hor);
+  v min limit := real (pixel vert) * (limits (2)(1)/size vert);
+
+  IF limits [1][2] = 0.0
+  THEN h max limit := real (pixel hor)
+  ELSE h max limit := real (pixel hor) * (limits (1)(2)/size hor) FI;
+ 
+  IF limits [2][2] = 0.0
+  THEN v max limit := real (pixel vert)
+  ELSE v max limit := real (pixel vert) * (limits (2)(2)/size vert) FI  .
+
+calc projection frame:
+  REAL VAR h min := max real,  h max :=-max real,
+           v min := max real,  v max :=-max real;
+ 
+  extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); 
+  extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max);
+  extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); 
+  extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max);
+  extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); 
+  extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max);
+  extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); 
+  extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max)  .
+
+normalize projektion :
+  REAL VAR sh := (h max limit - h min limit) / (h max - h min),
+           sv := (v max limit - v min limit) / (v max - v min),
+           dh := h min limit - h min*sh,
+           dv := v min limit - v min*sv;
+
+  FOR i FROM 1 UPTO 5
+  REP REAL CONST p  i 1 := p (i)(1);
+      p (i)(1) :=  (p  i  1  * cos a - p (i)(2) * sin a) * sh;
+      p (i)(2) :=  (p  i  1  * sin a + p (i)(2) * cos a) * sv
+  PER;
+  p (5)(1) := dh;
+  p (5)(2) := dv  .
+
+set picture range:
+  h min range := int (h min limit-0.5);
+  h max range := int (h max limit+0.5);
+  v min range := int (v min limit-0.5);
+  v max range := int (v max limit+0.5)  .
+
+set perspective mark:
+  perspective projektion := perspectives [3] <> 0.0  .
+
+END PROC new values;
+ 
+PROC transform (REAL CONST x, y, z, INT VAR h, v) :
+  IF perspective projektion
+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+       h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1));
+       v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2))
+  ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1));
+       v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2));
+  FI;
+END PROC transform;
+
+PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max):
+  REAL VAR h, v;
+  IF perspective projektion
+  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
+       h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w;
+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w
+  ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1));
+       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2))
+  FI;
+ 
+ IF h < h min
+ THEN h min := h
+ ELIF h > h max
+ THEN h max := h FI;
+
+ IF v < v min
+ THEN v min := v
+ ELIF v > v max
+ THEN v max := v FI
+
+END PROC extrema;
+
+INT PROC diagonal (REAL CONST percent):
+  int (percent * 0.01 * diagonale + 0.5)  .
+
+diagonale:
+  sqrt ((h max limit-h min limit) ** 2 + (v max limit-v min limit) ** 2) .
+
+END PROC diagonal;
+
+INT PROC height (REAL CONST percent):
+  int (percent * 0.01 * (v max limit-v min limit) + 0.5)
+END PROC height;
+
+INT PROC width (REAL CONST percent):
+  int (percent * 0.01 * (h max limit-h min limit) + 0.5)
+END PROC width;
+
+END PACKET transformation
+
diff --git a/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot
new file mode 100644
index 0000000..8bef1e4
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/GRAPHIK.vektor plot
@@ -0,0 +1,506 @@
+PACKET clipping DEFINES set range,            (*Autor: Heiko Indenbirken *)
+                        get range,            (*Stand:    27.06.85/12:39 *)
+                        clip:                 (*Änderung: 11.08.86/15:02 *)
+
+INT VAR x min :: 0, x max :: 1024, y min :: 0, y max :: 1024;
+
+PROC set range (INT CONST h min, v min, h max, v max):
+  IF h min >= h max OR v min >= v max
+  THEN errorstop ("Incorrect Range") FI;
+  x min := h min;  x max := h max;
+  y min := v min;  y max := v max
+END PROC set range;
+
+PROC get range (INT VAR h min, v min, h max, v max):
+  h min := x min;  h max := x max;
+  v min := y min;  v max := y max
+END PROC get range;
+
+PROC clip (INT CONST from x, from y, to x, to y,
+           PROC (INT CONST, INT CONST) move,
+           PROC (INT CONST, INT CONST) draw):
+  INT VAR x, y;
+  calculate parts of line;
+  IF both points inside
+  THEN draw (to x, to y)
+  ELIF both points outside
+  THEN 
+  ELIF first point outside
+  THEN intersection (to x, to y, from x, from y, from part, x, y);
+       move (x, y);
+       draw (x, y);                                    (* Macke im SHARD *)
+       draw (to x, to y)
+  ELIF second point outside
+  THEN intersection (from x, from y, to x, to y, to part, x, y);
+       draw (x, y)
+  ELSE intersection (to x, to y, from x, from y, from part, x, y);
+       move (x, y);
+       draw (x, y);                                    (* Macke im SHARD *)
+       clip (x, y, to x, to y,  PROC (INT CONST, INT CONST) move,
+                                PROC (INT CONST, INT CONST) draw)
+  FI  .
+
+calculate parts of line:
+  INT CONST from part :: part (from x, from y),
+            to part   :: part (to x, to y)  .
+
+both points inside:
+  from part = 0 AND to part = 0  .
+
+both points outside:
+  (from part AND to part) <> 0  .
+
+first point outside:
+  from part <> 0 AND to part = 0  .
+
+second point outside:
+  to part <> 0 AND from part = 0  .
+
+END PROC clip;
+
+INT PROC part (INT CONST x, y):
+  INT VAR index :: 0;
+  IF x > x max
+  THEN set bit (index, 0)
+  ELIF x < x min
+  THEN set bit (index, 1) FI;
+
+  IF y > y max
+  THEN set bit (index, 2)
+  ELIF y < y min
+  THEN set bit (index, 3) FI;
+
+  index
+
+END PROC part;
+
+PROC intersection (INT CONST from x, from y, to x, to y, to part, INT VAR x, y):
+  SELECT to part OF
+  CASE  1: right side
+  CASE  2: left side 
+  CASE  4: up side 
+  CASE  5: upright side 
+  CASE  6: upleft side 
+  CASE  8: down side 
+  CASE  9: downright side 
+  CASE 10: downleft side
+  OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT  .
+
+right side:
+  y := from y + int (real (x max-from x)*(dy/dx));
+  x := x max  .
+
+left side:
+  y := from y + int (real (x min-from x)*(dy/dx));
+  x := x min  .
+
+up side:
+  x := from x + int (real (y max-from y)*(dx/dy));
+  y := y max  .
+
+down side:
+  x := from x + int (real (y min-from y)*(dx/dy));
+  y := y min  .
+
+upright side:
+  right side;
+  IF y > y max
+  THEN up side FI  .
+
+downright side:
+  right side;
+  IF y < y min
+  THEN down side FI  . 
+
+upleft side:
+  left side;
+  IF y > y max
+  THEN up side FI  .
+
+downleft side:
+  left side;
+  IF y < y min
+  THEN down side FI  .
+
+dx: real (to x-from x)  .
+dy: real (to y-from y)  .
+
+END PROC intersection;
+
+END PACKET clipping;
+
+PACKET thick line DEFINES thick:              (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    02.07.85/15:07 *)
+                                              (*Änderung: 05.08.86/15:52 *)
+PROC thick (INT CONST x0, y0, x1, y1, thick,
+            PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  IF is point
+  THEN draw point
+  ELIF is horizontal line 
+  THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                        x0, y0, x1, y1, thick)
+  ELSE vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                      x0, y0, x1, y1, thick)
+  FI  .
+
+is point:
+  x0 = x1 AND y0 = y1  .
+
+is horizontal line:
+  abs (x0-x1) >= abs (y0-y1)  .
+
+draw point:
+  INT VAR i;
+  FOR i FROM -thick UPTO thick
+  REP line (x0-thick, y0+i, x0+thick, y0+i) PER  .
+
+END PROC thick;
+
+PROC horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                      INT CONST from x, from y, to x, to y, thick):
+  IF from x > to x
+  THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, 
+                        to x, to y, from x, from y, thick)
+  ELSE draw line FI  .
+
+draw line:
+  INT VAR i;
+  calculate increase;
+  calculate limit points;
+  FOR i FROM -thick UPTO thick
+  REP calculate delta x;
+      line (x start+delta x, y start+i, x end+delta x, y end+i)
+  PER  .
+
+calculate increase:
+  REAL VAR increase :: -dy / dx  .
+
+calculate limit points:
+  INT CONST x start :: from x - thick,
+            x end   :: to x   + thick,
+            y start :: from y + int (increase * real (thick)), 
+            y end   :: to y   - int (increase * real (thick))  .
+
+calculate delta x:
+  INT CONST delta x :: int (increase*real (i))  .
+
+dx: real (to x-from x)  .
+dy: real (to y-from y)  .
+
+END PROC horizontal line;
+
+PROC vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                    INT CONST from x, from y, to x, to y, thick):
+  IF from y > to y
+  THEN vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                      to x, to y, from x, from y, thick)
+  ELSE draw line FI  .
+
+draw line:
+  INT VAR i;
+  calculate increase;
+  calculate limit points;
+  FOR i FROM -thick UPTO thick
+  REP calculate delta y;
+      line (x start+i, y start+delta y, x end+i, y end+delta y)
+  PER  .
+
+calculate increase:
+  REAL VAR increase :: -dx / dy  .
+
+calculate limit points:
+  INT CONST x start :: from x + int (increase * real (thick)), 
+            x end   :: to x   - int (increase * real (thick)),
+            y start :: from y - thick,
+            y end   :: to y   + thick  .
+
+calculate delta y:
+  INT CONST delta y :: int (increase*real (i))  .
+
+dx: real (to x-from x)  .
+dy: real (to y-from y)  .
+
+END PROC vertical line;
+
+END PACKET thick line;
+
+PACKET graphik text DEFINES draw char,        (*Autor: Heiko Indenbirken *)
+                            zeichensatz:      (*Stand:    27.06.85/16:03 *)
+                                              (*Änderung: 28.06.85/19:06 *)
+                                              (*Änderung: 05.08.86/16:00 *)
+LET ZEICHENSATZ = ROW 255 TEXT;
+ZEICHENSATZ VAR zeichen;
+INT CONST char x :: 6, char y :: 10;
+
+zeichensatz ("ZEICHENSATZ");
+
+PROC zeichensatz (TEXT CONST name):
+  IF exists (name)
+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);
+       zeichen := new zeichen;
+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI
+END PROC zeichensatz;
+
+PROC draw char (INT CONST char no, INT CONST x, y, x size, y size, direction,
+                PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  TEXT CONST character :: zeichen [char no];
+  INT VAR n :: 1, x0, y0, x1, y1;
+  INT CONST len :: length (character);
+  WHILE n < len
+  REP value (character, n, x0, y0, x1, y1);
+      transform (x0, y0, x, y, x size, y size, direction);
+      transform (x1, y1, x, y, x size, y size, direction); 
+      line (x0, y0, x1, y1);
+      n INCR 4
+  PER  .
+
+END PROC draw char;
+
+PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1):
+  x0 := val (code (char SUB n));    y0 := val (code (char SUB n+1));
+  x1 := val (code (char SUB n+2));  y1 := val (code (char SUB n+3));
+END PROC value;
+
+INT PROC val (INT CONST n):
+  IF n > 127
+  THEN -256 OR n
+  ELSE n FI
+END PROC val;
+
+PROC transform (INT VAR x, y, INT CONST x0, y0, x size, y size, direction):
+  INT CONST old x :: x, old y :: y;
+  SELECT direction OF
+  CASE 0: x := x0 + x vektor;  y := y0 + y vektor
+  CASE 1: x := x0 - y vektor;  y := y0 + x vektor
+  CASE 2: x := x0 - x vektor;  y := y0 - y vektor
+  CASE 3: x := x0 + y vektor;  y := y0 - x vektor
+  ENDSELECT  .
+
+x vektor:
+  IF x size = 0
+  THEN old x
+  ELSE (old x*x size) DIV char x FI  .
+
+y vektor:
+  IF y size = 0
+  THEN old y
+  ELSE (old y*y size) DIV char y FI  .
+
+END PROC transform;
+
+END PACKET graphik text;
+
+PACKET graphik text DEFINES draw text:        (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    03.07.85/11:55 *)
+                                              (*Änderung: 05.08.86/16:04 *)
+PROC draw text (INT CONST x pos, y pos,
+                TEXT CONST msg, REAL CONST angle, INT CONST height, width,
+                PROC (INT CONST, INT CONST,
+                INT CONST, INT CONST, INT CONST, INT CONST) draw char):
+  INT CONST dir :: int (((angle MOD 360.0)+45.0) / 90.0);
+  INT VAR i;
+  REAL VAR x :: real (x pos), y :: real (y pos),
+           x step :: cosd (angle)*real (width),
+           y step :: sind (angle)*real (width);
+  FOR i FROM 1 UPTO length (msg)
+  REP IF control char
+      THEN execute control char
+      ELSE execute normal char FI
+  PER  .
+
+control char:
+  akt char < ""32""  .
+
+execute control char:
+  SELECT code (akt char) OF
+  CASE  1: home
+  CASE  2: right
+  CASE  3: up
+  CASE  7: out (""7"")
+  CASE  8: left
+  CASE 10: down
+  CASE 13: return
+  ENDSELECT  .
+
+home:
+  x := real (x pos);
+  y := real (y pos)  .
+
+right:
+  x INCR x step;  y INCR y step  . 
+
+up:
+  x INCR y step;  y INCR x step  . 
+
+left:
+  x DECR x step;  y DECR y step  .
+
+down:
+  x DECR y step;  y DECR x step  . 
+
+return:
+  x := real (x pos)  .
+
+execute normal char:
+  draw char (code (akt char), dir, int (x+0.5), int (y+0.5), height, width);
+  x INCR x step;
+  y INCR y step  .
+
+akt char:
+  msg SUB i  .
+
+END PROC draw text;
+
+END PACKET graphik text;
+
+PACKET comercial plot DEFINES bar,            (*Autor: Heiko Indenbirken *)
+                              circle:         (*Stand:    03.04.1985     *)
+                                              (*Änderung: 03.07.85/15:37 *)
+PROC bar (INT CONST from x, from y, to x, to y, pattern,
+          PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  IF from x > to x
+  THEN bar (to x, from y, from x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  ELIF from y > to y
+  THEN bar (from x, to y, to x, from y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  ELSE draw frame;
+       fill frame with pattern
+  FI  .
+
+draw frame:
+  line (from x, from y, from x, to y);
+  line (from x, to y, to x, to y);
+  line (to x, to y, to x, from y);
+  line (to x, from y, from x, from y)  .
+
+fill frame with pattern:
+  SELECT pattern OF
+  CASE 1: fill right (from x, to x, from y, to y, 2, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 2: fill hor   (from x, to x, from y, to y, 1, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 3: fill hor   (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 4: fill vert  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 5: fill hor   (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+          fill vert  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 6: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 7: fill left  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 8: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+          fill left  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  ENDSELECT  .
+
+END PROC bar;
+
+PROC fill hor (INT CONST from x, to x, from y, to y, step,
+               PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT VAR y :: from y;
+  REP line (from x, y, to x, y);
+      y INCR step
+  UNTIL y > to y PER  .
+
+END PROC fill hor;
+
+PROC fill vert (INT CONST from x, to x, from y, to y, step,
+                PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT VAR x :: from x;
+  REP line (x, from y, x, to y);
+      x INCR step
+  UNTIL x > to x PER  .
+
+END PROC fill vert;
+
+PROC fill right (INT CONST from x, to x, from y, to y, step,
+                 PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT CONST width  :: to x - from x,
+            height :: to y - from y,
+            length :: width + height,
+            height step :: height + step,
+            width step  :: width + step;
+
+  INT VAR t :: step, left  :: from x, right :: from x,
+                     lower :: from y, upper :: from y;
+(*               Ausfüllen von links unten nach rechts oben              *)
+  WHILE t < length
+  REP calc start point;
+      calc end point;
+      line (left, upper, right, lower);
+      t INCR step
+  PER  .
+
+calc start point:
+  IF t < height
+  THEN upper INCR step
+  ELIF t < height step
+  THEN left  := from x + t - height;
+       upper := to y
+  ELSE left INCR step FI  .
+
+calc end point:
+  IF t < width
+  THEN right INCR step
+  ELIF t < width step
+  THEN lower := from y + t - width;
+       right := to x
+  ELSE lower INCR step FI  .
+
+END PROC fill right;
+
+PROC fill left (INT CONST from x, to x, from y, to y, step,
+                PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT CONST width  :: to x - from x,
+            height :: to y - from y,
+            length :: width + height,
+            height step :: height + step,
+            width step  :: width + step;
+
+  INT VAR t :: step, left  :: to x,   right :: to x,
+                     lower :: from y, upper :: from y;
+(*               Ausfüllen von rechts unten nach links oben              *)
+  WHILE t < length
+  REP calc start point;
+      calc end point;
+      line (right, upper, left, lower);
+      t INCR step
+  PER  .
+
+calc start point:
+  IF t < height
+  THEN upper INCR step
+  ELIF t < height step
+  THEN right := to x - t + height;
+       upper := to y
+  ELSE right DECR step FI  .
+
+calc end point:
+  IF t < width
+  THEN left DECR step
+  ELIF t < width step
+  THEN lower := from y + t - width;
+       left  := from x
+  ELSE lower INCR step FI  .
+
+END PROC fill left;
+
+PROC circle (INT CONST x, y, REAL CONST rad, from, to, INT CONST pattern,
+             PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  REAL VAR t :: from;
+  INT VAR last x :: x, last y :: y;
+  WHILE t <= to
+  REP calc circle;
+      draw step;
+      t INCR 1.0
+  PER;
+  line (x rad, y rad, x, y)  .
+
+draw step:
+  IF pattern = 0
+  THEN line (last x, last y, x rad, y rad);
+       last x := x rad;
+       last y := y rad
+  ELSE line (x, y, x rad, y rad) FI  .
+
+calc circle:
+  INT CONST x rad :: int (cosd (t)*rad+0.5)+x,
+            y rad :: int (sind (t)*rad+0.5)+y  .
+
+END PROC circle;
+
+END PACKET comercial plot;
+
diff --git a/system/std.graphik/1.8.7/src/HP7475.plot b/system/std.graphik/1.8.7/src/HP7475.plot
new file mode 100644
index 0000000..860dd03
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/HP7475.plot
@@ -0,0 +1,254 @@
+PACKET hp7475 plot DEFINES set range,         (*Autor: Heiko Indenbirken *)
+                           get range,         (*Stand:    03.09.86/15:09 *)
+                           drawing area,
+                           begin plot,
+                           end plot,
+                           clear,
+
+                           set pen, get pen, 
+                           move, 
+                           draw,
+                           marker,
+                           bar, circle,
+                           where:
+
+(*                                                                       *)
+(*                     Hardware Anschluß des HP7475A:                    *)
+(*                  9600 Baud, 8 Bit, no parity, RTS/CTS                 *)
+(*   Leitungen                  1  -----  1                              *)
+(*   gekreuzt:                  2  --x--  3                              *)
+(*                              3  --x--  2                              *)
+(*                                                                       *)
+
+
+LET POS = STRUCT (INT x, y);
+LET RANGE = STRUCT (POS min, max);
+LET PEN = STRUCT (INT back, fore, thick, line);
+
+LET width scale  = 0.002690217391304,
+    height scale = 0.002728921124206;
+
+LET term  = ";",
+    comma = ",",
+    point = ".",
+    zero  = "0",
+    nil   = "",
+    etx   = ""3"";
+
+ 
+POS VAR old :: POS:(0, 0);
+RANGE VAR area :: RANGE:(POS:(0,0), POS:(11040, 7721));
+PEN VAR pen :: PEN : (0, 1, 0, 1);
+TEXT VAR result;
+
+ROW 16 TEXT VAR mark := ROW 16 TEXT:
+("99,0,2,-2,0,0,-4,4,0,0,4,-2,0;",
+"99,0,2,-1,0,-1,-1,0,-2,1,-1,2,0,1,1,0,2,-1,1,-1,0;",
+"99,0,2,-2,-3,4,0,-2,3;",
+"-99,-2,0,99,4,0,-99,-2,2,99,0,-4;",
+"-99,-2,-2,99,4,4,-99,-4,0,99,4,-4;",
+"99,0,2,-2,-2,2,-2,2,2,-2,2;",
+"-99,0,-2,99,0,4,-2,-2,4,0,-2,2;",
+"-99,-2,0,99,4,0,-99,-2,2,99,0,-4,2,2,-2,2,-2,-2,2,-2;",
+"-99,-2,-2,99,4,4,-4,0,4,-4;",
+"-99,-2,2,99,4,0,-4,-4,4,0;",
+"99,0,-2,-99,-2,4,99,2,-2,2,2;",
+"99,1,1,-2,0,0,-2,2,0,0,2,1,1,-99,-4,0,99,1,-1,-99,0,-2,99,-1,-1,-99,4,0,99,-1,1;",
+"-99,-2,0,99,4,0,-99,-1,1,99,-2,-2,-99,1,-1,99,0,4,-99,-1,-1,99,2,-2;",
+"-99,-2,2,99,4,0,-4,-4,4,0,-4,4;",
+"-99,-2,0,99,4,0;",
+"-99,0,299,0,-4;");
+
+ROW 5 TEXT CONST line pattern := ROW 5 TEXT:("LT;", "LT1;", "LT2;", "LT3;", "LT4;");
+ROW 8 TEXT CONST fill pattern := ROW 8 TEXT:("FT4,25,45;", "FT1,0,0;", "FT3,50,0;",
+                                 "FT3,50,90;", "FT4,50,0;", "FT3,50,-45;",
+                                 "FT3,50,45;", "FT4,50,45;");
+
+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) :
+   x cm    := 29.7;    y cm    := 21.07; 
+   x pixel := 11040;    y pixel :=  7721;
+END PROC drawing area;
+
+
+PROC set range (INT CONST h min, v min, h max, v max):
+  IF h min >= h max OR v min >= v max
+  THEN errorstop ("Incorrect Range") FI;
+  area := RANGE:(POS:(h min, v min), POS:(h max, v max))
+END PROC set range;
+
+PROC get range (INT VAR h min, v min, h max, v max):
+  h min := area.min.x;   v min := area.min.y;
+  h max := area.max.x;   v max := area.max.y
+END PROC get range;
+
+PROC begin plot: 
+  out ("IN;")
+ENDPROC begin plot;
+
+PROC end plot: 
+  TEXT VAR rec;
+  out ("IN;SP;PA22040,7721;DP;");
+  REP pause (10);
+      out ("OS;");
+      input (rec, ""13"", 600)
+  UNTIL enter pressed PER;
+  out ("IN;")  .
+
+enter pressed:
+  (int (rec) AND 4) > 0  .
+
+ENDPROC end plot;
+
+PROC clear:
+  new values (29.7, 21.07, 11040, 7721, area.min.x, area.max.x, area.min.y, area.max.y);
+  pen := PEN : (0, 1, 0, 1); 
+  old := area.min;
+  out ("DF;IP;");                                     (* Default     *)
+  out ("IW" + text (area.min.x, area.min.y) + ", " +  (* Clipping    *)
+               text (area.max.x, area.max.y) + term);
+  out ("SP1;");                                       (* Pen 1       *)
+  out ("LT;");                                        (* durchgehend *)
+  out ("PU;PA" + text (old.x, old.y));                (*  Startpunkt *)
+
+END PROC clear;
+
+PROC set pen (INT CONST back, fore, thick, type):
+  set colour;
+  set linetype  .
+
+set colour:
+  IF abs (fore) >= 1 AND abs (fore) <= 6
+  THEN out ("SP" + text (abs (fore)) + term);
+       pen.fore := abs (fore);
+  FI  .
+
+set linetype:
+  IF type >= 1 AND type <= 5
+  THEN out (line pattern [type]);
+       pen.line := type
+  ELSE out ("SP;");
+       pen.line := 0
+  FI  .
+
+END PROC set pen;
+
+PROC get pen (INT VAR back, fore, thick, line):
+  back  := pen.back;
+  fore  := pen.fore;
+  thick := pen.thick;
+  line  := pen.line
+END PROC get pen;
+
+PROC move (INT CONST x, y) :
+  out ("PU;PA" + text (x, y) + term);
+  old := POS : (x, y) 
+END PROC move;
+ 
+PROC draw (INT CONST x, y):
+  out ("PD;PA" + text (x, y) + term);
+  old := POS : (x, y)
+END PROC draw;
+
+PROC draw (TEXT CONST msg, REAL CONST angle, INT CONST height, width):
+  set angle;
+  set height and width;
+  plot msg  .
+
+set angle:
+  out ("DI " + text (cosd (angle), sind (angle)) + term)  .
+
+set height and width:
+  IF width = 0 AND height = 0
+  THEN out ("SR;")
+  ELSE out ("SI" + text (real (width) * width scale,
+                             real (height) * height scale) + term)
+  FI  .
+
+plot msg:
+  out ("LB" + msg + etx)  .
+
+END PROC draw;
+
+PROC bar (INT CONST from x, from y, to x, to y, pattern):
+  out ("PU;PA" + text (from x, from y) + term);
+  out ("LT;EA" + text (to x, to y) + term);
+  IF pattern > 0 AND pattern <= 8
+  THEN out (fill pattern [pattern]);
+       out ("RA" + text (to x, to y) + term);
+  FI;
+  out ("PU;PA" + text (old.x, old.y) + term);
+  out (line pattern [pen.line])  .
+
+END PROC bar;
+
+PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern):
+  out ("LT;PU;PA" + text (x, y) + term);
+  IF (from MOD 360.0) = 0.0 AND (to MOD 360.0) = 0.0
+  THEN out ("CI" + text (rad) + term)
+  ELSE out ("EW" + text (rad) + comma + text (from, to-from) + term) FI;
+
+  IF pattern > 0 AND pattern <= 6
+  THEN out (fill pattern [pattern]);
+       out ("WG" + text (rad) + comma + text (from, to-from) + term)
+  FI;
+  out ("PU;PA" + text (old.x, old.y) + term);
+  out (line pattern [pen.line])  .
+
+END PROC circle;
+
+PROC marker (INT CONST x, y, no, size):
+  out ("LT;PU;PA" + text (x, y) + term);
+  out ("DI1,0;");
+  IF size = 0
+  THEN out ("SI0.25,0.5;")
+  ELSE out ("SI" + text (real (size)*0.001, real (size)*0.002) + term) FI;
+  out ("UC" + mark [mark no]);
+  out ("PU;PA" + text (old.x, old.y) + term);
+  out (line pattern [pen.line])  .
+
+mark no:
+  IF no >= 1 AND no <= 16
+  THEN no
+  ELSE 1 FI  .
+
+END PROC marker;
+
+PROC where (INT VAR x, y):
+  x := old.x;  y := old.y
+END PROC where;
+
+TEXT PROC text (INT CONST x, y):
+  text (x) + comma + text (y)
+END PROC text;
+
+TEXT PROC text (REAL CONST x, y):
+  text (x) + comma + text (y)
+END PROC text;
+
+TEXT PROC text (REAL CONST x):
+  result := compress (text (x, 9, 4));
+
+  IF (result SUB 1) = point
+  THEN insert char (result, zero, 1)
+  ELIF (result SUB LENGTH result) = point
+  THEN result CAT zero FI;
+  result
+END PROC text;
+
+PROC input (TEXT VAR rec, TEXT CONST del, INT CONST time):
+  enable stop;
+  rec := nil;
+  REP TEXT CONST char := incharety (time);
+
+      IF char = nil
+      THEN errorstop ("Timeout after " + text (time))
+      ELIF pos (del, char) > 0
+      THEN LEAVE input
+      ELSE rec CAT char FI
+
+  PER  .
+
+END PROC input;
+
+END PACKET hp7475 plot
+
diff --git a/system/std.graphik/1.8.7/src/PC.plot b/system/std.graphik/1.8.7/src/PC.plot
new file mode 100644
index 0000000..712f5ea
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/PC.plot
@@ -0,0 +1,758 @@
+PACKET clipping DEFINES set range,            (*Autor: Heiko Indenbirken *)
+                        get range,            (*Stand:    27.06.85/12:39 *)
+                        clip:                 (*Änderung: 11.08.86/15:02 *)
+
+INT VAR x min :: 0, x max :: 1024, y min :: 0, y max :: 1024;
+
+PROC set range (INT CONST h min, v min, h max, v max):
+  IF h min >= h max OR v min >= v max
+  THEN errorstop ("Incorrect Range") FI;
+  x min := h min;  x max := h max;
+  y min := v min;  y max := v max
+END PROC set range;
+
+PROC get range (INT VAR h min, v min, h max, v max):
+  h min := x min;  h max := x max;
+  v min := y min;  v max := y max
+END PROC get range;
+
+PROC clip (INT CONST from x, from y, to x, to y,
+           PROC (INT CONST, INT CONST) move,
+           PROC (INT CONST, INT CONST) draw):
+  INT VAR x, y;
+  calculate parts of line;
+  IF both points inside
+  THEN draw (from x, from y);                          (* Macke im SHARD *)
+       draw (to x, to y)
+  ELIF both points outside
+  THEN 
+  ELIF first point outside
+  THEN intersection (to x, to y, from x, from y, from part, x, y);
+       move (x, y);
+       draw (x, y);                                    (* Macke im SHARD *)
+       draw (to x, to y)
+  ELIF second point outside
+  THEN intersection (from x, from y, to x, to y, to part, x, y);
+       draw (x, y)
+  ELSE intersection (to x, to y, from x, from y, from part, x, y);
+       move (x, y);
+       draw (x, y);                                    (* Macke im SHARD *)
+       clip (x, y, to x, to y,  PROC (INT CONST, INT CONST) move,
+                                PROC (INT CONST, INT CONST) draw)
+  FI  .
+
+calculate parts of line:
+  INT CONST from part :: part (from x, from y),
+            to part   :: part (to x, to y)  .
+
+both points inside:
+  from part = 0 AND to part = 0  .
+
+both points outside:
+  (from part AND to part) <> 0  .
+
+first point outside:
+  from part <> 0 AND to part = 0  .
+
+second point outside:
+  to part <> 0 AND from part = 0  .
+
+END PROC clip;
+
+INT PROC part (INT CONST x, y):
+  INT VAR index :: 0;
+  IF x > x max
+  THEN set bit (index, 0)
+  ELIF x < x min
+  THEN set bit (index, 1) FI;
+
+  IF y > y max
+  THEN set bit (index, 2)
+  ELIF y < y min
+  THEN set bit (index, 3) FI;
+
+  index
+
+END PROC part;
+
+PROC intersection (INT CONST from x, from y, to x, to y, to part, INT VAR x, y):
+  SELECT to part OF
+  CASE  1: right side
+  CASE  2: left side 
+  CASE  4: up side 
+  CASE  5: upright side 
+  CASE  6: upleft side 
+  CASE  8: down side 
+  CASE  9: downright side 
+  CASE 10: downleft side
+  OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT  .
+
+right side:
+  y := from y + int (real (x max-from x)*(dy/dx));
+  x := x max  .
+
+left side:
+  y := from y + int (real (x min-from x)*(dy/dx));
+  x := x min  .
+
+up side:
+  x := from x + int (real (y max-from y)*(dx/dy));
+  y := y max  .
+
+down side:
+  x := from x + int (real (y min-from y)*(dx/dy));
+  y := y min  .
+
+upright side:
+  right side;
+  IF y > y max
+  THEN up side FI  .
+
+downright side:
+  right side;
+  IF y < y min
+  THEN down side FI  . 
+
+upleft side:
+  left side;
+  IF y > y max
+  THEN up side FI  .
+
+downleft side:
+  left side;
+  IF y < y min
+  THEN down side FI  .
+
+dx: real (to x-from x)  .
+dy: real (to y-from y)  .
+
+END PROC intersection;
+
+END PACKET clipping;
+
+PACKET thick line DEFINES thick:              (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    02.07.85/15:07 *)
+                                              (*Änderung: 05.08.86/15:52 *)
+PROC thick (INT CONST x0, y0, x1, y1, thick,
+            PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  IF is point
+  THEN draw point
+  ELIF is horizontal line 
+  THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                        x0, y0, x1, y1, thick)
+  ELSE vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                      x0, y0, x1, y1, thick)
+  FI  .
+
+is point:
+  x0 = x1 AND y0 = y1  .
+
+is horizontal line:
+  abs (x0-x1) >= abs (y0-y1)  .
+
+draw point:
+  INT VAR i;
+  FOR i FROM -thick UPTO thick
+  REP line (x0-thick, y0+i, x0+thick, y0+i) PER  .
+
+END PROC thick;
+
+PROC horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                      INT CONST from x, from y, to x, to y, thick):
+  IF from x > to x
+  THEN horizontal line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line, 
+                        to x, to y, from x, from y, thick)
+  ELSE draw line FI  .
+
+draw line:
+  INT VAR i;
+  calculate increase;
+  calculate limit points;
+  FOR i FROM -thick UPTO thick
+  REP calculate delta x;
+      line (x start+delta x, y start+i, x end+delta x, y end+i)
+  PER  .
+
+calculate increase:
+  REAL VAR increase :: -dy / dx  .
+
+calculate limit points:
+  INT CONST x start :: from x - thick,
+            x end   :: to x   + thick,
+            y start :: from y + int (increase * real (thick)), 
+            y end   :: to y   - int (increase * real (thick))  .
+
+calculate delta x:
+  INT CONST delta x :: int (increase*real (i))  .
+
+dx: real (to x-from x)  .
+dy: real (to y-from y)  .
+
+END PROC horizontal line;
+
+PROC vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                    INT CONST from x, from y, to x, to y, thick):
+  IF from y > to y
+  THEN vertical line (PROC (INT CONST, INT CONST, INT CONST, INT CONST) line,
+                      to x, to y, from x, from y, thick)
+  ELSE draw line FI  .
+
+draw line:
+  INT VAR i;
+  calculate increase;
+  calculate limit points;
+  FOR i FROM -thick UPTO thick
+  REP calculate delta y;
+      line (x start+i, y start+delta y, x end+i, y end+delta y)
+  PER  .
+
+calculate increase:
+  REAL VAR increase :: -dx / dy  .
+
+calculate limit points:
+  INT CONST x start :: from x + int (increase * real (thick)), 
+            x end   :: to x   - int (increase * real (thick)),
+            y start :: from y - thick,
+            y end   :: to y   + thick  .
+
+calculate delta y:
+  INT CONST delta y :: int (increase*real (i))  .
+
+dx: real (to x-from x)  .
+dy: real (to y-from y)  .
+
+END PROC vertical line;
+
+END PACKET thick line;
+
+PACKET graphik text DEFINES draw char,        (*Autor: Heiko Indenbirken *)
+                            zeichensatz:      (*Stand:    27.06.85/16:03 *)
+                                              (*Änderung: 28.06.85/19:06 *)
+                                              (*Änderung: 05.08.86/16:00 *)
+LET ZEICHENSATZ = ROW 255 TEXT;
+ZEICHENSATZ VAR zeichen;
+INT CONST char x :: 6, char y :: 10;
+
+zeichensatz ("ZEICHENSATZ");
+
+PROC zeichensatz (TEXT CONST name):
+  IF exists (name)
+  THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);
+       zeichen := new zeichen;
+  ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI
+END PROC zeichensatz;
+
+PROC draw char (INT CONST char no, INT CONST x, y, x size, y size, direction,
+                PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  TEXT CONST character :: zeichen [char no];
+  INT VAR n :: 1, x0, y0, x1, y1;
+  INT CONST len :: length (character);
+  WHILE n < len
+  REP value (character, n, x0, y0, x1, y1);
+      transform (x0, y0, x, y, x size, y size, direction);
+      transform (x1, y1, x, y, x size, y size, direction); 
+      line (x0, y0, x1, y1);
+      n INCR 4
+  PER  .
+
+END PROC draw char;
+
+PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1):
+  x0 := val (code (char SUB n));    y0 := val (code (char SUB n+1));
+  x1 := val (code (char SUB n+2));  y1 := val (code (char SUB n+3));
+END PROC value;
+
+INT PROC val (INT CONST n):
+  IF n > 127
+  THEN -256 OR n
+  ELSE n FI
+END PROC val;
+
+PROC transform (INT VAR x, y, INT CONST x0, y0, x size, y size, direction):
+  INT CONST old x :: x, old y :: y;
+  SELECT direction OF
+  CASE 0: x := x0 + x vektor;  y := y0 + y vektor
+  CASE 1: x := x0 - y vektor;  y := y0 + x vektor
+  CASE 2: x := x0 - x vektor;  y := y0 - y vektor
+  CASE 3: x := x0 + y vektor;  y := y0 - x vektor
+  ENDSELECT  .
+
+x vektor:
+  IF x size = 0
+  THEN old x
+  ELSE (old x*x size) DIV char x FI  .
+
+y vektor:
+  IF y size = 0
+  THEN old y
+  ELSE (old y*y size) DIV char y FI  .
+
+END PROC transform;
+
+END PACKET graphik text;
+
+PACKET graphik text DEFINES draw text:        (*Autor: Heiko Indenbirken *)
+                                              (*Stand:    03.07.85/11:55 *)
+                                              (*Änderung: 05.08.86/16:04 *)
+PROC draw text (INT CONST x pos, y pos,
+                TEXT CONST msg, REAL CONST angle, INT CONST height, width,
+                PROC (INT CONST, INT CONST,
+                INT CONST, INT CONST, INT CONST, INT CONST) draw char):
+  INT CONST dir :: int (((angle MOD 360.0)+45.0) / 90.0);
+  INT VAR i;
+  REAL VAR x :: real (x pos), y :: real (y pos),
+           x step :: cosd (angle)*real (width),
+           y step :: sind (angle)*real (width);
+  FOR i FROM 1 UPTO length (msg)
+  REP IF control char
+      THEN execute control char
+      ELSE execute normal char FI
+  PER  .
+
+control char:
+  akt char < ""32""  .
+
+execute control char:
+  SELECT code (akt char) OF
+  CASE  1: home
+  CASE  2: right
+  CASE  3: up
+  CASE  7: out (""7"")
+  CASE  8: left
+  CASE 10: down
+  CASE 13: return
+  ENDSELECT  .
+
+home:
+  x := real (x pos);
+  y := real (y pos)  .
+
+right:
+  x INCR x step;  y INCR y step  . 
+
+up:
+  x INCR y step;  y INCR x step  . 
+
+left:
+  x DECR x step;  y DECR y step  .
+
+down:
+  x DECR y step;  y DECR x step  . 
+
+return:
+  x := real (x pos)  .
+
+execute normal char:
+  draw char (code (akt char), dir, int (x+0.5), int (y+0.5), height, width);
+  x INCR x step;
+  y INCR y step  .
+
+akt char:
+  msg SUB i  .
+
+END PROC draw text;
+
+END PACKET graphik text;
+
+PACKET comercial plot DEFINES bar,            (*Autor: Heiko Indenbirken *)
+                              circle:         (*Stand:    03.04.1985     *)
+                                              (*Änderung: 03.07.85/15:37 *)
+PROC bar (INT CONST from x, from y, to x, to y, pattern,
+          PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  IF from x > to x
+  THEN bar (to x, from y, from x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  ELIF from y > to y
+  THEN bar (from x, to y, to x, from y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  ELSE draw frame;
+       fill frame with pattern
+  FI  .
+
+draw frame:
+  line (from x, from y, from x, to y);
+  line (from x, to y, to x, to y);
+  line (to x, to y, to x, from y);
+  line (to x, from y, from x, from y)  .
+
+fill frame with pattern:
+  SELECT pattern OF
+  CASE 1: fill right (from x, to x, from y, to y, 2, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 2: fill hor   (from x, to x, from y, to y, 1, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 3: fill hor   (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 4: fill vert  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 5: fill hor   (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+          fill vert  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 6: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 7: fill left  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  CASE 8: fill right (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line);
+          fill left  (from x, to x, from y, to y, 5, PROC (INT CONST, INT CONST, INT CONST, INT CONST) line)
+  ENDSELECT  .
+
+END PROC bar;
+
+PROC fill hor (INT CONST from x, to x, from y, to y, step,
+               PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT VAR y :: from y;
+  REP line (from x, y, to x, y);
+      y INCR step
+  UNTIL y > to y PER  .
+
+END PROC fill hor;
+
+PROC fill vert (INT CONST from x, to x, from y, to y, step,
+                PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT VAR x :: from x;
+  REP line (x, from y, x, to y);
+      x INCR step
+  UNTIL x > to x PER  .
+
+END PROC fill vert;
+
+PROC fill right (INT CONST from x, to x, from y, to y, step,
+                 PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT CONST width  :: to x - from x,
+            height :: to y - from y,
+            length :: width + height,
+            height step :: height + step,
+            width step  :: width + step;
+
+  INT VAR t :: step, left  :: from x, right :: from x,
+                     lower :: from y, upper :: from y;
+(*               Ausfüllen von links unten nach rechts oben              *)
+  WHILE t < length
+  REP calc start point;
+      calc end point;
+      line (left, upper, right, lower);
+      t INCR step
+  PER  .
+
+calc start point:
+  IF t < height
+  THEN upper INCR step
+  ELIF t < height step
+  THEN left  := from x + t - height;
+       upper := to y
+  ELSE left INCR step FI  .
+
+calc end point:
+  IF t < width
+  THEN right INCR step
+  ELIF t < width step
+  THEN lower := from y + t - width;
+       right := to x
+  ELSE lower INCR step FI  .
+
+END PROC fill right;
+
+PROC fill left (INT CONST from x, to x, from y, to y, step,
+                PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  INT CONST width  :: to x - from x,
+            height :: to y - from y,
+            length :: width + height,
+            height step :: height + step,
+            width step  :: width + step;
+
+  INT VAR t :: step, left  :: to x,   right :: to x,
+                     lower :: from y, upper :: from y;
+(*               Ausfüllen von rechts unten nach links oben              *)
+  WHILE t < length
+  REP calc start point;
+      calc end point;
+      line (right, upper, left, lower);
+      t INCR step
+  PER  .
+
+calc start point:
+  IF t < height
+  THEN upper INCR step
+  ELIF t < height step
+  THEN right := to x - t + height;
+       upper := to y
+  ELSE right DECR step FI  .
+
+calc end point:
+  IF t < width
+  THEN left DECR step
+  ELIF t < width step
+  THEN lower := from y + t - width;
+       left  := from x
+  ELSE lower INCR step FI  .
+
+END PROC fill left;
+
+PROC circle (INT CONST x, y, rad, REAL CONST  from, to, INT CONST pattern,
+             PROC (INT CONST, INT CONST, INT CONST, INT CONST) line):
+  REAL VAR t :: from;
+  INT VAR last x :: x, last y :: y;
+  WHILE t <= to
+  REP calc circle;
+      draw step;
+      t INCR 5.0
+  PER;
+  line (x rad, y rad, x, y)  .
+
+draw step:
+  IF pattern = 0
+  THEN line (last x, last y, x rad, y rad);
+       last x := x rad;
+       last y := y rad
+  ELSE line (x, y, x rad, y rad) FI  .
+
+calc circle:
+  INT CONST x rad :: int (cosd (t)*real (rad)+0.5)+x,
+            y rad :: int (sind (t)*real (rad)+0.5)+y  .
+
+END PROC circle;
+
+END PACKET comercial plot;
+
+PACKET pc plot DEFINES drawing area,          (*Autor: Heiko Indenbirken *)
+                       begin plot,            (*Stand:    20.05.85       *)
+                       end plot,              (*Änderung: 27.06.85/16:17 *)
+                       clear,                 (*Änderung: 03.07.85/15:59 *)
+                                              (*Änderung: 06.08.86/10:03 *)
+                       graphik,
+                       set pen, get pen, 
+
+                       move, 
+                       draw,
+                       draw line,
+                       marker,
+                       bar, circle,
+                       where:
+
+ 
+LET POS = STRUCT (INT x, y);
+LET PEN = STRUCT (INT back, fore, thick, line);
+INT CONST back code  :: -4,
+          modus code :: -5,
+          draw code  :: -6,
+          move code  :: -7,
+          pen code   :: -8,
+          full line  :: -1;
+ 
+INT VAR d, y, pause time :: 10,
+        resolution :: 4, max x :: 319, max y :: 199; 
+BOOL VAR is clear := FALSE;
+POS VAR old :: POS : (0, 0);
+PEN VAR pen :: PEN : (0, 1, 0, full line);
+
+PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 
+   x cm    := 22.0;    y cm    := 13.7; 
+   x pixel := max x;   y pixel := max y;
+END PROC drawing area;
+
+PROC graphik (INT CONST modus, pause):
+  pause time := pause;
+  SELECT modus OF
+  CASE 0: resolution := 3;
+  CASE 1: resolution := 72;
+          max x := 639;
+          max y := 399 
+  CASE 2: resolution := 64;
+          max x := 639;
+          max y := 399 
+  CASE 3: resolution := 6;
+          max x := 639;
+          max y := 199 
+  CASE 4: resolution := 4;
+          max x := 319;
+          max y := 199
+  OTHERWISE errorstop ("Nur Modi 0-4") ENDSELECT;
+
+  set range (0, 0, max x, max y);
+END PROC graphik;
+ 
+PROC begin plot : 
+  control (modus code, resolution, 0, d);
+  is clear := TRUE;
+ENDPROC begin plot ;
+
+PROC end plot : 
+  IF pause time > 0
+  THEN indicate end plot FI;
+  control (modus code, 3, 0, d)  .
+
+indicate end plot:
+  control (pen code, full line, full line, d);
+  REP set indicator;
+  UNTIL incharety (pause time) <> "" PER  .
+
+set indicator:
+  control (move code, 0, max y, d);
+  control (draw code, max x, max y, d)  .
+
+ENDPROC end plot ;
+
+PROC clear:
+  INT VAR x0, x1, y0, y1;
+  new values (22.0, 13.7, max x, max y, x0, x1, y0, y1);
+  set range (x0, y0, x1, y1);
+  clear screen;
+  clear pen;
+  clear pos;
+  is clear := FALSE  .
+
+clear screen:
+  IF is clear OR full screen
+  THEN control (modus code, resolution, 0, d)
+  ELSE draw frame;
+       clear frame
+  FI  .
+
+full screen:
+  x0 < 10 AND x1 > (max x-10) AND
+  y0 < 10 AND y1 > (max y-10)  .
+
+draw frame:
+   control (move code, x0, y0, d);
+   control (draw code, x1, y0, d);
+   control (draw code, x1, y1, d);
+   control (draw code, x0, y1, d);
+   control (draw code, x0, y0, d)  .
+
+clear frame:
+  control (pen code, full line, 0, d);
+  FOR y FROM max y-y1 UPTO max y-y0
+  REP control (move code, x0, y, d); 
+      control (draw code, x1, y, d); 
+  PER  .
+
+clear pen:
+  pen := PEN : (0, 1, 0, full line); 
+  control (pen code, full line, 1, d)  .
+
+clear pos:
+  old := POS : (x0, y0);
+  control (move code, x0, max y-y0, d)  .
+
+END PROC clear;
+
+PROC set pen (INT CONST back, fore, thick, type):
+  set background;
+  set foreground and linetype;
+  set thickness  .
+
+set background:
+  pen.back := back;                    (*Hintergrund über niederwertiges *)
+  control (back code, 0, back no, d)  .(*Byte von colour code            *)
+                                       (*Höherwetiges Byte regelt die    *)
+back no:                               (*Farbpalette                     *)
+  IF back = 0
+  THEN std background
+  ELSE back FI  .
+
+std background:
+  IF resolution = 4
+  THEN 16
+  ELSE 15 FI  .
+
+set foreground and linetype:               (*0, 1, 2, 3 Farben: löschend,*)
+  pen.fore := possible colour;             (*ändernd oder überschreibend *)
+  pen.line := type;                        (* in allen Linientypen.      *)
+  control (pen code, line (type), pen.fore, d)  .
+
+possible colour:
+  IF fore <= full line
+  THEN full line
+  ELIF fore > 3 OR  (fore > 1 AND resolution <> 4)
+  THEN 1
+  ELSE fore FI  .
+
+set thickness:
+  pen.thick := thick DIV 10  .
+
+END PROC set pen;
+
+PROC get pen (INT VAR back, fore, thick, line):
+  back  := pen.back;
+  fore  := pen.fore;
+  thick := pen.thick;
+  line  := pen.line
+END PROC get pen;
+
+INT PROC line (INT CONST type):
+  SELECT type OF
+  CASE 0: 0
+  CASE 1: full line
+  CASE 2: 21845
+  CASE 3: 3855
+  CASE 4: 255
+  CASE 5: 4351
+  OTHERWISE type END SELECT
+END PROC line;
+
+PROC int move (INT CONST x, y):
+  control (move code, x,  max y-y, d);
+END PROC int move;
+
+PROC int draw (INT CONST x, y):
+  control (draw code, x, max y-y, d);
+END PROC int draw;
+
+PROC draw line (INT CONST from x, from y, to x, to y):
+  control (move code, from x, max y-from y, d);
+  clip (from x, from y, to x, to y, PROC int move, PROC int draw)
+END PROC draw line;
+
+PROC move (INT CONST x, y) :
+  control (move code, x, max y-y, d);
+  old := POS  : (x, y) 
+END PROC move;
+ 
+PROC draw (INT CONST x, y):
+  IF std thickness
+  THEN clip (old.x, old.y, x, y, PROC int move, PROC int draw)
+  ELSE thick (old.x, old.y, x, y, pen.thick, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line) FI;
+  old := POS  : (x, y)   .
+
+std thickness:  pen.thick = 0  .
+END PROC draw;
+
+PROC draw (TEXT CONST msg, REAL CONST angle, INT CONST height, width):
+  control (pen code, full line, pen.fore, d);
+  draw text (old.x, old.y, msg, angle, y size, x size,
+  PROC (INT CONST, INT CONST, INT CONST, INT CONST, INT CONST, INT CONST) draw char);
+  control (move code, old.x, max y-old.y, d);
+  control (pen code, line (pen.line), pen.fore, d)  .
+
+x size: IF width = 0
+        THEN 6
+        ELSE width FI  .
+y size: IF height = 0
+        THEN 10
+        ELSE height FI .
+
+END PROC draw;
+
+PROC draw char (INT CONST char, direction, x, y, INT CONST height, width):
+  draw char (char, x, y, width, height, direction,
+             PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line)
+END PROC draw char;
+
+PROC bar (INT CONST from x, from y, to x, to y, pattern):
+  control (pen code, full line, pen.fore, d);
+  bar (from x, from y, to x, to y, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line);
+  control (move code, old.x, max y-old.y, d);
+  control (pen code, line (pen.line), pen.fore, d)  .
+END PROC bar;
+
+PROC circle (INT CONST x, y, rad, REAL CONST from, to, INT CONST pattern):
+  control (pen code, full line, pen.fore, d);
+  circle (x, y, rad, from, to, pattern, PROC (INT CONST, INT CONST, INT CONST, INT CONST) draw line);
+  control (move code, old.x, max y-old.y, d);
+  control (pen code, line (pen.line), pen.fore, d)  .
+END PROC circle;
+
+PROC marker (INT CONST x, y, no, size):
+  control (pen code, full line, pen.fore, d);
+  draw char (no, 0, x, y, size, size);
+  control (move code, old.x, max y-old.y, d);
+  control (pen code, line (pen.line), pen.fore, d)  .
+END PROC marker;
+
+PROC where (INT VAR x, y):
+  x := old.x;  y := old.y
+END PROC where;
+
+END PACKET pc plot
+
diff --git a/system/std.graphik/1.8.7/src/ZEICHENSATZ b/system/std.graphik/1.8.7/src/ZEICHENSATZ
new file mode 100644
index 0000000..9866ec2
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/ZEICHENSATZ
diff --git a/system/std.graphik/1.8.7/src/gen Graphik b/system/std.graphik/1.8.7/src/gen Graphik
new file mode 100644
index 0000000..f70cc66
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/gen Graphik
@@ -0,0 +1,16 @@
+TEXT VAR geraet;
+page;
+out ("Bitte den Namen der Hardwareanpassung (z.B. 'PC.plot') eingeben: ");
+get line (geraet);
+IF NOT exists (geraet)
+THEN errorstop ("Endgerät nicht vorhanden") FI;
+
+insert ("GRAPHIK.Picfile");
+insert ("GRAPHIK.Transform");
+insert (geraet);
+insert ("GRAPHIK.Plot");
+
+
+
+
+
diff --git a/system/std.graphik/1.8.7/src/gen Plotter b/system/std.graphik/1.8.7/src/gen Plotter
new file mode 100644
index 0000000..73d7b2f
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/gen Plotter
@@ -0,0 +1,16 @@
+TEXT VAR geraet;
+page;
+out ("Bitte den Namen der Hardwareanpassung (z.B. 'PC.plot') eingeben: ");
+get line (geraet);
+IF NOT exists (geraet)
+THEN errorstop ("Endgerät nicht vorhanden") FI;
+
+insert ("GRAPHIK.Picfile");
+insert ("GRAPHIK.Transform");
+insert (geraet);
+insert ("GRAPHIK.Plotter");
+insert ("GRAPHIK.Server")
+
+
+
+
diff --git a/system/std.graphik/1.8.7/src/graphik editor b/system/std.graphik/1.8.7/src/graphik editor
new file mode 100644
index 0000000..7aa6e33
--- /dev/null
+++ b/system/std.graphik/1.8.7/src/graphik editor
@@ -0,0 +1,324 @@
+PACKET graphic editor DEFINES  graphic,           (*Autor: H.Indenbirken *)
+                               picfile, picture,  (*Stand: 26.02.1985    *)
+
+                               neu zeichnen,
+ 
+                               UP, DOWN, T,
+
+                               pen, select pen, selected pen, background,
+                               extrema pic, extrema picfile:
+ 
+
+ 
+LET norm cmd = ""1""27""3""10""9"epb"16"",
+    hop cmd = ""2""10""12""1"",
+    bell    = ""7"",
+    esc     = ""27"";
+
+PICFILE VAR p;
+PICTURE VAR pic;
+TEXT VAR command :: "", old command :: "", char, headline :: "";
+BOOL VAR within edit :: FALSE, new plot :: FALSE;
+ROW 3 ROW 2 REAL VAR size;
+ROW 2 ROW 2 REAL VAR limits;
+ROW 4 REAL VAR angles;
+ROW 2 REAL VAR oblique;
+ROW 3 REAL VAR perspective;
+
+PROC open graphic (TEXT CONST name, DATASPACE CONST ds):
+  p := ds; 
+  get values (p, size, limits, angles, oblique, perspective); 
+  head line := ""1""15"LEN       ................................ DIM    PEN    .."14" Picture      "15""14"";
+  replace (head line, 32-LENGTH name DIV 2, name);
+  new plot := TRUE;
+  within edit := TRUE
+END PROC open graphic;
+
+PROC graphic:
+  graphic (last param)
+END PROC graphic;
+
+PROC graphic (TEXT CONST name) :
+  IF NOT exists (name) 
+  THEN IF yes ("Soll ein neuer Picfile eingerichtet werden")
+       THEN graphic (new (name), name) FI
+  ELSE graphic (old (name), name) FI
+
+END PROC graphic;
+
+PROC graphic (DATASPACE CONST f, TEXT CONST name) :
+  open graphic (name, f);
+  reset;
+  kommandos bearbeiten;
+  within edit := FALSE  .
+
+kommandos bearbeiten :
+  REP IF new plot
+      THEN plot (p);
+           new plot := FALSE
+      FI;
+      read picture (p, pic);
+      out head line;
+      inchar (command);
+      do command
+  PER  .
+ 
+out head line:
+  replace (headline,  7, text (length (pic), 5));
+  replace (headline, 50, text (dim (pic), 1));
+  replace (headline, 57, text (pen (pic), 2));
+  replace (headline, 72, text (picture no (p), 4));
+  out (head line)  .
+
+do command:
+  SELECT pos (norm cmd, command) OF 
+  CASE  1: hop commands
+  CASE  2: escape commands
+  CASE  3: position up
+  CASE  4: position down
+  CASE  5: position direct
+  CASE  6: extrema pic
+  CASE  7: selected pen (pen (pic));
+  CASE  8: out (1, 2, ""15""5"Hintergrundfarbe: " +
+           colour of (background (p)) + " "14"")
+  CASE  9: identify (pic);
+  OTHERWISE out (bell) ENDSELECT .
+
+position up :
+  IF is first picture (p)
+  THEN out (bell);
+  ELSE up (p) FI  .
+
+position down :
+  IF eof (p)
+  THEN out (bell)
+  ELSE down (p) FI  .
+ 
+position direct:
+   out (1, 68, "");
+   edit get (command, 4, 4);
+   to pic (p, int (command))  .
+
+hop commands :
+  inchar (command);
+  SELECT pos (hop cmd, command) OF 
+  CASE 1: to first pic (p)
+  CASE 2: to eof (p)
+  CASE 3: delete picture (p);
+          IF NOT new plot
+          THEN erase (pic) FI
+  CASE 4: new plot := TRUE
+  OTHERWISE out (bell) ENDSELECT  .
+
+escape commands :
+  inchar (command);
+  IF command = "q"
+  THEN LEAVE kommandos bearbeiten
+  ELIF command = "f"
+  THEN do (old command)
+  ELIF command = esc
+  THEN kommandomodus
+  ELSE do (kommando auf taste (command)) FI  .
+
+END PROC graphic;
+
+PROC kommandomodus:
+  command := "";
+  disable stop;
+  REP get command;
+      do (command)
+  UNTIL command executed PER;
+
+  IF new values
+  THEN get values (size, limits, angles, oblique, perspective); 
+       set values (p, size, limits, angles, oblique, perspective); 
+       new plot := new plot OR new values
+  FI  .
+
+get command:
+  REP out (1, 2, ""15"Gib Graphikkommando: ");
+      edit get (command, 0, 54, "", "k", char);
+      out (""14"");
+      out (1, 2, ""5"");
+
+      IF char = ""13""
+      THEN LEAVE get command
+      ELIF char = ""27"k"
+      THEN command := old command FI
+  PER  .
+
+command executed:
+  IF is error
+  THEN out (1, 1, error message);
+       clear error;
+       FALSE
+  ELSE old command := command;
+       TRUE
+  FI  .
+
+END PROC kommandomodus;
+
+PROC out (INT CONST x, y, TEXT CONST t):
+  cursor (x, y);
+  out (t)
+END PROC out;
+
+TEXT PROC colour of (INT CONST colour):
+  SELECT colour OF
+  CASE 0: "löschen"
+  CASE 1: "std"
+  CASE 2: "rot"
+  CASE 3: "blau"
+  CASE 4: "grün"
+  CASE 5: "schwarz"
+  CASE 6: "weiß"
+  OTHERWISE text (colour) ENDSELECT  .
+END PROC colour of;
+
+TEXT PROC linetype of (INT CONST linetype):
+  SELECT linetype OF
+  CASE 0: "unsichtbar"
+  CASE 1: "durchgehend"
+  CASE 2: "gepunktet"
+  CASE 3: "kurz gestrichelt"
+  CASE 4: "lang gestrichelt"
+  CASE 5: "strichpunkt"
+  OTHERWISE text (linetype) ENDSELECT  .
+END PROC linetype of;
+
+PICFILE PROC picfile :
+  IF NOT within edit
+  THEN errorstop ("Not within editmode") FI;
+  p
+END PROC picfile;
+
+PICTURE PROC picture :
+  IF NOT within edit
+  THEN errorstop ("Not within editmode") FI;
+  pic
+END PROC picture;
+
+PROC neu zeichnen:
+  new plot := TRUE
+END PROC neu zeichnen;
+
+OP UP (INT CONST distance):
+  up (p, distance);
+  read picture (p, pic) 
+END OP UP;
+
+OP DOWN (INT CONST distance):
+  down (p, distance);
+  read picture (p, pic) 
+END OP DOWN;
+
+OP T (INT CONST n):
+  to pic (p, n);
+  read picture (p, pic) 
+END OP T;
+ 
+PROC pen (INT CONST n):
+  IF NOT new plot
+  THEN erase (pic) FI;
+
+  pen (pic, n);
+  write picture (p, pic);
+
+  IF NOT new plot
+  THEN show (pic) FI
+END PROC pen;
+
+PROC select pen (INT CONST n, colour, thickness, linetype, BOOL CONST hidden):
+  select pen (p, n, colour, thickness, linetype, hidden);
+  new plot := TRUE
+END PROC select pen;
+
+PROC select pen (INT CONST n, colour, thickness, linetype):
+  select pen (p, n, colour, thickness, linetype, FALSE);
+  new plot := TRUE
+END PROC select pen;
+
+PROC selected pen (INT CONST n, INT VAR colour, thickness, linetype,
+                   BOOL VAR hidden):
+  selected pen (p, n, colour, thickness, linetype, hidden);
+END PROC selected pen;
+
+PROC selected pen (INT CONST n):
+  INT VAR colour, thickness, linetype;
+  BOOL VAR hidden;
+  selected pen (p, n, colour, thickness, linetype, hidden);
+  out (1, 2, ""5""15"PEN #" + text (n) + ":  Farbe: " + colour of (colour) +
+             ", Dicke " + text (thickness) + ", Linientyp " + linetype of (linetype) +
+             hidden text + " "14"")  .
+
+hidden text:
+  IF hidden
+  THEN ". "
+  ELSE ", nicht sichtbare Linien werden unterdrückt." FI  .
+
+END PROC selected pen;
+
+INT PROC background:
+  background (p)
+END PROC background;
+
+PROC background (INT CONST n):
+  new plot := n <> background (p);
+  background (p, n)
+END PROC background;
+
+PROC extrema pic:
+  REAL VAR x min, x max, y min, y max, z min, z max;
+  IF dim (pic) = 2
+  THEN extrema (pic, x min, x max, y min, y max);
+       out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
+                  "]  [" + text (y min) + "," + text (y max) + "] "14"")
+  ELSE extrema (pic, x min, x max, y min, y max, z min, z max);
+       out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
+                  "]  [" + text (y min) + "," + text (y max) + 
+                  "]  [" + text (z min) + "," + text (z max) +"] "14"") 
+  FI
+END PROC extrema pic;
+
+PROC extrema picfile:
+  REAL VAR x min, x max, y min, y max, z min, z max;
+  extrema (p, x min, x max, y min, y max, z min, z max);
+  out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
+             "]  [" + text (y min) + "," + text (y max) + 
+             "]  [" + text (z min) + "," + text (z max) +"] "14"") 
+END PROC extrema picfile;
+
+PROC identify (PICTURE CONST pic):
+  begin plot;
+  hidden lines (TRUE);
+  pen (background (p), 1, 1, 2);
+  plot (pic);
+  end plot
+END PROC identify;
+
+PROC erase (PICTURE CONST pic):
+  INT VAR colour, thickness, linetype;
+  BOOL VAR hidden;
+
+  selected pen (p, pen (pic), colour, thickness, linetype, hidden); 
+  begin plot;
+  hidden lines (TRUE);
+  pen (background (p), 0, thickness, linetype);
+  plot (pic);
+  end plot
+END PROC erase;
+
+PROC show (PICTURE CONST pic):
+  INT VAR colour, thickness, linetype;
+  BOOL VAR hidden;
+
+  selected pen (p, pen (pic), colour, thickness, linetype, hidden); 
+  begin plot;
+  hidden lines (TRUE);
+  pen (background (p), colour, thickness, linetype);
+  plot (pic);
+  end plot
+END PROC show;
+
+END PACKET graphic editor;
+
diff --git a/system/std.zusatz/1.7.3/src/17CHARS.ELA b/system/std.zusatz/1.7.3/src/17CHARS.ELA
new file mode 100644
index 0000000..160997a
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/17CHARS.ELA
@@ -0,0 +1,44 @@
+PACKET special 17 chars DEFINES chars 17 :

+

+TEXT VAR rec , schar ;

+FILE VAR f ;

+

+PROC chars 17 :

+

+  REP

+    down ("""") ;

+    get schar ;

+  UNTIL perhaps schar ("225", "217")

+    COR perhaps schar ("239", "218")

+    COR perhaps schar ("245", "219")

+    COR perhaps schar ("193", "214")

+    COR perhaps schar ("207", "215")

+    COR perhaps schar ("213", "216")

+    COR perhaps schar ("235", "220")

+    COR perhaps schar ("173", "221")

+    COR perhaps schar ("163", "222")

+    COR perhaps schar ("160", "223")

+    COR perhaps schar ("194", "251")

+    COR eof

+  PER ;

+  zeile neu .

+

+get schar :

+  f := editfile ;

+  read record (f, rec) ;

+  schar := subtext (rec, col + 1, col + 3) .

+

+ENDPROC chars 17 ;

+

+BOOL PROC perhaps schar (TEXT CONST old, new) :

+

+  IF schar = old

+    THEN change (rec, col + 4, col + 3, new) ;

+         write record (f, rec) ;

+         TRUE

+    ELSE FALSE

+  FI .

+

+ENDPROC perhaps schar ;

+

+ENDPACKET special 17 chars ;

diff --git a/system/std.zusatz/1.7.3/src/EMU16.ELA b/system/std.zusatz/1.7.3/src/EMU16.ELA
new file mode 100644
index 0000000..a8e1292
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/EMU16.ELA
@@ -0,0 +1,109 @@
+PACKET emulator 16 DEFINES                     (* Autor:  J.Liedtke *)

+                                               (* Stand:  11.10.83  *)

+  killer ,                                     (* F. Klapper, 26.03.84 *) 

+  command handler ,

+  set command ,

+  to archive, 

+  from archive, 

+  load archive, 

+  save archive, 

+  list archive, 

+  release archive: 

+ 

+PROC list archive: 

+  list (archive) 

+ 

+END PROC list archive; 

+ 

+PROC release archive: 

+  release (archive) 

+ 

+END PROC release archive; 

+ 

+PROC to archive: 

+  save (last param, archive) 

+ 

+END PROC to archive; 

+ 

+PROC to archive (TEXT CONST t): 

+  save (t, archive) 

+ 

+END PROC to archive; 

+ 

+PROC from archive (TEXT CONST t): 

+  fetch (t, archive) 

+ 

+END PROC from archive; 

+ 

+PROC load archive: 

+  fetch all (archive) 

+ 

+END PROC load archive; 

+ 

+PROC save to archive (THESAURUS CONST thes): 

+  disable stop; 

+  all to archive (thes); 

+  IF is error 

+  THEN put error; 

+       line; 

+       clear error; 

+       IF yes ("naechste Archivfloppy eingelegt") 

+       THEN save to archive (remainder) 

+       FI 

+   FI; 

+   enable stop 

+ 

+END PROC save to archive; 

+ 

+PROC all to archive (THESAURUS CONST thes): 

+  enable stop; 

+  save (thes, archive) 

+ 

+END PROC all to archive; 

+ 

+PROC save archive: 

+  save to archive (ALL myself) 

+ 

+END PROC save archive; 

+ 

+PROC save archive (TEXT CONST liste): 

+  save to archive (ALL liste) 

+ 

+END PROC save archive; 

+ 

+PROC killer :

+  forget (ALL myself)

+

+ENDPROC killer ;

+

+TEXT VAR command line;

+INT VAR permitted type := 0 ;

+

+PROC set command (TEXT CONST command text, INT CONST type) :

+

+  command line := command text;

+  permitted type := type

+

+ENDPROC set command ;

+

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2) :

+

+  analyze command (command list, command line, permitted type, command index,

+                   number of params, param 1, param 2) 

+

+ENDPROC command handler ;

+ 

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2,

+                      TEXT CONST command text) :

+ 

+  get command (command text, command line) ;

+  analyze command (command list, command line, 0,

+                   command index, number of params, param 1, param 2) 

+

+ENDPROC command handler ;

+

+ENDPACKET emulator 16 ;

diff --git a/system/std.zusatz/1.7.3/src/EMU16M.ELA b/system/std.zusatz/1.7.3/src/EMU16M.ELA
new file mode 100644
index 0000000..ed8cff4
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/EMU16M.ELA
@@ -0,0 +1,162 @@
+PACKET emulator 16 multi DEFINES               (* Autor:  J.Liedtke *)

+                                               (* Stand:  11.10.83  *)

+  killer ,                                     (* F. Klapper, 16.05.84 *)

+  file names ,

+  out ,

+  command handler ,

+  set command ,

+  call ,

+  read , 

+  to archive, 

+  from archive, 

+  load archive, 

+  save archive, 

+  list archive, 

+  release archive, 

+  forward, 

+  backward, 

+  to eof,

+  to first record, 

+  is first record: 

+ 

+PROC list archive: 

+  list (archive) 

+END PROC list archive; 

+ 

+PROC release archive: 

+  release (archive) 

+END PROC release archive; 

+ 

+PROC to archive: 

+  save (last param, archive) 

+END PROC to archive; 

+ 

+PROC to archive (TEXT CONST t): 

+  save (t, archive) 

+END PROC to archive; 

+ 

+PROC from archive (TEXT CONST t): 

+  fetch (t, archive) 

+END PROC from archive; 

+ 

+PROC load archive: 

+  fetch all (archive) 

+END PROC load archive; 

+ 

+PROC save to archive (THESAURUS CONST thes): 

+  disable stop; 

+  all to archive (thes); 

+  IF is error 

+  THEN put error; 

+       line; 

+       clear error; 

+       IF yes ("naechste Archivfloppy eingelegt") 

+       THEN save to archive (remainder) 

+       FI 

+   FI; 

+   enable stop 

+END PROC save to archive; 

+ 

+PROC all to archive (THESAURUS CONST thes): 

+  enable stop; 

+  save (thes, archive) 

+END PROC all to archive; 

+ 

+PROC save archive: 

+  save to archive (ALL myself) 

+END PROC save archive; 

+ 

+PROC save archive (TEXT CONST liste): 

+  save to archive (ALL liste) 

+END PROC save archive; 

+

+PROC killer :

+  forget (ALL myself)

+ENDPROC killer ;

+

+THESAURUS VAR cat ;

+TEXT VAR file name ;

+

+PROC file names (FILE VAR f) :

+  file names (f, name (myself))

+ENDPROC file names ;

+

+PROC file names (FILE VAR f, TEXT CONST manager name) :

+  INT VAR index := 0 ;

+  cat := ALL task (manager name) ;

+  REP

+    get (cat, file name, index) ;

+    IF file name = ""

+      THEN LEAVE file names

+    FI ;

+    putline (f, file name)

+  PER

+ENDPROC file names ;

+

+PROC out (FILE VAR f, TEXT CONST t) :

+  write (f,t)

+ENDPROC out ;

+

+TEXT VAR command line;

+INT VAR permitted type := 0 ;

+

+PROC set command (TEXT CONST command text, INT CONST type) :

+  command line := command text;

+  permitted type := type

+ENDPROC set command ;

+

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2) :

+ 

+  analyze command (command list, command line, permitted type, command index,

+                   number of params, param 1, param 2) 

+ 

+ENDPROC command handler ;

+ 

+PROC command handler (TEXT CONST command list, 

+                      INT VAR command index , number of params ,

+                      TEXT VAR param 1, param 2,

+                      TEXT CONST command text) :

+ 

+  get command (command text, command line) ;

+  analyze command (command list, command line, 0,

+                   command index, number of params, param 1, param 2) 

+

+ENDPROC command handler ;

+

+PROC call (TEXT CONST dest name, INT CONST order code, 

+           DATASPACE VAR ds, INT VAR reply code) :

+

+  call (task (dest name), order code, ds, reply code)

+

+ENDPROC call ;

+

+PROC read (TEXT CONST file name) :

+  fetch (file name)

+ENDPROC read ;

+

+PROC read (TEXT CONST file name, manager name) :

+  fetch (file name, task(manager name))

+ENDPROC read ;

+

+PROC forward (FILE VAR f): 

+  down (f) 

+END PROC forward; 

+ 

+PROC backward (FILE VAR f): 

+  up (f) 

+END PROC backward; 

+ 

+PROC to first record (FILE VAR f): 

+  to line (f, 1) 

+END PROC to first record; 

+ 

+BOOL PROC is first record (FILE VAR f): 

+  line no (f) = 1 

+END PROC is first record; 

+ 

+PROC to eof (FILE VAR f): 

+  to line (f, lines (f)) 

+END PROC to eof;

+ENDPACKET emulator 16 multi ;

diff --git a/system/std.zusatz/1.7.3/src/FONTR16.ELA b/system/std.zusatz/1.7.3/src/FONTR16.ELA
new file mode 100644
index 0000000..91acfe0
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/FONTR16.ELA
@@ -0,0 +1,360 @@
+PACKET fonts routines

+(************************************************************************** 

+***** Verwaltung der Schriftfontstabelle  **  Author : R. Nolting     *****

+***** Benoetigt von allen Druckertreibern **  Version: 0.1 / 3.5.82   *****

+*****                                     **  Version: 1.0 / 8.6.82   ***** 

+*****                                     **  Version: 2.0 / 1. 8. 82 *****

+***** Schrittweite in x und y in Tabelle  **  Version: 3.0 / 1. 9. 83 ***** 

+***** Zeilenhoehe in cm                   **  Version: 3.1 / 2. 4. 84 *****

+**************************************************************************)

+ 

+    DEFINES 

+             load font table,

+             get font,

+             list fonts,

+             inch,

+             current font number,

+             lf height of current font,

+             x factor per inch, 

+             y factor per inch:

+

+LET max fonts = 8;

+LET max nr points = 4;

+LET PRINTTYPE = STRUCT (INT x steps per inch, y steps per inch,

+                        ROW max nr points INT point size,

+                        TEXT name, pitch table, codetable);

+ROW max fonts PRINTTYPE VAR font;

+FILE VAR font file;

+INT VAR font number := 1, point number := 1;

+TEXT VAR record :=  " ",

+         symb;

+INT VAR i;

+REAL CONST inch := 2.54;

+ 

+INT PROC x factor per inch: 

+  x step

+END PROC x factor per inch;

+ 

+INT PROC y factor per inch: 

+  lf 

+END PROC y factor per inch;

+ 

+REAL PROC lf height of current font:

+  real(point (point number)) * inch / real (lf)  (* 9.1.84 Nolting *)

+END PROC lf height of current font;

+ 

+INT PROC current font number: 

+  font number 

+END PROC current font number;

+(*******************************************************************

+*********  Setzen und Liefern von Schriftsaetzen              ******

+*******************************************************************)

+PROC init font:

+FOR font number FROM 1 UPTO max fonts REP;

+  lf := 1; 

+  x step := 1; 

+  FOR point number FROM 1 UPTO max nr points REP 

+    point(point number) := 1; 

+    PER;

+  kode := "";

+  name := "";

+  pitch:= "";

+  PER;

+END PROC init font;

+(******************************************************************)

+ 

+PROC list fonts:

+  line;

+  FOR font number FROM 1 UPTO max fonts REP

+   IF name <> "" AND name <> " "

+       THEN put typ name 

+       FI;

+    line;

+    PER;

+  font number := 1; point number := 1;

+. 

+put typ name:

+  put (font number); put (".");

+  put ("'"); put (name); put ("'");

+  IF length (pitch) > 1 

+     THEN put ("proportional mit Blankbreite"); put (code (pitch SUB 32))

+     ELSE put ("fest mit Blankbreite"); put (code (pitch));

+     FI;

+  put ("und Zeilenhoehe"); put (point (1));

+END PROC list fonts;

+ 

+BOOL PROC font is in table (TEXT CONST name of font):

+  record := name of font;

+  changeall (record, " ","");

+  IF record = ""

+     THEN font number := 1; TRUE

+     ELSE search through the table

+     FI

+.

+search through the table:

+(* der Name des gewuenschten Types darf noch ein angehaengtes Attribut haben *)

+  FOR font number FROM 1 UPTO max fonts REPEAT

+    IF pos (record, name) = 1

+       THEN LEAVE search through the table WITH TRUE

+       FI;

+    PER;

+    font number := 1;

+    FALSE

+ENDPROC font is in table;

+ 

+PROC get font (TEXT VAR name of font,

+               TEXT VAR font pitch table, font code table,

+               BOOL VAR success):

+INT VAR lf size := 0;

+  get font (name of font, lf size, 

+            font pitch table, font code table, success); 

+  replace (font pitch table, 10, code(lfsize)); 

+END PROC get font; 

+ 

+PROC get font (TEXT VAR name of font, INT VAR size,

+               TEXT VAR font pitch table, font code table,

+               BOOL VAR success):

+  success := font is in table (name of font);

+  name of font := name;

+  (* hiermit wird eine Ueberpruefung 'alter Typ = neuer Typ'

+     im aufrufenden Programm ermoeglicht *)

+  font code table := kode;

+  font pitch table := pitch;

+  point number := max nr points;

+  WHILE point (point number) <> size REP

+    point number DECR 1; 

+    UNTIL point number = 1 PER; 

+  size := point (point number); 

+  IF size = point (1) 

+     THEN font pitch table := pitch;

+          LEAVE get font 

+     ELSE font pitch table := ""

+     FI; 

+  INT VAR j := point (1); 

+  FOR i FROM 1 UPTO length (pitch) REP

+    font pitch table CAT code(code (pitch SUB i) * size DIV j)

+    PER;

+

+END PROC get font;

+ 

+LET tag            = 1 ,

+    bold           = 2 , 

+    number         = 3 ,

+    string         = 4 ,  (* = text; aber PROC text wird benoetigt *)

+    operator       = 5 ,

+    delimiter      = 6 , 

+    end of file    = 7 , 

+    within comment = 8 ,

+    within text    = 9 ;

+ 

+PROC load font table (TEXT CONST font file name):

+BOOL VAR prop font;

+INT VAR type of symbol := 0;

+REAL VAR blank in cm ,

+         lf in cm;

+REAL VAR width, inch factor;

+INT VAR factor width;

+ 

+enable stop;

+IF NOT exists (font file name)

+   THEN errorstop ("Fontdatei nicht vorhanden")

+   FI;

+font file := sequential file (input, font file name);

+  init font;

+  font number := 0;

+  getline (font file, record);

+  protline (record);

+  WHILE NOT eof (font file) REP

+    font number INCR 1;

+    get font name and parameters;

+    get char width and output function;

+  UNTIL eof (font file) COR font number >= max fonts PER;

+  font number := 1; point number := 1;

+.

+get font name and parameters:

+  get font name; 

+  get fixed or prop; 

+  get blank width; 

+  get linefeed height; 

+  get pointsizes;

+  get optional x steps per inch;

+  fill pitch and code table with default;

+. 

+get font name:

+  next entry;  prot (symb);

+  IF (symb SUB 1) = "#" 

+     THEN symb := subtext (symb, 2);

+          WHILE (symb SUB length(symb)) <> "#" REP

+            name CAT symb;

+            next entry; prot (symb);

+            IF symb = ""

+               THEN errorstop ("# fehlt beim Fontnamen");

+               FI;

+            PER;

+            name CAT subtext (symb, 1, length (symb)-1)

+     ELSE error stop ("1. Symbol kein Fontname")

+     FI;

+. 

+get fixed or prop:

+  next entry;

+  prop font := (symb SUB 1) = "p" OR (symb SUB 1) = "P";

+  prot (symb);

+. 

+get blank width:

+  next entry;

+  blank in cm := real (symb); 

+  IF NOT last conversion ok COR blank in cm < 0.01 

+     THEN errorstop ("Blankbreite falsch") 

+     FI;

+  prot ("Blank=");prot (symb);

+. 

+get linefeed height: 

+  next entry; 

+  lf in cm := real (symb);

+  IF NOT last conversion ok COR lf in cm < 0.01 

+     THEN errorstop ("Linefeedhoehe falsch") 

+     FI;

+  prot ("lf="); prot(symb);

+.

+get pointsizes:

+  next entry; 

+  IF symb <> "(" 

+     THEN protline ("alle Pointgroessen = 1 per Voreinstellung") ; 

+          LEAVE get pointsizes

+     FI; 

+  protline(" "); prot ("lf in punkten=");

+  get one lf size;

+  lf := int (inch * real (point (1))/ lf in cm + 0.5);

+. 

+get one lf size:

+  FOR i FROM 1 UPTO max nr points REP

+    next entry; 

+    IF symb = ")" 

+       THEN LEAVE get one lf size

+       ELIF symb = "" 

+            THEN errorstop ("Pointangaben unvollstaendig") 

+       FI; 

+    point(i) := int (symb); 

+    IF NOT last conversion ok COR point (i) < 1

+       THEN errorstop ("Pointgroesse falsch")

+       FI;

+    prot (symb); prot (",");

+    PER;

+. 

+get optional x steps per inch:

+  IF symb = ")"

+     THEN next entry FI;

+  IF symb = "" 

+     THEN width := 1.0

+     ELSE width := real (symb)

+     FI;

+  x step := int (inch * width / blank in cm + 0.5);

+  factor width := int (width + 0.5);

+  IF NOT last conversion ok COR x step < 1

+     THEN errorstop ("minimale Schritte falsch")

+     FI;

+  protline(" "); prot ("Schritte pro Inch="); prot (text(x step)); prot(","); prot (text(lf)); protline(" ");

+.

+fill pitch and code table with default:

+  IF prop font

+     THEN pitch  := 255 * code (factor width)

+     ELSE pitch  := code (factor width)

+     FI;

+  kode  := 31 * ""0"";

+  kode  CAT 224 * ""1""; (* print all *)

+  inch factor := real (x step)

+.

+get char width and output function:

+  WHILE NOT eof (font file) REP

+    getline (font file, record);

+    protline (record);

+    IF (record SUB 1) = "#" AND pos (record, "#", 2, length (record)) > 2

+       THEN LEAVE get char width and output function

+       FI;

+    get internal code for char;

+    IF char code > 0 AND char code <= 255

+       THEN IF prop font 

+               THEN get char width;

+                    prot (text(factor width));

+                    replace (pitch, char code, code (factor width))

+               FI;

+               get output function

+       FI;

+    PER;

+.

+get internal code for char:

+INT VAR char code;

+  next entry; prot (symb);

+  IF length(symb) = 1 

+     THEN char code := code (symb SUB 1)

+     ELIF symb >= "000" AND symb <= "255" 

+          THEN char code := int (symb); 

+               IF NOT last conversion ok 

+                  THEN errorstop ("Zeichen falsch") 

+                  FI 

+     ELSE errorstop ("Zeichen falsch") 

+     FI; 

+

+.

+get char width:

+  next entry; 

+  IF pos (symb, ".") > 0

+     THEN width := real (symb);

+          factor width := int (round(((width * inch factor) / inch), 0))

+     ELSE factor width := int (symb) 

+     FI;

+  IF NOT last conversion ok 

+     THEN errorstop ("Breitenangabe falsch") 

+     FI 

+.

+get output function:

+  next entry; prot (symb);  protline(" ");

+  IF symb = "" 

+     THEN symb := "1"

+     FI;

+  replace (kode, char code, code (int (symb)));

+  IF NOT last conversion ok 

+     THEN errorstop ("Ausgabefunktion falsch") 

+     FI;

+END PROC load font table;

+ 

+PROC next entry:

+INT VAR next blank pos;

+WHILE (record SUB 1) = " " REP

+  record := subtext (record, 2, length (record)) PER;

+next blank pos := pos (record, " ");

+IF next blank pos >= 1

+   THEN symb := subtext (record, 1, next blank pos - 1);

+        record := subtext (record, next blank pos + 1)

+   ELSE symb := record;

+        record := ""

+   FI;

+END PROC next entry;

+

+PROC prot (TEXT CONST t):

+  IF online

+     THEN put (t)

+     FI;

+END PROC prot;

+

+PROC protline (TEXT CONST t):

+  IF online

+     THEN putline (t)

+     FI;

+END PROC protline;

+

+init font; (* PACKET Initialisierung ******************************)

+.

+name:   font[font number].name 

+. 

+pitch:  font[font number].pitch table 

+. 

+kode:   font [font number].code table 

+.

+lf:     font [fontnumber].y steps per inch

+. 

+x step: font [font number].x steps per inch

+. 

+point:  font [font number].point size

+.

+END PACKET fonts routines;

diff --git a/system/std.zusatz/1.7.3/src/MINPRINT.ELA b/system/std.zusatz/1.7.3/src/MINPRINT.ELA
new file mode 100644
index 0000000..a0bd44a
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/MINPRINT.ELA
@@ -0,0 +1,94 @@
+PACKET minimal font routines DEFINES lf height of current font, 

+                                     x factor per inch, 

+                                     y factor per inch: 

+ 

+REAL CONST lf height of current font ::  2.54 / 6.0;

+INT CONST x factor per inch         :: 10,

+          y factor per inch         ::  6;

+ 

+END PACKET minimal font routines;

+

+PACKET minimal printer                 (* 25.04.84 *)

+    DEFINES  material,

+             start,

+             new page, 

+             reset printer,

+             line, 

+             print text , 

+             printer cmd,

+             on,

+             off,

+             x pos, 

+             y pos,

+             papersize,

+             limit,

+             change type:

+ 

+ 

+PROC change type (TEXT CONST name of type): ENDPROC change type; 

+

+PROC material (TEXT CONST value): END PROC material;

+ 

+PROC start (REAL CONST x,y): END PROC start;

+

+PROC papersize (REAL CONST x,y): END PROC papersize;

+

+PROC limit (REAL CONST l): END PROC limit;

+

+PROC on (TEXT CONST cmd): END PROC on;

+

+PROC off (TEXT CONST cmd): END PROC off;

+ 

+PROC xpos (REAL CONST cm): END PROC xpos; 

+ 

+PROC ypos (REAL CONST cm): END PROC ypos; 

+ 

+PROC printer cmd (TEXT CONST cmd):

+  out (buffer); buffer := "";

+  out(cmd)

+END PROC printer cmd;

+ 

+INT VAR actual line ;

+

+TEXT VAR buffer;

+

+PROC reset printer:

+  buffer := "";

+  actual line := 0 

+ENDPROC reset printer;

+ 

+PROC print text (TEXT CONST content, INT CONST mode): 

+  buffer CAT content

+ENDPROC print text; 

+ 

+PROC new page:

+  IF buffer <> ""

+  THEN line (1.0)

+  FI;

+  actual line := actual line MOD 72 ;

+  IF actual line > 0

+    THEN page feed

+  FI .

+

+page feed :

+  INT VAR i ;

+  FOR i FROM actual line UPTO 71 REP

+    out(" "13""10"")

+  PER ;

+  actual line := 0

+

+ENDPROC new page; 

+ 

+PROC line (REAL CONST lf): 

+  out (buffer); buffer := "";

+  IF lf > 0.0

+    THEN REAL VAR ist := 0.0 ;

+         REP

+           out (""13""10"") ;

+           actual line INCR 1 ;

+           ist INCR 1.0

+         UNTIL ist >= floor (lf) PER

+  FI 

+ENDPROC line; 

+ 

+ENDPACKET minimal printer;

diff --git a/system/std.zusatz/1.7.3/src/TO16.ELA b/system/std.zusatz/1.7.3/src/TO16.ELA
new file mode 100644
index 0000000..94cfc73
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/TO16.ELA
@@ -0,0 +1,102 @@
+PACKET to 16 DEFINES to 16 :

+

+

+LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT line) ,

+    OLDFILE   = BOUND ROW 4075 OLDRECORD ;

+

+LET free root = 1 ,

+    used root = 2 ;

+

+LET file type 16 = 1002 ;

+

+

+FILE VAR file 17 ;

+OLDFILE VAR file 16 ;

+DATASPACE VAR file space ;

+

+

+PROC to 16 :

+  to 16 (last param)

+ENDPROC to 16 ;

+

+PROC to 16 (TEXT CONST file name) :

+

+  last param (file name) ;

+  file 17 := sequential file (input, file name) ;

+  disable stop ;

+  file space := nilspace ;

+  file 16 := file space ;

+  type (file space, file type 16) ;

+  copy 17 to 16 ;

+  IF NOT is error

+    THEN replace 17 by 16 file

+  FI ;

+  forget (file space) .

+

+replace 17 by 16 file :

+  forget (file name, quiet) ;

+  copy (file space, file name) .

+

+ENDPROC to 16 ;

+

+PROC copy 17 to 16 :

+

+  enable stop ;

+  build used record chain ;

+  build free record chain .

+

+build used record chain :

+  copy all records ;

+  construct used chains head and circular links .

+

+copy all records :

+  INT VAR line ;

+  FOR line FROM 1 UPTO lines (file 17) REP

+    copy one record ;

+    cout (line)

+  PER .

+

+copy one record :

+  INT VAR index := line + 2 ;

+  TEXT VAR line 17;

+  record.pred := index - 1 ;

+  record.succ := index + 1 ;

+  getline (file 17, line 17) ;

+  change special 17 chars;

+  record.line := line 17.

+

+change special 17 chars: 

+  change all (line 17, ""217"", ""225"");

+  change all (line 17, ""218"", ""239"");

+  change all (line 17, ""219"", ""245"");

+  change all (line 17, ""214"", ""193"");

+  change all (line 17, ""215"", ""207"");

+  change all (line 17, ""216"", ""213"");

+  change all (line 17, ""220"", ""235"");

+  change all (line 17, ""221"", ""173"");

+  change all (line 17, ""222"", ""163"");

+  change all (line 17, ""223"", ""160"");

+  change all (line 17, ""251"", ""194"").

+

+construct used chains head and circular links :

+  record.succ := used root ;

+  used root record.pred := index ;

+  used root record.succ := used root + 1 ;

+  used root record.line := headline (file 17) .

+

+build free record chain :

+  free root record.pred := free root ;

+  free root record.succ := free root ;

+  free root record.y    := index + 1 ;

+  free root record.line := "    0    1    1" ;

+  free root record.line CAT text (maxlinelength (file 17), 5) .

+

+record : CONCR (file 16) (index) .

+

+used root record : CONCR (file 16) (used root) .

+

+free root record : CONCR (file 16) (free root) .

+

+ENDPROC copy 17 to 16 ;

+

+ENDPACKET to 16 ;

diff --git a/system/std.zusatz/1.7.3/src/complex b/system/std.zusatz/1.7.3/src/complex
new file mode 100644
index 0000000..d62085b
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/complex
@@ -0,0 +1,133 @@
+ 

+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; 

+ 

+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/system/std.zusatz/1.7.3/src/crypt b/system/std.zusatz/1.7.3/src/crypt
new file mode 100644
index 0000000..f6711fa
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/crypt
@@ -0,0 +1,139 @@
+PACKET cryptograf DEFINES                            (* Autor: J.Liedtke *)

+                                                     (* Stand: 01.10.80  *)

+  crypt ,

+  decrypt :

+ 

+TEXT VAR char , in buffer, out buffer ;

+INT VAR in pos , key index ;

+DATASPACE VAR scratch space := nilspace ;

+FILE VAR in, out;

+ 

+PROC crypt (TEXT CONST file, key) :

+ 

+  open (file) ;

+  initialize crypt (key) ;

+  WHILE NOT eof REP

+    read char ;

+    crypt char ;

+    write char

+  PER ;

+  close (file) .

+ 

+crypt char :

+  char := code (( character + random char + key char ) MOD 250) ;

+  IF key index = LENGTH key

+    THEN key index := 1

+    ELSE key index INCR 1

+  FI .

+ 

+character   : code (char) .

+ 

+random char : random (0,250).

+ 

+key char    : code (key SUB key index) .

+ 

+ENDPROC crypt ;

+ 

+PROC decrypt (TEXT CONST file, key) :

+ 

+  open (file) ;

+  initialize crypt (key) ;

+  WHILE NOT eof REP

+    read char ;

+    decrypt char ;

+    write char

+  PER ;

+  close (file) .

+ 

+decrypt char :

+  char := code (( character - random char - key char ) MOD 250) ;

+  IF key index = LENGTH key

+    THEN key index := 1

+    ELSE key index INCR 1

+  FI .

+ 

+character   : code (char) .

+ 

+random char : random (0,250) .

+ 

+key char    : code (key SUB key index) .

+ 

+ENDPROC decrypt ;

+ 

+PROC initialize crypt (TEXT CONST key) :

+ 

+  INT VAR random key := 0 ;

+  FOR key index FROM 1 UPTO LENGTH key REP

+    random key := (random key + code (key SUB key index)) MOD 32000

+  PER ;

+  initialize random (random key) ;

+  key index := 1

+ 

+ENDPROC initialize crypt ;

+ 

+PROC open (TEXT CONST source file) :

+ 

+  in := sequential file (input, source file) ;

+  getline (in, in buffer) ;

+  in pos := 1 ;

+  out := sequential file (output, scratch space) ;

+  out buffer := "" .

+ 

+ENDPROC open ;

+ 

+PROC close (TEXT CONST source file) :

+ 

+  IF out buffer <> ""

+    THEN putline (out, out buffer)

+  FI ;

+  forget (source file, quiet) ;

+  copy (scratch space, source file) ;

+  forget (scratch space) .

+ 

+ENDPROC close ;

+ 

+BOOL PROC eof :

+ 

+  IF in pos > LENGTH in buffer

+    THEN eof (in)

+    ELSE FALSE

+  FI

+ 

+ENDPROC eof ;

+ 

+PROC read char :

+ 

+  IF in pos > 250

+    THEN getline (in, in buffer) ;

+         in pos := 1 ;

+         read char

+  ELIF in pos > LENGTH in buffer

+    THEN in pos := 1 ;

+         getline (in, in buffer) ;

+         char := ""13""

+    ELSE char := in buffer SUB in pos ;

+         in pos INCR 1

+  FI .

+ 

+ENDPROC read char ;

+ 

+PROC write char :

+ 

+  IF char = ""13""

+    THEN putline (out, out buffer) ;

+         out buffer := ""

+    ELSE out buffer CAT char

+  FI ;

+  IF LENGTH out buffer = 250

+    THEN putline (out, out buffer) ;

+         out buffer := ""

+  FI .

+ 

+ENDPROC write char ;

+ 

+ENDPACKET cryptograf ;

+

+

+

+

+

diff --git a/system/std.zusatz/1.7.3/src/elan lister b/system/std.zusatz/1.7.3/src/elan lister
new file mode 100644
index 0000000..dc34176
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/elan lister
@@ -0,0 +1,263 @@
+PACKET elan lister DEFINES                            (* Autor: J.Liedtke *)

+                                                      (* Stand: 22.03.84  *)

+      is elan source ,

+      elan list :

+ 

+

+LET source lines per page  = 64 ,

+    x start                = 1 ,

+    y start                = 2 ,

+

+    tag                    = 1 ,

+    bold                   = 2 ,

+ 

+    linelength             = 120 ,

+    struct comment length  = 32 ,

+    max name length        = 25 ,

+    struct comment blanks  = "                                " ,

+    refinement layout line = "                                     |" ,

+    headline pre =

+       " Zeile    *****   E L A N    EUMEL 1.7  *****   " ;

+ 

+INT VAR  symbol type ,

+         line nr ,

+         page nr ,

+         line at page ;

+

+BOOL VAR within defines list ;

+

+TEXT VAR record,

+         list pre ,

+         source name ,

+         source prefix ,

+         symbol,

+         ahead symbol ,

+         bottom blanks := (linelength) * " " ;

+

+

+PROC elan list (FILE VAR source) :

+ 

+  initialize listing ;

+  within defines list := FALSE ;

+  WHILE NOT eof (source) REP

+    list one source line ;

+    line nr INCR 1

+  PER ;

+  page bottom ;

+  start (0.0,0.0) ;

+  new page .

+

+initialize listing :

+  reset printer ;

+  construct source name and prefix ;

+  print first page head ;

+  line nr := 1 .

+

+construct source name and prefix :

+  source name := headline (source) ;

+  INT CONST slash pos := pos (source name, "/") ;

+  IF slash pos = 0

+    THEN source prefix := ""

+    ELSE source prefix := subtext (source name, slash pos+1) + "/" ;

+         source name   := subtext (source name, 1, slash pos-1) 

+  FI .

+

+list one source line :

+  getline (source, record) ;

+  print list pre ;

+  printline (record) ;

+  page if necessary .

+

+print list pre :

+  list pre := text (line nr, 5) ;

+  IF pos (record, "P") = 0 AND pos (record, ":") = 0

+    THEN empty layout

+    ELSE analyze source line

+  FI ;

+  list pre CAT ("|") ;

+  print text (list pre, 0) .

+

+empty layout :

+  list pre CAT struct comment blanks .

+ 

+analyze source line :

+  scan (record) ;

+  next symbol (symbol, symbol type) ;

+  next symbol (ahead symbol) ;

+  IF   begin of packet     THEN packet layout 

+  ELIF within defines list THEN check end of defines part

+  ELIF begin of proc op    THEN proc op layout

+  ELIF begin of refinement THEN refinement layout

+  ELSE                          empty layout

+  FI .

+ 

+begin of packet :

+  symbol = "PACKET" .

+ 

+begin of proc op :

+  IF   is proc or op (symbol)

+    THEN TRUE

+  ELIF (symbol <> "END") AND  is proc or op (ahead symbol)

+    THEN symbol := ahead symbol ;

+         next symbol (ahead symbol) ; TRUE

+    ELSE FALSE

+  FI .

+ 

+begin of refinement :

+  symbol type = tag AND ahead symbol = ":" AND NOT within defines list .

+ 

+packet layout :

+  IF not at page head

+    THEN page bottom ;

+         page head

+  FI ;

+  layout ("   ", ahead symbol, "*") ;

+  within defines list := TRUE .

+

+check end of defines part :

+  empty layout ;

+  scan (record) ;

+  REP

+    nextsymbol (symbol) ;

+    IF symbol = ":"

+      THEN within defines list := FALSE

+    FI

+  UNTIL symbol = "" PER .

+

+proc op layout :

+(*printline ("") ;*)

+  printline ("") ;

+  printline ("") ;

+  IF not two free lines 

+    THEN page bottom ;

+         page head

+  FI ; 

+  layout ("   ", ahead symbol, ".") .

+ 

+refinement layout :

+(*print line (refinement layout line) ;*)

+  print line (refinement layout line) ;

+  IF not two free lines THEN page bottom; page head FI; 

+  layout ("      ", symbol, " ") .

+ 

+

+print first page head :

+  page nr := 1 ;

+  page head .

+

+page if necessary :

+  IF line at page > source lines per page

+    THEN page bottom ;

+         page head

+  FI .

+

+not two free lines :

+  line at page >= source lines per page - 2 .

+

+not at page head :

+  line at page > 5 .

+

+ENDPROC elan list ;

+ 

+BOOL PROC is proc or op (TEXT CONST symbol) :

+

+  symbol = "PROC" OR symbol = "PROCEDURE"

+  OR symbol = "OP" OR symbol = "OPERATOR" 

+

+ENDPROC is proc or op ;

+ 

+PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :

+

+  list pre CAT pre ;

+  name := subtext (name, 1, max name length) ;

+  list pre CAT name ;

+  list pre CAT " " ;

+  generate remaining struct comment .

+ 

+generate remaining struct comment :

+  INT VAR i ;

+  FOR i FROM 1 UPTO remaining struct comment length REP

+    list pre CAT post

+  PER .

+

+remaining struct comment length :

+  struct comment length - LENGTH pre - min(LENGTH name,max name length) - 1.

+ 

+ENDPROC layout ;

+

+PROC print line (TEXT CONST line text) :

+

+  print text (line text, 0) ;

+  line (1.0) ;

+  line at page INCR 1

+

+ENDPROC print line ;

+

+PROC printtext (TEXT CONST t, BOOL CONST b) :

+  out (t)

+ENDPROC printtext ;       (*** sonst im Hardwaretreiber *********)

+

+PROC page head :

+

+  new page ;

+  print text (headline pre, 0) ;

+  print text (date, 0);           (* R. Nolting 27.10.83 *)

+  print text ("   *****     ",0);

+  print text (source name, 0) ;

+  line (4.0) ;

+  line at page := 1 

+

+ENDPROC page head ;

+

+PROC page bottom :

+

+  WHILE line at page < source lines per page REP

+    line (1.0) ;

+    line at page INCR 1

+  PER ;

+  line (1.0) ;

+  printtext (text (source prefix + text (page nr), 8), FALSE) ;

+  printtext (bottom blanks, FALSE) ;

+  printtext (source prefix + text (page nr), FALSE) ;

+  line (1.0) ;

+  page nr INCR 1 .

+

+ENDPROC page bottom ;

+

+BOOL PROC is elan source (FILE VAR source) :

+

+  input (source) ;

+  get first symbol ;

+  symbol type = tag COR is bold begin of program COR is comment .

+

+is bold begin of program :

+  symbol type = bold CAND is elan bold .

+

+is elan bold :

+  symbol = "PACKET" COR is proc or op (symbol) COR is data declaration .

+

+is data declaration :

+  next symbol (symbol) ;

+  symbol = "VAR" OR symbol = "CONST" .

+

+is comment :

+  pos (record, "(*") > 0 OR pos (record, "{") > 0 .

+

+

+get first symbol :

+  get first non blank record ;

+  scan (record) ;

+  next symbol (symbol, symbol type) ;

+  reset (source) .

+

+get first non blank record :

+  REP

+    getline (source, record)

+  UNTIL record contains non blank OR eof (source) PER .

+

+record contains non blank :

+  pos (record, ""33"",""254"", 1) > 0 .

+

+ENDPROC is elan source ;

+

+ENDPACKET elan lister ;

diff --git a/system/std.zusatz/1.7.3/src/eumel printer b/system/std.zusatz/1.7.3/src/eumel printer
new file mode 100644
index 0000000..79a4b2c
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/eumel printer
@@ -0,0 +1,369 @@
+PACKET eumel printer DEFINES 

+(***************************************************************************

+*****  EUMEL - DRUCKER                      ** Author: A. Reichpietch     **

+*****                                       **         R. Nolting         **

+*****                                       ** Date:   30.09.81 Vers. 0   **

+*****                                       **         15.03.82 Vers. 1.0 **

+*****                                       **         22.07.82 Vers. 1.1 **

+*****                                       **         01.10.82 Vers. 1.2 **

+***** reelle Werte fuer limit etc.          **         15.01.83 Vers. 2.0 **

+***** direkte Druckerkommandos (Hardware)   **         15.08.83 Vers. 2.1 **

+*****                                       **         15.12.83 Vers. 2.2 **

+***** alle Zeilen-/Spaltenprocs entfernt    **         9.1.84   Vers. 2.3 **

+***** neue 'print text' prozedur            **         04.03.84 Vers. 2.4 **

+***************************************************************************)

+ 

+              print, 

+              reset print,

+              print line, 

+              pages printed,

+

+              is elan source , (* dummy Prozeduren , koennen von  *)

+              elan list :      (* 'elan lister' ueberdeckt werden *)

+ 

+

+LET blank = " " ,

+    backspace = ""8"" ,

+    begin mark underline = ""15"" ,

+    end mark underline = ""14"" ;

+LET paragraph end = " ";

+TEXT VAR inline := blank, 

+         outline := blank, 

+         type := blank, 

+         command char,

+         help := blank; 

+TEXT VAR command, 

+         par 1, par 2,

+         skip end text;

+REAL VAR  y position, y step, y max, y factor;

+INT VAR pagenr, from, to; 

+INT VAR printed pages;

+BOOL VAR not skipped, lines to be skipped,

+         first text line, end of paragraph,

+         linefeed needed;

+LET std pagelength = 25.4;

+

+INT VAR print mode set := left adj, collumn print possible;

+LET left adj=       0;

+LET right adj=      1;

+LET centre adj=     2;

+LET block line=     3;

+LET left col=       4;

+LET right col=      5;

+LET centre col=     6;

+LET block col=      7;

+LET collumn print = 4;

+ 

+

+PROC print (FILE VAR f):

+  enable stop;

+  reset printer; 

+  reset print;

+  print (f, from, to);

+END PROC print;

+ 

+PROC print (FILE VAR f, INT CONST first page, last page): 

+  enable stop;

+  from := first page; 

+  to := last page; 

+  IF from > 1 THEN not skipped := FALSE FI; 

+  WHILE (NOT eof(f)) AND (pagenr <= to)  REP 

+     getline (f, inline);

+     print input line;

+     ENDREP;

+  start(0.0, 0.0); make page;

+ENDPROC print; 

+

+PROC reset print:

+     first text line := TRUE;

+     not skipped := TRUE; 

+     lines to be skipped := FALSE;

+     command char := "#"; 

+     print mode set := left adj;

+     end of paragraph := TRUE;

+     inline := ""; 

+     y max := stdpagelength ;

+     y position := 10000.0;

+     y step := lf height of current font;

+     y factor := 1.0; 

+     pagenr := 0; 

+     from := 1; to := maxint;

+     printed pages := -1; (* move to top of first page will set to 0 *)

+ENDPROC reset print;

+ 

+INT PROC pages printed: 

+  printed pages 

+END PROC pages printed; 

+ 

+PROC print line (TEXT CONST in): 

+  inline := in;

+  print input line;

+END PROC print line;

+ 

+PROC print input line:

+(* debug   out ("print line:"); out (in); out (""10""13"");    debug *)

+INT VAR compos;

+INT VAR endpos := 0, tpos := 1;

+IF lines to be skipped

+     THEN IF pos (inline, skip end text) > 1 AND (inline SUB 1) = command char

+             THEN lines to be skipped := FALSE

+             FI;

+             LEAVE print input line

+     FI;

+  linefeed needed := FALSE;

+IF end of paragraph

+   THEN collumn print possible := collumn print

+   ELSE collumn print possible := 0

+   FI;

+compos := LENGTH inline;

+IF (inline SUB compos) = paragraph end

+   THEN end of paragraph := TRUE;

+        inline := subtext (inline, 1, compos -1)

+   ELSE end of paragraph := FALSE;

+   FI;

+  compos := pos (inline, command char);

+  IF compos <= 0

+     THEN print the line (inline);

+          new line;

+          LEAVE print input line

+     FI;

+  outline := "";

+  extract commands from input;

+  IF outline <> ""

+     THEN print the line (outline); new line 

+  ELIF linefeed needed 

+     THEN new line FI;

+.

+extract commands from input:

+WHILE compos > 0 REP

+  outline CAT subtext (inline, tpos, compos-1);

+  endpos := pos ( inline, command char, compos +1);

+  IF endpos <= compos

+     THEN endpos := compos - 1;

+          compos := 0

+     ELSE command := subtext ( inline, compos +1, endpos -1); 

+          analyze command ( command); 

+          tpos := endpos +1;

+          compos := pos(inline, command char, tpos);

+     FI;

+  PER;

+outline CAT subtext (inline, endpos + 1);

+

+ENDPROC print input line; 

+

+ 

+TEXT VAR comlist:="ub:1.0ue:2.0type:4.1linefeed:5.1limit:6.1free:7.1page:8.01

+pagenr:9.2pagelength:10.1start:11.2foot:12.0end:13.0head:15.0headeven:16.0

+headodd:17.0bottom:19.0bottomeven:20.0bottomodd:21.0"

+LET com list 2 =

+"on:22.1off:23.1block:24.0left:25.0right:26.0centre:27.0center:28.0material:31.1papersize:32.2print:33.2"; 

+comlist CAT comlist 2;

+ 

+PROC analyze command (TEXT CONST command): 

+(* debug   out ("analyze command:"); out (command); out (""10""13"");    debug *)

+IF pos (command, "-") = 1

+     THEN LEAVE analyze command

+     ELIF pos (command, "/") = 1 

+          THEN help := subtext (command, 2);

+               print line so far;

+               printer cmd (help);

+               LEAVE analyze command

+     FI;

+INT VAR comindex := -1, number := 0; 

+   par 1 := ""; par 2 := ""; 

+   disable stop;

+   analyze command ( com list, command, 3, comindex, number, par 1, par 2); 

+   IF is error

+      THEN clear error 

+      ELSE select command 

+      FI; 

+   enable stop;

+.

+select command : 

+ SELECT comindex OF 

+        CASE 1  :       print line so far; on ("u");

+        CASE 2  :       print line so far; off ("u");

+        CASE 4  :       print line so far; set type (par 1)

+        CASE 5  :       set linefeed ( par 1) 

+        CASE 6  :       set limit (par 1) 

+        CASE 7  :       print line so far; free (par 1)

+        CASE 8  :       print line so far; make page

+        CASE 9  :

+        CASE 10 :       set pagelength  (par 1)

+        CASE 11 :       set start (par 1, par 2)

+        CASE 12 :       (* skip text ("end") *)

+        CASE 15,16,17 : (* skip text ("end") *)

+        CASE 19,20,21 : (* skip text ("end") *)

+        CASE 22 :       print line so far; on (par1) 

+        CASE 23 :       print line so far; off (par1) 

+        CASE 24 :       print line so far; print mode set := block line;

+        CASE 25 :       print line so far; print mode set := left adj;

+        CASE 26 :       print line so far; print mode set := right adj

+        CASE 27 :       print line so far; print mode set := centre adj

+        CASE 28 :       comindex := print mode set MOD 4;

+                        IF comindex = block line

+                           THEN inline CAT "#block#"

+                        ELIF comindex = left adj

+                           THEN inline CAT "#left#"

+                        ELIF comindex = right adj

+                           THEN inline CAT "#right#"

+                        FI;

+                        print mode set := centre adj;

+(* the following commands must appear before any text *)

+        CASE 31 :       IF first text line THEN material (par1) FI

+        CASE 32 :       IF first text line THEN do papersize (par1, par2) FI

+        CASE 33 :       IF first text line THEN print from page till page (par1, par2) FI

+        OTHERWISE 

+       END SELECT ; 

+.

+print line so far:

+  IF outline <> ""

+     THEN print the line (outline);

+          outline := "";

+          linefeed needed := TRUE

+     FI;

+ 

+ENDPROC analyze command; 

+ 

+PROC do papersize (TEXT CONST s, t):

+REAL VAR w, l;

+     IF ok (par1, w) AND ok (par2, l) 

+          THEN papersize (w, l)

+     FI;

+END PROC do papersize;

+ 

+PROC print from page till page(TEXT VAR s, t):

+INT VAR i, j;

+  IF ok (par1, i) AND ok (par2, j)

+     THEN from := i;

+          to := j;

+     FI;

+END PROC print from page till page; 

+ 

+PROC set type (TEXT CONST new type): 

+  change type (new type);

+  y step := lf height of current font;

+ENDPROC set type; 

+ 

+PROC make page : 

+  IF y position > 0.0 CAND NOT first text line

+     THEN y position := y max + 1.0; new line

+     FI; 

+  end of paragraph := TRUE;

+  inline := "";  (* this stops further processing of the input line *)

+ENDPROC make page; 

+ 

+PROC skip text (TEXT CONST endword):

+  lines to be skipped := TRUE;

+  skip end text := endword;

+  inline := ""; (* possible rest of the line is not examined *)

+END PROC skip text;

+ 

+PROC set linefeed ( TEXT CONST lf): 

+REAL VAR l:= real (lf); 

+   IF last conversion ok THEN y factor := l FI;

+ENDPROC set linefeed; 

+ 

+PROC set limit ( TEXT CONST l): 

+  REAL VAR len;

+  IF ok (l, len) 

+     THEN limit (len) 

+     FI;

+ENDPROC set limit; 

+ 

+BOOL PROC ok ( TEXT CONST param, INT VAR number): 

+    number := int (param) ; 

+    last conversion ok 

+ENDPROC ok; 

+ 

+BOOL PROC ok ( TEXT CONST param, REAL VAR number): 

+    number := real (param) ; 

+    last conversion ok 

+ENDPROC ok; 

+ 

+PROC set pagelength (TEXT CONST y): 

+REAL VAR iy ; 

+  IF ok (y, iy )

+     THEN y max := iy;

+FI; 

+ENDPROC set pagelength; 

+ 

+PROC set start (TEXT CONST x, y): 

+REAL VAR rx, ry;

+  IF ok (x, rx) AND ok (y, ry) 

+     THEN start (rx, ry)

+     FI; 

+ENDPROC set start; 

+ 

+PROC free (TEXT CONST p): 

+REAL VAR x, y := y factor;

+  IF ok (p, x)

+     THEN advance 

+     FI; 

+y factor := y;

+end of paragraph := TRUE;

+  inline := "";  (* this stops further processing of the input line *)

+. 

+advance:

+  y factor := x / y step;

+  IF outline <> ""

+     THEN print the line (outline);

+          outline := ""

+     FI;

+  IF first text line

+     THEN new line FI;

+new line;

+END PROC free; 

+ 

+PROC print the line ( TEXT CONST in): 

+(* debug   out ("print the line:"); out (in); out (print mode set);

+out (""10""13"");  debug *)

+IF first text line

+     THEN first text line := FALSE; new line FI;

+IF not skipped

+   THEN IF print mode set = blockline

+           THEN IF end of paragraph

+                   THEN print text (in, left adj + collumn print possible)

+                   ELSE print text (in, blockline + collumn print possible)

+                   FI

+           ELSE print text (in, print mode set + collumn print possible)

+           FI

+   FI;

+ENDPROC print the line; 

+ 

+PROC new line: 

+(* debug   out ("new line: lf=");  out (text(yfactor)); out (""10""13"");    debug *)

+IF page is full 

+     THEN pagenr INCR 1; 

+          IF not skipped 

+             THEN printed pages INCR 1;

+                  new page

+                  FI;

+             check printmodes; 

+             y position := 0.0

+     ELSE IF not skipped

+             THEN line (y factor) 

+             FI;

+          y position INCR yfactor * y step 

+     FI; 

+ENDPROC new line; 

+ 

+PROC check printmodes: 

+   not skipped := ( pagenr >=  from) AND ( pagenr <= to);

+ENDPROC check printmodes; 

+ 

+BOOL PROC page is full: 

+     y position + yfactor * y step > y max

+ENDPROC page is full; 

+ 

+(********** dummys ************)

+

+BOOL PROC is elan source (FILE VAR source) :

+  FALSE

+ENDPROC is elan source ;

+ 

+PROC elan list (FILE VAR source) :

+  print (source)

+ENDPROC elan list ;

+

+ENDPACKET eumel printer;

diff --git a/system/std.zusatz/1.7.3/src/eumelmeter b/system/std.zusatz/1.7.3/src/eumelmeter
new file mode 100644
index 0000000..24f5833
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/eumelmeter
@@ -0,0 +1,130 @@
+                                              (* Author: J.Liedtke*)

+PACKET eumelmeter DEFINES                     (* Stand:  11.10.83 *)

+ 

+     init log ,

+     log :

+ 

+ 

+LET snapshot interval = 590.0 ;

+

+REAL VAR next snapshot time ,

+         time        , timex ,

+         paging wait , paging wait x ,

+         paging busy , paging busy x ,

+         fore cpu    , fore cpu x ,

+         back cpu    , back cpu x ,

+         system cpu  , system cpu x ,

+         delta t ;

+INT VAR storage max, used ;

+TEXT VAR record ;

+

+PROC init log :

+

+  time        := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  next snapshot time := time + snapshot interval

+

+ENDPROC init log ;

+

+PROC log (INT CONST active terminals, active background) :

+

+  new snapshot time if was clock reset ;

+  IF clock (1) >= next snapshot time

+    THEN save values ;

+         get new values ;

+         create stat record ;

+         put log (record) ;

+         define next snapshot time

+  FI .

+

+new snapshot time if was clock reset :

+  IF clock (1) < next snapshot time - snapshot interval 

+    THEN next snapshot time := clock (1)

+  FI .

+

+save values :

+  time x := time ;

+  paging wait x := paging wait ;

+  paging busy x := paging busy ;

+  fore cpu x    := fore cpu ;

+  back cpu x    := back cpu ;

+  system cpu x  := system cpu .

+

+get new values :

+  time := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  storage (storage max, used) .

+

+create stat record :

+  record :=  text (used, 5) ;

+  record CAT text (active terminals,3) ;

+  record CAT text (active background,3) ;

+  delta t := (time - time x) ;

+  percent (paging wait, paging wait x) ;

+  percent (paging busy, paging busy x) ;

+  percent (fore cpu, fore cpu x) ;

+  percent (back cpu, back cpu x) ;

+  percent (system cpu, system cpu x) ;

+  percent (last, 0.0) ;

+  percent (nutz, 0.0) .

+

+last :   paging wait  + paging busy  + fore cpu  + back cpu  + system cpu

+       - paging waitx - paging busyx - fore cpux - back cpux - system cpux .

+

+nutz :   time  - paging wait  - system cpu

+       - timex + paging waitx + system cpux .

+

+define next snapshot time :

+  next snapshot time := time + snapshot interval .

+ 

+ENDPROC log ;

+

+PROC percent (REAL CONST neu, alt ) :

+

+  record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%"

+

+ENDPROC percent ;

+

+ENDPACKET eumelmeter ;

+ 

+INT VAR active terminals , active background ;

+

+task password ("-") ;

+break ;

+command dialogue (FALSE) ;

+forget ("eumelmeter") ;

+init log ;

+REP

+  pause (6000) ;

+  count active processes (active terminals, active background) ;

+  log (active terminals, active background)

+PER ;

+

+PROC count active processes (INT VAR active terminals, active background) :

+ 

+  active terminals := 0 ;

+  active background := 0 ;

+  TASK VAR process := myself ;

+  REP

+    next active (process) ;

+    IF user process 

+      THEN IF process at terminal

+             THEN active terminals INCR 1

+             ELSE active background INCR 1

+           FI

+    FI

+  UNTIL process = myself PER .

+

+user process :         NOT (process < supervisor) .

+

+process at terminal :  channel (process) >= 0 .

+

+ENDPROC count active processes ;

diff --git a/system/std.zusatz/1.7.3/src/free channel b/system/std.zusatz/1.7.3/src/free channel
new file mode 100644
index 0000000..89f7ce0
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/free channel
@@ -0,0 +1,292 @@
+PACKET free channel DEFINES                       (* Autor: J.Liedtke *)

+                                                  (* Stand: 05.10.82  *)

+  FCHANNEL ,

+  := ,

+  free channel ,

+  open ,

+  close ,

+  out ,

+  in ,

+  dialogue :

+ 

+ 

+

+LET ack                = 0 ,

+    nak                = 1 ,

+    break code         = 6 ,

+    empty message code = 256 ,

+    long message code  = 257 ,

+    file message code  = 1024 ,

+    open code          = 1000 ,

+    close code         = 1001 ,

+

+    cr                 = ""13"" ;

+

+INT CONST task not existing := - 1 ;

+

+

+TYPE FCHANNEL = STRUCT (TASK server, TEXT input buffer, server name) ;

+

+INT VAR message code , response code ;

+TASK VAR partner , used by ;

+DATASPACE VAR ds ;

+

+BOUND TEXT VAR msg ;

+TEXT VAR response, char, esc char , record ;

+

+FILE VAR file ;

+

+

+OP := (FCHANNEL VAR dest, FCHANNEL CONST source) :

+ 

+  dest.server := source.server ;

+  dest.input buffer := "" ;

+  dest.server name := source.server name ;

+  open (dest)

+

+ENDOP := ;

+

+FCHANNEL PROC free channel (TEXT CONST channel name) :

+

+  FCHANNEL:(niltask,"", channel name)

+

+ENDPROC free channel ;

+

+PROC open (FCHANNEL VAR channel) :

+

+  TASK VAR task id ;

+  INT VAR receipt ;

+ 

+  initialize message dataspace ;

+  send open code ;

+  IF receipt <> ack

+    THEN errorstop ("channel not free")

+  FI .

+

+initialize message dataspace :

+  forget (ds) ;

+  ds := nilspace .

+

+send open code :

+  ping pong (channel.server, open code, ds, receipt) ;

+  IF receipt = task not existing

+    THEN channel.server := task (channel.server name) ;

+         ping pong (channel.server, open code, ds, receipt)

+  FI .

+ 

+ENDPROC open ;

+

+PROC close (FCHANNEL VAR channel) :

+

+  call (channel.server, close code, ds, response code)

+

+ENDPROC close ;

+

+PROC close (TEXT CONST channel server) :

+

+  call (task (channel server), close code, ds, response code)

+

+ENDPROC close ;

+

+

+PROC out (FCHANNEL VAR channel, TEXT CONST message) :

+

+  send message ;

+  get response .

+

+send message :

+  IF message = ""

+    THEN call (channel.server, empty message code, ds, response code)

+    ELSE msg := ds ;

+         CONCR (msg) := message ;

+         call (channel.server, long message code, ds, response code)

+  FI .

+

+get response :

+  IF response code < 0

+    THEN errorstop ("channel not ready")

+  ELIF response code < 256

+    THEN channel.input buffer CAT code (response code)

+  ELIF response code = long message code

+    THEN msg := ds ;

+         channel.input buffer CAT CONCR (msg)

+  FI .

+

+ENDPROC out ;

+

+PROC in (FCHANNEL VAR channel, TEXT VAR response) :

+

+  out (channel, "") ;

+  response := channel.input buffer ;

+  channel.input buffer := ""

+

+ENDPROC in ;

+

+PROC out (FCHANNEL VAR channel, DATASPACE CONST file space) :

+

+  out (channel, file space, ""0"")

+

+ENDPROC out ;

+

+PROC out (FCHANNEL VAR channel, DATASPACE CONST file space,

+          TEXT CONST handshake char) :

+

+  forget (ds) ;

+  ds := file space ;

+  call (channel.server, file message code + code (handshake char) ,

+                        ds, response code) ;

+  forget (ds) ;

+  ds := nilspace

+

+ENDPROC out ;

+

+

+PROC dialogue (FCHANNEL CONST channel, TEXT CONST esc) :

+

+  forget (ds) ;

+  ds := nilspace ;

+  partner := channel.server ;

+  esc char := esc ;

+  enable stop ;

+

+  response code := empty message code ;

+  REP

+    get and send message charety ;

+    out response option

+  PER .

+

+get and send message charety :

+  IF response code = empty message code

+    THEN char := incharety (10)

+    ELSE char := incharety

+  FI ;

+  IF char = ""

+    THEN call (partner, empty message code, ds, response code)

+  ELIF char = esc char

+    THEN LEAVE dialogue

+  ELSE   call (partner, code (char), ds, response code)

+  FI .

+

+out response option :

+  IF response code < 256

+    THEN out (code (response code))

+  ELIF response code = long message code

+    THEN msg := ds ;

+         out (CONCR (msg))

+  FI .

+

+ENDPROC dialogue ;

+

+PROC free channel (INT CONST nr) :

+

+  INT CONST my channel := nr ;

+  break ;

+  disable stop ;

+  REP

+    wait (ds, message code, partner) ;

+    IF message code = open code

+      THEN connect to my channel ;

+           use channel ;

+           break without advertise ;

+           send handshake ack 

+      ELSE send (partner, nak, ds)

+    FI

+  PER .

+

+use channel :

+  ping pong (partner, ack, ds, message code) ;

+  REP

+    execute message ;

+    response option

+  PER .

+

+execute message :

+  IF   message code < 0

+    THEN LEAVE use channel

+  ELIF message code < 256

+    THEN out (code (message code))

+  ELIF message code = long message code

+    THEN msg := ds ;

+         out (CONCR (msg))

+  ELIF message code >= file message code

+    THEN send file ;

+         clear error

+  ELIF message code = close code

+    THEN LEAVE use channel

+  FI .

+

+response option :

+  response := incharety (1) ;

+  IF response = ""

+    THEN ping pong (partner, empty message code, ds, message code)

+    ELSE short or long response

+  FI .

+

+short or long response :

+  char := incharety ;

+  IF char = ""

+    THEN short response

+    ELSE long response

+  FI .

+

+short response :

+  ping pong (partner, code (response), ds, message code) .

+

+long response :

+  msg := ds ;

+  response CAT char ;

+  REP

+    char := incharety ;

+    response CAT char

+  UNTIL char = "" PER ;

+  CONCR (msg) := response ;

+  ping pong (partner, long message code, ds, message code) .

+

+connect to my channel :

+  continue (my channel) ;

+  WHILE is error REP

+    clear error ;

+    pause (100) ;

+    continue (my channel)

+  PER .

+

+break without advertise :

+  INT VAR receipt ;

+  call (supervisor, break code, ds, receipt) .

+

+send handshake ack :

+  send (partner, ack, ds) .

+

+ENDPROC free channel ;

+

+PROC send file :

+

+  enable stop ;

+  get handshake ;

+  file := sequential file (input,ds) ;

+  REP

+    getline (file, record) ;

+    out (record) ;

+    out (cr) ;

+    handshake option

+  UNTIL eof (file) PER .

+

+get handshake :

+  TEXT CONST handshake char := code (message code - file message code) .

+

+handshake option :

+  IF handshake char <> ""0""

+    THEN wait for handshake or time out

+  FI .

+

+wait for handshake or time out :

+  REP

+    char := incharety (300)

+  UNTIL char = handshake char OR char = "" PER ;

+  IF char = ""

+    THEN LEAVE send file

+  FI .

+

+ENDPROC send file ;

+

+ENDPACKET free channel ;

diff --git a/system/std.zusatz/1.7.3/src/longint b/system/std.zusatz/1.7.3/src/longint
new file mode 100644
index 0000000..ac3dad5
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/longint
@@ -0,0 +1,422 @@
+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/system/std.zusatz/1.7.3/src/matrix b/system/std.zusatz/1.7.3/src/matrix
new file mode 100644
index 0000000..fbc5ffc
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/matrix
@@ -0,0 +1,470 @@
+PACKET matrix DEFINES MATRIX, matrix, idn,  (* Stand : 21.10.83      *)

+                      :=, 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.rows);

+  INT VAR i;

+  FOR i FROM 1 UPTO m.rows

+  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.columns);

+  INT VAR i;

+  FOR i FROM 1 UPTO m.columns

+  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;

+  FOR j FROM 1 UPTO n

+  REP pivotsuche (a, j, pos);

+      zeilentausch (a, j, pos);

+      transformiere die matrix

+  PER;

+  produkt der pivotelemente  .

+

+transformiere die matrix :

+  REAL VAR h := 1.0/sub (a, j, j);

+  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  .

+

+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/system/std.zusatz/1.7.3/src/minimal fonts routines b/system/std.zusatz/1.7.3/src/minimal fonts routines
new file mode 100644
index 0000000..adcfc66
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/minimal fonts routines
@@ -0,0 +1,9 @@
+PACKET minimal fonts routines DEFINES lf height of current font, 

+                                      x factor per inch, 

+                                      y factor per inch: 

+ 

+REAL CONST lf height of current font :: 2.54 / 6.0;

+INT CONST x factor per inch         :: 10,

+          y factor per inch         ::  6;

+ 

+END PACKET minimal fonts routines;

diff --git a/system/std.zusatz/1.7.3/src/printer-M b/system/std.zusatz/1.7.3/src/printer-M
new file mode 100644
index 0000000..45b1381
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/printer-M
@@ -0,0 +1,69 @@
+PACKET multi user printer :

+

+INT VAR printer channel ;

+

+  put ("Druckerkanal:") ;

+  get (printer channel) ;

+  server channel (printer channel); 

+ 

+  command dialogue (FALSE) ;

+  spool manager (PROC printer) ;

+

+

+LET ack = 0 ,

+    fetch code = 11 ,

+    file type = 1003 ;

+

+INT VAR reply , old heap size ;

+

+DATASPACE VAR ds ;

+

+FILE VAR file ;

+

+PROC printer :

+

+  disable stop ;

+  continue (server channel) ;

+  IF is error

+    THEN clear error ;

+         end

+  FI ;

+

+  old heap size := heap size ;

+  REP

+    forget (ds) ;

+    execute print ;

+    IF is error AND online

+      THEN put error

+    FI ;

+    clear error ;

+    IF heap size > old heap size + 4

+      THEN collect heap garbage ;

+           old heap size := heap size

+    FI

+  PER 

+

+ENDPROC printer ;

+

+PROC execute print :

+

+  enable stop ;

+  REP

+    ds := nilspace ;

+    call (father, fetch code, ds, reply) ;

+    IF reply = ack CAND type (ds) = file type

+      THEN print file

+    FI ;

+    forget (ds)

+  PER .

+

+print file :

+  file := sequential file (input, ds) ;

+  IF is elan source (file)

+    THEN elan list (file)

+    ELSE print (file)

+  FI .

+

+ENDPROC execute print ;

+

+ENDPACKET multi user printer ;

diff --git a/system/std.zusatz/1.7.3/src/printer-S b/system/std.zusatz/1.7.3/src/printer-S
new file mode 100644
index 0000000..5124cc4
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/printer-S
@@ -0,0 +1,36 @@
+PACKET single user print cmd DEFINES print :

+ 

+INT VAR print channel ;

+FILE VAR print file ;

+

+put ("Druckerkanal:") ;

+get (print channel) ;

+

+PROC print :

+

+  print (last param)

+

+ENDPROC print ;

+

+PROC print (TEXT CONST file name) :

+

+  last param (file name) ;

+  print file := sequential file (input, file name) ;

+  continue (print channel) ;

+  disable stop ;

+  execute print ;

+  continue (0)

+

+ENDPROC print ;

+

+PROC execute print :

+

+  enable stop ;

+  IF is elan source (print file)

+    THEN elan list (print file)

+    ELSE print (print file)

+  FI

+

+ENDPROC execute print ;

+

+ENDPACKET single user print cmd ;

diff --git a/system/std.zusatz/1.7.3/src/purge b/system/std.zusatz/1.7.3/src/purge
new file mode 100644
index 0000000..e325646
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/purge
@@ -0,0 +1,85 @@
+

+PACKET purge DEFINES purge :

+

+ 

+TEXT VAR task name, record, file name, dummy ;

+

+FILE VAR permit ;

+

+

+PROC purge :

+

+  IF exists ("permitted tasks")

+    THEN access catalogue ;

+         permit := sequential file (input, "permitted tasks") ;

+         say (""10""13"TASKS :"10""10""13"") ;

+         IF myself < supervisor

+           THEN purge son tasks (brother (supervisor))

+           ELSE purge son tasks (myself)

+         FI

+  FI ;

+  IF exists ("permitted files")

+    THEN permit := sequential file (input, "permitted files") ;

+         say (""10""13"DATEIEN :"10""10""13"") ;

+         purge files

+  FI

+

+ENDPROC purge ;

+

+PROC purge son tasks (TASK CONST father task) :

+

+  TASK VAR actual task := son (father task) ;

+  WHILE NOT is niltask (actual task) REP

+    purge son tasks (actual task) ;

+    IF NOT actual task permitted

+      THEN erase actual task

+    FI ;

+    actual task := brother (actual task)

+  END REP .

+

+erase actual task :

+  say ("""") ; say (task name) ; say ("""") ;

+  IF yes (" loeschen")

+    THEN end (actual task)

+  FI .

+

+actual task permitted :

+  task name := name (actual task) ;

+  reset (permit) ;

+  WHILE NOT eof (permit) REP

+    getline (permit, record) ;

+    IF task name = record

+      THEN LEAVE actual task permitted WITH TRUE

+    FI

+  END REP ;

+  FALSE .

+

+ENDPROC purge son tasks ;

+

+PROC purge files :

+

+  begin list ;

+  get list entry (file name, dummy) ;

+  WHILE file name <> "" REP

+    IF NOT file permitted

+      THEN forget (file name)

+    FI ;

+    get list entry (file name, dummy)

+  END REP .

+

+file permitted :

+  IF file name = "permitted tasks" OR file name = "permitted files"

+    THEN LEAVE file permitted WITH TRUE

+  FI ;

+  reset (permit) ;

+  WHILE NOT eof (permit) REP

+    getline (permit, record) ;

+    IF file name = record

+      THEN LEAVE file permitted WITH TRUE

+    FI

+  END REP ;

+  FALSE .

+

+ENDPROC purge files ;

+

+ENDPACKET purge ;

diff --git a/system/std.zusatz/1.7.3/src/referencer b/system/std.zusatz/1.7.3/src/referencer
new file mode 100644
index 0000000..5606e4c
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/referencer
@@ -0,0 +1,1077 @@
+PACKET referencer errors DEFINES report referencer error: 

+ 

+(* Programm zur Fehlerbehandlung des referencers.

+   Autor: Rainer Hahn

+   Stand: 04.05.83

+*)

+TEXT VAR fehlerdummy,

+         message;

+

+PROC report referencer error (INT CONST error nr,

+                           INT CONST line nr,

+                           TEXT CONST addition):

+ 

+  einfache fehlermeldung aufbauen; 

+  diese auf terminal ausgeben; 

+  fehlermeldung in fehlerdatei ausgeben. 

+ 

+einfache fehlermeldung aufbauen: 

+  message := "WARNUNG in Zeile ";

+  message CAT text (line nr);

+  message CAT " : ";

+  message CAT simple message.

+ 

+diese auf terminal ausgeben: 

+  line; 

+  out (message); 

+  line. 

+ 

+fehlermeldung in fehlerdatei ausgeben: 

+  note (message); 

+  note line;

+  fehlerdummy := "   >>> ";

+  fehlerdummy CAT zusatz;

+  note (fehlerdummy);

+  note line.

+ 

+simple message: 

+  SELECT error nr OF 

+  CASE 1: "Text Denoter ueber mehr als eine Zeile"

+  CASE 2: "Nicht beendeter Text Denoter bei Programmende" 

+  CASE 3: "Kommentar ueber mehr als eine Zeile" 

+  CASE 4: "Nicht beendeter Kommentar bei Programmende" 

+  CASE 5: "Ueberdeckung"

+  CASE 6, 9: "Refinement mehrmals eingesetzt" 

+  CASE 7, 10: "Refinement wird nicht aufgerufen"

+  CASE 8: "Objekt wird nicht angesprochen"

+  OTHERWISE "" 

+  ENDSELECT. 

+ 

+zusatz: 

+  SELECT error nr OF 

+  CASE 1, 2, 3, 4: "Ueber " + addition + " Zeilen"

+  CASE 5: addition

+  CASE 6, 7, 8: addition

+  CASE 9, 10: addition + " in mindestens einer Prozedur"

+  OTHERWISE "interner Fehler: HRZ Bielefeld benachrichtigen!" 

+  END SELECT.

+END PROC report referencer error 

+END PACKET referencer errors; 

+(************************************************************************)

+ 

+PACKET name table handling

+              DEFINES NAMETABLE,

+                      empty name table,

+                      put name, 

+                      get name,

+                      dump table:

+ 

+(* Programm zur Speicherung von Namen.

+   Autor: Rainer Hahn

+   Stand: 04.05.83

+*)

+LET hash table length           = 1024, 

+    hash table length minus one = 1023,

+    start of name table         = 255,

+    name table length           = 2000;

+ 

+TYPE NAMETABLE = STRUCT (INT number of entries, 

+                         ROW hash table length INT hash table,

+                         ROW name table length INT next, 

+                         ROW name table length TEXT name table); 

+ 

+TEXT VAR dummy, f;

+ 

+PROC put name (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer):

+  INT VAR errechneter index; 

+  hash (name, errechneter index); 

+  IF noch kein eintrag 

+    THEN gaenzlich neuer eintrag 

+    ELSE name in vorhandener kette 

+  FI. 

+ 

+noch kein eintrag: 

+  n . hash table [errechneter index] = 0. 

+ 

+gaenzlich neuer eintrag: 

+  n . hash table [errechneter index] := n . number of entries; 

+  neuer eintrag (n, name, pointer).

+ 

+name in vorhandener kette:

+  INT VAR dieser eintrag :: n. hash table [errechneter index]; 

+  REP 

+    IF name ist vorhanden

+      THEN pointer := dieser eintrag;

+           LEAVE put name 

+    ELIF kette zu ende

+      THEN neuer eintrag an vorhandene kette anketten; 

+           neuer eintrag (n, name, pointer);

+           LEAVE put name

+      ELSE naechster eintrag in der kette

+    FI 

+  END REP.

+ 

+name ist vorhanden: 

+  n . name table [dieser eintrag] = name.

+ 

+kette zu ende: 

+  n . next [dieser eintrag] = 0.

+ 

+neuer eintrag an vorhandene kette anketten: 

+  n . next [dieser eintrag] := n . number of entries. 

+ 

+naechster eintrag in der kette:

+  dieser eintrag := n . next [dieser eintrag].

+END PROC put name; 

+ 

+PROC neuer eintrag (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer):

+  n . name table [n . number of entries] := name; 

+  n . next [n . number of entries] := 0; 

+  pointer := n . number of entries;

+  n . number of entries INCR 1; 

+  IF n . number of entries > name table length 

+    THEN errorstop ("volle Namenstabelle")

+  FI 

+END PROC neuer eintrag;

+ 

+PROC hash (TEXT CONST name, INT VAR index) :

+  INT VAR i;

+  index := code (name SUB 1);

+  FOR i FROM 2 UPTO length (name) REP

+    addmult cyclic

+  ENDREP.

+ 

+addmult cyclic :

+  index INCR index ;

+  IF index > hash table length minus one

+    THEN wrap around

+  FI;

+  index := (index + code (name SUB i)) MOD hash table length.

+ 

+wrap around :

+  index DECR hash table length minus one

+ENDPROC hash ;

+ 

+PROC get name (NAMETABLE CONST n, INT CONST index, TEXT VAR t): 

+  IF index < n . number of entries AND index >= start of name table

+    THEN t := n . name table [index] 

+    ELSE errorstop ("Interner Fehler 1") 

+  FI 

+END PROC get name; 

+ 

+PROC empty name table (NAMETABLE VAR n): 

+INT VAR i;

+  n . number of entries := start of name table; 

+  FOR i FROM 1 UPTO hash table length REP 

+    n . hash table [i] := 0 

+  END REP 

+END PROC empty name table;

+ 

+PROC dump table (NAMETABLE CONST n): 

+  line;

+  put ("Bitte Name der Datei, in die die Namenstabelle gehen soll:");

+  getline (f);

+  line;

+  file assoziieren; 

+  dump namens ketten; 

+  zusammenfassung.

+ 

+file assoziieren: 

+  FILE VAR file :: sequential file (output, f). 

+ 

+dump namens ketten:

+  INT VAR i,

+          anz hash eintraege :: 0, 

+          kette 3 eintraege  :: 0;

+  FOR i FROM 1 UPTO hash table length REP 

+    IF n . hash table [i] <> 0 

+      THEN anz hash eintraege INCR 1;

+           INT VAR naechster eintrag :: n . hash table [i];

+           dump hash eintrag;

+           ketten eintraege

+    FI 

+  END REP. 

+ 

+dump hash eintrag: 

+  dummy := text (i); 

+  WHILE length (dummy) < 4 REP dummy CAT " " END REP;

+  dummy CAT ": ".

+ 

+ketten eintraege:

+  INT VAR anz eintraege pro kette :: 0;

+  WHILE naechster eintrag > 0 REP 

+    anz eintraege pro kette INCR 1;

+    dummy CAT " ";

+    dummy CAT text (naechster eintrag);

+    dummy CAT " -> ";

+    dummy CAT n . name table [naechster eintrag]; 

+    naechster eintrag := n . next [naechster eintrag];

+  END REP;

+  IF anz eintraege pro kette > 2 

+    THEN kette 3 eintraege INCR 1 

+  FI;

+  putline (file, dummy). 

+ 

+zusammenfassung: 

+  statistik ueberschrift;

+  anzahl hash eintraege; 

+  anzahl namens eintraege;

+  verkettungsfaktor; 

+  anzahl laengerer ketten.

+ 

+statistik ueberschrift: 

+  line (file, 2);

+  dummy := " ---------- "; 

+  dummy CAT "S T A T I S T I K:";

+  dummy CAT " ---------- ";

+  putline (file, dummy);

+  line (file, 2).

+ 

+anzahl hash eintraege:

+  dummy := "Anzahl Hash-Eintraege (max. "; 

+  dummy CAT text (hash table length); 

+  dummy CAT "): "; 

+  dummy CAT text (anz hash eintraege); 

+  putline (file, dummy).

+ 

+anzahl namens eintraege: 

+  dummy := "Anzahl Namen (max. "; 

+  dummy CAT text (name table length - start of name table + 1); 

+  dummy CAT "): "; 

+  dummy CAT text (n . number of entries - start of name table);

+  putline (file, dummy).

+ 

+verkettungsfaktor: 

+  dummy := "Verkettungsfaktor (Anzahl Namen / Anzahl Ketten): "; 

+  dummy CAT text (real (n . number of entries - start of name table) /

+         real (anz hash eintraege));

+  putline (file, dummy).

+ 

+anzahl laengerer ketten:

+  dummy := "Anzahl Ketten > 2 Eintraege: "; 

+  dummy CAT text (kette 3 eintraege); 

+  putline (file, dummy).

+END PROC dump table; 

+END PACKET name table handling; 

+(***************************************************************************)

+ 

+PACKET scanner DEFINES init scanning, 

+                       init name table with,

+                       dump name table,

+                       get name,

+                       end scanning,

+                       line number,

+                       symbol: 

+

+(* Programm zum scannen von ELAN-Programmen.

+   Autor: Rainer Hahn

+   Stand: 04.05.83

+*)

+FILE VAR eingabe; 

+ 

+DATASPACE VAR ds alt := nilspace,

+              ds neu := nilspace;

+ 

+BOUND NAMETABLE VAR tabelle;

+ 

+TEXT VAR zeile, 

+         zeichen, 

+         dummy;

+ 

+LET end of program = ""30"",

+    eop            = 1, 

+    identifier     = 2, 

+    keyword        = 3, 

+    delimiter      = 4,

+    klammer auf    = 40,

+    punkt          = 46,

+    doppelpunkt    = 58, 

+    init symbol    = 30, 

+    assign symbol  = 31;

+

+INT VAR zeilen nr,

+        zeichen pos;

+ 

+PROC init name table with (TEXT CONST worte):

+INT VAR index;

+  forget (ds alt);

+  ds alt := nilspace;

+  tabelle := dsalt;

+  empty name table (CONCR (tabelle));

+  INT VAR anf :: 1, 

+          ende :: pos (worte, ",", 1); 

+  WHILE ende > 0 REP 

+    dummy := subtext (worte, anf, ende - 1); 

+    put name (CONCR (tabelle), dummy, index); 

+    anf := ende + 1; 

+    ende := pos (worte, ",", ende + 1)

+  END REP; 

+  dummy := subtext (worte, anf); 

+  put name (CONCR (tabelle), dummy, index) 

+END PROC init name table with; 

+

+PROC init scanning (TEXT CONST f): 

+  IF exists (f) 

+    THEN namenstabelle holen;

+         erste zeile lesen 

+    ELSE errorstop ("Datei existiert nicht") 

+  FI. 

+ 

+namenstabelle holen: 

+  forget (ds neu);

+  ds neu := ds alt; 

+  tabelle := ds neu. 

+ 

+erste zeile lesen: 

+  eingabe := sequential file (input, f);

+  IF eof (eingabe) 

+    THEN errorstop ("Datei ist leer")

+    ELSE zeile := "";

+         zeilen nr := 0; 

+         zeile lesen; 

+         naechstes non blank zeichen

+  FI 

+END PROC init scanning; 

+

+PROC dump name table: 

+  dump table (CONCR (tabelle)) 

+END PROC dump name table; 

+ 

+PROC end scanning (TEXT CONST f): 

+  IF anything noted

+    THEN eingabe := sequential file (modify, f);

+         note edit (eingabe) 

+  FI

+END PROC end scanning; 

+ 

+PROC get name (INT CONST index, TEXT VAR t): 

+  get name (CONCR (tabelle), index, t) 

+END PROC get name; 

+ 

+PROC zeile lesen: 

+  getline (eingabe, zeile); 

+  zeilen nr INCR 1; 

+  cout (zeilen nr);

+  zeichen pos := 0

+END PROC zeile lesen; 

+ 

+PROC naechstes non blank zeichen: 

+  REP

+    zeichen pos := pos (zeile, ""33"", ""254"", zeichen pos + 1); 

+    IF zeichen pos <> 0 

+      THEN zeichen := (zeile SUB zeichen pos);

+           LEAVE naechstes non blank zeichen

+    ELIF eof (eingabe) 

+      THEN zeichen := end of program;

+           LEAVE naechstes non blank zeichen

+      ELSE zeile lesen

+    FI

+  END REP.

+END PROC naechstes non blank zeichen; 

+ 

+PROC naechstes zeichen: 

+  IF zeichen pos > length (zeile) 

+    THEN IF eof (eingabe) 

+           THEN zeichen := end of program;

+                LEAVE naechstes zeichen

+           ELSE zeile lesen 

+         FI 

+  FI; 

+  zeichenpos INCR 1; 

+  zeichen := zeile SUB zeichenpos

+END PROC naechstes zeichen; 

+ 

+INT PROC line number:

+  IF zeichenpos = pos (zeile, ""33"", ""254"", 1)

+    THEN zeilen nr - 1 

+    ELSE zeilen nr 

+  FI

+END PROC line number; 

+ 

+PROC symbol (INT VAR symb, type): 

+  REP 

+    suche naechstes checker symbol 

+  END REP. 

+ 

+suche naechstes checker symbol: 

+  SELECT code (zeichen) OF

+  CASE 30: (* end of programn *)

+    symb := eop; 

+    type := eop; 

+    LEAVE symbol

+  CASE 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110,

+       111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122:

+    (* small letters *)

+    identifier aufsammeln; 

+    put name (CONCR (tabelle), dummy, symb); 

+    type := identifier;

+    LEAVE symbol

+  CASE 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,

+       82, 83, 84, 85, 86, 87, 88, 89, 90: (* large letters *)

+    schluesselwort aufsammeln; 

+    put name (CONCR (tabelle), dummy, symb); 

+    type := keyword; 

+    LEAVE symbol

+  CASE 34: (* " *)

+    skip text denoter 

+  CASE 40: (* ( *) 

+    IF (zeile SUB zeichen pos + 1) = "*" 

+      THEN skip comment 

+      ELSE symb := code (zeichen);

+           type := delimiter;

+           naechstes non blank zeichen;

+           LEAVE symbol;

+    FI 

+  CASE 58: (* : *) 

+    IF (zeile SUB zeichenpos + 1) = "=" 

+      THEN symb := assign symbol;

+           zeichenpos INCR 1

+    ELIF (zeile SUB zeichenpos + 1) = ":" 

+      THEN symb := init symbol; 

+           zeichenpos INCR 1 

+      ELSE symb := doppelpunkt 

+    FI; 

+    type := delimiter; 

+    naechstes non blank zeichen;

+    LEAVE symbol

+  CASE 48, 49, 50, 51, 52, 53, 54, 55, 56, 57: (* 0 - 9 *)

+    int denoter skippen;

+    IF zeichen = "."

+      THEN naechstes non blank zeichen;

+           IF digit

+             THEN real denoter skippen

+             ELSE symb := punkt; 

+                  type := delimiter;

+                  LEAVE symbol

+           FI

+    FI

+  CASE 41, 44, 46, 59, 61: (* ) , . ; =  *) 

+    symb := code (zeichen); 

+    type := delimiter; 

+    naechstes non blank zeichen; 

+    LEAVE symbol

+  OTHERWISE naechstes non blank zeichen

+  END SELECT.

+END PROC symbol; 

+ 

+PROC real denoter skippen:

+  int denoter skippen;

+  IF zeichen = "e" 

+    THEN naechstes non blank zeichen;

+         int denoter skippen

+  FI

+END PROC real denoter skippen;

+

+PROC int denoter skippen:

+  naechstes non blank zeichen;

+  WHILE zeichen >= "0" AND zeichen <= "9" REP

+    naechstes non blank zeichen

+  ENDREP;

+  zeichenpos DECR 1;

+  naechstes non blank zeichen

+END PROC int denoter skippen;

+

+PROC identifier aufsammeln:

+  dummy := zeichen; 

+  REP 

+    naechstes non blank zeichen; 

+    IF small letter or digit 

+      THEN dummy CAT zeichen 

+      ELSE LEAVE identifier aufsammeln 

+    FI 

+  END REP 

+END PROC identifier aufsammeln; 

+ 

+PROC schluesselwort aufsammeln:

+  dummy := "";

+  sammle schluesselwort; 

+  IF dummy = "END" 

+    THEN noch einmal 

+  FI.

+ 

+sammle schluesselwort: 

+  WHILE large letter REP 

+    dummy CAT zeichen;

+    naechstes zeichen

+  END REP; 

+  IF zeichen = " "

+    THEN naechstes non blank zeichen

+  FI.

+ 

+noch einmal: 

+  sammle schluesselwort

+END PROC schluesselwort aufsammeln; 

+ 

+PROC skip text denoter: 

+  INT VAR anz zeilen :: 0; 

+  zeichen pos := pos (zeile, """", zeichenpos + 1);

+  WHILE zeichen pos = 0 REP 

+    naechste zeile einlesen;

+    zeichen pos := pos (zeile, """");

+  END REP;

+  ende text denoter.

+ 

+ende text denoter: 

+  IF anz zeilen > 1 

+    THEN report referencer error (1, zeilen nr, text (anz zeilen))

+  FI; 

+  naechstes non blank zeichen. 

+ 

+naechste zeile einlesen: 

+  IF eof (eingabe) 

+    THEN report referencer error (2, zeilen nr, text (anz zeilen));

+         zeichen := end of program; 

+         LEAVE skip text denoter 

+    ELSE zeile lesen;

+         anz zeilen INCR 1 

+  FI.

+END PROC skip text denoter; 

+

+PROC skip comment:

+  INT VAR anz zeilen :: 0;

+  zeichen pos := pos (zeile, "*)", zeichenpos + 2);

+  WHILE zeichen pos = 0 REP 

+    naechste zeile einlesen; 

+    zeichen pos := pos (zeile, "*)"); 

+  END REP;

+  ende comment.

+ 

+ende comment:

+  IF anz zeilen > 1 

+    THEN report referencer error (3, zeilen nr, text (anz zeilen))

+  FI; 

+  zeichen pos INCR 2;

+  naechstes non blank zeichen. 

+ 

+naechste zeile einlesen: 

+  IF eof (eingabe) 

+    THEN report referencer error (4, zeilen nr, text (anz zeilen));

+         zeichen := end of program; 

+         LEAVE skip comment

+    ELSE zeile lesen;

+         anz zeilen INCR 1 

+  FI.

+END PROC skip comment;

+

+BOOL PROC small letter or digit: 

+  (zeichen >= "0" AND zeichen <= "9") OR (zeichen >= "a" AND zeichen <= "z") 

+END PROC small letter or digit; 

+ 

+BOOL PROC small letter: 

+  zeichen >= "a" AND zeichen <= "z" 

+END PROC small letter; 

+ 

+BOOL PROC large letter:

+  zeichen >= "A" AND zeichen <= "Z"

+END PROC large letter;

+ 

+BOOL PROC digit:

+  zeichen >= "0" AND zeichen <= "9"

+END PROC digit;

+END PACKET scanner;

+(*************************************************************************)

+PACKET referencer2 DEFINES referencer:

+ 

+(* Programm fuer den 'referencer'

+   Autor: Rainer Hahn

+   Stand: 19.03.84

+*)

+INT VAR symb,

+        typ,

+        max index;

+ 

+TEXT VAR dummy,

+         dummy2,

+         name;

+ 

+DATASPACE VAR ds;

+ 

+BOUND ROW max TEXT VAR liste; 

+ 

+FILE VAR f; 

+ 

+BOOL VAR initialisiert :: FALSE,

+         symbol bereits geholt,

+         globale deklarationen;

+ 

+LET max = 1751,

+    global text     = "<--G", 

+    local text      = "<--L", 

+    refinement text = "<--R",

+    procedure text  = "<--P",

+    eop           = 1, 

+    identifier    = 2, 

+    keyword       = 3, 

+    init symbol   = 30, 

+    assign symbol = 31,

+    klammer auf   = 40, 

+    klammer zu    = 41,

+    komma         = 44,

+    punkt         = 46,

+    doppelpunkt   = 58, 

+    semikolon     = 59, 

+    proc symbol       = 255, 

+    end proc symbol   = 256,

+    packet symbol     = 257, 

+    end packet symbol = 258,

+    type symbol       = 259, 

+    var symbol        = 260,

+    const symbol      = 261,

+    let symbol        = 262,

+    leave symbol      = 263,

+    op symbol         = 264,

+    endop symbol      = 265,

+    endif symbol      = 266,

+    fi symbol         = 266;

+ 

+PROC referencer: 

+  referencer (last param) 

+END PROC referencer; 

+ 

+PROC referencer (TEXT CONST check file): 

+  referencer (check file, check file + ".r") 

+END PROC referencer; 

+ 

+PROC referencer (TEXT CONST check file, dump file):

+  IF exists (check file)

+    THEN dump file ueberpruefen

+    ELSE errorstop ("Eingabe-Datei nicht vorhanden")

+  FI.

+ 

+dump file ueberpruefen:

+ IF exists (dump file)

+   THEN errorstop ("Ausgabe-Datei existiert bereits")

+   ELSE disable stop;

+        start referencing (check file, dump file);

+        forget (ds);

+        enable stop;

+ FI

+END PROC referencer;

+ 

+PROC start referencing (TEXT CONST check file, dump file):

+  enable stop;

+  ueberschrift;

+  initialisierung;

+  verkuerzte syntax analyse;

+  line;

+  in dump file kopieren (dump file);

+  line;

+  end scanning (check file).

+ 

+ueberschrift:

+  page;

+  put ("REFERENCER:");

+  put (check file);

+  put ("->");

+  put (dump file);

+  line.

+ 

+initialisierung:

+  IF NOT initialisiert

+    THEN init name table with

+("PROC,ENDPROC,PACKET,ENDPACKET,TYPE,VAR,CONST,LET,LEAVE,OP,ENDOP,ENDIF,FI"); 

+         initialisiert := TRUE

+  FI; 

+  ds := nilspace;

+  liste := ds;

+  maxindex := endop symbol;

+  dummy := checkfile.

+ 

+verkuerzte syntax analyse: 

+  globale deklarationen := TRUE;

+  line;

+  init scanning (dummy);

+  symbol bereits geholt := FALSE;

+  REP 

+    IF symbol bereits geholt 

+      THEN symbol bereits geholt := FALSE 

+      ELSE symbol (symb, typ)

+    FI;

+    IF typ = keyword 

+      THEN nach schluesselwort verarbeiten

+    ELIF symb = punkt

+      THEN ggf refinement aufnehmen

+    ELIF typ = identifier 

+      THEN identifier aufnehmen und ggf aktuelle parameter liste

+    FI

+  UNTIL typ = eop ENDREP. 

+ 

+identifier aufnehmen und ggf aktuelle parameter liste:

+  in die liste (symb, "");

+  symbol (symb, typ); 

+  IF symb = klammer auf 

+    THEN aktuelle parameter aufnehmen 

+    ELSE symbol bereits geholt := TRUE 

+  FI. 

+

+nach schluesselwort verarbeiten:

+  SELECT symb OF 

+  CASE let symbol:

+    let deklarationen aufsammeln

+  CASE packet symbol:

+    namen des interface aufsammeln

+  CASE end packet symbol:

+    skip naechstes symbol 

+  CASE var symbol, const symbol:

+    datenobjekt deklaration aufnehmen

+  CASE proc symbol:

+    globale deklarationen := FALSE; 

+    prozedur name und ggf parameter aufsammeln

+  CASE end proc symbol:

+    globale deklarationen := TRUE;

+    skip naechstes symbol

+  CASE op symbol: 

+    globale deklarationen := FALSE; 

+    operatornamen skippen und ggf parameter aufsammeln 

+  CASE end op symbol: 

+    globale deklarationen := TRUE; 

+    skip until (semikolon) 

+  CASE type symbol: 

+    namen der typ definition aufsammeln

+  CASE leave symbol: 

+    skip naechstes symbol

+  OTHERWISE: 

+  ENDSELECT. 

+ 

+skip naechstes symbol: 

+  symbol (symb, typ). 

+END PROC start referencing;

+

+PROC aktuelle parameter aufnehmen: 

+  REP 

+    symbol (symb, typ); 

+    IF typ = identifier 

+      THEN in die liste (symb, "") 

+    FI 

+  UNTIL symb = klammer zu END REP. 

+END PROC aktuelle parameter aufnehmen; 

+ 

+PROC ggf refinement aufnehmen:

+  symbol (symb, typ); 

+  symbol bereits geholt := TRUE;

+  WHILE typ = identifier REP 

+    doppelpunkt oder selektor

+  END REP.

+ 

+doppelpunkt oder selektor:

+  INT CONST letzter id :: symb; 

+  symbol (symb, typ);

+  IF symb = doppelpunkt

+    THEN in die liste (letzter id, refinement text);

+         LEAVE ggf refinement aufnehmen

+    ELSE in die liste (letzter id, "");

+         IF symb = punkt 

+           THEN symbol (symb, typ) 

+           ELSE LEAVE ggf refinement aufnehmen

+         FI

+  FI

+END PROC ggf refinement aufnehmen; 

+ 

+PROC namen des interface aufsammeln: 

+  packet name ueberspringen;

+  namen der schnittstelle aufsammeln. 

+ 

+packet name ueberspringen: 

+  symbol (symb, typ).

+ 

+namen der schnittstelle aufsammeln:

+  REP 

+    symbol (symb, typ);

+    IF typ = identifier 

+      THEN in die liste (symb, "")

+    FI

+  UNTIL symb = doppelpunkt END REP.

+END PROC namen des interface aufsammeln; 

+ 

+PROC let deklarationen aufsammeln:

+  REP

+    symbol (symb, typ);

+    IF typ = identifier 

+      THEN let name aufnehmen

+    ELIF typ = keyword 

+      THEN bis zum komma oder semikolon

+    FI;

+  UNTIL symb = semikolon END REP.

+

+let name aufnehmen: 

+  IF globale deklarationen

+    THEN in die liste (symb, global text)

+    ELSE in die liste (symb, "")

+  FI;

+  REP

+    symbol (symb, typ);

+    IF typ = identifier

+      THEN in die liste (symb, "")

+    FI

+  UNTIL symb = komma OR symb = semikolon END REP. 

+END PROC let deklarationen aufsammeln;

+

+PROC namen der typ definition aufsammeln: 

+  REP 

+    symbol (symb, typ); 

+    bis zum komma oder semikolon

+  UNTIL symb = semikolon END REP 

+END PROC namen der typ definition aufsammeln;

+

+PROC bis zum komma oder semikolon: 

+  INT VAR anz klammern :: 0; 

+  REP 

+    symbol (symb, typ); 

+    (* fields aufnehmen weggelassen *)

+    IF symb = klammer auf 

+      THEN anz klammern INCR 1 

+    ELIF symb = klammer zu

+      THEN anz klammern DECR 1

+    FI

+  UNTIL (symb = komma AND anz klammern = 0) OR symb = semikolon ENDREP.

+END PROC bis zum komma oder semikolon; 

+ 

+PROC datenobjekt deklaration aufnehmen:

+  symbol (symb, typ); 

+  REP 

+    IF globale deklarationen

+      THEN in die liste (symb, global text) 

+      ELSE in die liste (symb, local text) 

+    FI; 

+    skip ggf initialisierung;

+    IF symb = komma 

+      THEN symbol (symb, typ) 

+    FI

+  UNTIL symb = semikolon END REP.

+

+skip ggf initialisierung: 

+  symbol (symb, typ); 

+  IF symb = init symbol OR symb = assign symbol

+    THEN initialisierung skippen

+  FI.

+ 

+initialisierung skippen: 

+  INT VAR anz klammern :: 0;

+  REP 

+    INT CONST vorheriges symbol :: symb,

+              vorheriger typ    :: typ;

+    symbol (symb, typ); 

+    IF symb = klammer auf 

+      THEN anz klammern INCR 1;

+           IF vorheriger typ = identifier 

+             THEN in die liste (vorheriges symbol, "") 

+           FI

+    ELIF symb = klammer zu 

+      THEN anz klammern DECR 1; 

+           IF vorheriger typ = identifier 

+             THEN in die liste (vorheriges symbol, "") 

+           FI

+    ELIF vorheriger typ = identifier AND symb = doppelpunkt

+      THEN in die liste (vorheriges symbol, refinement text); 

+           LEAVE datenobjekt deklaration aufnehmen

+    ELIF vorheriger typ = identifier 

+      THEN in die liste (vorheriges symbol, "")

+    FI

+  UNTIL (symb = komma AND anz klammern = 0)

+         OR symb = semikolon OR symb = end proc symbol OR 

+         symb = end op symbol OR symb = endif symbol OR symb = fi symbol

+  END REP.

+END PROC datenobjekt deklaration aufnehmen; 

+ 

+PROC prozedur name und ggf parameter aufsammeln: 

+  prozedurname aufsammeln;

+  symbol (symb, typ); 

+  IF symb <> doppelpunkt

+    THEN formale parameter aufsammeln

+  FI. 

+ 

+prozedurname aufsammeln:

+  symbol (symb, typ); 

+  in die liste (symb, procedure text).

+END PROC prozedurname und ggf parameter aufsammeln; 

+ 

+PROC operatornamen skippen und ggf parameter aufsammeln: 

+  symbol (symb, typ);

+  IF symb <> doppelpunkt

+    THEN formale parameter aufsammeln 

+  FI 

+END PROC operatornamen skippen und ggf parameter aufsammeln;

+ 

+PROC formale parameter aufsammeln: 

+  REP 

+    symbol (symb, typ); 

+    IF typ = identifier 

+      THEN in die liste (symb, local text); 

+    FI 

+  UNTIL symb = doppelpunkt END REP 

+END PROC formale parameter aufsammeln; 

+ 

+PROC skip until (INT CONST zeichencode): 

+  skip until (zeichencode, 0) 

+END PROC skip until; 

+ 

+PROC skip until (INT CONST z1, z2):

+  REP 

+    symbol (symb, typ) 

+  UNTIL symb = z1 OR symb = z2 END REP

+END PROC skip until; 

+ 

+PROC in die liste (INT CONST index, TEXT CONST zusatz): 

+  IF index > max index 

+    THEN listenelemente initialisieren; 

+  FI;

+  IF aktueller eintrag = "" 

+    THEN namens eintrag 

+  FI;

+  aktueller eintrag CAT " ";

+  aktueller eintrag CAT text (line number);

+  aktueller eintrag CAT zusatz.

+ 

+aktueller eintrag: 

+  liste [index]. 

+ 

+listenelemente initialisieren: 

+  INT VAR i; 

+  FOR i FROM max index + 1 UPTO index REP 

+     liste [i] := ""

+  END REP; 

+  max index := index.

+ 

+namens eintrag:

+  get name (index, aktueller eintrag);

+  WHILE length (aktueller eintrag) < 15 REP 

+    aktueller eintrag CAT " "

+  END REP; 

+  aktueller eintrag CAT ":".

+END PROC in die liste; 

+ 

+TEXT VAR zeile;

+

+PROC in dump file kopieren (TEXT CONST dump file): 

+  put ("Ausgabedatei erstellen"); 

+  line;

+  f := sequential file (output, dump file); 

+  INT VAR i; 

+  kopieren und ggf fehlermeldung;

+  modify (f);

+  ggf sortieren;

+  zeile ggf aufspalten.

+

+kopieren und ggf fehlermeldung:

+  FOR i FROM fi symbol UPTO max index REP 

+    cout (i);

+    zeile := liste [i];

+    IF zeile <> "" 

+      THEN ausgabe der referenz und ggf fehlermeldung

+    FI 

+  ENDREP.

+ 

+ausgabe der referenz und ggf fehlermeldung:

+  putline (f, zeile);

+  ggf referencer fehlermeldung.

+ 

+ggf sortieren:

+  IF yes (dump file + " sortieren")

+    THEN sort (dump file);

+  FI.

+

+zeile ggf aufspalten: 

+  i := 0;

+  to line (f, 1);

+  WHILE NOT eof (f) REP

+    i INCR 1;

+    cout (i);

+    read record (f, zeile);

+    ggf aufspalten

+  END REP.

+

+ggf aufspalten:

+INT VAR anf :: 1, ende :: pos (zeile, " ", 72); 

+  IF ende > 0

+    THEN dummy := subtext (zeile, 1, ende - 1);

+         write record (f, dummy);

+         spalte bis restzeile auf;

+         dummy CAT subtext (zeile, anf); 

+         write record (f, dummy);

+  FI;

+  down (f).

+

+spalte bis restzeile auf:

+   REP 

+     dummy :=  "                 ";

+     anf := ende + 1;

+     ende := pos (zeile, " ", ende + 55);

+     down (f);

+     insert record (f);

+     IF ende <= 0

+       THEN LEAVE spalte bis restzeile auf

+     FI;

+     dummy CAT subtext (zeile, anf, ende - 1); 

+     write record (f, dummy); 

+  END REP.

+END PROC in dump file kopieren; 

+ 

+PROC ggf referencer fehlermeldung:

+  name := subtext (zeile, 1, min( pos(zeile, " "), pos(zeile, ":")) - 1);

+  dummy := subtext (zeile, pos (zeile, ": ") + 2); 

+  ueberdeckungs ueberpruefung; 

+  not used ueberpruefung; 

+  IF pos (dummy, "R") > 0

+    THEN refinement mehr als zweimal verwendet

+  FI.

+ 

+ueberdeckungs ueberpruefung: 

+  IF pos (dummy, global text) > 0 AND pos (dummy, local text) > 0 

+    THEN dummy2 := "und Zeile "; 

+         dummy2 CAT text (nr (pos (dummy, local text))); 

+         dummy2 CAT ": "; 

+         dummy2 CAT name;

+         report referencer error

+            (5, nr (pos (dummy, global text)), dummy2) 

+  FI. 

+ 

+not used ueberpruefung: 

+  IF pos (dummy, " ") = 0 AND

+     (pos (dummy, global text) > 0 OR pos (dummy, local text) > 0 OR

+      pos (dummy, refinement text) > 0)

+    THEN not used fehlermeldung

+  FI. 

+ 

+not used fehlermeldung: 

+  report referencer error

+  (8, nr (length (dummy) - length (local text) + 1), name).

+ 

+refinement mehr als zweimal verwendet: 

+  INT VAR refinement deklarationen :: 0, 

+          refinement aufrufe       :: 0, 

+          anf                      :: 1;

+  WHILE pos (dummy,"R", anf) > 0 REP

+    refinement deklarationen INCR 1; 

+    anf := pos (dummy, "R", anf) + 1 

+  END REP; 

+  anf := 1; 

+  WHILE pos (dummy, " ", anf) > 0 REP

+    refinement aufrufe INCR 1; 

+    anf := pos (dummy, " ", anf) + 1 

+  END REP; 

+  IF refinement deklarationen = 1 

+    THEN IF refinement aufrufe > 1 

+           THEN report referencer error

+                     (6, nr (pos (dummy, refinement text)), name) 

+         ELIF refinement aufrufe = 0 

+           THEN report referencer error

+                     (7, nr (pos (dummy, refinement text)), name) 

+         FI

+  ELIF refinement deklarationen > 1 

+    THEN IF 2 * refinement deklarationen - 1 > refinement aufrufe

+           THEN report referencer error (9, 0, name)

+         ELIF 2 * refinement deklarationen - 1 < refinement aufrufe

+           THEN report referencer error (10, 0, name)

+         FI

+  FI.

+END PROC ggf referencer fehlermeldung; 

+ 

+INT PROC nr (INT CONST ende): 

+  INT VAR von :: ende - 1; 

+  WHILE von > 0 AND ((dummy SUB von) >= "0" AND (dummy SUB von) <= "9") REP 

+    von DECR 1 

+  END REP; 

+  int (subtext (dummy, von + 1, ende - 1)) 

+END PROC nr; 

+ 

+END PACKET referencer2;

diff --git a/system/std.zusatz/1.7.3/src/reporter b/system/std.zusatz/1.7.3/src/reporter
new file mode 100644
index 0000000..13e76b5
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/reporter
@@ -0,0 +1,479 @@
+PACKET reporter routines DEFINES generate counts,

+                                 count on,

+                                 count off,

+                                 generate reports,

+                                 eliminate reports,

+                                 assert,

+                                 report on,

+                                 report off,

+                                 report:

+

+(* Programm zur Ablaufverfolgung von ELAN Programmen. Das Programm 

+   verfolgt Prozedur- und Refinementaufrufe ('trace') und erstellt

+   eine Haeufigkeitszaehlung ('frequency count') und beachtet 'assertions'.

+ 

+   Autor: Rainer Hahn 

+   Letzte Aenderung: 11.01.84  

+   Ausgabe der Gesamtaufrufe (Jan. 84) 

+*)

+

+FILE VAR input file;

+

+INT VAR zeilen nr,

+        type;

+ 

+TEXT VAR zeile,

+         dummy,

+         dummy1,

+         symbol;

+ 

+LET quadro fis = "####",

+    triple fis = "###",

+    double fis = "##",

+

+    tag = 1 ;

+

+DATASPACE VAR ds := nilspace;

+BOUND ROW max STRUCT (INT anzahl, BOOL proc) VAR zaehlwerk;

+

+LET max = 2000;

+

+(******************* gen report-Routinen ******************************) 

+ 

+PROC generate reports:

+  generate reports (last param)

+END PROC generate reports;

+

+PROC generate reports (TEXT CONST name):

+  disable stop; 

+  gen trace statements (name); 

+  IF is error AND error message = "ende"

+    THEN clear error

+  FI;

+  last param (name);

+  enable stop. 

+END PROC generate reports;

+

+PROC gen trace statements (TEXT CONST name):

+  enable stop;

+  IF exists (name) 

+    THEN input file := sequential file (modify, name)

+    ELSE errorstop ("input file does not exist") 

+  FI;

+  input file modifizieren

+END PROC gen trace statements; 

+ 

+(*************************** Test file modifizieren *****************) 

+ 

+PROC input file modifizieren:

+  zeilen nr := 1;

+  to first record (input file); 

+  WHILE NOT eof (input file) REP 

+    lese zeile;

+    IF triple fis symbol

+      THEN wandele in quadro fis

+    FI;

+    IF proc oder op symbol

+      THEN verarbeite operator oder prozedurkopf

+    ELIF refinement symbol

+      THEN verarbeite ggf refinements

+    FI;

+    down (input file)

+  END REP.

+ 

+triple fis symbol:

+  pos (zeile, triple fis) > 0 AND 

+       (pos (zeile, triple fis) <> pos (zeile, quadro fis)).

+

+wandele in quadro fis:

+  change all (zeile, triple fis, quadro fis);

+  write record (input file, zeile).

+

+proc oder op symbol:

+  pos (zeile, "PROC") > 0 OR pos (zeile, "OP") > 0.

+

+verarbeite operator oder prozedurkopf:

+  IF NOT (pos (zeile, "END") > 0)

+    THEN scanne kopf;

+         insertiere trace anweisung

+  FI.

+

+scanne kopf:

+  scan (zeile);

+  REP

+    next symbol (symbol, type);

+    IF ende der zeile gescannt

+      THEN vorwaerts;

+           lese zeile;

+           continue scan (zeile);

+           next symbol (symbol, type)

+    FI

+  UNTIL symbol = "PROC" OR symbol = "OP" END REP;

+  baue trace statement fuer kopf auf.

+

+baue trace statement fuer kopf auf:

+  dummy := double fis;

+  dummy CAT "report(""";

+  dummy CAT symbol;

+  dummy CAT " ";

+  IF ende der zeile gescannt

+    THEN vorwaerts;

+         lese zeile;

+         continue scan (zeile)

+  FI;

+  next symbol (symbol, type);

+  dummy CAT symbol;

+  dummy CAT " ";

+  next symbol (symbol, type);

+  IF type = tag

+    THEN dummy CAT symbol

+  FI.

+

+ende der zeile gescannt:

+  type >= 7.

+

+insertiere trace anweisung:

+  WHILE pos (zeile, ":") = 0 REP

+    vorwaerts;

+    lese zeile

+  END REP;

+  schreibe zeile mit report statement.

+

+refinement symbol:

+  INT CONST point pos :=  pos (zeile, ".") ;

+  point pos > 0 AND point pos >= length (zeile) - 1.

+

+verarbeite ggf refinements:

+  ueberlies leere zeilen ; 

+  IF ist wirklich refinement

+    THEN insertiere report fuer refinement

+  FI .

+

+ueberlies leere zeilen :

+  REP 

+    vorwaerts;

+    lese zeile

+  UNTIL pos (zeile, ""33"", ""254"", 1) > 0 PER .

+ 

+ist wirklich refinement :

+  scan (zeile) ;

+  next symbol (symbol, type) ;

+  next symbol (symbol) ;

+  symbol = ":" AND type = tag .

+

+insertiere report fuer refinement:

+  dummy := double fis;

+  dummy CAT "report(""";

+  dummy1 := subtext (zeile, 1, pos (zeile, ":") - 1);

+  dummy CAT dummy1;

+  schreibe zeile mit report statement

+END PROC input file modifizieren; 

+ 

+PROC schreibe zeile mit report statement:

+  dummy CAT """);";

+  dummy CAT double fis;

+  IF doppelpunkt steht am ende der zeile

+    THEN (********** bei neuer Compiler-Version aendern:

+          fuelle zeile ggf auf 75 spalten auf;

+          zeile CAT dummy

+          die naechste drei zeilen dann loeschen **************)

+         down (input file);

+         insert record (input file);

+         write record (input file, dummy)

+    ELSE insert char (dummy, ":", 1);

+         change (zeile, ":", dummy);

+         write record (input file, zeile)

+  FI.

+

+doppelpunkt steht am ende der zeile:

+  pos (zeile, ":") >= length (zeile) - 1.

+

+(* Kommentarklammern beineuer Compiler Version hier weg:

+fuelle zeile ggf auf 75 spalten auf:

+  IF length (zeile) < 75

+    THEN dummy1 := (75 - length (zeile)) * " ";

+         zeile CAT dummy1

+  FI.*)

+END PROC schreibe zeile mit report statement;

+ 

+PROC vorwaerts:

+    down (input file);

+    IF eof (input file) 

+      THEN errorstop ("ende")

+    FI

+END PROC vorwaerts;

+

+PROC lese zeile:

+  read record (input file, zeile); 

+  cout (zeilen nr); 

+  zeilen nr INCR 1

+END PROC lese zeile;

+

+(************************ eliminate reports-Routinen ******************)

+

+PROC eliminate reports:

+  eliminate reports (last param)

+END PROC eliminate reports;

+

+PROC eliminate reports (TEXT CONST name): 

+  disable stop; 

+  eliminate statements (name); 

+  IF is error AND error message = "ende"

+    THEN clear error

+  FI;

+  last param (name);

+  enable stop. 

+END PROC eliminate reports;

+

+PROC eliminate statements (TEXT CONST name): 

+  enable stop;

+  IF exists (name) 

+    THEN input file := sequential file (modify, name)

+    ELSE errorstop ("input file does not exist") 

+  FI;

+  statements entfernen.

+

+statements entfernen:

+  to first record (input file);

+  zeilen nr := 1;

+  WHILE NOT eof (input file) REP

+    lese zeile;

+    IF pos (zeile, double fis) > 0

+      THEN eliminiere zeichenketten in dieser zeile

+      ELSE down (input file)

+    FI

+  END REP.

+

+eliminiere zeichenketten in dieser zeile:

+  INT VAR anfang := pos (zeile, double fis);

+  WHILE es ist noch etwas zu eliminieren REP

+    IF es ist ein quadro fis

+      THEN wandele es in ein triple fis

+    ELIF es ist ein triple fis

+      THEN lass diese sequenz stehen

+      ELSE entferne zeichenkette

+    FI

+  END REP;

+  IF zeile ist jetzt leer

+    THEN delete record (input file)

+    ELSE write record (input file, zeile);

+         down (input file)

+  FI.

+

+es ist noch etwas zu eliminieren:

+  anfang > 0.

+ 

+es ist ein quadro fis:

+  pos (zeile, quadro fis, anfang) = anfang.

+

+wandele es in ein triple fis:

+  delete char (zeile, anfang);

+  anfang := pos (zeile, double fis, anfang + 3).

+

+es ist ein triple fis:

+  pos (zeile, triple fis, anfang) = anfang.

+

+lass diese sequenz stehen:

+  anfang := pos (zeile, triple fis, anfang + 1) + 3.

+

+entferne zeichenkette:

+  INT VAR end := pos (zeile, double fis, anfang+2) ;

+  IF end > 0

+    THEN change (zeile, anfang, end + 1, "");

+         anfang := pos (zeile, double fis, anfang)

+    ELSE anfang := pos (zeile, double fis, anfang+2) 

+  FI .

+

+zeile ist jetzt leer:

+  pos (zeile, ""33"", ""254"", 1) = 0.

+END PROC eliminate statements; 

+

+(********************** Trace-Routinen *******************************) 

+ 

+FILE VAR trace file;

+

+BOOL VAR trace on, haeufigkeit on;

+

+PROC report (TEXT CONST message):

+  IF NOT exists ("TRACE")

+    THEN trace file := sequential file (output, "TRACE");

+         trace on := TRUE;

+         haeufigkeit on := FALSE;

+  FI;

+  BOOL CONST ist prozedur ::

+               (pos (message, "PROC") > 0 OR pos (message, "OP") > 0);

+  IF trace on

+    THEN ablauf verfolgung

+  FI;

+  IF haeufigkeit on

+    THEN haeufigkeits zaehlung (ist prozedur)

+  FI.

+

+ablauf verfolgung:

+  dummy := text (pcb (1));

+  dummy CAT ": ";

+  IF NOT ist prozedur

+    THEN dummy CAT "    "

+  FI;

+  dummy CAT message;

+  putline (trace file, dummy). 

+END PROC report;

+ 

+PROC report (TEXT CONST message, INT CONST value):

+  report (message, text (value))

+END PROC report;

+

+PROC report (TEXT CONST message, REAL CONST value):

+  report (message, text (value))

+END PROC report;

+ 

+PROC report (TEXT CONST message, TEXT CONST value):

+  dummy1 := message;

+  dummy1 CAT ": ";

+  dummy1 CAT value;

+  report (dummy1)

+END PROC report;

+

+PROC report (TEXT CONST message, BOOL CONST value):

+  dummy1 := message;

+  dummy1 CAT ": ";

+  IF value

+    THEN dummy1 CAT "TRUE"

+    ELSE dummy1 CAT "FALSE"

+  FI;

+  report (dummy1)

+END PROC report;

+

+PROC report on: 

+  trace on := TRUE;

+  dummy1 := "REPORT ---> ON";

+  report (dummy1)

+END PROC report on;

+ 

+PROC report off: 

+  dummy1 := "REPORT ---> OFF";

+  report (dummy1);

+  trace on := FALSE;

+END PROC report off; 

+

+PROC assert (BOOL CONST value):

+  assert ("", value)

+END PROC assert;

+

+PROC assert (TEXT CONST message, BOOL CONST value):

+  dummy1 := "ASSERTION:";

+  dummy1 CAT message;

+  dummy1 CAT " ---> ";

+  IF value

+    THEN dummy1 CAT "TRUE"

+    ELSE line;

+         put ("ASSERTION:"); 

+         put (message);

+         put ("---> FALSE");

+         line;

+         IF yes ("weiter")

+           THEN dummy1 CAT "FALSE"

+           ELSE errorstop ("assertion failed")

+         FI

+  FI;

+  report (dummy1)

+END PROC assert;

+

+(************************** haeufigkeits-zaehlung ****************)

+

+PROC count on:

+  report ("COUNT ---> ON");

+  haeufigkeit on := TRUE;

+  initialisiere haeufigkeit.

+

+initialisiere haeufigkeit:

+  INT VAR i;

+  forget (ds);

+  ds := nilspace;

+  zaehlwerk := ds;

+  FOR i FROM 1 UPTO max REP

+    zaehlwerk [i] . anzahl := 0

+  END REP

+END PROC count on;

+

+PROC count off:

+  report ("COUNT ---> OFF");

+  haeufigkeit on := FALSE

+END PROC count off;

+

+PROC haeufigkeits zaehlung (BOOL CONST ist prozedur):

+  IF pcb (1) <= max

+    THEN zaehlwerk [pcb (1)]. anzahl INCR 1;

+         zaehlwerk [pcb (1)] . proc := ist prozedur

+FI

+END PROC haeufigkeits zaehlung;

+

+PROC generate counts:

+  generate counts (last param)

+END PROC generate counts;

+

+PROC generate counts (TEXT CONST name): 

+  disable stop; 

+  insert counts (name); 

+  last param (name);

+  enable stop. 

+END PROC generate counts;

+

+PROC insert counts (TEXT CONST name):

+  enable stop;

+  IF exists (name)

+    THEN input file := sequential file (modify, name)

+    ELSE errorstop ("input file does not exist")

+  FI;

+  counts insertieren;

+  dataspace loeschen;

+  statistik ausgeben.

+ 

+counts insertieren:

+  REAL VAR gesamt aufrufe :: 0.0, 

+           proc   aufrufe :: 0.0, 

+           andere aufrufe :: 0.0; 

+  zeilen nr := 1;

+  WHILE zeilennr <= lines (input file) REP

+    cout (zeilen nr);

+    IF zaehlwerk [zeilen nr] . anzahl > 0

+      THEN anzahl aufrufe in die eingabe zeile einfuegen;

+           aufrufe mitzaehlen

+    FI;

+    zeilen nr INCR 1

+  END REP.

+

+anzahl aufrufe in die eingabe zeile einfuegen: 

+  to line (input file, zeilen nr);

+  read record (input file, zeile);

+  dummy := double fis;

+  dummy1 := text (zaehlwerk [zeilen nr] . anzahl);

+  dummy CAT dummy1;

+  dummy CAT double fis;

+  change (zeile, 1, 0, dummy);

+  write record (input file, zeile).

+

+aufrufe mitzaehlen: 

+  gesamt aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl); 

+  IF zaehlwerk [zeilen nr] . proc 

+    THEN proc aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) 

+    ELSE andere aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) 

+  FI. 

+ 

+dataspace loeschen:

+  forget (ds).

+ 

+statistik ausgeben: 

+  line (2); 

+  put ("Anzahl der Gesamtaufrufe:"); 

+  put (gesamt aufrufe); 

+  line; 

+  put ("davon:"); 

+  line; 

+  put (proc aufrufe); put ("Prozeduren oder Operatoren"); 

+  line; 

+  put (andere aufrufe); put ("Refinements und andere"); 

+  line. 

+END PROC insert counts;

+

+END PACKET reporter routines;

diff --git a/system/std.zusatz/1.7.3/src/scheduler b/system/std.zusatz/1.7.3/src/scheduler
new file mode 100644
index 0000000..7a76f10
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/scheduler
@@ -0,0 +1,419 @@
+ 

+PACKET std schedule strategy DEFINES                (* Autor: J.Liedtke *)

+                                                    (* Stand: 15.10.82  *)

+    strategic decision :

+

+

+PROC strategic decision 

+              (INT CONST foreground workers, background workers,

+               REAL CONST fore cpu load, back cpu load, paging load,

+               INT VAR lowest activation prio, max background tasks) :

+ 

+  IF no background permitted

+    THEN lowest activation prio := 0 ;

+         max background tasks := 0

+    ELSE lowest activation prio := 10 ;

+         select max background tasks

+  FI .

+ 

+no background permitted :

+      foreground workers > 0 AND fore cpu load > 0.03 .

+

+select max background tasks :

+  IF fore cpu load > 0.01

+    THEN max background tasks := 1

+  ELIF paging load < 0.07

+    THEN max background tasks := 3

+  ELIF paging load < 0.15

+    THEN max background tasks := 2

+    ELSE max background tasks := 1

+  FI .

+

+ENDPROC strategic decision ;

+

+ENDPACKET std schedule strategy ;

+

+

+                                              (* Autor: J.Liedtke*)

+PACKET eumelmeter DEFINES                     (* Stand: 11.10.83 *)

+ 

+     init log ,

+     log :

+ 

+ 

+LET snapshot interval = 590.0 ;

+

+REAL VAR next snapshot time ,

+         time        , timex ,

+         paging wait , paging wait x ,

+         paging busy , paging busy x ,

+         fore cpu    , fore cpu x ,

+         back cpu    , back cpu x ,

+         system cpu  , system cpu x ,

+         delta t ;

+INT VAR storage max, used ;

+TEXT VAR record ;

+

+PROC init log :

+

+  time        := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  next snapshot time := time + snapshot interval

+

+ENDPROC init log ;

+

+PROC log (INT CONST active terminals, active background) :

+

+  new snapshot time if was clock reset ;

+  IF clock (1) >= next snapshot time

+    THEN save values ;

+         get new values ;

+         create stat record ;

+         put log (record) ;

+         define next snapshot time

+  FI .

+

+new snapshot time if was clock reset :

+  IF clock (1) < next snapshot time - snapshot interval 

+    THEN next snapshot time := clock (1)

+  FI .

+

+save values :

+  time x := time ;

+  paging wait x := paging wait ;

+  paging busy x := paging busy ;

+  fore cpu x    := fore cpu ;

+  back cpu x    := back cpu ;

+  system cpu x  := system cpu .

+

+get new values :

+  time := clock (1) ;

+  paging wait := clock (2) ;

+  paging busy := clock (3) ;

+  fore cpu    := clock (4) ;

+  back cpu    := clock (5) ;

+  system cpu  := clock (6) ;

+  storage (storage max, used) .

+

+create stat record :

+  record :=  text (used, 5) ;

+  record CAT text (active terminals,3) ;

+  record CAT text (active background,3) ;

+  delta t := (time - time x) ;

+  percent (paging wait, paging wait x) ;

+  percent (paging busy, paging busy x) ;

+  percent (fore cpu, fore cpu x) ;

+  percent (back cpu, back cpu x) ;

+  percent (system cpu, system cpu x) ;

+  percent (last, 0.0) ;

+  percent (nutz, 0.0) .

+

+last :   paging wait  + paging busy  + fore cpu  + back cpu  + system cpu

+       - paging waitx - paging busyx - fore cpux - back cpux - system cpux .

+

+nutz :   time  - paging wait  - system cpu

+       - timex + paging waitx + system cpux .

+

+define next snapshot time :

+  next snapshot time := time + snapshot interval .

+ 

+ENDPROC log ;

+

+PROC percent (REAL CONST neu, alt ) :

+

+  record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%"

+

+ENDPROC percent ;

+

+ENDPACKET eumelmeter ;

+

+

+

+PACKET background que manager DEFINES                (* Autor: J.Liedtke *)

+                                                     (* Stand: 15.10.82  *)

+    into background que ,

+    delete from background que ,

+    get first from background que ,

+    get next from background que :

+

+LET que size = 100 ,

+    ENTRY    = STRUCT (TASK task, INT class) ;

+

+INT VAR end of que := 0 ,

+        actual entry pos ;

+

+ROW que size ENTRY VAR que ;

+

+

+PROC into background que (TASK CONST task) :

+

+  INT VAR class := prio (task) ;

+  IF end of que = que size

+    THEN delete all not existing tasks

+  FI ;

+  check whether already in que ;

+  IF already in que

+    THEN IF in same class

+           THEN LEAVE into background que

+           ELSE delete from background que (task) ;

+                into background que (task)

+         FI

+    ELSE insert new entry

+  FI .

+

+check whether already in que :

+  INT VAR entry pos := 1 ;

+  WHILE entry pos <= end of que  REP

+    IF que (entry pos).task = task

+      THEN LEAVE check whether already in que

+    FI ;

+    entry pos INCR 1

+  PER .

+

+already in que :  entry pos <= end of que .

+

+in same class :   que (entry pos).class = class .

+

+insert new entry :

+  end of que INCR 1 ;

+  que (end of que) := ENTRY:( task, class ) .

+

+delete all not existing tasks :

+  INT VAR j ;

+  FOR j FROM 1 UPTO end of que REP

+    TASK VAR examined := que (j).task ;

+    IF NOT exists (examined)

+      THEN delete from background que (examined)

+    FI

+  PER .

+

+ENDPROC into background que ;

+

+PROC delete from background que (TASK CONST task) :

+

+  search for entry ;

+  IF entry found

+    THEN delete entry ;

+         update actual entry pos 

+  FI .

+

+search for entry :

+  INT VAR entry pos := 1 ;

+  WHILE entry pos <= end of que REP

+    IF que (entry pos).task = task

+      THEN LEAVE search for entry

+    FI ;

+    entry pos INCR 1

+  PER .

+

+entry found : entry pos <= end of que .

+

+delete entry :

+  INT VAR i ;

+  FOR i FROM entry pos UPTO end of que - 1 REP

+    que (i) := que (i+1)

+  PER ;

+  end of que DECR 1 .

+

+update actual entry pos :

+  IF actual entry or following one deleted

+    THEN actual entry pos DECR 1

+  FI .

+

+actual entry or following one deleted :

+  entry pos >= actual entry pos .

+

+ENDPROC delete from background que ;

+

+PROC get first from background que (TASK VAR task, INT CONST lowest class) :

+

+  actual entry pos := 0 ;

+  get next from background que (task, lowest class)

+

+ENDPROC get first from background que ;

+

+PROC get next from background que (TASK VAR task, INT CONST lowest class) :

+ 

+  search next entry of permitted class ;

+  IF actual entry pos <= end of que

+    THEN task := que (actual entry pos).task

+    ELSE task := niltask

+  FI .

+

+search next entry of permitted class :

+  REP

+    actual entry pos INCR 1

+  UNTIL actual entry pos > end of que 

+        COR que (actual entry pos).class <= lowest class PER.

+

+ENDPROC get next from background que ;

+

+ENDPACKET background que manager ;

+

+ 

+

+PACKET scheduler DEFINES                         (* Autor: J.Liedtke *)

+                                                 (* Stand: 09.12.82  *)

+    scheduler :

+ 

+

+LET std background prio     = 7 ,

+    highest background prio = 5 ,

+    long slice              = 6000 ,

+    short slice             = 600 ,

+    blocked busy            = 4 ;

+

+INT VAR slice ,

+        foreground workers ,

+        background workers ;

+

+BOOL VAR is logging ;

+

+REAL VAR fore cpu load , back cpu load , paging load ;

+

+

+access catalogue ;

+TASK CONST ur task := brother (supervisor) ;

+

+TASK VAR actual task ;

+

+

+PROC scheduler :

+  IF yes ("mit eumelmeter")

+    THEN is logging := TRUE

+    ELSE is logging := FALSE

+  FI ;

+  task password ("-") ;

+  break ;

+  set autonom ;

+  command dialogue (FALSE) ;

+  forget ("scheduler", quiet) ;

+  disable stop; 

+  REP scheduler operation; 

+      clear error 

+  PER; 

+ 

+END PROC scheduler; 

+ 

+PROC scheduler operation:

+  enable stop;

+  IF is logging 

+    THEN init log 

+  FI;

+  slice := short slice ;

+  init system load moniting ;

+  REP

+    pause (slice) ;

+    monit system load ;

+    look at all active user tasks and block background workers ;

+    activate next background workers if possible ;

+    IF is logging

+      THEN log (foreground workers, background workers)

+    FI

+  PER .

+

+init system load moniting :

+  REAL VAR 

+  time     x := clock (1) ,

+  fore cpu x := clock (4) ,

+  back cpu x := clock (5) ,

+  paging   x := clock (2) + clock (3) .

+

+monit system load :

+  REAL VAR interval := clock (1) - time x ;

+  fore cpu load := (clock (4) - fore cpu x) / interval ;

+  back cpu load := (clock (5) - back cpu x) / interval ;

+  paging load   := (clock (2) + clock (3) - paging x) / interval ;

+  time     x := clock (1) ;

+  fore cpu x := clock (4) ;

+  back cpu x := clock (5) ;

+  paging   x := clock (2) + clock (3) .

+

+ENDPROC scheduler operation;

+

+PROC look at all active user tasks and block background workers :

+

+  foreground workers := 0 ;

+  background workers := 0 ;

+  actual task := myself ;

+  next active (actual task) ;

+  WHILE NOT (actual task = myself) REP

+    IF actual task < ur task

+      THEN look at this task

+    FI ;

+    next active (actual task)

+  END REP .

+

+look at this task :

+  IF channel (actual task) >= 0

+    THEN foreground workers INCR 1

+    ELSE background workers INCR 1 ;

+         block actual task if simple worker

+  FI .

+

+block actual task if simple worker :

+  IF son (actual task) = niltask

+    THEN pause (5) ;

+         block (actual task) ;

+         IF status (actual task) = blocked busy

+           THEN set background prio ;

+                into background que (actual task)

+         ELIF prio (actual task) < highest background prio

+           THEN unblock (actual task)

+         FI

+  FI .

+

+set background prio :

+  IF prio (actual task) < highest background prio

+    THEN prio (actual task, std background prio)

+  FI .

+ 

+ENDPROC look at all active user tasks and block background workers ;

+

+PROC activate next background workers if possible :

+

+  INT VAR lowest activation prio ,

+          max background workers ,

+          active background workers := 0 ;

+

+  strategic decision (foreground workers, background workers,

+                      fore cpu load, back cpu load, paging load,

+                      lowest activation prio, max background workers) ;

+

+  IF background permitted

+    THEN try to activate background workers

+  FI ;

+  IF active background workers > 0

+    THEN slice := short slice

+    ELSE slice := long slice

+  FI .

+

+background permitted : max background workers > 0 .

+

+try to activate background workers :

+  get first from background que (actual task, lowest activation prio) ;

+  IF NOT is niltask (actual task)

+    THEN delete from background que (actual task)

+  FI ;

+

+  WHILE active background workers < max background workers REP

+    IF is niltask (actual task)

+      THEN LEAVE try to activate background workers

+    ELIF status (actual task) <> blocked busy

+      THEN delete from background que (actual task)

+    ELSE

+           unblock (actual task) ;

+           active background workers INCR 1

+    FI ;

+    get next from background que (actual task, lowest activation prio)

+  PER .

+

+ENDPROC activate next background workers if possible ;

+ 

+ENDPACKET scheduler ;

+ 

+scheduler;

diff --git a/system/std.zusatz/1.7.3/src/spool manager b/system/std.zusatz/1.7.3/src/spool manager
new file mode 100644
index 0000000..8f9ab9f
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/spool manager
@@ -0,0 +1,377 @@
+PACKET spool manager DEFINES                         (* Autor: J. Liedtke *)

+    spool manager, server channel:                   (* 21.05.84          *)

+ 

+ 

+LET que size       = 100 ,

+

+    ack            = 0 ,

+    nak            = 1 ,

+    error nak      = 2 ,

+    second phase ack = 5 ,

+

+    fetch code     = 11 ,

+    save code      = 12 ,

+    erase code     = 14 ,

+    list code      = 15 ,

+    all code       = 17 ,

+    continue code  = 100,

+

+    empty          = 0 ,

+    used           = 1 ;

+

+TASK VAR order task , waiting server , from task , server ;

+INT VAR order code , reply , first , last , list index ;

+

+DATASPACE VAR ds ;

+

+TEXT VAR from title ;

+

+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;

+BOUND TEXT VAR error msg ;

+BOUND STRUCT (TEXT tname, tpass, TASK task) VAR sv msg ;

+

+FILE VAR list file ;

+TEXT VAR entry name, entry task;

+

+INT VAR command index , params ;

+TEXT VAR command line, param 1, param 2 ;

+ 

+LET spool command list =

+"break:1.0start:2.01stop:4.0first:5.0killer:6.0 " ;

+

+

+LET ENTRY = STRUCT (TEXT title, TASK origin, DATASPACE space, INT status) ;

+

+ROW que size ENTRY VAR que ;

+

+

+INT VAR server chan := 0; 

+ 

+PROC server channel (INT CONST ch): 

+  server chan := ch 

+ 

+END PROC server channel; 

+ 

+INT PROC server channel: 

+  server chan 

+ 

+END PROC server channel; 

+ 

+PROC spool manager (PROC server start) :

+  INT VAR old heap size := heap size;

+  begin (PROC server start, server) ;

+  set autonom ;

+  break ;

+  disable stop ;

+  first := 1 ;

+  last  := 1 ;

+  from task := niltask ;

+  waiting server := niltask ;

+  spool ;

+  clear error ;

+  forget all dataspaces.

+

+forget all dataspaces :

+  INT VAR i ;

+  FOR i FROM 1 UPTO que size REP

+    forget (que (i).space)

+  PER .

+

+spool:

+  REP

+    wait (ds, order code, order task) ;

+    IF   order code = fetch code    THEN out of que

+    ELIF order code = save code     THEN prepare into que

+    ELIF order code = second phase ack THEN into que

+    ELIF order code = erase code    THEN delete que entry

+    ELIF order code = list code     THEN list spool

+    ELIF order code = all code      THEN y all

+    ELIF order code >= continue code

+       AND order task = supervisor  THEN spool command (PROC server start)

+    FI;

+    clear error

+  PER;

+  collect heap garbage if necessary. 

+ 

+collect heap garbage if necessary: 

+  IF heap size > old heap size + 2 

+  THEN collect heap garbage; 

+       old heap size := heap size 

+  FI.

+

+ENDPROC spool manager ;

+

+PROC out of que :

+

+  forget (ds) ;

+  IF NOT (order task < myself)

+    THEN error ("not parent")

+  ELIF que empty

+    THEN waiting server := order task

+    ELSE send (order task, ack, que (first).space) ;

+         inc first

+  FI .

+

+que empty :   first = last .

+

+ENDPROC out of que ;

+

+PROC inc first :

+

+  que (first).status := empty ;

+  REP

+    first := first MOD que size + 1 ;

+  UNTIL first = last OR que (first).status <> empty PER

+

+ENDPROC inc first ;

+

+PROC dec first :

+

+  first DECR 1 ;

+  IF first = 0

+    THEN first := que size

+  FI

+

+ENDPROC dec first ;

+

+PROC prepare into que :

+

+  msg := ds ;

+  from task := order task ;

+  from title := CONCR (msg).name ;

+  send (order task,  second phase ack, ds) .

+

+ENDPROC prepare into que ;

+

+PROC into que :

+

+  IF order task = from task

+    THEN try entry into spool

+    ELSE send (order task, nak, ds)

+  FI .

+

+try entry into spool :

+  IF que full

+    THEN error ("spool overflow")

+    ELSE entry (que (last)) ;

+         last := next (last) ;

+         send (order task, ack, ds) ;

+         awake server if necessary

+  FI .

+ 

+awake server if necessary :

+  IF NOT is niltask (waiting server)

+    THEN send (waiting server, ack, que (first).space , reply) ;

+         IF reply = ack

+           THEN waiting server := niltask ;

+                inc first

+         FI

+  FI .

+

+que full  :   first = next (last) .

+

+ENDPROC into que ;

+

+PROC entry (ENTRY VAR que entry) :

+

+  que entry.title   := from title ;

+  que entry.origin  := from task ;

+  que entry.space   := ds ;

+  que entry.status  := used ;

+

+ENDPROC entry ;

+

+INT PROC next (INT CONST index) :

+

+  index MOD que size + 1 

+

+ENDPROC next ;

+

+

+PROC delete que entry :

+

+  msg := ds ;

+  INT VAR index := first ;

+  WHILE index <> last REP

+    IF entry found

+      THEN erase entry (index) ;

+           send (order task, ack, ds) ;

+           LEAVE delete que entry

+    FI ;

+    index := next (index)

+  PER ;

+  error ("your file does not exist") .

+

+entry found :

+  entry.status = used CAND entry.origin = order task

+  CAND entry.title = CONCR (msg).name .

+

+entry :  que (index) .

+

+ENDPROC delete que entry ;

+

+PROC erase entry (INT CONST index) :

+

+  entry.status := empty ;

+  forget (entry.space) ;

+  IF index = first

+    THEN inc first

+  FI .

+

+entry : que (index) .

+

+ENDPROC erase entry ;

+

+PROC list spool :

+

+  forget (ds) ;

+  ds := nilspace ;

+  list file := sequential file (output, ds) ;

+  to first que entry ; 

+  get next que entry (entry name, entry task) ; 

+  WHILE entry name <> "" REP 

+    putline (list file, text (entry task, 15) + " : " + entry name);

+    get next que entry (entry name, entry task)

+  PER;

+  send (order task, ack, ds) .

+

+ENDPROC list spool ;

+

+BOUND THESAURUS VAR all thesaurus;

+ 

+PROC y all:

+  forget (ds); 

+  ds := nilspace;

+  all thesaurus := ds; 

+  all thesaurus := empty thesaurus; 

+  to first que entry; 

+  get next que entry (entry name, entry task);   (* hier erster Eintrag *) 

+  WHILE entryname <> "" REP 

+    IF entry task = name (order task) 

+      AND NOT (all thesaurus CONTAINS entry name)

+      THEN insert (all thesaurus, entry name) 

+    FI; 

+    get next que entry (entry name, entry task) 

+  PER;

+  send (order task, ack, ds) 

+ 

+END PROC y all; 

+ 

+PROC to first que entry :

+

+  list index := first - 1

+

+ENDPROC to first que entry ;

+

+PROC get next que entry (TEXT VAR entry name, origin task name): 

+ 

+  WHILE list index <> last REP

+    list index := next (list index)

+  UNTIL que (list index).status <> empty PER ;

+  IF que (list index).status = used

+    THEN origin task name := name (que (list index).origin) ;

+         entry name := que (list index).title

+    ELSE entry name := ""; 

+         origin task name := ""

+  FI .

+

+ENDPROC get next que entry ;

+

+PROC error (TEXT CONST error text) :

+

+  forget (ds) ;

+  ds := nilspace ;

+  error msg := ds ;

+  CONCR (error msg) := error text ;

+  send (order task, error nak, ds)

+

+ENDPROC error ;

+

+PROC spool command (PROC server start) :

+

+  enable stop ;

+  continue (order code - continue code) ;

+  command dialogue (TRUE) ;

+  disable stop ;

+  REP 

+    get command ("gib spoolkommando :", command line);

+    analyze command (spool command list, command line, 3,

+                     command index, params, param1, param2);

+    execute command

+  PER .

+

+execute command :

+  SELECT command index OF 

+    CASE 1 : break cmd 

+    CASE 2 : start cmd

+    CASE 3 : start channel cmd

+    CASE 4 : stop cmd

+    CASE 5 : first cmd

+    CASE 6 : killer cmd

+  OTHERWISE  do (command line) END SELECT .

+

+start channel cmd: 

+  server channel (int (param1)); 

+  start cmd; 

+  break cmd. 

+ 

+break cmd: 

+  break; set autonom  ; LEAVE spool command. 

+

+start cmd :

+  IF is niltask (server)

+    THEN begin (PROC server start, server)

+  FI .

+

+stop cmd :

+  IF NOT is niltask (server)

+    THEN command dialogue (FALSE) ;

+         end (server) ;

+         server := niltask 

+  FI .

+

+first cmd :

+  line ;

+  to first que entry ;

+  get next que entry (entry name, entry task);

+  IF entry name = ""

+    THEN LEAVE first cmd

+  FI ;

+  REP

+    get next que entry (entry name, entry task) ;

+    IF entry name = ""

+      THEN LEAVE first cmd

+    FI;

+    say (text (entry task, 15) + " : " + entry name) ;

+    IF yes ("   als erstes")

+      THEN make to first entry ;

+           LEAVE first cmd

+    FI 

+  PER .

+

+make to first entry :

+  IF first = next (last)

+    THEN errorstop ("spool overflow")

+    ELSE dec first ;

+         que (first) := que (list index) ;

+         erase entry (list index)

+  FI .

+

+

+killer cmd :

+  line ;

+  to first que entry ;

+  REP

+    get next que entry (entry name, entry task) ;

+    IF entry name = "" 

+      THEN LEAVE killer cmd

+    FI ;

+    say (text (entry task, 15) + " : " + entry name) ;

+    IF yes ("   loeschen")

+      THEN erase entry (list index)

+    FI 

+  PER .

+ 

+ENDPROC spool command ;

+

+ENDPACKET spool manager ;

diff --git a/system/std.zusatz/1.7.3/src/std printer b/system/std.zusatz/1.7.3/src/std printer
new file mode 100644
index 0000000..91a07c7
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/std printer
@@ -0,0 +1,434 @@
+PACKET std printer DEFINES reset printer,        (* F. Klapper *)

+                           new page,             (* 21.05.84   *)

+                           start, 

+                           printer cmd, 

+                           on, 

+                           off, 

+                           material, 

+                           papersize, 

+                           limit,

+                           change type, 

+                           print text, 

+                           x pos,

+                           y pos,

+                           line: 

+

+LET begin mark cmd    = ""15"",   (* Kommandos für 'output buffer' *)

+    end   mark cmd    = ""14"",

+    bsp        cmd    = ""8"" , 

+    printercmd cmd    = ""16"",

+    begin mark code   = 15,

+    end   mark code   = 14, 

+    bsp        code   = 8, 

+    printercmd code   = 16,

+

+    cr                = ""13"",   (* Steuerzeichen für die Ausgabe *)

+    lf                = ""10"", 

+    underline char    = "_",

+

+    inch = 2.54,                  (* Konstanten *)

+    max printer cmds per line = 10;

+

+INT CONST std length of paper :: 12 * y factor per inch,

+          std width  of paper :: cm to x steps (13.2 * inch),

+          std limit           :: cm to x steps (12.0 * inch), 

+          std first line      :: 5, 

+          std first collumn   :: cm to x steps (inch),

+ 

+          no xpos :: - 10;       (* beliebige negative ganze Zahl *)

+

+INT VAR first collumn,

+        first line,

+        xlimit,

+        actual line,

+        x pos steps,

+        width  of paper,

+        length of paper,

+        x pos mode;

+

+BOOL VAR block mode,

+         underline on,   (* gibt durch on / off gesetzten Zustand an *)

+         underline out;  (* gibt Zustand an der bis jetzt durch output buffer

+                            ausgegebenen Stelle an                   *)

+TEXT VAR buffer,

+         x pos buffer,

+         left margin;

+ 

+ROW max printer cmds per line TEXT VAR cmd arry;

+INT VAR cmd pointer;

+

+  length of paper    := std length of paper;

+  first line         := std first line; 

+  actual line        := 0;

+  buffer             := ""; 

+  reset printer;

+ 

+INT PROC cm to x steps (REAL CONST cm): 

+  int ((abs (cm) * real (x factor per inch) / inch) + 0.5)

+END PROC cm to x steps; 

+ 

+INT PROC cm to y steps (REAL CONST cm): 

+  int ((abs (cm) * real (y factor per inch) / inch) + 0.5)

+END PROC cm to y steps; 

+ 

+PROC start (REAL CONST x, y):

+  first collumn := cm to x steps (x);

+  first line    := cm to y steps (y);

+  left margin   := first collumn * " "

+END PROC start;

+ 

+PROC papersize (REAL CONST w, l): 

+  width of paper  := cm to x steps (w);

+  length of paper := cm to y steps (l); 

+END PROC papersize;

+

+PROC limit (REAL CONST x): 

+   xlimit := cm to x steps (x);

+END PROC limit;

+ 

+PROC on (TEXT CONST attribute):

+  IF (attribute SUB 1) = "u"

+  THEN underline on := TRUE;

+       buff CAT begin mark cmd

+  FI.

+

+buff:

+  IF xpos steps >= 0

+  THEN x pos buffer

+  ELSE buffer

+  FI.

+END PROC on;

+

+PROC off (TEXT CONST attribute):

+  IF (attribute SUB 1) = "u"

+  THEN underline on := FALSE;

+       buff CAT end mark cmd

+  FI.

+

+buff:

+  IF xpos steps >= 0

+  THEN x pos buffer

+  ELSE buffer

+  FI.

+END PROC off;

+

+PROC printer cmd (TEXT CONST cmd): 

+  IF cmd pointer < max printer cmds per line

+  THEN cmd pointer INCR 1;

+       cmd arry (cmd pointer) := cmd;

+       buff CAT printercmd cmd

+  FI.

+

+buff:

+  IF xpos steps >= 0

+  THEN x pos buffer

+  ELSE buffer

+  FI.

+END PROC printer cmd; 

+ 

+PROC material (TEXT CONST name of material):

+END PROC material;

+ 

+PROC change type (TEXT CONST name of type): 

+ENDPROC change type; 

+

+PROC reset printer :

+  new page;                                   (* actual line := 0 *)

+  width  of paper    := std width  of paper;

+  length of paper    := std length of paper;

+  first line         := std first line; 

+  first collumn      := std first collumn;

+  xlimit             := std limit;

+  xpos mode          := 0;

+  cmd pointer        := 0;

+  x pos steps        := no x pos;

+  buffer             := ""; 

+  xpos buffer        := "";

+  left margin        := first collumn * " ";

+  block mode         := FALSE;

+  underline on       := FALSE;

+  underline out      := FALSE;

+ENDPROC reset printer;

+ 

+PROC print text (TEXT CONST content, INT CONST mode):

+  IF x pos steps >= 0

+  THEN x pos buffer CAT content;

+       x pos mode := mode MOD 4;

+       block mode := FALSE

+  ELSE buffer CAT content ;

+       block mode := (mode MOD 4) = 3

+  FI.

+END PROC print text;

+

+PROC tab and print:

+  SELECT x pos mode OF

+  CASE 0: fill (buffer, " ", x pos steps);

+  CASE 1: fill (buffer, " ", x pos steps - outputlength (x pos buffer));

+  CASE 2: fill (buffer, " ", 

+                x pos steps - outputlength (xpos buffer) DIV 2);

+  CASE 3: fill (buffer, " ", x pos steps);

+          block (x pos buffer, xlimit - x pos steps);

+  OTHERWISE

+  END SELECT;

+  buffer CAT x pos buffer;

+  x pos buffer := "";

+  x pos steps := no x pos.

+END PROC tab and print;

+ 

+INT PROC outputlength (TEXT CONST buff):

+  length (buff) - chars (buff, printercmd cmd) - chars (buff, begin mark cmd)

+                - chars (buff, end mark cmd) - chars (buff, bsp cmd) * 2 

+END PROC outputlength;

+

+PROC x pos (REAL CONST cm):

+  IF x pos steps >= 0

+  THEN tab and print

+  FI;

+  IF underline on

+  THEN       buffer CAT end   mark cmd;

+       x pos buffer CAT begin mark cmd

+  FI;

+  x pos steps := cm to x steps (cm)

+END PROC x pos;

+

+PROC y pos (REAL CONST cm):

+  IF actual line = 0

+  THEN output linefeed (first line - actual line); 

+       actual line := first line 

+  FI;

+  output buffer;

+  INT VAR y lf steps := cm to y steps (cm);

+  output linefeed (y lf steps + first line - actual line);

+  actual line := first line + y lf steps. 

+END PROC y pos;

+

+PROC line (REAL CONST proposed lf) :

+  IF actual line = 0

+  THEN output linefeed (first line - actual line); 

+       actual line := first line 

+  FI;

+  output buffer;

+  INT VAR done lf;

+  convert into min y steps (proposed lf, done lf);

+  output line feed (done lf);

+  actual line INCR done lf;

+END PROC line;

+

+PROC convert into min y steps (REAL CONST in, INT VAR out): 

+  IF in < 0.001

+  THEN out := 0

+  ELSE out := int (in);

+       IF out < 1 THEN out := 1 FI

+  FI; 

+ENDPROC convert into min y steps;

+

+PROC new page:

+  IF buffer <> ""

+  THEN line (1.0)

+  FI;

+  actual line := actual line MOD length of paper;

+  IF actual line > first line 

+  THEN output pagefeed (length of paper - actual line);

+       actual line := 0 

+  FI;

+END PROC new page;

+

+PROC output buffer:

+  IF x pos steps >= 0

+  THEN tab and print

+  ELIF block mode

+  THEN block (buffer, xlimit)

+  FI ;

+  TEXT VAR bsp buffer := "",

+           underline buffer := "";

+  INT VAR cmd pos := pos (buffer, ""1"", ""31"", 1),

+          akt cmd pointer := 0,

+          soon out := 0;

+  out (left margin);

+  put leading blanks not underlined;

+  WHILE cmd pos > 0

+  REP analyze cmd;

+      cmd pos := pos (buffer, ""1"", ""31"", cmd pos)

+  PER;

+  IF underline out

+  THEN fill (underline buffer, underline char, LENGTH buffer)

+  FI;

+  out buffer;

+  out bsp buffer;

+  out underline buffer;

+  buffer := "";

+  cmd pointer := 0.

+

+put leading blanks not underlined:

+  IF underline out

+  THEN INT VAR first non blank pos := pos (buffer, ""33"", ""254"", 1);

+       IF cmd pos > 0 CAND first non blank pos > 0

+       THEN fill (underline buffer, " ", 

+                  min (first non blank pos, cmd pos) - 1)

+       ELIF cmd pos > 0

+       THEN fill (underline buffer, " ", cmd pos - 1)

+       ELSE fill (underline buffer, " ", first non blank pos -1)

+       FI;

+  FI.

+

+analyze cmd:

+  SELECT code (buffer SUB cmd pos) OF 

+  CASE bsp code        : do bsp cmd

+  CASE begin mark code : do begin mark cmd

+  CASE end mark code   : do end   mark cmd

+  CASE printercmd code : do printercmd cmd

+  OTHERWISE 

+  END SELECT.

+

+do bsp cmd:

+  fill (bsp buffer, " ", cmd pos - 2);

+  cmd pos DECR 1;

+  bsp buffer CAT (buffer SUB cmd pos);

+  delete char (buffer, cmd pos);

+  delete char (buffer, cmd pos).

+

+do begin mark cmd:

+  IF NOT underline out

+  THEN underline out := TRUE;

+       fill (underline buffer, " ", cmd pos -1);

+       delete char (buffer, cmd pos)

+  FI.

+

+do end mark cmd:

+  IF underline out

+  THEN underline out := FALSE;

+       fill (underline buffer, underline char, cmd pos - 1);

+       delete char (buffer, cmd pos)

+  FI.

+

+do printercmd cmd:

+  IF akt cmd pointer < cmd pointer

+  THEN akt cmd pointer INCR 1;

+       out subtext (buffer, soon out + 1, cmd pos - 1);

+       soon out := cmd pos - 1;

+       delete char (buffer, cmd pos);

+       out (cmd arry (akt cmd pointer))

+  FI.

+

+out buffer:

+  (* out (left margin) steht schon weiter oben *)

+  outsubtext (buffer, soon out + 1).

+

+out bsp buffer:

+  IF bsp buffer <> ""

+  THEN out (cr);

+       out (left margin);

+       out (bsp buffer)

+  FI.

+

+out underline buffer:

+  IF underline buffer <> ""

+  THEN out (cr);

+       out (left margin);

+       out (underline buffer)

+  FI.

+END PROC output buffer;

+

+PROC fill (TEXT VAR buff, TEXT CONST char, INT CONST len):

+  buff CAT (len - outputlength (buff)) * char

+END PROC fill;

+

+PROC output linefeed (INT CONST min y steps):

+  IF min y steps > 0

+    THEN out (cr);

+         out (min y steps * lf)

+  FI

+ENDPROC output linefeed ;

+

+PROC output pagefeed (INT CONST rest) :

+  out (cr) ;

+  rest TIMESOUT lf

+ENDPROC output pagefeed ;

+

+(********************* B L O C K **********************************)

+LET blank = " " ,

+    enumeration list = "-).:" ;

+

+INT VAR to insert,

+        nr of blanks ,

+        nr of big spaces ,

+        begin ;

+

+TEXT VAR small space ,

+         big space ;

+

+BOOL VAR right := TRUE ;

+

+PROC block (TEXT VAR blockline, INT CONST len):

+  to insert := len - outputlength (blockline);

+  nr of blanks := 0; begin:=0;

+  IF to insert <= 0 THEN LEAVE block FI;

+  IF to insert > (xlimit DIV 3 ) THEN LEAVE block FI;

+  mark the variable blanks;

+  IF nr of blanks <= 0 THEN LEAVE block FI;

+  right := NOT right;

+  compute spaces;

+  insert spaces.

+

+mark the variable blanks:

+  skip blanks ;

+  begin := pos(blockline,blank,begin+1);

+  IF (pos (enumeration  list, (blockline SUB (begin-1))) > 0 )

+    THEN skip blanks ;

+         begin := pos(blockline,blank,begin+1);

+  FI;

+  WHILE begin > 0 REP

+     IF single blank gap

+       THEN change (blockline,begin,begin,""0""); 

+            nr of blanks INCR 1;

+       ELSE skip blanks

+     FI;

+     begin := pos(blockline,blank,begin+1);

+  ENDREP.

+

+single  blank gap :

+  ((blockline SUB (begin+1)) <> blank).

+

+skip blanks :

+  begin := pos (blockline, ""33"", ""254"", begin+1) .

+

+compute spaces:

+  INT VAR steps :=  to insert ;

+  INT VAR small :=  steps DIV nr of blanks;

+  nr of big spaces  :=  steps MOD nr of blanks;

+  small space := (small+1) * blank ;

+  big space := small space ;

+  big space CAT blank .

+

+insert spaces:

+  IF right THEN insert big spaces on right side

+           ELSE insert big spaces on left side

+  FI.

+

+insert big spaces on right side:

+  INT VAR nr of small spaces := nr of blanks - nr of big spaces;

+  INT VAR i;

+  FOR i FROM 1 UPTO nr of small spaces REP

+      change (blockline, ""0"",small space)

+  ENDREP;

+  changeall (blockline,""0"",big space).

+

+insert big spaces on left side:

+  INT VAR j;

+  FOR j FROM 1 UPTO nr of big spaces REP

+     change (blockline,""0"",big space)

+  ENDREP;

+  changeall (blockline,""0"",small space).

+ENDPROC block;

+

+INT PROC chars (TEXT CONST text, char) :

+  INT VAR how many := 0 ,

+  cmd pos := pos (text, char) ;

+  WHILE cmd pos > 0 REP

+    how many INCR 1 ;

+    cmd pos := pos (text, char, cmd pos+1)

+  PER ;

+  how many

+ENDPROC chars ;

+

+ENDPACKET std printer ;

diff --git a/system/std.zusatz/1.7.3/src/std printer generator-M b/system/std.zusatz/1.7.3/src/std printer generator-M
new file mode 100644
index 0000000..f07d31c
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/std printer generator-M
@@ -0,0 +1,22 @@
+forget ("std printer generator/M", quiet) ;

+check off ;

+

+fetch ("minimal fonts routines", archive); 

+fetch ("std printer", archive); 

+fetch ("eumel printer", archive);

+fetch ("elan lister", archive);

+fetch ("spool manager", archive);

+fetch ("printer/M", archive); 

+ 

+ins ("minimal fonts routines"); 

+ins ("std printer"); 

+ins ("eumel printer");

+ins ("elan lister");

+ins ("spool manager");

+run ("printer/M");

+ 

+PROC ins (TEXT CONST name): 

+  insert (name); 

+  forget (name, quiet) 

+END PROC ins;

+ 

diff --git a/system/std.zusatz/1.7.3/src/std printer generator-S b/system/std.zusatz/1.7.3/src/std printer generator-S
new file mode 100644
index 0000000..067df88
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/std printer generator-S
@@ -0,0 +1,15 @@
+forget ("std printer generator/S", quiet) ;

+check off ;

+

+ins ("minimal fonts routines"); 

+ins ("std printer"); 

+ins ("eumel printer");

+ins ("elan lister");

+ins ("printer/S");

+ 

+PROC ins (TEXT CONST name): 

+  fetch (name, archive);

+  insert (name); 

+  forget (name, quiet) 

+END PROC ins;

+ 

diff --git a/system/std.zusatz/1.7.3/src/vector b/system/std.zusatz/1.7.3/src/vector
new file mode 100644
index 0000000..fd1b0ef
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/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 :

+

+LET n = 4000;

+

+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;

diff --git a/system/std.zusatz/1.7.5/src/eumel printer b/system/std.zusatz/1.7.5/src/eumel printer
new file mode 100644
index 0000000..2fd3f38
--- /dev/null
+++ b/system/std.zusatz/1.7.5/src/eumel printer
@@ -0,0 +1,3067 @@
+PACKET eumel printer                           (* Autor   : Rudolf Ruland *)

+                                               (* Version : 4             *)

+                                               (* Stand   : 07.08.86      *)

+       DEFINES print, 

+               with elan listings,

+               is elan source,

+               bottom label for elan listings,

+               x pos,

+               y pos,

+               y offset index,

+               line type,

+               material,

+               pages printed :

+ 

+

+LET std x wanted                   =  2.54,

+    std y wanted                   =  2.35,

+    std limit                      =  16.0,

+    std pagelength                 =  25.0,

+    std linefeed faktor            =  1.0,

+    std material                   =  "";

+

+LET blank                          =  " ",

+    blank code 1                   =  33,

+    geschuetztes blank             =  ""223"", 

+    keine blankanalyse             =  0,

+    einfach blank                  =  1,

+    doppel blank                   =  2,

+ 

+    anweisungszeichen              =  "#",

+    anweisungszeichen code 1       =  36,

+    geschuetztes anweisungszeichen =  ""222"",

+    druckerkommando zeichen        =  "/",

+    quote                          =  """",

+ 

+    erweiterungs ausgang           =  32767,

+    blank ausgang                  =  32766,

+    anweisungs ausgang             =  32765,

+    d code ausgang                 =  32764,

+    max breite                     =  32763,

+ 

+    punkt                          =  ".",

+ 

+    leer                           =   0,

+

+    kommando token                 =  0,

+    text token                     =  1,

+ 

+    underline linetype             =  1,

+    underline bit                  =  0,

+    bold bit                       =  1,

+    italics bit                    =  2,

+    modifikations liste            =  "ubir",

+    anzahl modifikationen          =  4, 

+ 

+    document                       =  1,

+    page                           =  2,

+ 

+    write text                     =  1,

+    write cmd                      =  2,

+    carriage return                =  3, 

+    move                           =  4,

+    draw                           =  5,

+    on                             =  6, 

+    off                            =  7,

+    type                           =  8,

+ 

+    tag type                       =  1,

+    bold type                      =  2,

+    number type                    =  3,

+    text type                      =  4,

+    delimiter type                 =  6,

+    eof type                       =  7;

+ 

+ 

+INT CONST null ausgang            := -32767-1;

+ 

+ROW anzahl modifikationen INT CONST modifikations werte :=

+                               ROW anzahl modifikationen INT : (1, 2, 4, 8);

+ 

+TEXT CONST anweisungsliste := 

+    "type:1.1on:2.1off:3.1center:4.0right:5.0u:6.0d:7.0e:8.0b:9.0" +

+    "fillchar:10.1mark:11.2markend:12.0" +

+    "ub:13.0ue:14.0fb:15.0fe:16.0" +

+    "block:20.0columns:21.2columnsend:22.0free:23.1limit:24.1linefeed:25.1" + 

+    "material:26.1page:27.01pagelength:29.1start:30.2" + 

+    "table:31.0tableend:32.0clearpos:33.01" + 

+    "lpos:35.1rpos:36.1cpos:37.1dpos:38.2bpos:39.2" +

+    "textbegin:40.02textend:42.0" +

+    "indentation:43.1ytab:44.1";

+ 

+LET a type             =   1,      a block            =  20,

+    a on               =   2,      a columns          =  21,

+    a off              =   3,      a columnsend       =  22,

+    a center           =   4,      a free             =  23,

+    a right            =   5,      a limit            =  24,

+    a up               =   6,      a linefeed         =  25,

+    a down             =   7,      a material         =  26,

+    a end up or down   =   8,      a page0            =  27,

+    a bsp              =   9,      a page1            =  28,

+    a fill char        =  10,      a pagelength       =  29,

+    a mark             =  11,      a start            =  30,

+    a markend          =  12,      a table            =  31,

+    a ub               =  13,      a tableend         =  32,

+    a ue               =  14,      a clearpos0        =  33,

+    a fb               =  15,      a clearpos1        =  34,

+    a fe               =  16,      a lpos             =  35,

+                                   a rpos             =  36,

+                                   a cpos             =  37,

+                                   a dpos             =  38,

+                                   a bpos             =  39,

+                                   a textbegin0       =  40,

+                                   a textbegin2       =  41,

+                                   a textend          =  42,

+                                   a indentation      =  43,

+                                   a y tab            =  44;

+ 

+INT VAR  a xpos, a breite, a font, a modifikationen,

+         a modifikationen fuer x move, a ypos, aktuelle ypos,

+         letzter font, letzte modifikationen,

+         d ypos, d xpos, d font, d modifikationen, 

+ 

+         zeilenpos, alte zeilenpos, zeilen laenge, anzahl zeichen, ausgang,

+         anzahl einrueck blanks, blankbreite,

+         einrueckbreite, aktuelle einrueckbreite, alte einrueckbreite,

+         font durchschuss, fonthoehe, font tiefe,

+         groesste fonthoehe, aktuelle zeilenhoehe, letzte zeilenhoehe,

+         blankmodus, alter blankmodus,

+         token zeiger, erstes token der zeile, 

+

+         erstes tab token, tab anfang, anzahl blanks, 

+         d code 1, d pitch, fuell zeichen breite, erstes fuell token, 

+         letztes fuell token, 

+ 

+         x size, y size, x wanted, y wanted, x start, y start,

+         pagelength, limit, indentation,

+         left margin, top margin, seitenlaenge,

+         papierlaenge, papierbreite,

+         luecke, anzahl spalten, aktuelle spalte,

+

+         verschiebung, rest, neue modifikationen, modifikations modus, pass,

+ 

+         int param, anweisungs index, anzahl params, index,

+ 

+         gedruckte seiten;

+ 

+BOOL VAR zeile ist absatzzeile, letzte zeile war absatzzeile,

+         zeile muss geblockt werden, rechts, a block token, offsets,

+         tabellen modus, block modus, center modus, right modus,

+         seite ist offen, vor erster seite;

+ 

+REAL VAR linefeed faktor, real param;

+ 

+TEXT VAR zeile, anweisung, par1, par2, material wert, replacements,

+         fuell zeichen, d string, font offsets;

+ 

+ROW 256 INT VAR zeichenbreiten, replacement tabelle, zeichen zaehler;

+ 

+INITFLAG VAR in dieser task := FALSE;

+ 

+. zeile ist zu ende               : zeilenpos > zeilen laenge

+ 

+. zeilen breite                   : a xpos - left margin

+ 

+. neue zeilenhoehe                : int (linefeed faktor * real (fonthoehe) + 0.5)

+ 

+. naechstes zeichen ist blank     : pos (zeile, blank, zeilenpos + 1, zeilenpos + 1) <> 0

+ 

+. naechstes nicht blankes zeichen : pos (zeile, ""33"", ""255"", zeilenpos)

+ 

+. in letzter spalte               : aktuelle spalte >= anzahl spalten

+ 

+. anfangs blankmodus :

+    INT VAR dummy;

+    IF   center modus OR right modus

+         THEN dummy

+    ELIF index zaehler = 0

+         THEN blankmodus

+         ELSE alter blankmodus

+    FI

+ 

+. initialisiere tab variablen : 

+    erstes tab token := token index f + 1;

+    tab anfang       := zeilen breite;

+    anzahl blanks    := 0;

+.;

+ 

+(******************************************************************)

+ 

+LET zeilen nr laenge  =  4,

+    teil einrueckung  =  5,

+ 

+    headline pre  = "Zeile    ****   E L A N    EUMEL 1.7.5  ****   ",

+    headline post = "   ****    ";

+ 

+INT  VAR zeilen nr, rest auf seite,

+         max zeichen zeile, max zeichen fuss, layout laenge, layout laenge name,

+         symbol type, naechster symbol type;

+ 

+BOOL VAR vor erstem packet, innerhalb der define liste;

+ 

+TEXT VAR bottom label, dateiname, layout blanks, refinement layout zeile;

+ 

+ 

+. symbol           : fuell zeichen

+. naechstes symbol : d string

+. elan text        : d token. text

+.; 

+ 

+(******************************************************************)

+(*** tokenspeicher                                              ***)

+

+LET max token  = 3000,

+    max ypos   = 1000,

+ 

+    TOKEN      = STRUCT (TEXT text,

+                         INT  xpos, breite, font, modifikationen,

+                              modifikationen fuer x move, 

+                              offset index, naechster token index, 

+                         BOOL block token ),

+

+    YPOS       = STRUCT (INT ypos, vorheriger ypos index, naechster ypos index,

+                             erster token index, letzter token index ), 

+ 

+    TOKENLISTE = STRUCT (ROW max token TOKEN token liste,

+                         ROW max ypos  YPOS  ypos  liste );

+ 

+DATASPACE VAR ds;

+ 

+BOUND TOKENLISTE VAR tokenspeicher;

+ 

+TOKEN VAR d token, offset token;

+ 

+INT VAR erster ypos index a, letzter ypos index a, 

+        erster ypos index d, letzter ypos index d, 

+        ypos  index, ypos  index f, ypos  index a, ypos  index d, 

+        token index, token index f;

+ 

+. t  : tokenspeicher. token liste (token index)

+. tf : tokenspeicher. token liste (token index f)

+ 

+. y  : tokenspeicher. ypos  liste (ypos  index) 

+. yf : tokenspeicher. ypos  liste (ypos  index f) 

+. ya : tokenspeicher. ypos  liste (ypos  index a)

+. yd : tokenspeicher. ypos  liste (ypos  index d)

+ 

+. loesche druckspeicher :

+    erster ypos index d := 0;

+           ypos index f := 0;

+          token index f := 0;

+ 

+. druckspeicher ist nicht leer :

+    erster ypos index d <> 0

+ 

+. loesche analysespeicher :

+    erster ypos index a := 0;

+ 

+. analysespeicher ist nicht leer :

+    erster ypos index a <> 0

+.; 

+ 

+(******************************************************************)

+(*** anweisungsspeicher                                         ***)

+ 

+INT  VAR anweisungszaehler;

+TEXT VAR anweisungs indizes, params1 zeiger, params2 zeiger;

+THESAURUS VAR params1, params2; 

+ 

+PROC loesche anweisungsspeicher :

+ 

+    anweisungs zaehler := 0;

+    anweisungs indizes := "";

+    params1 zeiger     := "";

+    params2 zeiger     := "";

+    params1            := empty thesaurus;

+    params2            := empty thesaurus;

+ 

+END PROC loesche anweisungsspeicher; 

+ 

+(******************************************************************)

+(*** indexspeicher                                              ***)

+ 

+INT  VAR index zaehler;

+TEXT VAR grosse fonts, verschiebungen;

+

+PROC loesche indexspeicher :

+ 

+    index zaehler  := 0;

+    grosse fonts   := "";

+    verschiebungen := "";

+ 

+END PROC loesche indexspeicher; 

+ 

+ 

+(******************************************************************)

+(*** tabellenspeicher                                           ***)

+ 

+LET max tabs          =  30,

+    TABELLENEINTRAG   =  STRUCT (INT tab typ, tab position, tab param);

+

+TEXT VAR tab liste, fill char;

+THESAURUS VAR d strings;

+ROW max tabs TABELLENEINTRAG VAR tabspeicher;

+ 

+INT VAR tab index;

+ 

+. tab typ       : tab speicher (tab liste ISUB tab index). tab typ

+. tab position  : tab speicher (tab liste ISUB tab index). tab position

+. tab param     : tab speicher (tab liste ISUB tab index). tab param 

+. anzahl tabs   : LENGTH tab liste DIV 2 

+.;

+ 

+PROC loesche tabellenspeicher :

+ 

+    fill char := " ";

+    tabliste  := "";

+    d strings := empty thesaurus;

+    FOR tab index FROM 1 UPTO max tabs

+        REP tab speicher (tab index). tab typ := leer PER;

+ 

+END PROC loesche tabellenspeicher;

+ 

+(******************************************************************)

+(*** markierungsspeicher                                        ***)

+ 

+INT VAR mark index l, mark index r, alter mark index l, alter mark index r;

+ 

+ROW 4 TOKEN VAR mark token;

+ 

+. markierung links  : mark index l > 0

+. markierung rechts : mark index r > 0

+.;

+ 

+PROC loesche markierung :

+ 

+     mark index l := 0;

+     mark index r := 0;

+

+END PROC loesche markierung;

+ 

+ 

+PROC loesche alte markierung :

+ 

+     alter mark index l := 0;

+     alter mark index r := 0;

+

+END PROC loesche alte markierung;

+ 

+

+PROC initialisiere markierung :

+ 

+     FOR mark index l FROM 1 UPTO 4

+     REP mark token (mark index l). modifikationen fuer x move := 0;

+         mark token (mark index l). offset index               := text token;

+         mark token (mark index l). block token                := FALSE;

+         mark token (mark index l). naechster token index      := 0;

+     PER;

+ 

+END PROC initialisiere markierung;

+ 

+(******************************************************************)

+(*** durchschuss                                                ***)

+ 

+INT VAR durchschuss 1, durchschuss 2, anzahl durchschuss 1, 

+        anzahl durchschuss, zeilen zaehler;

+ 

+BOOL VAR wechsel := TRUE;

+ 

+INT PROC durchschuss :

+ 

+     zeilen zaehler INCR 1;

+     IF   zeilen zaehler <= anzahl durchschuss 1

+          THEN durchschuss 1

+     ELIF zeilen zaehler <= anzahl durchschuss 

+          THEN durchschuss 2

+          ELSE 0

+     FI

+ 

+END PROC durchschuss;

+ 

+ 

+PROC neuer durchschuss (INT CONST anzahl, rest) :

+ 

+     zeilen zaehler     := 0;

+     anzahl durchschuss := anzahl;

+     IF anzahl > 0 

+        THEN IF wechsel

+                THEN durchschuss 1        := rest DIV anzahl durchschuss;

+                     durchschuss 2        := durchschuss 1 + sign (rest);

+                     anzahl durchschuss 1 := anzahl durchschuss -

+                                             abs (rest) MOD anzahl durchschuss;

+                     wechsel              := FALSE;

+                ELSE durchschuss 2        := rest DIV anzahl durchschuss; 

+                     durchschuss 1        := durchschuss 2 + sign (rest);

+                     anzahl durchschuss 1 := abs (rest) MOD anzahl durchschuss;

+                     wechsel              := TRUE;

+             FI;

+        ELSE loesche durchschuss

+     FI;

+ 

+END PROC neuer durchschuss;

+ 

+ 

+PROC loesche durchschuss :

+

+     durchschuss 1           := 0;

+     durchschuss 2           := 0;

+     anzahl durchschuss 1    := 0;

+     anzahl durchschuss      := 0;

+     zeilen zaehler          := 0;

+ 

+END PROC loesche durchschuss;

+ 

+(****************************************************************)

+ 

+PROC initialisierung :

+ 

+  forget (ds);

+  ds := nilspace; tokenspeicher := ds;

+  loesche druckspeicher;

+  loesche anweisungsspeicher;

+  loesche indexspeicher;

+  initialisiere markierung;

+  right  modus                 := FALSE;

+  center modus                 := FALSE;

+  seite ist offen              := FALSE;

+  pass                         := 0;

+  a breite                     := 0;

+  a block token                := FALSE;

+  a modifikationen fuer x move := 0;

+  d code 1                     := leer;

+  erstes fuell token           := leer;

+  IF two bytes

+     THEN FOR index FROM   1 UPTO 129 REP zeichen zaehler (index) := 1 PER; 

+          FOR index FROM 130 UPTO 160 REP zeichen zaehler (index) := - maxint PER;

+          FOR index FROM 161 UPTO 224 REP zeichen zaehler (index) := 1 PER;

+          FOR index FROM 225 UPTO 240 REP zeichen zaehler (index) := - maxint PER;

+          FOR index FROM 241 UPTO 256 REP zeichen zaehler (index) := 1 PER;

+     ELSE FOR index FROM   1 UPTO 256 REP zeichen zaehler (index) := 1 PER; 

+  FI;

+ 

+END PROC initialisierung;

+ 

+(****************************************************************)

+(*** print - Kommando                                         ***)

+

+BOOL VAR elan listings erlaubt;

+FILE VAR eingabe;

+ 

+with elan listings (TRUE);

+ 

+PROC with elan listings (BOOL CONST flag) :

+     elan listings erlaubt := flag;

+END PROC with elan listings;

+ 

+BOOL PROC with elan listings : elan listings erlaubt END PROC with elan listings;

+ 

+ 

+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ):

+ 

+  print (PROC (TEXT VAR) next line, BOOL PROC eof,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 

+         FALSE, "");

+ 

+END PROC print;

+ 

+ 

+PROC print (FILE VAR file,

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+

+  eingabe := file;

+  input (eingabe);

+  print (PROC (TEXT VAR) lese zeile, BOOL PROC eof,

+         PROC (INT CONST, INT VAR, INT VAR) open,

+         PROC (INT CONST, INT CONST) close,

+         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, 

+         elan listings erlaubt CAND is elan source (eingabe), 

+         headline (eingabe) );

+ 

+END PROC print;

+ 

+PROC lese zeile (TEXT VAR zeile) : getline (eingabe, zeile) END PROC lese zeile;

+ 

+BOOL PROC eof : eof (eingabe) END PROC eof;

+ 

+BOOL PROC is elan source (FILE VAR eingabe) :

+ 

+hole erstes symbol;

+elan programm tag COR elan programm bold COR kommentar

+

+. elan programm tag :

+    symbol type = tag type CAND pos (zeile, ";") > 0 

+ 

+. elan programm bold :

+    symbol type = bold type CAND is elan bold

+

+    . is elan bold :

+        symbol = "PACKET" COR symbol = "LET"

+            COR proc oder op (symbol) COR deklaration

+            COR proc oder op (naechstes symbol)

+ 

+    . deklaration :

+        next symbol (naechstes symbol);

+        naechstes symbol = "VAR" OR naechstes symbol = "CONST"

+

+. kommentar :

+    pos (zeile, "(*") > 0 OR pos (zeile, "{") > 0 

+

+. 

+  hole erstes symbol :

+    hole erstes nicht blankes symbol; 

+    scan (zeile);

+    next symbol (symbol, symbol type);

+ 

+    . hole erstes nicht blankes symbol :

+        IF eof (eingabe) THEN LEAVE is elan source WITH FALSE FI;

+        REP getline (eingabe, zeile);

+        UNTIL pos (zeile, ""33"",""254"", 1) > 0 OR eof (eingabe) PER;

+        reset (eingabe);

+ 

+END PROC is elan source;

+

+(****************************************************************)

+ 

+bottom label for elan listings ("");

+ 

+PROC bottom label for elan listings (TEXT CONST label) :

+     bottom label := label;

+END PROC bottom label for elan listings;

+ 

+TEXT PROC bottom label for elan listings : bottom label END PROC bottom label for elan listings;

+ 

+ 

+PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, 

+            PROC (INT CONST, INT VAR, INT VAR) open,

+            PROC (INT CONST, INT CONST) close,

+            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,

+            BOOL CONST elan listing, TEXT CONST file name) :

+ 

+disable stop;

+gedruckte seiten := 0;

+drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,

+              PROC (INT CONST, INT VAR, INT VAR) open,

+              PROC (INT CONST, INT CONST) close,

+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,

+              elan listing, file name );

+IF is error THEN behandle fehlermeldung FI;

+ 

+. behandle fehlermeldung :

+    par1 := error message;

+    int param := error line;

+    clear error;

+    IF NOT vor erster seite

+       THEN IF seite ist offen

+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )

+            FI;

+            clear error;

+            close (document, 0);

+            clear error;

+    FI;

+    initialisierung;

+    errorstop (par1 (* + " -> " + text (int param) *) );

+ 

+END PROC print; 

+ 

+INT PROC x pos          : d xpos                END PROC x pos;

+INT PROC y pos          : d ypos                END PROC y pos;

+INT PROC y offset index : d token. offset index END PROC y offset index;

+INT PROC linetype       : underline linetype    END PROC linetype;

+TEXT PROC material      : material wert         END PROC material;

+INT PROC pages printed  : gedruckte seiten      END PROC pages printed;

+ 

+(****************************************************************)

+ 

+PROC drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof,

+                   PROC (INT CONST, INT VAR, INT VAR) open,

+                   PROC (INT CONST, INT CONST) close,

+                   PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute,

+                   BOOL CONST elan listing, TEXT CONST file name ) :

+ 

+ 

+enable stop;

+IF elan listing

+   THEN dateiname := file name;

+        drucke elan listing;

+   ELSE drucke text datei;

+FI;

+ 

+.

+  drucke text datei :

+    initialisiere druck; 

+    WHILE NOT eof

+    REP next line (zeile); 

+        analysiere zeile; 

+        drucke token soweit wie moeglich;

+        werte anweisungsspeicher aus;

+    PER;

+    schliesse druck ab; 

+ 

+. 

+  initialisiere druck :

+    IF NOT initialized (in dieser task)

+       THEN ds := nilspace;

+            initialisierung

+    FI;

+    vor erster seite               := TRUE;

+    tabellen modus                 := FALSE;

+    block modus                    := FALSE;

+    zeile ist absatzzeile          := TRUE;

+    x wanted                       := x step conversion (std x wanted);

+    y wanted                       := y step conversion (std y wanted);

+    limit                          := x step conversion (std limit);

+    pagelength                     := y step conversion (std pagelength);

+    linefeed faktor                := std linefeed faktor;

+    material wert                  := std material;

+    indentation                    := 0;

+    modifikations modus            := maxint; 

+    seitenlaenge                   := maxint;

+    papierlaenge                   := maxint;

+    left margin                    := 0;

+    top  margin                    := 0;

+    a ypos                         := top margin;

+    a font                         := -1;

+    a modifikationen               := 0;

+    aktuelle spalte                := 1;

+    anzahl spalten                 := 1;

+    stelle neuen font ein (1);

+    loesche tabellenspeicher;

+    loesche markierung;

+    loesche alte markierung;

+    loesche durchschuss;

+ 

+. 

+  schliesse druck ab :

+    IF NOT vor erster seite

+       THEN IF seite ist offen

+               THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                    PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute )

+            FI;

+            close (document, 0);

+    FI;

+ 

+.

+  drucke token soweit wie moeglich :

+    IF analysespeicher ist nicht leer

+       THEN letztes token bei gleicher ypos; 

+            IF NOT seite ist offen

+               THEN eroeffne seite (x wanted, y wanted,

+                                  PROC (INT CONST, INT VAR, INT VAR) open);

+            FI;

+            gehe zur letzten neuen ypos;

+            IF seitenlaenge ueberschritten OR papierlaenge ueberschritten 

+               THEN neue seite oder spalte;

+                    analysiere zeile nochmal;

+               ELSE sortiere neue token ein;

+                    IF in letzter spalte

+                       THEN drucke tokenspeicher (a ypos,

+                            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                    FI;

+            FI;

+    FI;

+ 

+    . gehe zur letzten neuen ypos :

+        ypos index a := letzter ypos index a

+ 

+    . seitenlaenge ueberschritten :

+        ya. ypos > seitenlaenge 

+ 

+    . papierlaenge ueberschritten :

+        ya. ypos > papierlaenge 

+ 

+    . neue seite oder spalte :

+        IF in letzter spalte

+           THEN schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                      PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                eroeffne seite (x wanted, aktuelles y wanted,

+                      PROC (INT CONST, INT VAR, INT VAR) open);

+           ELSE neue spalte;

+        FI;

+ 

+        . aktuelles y wanted :

+            IF seitenlaenge ueberschritten

+               THEN y wanted

+               ELSE 0

+            FI

+ 

+    . analysiere zeile nochmal :

+        setze auf alte werte zurueck;

+        loesche anweisungsspeicher;

+        analysiere zeile;

+        letztes token bei gleicher ypos;

+        sortiere neue token ein;

+ 

+        . setze auf alte werte zurueck :

+           zeile ist absatzzeile := letzte zeile war absatzzeile;

+           a modifikationen      := letzte modifikationen;

+           stelle neuen font ein (letzter font);

+ 

+.

+  werte anweisungsspeicher aus :

+    INT VAR index;

+    FOR index  FROM 1 UPTO anweisungszaehler

+    REP

+        SELECT anweisungs indizes ISUB index OF

+          CASE a block             : block anweisung

+          CASE a columns           : columns anweisung

+          CASE a columnsend        : columnsend anweisung

+          CASE a free              : free anweisung

+          CASE a limit             : limit anweisung

+          CASE a linefeed          : linefeed anweisung

+          CASE a material          : material anweisung

+          CASE a page0, a page1    : page anweisung

+          CASE a pagelength        : pagelength anweisung

+          CASE a start             : start anweisung

+          CASE a table             : table anweisung

+          CASE a tableend          : tableend anweisung 

+          CASE a clearpos0         : clearpos0 anweisung

+          CASE a clearpos1         : clearpos1 anweisung

+          CASE a lpos, a rpos, a cpos, a dpos

+                                   : lpos rpos cpos dpos anweisung

+          CASE a bpos              : bpos anweisung

+          CASE a fillchar          : fillchar anweisung

+          CASE a textbegin0        : textbegin0 anweisung

+          CASE a textbegin2        : textbegin2 anweisung

+          CASE a textend           : textend anweisung

+          CASE a indentation       : indentation anweisung

+          CASE a y tab             : y tab anweisung

+        END SELECT

+   PER; 

+   loesche anweisungsspeicher;

+ 

+   . block anweisung :

+       blockmodus := TRUE;

+ 

+   . columns anweisung :

+       IF anzahl spalten = 1 AND int  conversion ok (param1)

+                             AND real conversion ok (param2) 

+          THEN anzahl spalten := max (1, int param); 

+               luecke         := x step conversion (real param);

+       FI;

+ 

+   . columnsend anweisung :

+       anzahl spalten  := 1;

+       aktuelle spalte := 1; 

+       left margin     := x wanted - x start + indentation;

+ 

+   . free anweisung :

+       IF real conversion ok (param1) THEN a ypos INCR y step conversion (real param) FI;

+ 

+   . limit anweisung :

+       IF real conversion ok (param1) THEN limit := x step conversion (real param) FI;

+ 

+   . linefeed anweisung :

+       IF real conversion ok (param1)

+          THEN linefeed faktor    := real param;

+               letzte zeilenhoehe := neue zeilenhoehe;

+       FI;

+

+   . material anweisung :

+       material wert := param1;

+ 

+   . page anweisung :

+       IF seite ist offen

+          THEN IF NOT in letzter spalte

+                  THEN neue spalte

+                  ELSE schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                       papier laenge := maxint;

+               FI;

+          ELSE a ypos        := top margin;

+               papier laenge := maxint;

+       FI;

+ 

+   . pagelength anweisung :

+       IF real conversion ok (param1)

+          THEN pagelength   := y step conversion (real param);

+       FI;

+ 

+   . start anweisung :

+       IF real conversion ok (param1) THEN x wanted := x step conversion (real param) FI;

+       IF real conversion ok (param2) THEN y wanted := y step conversion (real param) FI;

+ 

+   . table anweisung :

+       tabellenmodus := TRUE;

+ 

+   . tableend anweisung :

+       tabellenmodus := FALSE;

+ 

+   . clearpos0 anweisung :

+       loesche tabellenspeicher;

+ 

+   . clearpos1 anweisung :

+       IF real conversion ok (param1) 

+          THEN int param := x step conversion (real param);

+               FOR tab index FROM 1 UPTO anzahl tabs

+               REP IF tab position = int param

+                      THEN tab typ := leer;

+                           delete int (tab liste, tab index);

+                           LEAVE clearpos1 anweisung;

+                   FI;

+               PER;

+       FI; 

+ 

+   . lpos rpos cpos dpos anweisung :

+       IF real conversion ok (param1)

+          THEN neuer tab eintrag (anweisungs indizes ISUB index, param2) FI; 

+ 

+   . bpos anweisung :

+       IF real conversion ok (param2) CAND real conversion ok (param1)

+            CAND real (param2) > real param

+          THEN neuer tab eintrag (a bpos, param2) FI;

+ 

+   . fillchar anweisung :

+        fill char := param1;

+ 

+   . textbegin0 anweisung :

+       aktuelle einrueckbreite := alte einrueckbreite;

+       mark index l            := alter mark index l;

+       mark index r            := alter mark index r;

+       loesche alte markierung;

+ 

+   . textbegin2 anweisung :

+       aktuelle einrueckbreite := alte einrueckbreite;

+       mark index l            := alter mark index l;

+       mark index r            := alter mark index r;

+       loesche alte markierung;

+       neuer durchschuss (int (param1), y step conversion (real (param 2)));

+ 

+   . textend anweisung :

+       alte einrueckbreite := aktuelle einrueckbreite;

+       alter mark index l  := mark index l;

+       alter mark index r  := mark index r;

+       loesche markierung;

+       loesche durchschuss;

+

+   . indentation anweisung :

+(*     IF real conversion ok (param1)

+          THEN int param   := x step conversion (real param);

+               left margin INCR (int param - indentation);

+               indentation :=    int param;

+       FI;

+  *)

+   . y tab anweisung :

+(*     IF real conversion ok (param1)

+          THEN int param := y step conversion (real param);

+               IF int param <= seitenlaenge THEN a ypos := int param FI;

+       FI;

+  *)

+       . param1 :

+           IF (params1 zeiger ISUB index) <> 0

+              THEN name (params1, params1 zeiger ISUB index)

+              ELSE ""

+           FI

+ 

+       . param2 :

+           IF (params2 zeiger ISUB index) <> 0

+              THEN name (params2, params2 zeiger ISUB index)

+              ELSE ""

+           FI

+ 

+

+.

+  drucke elan listing :

+    initialisiere elan listing;

+    WHILE NOT eof

+    REP next line (zeile);

+        zeilen nr INCR 1;

+        drucke elan zeile;

+    PER;

+    schliesse elan listing ab;

+ 

+.

+  initialisiere elan listing :

+    open document cmd;

+    hole elan list font;

+    initialisiere variablen;

+    elan fuss und kopf (1,

+               PROC (INT CONST, INT CONST) close,

+               PROC (INT CONST, INT VAR, INT VAR) open,

+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+    . open document cmd :

+        material wert         := "";

+        d token. offset index := 1;

+        erster ypos index d   := 0; 

+        vor erster seite      := FALSE;

+        seite ist offen       := FALSE;

+        open (document, x size, y size);

+        vor erster seite      := TRUE;

+ 

+    . hole elan list font :

+        d font := max (1, font ("elanlist"));

+        get replacements (d font, replacements, replacement tabelle);

+        einrueckbreite := indentation pitch (d font) ;

+        font hoehe     := font lead (d font) + font height (d font) + font depth (d font);

+ 

+    . initialisiere variablen :

+        innerhalb der define liste := FALSE;

+        vor erstem packet       := TRUE;

+        zeilen nr               := 0;

+        y wanted                := y size DIV 23;

+        pagelength              := y size - y wanted - y wanted; 

+        x wanted                := (min (x size DIV 10, x step conversion (2.54))

+                                        DIV einrueckbreite) * einrueckbreite; 

+        max zeichen zeile       := (x size - x wanted - (x wanted DIV 3)) DIV einrueckbreite;

+        max zeichen fuss        := fusszeilenbreite;

+        layout laenge           := min (38, max zeichen zeile DIV 3);

+        layout laenge name      :=  layout laenge - zeilen nr laenge - 8; 

+        layout blanks           := (layout laenge - zeilen nr laenge - 1) * " "; 

+        refinement layout zeile := (layout laenge - 1) * " " ;

+        refinement layout zeile CAT "|" ;

+        IF pagelength DIV fonthoehe - 6 < 35 OR max zeichen zeile < 65

+           THEN errorstop ("Schreibfeld fuer 'elan listing' zu klein") FI;

+ 

+        . fusszeilenbreite :

+            INT CONST dina 4 breite := x step conversion (21.0);

+            IF   x size <= dina 4 breite

+                 THEN (x size - 2 * x wanted) DIV einrueckbreite 

+            ELIF 120 * einrueckbreite <= dina 4 breite - 2 * x wanted

+                 THEN (dina 4 breite - 2 * x wanted) DIV einrueckbreite 

+                 ELSE min (120, (x size - 2 * x wanted) DIV einrueckbreite)

+            FI

+ 

+.

+  schliesse elan listing ab :

+    elan fuss und kopf (-1,

+               PROC (INT CONST, INT CONST) close,

+               PROC (INT CONST, INT VAR, INT VAR) open,

+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    close (document, 0);

+ 

+. 

+  drucke elan zeile :

+    IF pos (zeile, "#page#") = 1 

+       THEN IF nicht am seiten anfang THEN seiten wechsel FI;

+       ELSE bestimme elan layout;

+            bestimme elan zeile;

+            gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+            seitenwechsel wenn noetig;

+    FI;

+ 

+    . nicht am seitenanfang :

+        rest auf seite < pagelength - 3 * font hoehe

+ 

+    . seiten wechsel :

+        elan fuss und kopf (0,

+               PROC (INT CONST, INT CONST) close,

+               PROC (INT CONST, INT VAR, INT VAR) open,

+               PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+. 

+  bestimme elan layout :

+    IF pos (zeile, "P") = 0 AND pos (zeile, ":") = 0

+       THEN leeres layout 

+       ELSE analysiere elan zeile

+    FI;

+    elan text CAT "|";

+ 

+    . leeres layout :

+        elan text := text (zeilen nr, zeilen nr laenge);

+        elan text CAT layout blanks;

+ 

+    . analysiere elan zeile :

+        scan (zeile);

+        next symbol (symbol, symbol type);

+        next symbol (naechstes symbol, naechster symbol type) ;

+        IF   packet anfang              THEN packet     layout 

+        ELIF innerhalb der define liste THEN leeres     layout; pruefe ende der define liste 

+        ELIF proc op anfang             THEN proc op    layout

+        ELIF refinement anfang          THEN refinement layout

+                                        ELSE leeres     layout

+        FI;

+ 

+    . packet anfang :

+        symbol = "PACKET"

+ 

+    . proc op anfang :

+        IF   proc oder op (symbol)

+             THEN naechster symbol type <> delimiter type

+        ELIF (symbol <> "END") AND proc oder op (naechstes symbol)

+             THEN symbol := naechstes symbol;

+                  next symbol (naechstes symbol, naechster symbol type) ;

+                  naechster symbol type <> delimiter type

+             ELSE FALSE

+        FI

+ 

+    . refinement anfang :

+        symbol type = tag type AND naechstes symbol = ":" 

+                                  AND NOT innerhalb der define liste 

+ 

+    . packet layout :

+        IF nicht am seiten anfang AND

+             (NOT vor erstem packet OR gedruckte seiten > 1)

+           THEN seiten wechsel FI;

+        layout ("   ", naechstes symbol, "*") ;

+        vor erstem packet := FALSE ;

+        innerhalb der define liste := TRUE;

+        pruefe ende der define liste;

+

+       . pruefe ende der define liste :

+           IF pos (zeile, ":") <> 0

+              THEN scan (zeile);

+                   WHILE innerhalb der define liste

+                   REP next symbol (symbol);

+                       IF symbol = ":" THEN innerhalb der define liste := FALSE FI;

+                   UNTIL symbol = "" PER;

+           FI;

+

+    . proc op layout :

+        IF   keine vier zeilen mehr

+             THEN seiten wechsel

+        ELIF nicht am seitenanfang

+             THEN cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+        FI ; 

+        layout ("   ", naechstes symbol, ".");

+ 

+        . keine vier zeilen mehr :

+            rest auf seite <= 8 * font hoehe 

+ 

+    . refinement layout :

+        IF   keine drei zeilen mehr

+             THEN seiten wechsel

+        ELIF nicht am seitenanfang

+             THEN elan text := refinement layout zeile;

+                  gib elan text aus

+                       (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+        FI ; 

+        layout ("      ", symbol, " ");

+ 

+        . keine drei zeilen mehr :

+            rest auf seite <= 7 * font hoehe 

+ 

+. 

+  bestimme elan zeile : 

+    IF zeile ist nicht zu lang

+       THEN elan text CAT zeile;

+       ELSE drucke zeile in teilen 

+    FI;

+ 

+    . zeile ist nicht zu lang :

+        zeilen laenge := LENGTH zeile;

+        zeilen laenge <= rest auf zeile

+ 

+       . rest auf zeile :

+           max zeichen zeile - LENGTH elan text

+ 

+    . drucke zeile in teilen :

+        zeilen pos := 1;

+        bestimme einrueckung;

+        WHILE zeile noch nicht ganz gedruckt REP teil layout PER;

+ 

+    . bestimme einrueckung :

+        anzahl einrueck blanks := naechstes nicht blankes zeichen - 1;

+        IF anzahl einrueck blanks > rest auf zeile - 20

+           THEN anzahl einrueck blanks := 0 FI;

+ 

+    . zeile noch nicht ganz gedruckt :

+        bestimme zeilenteil;

+        NOT zeile ist zu ende

+ 

+        . bestimme zeilenteil :

+            bestimme laenge;

+            zeilen teil := subtext (zeile, zeilen pos, zeilen pos + laenge - 1);

+            elan text CAT zeilen teil;

+            zeilen pos INCR laenge;

+ 

+            . zeilen teil : par1

+

+            . bestimme laenge :

+               INT VAR laenge := zeilen laenge - zeilen pos + 1;

+               IF laenge > rest auf zeile

+                  THEN laenge := rest auf zeile;

+                       WHILE (zeile SUB (zeilen pos + laenge - 1)) <> " "

+                       REP laenge DECR 1 UNTIL laenge = 0 PER;

+                       IF laenge = 0 THEN laenge := rest auf zeile FI;

+               FI;

+ 

+    . teil layout :

+        gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+        elan text :=  (zeilen nr laenge - 1) * " "; 

+        elan text CAT "+";

+        elan text CAT layout blanks;

+        elan text CAT "|";

+        elan text cat blanks (anzahl einrueck blanks + teil einrueckung);

+ 

+. 

+  seiten wechsel wenn noetig :

+    IF keine zeilen mehr AND NOT eof THEN seiten wechsel FI; 

+ 

+    . keine zeilen mehr :

+        rest auf seite <= 4 * font hoehe 

+ 

+END PROC drucke datei;

+ 

+ 

+BOOL PROC real conversion ok (TEXT CONST param) :

+     real param := real (param);

+     last conversion ok AND real param >= 0.0

+END PROC real conversion ok;

+ 

+ 

+BOOL PROC int conversion ok (TEXT CONST param) :

+     int param := int (param);

+     last conversion ok AND int param >= 0 

+END PROC int conversion ok;

+ 

+ 

+PROC neuer tab eintrag (INT CONST typ, TEXT CONST param) :

+ 

+     suche neuen eintrag;

+     sortiere neue tab position ein;

+     tab typ      := typ;

+     tab position := neue tab position;

+     tab param    := eventueller parameter;

+ 

+     . suche neuen eintrag :

+         INT VAR index := 0;

+         REP index INCR 1;

+             IF tab speicher (index). tab typ = leer

+                THEN LEAVE suche neuen eintrag FI;

+         UNTIL index = max tabs PER;

+         LEAVE neuer tab eintrag;

+ 

+     . sortiere neue tab position ein :

+         INT VAR neue tab position := x step conversion (real param);

+         FOR tab index FROM 1 UPTO anzahl tabs

+         REP IF   tab position = neue tab position

+                THEN LEAVE neuer tab eintrag

+             ELIF tab position > neue tab position

+                THEN insert int (tab liste, tab index, index);

+                     LEAVE sortiere neue tab position ein;

+             FI;

+         PER;

+         tab liste CAT index;

+         tab index :=  anzahl tabs;

+ 

+     . eventueller parameter :

+         INT VAR link;

+         SELECT typ OF

+           CASE a dpos : insert (d strings, param, link); link

+           CASE a bpos : x step conversion (real(param))

+             OTHERWISE : 0

+         END SELECT

+ 

+END PROC neuer tab eintrag;

+ 

+ 

+PROC neue spalte :

+     a ypos           :=  top margin;

+     left margin     INCR (limit + luecke);

+     aktuelle spalte INCR 1;

+END PROC neue spalte ;

+ 

+ 

+BOOL PROC proc oder op (TEXT CONST symbol) :

+

+  symbol = "PROC" OR symbol = "PROCEDURE"

+    OR symbol = "OP" OR symbol = "OPERATOR" 

+

+ENDPROC proc oder op ;

+ 

+ 

+PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :

+

+name := subtext (name, 1, layout laenge name) ;

+elan text :=  text (zeilen nr, zeilen nr laenge);

+elan text CAT pre;

+elan text CAT name;

+elan text CAT " ";

+generiere strukturiertes layout;

+ 

+. generiere strukturiertes layout :

+    INT VAR index;

+    FOR index FROM 1 UPTO layout laenge - LENGTH elan text - 1

+        REP elan text CAT post PER;

+

+ENDPROC layout ;

+ 

+ 

+PROC elan text cat blanks (INT CONST anzahl) :

+ 

+  par2 := anzahl * " ";

+  elan text CAT par2;

+ 

+END PROC elan text cat blanks;

+ 

+ 

+(***********************************************************************)

+ 

+PROC analysiere zeile : 

+ 

+loesche analysespeicher;

+behandle fuehrende blanks;

+pruefe ob anweisungszeile;

+pruefe ob markierung links;

+ 

+IF   tabellen modus

+     THEN analysiere tabellenzeile

+ELIF letzte zeile war absatzzeile 

+     THEN analysiere zeile nach absatzzeile 

+     ELSE analysiere zeile nach blockzeile

+FI; 

+ 

+pruefe center und right modus;

+pruefe ob tabulation vorliegt;

+werte indexspeicher aus;

+berechne zeilenhoehe;

+pruefe ob markierung rechts;

+ 

+.

+  analysiere zeile nach absatzzeile :

+    test auf aufzaehlung;

+    IF zeile muss geblockt werden 

+       THEN analysiere blockzeile nach absatzzeile 

+       ELSE analysiere absatzzeile nach absatzzeile 

+    FI; 

+.

+  analysiere zeile nach blockzeile :

+    IF zeile muss geblockt werden 

+       THEN analysiere blockzeile nach blockzeile 

+       ELSE analysiere absatzzeile nach blockzeile

+    FI; 

+ 

+ 

+.

+  behandle fuehrende blanks :

+    zeilenpos := 1;

+    zeilenpos := naechstes nicht blankes zeichen; 

+    IF zeilenpos = 0

+       THEN behandle leerzeile;

+            LEAVE analysiere zeile;

+       ELSE letzte zeile war absatzzeile := zeile ist absatzzeile; 

+            IF letzte zeile war absatzzeile THEN neue einrueckung FI;

+            initialisiere analyse;

+    FI;

+ 

+    . behandle leerzeile :

+        a ypos INCR (letzte zeilenhoehe + durchschuss);

+        zeile ist absatzzeile := LENGTH zeile > 0;

+        pruefe ob markierung links;

+        pruefe ob markierung rechts;

+ 

+    . neue einrueckung :

+        aktuelle einrueckbreite := einrueckbreite;

+ 

+    . initialisiere analyse :

+        zeile ist absatzzeile        := (zeile SUB LENGTH zeile) = blank;

+        zeile muss geblockt werden   := block modus AND NOT zeile ist absatzzeile;

+        erstes token der zeile       := token index f + 1;

+        groesste fonthoehe           := fonthoehe;

+        aktuelle zeilenhoehe         := letzte zeilenhoehe;

+        zeilen laenge                := laenge der zeile;

+        anzahl einrueck blanks       := zeilen pos - 1; 

+        anzahl zeichen               := anzahl einrueck blanks;

+        a xpos                       := left margin + anzahl zeichen * aktuelle einrueckbreite; 

+        a modifikationen fuer x move := 0;

+        letzter font                 := a font;

+        letzte modifikationen        := a modifikationen;

+        IF zeile muss geblockt werden THEN initialisiere tab variablen FI;

+

+        . laenge der zeile :

+            IF zeile ist absatzzeile

+               THEN LENGTH zeile - 1

+               ELSE LENGTH zeile 

+            FI

+.

+  pruefe ob anweisungszeile :

+    IF erstes zeichen ist anweisungszeichen

+       THEN REP analysiere anweisung;

+                IF zeile ist zu ende THEN LEAVE analysiere zeile FI;

+            UNTIL zeichen ist kein anweisungs zeichen PER;

+    FI;

+ 

+    . erstes zeichen ist anweisungszeichen :

+        pos (zeile, anweisungszeichen, 1, 1) <> 0

+ 

+    . zeichen ist kein anweisungszeichen :

+        pos (zeile, anweisungszeichen, zeilen pos, zeilen pos) = 0

+ 

+.

+  pruefe ob markierung links :

+    IF markierung links

+       THEN mark token (mark index l). xpos := 

+                             left margin - mark token (mark index l). breite;

+            lege markierungs token an (mark index l);

+            erstes token der zeile := token index f + 1;

+            initialisiere tab variablen;

+    FI;

+ 

+. 

+  analysiere tabellenzeile : 

+    anfangs blankmodus := doppel blank;

+    alte zeilenpos     := zeilen pos;

+    a xpos             := 0;

+    FOR tab index FROM 1 UPTO anzahl tabs

+    REP lege fuell token an wenn noetig;

+        initialisiere tab variablen; 

+        SELECT tab typ OF

+          CASE a lpos  :  linksbuendige spalte

+          CASE a rpos  :  rechtsbuendige spalte

+          CASE a cpos  :  zentrierte spalte

+          CASE a dpos  :  dezimale spalte

+          CASE a bpos  :  geblockte spalte

+        END SELECT;

+        berechne fuell token wenn noetig;

+        tabulation;

+    PER;

+    analysiere rest der zeile;

+ 

+    . lege fuell token an wenn noetig :

+        IF fill char <> blank

+           THEN fuellzeichen                 := fill char;

+                fuellzeichen breite          := string breite (fuellzeichen);

+                token zeiger                 := zeilen pos;

+                erstes fuell token           := token index f + 1;

+                lege text token an;

+                letztes fuell token          := token index f;

+                a modifikationen fuer x move := a modifikationen

+        FI;

+ 

+    . berechne fuell token wenn noetig :

+        IF erstes fuell token <> leer

+           THEN IF letztes fuell token <> token index f 

+                   THEN berechne fuell token;

+                   ELSE loesche letzte token;

+                FI;

+                erstes fuell token := leer

+        FI;

+ 

+        . berechne fuell token :

+            INT VAR anzahl fuellzeichen, fuell breite;

+            token index         := erstes fuell token;

+            anzahl fuellzeichen := (tab anfang - t. xpos + left margin) 

+                                                 DIV fuellzeichen breite;

+            rest                := (tab anfang - t. xpos + left margin) 

+                                                 MOD fuellzeichen breite;

+            IF anzahl fuell zeichen > 0

+               THEN fuell text   := anzahl fuellzeichen * fuellzeichen; 

+                    fuell breite := anzahl fuellzeichen * fuellzeichen breite; 

+                    FOR token index FROM erstes fuell token UPTO letztes fuell token

+                    REP t. text   := fuell text;

+                        t. breite := fuell breite;

+                        IF erstes fuell token <> erstes token der zeile

+                           THEN t. xpos INCR rest DIV 2;

+                                t. modifikationen fuer x move := t. modifikationen;

+                        FI;

+                    PER;

+            FI;

+ 

+            . fuell text : par1

+ 

+        . loesche letzte token :

+            FOR token index FROM letztes fuell token DOWNTO erstes fuell token

+            REP loesche letztes token PER;

+ 

+    . tabulation :

+        alte zeilenpos := zeilenpos;

+        zeilenpos := naechstes nicht blankes zeichen; 

+        IF zeilenpos = 0

+           THEN zeilenpos := zeilenlaenge + 1; 

+                LEAVE analysiere tabellenzeile;

+        FI;

+        anzahl zeichen INCR zeilenpos - alte zeilenpos; 

+ 

+    . linksbuendige spalte : 

+        a xpos     := left margin + tab position;

+        tab anfang := tab position;

+        bestimme token bis terminator oder zeilenende;

+ 

+    . rechtsbuendige spalte :

+        bestimme token bis terminator oder zeilenende;

+        schreibe zeile rechtsbuendig (tab position);

+ 

+    . zentrierte spalte :

+        bestimme token bis terminator oder zeilenende;

+        zentriere zeile (tab position);

+ 

+    . dezimale spalte :

+        d string                  := name (d strings, tab param);

+        d code 1                  := code (d string SUB 1) + 1;

+        d pitch                   := zeichenbreiten (d code 1);

+        zeichenbreiten (d code 1) := d code ausgang;

+        bestimme token bis terminator oder zeilenende;

+        zeichenbreiten (d code 1) := d pitch;

+        d code 1                  := leer;

+        schreibe zeile rechtsbuendig (tab position);

+        IF zeichen ist dezimal zeichen

+           THEN IF tab position <> zeilen breite

+                   THEN a xpos     := left margin + tab position;

+                        tab anfang := tab position;

+                FI;

+                bestimme token bis terminator oder zeilenende

+        FI;

+ 

+        . zeichen ist dezimal zeichen :

+            pos (zeile, d string,  zeilen pos) = zeilen pos

+ 

+    . geblockte spalte :

+        blankmodus := einfach blank;

+        a xpos     := left margin + tab position;

+        tab anfang := tab position;

+        REP bestimme token bis terminator oder zeilenende; 

+            IF zeile ist zu ende OR naechstes zeichen ist blank

+               THEN blocke spalte wenn noetig;

+                    LEAVE geblockte spalte;

+               ELSE dehnbares blank gefunden;

+            FI;

+        PER;

+ 

+        . blocke spalte wenn noetig :

+            IF letztes zeichen ist kein geschuetztes blank

+               THEN blocke zeile (tab param) FI;

+            blank modus := doppel blank;

+ 

+        . letztes zeichen ist kein geschuetztes blank :

+            pos (zeile, geschuetztes blank,  zeilen pos - 1, zeilen pos - 1) = 0

+              AND NOT within kanji (zeile, zeilen pos - 2)

+

+    . analysiere rest der zeile :

+        blankmodus := keine blankanalyse;

+        zeilen pos := alte zeilenpos;

+        bestimme token bis terminator oder zeilenende;

+ 

+.

+  test auf aufzaehlung : 

+    anfangs blankmodus := einfach blank;

+    bestimme token bis terminator oder zeilenende;

+    IF zeile ist zu ende

+       THEN LEAVE analysiere zeile nach absatzzeile

+       ELSE aufzaehlung moeglich

+    FI;

+ 

+    . aufzaehlung moeglich :

+        bestimme letztes zeichen;

+        IF    (anzahl zeichen bei aufzaehlung < 2  AND letztes zeichen = "-")

+           OR (anzahl zeichen bei aufzaehlung < 20 AND letztes zeichen = ":")

+           OR (anzahl zeichen bei aufzaehlung < 7

+                                        AND pos (".)", letztes zeichen) <> 0)

+           OR naechstes zeichen ist blank

+          THEN tabulator position gefunden;

+        ELIF zeile muss geblockt werden

+          THEN dehnbares blank gefunden;

+        FI;

+ 

+        . bestimme letztes zeichen : 

+            token index := token index f;

+            WHILE token index >= erstes token der zeile

+            REP IF token ist text token 

+                   THEN letztes zeichen := t. text SUB LENGTH t. text;

+                        LEAVE bestimme letztes zeichen;

+                FI;

+                token index DECR 1;

+            PER;

+            letztes zeichen := "";

+ 

+        . letztes zeichen : par1

+ 

+        . anzahl zeichen bei aufzaehlung :

+            anzahl zeichen - anzahl einrueck blanks

+ 

+        . token ist text token :

+            t. offset index >= text token

+.

+  analysiere blockzeile nach absatzzeile :

+    REP bestimme token bis terminator oder zeilenende; 

+        IF zeile ist zu ende 

+           THEN blocke zeile (limit);

+                LEAVE analysiere blockzeile nach absatzzeile

+           ELSE analysiere blank in blockzeile nach absatzzeile 

+        FI;

+    PER;

+ 

+    . analysiere blank in blockzeile nach absatzzeile : 

+        IF naechstes zeichen ist blank

+           THEN tabulator position gefunden;

+           ELSE dehnbares blank gefunden;

+        FI;

+ 

+.

+  analysiere absatzzeile nach absatzzeile :

+    blankmodus := doppel blank;

+    REP bestimme token bis terminator oder zeilenende;

+        IF zeile ist zu ende 

+           THEN LEAVE analysiere absatzzeile nach absatzzeile

+           ELSE tabulator position gefunden

+        FI;

+    PER;

+ 

+.

+  analysiere blockzeile nach blockzeile :

+    anfangs blankmodus := einfach blank;

+    REP bestimme token bis terminator oder zeilenende;

+        IF zeile ist zu ende 

+           THEN blocke zeile (limit);

+                LEAVE analysiere blockzeile nach blockzeile

+           ELSE dehnbares blank gefunden 

+        FI;

+    PER;

+ 

+.

+  analysiere absatzzeile nach blockzeile :

+    anfangs blankmodus := keine blankanalyse;

+    bestimme token bis terminator oder zeilenende;

+

+.

+  dehnbares blank gefunden :

+    anzahl zeichen INCR 1;

+    zeilenpos      INCR 1;

+    a xpos         INCR blankbreite;

+    a modifikationen fuer x move := a modifikationen;

+    IF NOT a block token

+       THEN anzahl blanks  INCR 1;

+            a block token := TRUE; 

+    FI;

+.

+  tabulator position gefunden :

+    alte zeilenpos := zeilenpos; 

+    zeilenpos := naechstes nicht blankes zeichen;

+    IF zeilenpos = 0 

+       THEN zeilenpos := zeilen laenge + 1;

+       ELSE IF erstes token der zeile > token index f

+               THEN token zeiger := zeilen pos;

+                    lege text token an;

+            FI;

+            anzahl zeichen INCR (zeilenpos - alte zeilenpos);

+            a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; 

+            a modifikationen fuer x move := a modifikationen;

+            IF zeile muss geblockt werden THEN initialisiere tab variablen FI;

+    FI;

+ 

+.

+  pruefe center und right modus : 

+    IF center modus THEN zentriere zeile (limit DIV 2) FI;

+    IF right  modus THEN schreibe zeile rechtsbuendig (limit) FI;

+.

+  pruefe ob tabulation vorliegt:

+    IF analyse speicher ist nicht leer CAND a xpos > tf. xpos + tf. breite

+       THEN a modifikationen fuer x move := a modifikationen; 

+            token zeiger := zeilen pos;

+            lege text token an;

+    FI;

+.

+  werte indexspeicher aus :

+    INT VAR index;

+    IF index zaehler > 0

+       THEN FOR index FROM index zaehler DOWNTO 1

+                REP a ypos DECR (verschiebungen ISUB index) PER;

+            stelle neuen font ein (grosse fonts ISUB 1);

+            loesche index speicher;

+    FI;

+.

+  berechne zeilenhoehe :

+    verschiebung := aktuelle zeilenhoehe + durchschuss;

+    a ypos INCR verschiebung;

+    verschiebe token ypos (verschiebung);

+ 

+.

+  pruefe ob markierung rechts :

+    IF markierung rechts

+       THEN mark token (mark index r). xpos := left margin + limit;

+            lege markierungs token an (mark index r);

+    FI;

+ 

+END PROC analysiere zeile;

+ 

+ 

+PROC blocke zeile (INT CONST rechter rand) :

+ 

+rest := rechter rand - zeilen breite;

+IF rest > 0 AND anzahl blanks > 0

+   THEN INT CONST schmaler schritt       := rest DIV anzahl blanks,

+                  breiter schritt        := schmaler schritt + 1,

+                  anzahl breite schritte := rest MOD anzahl blanks;

+        IF rechts

+           THEN blocke token xpos (breiter schritt, schmaler schritt,

+                                                     anzahl breite schritte);

+                rechts := FALSE; 

+           ELSE blocke token xpos (schmaler schritt, breiter schritt,

+                                     anzahl blanks - anzahl breite schritte);

+                rechts := TRUE;

+       FI;

+       a xpos INCR ( breiter schritt * anzahl breite schritte +

+              schmaler schritt * (anzahl blanks - anzahl breite schritte) );

+FI;

+ 

+END PROC blocke zeile;

+ 

+ 

+PROC zentriere zeile (INT CONST zentrier pos) :

+ 

+IF erstes tab token <= token index f

+   THEN verschiebung := zentrier pos - tab anfang -

+                                   (zeilen breite - tab anfang) DIV 2; 

+        verschiebe token xpos (verschiebung);

+        a xpos     INCR verschiebung; 

+        tab anfang INCR verschiebung; 

+FI;

+center modus := FALSE;

+ 

+END PROC zentriere zeile;

+

+

+PROC schreibe zeile rechtsbuendig (INT CONST rechte pos) :

+ 

+IF erstes tab token <= token index f

+   THEN verschiebung := rechte pos - zeilen breite;

+        verschiebe token xpos (verschiebung);

+        a xpos     INCR verschiebung;

+        tab anfang INCR verschiebung; 

+FI;

+right modus := FALSE;

+ 

+ 

+END PROC schreibe zeile rechtsbuendig;

+

+ 

+PROC bestimme token bis terminator oder zeilenende :

+ 

+token zeiger := zeilen pos;

+REP stranalyze (zeichenbreiten, a breite, max breite, 

+                zeile, zeilen pos, zeilen laenge,

+                ausgang);

+    zeilen pos INCR 1;

+    IF   ausgang = blank ausgang

+         THEN analysiere blank

+    ELIF ausgang = anweisungs ausgang

+         THEN anweisung gefunden

+    ELIF ausgang = d code ausgang

+         THEN analysiere d string

+    ELIF ausgang = erweiterungs ausgang

+         THEN erweiterung gefunden

+         ELSE terminator oder zeilenende gefunden

+    FI;

+PER;

+ 

+. analysiere blank :

+    IF blankmodus = einfach blank OR

+       (blankmodus = doppel blank AND naechstes zeichen ist blank)

+       THEN terminator oder zeilenende gefunden 

+       ELSE a breite INCR blankbreite;

+            zeilenpos INCR 1;

+    FI;

+ 

+. analysiere d string :

+    IF pos (zeile, d string, zeilen pos) = zeilen pos 

+       THEN terminator oder zeilenende gefunden 

+       ELSE IF   d pitch = maxint

+                 THEN erweiterung gefunden

+            ELIF d pitch < 0

+                 THEN a breite INCR (d pitch XOR - maxint - 1); 

+                      zeilen pos INCR 2; 

+                 ELSE a breite INCR d pitch; 

+                      zeilenpos INCR 1;

+            FI;

+    FI;

+ 

+. erweiterung gefunden :

+    a breite INCR extended char pitch (a font, zeile SUB zeilen pos, 

+                                               zeile SUB zeilen pos + 1); 

+    zeilen pos INCR 2;

+ 

+. anweisung gefunden :

+    gegebenfalls neues token gefunden;

+    analysiere anweisung;

+    IF zeile ist zu ende

+       THEN LEAVE bestimme token bis terminator oder zeilenende FI;

+    token zeiger := zeilenpos;

+ 

+. terminator oder zeilenende gefunden :

+    IF ausgang = null ausgang THEN  zeilen laenge DECR 1 FI;

+    gegebenfalls neues token gefunden;

+    LEAVE bestimme token bis terminator oder zeilenende;

+ 

+    . gegebenfalls neues token gefunden :

+        IF token zeiger < zeilenpos THEN lege text token an FI;

+ 

+END PROC bestimme token bis terminator oder zeilen ende;

+

+ 

+PROC analysiere anweisung :

+ 

+   bestimme anweisung;

+   IF anweisung ist kommando

+      THEN lege kommando token an;

+      ELSE werte anweisung aus; 

+   FI;

+ 

+    . anweisungsanfang : token zeiger

+ 

+    . anweisungsende   : zeilen pos - 2

+ 

+    . erstes zeichen   : par1

+ 

+. bestimme anweisung :

+    anweisungsanfang := zeilenpos + 1;

+    zeilen pos := pos (zeile, anweisungszeichen, anweisungsanfang, zeilenlaenge);

+    IF zeilenpos = 0

+       THEN zeilenpos := anweisungsanfang - 1;

+            replace (zeile, zeilenpos, geschuetztes anweisungszeichen);

+            LEAVE analysiere anweisung;

+    FI;

+    zeilen pos INCR 1; 

+    anweisung      := subtext (zeile, anweisungsanfang, anweisungsende);

+    erstes zeichen := anweisung SUB 1;

+ 

+. anweisung ist kommando : 

+    IF   erstes zeichen = quote

+         THEN scan (anweisung);

+              next symbol (anweisung, symbol type);

+              next symbol (par2, naechster symbol type);

+              IF symbol type <> text type OR naechster symbol type <> eof type

+                 THEN LEAVE analysiere anweisung FI;

+              TRUE

+    ELIF erstes zeichen = druckerkommando zeichen

+         THEN delete char (anweisung, 1);

+              TRUE

+         ELSE FALSE

+    FI

+ 

+. 

+  werte anweisung aus :

+    analyze command (anweisungs liste, anweisung, number type,

+                     anweisungs index, anzahl params, par1, par2);

+    SELECT anweisungs index OF

+      CASE a type           : type anweisung

+      CASE a on             : on anweisung

+      CASE a off            : off anweisung

+      CASE a ub, a fb       : ub fb anweisung

+      CASE a ue, a fe       : ue fe anweisung

+      CASE a center         : center anweisung

+      CASE a right          : right anweisung

+      CASE a up, a down     : index anweisung

+      CASE a end up or down : end index anweisung

+      CASE a bsp            : bsp anweisung

+      CASE a fillchar       : fillchar anweisung

+      CASE a mark           : mark anweisung

+      CASE a markend        : markend anweisung

+      OTHERWISE : IF anweisungs index > 0 THEN speichere anweisung FI;

+    END SELECT;

+ 

+    . type anweisung :

+        change all (par1, " ", "");

+        stelle neuen font ein (font (par1));

+        groesste fonthoehe := max (groesste fonthoehe, fonthoehe);

+        a modifikationen   := 0;

+        IF nicht innerhalb eines indexes THEN berechne aktuelle zeilenhoehe FI;

+ 

+        . nicht innerhalb eines indexes :

+            index zaehler = 0

+ 

+        . berechne aktuelle zeilenhoehe :

+            IF linefeed faktor >= 1.0

+              THEN aktuelle zeilenhoehe := max (groesste   fonthoehe,

+                                                       letzte zeilenhoehe);

+              ELSE aktuelle zeilenhoehe := max (aktuelle zeilenhoehe,

+                                                       letzte zeilenhoehe);

+           FI;

+ 

+    . on anweisung :

+        par1 := par1 SUB 1;

+        IF pos (modifikations liste, par1) > 0

+           THEN set bit (a modifikationen, pos (modifikations liste, par1) - 1 );

+        FI;

+ 

+    . off anweisung :

+        par1 := par1 SUB 1;

+        IF pos (modifikations liste, par1) > 0

+           THEN reset bit (a modifikationen, pos (modifikations liste, par1) - 1 );

+        FI;

+

+    . ub fb anweisung :

+        IF anweisungs index = a ub

+           THEN par1 := "u"

+           ELSE par1 := "b"

+        FI;

+        on anweisung;

+

+    . ue fe anweisung :

+        IF anweisungs index = a ue

+           THEN par1 := "u"

+           ELSE par1 := "b"

+        FI;

+        off anweisung;

+

+    . center anweisung :

+        IF NOT zeile muss geblockt werden AND NOT tabellen modus

+               AND NOT right modus

+           THEN center modus := TRUE;

+                blankmodus   := keine blankanalyse;

+                initialisiere tab variablen; 

+        FI;

+ 

+    . right anweisung :

+        IF NOT zeile muss geblockt werden AND NOT tabellen modus

+           THEN IF center modus THEN zentriere zeile (limit DIV 2) FI;

+                right modus := TRUE;

+                blankmodus  := keine blankanalyse;

+                initialisiere tab variablen; 

+        FI;

+ 

+    . index anweisung :

+        INT CONST grosser font := a font, grosse fonthoehe := fonthoehe; 

+        INT VAR   kleiner font;

+        IF next smaller font exists (grosser font, kleiner font)

+           THEN stelle neuen font ein (kleiner font) FI;

+        IF font hoehe < grosse fonthoehe

+           THEN berechne verschiebung fuer kleinen font

+           ELSE berechne verschiebung fuer grossen font

+        FI;

+        a ypos INCR verschiebung;

+        merke grossen font und verschiebung;

+ 

+        . berechne verschiebung fuer kleinen font :

+            IF anweisungs index = a down

+               THEN verschiebung :=     15 PROZENT grosse fonthoehe;

+               ELSE verschiebung :=  - ( 9 PROZENT grosse fonthoehe )

+                                     - (grosse fonthoehe - fonthoehe);

+            FI;

+ 

+        . berechne verschiebung fuer grossen font :

+            IF anweisungs index = a down

+               THEN verschiebung :=    25 PROZENT fonthoehe;

+               ELSE verschiebung := - (50 PROZENT fonthoehe);

+            FI;

+ 

+        . merke grossen font und verschiebung :

+            index zaehler INCR 1;

+            grosse fonts   CAT grosser font;

+            verschiebungen CAT verschiebung;

+            IF index zaehler = 1

+               THEN alter blankmodus := blankmodus; 

+                          blankmodus := keine blankanalyse;

+            FI;

+ 

+    . end index anweisung :

+        IF index zaehler > 0

+           THEN schalte auf groesseren font zurueck;

+        FI;

+ 

+        . schalte auf groesseren font zurueck :

+            a ypos DECR (verschiebungen ISUB index zaehler);

+            stelle neuen font ein (grosse fonts ISUB index zaehler);

+            IF index zaehler = 1

+               THEN blankmodus := alter blankmodus;

+            FI;

+            index zaehler DECR 1;

+            verschiebungen := subtext (verschiebungen, 1, 2 * index zaehler);

+            grosse fonts   := subtext (grosse fonts,   1, 2 * index zaehler);

+ 

+    . bsp anweisung :

+        INT VAR breite davor, breite dahinter;

+        IF anweisungs anfang - 2 >= 1 AND anweisungs ende + 2 <= zeilen laenge

+           THEN IF is kanji esc (zeile SUB anweisungs anfang - 3)

+                   THEN zeichen davor := subtext (zeile, anweisungs anfang - 3,

+                                                         anweisungs anfang - 2);

+                   ELSE zeichen davor := zeile SUB anweisungs anfang - 2;

+                FI;

+                IF is kanji esc (zeile SUB anweisungs ende + 2)

+                   THEN zeichen dahinter := subtext (zeile, anweisungs ende + 2,

+                                                            anweisungs ende + 3 );

+                   ELSE zeichen dahinter := zeile SUB anweisungs ende + 2;

+                FI;

+                IF pos (" #", zeichen davor) = 0 AND pos (" #", zeichen dahinter) = 0 

+                   THEN breite davor    := char pitch (a font, zeichen davor);

+                        breite dahinter := char pitch (a font, zeichen dahinter);

+                        IF breite davor < breite dahinter THEN vertausche zeichen FI;

+                        lege token fuer zeichen dahinter an;

+                        a xpos INCR (breite davor - breite dahinter) DIV 2; 

+                FI;

+        FI;

+ 

+        . zeichen davor    : par1

+        . zeichen dahinter : par2

+ 

+        . vertausche zeichen :

+            change (zeile, anweisungs anfang - 2 - LENGTH zeichen davor + 1, 

+                           anweisungs anfang - 2, zeichen dahinter);

+            change (zeile, anweisungs ende + 2,

+                           anweisungs ende + 2 + LENGTH zeichen dahinter - 1, zeichen davor);

+            change (tf. text, LENGTH tf. text - LENGTH zeichen davor + 1,

+                              LENGTH tf. text, zeichen dahinter);

+            tf. breite INCR (breite dahinter - breite davor);

+            a xpos     INCR (breite dahinter - breite davor);

+            int param        := breite davor;

+            breite davor     := breite dahinter;

+            breite dahinter  := int param;

+ 

+        . lege token fuer zeichen dahinter an :

+            token zeiger := zeilen pos;

+            a breite     := breite dahinter;

+            zeilen pos INCR LENGTH zeichen dahinter;

+            a xpos     DECR (breite davor + breite dahinter) DIV 2; 

+            lege text token an;

+            anzahl zeichen DECR 1;

+ 

+    . fillchar anweisung :

+        IF par1 = "" THEN par1 := " " FI;

+        fill char := par1;

+        speichere anweisung;

+ 

+    . mark anweisung :

+        IF par1 <> "" 

+           THEN mark index l := (alter mark index l MOD 2) + 1;

+                neue markierung (par1, mark index l);

+           ELSE mark index l := 0;

+        FI;

+        IF par2 <> "" 

+           THEN mark index r := (alter mark index r MOD 2) + 3;

+                neue markierung (par2, mark index r);

+           ELSE mark index r := 0;

+        FI;

+ 

+    . markend anweisung :

+        loesche markierung;

+ 

+    . speichere anweisung :

+        anweisungs zaehler INCR 1;

+        anweisungs indizes CAT anweisungs index;

+        IF par1 <> ""

+           THEN insert (params1, par1); 

+                params1 zeiger CAT highest entry (params1);

+           ELSE params1 zeiger CAT 0;

+        FI;

+        IF par2 <> ""

+           THEN insert (params2, par2); 

+                params2 zeiger CAT highest entry (params2);

+           ELSE params2 zeiger CAT 0;

+        FI;

+ 

+END PROC analysiere anweisung;

+ 

+ 

+PROC stelle neuen font ein (INT CONST font nr ) :

+

+  IF font nr <> a font THEN neuer font FI;

+ 

+  . neuer font :

+      a font := max (1, font nr);

+      get font (a font, einrueckbreite, font durchschuss, font hoehe, font tiefe,

+                zeichenbreiten);

+      font hoehe INCR (font durchschuss + font tiefe);

+      letzte zeilenhoehe                         := neue zeilenhoehe;

+      blankbreite                                := zeichenbreiten (blank code 1);

+      zeichenbreiten (blank code 1)              := blank ausgang;

+      zeichenbreiten (anweisungs zeichen code 1) := anweisungs ausgang;

+      font offsets                               := y offsets (a font);

+      offsets                                    := LENGTH font offsets > 2;

+      IF d code 1 <> leer

+         THEN d pitch                            := zeichenbreiten (d code 1);

+              zeichenbreiten (d code 1)          := d code ausgang;

+     FI;

+ 

+END PROC stelle neuen font ein;

+ 

+ 

+INT OP PROZENT (INT CONST prozent, wert) :

+ 

+    (wert * prozent + 99) DIV 100

+ 

+END OP PROZENT; 

+ 

+ 

+PROC neue markierung (TEXT CONST text, INT CONST mark index) :

+ 

+      mark token (mark index). text           := text;

+      mark token (mark index). breite         := string breite (text);

+      mark token (mark index). font           := a font;

+      mark token (mark index). modifikationen := a modifikationen;

+ 

+END PROC neue markierung;

+ 

+ 

+INT PROC string breite (TEXT CONST string) :

+ 

+    INT VAR summe := 0, pos := 1;

+    REP stranalyze (zeichenbreiten, summe, max breite, string, pos, maxint, ausgang);

+        IF   ausgang = erweiterungs ausgang

+             THEN summe INCR extended char pitch (a font,

+                                       string SUB pos+1, string SUB pos+2);

+                  pos INCR 3;

+        ELIF ausgang = blank ausgang

+             THEN summe INCR blankbreite;

+                  pos INCR 2;

+        ELIF ausgang = anweisungs ausgang

+             THEN summe INCR char pitch (a font, anweisungszeichen);

+                  pos INCR 2;

+             ELSE LEAVE string breite WITH summe

+        FI;

+    PER;

+    0

+ 

+END PROC string breite;

+ 

+(*******************************************************************)

+ 

+PROC lege text token an :

+ 

+  aktuelle ypos := a ypos + (font offsets ISUB 1); 

+  neuer token index;

+  uebertrage text token (tf);

+  IF offsets THEN lege offsets an (font offsets) FI;

+  stranalyze (zeichen zaehler, anzahl zeichen, max int,

+              zeile, token zeiger, zeilen pos - 1, ausgang);

+  a xpos                       INCR a breite;

+  a breite                     := 0;

+  a modifikationen fuer x move := 0;

+  a block token                := FALSE;

+ 

+END PROC lege text token an;

+ 

+ 

+PROC uebertrage text token (TOKEN VAR tf) :

+ 

+  tf. text                       := subtext (zeile, token zeiger, zeilenpos - 1);

+  tf. xpos                       := a xpos;

+  tf. breite                     := a breite;

+  tf. font                       := a font;

+  tf. modifikationen             := a modifikationen;

+  tf. modifikationen fuer x move := a modifikationen fuer x move;

+  tf. offset index               := text token;

+  tf. block token                := a block token;

+

+END PROC uebertrage text token;

+ 

+ 

+PROC lege kommando token an :

+ 

+  aktuelle ypos := a ypos + (font offsets ISUB 1); 

+  neuer token index;

+  uebertrage kommando token (tf);

+  a modifikationen fuer x move := 0;

+  a block token                := FALSE;

+ 

+END PROC lege kommando token an;

+ 

+ 

+PROC uebertrage kommando token (TOKEN VAR tf) :

+ 

+  tf. text                       := anweisung;

+  tf. breite                     := 0;

+  tf. xpos                       := a xpos;

+  tf. font                       := a font;

+  tf. modifikationen             := a modifikationen;

+  tf. modifikationen fuer x move := a modifikationen fuer x move;

+  tf. offset index               := kommando token;

+  tf. block token                := a block token;

+ 

+END PROC uebertrage kommando token;

+ 

+ 

+PROC lege markierungs token an (INT CONST mark index) :

+ 

+  aktuelle ypos := a ypos + (mark font offsets ISUB 1); 

+  neuer token index;

+  tf := mark token (mark index);

+  IF mark offsets THEN lege offsets an (mark font offsets) FI;

+ 

+  . mark font offsets   : y offsets (mark token (mark index). font)

+ 

+  . mark offsets        : LENGTH mark font offsets > 2

+ 

+END PROC lege markierungs token an;

+ 

+ 

+PROC lege offsets an (TEXT CONST offsets) :

+ 

+  INT CONST anzahl offsets := LENGTH offsets DIV 2;

+  offset token := tf;

+  offset token. block token := FALSE;

+  reset bit (offset token. modifikationen, underline bit);

+  FOR index FROM 2 UPTO anzahl offsets

+  REP aktuelle ypos := a ypos + (offsets ISUB index); 

+      neuer token index;

+      tf               := offset token;

+      tf. offset index := index;

+  PER;

+ 

+END PROC lege offsets an;

+ 

+ 

+PROC neuer token index :

+ 

+IF   erster ypos index a = 0

+     THEN erste ypos

+ELIF ya. ypos = aktuelle ypos 

+     THEN neues token bei gleicher ypos

+     ELSE fuege neue ypos ein

+FI;

+ 

+  . erste ypos :

+      ypos  index f INCR 1;

+          erster     ypos index a := ypos index f;

+          letzter    ypos index a := ypos index f;

+      yf. vorheriger ypos index   := 0;

+      yf. naechster  ypos index   := 0;

+      erstes token bei neuer ypos;

+ 

+  . fuege neue ypos ein :

+      letztes token bei gleicher ypos;

+      IF ya. ypos > aktuelle ypos

+         THEN richtige ypos ist oberhalb

+         ELSE richtige ypos ist unterhalb

+      FI;

+ 

+      . richtige ypos ist oberhalb :

+          REP ypos index a := ya. vorheriger ypos index;

+              IF   ypos index a = 0

+                   THEN fuege ypos vor erstem ypos index ein;

+                        LEAVE richtige ypos ist oberhalb;

+              ELIF ya. ypos = aktuelle ypos

+                   THEN neues token bei neuer ypos;

+                        LEAVE richtige ypos ist oberhalb;

+              ELIF ya. ypos < aktuelle ypos

+                   THEN fuege ypos nach ypos index ein;

+                        LEAVE richtige ypos ist oberhalb;

+              FI;

+          PER;

+ 

+      . richtige ypos ist unterhalb :

+          REP ypos index a := ya. naechster ypos index;

+              IF   ypos index a = 0

+                   THEN fuege ypos nach letztem ypos index ein;

+                        LEAVE richtige ypos ist unterhalb;

+              ELIF ya. ypos = aktuelle ypos

+                   THEN neues token bei neuer ypos;

+                        LEAVE richtige ypos ist unterhalb;

+              ELIF ya. ypos > aktuelle ypos 

+                   THEN fuege ypos vor ypos index ein;

+                        LEAVE richtige ypos ist unterhalb;

+              FI;

+          PER;

+ 

+          . fuege ypos vor erstem ypos index ein :

+              ypos  index f INCR 1;

+              yf. vorheriger ypos index   := 0;

+              yf. naechster  ypos index   :=     erster    ypos index a;

+                  erster     ypos index a :=               ypos index f;

+                             ypos index a := yf. naechster ypos index;

+              ya. vorheriger ypos index   :=               ypos index f;

+              erstes token bei neuer ypos;

+ 

+          . fuege ypos nach ypos index ein :

+              ypos  index f INCR 1;

+              yf. vorheriger ypos index   :=               ypos index a;

+              yf. naechster  ypos index   := ya. naechster ypos index;

+              ya. naechster  ypos index   :=               ypos index f;

+                             ypos index a := yf. naechster ypos index;

+              ya. vorheriger ypos index   :=               ypos index f;

+              erstes token bei neuer ypos;

+ 

+          . fuege ypos vor ypos index ein :

+              ypos  index f INCR 1;

+              yf. naechster  ypos index   :=                ypos index a;

+              yf. vorheriger ypos index   := ya. vorheriger ypos index;

+              ya. vorheriger ypos index   :=                ypos index f;

+                             ypos index a := yf. vorheriger ypos index;

+              ya. naechster  ypos index   :=                ypos index f;

+              erstes token bei neuer ypos;

+ 

+          . fuege ypos nach letztem ypos index ein :

+              ypos  index f INCR 1;

+              yf. naechster  ypos index   := 0;

+              yf. vorheriger ypos index   :=     letzter    ypos index a;

+                  letzter    ypos index a :=                ypos index f;

+                             ypos index a := yf. vorheriger ypos index;

+              ya. naechster  ypos index   :=                ypos index f;

+              erstes token bei neuer ypos;

+ 

+END PROC neuer token index;

+ 

+

+PROC erstes token bei neuer ypos :

+     token index f INCR 1;

+                 ypos index a := ypos index f;

+     ya. erster token index   := token index f; 

+     ya. ypos                 := aktuelle ypos;

+END PROC erstes token bei neuer ypos;

+ 

+ 

+PROC neues token bei neuer ypos :

+     token index f INCR 1;

+     ya. ypos                 := aktuelle ypos;

+                  token index := ya. letzter token index;

+     t. naechster token index := token index f;

+END PROC neues token bei neuer ypos;

+ 

+ 

+PROC neues token bei gleicher ypos :

+     tf. naechster token index := token index f + 1;

+     token index f INCR 1;

+END PROC neues token bei gleicher ypos;

+ 

+ 

+PROC letztes token bei gleicher ypos : 

+     tf. naechster token index := 0;

+     ya. letzter   token index := token index f;

+END PROC letztes token bei gleicher ypos;

+ 

+ 

+PROC loesche letztes token :

+ 

+     IF token index f = ya. erster token index 

+        THEN loesche ypos

+        ELSE token index f DECR 1;

+     FI;

+ 

+     . loesche ypos :

+         kette vorgaenger um;

+         kette nachfolger um;

+         bestimme letzten ypos index;

+ 

+         . kette vorgaenger um :

+             ypos index := ya. vorheriger ypos index; 

+             IF ypos index = 0

+                THEN       erster ypos index a := ya. naechster ypos index;

+                ELSE y. naechster ypos index   := ya. naechster ypos index; 

+             FI;

+ 

+         . kette nachfolger um :

+             ypos index := ya. naechster ypos index;

+             IF ypos index = 0

+                THEN       letzter ypos index a := ya. vorheriger ypos index;

+                ELSE y. vorheriger ypos index   := ya. vorheriger ypos index; 

+             FI;

+ 

+         . bestimme letzten ypos index :

+             IF ypos index a = ypos index f THEN ypos index f DECR 1 FI;

+             token index f DECR 1;

+             ypos index a := letzter ypos index a; 

+             WHILE ypos index a <> 0

+                       CAND ya. letzter token index <> token index f

+             REP ypos index a := ya. vorheriger ypos index PER;

+ 

+END PROC loesche letztes token;

+ 

+ 

+PROC blocke token xpos (INT CONST dehnung 1, dehnung 2,

+                                  anzahl dehnungen fuer dehnung 1 ) :

+

+  INT VAR dehnung := 0, anzahl dehnungen := 0;

+  token index := erstes tab token;

+  WHILE token index <= token index f

+  REP erhoehe token xpos bei block token;

+      t. xpos INCR dehnung;

+      token index INCR 1; 

+  PER;

+ 

+  . erhoehe token xpos bei block token :

+      IF t. block token

+         THEN IF anzahl dehnungen < anzahl dehnungen fuer dehnung 1

+                 THEN anzahl dehnungen INCR 1;

+                      dehnung INCR dehnung 1;

+                 ELSE dehnung INCR dehnung 2;

+              FI;

+      FI;

+ 

+END PROC blocke token xpos;

+ 

+ 

+PROC verschiebe token xpos (INT CONST verschiebung) :

+ 

+  token index := erstes tab token;

+  WHILE token index <= token index f

+  REP t. xpos INCR verschiebung;

+      token index INCR 1; 

+  PER;

+ 

+END PROC verschiebe token xpos;

+ 

+ 

+PROC verschiebe token ypos (INT CONST verschiebung) :

+ 

+  ypos index := erster ypos index a;

+  WHILE ypos index <> 0

+  REP y. ypos INCR verschiebung; 

+      ypos index := y. naechster ypos index;

+  PER;

+ 

+END PROC verschiebe token ypos;

+ 

+ 

+PROC sortiere neue token ein :

+ 

+IF analysespeicher ist nicht leer

+   THEN IF druckspeicher ist nicht leer

+           THEN sortiere neue token in sortierte liste ein

+           ELSE sortierte liste ist leer

+        FI;

+FI;

+

+. sortierte liste ist leer :

+    IF erster ypos index a <> 0

+       THEN erster  ypos index d := erster  ypos index a;

+            letzter ypos index d := letzter ypos index a;

+                    ypos index d := letzter ypos index a;

+    FI;

+ 

+. sortiere neue token in sortierte liste ein :

+    gehe zum ersten neuen token;

+    bestimme erste einsortierposition;

+    WHILE es gibt noch neue token

+    REP IF   ypos index d = 0

+             THEN haenge neue token ans ende der sortierten liste 

+        ELIF ya. ypos > yd. ypos

+             THEN naechste ypos der sortierten liste

+        ELIF ya. ypos = yd. ypos

+             THEN neues token auf gleicher ypos

+             ELSE neue token vor ypos

+        FI; 

+    PER;

+ 

+    . gehe zum ersten neuen token :

+        ypos index a := erster ypos index a;

+ 

+    . bestimme erste einsortierposition :

+        WHILE ypos index d <> 0  CAND  ya. ypos < yd. ypos

+          REP ypos index d := yd. vorheriger ypos index PER;

+        IF ypos index d = 0 THEN erste neue token vor listen anfang FI;

+ 

+        . erste neue token vor listen anfang :

+                   ypos index d := erster ypos index d;

+            erster ypos index d := erster ypos index a;

+            REP ypos index a := ya. naechster ypos index;

+                IF   ypos index a = 0

+                     THEN verkette letztes ya mit yd;

+                          LEAVE sortiere neue token in sortierte liste ein

+                ELIF ya. ypos = yd. ypos

+                     THEN verkette ya mit yd;

+                          LEAVE erste neue token vor listen anfang

+                ELIF ya. ypos > yd. ypos

+                     THEN verkette vorheriges ya mit yd;

+                          ypos index d := yd. naechster ypos index;

+                          LEAVE erste neue token vor listen anfang

+                FI;

+            PER;

+ 

+    . es gibt noch neue token :

+        ypos index a <> 0

+ 

+    . haenge neue token ans ende der sortierten liste : 

+                       ypos index d := letzter ypos index d;

+        yd. naechster  ypos index   :=         ypos index a;

+        ya. vorheriger ypos index   :=         ypos index d;

+            letzter    ypos index d := letzter ypos index a;

+                       ypos index d := letzter ypos index a;

+                       ypos index a := 0;

+ 

+    . naechste ypos der sortierten liste :

+        ypos index d := yd. naechster ypos index;

+ 

+    . neues token auf gleicher ypos :

+                      token index   := yd. letzter   token index;

+        t . naechster token index   := ya. erster    token index;

+        yd. letzter   token index   := ya. letzter   token index;

+                      ypos  index a := ya. naechster ypos  index;

+                      ypos  index d := yd. naechster ypos  index;

+        IF ypos index d = 0 THEN ypos index d := letzter ypos index d FI;

+ 

+    . neue token vor ypos :

+        verkette ya mit vorherigem yd;

+        REP ypos index a := ya. naechster ypos index;

+            IF   ypos index a = 0

+                 THEN verkette letztes ya mit yd;

+                      LEAVE sortiere neue token in sortierte liste ein

+            ELIF ya. ypos = yd. ypos

+                 THEN verkette ya mit yd;

+                      LEAVE neue token vor ypos

+            ELIF ya. ypos > yd. ypos 

+                 THEN verkette vorheriges ya mit yd;

+                      ypos index d := yd. naechster ypos index;

+                      LEAVE neue token vor ypos

+            FI;

+        PER;

+

+ 

+. verkette ya mit vorherigem yd :

+                        index   := ypos index d;

+                   ypos index d := yd. vorheriger ypos index; 

+    yd. naechster  ypos index   :=                ypos index a;

+    ya. vorheriger ypos index   :=                ypos index d;

+                   ypos index d := index;

+ 

+. verkette letztes ya mit yd :

+                   ypos index a := letzter ypos index a;

+    yd. vorheriger ypos index   :=         ypos index a;

+    ya. naechster  ypos index   :=         ypos index d;

+                   ypos index a := 0;

+ 

+. verkette vorheriges ya mit yd :

+                        index   := ypos index a;

+                   ypos index a := ya. vorheriger ypos index; 

+    yd. vorheriger ypos index   :=         ypos index a;

+    ya. naechster  ypos index   :=         ypos index d;

+                   ypos index a := index;

+ 

+. verkette ya mit yd :

+    verkette vorheriges ya mit yd;

+    neues token auf gleicher ypos;

+ 

+END PROC sortiere neue token ein;

+ 

+(***************************************************************)

+ 

+PROC drucke tokenspeicher

+             (INT CONST max ypos,

+              PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+IF druckspeicher ist nicht leer

+   THEN gehe zur ersten ypos; 

+        WHILE yd. ypos <= max ypos 

+        REP drucke token bei ypos;

+            gehe zur naechsten ypos; 

+        PER;

+        loesche gedruckte token;

+FI;

+ 

+. gehe zur ersten ypos :

+    ypos index d := erster ypos index d;

+

+. drucke token bei ypos :

+    IF yd. ypos >= - y start

+       THEN druck durchgang;

+            IF bold      pass THEN fett         durchgang FI;

+            IF underline pass THEN unterstreich durchgang FI;

+    FI;

+ 

+    . bold      pass : bit (pass, bold bit)

+ 

+    . underline pass : bit (pass, underline bit)

+ 

+. gehe zur naechsten ypos : 

+    IF ypos index d = letzter ypos index d

+       THEN loesche druckspeicher;

+            LEAVE drucke tokenspeicher;

+    FI;

+    ypos index d := yd. naechster ypos index;

+ 

+. loesche gedruckte token :

+        erster     ypos index d := ypos index d;

+    yd. vorheriger ypos index   := 0;

+ 

+. 

+  druck durchgang :

+    verschiebung := yd. ypos - d ypos;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    gehe zum ersten token dieser ypos; 

+    REP drucke token UNTIL kein token mehr vorhanden PER;

+    gib cr aus;

+ 

+    . drucke token :

+        IF NOT token passt in zeile THEN berechne token teil FI;

+        font wechsel wenn noetig;

+        x move mit modifikations ueberpruefung; 

+        IF token ist text token

+           THEN gib text token aus

+                  (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+           ELSE gib kommando token aus

+        FI;

+ 

+    . gib kommando token aus :

+        execute (write cmd, d token. text, 1, LENGTH d token. text)

+ 

+        . berechne token teil :

+            INT CONST fuenf punkte := 5 * char pitch (d token. font, punkt);

+            INT VAR token pos, token breite, anzahl punkte, zeichen laenge, zeichen breite; 

+            IF   d token. xpos < - x start

+                   AND d token. xpos + d token. breite > - x start 

+                 THEN berechne token teil von links

+            ELIF d token. xpos < papierbreite

+                   AND d token. xpos + d token. breite > papierbreite

+                 THEN berechne token teil nach rechts

+                 ELSE LEAVE drucke token

+            FI;

+ 

+        . berechne token teil von links :

+            rest          := min (x size, d token. xpos + d token. breite + x start);

+            d token. xpos := - x start;

+            IF rest <= fuenf punkte 

+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);

+                    d token. text   := anzahl punkte * punkt;

+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);

+               ELSE token pos    := LENGTH d token. text + 1;

+                    token breite := fuenf punkte;

+                    berechne token teil breite von hinten;

+                    change (d token. text, 1, token pos - 1, 5 * punkt);

+                    d token. breite := token breite;

+            FI;

+ 

+            . berechne token teil breite von hinten :

+                WHILE naechstes zeichen passt noch davor

+                REP token breite INCR zeichen breite; 

+                    token pos    DECR zeichen laenge;

+                PER;

+ 

+            . naechstes zeichen passt noch davor :

+                IF within kanji (d token. text, token pos - 1) 

+                   THEN zeichen laenge := 2

+                   ELSE zeichen laenge := 1

+                FI;

+                zeichen breite := char pitch (d token. font,

+                    subtext (d token. text, token pos - zeichen laenge, token pos - 1));

+                token breite + zeichen breite < rest

+ 

+        . berechne token teil nach rechts :

+            rest := papier breite - d token. xpos;

+            IF rest <= fuenf punkte 

+               THEN anzahl punkte   := rest DIV char pitch (d token. font, punkt);

+                    d token. text   := anzahl punkte * punkt;

+                    d token. breite := anzahl punkte * char pitch (d token. font, punkt);

+               ELSE token pos    := 0;

+                    token breite := fuenf punkte;

+                    berechne token teil breite von vorne;

+                    change (d token. text, token pos + 1, LENGTH d token. text, 5 * punkt);

+                    d token. breite := token breite;

+            FI;

+ 

+            . berechne token teil breite von vorne :

+                WHILE naechstes zeichen passt noch dahinter

+                REP token breite INCR zeichen breite; 

+                    token pos    INCR zeichen laenge;

+                PER;

+ 

+            . naechstes zeichen passt noch dahinter :

+                IF is kanji esc (d token. text SUB token pos + 1) 

+                   THEN zeichen laenge := 2

+                   ELSE zeichen laenge := 1

+                FI;

+                zeichen breite := char pitch (d token. font,

+                    subtext (d token. text, token pos + 1, token pos + zeichen laenge));

+                token breite + zeichen breite < rest

+ 

+.

+  fett durchgang :

+    reset bit (pass, bold bit);

+    gehe zum ersten token dieser ypos;

+    REP gib token nochmal aus UNTIL kein token mehr vorhanden PER;

+    schalte modifikationen aus wenn noetig;

+    gib cr aus;

+ 

+    . gib token nochmal aus :

+        INT CONST min verschiebung := bold offset (d token. font); 

+        d token. xpos INCR min verschiebung;

+        IF bit (d token. modifikationen, bold bit) AND

+               token passt in zeile AND token ist text token 

+          THEN verschiebung := d token. xpos - d xpos;

+               font wechsel wenn noetig;

+               schalte italics ein wenn noetig;

+               x move wenn noetig;

+               gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+        FI;

+        d token. xpos DECR min verschiebung;

+ 

+        . schalte italics ein wenn noetig :

+            IF bit (d token. modifikationen, italics bit)

+               THEN neue modifikationen := modifikations werte (italics bit + 1);

+                    schalte modifikationen ein wenn noetig;

+               ELSE schalte modifikationen aus wenn noetig;

+            FI;

+ 

+. 

+  unterstreich durchgang :

+    INT VAR l xpos := 0;

+    reset bit (pass, underline bit);

+    schalte modifikationen aus wenn noetig;

+    gehe zum ersten token dieser ypos;

+    REP unterstreiche token UNTIL kein token mehr vorhanden PER;

+    gib cr aus;

+ 

+    . unterstreiche token :

+        IF token muss unterstrichen werden AND

+                token passt in zeile AND token ist text token 

+           THEN font wechsel wenn noetig;

+                berechne x move laenge; 

+                x move wenn noetig;

+                berechne unterstreich laenge;

+                unterstreiche;

+         FI;

+         l xpos := d token. xpos + d token. breite;

+ 

+         . token muss unterstrichen werden :

+             bit (d token. modifikationen, underline bit) OR

+                bit (d token. modifikationen fuer x move, underline bit)

+ 

+         . berechne x move laenge :

+             IF bit (d token. modifikationen fuer x move, underline bit) 

+                THEN verschiebung := l  xpos - d xpos

+                ELSE verschiebung := d token. xpos - d xpos

+             FI;

+

+         . berechne unterstreich laenge :

+             INT VAR unterstreich verschiebung;

+             IF bit (d token. modifikationen, underline bit) 

+                THEN unterstreich verschiebung := d token. xpos + 

+                                                d token. breite - d xpos

+                ELSE unterstreich verschiebung := d token. xpos - d xpos

+             FI;

+ 

+ 

+. gehe zum ersten token dieser ypos :

+    token index := yd. erster token index;

+    d token := t;

+ 

+. kein token mehr vorhanden :

+    token index := d token. naechster token  index;

+    IF token index = 0

+       THEN TRUE

+       ELSE d token := t;

+            FALSE

+    FI

+ 

+. token ist text token :

+    d token. offset index >= text token

+ 

+. token passt in zeile :

+    d token. xpos >= - x start AND

+         d token. xpos + d token. breite <= papier breite 

+ 

+. font wechsel wenn noetig :

+    IF d token. font <>  d font

+       THEN font wechsel (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;

+ 

+. schalte modifikationen ein wenn noetig :

+    IF d modifikationen <> neue modifikationen

+       THEN schalte modifikationen ein (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;

+ 

+. schalte modifikationen aus wenn noetig :

+    IF d modifikationen <> 0

+       THEN schalte modifikationen aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI;

+

+. x move wenn noetig :

+    IF verschiebung <> 0

+       THEN x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; 

+ 

+. gib cr aus :

+    execute (carriage return, "", d xpos, 0);

+    d xpos := 0;

+ 

+. 

+  x move mit modifikations ueberpruefung :

+    verschiebung := d token. xpos - d xpos;

+    IF verschiebung <> 0

+       THEN neue modifikationen := d token. modifikationen fuer x move;

+            schalte modifikationen ein wenn noetig;

+            x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    FI;

+    neue modifikationen := d token. modifikationen;

+    schalte modifikationen ein wenn noetig;

+ 

+. 

+  unterstreiche :

+    IF unterstreich verschiebung > 0

+       THEN disable stop; 

+            d xpos INCR unterstreich verschiebung;

+            execute (draw, "", unterstreich verschiebung, 0);

+            IF is error

+               THEN unterstreiche nach cr;

+            FI;

+            enable stop;

+    FI;

+ 

+    . unterstreiche nach cr :

+        clear error;

+        d xpos DECR unterstreich verschiebung;

+        verschiebung := d xpos;

+        gib cr aus;

+        x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+        d xpos INCR unterstreich verschiebung;

+        execute (draw, "", unterstreich verschiebung, 0);

+        IF is error

+           THEN clear error; 

+                d xpos DECR unterstreich verschiebung;

+                gib cr aus;

+                LEAVE unterstreich durchgang;

+        FI;

+

+END PROC drucke tokenspeicher;

+ 

+PROC y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+    IF verschiebung <> 0

+       THEN disable stop; 

+            d ypos INCR verschiebung;

+            execute (move, "", 0, verschiebung);

+            IF is error

+               THEN clear error;

+                    d ypos DECR verschiebung;

+                    verschiebung := 0;

+            FI;

+            enable stop;

+    FI;

+ 

+END PROC y move;

+ 

+

+PROC x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+    disable stop;

+    d xpos INCR verschiebung; 

+    execute (move, "", verschiebung, 0);

+    IF is error

+       THEN fuehre x move nach cr aus

+    FI;

+ 

+    . fuehre x move nach cr aus :

+        clear error;

+        schalte modifikationen aus wenn noetig;

+        gib cr aus;

+        IF d xpos <> 0

+           THEN execute (move, "", d xpos, 0);

+                IF is error

+                   THEN clear error;

+                        d xpos := 0;

+                FI

+        FI;

+        schalte modifikationen ein wenn noetig;

+ 

+        . gib cr aus :

+            execute (carriage return,  "", d xpos - verschiebung, 0);

+ 

+        . schalte modifikationen aus wenn noetig :

+            neue modifikationen := d modifikationen;

+            IF d modifikationen <> 0

+               THEN schalte modifikationen aus

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+            FI;

+ 

+        . schalte modifikationen ein wenn noetig :

+            IF d modifikationen <> neue modifikationen

+               THEN schalte modifikationen ein

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+            FI;

+ 

+END PROC x move;

+ 

+ 

+PROC schalte modifikationen ein 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+     disable stop;

+     INT VAR index;

+     IF d modifikationen <> 0

+        THEN schalte modifikationen aus

+               (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+     FI;

+     d modifikationen := neue modifikationen;

+     FOR index FROM 1 UPTO anzahl modifikationen

+     REP IF bit (d modifikationen, modifikations bit)

+            THEN modifikation muss eingeschaltet werden

+         FI; 

+     PER;

+ 

+     . modifikations bit : index - 1

+ 

+     . modifikation muss eingeschaltet werden :

+         IF bit (modifikations modus, modifikations bit) 

+            THEN execute (on, "", modifikations werte (index), 0);

+                 IF is error

+                    THEN clear error;

+                         reset bit (modifikations modus, modifikations bit); 

+                         set bit   (pass,                modifikations bit);

+                 FI;

+            ELSE set bit (pass, modifikations bit); 

+         FI;

+ 

+END PROC schalte modifikationen ein;

+ 

+ 

+PROC schalte modifikationen aus 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+     disable stop;

+     INT VAR index;

+     FOR index FROM 1 UPTO anzahl modifikationen

+     REP IF bit (d modifikationen, modifikations bit)

+            THEN modifikation muss ausgeschaltet werden

+         FI; 

+     PER;

+     d modifikationen := 0;

+ 

+     . modifikations bit : index - 1

+ 

+     . modifikation muss ausgeschaltet werden :

+         IF bit (modifikations modus, modifikations bit) 

+            THEN execute (off, "", modifikations werte (index), 0);

+                 IF is error THEN clear error FI;

+         FI;

+ 

+END PROC schalte modifikationen aus;

+ 

+ 

+PROC font wechsel 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+     disable stop;

+     d font := d token. font;

+     get replacements (d font, replacements, replacement tabelle);

+     execute (type, "", d font, 0);

+     IF is error THEN font wechsel nach cr FI;

+     enable stop;

+ 

+     . font wechsel nach cr :

+         clear error;

+         verschiebung := d xpos;

+         gib cr aus;

+         execute (type, "", d font, 0);

+         IF NOT is error

+            THEN schalte modifikationen aus

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+                 x move

+                    (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+         FI;

+ 

+        . gib cr aus :

+            execute (carriage return,  "", d xpos, 0);

+            d xpos := 0;

+ 

+END PROC font wechsel;

+ 

+ 

+PROC gib text token aus 

+            (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+  INT CONST token laenge := LENGTH d token. text;

+  INT VAR token pos := 1, alte token pos, summe := 0;

+  IF token laenge > 0

+     THEN REP alte token pos := token pos;

+              stranalyze (replacement tabelle, summe, 0,

+                          d token. text, token pos, token laenge,

+                          ausgang);

+              IF ausgang = 0 

+                 THEN gib token rest aus;

+                 ELSE gib token teil aus;

+                      gib ersatzdarstellung aus;

+              FI;

+          PER;

+  FI;

+ 

+  . gib token rest aus :

+      IF token laenge >= alte token pos

+         THEN execute (write text, d token. text, alte token pos, token laenge) FI;

+      d xpos INCR d token. breite;

+      LEAVE gib text token aus;

+

+  . gib token teil aus :

+      IF token pos >= alte token pos

+         THEN execute (write text, d token. text, alte token pos, token pos) FI;

+ 

+  . gib ersatzdarstellung aus :

+      IF ausgang = maxint

+         THEN ersatzdarstellung := extended replacement (d token. font,

+                d token. text SUB token pos + 1, d token. text SUB token pos + 2);

+              execute (write text, ersatzdarstellung, 1, LENGTH ersatzdarstellung);

+              tokenpos INCR 3;

+         ELSE IF ausgang < 0

+                 THEN ausgang := ausgang XOR (-32767-1);

+                      token pos INCR 1;

+              FI;

+              execute (write text, replacements, ausgang + 1, ausgang + code (replacements SUB ausgang));

+              token pos INCR 2;

+      FI;

+ 

+      . ersatzdarstellung : par1

+ 

+END PROC gib text token aus;

+ 

+ 

+PROC schliesse seite ab (PROC (INT CONST, INT CONST) close,

+                         PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+

+enable stop;

+gebe restliche token aus;

+seiten ende kommando;

+

+. gebe restliche token aus :

+    IF erster ypos index d <> 0

+       THEN drucke tokenspeicher (maxint,

+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    FI;

+    rest := papier laenge - d ypos;

+

+. seiten ende kommando :

+    seite ist offen := FALSE;

+    a ypos          := top margin;

+    aktuelle spalte := 1;

+    close (page, rest);

+ 

+END PROC schliesse seite ab;

+ 

+ 

+PROC eroeffne seite (INT CONST x wanted, y wanted,

+                     PROC (INT CONST, INT VAR, INT VAR) open ) :

+ 

+IF vor erster seite THEN eroeffne druck FI;

+seiten anfang kommando;

+initialisiere neue seite;

+

+. eroeffne druck :

+    open (document, x size, y size);

+    vor erster seite := FALSE;

+    d font           := -1;

+    d modifikationen := 0;

+

+. seiten anfang kommando :

+    x start := x wanted;

+    y start := y wanted;

+    open (page, x start, y start);

+    gedruckte seiten INCR 1;

+    seite ist offen := TRUE;

+

+. initialisiere neue seite :

+    INT CONST dif left margin := x wanted - x start - left margin + indentation,

+              dif top  margin := y wanted - y start - top  margin; 

+    IF dif left margin <> 0

+       THEN erstes tab token := 1;

+            verschiebe token xpos (dif left margin);

+            a xpos      INCR dif left margin;

+            left margin INCR dif left margin;

+    FI;

+    IF dif top margin <> 0

+       THEN verschiebe token ypos (dif top margin);

+            a ypos      INCR dif top margin;

+            top margin  INCR dif top margin;

+    FI;

+    d xpos := 0;

+    d ypos := 0;

+    IF seitenlaenge <= papierlaenge

+       THEN seitenlaenge := top margin + pagelength; 

+       ELSE seitenlaenge DECR papierlaenge;

+    FI;

+    papierlaenge := y size - y start;

+    papierbreite := x size - x start;

+

+END PROC eroeffne seite;

+ 

+(****************************************************************)

+ 

+PROC elan fuss und kopf (INT CONST fuss oder kopf,

+                PROC (INT CONST, INT CONST) close,

+                PROC (INT CONST, INT VAR, INT VAR) open,

+                PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+IF fuss oder kopf <= 0 THEN elan fuss FI;

+IF fuss oder kopf >= 0 THEN elan kopf FI;

+ 

+.

+  elan fuss :

+    y move zur fusszeile;

+    drucke elan fuss;

+    close page cmd;

+ 

+. y move zur fusszeile :

+    execute (carriage return,  "", d xpos, 0);

+    d xpos := 0;

+    verschiebung := rest auf seite - font hoehe;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+. drucke elan fuss :

+    IF bottom label = ""

+       THEN seiten nr := ""

+       ELSE seiten nr := bottom label;

+            seiten nr CAT "/";

+    FI;

+    seiten nr CAT text (gedruckte seiten);

+    elan text := seiten nr;

+    elan text CAT "   ";

+    elan text cat blanks ((max zeichen fuss - LENGTH dateiname) DIV 2 - LENGTH elan text);

+    elan text CAT dateiname;

+    elan text cat blanks (max zeichen fuss - LENGTH seiten nr - LENGTH elan text - 3);

+    elan text CAT "   ";

+    elan text CAT seiten nr;

+    IF LENGTH elan text > max zeichen zeile

+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;

+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+ 

+    . seiten nr : par1

+ 

+. close page cmd :

+    close (page, papierlaenge - d ypos);

+    seite ist offen := FALSE;

+

+.

+  elan kopf :

+    open page cmd ;

+    y move zur kopfzeile;

+    drucke elan kopf;

+

+. open page cmd :

+    x start         := x wanted;

+    y start         := y wanted;

+    open (page, x start, y start);

+    IF fuss oder kopf = 1 THEN execute (type, "", d font, 0) FI;

+    gedruckte seiten INCR 1;

+    seite ist offen := TRUE;

+    top  margin     := y wanted - y start;

+    left margin     := x wanted - x start;

+    rest auf seite  := pagelength;

+    papierlaenge    := y size - y start;

+    d ypos          := 0; 

+    d xpos          := 0;

+ 

+. y move zur kopf zeile :

+    verschiebung := top margin;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+    IF verschiebung = 0 THEN rest auf seite INCR top margin FI;

+ 

+. drucke elan kopf :

+    elan text :=  headline pre;

+    elan text CAT date;

+    elan text CAT headline post;

+    elan text CAT datei name;

+    IF LENGTH elan text > max zeichen zeile

+       THEN elan text := subtext (elan text, 1, max zeichen zeile) FI;

+    gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+    cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); 

+ 

+ENDPROC elan fuss und kopf;

+ 

+ 

+PROC gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) :

+ 

+cr plus lf (1, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+linker rand wenn noetig;

+d token. breite := LENGTH elan text * einrueckbreite;

+gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+. linker rand wenn noetig :

+    IF left margin > 0

+       THEN disable stop;

+            d xpos := left margin;

+            execute (move, "", left margin, 0);

+            IF is error 

+               THEN clear error;

+                    d xpos := 0;

+            FI;

+            enable stop;

+    FI;

+ 

+END PROC gib elan text aus;

+ 

+ 

+PROC cr plus lf (INT CONST anzahl,

+                 PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : 

+ 

+gib cr aus;

+gib lf aus;

+rest auf seite DECR verschiebung;

+ 

+. gib cr aus :

+    execute (carriage return,  "", d xpos, 0);

+    d xpos := 0;

+ 

+. gib lf aus :

+    verschiebung := anzahl * font hoehe;

+    y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);

+ 

+END PROC cr plus lf ; 

+ 

+ 

+END PACKET eumel printer;

diff --git a/system/std.zusatz/1.7.5/src/font convertor 9 b/system/std.zusatz/1.7.5/src/font convertor 9
new file mode 100644
index 0000000..22ce9af
--- /dev/null
+++ b/system/std.zusatz/1.7.5/src/font convertor 9
@@ -0,0 +1,1065 @@
+PACKET font convertor                             (* Autor : Rudolf Ruland *) 

+                                                  (* Stand : 11.07.86      *)

+        DEFINES create font table ,               (* Version 9             *)

+                add fonts,

+                create font file :

+

+ 

+LET t tag                         =  1,

+    t bold                        =  2,

+    t number                      =  3,

+    t text                        =  4,

+    t operator                    =  5,

+    t delimiter                   =  6,

+    t end of file                 =  7,

+ 

+    nil modus                     =  0,

+    font table modus              =  1,

+    font modus                    =  2,

+    extension modus               =  3,

+ 

+    x unit                        =  1,

+    y unit                        =  2,

+    on string                     =  3,

+    off string                    =  4,

+    indentation pitch             =  5,

+    font lead                     =  6,

+    font height                   =  7,

+    font depth                    =  8,

+    larger font                   =  9,

+    smaller font                  = 10,

+    font string                   = 11,

+    y off sets                    = 12,

+    bold off set                  = 13;

+ 

+THESAURUS VAR names, english identification := empty thesaurus,

+                     german  identification := empty thesaurus;

+ 

+insert (english identification, "xunit");

+insert (english identification, "yunit");

+insert (english identification, "onstring");

+insert (english identification, "offstring");

+insert (english identification, "indentationpitch");

+insert (english identification, "fontlead");

+insert (english identification, "fontheight");

+insert (english identification, "fontdepth");

+insert (english identification, "nextlargerfont");

+insert (english identification, "nextsmallerfont");

+insert (english identification, "fontstring");

+insert (english identification, "yoffsets");

+insert (english identification, "boldoffset");

+ 

+insert (german identification, "xeinheit");

+insert (german identification, "yeinheit");

+insert (german identification, "onsequenz");

+insert (german identification, "offsequenz");

+insert (german identification, "einrueckbreite");

+insert (german identification, "durchschuss");

+insert (german identification, "fonthoehe");

+insert (german identification, "fonttiefe");

+insert (german identification, "groessererfont");

+insert (german identification, "kleinererfont");

+insert (german identification, "fontsequenz");

+insert (german identification, "yverschiebungen");

+insert (german identification, "boldverschiebung");

+

+INT VAR modus, last modus, symbol type, int symbol, pitch,

+        identification nr, link nr, extension code 1,

+        char code 1, char code, char pos, vorzeichen,

+        replacements length, index;

+TEXT VAR symbol, font table name, replacement, char, buffer, z;

+BOOL VAR english;

+FILE VAR file, font file;

+ 

+(*****************************************************************) 

+ 

+LET max fonts       = 50,

+    max extensions  = 120, 

+    font table type = 3009,

+ 

+    FONTTABLE = STRUCT (

+ 

+        THESAURUS font names, 

+ 

+        TEXT replacements, font name links,

+             extension chars, extension indexes, 

+

+        ROW 4 TEXT on strings, off strings,

+ 

+        REAL x unit, y unit,

+ 

+        ROW 256 INT replacements table,

+ 

+        INT last font, last extension

+ 

+        ROW max fonts STRUCT (

+            TEXT font string, font name indexes, replacements,

+                 extension chars, extension indexes, y offsets,

+            ROW 256 INT pitch table, replacements table,

+            INT  indentation pitch, font lead, font height, font depth,

+                 next larger font, next smaller font, bold offset ) fonts ,

+ 

+        ROW max extensions STRUCT (

+            TEXT replacements,

+            ROW 256 INT pitch table, replacements table,

+            INT std pitch                                        ) extensions ,

+ 

+                        );

+ 

+BOUND FONTTABLE VAR font table;

+ 

+DATASPACE VAR ds;

+ 

+INT VAR font nr, extension nr;

+ 

+. font      : font table. fonts (font nr)

+. extension : font table. extensions (extension nr)

+. line nr   : line no (file) - 1

+.;

+ 

+(*****************************************************************) 

+ 

+ 

+PROC create font table :

+ 

+     create font table  (last param)

+ 

+END PROC create font table;

+

+ 

+PROC create font table (TEXT CONST font file) :

+ 

+file := sequential file (input, font file);

+disable stop;

+ds    := nilspace;

+modus := nil modus;

+load;

+IF is error THEN error (errormessage) FI;

+forget (ds);

+ 

+END PROC create font table;

+

+

+PROC add fonts (TEXT CONST font tab name, font file) :

+ 

+file := sequential file (input, font file);

+font table name := font tab name;

+change all (font table name, " ", "");

+IF NOT exists (font table name) COR type (old (font table name)) <> font table type

+   THEN errorstop ("Fonttabelle """ + font table name + """ gibt es nicht")

+FI;

+disable stop;

+ds           := old (font table name);

+fonttable    := ds;

+modus        := font modus;

+font nr      := fonttable. last font;

+extension nr := fonttable. last extension;

+load;

+IF is error THEN error (errormessage) FI;

+forget (ds);

+

+END PROC add fonts;

+

+ 

+PROC load :

+ 

+enable stop;

+initialize loading;

+REP get kennung; 

+    get identification;

+    get char specifications;

+UNTIL eof (file) OR symbol type = t end of file PER;

+font table found;

+ 

+. initialize loading :

+    scan (file);

+    get next symbol;

+ 

+. font table found :

+    IF font nr = 0

+       THEN errorstop ("Fonts zur Fonttabelle """

+                        + font table name + """ fehlen"); 

+       ELSE font table. last font      := font nr; 

+            font table. last extension := extension nr; 

+            forget (font table name, quiet);

+            copy (ds, font table name);

+            type (old (font table name), font table type);

+            forget (ds); ds := nilspace;

+    FI; 

+ 

+. get next symbol :

+    next symbol (file, symbol, symbol type);

+ 

+. get semicolon :

+    get next symbol;

+    IF symbol <> ";" OR symbol type <> t delimiter 

+       THEN errorstop ("';' erwartet") FI;

+ 

+.

+  get kennung :

+    cout (line nr);

+    IF symbol type <> t bold 

+       THEN errorstop ("Kennung erwartet") FI;

+    IF   symbol = "FONTTABLE" OR symbol = "FONTTABELLE" 

+      THEN initialize font table;

+           get font table name;

+    ELIF symbol = "FONT"

+      THEN initialize font;

+           get font names;

+    ELIF symbol = "EXTENSION" OR symbol = "ERWEITERUNG" 

+      THEN get extension char;

+           initialize extension;

+    ELIF modus = nil modus

+      THEN errorstop ("Kennung 'FONTTABLE' oder 'FONTTABELLE' zu Beginn der Datei erwartet") 

+      ELSE errorstop ("unzulaessige Kennung")

+    FI;

+ 

+    . initialize font table :

+        IF modus <> nil modus THEN font table found FI;

+        modus                          := font table modus;

+        font nr                        := 0;

+        extension nr                   := 0;

+        font table                     := ds;

+        font table. font names         := empty thesaurus; 

+        font table. replacements       := "";

+        font table. font name links    := "";

+        font table. extension chars    := "";

+        font table. extension indexes  := ""; 

+        font table. x unit             := 10.0/2.54;

+        font table. y unit             :=  6.0/2.54;

+        font table. replacements table := 0;

+        FOR index FROM 1 UPTO 4

+        REP font table. on  strings (index) := "";

+            font table. off strings (index) := "";

+        PER;

+ 

+    . get font table name :

+        get name list;

+        symbol type := t text;

+        symbol      := name (names, 1);

+        IF exists (symbol)

+           THEN  forget (symbol);

+                 IF exists (symbol)

+                    THEN errorstop ("Fonttabelle existiert schon") FI;

+        FI;

+        font table name := symbol;

+ 

+    . initialize font :

+        IF font nr = max fonts

+           THEN errorstop ("zu viele Fonts") FI;

+        font nr INCR 1;

+        modus                    := font modus;

+        replacements length      := LENGTH font table. replacements; 

+        font. font string        := "";

+        font. font name indexes  := "";

+        font. replacements       := "";

+        font. extension chars    := "";

+        font. extension indexes  := "";

+        font. y offsets          := ""0""0"";

+        font. indentation pitch  := int (font table. x unit * 2.54 / 10.0);

+        font. font lead          := 0;

+        font. font height        := int (font table. y unit * 2.54 / 6.0); 

+        font. font depth         := 0;

+        font. next larger  font  := 0;

+        font. next smaller font  := 0;

+        font. bold offset        := 0;

+        font. pitch table        := font. indentation pitch;

+        font. replacements table := font table. replacements table;

+        FOR index FROM 1 UPTO LENGTH font table. extension chars

+        REP font. replacements table 

+              ( code (font table. extension chars SUB index) + 1 ) := maxint;

+        PER;

+ 

+    . get font names :

+        get name list;

+        index := 0;

+        symbol type := t text;

+        WHILE next font name

+        REP link nr := link (font table. font names, symbol);

+            IF link nr = 0

+               THEN insert (font table. font names, symbol, link nr); 

+                    font table. font name links CAT font nr;

+            ELIF (font table. font name links ISUB link nr) = 0

+               THEN replace (font table. font name links, link nr, font nr);

+               ELSE errorstop ("Font existiert in Fonttabelle """

+                                + font table name + """ schon")

+            FI;

+            font. font name indexes CAT link nr;

+        PER;

+ 

+        . next font name :

+            get (names, symbol, index);

+            symbol <> ""

+ 

+    . get extension char :

+        get name list;

+        symbol type := t text;

+        symbol      := name (names, 1);

+        IF LENGTH symbol <> 1 

+           THEN errorstop ("nur ein Zeichen bei Erweiterung erlaubt") FI;

+        extension code 1 := code (symbol) + 1;

+        IF NOT is kanji esc (symbol) 

+           THEN errorstop ("ESC-Zeichen erwartet") FI;

+ 

+    . initialize extension :

+        IF NOT two bytes

+           THEN errorstop ("Erweiterungen nur im zwei-Byte-Modus erlaubt") FI;

+        IF extension nr = max extensions

+           THEN errorstop ("zu viele Erweiterungen") FI;

+        extension nr INCR 1;

+        IF modus <> extension modus THEN last modus := modus FI;

+        modus      := extension modus;

+        IF last modus = font table modus

+           THEN initalize font table extension

+           ELSE initalize font extension

+        FI;

+ 

+        . initalize font table extension :

+            IF pos (font table. extension chars, symbol) <> 0

+               THEN errorstop ("Erweiterung wurde schon definiert") FI;

+            extension. replacements        := "";

+            extension. std pitch           := 0;

+            extension. pitch table         := 0;

+            extension. replacements table  := 0;

+            font table. extension chars   CAT symbol;

+            font table. extension indexes CAT extension nr;

+            font table. replacements table (extension code 1) := max int;

+            replacements length            := 0;

+ 

+        . initalize font extension :

+            IF pos (font. extension chars, symbol) <> 0

+               THEN errorstop ("Erweiterung wurde schon definiert") FI;

+            extension. replacements   := "";

+            extension. std pitch      := font. pitch table (extension code 1) XOR (-maxint-1);

+            extension. pitch table    := extension. std pitch;

+            font. extension chars    CAT symbol;

+            font. extension indexes  CAT extension nr;

+            char pos := pos (font table. extension chars, symbol);

+            IF char pos <> 0

+               THEN index := font table. extension indexes ISUB char pos;

+                    extension. replacements table := 

+                          font table. extensions (index). replacements table;

+                    replacements length           :=

+                   LENGTH font table. extensions (index). replacements; 

+                    font. replacements table (extension code 1) := max int;

+               ELSE extension. replacements table := 0;

+                    replacements length           := 0;

+            FI;

+ 

+.

+  get identification :

+    WHILE identification found

+    REP cout (line nr);

+        determine identification link nr;

+        select identification;

+    PER;

+ 

+    . identification found :

+        get next symbol; 

+        symbol type = t tag

+ 

+    . determine identification link nr :

+        identification nr := link (english identification, symbol); 

+        english := TRUE;

+        IF identification nr = 0

+           THEN identification nr := link (german identification, symbol); 

+                english := FALSE;

+                IF identification nr = 0

+                   THEN errorstop ("unzulaesige Identifikation") FI;

+        FI;

+ 

+    . select identification :

+        get next symbol;

+        IF symbol <> "=" OR symbol type <> t operator

+           THEN errorstop ("'=' nach Identifikation fehlt") FI;

+        get next symbol; 

+        SELECT identification nr OF

+          CASE x unit            : x unit found

+          CASE y unit            : y unit found

+          CASE on string         : on string found

+          CASE off string        : off string found

+          CASE indentation pitch : indentation pitch found

+          CASE font lead         : font lead found

+          CASE font height       : font height found

+          CASE font depth        : font depth found

+          CASE larger font       : larger font found

+          CASE smaller font      : smaller font found

+          CASE font string       : font string found

+          CASE y offsets         : y offsets found

+          CASE bold offset       : bold offset found

+        END SELECT;

+ 

+    . x unit found :

+        check modus (font table modus);

+        font table. x unit := real (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("REAL-Denoter nach 'x unit' erwartet") 

+                   ELSE errorstop ("REAL-Denoter nach 'x einheit' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . y unit found :

+        check modus (font table modus);

+        font table. y unit := real (symbol); 

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("REAL-Denoter nach 'y unit' erwartet")

+                   ELSE errorstop ("REAL-Denoter nach 'y einheit' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . on string found :

+        check modus (font table modus);

+        FOR index FROM 1 UPTO 4

+        REP IF symbol type <> t text

+               THEN IF english

+                       THEN errorstop ("TEXT-Denoter nach 'on string' erwartet") 

+                       ELSE errorstop ("TEXT-Denoter nach 'on sequenz' erwartet") 

+                    FI;

+            FI;

+            font table. on strings (index) := symbol;

+            get next symbol;

+            IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+               THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+            IF symbol = ";" THEN LEAVE on string found FI;

+            IF index = 4 THEN errorstop ("';' erwartet") FI;

+            get next symbol;

+        PER;

+ 

+    . off string found :

+        check modus (font table modus);

+        FOR index FROM 1 UPTO 4

+        REP IF symbol type <> t text

+               THEN IF english

+                       THEN errorstop ("TEXT-Denoter nach 'off string' erwartet") 

+                       ELSE errorstop ("TEXT-Denoter nach 'off sequenz' erwartet") 

+                    FI;

+            FI;

+            font table. off strings (index) := symbol;

+            get next symbol;

+            IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+               THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+            IF symbol = ";" THEN LEAVE off string found FI;

+            IF index = 4 THEN errorstop ("';' erwartet") FI;

+            get next symbol;

+        PER;

+ 

+    . indentation pitch found :

+        check modus (font modus);

+        font. indentation pitch := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'indentation pitch' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'einrueckbreite' erwartet")

+                FI;

+        FI;

+        font. pitch table       := font. indentation pitch;

+        get semicolon;

+ 

+    . font lead found :

+        check modus (font modus);

+        font. font lead := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'font lead' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'durchschuss' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . font height found :

+        check modus (font modus);

+        font. font height := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'font height' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'fonthoehe' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . font depth found :

+        check modus (font modus);

+        font. font depth := int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'font depth' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'fonttiefe' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+    . larger font found :

+        check modus (font modus);

+        IF symbol type <> t text

+           THEN IF english

+                   THEN errorstop ("TEXT-Denoter nach 'next larger font' erwartet")

+                   ELSE errorstop ("TEXT-Denoter nach 'groesserer font' erwartet")

+                FI;

+        FI;

+        determine link nr;

+        font. next larger font := link nr;

+        get semicolon;

+ 

+    . smaller font found :

+        check modus (font modus);

+        IF symbol type <> t text

+           THEN IF english

+                   THEN errorstop ("TEXT-Denoter nach 'next smaller font' erwartet")

+                   ELSE errorstop ("TEXT-Denoter nach 'kleinerer font' erwartet")

+                FI;

+        FI;

+        determine link nr;

+        font. next smaller font := link nr;

+        get semicolon;

+ 

+        . determine link nr :

+            change all (symbol, " ", "");

+            IF   symbol = ""

+              THEN link nr := 0

+              ELSE link nr := link (font table. font names, symbol);

+                   IF link nr = 0

+                      THEN insert (font table. font names, symbol, link nr);

+                           font table. font name links CAT 0;

+                   FI;

+            FI;

+ 

+    . font string found :

+        check modus (font modus);

+        IF symbol type <> t text

+           THEN IF english

+                   THEN errorstop ("TEXT-Denoter nach 'font string' erwartet")

+                   ELSE errorstop ("TEXT-Denoter nach 'fontsequenz' erwartet")

+                FI;

+        FI;

+        font. font string := symbol;

+        get semicolon;

+ 

+    . y offsets found :

+        check modus (font modus);

+        font. y offsets := "";

+        REP IF symbol = "-" AND symbol type = t operator

+               THEN vorzeichen := -1;

+                    get next symbol;

+               ELSE vorzeichen :=  1;

+            FI;

+            int symbol := vorzeichen * int (symbol);

+            IF NOT last conversion ok

+               THEN IF english

+                       THEN errorstop ("INT-Denoter nach 'y offsets' erwartet")

+                       ELSE errorstop ("INT-Denoter nach 'y verschiebungen' erwartet")

+                    FI;

+            FI;

+            font. y offsets CAT int symbol;

+            get next symbol;

+            IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+               THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+            IF symbol = ";" THEN LEAVE y offsets found FI;

+            get next symbol;

+        PER;

+

+    . bold offset found :

+        check modus (font modus);

+        IF symbol = "-" AND symbol type = t operator

+           THEN vorzeichen := -1;

+                get next symbol;

+           ELSE vorzeichen :=  1;

+        FI;

+        font. bold offset := vorzeichen * int (symbol);

+        IF NOT last conversion ok

+           THEN IF english

+                   THEN errorstop ("INT-Denoter nach 'bold offset' erwartet")

+                   ELSE errorstop ("INT-Denoter nach 'bold verschiebungen' erwartet")

+                FI;

+        FI;

+        get semicolon;

+ 

+.

+  get char specifications :

+    WHILE char found

+    REP cout (line nr); 

+        char specification;

+        get next symbol; 

+    PER;

+

+    . char found :

+        symbol type = t text

+ 

+    . char specification :

+        IF LENGTH symbol <> 1 

+           THEN errorstop ("nur ein Zeichen bei Zeichenangabe erlaubt") FI;

+        char := symbol; 

+        char code 1 := code (char) + 1;

+        look for specification;

+        look for specification;

+        get semicolon;

+ 

+    . look for specification :

+        get next symbol; 

+        IF   symbol = ";" AND symbol type = t delimiter 

+          THEN LEAVE char specification

+        ELIF symbol = "," AND symbol type = t delimiter 

+          THEN get specification

+          ELSE errorstop ("',' oder ';' bei Zeichenspezifikation erwartet")

+        FI;

+ 

+    . get specification :

+        get next symbol;

+        IF   symbol type = t number

+          THEN pitch specification;

+        ELIF symbol type = t text 

+          THEN replacement specification

+          ELSE errorstop ("unzulaessiger Wert bei Zeichenspezifikation")

+        FI;

+ 

+        . pitch specification :

+            int symbol := int (symbol);

+            IF NOT last conversion ok

+               THEN errorstop ("INT-Denoter bei Breitenangabe erwartet") FI;

+            IF   modus = font modus

+               THEN font. pitch table (char code 1) := int symbol;

+                    IF is kanji esc (char)

+                       THEN set bit (font. pitch table (char code 1), 15) FI; 

+            ELIF modus = extension modus

+               THEN IF last modus = font modus AND

+                         font. pitch table (extension code 1) <> max int

+                       THEN font. pitch table (extension code 1) := max int FI;

+                    extension. pitch table (char code 1) := int symbol;

+            FI;

+ 

+        . replacement specification : 

+            IF LENGTH symbol > 255

+               THEN errorstop ("Ersatzdarstellungen duerfen nur 255 Zeichen haben") FI;

+            IF   modus = font table modus

+               THEN font table. replacements table (char code 1) := 

+                                       (LENGTH font table. replacements + 1); 

+                    font table. replacements CAT code (LENGTH symbol);

+                    font table. replacements CAT symbol;

+                    IF is kanji esc (char)

+                       THEN set bit (font table. replacements table (char code 1), 15) FI; 

+            ELIF modus = font modus

+               THEN font. replacements table (char code 1) :=

+                       (replacements length + LENGTH font. replacements + 1); 

+                    font. replacements CAT code (LENGTH symbol);

+                    font. replacements CAT symbol;

+                    IF is kanji esc (char)

+                       THEN set bit (font. replacements table (char code 1), 15) FI; 

+            ELIF modus = extension modus

+               THEN IF last modus = font modus AND

+                         font. replacements table (extension code 1) <> max int

+                       THEN font. replacements table (extension code 1) := max int FI;

+                    extension. replacements table (char code 1) :=

+                      (replacements length + LENGTH extension. replacements + 1); 

+                    extension. replacements CAT code (LENGTH symbol);

+                    extension. replacements CAT symbol;

+            FI;

+ 

+END PROC load;

+ 

+ 

+PROC get name list :

+ 

+   names := empty thesaurus;

+   get next symbol;

+   IF symbol <> ":" OR symbol type <> t delimiter 

+      THEN errorstop ("':' nach Kennung erwartet") FI;

+   REP get next symbol;

+       change all (symbol, " ", "");

+       IF symbol type <> t text

+          THEN errorstop ("TEXT-Denoter in Namesliste erwartet") FI;

+       IF symbol = ""

+          THEN errorstop ("'niltext' als Name nicht erlaubt") FI;

+       insert (names, symbol);

+       get next symbol;

+       IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter 

+          THEN errorstop ("',' oder ';' in Liste erwartet") FI;

+   UNTIL symbol = ";" PER;

+ 

+   . get next symbol :

+       next symbol (file, symbol, symbol type);

+ 

+END PROC get name list;

+ 

+ 

+OP := (ROW 256 INT VAR l, INT CONST r) :

+ 

+INT VAR i;

+IF modus = extension modus OR NOT two bytes

+   THEN FOR i FROM   1 UPTO 256 REP l (i) := r PER; 

+   ELSE FOR i FROM   1 UPTO 129 REP l (i) := r PER;

+        FOR i FROM 130 UPTO 160 REP l (i) := r - maxint - 1 PER;

+        FOR i FROM 161 UPTO 224 REP l (i) := r PER;

+        FOR i FROM 225 UPTO 240 REP l (i) := r - maxint - 1 PER;

+        FOR i FROM 241 UPTO 256 REP l (i) := r PER;

+FI;

+

+END OP :=;

+ 

+ 

+PROC check modus (INT CONST mod) :

+ 

+  IF mod <> modus THEN errorstop ("unzulaessige Identifikation") FI;

+ 

+END PROC check modus;

+ 

+ 

+PROC error (TEXT CONST message) :

+

+(*INT CONST l := error line;*)

+  clear error;

+  errorstop ("Zeile " + text (line nr) + " bei " + letztes symbol +

+             " : " + message (* + errorline if neccessary *) ); 

+ 

+  . letztes symbol :

+      IF symbol type <> t text

+         THEN symbol

+         ELSE decode (symbol);

+              """" + symbol + """"

+      FI

+(*

+  . errorline if neccessary :

+      IF l = 0 

+         THEN ""

+         ELSE " -> " + text (l) 

+      FI

+*)

+END PROC error;

+ 

+ 

+(*******************************************************************)

+ 

+ 

+PROC create font file (TEXT CONST font table name, font file name) :

+

+enable stop;

+connect font table;

+put font table in font file;

+ 

+.

+  connect font table :

+    buffer := font table name;

+    change all (buffer, " ", "");

+    IF NOT exists (buffer) COR type (old (buffer)) <> font table type

+       THEN errorstop ("Fonttabelle """ + buffer + """ gibt es nicht")

+    FI;

+   font table := old (buffer);

+

+.

+  put font table in font file :

+    enable stop;

+    font file := sequential file (output, font file name);

+    z         := " ";

+    max line length (font file, 1000);

+    put font table;

+    FOR font nr FROM 1 UPTO font table. last font REP put font PER;

+ 

+. put font table :

+    z CAT "FONTTABLE  :  """; z CAT buffer;                  z CAT """;"; put z; 

+    z CAT "  x unit      =  ";   z CAT text (font table. x unit); z CAT ";"; put z; 

+    z CAT "  y unit      =  ";   z CAT text (font table. y unit); z CAT ";"; put z; 

+    z CAT "  on string   =  """; z cat on strings;              z CAT """;"; put z; 

+    z CAT "  off string  =  """; z cat off strings;             z CAT """;"; put z; 

+    put font table replacements;

+    put font table extensions;

+    put z;

+ 

+    . z cat on strings :

+        FOR index FROM 1 UPTO 4

+        REP buffer := font table. on strings (index);

+            decode (buffer); 

+            z CAT buffer;

+            IF index <> 4 THEN z CAT """,  """ FI;

+        PER;

+ 

+    . z cat off strings :

+        FOR index FROM 1 UPTO 4

+        REP buffer := font table. off strings (index);

+            decode (buffer); 

+            z CAT buffer;

+            IF index <> 4 THEN z CAT """,  """ FI;

+        PER;

+ 

+    . put font table replacements : 

+        put z;

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            link nr     := font table. replacements table (char code 1);

+            reset bit (link nr, 15);

+            IF link nr > 0 AND link nr <> maxint

+               THEN z CAT "  ";

+                    put char code;

+                    put font table replacement;

+                    put z;

+            FI;

+        PER;

+ 

+        . put font table replacement :

+            replacement := subtext (font table.  replacements, link nr + 1,

+                     link nr + code (font table. replacements SUB link nr) );

+            put replacement;

+

+    . put font table extensions :

+        IF font table. extension chars <> ""

+           THEN FOR index FROM 1 UPTO LENGTH font table. extension chars 

+                REP put font table extension PER;

+        FI;

+ 

+    . put font table extension :

+        put z;

+        z CAT "  EXTENSION  :  """"";

+        z CAT text 3 (code (font table. extension chars SUB index));

+        z CAT """"";";

+        put z; put z; 

+        replacements length := 0;

+        extension nr        := font table. extension indexes ISUB index;

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            link nr     := extension. replacements table (char code 1);

+            IF link nr > 0

+               THEN z CAT "  ";

+                    put char code;

+                    put extension replacement;

+                    put z;

+            FI;

+        PER;

+ 

+. put font :

+    put z;

+            z CAT "  FONT  :  "; z cat font names; z CAT ";"; put z; 

+            z CAT "    indentation pitch  =  ";

+            z CAT text(font. indentation pitch);

+            z CAT ";"; put z; 

+    IF font. font lead <> 0 

+       THEN z CAT "    font lead          =  ";

+            z CAT text(font. font lead);

+            z CAT ";"; put z;

+    FI;

+            z CAT "    font height        =  ";

+            z CAT text(font. font height);

+            z CAT ";"; put z; 

+    IF font. font depth <> 0

+       THEN z CAT "    font depth         =  ";

+            z CAT text(font. font depth);

+            z CAT ";"; put z;

+    FI;

+    IF next larger <> ""

+       THEN z CAT "    next larger font   =  """;

+            z CAT next larger;

+            z CAT """;"; put z;

+    FI;

+    IF next smaller <> ""

+       THEN z CAT "    next smaller font  =  """;

+            z CAT next smaller;

+            z CAT """;"; put z;

+    FI;

+    IF font. font string <> ""

+       THEN z CAT "    font string        =  """;

+            z CAT font string;

+            z CAT """;"; put z;

+    FI;

+    IF (font. y offsets ISUB 1) <> 0 OR LENGTH font. y offsets > 2

+       THEN z CAT "    y offsets          =  ";

+            z cat y offsets;

+            z CAT ";"; put z; 

+    FI;

+    IF font. bold offset <> 0

+       THEN z CAT "    bold offset        =  ";

+            z CAT text(font. bold offset);

+            z CAT ";"; put z;

+    FI;

+    put font pitches and replacements;

+    put font extensions;

+ 

+    . next larger  : name (font table. font names, font. next larger font)

+    . next smaller : name (font table. font names, font. next smaller font)

+    . font string  : buffer := font. font string; decode (buffer); buffer

+ 

+    . z cat font names :

+        z CAT """";

+        z CAT name (font table. font names, font. font name indexes ISUB 1);

+        z CAT """";

+        FOR index FROM 2 UPTO LENGTH font. font name indexes DIV 2

+        REP z CAT ",  """;

+            z CAT name (font table. font names, font. font name indexes ISUB index);

+            z CAT """";

+        PER;

+ 

+    . z cat y offsets :

+        z CAT text (font. y offsets ISUB 1);

+        FOR index FROM 2 UPTO LENGTH font. y offsets DIV 2

+        REP z CAT ",  ";

+            z CAT text (font. y offsets ISUB index);

+        PER;

+ 

+    . put font pitches and replacements :

+        BOOL VAR ausgabe := FALSE; 

+        replacements length := LENGTH font table. replacements;

+        put z;

+        z CAT "  "; 

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            pitch       := font. pitch table (char code 1); 

+            reset bit (pitch, 15); 

+            link nr     := font. replacements table (char code 1);

+            reset bit (link nr, 15);

+            IF (pitch <> font. indentation pitch) OR

+               (link nr > replacements length AND link nr <> maxint)

+               THEN put font char pitch and replacement;

+                    IF ausgabe 

+                       THEN put z;

+                            ausgabe := FALSE;

+                       ELSE ausgabe := TRUE;

+                    FI;

+                    z CAT "  "; 

+            FI;

+        PER;

+        IF ausgabe THEN put z ELSE z := " " FI;

+

+        . put font char pitch and replacement :

+            put char code;

+            put font char pitch; 

+            IF   link nr > replacements length AND link nr <> maxint

+                 THEN put font replacement;

+                      IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI;

+            ELIF ausgabe

+                 THEN z CAT ";"

+                 ELSE z CAT ";            ";

+            FI;

+ 

+        . put font char pitch :

+            IF pitch = max int 

+               THEN char pos := pos (font. extension chars, code (char code));

+                    IF char pos <> 0

+                       THEN pitch := font table. extensions

+                              (font. extension indexes ISUB char pos). std pitch 

+                    FI;

+            FI;

+            put char pitch; 

+ 

+        . put font replacement :

+            link nr DECR replacements length;

+            replacement := subtext (font.  replacements, link nr + 1,

+                           link nr + code (font. replacements SUB link nr) );

+            put replacement;

+ 

+    . put font extensions :

+        IF font. extension chars <> ""

+           THEN FOR index FROM 1 UPTO LENGTH font. extension chars 

+                REP put font extension PER;

+        FI;

+ 

+    . put font extension :

+        put z;

+        z CAT "  ERWEITERUNG  :  """"";

+        z CAT text 3 (code (font. extension chars SUB index));

+        z CAT """"";";

+        put z; put z; z CAT "  "; 

+        detemine replacements length;

+        extension nr := font. extension indexes ISUB index;

+        ausgabe      := FALSE;

+        FOR char code FROM 0 UPTO 255

+        REP char code 1 := char code + 1;

+            pitch       := extension. pitch table (char code 1);

+            link nr     := extension. replacements table (char code 1);

+            IF pitch <> extension. std pitch OR link nr > replacements length

+               THEN put extension char pitch and replacement; 

+                    IF ausgabe 

+                       THEN put z;

+                            ausgabe := FALSE;

+                       ELSE ausgabe := TRUE;

+                    FI;

+                    z CAT "  "; 

+            FI;

+        PER;

+        IF ausgabe THEN put z ELSE z := " " FI;

+ 

+        . detemine replacements length :

+            char pos := pos (font table. extension chars,

+                                         font. extension chars SUB index); 

+            IF char pos <> 0

+               THEN replacements length := LENGTH font table. extensions

+                  (font table. extension indexes ISUB char pos). replacements; 

+               ELSE replacements length := 0;

+            FI;

+ 

+        . put extension char pitch and replacement :

+            put char code;

+            put char pitch;

+            IF   link nr > replacements length

+                 THEN put extension replacement;

+                      IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI;

+            ELIF ausgabe

+                 THEN z CAT ";"

+                 ELSE z CAT ";            ";

+            FI;

+ 

+. put extension replacement :

+    link nr DECR replacements length;

+    replacement := subtext (extension. replacements, link nr + 1,

+                     link nr + code (extension. replacements SUB link nr) );

+    put replacement;

+ 

+. put char code :

+    IF (char code >= 32  AND char code <= 122) OR

+       (char code >= 214 AND char code <= 223) OR

+        char code  = 124  OR char code  = 126  OR char code  = 251

+       THEN z CAT "(* ";

+            z CAT code (char code);

+            z CAT " *) """"";

+       ELSE z CAT "        """"";

+    FI;

+    z CAT text 3 (char code);

+    z CAT """""";

+ 

+. put char pitch : 

+    z CAT ",";

+    z CAT text (pitch, 5);

+ 

+. put replacement :

+    decode (replacement);

+    z CAT ",   """;

+    z CAT replacement;

+    z CAT """;"

+ 

+END PROC create font file;

+ 

+ 

+PROC put z :

+ 

+  putline (font file, z);

+  cout (lines (font file));

+  z := " ";

+ 

+END PROC put z;

+ 

+ 

+PROC decode (TEXT VAR string) :

+ 

+  INT VAR p;

+  change all (string, """", """""");

+  p := pos (string, ""0"", ""31"", 1);

+  WHILE p <> 0

+  REP change (string, p, p, """" + text (code(string SUB p)) + """");

+      p := pos (string, ""0"", ""31"", p);

+  PER;

+  p := pos (string, ""127"", ""255"", 1);

+  WHILE p <> 0

+  REP change (string, p, p, """" + text (code(string SUB p)) + """");

+      p := pos (string, ""127"", ""255"", p);

+  PER;

+ 

+END PROC decode;

+ 

+ 

+TEXT PROC text 3 (INT CONST value) :

+ 

+  buffer := text (value, 3);

+  change all (buffer, " ", "0");

+  buffer

+ 

+END PROC text 3;

+ 

+END PACKET font convertor;

diff --git a/system/std.zusatz/1.8.7/source-disk b/system/std.zusatz/1.8.7/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/system/std.zusatz/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/system/std.zusatz/1.8.7/src/complex b/system/std.zusatz/1.8.7/src/complex
new file mode 100644
index 0000000..e2139d0
--- /dev/null
+++ b/system/std.zusatz/1.8.7/src/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/system/crypt b/system/std.zusatz/1.8.7/src/crypt
index b04728a..b04728a 100644
--- a/system/crypt
+++ b/system/std.zusatz/1.8.7/src/crypt
diff --git a/system/eumel printer.5 b/system/std.zusatz/1.8.7/src/eumel printer.5
index e61a073..e61a073 100644
--- a/system/eumel printer.5
+++ b/system/std.zusatz/1.8.7/src/eumel printer.5
diff --git a/system/eumelmeter b/system/std.zusatz/1.8.7/src/eumelmeter
index ba92476..ba92476 100644
--- a/system/eumelmeter
+++ b/system/std.zusatz/1.8.7/src/eumelmeter
diff --git a/system/font convertor 9 b/system/std.zusatz/1.8.7/src/font convertor 9
index a5d0ea7..a5d0ea7 100644
--- a/system/font convertor 9
+++ b/system/std.zusatz/1.8.7/src/font convertor 9
diff --git a/system/free channel b/system/std.zusatz/1.8.7/src/free channel
index 3814f9d..3814f9d 100644
--- a/system/free channel
+++ b/system/std.zusatz/1.8.7/src/free channel
diff --git a/system/std.zusatz/1.8.7/src/longint b/system/std.zusatz/1.8.7/src/longint
new file mode 100644
index 0000000..e78bb52
--- /dev/null
+++ b/system/std.zusatz/1.8.7/src/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/system/std.zusatz/1.8.7/src/matrix b/system/std.zusatz/1.8.7/src/matrix
new file mode 100644
index 0000000..d9de9fb
--- /dev/null
+++ b/system/std.zusatz/1.8.7/src/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/system/purge b/system/std.zusatz/1.8.7/src/purge
index 55230ff..55230ff 100644
--- a/system/purge
+++ b/system/std.zusatz/1.8.7/src/purge
diff --git a/system/referencer b/system/std.zusatz/1.8.7/src/referencer
index 2ee65e4..2ee65e4 100644
--- a/system/referencer
+++ b/system/std.zusatz/1.8.7/src/referencer
diff --git a/system/reporter b/system/std.zusatz/1.8.7/src/reporter
index 4febc32..4febc32 100644
--- a/system/reporter
+++ b/system/std.zusatz/1.8.7/src/reporter
diff --git a/system/scheduler b/system/std.zusatz/1.8.7/src/scheduler
index cba48e0..cba48e0 100644
--- a/system/scheduler
+++ b/system/std.zusatz/1.8.7/src/scheduler
diff --git a/system/std analysator b/system/std.zusatz/1.8.7/src/std analysator
index 7e14722..7e14722 100644
--- a/system/std analysator
+++ b/system/std.zusatz/1.8.7/src/std analysator
diff --git a/system/std.zusatz/1.8.7/src/vector b/system/std.zusatz/1.8.7/src/vector
new file mode 100644
index 0000000..5c9e896
--- /dev/null
+++ b/system/std.zusatz/1.8.7/src/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;
+
diff --git a/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5) b/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5)
new file mode 100644
index 0000000..1a3c167
--- /dev/null
+++ b/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5)
@@ -0,0 +1,74 @@
+(*************************************************)

+(* Typtabelle   : AT.ascii(SHard>=4.5)           *)

+(* Generiert am : 26.07.88                       *)

+(* Version/Typ  : 1.8.2/32001                    *)

+(*************************************************)

+ 

+forget ("AT.ascii(SHard>=4.5)", quiet) ;

+new type ("AT.ascii(SHard>=4.5)") ;

+

+enter xsize (80) ;

+enter ysize (24) ;

+cursor logic (0, ""6"", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  0, 0, "") ;   

+enter outcode (  1,   1) ; (* Cursor Home : <CTRL-A> *) 

+enter outcode (  2,   2) ; (* Cursor right: <CTRL-B> *) 

+enter outcode (  3,   3) ; (* Cursor up   : <CTRL-C> *) 

+enter outcode (  4,   4) ; (* CLEOP       : <CTRL-D> *) 

+enter outcode (  5,   5) ; (* CLEOL       : <CTRL-E> *) 

+enter outcode (  8,   8) ; (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ; (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ; (* CR          : <CR> *) 

+enter outcode ( 14, 0, ""14" ") ; (* END MARK    : <CTRL-N> <SPACE> *) 

+enter outcode ( 15, 0, ""15" ") ; (* BEGIN MARK  : <CTRL-O> <SPACE> *) 

+enter outcode (220, 0, ""15"k"14"") ; (* Trenn-k     : <CTRL-O> k <CTRL-N> 

+*) 

+enter outcode (221, 0, ""15"-"14"") ; (* Trennstrich : <CTRL-O> - <CTRL-N> 

+*) 

+enter outcode (222, 0, ""15"#"14"") ; (* Fest-#      : <CTRL-O> # <CTRL-N> 

+*) 

+enter outcode (223, 0, ""15" "14"") ; (* Fest-Blank  : <CTRL-O> <SPACE> 

+<CTRL-N> *) 

+enter outcode (251, 0, ""225"") ; (* sz          : <225> *) 

+enter outcode (252,  21) ; (* <CTRL-U> *) 

+

+

+(* Eingabe Codes : *)

+enter incode (  7, ""7"") ; (* SV - Call   : <CTRL-G> *)

+enter incode (  4, ""4"") ; (* Info        : <CTRL-D> *)

+enter incode (  1, ""1"") ; (* HOP         : <CTRL-A> *)

+enter incode ( 18, ""18"") ; (* Insert line : <CTRL-R> *)

+enter incode ( 96, "<") ; (* < *)

+enter incode (126, ">") ; (* > *)

+enter incode ( 64, """") ; (* " *)

+enter incode ( 35, ""252"") ; (* <252> *)

+enter incode ( 94, "&") ; (* & *)

+enter incode ( 38, "/") ; (* / *)

+enter incode ( 42, "(") ; (* ( *)

+enter incode ( 40, ")") ; (* ) *)

+enter incode ( 41, "=") ; (* = *)

+enter incode ( 45, "ß") ; (* <251> *)

+enter incode ( 95, "?") ; (* ? *)

+enter incode ( 61, "'") ; (* ' *)

+enter incode ( 43, "`") ; (* ` *)

+enter incode (121, "z") ; (* z *)

+enter incode ( 89, "Z") ; (* Z *)

+enter incode (122, "y") ; (* y *)

+enter incode ( 90, "Y") ; (* Y *)

+enter incode ( 60, ";") ; (* ; *)

+enter incode ( 62, ":") ; (* : *)

+enter incode ( 47, "-") ; (* - *)

+enter incode ( 63, "_") ; (* _ *)

+enter incode ( 59, "ö") ; (* <218> *)

+enter incode ( 58, ""215"") ; (* <215> *)

+enter incode ( 39, "ä") ; (* <217> *)

+enter incode ( 34, ""214"") ; (* <214> *)

+enter incode ( 91, "ü") ; (* <219> *)

+enter incode ( 93, "+") ; (* + *)

+enter incode (123, ""216"") ; (* <216> *)

+enter incode (125, "*") ; (* * *)

+enter incode ( 92, "#") ; (* # *)

+enter incode (124, "^") ; (* ^ *)

+

diff --git a/system/terminal-codes/1.8.2/src/GEN182.ELA b/system/terminal-codes/1.8.2/src/GEN182.ELA
new file mode 100644
index 0000000..be9c208
--- /dev/null
+++ b/system/terminal-codes/1.8.2/src/GEN182.ELA
@@ -0,0 +1,245 @@
+(* Typtabellengenerierungsprogramm, Stand : 26.11.85 *) 

+ 

+page ; 

+putline ("- Erzeugen einer .gen Datei aus einer Typtabelle -") ; 

+line ; 

+BOUND STRUCT (INT maxx, maxy, 

+              ROW 248 INT align,

+              ROW 128 INT outcodes, 

+              ROW 128 INT instrings,

+              ROW 128 INT outstrings) VAR x ; 

+ 

+TEXT VAR t , filename ; 

+INT VAR i , laenge , position , eumel code ;

+FILE VAR f ; 

+put ("Name der Tabelle:") ; 

+getline (t) ; 

+IF exists (t+".gen") THEN forget (t+".gen") FI ; 

+IF exists (t+".gen") 

+THEN filename := t + ".new.gen" 

+ELSE filename := t + ".gen"

+FI ; 

+f := sequentialfile (output, filename) ; 

+putline (f, "(" + 49 * "*" + ")") ; 

+putline (f, "(* Typtabelle   : " + text (t, 30) + " *)") ; 

+putline (f, "(* Generiert am : " + text (date, 30) + " *)") ; 

+putline (f, "(* Version/Typ  : " + text ("1.8.2/32001", 30) + " *)") ;

+putline (f, "(" + 49 * "*" + ")") ; 

+line (f) ; 

+putline (f, "forget (""" + t + """, quiet) ;") ; 

+putline (f, "new type (""" + t + """) ;") ; 

+line (f) ; 

+x := old (t, 32001) ; 

+putline (f, "enter xsize ("+text (x.maxx)+") ;") ; 

+putline (f, "enter ysize ("+text (x.maxy)+") ;") ;

+t := "  " ; 

+IF (x.outstrings (1) AND 255) = 2 

+   THEN putline (f, "elbit cursor ;") ; 

+        line (f) ; 

+   ELSE write (f, "cursor logic (") ; 

+        position := x.outstrings(2) ;

+        put (f, text (position AND 255) + ",") ; 

+        position := (x.outcodes (4) AND 127) * 8+1 ;

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        putline (f, denoter (x.outstrings, position, 0) + ") ;") ; 

+        line (f)

+FI ; 

+putline (f, "(* Ausgabe Codes : *)") ; 

+FOR i FROM 1 UPTO 128 REP 

+ cout (lineno (f)) ;

+ replace (t, 1, x.outcodes (i)) ; 

+ IF i <> 4 

+ THEN IF code (t SUB 1) <> 255 

+      THEN eumel code := (i-1) * 2 ; 

+           put (f, "enter outcode (" + text (eumel code, 3) + ",") ; 

+           IF code (t SUB 1) > 127 

+           THEN outstring ((code (t SUB 1)-128)*8) 

+           ELSE numberput (code (t SUB 1)) 

+           FI ; 

+           line (f) 

+      FI 

+ FI ; 

+ IF code (t SUB 2) <> 255 

+ THEN eumel code := (i-1) * 2 + 1 ; 

+      put (f, "enter outcode (" + text (eumel code, 3) + ",") ;

+      IF code (t SUB 2) > 127 

+      THEN outstring ((code (t SUB 2)-128)*8)

+      ELSE numberput (code (t SUB 2)) 

+      FI ; 

+      line (f) 

+ FI ; 

+PER ; 

+line (f) ; 

+line (f) ; 

+ 

+putline (f, "(* Eingabe Codes : *)") ; 

+i := 0 ; 

+WHILE i < 256 CAND incode (i) <> 255 REP

+ cout (lineno (f)) ; 

+ eumel code := incode (i) ; 

+ put (f, "enter incode (" + text (eumel code,3) + ",") ; 

+ write (f, denoter (x.instrings, i + 1, 255)) ; 

+ put (f, ") ; (*") ; 

+ i INCR 1 ; 

+ IF in bezeichnung (eumel code) <> "" 

+ THEN put (f, in bezeichnung (eumel code) + ":") 

+ FI ; 

+ WHILE i < 256 CAND incode (i) <> 255 REP 

+  charput (incode (i)) ; 

+  i INCR 1 

+ PER ; 

+ i INCR 1 ; 

+ putline (f, "*)") 

+PER ; 

+ 

+edit (filename) ; 

+ 

+INT PROC incode (INT CONST element) : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.instrings (element DIV 2 + 1)); 

+ IF (element MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC incode ; 

+ 

+ 

+TEXT PROC in bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "HOP         " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 4 : "Info        "

+  CASE 7 : "SV - Call   " 

+  CASE 8 : "Cursor left " 

+  CASE 9 : "TAB         " 

+  CASE 10: "Cursor down " 

+  CASE 11: "RUBIN       " 

+  CASE 12: "RUBOUT      "

+  CASE 13: "CR          " 

+  CASE 16: "MARK        " 

+  CASE 17: "Stop        " 

+  CASE 18: "Insert line "

+  CASE 23: "Weiter      " 

+  CASE 27: "Escape      "

+  CASE 214:"ae-Taste    " 

+  CASE 215:"oe-Taste    " 

+  CASE 216:"ue-Taste    "

+  CASE 217:"Ae-Taste    " 

+  CASE 218:"Oe-Taste    " 

+  CASE 219:"Ue-Taste    " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz-Taste    " 

+  OTHERWISE IF code < 32 THEN "Funct.-Taste" 

+                         ELSE "" 

+            FI 

+ ENDSELECT 

+ENDPROC in bezeichnung ; 

+ 

+TEXT PROC out bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "Cursor Home " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 4 : "CLEOP       " 

+  CASE 5 : "CLEOL       " 

+  CASE 6 : "Cursor (YX) " 

+  CASE 7 : "Beep        " 

+  CASE 8 : "Cursor left " 

+  CASE 10: "Cursor down " 

+  CASE 13: "CR          " 

+  CASE 14: "END MARK    " 

+  CASE 15: "BEGIN MARK  " 

+  CASE 214:"ae          " 

+  CASE 215:"oe          " 

+  CASE 216:"ue          "

+  CASE 217:"Ae          " 

+  CASE 218:"Oe          " 

+  CASE 219:"Ue          " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz          " 

+  OTHERWISE ""

+ ENDSELECT 

+ENDPROC out bezeichnung ; 

+ 

+PROC charput (INT CONST nr) : 

+ IF   nr =  27 THEN put (f, "<ESC>") 

+ ELIF nr =  10 THEN put (f, "<LF>") 

+ ELIF nr =  13 THEN put (f, "<CR>") 

+ ELIF nr =  32 THEN put (f, "<SPACE>") 

+ ELIF nr = 127 THEN put (f, "<DEL>") 

+ ELIF nr > 127 THEN put (f, "<" + text (nr) + ">") 

+ ELIF nr >  32 THEN put (f, code (nr))

+ ELSE put (f, "<CTRL-" + code (nr+64) + ">") 

+ FI 

+ENDPROC charput ; 

+ 

+PROC numberput (INT CONST nr) : 

+ put (f, text (nr,3 ) + ") ; (*") ;

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ; 

+ charput (nr) ; 

+ put (f, "*)") ; 

+ENDPROC numberput ; 

+ 

+TEXT PROC denoter (ROW 128 INT VAR y, INT CONST pos, ende) : 

+ INT VAR i := pos ; 

+ TEXT VAR t := "  " , zeile := """" ; 

+ laenge := 0 ; 

+ WHILE i < 256 AND zugriff <> ende REP 

+  IF zugriff > 31 AND zugriff < 127 THEN zeile CAT code (zugriff) 

+  ELIF zugriff = 34 THEN zeile CAT """"""

+  ELIF zugriff = 251 THEN zeile CAT "ß" 

+  ELIF zugriff > 216 AND zugriff < 224 THEN zeile CAT code (zugriff) 

+  ELSE zeile CAT """" ; 

+       zeile CAT text (zugriff) ; 

+       zeile CAT """" 

+  FI ; 

+  i INCR 1 ; 

+  laenge INCR 1 

+ PER ; 

+ zeile CAT """" ; 

+ zeile. 

+ 

+ 

+zugriff : 

+ replace (t, 1, y (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC denoter ; 

+ 

+ 

+PROC outstring (INT CONST element) : 

+ INT VAR i := element ; 

+ put (f, text (zugriff) + ",") ; 

+ put (f, denoter (x.outstrings, i + 1, 0) + ") ; (*") ; 

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ;

+ i INCR 1 ; 

+ WHILE zugriff <> 0 REP 

+  charput (zugriff) ; 

+  i INCR 1 

+ PER ; 

+ put (f, "*)") . 

+ 

+ 

+zugriff : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.outstrings (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC outstring 

+

+

diff --git a/system/terminal-codes/unknown/src/A210 b/system/terminal-codes/unknown/src/A210
new file mode 100644
index 0000000..4b63b40
--- /dev/null
+++ b/system/terminal-codes/unknown/src/A210
@@ -0,0 +1,78 @@
+(*************************************************)

+(* Typtabelle   : A210                           *)

+(* Zeichensatz  : ASCII                          *) 

+(* Keyboard     : ASCII                          *) 

+(* Erstellt am  : 07.12.85                       *)

+(*************************************************)

+

+forget ("A210", quiet) ;

+new type ("A210") ;

+

+enter outcode (127, 0, ""27"F"127"") ; (* Erster Outstring ! *) 

+INT VAR i ; 

+FOR i FROM 128 UPTO 254 REP 

+ link outcode (i, 4) (* first outstring *)

+PER ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y") ; (* CLEOP       : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14, 0, ""27"G0") ;(* END MARK    : <ESC> G 0 *) 

+enter outcode ( 15, 0, ""27"G4") ;(* BEGIN MARK  : <ESC> G 4 *) 

+enter outcode ( 16, 0, ""27"G8") ;(* UNDERLINE   : <ESC> G 8 *) 

+enter outcode ( 17, 0, ""27"G2") ;(* FLASH       : <ESC> G 2 *) 

+ 

+(* Low Video on = <ESC> ) , High Video on = <ESC> ( *) 

+enter outcode (214, 0, ""27")A"27"(") ; (* ae     : <ESC> ) A <ESC> ( *) 

+enter outcode (215, 0, ""27")O"27"(") ; (* oe     : <ESC> ) O <ESC> ( *) 

+enter outcode (216, 0, ""27")U"27"(") ; (* ue     : <ESC> ) U <ESC> ( *) 

+enter outcode (217, 0, ""27")a"27"(") ; (* Ae     : <ESC> ) a <ESC> ( *) 

+enter outcode (218, 0, ""27")o"27"(") ; (* Oe     : <ESC> ) o <ESC> ( *) 

+enter outcode (219, 0, ""27")u"27"(") ; (* Ue     : <ESC> ) u <ESC> ( *)

+enter outcode (220, 0, ""27")k"27"(") ; (* Trenn-k     : k *) 

+enter outcode (221, 0, ""27")-"27"(") ; (* Trennstrich : - *) 

+enter outcode (222, 0, ""27")#"27"(") ; (* Fest-#      : # *) 

+enter outcode (223, 0, ""27")_"27"(") ; (* Fest-Blank  : <SPACE> *) 

+enter outcode (251, 0, ""27")B"27"(") ; (* sz     : <ESC> ) B <ESC> ( *) 

+

+(* Eingabecodes : *)

+enter incode (  0, ""0"")  ;  (* Wird beim Einschalten dreimal gesendet *)

+enter incode (  1, ""30"") ;  (* HOP         : <CTRL-^> *)

+enter incode (  2, ""12"") ;  (* Cursor right: <CTRL-L> *)

+enter incode (  3, ""11"") ;  (* Cursor up   : <CTRL-K> *)

+enter incode (  7, ""1"A"13"") ; (* SV - Call   : <CTRL-A> A <CR> *)

+enter incode (  7, ""2"") ;   (* SV - Call   : <CTRL-B> *)

+enter incode (  8, ""8"") ; 

+enter incode (  9, ""9"") ;   (* TAB         : <CTRL-I> *)

+enter incode ( 10, ""22"") ;  (* Cursor down : <CTRL-Y> *)

+enter incode ( 11, ""27"Q") ; (* RUBIN       : <ESC> Q *)

+enter incode ( 12, ""127"") ; (* RUBOUT      : <DEL> *)

+enter incode ( 12, ""27"W") ; (* RUBOUT      : <ESC> W *)

+enter incode ( 16, ""27"E") ; (* MARK        : <ESC> E *)

+enter incode ( 17, ""19"") ;  (* Stop        : <CTRL-S> *)

+enter incode ( 17, ""1"@"13"") ; (* Stop        : <CTRL-A> @ <CR> *)

+enter incode ( 23, ""17"") ;     (* Weiter      : <CTRL-Q> *)

+enter incode ( 23, ""1"B"13"") ; (* Weiter      : <CTRL-A> B <CR> *)

+enter incode (  4, ""1"C"13"") ; (* Funct.-Taste: <CTRL-A> C <CR> *)

+enter incode ( 20, ""1"D"13"") ; (* Funct.-Taste: <CTRL-A> D <CR> *)

+enter incode ( 21, ""1"E"13"") ; (* Funct.-Taste: <CTRL-A> E <CR> *)

+enter incode ( 22, ""1"F"13"") ; (* Funct.-Taste: <CTRL-A> F <CR> *)

+enter incode ( 24, ""1"G"13"") ; (* Funct.-Taste: <CTRL-A> G <CR> *)

+enter incode ( 25, ""1"H"13"") ; (* Funct.-Taste: <CTRL-A> H <CR> *)

+enter incode ( 26, ""1"I"13"") ; (* Funct.-Taste: <CTRL-A> I <CR> *)

+enter incode ( 28, ""1"J"13"") ; (* Funct.-Taste: <CTRL-A> J <CR> *)

+enter incode ( 29, ""1"`"13"") ; (* Funct.-Taste: <CTRL-A> ` <CR> *)

+enter incode ( 30, ""1"a"13"") ; (* Funct.-Taste: <CTRL-A> a <CR> *)

+enter incode ( 31, ""1"b"13"") ; (* Weiter      : <CTRL-A> b <CR> *)

+ 

+PROC link outcode (INT CONST eumelcode, begin of string) : 

+ enter outcode (eumelcode, begin of string -128) 

+ENDPROC link outcode ;

diff --git a/system/terminal-codes/unknown/src/A210.german b/system/terminal-codes/unknown/src/A210.german
new file mode 100644
index 0000000..656ad31
--- /dev/null
+++ b/system/terminal-codes/unknown/src/A210.german
@@ -0,0 +1,87 @@
+(*************************************************)

+(* Typtabelle   : A210 - Emulation QT102!        *)

+(* Zeichensatz  : German                         *) 

+(* Keyboard     : German                         *) 

+(* Erstellt am  : 04.02.87                       *)

+(*************************************************)

+

+forget ("A210.german", quiet) ;

+new type ("A210.german") ;

+

+enter outcode (127, 0, ""27"F"127"") ; (* Erster Outstring ! *) 

+INT VAR i ; 

+FOR i FROM 128 UPTO 254 REP 

+ link outcode (i, 4) (* first outstring *)

+PER ; 

+ 

+cursor logic (32, ""27"=", "", "") ;

+ 

+(* Ausgabe Codes : *)

+enter outcode (  1,  30) ;        (* Cursor Home : <CTRL-^> *) 

+enter outcode (  2,  12) ;        (* Cursor right: <CTRL-L> *) 

+enter outcode (  3,  11) ;        (* Cursor up   : <CTRL-K> *) 

+enter outcode (  4, 0, ""27"Y") ; (* CLEOP       : <ESC> Y *) 

+enter outcode (  5, 0, ""27"T") ; (* CLEOL       : <ESC> T *) 

+enter outcode (  8,   8) ;        (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ;        (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ;        (* CR          : <CR> *) 

+enter outcode ( 14, 0, ""27"G0") ;(* END MARK    : <ESC> G 0 *) 

+enter outcode ( 15, 0, ""27"G4") ;(* BEGIN MARK  : <ESC> G 4 *) 

+enter outcode ( 16, 0, ""27"G8") ;(* UNDERLINE   : <ESC> G 8 *) 

+enter outcode ( 17, 0, ""27"G2") ;(* FLASH       : <ESC> G 2 *) 

+ 

+(* Low Video on = <ESC> ) , High Video on = <ESC> ( *) 

+enter outcode (214, "[") ; (* Ae     : [ *) 

+enter outcode (215, "\") ; (* Oe     : \ *) 

+enter outcode (216, "]") ; (* Ue     : ] *)

+enter outcode (217, "{") ; (* ae     : {      } *) 

+enter outcode (218, "|") ; (* oe     : | *) 

+enter outcode (219, "}") ; (* ue     : }      { *)

+enter outcode (220, ""27")k"27"(") ; (* Trenn-k     : k *) 

+enter outcode (221, ""27")-"27"(") ; (* Trennstrich : - *) 

+enter outcode (222, ""27")#"27"(") ; (* Fest-#      : # *) 

+enter outcode (223, ""27")_"27"(") ; (* Fest-Blank  : <SPACE> *) 

+enter outcode (251, "~") ; (* sz     : ~ *) 

+enter outcode (252, "@") ; (* Paragraph: @ *)

+

+(* Eingabecodes : *)

+(* Achtung: Tabelle ist randvoll! *) 

+enter incode (  0, ""0"")  ;  (* Wird beim Einschalten dreimal gesendet *)

+enter incode (  1, ""30"") ;  (* HOP         : <CTRL-^> *)

+enter incode (  2, ""12"") ;  (* Cursor right: <CTRL-L> *)

+enter incode (  3, ""11"") ;  (* Cursor up   : <CTRL-K> *)

+enter incode (  7, ""1"A"13"") ; (* SV - Call   : F2 *)

+enter incode (  7, ""2"") ;   (* SV - Call   : <CTRL-B> *)

+enter incode (  9, ""9"") ;   (* TAB         : <CTRL-I> *)

+enter incode ( 10, ""22"") ;  (* Cursor down : <CTRL-Y> *)

+enter incode ( 11, ""27"Q") ; (* RUBIN       : <ESC> Q *)

+enter incode ( 12, ""127"") ; (* RUBOUT      : <DEL> *)

+enter incode ( 12, ""27"W") ; (* RUBOUT      : <ESC> W *)

+enter incode ( 16, ""27"E") ; (* MARK        : <ESC> E *)

+enter incode ( 17, ""19"") ;  (* Stop        : <CTRL-S> *)

+enter incode ( 23, ""17"") ;  (* Weiter      : <CTRL-Q> *)

+enter incode ( 23, ""3"") ;   (* Weiter      : <CTRL-C> *) 

+enter incode (  4, ""1"C"13"") ; (* Funct.-Taste F4 : <CTRL-A> C <CR>*) 

+enter incode ( 20, ""1"D"13"") ; (* Funct.-Taste F5 : <CTRL-A> D <CR> *)

+enter incode ( 21, ""1"E"13"") ; (* Funct.-Taste F6 : <CTRL-A> E <CR> *)

+enter incode ( 22, ""1"F"13"") ; (* Funct.-Taste F7 : <CTRL-A> F <CR> *)

+enter incode ( 24, ""1"G"13"") ; (* Funct.-Taste F8 : <CTRL-A> G <CR> *)

+enter incode ( 25, ""1"H"13"") ; (* Funct.-Taste F9 : <CTRL-A> H <CR> *)

+enter incode ( 26, ""1"I"13"") ; (* Funct.-Taste F10: <CTRL-A> I <CR> *)

+enter incode ( 28, ""1"J"13"") ; (* Funct.-Taste F11: <CTRL-A> J <CR> *)

+enter incode ( 29, ""1"`"13"") ; (* Funct.-Taste F12: <CTRL-A> ` <CR> *)

+enter incode ( 30, ""1"a"13"") ; (* Funct.-Taste F13: <CTRL-A> a <CR> *)

+enter incode ( 31, ""1"b"13"") ; (* Funct.-Taste F14: <CTRL-A> b <CR> *)

+enter incode (214, "[") ; 

+enter incode (215, "\") ; 

+enter incode (216, "]") ; 

+enter incode (217, "{") ; 

+enter incode (218, "|") ; 

+enter incode (219, "}") ; 

+enter incode (251, "~") ; 

+enter incode (252, "@") ; 

+

+ 

+PROC link outcode (INT CONST eumelcode, begin of string) : 

+ enter outcode (eumelcode, begin of string -128) 

+ENDPROC link outcode ;

diff --git a/system/terminal-codes/unknown/src/A230+ b/system/terminal-codes/unknown/src/A230+
new file mode 100644
index 0000000..89dcb79
--- /dev/null
+++ b/system/terminal-codes/unknown/src/A230+
@@ -0,0 +1,61 @@
+TEXT VAR  name :="A230+"; 

+command dialogue (FALSE); forget (name, quiet) ; 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""27"G0 ");

+enter outcode (15,0,""27"G4 ");

+ 

+enter outcode ( 91,0,">");

+enter outcode ( 92,0,"/");

+enter outcode ( 93,0,">");

+enter outcode (123,0,"(");

+enter outcode (124,0,"!");

+enter outcode (125,0,")");

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (214,91);

+enter outcode (215,92);

+enter outcode (216,93);

+enter outcode (217,123);

+enter outcode (218,124);

+enter outcode (219,125);

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223,"_") ; 

+enter outcode (251,126);

+ 

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+ 

+enter incode (63,""0"") ;

+enter incode ( 1,""30"");                            (* HOP *) 

+enter incode ( 2,""12"");                            (* up *) 

+enter incode ( 3,""11"");                            (* right *) 

+enter incode (10,""22"");                            (* down *) 

+enter incode ( 8,""8"");                             (* left *) 

+enter incode (11,""27"Q");enter incode (11,""26"");  (* rubin *) 

+enter incode (12,""27"W");enter incode (12,""127""); (* rubout *) 

+enter incode (12,""27"E");                           (*   "    *) 

+enter incode (16,""16"");                            (* mark *) 

+enter incode (16,""27"T");                           (* mark *) 

+enter incode (7,""2"");                              (* sv *) 

+enter incode (7, ""1""64""13"");                     (* F1 = SV *) 

+enter incode (17,""1""66""13"");                     (* F2 = stop *) 

+enter incode (23,""3"");                             (* weiter *) 

+enter incode (23,""1""65""13"");                     (* F3 = weiter *) 

+

diff --git a/system/terminal-codes/unknown/src/DEC.VT220.ascii b/system/terminal-codes/unknown/src/DEC.VT220.ascii
new file mode 100644
index 0000000..c83f9b9
--- /dev/null
+++ b/system/terminal-codes/unknown/src/DEC.VT220.ascii
@@ -0,0 +1,49 @@
+TEXT VAR  name :="DEC.VT220.ascii";

+new type (name);

+cursor logic  ( 1,  1, ""155"",";","H");

+enter outcode ( 1,  0, ""155"1;1H");  (* home *)

+enter outcode ( 2,  0, ""155"C");     (* right *)

+enter outcode ( 3,  0, ""155"A");     (* up *)

+enter outcode ( 4, 40, ""155"J");     (* clear eop *)

+enter outcode ( 5,  0, ""155"K");     (* clear eol *)

+enter outcode (10,  0, ""132"");      (* down    *) 

+enter outcode (14,  0, ""155"27m ");  (* end mark *)

+enter outcode (15,  0, ""155"7m ");   (* begin mark *)

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+

+enter outcode (214, ""196"");         (* AE *)

+enter outcode (215, ""214"");         (* OE *)

+enter outcode (216, ""220"");         (* UE *)

+enter outcode (217, ""228"");         (* ae *)

+enter outcode (218, ""246"");         (* oe *)

+enter outcode (219, ""252"");         (* ue *)

+enter outcode (220, "k");             (* Trenn-k  *) 

+enter outcode (221, "-");             (* Trenn-   *) 

+enter outcode (222, "#");             (* Pseudo-# *)

+enter outcode (223, " ");             (* gesch. Blank *) 

+enter outcode (251, ""223"");         (* sz *)

+ 

+enter incode ( 1, ""155"4"126"");     (* hop *)

+enter incode ( 2, ""155"C");          (* right *)

+enter incode ( 3, ""155"A");          (* up *)

+enter incode ( 4, ""4"");             (* info *) 

+enter incode ( 7, ""2"");             (* sv *)

+enter incode ( 7, ""254"");           (* sv *)

+enter incode ( 8, ""155"D");          (* left *)

+enter incode (10, ""155"B");          (* down *)

+enter incode (11, ""155"2"126"");     (* rubin *)

+enter incode (12, ""155"3"126"");     (* rubout *)

+enter incode (12, ""127"");           (* rubout *)

+enter incode (16, ""155"1"126"");     (* mark *)

+enter incode (17, ""1"");             (* stop *) 

+enter incode (23, ""3"");             (* weiter *)

+enter incode (27, ""96"");            (* esc *)

+

+enter incode (25, ""155""50""56""126"");  (* help *)

+enter incode (26, ""155""50""57""126"");  (* do *)

+enter incode (28, ""155"5"126"");         (* prev screen *)

+enter incode (29, ""155"6"126"");         (* next screen *)

diff --git a/system/terminal-codes/unknown/src/DEC.VT220.german b/system/terminal-codes/unknown/src/DEC.VT220.german
new file mode 100644
index 0000000..e45114b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/DEC.VT220.german
@@ -0,0 +1,66 @@
+TEXT VAR  name :="DEC.VT220.german"; 

+new type (name);

+cursor logic  ( 1, 1, ""155"",";","H");

+enter outcode ( 1,  0, ""155"1;1H");  (* home *)

+enter outcode ( 2,  0, ""155"C");     (* right *)

+enter outcode ( 3,  0, ""155"A");     (* up *)

+enter outcode ( 4, 40, ""155"J");     (* clear eop *)

+enter outcode ( 5,  0, ""155"K");     (* clear eol *)

+enter outcode (10,  0, ""132"");      (* newline *) 

+enter outcode (14,  0, ""155"27m ");  (* end mark *)

+enter outcode (15,  0, ""155"7m ");   (* begin mark *)

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+

+enter outcode (214, ""196"");         (* AE *)

+enter outcode (215, ""214"");         (* OE *)

+enter outcode (216, ""220"");         (* UE *)

+enter outcode (217, ""228"");         (* ae *)

+enter outcode (218, ""246"");         (* oe *)

+enter outcode (219, ""252"");         (* ue *)

+enter outcode (220, "k");             (* Trenn-k  *) 

+enter outcode (221, "-");             (* Trenn-   *) 

+enter outcode (222, "#");             (* Pseudo-# *)

+enter outcode (223, " ");             (* gesch. Blank *) 

+enter outcode (251, ""223"");         (* sz *)

+

+

+enter incode (27, ""155"5"126"");     (* esc *)

+enter incode ( 1, ""155"4"126"");     (* hop *)

+enter incode ( 2, ""155"C");          (* right *)

+enter incode ( 3, ""155"A");          (* up *)

+enter incode ( 4, ""4"");             (* info *) 

+enter incode ( 7, ""2"");             (* sv *)

+enter incode ( 7, ""254"");           (* sv *)

+enter incode ( 8, ""155"D");          (* left *)

+enter incode (10, ""155"B");          (* down *)

+enter incode (11, ""155"2"126"");     (* rubin *)

+enter incode (12, ""155"3"126"");     (* rubout *)

+enter incode (12, ""127"");           (* rubout *)

+enter incode (16, ""155"1"126"");     (* mark *)

+enter incode (17, ""1"");             (* stop *) 

+enter incode (23, ""3"");             (* weiter *)

+enter incode (27, ""155"23~");        (* esc    *)

+enter incode (214, ""196"");         (* AE *)

+enter incode (215, ""214"");         (* OE *)

+enter incode (216, ""220"");         (* UE *)

+enter incode (217, ""228"");         (* ae *)

+enter incode (218, ""246"");         (* oe *)

+enter incode (219, ""252"");         (* ue *)

+enter incode (251, ""223"");         (* sz *)

+

+enter incode (25, ""155""50""56""126"");  (* help *)

+enter incode (26, ""155""50""57""126"");  (* do *)

+enter incode (28, ""155"5"126"");         (* prev screen *)

+enter incode (29, ""155"6"126"");         (* next screen *)

+

+

+

+

+

+

+

+

diff --git a/system/terminal-codes/unknown/src/DM5 b/system/terminal-codes/unknown/src/DM5
new file mode 100644
index 0000000..a672698
--- /dev/null
+++ b/system/terminal-codes/unknown/src/DM5
@@ -0,0 +1,53 @@
+LET name = "DM5";

+

+   forget (name,quiet); 

+   new type (name);

+

+cursor logic (32,""27"F","","");

+

+(*************************************************)

+(**** Tasten des Beehive Standard Terminals : ****)

+(*************************************************) 

+(** ae -> 24  Ae -> 20   home   -> esc H        **)

+(** oe -> 25  Oe -> 21   hop    -> 1            **)

+(** ue -> 26  Ue -> 22   mark   -> 4            **)

+(** sz -> 30             rubin  -> 5            **)

+(** cursor r -> 12       weiter -> 15           **)

+(** cursor u -> 11       sv     -> 14           **)

+(**                      halt   -> 6            **)

+(*************************************************)

+

+(* Ein- und Ausgabe-Steuerzeichen: *)

+enter incode (1,  ""27"H"); (* home *)  enter outcode (1,  0, ""27"H");

+enter incode (16, ""4"");   (* mark *)  enter outcode (15, 0, ""27"dP ");

+enter incode (11, ""5"");               enter outcode (14, 0, ""27"m ");

+enter incode (12, ""127"");

+enter incode (7,  ""14"");  (* sv *)

+enter incode (17, ""15"");  (* halt *)

+enter incode (23, ""6"");   (* weiter *)

+ 

+enter outcode (5,  0, ""27"K");         enter incode (3, ""11"");

+enter outcode (4, 40, ""27"J");         enter incode (2, ""12"");

+enter outcode (3,  ""11"");

+enter outcode (2,  0, ""27"C");

+

+(* Umlaute *)

+(* Ae *) enter incode (214, ""20""); enter outcode (214, 0, ""27"dQA"27"m");

+(* Oe *) enter incode (215, ""21""); enter outcode (215, 0, ""27"dQO"27"m");

+(* Ue *) enter incode (216, ""22""); enter outcode (216, 0, ""27"dQU"27"m");

+(* ae *) enter incode (217, ""24""); enter outcode (217, 0, ""27"dQa"27"m");

+(* oe *) enter incode (218, ""25""); enter outcode (218, 0, ""27"dQo"27"m");

+(* ue *) enter incode (219, ""26""); enter outcode (219, 0, ""27"dQu"27"m");

+(* ss *) enter incode (251, ""30""); enter outcode (251, 0, ""27"dQB"27"m");

+(* paragraph *)

+         enter incode (252, ""64""); enter outcode (252, 0, ""27"dQ$"27"m");

+

+(* Textkosmetik *)

+enter outcode (124, 0, ""27"Rd"27"S") ;

+enter outcode (220, "k") ;

+enter outcode (221, 0, ""27"dA-"27"m") ; 

+enter outcode (222, 0, ""27"dQ#"27"m") ; 

+enter outcode (223, "_") ;

+

+enter outcode (255, "%");

+

diff --git a/system/terminal-codes/unknown/src/ELBIT.ascii b/system/terminal-codes/unknown/src/ELBIT.ascii
new file mode 100644
index 0000000..3957ee8
--- /dev/null
+++ b/system/terminal-codes/unknown/src/ELBIT.ascii
@@ -0,0 +1,32 @@
+TEXT VAR  name :="ELBIT.ascii"; 

+new type (name);

+elbit cursor;

+enter outcode (1,12); 

+enter outcode (2  ,21  );

+enter outcode (3  ,26  );

+enter outcode (5  ,22  );

+enter outcode (4,64,""20"");

+enter incode (1,""12""); 

+enter incode (2  ,""21""  );

+enter incode (3  ,""26""  );

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

+

+enter outcode (214,"A");

+enter outcode (215,"O"); 

+enter outcode (216,"U"); 

+enter outcode (217,"a"); 

+enter outcode (218,"o"); 

+enter outcode (219,"u"); 

+enter outcode (251,"B");

+

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223,"_") ; 

+ 

+enter incode (11,""126"");  (* rubin *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,"^") ; (* mark *)

diff --git a/system/terminal-codes/unknown/src/ELBIT.german b/system/terminal-codes/unknown/src/ELBIT.german
new file mode 100644
index 0000000..17d5454
--- /dev/null
+++ b/system/terminal-codes/unknown/src/ELBIT.german
@@ -0,0 +1,47 @@
+TEXT VAR  name :="ELBIT.german"; 

+new type (name);

+elbit cursor;

+enter outcode (1,12); 

+enter outcode (2  ,21  );

+enter outcode (3  ,26  );

+enter outcode (5  ,22  );

+enter outcode (4,64,""20"");

+enter incode (1,""12""); 

+enter incode (2  ,""21""  );

+enter incode (3  ,""26""  );

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

+

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""64"");

+ 

+enter outcode ( 91,"(");

+enter outcode ( 92,"/");

+enter outcode ( 93,")");

+enter outcode (123,"<");

+enter outcode (124,"!");

+enter outcode (125,">");

+enter outcode (126,"^");

+enter outcode (214,91);

+enter outcode (215,92); 

+enter outcode (216,93); 

+enter outcode (217,123); 

+enter outcode (218,124); 

+enter outcode (219,125); 

+enter outcode (251,64);

+

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223,"_") ; 

+ 

+enter incode (11,""126"");  (* rubin *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,"^") ; (* mark *)

diff --git a/system/terminal-codes/unknown/src/FT10-20.ascii b/system/terminal-codes/unknown/src/FT10-20.ascii
new file mode 100644
index 0000000..7f26910
--- /dev/null
+++ b/system/terminal-codes/unknown/src/FT10-20.ascii
@@ -0,0 +1,75 @@
+                                                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 14.07.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="FT10/20.ascii"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""27"H");                      (* HOP                   *) 

+enter incode ( 2, ""27"C");                      (* RECHTS                *) 

+enter incode ( 3, ""27"A");                      (* OBEN                  *) 

+enter incode ( 4, ""4"");      (* CNTL D    *)   (* INFO                  *) 

+enter incode ( 7, ""2"");      (* CNTL B    *)   (* SV                    *) 

+enter incode ( 7, ""7"");      (* CNTL G    *)   (* SV                    *) 

+enter incode ( 8, ""27"D");                      (* LINKS                 *) 

+enter incode ( 9, ""27">");    (* BACKTAB   *)   (* TAB                   *) 

+enter incode (10, ""27"B");                      (* UNTEN                 *) 

+enter incode (11, ""27"K");                      (* RUBIN                 *) 

+enter incode (12, ""27"E");                      (* RUBOUT                *) 

+enter incode (12, ""127"");    (* DEL       *)   (* RUBOUT                *) 

+enter incode (16, ""27"J");                      (* MARK                  *) 

+enter incode (17, ""1"");      (* CNTL A    *)   (* STOP                  *) 

+enter incode (23, ""3"");      (* CNTL C    *)   (* WEITER                *) 

+enter incode (24, ""0"") ;     (* BREAK     *)   (* weitere ESC-Zeichen   *)

+enter incode (25, ""27"N") ;   (* LOCAL     *)   (*                       *)

+enter incode (26, ""27"V") ;   (* UNLOCK    *)   (*                       *)

+enter incode (28, ""27"I") ;   (* SEND PAGE *)   (*                       *)

+

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+

+enter outcode ( 0, "");                          (* NULL                  *)

+enter outcode ( 1,  0, ""27"H");                 (* HOME                  *)

+enter outcode ( 2, 12);                          (* RECHTS                *)

+enter outcode ( 3, 11);                          (* OBEN                  *)

+enter outcode ( 4, 40, ""27"J");                 (* CL EOP                *)

+enter outcode ( 5,  0, ""27"K");                 (* CL EOL                *)

+enter outcode ( 7,  7);                          (* BELL                  *)

+enter outcode ( 8,  8);                          (* LINKS                 *)

+enter outcode (10, 10);                          (* UNTEN                 *)

+enter outcode (13, 13);                          (* RETURN                *)

+enter outcode (14,  0, ""27"d@ ");               (* END MARK              *)

+enter outcode (15,  0, ""27"dP ");               (* BEGIN MARK            *)

+

+enter outcode (27, 27);                          (* ESC                   *)

+

+enter outcode (20, 14);                          (* shift out - grafic on *)

+enter outcode (24, 14);

+enter outcode (21, 15);                          (* shift in  - grafic off*)

+enter outcode (25, 15);

+enter outcode (26,  5);                          (* answer back message   *)

+ 

+cursor logic (32,""27"F","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode ( 92, ""27"/");                     (* backslash             *)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+enter outcode (214, 0, ""27" 1"14""034""15"");   (* �                     *)

+enter outcode (215, 0, ""27" 1"14""046""15"");   (* �                     *)

+enter outcode (216, 0, ""27" 1"14""052""15"");   (* �                     *)

+enter outcode (217, 0, ""27" 1"14""066""15"");   (* �                     *)

+enter outcode (218, 0, ""27" 1"14""078""15"");   (* �                     *)

+enter outcode (219, 0, ""27" 1"14""084""15"");   (* �                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, 0, ""27" 3"14""077""15"");   (* Trenn-Strich          *)

+enter outcode (222, 0, ""27" 4"14""069""15"");   (* gesch. Nummerkreuz    *)

+enter outcode (223, 0, ""27" 2"14""110""15"");   (* gesch. Blank          *)

+enter outcode (251, 0, ""27" 1"14""062""15"");   (* �                     *)

+enter outcode (252, 0, ""27" 1"14""063""15"");   (* �                     *)

diff --git a/system/terminal-codes/unknown/src/FT10-20.german b/system/terminal-codes/unknown/src/FT10-20.german
new file mode 100644
index 0000000..09d4337
--- /dev/null
+++ b/system/terminal-codes/unknown/src/FT10-20.german
@@ -0,0 +1,94 @@
+                                                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 14.07.86      *)

+ 

+INT VAR i; 

+TEXT VAR table :="FT10/20.german"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""27"H");                      (* HOP                   *) 

+enter incode ( 2, ""27"C");                      (* RECHTS                *) 

+enter incode ( 3, ""27"A");                      (* OBEN                  *) 

+enter incode ( 4, ""4"");      (* CNTL D    *)   (* INFO                  *) 

+enter incode ( 7, ""2"");      (* CNTL B    *)   (* SV                    *) 

+enter incode ( 7, ""7"");      (* CNTL G    *)   (* SV                    *) 

+enter incode ( 8, ""27"D");                      (* LINKS                 *) 

+enter incode ( 9, ""27">");    (* BACKTAB   *)   (* TAB                   *) 

+enter incode (10, ""27"B");                      (* UNTEN                 *) 

+enter incode (11, ""27"K");                      (* RUBIN                 *) 

+enter incode (12, ""27"E");                      (* RUBOUT                *) 

+enter incode (12, ""127"");    (* DEL       *)   (* RUBOUT                *) 

+enter incode (16, ""27"J");                      (* MARK                  *) 

+enter incode (17, ""1"");      (* CNTL A    *)   (* STOP                  *) 

+enter incode (23, ""3"");      (* CNTL C    *)   (* WEITER                *) 

+enter incode (24, ""0"") ;     (* BREAK     *)   (* weitere ESC-Zeichen   *)

+enter incode (25, ""27"N") ;   (* LOCAL     *)   (*                       *)

+enter incode (26, ""27"V") ;   (* UNLOCK    *)   (*                       *)

+enter incode (28, ""27"I") ;   (* SEND PAGE *)   (*                       *)

+

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+

+enter outcode ( 0, "");                          (* NULL                  *)

+enter outcode ( 1,  0, ""27"H");                 (* HOME                  *)

+enter outcode ( 2, 12);                          (* RECHTS                *)

+enter outcode ( 3, 11);                          (* OBEN                  *)

+enter outcode ( 4, 40, ""27"J");                 (* CL EOP                *)

+enter outcode ( 5,  0, ""27"K");                 (* CL EOL                *)

+enter outcode ( 7,  7);                          (* BELL                  *)

+enter outcode ( 8,  8);                          (* LINKS                 *)

+enter outcode (10, 10);                          (* UNTEN                 *)

+enter outcode (13, 13);                          (* RETURN                *)

+enter outcode (14,  0, ""27"d@ ");               (* END MARK              *)

+enter outcode (15,  0, ""27"dP ");               (* BEGIN MARK            *)

+

+enter outcode (27, 27);                          (* ESC                   *)

+

+enter outcode (20, 14);                          (* shift out - grafic on *)

+enter outcode (24, 14);

+enter outcode (21, 15);                          (* shift in  - grafic off*)

+enter outcode (25, 15);

+enter outcode (26,  5);                          (* answer back message   *)

+ 

+cursor logic (32,""27"F","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode ( 39, "/");                         (* '                     *)

+enter incode ( 47, "'");                         (* /                     *)

+enter incode ( 92, ""27"/");                     (* backslash             *)

+enter incode (214, ""91"");                      (* �                     *)

+enter incode (215, ""92"");                      (* �                     *)

+enter incode (216, ""93"");                      (* �                     *)

+enter incode (217, ""123"");                     (* �                     *)

+enter incode (218, ""124"");                     (* �                     *)

+enter incode (219, ""125"");                     (* �                     *)

+enter incode (251, ""126"");                     (* �                     *)

+enter incode (252, ""064"");                     (* �                     *)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+ 

+enter outcode ( 64, 0, ""27" 0"14""064""15"");   (* @                     *)

+enter outcode ( 91, 0, ""27" 0"14""091""15"");   (* [                     *)

+enter outcode ( 92, 0, ""27" 0"14""092""15"");   (* \                     *)

+enter outcode ( 93, 0, ""27" 0"14""093""15"");   (* ]                     *)

+enter outcode (123, 0, ""27" 0"14""123""15"");   (* geschw. Klammer auf   *)

+enter outcode (124, 0, ""27" 0"14""124""15"");   (* |                     *)

+enter outcode (125, 0, ""27" 0"14""125""15"");   (* geschw. Klammer zu    *)

+enter outcode (126, 0, ""27" 0"14""126""15"");   (* ~                     *)

+enter outcode (214,  91);                        (* �                     *)

+enter outcode (215,  92);                        (* �                     *)

+enter outcode (216,  93);                        (* �                     *)

+enter outcode (217, 123);                        (* �                     *)

+enter outcode (218, 124);                        (* �                     *)

+enter outcode (219, 125);                        (* �                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, 0, ""27" 3"14""077""15"");   (* Trenn-Strich          *)

+enter outcode (222, 0, ""27" 4"14""069""15"");   (* gesch. Nummerkreuz    *)

+enter outcode (223, 0, ""27" 2"14""110""15"");   (* gesch. Blank          *)

+enter outcode (251, 126);                        (* �                     *)

+enter outcode (252,  64);                        (* �                     *)

diff --git a/system/terminal-codes/unknown/src/GENGEN.ELA b/system/terminal-codes/unknown/src/GENGEN.ELA
new file mode 100644
index 0000000..2add75a
--- /dev/null
+++ b/system/terminal-codes/unknown/src/GENGEN.ELA
@@ -0,0 +1,244 @@
+(* Typtabellengenerierungsprogramm, Stand : 26.11.85 *) 

+ 

+page ; 

+putline ("- Erzeugen einer .gen Datei aus einer Typtabelle -") ; 

+line ; 

+BOUND STRUCT (ALIGN space, ROW 128 INT outcodes, 

+                           ROW  64 INT outstrings,

+                           ROW  64 INT instrings) VAR x ; 

+ 

+TEXT VAR t , filename ; 

+INT VAR i , laenge , position , eumel code ; 

+FILE VAR f ; 

+put ("Name der Tabelle:") ; 

+getline (t) ; 

+IF exists (t+".gen") THEN forget (t+".gen") FI ; 

+IF exists (t+".gen") 

+THEN filename := t + ".new.gen" 

+ELSE filename := t + ".gen"

+FI ; 

+f := sequentialfile (output, filename) ; 

+putline (f, "(" + 49 * "*" + ")") ; 

+putline (f, "(* Typtabelle   : " + text (t, 30) + " *)") ; 

+putline (f, "(* Generiert am : " + text (date, 30) + " *)") ; 

+putline (f, "(" + 49 * "*" + ")") ; 

+line (f) ; 

+putline (f, "forget (""" + t + """, quiet) ;") ; 

+putline (f, "new type (""" + t + """) ;") ; 

+line (f) ; 

+x := old (t) ; 

+t := "  " ; 

+IF (x.outstrings (1) AND 255) = 2 

+   THEN putline (f, "elbit cursor ;") ; 

+        line (f) ; 

+   ELSE write (f, "cursor logic (") ; 

+        put (f, text (x.outstrings (2) AND 255) + ",") ; 

+        position := (x.outcodes (4) AND 127) + 1 ;

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        put (f, denoter (x.outstrings, position, 0) + ",") ; 

+        position INCR (laenge + 2) ; 

+        putline (f, denoter (x.outstrings, position, 0) + ") ;") ; 

+        line (f)

+FI ; 

+putline (f, "(* Ausgabe Codes : *)") ; 

+FOR i FROM 1 UPTO 128 REP 

+ cout (lineno (f)) ;

+ replace (t, 1, x.outcodes (i)) ; 

+ IF i <> 4 

+ THEN IF code (t SUB 1) <> 255 

+      THEN eumel code := (i-1) * 2 ; 

+           put (f, "enter outcode (" + text (eumel code, 3) + ",") ; 

+           IF code (t SUB 1) > 127 

+           THEN outstring (code (t SUB 1)-128) 

+           ELSE numberput (code (t SUB 1)) 

+           FI ; 

+           line (f) 

+      FI 

+ FI ; 

+ IF code (t SUB 2) <> 255 

+ THEN eumel code := (i-1) * 2 + 1 ; 

+      put (f, "enter outcode (" + text (eumel code, 3) + ",") ;

+      IF code (t SUB 2) > 127 

+      THEN outstring (code (t SUB 2) - 128) 

+      ELSE numberput (code (t SUB 2)) 

+      FI ; 

+      line (f) 

+ FI ; 

+PER ; 

+line (f) ; 

+line (f) ; 

+ 

+putline (f, "(* Eingabe Codes : *)") ; 

+i := 0 ; 

+WHILE i < 128 CAND incode (i) <> 255 REP

+ cout (lineno (f)) ; 

+ eumel code := incode (i) ; 

+ put (f, "enter incode (" + text (eumel code,3) + ",") ; 

+ write (f, denoter (x.instrings, i + 1, 255)) ; 

+ put (f, ") ; (*") ; 

+ i INCR 1 ; 

+ IF in bezeichnung (eumel code) <> "" 

+ THEN put (f, in bezeichnung (eumel code) + ":") 

+ FI ; 

+ WHILE i < 128 CAND incode (i) <> 255 REP 

+  charput (incode (i)) ; 

+  i INCR 1 

+ PER ; 

+ i INCR 1 ; 

+ putline (f, "*)") 

+PER ; 

+ 

+edit (filename) ; 

+ 

+INT PROC incode (INT CONST element) : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.instrings (element DIV 2 + 1)); 

+ IF (element MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC incode ; 

+ 

+ 

+TEXT PROC in bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "HOP         " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 7 : "SV - Call   " 

+  CASE 8 : "Cursor left " 

+  CASE 9 : "TAB         " 

+  CASE 10: "Cursor down " 

+  CASE 11: "RUBIN       " 

+  CASE 12: "RUBOUT      "

+  CASE 13: "CR          " 

+  CASE 16: "MARK        " 

+  CASE 17: "Stop        " 

+  CASE 23: "Weiter      " 

+  CASE 27: "Escape      "

+  CASE 214:"ae-Taste    " 

+  CASE 215:"oe-Taste    " 

+  CASE 216:"ue-Taste    "

+  CASE 217:"Ae-Taste    " 

+  CASE 218:"Oe-Taste    " 

+  CASE 219:"Ue-Taste    " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz-Taste    " 

+  OTHERWISE IF code < 32 THEN "Funct.-Taste" 

+                         ELSE "" 

+            FI 

+ ENDSELECT 

+ENDPROC in bezeichnung ; 

+ 

+TEXT PROC out bezeichnung (INT CONST code) : 

+ SELECT code OF 

+  CASE 1 : "Cursor Home " 

+  CASE 2 : "Cursor right"

+  CASE 3 : "Cursor up   " 

+  CASE 4 : "CLEOP       " 

+  CASE 5 : "CLEOL       " 

+  CASE 6 : "Cursor (YX) " 

+  CASE 7 : "Beep        " 

+  CASE 8 : "Cursor left " 

+  CASE 10: "Cursor down " 

+  CASE 13: "CR          " 

+  CASE 14: "END MARK    " 

+  CASE 15: "BEGIN MARK  " 

+  CASE 214:"ae          " 

+  CASE 215:"oe          " 

+  CASE 216:"ue          "

+  CASE 217:"Ae          " 

+  CASE 218:"Oe          " 

+  CASE 219:"Ue          " 

+  CASE 220:"Trenn-k     " 

+  CASE 221:"Trennstrich " 

+  CASE 222:"Fest-#      " 

+  CASE 223:"Fest-Blank  " 

+  CASE 251:"sz          " 

+  OTHERWISE ""

+ ENDSELECT 

+ENDPROC out bezeichnung ; 

+ 

+PROC charput (INT CONST nr) : 

+ IF nr = 27 THEN put (f, "<ESC>") 

+ ELIF nr = 10 THEN put (f, "<LF>") 

+ ELIF nr = 13 THEN put (f, "<CR>") 

+ ELIF nr = 32 THEN put (f, "<SPACE>") 

+ ELIF nr = 127 THEN put (f, "<DEL>") 

+ ELIF nr > 127 THEN put (f, "<" + text (nr) + ">") 

+ ELIF nr > 32 THEN put (f, code (nr))

+ ELSE put (f, "<CTRL-" + code (nr+64) + ">") 

+ FI 

+ENDPROC charput ; 

+ 

+PROC numberput (INT CONST nr) : 

+ put (f, text (nr,3 ) + ") ; (*") ;

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ; 

+ charput (nr) ; 

+ put (f, "*)") ; 

+ENDPROC numberput ; 

+ 

+TEXT PROC denoter (ROW 64 INT VAR y, INT CONST pos, ende) : 

+ INT VAR i := pos ; 

+ TEXT VAR t := "  " , zeile := """" ; 

+ laenge := 0 ; 

+ WHILE i < 128 AND zugriff <> ende REP 

+  IF zugriff > 31 AND zugriff < 127 THEN zeile CAT code (zugriff) 

+  ELIF zugriff = 34 THEN zeile CAT """"""

+  ELIF zugriff = 251 THEN zeile CAT "ß" 

+  ELIF zugriff > 216 AND zugriff < 224 THEN zeile CAT code (zugriff) 

+  ELSE zeile CAT """" ; 

+       zeile CAT text (zugriff) ; 

+       zeile CAT """" 

+  FI ; 

+  i INCR 1 ; 

+  laenge INCR 1 

+ PER ; 

+ zeile CAT """" ; 

+ zeile. 

+ 

+ 

+zugriff : 

+ replace (t, 1, y (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC denoter ; 

+ 

+ 

+PROC outstring (INT CONST element) : 

+ INT VAR i := element ; 

+ put (f, text (zugriff) + ",") ; 

+ put (f, denoter (x.outstrings, i + 1, 0) + ") ; (*") ; 

+ IF out bezeichnung (eumel code) <> "" 

+ THEN put (f, out bezeichnung (eumel code) + ":") 

+ FI ;

+ i INCR 1 ; 

+ WHILE zugriff <> 0 REP 

+  charput (zugriff) ; 

+  i INCR 1 

+ PER ; 

+ put (f, "*)") . 

+ 

+ 

+zugriff : 

+ TEXT VAR t := "  " ; 

+ replace (t, 1, x.outstrings (i DIV 2 + 1)) ;

+ IF (i MOD 2) = 0 THEN code (t SUB 1) 

+ ELSE code (t SUB 2) 

+ FI 

+ENDPROC outstring 

+

+

+

+

+

+

+

+

+

diff --git a/system/terminal-codes/unknown/src/GT100 b/system/terminal-codes/unknown/src/GT100
new file mode 100644
index 0000000..c366d09
--- /dev/null
+++ b/system/terminal-codes/unknown/src/GT100
@@ -0,0 +1,44 @@
+TEXT VAR  name :="GT100";

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""27"H");

+enter outcode (2 ,0,""27"C");

+enter outcode (3 ,0,""27"A");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""126"");

+enter outcode (15,0,""126"");

+ 

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+ 

+enter outcode (214,91);

+enter outcode (215,92);

+enter outcode (216,93);

+enter outcode (217,123);

+enter outcode (218,124);

+enter outcode (219,125);

+enter outcode (223,"_") ; 

+enter outcode (251,"B");

+ 

+ 

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11""); 

+enter incode (10,""10"");

+enter incode ( 8,""8"");

+enter incode (11,""6"");

+enter incode (12,""127"");

+enter incode (16,""26"");

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""27"z");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""17"");  (* weiter *)

+

diff --git a/system/terminal-codes/unknown/src/IBM.PC.AT b/system/terminal-codes/unknown/src/IBM.PC.AT
new file mode 100644
index 0000000..7c7a80c
--- /dev/null
+++ b/system/terminal-codes/unknown/src/IBM.PC.AT
@@ -0,0 +1,63 @@
+LET name = "IBM.PC.AT"; 

+forget (name, quiet); 

+new type (name); 

+ 

+cursor logic (0, ""6"", "", "");

+ 

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* Ä *)

+enter outcode (215, 153);                 (* Ö *)

+enter outcode (216, 154);                 (* Ü *)

+enter outcode (217, 132);                 (* ä *)

+enter outcode (218, 148);                 (* ö *)

+enter outcode (219, 129);                 (* ü *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* ß *) 

+ 

+enter incode (  1, ""199"");              (* HOP *)

+enter incode (  2, ""205"");              (* RECHTS *)

+enter incode (  3, ""200"");              (* OBEN *)

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""2"");              (* SV *)

+enter incode (  7, ""187"");              (* SV *)

+enter incode (  8, ""203"");              (* LINKS *)

+enter incode ( 10, ""208"");              (* UNTEN *)

+enter incode ( 11, ""210"");              (* RUBIN *)

+enter incode ( 12, ""211"");              (* RUBOUT *)

+enter incode ( 16, ""201"");              (* MARK *)

+enter incode ( 17,   ""1"");              (* STOP *)

+enter incode ( 18, ""209"");              (* NEWLINE *)

+enter incode ( 23,   ""3"");              (* WEITER *)

+enter incode ( 27,  ""96"");              (* ESC *)

+enter incode ( 34,  ""64"");              (* " *)

+enter incode ( 38,  ""94"");              (* & *)

+enter incode ( 39,  ""61"");              (* ' *)

+enter incode ( 40,  ""42"");              (* ( *)

+enter incode ( 41,  ""40"");              (* ) *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode ( 43,  ""93"");              (* + *)

+enter incode ( 45,  ""47"");              (* - *)

+enter incode ( 47,  ""38"");              (* / *)

+enter incode ( 58,  ""62"");              (* : *)

+enter incode ( 59,  ""60"");              (* ; *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 61,  ""41"");              (* = *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode ( 63,  ""95"");              (* ? *)

+enter incode ( 89,  ""90"");              (* Y *)

+enter incode ( 90,  ""89"");              (* Z *)

+enter incode ( 95,  ""63"");              (* _ *)

+enter incode ( 96,  ""43"");              (* ` *)

+enter incode (121, ""122"");              (* y *)

+enter incode (122, ""121"");              (* z *)

+enter incode (214,  ""34"");              (* Ä *)

+enter incode (215,  ""58"");              (* Ö *)

+enter incode (216, ""123"");              (* Ü *)

+enter incode (217,  ""39"");              (* ä *)

+enter incode (218,  ""59"");              (* ö *)

+enter incode (219,  ""91"");              (* ü *)

+enter incode (251,  ""45"");              (* ß *)

diff --git a/system/terminal-codes/unknown/src/M20 b/system/terminal-codes/unknown/src/M20
new file mode 100644
index 0000000..6de575a
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M20
@@ -0,0 +1,10 @@
+TEXT VAR  name :="M20"; 

+command dialogue (FALSE); forget (name); 

+new type (name);

+cursor logic (0,""6"","","");

+ 

+enter incode (7,""7"");  (* sv *)

+ 

+ 

+enter outcode (14,""14""); 

+enter outcode (15,""15"");

diff --git a/system/terminal-codes/unknown/src/M20.original b/system/terminal-codes/unknown/src/M20.original
new file mode 100644
index 0000000..31bb7c4
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M20.original
@@ -0,0 +1,27 @@
+TEXT VAR name := "M20.original"; 

+command dialogue (FALSE); forget (name);

+new type (name); 

+cursor logic (0,""6"","",""); 

+ 

+enter outcode (14, ""14""); 

+enter outcode (15, ""15""); 

+ 

+enter incode (7,""7"");  (* sv *)

+enter incode ( code ( ";" ), "!"); 

+enter incode ( code ( "=" ), "@"); 

+enter incode ( code ( "%" ), "$"); 

+enter incode ( code ( "&" ), "%"); 

+enter incode ( code ( "(" ), "&"); 

+enter incode ( code ( ")" ), "/"); 

+enter incode ( code ( "_" ), "("); 

+enter incode ( code ( "@" ), ")"); 

+enter incode ( code ( "/" ), "="); 

+enter incode ( code ( ":" ), "?"); 

+enter incode ( code ( "^" ), "�"); 

+enter incode ( code ( "!" ), ":"); 

+enter incode ( code ( "�" ), "_"); 

+enter incode ( code ( "$" ), "#"); 

+enter incode ( code ( "#" ), "^"); 

+enter incode ( code ( "?" ), ";");

+

+command dialogue (TRUE);

diff --git a/system/terminal-codes/unknown/src/M24 b/system/terminal-codes/unknown/src/M24
new file mode 100644
index 0000000..2588f03
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M24
@@ -0,0 +1,63 @@
+LET name = "M24"; 

+forget (name, quiet); 

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* Ä *)

+enter outcode (215, 153);                 (* Ö *)

+enter outcode (216, 154);                 (* Ü *)

+enter outcode (217, 132);                 (* ä *)

+enter outcode (218, 148);                 (* ö *)

+enter outcode (219, 129);                 (* ü *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* ß *) 

+ 

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""7"");              (* SV *)

+enter incode (  7, ""206"");              (* SV *)

+enter incode ( 17,  ""17"");              (* STOP *)

+enter incode ( 17, ""208"");              (* STOP *)

+enter incode ( 23,  ""23"");              (* WEITER *)

+enter incode ( 23, ""207"");              (* WEITER *)

+

+enter incode ( 34,  ""64"");              (* " *)

+enter incode ( 35,  ""96"");              (* # *)

+enter incode ( 38,  ""94"");              (* & *)

+enter incode ( 39,  ""61"");              (* ' *)

+enter incode ( 40,  ""42"");              (* ( *)

+enter incode ( 41,  ""40"");              (* ) *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode ( 42, ""201"");              (* * *)

+enter incode ( 43,  ""93"");              (* + *)

+enter incode ( 43, ""203"");              (* + *)

+enter incode ( 45,  ""47"");              (* - *)

+enter incode ( 45, ""202"");              (* - *)

+enter incode ( 47,  ""38"");              (* / *)

+enter incode ( 47, ""200"");              (* / *) 

+enter incode ( 58,  ""62"");              (* : *)

+enter incode ( 59,  ""60"");              (* ; *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 61,  ""41"");              (* = *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode ( 63,  ""95"");              (* ? *)

+enter incode ( 64,  ""35"");              (* @ *)

+enter incode ( 89,  ""90"");              (* Y *)

+enter incode ( 90,  ""89"");              (* Z *)

+enter incode ( 94, ""126"");              (* ^ *)

+enter incode ( 95,  ""63"");              (* _ *)

+enter incode ( 96,  ""43"");              (* ` *)

+enter incode (121, ""122"");              (* y *)

+enter incode (122, ""121"");              (* z *)

+enter incode (214,  ""34"");              (* Ä *)

+enter incode (215,  ""58"");              (* Ö *)

+enter incode (216, ""123"");              (* Ü *)

+enter incode (217,  ""39"");              (* ä *)

+enter incode (218,  ""59"");              (* ö *)

+enter incode (219,  ""91"");              (* ü *)

+enter incode (251,  ""45"");              (* ß *)

diff --git a/system/terminal-codes/unknown/src/M24.keybfr1 b/system/terminal-codes/unknown/src/M24.keybfr1
new file mode 100644
index 0000000..33949d4
--- /dev/null
+++ b/system/terminal-codes/unknown/src/M24.keybfr1
@@ -0,0 +1,64 @@
+

+LET name = "M24.keybfr1";

+forget(name,quiet);

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* � *)

+enter outcode (215, 153);                 (* � *)

+enter outcode (216, 154);                 (* � *)

+enter outcode (217, 132);                 (* � *)

+enter outcode (218, 148);                 (* � *)

+enter outcode (219, 129);                 (* � *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225); 

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""7"");              (* SV *)

+enter incode (  7, ""206"");              (* SV *)

+enter incode ( 17,  ""17"");              (* STOP *)

+enter incode ( 17, ""208"");              (* STOP *)

+enter incode ( 23,  ""23"");              (* WEITER *)

+enter incode ( 23, ""207"");              (* WEITER *)

+enter incode ( 45,  ""61"");              (* - *)

+enter incode (125,  ""96"");              (*   *)

+enter incode ( 41,  ""95"");              (* ) *)

+enter incode ( 35,  ""45"");              (* # *)

+enter incode ( 38,  ""33"");              (* & *)

+enter incode (130,  ""64"");              (* � *)

+enter incode ( 34,  ""35"");              (* " *)

+enter incode ( 39,  ""36"");              (* ' *)

+enter incode ( 40,  ""37"");              (* ( *)

+enter incode (151,  ""39"");              (* � *)

+enter incode (138,  ""38"");              (* � *)

+enter incode ( 33,  ""42"");              (* ! *)

+enter incode (135,  ""40"");              (* � *)

+enter incode (133,  ""41"");              (* � *)

+enter incode ( 97, ""113"");              (* a *)

+enter incode ( 65,  ""81"");              (* A *)

+enter incode ( 122,""119"");              (* z *)

+enter incode ( 90,  ""87"");              (* Z *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode (113,  ""97"");              (* q *)

+enter incode ( 81,  ""65"");              (* Q *)

+enter incode (109,  ""59"");              (* m *)

+enter incode ( 77,  ""58"");              (* M *)

+enter incode ( 37,  ""34"");              (* % *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode (119, ""122"");              (* w *)

+enter incode ( 87,  ""90"");              (* W *)

+enter incode ( 44, ""109"");              (* , *)

+enter incode ( 63,  ""77"");              (* ? *)

+enter incode ( 59,  ""44"");              (* ; *)

+enter incode ( 46,  ""60"");              (* . *)

+enter incode ( 58,  ""46"");              (* : *)

+enter incode ( 61,  ""47"");              (* = *)

+enter incode ( 43,  ""63"");              (* + *)

+enter incode ( 47,  ""62"");              (* / *)

+

diff --git a/system/terminal-codes/unknown/src/PC.KB2 b/system/terminal-codes/unknown/src/PC.KB2
new file mode 100644
index 0000000..4917eb0
--- /dev/null
+++ b/system/terminal-codes/unknown/src/PC.KB2
@@ -0,0 +1,79 @@
+LET type = "PC.KB2";

+IF exists (type) THEN forget (type, quiet) FI;

+new type (type);

+cursor logic (0, ""6"", "", "");

+ 

+enter outcode ( 14, 0, ""14" ");      {end mark}

+enter outcode ( 15, 0, ""15" ");      {begin mark}

+enter outcode (214, ""142"");         {Ä}

+enter outcode (215, ""153"");         {Ö}

+enter outcode (216, ""154"");         {Ü}

+enter outcode (217, ""132"");         {ä}

+enter outcode (218, ""148"");         {ö}

+enter outcode (219, ""129"");         {ü}

+enter outcode (220, 0, ""15"k"14"");  {trenn-k}

+enter outcode (221, 0, ""15"-"14"");  {trenn-strich}

+enter outcode (222, 0, ""15"#"14"");  {pseudo-fis}

+enter outcode (223, 0, ""15" "14"");  {pseudo-blank}

+enter outcode (251, ""225"");         {ß}

+ 

+enter incode (  1, ""199"");          {hop}

+enter incode (  2, ""205"");          {rechts}

+enter incode (  3, ""200"");          {oben}

+enter incode (  7, ""2"");            {sv: ctrl b}

+enter incode (  7, ""187"");          {sv: f1}

+enter incode (  8, ""203"");          {links}

+enter incode ( 10, ""208"");          {unten}

+enter incode ( 11, ""210"");          {rubin: ins}

+enter incode ( 12, ""211"");          {rubout: del}

+enter incode ( 16, ""201"");          {mark: pg up}

+enter incode ( 17, ""1"");            {stop: ctrl a}

+

+(*

+enter incode ( 18, ""190"");          {""18"": f2}

+enter incode ( 19, ""191"");          {""19"": f3}

+enter incode ( 20, ""192"");          {""20"": f4}

+enter incode ( 21, ""193"");          {""21"": f5}

+enter incode ( 22, ""194"");          {""22"": f6}

+*)

+

+enter incode ( 23, ""3"");            {start: ctrl b}

+enter incode ( 23, "00");             {start: 00}

+

+(*

+enter incode ( 24, ""195"");          {""24"": f7}

+enter incode ( 25, ""196"");          {""25"": f8}

+enter incode ( 26, ""212"");          {""26"": f9}

+enter incode ( 28, ""213"");          {""28"": f10}

+enter incode ( 29, ""214"");          {""29"": f11}

+enter incode ( 30, ""215"");          {""30"": f12}

+enter incode ( 31, ""216"");          {""31"": f13}

+*)

+

+enter incode ( 35, ""93"");           {#}

+enter incode ( 39, ""94"");           {'}

+enter incode ( 42, ""123"");          {*}

+enter incode ( 43, ""91"");           {+}

+enter incode ( 45, ""47"");           {-}

+enter incode ( 47, ""39"");           {/}

+enter incode ( 58, ""62"");           {:}

+enter incode ( 59, ""60"");           {;}

+enter incode ( 60, ""92"");           {<}

+enter incode ( 61, ""95"");           {=}

+enter incode ( 62, ""124"");          {>}

+enter incode ( 63, ""61"");           {?}

+enter incode ( 64, ""35"");           {@}

+enter incode ( 89, ""90"");           {Y}

+enter incode ( 90, ""89"");           {Z}

+enter incode ( 94, ""125"");          {^}

+enter incode ( 95, ""63"");           {_}

+enter incode ( 96, ""126"");          {\}

+enter incode (121, ""122"");          {y}

+enter incode (122, ""121"");          {z}

+enter incode (214, ""42"");           {Ä}

+enter incode (215, ""43"");           {Ö}

+enter incode (216, ""96"");           {Ü}

+enter incode (217, ""58"");           {ä}

+enter incode (218, ""59"");           {ö}

+enter incode (219, ""64"");           {ü}

+enter incode (251, ""45"");           {ß}

diff --git a/system/terminal-codes/unknown/src/PC.french b/system/terminal-codes/unknown/src/PC.french
new file mode 100644
index 0000000..6a1675c
--- /dev/null
+++ b/system/terminal-codes/unknown/src/PC.french
@@ -0,0 +1,68 @@
+LET name = "PC.french"; 

+forget (name, quiet); 

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* � *)

+enter outcode (215, 153);                 (* � *)

+enter outcode (216, 154);                 (* � *)

+enter outcode (217, 132);                 (* � *)

+enter outcode (218, 148);                 (* � *)

+enter outcode (219, 129);                 (* � *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* � *) 

+

+enter incode (  1, ""199"");              (* HOP *)

+enter incode (  2, ""205"");              (* RECHTS *)

+enter incode (  3, ""200"");              (* OBEN *)

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""2"");              (* SV *)

+enter incode (  8, ""203"");              (* LINKS *)

+enter incode ( 10, ""208"");              (* UNTEN *)

+enter incode ( 11, ""210"");              (* RUBIN *)

+enter incode ( 12, ""211"");              (* RUBOUT *)

+enter incode ( 16, ""201"");              (* MARK *)

+enter incode ( 17,   ""1"");              (* STOP *)

+enter incode ( 18, ""209"");              (* NEWLINE *)

+enter incode ( 23,   ""3"");              (* WEITER *)

+enter incode ( 45,  ""61"");              (* - *)

+enter incode ( 41,  ""95"");              (* ) *)

+enter incode ( 35,  ""45"");              (* # *)

+enter incode ( 38,  ""33"");              (* & *)

+enter incode ( 34,  ""35"");              (* " *)

+enter incode ( 40,  ""37"");              (* ( *)

+enter incode ( 33,  ""42"");              (* ! *)

+enter incode ( 97, ""113"");              (* a *)

+enter incode ( 65,  ""81"");              (* A *)

+enter incode ( 122,""119"");              (* z *)

+enter incode ( 90,  ""87"");              (* Z *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode (113,  ""97"");              (* q *)

+enter incode ( 81,  ""65"");              (* Q *)

+enter incode (109,  ""59"");              (* m *)

+enter incode ( 77,  ""58"");              (* M *)

+enter incode ( 37,  ""34"");              (* % *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode (119, ""122"");              (* w *)

+enter incode ( 87,  ""90"");              (* W *)

+enter incode ( 44, ""109"");              (* , *)

+enter incode ( 63,  ""77"");              (* ? *)

+enter incode ( 59,  ""44"");              (* ; *)

+enter incode ( 46,  ""60"");              (* . *)

+enter incode ( 58,  ""46"");              (* : *)

+enter incode ( 61,  ""47"");              (* = *)

+enter incode ( 43,  ""63"");              (* + *)

+enter incode ( 47,  ""62"");              (* / *)

+enter incode (125,  ""96"");              (* } *)

+

+

+

+

+

diff --git a/system/terminal-codes/unknown/src/PC.german b/system/terminal-codes/unknown/src/PC.german
new file mode 100644
index 0000000..50a49fc
--- /dev/null
+++ b/system/terminal-codes/unknown/src/PC.german
@@ -0,0 +1,63 @@
+LET name = "PC.german"; 

+forget (name, quiet); 

+new type (name); 

+

+cursor logic (0, ""6"", "", "");

+

+enter outcode ( 14, 0, ""14" ");          (* end   mark *)

+enter outcode ( 15, 0, ""15" ");          (* begin mark *)

+enter outcode (214, 142);                 (* Ä *)

+enter outcode (215, 153);                 (* Ö *)

+enter outcode (216, 154);                 (* Ü *)

+enter outcode (217, 132);                 (* ä *)

+enter outcode (218, 148);                 (* ö *)

+enter outcode (219, 129);                 (* ü *)

+enter outcode (220, 0, ""15""107""14"");  (* druck k *)

+enter outcode (221, 0, ""15""45""14"");   (* druck - *)

+enter outcode (222, 0, ""15""35""14"");   (* druck # *)

+enter outcode (223, 0, ""15""32""14"");   (* druck   *)

+enter outcode (251, 225);                 (* ß *) 

+ 

+enter incode (  1, ""199"");              (* HOP *)

+enter incode (  2, ""205"");              (* RECHTS *)

+enter incode (  3, ""200"");              (* OBEN *)

+enter incode (  4,   ""4"");              (* INFO *)

+enter incode (  7,   ""2"");              (* SV *)

+enter incode (  8, ""203"");              (* LINKS *)

+enter incode ( 10, ""208"");              (* UNTEN *)

+enter incode ( 11, ""210"");              (* RUBIN *)

+enter incode ( 12, ""211"");              (* RUBOUT *)

+enter incode ( 16, ""201"");              (* MARK *)

+enter incode ( 17,   ""1"");              (* STOP *)

+enter incode ( 18, ""209"");              (* NEWLINE *)

+enter incode ( 23,   ""3"");              (* WEITER *)

+enter incode ( 34,  ""64"");              (* " *)

+enter incode ( 35,  ""96"");              (* # *)

+enter incode ( 38,  ""94"");              (* & *)

+enter incode ( 39,  ""61"");              (* ' *)

+enter incode ( 40,  ""42"");              (* ( *)

+enter incode ( 41,  ""40"");              (* ) *)

+enter incode ( 42, ""125"");              (* * *)

+enter incode ( 43,  ""93"");              (* + *)

+enter incode ( 45,  ""47"");              (* - *)

+enter incode ( 47,  ""38"");              (* / *)

+enter incode ( 58,  ""62"");              (* : *)

+enter incode ( 59,  ""60"");              (* ; *)

+enter incode ( 60,  ""92"");              (* < *)

+enter incode ( 61,  ""41"");              (* = *)

+enter incode ( 62, ""124"");              (* > *)

+enter incode ( 63,  ""95"");              (* ? *)

+enter incode ( 64, ""249"");              (* @ *)

+enter incode ( 89,  ""90"");              (* Y *)

+enter incode ( 90,  ""89"");              (* Z *)

+enter incode ( 95,  ""63"");              (* _ *)

+enter incode ( 96,  ""43"");              (* ` *)

+enter incode (121, ""122"");              (* y *)

+enter incode (122, ""121"");              (* z *)

+enter incode (214,  ""34"");              (* Ä *)

+enter incode (215,  ""58"");              (* Ö *)

+enter incode (216, ""123"");              (* Ü *)

+enter incode (217,  ""39"");              (* ä *)

+enter incode (218,  ""59"");              (* ö *)

+enter incode (219,  ""91"");              (* ü *)

+enter incode (251,  ""45"");              (* ß *)

diff --git a/system/terminal-codes/unknown/src/Qume.german b/system/terminal-codes/unknown/src/Qume.german
new file mode 100644
index 0000000..850a15b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/Qume.german
@@ -0,0 +1,77 @@
+(* 

+    Typdefinition:  Qume deutsch                          12.10.84 

+*)

+TEXT VAR  name :="Qume.german"; 

+command dialogue (FALSE);forget (name); 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,0,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (7,7); 

+enter outcode (8,8); 

+enter outcode (10,10); 

+enter outcode (13,13); 

+enter outcode (14,0,""27"G0");

+enter outcode (15,0,""27"G4");

+enter outcode (130,0,"-"); 

+enter outcode (131,0,"-"); 

+enter outcode (132,0,"-"); 

+enter outcode (133,0,"-"); 

+enter outcode (134,0,"-"); 

+enter outcode (135,0,"I"); 

+enter outcode (136,0,"I"); 

+enter outcode (137,0,"-"); 

+enter outcode (138,0,"-"); 

+enter outcode (139,0,"I"); 

+enter outcode (140,0,"I"); 

+ 

+enter outcode (214,""91"");

+enter outcode (215,""92"");

+enter outcode (216,""93"");

+enter outcode (217,""123"");

+enter outcode (218,""124"");

+enter outcode (219,""125"");

+ 

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223," ") ; 

+enter outcode (251,""126"");

+ 

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+ 

+enter incode ( 1,""26"");

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11"");

+enter incode (10,""10"");

+enter incode ( 8,""8"");

+enter incode (9,""9"");

+enter incode (11,""01""67""13"");

+enter incode (11,""01""71""13"");

+enter incode (11,""01""75""13"");

+enter incode (12,""127""); 

+enter incode (13,""13"");

+enter incode (16,""01""66""13""); 

+enter incode (16,""01""70""13""); 

+enter incode (16,""01""74""13""); 

+enter incode (17,""01""64""13""); (* stop *)

+enter incode (17,""01""68""13""); 

+enter incode (17,""01""72""13""); 

+enter incode (23,""01""65""13"");  (* weiter *)

+enter incode (23,""01""69""13""); 

+enter incode (23,""01""73""13""); 

+ 

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""0"");  (* sv *)

+ 

+command dialogue (TRUE);            (* 12.10.84 *) 

diff --git a/system/terminal-codes/unknown/src/REGENT25 b/system/terminal-codes/unknown/src/REGENT25
new file mode 100644
index 0000000..25955d6
--- /dev/null
+++ b/system/terminal-codes/unknown/src/REGENT25
@@ -0,0 +1,34 @@
+TEXT VAR  name :="REGENT25"; 

+new type (name);

+cursor logic (32,""27"Y","","");

+enter outcode (1,0,""27"Y  "); 

+enter outcode (2  ,6   );

+enter outcode (3  ,26  );

+enter outcode (5  ,0,""27"K" );

+enter outcode (4,120,""27"k");

+ 

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223, "_");

+ 

+enter outcode (214,"A");    (* Umlaute *)

+enter outcode (215,"O"); 

+enter outcode (216,"U"); 

+enter outcode (217,"a"); 

+enter outcode (218,"o"); 

+enter outcode (219,"u"); 

+enter outcode (251,"B");

+ 

+enter incode (2  ,""6""  );

+enter incode (3  ,""26""  );

+enter incode (8  ,""21"" ); (* backspace *)

+enter incode (4,""4"");   (* info   *) 

+enter incode (7,""29"");  (* sv     *)

+enter incode (17,""3"");  (* stop *) 

+enter incode (23,""0"");  (* weiter *)

+

+

+enter incode (11,"^");      (* rubin  *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,""126"") ; (* mark   *)

diff --git a/system/terminal-codes/unknown/src/REGENT40 b/system/terminal-codes/unknown/src/REGENT40
new file mode 100644
index 0000000..4f6323a
--- /dev/null
+++ b/system/terminal-codes/unknown/src/REGENT40
@@ -0,0 +1,37 @@
+TEXT VAR  name :="REGENT40"; 

+new type (name);

+cursor logic (32,""27"Y","","");

+enter outcode (1,0,""27"Y  "); 

+enter outcode (2  ,6   );

+enter outcode (3  ,26  );

+enter outcode (5  ,0,""27"K" );

+enter outcode (4,120,""27"k");

+ 

+   enter outcode (15,0,""27"0@");     (* invers video ein = begin mark*) 

+   enter outcode (14,0,""27"0P");     (* invers video aus = end mark*) 

+ 

+enter outcode (220, "k");     (* Trenn-k *) 

+enter outcode (221, "-");     (* Trenn-  *) 

+enter outcode (222, "#"); 

+enter outcode (223, "_");

+ 

+enter outcode (214,"A");    (* Umlaute *)

+enter outcode (215,"O"); 

+enter outcode (216,"U"); 

+enter outcode (217,"a"); 

+enter outcode (218,"o"); 

+enter outcode (219,"u"); 

+enter outcode (251,"B");

+ 

+enter incode (2  ,""6""  );

+enter incode (3  ,""26""  );

+enter incode (8  ,""21"" ); (* backspace *)

+enter incode (4,""4"");   (* info   *) 

+enter incode (7,""29"");  (* sv     *)

+enter incode (17,""3"");  (* stop *) 

+enter incode (23,""0"");  (* weiter *)

+

+

+enter incode (11,"^");      (* rubin  *) 

+enter incode (12,""127"");  (* rubout *) 

+enter incode (16,""126"") ; (* mark   *)

diff --git a/system/terminal-codes/unknown/src/RUC.AT.ascii b/system/terminal-codes/unknown/src/RUC.AT.ascii
new file mode 100644
index 0000000..cad3c5b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/RUC.AT.ascii
@@ -0,0 +1,75 @@
+(*************************************************)

+(* Typtabelle   : RUC.AT.ascii                   *)

+(* Generiert am : 21.03.87                       *)

+(*************************************************)

+

+forget ("RUC.AT.ascii", quiet) ;

+new type ("RUC.AT.ascii") ;

+

+cursor logic (0, ""6"", "", "") ;

+

+(* Ausgabe Codes : *)

+enter outcode (  1,   1) ; (* Cursor Home : <CTRL-A> *) 

+enter outcode (  2,   2) ; (* Cursor right: <CTRL-B> *) 

+enter outcode (  3,   3) ; (* Cursor up   : <CTRL-C> *) 

+enter outcode (  4,   4) ; (* CLEOP       : <CTRL-D> *) 

+enter outcode (  5,   5) ; (* CLEOL       : <CTRL-E> *) 

+enter outcode (  8,   8) ; (* Cursor left : <CTRL-H> *) 

+enter outcode ( 10,  10) ; (* Cursor down : <LF> *) 

+enter outcode ( 13,  13) ; (* CR          : <CR> *) 

+enter outcode ( 14, 0, " "14"") ; (* END MARK    : <CTRL-N> <SPACE> *) 

+enter outcode ( 15, 0, ""15" ") ; (* BEGIN MARK  : <CTRL-O> <SPACE> *) 

+enter outcode (214, 0, ""142"") ; (* Ae          : <142> *) 

+enter outcode (215, 0, ""153"") ; (* Oe          : <153> *) 

+enter outcode (216, 0, ""154"") ; (* Ue          : <154> *) 

+enter outcode (217, 0, ""132"") ; (* ae          : <132> *) 

+enter outcode (218, 0, ""148"") ; (* oe          : <148> *) 

+enter outcode (219, 0, ""129"") ; (* ue          : <129> *) 

+enter outcode (220, 0, ""15"k"14"") ; (* Trenn-k : <CTRL-O> k <CTRL-N> *) 

+enter outcode (221, 0, ""15"-"14"") ; (* Trennstrich: <CTRL-O> - <CTRL-N> *) 

+enter outcode (222, 0, ""15"#"14"") ; (* Fest-#  : <CTRL-O> # <CTRL-N> *) 

+enter outcode (223, 0, ""15" "14"") ; (* Fest-Blank:<CTRL-O><SPACE><CTRL-N>*) 

+enter outcode (251, 0, ""225"") ; (* sz          : <225> *) 

+enter outcode (252, 21) ;         (* paragraph   : <21> *)

+

+

+(* Eingabe Codes : *)

+enter incode ( 17, ""1"") ;   (* Stop        : <CTRL-A> *)

+enter incode (  7, ""2"") ;   (* SV - Call   : <CTRL-B> *)

+enter incode (  7, ""187"");  (* SV - Call   : F1 *)

+enter incode ( 23, ""3"") ;   (* Weiter      : <CTRL-C> *)

+enter incode (  4, ""4"") ;   (* INFO        : <CTRL-D> *)

+enter incode (  1, ""199"") ; (* HOP         : POS1  *)

+enter incode (  2, ""205"") ; (* Cursor right: <205> *)

+enter incode (  3, ""200"") ; (* Cursor up   : <200> *)

+enter incode (  8, ""203"") ; (* Cursor left : <203> *)

+enter incode ( 10, ""208"") ; (* Cursor down : <208> *)

+enter incode ( 11, ""210"") ; (* RUBIN       : INSERT *)

+enter incode ( 12, ""211"") ; (* RUBOUT      : DELETE *)

+enter incode ( 16, ""201"") ; (* MARK        : Page up *)

+                              (* AE-Taste    : F13 = SHIFT F3 *)

+                              (* OE-Taste    : F14 = SHIFT F4 *)

+                              (* UE-Taste    : F15 = SHIFT F5 *)

+                              (* ae-Taste    : F16 = SHIFT F6 *)

+                              (* oe-Taste    : F17 = SHIFT F7 *)

+                              (* ue-Taste    : F18 = SHIFT F8 *)

+                              (* trenn-k     : F19 = SHIFT F9 *)

+                              (* trenn -     : F20 = SHIFT F10 *)

+                              (* fix #       : F21 = CTRL  F1 *) 

+                              (* fix blank   : F22 = CTRL  F2 *) 

+enter incode (252, ""224"") ; (* paragraph   : F23 = CTRL  F3 *)

+enter incode (251, ""225"") ; (* sz-Taste    : F24 = CTRL  F4 *)

+enter incode ( 14, ""207"") ; (* Funct.-Taste: END   *)

+enter incode ( 15, ""204"") ; (* Funct.-Taste: Num-5 *)

+enter incode ( 18, ""209"") ; (* NEWLINE     : Page down *)

+enter incode ( 19, ""188"") ; (* Funct.-Taste: F2    *)

+enter incode ( 20, ""189"") ; (* Funct.-Taste: F3    *)

+enter incode ( 21, ""190"") ; (* Funct.-Taste: F4    *)

+enter incode ( 22, ""191"") ; (* Funct.-Taste: F5    *)

+enter incode ( 24, ""192"") ; (* Funct.-Taste: F6    *)

+enter incode ( 25, ""193"") ; (* Funct.-Taste: F7    *)

+enter incode ( 26, ""194"") ; (* Funct.-Taste: F8    *)

+enter incode ( 28, ""195"") ; (* Funct.-Taste: F9    *)

+enter incode ( 29, ""196"") ; (* Funct.-Taste: F10   *)

+enter incode ( 30, ""212"") ; (* Funct.-Taste: F11 = SHIFT F1 *)

+enter incode ( 31, ""213"") ; (* Funct.-Taste: F12 = SHIFT F2 *)

diff --git a/system/terminal-codes/unknown/src/SIEMENS.PC-D b/system/terminal-codes/unknown/src/SIEMENS.PC-D
new file mode 100644
index 0000000..8308f72
--- /dev/null
+++ b/system/terminal-codes/unknown/src/SIEMENS.PC-D
@@ -0,0 +1,88 @@
+                                                (* Autor : Rudolf Ruland *)

+                                                (* Stand : 13.05.86      *)

+

+LET csi = ""27"[";

+ 

+TEXT VAR table :="SIEMENS.PC-D"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode (  1, ""182"");                     (* HOP                   *)

+enter incode (  1, ""181"");                     (* HOP                   *)

+enter incode (  2, ""205"");                     (* RECHTS                *)

+enter incode (  2, ""207"");                     (* RECHTS                *)

+enter incode (  3, ""200"");                     (* OBEN                  *)

+enter incode (  3, ""201"");                     (* OBEN                  *)

+enter incode (  4, ""004"");   (* CTRL d    *)   (* INFO                  *)

+enter incode (  7, ""187"");   (* F1        *)   (* SV                    *)

+enter incode (  7, ""002"");   (* CTRL b    *)   (* SV                    *)

+enter incode (  8, ""199"");                     (* LINKS                 *)

+enter incode (  8, ""203"");                     (* LINKS                 *)

+enter incode (  9, ""143"");   (* BACKTAB   *)   (* TAB                   *)

+enter incode ( 10, ""208"");                     (* UNTEN                 *)

+enter incode ( 10, ""209"");                     (* UNTEN                 *)

+enter incode ( 11, ""169"");   (* EINFÜGEN  *)   (* RUBIN                 *)

+enter incode ( 11, ""210"");                     (* RUBIN                 *)

+enter incode ( 12, ""008"");   (* BACK  <X| *)   (* RUBOUT                *)

+enter incode ( 12, ""168"");   (* LÖCHEN    *)   (* RUBOUT                *)

+enter incode ( 12, ""211"");                     (* RUBOUT                *)

+enter incode ( 12, ""253"");   (* CE        *)   (* RUBOUT                *)

+enter incode ( 16, ""239"");   (* HILFE     *)   (* MARK                  *)

+enter incode ( 17, ""001"");   (* CTRL a    *)   (* STOP                  *) 

+enter incode ( 18, ""161"");   (* F12       *)   (* newline               *)

+enter incode ( 23, ""003"");   (* CTRL c    *)   (* WEITER                *) 

+enter incode ( 15, ""188"");   (* F2        *)   (* weitere ESC-Zeichen   *)

+enter incode ( 21, ""189"");   (* F3        *)

+enter incode ( 22, ""190"");   (* F4        *)

+enter incode ( 24, ""191"");   (* F5        *)

+enter incode ( 25, ""192"");   (* F6        *)

+enter incode ( 26, ""193"");   (* F7        *)

+enter incode ( 28, ""194"");   (* F8        *)

+enter incode ( 29, ""195"");   (* F9        *)

+enter incode ( 30, ""196"");   (* F10       *)

+enter incode ( 31, ""160"");   (* F11       *)

+

+ 

+enter outcode ( 0, "");                          (* NULL                  *)

+enter outcode ( 1,  0, csi + "H");               (* HOME                  *)

+enter outcode ( 2,  0, csi + "C");               (* RECHTS                *)

+enter outcode ( 3,  0, csi + "A");               (* OBEN                  *)

+enter outcode ( 4,  0, csi + "0J");              (* CL EOP                *)

+enter outcode ( 5,  0, csi + "0K");              (* CL EOL                *)

+enter outcode ( 7,  7);                          (* BELL                  *)

+enter outcode ( 8,  8);                          (* LINKS                 *)

+enter outcode (10, 10);                          (* UNTEN                 *)

+enter outcode (13, 13);                          (* RETURN                *)

+enter outcode (14,  0, csi + "m ");              (* END MARK              *)

+enter outcode (15,  0, csi + "7m ");             (* BEGIN MARK            *)

+

+enter outcode (27, 27);                          (* ESC                   *)

+

+cursor logic (1,1,csi,";","H"); 

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode ( 46, ""240"");   (* +/-       *)   (* .                     *)

+enter incode (214, ""142"");                     (* Ä                     *)

+enter incode (215, ""153"");                     (* Ö                     *)

+enter incode (216, ""154"");                     (* Ü                     *)

+enter incode (217, ""132"");                     (* ä                     *)

+enter incode (218, ""148"");                     (* ö                     *)

+enter incode (219, ""129"");                     (* ü                     *)

+enter incode (251, ""225"");                     (* ß                     *)

+enter incode (252, ""021"");                     (* ⁿ                     *)

+                                                 

+enter outcode (214, ""142"");                    (* Ä                     *)

+enter outcode (215, ""153"");                    (* Ö                     *)

+enter outcode (216, ""154"");                    (* Ü                     *)

+enter outcode (217, ""132"");                    (* ä                     *)

+enter outcode (218, ""148"");                    (* ö                     *)

+enter outcode (219, ""129"");                    (* ü                     *)

+enter outcode (220, "k"    );                    (* Trenn-k               *)

+enter outcode (221, ""205"");                    (* Trennstrich           *)

+enter outcode (222, ""206"");                    (* gesch. Nummernkreuz   *)

+enter outcode (223, ""176"");                    (* gesch. Blank          *)

+enter outcode (251, ""225"");                    (* ß                     *)

+enter outcode (252, ""021"");                    (* ⁿ                     *)

diff --git a/system/terminal-codes/unknown/src/TAP5060.ELA b/system/terminal-codes/unknown/src/TAP5060.ELA
new file mode 100644
index 0000000..a5a1d70
--- /dev/null
+++ b/system/terminal-codes/unknown/src/TAP5060.ELA
@@ -0,0 +1,49 @@
+ 

+TEXT VAR name := subtext ( std , 1 , length ( std ) - 4 ) ; 

+lastparam ( "" ) ; 

+forget ( name , quiet ) ; 

+new type ( name ) ; 

+ 

+cursor logic ( 0 , ""6"" , "" , "" ) ; 

+ 

+enter outcode ( 15 , 0, ""15" " ) ; 

+enter outcode ( 14 , 0, ""14" " ) ; 

+

+enter outcode ( 214, 142 ) ; 

+enter outcode ( 215, 153 ) ; 

+enter outcode ( 216, 154 ) ; 

+enter outcode ( 217, 132 ) ; 

+enter outcode ( 218, 148 ) ; 

+enter outcode ( 219, 129 ) ; 

+enter outcode ( 220, 0, ""15""107""14"");  (* druck k *)

+enter outcode ( 221, 0, ""15""45""14"");   (* druck - *)

+enter outcode ( 222, 0, ""15""35""14"");   (* druck # *)

+enter outcode ( 223, 0, ""15""32""14"");   (* druck   *)

+enter outcode ( 251, 225);                 (* ß *) 

+ 

+enter incode ( 214, ""142"" ) ;   (* Ä         *) 

+enter incode ( 215, ""153"" ) ;   (* Ö         *) 

+enter incode ( 216, ""154"" ) ;   (* Ü         *) 

+enter incode ( 217, ""132"" ) ;   (* ä         *) 

+enter incode ( 218, ""148"" ) ;   (* ö         *) 

+enter incode ( 219, ""129"" ) ;   (* ü         *) 

+enter incode ( 251, ""225"" ) ;   (* ß         *) 

+enter incode (  64, ""21""  ) ;   (* ⁿ         *) 

+enter incode (  96, ""36""  ) ;   (* `         *)

+ 

+enter incode (  1, ""199"" ) ;    (* hop       *) 

+enter incode (  2, ""205"" ) ;    (* right     *) 

+enter incode (  3, ""200"" ) ;    (* up        *) 

+enter incode (  7, ""187"" ) ;    (* SV -> F1  *) 

+enter incode (  7, ""2""   ) ;    (* SV        *) 

+enter incode (  8, ""203"" ) ;    (* left      *) 

+enter incode (  9, ""143"" ) ;    (* tab       *) 

+enter incode ( 10, ""208"" ) ;    (* down      *) 

+enter incode ( 11, ""210"" ) ;    (* rubin     *) 

+enter incode ( 12, ""211"" ) ;    (* rubout    *) 

+enter incode ( 16, ""198"" ) ;    (* mark      *) 

+enter incode ( 17, ""1""   ) ;    (* stop      *) 

+enter incode ( 23, ""3""   ) ;    (* start     *) 

+

+enter incode ( 187, ""136"") ;    (* F1        *)

+

diff --git a/system/terminal-codes/unknown/src/TVI.german b/system/terminal-codes/unknown/src/TVI.german
new file mode 100644
index 0000000..c24f063
--- /dev/null
+++ b/system/terminal-codes/unknown/src/TVI.german
@@ -0,0 +1,57 @@
+TEXT VAR  name :="TVI.german"; 

+command dialogue (FALSE); forget (name, quiet) ; 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""27"G0");

+enter outcode (15,0,""27"G4");

+ 

+enter outcode ( 91,0,"<");

+enter outcode ( 92,0,"/");

+enter outcode ( 93,0,">");

+enter outcode (123,0,"(");

+enter outcode (124,0,"!");

+enter outcode (125,0,")");

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (214,91);

+enter outcode (215,92);

+enter outcode (216,93);

+enter outcode (217,123);

+enter outcode (218,124);

+enter outcode (219,125);

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223,"_") ; 

+enter outcode (251,126);

+ 

+enter incode (214,""91"");

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123"");

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+ 

+enter incode (63,""0"") ;

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11"");

+enter incode (10,""22"");

+enter incode ( 8,""8"");

+enter incode (11,""27"Q");enter incode (11,""26"");

+enter incode (12,""27"W");enter incode (12,""127"");

+enter incode (16,""16"");

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

diff --git a/system/terminal-codes/unknown/src/TVI914.ascii b/system/terminal-codes/unknown/src/TVI914.ascii
new file mode 100644
index 0000000..4909462
--- /dev/null
+++ b/system/terminal-codes/unknown/src/TVI914.ascii
@@ -0,0 +1,43 @@
+TEXT VAR  name :="TVI914.ascii"; 

+command dialogue (FALSE); forget (name, quiet) ; 

+new type (name);

+cursor logic (32,""27"=","","");

+enter outcode (1 ,0,""30"");

+enter outcode (2 ,0,""12"");

+enter outcode (3 ,0,""11"");

+enter outcode (4 ,40,""27"Y");

+enter outcode (5 ,0,""27"T");

+enter outcode (14,0,""27"G0 ");

+enter outcode (15,0,""27"G4 ");

+ 

+ 

+INT VAR i ; 

+FOR i FROM 127 UPTO 255 REP 

+  enter outcode (i, "?") 

+PER ; 

+ 

+enter outcode (214,"A");

+enter outcode (215,"O");

+enter outcode (216,"U");

+enter outcode (217,"a");

+enter outcode (218,"o");

+enter outcode (219,"u");

+enter outcode (220,"k") ; 

+enter outcode (221,"-") ; 

+enter outcode (222,"#") ; 

+enter outcode (223,"_") ; 

+enter outcode (251,"B");

+ 

+enter incode (63,""0"") ;

+enter incode ( 1,""30"");

+enter incode ( 2,""12"");

+enter incode ( 3,""11"");

+enter incode (10,""22"");

+enter incode ( 8,""8"");

+enter incode (11,""27"Q");enter incode (11,""26"");

+enter incode (12,""27"W");enter incode (12,""127"");

+enter incode (16,""23"");

+enter incode (4,""4"");  (* info *) 

+enter incode (7,""2"");  (* sv *)

+enter incode (17,""1"");  (* stop *) 

+enter incode (23,""3"");  (* weiter *)

diff --git a/system/terminal-codes/unknown/src/VC404.ascii b/system/terminal-codes/unknown/src/VC404.ascii
new file mode 100644
index 0000000..614e26d
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VC404.ascii
@@ -0,0 +1,61 @@
+                                                  (* Autor : Rudolf Ruland *)

+                                                  (* Stand : 06.05.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="VC404.ascii"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""025"");                      (* HOP                   *) 

+enter incode ( 2, ""021"");                      (* ->                    *) 

+enter incode ( 3, ""026"");                      (* UP                    *) 

+enter incode ( 4, ""004"");                      (* INFO                  *) 

+enter incode ( 7, ""002"");                      (* SV                    *) 

+enter incode ( 7, ""007"");                      (* SV                    *) 

+enter incode ( 8, ""008"");                      (* <-                    *) 

+enter incode ( 9, ""009"");                      (* TAB                   *) 

+enter incode (10, ""010"");                      (* DOWN                  *) 

+enter incode (11, ""096"");                      (* RUBIN                 *) 

+enter incode (12, ""127"");                      (* RUBOUT                *) 

+enter incode (13, ""013"");                      (* RETURN                *) 

+enter incode (16, ""126"");                      (* MARK                  *) 

+enter incode (17, ""001"");                      (* STOP                  *) 

+enter incode (23, ""003"");                      (* WEITER                *) 

+ 

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+ 

+enter outcode ( 0,  "");                         (* NULL                  *)

+enter outcode ( 1,  25);                         (* HOME                  *)

+enter outcode ( 2,  21);                         (* RECHTS                *)

+enter outcode ( 3,  26);                         (* OBEN                  *)

+enter outcode ( 4, 120, ""23"");                 (* CL EOP                *)

+enter outcode ( 5,  22);                         (* CL EOL                *)

+enter outcode ( 7,   7);                         (* BELL                  *)

+enter outcode ( 8,   8);                         (* LINKS                 *)

+enter outcode (10,  10);                         (* UNTEN                 *)

+enter outcode (13,  13);                         (* RETURN                *)

+enter outcode (14, 126);                         (* END MARK              *)

+enter outcode (15, 126);                         (* BEGIN MARK            *)

+ 

+cursor logic (32,""16"","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+ 

+enter outcode (214, "A");                        (* �                     *)

+enter outcode (215, "O");                        (* �                     *)

+enter outcode (216, "U");                        (* �                     *)

+enter outcode (217, "a");                        (* �                     *)

+enter outcode (218, "o");                        (* �                     *)

+enter outcode (219, "u");                        (* �                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, "-");                        (* Trenn-Strich          *) 

+enter outcode (222, "#");                        (* gesch. Nummerkreuz    *)

+enter outcode (223, "_");                        (* gesch. Blank          *)

+enter outcode (251, "B");                        (* �                     *)

diff --git a/system/terminal-codes/unknown/src/VC404.german b/system/terminal-codes/unknown/src/VC404.german
new file mode 100644
index 0000000..4c00a44
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VC404.german
@@ -0,0 +1,75 @@
+                                                  (* Autor : Rudolf Ruland *)

+                                                  (* Stand : 06.05.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="VC404.german"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""025"");                      (* HOP                   *) 

+enter incode ( 2, ""021"");                      (* ->                    *) 

+enter incode ( 3, ""026"");                      (* UP                    *) 

+enter incode ( 4, ""004"");                      (* INFO                  *) 

+enter incode ( 7, ""002"");                      (* SV                    *) 

+enter incode ( 7, ""007"");                      (* SV                    *) 

+enter incode ( 8, ""008"");                      (* <-                    *) 

+enter incode ( 9, ""009"");                      (* TAB                   *) 

+enter incode (10, ""010"");                      (* DOWN                  *) 

+enter incode (11, ""096"");                      (* RUBIN                 *) 

+enter incode (12, ""127"");                      (* RUBOUT                *) 

+enter incode (13, ""013"");                      (* RETURN                *) 

+enter incode (16, ""126"");                      (* MARK                  *) 

+enter incode (17, ""001"");                      (* STOP                  *) 

+enter incode (23, ""003"");                      (* WEITER                *) 

+ 

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+ 

+enter outcode ( 0,  "");                         (* NULL                  *)

+enter outcode ( 1,  25);                         (* HOME                  *)

+enter outcode ( 2,  21);                         (* RECHTS                *)

+enter outcode ( 3,  26);                         (* OBEN                  *)

+enter outcode ( 4, 120, ""23"");                 (* CL EOP                *)

+enter outcode ( 5,  22);                         (* CL EOL                *)

+enter outcode ( 7,   7);                         (* BELL                  *)

+enter outcode ( 8,   8);                         (* LINKS                 *)

+enter outcode (10,  10);                         (* UNTEN                 *)

+enter outcode (13,  13);                         (* RETURN                *)

+enter outcode (14, 126);                         (* END MARK              *)

+enter outcode (15, 126);                         (* BEGIN MARK            *)

+ 

+cursor logic (32,""16"","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+enter incode (214, ""091"");                     (* Ä                     *)

+enter incode (215, ""092"");                     (* Ö                     *)

+enter incode (216, ""093"");                     (* Ü                     *)

+enter incode (217, ""123"");                     (* ä                     *)

+enter incode (218, ""124"");                     (* ö                     *)

+enter incode (219, ""125"");                     (* ü                     *)

+enter incode (251, ""064"");                     (* ß                     *)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+ 

+enter outcode ( 91, "(");                        (* [                     *)

+enter outcode ( 92, "/");                        (* \                     *)

+enter outcode ( 93, ")");                        (* ]                     *)

+enter outcode (123, "<");                        (* geschw. Klammer auf   *)

+enter outcode (124, "!");                        (* |                     *)

+enter outcode (125, ">");                        (* geschw. Klammer zu    *)

+enter outcode (214,  91);                        (* Ä                     *)

+enter outcode (215,  92);                        (* Ö                     *)

+enter outcode (216,  93);                        (* Ü                     *)

+enter outcode (217, 123);                        (* ä                     *)

+enter outcode (218, 124);                        (* ö                     *)

+enter outcode (219, 125);                        (* ü                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, "-");                        (* Trenn-Strich          *) 

+enter outcode (222, "#");                        (* gesch. Nummerkreuz    *)

+enter outcode (223, "_");                        (* gesch. Blank          *)

+enter outcode (251,  64);                        (* ß                     *)

diff --git a/system/terminal-codes/unknown/src/VC404.hrz b/system/terminal-codes/unknown/src/VC404.hrz
new file mode 100644
index 0000000..ede1743
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VC404.hrz
@@ -0,0 +1,67 @@
+                                                  (* Autor : Rudolf Ruland *)

+                                                  (* Stand : 06.05.86      *) 

+ 

+INT VAR i; 

+TEXT VAR table :="VC404.hrz"; 

+forget (table, quiet);

+new type (table);

+ 

+(******************   Steuerzeichen   *************************************)

+ 

+enter incode ( 1, ""025"");                      (* HOP                   *) 

+enter incode ( 2, ""021"");                      (* ->                    *) 

+enter incode ( 3, ""026"");                      (* UP                    *) 

+enter incode ( 4, ""004"");                      (* INFO                  *) 

+enter incode ( 7, ""002"");                      (* SV                    *) 

+enter incode ( 7, ""007"");                      (* SV                    *) 

+enter incode ( 8, ""008"");                      (* <-                    *) 

+enter incode ( 9, ""009"");                      (* TAB                   *) 

+enter incode (10, ""010"");                      (* DOWN                  *) 

+enter incode (11, ""096"");                      (* RUBIN                 *) 

+enter incode (12, ""127"");                      (* RUBOUT                *) 

+enter incode (13, ""013"");                      (* RETURN                *) 

+enter incode (16, ""126"");                      (* MARK                  *) 

+enter incode (17, ""001"");                      (* STOP                  *) 

+enter incode (23, ""003"");                      (* WEITER                *) 

+ 

+FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; 

+ 

+enter outcode ( 0,  "");                         (* NULL                  *)

+enter outcode ( 1,  25);                         (* HOME                  *)

+enter outcode ( 2,  21);                         (* RECHTS                *)

+enter outcode ( 3,  26);                         (* OBEN                  *)

+enter outcode ( 4, 120, ""23"");                 (* CL EOP                *)

+enter outcode ( 5,  22);                         (* CL EOL                *)

+enter outcode ( 7,   7);                         (* BELL                  *)

+enter outcode ( 8,   8);                         (* LINKS                 *)

+enter outcode (10,  10);                         (* UNTEN                 *)

+enter outcode (13,  13);                         (* RETURN                *)

+enter outcode (14, 126);                         (* END MARK              *)

+enter outcode (15, 126);                         (* BEGIN MARK            *)

+ 

+cursor logic (32,""16"","","");

+ 

+(********************   Textzeichen   *************************************)

+ 

+FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; 

+FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER;  (* japanische    *)

+FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER;  (*   ESC-Zeichen *)

+

+enter outcode ( 91, "(");                        (* [                     *)

+enter outcode ( 92, "/");                        (* \                     *)

+enter outcode ( 93, ")");                        (* ]                     *)

+enter outcode (123, "<");                        (* geschw. Klammer auf   *)

+enter outcode (124, "!");                        (* |                     *)

+enter outcode (125, ">");                        (* geschw. Klammer zu    *)

+enter outcode (214,  91);                        (* Ä                     *)

+enter outcode (215,  92);                        (* Ö                     *)

+enter outcode (216,  93);                        (* Ü                     *)

+enter outcode (217, 123);                        (* ä                     *)

+enter outcode (218, 124);                        (* ö                     *)

+enter outcode (219, 125);                        (* ü                     *)

+enter outcode (220, "k");                        (* Trenn-k               *)

+enter outcode (221, "-");                        (* Trenn-Strich          *) 

+enter outcode (222, "#");                        (* gesch. Nummerkreuz    *)

+enter outcode (223, "_");                        (* gesch. Blank          *)

+enter outcode (251,  64);                        (* ß                     *)

+ 

diff --git a/system/terminal-codes/unknown/src/VIDEOSTAR b/system/terminal-codes/unknown/src/VIDEOSTAR
new file mode 100644
index 0000000..bead5b9
--- /dev/null
+++ b/system/terminal-codes/unknown/src/VIDEOSTAR
@@ -0,0 +1,52 @@
+# 

+      VIDEOSTAR CONFIGURATIONS-PROGRAMM,  VERSION 25.06.1985 

+       Terminal = REGENT40 Emulation, deutscher Zeichensatz 

+#

+TEXT VAR  name :="VIDEOSTAR"; 

+forget(name, quiet);

+new type (name);

+cursor logic  (32,""27"Y","","");

+enter outcode (1  ,0,""27"Y  "); 

+enter outcode (2  ,6   );

+enter outcode (3  ,26  );

+enter outcode (5  ,0,""27"K" );

+enter outcode (4,0,""27"k");

+enter outcode (14,0,""27"0@ ");     (* invers video ein = begin mark*) 

+enter outcode (15,0,""27"0P ");     (* invers video aus = end mark*) 

+ 

+enter outcode (220,"k");            (* Trenn-k *) 

+enter outcode (221,"-");            (* Trenn-  *) 

+enter outcode (222,"#"); 

+enter outcode (223,"_");

+enter outcode (140,""12"");         (* Clear fuer Graphik *) 

+ 

+enter outcode (214, 0,  ""27"9B"91""27"9A");   (* ASCII Klammern *)

+enter outcode (215, 0,  ""27"9B"92""27"9A"); 

+enter outcode (216, 0,  ""27"9B"93""27"9A"); 

+enter outcode (217, 0, ""27"9B"123""27"9A"); 

+enter outcode (218, 0, ""27"9B"124""27"9A"); 

+enter outcode (219, 0, ""27"9B"125""27"9A"); 

+enter outcode (251, 0, ""27"9B"126""27"9A"); 

+ 

+enter incode (1  ,""30"");     (* hop *)

+enter incode (2  ,""6""  );

+enter incode (3  ,""26""  );

+enter incode (8  ,""21"" );    (* backspace *)

+enter incode (4,""4"");        (* info   *) 

+enter incode (7,""2"");        (* sv     *)

+enter incode (17,""1"");       (* stop   *) 

+enter incode (23,""3"");       (* weiter *)

+enter incode (18, ""27"M");    (*  Insert Line *)

+enter incode (11,""25"");      (* rubin  *) 

+enter incode (12,""127"");     (* rubout *) 

+enter incode (16,""12"") ;     (* mark   *)

+ 

+ 

+enter incode (214,""91"");     (* Umlaute *)

+enter incode (215,""92"");

+enter incode (216,""93"");

+enter incode (217,""123""); 

+enter incode (218,""124"");

+enter incode (219,""125"");

+enter incode (251,""126"");

+

diff --git a/system/terminal-codes/unknown/src/basis108(ascii) b/system/terminal-codes/unknown/src/basis108(ascii)
new file mode 100644
index 0000000..8df50f2
--- /dev/null
+++ b/system/terminal-codes/unknown/src/basis108(ascii)
@@ -0,0 +1,90 @@
+                                      (* Terminaltyp: Basis108 *) 

+                                      (* Keyboard   : ASCII    *) 

+                                      (* Zeichensatz: ASCII    *) 

+                                      (* Stand      : 28.04.86 *) 

+ 

+forget  ("basis108(ascii)", quiet) ; 

+new type ("basis108(ascii)") ; 

+ 

+cursor logic  (0, ""6"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (14, 0, " "14"") ; 

+enter outcode (15, 0, ""15" ") ; 

+ 

+enter outcode (214, 0, ""15"A"14"") ; 

+enter outcode (215, 0, ""15"O"14"") ; 

+enter outcode (216, 0, ""15"U"14"") ; 

+enter outcode (217, 0, ""15"a"14"") ; 

+enter outcode (218, 0, ""15"o"14"") ; 

+enter outcode (219, 0, ""15"u"14"") ; 

+enter outcode (251, 0, ""15"B"14"") ; 

+ 

+enter outcode (220, 0, ""15"k"14"") ; 

+enter outcode (221, 0, ""15"-"14"") ; 

+enter outcode (222, 0, ""15"#"14"") ; 

+enter outcode (223, 0, ""15" "14"") ; 

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode( 4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = � *) 

+                              (* SHIFT F6 = � 

+Andere incodes schon Hardware-   SHIFT F7 = � 

+m��ig implementiert:             SHIFT F8 = � 

+                                 SHIFT F9 = � 

+                                 SHIFT F10= � 

+                                 SHIFT F11= � 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Gesch�tztes Fis   ( # ) 

+                                 SHIFT F15= Gesch�tztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ;

diff --git a/system/terminal-codes/unknown/src/basis108(deutsch) b/system/terminal-codes/unknown/src/basis108(deutsch)
new file mode 100644
index 0000000..d2125a6
--- /dev/null
+++ b/system/terminal-codes/unknown/src/basis108(deutsch)
@@ -0,0 +1,106 @@
+                                      (* Terminaltyp: Basis108 *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Deutsch  *) 

+                                      (* Stand      : 28.04.86 *) 

+ 

+forget  ("basis108(deutsch)", quiet) ; 

+new type ("basis108(deutsch)") ; 

+ 

+cursor logic  (0, ""6"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (14, 0, " "14"") ; 

+enter outcode (15, 0, ""15" ") ; 

+ 

+enter outcode (91,  0, ""15"("14"") ; 

+enter outcode (92,  0, ""15"/"14"") ; 

+enter outcode (93,  0, ""15")"14"") ; 

+enter outcode (123, 0, ""15"<"14"") ; 

+enter outcode (124, 0, ""15"!"14"") ; 

+enter outcode (125, 0, ""15">"14"") ; 

+enter outcode (126, 0, ""15"`"14"") ; 

+ 

+enter outcode (214,  91) ; 

+enter outcode (215,  92) ; 

+enter outcode (216,  93) ; 

+enter outcode (217, 123) ; 

+enter outcode (218, 124) ; 

+enter outcode (219, 125) ; 

+enter outcode (251, 126) ; 

+ 

+enter outcode (220, 0, ""15"k"14"") ; 

+enter outcode (221, 0, ""15"-"14"") ; 

+enter outcode (222, 0, ""15"#"14"") ; 

+enter outcode (223, 0, ""15" "14"") ; 

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+(*enter incode( 4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts*) *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+enter incode (251, ""213"") ; (* SHIFT F5 = ß *) 

+                              (* SHIFT F6 = ä 

+Andere incodes schon Hardware-   SHIFT F7 = ö 

+mäßig implementiert:             SHIFT F8 = ü 

+                                 SHIFT F9 = Ä 

+                                 SHIFT F10= Ö 

+                                 SHIFT F11= Ü 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Geschütztes Fis   ( # ) 

+                                 SHIFT F15= Geschütztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ; 

diff --git a/system/terminal-codes/unknown/src/basis108(info) b/system/terminal-codes/unknown/src/basis108(info)
new file mode 100644
index 0000000..421c803
--- /dev/null
+++ b/system/terminal-codes/unknown/src/basis108(info)
@@ -0,0 +1,107 @@
+                                      (* Terminaltyp: Basis108 *) 

+                                      (* Keyboard   : Deutsch  *) 

+                                      (* Zeichensatz: Deutsch  *) 

+                                      (* Stand      : 19.06.86 *) 

+                                      (* Mit 'info'-Taste auf => *) 

+                                      (* Ohne sz auf SHIFT F5  *) 

+ 

+forget  ("basis108(info)", quiet) ; 

+new type ("basis108(info)") ; 

+ 

+cursor logic  (0, ""6"", "", "") ; 

+ 

+(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) 

+illegal (11, 12) ; 

+illegal (16, 31) ; 

+illegal (128, 213) ; 

+illegal (224, 250) ; 

+illegal (252, 255) ; 

+ 

+enter outcode (14, 0, " "14"") ; 

+enter outcode (15, 0, ""15" ") ; 

+ 

+enter outcode (91,  0, ""15"("14"") ; 

+enter outcode (92,  0, ""15"/"14"") ; 

+enter outcode (93,  0, ""15")"14"") ; 

+enter outcode (123, 0, ""15"<"14"") ; 

+enter outcode (124, 0, ""15"!"14"") ; 

+enter outcode (125, 0, ""15">"14"") ; 

+enter outcode (126, 0, ""15"`"14"") ; 

+ 

+enter outcode (214,  91) ; 

+enter outcode (215,  92) ; 

+enter outcode (216,  93) ; 

+enter outcode (217, 123) ; 

+enter outcode (218, 124) ; 

+enter outcode (219, 125) ; 

+enter outcode (251, 126) ; 

+ 

+enter outcode (220, 0, ""15"k"14"") ; 

+enter outcode (221, 0, ""15"-"14"") ; 

+enter outcode (222, 0, ""15"#"14"") ; 

+enter outcode (223, 0, ""15" "14"") ; 

+ 

+enter incode (  1, ""192"") ; (* Home        : Cursorblock mitte          *) 

+enter incode (  2, ""149"") ; (* Cursor right: Cursorblock mitte rechts   *) 

+enter incode (  3, ""139"") ; (* Cursor up   : Cursorblock oben mitte     *) 

+enter incode (  4,  ""21"") ; (* Info usw.   : Cursorblock unten rechts   *) 

+enter incode (  7, ""194"") ; (* SV - Call   : Funktionstaste F2          *) 

+enter incode (  8, ""136"") ; (* Cursor left : Cursorblock mitte links    *) 

+enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte    *) 

+enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links     *) 

+enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste               *) 

+enter incode ( 16, ""143"") ; (* MARK        : Cursorblock oben rechts    *) 

+enter incode ( 17, ""193"") ; (* Stop        : Funktionstaste F1          *) 

+enter incode ( 23, ""195"") ; (* Weiter      : Funktionstaste F3          *) 

+enter incode ( 31,   ""8"") ; (* Backspace   : (2x) gerahmter Linkspfeil  *) 

+ 

+enter incode (214,  ""91"") ; 

+enter incode (215,  ""92"") ; 

+enter incode (216,  ""93"") ; 

+enter incode (217, ""123"") ; 

+enter incode (218, ""124"") ; 

+enter incode (219, ""125"") ; 

+enter incode (251, ""126"") ; 

+ 

+enter incode ( 0,  ""24"") ;  (* CE *) 

+enter incode ( 5, ""196"") ;  (* F4 *) 

+enter incode ( 6, ""197"") ;  (* F5 *) 

+enter incode (14, ""198"") ;  (* F6 *) 

+enter incode (15, ""199"") ;  (* F7 *) 

+enter incode (18, ""200"") ;  (* F8 *) 

+enter incode (19, ""201"") ;  (* F9 *) 

+enter incode (20, ""202"") ;  (* F10 *) 

+enter incode (21, ""203"") ;  (* F11 *) 

+enter incode (22, ""204"") ;  (* F12 *) 

+enter incode (24, ""205"") ;  (* F13 *) 

+enter incode (25, ""206"") ;  (* F14 *) 

+enter incode (26, ""207"") ;  (* F15 *) 

+enter incode (28, ""209"") ;  (* SHIFT F1 *) 

+enter incode (29, ""210"") ;  (* SHIFT F2 *) 

+enter incode (30, ""211"") ;  (* SHIFT F3 *) 

+ 

+enter incode (126,""165"") ;  (* CTRL  F5 *) 

+enter incode (91, ""166"") ;  (* CTRL  F6 *) 

+enter incode (92, ""167"") ;  (* CTRL  F7 *) 

+enter incode (93, ""168"") ;  (* CTRL  F8 *) 

+enter incode (123,""169"") ;  (* CTRL  F9 *) 

+enter incode (124,""170"") ;  (* CTRL  F10 *) 

+enter incode (125,""171"") ;  (* CTRL  F11 *) 

+ 

+                              (* SHIFT F6 = � 

+Andere incodes schon Hardware-   SHIFT F7 = � 

+m��ig implementiert:             SHIFT F8 = � 

+                                 SHIFT F9 = � 

+                                 SHIFT F10= � 

+                                 SHIFT F11= � 

+                                 SHIFT F12= Trenn-k           ( k ) 

+                                 SHIFT F13= Trenn-Strich      ( - ) 

+                                 SHIFT F14= Gesch�tztes Fis   ( # ) 

+                                 SHIFT F15= Gesch�tztes Blank (   ) *) 

+ 

+PROC illegal (INT CONST from, to) : 

+ INT VAR i ; 

+ FOR i FROM from UPTO to REP 

+  enter outcode (i, 127)

+ PER 

+ENDPROC illegal ; 

diff --git a/system/terminal-codes/unknown/src/ws580 b/system/terminal-codes/unknown/src/ws580
new file mode 100644
index 0000000..a2e341b
--- /dev/null
+++ b/system/terminal-codes/unknown/src/ws580
@@ -0,0 +1,62 @@
+TEXT VAR  name :="ws580"; 

+command dialogue (FALSE); forget (name); 

+new type (name);

+cursor logic (32,""27"Y","","");

+ 

+enter incode (   2,  ""6"");                 (* rechts *)

+enter incode (   3,  ""26"");                (* oben   *)

+enter incode (   7,  ""2"");                 (* sv     *)

+enter incode (   8,  ""21"");                (* links  *)

+enter incode (  11,  ""94"");                (* rubin  *) 

+enter incode (  12,  ""8"");                 (* rubout *)

+enter incode (  16,  ""96"");                (* mark   *)

+enter incode (  23,  ""19"");                (* weiter *)

+ 

+enter incode ( 214, ""91"");                 (*  Ä  *) 

+enter incode ( 215, ""92"");                 (*  Ö  *) 

+enter incode ( 216, ""93"");                 (*  Ü  *) 

+enter incode ( 217, ""123"");                (*  ä  *) 

+enter incode ( 218, ""124"");                (*  ö  *) 

+enter incode ( 219, ""125"");                (*  ü  *) 

+enter incode ( 251, ""126"");                (*  ß  *) 

+ 

+enter outcode (  1, 0, ""27"Y  ");           (* home   *)

+enter outcode (  2, 0, ""6"");               (* rechts *) 

+enter outcode (  3, 0, ""26"");              (* oben   *) 

+enter outcode (  4, 0, ""27"k");             (* cleop  *) 

+enter outcode (  5, 0, ""27"K");             (* cleoln *) 

+enter outcode ( 14, 0, ""47"");              (* endmrk *) 

+enter outcode ( 15, 0, ""47"");              (* mark   *) 

+ 

+clear all 8 bit chars; 

+ 

+enter outcode ( 91, "(");          (*   [   *)

+enter outcode ( 92, "!");          (*   \   *)

+enter outcode ( 93, ")");          (*   ]   *)

+enter outcode (123, "(");          (*       *)

+enter outcode (124, "!");          (*   |   *)

+enter outcode (125, ")");          (*       *)

+enter outcode (126, "-");          (*   ~   *) 

+ 

+enter outcode (214, ""91"");       (*   Ä   *)

+enter outcode (215, ""92"");       (*   Ü   *)

+enter outcode (216, ""93"");       (*   Ö   *)

+enter outcode (217, ""123"");      (*   ä   *)

+enter outcode (218, ""124"");      (*   ü   *)

+enter outcode (219, ""125"");      (*   ö   *)

+enter outcode (251, ""126"");      (*   ß   *) 

+ 

+enter outcode (220, "k");          (* trenn k *) 

+enter outcode (221, "-");          (* trenn - *)

+enter outcode (222, "#");          (* kdo   # *) 

+enter outcode (223, " ");          (* trenn   *)

+ 

+command dialogue (TRUE). 

+ 

+ 

+clear all 8 bit chars : 

+  INT VAR i; 

+ 

+  FOR i FROM 128 UPTO 255 REP 

+    enter outcode (i, " "); 

+  PER.