Add source files from Michael

16 files changed, 6711 insertions, 0 deletions

diff --git a/system/base/unknown/src/SPOLMAN5.ELA b/system/base/unknown/src/SPOLMAN5.ELA
new file mode 100644
index 0000000..99d4ec2
--- /dev/null
+++ b/system/base/unknown/src/SPOLMAN5.ELA
@@ -0,0 +1,1003 @@
+PACKET queue handler DEFINES enter into que,

+                             exists in que,

+                             all in que,

+                             erase from que, 

+                             erase last top of que,

+                             get top of que, 

+                             restore ,

+                             list que, 

+                             info, killer,first, 

+                             que status, 

+                             que empty,

+                             set entry types,

+                             change entry types,

+                             initialize que:

+ 

+ 

+LET que size    = 100, 

+ 

+    empty       =   0, 

+    used        =   1,

+    blocked     =   2, 

+    nil         =   0,

+    user  error =  99,

+    unused char =   ""0"", 

+    used char   =   ""1"", 

+    blocked char=   ""2"", 

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

+                         DATASPACE space, INT storage,    acc code ) ; 

+ 

+ROW que size ENTRY VAR que ; 

+ 

+TEXT VAR status list; 

+BOOL VAR n ok := FALSE; 

+INT  VAR top of que,

+         first que entry, 

+         last que entry,

+         index ;

+ 

+.entry: que[index]. ;

+ 

+PROC initialize que : 

+  FOR index FROM 1 UPTO que size REP 

+    forget( entry.space ); 

+    entry.acc code := empty

+  END REP ; 

+  first que entry := nil;

+  last que entry  := nil; 

+  top of que      := nil;

+  index           := nil; 

+  status list     := que size * unused char; 

+END PROC initialize que ; 

+ 

+initialize que ; 

+

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

+ 

+INT PROC next (INT CONST pre) : 

+  pre MOD que size + 1 

+END PROC next ; 

+ 

+PROC block (INT CONST entry number) : 

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

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

+ENDPROC block; 

+ 

+PROC unblock (INT CONST entry number) : 

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

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

+ENDPROC unblock; 

+ 

+PROC to next que entry: 

+  REP 

+    IF index = last que entry OR index = nil

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

+    FI ;

+    index := next(index)

+  UNTIL entry.acc code <> empty PER 

+END PROC to next que entry ; 

+ 

+PROC to first que entry : 

+  index := first que entry 

+END PROC to first que entry ; 

+ 

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

+ 

+  check if index identifies entry ;

+  IF last que entry = nil 

+    THEN index := nil 

+    ELSE index := last que entry ; 

+         REPEAT 

+           IF is wanted entry 

+             THEN LEAVE search que entry 

+           FI ; 

+           IF index = first que entry 

+             THEN index := nil 

+             ELSE index DECR 1 ; 

+                  IF index = 0 

+                    THEN index := que size 

+                  FI 

+           FI 

+         UNTIL index = nil PER 

+  FI. 

+ 

+is wanted entry: 

+ 

+  entry.acc code <> empty CAND 

+  entry.title    =  title CAND 

+ (entry.origin   =  origin OR 

+  origin = niltask ).

+ 

+check if index identifies entry: 

+ 

+  IF index <> nil CAND is wanted entry 

+    THEN LEAVE search que entry 

+  FI 

+ 

+END PROC search que entry ; 

+ 

+PROC exec erase :

+ 

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

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

+    try to cut off queue ends. 

+ 

+try to cut off queue ends: 

+ 

+  WHILE first entry is not valid REP 

+    check if que empty ; 

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

+  END REP ; 

+  WHILE last entry is not valid REP 

+    make index invalid if necessary ; 

+    last que entry DECR 1 ; 

+    IF last que entry = 0 

+      THEN last que entry := que size 

+    FI 

+  END REP . 

+ 

+first entry is not valid: 

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

+ 

+last entry is not valid: 

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

+ 

+check if que empty: 

+     IF first que entry = last que entry 

+       THEN first que entry := nil ;

+            last que entry  := nil ; 

+            index := nil ; 

+            LEAVE try to cut off queue ends

+     FI.

+

+make index invalid if necessary: 

+     IF index = last que entry 

+       THEN index := nil 

+     FI. 

+ 

+END PROC exec erase ;

+ 

+PROC exec first: 

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

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

+  ELIF index = top of que 

+    THEN errorstop ("Auftrag wird bereits bearbeitet") 

+  ELIF entry.acc code = empty 

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

+    ELSE first que entry DECR 1 ; 

+         IF first que entry = 0 

+           THEN first que entry := que size 

+         FI ; 

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

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

+         exec erase 

+  FI 

+END PROC exec first ; 

+ 

+PROC erase last top of que: 

+  IF top of que <> nil 

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

+         top of que := nil 

+  FI 

+END PROC erase last top of que;

+ 

+ 

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

+ 

+LET semicolon = ";" , 

+    colon     = ":" , 

+    quote     = """"; 

+TEXT VAR entry types ::   ""   ; 

+ 

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

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

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

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

+END PROC no permitted type ; 

+ 

+TEXT PROC record of que entry: 

+  IF entry.acc code = empty 

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

+    ELSE TEXT VAR record :: "" ; 

+         record CAT storage in k ; 

+         record CAT type of entry ; 

+         record CAT name of entry ; 

+         record CAT origin of entry ; 

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

+         record

+  FI. 

+ 

+storage in k: 

+ 

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

+ 

+type of entry: 

+ 

+  IF entry types = "" 

+    THEN 12 * "?" 

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

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

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

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

+         IF semi colon pos = 0 

+           THEN 12 * "?" 

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

+         FI 

+  FI. 

+ 

+name of entry: 

+ 

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

+ 

+origin of entry: 

+ 

+  IF entry.origin = niltask 

+    THEN 20 * " "

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

+  FI 

+ 

+END PROC record of que entry ;

+ 

+PROC set entry types (TEXT CONST t) : 

+  check if void ;

+  IF first char is no semicolon

+    THEN entry types := semicolon

+    ELSE entry types := "" 

+  FI;

+  entry types CAT t ; 

+  IF last char is no semicolon

+    THEN entry types CAT semicolon 

+  FI.

+

+check if void: 

+  IF t = "" 

+    THEN entry types := ""; 

+         LEAVE set entry types 

+  FI. 

+ 

+first char is no semicolon: 

+  (t SUB 1) <> semicolon. 

+ 

+last char is no semicolon: 

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

+ 

+END PROC set entry types ; 

+ 

+PROC change entry types: 

+  TEXT VAR t :: entry types;

+  line;putline("Entrytypes :");

+  editget(t); 

+  set entry types (t) 

+END PROC change entry types; 

+ 

+ 

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

+ 

+ 

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

+  search que entry (title, origin) ; 

+  IF index = nil 

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

+  ELIF index = top of que 

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

+    ELSE exec erase 

+  FI 

+END PROC erase from que ; 

+ 

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

+  search que entry (title, origin) ; 

+  index <> nil 

+END PROC exists in que ; 

+ 

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

+ 

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

+ 

+  THESAURUS VAR result := empty thesaurus ; 

+  to first que entry ; 

+  WHILE index <> 0 REP 

+    IF entry.origin = origin OR origin = niltask 

+      THEN insert (result, entry.title)

+    FI ; 

+    to next que entry

+  END REP ; 

+  result 

+ 

+END PROC all in que ; 

+ 

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

+                     DATASPACE CONST space ):

+ 

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

+    THEN errorstop ("Queue zu voll")

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

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

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

+         index := last que entry;

+         entry := ENTRY: 

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

+         IF first que entry = nil 

+           THEN first que entry := 1 

+         FI ; 

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

+  FI. 

+ 

+task name : 

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

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

+ 

+END PROC enter into que ; 

+ 

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

+  forget (top space) ;

+  IF que empty 

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

+    ELSE erase last top of que; 

+         top of que := first que entry; 

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

+            wrap around if necessary

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

+  FI . 

+ 

+wrap around if necessary : 

+ 

+  IF entry is allowed to be printed THEN 

+     give it to spool manager 

+  ELSE enter into end of queue FI. 

+ 

+entry is allowed to be printed : 

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

+ 

+give it to spool manager : 

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

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

+ 

+enter into end of queue : 

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

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

+                  ,top space); 

+  index := first que entry; 

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

+  get top of que (top space). 

+ 

+END PROC get top of que ; 

+ 

+PROC restore:

+  top of que := nil 

+END PROC restore ; 

+ 

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

+  first que entry = last que entry AND 

+  top of que      = last que entry. 

+END PROC que empty ; 

+ 

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

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

+ 

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

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

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

+  FI ; 

+  IF top of que <> nil 

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

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

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

+    ELSE size INCR 1 ; 

+         top title       := "" ; 

+         top origin      := niltask ;

+         top origin name := "" 

+  FI 

+END PROC que status ;

+

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

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

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

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

+                "weiter (w) ? "; 

+ 

+PROC info : 

+ 

+     to first que entry; 

+     WHILE index <> nil REP 

+       record := record of que entry; 

+       WHILE index <> top of que REPEAT 

+         ask user what to do; 

+         out (input char); 

+         exec command

+       UNTIL command index = 1 PER; 

+       to next que entry; 

+     PER. 

+ 

+ask user what to do : 

+ 

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

+     out (record); 

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

+     INT VAR command index; TEXT VAR input char; 

+     REPEAT 

+       inchar (input char); 

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

+     UNTIL command index > 0 PER. 

+ 

+exec command : 

+ 

+     SELECT command index OF 

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

+               type (entry.space,1003); 

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

+               edit (f); line (2); 

+               type (entry.space,old dataspace type) 

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

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

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

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

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

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

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

+                               que [dummy no].space) 

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

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

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

+     ENDSELECT. 

+ 

+ENDPROC info; 

+ 

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

+  open listfile ;

+  to first que entry ; 

+  WHILE index <> nil REP 

+    TEXT VAR record :: record of que entry ; 

+    IF index = top of que 

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

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

+    FI ;

+    putline (f,record) ;

+    to next que entry

+  END REP.

+ 

+open listfile:

+ 

+  forget (ds) ; 

+  ds := nilspace ; 

+  f := sequentialfile (output,ds) ; 

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

+  line (f)

+

+END PROC list que ; 

+ 

+PROC killer : info ENDPROC killer; 

+PROC first  : info ENDPROC first; 

+ 

+END PACKET queue handler ; 

+ 

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

+(*   Programm zur Verwaltung einer Servertask                              *)

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

+(*        Autor: A.Vox                                                     *)

+(*        Stand: 3.6.85                                                    *)

+(*                                                                         *)

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

+PACKET spool manager DEFINES server status, 

+                             server modus, 

+                             server task, 

+                             server channel, 

+                             server routine, 

+                             server fail msg, 

+ 

+                             log edit, 

+                             logline, 

+                             logfilename,

+                             check, 

+                             feed server if hungry, 

+                             check if server vanished, 

+ 

+                             spool manager, 

+                             get title and origin, 

+

+                             start, 

+                             stop, 

+                             pause, 

+                             spool info, 

+                             list, 

+                             spool maintenance: 

+ 

+ 

+     LET user error = 99;

+ 

+     LET { Status: }       { Modus: }

+         init = 0,         active  = 0,

+         work = 1,         paused  = 1, 

+         wait = 2,         stopped = 2,

+         dead = 3;

+ 

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

+ 

+INT VAR status :: init,

+        modus  :: stopped;

+ 

+TASK VAR server  :: niltask; 

+TEXT VAR routine :: "", 

+         fail msg:: ""; 

+INT VAR channel  :: 0;

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

+ 

+INT  VAR que size; 

+TEXT VAR actual title, 

+         actual origin name; 

+TASK VAR actual origin; 

+ 

+ 

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

+ 

+TASK PROC  servertask    : server       END PROC servertask; 

+INT  PROC  serverstatus  : status       END PROC serverstatus; 

+INT  PROC  servermodus   : modus        END PROC servermodus; 

+TEXT PROC  serverroutine : routine      END PROC serverroutine; 

+TEXT PROC  serverfailmsg : fail msg     END PROC serverfailmsg;

+INT  PROC  serverchannel : channel      END PROC serverchannel; 

+ 

+PROC serverroutine (TEXT CONST neu): 

+  routine := neu 

+END PROC serverroutine; 

+ 

+PROC serverfailmsg (TEXT CONST neu): 

+  failmsg := neu 

+END PROC serverfailmsg; 

+ 

+PROC serverchannel (INT CONST neu): 

+  channel := neu 

+END PROC serverchannel; 

+ 

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

+ 

+TEXT CONST logfilename :: "Vorkommnisse"; 

+FILE VAR logfile; 

+ 

+TEXT VAR fail title  :: "" ;

+TASK VAR fail origin :: niltask ; 

+REAL VAR fail time   :: 0.0 ; 

+ 

+PROC logline (TEXT CONST mess): 

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

+  clear file if too large ; 

+  put(logfile, date);

+  put(logfile, time of day); 

+  put(logfile, " : ");

+  putline(logfile, mess) 

+END PROC logline ; 

+ 

+PROC log edit: 

+  enable stop ; 

+  IF NOT exists(logfilename) 

+    THEN errorstop ("keine Eintragungen vorhanden") 

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

+         position to actual page; 

+         edit(logfile);

+         line (2); 

+         forget (logfilename); 

+  FI. 

+ 

+position to actual page: 

+ 

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

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

+  IF begin of last page < 1 

+    THEN toline(logfile,1) 

+    ELSE toline(logfile,begin of last page) 

+  FI

+ 

+END PROC logedit; 

+ 

+PROC clear file if too large: 

+  IF lines(logfile) > 1000 

+    THEN modify (logfile) ; 

+         toline (logfile, 900) ; 

+         remove (logfile, 900) ; 

+         clear removed (logfile) ;

+         output (logfile) 

+  FI 

+END PROC clear file if too large ; 

+ 

+PROC end server (TEXT CONST mess): 

+  access catalogue; 

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

+    THEN end(server) 

+  FI; 

+  failtime := clock(1); 

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

+  logline (mess) ; 

+  IF fail title <> "" 

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

+    ELSE logline("kein Auftrag betroffen") 

+  FI ; 

+  status := dead ; 

+  server := niltask 

+END PROC end server; 

+ 

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

+  check if server vanished ; 

+  IF less than 3 days ago AND 

+     was failure          AND 

+     title matches        AND 

+     origin matches 

+    THEN fail origin := myself ; 

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

+  FI. 

+ 

+less than 3 days ago: 

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

+ 

+origin matches: 

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

+ 

+title matches: 

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

+ 

+was failure: 

+  fail title <> ""

+ 

+END PROC check ; 

+ 

+PROC start server: 

+  begin (PROC server start,server) ; 

+  status := init 

+END PROC start server; 

+ 

+PROC server start: 

+  disable stop ; 

+  IF channel <> 0 

+    THEN continue (channel) ; 

+  FI ;

+  command dialogue (FALSE) ; 

+  out (cmd form feed); 

+  do (routine) ; 

+  IF is error 

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

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

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

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

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

+  FI ; 

+  IF online 

+    THEN out (fail msg) 

+  FI ; 

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

+  end (myself) 

+END PROC server start ;

+ 

+PROC check if server vanished: 

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

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

+         start server 

+  FI 

+END PROC check if server vanished; 

+ 

+ 

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

+ 

+   LET ack              = 0,

+       second phase ack = 5,

+       not existing nak = 6,

+ 

+       begin code       = 4, 

+       fetch code       = 11, 

+       save code        = 12,

+       exists code      = 13, 

+       erase code       = 14, 

+       list code        = 15, 

+       all code         = 17, 

+       clear code       = 18, 

+       release code     = 20, 

+       check code       = 22, 

+ 

+       terminate code   = 25, 

+       logline code     = 26, 

+       get title code   = 27, 

+ 

+       continue code    = 100; 

+ 

+ 

+DATASPACE VAR packet space ; 

+INT VAR reply ; 

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

+.f name: msg.f name. ; 

+ 

+TEXT VAR save title :: "";

+FILE VAR listfile; 

+ 

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

+  forget (packet space) ; 

+  packet space := nilspace ; 

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

+  IF reply = ack 

+    THEN msg := packet space ; 

+         title := msg.f name ; 

+         origin := msg.a ; 

+         forget (packet space)

+    ELSE forget (packet space) ; 

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

+  FI 

+END PROC get title and origin; 

+ 

+PROC feed server if hungry:

+  check if server vanished ; 

+  IF status = wait AND NOT que empty 

+    THEN get top of que (packet space) ; 

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

+         forget (packet space) ;

+         IF reply = ack 

+           THEN status := work 

+           ELSE restore ; 

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

+                start server 

+         FI 

+  FI 

+ENDPROC feed server if hungry;

+ 

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

+ 

+  enable stop ; 

+  msg := ds ; 

+  SELECT order OF 

+    CASE terminate code: terminate 

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

+    CASE get title code: send title 

+    OTHERWISE 

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

+        THEN send top of que 

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

+      FI 

+  END SELECT ; 

+  forget(ds). 

+ 

+terminate: 

+  end server ("Server terminiert :") ; 

+  start server.

+ 

+send title: 

+  forget (ds) ; 

+  ds := nilspace ; 

+  msg := ds ; 

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

+  send (server, ack, ds).

+ 

+send top of que: 

+  status := wait ; 

+  erase last top of que ;

+  IF modus = active 

+    THEN feed server if hungry

+  FI 

+ 

+END PROC server request; 

+ 

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

+                   TASK CONST order task) : 

+ 

+  IF ordertask < myself 

+    THEN server request (ds,order,phase) 

+  ELIF ordertask = supervisor

+    THEN system request 

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

+  FI; 

+  check storage; 

+  error protocol. 

+ 

+check storage: 

+  INT VAR size, used; 

+  storage(size,used); 

+  IF used > size 

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

+         initialize que; 

+         logline("Queue geloescht !!"); 

+         stop 

+  FI. 

+ 

+error protocol: 

+  IF is error AND error code <> user error 

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

+         logline (errormessage) ; 

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

+                  "   Code: "  + text(errorcode) ) 

+  FI. 

+ 

+system request: 

+  IF order > continue code 

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

+         forget(ds) ; 

+         IF reply = ack 

+           THEN spool maintenance 

+         FI 

+  FI 

+ 

+END PROC spool manager; 

+ 

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

+                    TASK CONST order task): 

+ 

+  enable stop ; 

+  check if server vanished ;

+  msg := ds ; 

+  SELECT order OF 

+    CASE begin code : special begin 

+    CASE fetch code:  y get logfile 

+    CASE save code :  y save 

+    CASE exists code: y exists 

+    CASE erase code:  y erase 

+    CASE list code:   y list 

+    CASE all code:    y all 

+    CASE release code, 

+         clear code:  y restart 

+    CASE check code:  y check 

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

+  END SELECT. 

+ 

+special begin : 

+   INT VAR dummy; 

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

+   send (order task,ack,ds). 

+ 

+y get logfile: 

+  forget(ds) ; 

+  ds := old(logfilename) ; 

+  send (ordertask, ack, ds). 

+ 

+y erase: 

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

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

+  ELIF phase = 1 

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

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

+         send (ordertask, ack, ds) 

+  FI. 

+ 

+y save: 

+  IF phase = 1 

+    THEN save title := f name ; 

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

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

+         IF modus = active 

+           THEN feed server if hungry

+         FI ; 

+         send (order task,ack,ds); 

+  FI. 

+ 

+y list: 

+  list que (listfile,ds) ; 

+  send (ordertask, ack, ds). 

+ 

+y all: 

+  forget(ds) ; 

+  ds := nilspace ; 

+  BOUND THESAURUS VAR all names := ds ; 

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

+  send (ordertask, ack, ds). 

+ 

+y exists: 

+  IF exists in que (f name,ordertask) 

+    THEN send (ordertask, ack, ds) 

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

+  FI. 

+ 

+y check: 

+  check (f name,ordertask) ; 

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

+  IF there is a title   AND

+     is actual origin   AND 

+     is actual title 

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

+  ELIF exists in que (f name,ordertask) 

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

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

+  FI. 

+ 

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

+  is actual origin:  ordertask = actual origin .

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

+ 

+y restart: 

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

+  IF actual origin = ordertask 

+    THEN IF phase = 1 

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

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

+                start server ; 

+                IF order = clear code 

+                  THEN restore 

+                  ELSE erase last top of que

+                FI ; 

+                manager message ("Auftrag unterbrochen") 

+         FI

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

+  FI

+

+END PROC spool command ; 

+ 

+PROC start: 

+  IF modus = stopped 

+    THEN start server ; 

+         modus := active; 

+         message ("Server aktiviert") 

+  ELIF modus = paused 

+    THEN modus := active ; 

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

+         feed server if hungry

+    ELSE message ("Server bereits aktiv") 

+  FI 

+END PROC start; 

+ 

+PROC stop: 

+  IF modus <> stopped 

+    THEN end server ("Gestoppt :"); 

+         modus := stopped ;

+         status := init ; 

+         message ("Server gestoppt") 

+    ELSE message ("Server bereits gestoppt") 

+  FI 

+END PROC stop; 

+ 

+PROC pause: 

+  IF modus = active 

+    THEN modus := paused ; 

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

+  ELIF modus = paused 

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

+    ELSE errorstop ("Server ist gestoppt") 

+  FI 

+END PROC pause; 

+ 

+PROC message (TEXT CONST mess): 

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

+  say(mess) ; 

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

+END PROC message ; 

+ 

+PROC list: 

+  list que(listfile,packet space) ; 

+  show(listfile) 

+END PROC list; 

+ 

+PROC spool maintenance: 

+  command dialogue (TRUE);

+  IF exists(logfilename) 

+    THEN logedit 

+  FI; 

+  WHILE online REP

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

+    do command 

+  END REP ; 

+  command dialogue (FALSE) ; 

+  break ; 

+  set autonom 

+END PROC spool maintenance ;

+ 

+PROC spoolinfo: 

+  check if server vanished ;

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

+  line(2) ; 

+  putline("Queue :") ; 

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

+  IF actual title <> "" 

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

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

+  FI ; 

+  line ; 

+  putline("Server :"); 

+  put("Status :"); 

+  SELECT status OF 

+    CASE init : putline("initialisiert") 

+    CASE work : putline("arbeitet") 

+    CASE wait : putline("wartet")

+    OTHERWISE   putline("gestorben")

+  END SELECT ;

+  put("Modus  :"); 

+  SELECT modus OF 

+    CASE active : putline("aktiv") 

+    CASE paused : putline("pausierend") 

+    OTHERWISE     putline("gestoppt") 

+  END SELECT ; 

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

+  line(2) 

+END PROC spool info 

+ 

+END PACKET spool manager; 

+ 

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

+                                               (* Stand:  26.04.82 *)

+       command dialogue ,

+       say ,

+       yes ,

+       no ,

+       param position ,

+       last param :

+ 

+ 

+LET up      = ""3"" ,

+    right   = ""2"" ,

+    param pre  = " (""" ,

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

+

+TEXT VAR std param := "" ;

+ 

+BOOL VAR dialogue flag := TRUE ;

+

+INT VAR param x := 0 ;

+ 

+ 

+BOOL PROC command dialogue :

+  dialogue flag

+ENDPROC command dialogue ;

+ 

+PROC command dialogue (BOOL CONST status) :

+  dialogue flag := status

+ENDPROC command dialogue ;

+ 

+ 

+BOOL PROC yes (TEXT CONST question) :

+ 

+  IF dialogue flag

+    THEN ask question

+    ELSE TRUE

+  FI .

+ 

+ask question :

+  put (question) ;

+  skip previous input chars ;

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

+  get answer ;

+  IF correct answer

+    THEN putline (answer) ;

+         positive answer

+    ELSE out (""7"") ;

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

+         yes (question)

+  FI .

+ 

+get answer :

+  TEXT VAR answer ;

+  inchar (answer) .

+ 

+correct answer :

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

+ 

+positive answer :

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

+

+skip previous input chars :

+  REP UNTIL incharety = "" PER .

+ 

+ENDPROC yes ;

+ 

+BOOL PROC no (TEXT CONST question) :

+ 

+  NOT yes (question)

+ 

+ENDPROC no ;

+ 

+PROC say (TEXT CONST message) :

+ 

+  IF dialogue flag

+    THEN out (message)

+  FI

+ 

+ENDPROC say ;

+ 

+PROC param position (INT CONST x) :

+ 

+  param x := x

+

+ENDPROC param position ;

+

+TEXT PROC last param :

+ 

+  IF param x > 0

+    THEN out (up) ;

+         param x TIMESOUT right ;

+         out (param pre) ;

+         out (std param) ;

+         out (param post)

+  FI ;

+  std param

+ 

+ENDPROC last param ;

+ 

+PROC last param (TEXT CONST new) :

+  std param := new

+ENDPROC last param ;

+

+ENDPACKET command dialogue ;

+

+

+PACKET input DEFINES                         (* Stand: 01.05.81 *)

+ 

+    get ,

+    getline , 

+    get secret line :

+ 

+ 

+LET cr              = ""13"" ,

+    esc             = ""27"" ,

+    rubout          = ""12"" ,

+    bell            = ""7"" ,

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

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

+

+PROC get (TEXT VAR word) : 

+ 

+  REP

+    get (word, " ")

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

+  delete leading blanks .

+ 

+delete leading blanks :

+  WHILE (word SUB 1) = " " REP

+    word := subtext (word,2)

+  PER .

+ 

+ENDPROC get ;

+ 

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

+ 

+  word := "" ;

+  feldseparator (separator) ;

+  editget (word) ;

+  feldseparator ("") ;

+  echoe last char

+ 

+ENDPROC get ;

+ 

+PROC echoe last char :

+ 

+  TEXT CONST last char := feldzeichen ;

+  IF last char = ""13""

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

+    ELSE out (last char)

+  FI

+ 

+ENDPROC echoe last char ;

+ 

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

+ 

+  word := "" ;

+  feldseparator ("") ;

+  editget (word, length, length) ;

+  echoe last char 

+ 

+ENDPROC get ;

+ 

+PROC getline (TEXT VAR line ) : 

+ 

+  line := "" ;

+  feldseparator ("") ;

+  editget (line) ;

+  echoe last char

+ 

+ENDPROC getline ;

+ 

+PROC get secret line (TEXT VAR line) :

+

+  TEXT VAR char ;

+  line := "" ;

+  get start cursor position ;

+  get line very secret ;

+  IF char = esc

+    THEN get line little secret

+  FI ;

+  cursor to start position ;

+  out (del line cr lf) .

+

+get line very secret :

+  REP

+    inchar (char) ;

+    IF char = esc OR char = cr

+      THEN LEAVE get line very secret

+    ELIF char = rubout

+      THEN delete last char

+    ELIF char >= " "

+      THEN line CAT char ;

+           out (".")

+    ELSE   out (bell)

+    FI

+  PER .

+

+delete last char :

+  IF LENGTH line = 0

+    THEN out (bell)

+    ELSE out (back blank back) ;

+         delete char (line, LENGTH line)

+  FI .

+

+get line little secret :

+  feldseparator ("") ;

+  cursor to start position ;

+  editget (line) .

+

+get start cursor position :

+  INT VAR x, y; 

+  get cursor (x, y) .

+

+cursor to start position :

+  cursor (x, y) .

+

+ENDPROC get secret line ;

+

+ENDPACKET input ;

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

+                                                (* H.Indenbirken, 19.08.82 *)

+  transform,

+  set values,

+

+  clear ,

+  begin plot ,

+  end plot ,

+  dir move,

+  dir draw ,

+  pen,

+  pen info :

+ 

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

+    y raster = 43,

+    display hor  = 78.0,

+    display vert = 43.0;

+ 

+INT CONST up         :=  1 ,

+          right      :=  1 ,

+          down       := -1 ,

+          left       := -1 ;

+ 

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

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

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

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

+

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

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

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

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

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

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

+ROW 5 ROW 5 REAL VAR result;

+INT VAR i, j;

+

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

+  ROW 5 ROW 5 REAL VAR erg;

+  FOR i FROM 1 UPTO 5

+  REP FOR j FROM 1 UPTO 5

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

+      PER

+  PER;

+  erg  .

+

+zeile i mal spalte j :

+  INT VAR k;

+  REAL VAR summe :: 0.0;

+  FOR k FROM 1 UPTO 5

+  REP summe INCR zeile i * spalte j PER;

+  summe  .

+

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

+

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

+

+END OP *;

+ 

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

+                 ROW 2 ROW 2 REAL CONST limits,

+                 ROW 3 REAL CONST angles,

+                 ROW 2 REAL CONST oblique,

+                 ROW 3 REAL CONST perspective) :

+  norm p;

+  set views;

+  calc two dim extrema;

+  calc limits;

+  calc result values  .

+

+norm p :

+  p := ROW 5 ROW 5 REAL :

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

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

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

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

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

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

+

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

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

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

+

+set views :

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

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

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

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

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

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

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

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

+

+  result := ROW 5 ROW 5 REAL :

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

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

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

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

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

+  p := p*result;

+

+ 

+  result := ROW 5 ROW 5 REAL :

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

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

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

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

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

+  p := p * result;

+

+  result := ROW 5 ROW 5 REAL :

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

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

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

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

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

+  p := p * result  .

+

+calc two dim extrema :

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

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

+

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

+  extrema;

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

+  extrema;

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

+  extrema;

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

+  extrema;

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

+  extrema;

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

+  extrema;

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

+  extrema;

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

+  extrema  .

+

+extrema :

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

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

+ 

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

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

+ 

+calc limits :

+  IF all limits smaller than 2

+  THEN prozente

+  ELSE zentimeter FI  .

+

+all limits smaller than 2 :

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

+

+prozente :

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

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

+ 

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

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

+ 

+zentimeter : 

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

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

+ 

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

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

+

+calc result values :

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

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

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

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

+

+  result := ROW 5 ROW 5 REAL :

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

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

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

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

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

+  p := p * result  .

+ 

+END PROC set values;

+ 

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

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

+

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

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

+END PROC transform;

+

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

+INT VAR x pos := 0 ,

+        y pos := 0 ,

+        new x pos ,

+        new y pos ;

+ 

+ROW 24 TEXT VAR display;

+clear ;

+ 

+PROC clear :

+

+  INT VAR i;

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

+  FOR i FROM 2 UPTO 24

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

+  PER;

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

+ 

+END PROC clear ;

+ 

+PROC begin plot :

+

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

+ 

+ENDPROC begin plot ;

+ 

+PROC end plot :

+ 

+ENDPROC end plot ;

+ 

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

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

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

+

+END PROC dir move;

+

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

+ 

+  x pos := x val;

+  y pos := y val

+

+ENDPROC move ;

+ 

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

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

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

+

+END PROC dir draw;

+

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

+

+  new x pos := x val;

+  new y pos := y val;

+

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

+ 

+END PROC draw ;

+ 

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

+  out (""6"");

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

+  out (code (x pos));

+

+  out (text)

+ 

+END PROC dir draw;

+ 

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

+

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

+  act no := no;

+  act thickness := thickness;

+  act line type := line type

+ 

+ENDPROC pen ;

+

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

+  no := act no;

+  thickness := act thickness;

+  line type := act line type

+

+END PROC pen info;

+ 

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

+ 

+  IF dx >= 0

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

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

+ 

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

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

+         FI

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

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

+ 

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

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

+         FI

+  FI .

+ 

+ENDPROC plot vector ;

+ 

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

+

+  prepare first step ;

+  INT VAR i ;

+  FOR i FROM 1 UPTO dx REP

+    do one step

+  PER .

+ 

+prepare first step :

+  point;

+  INT VAR old error := 0 ,

+          up right error := dy - dx ,

+          right error    := dy .

+ 

+do one step :

+  IF right is better

+    THEN do right step

+    ELSE do up right step

+  FI .

+ 

+right is better :

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

+ 

+do upright step :

+  x pos INCR right ;

+  y pos INCR up ;

+  point ;

+  old error INCR upright error .

+ 

+do right step :

+  x pos INCR right ;

+  point ;

+  old error INCR right error .

+ 

+ENDPROC vector ;

+ 

+ 

+PROC point :

+  INT CONST line :: y pos DIV 2;

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

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

+             new point :: calculated point;

+ 

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

+  out (""6"") ;

+  out (code (23-line)) ;

+  out (code (x pos)) ;

+  out (new point) .

+ 

+calculated point :

+  IF above

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

+       THEN "|"

+       ELSE "'" FI

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

+       THEN "|"

+       ELSE "," FI

+  FI

+ 

+END PROC point;

+ 

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

+INT PROC round (REAL CONST x) :

+  IF x > real max int

+  THEN max int

+  ELIF x < 0.0

+  THEN 0

+  ELSE int (x + 0.5) FI

+

+END PROC round;

+

+ENDPACKET std plot ;

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

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

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

+                                                  (* Vers.: 1.6.0          *)

+        bildeditor,                               (* test des bildeditors, *)

+        schreiberlaubnis,

+        zeile unveraendert,

+        feldanfangsmarke,

+        bildmarksatz,

+        bildeinfuegen,

+        bildneu,

+        bildzeile,

+        bildmarke,

+        bildstelle,

+        bildlaenge,

+        bildmaxlaenge,

+        bildsatz,

+        bildrand :

+ 

+ 

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

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

+                                fortsetzung, TEXT inhalt);

+ 

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

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

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

+ 

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

+ 

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

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

+ 

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

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

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

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

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

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

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

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

+ 

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

+ 

+BOOL PROC schreiberlaubnis :

+  schreiben erlaubt

+END PROC schreiberlaubnis;

+ 

+PROC schreiberlaubnis (BOOL CONST b) :

+  schreiben erlaubt := b

+END PROC schreiberlaubnis;

+ 

+BOOL PROC bildneu :

+  neu

+END PROC bildneu;

+ 

+PROC bildneu (BOOL CONST b) :

+  neu := b

+END PROC bildneu;

+ 

+PROC bildeinfuegen (BOOL CONST b):

+  einfuegen := b

+END PROC bildeinfuegen;

+ 

+INT PROC bildmarke :

+  marke

+END PROC bildmarke;

+ 

+PROC bildmarke (INT CONST i) :

+  marke := i

+END PROC bildmarke;

+ 

+INT PROC feldanfangsmarke :

+  alte feldmarke

+END PROC feldanfangsmarke;

+ 

+PROC feldanfangsmarke (INT CONST i) :

+  alte feldmarke := i

+END PROC feldanfangsmarke;

+ 

+INT PROC bildstelle :

+  stelle

+END PROC bildstelle;

+ 

+PROC bildstelle (INT CONST i) :

+  stelle := i

+END PROC bildstelle;

+ 

+INT PROC bildmarksatz :

+  marksatz

+END PROC bildmarksatz;

+ 

+PROC bildmarksatz (INT CONST i) :

+  marksatz := i

+END PROC bildmarksatz;

+ 

+INT PROC bildsatz :

+  satz

+END PROC bildsatz;

+ 

+PROC bildsatz (INT CONST i) :

+  satz := i

+END PROC bildsatz;

+ 

+INT PROC bildzeile :

+  zeile

+END PROC bildzeile;

+ 

+PROC bildzeile (INT CONST i) :

+  zeile := min (i, laenge)

+END PROC bildzeile;

+ 

+INT PROC bildlaenge :

+  laenge

+END PROC bildlaenge;

+ 

+PROC bildlaenge (INT CONST i) :

+  laenge := i

+END PROC bildlaenge;

+ 

+PROC bildmaxlaenge (INT CONST i) : 

+  maxlaenge := i 

+END PROC bildmaxlaenge; 

+ 

+INT PROC bildrand :

+  rand

+END PROC bildrand;

+ 

+PROC bildrand (INT CONST i) :

+  rand := i

+END PROC bildrand;

+ 

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

+  IF a > b THEN a ELSE b FI

+END PROC max;

+ 

+PROC zeile unveraendert :

+  zeileneu := FALSE

+END PROC zeile unveraendert;

+ 

+ 

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

+ 

+PROC bildeditor (DATEI VAR datei) :

+ 

+     INTERNAL 293 ; 

+ 

+  INT  VAR j;

+ 

+  kommando := feldkommando;

+  IF   neu

+  THEN bild ausgeben (datei) 

+  ELIF zeileneu

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

+  ELSE feldposition; zeileneu := TRUE

+  FI;

+  REPEAT

+    IF   neu             THEN bild ausgeben (datei) 

+    ELIF ueberschriftneu THEN ueberschrift  (datei) 

+    FI ;

+    IF   stelle = anker

+         THEN IF   schreiben erlaubt

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

+                   satz ausgeben (datei)

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

+              FI

+    FI ;

+    feldbearbeitung; 

+    IF   zeichen <> escape THEN kommandoausfuehrung FI

+  UNTIL  zeichen =  escape

+  END REPEAT; 

+  feldkommando (kommando) .

+ 

+feldbearbeitung :

+  feldkommando (kommando); 

+  IF   schreiben erlaubt

+  THEN feldeditor (inhalt); kommando := feldkommando

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

+       IF   teil <> inhalt

+       THEN kommando := escape q; kommando CAT teil

+       ELSE kommando := feldkommando

+       FI

+  FI;

+  zeichen := kommando SUB 1;

+  feldnachbehandlung .

+ 

+ 

+feldnachbehandlung :

+  IF   inhalt = ""

+  THEN IF   schreiben erlaubt

+       THEN IF   zeichen > hoechstes steuerzeichen

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

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

+                 feldout (inhalt); zeichen := cr

+  FI   FI   FI . 

+ 

+kommandoausfuehrung :

+  delete char (kommando, 1);

+  IF   marke > 0

+  THEN bildmarkeditor (datei) 

+  ELSE 

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

+    CASE 1: 

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

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

+      CASE 1: oben links

+      CASE 2: IF   schreiben erlaubt

+              THEN zeilen einfuegen  ELSE out (bell) FI

+      CASE 3: IF   schreiben erlaubt

+              THEN zeile ausfuegen   ELSE out (bell) FI

+      CASE 4: weiterblaettern

+      CASE 5: zurueckblaettern

+      CASE 6: neue seite

+      CASE 7: ueberschriftneu := TRUE

+      CASE 8: lernmodus umschalten

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

+      END SELECT

+    CASE 2: neue zeile

+    CASE 3: markieren beginnen

+    CASE 4: naechster satz

+    CASE 5: vorgaenger (datei)

+    CASE 6: feldposition (feldanfang); naechster satz

+    CASE 7: ueberschriftneu := TRUE;

+    OTHERWISE

+      IF   zeichen > hoechstes steuerzeichen

+      THEN IF schreiben erlaubt THEN ueberlauf FI

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

+           insert char (kommando, escape,  1)

+      FI

+    END SELECT

+  FI . 

+ 

+oben links :

+  ueberschriftneu := TRUE;

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

+  feldposition (feldanfang) .

+ 

+zeile ausfuegen : 

+  IF   feldstelle = 1

+  THEN satz loeschen (datei); 

+       IF   stelle = anker THEN vorgaenger (datei) FI

+  ELSE zeilen rekombinieren

+  FI .

+ 

+zeilen einfuegen :

+  ueberschriftneu := TRUE;

+  IF   einfuegen 

+  THEN einfuegen := FALSE;

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

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

+  ELSE einfuegen := TRUE; 

+       IF   logischer satzanfang

+       THEN satz erzeugen (datei, stelle);

+            IF zeilen >= zeile THEN bildrest loeschen FI;

+            zeilen := zeile; satz ausgeben (datei)

+       ELSE IF   feldstelle <= LENGTH inhalt

+            THEN zeile auftrennen

+            FI;

+            IF   zeile < zeilen 

+            THEN nachfolger (datei); bildrest loeschen; 

+                 vorgaenger (datei); zeilen := zeile

+            FI ; feldposition

+       FI

+  FI .

+ 

+logischer satzanfang :

+  FOR j FROM feldanfang UPTO feldstelle - 1

+  REP IF   (inhalt SUB j) = "" 

+      THEN LEAVE logischer satzanfang WITH TRUE

+      ELIF (inhalt SUB j) <> " "

+      THEN LEAVE logischer satzanfang WITH FALSE

+      FI

+  END REP; TRUE . 

+ 

+zeilen rekombinieren :

+  IF   eof (datei) THEN

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

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

+       stelle := datei (stelle).nachfolger;

+       satz loeschen (datei, stelle); 

+       stelle := datei (stelle).vorgaenger;

+       bildausgeben (datei)

+  FI .

+ 

+zeile auftrennen :

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

+  stelle := datei (stelle).nachfolger;

+  satz erzeugen (datei, stelle);

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

+  stelle := marke; marke := 0; 

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

+ 

+weiterblaettern :

+  ueberschriftneu := TRUE;

+  IF   eof (datei)

+  THEN out (bell)

+  ELSE IF   zeile = laenge

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

+       ELIF einfuegen

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

+       FI;

+       WHILE zeile < zeilen AND stelle <> anker 

+       REP nachfolger (datei) END REP;

+       IF   stelle = anker

+       THEN vorgaenger (datei) 

+  FI   FI .

+ 

+zurueckblaettern :

+  ueberschriftneu := TRUE;

+  IF   satz > 1

+  THEN IF   zeile = 1

+       THEN vorgaenger (datei); zeile := laenge

+       FI;

+       WHILE zeile > 1 AND satz > 1

+       REP vorgaenger (datei) PER;

+       zeile := 1

+  FI .

+ 

+ueberlauf :

+  insert char (kommando, zeichen, 1);

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

+  satz erzeugen (datei, stelle); 

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

+  IF   zeile <= zeilen OR neu

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

+  FI ;

+  inhalt := "" .

+ 

+lernmodus umschalten :

+  feldlernmodus (NOT feldlernmodus);

+  ueberschriftneu := TRUE; 

+  IF   feldlernmodus 

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

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

+       insert char (kommando, hop, 1)

+  FI.

+ 

+neue seite :

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

+ 

+neue zeile : 

+  BOOL VAR wirklich einfuegen := einfuegen;

+  IF   feldstelle > LENGTH inhalt OR feldstelle >= feldende

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

+  ELIF einfuegen AND logischer satzanfang

+  THEN feldposition (feldanfang); feldeinruecken (inhalt)

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

+       wirklich einfuegen := FALSE

+  FI;

+  IF   stelle = anker THEN

+  ELIF wirklich einfuegen

+  THEN satz erzeugen (datei, stelle);

+       IF   zeile <= zeilen OR neu

+       THEN bild ausgeben (datei)

+       ELSE satz ausgeben (datei)

+       FI

+  ELIF neu THEN

+  ELSE IF   zeile > zeilen

+       THEN satz ausgeben (datei)

+       FI;

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

+       REP  IF   (inhalt SUB j) <> blank

+            THEN feldposition (j); LEAVE neue zeile FI 

+       PER 

+  FI . 

+ 

+naechster satz :

+  nachfolger (datei);

+  IF   neu 

+  THEN IF   stelle = anker

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

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

+                 neu := FALSE

+       FI   FI

+  ELIF zeile <= zeilen THEN

+  ELIF stelle = anker  THEN

+  ELSE satz ausgeben (datei)

+  FI .

+ 

+markieren beginnen :

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

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

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

+       alte feldmarke := feldmarke

+  ELSE out (bell)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC bildeditor;

+ 

+ 

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

+ 

+PROC bildmarkeditor (DATEI VAR datei) :

+  INT  VAR j, k;

+ 

+  IF   zeichen  = right OR zeichen = tab

+  THEN zeichen := down;

+       feldposition (feldanfang)

+  FI;

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

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

+            IF   zeichen = up

+            THEN rueckblaetternd demarkieren

+            ELIF zeichen = down

+            THEN weiterblaetternd markieren

+            ELSE out (bell)

+            FI;

+            zeichen := ""

+    CASE 2: markieren beenden

+    CASE 3: IF schreiben erlaubt

+            THEN markiertes loeschen

+            ELSE out (bell)

+            FI

+    CASE 4: zeile demarkieren

+    CASE 5,6: zeile markieren

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

+              insert char (kommando, escape,  1)

+  END SELECT;

+  IF   marke > 0

+  THEN IF   stelle = marke

+       THEN feldmarke (alte feldmarke)

+       ELSE feldmarke (feldanfang)

+       FI

+  FI .

+ 

+markieren beenden :

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

+  IF   marke = stelle

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

+       marke := 0;

+  ELSE marke := 0; neu := TRUE

+  FI .

+ 

+markiertes loeschen :

+  IF   stelle = marke

+  THEN satzausschnitt loeschen

+  ELSE letzten satz bis stelle loeschen;

+       ersten satz ab marke loeschen;

+       alle zwischensaetze loeschen;

+       IF   zeile <= 1 

+       THEN zeile := 1

+       FI;

+       feldstelle (feldanfang); feldmarke (0);

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

+  FI . 

+ 

+satzausschnitt loeschen :

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

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

+  IF   inhalt = ""

+  THEN satz loeschen (datei)

+  ELSE satz ausgeben (datei)

+  FI .

+ 

+letzten satz bis stelle loeschen :

+  IF   feldstelle > LENGTH inhalt

+  THEN satz loeschen (datei, stelle)

+  ELIF feldstelle > feldanfang

+  THEN inhalt := subtext (inhalt, feldstelle)

+  FI .

+ 

+ersten satz ab marke loeschen :

+  INT CONST altstelle := stelle;

+  stelle := marke;

+  IF   alte feldmarke = 1

+  THEN satz loeschen (datei, stelle);

+       satz DECR 1; zeile DECR 1

+  ELSE IF   alte feldmarke <= LENGTH inhalt

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

+       FI;

+       stelle := datei (stelle).nachfolger

+  FI .

+ 

+alle zwischensaetze loeschen :

+  WHILE stelle <> altstelle

+  REP satzloeschen (datei, stelle);

+      satz DECR 1; zeile DECR 1

+  PER .

+ 

+zeile markieren : 

+  IF   zeichen = cr

+  THEN feldstelle (feldanfang)

+  FI;

+  IF   eof (datei) 

+  THEN feldstelle (feldende)

+  ELSE nachfolger (datei)

+  FI;

+  markierung justieren (datei);

+  satz ausgeben (datei) . 

+ 

+zeile demarkieren :

+  IF   stelle = marke

+  THEN out (bell); LEAVE zeile demarkieren

+  FI;

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

+  vorgaenger (datei);

+  markierung justieren (datei);

+  satz ausgeben (datei) .

+ 

+weiterblaetternd markieren :

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

+  WHILE NOT eof (datei)

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

+  IF   eof (datei)

+  THEN feldstelle (feldende); 

+  FI;

+  neu := TRUE .

+ 

+rueckblaetternd demarkieren :

+  IF   stelle = marke

+  THEN out (bell); LEAVE rueckblaetternd demarkieren

+  FI;

+  FOR j FROM 1 UPTO laenge 

+  WHILE stelle <> marke

+  REP vorgaenger (datei) PER;

+  neu := TRUE .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC bildmarkeditor;

+ 

+PROC markierung justieren (DATEI CONST datei) :

+  IF   feldstelle > LENGTH inhalt

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

+  FI;

+  IF   stelle =  marke

+  THEN feldmarke (alte feldmarke);

+       IF   feldstelle < feldmarke

+       THEN feldstelle (feldmarke)

+       FI

+  ELSE feldmarke (feldanfang)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC markierung justieren;

+ 

+PROC vorgaenger (DATEI VAR datei) :

+  IF   eof (datei) 

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

+  FI   FI ; 

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

+  IF   stelle = anker

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

+       satz := 1; zeile := 1

+  ELIF zeile > 1

+  THEN out (up); zeile DECR 1

+  ELSE neu := TRUE

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+END PROC vorgaenger;

+ 

+PROC nachfolger (DATEI CONST datei) :

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

+  IF   zeile <= laenge 

+  THEN out (down) 

+  ELIF laenge <> maxlaenge 

+  THEN neu := TRUE ; zeile := laenge

+  FI 

+END PROC nachfolger;

+ 

+PROC  bild ausgeben (DATEI VAR datei) :

+ 

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

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

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

+          altzeile  :: zeile,  altmarke :: feldmarke;

+  ueberschrift (datei); 

+  IF   marke > 0 OR neu

+  THEN zurueck zur ersten zeile;

+       cursor (1, rand+2) FI; 

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

+  WHILE zeile <= laenge AND stelle <> anker

+  REP zeile schreiben PER; 

+  feldstelle (alte feldstelle);

+  feldmarke (altmarke);

+  zeilen := zeile - 1;

+  IF   zeile > laenge 

+  THEN zeile := laenge; feldposition

+  ELSE bildrest loeschen

+  FI;

+  (zeile - altzeile) TIMESOUT up;

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

+  neu   := FALSE .

+ 

+zurueck zur ersten zeile :

+  IF   eof (datei) 

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

+       REP vorgaenger (datei) END REP;

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

+  FI;

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

+  REP IF   stelle = marke

+      THEN feldmarke (0)

+      FI;

+      vorgaenger (datei)

+  PER;

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

+ 

+inhalt :

+  datei (stelle).inhalt .

+ 

+zeile schreiben :

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

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

+   feldout (inhalt);

+   IF   stelle = altstelle

+   THEN feldmarke (0)

+   ELIF feldmarke > feldanfang

+   THEN feldmarke (feldanfang)

+   FI;

+   zeile INCR 1;

+   IF   zeile <= laenge

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

+        satz INCR 1; out (down)

+   FI .

+ 

+END PROC bild ausgeben;

+ 

+PROC ueberschrift (DATEI CONST datei) : 

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

+  INT CONST punkte :: 

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

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

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

+  IF   feldeinfuegen

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

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

+  IF   einfuegen

+  THEN out ("INS")

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

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

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

+  punkte TIMESOUT ".";

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

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

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

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

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

+  feldtab (tabulator);

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

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

+  ueberschriftneu := FALSE 

+ 

+END PROC ueberschrift;

+ 

+TEXT VAR tabulator;

+ 

+PROC satz ausgeben (DATEI VAR datei) : 

+  IF   zeile > laenge

+  THEN roll up

+  ELIF zeile > zeilen

+  THEN zeilen INCR 1

+  FI;

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

+roll up :

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

+END PROC satz ausgeben;

+ 

+PROC satz loeschen (DATEI VAR datei) :

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

+  IF   zeile > zeilen

+  THEN bildrest loeschen;

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

+  ELSE bild ausgeben (datei)

+  FI

+END PROC satz loeschen;

+ 

+PROC bildrest loeschen :

+  out (cr); feldrand TIMESOUT right;

+  IF   (rand+laenge) = maxlaenge

+  THEN out (clear eop)

+  ELSE out (up);

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

+       (laenge-zeile)   TIMESOUT up

+  FI;

+  feldposition

+END PROC bildrest loeschen;

+ 

+BOOL PROC eof (DATEI CONST datei) :

+  datei (stelle).nachfolger = anker

+END PROC eof;

+ 

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

+ 

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

+  EXTERNAL 291 ;

+END  PROC satz erzeugen; 

+ 

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

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

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

+(*

+PROC test des bildeditors :

+ 

+  IF   NOT exists ("test")

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

+  FI ;

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

+  BOUND DATEI VAR datei := ds ;

+  feldwortweise (NOT feldwortweise);

+  bildneu (TRUE); bildmarke (0); 

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

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

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

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

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

+  PER;

+ 

+END PROC test des bildeditors;

+*)

+END PACKET bildeditor;

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

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

+                                              (* Stand:  29.02.82 *)

+       command handler ,

+       do command ,

+       command error ,

+       set command :

+ 

+ 

+LET esc          = ""27"" ,

+    esc k        = ""27"k" ,

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

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

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

+ 

+    tag type = 1 ,

+    texttype = 4 ,

+    eof type = 7 ;

+ 

+ 

+TEXT VAR command line := "" ,

+         previous command line := "" ,

+         symbol ,

+         procedure ,

+         pattern ,

+         error note := "" ;

+ 

+INT VAR  symbol type ,

+         allowed type := 0 ;

+ 

+ 

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

+

+  param position (0) ;

+  command line := command ;

+  allowed type := type

+ 

+ENDPROC set command ;

+ 

+PROC do command :

+ 

+  do (command line)

+

+ENDPROC do command ;

+

+ 

+PROC command handler ( TEXT CONST command list,

+                       INT VAR command index, number of params,

+                       TEXT VAR param 1, param 2,

+                       TEXT CONST command text ) :

+ 

+prepare and get command ;

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

+ 

+prepare and get command :

+  set line nr (0) ;

+  error protocoll ;

+  get command from console .

+ 

+error protocoll :

+  IF is error

+    THEN put error ;

+         clear error

+    ELSE command line := "" ;

+  FI .

+ 

+get command from console :

+  INT VAR x, y;

+  out (crlf) ;

+  get cursor (x, y) ;

+  cursor (x, y) ;

+  REP

+    out (command pre) ;

+    out (command text) ;

+    out (command post) ;

+    editget command

+  UNTIL command line <> "" PER ;

+  param position (LENGTH command line) ;

+  out (command post) .

+ 

+editget command :

+  feldaudit ("") ;

+  feldlernmodus (FALSE) ;

+  REP

+    feldtabulator ("") ;

+    feldseparator (esc) ;

+    editget (command line) ;

+    ignore halt errors during editget ;

+    IF feldzeichen = esc k

+      THEN command line := previous command line

+      ELSE previous command line := command line ;

+           LEAVE editget command

+    FI

+  PER .

+

+ignore halt errors during editget :

+  IF is error

+    THEN clear error

+  FI .

+

+ENDPROC command handler ;

+ 

+PROC command handler ( TEXT CONST command list,

+                       INT VAR command index, number of params,

+                       TEXT VAR param 1, param 2) :

+ 

+  scan (command line) ;

+  next symbol ;

+  IF pos (command list, symbol) > 0

+    THEN procedure name ;

+         parameter list pack option ;

+         nothing else in command line ;

+         decode command

+    ELSE impossible command

+  FI .

+ 

+procedure name :

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

+    THEN procedure := symbol ;

+         next symbol

+    ELSE error ("incorrect procedure name")

+  FI .

+ 

+parameter list pack option :

+  number of params := 0 ;

+  param 1 := "" ;

+  param 2 := "" ;

+  IF symbol = "("

+    THEN next symbol ;

+         parameter list ;

+         IF symbol <> ")"

+           THEN error (") expected")

+         FI

+  ELIF symbol type <> eof type

+    THEN error ("( expected")

+  FI .

+ 

+parameter list :

+  parameter (param 1, number of params) ;

+  IF symbol = ","

+    THEN next symbol ;

+         parameter (param 2, number of params) ;

+  FI ;

+  IF symbol <> ")"

+    THEN error (") expected")

+  FI .

+ 

+nothing else in command line :

+  next symbol ;

+  IF symbol <> ""

+    THEN error ("command too complex")

+  FI .

+

+decode command :

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

+ 

+impossible command :

+  command index := 0 .

+ 

+ENDPROC command handler ;

+ 

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

+ 

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

+    THEN param := symbol ;

+         number of params INCR 1 ;

+         next symbol

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

+  FI

+ 

+ENDPROC parameter ;

+ 

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

+ 

+  pattern := procedure ;

+  pattern CAT ":" ;

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

+  IF procedure name found

+    THEN get colon pos ;

+         get dot pos ;

+         get end pos ;

+         get command index ;

+         get param index ;

+         IF param index >= 0

+           THEN command index + param index

+           ELSE - command index

+         FI

+    ELSE 0

+  FI .

+ 

+procedure name found :

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

+ 

+get param index :

+  INT CONST param index :=

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

+ 

+get command index :

+  INT CONST command index :=

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

+ 

+get colon pos :

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

+ 

+get dot pos :

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

+ 

+get end pos :

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

+ 

+ENDPROC index ;

+ 

+PROC error (TEXT CONST message) :

+ 

+  error note := message ;

+  scan ("") ;

+  procedure := "-"

+ 

+ENDPROC error ;

+ 

+PROC command error :

+

+  disable stop ;

+  IF error note <> ""

+    THEN errorstop (error note) ;

+         error note := ""

+  FI ;

+  enable stop

+

+ENDPROC command error ;

+

+

+PROC next symbol :

+ 

+  next symbol (symbol, symbol type)

+ 

+ENDPROC next symbol ;

+ 

+iNDPACKET command handler ;

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

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

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

+                                                  (* Vers.: 1.6.0        *)

+        define escape ,

+        dateieditor :

+ 

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

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

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

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

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

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

+ 

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

+                                    fortsetzung, TEXT inhalt);

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

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

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

+FILE VAR sekundaerfile ;

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

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

+BOOL VAR war fehler, boolwert;

+LET op1namen = 

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

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

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

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

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

+    changecode = 11, or = 21;

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

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

+    plen = 25, peof  = 29;

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

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

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

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

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

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

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

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

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

+LET varimax   = 10;

+INT VAR freivar :: 1;

+ROW varimax INT  VAR varzahlwert, vartyp;

+ROW varimax TEXT VAR vartextwert, varname;

+FOR j FROM 1 UPTO varimax

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

+ 

+ROW 127 TEXT VAR escapefkt;

+ 

+ 

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

+ 

+PROC dateieditor (DATEI VAR datei) :

+ 

+  INTERNAL 295 ;

+ 

+  REP   datei editieren

+  UNTIL (feldkommando SUB 1) <> escape

+  PER .

+ 

+datei editieren :

+  war fehler := FALSE ;

+  zeichen := feldkommando SUB 2;

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

+  THEN LEAVE dateieditor

+  ELIF zeichen = escape

+  THEN kommando ermitteln

+  ELSE tastenkommando ermitteln ;    (* Li 19.1.82 *)

+       abbruchtest;

+       feldkommando (subtext (feldkommando, 3))

+  FI;

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

+ 

+tastenkommando ermitteln :

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

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

+    ELSE kommando := ""

+  FI .

+

+abbruchtest :

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+ 

+kommando ermitteln :

+  IF   (feldkommando SUB 1) = hop

+  THEN lernsequenz auf taste legen;

+       feldkommando (subtext (feldkommando, 4));

+       LEAVE datei editieren

+  FI;

+  feldkommando (subtext (feldkommando, 3));

+  kommando := ""; dialog; analysieren .

+ 

+dialog:

+  REP   kommandodialog;

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

+        THEN LEAVE dialog

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

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

+        ELSE kommando := ""

+        FI

+  PER .

+ 

+lernsequenz auf taste legen :

+  lernsequenz := feldaudit;

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

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

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

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

+  escapefkt (lerncode) CAT """" .

+ 

+kommandodialog :

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

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

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

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

+  bildneu (TRUE);

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

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

+ 

+analysieren :

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

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

+       LEAVE datei editieren

+  ELIF kommando = ""

+  THEN LEAVE datei editieren

+  ELIF (kommando SUB 1) = "?"

+  THEN kommandos erklaeren;

+       LEAVE datei editieren

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

+  THEN feldkommando (escape escape);

+       LEAVE dateieditor

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

+  FI .

+ 

+ausfuehren : 

+  haltzeile := satzmax;

+  IF   kommando = ""

+  THEN zeile unveraendert

+  ELSE scan (kommando); nextsymbol;

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

+       THEN IF symboltyp <> eol THEN fehler bearbeiten FI

+       FI;

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

+   FI .

+ 

+kommandos erklaeren : 

+  out (clear); 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

+  inchar (zeichen) .

+ 

+END PROC dateieditor; 

+ 

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

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

+END PROC define escape ;

+ 

+ 

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

+ 

+PROC fehler bearbeiten :

+  IF NOT war fehler

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

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

+       out (clear line mark)

+  FI

+END PROC fehler bearbeiten;

+ 

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

+ 

+BOOL PROC klammerzu :

+  IF   symbol = ")"

+  THEN nextsymbol; TRUE

+  ELSE fehler

+  FI

+END PROC klammerzu;

+ 

+PROC nextsymbol :

+  nextsymbol (symbol, symboltyp);

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

+END PROC nextsymbol;

+ 

+PROC eof (DATEI VAR datei) :

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

+END PROC eof;

+ 

+PROC nachsatz (DATEI CONST datei) :

+  stelle := datei (stelle).nachfolger;

+  satz INCR 1; protokoll

+END PROC nachsatz;

+ 

+PROC vorsatz  (DATEI CONST datei) :

+  stelle := datei (stelle).vorgaenger;

+  satz DECR 1; protokoll

+END PROC vorsatz;

+ 

+ 

+PROC protokoll :

+  cout (satz) ;

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+END PROC protokoll;

+ 

+ 

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

+ 

+PROC row (DATEI VAR datei) : 

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

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

+ 

+ziel voraus :

+  satz := bildsatz; stelle := bildstelle;

+  IF   zahlwert > satz

+  THEN TRUE

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

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

+  ELSE FALSE

+  FI .

+ 

+vorwaerts springen :

+  IF zahlwert <= 0

+    THEN fehler bearbeiten

+  FI ;

+  WHILE stelle <> dateianker AND satz < zahlwert

+  REP nachsatz (datei) UNTIL war fehler PER;

+  IF   stelle = dateianker AND satz > 1 

+  THEN vorsatz (datei);

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

+  FI .

+ 

+rueckwaerts springen :

+  WHILE stelle <> bildmarke  AND satz > zahlwert

+  REP vorsatz (datei) UNTIL war fehler PER .

+ 

+END PROC row;

+ 

+PROC search (DATEI VAR datei) :

+  stelle := bildstelle;

+  IF textwert <> "" THEN contextadressierung FI;

+  typ := void .

+ 

+contextadressierung : 

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

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

+  IF    stelle = dateianker

+  THEN  vorsatz (datei);

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

+  ELIF  j > 0

+  THEN  feldstelle ((LENGTH textwert)+j)

+  FI;

+  IF    bildstelle <> stelle

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

+  FI .

+ 

+noch nicht gefunden : 

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

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

+ 

+END PROC search; 

+ 

+ 

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

+ 

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

+  stelle := bildstelle; satz := bildsatz;

+  IF   datei eroeffnung korrekt

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

+       zeile auftrennen; file kopieren; kopiertes markieren;

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

+  FI ; textwert := "" .

+ 

+datei eroeffnung korrekt :

+  IF   textwert = ""

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

+  ELIF exists (textwert)

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

+       NOT eof (sekundaerfile) 

+  ELSE FALSE

+  FI .

+ 

+file kopieren : 

+  INT VAR altstelle;

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

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

+      satz erzeugen (datei, stelle);

+      IF stelle = altstelle THEN LEAVE file kopieren FI; 

+      getline (sekundaerfile, inhalt)

+  UNTIL war fehler

+  PER .

+ 

+zeile auftrennen : 

+  marke := stelle; bildmarksatz (satz);

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

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

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

+ 

+kopiertes markieren : 

+  nachsatz (datei);

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

+  vorsatz (datei);

+  IF   datei (marke).inhalt = "" 

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

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

+  FI; 

+  feldmarke (feldanfang); feldanfangsmarke (feldanfang);

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

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+END PROC vom file holen; 

+ 

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

+  neuen sekundaerfile erzeugen;

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

+  IF   stelle = marke 

+  THEN IF   feldmarke <> feldstelle

+       THEN putline (sekundaerfile,

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

+       FI

+  ELSE IF   feldanfangsmarke <= LENGTH inhalt

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

+       FI;  schreiben;

+       IF   feldstelle > feldanfang 

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

+       FI

+  FI .

+ 

+schreiben: 

+  REP nachsatz (datei);

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

+      putline (sekundaerfile, inhalt) 

+  PER .

+ 

+neuen sekundaerfile erzeugen : 

+  IF   textwert = ""

+    THEN sekundaerfile := sequential file (output) ;

+    ELSE IF   exists (textwert) 

+         THEN forget (textwert)

+         FI;

+         IF   exists (textwert)

+         THEN LEAVE in file bringen

+         FI;

+         sekundaerfile := sequential file (output, textwert)

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+END PROC in file bringen; 

+ 

+ 

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

+ 

+BOOL PROC primary (DATEI VAR datei) : 

+ 

+  SELECT symboltyp OF

+    CASE integer :

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

+         THEN zahlwert := int (symbol);

+              typ := symboltyp;

+              nextsymbol; TRUE

+         ELSE fehler

+         FI

+    CASE texttyp :

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

+    CASE delimiter :

+         IF   symbol = "("

+         THEN nextsymbol;

+              IF ausdruck (datei) THEN klammerzu ELSE fehler FI

+         ELSE fehler

+         FI

+    CASE tag :

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

+         IF   pcode = 0

+         THEN is variable

+         ELSE nextsymbol; prozedurieren

+         FI

+    CASE bold, operator :

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

+         IF   op1code = 0

+         THEN fehler

+         ELIF op1code = r                   (* Li 12.01.81 *)

+         THEN wiederholung (datei)

+         ELSE nextsymbol ;

+              IF primary (datei)

+              THEN operieren 

+              ELSE fehler

+              FI

+         FI

+     OTHERWISE : fehler

+   END SELECT .

+ 

+is variable : 

+  INT  VAR var :: 1;

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

+  IF   var = freivar

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

+       IF   symbol = ":="

+       THEN deklarieren

+       ELSE LEAVE is variable WITH fehler

+       FI

+  ELSE nextsymbol

+  FI;

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

+ 

+dereferenzieren :

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

+  textwert := vartextwert (var); TRUE .

+ 

+assignieren :

+  IF   primary (datei)

+  THEN IF   typ = integer

+       THEN varzahlwert (var) := zahlwert

+       ELIF typ = texttyp

+       THEN vartextwert (var) := textwert

+       ELSE fehler bearbeiten

+       FI;

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

+  ELSE fehler bearbeiten

+  FI;

+  NOT war fehler .

+ 

+deklarieren :

+  IF   freivar = varimax

+  THEN fehler bearbeiten

+  ELSE freivar INCR 1

+  FI .

+ 

+prozedurieren :

+  typ := integer;

+  SELECT pcode OF 

+    CASE pcol   : zahlwert := feldstelle

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

+    CASE prow   : zahlwert := bildsatz

+    CASE phalt  : zahlwert := haltzeile

+    CASE plimit : zahlwert := feldlimit

+    CASE pmark  : zahlwert := bildmarke

+    CASE peof   : eof (datei) 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  NOT war fehler .

+ 

+operieren :

+  SELECT op1code OF

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

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

+    CASE b     : begin

+    CASE c     : col 

+    CASE g     : get 

+    CASE h     : halt 

+    CASE l     : limit 

+    CASE m     : mark

+    CASE p     : put

+    CASE i     : if 

+    CASE w     : write

+    CASE s     : size 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  typ := void; TRUE .

+ 

+begin : 

+  zahlwert := zahlwert MOD 180;

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

+ 

+col :

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

+ 

+get : 

+  IF   bildmarke <= 0 AND schreiberlaubnis

+  THEN vom file holen (datei, textwert)

+  FI .

+ 

+halt :

+  haltzeile := zahlwert .

+ 

+limit :

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

+ 

+mark :

+  IF   zahlwert = 0

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

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

+       bildmarksatz (bildsatz)

+  FI .

+ 

+put : 

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

+ 

+if : 

+  IF   bedingung (datei) 

+  THEN IF   boolwert 

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

+            THEN nextsymbol;

+                 IF   ausdruck (datei)

+                 THEN skip elseteil

+                 ELSE fehler bearbeiten

+                 FI 

+            ELSE fehler bearbeiten

+            FI

+       ELSE skip thenteil; 

+            IF   j = 1

+            THEN elseteil

+            ELIF j <> 5

+            THEN fehler bearbeiten

+            FI

+       FI

+  ELSE fehler bearbeiten

+  FI .

+ 

+elseteil :

+  IF   ausdruck (datei)

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

+  FI .

+ 

+skip elseteil : 

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

+  nextsymbol .

+ 

+skip thenteil : 

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

+  nextsymbol .

+ 

+nicht elsefi : 

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

+ 

+write :

+  feldkommando (textwert); zeile unveraendert .

+ 

+size :

+  IF   bildlaenge > maxbildlaenge

+  THEN maxbildlaenge := bildlaenge

+  FI;

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

+  bildzeile  (min (bildzeile, bildlaenge)); 

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

+ 

+END PROC primary; 

+ 

+ 

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

+ 

+BOOL PROC wiederholung (DATEI VAR datei) : 

+ 

+  fix scanner ;              (* Li 12.01.81 *)

+  wiederholt interpretieren;

+  skip endrep; typ := void;

+  NOT war fehler .

+ 

+wiederholt interpretieren :

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

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

+  UNTIL ende der wiederholung

+  PER .

+ 

+until : 

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

+  THEN nextsymbol;

+       IF   primary (datei) THEN FI;

+       IF   bedingung (datei) 

+       THEN IF   boolwert

+            THEN LEAVE wiederholt interpretieren;TRUE

+            ELSE TRUE

+            FI

+       ELSE fehler

+       FI

+  ELSE TRUE

+  FI .

+ 

+ende der wiederholung :

+  IF war fehler

+    THEN TRUE

+  ELIF datei (stelle).nachfolger = dateianker

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

+  ELSE FALSE

+  FI .

+ 

+skip endrep :

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

+  REP nextsymbol PER;

+  nextsymbol .

+ 

+abbruchtest :

+  IF   is incharety (escape)

+  THEN fehler bearbeiten

+  FI .

+ 

+END PROC wiederholung; 

+ 

+BOOL PROC bedingung (DATEI VAR datei) : 

+  INT VAR relator; 

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

+  IF   relator = 0

+  THEN fehler

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

+       nextsymbol; 

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

+       TEXT VAR operandtextwert :: textwert; 

+       IF   primary (datei) THEN FI; 

+       IF   operandtyp <> typ

+       THEN fehler

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

+       FI

+  FI .

+ 

+vergleich : 

+  SELECT relator OF 

+    CASE  1 : operandzahlwert =  zahlwert 

+    CASE  2 : operandzahlwert >  zahlwert 

+    CASE  3 : operandzahlwert <  zahlwert 

+    CASE  4 : operandzahlwert <= zahlwert 

+    CASE  6 : operandzahlwert >= zahlwert 

+    CASE  8 : operandzahlwert <> zahlwert 

+    CASE  9 : operandtextwert =  textwert 

+    CASE 10 : operandtextwert >  textwert 

+    CASE 11 : operandtextwert <  textwert 

+    CASE 12 : operandtextwert <= textwert 

+    CASE 14 : operandtextwert >= textwert 

+    CASE 16 : operandtextwert <> textwert 

+    OTHERWISE fehler

+  END SELECT .

+ 

+END PROC bedingung; 

+ 

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

+ 

+BOOL PROC ausdruck (DATEI VAR datei) : 

+  INT VAR opcode, operandtyp, operandzahlwert;

+  TEXT VAR operandtextwert;

+  IF   primary (datei)

+  THEN BOOL VAR war operation :: TRUE;

+       WHILE operator AND war operation

+       REP IF   primary (datei)

+           THEN war operation := operator verarbeiten

+           ELSE war operation := FALSE

+           FI

+       PER;

+       war operation

+  ELSE fehler

+  FI .

+ 

+operator :

+  IF   kommandoende

+  THEN IF   typ = integer

+       THEN row (datei)

+       ELIF typ = texttyp

+       THEN search (datei)

+       FI

+  FI;

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

+  IF   opcode = 0

+  THEN FALSE

+  ELSE nextsymbol; operandtyp := typ;

+       operandzahlwert := zahlwert;

+       operandtextwert := textwert;

+       NOT war fehler

+  FI .

+ 

+operator verarbeiten :

+  SELECT opcode OF

+    CASE plus :

+         IF   typ = integer

+         THEN zahlwert := operandzahlwert + zahlwert

+         ELSE textwert := operandtextwert + textwert

+         FI

+    CASE minus : 

+         zahlwert := operandzahlwert - zahlwert

+    CASE mal :

+         IF   typ = integer

+         THEN zahlwert := operandzahlwert * zahlwert

+         ELSE textwert := operandzahlwert * textwert

+         FI

+    CASE durch :

+         zahlwert := operandzahlwert DIV zahlwert

+    CASE changecode : 

+         change

+    CASE semicolon : 

+    OTHERWISE fehler bearbeiten

+  END SELECT;

+  NOT war fehler .

+ 

+change : 

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

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

+       INT VAR fstelle :: feldstelle;

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

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

+       FI;

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

+       THEN fstelle := fstelle - LENGTH textwert; 

+            FOR j FROM 1 UPTO LENGTH ersatz 

+            REP IF   j <=  LENGTH textwert 

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

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

+                FI;

+                fstelle INCR 1

+            PER;

+            FOR j FROM 1+LENGTH ersatz UPTO LENGTH textwert 

+            REP delete char (inhalt, fstelle) PER;

+       FI;

+       feldstelle (fstelle); typ := void

+  ELSE fehler bearbeiten

+  FI .

+ 

+inhalt :

+  datei (stelle).inhalt . 

+ 

+kommandoende :

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

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

+    OTHERWISE symboltyp = eol

+  END SELECT .

+ 

+END PROC ausdruck;

+ 

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

+ 

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

+  EXTERNAL 291 ;

+END  PROC satz erzeugen; 

+ 

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

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+END PACKET dateieditorpaket;

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

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

+                                               (* Stand: 26.04.82     *) 

+    edit ,                                     (* Vers.: 1.6.3        *)

+    show ,

+    editmode :

+ 

+FILE VAR file 1, file 2 ;

+ 

+PROC edit (FILE VAR file) :

+  x edit (file) ;

+ENDPROC edit ;

+ 

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

+  x edit (file 1, file 2 )

+ENDPROC edit ;

+ 

+PROC edit (TEXT CONST file name) :

+  last param (file name) ;

+  IF exists (file name)

+    THEN edit 1 (file name)

+  ELIF yes ("neue datei einrichten")

+    THEN edit 1 (file name)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit ;

+ 

+PROC edit :

+  edit (last param)

+ENDPROC edit ;

+ 

+PROC edit 1 (TEXT CONST name) :

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

+  IF NOT is error

+    THEN edit (file 1)

+  FI

+ENDPROC edit 1 ;

+ 

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

+  IF exists (file name 1)

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

+  ELIF yes ("erste datei neu einrichten")

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

+  ELSE errorstop ("")

+  FI

+ENDPROC edit ;

+ 

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

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

+  IF exists (file name 2)

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

+         edit (file 1, file 2)

+  ELIF yes ("zweite datei neu einrichten")

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

+         edit (file 1, file 2)

+  ELSE errorstop ("")

+  FI

+ENDPROC edit 2 ;

+ 

+PROC show (FILE VAR file) :

+  schreiberlaubnis (FALSE) ;

+  edit (file) ;

+  schreiberlaubnis (TRUE)

+ENDPROC show ;

+ 

+PROC show (TEXT CONST file name) :

+  IF exists (file name)

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

+         show (file 1) ;

+    ELSE errorstop ("file does not exist")

+  FI

+ENDPROC show ;

+ 

+PROC editmode :

+  feldwortweise (NOT feldwortweise) ;

+  say ("      ") ;

+  IF feldwortweise

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

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

+  FI .

+

+ENDPROC editmode ;

+

+ 

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

+ 

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

+                            fortsetzung, TEXT inhalt),

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

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

+ 

+BOOL VAR war kein wechsel ;

+TEXT VAR tabulator :: 77*" ";

+ 

+ 

+PROC editor (DATEI VAR datei) : 

+  enable stop ;

+  grundzustand;

+  zustand aus datei holen ; 

+ 

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

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

+  UNTIL (feldkommando SUB 1) = escape

+  PER;

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

+  feldkommando (subtext (feldkommando, 3));

+ 

+  IF schreiberlaubnis THEN zustand in datei retten FI;

+  schreiberlaubnis (TRUE);

+  out (bottom) .

+ 

+grundzustand :

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

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

+  feldeinfuegen (FALSE).

+ 

+zustand in datei retten : 

+  inhalt :=  text (bildstelle, 5);

+  inhalt CAT text (bildsatz,   5);

+  inhalt CAT text (bildzeile,  5);

+  inhalt CAT text (feldlimit,  5);

+  feldtab (tabulator);

+  inhalt CAT tabulator .

+ 

+zustand aus datei holen :

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

+  IF satz nr > 0

+    THEN bildstelle (satz nr)

+    ELSE bildstelle (datei (dateianker).nachfolger)

+  FI ;

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

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

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

+  tabulator := subtext (inhalt, 21) ; 

+  feldtabulator (tabulator) .

+ 

+inhalt :

+  datei (freianker).inhalt . 

+ 

+END PROC editor;

+ 

+PROC y edit (DATEI VAR datei) :

+  editor (datei);

+  close

+END PROC y edit;

+ 

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

+ 

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

+  INT CONST alte laenge := bildlaenge - 1;

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

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

+  zweimal editieren;

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

+  close .

+ 

+zweimal editieren:

+  page;

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

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

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

+      IF war kein wechsel THEN LEAVE zweimal editieren FI;

+      bildrand (alte laenge + 1 - laenge); 

+      editor (zweite datei); laenge anpassen

+  UNTIL war kein wechsel

+  PER .

+ 

+laenge anpassen :

+  laenge := bildlaenge;

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

+  IF   laenge <= alte laenge - 2

+  THEN laenge := alte laenge - laenge

+  ELSE laenge := 2

+  FI ; bildlaenge (laenge) .

+END PROC y edit;

+ 

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

+ 

+PROC x edit (FILE VAR f) :

+  EXTERNAL 296

+ENDPROC x edit ;

+ 

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

+  EXTERNAL 297

+ENDPROC x edit ;

+ 

+LET FDATEI= STRUCT ( BOUND DATEI f ,

+                     INT index, pointer, line counter,

+                         mode, max line length, max page length,

+                     BOOL edit status unchanged) ;

+ 

+PROC x edit (FDATEI VAR f1) :

+  INTERNAL 296 ;

+  y edit (CONCR (f1.f))

+ENDPROC x edit ; 

+ 

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

+  INTERNAL 297 ;

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

+ENDPROC x edit ;

+ 

+PROC dateieditor (DATEI VAR d) :

+  EXTERNAL 295

+ENDPROC dateieditor ;

+ 

+PROC bildeditor (DATEI VAR d) :

+  EXTERNAL 293

+ENDPROC bildeditor ;

+ 

+ENDPACKET editor ;

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

+PACKET local manager part 2 DEFINES            (* Autor: J.Liedtke *)

+                                               (* Stand: 29.04.80  *)

+  list ,

+  file names :

+ 

+ 

+FILE VAR list file ;

+TEXT VAR file name, status text;

+ 

+PROC list :

+ 

+  list file := sequential file (output) ;

+  headline (list file, "list") ;

+  list (list file) ;

+  show (list file) ;

+  close

+ 

+ENDPROC list ;

+ 

+PROC list (FILE VAR f) :

+ 

+  begin list ;

+  putline (f, "") ;

+  REP

+    get list entry (file name, status text) ;

+    IF file name = ""

+      THEN LEAVE list

+    FI ;

+    out (f, status text + "  """ ) ;

+    out (f, file name) ;

+    out (f, """") ;

+    line (f)

+  PER

+ 

+ENDPROC list ;

+ 

+PROC file names (FILE VAR f) :

+ 

+  begin list ;

+  REP

+    get list entry (file name, status text) ;

+    IF file name = ""

+      THEN LEAVE file names

+    FI ;

+    putline (f, file name)

+  PER

+ 

+ENDPROC file names ;

+

+ENDPACKET local manager part 2 ;

+ 

+ 

+PACKET elan DEFINES                               (*Autor: J.Liedtke *)

+                                                  (*Stand: 01.05.82  *)

+    do ,

+    run ,

+    run again ,

+    insert ,

+    prot ,

+    prot off ,

+    check on ,

+    check off :

+ 

+ 

+LET newinit option = FALSE ,

+    ins = TRUE ,

+    no ins = FALSE ,

+    lst = TRUE ,

+    no lst = FALSE ,

+    compiler dump option = FALSE ,

+    sys option = TRUE ,

+    stop at first error = TRUE ,

+    multiple error analysis = FALSE ,

+    sermon = TRUE ,

+    no sermon = FALSE ,

+

+    run again mode = 0 ,

+    compile file mode = 1 ,

+    compile line mode = 2 ,

+

+    error message = 4 ;

+

+BOOL VAR list option := FALSE ,

+         check option := TRUE ,

+         errors occurred ;

+

+INT VAR run again mod nr := 0 ;

+DATASPACE VAR ds ;

+

+FILE VAR error file, source file ;

+ 

+ 

+PROC do (TEXT CONST command) :

+

+  INT VAR dummy mod ;

+  run again mod nr := 0 ;

+  errors occurred := FALSE ;

+  elan (compile line mode, ds, command, dummy mod,

+        newinit option, no ins, compiler dump option, no lst, sys option,

+        check option, stop at first error, no sermon) ;

+  IF errors occurred

+    THEN forget (ds) ;

+         errorstop ("")

+  FI

+ 

+ENDPROC do ;

+ 

+ 

+PROC run (TEXT CONST file name) : 

+ 

+  last param (file name) ;

+  run elan (file name, no ins)

+ 

+END PROC run;

+ 

+PROC run :

+ 

+  run (last param)

+ 

+ENDPROC run ;

+ 

+PROC run again :

+ 

+  IF run again mod nr > 0

+    THEN INT VAR mod := run again mod nr ;

+         elan (run again mode, ds, "", run again mod nr,

+               newinit option, no ins, compiler dump option, no lst, 

+               sys option, check option, stop at first error, no sermon)

+    ELSE errorstop ("run again impossible")

+  FI

+ 

+ENDPROC run again ;

+ 

+PROC insert (TEXT CONST file name) : 

+ 

+  last param (file name) ;

+  run elan (file name, ins)

+ 

+ENDPROC insert ;

+ 

+PROC insert :

+ 

+  insert (last param)

+ 

+ENDPROC insert ;

+ 

+PROC run elan (TEXT CONST file name, BOOL CONST insert option) :

+

+  IF exists (file name)

+    THEN compile and execute

+    ELSE errorstop ("file does not exist")

+  FI .

+

+compile and execute :

+  disable stop ;

+  errors occurred := FALSE ;

+  elan (compile file mode, old (file name, 1002), "" , run again mod nr,

+        newinit option, insert option, compiler dump option, list option,

+        sys option, check option, multiple error analysis, sermon) ;

+ 

+  IF errors occurred

+    THEN ignore halt during compiling ;

+         errors occurred := FALSE ;

+         enable stop ;

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

+         modify (error file) ;

+         edit (error file, source file) ;

+         forget (ds)

+  FI .

+

+ignore halt during compiling :

+  IF is error

+    THEN put error ;

+         clear error ;

+         pause (5)

+  FI .

+

+ENDPROC run elan ;

+

+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, 

+           INT VAR start module number,

+           BOOL CONST newinit, ins, dump, lst, sys, rt check, error1, ser) :

+  EXTERNAL 256

+ENDPROC elan ;

+

+PROC out text (TEXT CONST text, INT CONST out type) :

+

+  INTERNAL 257 ;

+  out (text) ;

+  IF out type = error message 

+    THEN access error file ;

+         out (error file, text)

+  FI .

+ 

+access error file :

+  IF NOT errors occurred

+    THEN open error file

+  FI .

+

+ENDPROC out text ;

+

+PROC out line (INT CONST out type) :

+

+  INTERNAL 258 ;

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

+  IF out type = error message

+    THEN access error file ;

+         line (error file)

+  FI .

+

+access error file :

+  IF NOT errors occurred

+    THEN open error file

+  FI .

+

+ENDPROC out line ;

+

+PROC open error file :

+

+  errors occurred := TRUE ;

+  forget (ds) ;

+  ds := nilspace ;

+  error file := sequential file (output, ds) ;

+  headline (error file, "errors")

+

+ENDPROC open error file ;

+

+PROC prot :

+  list option := TRUE

+ENDPROC prot ;

+ 

+PROC prot off :

+  list option := FALSE

+ENDPROC prot off ;

+ 

+PROC check on :

+  check option := TRUE

+ENDPROC check on ;

+ 

+PROC check off :

+  check option := FALSE

+ENDPROC check off ;

+ 

+ENDPACKET elan ;

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

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

+        (*****************)                       (* Stand: 12.04.82     *)

+                                                  (* Vers.: 1.6.0        *)

+        editget,

+        feldeditor,

+        feldout,

+        feldposition,

+        feldeinruecken,

+        feldtab,

+        feldtabulator,

+        feldseparator,

+        feldmarke,

+        feldstelle,

+        feldwortweise,

+        feldanfang,

+        feldende,

+        feldrand,

+        feldlimit,

+        feldaudit,

+        feldzeichen,

+        feldkommando,

+        feldeinfuegen,

+        feldlernmodus,

+        is incharety,

+        getchar,

+        min :

+ 

+ 

+TEXT VAR tabulator :: "", separator :: "", fzeichen ::"",

+         kommando  :: "", audit     :: "";

+ 

+INT  VAR fmarke  ::  0, fstelle :: 1, frand :: 0, limit :: 77,

+         fanfang ::  1, dyn fanfang :: fanfang,  flaenge, fj,

+         fende   :: 77, dyn fende   :: fende, dezimalen :: 0;

+ 

+BOOL VAR wortweise      :: FALSE, feinfuegen :: FALSE,

+         blankseparator :: FALSE, lernmodus  :: FALSE,

+         war absatz; 

+ 

+LET blank = " ", hop=""1"", right=""2"", up=""3"", clear eop=""4"",

+    clear eol=""5"", bell=""7"", left=""8"", tab=""9"", down=""10"",

+    rubin=""11"", rubout=""12"", cr=""13"", mark=""16"", escape=""27"",

+    hoechstes steuerzeichen=""31"", dach=""94"", end mark=""14"", begin

+    mark=""15"", clear=""1""4"", hop tab=""1""9"", hop rubin=""1""11"",

+    hop rubout=""1""12"", hop cr=""1""13"", cr down=""13""10"",

+    right left tab rubout escape = ""2""8""9""12""27"", hop escape=""1""27"",

+    left left=""8""8"", left endmark=""8""14"", endmark left=""14""8"",

+    left right=""8""2"", blank left=" "8"",

+    blank left rubout=" "8""12"", absatzmarke=""15""14"", 

+    hop esc right left tab rubin rubout cr = ""1""27""2""8""9""11""12""13"",

+    hop esc right left tab down cr         = ""1""27""2""8""9""10""13"";

+ 

+(***************************  p r o z e d u r e n  *************************)

+ 

+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editfende):

+ 

+  disable stop ;  (* J.Liedtke 10.02.82 *)

+

+  INT CONST altflaenge :: LENGTH editsatz, altfrand :: frand,

+            altfmarke  :: fmarke, altfstelle :: fstelle,

+            altfanfang :: fanfang, altfende  :: fende, altlimit :: limit;

+  BOOL CONST altwortweise :: wortweise, altfeinfuegen :: feinfuegen;

+  fmarke := 0; fstelle := 1; fanfang := 1; dyn fanfang := 1; 

+  fende  := editfende MOD 256; dyn fende := fende;

+  limit  := editlimit MOD 256; wortweise := FALSE;

+  feinfuegen := FALSE; 

+  INT VAR x, y; get cursor (x,y); frand := x-1; 

+  out (editsatz);   cursor (x,y); 

+  REP

+    feldeditor (editsatz);

+    IF   (kommando SUB 1) = escape OR (kommando SUB 1) = hop 

+    THEN delete char (kommando, 1)

+    FI;

+    delete char (kommando, 1) 

+  UNTIL fzeichen = cr OR (fzeichen SUB 1) = separator OR is error

+  PER;

+  cursor (x + 1 + editflaenge - dyn fanfang, y); 

+  fmarke := altfmarke;  fstelle := altfstelle; fanfang := altfanfang;

+  dyn fanfang := fanfang; fende := altfende; dyn fende := fende;

+  limit := altlimit;  wortweise := altwortweise; frand := altfrand;

+  feinfuegen := altfeinfuegen . 

+ 

+editflaenge :

+  min (dyn fende, flaenge) .

+ 

+END PROC editget;

+ 

+PROC editget (TEXT VAR editsatz) :

+  INT VAR x, y; get cursor (x,y);

+  editget (editsatz, 255, fende-fanfang+2+frand-x)

+END PROC editget;

+ 

+PROC feldout (TEXT CONST satz) :

+  INT VAR x, y;

+  flaenge := min (fende, LENGTH satz);

+  out (cr);

+  frand TIMESOUT right; feldrest loeschen (fanfang);

+  IF   fmarke > 0

+  THEN outsubtext (satz, fanfang, fmarke-1); out (begin mark);

+       outsubtext (satz, fmarke, min (fstelle-1,flaenge));

+       out (end mark); outsubtext (satz, fstelle, flaenge);

+  ELIF absatzmarke noetig (satz) 

+  THEN get cursor (x,y); outsubtext (satz, fanfang, flaenge); 

+       cursor (x + fende + 1 - fanfang, y); out (absatzmarke)

+  ELSE outsubtext (satz, fanfang, flaenge)

+  FI

+END PROC feldout;

+ 

+ 

+PROC feld einruecken (TEXT CONST satz) :

+ 

+  IF   fstelle = fanfang

+  THEN fstelle := neue einrueckposition;

+       (fstelle-fanfang) TIMESOUT right

+  FI .

+ 

+neue einrueckposition :

+  INT VAR suchindex;

+  FOR suchindex FROM fanfang UPTO min (LENGTH satz, fende)

+  REP  IF   (satz SUB suchindex) <> blank

+       THEN LEAVE neue einrueckposition WITH suchindex

+       FI

+  PER;

+  fanfang .

+ 

+END PROC feld einruecken;

+ 

+TEXT PROC feldzeichen :

+  fzeichen

+END PROC feldzeichen;

+ 

+TEXT PROC feldkommando :

+  kommando

+END PROC feldkommando;

+ 

+PROC feldkommando (TEXT CONST t) :

+  kommando := t

+END PROC feldkommando;

+ 

+PROC feldtab (TEXT VAR t) :

+  t := tabulator

+END PROC feldtab;

+ 

+PROC feldtabulator (TEXT CONST t) :

+  tabulator := t

+END PROC feldtabulator;

+ 

+TEXT PROC feldseparator :

+  separator

+END PROC feldseparator;

+ 

+PROC feldseparator (TEXT CONST t) :

+  separator := t; blankseparator := t = blank

+END PROC feldseparator;

+ 

+TEXT PROC feldaudit :

+  audit

+END PROC feldaudit;

+ 

+PROC feldaudit (TEXT CONST a) :

+  audit := a

+END PROC feldaudit;

+ 

+BOOL PROC feldlernmodus :

+  lernmodus

+END PROC feldlernmodus;

+ 

+PROC feldlernmodus (BOOL CONST b) :

+  lernmodus := b 

+END PROC feldlernmodus;

+ 

+BOOL PROC feldeinfuegen :

+  feinfuegen

+END PROC feldeinfuegen;

+ 

+PROC feldeinfuegen (BOOL CONST b):

+  feinfuegen := b

+END PROC feldeinfuegen;

+ 

+BOOL PROC feldwortweise :

+  wortweise

+END PROC feldwortweise;

+ 

+PROC feldwortweise (BOOL CONST b) :

+  wortweise := b

+END PROC feldwortweise;

+ 

+INT PROC feldmarke :

+  fmarke

+END PROC feldmarke;

+ 

+PROC feldmarke (INT CONST i) :

+  fmarke  := i MOD 256

+END PROC feldmarke;

+ 

+INT PROC feldstelle :

+  fstelle

+END PROC feldstelle;

+ 

+PROC feldstelle (INT CONST i) :

+  fstelle := i MOD 256

+END PROC feldstelle;

+ 

+INT PROC feldanfang :

+  fanfang

+END PROC feldanfang;

+ 

+PROC feldanfang (INT CONST i) :

+  fanfang := i MOD 256; dyn fanfang := fanfang

+END PROC feldanfang;

+ 

+INT PROC feldende :

+  fende

+END PROC feldende;

+ 

+PROC feldende (INT CONST i) :

+  fende := i MOD 256; dyn fende := fende

+END PROC feldende;

+ 

+INT PROC feldrand :

+  frand

+END PROC feldrand;

+ 

+PROC feldrand (INT CONST i) :

+  frand := i MOD 256

+END PROC feldrand;

+ 

+INT PROC feldlimit :

+  limit

+END PROC feldlimit;

+ 

+PROC feldlimit (INT CONST i) :

+  limit := i MOD 256

+END PROC feldlimit;

+ 

+PROC feldposition :

+  INT VAR x, y;

+  IF   fstelle <= fende

+  THEN IF   fstelle < fanfang

+       THEN fstelle := fanfang;

+            IF fanfang > fende

+            THEN fende := fanfang; dyn fende := fanfang

+            FI

+       FI

+  ELSE fstelle := fende;

+       IF   fanfang > fende

+       THEN fanfang := fende; dyn fanfang := fende

+       FI

+  FI;

+  get cursor(x,y); cursor(1+frand+fstelle-fanfang+fmarke oder fstelle, y). 

+ 

+fmarke oder fstelle :

+  IF fmarke > 0 THEN 1 ELSE 0 FI .

+ 

+END PROC feldposition;

+ 

+PROC feldposition (INT CONST i) :

+  fstelle := i; feldposition

+END PROC feldposition;

+ 

+BOOL PROC absatzmarke noetig (TEXT CONST satz) : 

+ 

+  IF   wortweise

+  THEN (satz SUB LENGTH satz) = blank 

+  ELSE FALSE

+  FI

+END PROC absatzmarke noetig;

+ 

+PROC zeile neu schreiben (TEXT CONST satz) :

+  INT VAR x,y; get cursor (x,y);

+  flaenge := min (dyn fende, LENGTH satz);

+  cursor (1+frand, y);

+  feldrest loeschen (dyn fanfang);

+  outsubtext (satz, dyn fanfang, flaenge);

+  cursor (x,y)

+END PROC zeile neu schreiben;

+ 

+PROC feldrest loeschen (INT CONST fstelle):

+  INT VAR x,y;

+  IF   frand + fende <= 76

+  THEN get cursor (x,y); (1 + dyn fende - fstelle) TIMESOUT blank;

+       cursor (x,y)

+  ELSE out (clear eol); war absatz := FALSE 

+  FI

+END PROC feldrest loeschen;

+ 

+TEXT OP SUBB (TEXT CONST t, INT CONST i) :

+  IF i <= LENGTH t THEN t SUB i ELSE blank FI

+END OP SUBB;

+ 

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

+  IF a < b THEN a ELSE b FI

+END PROC min;

+ 

+BOOL PROC is incharety (TEXT CONST muster) :

+ 

+  fzeichen := incharety; 

+  IF   fzeichen = ""

+  THEN FALSE

+  ELSE IF   lernmodus 

+       THEN audit CAT fzeichen;

+            IF fzeichen = """" THEN audit CAT fzeichen

+       FI   FI ;

+       IF   fzeichen = muster 

+       THEN kommando := ""; TRUE

+       ELSE kommando CAT fzeichen; FALSE

+  FI   FI

+END PROC is incharety; 

+ 

+PROC getchar (TEXT VAR fzeichen) :

+ 

+  IF   kommando = ""

+  THEN inchar (fzeichen)

+  ELSE fzeichen := kommando SUB 1;

+       delete char (kommando, 1);

+       kommando CAT incharety

+  FI;

+  IF   lernmodus

+  THEN audit CAT fzeichen;

+       IF   fzeichen = """"

+       THEN audit CAT fzeichen

+       FI

+  FI .

+END PROC getchar;

+ 

+ 

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

+ 

+PROC feldeditor (TEXT VAR satz) :

+

+  enable stop ; (* J. Liedtke 10.02.82 *)

+

+  INT VAR x, y;

+  BOOL VAR inkompetent :: FALSE; war absatz := absatzmarke noetig (satz);

+  IF   fstelle <= fende 

+  THEN IF fstelle < fanfang THEN feldposition FI

+  ELSE feldposition

+  FI;

+  flaenge := min (fende, LENGTH satz);

+ 

+  REP  e i n g a b e  UNTIL inkompetent PER;

+ 

+  blanks abschneiden;

+  IF dyn fanfang <> fanfang THEN zurechtruecken FI;

+  IF   NOT war absatz AND absatzmarke noetig (satz) 

+  THEN absatzmarke schreiben

+  ELIF war absatz AND NOT absatzmarke noetig (satz)

+  THEN absatzmarke loeschen

+  FI .

+ 

+absatzmarke schreiben : 

+  get cursor (x,y); cursor (frand+fende-fanfang+2, y); out (absatzmarke);

+  cursor (x,y) .

+ 

+absatzmarke loeschen : 

+  get cursor (x,y); cursor (frand+fende-fanfang+2, y); out ("  ");

+  cursor (x,y) .

+ 

+zurechtruecken :

+  fstelle DECR (dyn fanfang - fanfang);

+  dyn fanfang := fanfang; dyn fende := fende;

+  zeile neu schreiben (satz) .

+ 

+blanks abschneiden :

+  flaenge := LENGTH satz;

+  FOR fj FROM flaenge DOWNTO 0 WHILE (satz SUB fj) = blank

+  REP delete char (satz, fj) PER;

+  IF fj < flaenge THEN satz CAT blank FI .

+ 

+eingabe :

+  IF   fmarke <= 0

+  THEN s c h r e i b e d i t o r;

+       IF   ueberlaufbedingung

+       THEN ueberlauf

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

+       FI

+  ELSE m a r k e d i t o r

+  FI .

+ 

+ueberlaufbedingung :

+  IF   fstelle <= dyn fende

+  THEN IF   fstelle <= limit

+       THEN FALSE

+       ELSE fzeichen > hoechstes steuerzeichen

+       FI

+  ELSE TRUE

+  FI .

+ 

+ueberlauf :

+  IF   fstelle > limit

+  THEN IF   wortweise OR fstelle > LENGTH satz

+       THEN ueberlauf in naechste zeile; LEAVE ueberlauf

+       FI

+  FI;

+  IF   fstelle >  dyn fende

+  THEN fstelle := dyn fende; out (left);

+       zeile um eins nach links verschieben

+  FI .

+ 

+ueberlauf in naechste zeile :

+  IF   wortweise

+  THEN umbrechen

+  ELSE out (bell); kommando := cr

+  FI;

+  inkompetent := TRUE .

+ 

+umbrechen :

+  IF   LENGTH satz > limit

+  THEN kommando CAT  subtext (satz, limit+1);

+       FOR fj FROM LENGTH satz DOWNTO fstelle

+       REP kommando CAT left PER;

+       satz := subtext (satz, 1, limit)

+  FI;

+  fj := limit;

+  zeichen zuruecknehmen;

+  (fstelle-fj) TIMESOUT left; fstelle := fj; feldrest loeschen (fstelle);

+  IF kommando = "" THEN kommando := blank left rubout FI;

+  blanks loeschen.

+ 

+blanks loeschen: 

+  REP   fj DECR 1;

+        IF (satz SUB fj) <> blank THEN LEAVE blanks loeschen FI;

+        delete char (satz, fj)

+  PER .

+ 

+zeichen zuruecknehmen: 

+  REP   fzeichen := satz SUB fj; delete char (satz, fj);

+        IF fzeichen = blank THEN LEAVE zeichen zuruecknehmen FI;

+        insert char (kommando, fzeichen, 1);

+        IF fj = fanfang     THEN LEAVE zeichen zuruecknehmen FI;

+        fj DECR1

+  PER.

+ 

+ausfuehren :

+  dezimalen := 0;

+  SELECT pos (hop esc right left tab rubin rubout cr, fzeichen) OF

+    CASE 1 : getchar (fzeichen);

+             SELECT pos (right left tab rubout escape, fzeichen) OF

+               CASE 1 : zum rechten frand

+               CASE 2 : zum linken  frand

+               CASE 3 : tabulator setzen

+               CASE 4 : zeile loeschen

+               CASE 5 : bei lernmodus ein zeichen lesen

+               OTHERWISE hop return

+             END SELECT

+    CASE 2 : escape aktion

+    CASE 3 : nach rechts

+    CASE 4 : nach links

+    CASE 5 : nach tabulator

+    CASE 6 : feinfuegen umschalten

+    CASE 7 : ausfuegen

+    CASE 8 : ggf absatz erzeugen; return

+    OTHERWISE return

+  END SELECT .

+ 

+ggf absatz erzeugen : 

+  IF   wortweise

+  THEN IF   fstelle > LENGTH satz

+       THEN IF   (satz SUB LENGTH satz) <> blank

+            THEN satz CAT blank; fstelle INCR 1

+            FI

+       FI

+  FI .

+ 

+nach rechts :

+  IF   fstelle < dyn fende AND (fstelle < limit OR fstelle < flaenge)

+  THEN out (right); fstelle INCR1

+  ELIF LENGTH satz > dyn fende

+  THEN zeile um eins nach links verschieben

+  ELSE return

+  FI .

+ 

+nach links :

+  IF   fstelle > dyn fanfang

+  THEN out (left); fstelle DECR1

+  ELIF dyn fanfang = fanfang

+  THEN out (bell)

+  ELSE zeile um eins nach rechts verschieben

+  FI .

+ 

+bei lernmodus ein zeichen lesen :

+  IF   lernmodus

+  THEN getchar (fzeichen); return;

+       fzeichen := escape

+  FI;

+  hop return; fzeichen := hop escape .

+ 

+zeile um eins nach links  verschieben :

+  dyn fanfang INCR 1; dyn fende INCR 1;

+  fstelle := dyn fende; zeile neu schreiben (satz) .

+ 

+zeile um eins nach rechts verschieben :

+  dyn fanfang DECR 1; dyn fende DECR 1;

+  fstelle := dyn fanfang; zeile neu schreiben (satz) .

+ 

+feinfuegen umschalten :

+  IF   feinfuegen

+  THEN feinfuegen := FALSE

+  ELSE feinfuegen := TRUE; get cursor (x,y); out (dach);

+       outsubtext (satz, fstelle, flaenge);

+       cursor (x,y); pause (1); 

+       feldrest loeschen (fstelle);

+       outsubtext (satz, fstelle, flaenge);

+       cursor (x,y) 

+  FI;

+  return .

+ 

+ausfuegen :

+  IF   flaenge < dyn fanfang OR fstelle > flaenge

+  THEN IF   fstelle = flaenge + 1 AND fstelle > dyn fanfang 

+       THEN fstelle := flaenge; out (left)

+       ELSE out (bell);

+            LEAVE ausfuegen

+       FI

+  FI;

+  ausfuegeoperation; delete char (satz, fstelle);

+  flaenge := min (dyn fende, LENGTH satz) .

+ 

+ausfuegeoperation :

+  get cursor (x,y); outsubtext (satz, fstelle+1, flaenge+1);

+  out (blank); cursor (x,y) .

+ 

+zum linken frand :

+  IF   fstelle > fanfang

+  THEN get cursor (x,y); cursor (1+frand, y); 

+       IF   dyn fanfang = fanfang

+       THEN fstelle := fanfang

+       ELSE verschieben an linken frand

+       FI

+  FI .

+ 

+zum rechten frand :

+  fj := min (dyn fende, limit); get cursor (x,y);

+  IF   LENGTH satz >  fj

+  THEN IF   fstelle >= LENGTH satz

+       THEN out (bell)

+       ELIF LENGTH satz > dyn fende

+       THEN verschieben an rechten frand

+       ELSE cursor (x + LENGTH satz - fstelle, y);

+            fstelle := LENGTH satz

+       FI

+  ELIF fstelle < fj

+  THEN cursor (x + fj-fstelle, y); fstelle := fj

+  FI .

+ 

+verschieben an linken  frand :

+  dyn fanfang := fanfang; dyn fende := fende;

+  fstelle := fanfang; zeile neu schreiben (satz).

+ 

+verschieben an rechten frand :

+  (dyn fende - fstelle) TIMESOUT right;

+  dyn fanfang INCR (LENGTH satz - dyn fende); dyn fende := LENGTH satz;

+  fstelle := dyn fende; zeile neu schreiben (satz).

+ 

+nach tabulator :

+  fj := pos (tabulator, "^", fstelle+1);

+  IF   fj = 0

+  THEN IF   (satz SUB fstelle) = blank AND fstelle = fanfang

+       THEN IF   satz = blank 

+            THEN fstelle INCR 1; out (right)

+            ELSE out (blank left); feld einruecken (satz);

+            FI;

+            LEAVE nach tabulator

+       ELIF flaenge < dyn fende AND fstelle <= flaenge

+       THEN fj := flaenge + 1

+       FI

+  ELSE dezimalen := 1

+  FI;

+  IF   fj > 0 AND fj <= dyn fende

+  THEN outsubtext (satz, fstelle, fj-1); fstelle := fj

+  ELSE (fstelle-dyn fanfang) TIMESOUT left;

+       fstelle := dyn fanfang; insert char (kommando, down, 1)

+  FI .

+ 

+tabulator setzen :

+  IF   (tabulator SUB fstelle) = "^"

+  THEN fzeichen := right

+  ELSE fzeichen := "^"

+  FI;

+  WHILE fstelle > LENGTH tabulator

+  REP  tabulator CAT right PER;

+  replace (tabulator, fstelle, fzeichen);

+  insert char (kommando,   tab, 1);

+  insert char (kommando, hop, 1);

+  inkompetent := TRUE .

+ 

+zeile loeschen :

+  IF   fstelle = 1 

+  THEN satz := ""; feldrest loeschen (fstelle); hop return

+  ELIF fstelle <= flaenge

+  THEN REP delete char (satz, LENGTH satz)

+       UNTIL fstelle > LENGTH satz

+       PER;

+       flaenge := fstelle - 1; feldrest loeschen (fstelle)

+  ELSE hop return

+  FI .

+ 

+(***********************  s c h r e i b e d i t o r  ***********************)

+ 

+schreibeditor :

+  REP   getchar (fzeichen);

+        IF   fzeichen <= hoechstes steuerzeichen THEN LEAVE schreibeditor

+        ELIF separator bedingung                 THEN LEAVE schreibeditor

+        ELSE f o r t s c h r e i b e n           FI 

+  PER .

+ 

+separatorbedingung :

+  IF   blankseparator

+  THEN IF   flaenge + 2 <= fstelle

+       THEN insert char (kommando, fzeichen, 1);

+            fzeichen := blank

+       FI

+  FI;

+  fzeichen = separator .

+ 

+fortschreiben :

+  IF   dezimalen > 0 THEN dezimaltabulator FI;

+  out (fzeichen);

+  IF   fstelle > flaenge

+  THEN anhaengen

+  ELIF dezimalen = 0 AND feinfuegen

+  THEN insert char (satz, fzeichen, fstelle)

+  ELSE replace     (satz, fstelle, fzeichen)

+  FI;

+  flaenge := min (dyn fende, LENGTH satz);

+  fstelle INCR 1;

+  IF   feinfuegen AND dezimalen = 0 AND fstelle <= flaenge

+  THEN zeilenrest neu schreiben

+  FI;

+  IF   fstelle > dyn fende

+  OR   fstelle > limit AND (wortweise OR fstelle > flaenge)

+  THEN LEAVE schreibeditor

+  FI .

+ 

+zeilenrest neu schreiben :

+  get cursor (x,y); outsubtext (satz, fstelle, flaenge); cursor (x,y) .

+ 

+dezimaltabulator :

+  IF   fzeichen < "0" OR fzeichen > "9"

+  THEN dezimalen := 0

+  ELIF dezimalen = 1

+  THEN IF   (satz SUB fstelle) = blank OR fstelle > flaenge

+       THEN dezimalen := 2

+       ELSE dezimalen := 0

+       FI

+  ELIF (satz SUB fstelle-dezimalen) = blank

+  THEN replace (satz, fstelle-dezimalen,

+                subtext (satz, fstelle-dezimalen+1, fstelle-1)) ;

+       dezimalen TIMESOUT left;

+       outsubtext (satz, fstelle-dezimalen, fstelle-2);

+       dezimalen INCR 1; fstelle DECR 1

+  ELSE dezimalen := 0

+  FI .

+ 

+anhaengen :

+  FOR fj FROM flaenge+2 UPTO fstelle

+  REP satz CAT blank PER;

+  satz CAT fzeichen .

+ 

+ 

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

+ 

+markeditor :

+  getchar (fzeichen);

+  SELECT pos (hop esc right left tab down cr, fzeichen) OF

+    CASE 1 : getchar (fzeichen);

+             IF   fzeichen = right THEN markierung maximal

+             ELIF fzeichen = left  THEN markierung minimal

+             ELSE hop return

+             FI

+    CASE 2 : escape aktion

+    CASE 3 : markierung verlaengern

+    CASE 4 : markierung verkuerzen

+    CASE 5 : markierung bis tab verlaengern

+    CASE 6,7 : zeilenrest markieren

+    OTHERWISE IF   fzeichen <= hoechstes steuerzeichen

+              THEN return

+              ELSE out (bell)

+              FI

+  END SELECT .

+ 

+markierung verlaengern :

+  IF   fstelle <= flaenge

+  THEN out (satz SUB fstelle, end mark left); fstelle INCR 1

+  ELSE return

+  FI .

+ 

+markierung maximal :

+  IF   fstelle <= flaenge

+  THEN outsubtext (satz, fstelle, flaenge); out (end mark left);

+       fstelle := flaenge + 1

+  FI .

+ 

+zeilenrest markieren :

+  IF   fstelle <= flaenge

+  THEN outsubtext (satz, fstelle, flaenge);

+       out (end mark left);

+       (flaenge-fstelle+2) TIMESOUT left

+  FI;

+  return .

+ 

+markierung verkuerzen :

+  IF   fstelle > fmarke

+  THEN fstelle DECR 1;

+       out (left end mark, satz SUBB fstelle, left left)

+  ELSE out (bell)

+  FI .

+ 

+markierung minimal :

+  IF   fstelle > fmarke

+  THEN (fstelle-fmarke) TIMESOUT left; out (end mark);

+       outsubtext (satz, fmarke, fstelle-1);

+       (fstelle-fmarke+1) TIMESOUT left; fstelle := fmarke

+  FI .

+ 

+markierung bis tab verlaengern :

+  fj := pos (tabulator, "^", fstelle + 1);

+  IF   fj = 0

+  THEN fj := flaenge - fstelle + 1; IF fj <= 0 THEN return FI

+  ELSE fj DECR fstelle

+  FI;

+  IF   fj > 0

+  THEN outsubtext (satz, fstelle, min (fstelle+fj-1, flaenge));

+       out (end mark left)

+  FI;

+  fstelle INCR fj;

+  IF fstelle > (dyn fende+1) THEN return FI .

+ 

+ 

+(******************* allgemein verwendete refinements *********************)

+ 

+return :

+  insert char (kommando, fzeichen, 1);

+  inkompetent := TRUE .

+ 

+hop return :

+  return; insert char (kommando, hop, 1) .

+ 

+escape aktion :

+  getchar (fzeichen); return;

+  insert char (kommando, escape, 1);

+  insert char (fzeichen, escape, 1) .

+ 

+END PROC feldeditor;

+ 

+END PACKET feldeditor;

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

+PACKET file DEFINES                            (* Autor: J.Liedtke *)

+                                               (* Stand: 30.04.82  *)

+       FILE ,

+       := ,

+       input ,

+       output ,

+       modify ,

+       sequential file ,

+       getline ,

+       putline ,

+       line ,

+       reset ,

+       eof ,

+       put ,

+       get ,

+       page ,

+       out ,

+       eop ,

+       close ,

+       max line length ,

+       max page length ,

+       read record , 

+       write record , 

+       forward , 

+       backward , 

+       delete record , 

+       insert record , 

+       to first record ,

+       to eof , 

+       is first record , 

+       headline ,

+       copy attributes ,

+       reorganize ,

+       feldeditor ,

+       feldout ,

+       feldeinruecken ,

+       pos ,

+       change ,

+       subtext ,

+       sort :

+ 

+ 

+ 

+TYPE FILE = STRUCT ( BOUND DATEI f ,

+                     INT index, pointer, line counter,

+                         mode, max line length, max page length,

+                     BOOL edit status unchanged) ;

+ 

+TYPE TRANSPUTDIRECTION = INT ;

+ 

+LET closed = 1 ,

+    in     = 2 ,

+    outp   = 3 ,

+    mod    = 4 ,

+    end    = 5 ,

+    escape = ""27"" ,

+

+    nullzustand    = "    0    1    1" ,

+

+    max length = 15 000 ;    (*  < maxint/2 because 2 * maxlength possible*)

+

+ 

+TRANSPUTDIRECTION PROC input :

+  TRANSPUTDIRECTION : ( in )

+ENDPROC input ;

+ 

+TRANSPUTDIRECTION PROC output :

+  TRANSPUTDIRECTION : ( outp )

+ENDPROC output ;

+ 

+TRANSPUTDIRECTION PROC modify :

+  TRANSPUTDIRECTION : ( mod )

+ENDPROC modify ;

+ 

+LET DATEI = ROW 4075 STRUCT (

+                INT nachfolger, vorgaenger, index, fortsetzung,

+                TEXT inhalt ) ;

+ 

+LET anker = 2 ,

+    freianker = 1 ;

+ 

+TEXT VAR number word ;

+

+FILE VAR result file ;

+ 

+DATASPACE VAR scratch space ;

+close ;

+ 

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode) :

+ 

+  IF CONCR (mode) = outp

+    THEN close

+  FI ;

+  sequential file (mode, scratch space)

+ 

+ENDPROC sequential file ;

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,

+                           DATASPACE VAR ds) :

+ 

+  IF type (ds) = 1002

+    THEN result file.f := ds

+  ELIF type (ds) < 0

+    THEN result file.f := ds ;

+         type (ds, 1002) ;

+         datei initialisieren (CONCR (result file.f))

+  ELSE   errorstop ("dataspace has wrong type") ;

+         result file.f := scratch space

+  FI ;

+  result file.mode := CONCR (mode) ;

+  reset (result file) ;

+  result file.max line length := max line length (result file) ;

+  result file.max page length := 0 ;

+ 

+  result file .

+ 

+ENDPROC sequential file ;

+ 

+ 

+FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,

+                           TEXT CONST name ) :

+ 

+  IF exists (name)

+    THEN get dataspace if file

+  ELIF CONCR (mode) <> in

+    THEN get new file space

+  ELSE errorstop ("input file not existing") ;

+       result file.f := scratch space

+  FI ;

+  IF CONCR (mode) <> in

+    THEN status (name, "") ;

+         headline (result file, name)

+  FI ;

+  result file.mode := CONCR (mode) ;

+  reset (result file) ;

+  result file.max line length := max line length (result file) ;

+  result file.max page length := 0 ;

+ 

+  result file .

+ 

+get new file space :

+  result file.f := new (name) ;

+  IF NOT is error

+    THEN type (old (name), 1002) ;

+         datei initialisieren ( CONCR (result file.f) )

+  FI .

+ 

+get dataspace if file :

+  result file.f := old (name, 1002) .

+ 

+ENDPROC sequential file ;

+ 

+INT PROC max line length (FILE CONST file) :

+ 

+  int (subtext (zustand, 16, 20)) .

+ 

+zustand : 

+  CONCR (file.f) (freianker).inhalt .

+

+ENDPROC max line length ;

+ 

+PROC max line length (FILE VAR file, INT CONST length) :

+ 

+  replace (zustand, 16, text (length,5)) .

+ 

+zustand : 

+  CONCR (file.f) (freianker).inhalt .

+ 

+ENDPROC max line length ;

+ 

+PROC headline (FILE VAR file, TEXT CONST head) :

+ 

+  CONCR (file.f)(anker).inhalt := head

+ 

+ENDPROC headline ;

+ 

+TEXT PROC headline (FILE VAR file) :

+ 

+  CONCR (file.f)(anker).inhalt

+ 

+ENDPROC headline ;

+ 

+PROC copy attributes (FILE CONST source, FILE VAR dest) :

+

+  dest attributes := source attributes ;

+  reset edit status (dest) ;

+  dest headline   := source headline .

+

+dest attributes :   CONCR (dest.f) (freianker).inhalt .

+source attributes : CONCR (source.f) (freianker).inhalt .

+

+dest headline :     CONCR (dest.f) (anker).inhalt .

+source headline :   CONCR (source.f) (anker).inhalt .

+

+ENDPROC copy attributes ;

+

+

+PROC input (FILE VAR file) :

+ 

+  file.mode := in ;

+  reset (file)

+ 

+ENDPROC input ;

+ 

+PROC output (FILE VAR file) :

+ 

+  file.mode := outp ;

+  reset (file)

+ 

+ENDPROC output ;

+ 

+PROC modify (FILE VAR file) :

+ 

+  file.mode := mod ;

+  reset (file)

+ 

+ENDPROC modify ;

+ 

+ 

+PROC putline (FILE VAR file, TEXT CONST record) :

+ 

+  check mode (file, outp) ;

+  line (file) ;

+  CONCR (file.f)(file.index).inhalt := record ;

+  file.pointer := max length

+ 

+ENDPROC putline ;

+ 

+ 

+PROC getline (FILE VAR file, TEXT VAR record) :

+ 

+  check mode (file, in) ;

+  line (file) ;

+  record := CONCR (file.f)(file.index).inhalt ;

+  file.pointer := max length

+ 

+ENDPROC getline ;

+ 

+ 

+PROC line (FILE VAR file) :

+ 

+  file.index := CONCR (file.f) (file.index).nachfolger ;

+  file.pointer  := 0 ;

+  IF file.mode = in

+    THEN check eof

+  ELIF file.mode = outp

+    THEN satz erzeugen (CONCR (file.f), file.index) ;

+         CONCR (file.f)(file.index).inhalt := "" ;

+         perhaps implicit page feed

+  FI .

+ 

+check eof :

+  IF eof

+    THEN file.mode := end

+  FI .

+ 

+eof : CONCR (file.f)(file.index).nachfolger = anker .

+ 

+perhaps implicit page feed :

+  file.line counter INCR 1 ;

+  IF file.line counter = file.max page length

+    THEN page (file)

+  FI .

+ 

+ENDPROC line ;

+ 

+PROC check mode (FILE CONST file, INT CONST mode) :

+ 

+  IF file.mode = mode

+      THEN LEAVE check mode

+  ELIF file.mode = closed

+      THEN errorstop ("file not open")

+  ELIF file.mode = mod

+      THEN errorstop ("operation not in transputdirection 'modify'")

+  ELIF mode = mod

+      THEN errorstop ("operation only in transputdirection 'modify'")

+  ELIF file.mode = end

+      THEN IF eof (file) THEN errorstop ("input after end of file") FI

+  ELIF mode = in

+      THEN errorstop ("input access to output file")

+  ELIF mode = outp

+      THEN errorstop ("output access to input file")

+  FI

+ 

+ENDPROC check mode ;

+ 

+PROC reset (FILE VAR file) :

+ 

+  file.pointer := max length ;

+  file.line counter := 0 ;

+  file.edit status unchanged := TRUE ;

+  initialize file index ;

+  set correct file mode .

+ 

+initialize file index :

+  IF file.mode = outp

+    THEN file.index := last record

+    ELSE file.index := anker

+  FI .

+ 

+set correct file mode :

+  IF file.mode = end

+    THEN file.mode := in

+  FI ;

+  IF file.mode = in AND empty file

+    THEN file.mode := end

+  FI .

+ 

+last record : CONCR (file.f) (anker).vorgaenger .

+ 

+empty file  : CONCR (file.f) (anker).nachfolger = anker .

+ 

+ENDPROC reset ;

+ 

+BOOL PROC eof (FILE CONST file) :

+ 

+  IF file.mode = end

+    THEN end of record

+  ELIF file.mode = mod

+    THEN file.index = anker

+    ELSE FALSE

+  FI .

+ 

+end of record :

+  file.pointer >= length (CONCR (file.f)(file.index).inhalt) .

+ 

+ENDPROC eof ;

+ 

+PROC line (FILE VAR file, INT CONST lines) :

+ 

+  check mode (file, outp) ;

+  INT VAR i ;

+  FOR i FROM 1 UPTO lines REP

+    line (file)

+  PER

+ 

+ENDPROC line ;

+ 

+PROC page (FILE VAR file) :

+ 

+  file.line counter := 0 ;

+  putline (file, "#page")

+ 

+ENDPROC page ;

+ 

+BOOL PROC eop (FILE CONST file) :

+ 

+  CONCR (file.f)(file.index).inhalt = "#page"

+ 

+ENDPROC eop ;

+ 

+PROC put (FILE VAR file, TEXT CONST word) :

+ 

+  check mode (file, outp) ;

+  IF file.pointer + LENGTH word >= file.max line length

+    THEN line (file)

+  FI ;

+  put word (CONCR (file.f)(file.index).inhalt, word, file.pointer)

+ 

+ENDPROC put ;

+ 

+PROC put word (TEXT VAR record, TEXT CONST word, INT VAR pointer) :

+ 

+  IF pointer > 0

+    THEN record CAT " " ;

+  FI ;

+  record CAT word ;

+  pointer := LENGTH record

+ 

+ENDPROC put word ;

+ 

+PROC put (FILE VAR f, INT CONST value) :

+ 

+  put (f, text (value) )

+ 

+ENDPROC put ;

+ 

+PROC put (FILE VAR f, REAL CONST real) :

+ 

+  put (f, text (real) )

+ 

+ENDPROC put ;

+ 

+PROC out (FILE VAR file, TEXT CONST word) :

+ 

+  check mode (file, outp) ;

+  IF file.pointer + LENGTH word >= file.max line length

+    THEN line (file)

+  FI ;

+  record CAT word ;

+  file.pointer INCR LENGTH word .

+ 

+record : CONCR (file.f)(file.index).inhalt .

+ 

+ENDPROC out ;

+ 

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

+ 

+  check mode (file, in) ;

+  get word (CONCR (file.f)(file.index).inhalt, word,

+            file.pointer, max length, separator)

+ 

+ENDPROC get ;

+ 

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

+ 

+  check mode (file, in) ;

+  get word (CONCR (file.f)(file.index).inhalt, word,

+            file.pointer, max length, "")

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR file, TEXT VAR word) :

+ 

+  check mode (file, in) ;

+  next word (file, CONCR (file.f)(file.index).inhalt, word)

+ 

+ENDPROC get ;

+ 

+PROC next word (FILE VAR file, TEXT CONST record, TEXT VAR word) :

+ 

+  get next non blank char ;

+  IF char found

+    THEN get word (record, word, file.pointer, max length, " ")

+  ELIF last line of file

+    THEN word := "" ;

+         file.pointer := max length

+    ELSE line (file) ;

+         get (file, word)

+  FI .

+ 

+get next non blank char :

+  TEXT VAR char ;

+  REP

+    file.pointer INCR 1 ;

+    char := record SUB file.pointer

+  UNTIL char <> " " PER ;

+  file.pointer DECR 1 .

+ 

+char found :  char <> "" .

+ 

+last line of file :

+  CONCR (file.f) (anker).nachfolger = anker .

+ 

+ENDPROC next word ;

+ 

+PROC get (FILE VAR f, INT VAR number) :

+ 

+  get (f, number word) ;

+  number := int (number word)

+ 

+ENDPROC get ;

+ 

+PROC get (FILE VAR f, REAL VAR number) :

+ 

+  get (f, number word) ;

+  number := real (number word)

+ 

+ENDPROC get ;

+ 

+PROC get word (TEXT CONST record, TEXT VAR word, INT VAR pointer,

+               INT CONST max length, TEXT CONST separator) :

+ 

+  INT VAR end of word := pos (record, separator, pointer+1) - 1 ;

+  IF end of word < 0

+    THEN end of word := pointer + max length

+  FI ;

+  word := subtext (record, pointer+1, end of word) ;

+  pointer := end of word + 1

+ 

+ENDPROC get word ;

+ 

+PROC close (FILE VAR file) :

+ 

+  file.mode := closed

+ 

+ENDPROC close ;

+ 

+PROC close :

+ 

+  disable stop ;

+  forget (scratch space) ;

+  scratch space := nilspace

+ 

+ENDPROC close ;

+ 

+INT PROC max page length (FILE CONST file) :

+  file.max page length

+ENDPROC max page length ;

+ 

+PROC max page length (FILE VAR file, INT CONST length) :

+  file.max page length := length

+ENDPROC max page length

+ 

+ 

+PROC read record (FILE CONST file, TEXT VAR record) : 

+ 

+  check mode (file, mod) ;

+  record := CONCR (file.f) (file.index).inhalt 

+ 

+ENDPROC read record ; 

+ 

+PROC write record (FILE VAR file, TEXT CONST record) : 

+ 

+  check mode (file, mod) ;

+  CONCR (file.f) (file.index).inhalt := record 

+ 

+ENDPROC write record ; 

+ 

+PROC forward (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.index <> anker 

+    THEN file.index := CONCR (file.f) (file.index).nachfolger 

+    ELSE errorstop ("forward at eof") 

+  FI 

+ 

+ENDPROC forward ; 

+ 

+PROC backward (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := CONCR (file.f) (file.index).vorgaenger ; 

+  IF file.index = anker 

+    THEN to first record (file) ; 

+         errorstop ("backward at first record") 

+  FI 

+ 

+ENDPROC backward ; 

+ 

+PROC delete record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.edit status unchanged

+    THEN reset edit status (file)

+  FI ;

+  satz loeschen (CONCR (file.f), file.index) 

+ 

+ENDPROC delete record ; 

+ 

+PROC insert record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  IF file.edit status unchanged

+    THEN reset edit status (file)

+  FI ;

+  satz erzeugen (CONCR (file.f), file.index) 

+ 

+ENDPROC insert record ; 

+ 

+PROC to first record (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := CONCR (file.f) (anker).nachfolger 

+ 

+ENDPROC to first record ; 

+ 

+PROC to eof (FILE VAR file) : 

+ 

+  check mode (file, mod) ;

+  file.index := anker 

+ 

+ENDPROC to eof ; 

+ 

+BOOL PROC is first record (FILE CONST file) : 

+ 

+  file.index = CONCR (file.f) (anker).nachfolger 

+ 

+ENDPROC is first record ; 

+ 

+PROC reset edit status (FILE VAR file) :

+ 

+  replace (zustand, 1, nullzustand) ;

+  file.edit status unchanged := FALSE .

+ 

+zustand :  CONCR (file.f)(freianker).inhalt .

+ 

+ENDPROC reset edit status ;

+ 

+ 

+FILE VAR scratch , file ;

+TEXT VAR record ;

+ 

+LET esc = ""27"" ;

+ 

+PROC reorganize (TEXT CONST file name) :

+ 

+  IF exists (file name)

+    THEN last param (file name) ;

+         reorganize file

+    ELSE errorstop ("file does not exist")

+  FI .

+ 

+reorganize file :

+  scratch := sequential file (output) ;

+  headline (scratch, file name) ;

+  IF format 15

+    THEN set to 16 file type ; 

+         file := sequential file (input, file name)

+    ELSE file := sequential file (input, file name) ;

+         copy attributes (file, scratch) 

+  FI ;

+ 

+  disable stop ;

+

+  INT VAR counter := 0 ;

+  WHILE NOT eof (file) REP

+    getline (file, record) ;

+    putline (scratch, record) ;

+    counter INCR 1 ;

+    cout (counter) ;

+    IF is incharety (escape) OR is error

+      THEN close ;

+           LEAVE reorganize

+    FI

+  PER ;

+  forget file ;

+  copy (scratch space, file name) ;

+  close .

+ 

+forget file :

+  BOOL CONST old status := command dialogue ;

+  command dialogue (FALSE) ;

+  forget (file name) ;

+  command dialogue (old status) .

+ 

+format 15 :  type (old (file name)) = 1001 .

+

+set to 16 file type :

+  type (old (file name), 1002) .

+

+ENDPROC reorganize ;

+ 

+PROC reorganize :

+ 

+  reorganize (last param)

+ 

+ENDPROC reorganize ;

+ 

+PROC feldout (FILE CONST file, TEXT CONST satz) :

+ 

+  feldout ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldout ;

+ 

+PROC feldeinruecken (FILE CONST file, TEXT CONST satz) :

+ 

+  feldeinruecken ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldeinruecken ;

+ 

+PROC feldeditor (FILE VAR file, TEXT CONST satz) :

+ 

+  feldeditor ( CONCR (file.f) (file.index).inhalt )

+ 

+ENDPROC feldeditor ;

+ 

+INT PROC pos (FILE CONST file, TEXT CONST pattern, INT CONST from) :

+ 

+  pos ( CONCR (file.f) (file.index).inhalt, pattern, from )

+ 

+ENDPROC pos ;

+ 

+PROC change (FILE VAR file, INT CONST from, to, TEXT CONST new) :

+ 

+  change ( CONCR (file.f) (file.index).inhalt, from, to, new )

+ 

+ENDPROC change ;

+ 

+TEXT PROC subtext (FILE CONST file, INT CONST from) :

+ 

+  record := subtext ( CONCR (file.f) (file.index).inhalt, from ) ;

+  record

+ 

+ENDPROC subtext ;

+ 

+TEXT PROC subtext (FILE CONST file, INT CONST from, to) :

+ 

+  record := subtext ( CONCR (file.f) (file.index).inhalt, from, to ) ;

+  record

+ 

+ENDPROC subtext ;

+ 

+(*  sortieren sequentieller Dateien                  Autor: P.Heyderhoff *) 

+                                                  (* Stand: 14.11.80     *) 

+ 

+BOUND DATEI VAR datei; 

+INT  VAR sortierstelle, sortanker, byte;

+TEXT VAR median, tausch ;

+ 

+PROC sort (TEXT CONST dateiname) : 

+     sortierstelle := feldanfang; sort (dateiname, "")

+ END PROC sort; 

+ 

+PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : 

+     sortierstelle := sortieranfang; sort (dateiname, "")

+ END PROC sort; 

+ 

+PROC sort (TEXT CONST dateiname, feldname) :

+     IF   exists (dateiname)

+     THEN datei := old (dateiname); 

+          IF   CONCR(datei) (freianker).nachfolger <> freianker 

+          THEN reorganize (dateiname) 

+          FI ; 

+          sortanker := 3;

+          IF   feldname = ""

+          THEN byte := 0

+          ELSE feldname in feldnummer uebersetzen

+          FI;

+          quicksort(sortanker, CONCR(datei)(freianker).fortsetzung-1) 

+     FI .

+feldname in feldnummer uebersetzen :

+    byte := pos (CONCR(datei) (sortanker).inhalt, feldname);

+    IF   byte > 0

+    THEN byte := pos (CONCR(datei) (sortanker).inhalt, code(255-byte))

+    FI;

+    IF   byte = 0 

+    THEN errorstop ("sort: feldname"); LEAVE sort

+    FI ; sortanker INCR 1 .

+ END PROC sort; 

+ 

+PROC quicksort ( INT CONST anfang, ende ) : 

+     IF   anfang < ende 

+     THEN INT VAR p,q; 

+          spalte    (anfang, ende, p, q); 

+          quicksort (anfang, q); 

+          quicksort (p, ende)    FI 

+ END PROC quicksort; 

+ 

+PROC spalte (INT CONST anfang, ende, INT VAR p, q): 

+     fange an der seite an und waehle den median; 

+     ruecke p und q so dicht wie moeglich zusammen; 

+     hole ggf median in die mitte . 

+ 

+   fange an der seite an und waehle den median : 

+     p := anfang; q := ende ; 

+     INT CONST m :: (p + q) DIV 2 ; 

+     median := subtext(datei m, merkmal m) . 

+ 

+   ruecke p und q so dicht wie moeglich zusammen : 

+     REP schiebe p und q so weit wie moeglich auf bzw ab; 

+         IF p < q THEN vertausche die beiden FI 

+     UNTIL p > q END REP . 

+ 

+   vertausche die beiden : 

+     tausch := datei p; datei p := datei q; datei q := tausch; 

+     p INCR 1; q DECR 1 . 

+ 

+   schiebe p und q so weit wie moeglich auf bzw ab : 

+     WHILE p kann groesser werden REP p INCR 1 END REP; 

+     WHILE q kann kleiner  werden REP q DECR 1 END REP . 

+ 

+   p kann groesser werden : 

+     IF p <= ende THEN subtext (datei p, merkmal p) <= median ELSE FALSE FI . 

+ 

+   q kann kleiner werden : 

+     IF q >= anfang THEN subtext(datei q,merkmal q) >= median ELSE FALSE FI . 

+ 

+   hole ggf median in die mitte : 

+     IF   m < q THEN vertausche m und q 

+     ELIF m > p THEN vertausche m und p FI . 

+ 

+   vertausche m und q : 

+     tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . 

+ 

+   vertausche m und p : 

+     tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . 

+ 

+   merkmal m :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei m SUB byte) FI .

+ 

+   merkmal p :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei p SUB byte) FI .

+ 

+   merkmal q :

+     IF byte = 0 THEN sortierstelle  ELSE 255 - code (datei q SUB byte) FI .

+ 

+   datei m :  CONCR(datei)(m).inhalt . 

+   datei p :  CONCR(datei)(p).inhalt . 

+   datei q :  CONCR(datei)(q).inhalt . 

+ 

+END PROC spalte; 

+ 

+ 

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

+ 

+OP := (FILE VAR a, FILE CONST b) :

+  EXTERNAL 294

+ENDOP := ;

+ 

+PROC becomes (ROW 8 INT VAR a, b) :

+  INTERNAL 294 ;

+  a := b

+ENDPROC becomes ;

+ 

+PROC datei initialisieren (DATEI VAR datei) : 

+  EXTERNAL 290 ;

+END  PROC datei initialisieren; 

+ 

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

+  EXTERNAL 291;

+END  PROC satz erzeugen; 

+ 

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

+  EXTERNAL 292 ;

+END  PROC satz loeschen; 

+ 

+ENDPACKET file ;

diff --git a/system/base/unknown/src/init b/system/base/unknown/src/init
new file mode 100644
index 0000000..02b8e74
--- /dev/null
+++ b/system/base/unknown/src/init
@@ -0,0 +1,250 @@
+ " Compiler Error : " 

+"              "

+"               |" 

+" Fehler entdeckt  " 

+"Keine Fehler gefunden,  "

+" Sekunden CPU-Zeit verbraucht"

+"       *******  ENDE DER UEBERSETZUNG  *******" 

+"FEHLER bei >> " 

+" <<  " 

+"weiter bei "

+"   ("      ")  " 

+"EOF im Programm" 

+"EOF beim Skippen" 

+"EOF im TEXT Denoter" 

+"EOF im Kommentar" 

+"' nach Bold fehlt"

+"das MAIN PACKET muss das letzte sein" 

+"ungueltiger Name fuer ein Interface Objekt" 

+"':' fehlt"

+"nach ENDPACKET folgt nicht der Paketname" 

+"ENDPACKET fehlt" 

+"CONST oder VAR fehlt" 

+"ungueltiger Name"

+" ',' in Deklarationsliste fehlt"

+"ist nicht der PROC Name"

+"fehlerhaftes Endes des MAIN PACKET" 

+"ENDPROC fehlt" 

+"PROC/OP Schachtelung unzulaessig" 

+"OP darf kein Parameter sein"

+"steht mehrfach im PACKET Interface" 

+"Mehrfachdeklaration" 

+"ist schon als Datenobjekt deklariert"

+"ist schon als PROC/OP deklariert" 

+"')' nach Parameterliste erwartet" 

+"Standard-Schluesselwort kann nicht redefiniert werden"

+"ungueltig als BOLD" 

+"'(' fehlt"

+"CONST bzw VAR nicht bei Strukturfeldern" 

+"'=' fehlt" 

+"Schluesselwort wird im Paket schon andersartig verwandt"

+"Dieser Typ ist schon definiert" 

+"ungueltiger Deklarierer" 

+"ungueltiger OP Name"

+"OP muss monadisch oder dyadisch sein" 

+"ist nicht der OP Name" 

+"ENDOP fehlt" 

+"Name nach ENDPROC fehlt" 

+"Name nach ENDOP fehlt" 

+"END END ist Unsinn"

+"Diese END... kenne ich nicht"

+"ROW Groesse ist kein INT" 

+"ROW Groesse ist kein Denoter"

+"Ein ROW muss mindestens ein Element haben"

+"ROW Groesse fehlt" 

+"Parameter kann man nicht initialisieren"

+"Konstanten muessen initialisert werden"

+"'::' verwenden"

+"')' fehlt" 

+"Nachkommastellen fehlen" 

+"Exponent fehlt"

+"Undefinierter Typ" 

+"Rekursiv definierter Typ" 

+"Mehrfach definierter Selektor" 

+"VARs koennen aus dem Paket nicht herausgereicht werden" 

+"NO SHORTHAND DECLARATION IN THIS SCOPE FOR ROW SIZE DENOTER."

+"Typ Deklarationen nur im Paketrumpf" 

+"CONST bzw. VAR ohne Zusammenhang" 

+"ist nicht deklariert, steht aber in der Paket-Schnittstelle" 

+"ist nicht deklariert"

+"Typ ist schon deklariert" 

+"THIS IS NO CORRECT EXTERNAL NUMBER." 

+" EXTERNAL und INTERNAL unzulaessig"

+"Name erwartet" 

+"Denoter erwartet"

+"ENDPROC ohne Zusammenhang"

+"ENDOP ohne Zusammenhang"

+"Refinement ohne Zusammenhang"

+"Delimiter zwischen Paket-Refinement und Deklaration fehlt"

+"unzulaessiges Selektor-Symbol (kein Name)"

+"BOUND Schachtelungen unzulaessig"

+"Textende fehlt" 

+

+"Denoter-Wert wird fuer diese Maschine zu gross" 

+"NOBODY SHOULD EVER WRITE THAT, Uli ! " 

+"ist ein zusammenhangloses Schluesselwort"

+"'::' nur fuer Initialisierungen, sonst ':='"

+"welches Objekt soll verlassen werden?"

+"du bist gar nicht innerhalb dieses Refinements"

+"nur die eigene PROC / OP kann verlassen werden"

+"THEN fehlt"

+"FI fehlt"

+"BOOL - Ausdruck erwartet" 

+"ELSE - Teil ist notwendig, da ein Wert geliefert wird"

+"Mit ELIF kann kein IF-Statement beginnen"

+"INT - Ausdruck erwartet"

+"OF fehlt"

+"Keine Typanpassung moeglich"

+"CASE - Label fehlt"

+"CASE - Label ist zu gross (skipped)" 

+"mehrfach definiertes CASE-Label"

+"ungueltiges Zeichen nach CASE-Label" 

+" OTHERWISE PART fehlt"

+"END SELECT fehlt" 

+"DEAR USER, PLEASE BE REMINDED OF NOT CALLING REFINEMENTS RECURSIVLY !"

+"Dieses Refinement wird nicht benutzt" 

+"Zwischen diesen Symbolen fehlt ein Operator oder ein ';'"

+"undefinierter monadischer Operator" 

+"undefinierter dyadischer Operator" 

+"Operator vor '(' fehlt" 

+"kann nicht redefiniert werden" 

+"Auf die Feinstruktur des Typs kann man nicht mehr zugreifen" 

+"fuer diesen Typ nicht definierter Selektor" 

+"Primitive Typen koennen nicht selektiert werden"

+"bei ROWs nur Subscription"

+"ungueltiger Selectand" 

+"unzulaessiger Index fuer Subscription"

+"'[' ohne Zusammenhang"

+"']' ohne Zusammenhang"

+"']' nach Subscription fehlt"

+"',' ungueltig zwischen UNITs"

+"':' ungueltig zwischen UNITs"

+"';' fehlt"

+"nur die letzte UNIT einer SECTION darf einen Wert liefern"

+"Der Paketrumpf kann keinen Wert liefern" 

+"anstelle des letzten Symbols wurde ein Operand erwartet" 

+"Der Schleifenrumpf darf keinen Wert liefern"

+"INT VAR erwartet"

+"wird schon in einer aeusseren Schleife als Laufvariable benutzt"

+"FROM erwartet"

+"UPTO bzw DOWNTO fehlt"

+"REPEAT fehlt"

+"END REP fehlt"

+"UNTIL ohne Zusammenhang"

+"Die Konstante darf nicht mit ':=' veraendert werden"

+"In einer FOR-Schleife darf die Laufvariable nicht veraendert werden"

+"falscher Typ des Resultats" 

+"ist CONST, es wird aber ein VAR Parameter verlangt"

+"unbekannte Prozedur"

+"Parameter-Prozedur liefert falsches Resultat" 

+"Es gibt keine Prozedur mit diesen Parametern"

+"unbekannte Parameter-Prozedur" 

+"VIRTUAL PARAM MODE INCONSISTENCE" 

+"INCONSISTENCE BETWEEN THE PARAMETERS OF THE ACTUAL AND THE FORMAL PARAM PROC

+EDURE "

+"nicht deklariertes Objekt"

+"THIS OBJECT IS USED OUTSIDE IT'S RANGE"

+"Kein TYPE DISPLAY moeglich, da die Feinstruktur hier unbekannt ist"

+"zu wenig Felder angegeben"

+"zu viele Felder angegeben"

+"unzulaessiger Trenner zwischen Feldern"

+"Dies Feld hat einen falschen Typ"

+"THIS ROW DISPLAY DOES NOT HAVE THE CORRECT NUMBER OF ELEMENTS." 

+"Dieser Typ kann nicht noch mehr konkretisiert werden"

+

+"Warnung in Zeile"

+"   Zeile "

+"in Zeile "

+"<----+--->" 

+" TYPE undefiniert "

+" MODE undefiniert "

+"Parameter spezifiziert "

+"Parameter Typ(en) sind "

+" B Code, "

+" B Paketdaten generiert"

+"Operandentyp"

+"Typ des linken Operanden "

+"Typ des rechten Operanden "

+"erwartet "

+"gefunden "

+ "NULL   1TEST   1NOT    2INCR   1DECR 

+ 1MOV2   2MOV8   2MOVS   2EQI    2LSEQI

+ 2EQR    2LSEQR  2COMPLI 2COMPLR 2ADDI 

+ 3SUBI   3MULTI  3DIVI   3ADDR   3SUBR 

+ 3MULTR  3DIVR   3AND    2OR     2BRANCH

+8BTRUE  8BFALSE 8ACCDS  2ALIAS  5RETURN

+0MOVE   3CASE   3SUBS   5SUBS2  4SUBS8

+ 4SUBS16 4SEL    3BSTL   6ESTL   7HEAD 

+ 1PACKET 1BOOL   1NBOOL  1" 

+ 

+(*000  *)    END    INTERNAL   BOUND 

+(*001  *)    PACKET 

+(*002  *)    ENDPACKET 

+(*003  *)    DEFINES 

+(*003 A*)    LET 

+(*004  *)    PROCEDURE 

+(*005  *)    PROC 

+(*006  *)    ENDPROC 

+(*006A *)    ENDPROCEDURE 

+(*007  *)    OPERATOR 

+(*008  *)    OP 

+(*009  *)    ENDOP 

+(*009A *)    ENDOPERATOR 

+(*010  *)    TYPE 

+(*011  *)    INT 

+(*012  *)    REAL 

+(*013  *)    DATASPACE 

+(*015  *)    TEXT 

+(*016  *)    BOOL 

+(*017  *)    CONST 

+(*018  *)    VAR 

+(* INIT CONTROL *)  INTERNAL 

+(*019  *)    ROW 

+(*0191 *)    STRUCT CONCR 

+(*0193*)   ACTUAL 

+(*020  *)    REP 

+(*020A *)    REPEAT 

+(*021  *)    ENDREP 

+(*021A *)    ENDREPEAT PER 

+(*022  *)    SELECT 

+(*023  *)    ENDSELECT 

+(*0235 *)    EXTERNAL 

+(*024 *)     IF    (*024A *)   ENDIF 

+(*021  *)     THEN 

+(*022  *)     ELIF 

+(*023  *)     ELSE 

+(*024  *)     FI 

+(*026  *)     OF 

+(*026A *)     CASE 

+(*027  *)     OTHERWISE 

+(*029  *)     FOR 

+(*030  *)     FROM 

+(*031  *)     UPTO 

+(*032  *)     DOWNTO 

+(*034  *)     UNTIL 

+(*035  *)     WHILE 

+(*036  *)     LEAVE   WITH 

+(*0361 *)     TRUE 

+(*362 *)    FALSE 

+(*038  *)     :: SBL = := INCR DECR 

+(*039  *)     + - * / DIV MOD ** AND CAND OR COR NOT   <> > >= < <= 

+(*040  *)     MAIN 

+(*043*)  ENDOFFILE 

+ 

+PACKET a :

+

+PROC out (TEXT CONST t) :

+  EXTERNAL 60

+ENDPROC out ;

+

+PROC out text (TEXT CONST t, INT CONST typ) :

+  INTERNAL 257 ;

+  out (t)

+ENDPROC out text ;

+

+PROC out line (INT CONST typ) :

+  INTERNAL 258 ;

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

+ENDPROC out line ;

+

+ENDPACKET a ; 

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

+PACKET integer DEFINES 

+               sign, SIGN, abs, ABS, **, min, max, maxint,

+               get, random, initialize random :

+ 

+INT PROC maxint : 32767 ENDPROC maxint ;

+ 

+INT PROC sign (INT CONST argument) : 

+ 

+  IF argument < 0 THEN -1 

+  ELIF argument > 0 THEN 1 

+  ELSE 0 

+  FI 

+ 

+ENDPROC sign ; 

+ 

+INT OP SIGN (INT CONST argument) : 

+  sign (argument) 

+ENDOP SIGN ;

+ 

+INT PROC abs (INT CONST argument) : 

+ 

+  IF argument > 0 THEN argument 

+  ELSE - argument 

+  FI 

+ 

+ENDPROC abs ;

+ 

+INT OP ABS (INT CONST argument) : 

+  abs (argument) 

+ENDOP ABS ;

+ 

+INT OP ** (INT CONST arg, exp) : 

+ 

+  INT VAR x := arg , z := 1 ,

+          counter := exp ;

+ 

+  IF exp < 0 THEN errorstop ("INT OP ** : negative exponent") FI ;

+  IF arg = 0 AND exp = 0 

+    THEN errorstop (" 0 ** 0 is not defined") 

+  FI ;

+  IF exp = 0 THEN x := 1 FI ;

+ 

+  WHILE counter >= 2 REP 

+    calculate new x and z ;

+    counter := counter DIV 2 ;

+  ENDREP ;

+  z * x . 

+ 

+calculate new x and z : 

+  IF counter is not even 

+    THEN z := z * x 

+  FI ;

+  x := x * x . 

+ 

+counter is not even : 

+  counter MOD 2 = 1 . 

+ 

+ENDOP ** ;

+ 

+INT PROC min (INT CONST first, second) : 

+ 

+  IF first < second THEN first ELSE second FI 

+ 

+ENDPROC min ;

+ 

+INT PROC max (INT CONST first, second) : 

+ 

+  IF first > second THEN first ELSE second FI 

+ 

+ENDPROC max ; 

+ 

+ 

+PROC get (INT VAR number) :

+ 

+  get (word) ;

+  number := int (word) 

+ 

+ENDPROC get ;

+ 

+TEXT VAR word := "" ;

+ 

+ 

+ 

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

+(***                                          ***)

+(***          generator     32 650            ***)

+(***                                          ***)

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

+ 

+(*  INT-Zufallsgenerator mit Periode 32650      *)  (*Autor: Bake    *)

+                                                    (*Gymnasium Aspe *)

+ 

+INT VAR   z1 ::  14,   (* fuer den generator mit periode   25 *)

+          z2 :: 345;   (* fuer den generator mit periode 1306 *)

+ 

+ 

+     INT PROCEDURE   random   (INT CONST ugrenze, ogrenze) :

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

+ 

+generator 25;

+generator 1306;

+(zufallszahl MOD intervallgroesse) + ugrenze.

+ 

+(* Durch MOD wird bei grosser 'intervallgroesse' der vordere

+   Bereich doppelt ueberdeckt, also keine Gleichverteilung. heinrichs 

+   24.04.81 *)

+

+

+     generator 25 :

+z1 := (11 * z1 + 18) MOD 25

+(* erster generator. liefert alle zahlen zwischen 0 und 24. *).

+ 

+     generator 1306 :

+z2 := (24 * z2 + 23) MOD 1307

+(* zweiter generator. liefert alle zahlen zwischen 0 und 1305. *).

+ 

+     zufallszahl : 

+z1 + z2 * 25  (* diese zahl liegt zwischen 0 und 32 649 *).

+ 

+     intervallgroesse :   ogrenze - ugrenze + 1

+ 

+END PROC   random ;

+ 

+ 

+  PROCEDURE   initialize random   (INT CONST wert) :

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

+ 

+z1 := wert MOD 25;

+z2 := wert MOD 1306

+ 

+END PROC   initialize random ;

+ 

+ENDPACKET integer ; 

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

+PACKET mathlib DEFINES sqrt,**,exp,ln,log2,log10,sin,cos, 

+                       tan,arctan,sind,cosd,tand,arctand,e,pi,

+                       random,initializerandom :

+ 

+ 

+REAL VAR rdg::0.4711; 

+ 

+REAL PROC pi: 

+   3.141592653589793. 

+END PROC pi; 

+ 

+REAL PROC e: 

+  2.718281828459045. 

+END PROC e; 

+ 

+REAL PROC ln(REAL CONST x): 

+LET ln2= 0.6931471805599453; 

+log2(x)*ln2. 

+END PROC ln; 

+ 

+REAL PROC log2(REAL CONST z): 

+INT VAR k::0,p::0; 

+REAL VAR m::0.0,x::z,t::0.0,summe::0.0; 

+IF   x>0.0 

+THEN normal 

+ELSE errorstop("log2 mit negativer zahl");4711.4711 

+FI. 

+normal: 

+ IF   x>=0.5 

+ THEN normalise downwards 

+ ELSE normalise upwards 

+  FI; 

+  IF   x>=0.1 AND x< 0.7071067811865475 THEN 

+       t:=(x-0.5946035575013605)/(x+0.5946035575013605); 

+       summe:=reihenentwicklung (t) - 0.75 

+  FI; 

+  IF  x>=0.7071067811865475 AND x < 1.0 THEN 

+      t:=(x - 0.8408964152537145)/(x+0.8408964152537145); 

+      summe:= reihenentwicklung(t)-0.25 

+  FI; 

+  summe-real(p - 4*k). 

+ 

+ normalise downwards: 

+  WHILE  x>= 16.0 REP 

+    x:=x/16.0;k:=k+1; 

+  END REP; 

+  WHILE  x>=0.5 REP 

+    x:=x/2.0;p:=p-1; 

+  END REP. 

+ 

+ normalise upwards: 

+  WHILE x<=0.0625 REP 

+    x:=x*16.0;k:=k-1; 

+  END REP; 

+  WHILE x<= 0.5 REP 

+    x:=x*2.0;p:=p+1; 

+  END REP. 

+ 

+END PROC log2; 

+ 

+REAL PROC reihenentwicklung(REAL CONST x):

+  REAL VAR i::39.0,s::1.0/39.0; 

+  LET ln2=0.6931471805599453; 

+  WHILE i>1.0 REP 

+    i:=i-2.0;s:=s*x*x + 1.0/i; 

+  END REP; 

+  s*2.0*x/ln2. 

+END PROC reihenentwicklung; 

+ 

+REAL PROC log10(REAL CONST x): 

+  LET lg2=0.301029995664; 

+  log2(x)*lg2. 

+END PROC log10; 

+ 

+REAL PROC sqrt(REAL CONST z): 

+  REAL VAR y0,y1,x::z; 

+  INT VAR p::0; 

+  BOOL VAR q::FALSE; 

+  IF   x<0.0 

+  THEN errorstop("sqrt von negativer zahl");0.0

+  ELSE correct 

+  FI. 

+ 

+ correct: 

+  IF   x=0.0 

+  THEN 0.0 

+  ELSE nontrivial 

+  FI. 

+ 

+ nontrivial: 

+  IF   x<0.01 

+  THEN small 

+  ELSE notsmall 

+  FI. 

+ 

+ 

+ notsmall: 

+  IF   x>1.0 

+  THEN big 

+  ELSE normal 

+  FI. 

+ 

+ small: 

+  WHILE x<0.01 REP 

+    p:=p-1;x:=x*100.0; 

+  END REP; 

+  normal. 

+ 

+ big: 

+  WHILE x>=1.0 REP

+    p:=p+1;x:=x/100.0; 

+  END REP; 

+  normal. 

+ 

+ normal: 

+  IF   x<0.1 

+  THEN x:=x*10.0;q:=TRUE 

+  FI; 

+  y0:=10.0**p*(1.681595-1.288973/(0.8408065+x)); 

+  IF   q 

+  THEN y0:=y0/3.162278 

+  FI; 

+  y1:=(y0+z/y0)/2.0; 

+  y0:=(y1+z/y1)/2.0; 

+  y1:=(y0+z/y0)/2.0; 

+  (y1-z/y1)/2.0+z/y1. 

+ 

+END PROC sqrt; 

+ 

+REAL PROC exp(REAL CONST z): 

+  REAL VAR c,d,x::z, a, b ; 

+  IF   x<-180.2187 

+  THEN 0.0 

+  ELIF x<0.0 

+  THEN 1.0/exp(-x) 

+  ELIF x=0.0 

+  THEN 1.0 

+  ELSE x:=x/0.6931471805599453;approx 

+  FI. 

+ 

+ approx: 

+  a:=floor(x/4.0)+1.0; 

+  b:=floor(4.0*a-x); 

+  c:=(4.0*a-b-x)*16.0; 

+  d:=(c -floor(c))/16.0; 

+  d:=d*0.6931471805599453; 

+  ( (16.0 POWER a) / (2.0 POWER b) / (1.044273782427419 POWER c ))* 

+  ((((((0.135910788320380e-2*d-0.8331563191293753e-2)*d 

+  +0.4166661437490328e-1)*d-0.1666666658727157)*d+0.4999999999942539)*d 

+  - 0.9999999999999844)*d+1.0). 

+ 

+ENDPROC exp ; 

+ 

+REAL OP POWER (REAL CONST basis, exponent) : 

+ 

+  IF floor (exponent) = 0.0 

+    THEN 1.0 

+    ELSE power 

+  FI . 

+ 

+power : 

+  REAL VAR counter := floor (abs (exponent)) - 1.0 , 

+           result  := basis ; 

+  WHILE counter > 0.0 REP 

+    result := result * basis ; 

+    counter := counter - 1.0 

+  PER ; 

+  IF exponent > 0.0 

+    THEN result 

+    ELSE 1.0 / result 

+  FI . 

+ 

+ENDOP POWER ; 

+ 

+REAL PROC tan (REAL CONST x): 

+  REAL VAR p; 

+  p:=1.273239544735168*ABSx; 

+  tg(p)*sign(x). 

+END PROC tan; 

+ 

+REAL PROC tand(REAL CONST x): 

+  REAL VAR p; 

+  p:=0.02222222222222222*ABSx; 

+  tg(p)*sign(x). 

+END PROC tand; 

+ 

+REAL PROC tg(REAL CONST x): 

+  REAL VAR r,s,u,q; 

+  q:=floor(x);r:=x-q; 

+  IF q = floor(q/2.0) * 2.0 

+  THEN s:=r 

+  ELSE s:=(1.0-r) 

+  FI; 

+  q:= q - floor(q/4.0) * 4.0 ; 

+  u:=s*s; 

+  s:=s*0.785398163397448; 

+  s:=s/(((((((((-0.4018243865271481e-10*u-0.4404768172667185e-9)*u- 

+  0.748183650813680e-8)*u-0.119216115119129e-6)*u-0.1909255769212821e-5)*u- 

+0.3064200638849133e-4)*u-0.4967495424202482e-3)*u-0.8455650263333471e-2)*u- 

+  0.2056167583560294)*u+1.0); 

+  IF   q=0.0 

+  THEN s 

+  ELIF q=3.0 

+  THEN -s 

+  ELIF q=1.0 

+  THEN 1.0/s 

+  ELSE -1.0/s 

+  FI . 

+ 

+END PROC tg;

+ 

+REAL PROC sin(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x*1.273239544735168; 

+  q:=int(y); 

+  r:=y-real(q); 

+  IF   x<0.0 

+  THEN q:=q+4 

+  FI; 

+  sincos(q,r). 

+END PROC sin; 

+ 

+REAL PROC sind(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABSx/45.0; 

+  q:=int(y); 

+  r:=y-real(q); 

+  IF   x<0.0 

+  THEN q:=q+4 

+  FI; 

+  sincos(q,r). 

+END PROC sind; 

+ 

+ 

+REAL PROC cos(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x*1.273239544735168; 

+  q:=int(y); 

+  r:=y-real(q); 

+  q:=q+2; 

+  sincos(q,r). 

+END PROC cos; 

+ 

+REAL PROC cosd(REAL CONST x): 

+  REAL VAR y,r; 

+  INT VAR q; 

+  y:=ABS x/45.0; 

+  q:=int(y); 

+  r:=y-real(q); 

+  q:=q+2; 

+  sincos(q,r). 

+END PROC cosd; 

+ 

+ 

+REAL PROC sincos(INT VAR q,REAL VAR r): 

+  SELECT q MOD 8 + 1 OF 

+  CASE 1 : sin approx(r) 

+  CASE 2 : cos approx (1.0-r) 

+  CASE 3 : cos approx(r) 

+  CASE 4 : sin approx(1.0-r) 

+  CASE 5 : - sin approx(r) 

+  CASE 6 : - cos approx(1.0-r) 

+  CASE 7 : - cos approx(r) 

+  CASE 8 : - sin approx(1.0-r) 

+  OTHERWISE 0.0 

+  END SELECT 

+END PROC sincos; 

+ 

+REAL PROC sin approx(REAL CONST x): 

+  REAL VAR z::x*x; 

+  x*((((((0.6877101540593035e-11*z-0.1757149296873372e-8)*z+0.313361621667256

+8

+e-6)*z-0.3657620415845891e-4)*z+0.2490394570188737e-2)*z-0.807455121882e-1 

+)*z+0.7853981633974483). 

+END PROC sin approx; 

+ 

+REAL PROC cos approx(REAL CONST x): 

+  REAL VAR z::x*x; 

+  (((((( -0.3857761864560276e-12*z+0.115004970178141e-9)*z-0.246113638267419e

+-7)*z+0.3590860445885748e-5)*z-0.3259918869266875e-3)*z+0.1585434424381541e-1

+)*z-0.3084251375340425)*z+1.0. 

+END PROC cos approx; 

+ 

+REAL PROC arctan(REAL CONST x): 

+REAL VAR z::x*x; 

+IF   x<0.0 THEN -arctan(-x) 

+ELIF x>1.0 THEN 3.141592653589792/2.0-arctan(1.0/x) 

+ELIF x*1.0e16>2.67949192431e15   THEN pi/6.0+arctan(1.732050807568877-4.0 

+/(x+1.732050807568877)) 

+ELSE  x/(((((((0.0107090276046822*z-0.01647757182108040)*z 

+      +0.02177846332482151)*z-0.03019339673273880)*z+0.04656083561183398)*z 

+      -0.0888888888888888)*z+0.3333333333333333)*z+1.0)FI. 

+END PROC arctan; 

+ 

+REAL PROC arctand(REAL CONST x): 

+  arctan(x)/3.1415926589793*180.0. 

+END PROC arctand; 

+ 

+ 

+BOOL PROC even(INT CONST number): 

+ (number DIV 2)*2=number. 

+END PROC even; 

+ 

+REAL OP **(REAL CONST base,exponent): 

+  IF   base<0.0 

+  THEN errorstop("hoch mit negativer basis") 

+  FI; 

+  IF   base=0.0 

+  THEN test exponent 

+  ELSE

+      exp(exponent*ln(base)) 

+  FI. 

+ 

+ test exponent: 

+  IF   exponent=0.0 

+  THEN errorstop("0**0 geht nicht");4711.4711 

+  ELSE 0.0 

+  FI. 

+ 

+END OP **; 

+ 

+ 

+REAL PROC sign(REAL CONST number): 

+  IF   number >0.0  THEN 1.0 

+  ELIF number <0.0  THEN -1.0 

+  ELSE 0.0 

+  FI. 

+END PROC sign ;

+ 

+REAL OP **(REAL CONST a,INT CONST b): 

+REAL VAR p::1.0,r::a;INT VAR n::ABS b; 

+WHILE n>0 REP 

+  IF   n MOD 2=0 

+  THEN n:=n DIV 2;r:=r*r 

+  ELSE n DECR 1;p:=p*r 

+  FI; 

+END REP; 

+IF   b>0 

+THEN p 

+ELSE 1.0/p 

+FI. 

+END OP **; 

+ 

+ 

+ 

+REAL PROC random: 

+rdg:=rdg+pi;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=frac(rdg);rdg. 

+END PROC random; 

+ 

+ 

+PROC initializerandom(REAL CONST z): 

+ rdg:=z; 

+END PROC initializerandom; 

+ 

+END PACKET mathlib; 

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

+PACKET real DEFINES                            (* Autor: J.Liedtke *) 

+                                               (* Stand: 30.04.80  *) 

+   text , 

+   int ,

+   real ,

+   round ,

+   floor , 

+   frac ,

+   INCR ,

+   DECR ,

+   abs , 

+   ABS , 

+   sign ,

+   SIGN ,

+   MOD ,

+   min ,

+   max ,

+   put , 

+   get , 

+   max real ,

+   small real :

+

+LET mantissa length = 13 ;

+

+TEXT VAR mantissa ;

+

+ROW 10 REAL VAR real digit ;

+ 

+INT VAR i ; REAL VAR d := 0.0 ;

+FOR i FROM 1 UPTO 10 REP

+  real digit (i) := d ;

+  d := d + 1.0

+PER ;

+ 

+REAL PROC max real : 9.999999999999e126 ENDPROC max real ;

+ 

+REAL PROC small real : 1.0e-12 ENDPROC small real ;

+ 

+PROC sld (INT CONST in, REAL VAR real, INT VAR out) :

+  EXTERNAL 96 

+ENDPROC sld ; 

+ 

+INT PROC decimal exponent (REAL CONST mantissa) : 

+  EXTERNAL 97 

+ENDPROC decimal exponent ; 

+ 

+PROC set exp (INT CONST exponent, REAL VAR number) : 

+  EXTERNAL 98 

+ENDPROC set exp ; 

+ 

+REAL PROC tenpower (INT CONST exponent) :

+  REAL VAR result := 1.0 ;

+  set exp (exponent, result) ;

+  result

+ENDPROC tenpower ;

+

+REAL PROC floor (REAL CONST real) : 

+  EXTERNAL 99 

+ENDPROC floor ; 

+ 

+REAL PROC round (REAL CONST real, INT CONST digits) : 

+ 

+  REAL VAR result := real ;

+  IF (real <> 0.0) CAND (decimal exponent (real) + digits < mantissa length)

+    THEN round result ;

+  FI ;

+  result .

+

+round result :

+  set exp (decimal exponent (result) + digits, result) ;

+  IF result >= 0.0

+    THEN result := floor (result + 0.5)

+    ELSE result := floor (result - 0.5)

+  FI ;

+  set exp (decimal exponent (result) - digits, result) .

+

+ENDPROC round ; 

+ 

+TEXT VAR result ;

+ 

+TEXT PROC text (REAL CONST real) : 

+ 

+  REAL VAR value := rounded to seven digits ; 

+  IF value = 0.0 

+    THEN "0.0" 

+    ELSE 

+      process sign ; 

+      get mantissa (value) ; 

+      INT CONST exponent := decimal exponent (value) ; 

+      get short mantissa ; 

+      IF exponent > 7 OR exponent < LENGTH short mantissa - 7 

+        THEN scientific notation 

+        ELSE short notation 

+      FI 

+    FI . 

+ 

+rounded to seven digits : 

+  round ( real * tenpower( -decimal exponent(real) ) , 6 ) 

+        * tenpower ( decimal exponent(real) ) . 

+ 

+process sign : 

+  IF value < 0.0 

+    THEN result := "-" ; 

+         value := - value 

+    ELSE result := "" 

+  FI . 

+ 

+get short mantissa : 

+  INT VAR i := 7 ; 

+  WHILE (mantissa SUB i) = "0" REP 

+    i DECR 1 

+  UNTIL i=1 END REP ; 

+  TEXT CONST short mantissa := subtext (mantissa, 1, i) . 

+ 

+scientific notation : 

+  result CAT (mantissa SUB 1) ; 

+  result CAT "." ; 

+  result CAT subtext (mantissa, 2, 7) ; 

+  result + "e" + text (exponent) . 

+ 

+short notation : 

+  result CAT subtext (short mantissa, 1, exponent+1) ; 

+  result CAT (exponent+1 - LENGTH short mantissa) * "0" ; 

+  result CAT "." ; 

+  IF exponent < 0 

+    THEN result + (-exponent-1) * "0" + short mantissa 

+    ELSE result + subtext (short mantissa, exponent+2) 

+  FI . 

+ 

+ENDPROC text ; 

+ 

+PROC get mantissa (REAL CONST number) :

+

+  REAL VAR real mantissa := number ;

+  mantissa := "" ;

+  INT VAR i , digit ;

+  FOR i FROM 1 UPTO mantissa length REP

+    sld (0, real mantissa, digit) ;

+    mantissa CAT code (digit + 48)

+  PER ;

+

+ENDPROC get mantissa ;

+

+PROC put (REAL CONST real) : 

+ 

+  put (text (real) ) 

+ 

+ENDPROC put ; 

+ 

+TEXT PROC text (REAL CONST real, INT CONST length, fracs) :

+ 

+  REAL VAR value := round (real, fracs) ;

+  INT VAR  exponent  := decimal exponent (value) ;

+           IF value = 0.0 THEN exponent := 0 FI ;

+  INT VAR  floors    := exponent + 1 ,

+           floor length := length - fracs - 1 ;

+           IF value < 0.0 THEN floor length DECR 1 FI ;

+ 

+  IF value too big

+    THEN length * "*"

+    ELSE transformed value

+  FI .

+ 

+transformed value :

+  process leading blanks and sign ;

+  get mantissa (value) ;

+  result CAT subtext (mantissa, 1, floors) ;

+  IF LENGTH mantissa < floors

+    THEN result CAT (floors - LENGTH mantissa) * "0"

+  FI ;

+  result CAT "." ;

+  IF exponent < 0

+    THEN result CAT (-floors) * "0" ;

+         result CAT subtext (mantissa, 1, length - LENGTH result)

+    ELSE result CAT subtext (mantissa, floors+1, floors + fracs)

+  FI ;

+  IF LENGTH result < length

+    THEN result CAT (length - LENGTH result) * "0"

+  FI ;

+  result .

+ 

+process leading blanks and sign :

+  result := (floor length - max(floors,0)) * " " ;

+  IF value < 0.0

+    THEN result CAT "-" ;

+         value := - value

+  FI .

+ 

+value too big :

+  floors > floor length .

+ 

+ENDPROC text ;

+ 

+REAL PROC real (TEXT CONST text) : 

+ 

+  skip leading blanks ;

+  sign ; 

+  mantissa part ; 

+  exponent ; 

+  check correct conversion ;

+  result . 

+ 

+skip leading blanks :

+  INT VAR pos := 1 ;

+  skip blanks .

+ 

+skip blanks :

+  WHILE (text SUB pos) = " " REP

+    pos INCR 1

+  PER .

+ 

+sign : 

+  BOOL VAR negative ; 

+  IF (text SUB pos) = "-" 

+    THEN negative := TRUE ; 

+         pos INCR 1

+  ELIF (text SUB pos) = "+" 

+    THEN negative := FALSE ; 

+         pos INCR 1

+  ELSE   negative := FALSE

+  FI . 

+ 

+mantissa part: 

+  REAL VAR value := 0.0 ; 

+  INT VAR exponent pos := 0 ;

+  WHILE pos <= LENGTH text REP 

+    TEXT VAR digit := text SUB pos ; 

+    IF digit <= "9" AND digit >= "0" 

+      THEN value := value * 10.0 + real digit (code (digit) - 47) ;

+           pos INCR 1 

+    ELIF digit = "." 

+      THEN pos INCR 1 ;

+           exponent pos := pos

+    ELSE LEAVE mantissa part 

+    FI 

+  END REP . 

+ 

+exponent : 

+  INT VAR exp ;

+  IF exponent pos > 0

+    THEN exp := exponent pos - pos

+    ELSE exp := 0

+  FI ;

+  IF (text SUB pos) = "e" 

+    THEN exp INCR int (subtext(text,pos+1)) 

+  FI . 

+ 

+check correct conversion :

+  skip blanks ;

+  IF pos > LENGTH text

+    THEN set conversion (TRUE)

+    ELSE set conversion (FALSE)

+  FI .

+ 

+result : 

+  value := value * tenpower (exp) ; 

+  IF negative 

+    THEN - value 

+    ELSE value 

+  FI . 

+ 

+ENDPROC real ; 

+ 

+TEXT VAR word ;

+ 

+PROC get (REAL VAR value) : 

+ 

+  get (word) ; 

+  value := real (word) 

+ 

+ENDPROC get ; 

+ 

+REAL PROC abs (REAL CONST value) : 

+ 

+  IF value >= 0.0 

+    THEN  value 

+    ELSE -value 

+  FI 

+ 

+ENDPROC abs ; 

+ 

+REAL OP ABS (REAL CONST value) : 

+ 

+  abs (value) 

+ 

+ENDOP ABS ; 

+ 

+INT PROC sign (REAL CONST value) :

+ 

+  IF   value < 0.0 THEN -1

+  ELIF value = 0.0 THEN  0

+  ELSE                   1

+  FI

+ 

+ENDPROC sign ;

+ 

+INT OP SIGN (REAL CONST value) :

+ 

+  sign (value)

+ 

+ENDOP SIGN ;

+ 

+REAL OP MOD (REAL CONST left, right) :

+ 

+  REAL VAR result := left - floor (left/right) * right ;

+  IF left < 0.0

+    THEN result + abs (right)

+    ELSE result

+  FI

+ 

+ENDOP MOD ;

+ 

+REAL PROC frac (REAL CONST value) :

+ 

+  value - floor (value)

+ 

+ENDPROC frac ;

+ 

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

+ 

+  IF a > b THEN a ELSE b FI

+ 

+ENDPROC max ;

+ 

+REAL PROC min (REAL CONST a, b) :

+ 

+  IF a < b THEN a ELSE b FI

+ 

+ENDPROC min ;

+ 

+OP INCR (REAL VAR dest, REAL CONST increment) :

+ 

+  dest := dest + increment

+ 

+ENDOP INCR ;

+ 

+OP DECR (REAL VAR dest, REAL CONST decrement) : 

+ 

+  dest := dest - decrement

+ 

+ENDOP DECR ;

+ 

+INT PROC int (REAL CONST value) :

+ 

+  INT VAR result := 0, digit ,i ;

+  REAL VAR mantissa := value ;

+ 

+  FOR i FROM 0 UPTO decimal exponent (value) REP

+    sld (0, mantissa, digit) ;

+    result := result * 10 + digit 

+  PER ;

+ 

+  IF value < 0.0

+    THEN - result

+    ELSE   result

+  FI

+ 

+ENDPROC int ;

+ 

+REAL PROC real (INT CONST value) :

+ 

+  IF value < 0

+    THEN - real (-value)

+  ELIF value < 10

+    THEN real digit (value+1)

+    ELSE split value into head and last digit ;

+         real (head) * 10.0 + real digit (last digit+1)

+  FI .

+ 

+split value into head and last digit :

+  INT CONST

+  head := value DIV 10 ,

+  last digit := value - head * 10 .

+ 

+ENDPROC real ;

+ 

+ENDPACKET real ; 

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

+PACKET scanner DEFINES                (* Autor: J.Liedtke        *)

+                                      (* Stand: 30.12.81         *)

+       scan , 

+       continue scan ,

+       next symbol , 

+       fix scanner ,

+       reset scanner :

+ 

+ 

+LET tag     = 1 ,

+    bold    = 2 , 

+    integer = 3 ,

+    text    = 4 ,

+    operator= 5 ,

+    delimiter = 6 , 

+    end of file = 7 , 

+    within comment = 8 ,

+    within text    = 9 ;

+ 

+ 

+TEXT VAR line := "" , 

+         char := "" ; 

+ 

+INT VAR  position  := 0 ,

+         reset position ,

+         comment depth ;

+BOOL VAR continue text ;

+ 

+ 

+PROC scan (TEXT CONST scan text) : 

+ 

+  comment depth := 0 ;

+  continue text := FALSE ;

+  continue scan (scan text)

+ 

+ENDPROC scan ;

+ 

+PROC continue scan (TEXT CONST scan text) :

+ 

+  line := scan text ;

+  position  := 0 ;

+  next non blank char ;

+  reset position := position

+ 

+ENDPROC continue scan ;

+

+PROC fix scanner :

+

+  reset position := position

+

+ENDPROC fix scanner ;

+

+PROC reset scanner :

+

+  position := reset position ;

+  char := line SUB position

+

+ENDPROC reset scanner ;

+ 

+PROC next symbol (TEXT VAR symbol) : 

+ 

+  INT VAR type ;

+  next symbol (symbol, type) 

+ 

+ENDPROC next symbol ;

+ 

+PROC next symbol (TEXT VAR symbol, INT VAR type) : 

+ 

+  skip blanks ;

+  symbol := "" ;

+  IF   is niltext THEN eof

+  ELIF is comment THEN process comment

+  ELIF is text THEN process text 

+  ELIF is lower case letter THEN process tag 

+  ELIF is upper case letter THEN process bold 

+  ELIF is digit THEN process integer

+  ELIF is delimiter THEN process delimiter

+  ELSE  process operator 

+  FI . 

+ 

+skip blanks : 

+  IF char = " " 

+    THEN next non blank char 

+  FI . 

+ 

+ 

+process comment :

+  read comment ;

+  IF comment depth = 0

+    THEN next symbol (symbol, type)

+    ELSE type := within comment

+  FI .

+ 

+process tag : 

+  type := tag ;

+  REP 

+    symbol CAT char ;

+    next non blank char 

+  UNTIL NOT (is lower case letter OR is digit) ENDREP .

+ 

+process bold : 

+  type := bold ;

+  REP 

+    symbol CAT char ; 

+    next char 

+  UNTIL NOT is upper case letter ENDREP .

+ 

+process integer :

+  type := integer ;

+  REP 

+    symbol CAT char ; 

+    next non blank char 

+  UNTIL NOT (is digit OR char = ".") ENDREP . 

+ 

+process text : 

+  type := text ;

+  IF continue text

+    THEN continue text := FALSE

+    ELSE next char

+  FI ;

+  WHILE not end of text REP 

+    symbol CAT char ;

+    next char 

+  ENDREP . 

+ 

+not end of text : 

+  IF is niltext 

+    THEN continue text := TRUE ; type := within text ; FALSE

+  ELIF is quote 

+    THEN end of text or exception

+  ELSE TRUE 

+  FI . 

+ 

+end of text or exception :

+  next char ;

+  IF is quote

+    THEN TRUE

+  ELIF is digit

+    THEN get special char ; TRUE

+  ELSE FALSE

+  FI .

+ 

+get special char :

+  TEXT VAR special symbol ;

+  next symbol (special symbol) ;

+  char := code ( int (special symbol ) ) .

+ 

+process delimiter : 

+  type := delimiter ;

+  symbol := char ;

+  next non blank char . 

+ 

+process operator : 

+  type := operator ; 

+  symbol := char ;

+  nextchar ;

+  IF symbol = ":" 

+    THEN IF char = "=" OR char = ":" 

+           THEN symbol := ":=" ;

+                nextchar 

+           ELSE type := delimiter 

+         FI 

+  ELIF is relational double char 

+    THEN symbol CAT char ;

+         nextchar 

+  ELIF symbol = "*" AND char = "*" 

+    THEN symbol := "**" ; 

+         next char 

+  FI .

+ 

+eof : 

+  type := end of file ;

+  symbol := "" .

+ 

+is lower case letter :  char lies in (97, 122) . 

+ 

+is upper case letter :  char lies in (65, 90) . 

+ 

+is digit :  char lies in (48, 57) . 

+ 

+is delimiter : pos ( "()[].,;" , char ) > 0 AND char <> "" . 

+ 

+is relational double char : 

+  TEXT VAR double := symbol + char ; 

+  double = "<>" OR double = "<=" OR double = ">=" . 

+ 

+is text : is quote OR continue text .

+ 

+is quote : char = """" .

+ 

+is niltext : char = "" . 

+ 

+is comment :

+  IF comment depth = 0

+    THEN char = "{" OR char = "(" AND ahead char = "*"

+    ELSE comment depth DECR 1 ; TRUE

+  FI .

+ 

+ENDPROC next symbol ;

+ 

+PROC next char : 

+ 

+  position INCR 1 ;

+  char := line SUB position

+ 

+ENDPROC next char ;

+ 

+PROC next non blank char : 

+ 

+  REP 

+   position INCR 1 

+  UNTIL (line SUB position) <> " " ENDREP ;

+  char := line SUB position

+ 

+ENDPROC next non blank char ; 

+ 

+TEXT PROC ahead char : 

+ 

+  line SUB position+1 

+ 

+ENDPROC ahead char ; 

+ 

+BOOL PROC char lies in (INT CONST lower bound, upper bound) : 

+ 

+  lower bound <= code(char) AND code(char) <= upper bound 

+ 

+ENDPROC char lies in ;

+ 

+PROC read comment : 

+ 

+  TEXT VAR last char ; 

+  comment depth INCR 1 ;

+  REP 

+    last char := char ; 

+    nextchar ; 

+    IF is begin comment

+      THEN read comment

+    FI ;

+    IF char = ""

+      THEN LEAVE read comment

+    FI

+  UNTIL is end comment PER ; 

+  comment depth DECR 1 ;

+  next nonblank char . 

+ 

+is end comment :

+  char = "}" OR char = ")" AND last char = "*" .

+ 

+is begin comment :

+  char = "{" OR char = "(" AND ahead char = "*" .

+ 

+ENDPROC read comment ;

+ 

+ENDPACKET scanner ;

diff --git a/system/base/unknown/src/stdescapeset b/system/base/unknown/src/stdescapeset
new file mode 100644
index 0000000..0c69ea7
--- /dev/null
+++ b/system/base/unknown/src/stdescapeset
@@ -0,0 +1,31 @@
+PACKET  std escape set                              (* Autor: P.Heyderhoff *)

+        (************)                              (* Stand: 20.01.1981   *)

+                                                    (* Vers.: 1.5.5        *)

+DEFINES std escape set :

+ 

+PROC std escape set : 

+ 

+  define escape ("p", "IFmark>0THEN PUT"""";W""""12""""FI") ;

+  define escape ("g", "GET"""";M0") ;

+  define escape ("d", "IFmark>0THEN PUT"""";M0ELSE GET"""";M0FI");

+  define escape ("B", "W""""194""""") ;

+  define escape ("A", "W""""193""""") ;

+  define escape ("O", "W""""207""""") ;

+  define escape ("U", "W""""213""""") ;

+  define escape ("a", "W""""225""""") ;

+  define escape ("o", "W""""239""""") ;

+  define escape ("u", "W""""245""""") ;

+  define escape ("z", "C1;""""C(((limit-len)/2)*"" "")") ;

+  define escape ("l", "i:=col;C1;M1;Ci;W""""12""""") ;

+  define escape ("h", "S11") ;

+  define escape ("v", "S23") ;

+  define escape ("1", "1;C1"); 

+  define escape ("9", "9999;C(len+1)");

+  define escape (""2"", """ """);

+  define escape (""10"","+1;R Clen;"" ""Ucol>lenE");

+  define escape (""3"", "R-1;Hrow;Clen;"" ""Ucol>lenE"); 

+  define escape (""8"", "COL(col-10)");

+ 

+ENDPROC std escape set ;

+ 

+ENDPACKET std escape set ;