KolibriOS/oberon-07-compiler
16
0 Fork 0
mirror of https://github.com/AntKrotov/oberon-07-compiler.git synced 2026-10-05 09:45:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

скорость компиляции увеличена на ~15%

Browse Source
This commit is contained in:
AntKrotov committed 2021-02-04 00:23:34 +03:00
1 parent 2d4f06e5ab
commit 0d435b9349
10 files changed
+251 -246
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

Compiler
BIN
View File
Binary file not shown.
Compiler.exe
BIN
View File
Binary file not shown.
source/ARITH.ob07
+3 -3
View File
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE ARITH;
IMPORT AVLTREES, STRINGS, UTILS;
IMPORT STRINGS, UTILS, LISTS;
CONST
@@ -31,7 +31,7 @@ TYPE
set: SET;
bool: BOOLEAN;
string*: AVLTREES.DATA
string*: LISTS.ITEM
END;
source/ELF.ob07
+10 -29
View File
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
Copyright (c) 2019-2020, Anton Krotov
Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
MODULE ELF;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS, STRINGS;
CONST
@@ -155,25 +155,6 @@ BEGIN
END NewSym;
PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER;
VAR
i, h: INTEGER;
g: SET;
BEGIN
h := 0;
i := 0;
WHILE name[i] # 0X DO
h := h * 16 + ORD(name[i]);
g := BITS(h) * {28..31};
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
INC(i)
END
RETURN h
END HashStr;
PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
VAR
symi, hi, k: INTEGER;
@@ -329,18 +310,18 @@ BEGIN
hashtab := CHL.CreateIntList();
CHL.PushInt(hashtab, HashStr(""));
CHL.PushInt(hashtab, STRINGS.HashStr(""));
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
CHL.PushInt(hashtab, HashStr("dlopen"));
CHL.PushInt(hashtab, STRINGS.HashStr("dlopen"));
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
CHL.PushInt(hashtab, HashStr("dlsym"));
CHL.PushInt(hashtab, STRINGS.HashStr("dlsym"));
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
IF so THEN
item := program.exp_list.first;
WHILE item # NIL DO
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
CHL.PushInt(hashtab, HashStr(Name));
CHL.PushInt(hashtab, STRINGS.HashStr(Name));
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
item := item.next
END;
@@ -575,7 +556,7 @@ BEGIN
WR.Write32LE(00000201H)
END;
WR.Write32LE(symCount);
WR.Write32LE(symCount);
@@ -588,14 +569,14 @@ BEGIN
END;
CHL.WriteToFile(strtab);
IF amd64 THEN
WR.Write64LE(0);
WR.Write64LE(0)
ELSE
WR.Write32LE(0);
WR.Write32LE(0)
END;
WR.Write32LE(0)
END;
CHL.WriteToFile(program.code);
WHILE pad > 0 DO
source/PARS.ob07
+11 -11
View File
@@ -344,7 +344,7 @@ END QIdent;
PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
VAR
str: SCAN.LEXSTR;
string1, string2: SCAN.IDENT;
string1, string2: SCAN.STRING;
bool: BOOLEAN;
BEGIN
@@ -352,20 +352,20 @@ BEGIN
IF v.typ = ARITH.tCHAR THEN
ASSERT(v2.typ = ARITH.tSTRING);
ARITH.charToStr(v, str);
string1 := SCAN.enterid(str);
string2 := v2.string(SCAN.IDENT)
string1 := SCAN.enterStr(str);
string2 := v2.string(SCAN.STRING)
END;
IF v2.typ = ARITH.tCHAR THEN
ASSERT(v.typ = ARITH.tSTRING);
ARITH.charToStr(v2, str);
string2 := SCAN.enterid(str);
string1 := v.string(SCAN.IDENT)
string2 := SCAN.enterStr(str);
string1 := v.string(SCAN.STRING)
END;
IF v.typ = v2.typ THEN
string1 := v.string(SCAN.IDENT);
string2 := v2.string(SCAN.IDENT)
string1 := v.string(SCAN.STRING);
string2 := v2.string(SCAN.STRING)
END;
CASE operator OF
@@ -624,7 +624,7 @@ VAR
getpos(parser, pos);
ConstExpression(parser, str);
IF str.typ = ARITH.tSTRING THEN
name := str.string(SCAN.IDENT).s
name := str.string(SCAN.STRING).s
ELSIF str.typ = ARITH.tCHAR THEN
ARITH.charToStr(str, name)
ELSE
@@ -1141,15 +1141,15 @@ VAR
getpos(parser, pos);
endname := parser.lex.ident;
IF ~codeProc & (_import = NIL) THEN
check(endname = name, pos, 60);
check(PROG.IdEq(endname, name), pos, 60);
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
IF endname = parser.unit.name THEN
IF PROG.IdEq(endname, parser.unit.name) THEN
ExpectSym(parser, SCAN.lxPOINT);
Next(parser);
endmod := TRUE
ELSIF endname = name THEN
ELSIF PROG.IdEq(endname, name) THEN
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
source/PROG.ob07
+70 -85
View File
@@ -300,15 +300,18 @@ BEGIN
END closeUnit;
PROCEDURE IdEq* (a, b: SCAN.IDENT): BOOLEAN;
RETURN (a.hash = b.hash) & (a.s = b.s)
END IdEq;
PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN;
VAR
item: IDENT;
BEGIN
ASSERT(ident # NIL);
item := unit.idents.last(IDENT);
WHILE (item.typ # idGUARD) & (item.name # ident) DO
WHILE (item.typ # idGUARD) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END
@@ -324,7 +327,6 @@ VAR
BEGIN
ASSERT(unit # NIL);
ASSERT(ident # NIL);
res := unique(unit, ident);
@@ -410,21 +412,19 @@ VAR
item: IDENT;
BEGIN
ASSERT(ident # NIL);
item := unit.idents.last(IDENT);
IF item # NIL THEN
IF currentScope THEN
WHILE (item.name # ident) & (item.typ # idGUARD) DO
WHILE (item.typ # idGUARD) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END;
IF item.name # ident THEN
IF item.typ = idGUARD THEN
item := NIL
END
ELSE
WHILE (item # NIL) & (item.name # ident) DO
WHILE (item # NIL) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END
END
@@ -452,7 +452,8 @@ BEGIN
NEW(item);
item := NewIdent();
item.name := NIL;
item.name.s := "";
item.name.hash := 0;
item.typ := idGUARD;
LISTS.push(unit.idents, item)
@@ -508,7 +509,6 @@ VAR
BEGIN
ASSERT(unit # NIL);
ASSERT(_type # NIL);
ASSERT(baseIdent # NIL);
NEW(newptr);
@@ -648,19 +648,22 @@ END getUnit;
PROCEDURE enterStTypes (unit: UNIT);
PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; _type: _TYPE);
PROCEDURE enter (unit: UNIT; nameStr: SCAN.LEXSTR; _type: _TYPE);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idTYPE);
SCAN.setIdent(name, nameStr);
ident := addIdent(unit, name, idTYPE);
ident._type := _type
END;
upper := name;
upper := nameStr;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idTYPE);
SCAN.setIdent(name, upper);
ident := addIdent(unit, name, idTYPE);
ident._type := _type
END enter;
@@ -685,80 +688,64 @@ END enterStTypes;
PROCEDURE enterStProcs (unit: UNIT);
PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
PROCEDURE Enter (unit: UNIT; nameStr: SCAN.LEXSTR; nfunc, tfunc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
ident.stproc := proc;
SCAN.setIdent(name, nameStr);
ident := addIdent(unit, name, tfunc);
ident.stproc := nfunc;
ident._type := program.stTypes.tNONE
END;
upper := name;
upper := nameStr;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idSTPROC);
ident.stproc := proc;
SCAN.setIdent(name, upper);
ident := addIdent(unit, name, tfunc);
ident.stproc := nfunc;
ident._type := program.stTypes.tNONE
END EnterProc;
PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
BEGIN
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
ident.stproc := func;
ident._type := program.stTypes.tNONE
END;
upper := name;
STRINGS.UpCase(upper);
ident := addIdent(unit, SCAN.enterid(upper), idSTFUNC);
ident.stproc := func;
ident._type := program.stTypes.tNONE
END EnterFunc;
END Enter;
BEGIN
EnterProc(unit, "assert", stASSERT);
EnterProc(unit, "dec", stDEC);
EnterProc(unit, "excl", stEXCL);
EnterProc(unit, "inc", stINC);
EnterProc(unit, "incl", stINCL);
EnterProc(unit, "new", stNEW);
EnterProc(unit, "copy", stCOPY);
Enter(unit, "assert", stASSERT, idSTPROC);
Enter(unit, "dec", stDEC, idSTPROC);
Enter(unit, "excl", stEXCL, idSTPROC);
Enter(unit, "inc", stINC, idSTPROC);
Enter(unit, "incl", stINCL, idSTPROC);
Enter(unit, "new", stNEW, idSTPROC);
Enter(unit, "copy", stCOPY, idSTPROC);
EnterFunc(unit, "abs", stABS);
EnterFunc(unit, "asr", stASR);
EnterFunc(unit, "chr", stCHR);
EnterFunc(unit, "len", stLEN);
EnterFunc(unit, "lsl", stLSL);
EnterFunc(unit, "odd", stODD);
EnterFunc(unit, "ord", stORD);
EnterFunc(unit, "ror", stROR);
EnterFunc(unit, "bits", stBITS);
EnterFunc(unit, "lsr", stLSR);
EnterFunc(unit, "length", stLENGTH);
EnterFunc(unit, "min", stMIN);
EnterFunc(unit, "max", stMAX);
Enter(unit, "abs", stABS, idSTFUNC);
Enter(unit, "asr", stASR, idSTFUNC);
Enter(unit, "chr", stCHR, idSTFUNC);
Enter(unit, "len", stLEN, idSTFUNC);
Enter(unit, "lsl", stLSL, idSTFUNC);
Enter(unit, "odd", stODD, idSTFUNC);
Enter(unit, "ord", stORD, idSTFUNC);
Enter(unit, "ror", stROR, idSTFUNC);
Enter(unit, "bits", stBITS, idSTFUNC);
Enter(unit, "lsr", stLSR, idSTFUNC);
Enter(unit, "length", stLENGTH, idSTFUNC);
Enter(unit, "min", stMIN, idSTFUNC);
Enter(unit, "max", stMAX, idSTFUNC);
IF TARGETS.RealSize # 0 THEN
EnterProc(unit, "pack", stPACK);
EnterProc(unit, "unpk", stUNPK);
EnterFunc(unit, "floor", stFLOOR);
EnterFunc(unit, "flt", stFLT)
Enter(unit, "pack", stPACK, idSTPROC);
Enter(unit, "unpk", stUNPK, idSTPROC);
Enter(unit, "floor", stFLOOR, idSTFUNC);
Enter(unit, "flt", stFLT, idSTFUNC)
END;
IF TARGETS.BitDepth >= 32 THEN
EnterFunc(unit, "wchr", stWCHR)
Enter(unit, "wchr", stWCHR, idSTFUNC)
END;
IF TARGETS.Dispose THEN
EnterProc(unit, "dispose", stDISPOSE)
Enter(unit, "dispose", stDISPOSE, idSTPROC)
END
END enterStProcs;
@@ -769,8 +756,6 @@ VAR
unit: UNIT;
BEGIN
ASSERT(name # NIL);
NEW(unit);
unit.name := name;
@@ -808,7 +793,6 @@ VAR
BEGIN
ASSERT(self # NIL);
ASSERT(name # NIL);
ASSERT(unit # NIL);
field := NIL;
@@ -816,7 +800,7 @@ BEGIN
field := self.fields.first(FIELD);
WHILE (field # NIL) & (field.name # name) DO
WHILE (field # NIL) & ~IdEq(field.name, name) DO
field := field.next(FIELD)
END;
@@ -840,8 +824,6 @@ VAR
res: BOOLEAN;
BEGIN
ASSERT(name # NIL);
res := getField(self, name, self.unit) = NIL;
IF res THEN
@@ -899,11 +881,9 @@ VAR
item: PARAM;
BEGIN
ASSERT(name # NIL);
item := self.params.first(PARAM);
WHILE (item # NIL) & (item.name # name) DO
WHILE (item # NIL) & ~IdEq(item.name, name) DO
item := item.next(PARAM)
END
@@ -917,8 +897,6 @@ VAR
res: BOOLEAN;
BEGIN
ASSERT(name # NIL);
res := getParam(self, name) = NIL;
IF res THEN
@@ -1099,23 +1077,27 @@ PROCEDURE createSysUnit;
VAR
ident: IDENT;
unit: UNIT;
name: SCAN.IDENT;
PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
PROCEDURE EnterProc (sys: UNIT; nameStr: SCAN.LEXSTR; idtyp, proc: INTEGER);
VAR
ident: IDENT;
upper: SCAN.LEXSTR;
name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
ident := addIdent(sys, SCAN.enterid(name), idtyp);
SCAN.setIdent(name, nameStr);
ident := addIdent(sys, name, idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
END;
upper := name;
upper := nameStr;
STRINGS.UpCase(upper);
ident := addIdent(sys, SCAN.enterid(upper), idtyp);
SCAN.setIdent(name, upper);
ident := addIdent(sys, name, idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
@@ -1123,7 +1105,8 @@ VAR
BEGIN
unit := newUnit(SCAN.enterid("$SYSTEM"));
SCAN.setIdent(name, "$SYSTEM");
unit := newUnit(name);
unit.fname := "SYSTEM";
EnterProc(unit, "adr", idSYSFUNC, sysADR);
@@ -1160,11 +1143,13 @@ BEGIN
EnterProc(unit, "get32", idSYSPROC, sysGET32);
IF LowerCase THEN
ident := addIdent(unit, SCAN.enterid("card32"), idTYPE);
SCAN.setIdent(name, "card32");
ident := addIdent(unit, name, idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE
END;
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
SCAN.setIdent(name, "CARD32");
ident := addIdent(unit, name, idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE;
END;
source/SCAN.ob07
+114 -96
View File
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE SCAN;
IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS;
IMPORT TXT := TEXTDRV, ARITH, S := STRINGS, ERRORS, LISTS;
CONST
@@ -54,11 +54,17 @@ TYPE
END;
IDENT* = POINTER TO RECORD (AVL.DATA)
STRING* = POINTER TO RECORD (LISTS.ITEM)
s*: LEXSTR;
offset*, offsetW*: INTEGER;
key: INTEGER
offset*, offsetW*, hash: INTEGER
END;
IDENT* = RECORD
s*: LEXSTR;
hash*: INTEGER
END;
@@ -73,9 +79,10 @@ TYPE
s*: LEXSTR;
length*: INTEGER;
sym*: INTEGER;
hash: INTEGER;
pos*: POSITION;
ident*: IDENT;
string*: IDENT;
string*: STRING;
value*: ARITH.VALUE;
error*: INTEGER;
@@ -85,43 +92,78 @@ TYPE
SCANNER* = TXT.TEXT;
KEYWORD = ARRAY 10 OF CHAR;
VAR
idents: AVL.NODE;
delimiters: ARRAY 256 OF BOOLEAN;
NewIdent: IDENT;
upto, LowerCase, _if: BOOLEAN;
def: LISTS.LIST;
strings, def: LISTS.LIST;
KW: ARRAY 33 OF RECORD upper, lower: KEYWORD; uhash, lhash: INTEGER END;
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
END nodecmp;
PROCEDURE enterKW (s: KEYWORD; idx: INTEGER);
BEGIN
KW[idx].lower := s;
KW[idx].upper := s;
S.UpCase(KW[idx].upper);
KW[idx].uhash := S.HashStr(KW[idx].upper);
KW[idx].lhash := S.HashStr(KW[idx].lower);
END enterKW;
PROCEDURE enterid* (s: LEXSTR): IDENT;
PROCEDURE checkKW (ident: IDENT): INTEGER;
VAR
newnode: BOOLEAN;
node: AVL.NODE;
i, res: INTEGER;
BEGIN
NewIdent.s := s;
idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
IF newnode THEN
NEW(NewIdent);
NewIdent.offset := -1;
NewIdent.offsetW := -1;
NewIdent.key := 0
res := lxIDENT;
i := 0;
WHILE i < LEN(KW) DO
IF (KW[i].uhash = ident.hash) & (KW[i].upper = ident.s)
OR LowerCase & (KW[i].lhash = ident.hash) & (KW[i].lower = ident.s) THEN
res := i + lxKW;
i := LEN(KW)
END;
INC(i)
END
RETURN node.data(IDENT)
END enterid;
RETURN res
END checkKW;
PROCEDURE enterStr* (s: LEXSTR): STRING;
VAR
str, res: STRING;
hash: INTEGER;
BEGIN
hash := S.HashStr(s);
str := strings.first(STRING);
res := NIL;
WHILE str # NIL DO
IF (str.hash = hash) & (str.s = s) THEN
res := str;
str := NIL
ELSE
str := str.next(STRING)
END
END;
IF res = NIL THEN
NEW(res);
res.s := s;
res.offset := -1;
res.offsetW := -1;
res.hash := S.HashStr(s);
LISTS.push(strings, res)
END
RETURN res
END enterStr;
PROCEDURE putchar (VAR lex: LEX; c: CHAR);
@@ -143,6 +185,13 @@ BEGIN
END nextc;
PROCEDURE setIdent* (VAR ident: IDENT; s: LEXSTR);
BEGIN
ident.s := s;
ident.hash := S.HashStr(s);
END setIdent;
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
VAR
c: CHAR;
@@ -159,12 +208,8 @@ BEGIN
IF lex.over THEN
lex.sym := lxERROR06
ELSE
lex.ident := enterid(lex.s);
IF lex.ident.key # 0 THEN
lex.sym := lex.ident.key
ELSE
lex.sym := lxIDENT
END
setIdent(lex.ident, lex.s);
lex.sym := checkKW(lex.ident)
END
END ident;
@@ -312,7 +357,7 @@ BEGIN
END;
IF lex.sym = lxSTRING THEN
lex.string := enterid(lex.s);
lex.string := enterStr(lex.s);
lex.value.typ := ARITH.tSTRING;
lex.value.string := lex.string
END
@@ -594,7 +639,6 @@ BEGIN
lex.length := 0;
lex.pos.line := text.line;
lex.pos.col := text.col;
lex.ident := NIL;
lex.over := FALSE;
IF S.letter(c) THEN
@@ -668,24 +712,6 @@ VAR
i: INTEGER;
delim: ARRAY 23 OF CHAR;
PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
VAR
id: IDENT;
upper: LEXSTR;
BEGIN
IF LowerCase THEN
id := enterid(kw);
id.key := key
END;
upper := kw;
S.UpCase(upper);
id := enterid(upper);
id.key := key
END enterkw;
BEGIN
upto := FALSE;
LowerCase := lower;
@@ -700,48 +726,39 @@ BEGIN
delimiters[ORD(delim[i])] := TRUE
END;
NEW(NewIdent);
NewIdent.s := "";
NewIdent.offset := -1;
NewIdent.offsetW := -1;
NewIdent.key := 0;
idents := NIL;
enterkw(lxARRAY, "array");
enterkw(lxBEGIN, "begin");
enterkw(lxBY, "by");
enterkw(lxCASE, "case");
enterkw(lxCONST, "const");
enterkw(lxDIV, "div");
enterkw(lxDO, "do");
enterkw(lxELSE, "else");
enterkw(lxELSIF, "elsif");
enterkw(lxEND, "end");
enterkw(lxFALSE, "false");
enterkw(lxFOR, "for");
enterkw(lxIF, "if");
enterkw(lxIMPORT, "import");
enterkw(lxIN, "in");
enterkw(lxIS, "is");
enterkw(lxMOD, "mod");
enterkw(lxMODULE, "module");
enterkw(lxNIL, "nil");
enterkw(lxOF, "of");
enterkw(lxOR, "or");
enterkw(lxPOINTER, "pointer");
enterkw(lxPROCEDURE, "procedure");
enterkw(lxRECORD, "record");
enterkw(lxREPEAT, "repeat");
enterkw(lxRETURN, "return");
enterkw(lxTHEN, "then");
enterkw(lxTO, "to");
enterkw(lxTRUE, "true");
enterkw(lxTYPE, "type");
enterkw(lxUNTIL, "until");
enterkw(lxVAR, "var");
enterkw(lxWHILE, "while")
enterKW("array", 0);
enterKW("begin", 1);
enterKW("by", 2);
enterKW("case", 3);
enterKW("const", 4);
enterKW("div", 5);
enterKW("do", 6);
enterKW("else", 7);
enterKW("elsif", 8);
enterKW("end", 9);
enterKW("false", 10);
enterKW("for", 11);
enterKW("if", 12);
enterKW("import", 13);
enterKW("in", 14);
enterKW("is", 15);
enterKW("mod", 16);
enterKW("module", 17);
enterKW("nil", 18);
enterKW("of", 19);
enterKW("or", 20);
enterKW("pointer", 21);
enterKW("procedure", 22);
enterKW("record", 23);
enterKW("repeat", 24);
enterKW("return", 25);
enterKW("then", 26);
enterKW("to", 27);
enterKW("true", 28);
enterKW("type", 29);
enterKW("until", 30);
enterKW("var", 31);
enterKW("while", 32)
END init;
@@ -757,5 +774,6 @@ END NewDef;
BEGIN
def := LISTS.create(NIL)
def := LISTS.create(NIL);
strings := LISTS.create(NIL)
END SCAN.
source/STATEMENTS.ob07
+22 -20
View File
@@ -208,7 +208,7 @@ BEGIN
IF e._type = tCHAR THEN
res := 1
ELSE
res := LENGTH(e.value.string(SCAN.IDENT).s)
res := LENGTH(e.value.string(SCAN.STRING).s)
END
RETURN res
END strlen;
@@ -241,7 +241,7 @@ BEGIN
IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
res := 1
ELSE
res := _length(e.value.string(SCAN.IDENT).s)
res := _length(e.value.string(SCAN.STRING).s)
END
RETURN res
END utf8strlen;
@@ -302,11 +302,11 @@ END assigncomp;
PROCEDURE String (e: PARS.EXPR): INTEGER;
VAR
offset: INTEGER;
string: SCAN.IDENT;
string: SCAN.STRING;
BEGIN
IF strlen(e) # 1 THEN
string := e.value.string(SCAN.IDENT);
string := e.value.string(SCAN.STRING);
IF string.offset = -1 THEN
string.offset := IL.putstr(string.s);
END;
@@ -322,11 +322,11 @@ END String;
PROCEDURE StringW (e: PARS.EXPR): INTEGER;
VAR
offset: INTEGER;
string: SCAN.IDENT;
string: SCAN.STRING;
BEGIN
IF utf8strlen(e) # 1 THEN
string := e.value.string(SCAN.IDENT);
string := e.value.string(SCAN.STRING);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
END;
@@ -335,7 +335,7 @@ BEGIN
IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
offset := IL.putstrW1(ARITH.Int(e.value))
ELSE (* e._type.typ = PROG.tSTRING *)
string := e.value.string(SCAN.IDENT);
string := e.value.string(SCAN.STRING);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
END;
@@ -437,7 +437,7 @@ BEGIN
ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
ELSIF isStringW1(e) & (VarType = tWCHAR) THEN
IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isCharW(e) & (VarType = tWCHAR) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
@@ -609,7 +609,7 @@ BEGIN
IL.Const(0);
IL.Param1
ELSIF isStringW1(e) & (p._type = tWCHAR) THEN
IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s));
IL.Const(StrToWChar(e.value.string(SCAN.STRING).s));
IL.Param1
ELSIF (e._type.typ = PROG.tSTRING) OR
(e._type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p._type.typ = PROG.tARRAY) & (p._type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
@@ -1151,7 +1151,7 @@ BEGIN
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
IF e.obj = eCONST THEN
IF isStringW1(e) THEN
ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s)))
ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.STRING).s)))
ELSE
ARITH.ord(e.value)
END
@@ -2156,15 +2156,15 @@ VAR
IF e.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e.value, s)
ELSE
s := e.value.string(SCAN.IDENT).s
s := e.value.string(SCAN.STRING).s
END;
IF e1.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e1.value, s1)
ELSE
s1 := e1.value.string(SCAN.IDENT).s
s1 := e1.value.string(SCAN.STRING).s
END;
PARS.check(ARITH.concat(s, s1), pos, 5);
e.value.string := SCAN.enterid(s);
e.value.string := SCAN.enterStr(s);
e.value.typ := ARITH.tSTRING;
e._type := PROG.program.stTypes.tSTRING
END
@@ -2372,10 +2372,10 @@ BEGIN
END
ELSIF isStringW1(e) & isCharW(e1) THEN
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
ELSIF isBoolean(e) & isBoolean(e1) THEN
IF constant THEN
@@ -2489,10 +2489,10 @@ BEGIN
END
ELSIF isStringW1(e) & isCharW(e1) THEN
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
ELSIF isReal(e) & isReal(e1) THEN
IF constant THEN
@@ -2798,8 +2798,8 @@ VAR
a := ARITH.getInt(value)
ELSIF isCharW(caseExpr) THEN
PARS.ConstExpression(parser, value);
IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.STRING).s) = 1) & (LENGTH(value.string(SCAN.STRING).s) > 1) THEN
ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.STRING).s)))
ELSE
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
END;
@@ -3264,9 +3264,11 @@ VAR
PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
VAR
id: PROG.IDENT;
ident: SCAN.IDENT;
BEGIN
id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
SCAN.setIdent(ident, name);
id := PROG.getIdent(rtl, ident, FALSE);
IF (id # NIL) & (id._import # NIL) THEN
IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label);
source/STRINGS.ob07
+20 -1
View File
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -331,4 +331,23 @@ BEGIN
END Utf8To16;
PROCEDURE HashStr* (name: ARRAY OF CHAR): INTEGER;
VAR
i, h: INTEGER;
g: SET;
BEGIN
h := 0;
i := 0;
WHILE name[i] # 0X DO
h := h * 16 + ORD(name[i]);
g := BITS(h) * {28..31};
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
INC(i)
END
RETURN h
END HashStr;
END STRINGS.
source/UTILS.ob07
+1 -1
View File
@@ -24,7 +24,7 @@ CONST
vMajor* = 1;
vMinor* = 50;
Date* = "2021-02-03";
Date* = "2021-02-04";
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";