kolibrios-gitea/programs/develop/oberon07/Source/PARS.ob07
Kirill Lipatov (Leency) 65c332bd36 oberon07: update to the latest version from https://github.com/AntKrotov/oberon-07-compiler
git-svn-id: svn://kolibrios.org@7983 a494cfbc-eb01-0410-851d-a64ba20cac60
2020-05-25 20:48:33 +00:00

1295 lines
34 KiB
Plaintext

(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE PARS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS,
C := COLLECTIONS, TARGETS, THUMB;
CONST
eCONST* = 1; eTYPE* = 2; eVAR* = 3; eEXPR* = 4;
eVREC* = 5; ePROC* = 6; eVPAR* = 7; ePARAM* = 8;
eSTPROC* = 9; eSTFUNC* = 10; eSYSFUNC* = 11; eSYSPROC* = 12;
eIMP* = 13;
TYPE
PATH* = PATHS.PATH;
PARSER* = POINTER TO rPARSER;
POSITION* = RECORD (SCAN.POSITION)
parser*: PARSER
END;
EXPR* = RECORD
obj*: INTEGER;
type*: PROG.TYPE_;
value*: ARITH.VALUE;
stproc*: INTEGER;
readOnly*: BOOLEAN;
ident*: PROG.IDENT
END;
STATPROC = PROCEDURE (parser: PARSER);
EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
rPARSER = RECORD (C.ITEM)
fname*: PATH;
path: PATH;
lib_path: PATH;
ext: PATH;
modname: PATH;
scanner: SCAN.SCANNER;
lex*: SCAN.LEX;
sym*: INTEGER;
unit*: PROG.UNIT;
constexp*: BOOLEAN;
main*: BOOLEAN;
open*: PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
parse*: PROCEDURE (parser: PARSER);
StatSeq*: STATPROC;
expression*: EXPRPROC;
designator*: EXPRPROC;
chkreturn: RETPROC;
create*: PROCEDURE (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER
END;
VAR
program*: PROG.PROGRAM;
parsers: C.COLLECTION;
lines*, modules: INTEGER;
PROCEDURE destroy* (VAR parser: PARSER);
BEGIN
IF parser.scanner # NIL THEN
SCAN.close(parser.scanner)
END;
C.push(parsers, parser);
parser := NIL
END destroy;
PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);
BEGIN
pos.line := parser.lex.pos.line;
pos.col := parser.lex.pos.col;
pos.parser := parser
END getpos;
PROCEDURE error* (pos: POSITION; errno: INTEGER);
BEGIN
ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
END error;
PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
BEGIN
IF ~condition THEN
error(pos, errno)
END
END check;
PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
VAR
pos: POSITION;
BEGIN
IF ~condition THEN
getpos(parser, pos);
error(pos, errno)
END
END check1;
PROCEDURE Next* (parser: PARSER);
VAR
errno: INTEGER;
BEGIN
SCAN.Next(parser.scanner, parser.lex);
errno := parser.lex.error;
IF (errno = 0) & (TARGETS.CPU = TARGETS.cpuMSP430) THEN
IF parser.lex.sym = SCAN.lxFLOAT THEN
errno := -SCAN.lxERROR13
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
errno := -SCAN.lxERROR10
END
END;
IF errno # 0 THEN
check1(FALSE, parser, errno)
END;
parser.sym := parser.lex.sym
END Next;
PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);
BEGIN
Next(parser);
getpos(parser, pos)
END NextPos;
PROCEDURE checklex* (parser: PARSER; sym: INTEGER);
VAR
err: INTEGER;
BEGIN
IF parser.sym # sym THEN
CASE sym OF
|SCAN.lxCOMMA: err := 65
|SCAN.lxRROUND: err := 33
|SCAN.lxPOINT: err := 26
|SCAN.lxIDENT: err := 22
|SCAN.lxRSQUARE: err := 71
|SCAN.lxRCURLY: err := 35
|SCAN.lxUNDEF: err := 34
|SCAN.lxTHEN: err := 88
|SCAN.lxEND: err := 27
|SCAN.lxDO: err := 89
|SCAN.lxUNTIL: err := 90
|SCAN.lxCOLON: err := 53
|SCAN.lxOF: err := 67
|SCAN.lxASSIGN: err := 96
|SCAN.lxTO: err := 57
|SCAN.lxLROUND: err := 64
|SCAN.lxEQ: err := 32
|SCAN.lxSEMI: err := 24
|SCAN.lxRETURN: err := 38
|SCAN.lxMODULE: err := 21
|SCAN.lxSTRING: err := 66
END;
check1(FALSE, parser, err)
END
END checklex;
PROCEDURE ExpectSym* (parser: PARSER; sym: INTEGER);
BEGIN
Next(parser);
checklex(parser, sym)
END ExpectSym;
PROCEDURE ImportList (parser: PARSER);
VAR
name: SCAN.IDENT;
parser2: PARSER;
pos: POSITION;
alias: BOOLEAN;
unit: PROG.UNIT;
ident: PROG.IDENT;
BEGIN
alias := FALSE;
REPEAT
ExpectSym(parser, SCAN.lxIDENT);
name := parser.lex.ident;
getpos(parser, pos);
IF ~alias THEN
ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
check(ident # NIL, pos, 30)
END;
Next(parser);
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
alias := FALSE;
unit := PROG.getUnit(program, name);
IF unit # NIL THEN
check(unit.closed, pos, 31)
ELSE
parser2 := parser.create(parser.path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
IF ~parser2.open(parser2, name.s) THEN
IF parser.path # parser.lib_path THEN
destroy(parser2);
parser2 := parser.create(parser.lib_path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
check(parser2.open(parser2, name.s), pos, 29)
ELSE
error(pos, 29)
END
END;
parser2.parse(parser2);
unit := parser2.unit;
destroy(parser2)
END;
IF unit = program.sysunit THEN
parser.unit.sysimport := TRUE
END;
ident.unit := unit
ELSIF parser.sym = SCAN.lxASSIGN THEN
alias := TRUE
ELSE
check1(FALSE, parser, 28)
END
UNTIL parser.sym = SCAN.lxSEMI;
Next(parser)
END ImportList;
PROCEDURE QIdent (parser: PARSER; forward: BOOLEAN): PROG.IDENT;
VAR
ident: PROG.IDENT;
unit: PROG.UNIT;
BEGIN
ASSERT(parser.sym = SCAN.lxIDENT);
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
IF ~forward THEN
check1(ident # NIL, parser, 48)
END;
IF (ident # NIL) & (ident.typ = PROG.idMODULE) THEN
unit := ident.unit;
ExpectSym(parser, SCAN.lxPOINT);
ExpectSym(parser, SCAN.lxIDENT);
ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
check1((ident # NIL) & ident.export, parser, 48)
END
RETURN ident
END QIdent;
PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
VAR
str: SCAN.LEXSTR;
string1, string2: SCAN.IDENT;
bool: BOOLEAN;
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)
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)
END;
IF v.typ = v2.typ THEN
string1 := v.string(SCAN.IDENT);
string2 := v2.string(SCAN.IDENT)
END;
CASE operator OF
|SCAN.lxEQ: bool := string1.s = string2.s
|SCAN.lxNE: bool := string1.s # string2.s
|SCAN.lxLT: bool := string1.s < string2.s
|SCAN.lxGT: bool := string1.s > string2.s
|SCAN.lxLE: bool := string1.s <= string2.s
|SCAN.lxGE: bool := string1.s >= string2.s
END;
ARITH.setbool(v, bool)
END strcmp;
PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
VAR
e: EXPR;
pos: POSITION;
BEGIN
getpos(parser, pos);
parser.constexp := TRUE;
parser.expression(parser, e);
parser.constexp := FALSE;
check(e.obj = eCONST, pos, 62);
v := e.value
END ConstExpression;
PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
VAR
name: SCAN.IDENT;
export: BOOLEAN;
pos: POSITION;
BEGIN
ASSERT(parser.sym = SCAN.lxIDENT);
WHILE parser.sym = SCAN.lxIDENT DO
getpos(parser, pos);
name := parser.lex.ident;
Next(parser);
export := parser.sym = SCAN.lxMUL;
IF export THEN
check1(parser.unit.scopeLvl = 0, parser, 61);
Next(parser)
END;
check(PROG.addField(rec, name, export), pos, 30);
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT)
ELSE
checklex(parser, SCAN.lxCOLON)
END
END
END FieldList;
PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_);
VAR
ident: PROG.IDENT;
PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_);
VAR
ident: PROG.IDENT;
exit: BOOLEAN;
vPar: BOOLEAN;
dim: INTEGER;
t0, t1: PROG.TYPE_;
BEGIN
vPar := parser.sym = SCAN.lxVAR;
IF vPar THEN
Next(parser)
END;
checklex(parser, SCAN.lxIDENT);
exit := FALSE;
WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
Next(parser);
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT)
ELSIF parser.sym = SCAN.lxCOLON THEN
Next(parser);
dim := 0;
WHILE parser.sym = SCAN.lxARRAY DO
INC(dim);
check1(dim <= PROG.MAXARRDIM, parser, 84);
ExpectSym(parser, SCAN.lxOF);
Next(parser)
END;
checklex(parser, SCAN.lxIDENT);
ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68);
t0 := ident.type;
t1 := t0;
WHILE dim > 0 DO
t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
t1.base := t0;
t0 := t1;
DEC(dim)
END;
PROG.setParams(type, t1);
Next(parser);
exit := TRUE
ELSE
checklex(parser, SCAN.lxCOLON)
END
END
END FPSection;
BEGIN
IF parser.sym = SCAN.lxLROUND THEN
Next(parser);
IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN
FPSection(parser, type);
WHILE parser.sym = SCAN.lxSEMI DO
Next(parser);
FPSection(parser, type)
END
END;
checklex(parser, SCAN.lxRROUND);
Next(parser);
IF parser.sym = SCAN.lxCOLON THEN
ExpectSym(parser, SCAN.lxIDENT);
ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68);
check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
type.base := ident.type;
Next(parser)
ELSE
type.base := NIL
END
END
END FormalParameters;
PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
VAR
res, sf: INTEGER;
BEGIN
IF parser.lex.s = "stdcall" THEN
sf := PROG.sf_stdcall
ELSIF parser.lex.s = "stdcall64" THEN
sf := PROG.sf_stdcall64
ELSIF parser.lex.s = "ccall" THEN
sf := PROG.sf_ccall
ELSIF parser.lex.s = "ccall16" THEN
sf := PROG.sf_ccall16
ELSIF parser.lex.s = "win64" THEN
sf := PROG.sf_win64
ELSIF parser.lex.s = "systemv" THEN
sf := PROG.sf_systemv
ELSIF parser.lex.s = "windows" THEN
sf := PROG.sf_windows
ELSIF parser.lex.s = "linux" THEN
sf := PROG.sf_linux
ELSIF parser.lex.s = "code" THEN
sf := PROG.sf_code
ELSIF parser.lex.s = "noalign" THEN
sf := PROG.sf_noalign
ELSE
check1(FALSE, parser, 124)
END;
check1(sf IN program.sysflags, parser, 125);
IF proc THEN
check1(sf IN PROG.proc_flags, parser, 123)
ELSE
check1(sf IN PROG.rec_flags, parser, 123)
END;
CASE sf OF
|PROG.sf_stdcall:
res := PROG.stdcall
|PROG.sf_stdcall64:
res := PROG.stdcall64
|PROG.sf_ccall:
res := PROG.ccall
|PROG.sf_ccall16:
res := PROG.ccall16
|PROG.sf_win64:
res := PROG.win64
|PROG.sf_systemv:
res := PROG.systemv
|PROG.sf_code:
res := PROG.code
|PROG.sf_windows:
IF TARGETS.OS = TARGETS.osWIN32 THEN
res := PROG.stdcall
ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
res := PROG.win64
END
|PROG.sf_linux:
IF TARGETS.OS = TARGETS.osLINUX32 THEN
res := PROG.ccall16
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
res := PROG.systemv
END
|PROG.sf_noalign:
res := PROG.noalign
END
RETURN res
END sysflag;
PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
VAR
call: INTEGER;
dll, proc: SCAN.LEXSTR;
pos: POSITION;
BEGIN
import := NIL;
IF parser.sym = SCAN.lxLSQUARE THEN
getpos(parser, pos);
check1(parser.unit.sysimport, parser, 54);
Next(parser);
call := sysflag(parser, TRUE);
Next(parser);
IF parser.sym = SCAN.lxMINUS THEN
Next(parser);
INC(call)
END;
IF ~isProc THEN
checklex(parser, SCAN.lxRSQUARE)
END;
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxSTRING);
dll := parser.lex.s;
STRINGS.UpCase(dll);
ExpectSym(parser, SCAN.lxCOMMA);
ExpectSym(parser, SCAN.lxSTRING);
proc := parser.lex.s;
Next(parser);
import := IL.AddImp(dll, proc)
END;
checklex(parser, SCAN.lxRSQUARE);
Next(parser)
ELSE
CASE TARGETS.BitDepth OF
|16: call := PROG.default16
|32: IF TARGETS.target = TARGETS.STM32CM3 THEN
call := PROG.ccall
ELSE
call := PROG.default32
END
|64: call := PROG.default64
END
END;
IF import # NIL THEN
check(TARGETS.Import, pos, 70)
END
RETURN call
END procflag;
PROCEDURE type (parser: PARSER; VAR t: PROG.TYPE_; flags: SET);
CONST
comma = 0;
closed = 1;
forward = 2;
VAR
arrLen: ARITH.VALUE;
typeSize: ARITH.VALUE;
ident: PROG.IDENT;
unit: PROG.UNIT;
pos, pos2: POSITION;
fieldType: PROG.TYPE_;
baseIdent: SCAN.IDENT;
a, b: INTEGER;
RecFlag: INTEGER;
import: IL.IMPORT_PROC;
BEGIN
unit := parser.unit;
t := NIL;
IF parser.sym = SCAN.lxIDENT THEN
ident := QIdent(parser, forward IN flags);
IF ident # NIL THEN
check1(ident.typ = PROG.idTYPE, parser, 49);
t := ident.type;
check1(t # NIL, parser, 50);
IF closed IN flags THEN
check1(t.closed, parser, 50)
END
END;
Next(parser)
ELSIF (parser.sym = SCAN.lxARRAY) OR ((parser.sym = SCAN.lxCOMMA) & (comma IN flags)) THEN
IF parser.sym = SCAN.lxARRAY THEN
getpos(parser, pos2)
END;
NextPos(parser, pos);
ConstExpression(parser, arrLen);
check(arrLen.typ = ARITH.tINTEGER, pos, 43);
check(ARITH.check(arrLen), pos, 39);
check(ARITH.getInt(arrLen) > 0, pos, 51);
t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
IF parser.sym = SCAN.lxCOMMA THEN
type(parser, t.base, {comma, closed})
ELSIF parser.sym = SCAN.lxOF THEN
Next(parser);
type(parser, t.base, {closed})
ELSE
check1(FALSE, parser, 47)
END;
t.align := t.base.align;
a := t.length;
b := t.base.size;
check(ARITH.mulInt(a, b), pos2, 104);
check(ARITH.setInt(typeSize, a), pos2, 104);
t.size := a;
t.closed := TRUE
ELSIF parser.sym = SCAN.lxRECORD THEN
getpos(parser, pos2);
Next(parser);
t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit);
t.align := 1;
IF parser.sym = SCAN.lxLSQUARE THEN
check1(parser.unit.sysimport, parser, 54);
Next(parser);
RecFlag := sysflag(parser, FALSE);
t.noalign := RecFlag = PROG.noalign;
ExpectSym(parser, SCAN.lxRSQUARE);
Next(parser)
END;
IF parser.sym = SCAN.lxLROUND THEN
check1(~t.noalign, parser, 111);
ExpectSym(parser, SCAN.lxIDENT);
getpos(parser, pos);
type(parser, t.base, {closed});
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
IF t.base.typ = PROG.tPOINTER THEN
t.base := t.base.base;
check(t.base # NIL, pos, 55)
END;
check(~t.base.noalign, pos, 112);
checklex(parser, SCAN.lxRROUND);
Next(parser);
t.size := t.base.size;
IF t.base.align > t.align THEN
t.align := t.base.align
END
ELSE
t.base := program.stTypes.tANYREC
END;
WHILE parser.sym = SCAN.lxIDENT DO
FieldList(parser, t);
ASSERT(parser.sym = SCAN.lxCOLON);
Next(parser);
type(parser, fieldType, {closed});
check(PROG.setFields(t, fieldType), pos2, 104);
IF (fieldType.align > t.align) & ~t.noalign THEN
t.align := fieldType.align
END;
IF parser.sym = SCAN.lxSEMI THEN
ExpectSym(parser, SCAN.lxIDENT)
ELSE
checklex(parser, SCAN.lxEND)
END
END;
t.closed := TRUE;
IL.AddRec(t.base.num);
IF ~t.noalign THEN
check(UTILS.Align(t.size, t.align), pos2, 104);
check(ARITH.setInt(typeSize, t.size), pos2, 104)
END;
checklex(parser, SCAN.lxEND);
Next(parser)
ELSIF parser.sym = SCAN.lxPOINTER THEN
ExpectSym(parser, SCAN.lxTO);
Next(parser);
t := PROG.enterType(program, PROG.tPOINTER, TARGETS.AdrSize, 0, unit);
t.align := TARGETS.AdrSize;
getpos(parser, pos);
IF parser.sym = SCAN.lxIDENT THEN
baseIdent := parser.lex.ident
END;
type(parser, t.base, {forward});
IF t.base # NIL THEN
check(t.base.typ = PROG.tRECORD, pos, 58)
ELSE
PROG.frwPtr(unit, t, baseIdent, pos)
END
ELSIF parser.sym = SCAN.lxPROCEDURE THEN
NextPos(parser, pos);
t := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t.align := TARGETS.AdrSize;
t.call := procflag(parser, import, FALSE);
FormalParameters(parser, t)
ELSE
check1(FALSE, parser, 49)
END
END type;
PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
VAR
ident: PROG.IDENT;
pos: POSITION;
BEGIN
ASSERT(parser.sym = SCAN.lxIDENT);
name := parser.lex.ident;
getpos(parser, pos);
ident := PROG.addIdent(parser.unit, name, typ);
check(ident # NIL, pos, 30);
ident.pos := pos;
Next(parser);
IF parser.sym = SCAN.lxMUL THEN
check1(ident.global, parser, 61);
ident.export := TRUE;
Next(parser)
END
RETURN ident
END IdentDef;
PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
VAR
ident: PROG.IDENT;
name: SCAN.IDENT;
pos: POSITION;
BEGIN
IF const THEN
ident := IdentDef(parser, PROG.idNONE, name)
ELSE
ident := IdentDef(parser, PROG.idTYPE, name)
END;
checklex(parser, SCAN.lxEQ);
NextPos(parser, pos);
IF const THEN
ConstExpression(parser, ident.value);
IF ident.value.typ = ARITH.tINTEGER THEN
check(ARITH.check(ident.value), pos, 39)
ELSIF ident.value.typ = ARITH.tREAL THEN
check(ARITH.check(ident.value), pos, 40)
END;
ident.typ := PROG.idCONST;
ident.type := PROG.getType(program, ident.value.typ)
ELSE
type(parser, ident.type, {})
END;
checklex(parser, SCAN.lxSEMI);
Next(parser)
END ConstTypeDeclaration;
PROCEDURE VarDeclaration (parser: PARSER);
VAR
ident: PROG.IDENT;
name: SCAN.IDENT;
t: PROG.TYPE_;
BEGIN
REPEAT
ident := IdentDef(parser, PROG.idVAR, name);
IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT)
ELSIF parser.sym = SCAN.lxCOLON THEN
Next(parser);
type(parser, t, {});
PROG.setVarsType(parser.unit, t);
checklex(parser, SCAN.lxSEMI);
Next(parser)
ELSE
checklex(parser, SCAN.lxCOLON)
END
UNTIL parser.sym # SCAN.lxIDENT
END VarDeclaration;
PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
VAR
ptr: PROG.FRWPTR;
endmod: BOOLEAN;
pos: POSITION;
PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
VAR
proc: PROG.IDENT;
endname,
name: SCAN.IDENT;
param: PROG.PARAM;
unit: PROG.UNIT;
ident: PROG.IDENT;
e: EXPR;
pos, pos1,
pos2: POSITION;
label: INTEGER;
enter: IL.COMMAND;
call: INTEGER;
t: PROG.TYPE_;
import: IL.IMPORT_PROC;
endmod, b: BOOLEAN;
fparams: SET;
variables: LISTS.LIST;
int, flt: INTEGER;
comma: BOOLEAN;
code, iv: ARITH.VALUE;
codeProc,
handler: BOOLEAN;
BEGIN
endmod := FALSE;
handler := FALSE;
unit := parser.unit;
call := procflag(parser, import, TRUE);
getpos(parser, pos);
pos1 := pos;
checklex(parser, SCAN.lxIDENT);
IF import # NIL THEN
proc := IdentDef(parser, PROG.idIMP, name);
proc.import := import;
program.procs.last(PROG.PROC).import := import
ELSE
proc := IdentDef(parser, PROG.idPROC, name)
END;
check(PROG.openScope(unit, proc.proc), pos, 116);
proc.type := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
t := proc.type;
t.align := TARGETS.AdrSize;
t.call := call;
FormalParameters(parser, t);
IF parser.sym = SCAN.lxLSQUARE THEN
getpos(parser, pos2);
check(TARGETS.target = TARGETS.STM32CM3, pos2, 24);
Next(parser);
getpos(parser, pos2);
ConstExpression(parser, iv);
check(iv.typ = ARITH.tINTEGER, pos2, 43);
check((0 <= ARITH.Int(iv)) & (ARITH.Int(iv) <= THUMB.maxIVT), pos2, 46);
check(THUMB.SetIV(ARITH.Int(iv)), pos2, 121);
checklex(parser, SCAN.lxRSQUARE);
Next(parser);
handler := TRUE
END;
codeProc := call IN {PROG.code, PROG._code};
IF call IN {PROG.systemv, PROG._systemv} THEN
check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120)
END;
param := t.params.first(PROG.PARAM);
WHILE param # NIL DO
ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
ASSERT(ident # NIL);
ident.type := param.type;
ident.offset := param.offset;
IF param.vPar THEN
ident.typ := PROG.idVPAR
END;
param := param.next(PROG.PARAM)
END;
IF import = NIL THEN
label := IL.NewLabel();
proc.proc.label := label;
proc.proc.used := handler;
IF handler THEN
IL.AddCmd2(IL.opHANDLER, label, ARITH.Int(iv))
END
END;
IF codeProc THEN
enter := IL.EnterC(label);
comma := FALSE;
WHILE (parser.sym # SCAN.lxSEMI) OR comma DO
getpos(parser, pos2);
ConstExpression(parser, code);
check(code.typ = ARITH.tINTEGER, pos2, 43);
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
check(ARITH.range(code, 0, 255), pos2, 42)
ELSIF TARGETS.CPU = TARGETS.cpuTHUMB THEN
check(ARITH.range(code, 0, 65535), pos2, 110)
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
IF comma THEN
Next(parser)
ELSE
checklex(parser, SCAN.lxSEMI)
END
END
END;
checklex(parser, SCAN.lxSEMI);
Next(parser);
IF import = NIL THEN
IF parser.main & proc.export & TARGETS.Dll THEN
IF TARGETS.target = TARGETS.KolibriOSDLL THEN
check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
END;
IL.AddExp(label, proc.name.s);
proc.proc.used := TRUE
END;
IF ~codeProc THEN
b := DeclarationSequence(parser)
END;
program.locsize := 0;
IF call IN {PROG._win64, PROG.win64} THEN
fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
ELSIF call IN {PROG._systemv, PROG.systemv} THEN
fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
ELSIF codeProc THEN
ELSE
enter := IL.Enter(label, 0)
END;
proc.proc.enter := enter;
IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
Next(parser);
parser.StatSeq(parser)
END;
IF ~codeProc & (t.base # NIL) THEN
checklex(parser, SCAN.lxRETURN);
NextPos(parser, pos);
parser.expression(parser, e);
check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
END;
IF ~codeProc THEN
proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
enter.param2 := program.locsize;
checklex(parser, SCAN.lxEND)
ELSE
proc.proc.leave := IL.LeaveC()
END;
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.options.ram, pos1, 63)
END
END;
IF parser.sym = SCAN.lxEND THEN
ExpectSym(parser, SCAN.lxIDENT);
getpos(parser, pos);
endname := parser.lex.ident;
IF ~codeProc & (import = NIL) THEN
check(endname = name, pos, 60);
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
IF endname = parser.unit.name THEN
ExpectSym(parser, SCAN.lxPOINT);
Next(parser);
endmod := TRUE
ELSIF endname = name THEN
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
error(pos, 60)
END
END
END;
IF ~codeProc & (import = NIL) THEN
variables := LISTS.create(NIL);
ELSE
variables := NIL
END;
PROG.closeScope(unit, variables);
IF ~codeProc & (import = NIL) THEN
enter.variables := variables
END
RETURN endmod
END ProcDeclaration;
BEGIN
IF parser.sym = SCAN.lxCONST THEN
Next(parser);
WHILE parser.sym = SCAN.lxIDENT DO
ConstTypeDeclaration(parser, TRUE)
END
END;
IF parser.sym = SCAN.lxTYPE THEN
Next(parser);
WHILE parser.sym = SCAN.lxIDENT DO
ConstTypeDeclaration(parser, FALSE)
END
END;
ptr := PROG.linkPtr(parser.unit);
IF ptr # NIL THEN
pos.line := ptr.pos.line;
pos.col := ptr.pos.col;
pos.parser := parser;
IF ptr.notRecord THEN
error(pos, 58)
ELSE
error(pos, 48)
END
END;
IF parser.sym = SCAN.lxVAR THEN
Next(parser);
IF parser.sym = SCAN.lxIDENT THEN
VarDeclaration(parser)
END
END;
endmod := FALSE;
WHILE ~endmod & (parser.sym = SCAN.lxPROCEDURE) DO
Next(parser);
endmod := ProcDeclaration(parser)
END
RETURN endmod
END DeclarationSequence;
PROCEDURE parse (parser: PARSER);
VAR
unit: PROG.UNIT;
label: INTEGER;
name: INTEGER;
endmod: BOOLEAN;
errlabel: INTEGER;
errno: INTEGER;
BEGIN
ASSERT(parser # NIL);
ASSERT(parser.scanner # NIL);
ExpectSym(parser, SCAN.lxMODULE);
ExpectSym(parser, SCAN.lxIDENT);
IF ~parser.main THEN
check1(parser.lex.s = parser.modname, parser, 23)
END;
unit := PROG.newUnit(program, parser.lex.ident);
parser.unit := unit;
ExpectSym(parser, SCAN.lxSEMI);
Next(parser);
IF parser.sym = SCAN.lxIMPORT THEN
ImportList(parser)
END;
INC(modules);
CONSOLE.String("compiling ");
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN
CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ")
END;
CONSOLE.String(unit.name.s);
IF parser.unit.sysimport THEN
CONSOLE.String(" (SYSTEM)")
END;
CONSOLE.Ln;
label := IL.NewLabel();
IL.AddJmpCmd(IL.opJMP, label);
name := IL.putstr(unit.name.s);
errlabel := IL.NewLabel();
IL.SetLabel(errlabel);
IL.StrAdr(name);
IL.Param1;
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN
IL.AddCmd(IL.opPUSHC, modules)
END;
IL.AddCmd0(IL.opERR);
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
IL.SetErrLabel(errno);
IL.AddCmd(IL.opPUSHC, errno);
IL.AddJmpCmd(IL.opJMP, errlabel)
END;
endmod := DeclarationSequence(parser);
IL.SetLabel(label);
IF ~endmod THEN
IF parser.sym = SCAN.lxBEGIN THEN
Next(parser);
parser.StatSeq(parser)
END;
checklex(parser, SCAN.lxEND);
ExpectSym(parser, SCAN.lxIDENT);
check1(parser.lex.s = unit.name.s, parser, 25);
ExpectSym(parser, SCAN.lxPOINT)
END;
INC(lines, parser.lex.pos.line);
PROG.closeUnit(unit)
END parse;
PROCEDURE open (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
BEGIN
ASSERT(parser # NIL);
STRINGS.append(parser.fname, modname);
STRINGS.append(parser.fname, parser.ext);
STRINGS.append(parser.modname, modname);
parser.scanner := SCAN.open(parser.fname)
RETURN parser.scanner # NIL
END open;
PROCEDURE NewParser (): PARSER;
VAR
pars: PARSER;
citem: C.ITEM;
BEGIN
citem := C.pop(parsers);
IF citem = NIL THEN
NEW(pars)
ELSE
pars := citem(PARSER)
END
RETURN pars
END NewParser;
PROCEDURE create* (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER;
VAR
parser: PARSER;
BEGIN
parser := NewParser();
parser.path := path;
parser.lib_path := lib_path;
parser.ext := UTILS.FILE_EXT;
parser.fname := path;
parser.modname := "";
parser.scanner := NIL;
parser.unit := NIL;
parser.constexp := FALSE;
parser.main := FALSE;
parser.open := open;
parser.parse := parse;
parser.StatSeq := StatSeq;
parser.expression := expression;
parser.designator := designator;
parser.chkreturn := chkreturn;
parser.create := create
RETURN parser
END create;
PROCEDURE init* (options: PROG.OPTIONS);
BEGIN
program := PROG.create(options);
parsers := C.create();
lines := 0;
modules := 0
END init;
END PARS.