blackbox-linux-console/BlackBox/Std/Mod/Interpreter.txt

MODULE StdInterpreter;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Interpreter.odc *)
	(* DO NOT EDIT *)

	IMPORT Kernel, Meta, Strings, Views, Dialog;

	TYPE
		IntValue = POINTER TO RECORD (Meta.Value)
			int: INTEGER;
		END;
		StrValue = POINTER TO RECORD (Meta.Value)
			str: Dialog.String;
		END;
		CallHook = POINTER TO RECORD (Dialog.CallHook) END;

		
	PROCEDURE (hook: CallHook) Call (IN proc, errorMsg: ARRAY OF CHAR; VAR res: INTEGER);
		TYPE Ident = ARRAY 32 OF CHAR;
		CONST
			modNotFound = 10; procNotFound = 11; identExpected = 12; unknownIdent = 13;
			depositExpected = 14; noDepositExpected = 15; syntaxError = 16;
			lparenExpected = 17; rparenExpected = 18; containerExpected = 19; quoteExpected = 20;
			fileNotFound = 21; noController = 22; noDialog = 23; cannotUnload = 24; commaExpected = 25;
			incompParList = 26;
		CONST
			 ident = 0; dot = 1; semicolon = 2; eot = 3; lparen = 4; rparen = 5; quote = 6; comma = 7; int = 8;
		VAR
			i, type: INTEGER; ch: CHAR; id: Ident; x: INTEGER;
			par: ARRAY 100 OF POINTER TO Meta.Value; numPar: INTEGER;
			
		PROCEDURE Concat (a, b: ARRAY OF CHAR; VAR c: ARRAY OF CHAR);
			VAR i, j: INTEGER; ch: CHAR;
		BEGIN
			IF a = " " THEN Dialog.MapString("#System:CommandError", c) ELSE c := a$ END;
			i := 0; WHILE c[i] # 0X DO INC(i) END;
			c[i] := " "; INC(i);
			j := 0; ch := b[0]; WHILE ch # 0X DO c[i] := ch; INC(i); INC(j); ch := b[j] END;
			c[i] := 0X
		END Concat;

		PROCEDURE Error (n: INTEGER; msg, par0, par1: ARRAY OF CHAR);
			VAR e, f: ARRAY 256 OF CHAR;
		BEGIN
			IF res = 0 THEN
				res := n;
				IF errorMsg # "" THEN
					Dialog.MapString(errorMsg, e);
					Dialog.MapParamString(msg, par0, par1, "", f);
					Concat(e, f, f);
					Dialog.ShowMsg(f)
				END
			END
		END Error;
		
		PROCEDURE Init (VAR s: ARRAY OF CHAR);
			VAR i: INTEGER;
		BEGIN
			i := 0; WHILE i < LEN(s) DO s[i] := 0X; INC(i) END
		END Init;
		
		PROCEDURE ShowLoaderResult (IN mod: ARRAY OF CHAR);
			VAR res: INTEGER; importing, imported, object: ARRAY 256 OF CHAR;
		BEGIN
			Kernel.GetLoaderResult(res, importing, imported, object);
			CASE res OF
			| Kernel.fileNotFound:
				Error(Kernel.fileNotFound, "#System:CodeFileNotFound", imported, "")
			| Kernel.syntaxError:
				Error(Kernel.syntaxError, "#System:CorruptedCodeFileFor", imported, "")
			| Kernel.objNotFound:
				Error(Kernel.objNotFound, "#System:ObjNotFoundImpFrom", imported, importing)
			| Kernel.illegalFPrint:
				Error(Kernel.illegalFPrint, "#System:ObjInconsImpFrom", imported, importing)
			| Kernel.cyclicImport:
				Error(Kernel.cyclicImport, "#System:CyclicImpFrom", imported, importing)
			| Kernel.noMem:
				Error(Kernel.noMem, "#System:NotEnoughMemoryFor", imported, "")
			ELSE
				Error(res, "#System:CannotLoadModule", mod, "")
			END
		END ShowLoaderResult;

		PROCEDURE CallProc (IN mod, proc: ARRAY OF CHAR);
			VAR i, t: Meta.Item; ok: BOOLEAN;
		BEGIN
			ok := FALSE;
			Meta.Lookup(mod, i);
			IF i.obj = Meta.modObj THEN
				i.Lookup(proc, i);
				IF i.obj = Meta.procObj THEN
					i.GetReturnType(t);
					IF (t.typ = 0) & (i.NumParam() = numPar) THEN
						i.ParamCallVal(par, t, ok)
					ELSE ok := FALSE
					END;
					IF ~ok THEN
						Error(incompParList, "#System:IncompatibleParList", mod, proc)
					END
				ELSE
					Error(Kernel.commNotFound, "#System:CommandNotFoundIn", proc, mod)
				END
			ELSE
				ShowLoaderResult(mod)
			END
		END CallProc;

		PROCEDURE GetCh;
		BEGIN
			IF i < LEN(proc) THEN ch := proc[i]; INC(i) ELSE ch := 0X END
		END GetCh;

		PROCEDURE Scan;
			VAR j: INTEGER; num: ARRAY 32 OF CHAR; r: INTEGER;
		BEGIN
			IF res = 0 THEN
				WHILE (ch # 0X) & (ch <= " ") DO GetCh END;
				IF ch = 0X THEN
					type := eot
				ELSIF ch = "." THEN
					type := dot; GetCh
				ELSIF ch = ";" THEN
					type := semicolon; GetCh
				ELSIF ch = "(" THEN
					type := lparen; GetCh
				ELSIF ch = ")" THEN
					type := rparen; GetCh
				ELSIF ch = "'" THEN
					type := quote; GetCh
				ELSIF ch = "," THEN
					type := comma; GetCh
				ELSIF (ch >= "0") & (ch <= "9") OR (ch = "-") THEN
					type := int; j := 0;
					REPEAT num[j] := ch; INC(j); GetCh UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "H");
					num[j] := 0X; Strings.StringToInt(num, x, r)
				ELSIF (ch >= "a") & (ch <= "z") OR (ch >= "A") & (ch <= "Z") OR
						(ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR (ch = "_") THEN
					type := ident;
					id[0] := ch; j := 1; GetCh;
					WHILE (ch # 0X) & (i < LEN(proc)) &
								((ch >= "a") & (ch <= "z") OR (ch >= "A") & (ch <= "Z") OR
								(ch >= 0C0X) & (ch # "×") & (ch # "÷") & (ch <= 0FFX) OR
								(ch = "_") OR (ch >= "0") & (ch <= "9")) DO
						id[j] := ch; INC(j); GetCh
					END;
					id[j] := 0X
				ELSE Error(syntaxError, "#System:SyntaxError", "", "")
				END
			END
		END Scan;
		
		PROCEDURE String (VAR s: ARRAY OF CHAR);
			VAR j: INTEGER;
		BEGIN
			IF type = quote THEN
				j := 0;
				WHILE (ch # 0X) & (ch # "'") & (j < LEN(s) - 1) DO s[j] := ch; INC(j); GetCh END; s[j] := 0X;
				IF ch = "'" THEN
					GetCh; Scan
				ELSE Error(quoteExpected, "#System:QuoteExpected", "", "")
				END
			ELSE Error(quoteExpected, "#System:QuoteExpected", "", "")
			END
		END String;

		PROCEDURE ParamList ();
			VAR iv: IntValue; sv: StrValue;
		BEGIN
			numPar := 0;
			IF type = lparen THEN Scan;
				WHILE (numPar < LEN(par)) & (type # rparen) & (res = 0) DO
					IF type = quote THEN
						NEW(sv);
						String(sv.str);
						par[numPar] := sv;
						INC(numPar)
					ELSIF type = int THEN
						NEW(iv);
						iv.int := x; Scan;
						par[numPar] := iv;
						INC(numPar)
					ELSE Error(syntaxError, "#System:SyntaxError", "", "")
					END;
					IF type = comma THEN Scan
					ELSIF type # rparen THEN Error(rparenExpected, "#System:RParenExpected", "", "")
					END
				END;
				Scan
			END
		END ParamList;

		PROCEDURE Command;
			VAR left, right: Ident;
		BEGIN
			(* protect from parasitic anchors on stack *)
			Init(left); Init(right);
			left := id; Scan;
			IF type = dot THEN	(* Oberon command *)
				Scan;
				IF type = ident THEN
					right := id; Scan; ParamList();
					CallProc(left, right)
				ELSE Error(identExpected, "#System:IdentExpected", "", "")
				END
			ELSE Error(unknownIdent, "#System:UnknownIdent", id, "")
			END
		END Command;

	BEGIN
		(* protect from parasitic anchors on stack *)
		i := 0; type := 0; Init(id); x := 0;
		Views.ClearQueue;
		res := 0; i := 0; GetCh;
		Scan;
		IF type = ident THEN
			Command; WHILE (type = semicolon) & (res = 0) DO Scan; Command END;
			IF type # eot THEN Error(syntaxError, "#System:SyntaxError", "", "") END
		ELSE Error(syntaxError, "#System:SyntaxError", "", "")
		END;
		IF (res = 0) & (Views.Available() > 0) THEN
			Error(noDepositExpected, "#System:NoDepositExpected", "", "")
		END;
		Views.ClearQueue
	END Call;
	
	PROCEDURE Init;
		VAR hook: CallHook;
	BEGIN
		NEW(hook); Dialog.SetCallHook(hook)
	END Init;

BEGIN
	Init
END StdInterpreter.