Trurl-based/Std/Mod/Interpreter.txt

   1 MODULE StdInterpreter;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Interpreter.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT Kernel, Meta, Strings, Views, Dialog;
   7
   8         TYPE
   9                 IntValue = POINTER TO RECORD (Meta.Value)
  10                         int: INTEGER;
  11                 END;
  12                 StrValue = POINTER TO RECORD (Meta.Value)
  13                         str: Dialog.String;
  14                 END;
  15                 CallHook = POINTER TO RECORD (Dialog.CallHook) END;
  16
  17
  18         PROCEDURE (hook: CallHook) Call (IN proc, errorMsg: ARRAY OF CHAR; VAR res: INTEGER);
  19                 TYPE Ident = ARRAY 32 OF CHAR;
  20                 CONST
  21                         modNotFound = 10; procNotFound = 11; identExpected = 12; unknownIdent = 13;
  22                         depositExpected = 14; noDepositExpected = 15; syntaxError = 16;
  23                         lparenExpected = 17; rparenExpected = 18; containerExpected = 19; quoteExpected = 20;
  24                         fileNotFound = 21; noController = 22; noDialog = 23; cannotUnload = 24; commaExpected = 25;
  25                         incompParList = 26;
  26                 CONST
  27                          ident = 0; dot = 1; semicolon = 2; eot = 3; lparen = 4; rparen = 5; quote = 6; comma = 7; int = 8;
  28                 VAR
  29                         i, type: INTEGER; ch: CHAR; id: Ident; x: INTEGER;
  30                         par: ARRAY 100 OF POINTER TO Meta.Value; numPar: INTEGER;
  31
  32                 PROCEDURE Concat (a, b: ARRAY OF CHAR; VAR c: ARRAY OF CHAR);
  33                         VAR i, j: INTEGER; ch: CHAR;
  34                 BEGIN
  35                         IF a = " " THEN Dialog.MapString("#System:CommandError", c) ELSE c := a$ END;
  36                         i := 0; WHILE c[i] # 0X DO INC(i) END;
  37                         c[i] := " "; INC(i);
  38                         j := 0; ch := b[0]; WHILE ch # 0X DO c[i] := ch; INC(i); INC(j); ch := b[j] END;
  39                         c[i] := 0X
  40                 END Concat;
  41
  42                 PROCEDURE Error (n: INTEGER; msg, par0, par1: ARRAY OF CHAR);
  43                         VAR e, f: ARRAY 256 OF CHAR;
  44                 BEGIN
  45                         IF res = 0 THEN
  46                                 res := n;
  47                                 IF errorMsg # "" THEN
  48                                         Dialog.MapString(errorMsg, e);
  49                                         Dialog.MapParamString(msg, par0, par1, "", f);
  50                                         Concat(e, f, f);
  51                                         Dialog.ShowMsg(f)
  52                                 END
  53                         END
  54                 END Error;
  55
  56                 PROCEDURE Init (VAR s: ARRAY OF CHAR);
  57                         VAR i: INTEGER;
  58                 BEGIN
  59                         i := 0; WHILE i < LEN(s) DO s[i] := 0X; INC(i) END
  60                 END Init;
  61
  62                 PROCEDURE ShowLoaderResult (IN mod: ARRAY OF CHAR);
  63                         VAR res: INTEGER; importing, imported, object: ARRAY 256 OF CHAR;
  64                 BEGIN
  65                         Kernel.GetLoaderResult(res, importing, imported, object);
  66                         CASE res OF
  67                         | Kernel.fileNotFound:
  68                                 Error(Kernel.fileNotFound, "#System:CodeFileNotFound", imported, "")
  69                         | Kernel.syntaxError:
  70                                 Error(Kernel.syntaxError, "#System:CorruptedCodeFileFor", imported, "")
  71                         | Kernel.objNotFound:
  72                                 Error(Kernel.objNotFound, "#System:ObjNotFoundImpFrom", imported, importing)
  73                         | Kernel.illegalFPrint:
  74                                 Error(Kernel.illegalFPrint, "#System:ObjInconsImpFrom", imported, importing)
  75                         | Kernel.cyclicImport:
  76                                 Error(Kernel.cyclicImport, "#System:CyclicImpFrom", imported, importing)
  77                         | Kernel.noMem:
  78                                 Error(Kernel.noMem, "#System:NotEnoughMemoryFor", imported, "")
  79                         ELSE
  80                                 Error(res, "#System:CannotLoadModule", mod, "")
  81                         END
  82                 END ShowLoaderResult;
  83
  84                 PROCEDURE CallProc (IN mod, proc: ARRAY OF CHAR);
  85                         VAR i, t: Meta.Item; ok: BOOLEAN;
  86                 BEGIN
  87                         ok := FALSE;
  88                         Meta.Lookup(mod, i);
  89                         IF i.obj = Meta.modObj THEN
  90                                 i.Lookup(proc, i);
  91                                 IF i.obj = Meta.procObj THEN
  92                                         i.GetReturnType(t);
  93                                         IF (t.typ = 0) & (i.NumParam() = numPar) THEN
  94                                                 i.ParamCallVal(par, t, ok)
  95                                         ELSE ok := FALSE
  96                                         END;
  97                                         IF ~ok THEN
  98                                                 Error(incompParList, "#System:IncompatibleParList", mod, proc)
  99                                         END
 100                                 ELSE
 101                                         Error(Kernel.commNotFound, "#System:CommandNotFoundIn", proc, mod)
 102                                 END
 103                         ELSE
 104                                 ShowLoaderResult(mod)
 105                         END
 106                 END CallProc;
 107
 108                 PROCEDURE GetCh;
 109                 BEGIN
 110                         IF i < LEN(proc) THEN ch := proc[i]; INC(i) ELSE ch := 0X END
 111                 END GetCh;
 112
 113                 PROCEDURE Scan;
 114                         VAR j: INTEGER; num: ARRAY 32 OF CHAR; r: INTEGER;
 115                 BEGIN
 116                         IF res = 0 THEN
 117                                 WHILE (ch # 0X) & (ch <= " ") DO GetCh END;
 118                                 IF ch = 0X THEN
 119                                         type := eot
 120                                 ELSIF ch = "." THEN
 121                                         type := dot; GetCh
 122                                 ELSIF ch = ";" THEN
 123                                         type := semicolon; GetCh
 124                                 ELSIF ch = "(" THEN
 125                                         type := lparen; GetCh
 126                                 ELSIF ch = ")" THEN
 127                                         type := rparen; GetCh
 128                                 ELSIF ch = "'" THEN
 129                                         type := quote; GetCh
 130                                 ELSIF ch = "," THEN
 131                                         type := comma; GetCh
 132                                 ELSIF (ch >= "0") & (ch <= "9") OR (ch = "-") THEN
 133                                         type := int; j := 0;
 134                                         REPEAT num[j] := ch; INC(j); GetCh UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "H");
 135                                         num[j] := 0X; Strings.StringToInt(num, x, r)
 136                                 ELSIF (ch >= "a") & (ch <= "z") OR (ch >= "A") & (ch <= "Z") OR
 137                                                 (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") THEN
 138                                         type := ident;
 139                                         id[0] := ch; j := 1; GetCh;
 140                                         WHILE (ch # 0X) & (i < LEN(proc)) &
 141                                                                 ((ch >= "a") & (ch <= "z") OR (ch >= "A") & (ch <= "Z") OR
 142                                                                 (ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR
 143                                                                 (ch = "_") OR (ch >= "0") & (ch <= "9")) DO
 144                                                 id[j] := ch; INC(j); GetCh
 145                                         END;
 146                                         id[j] := 0X
 147                                 ELSE Error(syntaxError, "#System:SyntaxError", "", "")
 148                                 END
 149                         END
 150                 END Scan;
 151
 152                 PROCEDURE String (VAR s: ARRAY OF CHAR);
 153                         VAR j: INTEGER;
 154                 BEGIN
 155                         IF type = quote THEN
 156                                 j := 0;
 157                                 WHILE (ch # 0X) & (ch # "'") & (j < LEN(s) - 1) DO s[j] := ch; INC(j); GetCh END; s[j] := 0X;
 158                                 IF ch = "'" THEN
 159                                         GetCh; Scan
 160                                 ELSE Error(quoteExpected, "#System:QuoteExpected", "", "")
 161                                 END
 162                         ELSE Error(quoteExpected, "#System:QuoteExpected", "", "")
 163                         END
 164                 END String;
 165
 166                 PROCEDURE ParamList ();
 167                         VAR iv: IntValue; sv: StrValue;
 168                 BEGIN
 169                         numPar := 0;
 170                         IF type = lparen THEN Scan;
 171                                 WHILE (numPar < LEN(par)) & (type # rparen) & (res = 0) DO
 172                                         IF type = quote THEN
 173                                                 NEW(sv);
 174                                                 String(sv.str);
 175                                                 par[numPar] := sv;
 176                                                 INC(numPar)
 177                                         ELSIF type = int THEN
 178                                                 NEW(iv);
 179                                                 iv.int := x; Scan;
 180                                                 par[numPar] := iv;
 181                                                 INC(numPar)
 182                                         ELSE Error(syntaxError, "#System:SyntaxError", "", "")
 183                                         END;
 184                                         IF type = comma THEN Scan
 185                                         ELSIF type # rparen THEN Error(rparenExpected, "#System:RParenExpected", "", "")
 186                                         END
 187                                 END;
 188                                 Scan
 189                         END
 190                 END ParamList;
 191
 192                 PROCEDURE Command;
 193                         VAR left, right: Ident;
 194                 BEGIN
 195                         (* protect from parasitic anchors on stack *)
 196                         Init(left); Init(right);
 197                         left := id; Scan;
 198                         IF type = dot THEN      (* Oberon command *)
 199                                 Scan;
 200                                 IF type = ident THEN
 201                                         right := id; Scan; ParamList();
 202                                         CallProc(left, right)
 203                                 ELSE Error(identExpected, "#System:IdentExpected", "", "")
 204                                 END
 205                         ELSE Error(unknownIdent, "#System:UnknownIdent", id, "")
 206                         END
 207                 END Command;
 208
 209         BEGIN
 210                 (* protect from parasitic anchors on stack *)
 211                 i := 0; type := 0; Init(id); x := 0;
 212                 Views.ClearQueue;
 213                 res := 0; i := 0; GetCh;
 214                 Scan;
 215                 IF type = ident THEN
 216                         Command; WHILE (type = semicolon) & (res = 0) DO Scan; Command END;
 217                         IF type # eot THEN Error(syntaxError, "#System:SyntaxError", "", "") END
 218                 ELSE Error(syntaxError, "#System:SyntaxError", "", "")
 219                 END;
 220                 IF (res = 0) & (Views.Available() > 0) THEN
 221                         Error(noDepositExpected, "#System:NoDepositExpected", "", "")
 222                 END;
 223                 Views.ClearQueue
 224         END Call;
 225
 226         PROCEDURE Init;
 227                 VAR hook: CallHook;
 228         BEGIN
 229                 NEW(hook); Dialog.SetCallHook(hook)
 230         END Init;
 231
 232 BEGIN
 233         Init
 234 END StdInterpreter.