Initial import

224 files changed, 87641 insertions, 0 deletions

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/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/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