|
|
@@ -0,0 +1,710 @@
|
|
|
+(* Renamed for readability. Semantics unchanged. Original identifiers: see docs/compiler/ + src/compiler/RENAME-MAP.md. *)
|
|
|
+IMPLEMENTATION MODULE Scanner;
|
|
|
+IMPORT Compiler, Files, Texts, ComLine, Loader, Doubles, Errors, SymTab, CodeGen;
|
|
|
+IMPORT VarAddr;
|
|
|
+FROM SYSTEM IMPORT ADR, MOVE, CODE, TSIZE, BYTE, OVERFLOW, REALOVERFLOW;
|
|
|
+FROM STORAGE IMPORT ALLOCATE,MARK,RELEASE;
|
|
|
+
|
|
|
+VAR withScopeSave: RecordPtr;
|
|
|
+ tokenLength: CARDINAL;
|
|
|
+
|
|
|
+CONST FREEMARKER = 3AE3H;
|
|
|
+CONST EOT = 032C; DEL = 177C;
|
|
|
+CONST LINEFEED = 012C; TAB = 011C; CR = 015C;
|
|
|
+
|
|
|
+VAR stackLimit [0316H]: ADDRESS;
|
|
|
+VAR buffer [0080H]: ARRAY [0..127] OF CHAR;
|
|
|
+VAR bufIndex[006CH]: CARDINAL;
|
|
|
+VAR filePos [006EH]: CARDINAL;
|
|
|
+VAR column [0070H]: CARDINAL;
|
|
|
+VAR flag [0072H]: CARDINAL;
|
|
|
+
|
|
|
+CONST EXPECTED = " expected, but ";
|
|
|
+
|
|
|
+(* $[+ remove procedure names *)
|
|
|
+
|
|
|
+PROCEDURE ScannerError(param1: CARDINAL);
|
|
|
+BEGIN
|
|
|
+ Errors.ReportError(param1);
|
|
|
+END ScannerError;
|
|
|
+
|
|
|
+PROCEDURE ChangeFileExtension(VAR s: ARRAY OF CHAR; ext: Ext; b: BOOLEAN);
|
|
|
+VAR i: CARDINAL;
|
|
|
+BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < HIGH(s) - 3) AND (s[i] <> 0C) AND (s[i] <> '.') DO
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ IF b OR (s[i] <> '.') THEN
|
|
|
+ s[i] := '.';
|
|
|
+ MOVE(ADR(ext), ADR(s[i+1]), 3);
|
|
|
+ END;
|
|
|
+END ChangeFileExtension;
|
|
|
+
|
|
|
+PROCEDURE EnterModuleSymbol(param3: ARRAY OF CHAR; param1: CARDINAL): CARDINAL;
|
|
|
+VAR i: CARDINAL;
|
|
|
+ ptr : POINTER TO SymTab.Symbol;
|
|
|
+BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < SymTab.moduleCount) AND (SymTab.moduleTable^[i].name <> param3) DO
|
|
|
+ INC(i)
|
|
|
+ END;
|
|
|
+ ptr := ADR(SymTab.moduleTable^[i]);
|
|
|
+ IF i < SymTab.moduleCount THEN
|
|
|
+ IF ptr^.word <> param1 THEN Errors.ReportErrorWithText(12, ptr^.name) END;
|
|
|
+ ELSE
|
|
|
+ IF i > 15 THEN ScannerError(84) END;
|
|
|
+ ptr^.name := param3;
|
|
|
+ ptr^.word := param1;
|
|
|
+ INC(SymTab.moduleCount);
|
|
|
+ END;
|
|
|
+ RETURN i
|
|
|
+END EnterModuleSymbol;
|
|
|
+
|
|
|
+PROCEDURE Allocate(VAR a:ADDRESS; n:CARDINAL); (* was in Z80 code *)
|
|
|
+BEGIN
|
|
|
+ ALLOCATE(a, n);
|
|
|
+ RETURN;
|
|
|
+
|
|
|
+(* padding to compensate for length difference *)
|
|
|
+ n := n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n+n;
|
|
|
+ RETURN; RETURN;
|
|
|
+
|
|
|
+END Allocate;
|
|
|
+
|
|
|
+PROCEDURE GetStackMark(VAR param1: ADDRESS);
|
|
|
+BEGIN
|
|
|
+ param1 := stackLimit - 60;
|
|
|
+END GetStackMark;
|
|
|
+
|
|
|
+PROCEDURE CheckStackMark(param1: ADDRESS);
|
|
|
+BEGIN
|
|
|
+ stackLimit := param1 + 60;
|
|
|
+ param1^ := FREEMARKER;
|
|
|
+END CheckStackMark;
|
|
|
+
|
|
|
+(* proc 22: find identifier in keyword list *)
|
|
|
+PROCEDURE FindIdent(list: List; identifier: ADDRESS; caseInsensitive: BOOLEAN): RecordPtr;
|
|
|
+(* original was in Z80 code *)
|
|
|
+VAR current: T1;
|
|
|
+BEGIN
|
|
|
+ current := list^.first;
|
|
|
+ WHILE current <> NIL DO
|
|
|
+ IF StrCmp(identifier, current^.link1, caseInsensitive) THEN
|
|
|
+ RETURN ADDRESS(current)
|
|
|
+ END;
|
|
|
+ current := current^.link0;
|
|
|
+ END;
|
|
|
+ RETURN NIL;
|
|
|
+
|
|
|
+(* padding to compensate for different length *)
|
|
|
+ caseInsensitive := NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT
|
|
|
+ NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT NOT caseInsensitive
|
|
|
+END FindIdent;
|
|
|
+
|
|
|
+(* proc 23: original was in Z80 code, removed caseInsensitive comparison *)
|
|
|
+PROCEDURE StrCmp(ptr1, ptr2: StringPtr; caseInsensitive: BOOLEAN):BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ WHILE ptr1^[0] = ptr2^[0] DO
|
|
|
+ IF ptr1^[0] = 0C THEN RETURN TRUE END;
|
|
|
+ ptr1 := ADDRESS(ptr1)+1;
|
|
|
+ ptr2 := ADDRESS(ptr2)+1;
|
|
|
+ END;
|
|
|
+ RETURN FALSE;
|
|
|
+END StrCmp;
|
|
|
+
|
|
|
+(* StrLen: original was Z80 code *)
|
|
|
+PROCEDURE StrLen(VAR s: ARRAY OF CHAR): CARDINAL;
|
|
|
+VAR i: CARDINAL;
|
|
|
+BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (i < HIGH(s)) AND (s[i] # 0C) DO INC(i) END;
|
|
|
+ IF i # 0 THEN RETURN i END;
|
|
|
+ RETURN 1; (* never return a zero length *)
|
|
|
+END StrLen;
|
|
|
+
|
|
|
+PROCEDURE CopyStringToHeap(VAR a: ADDRESS; VAR s: ARRAY OF CHAR);
|
|
|
+VAR length: CARDINAL;
|
|
|
+BEGIN
|
|
|
+ length := StrLen(s);
|
|
|
+ Allocate(a, length+1);
|
|
|
+ MOVE(ADR(s), a, length);
|
|
|
+END CopyStringToHeap;
|
|
|
+
|
|
|
+PROCEDURE NewNode(n:CARDINAL):ADDRESS;
|
|
|
+VAR ptr: Compiler.RecordPtr;
|
|
|
+BEGIN
|
|
|
+ Allocate(ptr, 14);
|
|
|
+ ptr^.word4 := n;
|
|
|
+ RETURN ptr
|
|
|
+END NewNode;
|
|
|
+
|
|
|
+PROCEDURE NewSizedNode(n:CARDINAL):ADDRESS;
|
|
|
+VAR ptr: Compiler.RecordPtr;
|
|
|
+BEGIN
|
|
|
+ IF n <= 1 THEN Allocate(ptr, 14)
|
|
|
+ ELSIF n <= 6 THEN Allocate(ptr, 10)
|
|
|
+ ELSIF n <= 11 THEN Allocate(ptr, 12)
|
|
|
+ ELSE Allocate(ptr, 16)
|
|
|
+ END;
|
|
|
+ ptr^.word4 := n;
|
|
|
+ RETURN ptr
|
|
|
+END NewSizedNode;
|
|
|
+
|
|
|
+PROCEDURE MakeIdentifierNode(param1: CARDINAL): ADDRESS;
|
|
|
+VAR ptr : Compiler.RecordPtr;
|
|
|
+BEGIN
|
|
|
+ NeedIdentifier;
|
|
|
+ IF ADDRESS(scopeCursor) = SymTab.currentScope THEN Errors.ReportErrorWithText(1, tokenBuffer) END;
|
|
|
+ ptr := NewNode(param1);
|
|
|
+ CopyStringToHeap(ptr^.word1, tokenBuffer);
|
|
|
+ GetSym;
|
|
|
+ RETURN ptr
|
|
|
+END MakeIdentifierNode;
|
|
|
+
|
|
|
+PROCEDURE InsertSymbol(param1: SymTab.T1);
|
|
|
+BEGIN
|
|
|
+ IF FindIdent(ADR(SymTab.currentScope^.link1), param1^.link1, 9 IN scanOptions) # NIL THEN
|
|
|
+ Errors.ReportErrorWithText(1, param1^.link1^)
|
|
|
+ END;
|
|
|
+ param1^.link0 := SymTab.currentScope^.link1;
|
|
|
+ SymTab.currentScope^.link1 := param1;
|
|
|
+END InsertSymbol;
|
|
|
+
|
|
|
+PROCEDURE DeclareIdentifier(param1: CARDINAL): ADDRESS;
|
|
|
+VAR ptr: SymTab.T1;
|
|
|
+BEGIN
|
|
|
+ ptr := MakeIdentifierNode(param1);
|
|
|
+ ptr^.link0 := SymTab.currentScope^.link1;
|
|
|
+ SymTab.currentScope^.link1 := ptr;
|
|
|
+ RETURN ptr;
|
|
|
+END DeclareIdentifier;
|
|
|
+
|
|
|
+PROCEDURE OpenScope(a:ADDRESS; next: ADDRESS);
|
|
|
+BEGIN
|
|
|
+ Allocate(SymTab.currentScope, 14);
|
|
|
+ SymTab.currentScope^.w0 := a;
|
|
|
+ SymTab.currentScope^.link1 := next;
|
|
|
+END OpenScope;
|
|
|
+
|
|
|
+PROCEDURE WriteListingPrefix;
|
|
|
+VAR PipeChar[034EH]: CHAR;
|
|
|
+BEGIN
|
|
|
+ Texts.WriteLn(2);
|
|
|
+ IF listingEnabled
|
|
|
+ THEN Texts.WriteCard(2, CodeGen.nextEmitPos - codeSize, 4)
|
|
|
+ ELSE Texts.SetCol(2, 4)
|
|
|
+ END;
|
|
|
+ Texts.WriteChar(2, PipeChar);
|
|
|
+ Texts.WriteChar(2, ' ')
|
|
|
+END WriteListingPrefix;
|
|
|
+
|
|
|
+PROCEDURE EchoSourceChar;
|
|
|
+BEGIN
|
|
|
+ IF (ORD(curChar) + 1) MOD 256 > 32 THEN Texts.WriteChar(2, curChar); RETURN END;
|
|
|
+ IF curChar = LINEFEED THEN column := 0; WriteListingPrefix; RETURN END;
|
|
|
+ IF curChar = TAB THEN
|
|
|
+ REPEAT Texts.WriteChar(2," "); INC(column) UNTIL column MOD 8 = 0;
|
|
|
+ ELSIF (curChar < " ") AND (curChar # CR) THEN
|
|
|
+ Texts.WriteChar(2, "^");
|
|
|
+ Texts.WriteChar(2, CHR(ORD(curChar)+40H))
|
|
|
+ END;
|
|
|
+END EchoSourceChar;
|
|
|
+
|
|
|
+PROCEDURE RefillBuffer;
|
|
|
+VAR nbRead: CARDINAL;
|
|
|
+BEGIN
|
|
|
+ nbRead := Files.ReadBytes(sourceFile, ADR(buffer), 128);
|
|
|
+ IF nbRead < 128 THEN buffer[nbRead] := EOT END;
|
|
|
+ bufIndex := 0;
|
|
|
+ NextChar
|
|
|
+END RefillBuffer;
|
|
|
+
|
|
|
+PROCEDURE InitScanner;
|
|
|
+BEGIN
|
|
|
+ curChar := ' ';
|
|
|
+ column := 0;
|
|
|
+ bufIndex := 128;
|
|
|
+ IF 0 IN scanOptions THEN WriteListingPrefix END;
|
|
|
+ Files.NoTrailer(sourceFile)
|
|
|
+END InitScanner;
|
|
|
+
|
|
|
+PROCEDURE OpenSourceFile;
|
|
|
+VAR nbRead: CARDINAL;
|
|
|
+BEGIN
|
|
|
+ IF NOT Files.Open(sourceFile, ComLine.inName) THEN HALT END;
|
|
|
+ InitScanner;
|
|
|
+ Files.SetPos(sourceFile, LONG((tokenPos DIV 128) * 128));
|
|
|
+ nbRead := Files.ReadBytes(sourceFile, ADR(buffer), 128);
|
|
|
+ bufIndex := tokenPos MOD 128;
|
|
|
+ filePos := tokenPos;
|
|
|
+ GetSym
|
|
|
+END OpenSourceFile;
|
|
|
+
|
|
|
+PROCEDURE NextChar; (* original was in Z80 code *)
|
|
|
+VAR ch: CHAR;
|
|
|
+BEGIN
|
|
|
+ IF bufIndex = 128 THEN RefillBuffer
|
|
|
+ ELSE
|
|
|
+ ch := buffer[bufIndex];
|
|
|
+ INC(bufIndex);
|
|
|
+ IF ch = EOT THEN curChar := 377C ELSE curChar := ch END;
|
|
|
+ INC(filePos);
|
|
|
+ IF 0 IN scanOptions THEN
|
|
|
+ IF ch >= ' ' THEN
|
|
|
+ INC(column);
|
|
|
+ IF flag # 0 THEN
|
|
|
+ Texts.WriteChar(3, ch);
|
|
|
+ RETURN; RETURN; (* padding *)
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ EchoSourceChar
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ RETURN;
|
|
|
+(* padding to compensate for smaller length *)
|
|
|
+ INC(ch); INC(ch); INC(ch); INC(ch); INC(ch); INC(ch);
|
|
|
+ INC(ch); INC(ch); INC(ch); INC(ch); RETURN; RETURN; RETURN; RETURN;
|
|
|
+END NextChar;
|
|
|
+
|
|
|
+PROCEDURE GetSym;
|
|
|
+(* $[- keep procedure names *)
|
|
|
+
|
|
|
+ (* proc 35 *)
|
|
|
+ PROCEDURE ParseNumber;
|
|
|
+ VAR local2: CARDINAL;
|
|
|
+ VAR local3: CARDINAL;
|
|
|
+ VAR local4: CARDINAL;
|
|
|
+ VAR local5: CARDINAL;
|
|
|
+ VAR local6: CARDINAL;
|
|
|
+ VAR local7: INTEGER;
|
|
|
+ VAR local8: BOOLEAN;
|
|
|
+ VAR local9 : BOOLEAN;
|
|
|
+ VAR local10: BOOLEAN;
|
|
|
+ VAR local12: LONGINT;
|
|
|
+ VAR local14: LONGINT;
|
|
|
+ VAR local16: LONGINT;
|
|
|
+ VAR local18: LONGINT;
|
|
|
+
|
|
|
+ (* $[+ remove procedure names *)
|
|
|
+
|
|
|
+ (* proc 36 *)
|
|
|
+ PROCEDURE Power10(exp: CARDINAL): REAL;
|
|
|
+ VAR n: CARDINAL;
|
|
|
+ VAR r: REAL;
|
|
|
+ BEGIN
|
|
|
+ n := 0;
|
|
|
+ r := 1.0;
|
|
|
+ REPEAT
|
|
|
+ IF ODD(exp) THEN
|
|
|
+ CASE n OF
|
|
|
+ | 0 : r := r * 1.0E01
|
|
|
+ | 1 : r := r * 1.0E02
|
|
|
+ | 2 : r := r * 1.0E04
|
|
|
+ | 3 : r := r * 1.0E08
|
|
|
+ | 4 : r := r * 1.0E16
|
|
|
+ | 5 : r := r * 1.0E32
|
|
|
+ ELSE RAISE REALOVERFLOW
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ exp := exp DIV 2;
|
|
|
+ INC(n);
|
|
|
+ UNTIL exp = 0;
|
|
|
+ RETURN r
|
|
|
+ END Power10;
|
|
|
+
|
|
|
+ PROCEDURE AccumulateDigit;
|
|
|
+ VAR digit: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ IF tokenLength < 128 THEN tokenBuffer[tokenLength] := curChar; INC(tokenLength) END;
|
|
|
+ NextChar;
|
|
|
+ digit := ORD(curChar) - ORD('0');
|
|
|
+ IF digit > 9 THEN
|
|
|
+ IF digit >= 17 THEN digit := digit - 7 ELSE digit := 16 END;
|
|
|
+ END; (* 043C *)
|
|
|
+ local4 := digit
|
|
|
+ END AccumulateDigit;
|
|
|
+
|
|
|
+ (* $[- keep procedure names *)
|
|
|
+ BEGIN (* ParseNumber *)
|
|
|
+ local2 := 0;
|
|
|
+ local12 := LONG(0);
|
|
|
+ local7 := 0;
|
|
|
+ local18 := local12;
|
|
|
+ local16 := local12;
|
|
|
+ local14 := local12;
|
|
|
+ tokenLength:= 0;
|
|
|
+ local4 := ORD(curChar) - ORD('0');
|
|
|
+ local5 := local4;
|
|
|
+ local10 := TRUE;
|
|
|
+ local9 := TRUE;
|
|
|
+ REPEAT
|
|
|
+ IF local5 > 7 THEN
|
|
|
+ local10 := FALSE;
|
|
|
+ IF local5 > 9 THEN local9 := FALSE END;
|
|
|
+ END;
|
|
|
+ IF local4 <= 9 THEN
|
|
|
+ local14 := local14 * LONG(10) + LONG(local4);
|
|
|
+ IF local14 < 3355443L THEN local12 := local14 ELSE INC(local7) END;
|
|
|
+ IF local4 <= 7 THEN local16 := local16 * LONG(8) + LONG(local4) END;
|
|
|
+ END; (* 04b1 *)
|
|
|
+ IF local18 <= LONG(65535) THEN local18 := local18 * LONG(16) + LONG(local4) END;
|
|
|
+ local5 := local4;
|
|
|
+ AccumulateDigit;
|
|
|
+ UNTIL local4 > 15;
|
|
|
+ literalType := Compiler.CardType;
|
|
|
+ IF curChar = '.' THEN
|
|
|
+ AccumulateDigit;
|
|
|
+ IF curChar = '.' THEN curChar := DEL; DEC(tokenLength)
|
|
|
+ ELSIF curChar = ')' THEN curChar := ']'; DEC(tokenLength)
|
|
|
+ ELSE
|
|
|
+ IF NOT local9 THEN ScannerError(30) END;
|
|
|
+ literalType := Compiler.RealType;
|
|
|
+ WHILE local4 <= 9 DO
|
|
|
+ IF local12 < 3355443L THEN
|
|
|
+ local12 := local12 * LONG(10) + LONG(local4);
|
|
|
+ DEC(local7)
|
|
|
+ END; (* 0527 *)
|
|
|
+ AccumulateDigit;
|
|
|
+ END; (* 052B *)
|
|
|
+ IF local4 IN {13, 14} THEN
|
|
|
+ IF local4 = 13 THEN literalType := Compiler.LongrealType END;
|
|
|
+ local3 := 0;
|
|
|
+ AccumulateDigit;
|
|
|
+ local8 := (curChar = '-');
|
|
|
+ IF local8 OR (curChar = '+') THEN AccumulateDigit END;
|
|
|
+ IF local4 > 9 THEN ScannerError(30) END;
|
|
|
+ REPEAT
|
|
|
+ IF local3 < 255 THEN local3 := local3 * 10 + local4 END;
|
|
|
+ AccumulateDigit;
|
|
|
+ UNTIL local4 > 9;
|
|
|
+ IF local8
|
|
|
+ THEN DEC(local7, local3)
|
|
|
+ ELSE INC(local7, local3)
|
|
|
+ END;
|
|
|
+ END; (* 0577 *)
|
|
|
+ IF literalType = Compiler.RealType THEN
|
|
|
+ IF local12 >= 16777216L
|
|
|
+ THEN realValue := FLOAT((local12 + LONG(1)) DIV LONG(2)) * 2.0
|
|
|
+ ELSE realValue := FLOAT(local12)
|
|
|
+ END;
|
|
|
+ IF local7 < 0 THEN realValue := realValue / Power10(-local7)
|
|
|
+ ELSIF local7 # 0 THEN realValue := realValue * Power10(local7)
|
|
|
+ END;
|
|
|
+ ELSE
|
|
|
+ tokenBuffer[tokenLength] := 0C;
|
|
|
+ IF NOT Doubles.StrToDouble(tokenBuffer, longrealValue) THEN ScannerError(74) END;
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ END; (* 05D4 *)
|
|
|
+ IF literalType^.word4 # 8 THEN
|
|
|
+ IF curChar = 'L' THEN
|
|
|
+ AccumulateDigit;
|
|
|
+ realValue := REAL(local14);
|
|
|
+ literalType := Compiler.LongintType;
|
|
|
+ ELSE
|
|
|
+ local6 := 65535;
|
|
|
+ IF curChar = 'H' THEN AccumulateDigit; local12 := local18
|
|
|
+ ELSE
|
|
|
+ IF local5 IN {11, 12} THEN
|
|
|
+ IF NOT local10 THEN ScannerError(30) END;
|
|
|
+ local12 := local16;
|
|
|
+ IF local5 = 12 THEN literalType := Compiler.CharType; local6 := 255 END;
|
|
|
+ ELSE
|
|
|
+ IF NOT local9 OR (local5 > 9) THEN ScannerError(30) END;
|
|
|
+ local12 := local14;
|
|
|
+ END;
|
|
|
+ END; (* 062e *)
|
|
|
+ IF local12 > LONG(local6) THEN ScannerError(73) END;
|
|
|
+ cardValue := CARD(local12);
|
|
|
+ END;
|
|
|
+ END; (* 063f *)
|
|
|
+ IF charClassTable^[ORD(curChar)] = 10 THEN ScannerError(30) END;
|
|
|
+ EXCEPTION
|
|
|
+ | OVERFLOW: ScannerError(73)
|
|
|
+ | REALOVERFLOW:
|
|
|
+ IF local7 >= 0 THEN ScannerError(74) END;
|
|
|
+ realValue := REAL(0L);
|
|
|
+ END ParseNumber;
|
|
|
+
|
|
|
+(* $[+ remove procedure names *)
|
|
|
+ PROCEDURE SkipComment;
|
|
|
+ VAR local2: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ REPEAT
|
|
|
+ REPEAT
|
|
|
+ IF curChar = CHR(255) THEN ScannerError(29) END;
|
|
|
+ NextChar;
|
|
|
+ IF curChar = '(' THEN
|
|
|
+ REPEAT NextChar UNTIL curChar # '(';
|
|
|
+ IF curChar = '*' THEN SkipComment END; (* recursive call *)
|
|
|
+ END;
|
|
|
+ IF curChar = '$' THEN
|
|
|
+ NextChar;
|
|
|
+ local2 := CARDINAL(BITSET(curChar) * {0,1,2,3,4,6}) - ORD('L');
|
|
|
+ IF local2 <= 15 THEN
|
|
|
+ NextChar;
|
|
|
+ IF curChar = '-' THEN EXCL(scanOptions, local2)
|
|
|
+ ELSIF curChar = '+' THEN INCL(scanOptions, local2)
|
|
|
+ END;
|
|
|
+ IF local2 = 0 THEN Texts.WriteLn(2) END;
|
|
|
+ END;
|
|
|
+ END; (* 06c6 *)
|
|
|
+ UNTIL curChar = '*';
|
|
|
+ REPEAT NextChar UNTIL curChar # '*';
|
|
|
+ UNTIL curChar = ')';
|
|
|
+ END SkipComment;
|
|
|
+
|
|
|
+ PROCEDURE ScanNextToken():BOOLEAN; (* original was in Z80 code *)
|
|
|
+ VAR i: CARDINAL;
|
|
|
+ VAR local3: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ isLiteral := FALSE;
|
|
|
+ identKind := 7;
|
|
|
+ WHILE curChar <= ' ' DO NextChar END;
|
|
|
+ tokenPos := filePos - 1;
|
|
|
+ tokenColumn := column;
|
|
|
+ IF curChar < CHR(128)
|
|
|
+ THEN curSymbol := charClassTable^[ORD(curChar)]
|
|
|
+ ELSE curSymbol := 0
|
|
|
+ END;
|
|
|
+ IF curSymbol = 10 THEN
|
|
|
+ i := 0;
|
|
|
+ REPEAT
|
|
|
+ IF i # 128 THEN tokenBuffer[i] := curChar; INC(i) END;
|
|
|
+ NextChar;
|
|
|
+ local3 := charClassTable^[ORD(curChar)];
|
|
|
+ UNTIL (local3 # 10) AND (local3 # 11);
|
|
|
+ tokenBuffer[i] := 0C;
|
|
|
+ RETURN TRUE
|
|
|
+ END; (* 0730 *)
|
|
|
+ RETURN FALSE;
|
|
|
+ (* padding to compensate for smaller code *)
|
|
|
+ i := i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i+i
|
|
|
+ END ScanNextToken;
|
|
|
+
|
|
|
+VAR local2: BOOLEAN;
|
|
|
+ local3: CARDINAL;
|
|
|
+ local4: BOOLEAN;
|
|
|
+ local5: CHAR;
|
|
|
+BEGIN
|
|
|
+ REPEAT
|
|
|
+ IF ScanNextToken() THEN
|
|
|
+ local4 := 9 IN scanOptions;
|
|
|
+ curSymbol := keywordHashFunc(ADR(tokenBuffer), local4);
|
|
|
+ IF curSymbol # 0 THEN
|
|
|
+ identKind := 7;
|
|
|
+ IF ((curSymbol = 14) OR (curSymbol = 39)) AND NOT (12 IN scanOptions) THEN
|
|
|
+ Errors.AskContinue(2)
|
|
|
+ END;
|
|
|
+ RETURN
|
|
|
+ END; (* 0797 *)
|
|
|
+ scopeCursor := ADDRESS(SymTab.currentScope);
|
|
|
+ REPEAT
|
|
|
+ curNode := FindIdent(ADR(scopeCursor^.link1), ADR(tokenBuffer), local4);
|
|
|
+ IF curNode # NIL THEN
|
|
|
+ literalType := ADDRESS(curNode^.word2);
|
|
|
+ identKind := curNode^.word4;
|
|
|
+ followSet := curNode^.word3;
|
|
|
+ RETURN
|
|
|
+ END;
|
|
|
+ scopeCursor := scopeCursor^.link0;
|
|
|
+ UNTIL scopeCursor = NIL;
|
|
|
+ identKind := 0;
|
|
|
+ RETURN
|
|
|
+ END; (* 07BA *)
|
|
|
+ local2 := TRUE;
|
|
|
+ CASE curSymbol OF
|
|
|
+ | 0 : ScannerError(31 - ORD(curChar = CHR(255)) * 2)
|
|
|
+ | 2 : NextChar;
|
|
|
+ IF curChar = '=' THEN curSymbol := 27; NextChar
|
|
|
+ ELSIF curChar = ')' THEN curSymbol := 7; NextChar
|
|
|
+ END;
|
|
|
+ | 3 : NextChar;
|
|
|
+ IF curChar = '.' THEN curSymbol := 4; NextChar
|
|
|
+ ELSIF curChar = ')' THEN curSymbol := 6; NextChar
|
|
|
+ END;
|
|
|
+ |11 : isLiteral := TRUE;
|
|
|
+ identKind := 1;
|
|
|
+ curSymbol := 0;
|
|
|
+ ParseNumber;
|
|
|
+ tokenBuffer[tokenLength] := 0C
|
|
|
+ |12 : local3 := 0;
|
|
|
+ isLiteral := TRUE;
|
|
|
+ identKind := 1;
|
|
|
+ curSymbol := 0;
|
|
|
+ local5 := curChar;
|
|
|
+ NextChar;
|
|
|
+ WHILE curChar # local5 DO
|
|
|
+ IF curChar = LINEFEED THEN ScannerError(28) END;
|
|
|
+ IF curChar = CHR(255) THEN ScannerError(29) END;
|
|
|
+ IF local3 < 128 THEN
|
|
|
+ tokenBuffer[local3] := curChar;
|
|
|
+ INC(local3);
|
|
|
+ END;
|
|
|
+ NextChar;
|
|
|
+ END; (* 0839 *)
|
|
|
+ tokenBuffer[local3] := 0C;
|
|
|
+ NextChar;
|
|
|
+ literalType := Compiler.charArrayDesc;
|
|
|
+ IF local3 = 1 THEN
|
|
|
+ literalType := Compiler.CharType;
|
|
|
+ cardValue := ORD(tokenBuffer[0]);
|
|
|
+ END;
|
|
|
+ ELSE
|
|
|
+ NextChar;
|
|
|
+ CASE curSymbol OF
|
|
|
+ | 43: IF curChar = '*' THEN SkipComment; NextChar; local2 := FALSE
|
|
|
+ ELSIF curChar = '.' THEN curSymbol := 44; NextChar
|
|
|
+ ELSIF curChar = ':' THEN curSymbol := 45; NextChar
|
|
|
+ END;
|
|
|
+ | 54: IF curChar = '=' THEN curSymbol := 56; NextChar
|
|
|
+ ELSIF curChar = '>' THEN curSymbol := 53; NextChar
|
|
|
+ END;
|
|
|
+ | 55: IF curChar = '=' THEN curSymbol := 57; NextChar END;
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ UNTIL local2;
|
|
|
+END GetSym;
|
|
|
+
|
|
|
+PROCEDURE AcceptSymbol(param1: CARDINAL): BOOLEAN;
|
|
|
+BEGIN
|
|
|
+ IF curSymbol = param1 THEN GetSym; RETURN TRUE END;
|
|
|
+ RETURN FALSE
|
|
|
+END AcceptSymbol;
|
|
|
+
|
|
|
+PROCEDURE PushWithScope;
|
|
|
+BEGIN
|
|
|
+ IF identKind = 6 THEN
|
|
|
+ withScopeSave^.word1 := ADDRESS(curNode^.high);
|
|
|
+ withScopeSave^.word0 := ADDRESS(SymTab.currentScope);
|
|
|
+ SymTab.currentScope := ADDRESS(withScopeSave);
|
|
|
+ GetSym;
|
|
|
+ ExpectSymbol(3);
|
|
|
+ NeedIdentifier;
|
|
|
+ IF scopeCursor # ADDRESS(withScopeSave) THEN Errors.ReportErrorWithText(3, tokenBuffer) END;
|
|
|
+ SymTab.currentScope := SymTab.currentScope^.w0;
|
|
|
+ END;
|
|
|
+END PushWithScope;
|
|
|
+
|
|
|
+PROCEDURE ExpectSymbol(param1:CARDINAL);
|
|
|
+VAR local2: BITSET;
|
|
|
+VAR local3: CARDINAL;
|
|
|
+BEGIN
|
|
|
+ IF curSymbol = param1 THEN GetSym; RETURN END;
|
|
|
+ local3 := 0;
|
|
|
+ local2 := {};
|
|
|
+ IF param1 >= 51 THEN local3 := 51
|
|
|
+ ELSIF param1 >= 40 THEN local3 := 40
|
|
|
+ ELSIF param1 >= 27 THEN local3 := 27
|
|
|
+ ELSIF param1 >= 13 THEN local3 := 13
|
|
|
+ END;
|
|
|
+ local2 := local2 + {param1 - local3};
|
|
|
+ Errors.ReportExpectedSet(local2, local3)
|
|
|
+END ExpectSymbol;
|
|
|
+
|
|
|
+PROCEDURE TestSymbolInSet(param1: BITSET);
|
|
|
+BEGIN
|
|
|
+ IF NOT (curSymbol IN param1) THEN Errors.ReportExpectedSet(param1, 0) END;
|
|
|
+END TestSymbolInSet;
|
|
|
+
|
|
|
+PROCEDURE TestSymbolRange40(param1: BITSET);
|
|
|
+BEGIN
|
|
|
+ IF NOT ((curSymbol-40) IN param1) THEN Errors.ReportExpectedSet(param1, 40) END;
|
|
|
+END TestSymbolRange40;
|
|
|
+
|
|
|
+PROCEDURE TestSymbolRange13(param1: BITSET);
|
|
|
+BEGIN
|
|
|
+ IF NOT ((curSymbol-13) IN param1) THEN Errors.ReportExpectedSet(param1, 13) END;
|
|
|
+END TestSymbolRange13;
|
|
|
+
|
|
|
+PROCEDURE NeedIdentifier;
|
|
|
+BEGIN
|
|
|
+ IF (identKind = 7) OR isLiteral THEN
|
|
|
+ Errors.ShowErrorPosition('A');
|
|
|
+ Texts.WriteString(3, "Identifier");
|
|
|
+ Texts.WriteString(3, EXPECTED);
|
|
|
+ Errors.Allocate;
|
|
|
+ Errors.AskEditOrQuit;
|
|
|
+ END;
|
|
|
+END NeedIdentifier;
|
|
|
+
|
|
|
+PROCEDURE ExpectStringLiteral(VAR param2: ARRAY OF CHAR);
|
|
|
+BEGIN
|
|
|
+ NeedIdentifier;
|
|
|
+ IF StrCmp(ADR(tokenBuffer), ADR(param2), 9 IN scanOptions) THEN GetSym; RETURN END;
|
|
|
+ Errors.ReportErrorWithText(9, param2);
|
|
|
+END ExpectStringLiteral;
|
|
|
+
|
|
|
+PROCEDURE ExpectIdentKind(param1: CARDINAL);
|
|
|
+BEGIN
|
|
|
+ IF identKind # param1 THEN
|
|
|
+ NeedIdentifier;
|
|
|
+ IF identKind = 0 THEN Errors.ReportErrorWithText(0, tokenBuffer) END;
|
|
|
+ Errors.ShowErrorPosition('B');
|
|
|
+ Errors.WriteKindName(param1);
|
|
|
+ Texts.WriteString(3, EXPECTED);
|
|
|
+ Errors.WriteKindName(identKind);
|
|
|
+ Texts.WriteString(3, " found");
|
|
|
+ Errors.AskEditOrQuit;
|
|
|
+ END;
|
|
|
+END ExpectIdentKind;
|
|
|
+
|
|
|
+PROCEDURE Compile;
|
|
|
+
|
|
|
+ (* Z80 proc 40 removed, replaced by a MCode one in module VarAddr *)
|
|
|
+ (*
|
|
|
+ PROCEDURE VarAddress(VAR v: WORD):ADDRESS;
|
|
|
+ CODE("Z80RET")
|
|
|
+ END VarAddress;
|
|
|
+ *)
|
|
|
+
|
|
|
+VAR addr: ADDRESS;
|
|
|
+ ptr [006EH]: CARDINAL;
|
|
|
+ console [0072H]: BOOLEAN;
|
|
|
+ jmpOpcode [0074H]: CARDINAL;
|
|
|
+ jmpAddress[0075H]: CARDINAL;
|
|
|
+
|
|
|
+(* $[- keep procedure names *)
|
|
|
+
|
|
|
+BEGIN
|
|
|
+ jmpOpcode := 0C3H;
|
|
|
+ addr := VarAddr.ADR(scanOptions)-6;
|
|
|
+ addr := ADDRESS(addr^) - 4;
|
|
|
+ jmpAddress:= addr + CARDINAL(addr^) + 3;
|
|
|
+ MARK(addr);
|
|
|
+ ptr := 0;
|
|
|
+ console := (ComLine.outName = "CON:");
|
|
|
+ listingEnabled := FALSE;
|
|
|
+ tokenPos := 0;
|
|
|
+ Allocate(withScopeSave, 14);
|
|
|
+ Compiler.InitCompiler;
|
|
|
+ IF sourceFile <> NIL THEN
|
|
|
+ Allocate(codeBuffer, 4096);
|
|
|
+ Loader.Call("COMPILE");
|
|
|
+ IF Compiler.nativeCodeRequested THEN
|
|
|
+ CheckStackMark(codeBuffer + CodeGen.nextEmitPos);
|
|
|
+ IF CodeGen.windowBase <> 0 THEN
|
|
|
+ MOVE(codeBuffer, codeBuffer + CodeGen.windowBase, CodeGen.nextEmitPos - CodeGen.windowBase);
|
|
|
+ Files.SetPos(codeFile, LONG(0));
|
|
|
+ IF Files.ReadBytes(codeFile, codeBuffer, CodeGen.windowBase) <> CodeGen.windowBase THEN
|
|
|
+ RAISE Files.EndError
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ Files.SetPos(codeFile, LONG(0));
|
|
|
+ Loader.Call("GENZ80");
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ Texts.CloseText(Texts.output);
|
|
|
+ RELEASE(addr);
|
|
|
+
|
|
|
+EXCEPTION Loader.LoadError:
|
|
|
+ Texts.WriteLn(3); (* console *)
|
|
|
+ Texts.WriteString(3,"ERROR: CANNOT LOAD OVERLAY");
|
|
|
+ Texts.WriteLn(3);
|
|
|
+ Files.Delete(codeFile);
|
|
|
+ RELEASE(addr)
|
|
|
+END Compile;
|
|
|
+
|
|
|
+(* $[+ remove procedure names *)
|
|
|
+END Scanner.
|