Add extracted sources from floppy disk images

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

5 files changed, 2918 insertions, 0 deletions

diff --git a/lisp/lisp.1 b/lisp/lisp.1
new file mode 100644
index 0000000..32a9c27
--- /dev/null
+++ b/lisp/lisp.1
@@ -0,0 +1,1306 @@
+PACKET lisp heap and oblist management              (* Autor: J.Durchholz *) 
+                                                    (* Datum: 09.05.1984  *) 
+    DEFINES                                         (* Version 1.7.2      *) 
+                                                    (* hey 25.2.83 *) 
+  initialize lisp system, 
+  dump lisp heap, 
+  lisp storage, 
+  collect lisp heap garbage, 
+  SYM, 
+  :=, 
+  nil, 
+  pname, 
+  head, 
+  set head, 
+  tail, 
+  set tail, 
+  cons, 
+  eq, 
+  equal, 
+  null, 
+  atom, 
+  is named atom, 
+  begin oblist dump, 
+  next atom, 
+  new atom, 
+  create atom, 
+  delete atom, 
+  begin property list dump, 
+  next property, 
+  add property, 
+  alter property, 
+  property, 
+  delete property, 
+  property exists, 
+  add flag, 
+  flag, 
+  delete flag, 
+  text, 
+  is text, 
+  character, 
+  is character, 
+  sym character, 
+  int 1, 
+  int 2, 
+  is int pair, 
+  sym: 
+ 
+ 
+(* NOTE: All internal routines are prefixed by x *) 
+ 
+ 
+(***************************** heap management ****************************) 
+ 
+LET 
+    max size = 32767, 
+    NODE = STRUCT (INT status, 
+                       head, tail); 
+LET HEAP = STRUCT (INT size, 
+                   ROW max size NODE node); 
+ 
+ 
+BOUND HEAP VAR heap; 
+ 
+ 
+PROC initialize lisp system (DATASPACE CONST ds): 
+  IF type (ds) < 0 THEN 
+    heap := ds; 
+    x initialize oblist and heap size; 
+    create atom ("NIL"); 
+    create atom ("PNAME"); 
+  ELSE 
+    heap := ds 
+  FI 
+END PROC initialize lisp system; 
+ 
+ 
+PROC dump lisp heap (FILE VAR f): 
+  put line (f, "Groesse :" + text (CONCR (heap).size)); 
+  line (f); 
+  put (CONCR (heap).size); 
+  BOOL VAR is char := FALSE; 
+  INT VAR i; 
+  FOR i FROM 1 UPTO CONCR (heap).size REP 
+    cout (i); 
+    dump ith node 
+  PER. 
+ 
+dump ith node: 
+  put (f, text (i, 6)); 
+  put (f, status); 
+  put (f, head); 
+  put (f, tail); 
+  line (f). 
+ 
+status: 
+  SELECT ith node.status OF 
+    CASE atomic             : "ATOMIC............" 
+    CASE non atomic         : "NON ATOMIC........" 
+    CASE oblist bone        : "OBLIST BONE......." 
+    CASE property indicator : "PROPERTY INDICATOR" 
+    CASE property root      : "PROPERTY ROOT....." 
+    CASE flag indicator     : "FLAG INDICATOR...." 
+    CASE text data          : "TEXT DATA........." 
+    CASE character data     : is char := TRUE; "CHARACTER DATA...." 
+    CASE int data           : "INT DATA.........." 
+    OTHERWISE                 "????." + text (ith node.status, 6) + ".????" 
+  END SELECT. 
+ 
+head: 
+  maybe a code + text (ith node.head, 6). 
+ 
+maybe a code: 
+  IF is char THEN 
+    is char := FALSE; 
+    IF ith node.head > 31 AND 128 > ith node.head THEN 
+      " " + code (ith node.head) + " " 
+    ELSE 
+      "   " 
+    FI 
+  ELSE 
+    "   " 
+  FI. 
+ 
+tail: 
+  text (ith node.tail, 6). 
+ 
+ith node: 
+  CONCR (heap).node (i). 
+ 
+END PROC dump lisp heap; 
+ 
+ 
+PROC lisp storage (INT VAR size, used): 
+  size := max size; 
+  used := CONCR (heap).size 
+END PROC lisp storage; 
+ 
+ 
+PROC collect lisp heap garbage: 
+  mark all used nodes; 
+  transfer all used high address nodes to unused low address nodes; 
+  adjust all pointers to cleared high address area and unmark all nodes; 
+  adjust size. 
+ 
+mark all used nodes: 
+  INT VAR i; 
+  FOR i FROM 2 UPTO 28 REP 
+    x mark (i) 
+  PER. 
+ 
+transfer all used high address nodes to unused low address nodes: 
+  INT VAR high address :: CONCR (heap).size + 1, 
+          low address :: 0; 
+  REP 
+    find next lower used high address node; 
+    IF no used high address node found THEN 
+      LEAVE transfer all used high address nodes to unused low address nodes 
+    FI; 
+    find next higher unused low address node; 
+    IF no unused low address node found THEN 
+      LEAVE transfer all used high address nodes to unused low address nodes 
+    FI; 
+    transfer high address node to low address node 
+  PER. 
+ 
+find next lower used high address node: 
+  REP 
+    high address DECR 1 
+  UNTIL high address node marked PER. 
+ 
+high address node marked: 
+  high address node.status < 0. 
+ 
+no used high address node found: 
+  low address = high address. 
+ 
+find next higher unused low address node: 
+  REP 
+    low address INCR 1 
+  UNTIL low address node not marked OR low address = high address PER. 
+ 
+low address node not marked: 
+  low address node.status > 0. 
+ 
+no unused low address node found : 
+  low address = high address. 
+ 
+transfer high address node to low address node: 
+  low address node.status := high address node.status; 
+  low address node.head := high address node.head; 
+  low address node.tail := high address node.tail; 
+  high address node.head := low address. 
+ 
+adjust all pointers to cleared high address area and unmark all nodes: 
+  (* 'high address' should now point to the last node of the used area   *) 
+  FOR low address FROM 1 UPTO high address REP 
+    unmark low address node; 
+    SELECT low address node.status OF 
+      CASE oblist bone: adjust head
+      CASE atomic, 
+           non atomic, 
+           property indicator, 
+           property root, 
+           flag indicator: adjust head; adjust tail 
+      CASE text data, character data: adjust tail 
+      CASE int data: 
+      OTHERWISE x lisp error ("Status " + text (low address node.status) + 
+                              " gefunden bei pointer Justage") 
+    END SELECT 
+  PER. 
+ 
+unmark low address node: 
+  low address node.status := - low address node.status. 
+ 
+adjust head: 
+  IF low address node.head > high address THEN 
+    low address node.head := node (low address node.head).head 
+  FI. 
+ 
+adjust tail: 
+  IF low address node.tail > high address THEN 
+    low address node.tail := node (low address node.tail).head 
+  FI. 
+ 
+adjust size: 
+  CONCR (heap).size := high address. 
+ 
+low address node: 
+  node (low address). 
+ 
+high address node: 
+  node (high address). 
+ 
+node: 
+  CONCR (heap).node. 
+ 
+END PROC collect lisp heap garbage; 
+ 
+ 
+PROC x mark (INT CONST ptr): 
+  IF node not yet marked THEN 
+    mark node; 
+    SELECT - ptr node.status OF 
+      CASE oblist bone: x mark (ptr node.head) 
+      CASE atomic, 
+           non atomic, 
+           property indicator, 
+           property root, 
+           flag indicator: x mark (ptr node.head); x mark (ptr node.tail) 
+      CASE text data, character data: x mark (ptr node.tail) 
+      CASE int data: 
+      OTHERWISE error stop ("Status " + text (- ptr node.status) + 
+                            " gefunden beim Markieren") 
+    END SELECT 
+  FI. 
+ 
+ 
+node not yet marked: 
+  ptr node.status > 0. 
+ 
+mark node: 
+  ptr node.status := - ptr node.status. 
+ 
+ptr node: 
+  CONCR (heap).node (ptr) 
+ 
+END PROC x mark; 
+ 
+ 
+TYPE SYM = INT; 
+ 
+ 
+OP := (SYM VAR left, SYM CONST right): 
+  CONCR (left) := CONCR (right) 
+END OP :=; 
+ 
+ 
+LET atomic = 1, 
+    non atomic = 2, 
+    oblist bone = 3, 
+    property indicator = 4, 
+    property root = 5, 
+    flag indicator = 6, 
+    text data = 7, 
+    character data = 8, 
+    int data = 9; 
+ 
+SYM CONST nil :: SYM :(35),   (* 'x initialize oblist and heap size' will *) 
+          pname :: SYM :(44); (* place the atom NIL at node 35 and PNAME  *) 
+                              (* at node 44                               *) 
+ 
+ 
+(***************************** basic functions ****************************) 
+ 
+ 
+SYM PROC head (SYM CONST sym): 
+  SELECT status of sym OF 
+    CASE atomic: error stop ("Atome haben keinen head"); nil 
+    CASE non atomic: SYM :(head of sym) 
+    CASE oblist bone, 
+         property indicator, 
+         property root, 
+         flag indicator    : x lisp error ("Versteckter Knoten, Type:" + 
+                                         text (status of sym)); 
+                             nil 
+    CASE text data, 
+         character data, 
+         int data       : error stop ("Daten haben keinen head"); nil 
+    OTHERWISE x lisp error ("Illegaler Status " + text (status of sym));
+              nil 
+  END SELECT. 
+ 
+status of sym: 
+  sym node.status. 
+ 
+head of sym: 
+  sym node.head. 
+ 
+sym node: 
+  CONCR (heap).node (CONCR (sym)) 
+ 
+END PROC head; 
+ 
+ 
+SYM PROC x head (SYM CONST sym): 
+  SYM :(CONCR (heap).node (CONCR (sym)).head) 
+END PROC x head; 
+ 
+ 
+PROC set head (SYM CONST sym, new head): 
+  SELECT status of sym OF 
+    CASE atomic: errorstop ("Atome haben keinen head") 
+    CASE non atomic: head of sym := CONCR (new head) 
+    CASE oblist bone, 
+         property indicator, 
+         property root, 
+         flag indicator    : x lisp error ("Versteckter Knoten, Type:" + 
+                                         text (status of sym)) 
+    CASE text data, 
+         character data, 
+         int data        : error stop ("Daten haben keinen head") 
+    OTHERWISE x lisp error ("Illegaler Status " + text (status of sym))
+  END SELECT. 
+ 
+status of sym: 
+  sym node.status. 
+ 
+head of sym: 
+  sym node.head. 
+ 
+sym node: 
+  CONCR (heap).node (CONCR (sym)). 
+ 
+END PROC set head; 
+ 
+ 
+PROC x set head (SYM CONST sym, new head): 
+  CONCR (heap).node (CONCR (sym)).head := CONCR (new head) 
+END PROC x set head; 
+ 
+ 
+SYM PROC tail (SYM CONST sym): 
+  SELECT status of sym OF 
+    CASE atomic: error stop ("Atome haben keinen tail"); nil 
+    CASE non atomic: SYM :(tail of sym) 
+    CASE oblist bone, 
+         property indicator, 
+         flag indicator    : x lisp error ("Versteckter Knoten:" + 
+                                         text (status of sym)); 
+                             nil 
+    CASE text data, 
+         character data, 
+         int data        : error stop ("Daten haben keinen tail"); nil 
+    OTHERWISE x lisp error ("Illegaler Status: "+ text (status of sym)); 
+              nil 
+  END SELECT. 
+ 
+status of sym: 
+  sym node.status. 
+ 
+tail of sym: 
+  sym node.tail. 
+ 
+sym node: 
+  CONCR (heap).node (CONCR (sym)). 
+ 
+END PROC tail; 
+ 
+ 
+SYM PROC x tail (SYM CONST sym): 
+  SYM :(CONCR (heap).node (CONCR (sym)).tail) 
+END PROC x tail; 
+ 
+ 
+PROC set tail (SYM CONST sym, new tail): 
+  SELECT status of sym OF 
+    CASE atomic: error stop ("Atome haben keinen tail") 
+    CASE non atomic: tail of sym := CONCR (new tail) 
+    CASE oblist bone, 
+         property indicator, 
+         property root, 
+         flag indicator    : x lisp error ("Versteckter Knoten, Type: " + 
+                                         text (status of sym)) 
+    CASE text data, 
+         character data, 
+         int data       : error stop ("Daten tails sind unveraenderbar")
+    OTHERWISE x lisp error ("Illegaler Status: " + text (status of sym)) 
+  END SELECT. 
+ 
+status of sym: 
+  sym node.status. 
+ 
+tail of sym: 
+  sym node.tail. 
+ 
+sym node: 
+  CONCR (heap).node (CONCR (sym)). 
+ 
+END PROC set tail; 
+ 
+ 
+PROC x set tail (SYM CONST sym, new tail): 
+  CONCR (heap).node (CONCR (sym)).tail := CONCR (new tail) 
+END PROC x set tail; 
+ 
+ 
+SYM PROC cons (SYM CONST head, tail): 
+  SYM VAR result; 
+  search free node; 
+  result node.status := non atomic; 
+  result node.head := CONCR (head); 
+  result node.tail := CONCR (tail); 
+  result. 
+ 
+search free node: 
+  IF CONCR (heap).size = max size THEN 
+    error stop ("LISP Heap Ueberlauf"); 
+    LEAVE cons WITH nil 
+  ELSE 
+    CONCR (heap).size INCR 1; 
+    CONCR (result) := CONCR (heap).size; cout(CONCR(result))
+  FI. 
+ 
+result node: 
+  CONCR (heap).node (CONCR (result)). 
+ 
+END PROC cons; 
+ 
+ 
+BOOL PROC eq (SYM CONST sym 1, sym 2): 
+  CONCR (sym 1) = CONCR (sym 2) 
+END PROC eq; 
+ 
+ 
+BOOL PROC equal (SYM CONST sym 1, sym 2): 
+  eq (sym 1, sym 2) COR have same value. 
+ 
+have same value: 
+  IF sym 1 node.status <> sym 2 node.status THEN 
+    FALSE 
+  ELSE 
+    SELECT sym 1 node.status OF 
+      CASE atomic: FALSE 
+      CASE non atomic: equal (head (sym 1), head (sym 2)) CAND 
+                       equal (tail (sym 1), tail (sym 2)) 
+      CASE oblist bone, 
+           property indicator, 
+           property root, 
+           flag indicator: x lisp error ("Versteckter Knoten, Type: " + 
+                                         text (x status (sym 1))); FALSE 
+      CASE text data: equal texts 
+      CASE character data: sym 1 node.head = sym 2 node.head 
+      CASE int data: sym 1 node.head = sym 2 node.head AND 
+                     sym 1 node.tail = sym 2 node.tail 
+      OTHERWISE x lisp error ("Ilegaler Status " + text (x status (sym 1)));
+                              FALSE 
+    END SELECT 
+  FI. 
+ 
+equal texts: 
+  equal length CAND equal character sequence. 
+ 
+equal length: 
+  eq (x head (sym 1), x head (sym 2)). 
+ 
+equal character sequence: 
+  SYM VAR actual sym 1 character :: sym 1, 
+          actual sym 2 character :: sym 2; 
+  INT VAR i; 
+  FOR i FROM 1 UPTO sym 1 node. head REP 
+    actual sym 1 character := x tail (actual sym 1 character); 
+    actual sym 2 character := x tail (actual sym 2 character); 
+    IF eq (actual sym 1 character, actual sym 2 character) THEN 
+      LEAVE equal character sequence WITH TRUE 
+    FI; 
+    IF x status (actual sym 1 character) <> character data OR 
+       x status (actual sym 2 character) <> character data    THEN 
+      x lisp error ("Ungueltiges Zeichen im text"); 
+      LEAVE equal character sequence WITH FALSE 
+    FI; 
+    IF CONCR (x head (actual sym 1 character)) <> 
+       CONCR (x head (actual sym 2 character))    THEN 
+      LEAVE equal character sequence WITH FALSE 
+    FI 
+  PER; 
+  TRUE. 
+ 
+sym 1 node: 
+  CONCR (heap).node (CONCR (sym 1)). 
+ 
+sym 2 node: 
+  CONCR (heap).node (CONCR (sym 2)). 
+ 
+END PROC equal; 
+ 
+ 
+BOOL PROC null (SYM CONST sym): 
+  CONCR (sym) = CONCR (nil) 
+END PROC null; 
+ 
+ 
+BOOL PROC atom (SYM CONST sym): 
+  SELECT x status (sym) OF 
+    CASE atomic, 
+         text data, 
+         character data, 
+         int data:       TRUE 
+    CASE non atomic: FALSE 
+    CASE oblist bone, 
+         property indicator, 
+         property root, 
+         flag indicator    : x lisp error ("Versteckter Knoten, Type:" + 
+                                         text (x status (sym))); TRUE 
+    OTHERWISE x lisp error ("Illegaler Status " + 
+                             text (x status (sym))); TRUE
+  END SELECT 
+END PROC atom; 
+ 
+ 
+BOOL PROC is named atom (SYM CONST sym): 
+  x status (sym) = atomic 
+END PROC is named atom; 
+ 
+ 
+(*------------------- internal heap management routines ------------------*) 
+ 
+ 
+SYM PROC x new node (INT CONST status, head, tail): 
+  IF CONCR (heap).size = max size THEN 
+    error stop ("LISP Heap Ueberlauf"); nil 
+  ELSE 
+    CONCR (heap).size INCR 1; 
+    new node.status := status; 
+    new node.head := head; 
+    new node.tail := tail; 
+    SYM :(CONCR (heap).size) 
+  FI. 
+ 
+new node: 
+  node (CONCR (heap).size). 
+ 
+node: 
+  CONCR (heap).node. 
+ 
+END PROC x new node; 
+ 
+ 
+INT PROC x status (SYM CONST sym): 
+  CONCR (heap).node (CONCR (sym)).status 
+END PROC x status; 
+ 
+ 
+(**************************** oblist management ***************************) 
+ 
+ 
+(* Oblist organization: 
+ 
+(NOTE: 
+ 
+                                 +-----------------+ 
+                                 l     <status>    l 
+ All nodes are represented as    +--------+--------+    in all comments 
+                                 l <head> l <tail> l    of this packet. 
+                                 +--------+--------+ 
+ 
+END OF NOTE) 
+ 
+ 
+The 'oblist' (object list) is organized as follows: 
+ 
+  +-------------+ 
+  l oblist bone l 
+  +------+------+  +--> list of all atoms whose print names begin with "§" 
+  l   o  l XXXX l  l 
+  +---+--+------+  l 
+      +------------+ 
+  +-------------+ 
+  l oblist bone l 
+  +------+------+  +--> list of all atoms whose print names begin with "A" 
+  l   o  l XXXX l  l 
+  +---+--+------+  l 
+      +------------+ 
+            . 
+            . 
+            . 
+ 
+  +-------------+ 
+  l oblist bone l 
+  +------+------+  +--> list of all atoms whose print names begin with "Z" 
+  l   o  l XXXX l  l 
+  +---+--+------+  l 
+      +------------+ 
+ 
+ 
+These nodes with status 'oblist bone' form the oblist skeleton. As long as
+the lisp heap exists, they are stored contiguously in nodes 2 - 28; they
+cannot be changed directly by the user. This way of storing the oblist
+skeleton allows a hashing scheme to be applied when searching for an atom
+with a given name. The hash width of 27 is the smallest one thas distributes
+all atoms according to their character; with a smaller hash size, two or
+more lists would be merged, with the effect that some of the atom lists
+would contain atoms beginning with different characters.
+ 
+ 
+The list of all atoms whose print names begin with a certain character
+is organized as follows: 
+ 
+  +-------------+ 
+  l    atomic   l 
+  +------+------+ 
+  l   o  l  o---+--> property list of first atom 
+  +---+--+------+ 
+      l 
+      V 
+  +-------------+ 
+  l    atomic   l 
+  +------+------+ 
+  l   o  l  o---+--> property list of 2nd atom 
+  +---+--+------+ 
+      l 
+      V 
+      . 
+      . 
+      . 
+ 
+      l 
+      V 
+  +-------------+ 
+  l    atomic   l 
+  +------+------+ 
+  l   o  l  o---+--> property list of last atom 
+  +---+--+------+ 
+      l 
+      V 
+    oblist bone where the atom list began 
+ 
+ 
+These lists cannot be acessed directly by the user, too. 
+*) 
+ 
+ 
+ 
+PROC x initialize oblist and heap size: 
+  node (1).status := text data; 
+  node (1).head := 32 (* blank *); 
+  node (1).tail := 1; 
+  INT VAR i; 
+  FOR i FROM 2 UPTO 28 REP 
+    node (i).status := oblist bone; 
+    node (i).head := i 
+  PER; 
+  CONCR (heap).size := 28. 
+ 
+node: 
+  CONCR (heap).node. 
+ 
+END PROC x initialize oblist and heap size; 
+ 
+ 
+(*++++++++++++++++++++++++++++++ oblist dump +++++++++++++++++++++++++++++*) 
+ 
+ 
+SYM VAR actual oblist bone :: SYM :(0), 
+        actual atom :: SYM :(0); 
+ 
+ 
+PROC begin oblist dump: 
+  actual oblist bone := SYM :(2); 
+  actual atom := SYM :(2) 
+END PROC begin oblist dump; 
+ 
+ 
+SYM PROC next atom: 
+  actual atom := x head (actual atom); 
+  WHILE no more atoms in this atom list REP 
+    try next oblist bone 
+  PER; 
+  actual atom. 
+ 
+no more atoms in this atom list: 
+  (* NIL is given as last atom when 'next atom' is called repeatedly, so *) 
+  (* it can serve as a terminator. So NIL "does not count" if it is      *) 
+  (* encountered during one of the calls.                                *) 
+  IF null (actual atom) THEN 
+    actual atom := x head (actual atom) 
+  FI; 
+  eq (actual atom, actual oblist bone). 
+ 
+try next oblist bone: 
+  IF actual oblist bone is last oblist bone THEN 
+    actual atom := SYM :(2); 
+    LEAVE next atom WITH nil 
+  FI; 
+  CONCR (actual oblist bone) INCR 1; 
+  actual atom := x head (actual oblist bone). 
+ 
+actual oblist bone is last oblist bone: 
+  CONCR (actual oblist bone) = 28. 
+ 
+END PROC next atom; 
+ 
+ 
+(*+++++++++++++++++++++++ atom search and creation +++++++++++++++++++++++*) 
+ 
+ 
+SYM VAR predecessor, result; 
+  (* Variables used for communication between the internal search        *) 
+  (* procedures and the procedures calling them.                         *) 
+ 
+ 
+SYM PROC atom (TEXT CONST name): 
+  x search atom (name); 
+  IF atom not already existing THEN 
+    nil 
+  ELSE 
+    result 
+  FI. 
+ 
+atom not already existing: 
+  x status (result) = oblist bone. 
+ 
+END PROC atom; 
+ 
+ 
+SYM PROC new atom (TEXT CONST name): 
+  x search atom (name); 
+  IF atom not already existing THEN 
+    x create new atom (name); 
+  FI; 
+  result. 
+ 
+atom not already existing: 
+  x status (result) = oblist bone. 
+ 
+END PROC new atom; 
+ 
+ 
+PROC create atom (TEXT CONST name): 
+  x search atom (name); 
+  IF atom already existing THEN 
+    error stop ("Atom " + name + " existiert bereits") 
+  ELSE 
+    x create new atom (name) 
+  FI. 
+ 
+atom already existing: 
+  x status (result) <> oblist bone. 
+ 
+END PROC create atom; 
+ 
+ 
+PROC delete atom (SYM CONST atom): 
+  IF is named atom (atom) THEN 
+    IF null (atom) OR eq (atom, pname) THEN 
+      error stop ("Dies Atom darf nicht geloescht werden") 
+    ELSE 
+      search predecessor; 
+      delete atom from atom list 
+    FI 
+  ELSE 
+    error stop ("Nur benannte Atome können geloescht werden") 
+  FI. 
+ 
+search predecessor: 
+  predecessor := x head (atom); 
+  WHILE NOT eq (x head (predecessor), atom) REP 
+    predecessor := x head (predecessor) 
+  PER. 
+ 
+delete atom from atom list: 
+  x set head (predecessor, x head (atom)). 
+ 
+END PROC delete atom; 
+ 
+ 
+PROC x search atom (TEXT CONST name): 
+  CONCR (result) := (code (name SUB 1) + 17) MOD 27 + 2; 
+  (* This formula places the list of atoms beginning with "§" at the     *) 
+  (* first oblist bone, the list of atoms beginning with "A" at the      *) 
+  (* at the second one, and so on. (See also the big comment in lines    *) 
+  (* 600 - 700)                                                          *) 
+  REP 
+    predecessor := result; 
+    result := x head (predecessor); 
+  UNTIL end of atom list reached COR right atom found PER. 
+ 
+end of atom list reached: 
+  x status (result) = oblist bone. 
+ 
+right atom found: 
+  SYM VAR actual character node := property (result, pname); 
+  IF NOT is text (actual character node) THEN 
+    x lisp error ("Namen erwartet"); 
+    LEAVE right atom found WITH FALSE 
+  FI; 
+  IF CONCR (x head (actual character node)) <> length (name) THEN 
+    FALSE 
+  ELSE 
+    INT VAR i; 
+    FOR i FROM 1 UPTO length (name) REP 
+      to next character node; 
+      check wether is character data node; 
+      check wether character matches; 
+    PER; 
+    TRUE 
+  FI. 
+ 
+to next character node: 
+  actual character node := x tail (actual character node). 
+ 
+check wether is character data node: 
+  IF x status (actual character node) <> character data THEN 
+    x lisp error ("Zeichenkette erwartet"); 
+    LEAVE right atom found WITH FALSE 
+  FI. 
+ 
+check wether character matches: 
+  IF code (name SUB i) <> CONCR (x head (actual character node)) THEN 
+    LEAVE right atom found WITH FALSE 
+  FI. 
+ 
+END PROC x search atom; 
+ 
+ 
+PROC x create new atom (TEXT CONST name): 
+  (* It is necessary that 'x search atom' has been executed before        *) 
+  (* calling 'x create new atom' because this procedure relies on the     *) 
+  (* value of 'predecessor'.                                              *) 
+  enable stop; 
+  SYM CONST sym name :: sym (name); 
+  IF CONCR (heap).size + 3 > max size THEN 
+    error stop ("LISP Heap Ueberlauf") 
+  FI; 
+  result := newly created atom; 
+  x set head (predecessor, result). 
+ 
+newly created atom: 
+  x new node (atomic, CONCR (oblist bone node), CONCR (property list)). 
+ 
+oblist bone node: 
+  x head (predecessor). 
+ 
+property list: 
+  x new node (property indicator, CONCR (pname), property root node). 
+ 
+property root node: 
+  CONCR (x new node (property root, CONCR (sym name), CONCR (nil))). 
+ 
+END PROC x create new atom; 
+ 
+ 
+(************************* property list handling *************************) 
+ 
+(* 
+The property lists consist of chained units of the structure 
+ 
+  +--------------------+   +---------------+ 
+  l property indicator l   l property root l 
+  +----------+---------+   +-------+-------+ 
+  l    o     l    o----+-->l   o   l   o---+--> . . . 
+  +----+-----+---------+   +---+---+-------+ 
+       l                       l 
+       V                       V 
+  property id              property 
+ 
+ 
+or 
+ 
+  +----------------+ 
+  l flag indicator l 
+  +--------+-------+ 
+  l   o    l   o---+--> . . . 
+  +---+----+-------+ 
+      l 
+      V 
+   flag id 
+ 
+ 
+ 
+The property lists cannot be altered or read directly, too. 
+ 
+For property list handling there exist procedures that insert, change, read
+and delete properties resp. flags. Thus, the only thing that can be done
+with any property of an atom without using these special procedures, is
+comparing to or 'cons'ing with some other S-expression. 
+At any given time the property list of any atom (including 'NIL') contains
+the property 'PNAME' giving the print name of the atom, stored as a list of
+characters. This special property cannot be altered, overwritten by 'add
+property' or deleted.
+*) 
+ 
+ 
+(*++++++++++++++++++++++++++ property list dump ++++++++++++++++++++++++++*) 
+ 
+ 
+SYM VAR actual property list node :: nil; 
+ 
+ 
+PROC begin property list dump (SYM CONST atom): 
+  actual property list node := x tail (atom) 
+END PROC begin property list dump; 
+ 
+ 
+PROC next property (SYM VAR property id, property): 
+  IF null (actual property list node) THEN 
+    property id := nil; 
+    property := nil 
+  ELSE 
+    SELECT x status (actual property list node) OF 
+      CASE flag indicator: get flag id 
+      CASE property indicator: get property id and property 
+      OTHERWISE x lisp error ("Flagge oder Eigenschaft erwartet und nicht: " 
+                              + text (x status (actual property list node))) 
+    END SELECT 
+  FI. 
+ 
+get flag id: 
+  property id := x head (actual property list node); 
+  actual property list node := x tail (actual property list node); 
+  property := nil. 
+ 
+get property id and property: 
+  property id := x head (actual property list node); 
+  actual property list node := x tail (actual property list node); 
+  IF x status (actual property list node) = property root THEN 
+    property := x head (actual property list node); 
+    actual property list node := x tail (actual property list node) 
+  ELSE 
+    x lisp error ("Eigenschaftswurzel erwartet, nicht:" + 
+                text (x status (actual property list node))); 
+    property := nil 
+  FI. 
+ 
+END PROC next property; 
+ 
+ 
+(*+++++++++++++++++++++++++++++ properties +++++++++++++++++++++++++++++++*) 
+ 
+ 
+SYM VAR last atom :: SYM :(0), 
+        p list predecessor, 
+        p list result; 
+ 
+ 
+PROC add property (SYM CONST atom, property id, property): 
+  IF eq (property id, pname) THEN 
+    errorstop ("Der PNAME eines Atoms darf nicht versteckt sein") 
+  ELSE 
+    IF CONCR (heap).size + 2 > max size THEN 
+      error stop ("LISP Heap Ueberlauf"); 
+      LEAVE add property 
+    FI; 
+    x set tail (atom, new property plus old property list); 
+    IF eq (atom, last atom) AND 
+       eq (property id, x head (p list result)) THEN 
+      p list predecessor := atom; 
+      p list result := x tail (atom) 
+    FI 
+  FI. 
+ 
+new property plus old property list: 
+  x new node (property indicator, 
+        CONCR (property id), CONCR (property root plus old property list)). 
+ 
+property root plus old property list: 
+  x new node (property root, CONCR (property), CONCR (old property list)). 
+ 
+old property list: 
+  x tail (atom) 
+ 
+END PROC add property; 
+ 
+ 
+PROC alter property (SYM CONST atom, property id, new property): 
+  IF eq (property id, pname) THEN 
+    error stop ("Namen kann man nicht aendern") 
+  ELSE 
+    x search property id (atom, property id); 
+    IF null (p list result) THEN 
+      error stop ("Eigenschaft existiert nicht") 
+    ELSE 
+      x set head (x tail (p list result), new property) 
+    FI 
+  FI 
+END PROC alter property; 
+ 
+ 
+SYM PROC property (SYM CONST atom, property id): 
+  x search property id (atom, property id); 
+  IF null (p list result) THEN 
+    nil 
+  ELSE 
+    x head (x tail (p list result)) 
+  FI 
+END PROC property; 
+ 
+ 
+PROC delete property (SYM CONST atom, property id): 
+  IF eq (property id, pname) THEN 
+    errorstop ("Der Name eines Atoms darf nicht geloescht werden") 
+  ELSE 
+    x search property id (atom, property id); 
+    IF NOT null (p list result) THEN 
+      x set tail (p list predecessor, x tail (x tail (p list result))); 
+      last atom := SYM :(0) 
+    FI 
+  FI 
+END PROC delete property; 
+ 
+ 
+BOOL PROC property exists (SYM CONST atom, property id): 
+  x search property id (atom, property id); 
+  NOT null (p list result) 
+END PROC property exists; 
+ 
+ 
+PROC x search property id (SYM CONST atom, property id): 
+  IF eq (last atom, atom) AND eq (x head (p list result), property id) THEN 
+    LEAVE x search property id 
+  FI; 
+  last atom := atom; 
+  p list predecessor := atom; 
+  REP 
+    p list result := x tail (p list predecessor); 
+    IF end of property list THEN 
+      last atom := SYM :(0); 
+      LEAVE x search property id 
+    FI; 
+    SELECT x status (p list result) OF 
+      CASE flag indicator: p list predecessor := p list result 
+      CASE property indicator: check wether property root node follows; 
+                               IF correct property id found THEN 
+                                 LEAVE x search property id 
+                               ELSE 
+                                 p list predecessor := xtail (p list result) 
+                               FI 
+      CASE property root: xlisperror("Unordentliche Eigenschaftwurzel"); 
+                          p list result := nil; 
+                          last atom := SYM :(0); 
+                          LEAVE x search property id 
+      OTHERWISE x lisp error ("Eigenschaften erwartet und nicht: " + 
+                              text (x status (p list result))); 
+                p list result := nil; 
+                last atom := SYM :(0); 
+                LEAVE x search property id 
+    END SELECT 
+  PER. 
+ 
+end of property list: 
+  null (p list result). 
+ 
+check wether property root node follows: 
+  IF x status (x tail (p list result)) <> property root THEN 
+    x lisp error ("Eigenschaftswurzel erwartet"); 
+    p list result := nil; 
+    last atom := SYM :(0); 
+    LEAVE x search property id 
+  FI. 
+ 
+correct property id found: 
+  eq (x head (p list result), property id). 
+ 
+END PROC x search property id; 
+ 
+ 
+(*++++++++++++++++++++++++++++++++ flags +++++++++++++++++++++++++++++++++*) 
+ 
+ 
+PROC add flag (SYM CONST atom, flag id): 
+  enable stop; 
+  x set tail (atom, new flag plus old property list). 
+ 
+new flag plus old property list: 
+  x new node (flag indicator, CONCR (flag id), old property list). 
+ 
+old property list: 
+  CONCR (x tail (atom)) 
+ 
+END PROC add flag; 
+ 
+ 
+BOOL PROC flag (SYM CONST atom, flag id): 
+  x search flag id (atom, flag id); 
+  NOT null (result) 
+END PROC flag; 
+ 
+ 
+PROC delete flag (SYM CONST atom, flag id): 
+  x search flag id (atom, flag id); 
+  IF NOT (is error COR null (result)) THEN 
+    x set tail (predecessor, x tail (result)) 
+  FI 
+END PROC delete flag; 
+ 
+ 
+PROC x search flag id (SYM CONST atom, flag id): 
+  predecessor := atom; 
+  REP 
+    result := x tail (predecessor); 
+    IF end of property list THEN 
+      LEAVE x search flag id 
+    FI; 
+    SELECT x status (result) OF 
+      CASE property root, property indicator: predecessor := result 
+      CASE flag indicator: IF correct flag id found THEN 
+                             LEAVE x search flag id 
+                           ELSE 
+                             predecessor := result 
+                           FI 
+      OTHERWISE x lisp error ("Eigenschaften erwartet und nicht:" + 
+                              text (x status (result))); 
+                result := nil; 
+                LEAVE x search flag id 
+    END SELECT 
+  PER. 
+ 
+end of property list: 
+  null (result). 
+ 
+correct flag id found: 
+  eq (x head (result), flag id). 
+ 
+END PROC x search flag id; 
+ 
+ 
+(****** Conversion of non-LISP data to LISP structures and vice versa *****) 
+ 
+ 
+TEXT PROC text (SYM CONST sym): 
+  IF is text (sym) THEN 
+    TEXT VAR result := ""; 
+    SYM VAR actual node :: sym; 
+    INT VAR i; 
+    FOR i FROM 1 UPTO CONCR (x head (sym)) REP 
+      actual node := x tail (actual node); 
+      result CAT actual character 
+    PER; 
+    result 
+  ELSE 
+    error stop ("ist kein text"); 
+    "" 
+  FI. 
+ 
+actual character: 
+  IF x status (actual node) <> character data THEN 
+    x lisp error ("Zeichenfolge erwartet"); 
+    LEAVE text WITH result 
+  FI; 
+  code (CONCR (x head (actual node))). 
+ 
+END PROC text; 
+ 
+ 
+BOOL PROC is text (SYM CONST sym): 
+  x status (sym) = text data 
+END PROC is text; 
+ 
+ 
+SYM PROC sym (TEXT CONST text): 
+  SYM VAR result :: x new node (text data, 
+                                length (text), CONCR (nil)), 
+          actual character node :: result; 
+  INT VAR length of text; 
+  ignore blanks at end of text;
+  INT VAR i; 
+  FOR i FROM 1 UPTO length of text REP 
+    x set tail (actual character node, new next character node); 
+    actual character node := x tail (actual character node) 
+  PER; 
+  result. 
+ 
+ignore blanks at end of text: 
+  FOR length of text FROM length (text) DOWNTO 0 REP 
+    IF (text SUB length of text) <> " " THEN 
+      LEAVE ignore blanks at end of text 
+    FI 
+  PER; 
+  length of text := 0. 
+ 
+new next character node: 
+  x new node (character data, code (text SUB i), 1). 
+ 
+END PROC sym; 
+ 
+ 
+INT PROC character (SYM CONST sym): 
+  IF x status (sym) = character data THEN 
+    CONCR (x head (sym)) 
+  ELSE 
+    error stop ("ist kein Charakter"); 
+    -1 
+  FI 
+END PROC character; 
+ 
+ 
+BOOL PROC is character (SYM CONST sym): 
+  x status (sym) = character data 
+END PROC is character; 
+ 
+ 
+SYM PROC sym character (INT CONST char): 
+  x new node (character data, char MOD 256, 1) 
+END PROC sym character; 
+ 
+ 
+INT PROC int 1 (SYM CONST sym): 
+  IF x status (sym) = int data THEN 
+    CONCR (x head (sym)) 
+  ELSE 
+    error stop ("ist keine Zahl"); 
+    -1 
+  FI 
+END PROC int 1; 
+ 
+ 
+INT PROC int 2 (SYM CONST sym): 
+  IF x status (sym) = int data THEN 
+    CONCR (x tail (sym)) 
+  ELSE 
+    error stop ("ist keine Zahl"); 
+    -1 
+  FI 
+END PROC int 2; 
+ 
+ 
+BOOL PROC is int pair (SYM CONST sym): 
+  x status (sym) = int data 
+END PROC is int pair; 
+ 
+ 
+SYM PROC sym (INT CONST int 1, int 2): 
+  x new node (int data, int 1, int 2) 
+END PROC sym; 
+ 
+ 
+(********************* internal error routine *****************************) 
+ 
+ 
+PROC x lisp error (TEXT CONST error message): 
+  error stop (""13"LISP SYSTEM FEHLER: " + error message ) 
+END PROC x lisp error; 
+ 
+ 
+END PACKET lisp heap and oblist management; 
+ 
+ 
+ 
+PACKET name                                         (* Autor: J.Durchholz *) 
+                                                    (* Datum: 15.06.1982  *) 
+    DEFINES                                         (* Version 1.1.1      *) 
+ 
+  name: 
+ 
+TEXT PROC name (SYM CONST sym): 
+  IF is named atom (sym) THEN 
+    text (property (sym, pname)) 
+  ELSE 
+    ""15"IST_KEIN_ATOM"14"" 
+  FI 
+END PROC name; 
+ 
+ 
+END PACKET name; 
+ 
+ 
+ 
+PACKET lisp storage info                            (* Autor: J.Durchholz *) 
+                                                    (* Datum: 23.08.1982  *) 
+    DEFINES                                         (* Version 1.1.1      *) 
+ 
+  lisp storage info: 
+ 
+ 
+PROC lisp storage info: 
+  INT VAR size, used; 
+  lisp storage (size, used); 
+  out (""13""10"      "); 
+  put (used); 
+  put ("Knoten von"); 
+  put (size); 
+  put line ("Knoten des LISP-Heaps sind belegt!") 
+END PROC lisp storage info; 
+ 
+ 
+END PACKET lisp storage info; 
+
diff --git a/lisp/lisp.2 b/lisp/lisp.2
new file mode 100644
index 0000000..28e6924
--- /dev/null
+++ b/lisp/lisp.2
@@ -0,0 +1,584 @@
+PACKET character buffer                            (* Autor : J.Durchholz *) 
+                                                   (* Datum : 09.05.1984  *) 
+    DEFINES                                        (* Version 1.7.2       *) 
+                                      (* 21.2.83. hey 293, 450,97,361 *)
+  get char, 
+  line nr, 
+  init char buffer: 
+ 
+ 
+TEXT VAR buffer; 
+INT VAR pointer, 
+        line; 
+ 
+ 
+INT PROC line nr: 
+  line 
+END PROC line nr; 
+ 
+ 
+PROC init char buffer: 
+  buffer := ""; 
+  pointer := 1; 
+  line := 0; 
+END PROC init char buffer; 
+ 
+ 
+PROC get char (FILE VAR f, TEXT VAR char): 
+  IF buffer empty THEN 
+    try to find nonempty line and put it into buffer; 
+    char := " "; 
+    pointer := 1 
+  ELSE 
+    char := buffer SUB pointer; 
+    pointer INCR 1 
+  FI. 
+ 
+buffer empty: 
+  pointer > length (buffer). 
+ 
+try to find nonempty line and put it into buffer: 
+  REP 
+    IF eof (f) THEN 
+      char := ""; 
+      LEAVE get char 
+    FI; 
+    get line (f, buffer); 
+    line INCR 1 
+  UNTIL buffer <> "" PER. 
+ 
+END PROC get char; 
+ 
+ 
+END PACKET character buffer; 
+ 
+ 
+ 
+ 
+PACKET lisp io                                      (* Autor: J.Durchholz *) 
+                                                    (* Datum: 10.09.1982  *) 
+    DEFINES                                         (* Version 4.1.3      *) 
+                                                    (* Änderung: notebook *)
+  put,  note,                                       (*    13.3.86  I. Ley *)
+  verbose lisp output, 
+  get, 
+  get all: 
+ 
+ 
+BOOL VAR verbose :: FALSE; 
+ 
+ 
+PROC verbose lisp output (BOOL CONST b): 
+  verbose := b 
+END PROC verbose lisp output; 
+ 
+BOOL PROC verbose lisp output: 
+  verbose 
+END PROC verbose lisp output; 
+ 
+ 
+PROC put (SYM CONST sym): 
+  IF atom (sym) THEN 
+    put atom 
+  ELSE 
+    put structure 
+  FI. 
+ 
+put atom: 
+  IF is named atom (sym) THEN 
+    put (name (sym)) 
+  ELIF is int pair (sym) THEN 
+    put (int 1 (sym)) 
+  ELIF is text (sym) THEN 
+    IF verbose THEN 
+      TEXT VAR buffer :: text (sym); 
+      change all (buffer, """", """"""); 
+      buffer CAT """"; 
+      put ("""" + buffer) 
+    ELSE 
+      write (text (sym)) 
+    FI 
+  ELIF is character (sym) THEN 
+    IF verbose THEN 
+      buffer := "'"; 
+      buffer CAT code (character (sym)); 
+      buffer CAT "'"; 
+      put (buffer) 
+    ELSE 
+      out (code (character (sym))) 
+    FI 
+  ELSE 
+    put (""15"UNBEKANNTER_ATOM_TYP"14"") 
+  FI. 
+ 
+put structure: 
+  put ("("); 
+  SYM VAR actual node := sym; 
+  REP 
+    put (head (actual node)); 
+    actual node := tail (actual node) 
+  UNTIL atom (actual node) PER; 
+  IF NOT null (actual node) THEN 
+    put ("."); 
+    put (actual node) 
+  FI; 
+  put (")"). 
+ 
+END PROC put; 
+ 
+PROC put (FILE VAR f, SYM CONST sym): 
+  IF atom (sym) THEN 
+    put atom 
+  ELSE 
+    put structure 
+  FI. 
+ 
+put atom: 
+  IF is named atom (sym) THEN 
+    put (f, name (sym)) 
+  ELIF is int pair (sym) THEN 
+    put (f, int 1 (sym)) 
+  ELIF is text (sym) THEN 
+    IF verbose THEN 
+      TEXT VAR buffer :: text (sym); 
+      change all (buffer, """", """"""); 
+      buffer CAT """"; 
+      put (f, """" + buffer) 
+    ELSE 
+      put (f, text (sym)) 
+    FI 
+  ELIF is character (sym) THEN 
+    IF verbose THEN 
+      buffer := "'"; 
+      buffer CAT code (character (sym)); 
+      buffer CAT "'"; 
+      put (f,  buffer) 
+    ELSE 
+      put (f,  code (character (sym))) 
+    FI 
+  ELSE 
+    put ( f, ""15"UNBEKANNTER_ATOM_TYP"14"") 
+  FI. 
+ 
+put structure: 
+  put (f, "("); 
+  SYM VAR actual node := sym; 
+  REP 
+    put (f, head (actual node)); 
+    actual node := tail (actual node) 
+  UNTIL atom (actual node) PER; 
+  IF NOT null (actual node) THEN 
+    put (f, "."); 
+    put (f, actual node) 
+  FI; 
+  put (f, ")"). 
+ 
+END PROC put; 
+ 
+ PROC note (SYM CONST sym): 
+  IF atom (sym) THEN 
+    note atom 
+  ELSE 
+    note structure 
+  FI. 
+ 
+note atom: 
+  IF is named atom (sym) THEN 
+    note ( name (sym)) 
+  ELIF is int pair (sym) THEN 
+    note (int 1 (sym)) 
+  ELIF is text (sym) THEN 
+    IF verbose THEN 
+      TEXT VAR buffer :: text (sym); 
+      change all (buffer, """", """"""); 
+      buffer CAT """"; 
+      note ( """" + buffer) 
+    ELSE 
+      note ( text (sym)) 
+    FI 
+  ELIF is character (sym) THEN 
+    IF verbose THEN 
+      buffer := "'"; 
+      buffer CAT code (character (sym)); 
+      buffer CAT "'"; 
+      note ( buffer) 
+    ELSE 
+      note ( code (character (sym))) 
+    FI 
+  ELSE 
+    note ( ""15"UNBEKANNTER_ATOM_TYP"14"") 
+  FI. 
+ 
+note structure: 
+  note ( "("); 
+  SYM VAR actual node := sym; 
+  REP 
+    note ( head (actual node)); 
+    actual node := tail (actual node) 
+  UNTIL atom (actual node) PER; 
+  IF NOT null (actual node) THEN 
+    note ( "."); 
+    note ( actual node) 
+  FI; 
+  note ( ")"). 
+ 
+END PROC note; 
+ 
+PROC get (FILE VAR f, SYM VAR s): 
+  initialize scanner (f); 
+  IF NOT get s expression (s) THEN 
+    error ("LISP-Ausdruck erwartet") 
+  FI; 
+  scanner postprocessing (f) 
+END PROC get; 
+ 
+ 
+(**************************** parser for 'get' ****************************) 
+ 
+ 
+LET end of file type = 0, 
+    name type = 1, 
+    text type = 2, 
+    character type = 3, 
+    int type = 4, 
+    other char type = 5; 
+ 
+ 
+BOOL PROC get s expression (SYM VAR s): 
+  (* The boolean result indicates wether the error has not occurred that  *) 
+  (* 'get next symbol' was called, but then the symbol was not expected   *) 
+  (* and thus could not be processed.                                     *) 
+  get next symbol; 
+  SELECT symbol type OF 
+    CASE end of file type: FALSE 
+    CASE name type: s := new atom (symbol); TRUE 
+    CASE text type: s := sym (symbol); TRUE 
+    CASE character type: s := sym character (code (symbol)); TRUE 
+    CASE int type: s := sym (int (symbol), -1); TRUE 
+    CASE other char type: get structure 
+    OTHERWISE error ("EINLESEFEHLER: unbekannter Symboltyp: " + 
+                     text (symbol type)); TRUE 
+  END SELECT. 
+ 
+get structure: 
+  IF symbol <> "(" THEN 
+    FALSE 
+  ELSE 
+    get list; 
+    IF symbol type <> other char type OR symbol <> ")" THEN 
+      error (">> ) << erwartet"); 
+      FALSE 
+    ELSE 
+      TRUE 
+    FI 
+  FI. 
+ 
+get list: 
+  SYM VAR father, son; 
+  IF get s expression (son) THEN 
+    get list elements; 
+  ELSE 
+    s := nil 
+  FI. 
+ 
+get list elements: 
+  father := cons (son, nil); 
+  s := father; 
+  WHILE get s expression (son) REP 
+    set tail (father, cons (son, nil)); 
+    father := tail (father) 
+  PER; 
+  IF symbol type = other char type AND symbol = "." THEN 
+    IF get s expression (son) THEN 
+      set tail (father, son); 
+      get next symbol 
+    ELSE 
+      error ("LISP-Ausdruck nach dem Punkt erwartet") 
+    FI 
+  FI. 
+ 
+END PROC get s expression; 
+ 
+ 
+(********************* scanner for 'get x espression' *********************) 
+ 
+ 
+FILE VAR infile; 
+ 
+ 
+PROC initialize scanner (FILE CONST f): 
+  infile := f; 
+  no input errors := TRUE; 
+  init char buffer; 
+  get char (infile, actual char) 
+END PROC initialize scanner; 
+ 
+ 
+PROC scanner postprocessing (FILE VAR f): 
+  f := infile 
+END PROC scanner postprocessing; 
+ 
+ 
+TEXT VAR symbol; INT VAR symbol type; 
+ 
+ 
+PROC get next symbol: 
+  skip blanks; 
+  IF actual char = "" THEN 
+    symbol := "DATEIENDE"; 
+    symbol type := end of file type 
+  ELIF is letter THEN 
+    get name 
+  ELIF is digit or sign THEN 
+    get integer 
+  ELIF is double quote THEN 
+    get text 
+  ELIF is single quote THEN 
+    get character 
+  ELSE 
+    get other char 
+  FI .
+ 
+is letter: 
+  IF "a" <= actual char AND actual char <= "z" THEN 
+    actual char := code (code (actual char) - code ("a") + code ("A")); 
+    TRUE 
+  ELSE 
+    "§" <= actual char AND actual char <= "Z" 
+  FI. 
+ 
+get name: 
+  symbol type := name type; 
+  symbol := actual char; 
+  REP 
+    get char (infile, actual char); 
+    IF is neither letter nor digit THEN 
+      LEAVE get name 
+    FI; 
+    symbol CAT actual char 
+  PER. 
+ 
+is neither letter nor digit: 
+  NOT (is letter OR is digit OR is underscore). 
+ 
+is digit: 
+  "0" <= actual char AND actual char <= "9". 
+ 
+is underscore: 
+  actual char = "_". 
+ 
+is digit or sign: 
+  is digit OR actual char = "+" OR actual char = "-". 
+ 
+get integer: 
+  symbol type := int type; 
+  IF actual char = "+" THEN 
+    get char (infile, actual char); 
+    skip blanks; 
+    symbol := actual char 
+  ELIF actual char = "-" THEN 
+    symbol := "-"; 
+    get char (infile, actual char); 
+    skip blanks; 
+    symbol CAT actual char 
+  ELSE 
+    symbol := actual char 
+  FI; 
+  REP 
+    get char (infile, actual char); 
+    IF NOT is digit THEN 
+      LEAVE get integer 
+    FI; 
+    symbol CAT actual char 
+  PER. 
+ 
+is double quote: 
+  actual char = """". 
+ 
+get text: 
+  symbol := ""; 
+  symbol type := text type; 
+  REP 
+    get char (infile, actual char); 
+    IF is double quote THEN 
+      get char (infile, actual char); 
+      IF NOT is double quote THEN LEAVE get text 
+      FI 
+    ELIF actual char = ""    THEN LEAVE get text  (*hey*)
+    FI; 
+    symbol CAT actual char 
+  PER. 
+ 
+is single quote: 
+  actual char = "'". 
+ 
+get character: 
+  symbol type := character type; 
+  get char (infile, symbol); 
+  get char (infile, actual char); 
+  IF actual char <> "'" THEN 
+    error (">> ' << erwartet") 
+  ELSE 
+    get char (infile, actual char) 
+  FI. 
+ 
+get other char: 
+  symbol type := other char type; 
+  symbol := actual char; 
+  get char (infile, actual char). 
+ 
+END PROC get next symbol; 
+ 
+ 
+TEXT VAR actual char; 
+ 
+ 
+PROC skip blanks: 
+  INT VAR comment depth :: 0; 
+  WHILE is comment OR actual char = " " REP 
+    get char (infile, actual char) 
+  PER. 
+ 
+is comment: 
+  IF actual char = "{" THEN 
+    comment depth INCR 1; 
+    TRUE 
+  ELIF actual char = "}" THEN 
+    IF comment depth = 0 THEN 
+      error (">> { << fehlt") 
+    ELSE 
+      comment depth DECR 1 
+    FI; 
+    TRUE 
+  ELSE 
+    IF comment depth > 0 THEN 
+      IF actual char = "" THEN 
+        error ("DATEIENDE im Kommentar"); 
+        FALSE 
+      ELSE 
+        TRUE 
+      FI 
+    ELSE 
+      FALSE 
+    FI 
+  FI. 
+ 
+END PROC skip blanks; 
+ 
+ 
+BOOL VAR no input errors; 
+FILE VAR errors; 
+ 
+ 
+PROC error (TEXT CONST error message): 
+  out ("FEHLER in Zeile "); 
+  out (text (line nr)); 
+  out (" bei >> "); 
+  out (symbol); 
+  out (" << : "); 
+  out (error message); 
+  line; 
+  IF no input errors THEN 
+    no input errors := FALSE; 
+    errors := notefile; modify(errors);
+    headline (errors, "Einlesefehler"); output(errors)
+  FI; 
+  write (errors, "FEHLER in Zeile "); 
+  write (errors, text (line nr)); 
+  write (errors, " bei >> "); 
+  write (errors, symbol); 
+  write (errors, " << : "); 
+  write (errors, error message); 
+  line (errors) 
+END PROC error; 
+ 
+ 
+PROC get (SYM VAR sym):     (*hey*)
+  disable stop; 
+  FILE VAR in  :: sequential file (modify, "LISP INPUT"), 
+           out :: notefile; modify (out);
+  headline (out,"LISP OUTPUT");
+  headline (in, "LISP INPUT");
+  noteedit (in);
+  input (in); 
+  get (in, sym); 
+  WHILE NOT no input errors AND NOT is error REP 
+    modify (errors);
+    headline (errors, " LISP-Fehlermeldungen"); 
+    headline (in, " Bitte KORREKTEN LISP-Ausdruck"); 
+    noteedit (in); 
+    headline (errors, "notebook"); 
+    input (in); 
+    get (in, sym) 
+  PER; 
+END PROC get; 
+ 
+ 
+PROC get all (FILE VAR f, SYM VAR sym): 
+  get (f, sym); 
+  skip blanks; 
+  IF NOT eof (infile) THEN 
+    error ("Hinter dem letzten Symbol des LISP-Ausdruck stehen noch Zeichen") 
+  FI 
+END PROC get all; 
+ 
+ 
+END PACKET lisp io; 
+ 
+ 
+ 
+PACKET lisp integer                                 (* Autor: J.Durchholz *) 
+                                                    (* Datum: 30.08.1982  *) 
+    DEFINES                                         (* Version 1.1.2      *) 
+ 
+  sum, 
+  difference, 
+  product, 
+  quotient,
+  remainder:
+ 
+SYM PROC sum (SYM CONST summand list): 
+  INT VAR result := 0; 
+  SYM VAR list rest := summand list; 
+  WHILE NOT atom (list rest) REP 
+    result INCR int 1 (head (list rest)); 
+    list rest := tail (list rest) 
+  PER; 
+  IF NOT null (list rest) THEN 
+    error stop ("Summandenliste endet falsch") 
+  FI ;
+  sym (result, -1) 
+END PROC sum; 
+ 
+ 
+SYM PROC difference (SYM CONST minuend, subtrahend): 
+  sym (int 1 (minuend) - int 1 (subtrahend), -1) 
+END PROC difference; 
+ 
+ 
+SYM PROC product (SYM CONST factor list): 
+  INT VAR result := 1; 
+  SYM VAR list rest := factor list; 
+  WHILE NOT atom (list rest) REP 
+    result := result * int 1 (head (list rest)); 
+    list rest := tail (list rest) 
+  PER; 
+  IF NOT null (list rest) THEN 
+    error stop ("Faktorenliste endet falsch") 
+  FI; 
+  sym (result, -1) 
+END PROC product; 
+ 
+ 
+SYM PROC quotient (SYM CONST dividend, divisor): 
+  sym (int 1 (dividend) DIV int 1 (divisor), -1) 
+END PROC quotient; 
+ 
+ 
+SYM PROC remainder(SYM CONST dividend, divisor): 
+  sym (int 1 (dividend) MOD int 1 (divisor), -1) 
+END PROC remainder;
+ 
+ 
+END PACKET lisp integer; 
+
diff --git a/lisp/lisp.3 b/lisp/lisp.3
new file mode 100644
index 0000000..a93463c
--- /dev/null
+++ b/lisp/lisp.3
@@ -0,0 +1,767 @@
+PACKET lisp heap maintenance                        (* Autor: J.Durchholz *) 
+                                                    (* Datum: 09.05.1984  *) 
+    DEFINES                                         (* Version 1.7.2      *) 
+                                                    (* Testhilfe          *) 
+  create lisp system,                  (* hey, 02.3.83 : 121,334,542,732 *) 
+  dump oblist: 
+ 
+ 
+PROC create lisp system (FILE VAR f, DATASPACE CONST new heap): 
+  initialize lisp system (new heap); 
+  input (f); 
+  WHILE NOT eof (f) REP 
+    TEXT VAR name; 
+    get (f, name); 
+    SYM CONST s :: new atom (name); 
+    get (f, name); 
+    SYM CONST property name :: new atom (name); 
+    IF NOT null (property name) THEN 
+      SYM VAR property; 
+      get (f, property); 
+      add property (s, property name, property) 
+    FI 
+  PER 
+END PROC create lisp system; 
+ 
+ 
+PROC dump oblist (FILE VAR f): 
+  begin oblist dump; 
+  REP 
+    SYM CONST actual atom :: next atom; 
+    put line (f, name (actual atom)); 
+    dump property list 
+  UNTIL null (actual atom) PER. 
+ 
+dump property list: 
+  begin property list dump (actual atom); 
+  REP 
+    SYM VAR id, value; 
+    next property (id, value); 
+    write (f, "  "); 
+    write (f, name (id)); 
+    write (f, " "); 
+    write (f, name (value)); 
+    line (f) 
+  UNTIL null (id) AND null (value) PER. 
+ 
+END PROC dump oblist; 
+ 
+ 
+PROC dump oblist: 
+  begin oblist dump; 
+  REP 
+    SYM CONST actual atom :: next atom; 
+    put line (name (actual atom)); 
+    dump property list 
+  UNTIL null (actual atom) PER. 
+ 
+dump property list: 
+  begin property list dump (actual atom); 
+  REP 
+    SYM VAR id, value; 
+    next property (id, value); 
+    out ("  "); 
+    out (name (id)); 
+    out (" "); 
+    put line (name (value)); 
+  UNTIL null (id) AND null (value) PER. 
+ 
+END PROC dump oblist; 
+ 
+ 
+END PACKET lisp heap maintenance; 
+ 
+ 
+ 
+PACKET lisp interpreter                             (* Autor: J.Durchholz *) 
+                                                    (* Datum: 27.12.1982  *) 
+    DEFINES                                         (* Version 3.1.7      *) 
+  evalquote,
+  apply, 
+  eval, 
+  try: 
+ 
+ 
+(* SYM-objects used by the interpreter. They all point to constant structure
+ within the heap. As their address may change during garbage collection,
+ it must be possible to correct the references to them made by the
+ SYM-objects. That is the reason why they are declared VAR instead of CONST*)
+SYM VAR lambda constant, 
+        label constant, 
+        quote constant, 
+        function constant, 
+        indefinite constant, 
+        apval constant, 
+        true constant, 
+        false constant; 
+ 
+SYM VAR errors; 
+BOOL VAR trace :: FALSE; 
+ 
+PROC initialize constants: 
+  lambda constant := new atom ("LAMBDA"); 
+  label constant := new atom ("LABEL"); 
+  quote constant := new atom ("QUOTE"); 
+  function constant := new atom ("FUNCTION"); 
+  indefinite constant := new atom ("INDEFINITE"); 
+  apval constant := new atom ("APVAL"); 
+  true constant := new atom ("T"); 
+  false constant := new atom ("F"); 
+  errors := new atom ("ERRORS") 
+END PROC initialize constants; 
+ 
+ 
+SYM PROC evalquote (SYM CONST expr):     (*hey*)
+  enable stop; 
+  initialize constants; 
+  x apply ( head (expr), quote (tail (expr)), nil )
+END PROC evalquote;
+ 
+ 
+SYM PROC quote (SYM CONST x):
+  IF eq (x,nil) THEN nil
+  ELSE set head (x, new head); set tail (x, quote (tail(x))); x
+  FI .
+new head:
+  cons (quote constant, cons (head(x), nil) )
+END PROC quote;
+ 
+ 
+SYM PROC apply (SYM CONST function, argument list, alist): 
+  enable stop; 
+  initialize constants; 
+  x apply (function, argument list, alist) 
+END PROC apply; 
+ 
+ 
+SYM PROC x apply (SYM CONST function, argument list, alist): 
+  IF trace THEN line;
+    put ("a p p l y :"); put (function); line;
+    put ("arguments :"); put (argument list); line;
+  FI;
+  SYM VAR new alist; 
+  initialize for alist insertion; 
+  reduce actual fn to lambda expression; 
+  insert parameter evaluated argument pairs in reversed order in new alist; 
+  function body evaluation. 
+ 
+reduce actual fn to lambda expression: 
+  SYM VAR actual fn :: function; 
+  REP 
+    IF is named atom (actual fn) THEN 
+      get function from property list of actual fn 
+                                           or from functional alist entry 
+    ELIF atom (actual fn) THEN 
+      error stop ("Eine Funktion darf kein unbenanntes Atom sein") 
+    ELSE 
+      IF eq (head (actual fn), lambda constant) THEN 
+        LEAVE reduce actual fn to lambda expression 
+      ELIF eq (head (actual fn), label constant) THEN 
+        get function from label expression and update alist 
+      ELSE 
+        error stop ("Funktion ist weder Atom noch LAMBDA-/LABEL-Ausdruck") 
+      FI 
+    FI 
+  PER. 
+ 
+get function from property list of actual fn or from functional alist entry: 
+  IF property exists (actual fn, function constant) THEN 
+    get function from property list of actual fn 
+  ELSE 
+    get function from functional alist entry 
+  FI. 
+ 
+get function from property list of actual fn: 
+  actual fn := property (actual fn, function constant). 
+ 
+get function from functional alist entry: 
+  SYM VAR actual alist entry; 
+  begin alist retrieval; 
+  REP 
+    IF end of alist THEN 
+      error stop ("Die Funktion " + name (actual fn) + 
+                  " ist nicht definiert") 
+    FI; 
+    search for next functional alist entry; 
+  UNTIL eq (head (actual functional alist entry), actual fn) PER; 
+  actual fn := tail (actual functional alist entry). 
+ 
+get function from label expression and update alist: 
+  actual fn := tail (actual fn); 
+  IF atom (actual fn) COR 
+     (NOT atom (head (actual fn)) OR atom (tail (actual fn))) COR 
+     NOT null (tail (tail (actual fn)))                           THEN 
+    error stop ("Ungueltiger LABEL-Ausdruck") 
+  FI; 
+  SYM VAR new alist entry; 
+  prepare new functional alist entry; 
+  set head (new alist entry, head (actual fn)); 
+  actual fn := head (tail (actual fn)); 
+  set tail (new alist entry, actual fn). 
+ 
+insert parameter evaluated argument pairs in reversed order in new alist: 
+  actual fn := tail (actual fn); 
+  IF atom (actual fn) THEN 
+    error stop ("Ungueltiger LAMBDA-Ausdruck") 
+  FI; 
+  SYM VAR parameter list rest :: head (actual fn), 
+          argument list rest :: argument list; 
+  actual fn := tail (actual fn); 
+  WHILE NOT null (parameter list rest) REP 
+    add next parameter argument pair to alist 
+  PER; 
+  check wether no arguments are left over. 
+ 
+add next parameter argument pair to alist: 
+  IF atom (parameter list rest) THEN 
+    error stop ("Parameterliste endet falsch") 
+  FI; 
+  SYM VAR param pointer :: head (parameter list rest); 
+  parameter list rest := tail (parameter list rest); 
+  IF is named atom (param pointer) AND NOT null (param pointer) THEN 
+    add parameter evaluated argument pair to alist; 
+    advance argument list rest 
+  ELIF atom (param pointer) THEN 
+    error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") 
+  ELSE 
+    IF eq (head (param pointer), indefinite constant) THEN 
+      check wether is last param; 
+      advance param pointer; 
+      IF eq (head (param pointer), quote constant) THEN 
+        advance param pointer; 
+        move param pointer to parameter; 
+        add parameter indefinite quoted argument pair to alist 
+      ELSE 
+        move param pointer to parameter; 
+        add parameter indefinite evaluated argument pair to alist 
+      FI; 
+      argument list rest := nil 
+    ELIF eq (head (param pointer), quote constant) THEN 
+      advance param pointer; 
+      move param pointer to parameter; 
+      add parameter quoted argument pair to alist; 
+      advance argument list rest 
+    ELIF eq (head (param pointer), function constant) THEN 
+      advance param pointer; 
+      move param pointer to parameter; 
+      add parameter functional argument pair to alist; 
+      advance argument list rest 
+    ELSE 
+      error stop ("Ungueltiger Parameter") 
+    FI 
+  FI. 
+ 
+advance param pointer: 
+  param pointer := tail (param pointer); 
+  IF atom (param pointer) THEN 
+    error stop ("Ungueltiger Parameter") 
+  FI. 
+ 
+move param pointer to parameter: 
+  IF NOT null (tail (param pointer)) THEN 
+    error stop ("Ungueltiger Parameter") 
+  FI; 
+  param pointer := head (param pointer); 
+  IF NOT atom (param pointer) OR null (param pointer) THEN 
+    error stop ("Unbenannte Atome und NIL koennen nicht Parameter sein") 
+  FI. 
+ 
+advance argument list rest: 
+  argument list rest := tail (argument list rest). 
+ 
+add parameter evaluated argument pair to alist: 
+  prepare new alist entry; 
+  set head (new alist entry, param pointer); 
+  set tail (new alist entry, x eval (actual argument, alist)). 
+ 
+check wether is last param: 
+  IF NOT null (parameter list rest) THEN 
+    error stop ("Ein INDEFINITE-Parameter muss der letzte sein") 
+  FI. 
+ 
+add parameter indefinite quoted argument pair to alist: 
+  prepare new alist entry; 
+  set head (new alist entry, param pointer); 
+  set tail (new alist entry, argument list rest); 
+  WHILE NOT atom (argument list rest) REP 
+    argument list rest := tail (argument list rest) 
+  PER; 
+  IF NOT null (argument list rest) THEN 
+    error stop ("Argumentliste endet falsch") 
+  FI. 
+ 
+add parameter indefinite evaluated argument pair to alist: 
+  prepare new alist entry; 
+  set head (new alist entry, param pointer); 
+  last evaluated argument := new alist entry; 
+  WHILE NOT atom (argument list rest) REP 
+    set tail (last evaluated argument, 
+              cons (x eval (head (argument list rest), alist), nil)); 
+    last evaluated argument := tail (last evaluated argument); 
+    advance argument list rest 
+  PER; 
+  IF NOT null (argument list rest) THEN 
+    error stop ("Argumentliste endet falsch") 
+  FI. 
+ 
+last evaluated argument: 
+  param pointer. 
+(* The value of param pointer is not used further, so the *) 
+(* variable can be "reused" in this manner. *) 
+ 
+add parameter quoted argument pair to alist: 
+  prepare new alist entry; 
+  set head (new alist entry, param pointer); 
+  set tail (new alist entry, actual argument). 
+ 
+add parameter functional argument pair to alist: 
+  prepare new functional alist entry; 
+  set head (new alist entry, param pointer); 
+  set tail (new alist entry, actual argument). 
+ 
+actual argument: 
+  IF atom (argument list rest) THEN 
+    IF null (argument list rest) THEN 
+      error stop ("Zuwenig Argumente") 
+    ELSE 
+      error stop ("Argumentliste endet falsch") 
+    FI 
+  FI; 
+  head (argument list rest). 
+ 
+check wether no arguments are left over: 
+  IF NOT null (argument list rest) THEN 
+    error stop ("Zuviele Argumente") 
+  FI. 
+ 
+function body evaluation: 
+  IF is int pair (actual fn) THEN 
+    predefined function evaluation 
+  ELIF atom (actual fn) COR NOT null (tail (actual fn)) THEN 
+    error stop ("Ungueltiger LAMBDA-Ausdruck"); nil 
+  ELSE 
+    x eval (head (actual fn), new alist) 
+  FI. 
+ 
+predefined function evaluation: 
+  SELECT int 1 (actual fn) OF 
+    CASE 0: call eval cond 
+    CASE 1: call begin oblist dump 
+    CASE 2: call next atom 
+    CASE 3: call add property 
+    CASE 4: call alter property 
+    CASE 5: call delete property 
+    CASE 6: call property exists 
+    CASE 7: call property 
+    CASE 8: call add flag 
+    CASE 9: call flag 
+    CASE 10: call delete flag 
+    CASE 11: call begin property list dump 
+    CASE 12: call next property 
+    CASE 13: call apply 
+    CASE 14: call eval 
+    CASE 15: call try 
+    CASE 16: give association list 
+    CASE 17: call error stop 
+    CASE 18: call head 
+    CASE 19: call set head 
+    CASE 20: call tail 
+    CASE 21: call set tail 
+    CASE 22: call cons 
+    CASE 23: call eq 
+    CASE 24: call get sym 
+    CASE 25: call put sym 
+    CASE 26: call null 
+    CASE 27: call is atom 
+    CASE 28: call is named atom 
+    CASE 29: call get named atom 
+    CASE 30: call put named atom 
+    CASE 31: call is text 
+    CASE 32: call get text 
+    CASE 33: call put text 
+    CASE 34: call is character 
+    CASE 35: call get character 
+    CASE 36: call put character 
+    CASE 37: call is int 
+    CASE 38: call get int 
+    CASE 39: call put int 
+    CASE 40: call sum 
+    CASE 41: call difference 
+    CASE 42: call product 
+    CASE 43: call quotient 
+    CASE 44: call remainder
+    CASE 45: call equal 
+    CASE 46: call trace
+    CASE 47: call define
+    CASE 48: call set
+    OTHERWISE error stop("Es gibt (noch) keine LISP-Funktion mit der Nummer" 
+                          + text (int 1 (actual fn)) ); nil 
+  END SELECT. 
+ 
+call eval cond: 
+  x eval condition (arg 1, alist). 
+ 
+call begin oblist dump: 
+  begin oblist dump; nil. 
+ 
+call next atom: 
+  next atom. 
+ 
+call add property: 
+  add property (arg 3, arg 2, arg 1); arg 1. 
+ 
+call alter property: 
+  alter property (arg 3, arg 2, arg 1); arg 1. 
+ 
+call delete property: 
+  delete property (arg 2, arg 1); nil. 
+ 
+call property exists: 
+  IF property exists(arg 2,arg 1) THEN true constant ELSE false constant FI. 
+ 
+call property: 
+  property (arg 2, arg 1). 
+ 
+call add flag: 
+  add flag (arg 2, arg 1); nil. 
+ 
+call flag: 
+  IF flag (arg 2, arg 1) THEN true constant ELSE false constant FI. 
+ 
+call delete flag: 
+  delete flag (arg 2, arg 1); nil. 
+ 
+call begin property list dump: 
+  begin property list dump (arg 1); nil. 
+ 
+call next property: 
+  SYM VAR s1, s2; next property (s1, s2); cons (s1, s2). 
+ 
+call apply: 
+  x apply (arg 3, arg 2, arg 1). 
+ 
+call eval: 
+  x eval (arg 2, arg 1). 
+ 
+call try: 
+  x try (arg 4, arg 3, arg 2, arg 1). 
+ 
+give association list: 
+  alist. 
+ 
+call error stop: 
+  error stop (text (arg 1)); nil. 
+ 
+call head: 
+  head (arg 1). 
+ 
+call set head: 
+  set head (arg 2, arg 1); arg 2. 
+ 
+call tail: 
+  tail (arg 1). 
+ 
+call set tail: 
+  set tail (arg 2, arg 1); arg 2. 
+ 
+call cons: 
+  cons (arg 2, arg 1). 
+ 
+call eq: 
+  IF eq (arg 2, arg 1) THEN true constant ELSE false constant FI. 
+ 
+call get sym: 
+  get (s1); s1. 
+ 
+call put sym: 
+  put (arg 1); arg 1. 
+ 
+call null: 
+  IF null (arg 1) THEN true constant ELSE false constant FI. 
+ 
+call is atom: 
+  IF atom (arg 1) THEN true constant ELSE false constant FI. 
+ 
+call is named atom: 
+  IF is named atom (arg 1) THEN true constant ELSE false constant FI. 
+ 
+call get named atom: 
+  TEXT VAR t; get (t); new atom (t). 
+ 
+call put named atom: 
+  put (name (arg 1)); arg 1. 
+ 
+call is text: 
+  IF is text (arg 1) THEN true constant ELSE false constant FI. 
+ 
+call get text: 
+  get (t); sym (t). 
+ 
+call put text: 
+  put (text (arg 1)); arg 1. 
+ 
+call is character: 
+  IF is character (arg 1) THEN true constant ELSE false constant FI. 
+ 
+call get character: 
+  inchar (t); sym character (code (t)). 
+ 
+call put character: 
+  out (code (character (arg 1))); arg 1. 
+ 
+call is int: 
+  IF is int pair (arg 1) THEN true constant ELSE false constant FI. 
+ 
+call get int: 
+  INT VAR i; get (i); sym (i, -1). 
+ 
+call put int: 
+  put (int 1 (arg 1)); arg 1. 
+ 
+call sum: 
+  sum (arg 1). 
+ 
+call difference: 
+  difference (arg 2, arg 1). 
+ 
+call product: 
+  product (arg 1). 
+ 
+call quotient: 
+  quotient (arg 2, arg 1). 
+ 
+call remainder:
+  remainder(arg 2, arg 1). 
+ 
+call equal:
+  IF equal (arg 2, arg 1) THEN true constant ELSE false constant FI.
+ 
+call trace:
+  trace := NOT trace;
+  IF trace THEN true constant ELSE false constant FI . 
+ 
+call define:     (*hey*) 
+  define (arg 1) . 
+ 
+call set:         (*hey*) 
+  add property (new atom ( name (arg 2)), apval constant, arg 1); arg 1 . 
+ 
+arg 1: 
+  tail (head (new alist)). 
+ 
+arg 2: 
+  tail (head (tail (new alist))). 
+ 
+arg 3: 
+  tail (head (tail (tail (new alist)))). 
+ 
+arg 4: 
+  tail (head (tail (tail (tail (new alist))))). 
+ 
+END PROC x apply; 
+ 
+SYM PROC define (SYM CONST x):   (*hey*) 
+  IF   eq (x, nil) THEN nil 
+  ELSE add property (new atom (name (head (head (x)))), 
+                     function constant, tail (head (x)) ); 
+       cons (head (head (x)), define (tail (x)) ) 
+  FI . 
+END PROC define; 
+ 
+SYM VAR old alist :: nil;
+ 
+SYM PROC eval (SYM CONST expression, alist): 
+  enable stop; 
+  initialize constants; 
+  x eval (expression, alist) 
+END PROC eval; 
+ 
+ 
+SYM PROC x eval (SYM CONST expression, alist):   (*hey*)
+  IF trace THEN line;
+    put ("e v a l   :"); put (expression); line;
+    IF NOT equal (alist, old alist) THEN
+    put ("bindings  :"); old alist := alist; put (alist); line FI
+  FI;
+  IF atom (expression) THEN 
+    IF is named atom (expression) THEN 
+      value from property list of expression or from alist entry 
+    ELSE 
+      expression 
+    FI 
+  ELSE 
+    x apply (head (expression), tail (expression), alist) 
+  FI. 
+ 
+value from property list of expression or from alist entry: 
+  IF property exists (expression, apval constant) THEN 
+    value from property list of expression 
+  ELSE 
+    value from alist entry 
+  FI. 
+ 
+value from property list of expression: 
+  property (expression, apval constant). 
+ 
+value from alist entry: 
+  SYM VAR actual alist entry; 
+  begin alist retrieval; 
+  REP 
+    IF end of alist THEN 
+      error stop ("Das Atom " + name (expression) + " hat keinen Wert") 
+    FI; 
+    search for next alist entry 
+  UNTIL eq (head (actual alist entry), expression) PER; 
+  tail (actual alist entry). 
+ 
+END PROC x eval; 
+ 
+ 
+SYM PROC try (SYM CONST expression list, alist, 
+                        error output, break possible): 
+  enable stop; 
+  initialize constants; 
+  x try (expression list, alist, error output, break possible) 
+END PROC try; 
+ 
+ 
+SYM PROC x try (SYM CONST expression list, alist, 
+                          error output, break possible): 
+  BOOL CONST output :: bool (error output), 
+             halt enabled :: bool (break possible); 
+  SYM VAR expr list rest :: expression list; 
+  REP 
+    IF null (expr list rest) THEN 
+      LEAVE x try WITH nil 
+    ELIF atom (expr list rest) THEN 
+      error stop ("Ausdrucksliste fuer 'try' endet falsch") 
+    ELSE 
+      try evaluation of actual expression 
+    FI; 
+    expr list rest := tail (expr list rest) 
+  PER; 
+  nil. 
+ 
+try evaluation of actual expression: 
+  disable stop; 
+  SYM VAR result :: x eval (head (expr list rest), alist); 
+  IF is error THEN 
+    IF error message = "halt from terminal" AND halt enabled THEN 
+      enable stop 
+    ELIF output THEN 
+      put error 
+    FI; 
+    add property (errors, apval constant, sym (error message)); 
+    clear error 
+  ELSE 
+    LEAVE x try WITH result 
+  FI; 
+  enable stop. 
+ 
+END PROC x try; 
+ 
+ 
+SYM PROC x eval condition (SYM CONST pair list, alist): 
+  enable stop; 
+  SYM VAR cond pair list rest :: pair list; 
+  REP 
+    IF atom (cond pair list rest) THEN 
+      error stop ("Keine 'T'-Bedingung in bedingtem Ausdruck gefunden") 
+    FI; 
+    check wether is correct pair; 
+    IF true condition found THEN 
+      LEAVE x eval condition WITH x eval (head (tail (actual pair)), alist) 
+    FI; 
+    cond pair list rest := tail (cond pair list rest) 
+  PER; 
+  nil. 
+ 
+check wether is correct pair: 
+  IF atom (actual pair) COR 
+     atom (tail (actual pair)) COR 
+     NOT null (tail (tail (actual pair))) THEN 
+    error stop ("Ungueltiges Paar im bedingten Ausdruck") 
+  FI. 
+ 
+true condition found: 
+  bool (x eval (head (actual pair), alist)). 
+ 
+actual pair: 
+  head (cond pair list rest). 
+ 
+END PROC x eval condition; 
+ 
+ 
+BOOL PROC bool (SYM CONST sym): 
+  IF eq (sym, true constant) THEN 
+    TRUE 
+  ELIF eq (sym, false constant) THEN 
+    FALSE 
+  ELSE 
+    error stop ("'T' oder 'F' erwartet"); TRUE 
+  FI 
+END PROC bool; 
+ 
+ 
+(******* a-list handling refinements used in 'x apply' and 'x eval' *******) 
+ 
+(* declared within 'x apply' and 'x eval': 'actual alist entry'           *) 
+ 
+. 
+ 
+initialize for alist insertion: 
+  new alist := alist. 
+ 
+begin alist retrieval: 
+  SYM VAR actual alist pos :: alist. 
+ 
+search for next alist entry: 
+  WHILE NOT end of alist REP 
+    IF atom (actual alist pos) THEN 
+      error stop ("Bindeliste endet falsch") 
+    FI; 
+    actual alist entry := head (actual alist pos); 
+    actual alist pos := tail (actual alist pos); 
+  UNTIL is non functional alist entry PER. 
+ 
+is non functional alist entry: 
+  NOT is functional alist entry. 
+ 
+search for next functional alist entry: 
+  WHILE NOT end of alist REP 
+    IF atom (actual alist pos) THEN 
+      error stop ("Bindeliste endet falsch") 
+    FI; 
+    actual alist entry := head (actual alist pos); 
+    actual alist pos := tail (actual alist pos); 
+  UNTIL is functional alist entry PER; 
+  actual alist entry := tail (actual alist entry). 
+ 
+is functional alist entry: 
+  check wether is alist entry; 
+  null (head (actual alist entry)). 
+ 
+check wether is alist entry: 
+  IF atom (actual alist entry) THEN 
+    error stop ("Bindelisteneintrag ist kein Paar") 
+  FI. 
+ 
+end of alist: 
+  null (actual alist pos). 
+ 
+actual functional alist entry: 
+  actual alist entry. 
+ 
+prepare new alist entry: 
+  new alist := cons (cons (nil, nil), new alist); 
+  new alist entry := head (new alist). 
+ 
+prepare new functional alist entry: 
+  new alist := cons (cons (nil, cons (nil, nil)), new alist); 
+  new alist entry := tail (head (new alist)). 
+ 
+ 
+END PACKET lisp interpreter; 
+ 
+ 
+
diff --git a/lisp/lisp.4 b/lisp/lisp.4
new file mode 100644
index 0000000..0733dcd
--- /dev/null
+++ b/lisp/lisp.4
@@ -0,0 +1,143 @@
+PACKET lisp               (* Autor: J.Durchholz , P. Heyderhoff *)
+                          (* Datum: 09.05.1984  *)
+    DEFINES               (* Version 1.7.2      *)
+                          (* Änderung: notebook                       *)
+                          (*    13.3.86  I. Ley                       *)
+                          (* Änderung: start lisp system              *)
+                          (*    25.3.86  I. Ley                       *)
+                          (* Anpassung an ELAN-Compiler Version 1.7.5 *)
+                          (*     8.4.86  I. Ley                       *)
+  start lisp system,
+  lisp heap,
+  insert lisp,
+  run lisp,
+  run lisp again,
+  lisp,
+  break lisp:
+ 
+SYM VAR run again pointer :: nil;
+DATASPACE VAR insert heap :: nil space;
+ 
+PROC start lisp system (DATASPACE CONST heap):
+  enable stop;
+  initialize lisp system (heap);
+  forget (insert heap);
+  insert heap := heap
+END PROC start lisp system;
+ 
+ 
+PROC start lisp system (DATASPACE CONST heap, FILE VAR f):
+  enable stop;
+  create lisp system (f, heap);
+  forget (insert heap);
+  insert heap := heap
+END PROC start lisp system;
+ 
+ 
+PROC start lisp system (FILE VAR f):
+  create lisp system (f, insert heap)
+END PROC start lisp system;
+ 
+ 
+DATASPACE PROC lisp heap:
+  insert heap
+END PROC lisp heap;
+ 
+ 
+DATASPACE VAR run heap :: nil space;
+ 
+ 
+PROC insert lisp:
+  insert lisp (last param)
+END PROC insert lisp;
+ 
+ 
+PROC insert lisp (TEXT CONST file name):
+  interpret (insert heap, file name)
+END PROC insert lisp;
+ 
+ 
+PROC run lisp:
+  run lisp (last param)
+END PROC run lisp;
+ 
+ 
+PROC run lisp (TEXT CONST file name):
+  forget (run heap);
+  run heap := insert heap;
+  interpret (run heap, file name)
+END PROC run lisp;
+ 
+ 
+PROC interpret (DATASPACE CONST heap, TEXT CONST file name):
+  enable stop;
+  FILE VAR f :: sequential file (input, file name);
+  interpret (heap, f)
+END PROC interpret;
+ 
+ 
+PROC interpret (DATASPACE CONST heap, FILE VAR f):
+  initialize lisp system (heap);
+  get (f, run again pointer);
+  add property (new atom ("program"), new atom ("APVAL"), run again pointer);
+  put (evalquote (run again pointer))
+END PROC interpret;
+ 
+PROC run lisp again:
+  put (evalquote (run again pointer))
+END PROC run lisp again;
+ 
+ 
+PROC get ausdruck:
+  enable stop; get (ausdruck)
+END PROC get ausdruck;
+ 
+SYM VAR ausdruck; 
+ 
+PROC lisp:
+ 
+(* HAUPT TESTPROGRAMM FUER LISP      Heyderhoff    25.1.83   *)
+IF NOT exists ("LISP HEAP") THEN 
+  FILE VAR bootstrap :: sequential file (input, "lisp.bootstrap"); 
+  create lisp system (bootstrap, new ("LISP HEAP")); 
+  verbose lisp output (TRUE);
+FI; 
+SYM VAR work;
+command dialogue(FALSE); forget ("LISP INPUT"); command dialogue(TRUE);
+(* bildlaenge(23); *) (* EUMEL 1.65 *)
+disable stop; 
+REP 
+  get (ausdruck); 
+  IF is error THEN 
+    handle error 
+  ELSE 
+    work := evalquote (ausdruck);
+    IF is error THEN  handle error 
+    ELSE note (work)
+    FI 
+  FI 
+PER .
+ 
+handle error: 
+  IF text (error message, 18) = "halt from terminal" THEN 
+    enable stop 
+  ELSE 
+    note (error message);
+    put (     error message); pause(20);
+    clear error; 
+  FI .
+END PROC lisp;
+ 
+PROC break lisp:
+  break; 
+  page; 
+  quit;
+  FILE VAR in  :: sequential file (modify, "LISP INPUT"), 
+           out :: notefile; modify (out);
+  headline (out,"LISP OUTPUT");
+  headline (in, "LISP INPUT");
+  noteedit (in);
+END PROC break lisp
+ 
+END PACKET lisp;
+
diff --git a/lisp/lisp.bootstrap b/lisp/lisp.bootstrap
new file mode 100644
index 0000000..37efbde
--- /dev/null
+++ b/lisp/lisp.bootstrap
@@ -0,0 +1,118 @@
+NIL                      APVAL 
+NIL 
+T                        APVAL 
+T 
+F                        APVAL 
+F 
+COND                     FUNCTION 
+(LAMBDA ((INDEFINITE QUOTE X)) . 0) 
+BEGINOBLISTDUMP        FUNCTION 
+(LAMBDA () . 1) 
+NEXTATOM                FUNCTION 
+(LAMBDA () . 2) 
+ADDPROPERTY             FUNCTION 
+(LAMBDA (X X X) . 3) 
+ALTERPROPERTY           FUNCTION 
+(LAMBDA (X X X) . 4) 
+DELETEPROPERTY          FUNCTION 
+(LAMBDA (X X) . 5) 
+PROPERTYEXISTS          FUNCTION 
+(LAMBDA (X X) . 6) 
+PROPERTY                 FUNCTION 
+(LAMBDA (X X) . 7) 
+ADDFLAG                 FUNCTION 
+(LAMBDA (X X) . 8) 
+FLAG                     FUNCTION 
+(LAMBDA (X X) . 9) 
+DELETEFLAG              FUNCTION 
+(LAMBDA (X X) . 10) 
+BEGINPROPERTYLISTDUMP FUNCTION 
+(LAMBDA (X) . 11) 
+NEXTPROPERTY            FUNCTION 
+(LAMBDA () . 12) 
+APPLY                    FUNCTION 
+(LAMBDA (X X X) . 13) 
+EVAL                     FUNCTION 
+(LAMBDA (X X) . 14) 
+TRY                      FUNCTION 
+(LAMBDA (X X X X) . 15) 
+ASSOCIATIONLIST         FUNCTION 
+(LAMBDA () . 16) 
+ERRORSTOP               FUNCTION 
+(LAMBDA (X) . 17) 
+HEAD                     FUNCTION 
+(LAMBDA (X) . 18) 
+SETHEAD                 FUNCTION 
+(LAMBDA (X X) . 19) 
+TAIL                     FUNCTION 
+(LAMBDA (X) . 20) 
+SETTAIL                 FUNCTION 
+(LAMBDA (X X) . 21) 
+CONS                     FUNCTION 
+(LAMBDA (X X) . 22) 
+EQ                       FUNCTION 
+(LAMBDA (X X) . 23) 
+GET                      FUNCTION 
+(LAMBDA () . 24) 
+PUT                      FUNCTION 
+(LAMBDA (X) . 25) 
+NULL                     FUNCTION 
+(LAMBDA (X) . 26) 
+ATOM                     FUNCTION 
+(LAMBDA (X) . 27) 
+NAMEDATOM               FUNCTION 
+(LAMBDA (X) . 28) 
+GETATOM                 FUNCTION 
+(LAMBDA () . 29) 
+PUTATOM                 FUNCTION 
+(LAMBDA (X) . 30) 
+TEXT                     FUNCTION 
+(LAMBDA (X) . 31) 
+GETTEXT                 FUNCTION 
+(LAMBDA () . 32) 
+PUTTEXT                 FUNCTION 
+(LAMBDA (X) . 33) 
+CHARACTER                FUNCTION 
+(LAMBDA (X) . 34) 
+GETCHARACTER            FUNCTION 
+(LAMBDA () . 35) 
+PUTCHARACTER            FUNCTION 
+(LAMBDA (X) . 36) 
+INT                      FUNCTION 
+(LAMBDA (X). 37) 
+GETINT                  FUNCTION 
+(LAMBDA () . 38) 
+PUTINT                  FUNCTION 
+(LAMBDA (X) . 39) 
+SUM                      FUNCTION 
+(LAMBDA ((INDEFINITE X)) . 40) 
+DIFFERENCE               FUNCTION 
+(LAMBDA (X X). 41) 
+PRODUCT                  FUNCTION 
+(LAMBDA ((INDEFINITE X)). 42) 
+QUOTIENT                 FUNCTION 
+(LAMBDA (X X).43) 
+REMAINDER                FUNCTION 
+(LAMBDA (X X).44) 
+EQUAL                    FUNCTION 
+(LAMBDA (X X) . 45) 
+TRACE                    FUNCTION 
+(LAMBDA () . 46 ) 
+DEFINE                   FUNCTION 
+(LAMBDA ((INDEFINITE X)) . 47 ) 
+SET                      FUNCTION 
+(LAMBDA (X X) . 48 ) 
+QUOTE                    FUNCTION 
+(LAMBDA ((QUOTE X)) X) 
+LIST                     FUNCTION 
+(LAMBDA ((INDEFINITE X)) X) 
+DO                       FUNCTION 
+(LAMBDA ((INDEFINITE X)) NIL) 
+PUTLIST                 FUNCTION 
+(LAMBDA ((INDEFINITE X)) 
+  (COND 
+    ((NULL X) NIL) 
+    (T (DO (PUT (HEAD X)) (PUTLIST (TAIL X)))) 
+  ) 
+) 
+