From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 lang/dynamo/1.8.7/src/dyn.tool | 217 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 217 insertions(+)
 create mode 100644 lang/dynamo/1.8.7/src/dyn.tool

(limited to 'lang/dynamo/1.8.7/src/dyn.tool')

diff --git a/lang/dynamo/1.8.7/src/dyn.tool b/lang/dynamo/1.8.7/src/dyn.tool
new file mode 100644
index 0000000..65769d8
--- /dev/null
+++ b/lang/dynamo/1.8.7/src/dyn.tool
@@ -0,0 +1,217 @@
+PACKET io handling DEFINES error listing, err, message, errors, init errors,
+                           text, kill, trunc, hash, no errors :
+(* Autor : R. Keil, Version vom 22.07.83, Änderung: C. Szymanski, 21.07.88 *)
+
+LET errmax        = 67,
+    max hash size = 300;
+ 
+ROW errmax TEXT VAR error;
+FILE VAR listfile;                    (* -> VERSION 3.2  *)
+BOOL VAR list;
+INT VAR errorno, i;
+ 
+PROC init errors (TEXT CONST fname) :
+ FILE VAR errorfile := sequential file (input, fname);
+ TEXT VAR buffer;
+ FOR i FROM 1 UPTO errmax WHILE NOT eof (errorfile) REP
+  getline (errorfile, buffer);
+  error (i) := buffer
+ END REP
+END PROC init errors;
+ 
+PROC init errors :
+  errorno := 0
+END PROC init errors;
+ 
+PROC error listing (TEXT CONST listname) :
+ list := listname <> "nolist";
+ IF list
+  THEN kill (listname);
+       listfile := sequential file (output, listname)
+ FI
+END PROC error listing;
+ 
+INT PROC errors :
+ error no
+END PROC errors;
+ 
+PROC err (TEXT CONST s, INT CONST m, line no) :
+ message ("Fehler in Zeile " + text (line no) + " bei >>" + s + "<< : "
+          + error (m));
+ errorno INCR 1
+END PROC err;
+ 
+BOOL PROC no errors :
+ IF errors = 0
+  THEN TRUE
+  ELSE display (text (error no) + " Fehler gefunden"13""10""); FALSE
+ FI
+END PROC no errors;
+
+PROC message (TEXT CONST m) :
+ IF list
+  THEN putline (list file, m);
+ FI;
+ note (m);                             (* C.S. 21.07.88 *)
+ note line;
+ display (m);
+ display (""13""10"")
+END PROC message;
+ 
+TEXT PROC text (BOOL CONST b) :
+ IF b
+  THEN "TRUE"
+  ELSE "FALSE"
+ FI
+END PROC text;
+ 
+PROC kill (TEXT CONST file name) :
+ command dialogue (FALSE);
+ forget (file name);
+ command dialogue (TRUE)
+END PROC kill;
+ 
+TEXT PROC trunc (TEXT CONST t) :
+ text (t, length (t) - 2)
+END PROC trunc;
+ 
+INT PROC hash (TEXT CONST word) :
+ INT VAR qs := 0;
+ FOR i FROM 1 UPTO length (word) REP
+  qs INCR code (word SUB i)
+ END REP;
+ (qs MOD max hash size) + 1.
+END PROC hash
+ 
+END PACKET io handling;
+ 
+ 
+(************************* S C A N N E R **************************)
+ 
+PACKET scan DEFINES next sym, scanner, scanpos :
+ 
+ 
+LET bold      = 1,          (* Autor : R. Keil, T. Froehlich *)
+    number    = 2,          (* Version vom 04.07.83 *)
+    delimiter = 3,
+    eol       = 4;
+ 
+TEXT VAR main buf, sym;
+INT  VAR position, type, cc, begin pos;
+ 
+PROC nextsym (TEXT CONST buf, TEXT VAR scan sym,
+              INT VAR scan type, pos) :
+ TEXT VAR char := buf SUB pos;
+ cc := code (char);
+ IF (cc >= 97 AND cc <= 122)
+  THEN process lower case
+ ELIF cc = 46 OR is int
+  THEN process real
+ ELIF (cc >= 65 AND cc <= 90)
+  THEN process upper case
+  ELSE process delimiter
+ FI.
+ 
+ process upper case :
+  scan type := bold;
+  scan sym  := low;
+  next char;
+  WHILE (cc >= 65 AND cc <= 90) OR is int REP
+   scan sym CAT low;
+   next char
+  END REP.
+ 
+ process lower case :
+  scan type := bold;
+  begin pos := pos;
+  REP
+   next char
+  UNTIL lower case char AND NOT is int END REP;
+  scan sym := subtext (buf, begin pos, pos - 1).
+ 
+ lower case char :
+  cc < 97 OR cc > 122.
+
+ process real :
+  process base;
+  process exponent;
+  scan type := number.
+ 
+ process base :
+  IF cc = 46
+   THEN next char;
+        IF is int
+         THEN scan sym := "0.";
+              process int
+         ELSE scan type := delimiter;
+              scan sym := ".";
+              LEAVE process real
+        FI
+   ELSE scan sym := "";
+        process int;
+        IF cc = 46
+         THEN scan sym CAT char;
+              next char;
+              IF is int
+               THEN process int
+               ELSE scan sym CAT "0"
+              FI
+         ELSE scan sym CAT ".0"
+        FI
+  FI.
+ 
+ process exponent :
+  IF cc = 69 OR cc = 101
+   THEN scan sym CAT "e";
+        next char;
+        IF cc = 43 OR cc = 45
+         THEN scan sym CAT char; next char
+        FI;
+        IF is int
+         THEN process int
+         ELSE err (char, 63, 0)
+        FI
+  FI.
+ 
+ process int :
+  WHILE is int REP
+   scan sym CAT char;
+   next char
+  END REP.
+ 
+is int :
+ cc >= 48 AND cc <= 57.
+ 
+ process delimiter :
+  IF cc = -1
+   THEN scan sym := "EOL"; scan type := eol
+   ELSE scan type := delimiter;
+        scan sym := char
+  FI;
+  pos INCR 1.
+ 
+ next char :
+  pos INCR 1; char := buf SUB pos; cc := code (char).
+ 
+ low :
+  IF cc >= 65 AND cc <= 90
+   THEN code (cc + 32)
+   ELSE char
+  FI.
+END PROC next sym;
+ 
+PROC scanner (TEXT CONST buf) :
+  main buf := buf; position := 1
+END PROC scanner;
+ 
+PROC next sym (TEXT VAR sym, INT VAR type) :
+  next sym (main buf, sym, type, position)
+END PROC next sym;
+ 
+INT PROC scanpos :
+ position
+END PROC scanpos
+ 
+END PACKET scan
+ 
+
-- 
cgit v1.2.3