summaryrefslogtreecommitdiff
path: root/lang/dynamo/1.8.7/src/dyn.tool
diff options
context:
space:
mode:
Diffstat (limited to 'lang/dynamo/1.8.7/src/dyn.tool')
-rw-r--r--lang/dynamo/1.8.7/src/dyn.tool217
1 files changed, 217 insertions, 0 deletions
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
+
+