forked from KolibriOS/kolibrios
3352 lines
100 KiB
Plaintext
3352 lines
100 KiB
Plaintext
(*
|
|
BSD 2-Clause License
|
|
|
|
Copyright (c) 2018-2020, Anton Krotov
|
|
All rights reserved.
|
|
*)
|
|
|
|
MODULE STATEMENTS;
|
|
|
|
IMPORT
|
|
|
|
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB,
|
|
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
|
|
|
|
|
|
CONST
|
|
|
|
eCONST = PARS.eCONST; eTYPE = PARS.eTYPE; eVAR = PARS.eVAR;
|
|
eEXPR = PARS.eEXPR; eVREC = PARS.eVREC; ePROC = PARS.ePROC;
|
|
eVPAR = PARS.eVPAR; ePARAM = PARS.ePARAM; eSTPROC = PARS.eSTPROC;
|
|
eSTFUNC = PARS.eSTFUNC; eSYSFUNC = PARS.eSYSFUNC; eSYSPROC = PARS.eSYSPROC;
|
|
eIMP = PARS.eIMP;
|
|
|
|
errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4;
|
|
errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8;
|
|
errCHR = 9; errWCHR = 10; errBYTE = 11;
|
|
|
|
chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
|
|
|
|
chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};
|
|
|
|
|
|
TYPE
|
|
|
|
isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;
|
|
|
|
RANGE = RECORD
|
|
|
|
a, b: INTEGER
|
|
|
|
END;
|
|
|
|
CASE_LABEL = POINTER TO rCASE_LABEL;
|
|
|
|
rCASE_LABEL = RECORD (AVL.DATA)
|
|
|
|
range: RANGE;
|
|
|
|
variant, self: INTEGER;
|
|
|
|
type: PROG.TYPE_;
|
|
|
|
prev: CASE_LABEL
|
|
|
|
END;
|
|
|
|
CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)
|
|
|
|
label: INTEGER;
|
|
cmd: IL.COMMAND;
|
|
processed: BOOLEAN
|
|
|
|
END;
|
|
|
|
|
|
VAR
|
|
|
|
Options: PROG.OPTIONS;
|
|
|
|
begcall, endcall: IL.COMMAND;
|
|
|
|
CaseLabels, CaseVar: C.COLLECTION;
|
|
|
|
CaseVariants: LISTS.LIST;
|
|
|
|
CPU: INTEGER;
|
|
|
|
tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_;
|
|
|
|
|
|
PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
|
|
RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}
|
|
END isExpr;
|
|
|
|
|
|
PROCEDURE isVar (e: PARS.EXPR): BOOLEAN;
|
|
RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC}
|
|
END isVar;
|
|
|
|
|
|
PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type = tBOOLEAN)
|
|
END isBoolean;
|
|
|
|
|
|
PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type = tINTEGER)
|
|
END isInteger;
|
|
|
|
|
|
PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type = tBYTE)
|
|
END isByte;
|
|
|
|
|
|
PROCEDURE isInt (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isByte(e) OR isInteger(e)
|
|
END isInt;
|
|
|
|
|
|
PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type = tREAL)
|
|
END isReal;
|
|
|
|
|
|
PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type = tSET)
|
|
END isSet;
|
|
|
|
|
|
PROCEDURE isString (e: PARS.EXPR): BOOLEAN;
|
|
RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR})
|
|
END isString;
|
|
|
|
|
|
PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;
|
|
RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
|
|
END isStringW;
|
|
|
|
|
|
PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type = tCHAR)
|
|
END isChar;
|
|
|
|
|
|
PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type = tWCHAR)
|
|
END isCharW;
|
|
|
|
|
|
PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER)
|
|
END isPtr;
|
|
|
|
|
|
PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type.typ = PROG.tRECORD)
|
|
END isRec;
|
|
|
|
|
|
PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isRec(e) OR isPtr(e)
|
|
END isRecPtr;
|
|
|
|
|
|
PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY)
|
|
END isArr;
|
|
|
|
|
|
PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
|
|
END isProc;
|
|
|
|
|
|
PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;
|
|
RETURN e.type.typ = PROG.tNIL
|
|
END isNil;
|
|
|
|
|
|
PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isArr(e) & (e.type.base = tCHAR)
|
|
END isCharArray;
|
|
|
|
|
|
PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isArr(e) & (e.type.base = tWCHAR)
|
|
END isCharArrayW;
|
|
|
|
|
|
PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
|
|
RETURN isCharArray(e) OR isCharArrayW(e)
|
|
END isCharArrayX;
|
|
|
|
|
|
PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
|
|
BEGIN
|
|
pos.line := parser.lex.pos.line;
|
|
pos.col := parser.lex.pos.col;
|
|
pos.parser := parser
|
|
END getpos;
|
|
|
|
|
|
PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
|
|
BEGIN
|
|
PARS.Next(parser);
|
|
getpos(parser, pos)
|
|
END NextPos;
|
|
|
|
|
|
PROCEDURE strlen (e: PARS.EXPR): INTEGER;
|
|
VAR
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
ASSERT(isString(e));
|
|
IF e.type = tCHAR THEN
|
|
res := 1
|
|
ELSE
|
|
res := LENGTH(e.value.string(SCAN.IDENT).s)
|
|
END
|
|
RETURN res
|
|
END strlen;
|
|
|
|
|
|
PROCEDURE _length (s: ARRAY OF CHAR): INTEGER;
|
|
VAR
|
|
i, res: INTEGER;
|
|
|
|
BEGIN
|
|
i := 0;
|
|
res := 0;
|
|
WHILE (i < LEN(s)) & (s[i] # 0X) DO
|
|
IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN
|
|
INC(res)
|
|
END;
|
|
INC(i)
|
|
END
|
|
|
|
RETURN res
|
|
END _length;
|
|
|
|
|
|
PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER;
|
|
VAR
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
ASSERT(isStringW(e));
|
|
IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
|
|
res := 1
|
|
ELSE
|
|
res := _length(e.value.string(SCAN.IDENT).s)
|
|
END
|
|
RETURN res
|
|
END utf8strlen;
|
|
|
|
|
|
PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER;
|
|
VAR
|
|
res: ARRAY 2 OF WCHAR;
|
|
|
|
BEGIN
|
|
ASSERT(STRINGS.Utf8To16(s, res) = 1)
|
|
RETURN ORD(res[0])
|
|
END StrToWChar;
|
|
|
|
|
|
PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN;
|
|
RETURN (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
|
|
END isStringW1;
|
|
|
|
|
|
PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN;
|
|
VAR
|
|
res: BOOLEAN;
|
|
|
|
BEGIN
|
|
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
|
|
|
|
IF t = e.type THEN
|
|
res := TRUE
|
|
ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
|
|
IF (e.obj = eCONST) & (t = tBYTE) THEN
|
|
res := ARITH.range(e.value, 0, 255)
|
|
ELSE
|
|
res := TRUE
|
|
END
|
|
ELSIF
|
|
(e.obj = eCONST) & isChar(e) & (t = tWCHAR)
|
|
OR isStringW1(e) & (t = tWCHAR)
|
|
OR PROG.isBaseOf(t, e.type)
|
|
OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type)
|
|
OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE})
|
|
OR PROG.arrcomp(e.type, t)
|
|
OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))
|
|
OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))
|
|
THEN
|
|
res := TRUE
|
|
ELSE
|
|
res := FALSE
|
|
END
|
|
ELSE
|
|
res := FALSE
|
|
END
|
|
|
|
RETURN res
|
|
END assigncomp;
|
|
|
|
|
|
PROCEDURE String (e: PARS.EXPR): INTEGER;
|
|
VAR
|
|
offset: INTEGER;
|
|
string: SCAN.IDENT;
|
|
|
|
BEGIN
|
|
IF strlen(e) # 1 THEN
|
|
string := e.value.string(SCAN.IDENT);
|
|
IF string.offset = -1 THEN
|
|
string.offset := IL.putstr(string.s);
|
|
END;
|
|
offset := string.offset
|
|
ELSE
|
|
offset := IL.putstr1(ARITH.Int(e.value))
|
|
END
|
|
|
|
RETURN offset
|
|
END String;
|
|
|
|
|
|
PROCEDURE StringW (e: PARS.EXPR): INTEGER;
|
|
VAR
|
|
offset: INTEGER;
|
|
string: SCAN.IDENT;
|
|
|
|
BEGIN
|
|
IF utf8strlen(e) # 1 THEN
|
|
string := e.value.string(SCAN.IDENT);
|
|
IF string.offsetW = -1 THEN
|
|
string.offsetW := IL.putstrW(string.s);
|
|
END;
|
|
offset := string.offsetW
|
|
ELSE
|
|
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);
|
|
IF string.offsetW = -1 THEN
|
|
string.offsetW := IL.putstrW(string.s);
|
|
END;
|
|
offset := string.offsetW
|
|
END
|
|
END
|
|
|
|
RETURN offset
|
|
END StringW;
|
|
|
|
|
|
PROCEDURE CheckRange (range, line, errno: INTEGER);
|
|
VAR
|
|
label: INTEGER;
|
|
|
|
BEGIN
|
|
label := IL.NewLabel();
|
|
IL.AddCmd2(IL.opCHKIDX, label, range);
|
|
IL.OnError(line, errno);
|
|
IL.SetLabel(label)
|
|
END CheckRange;
|
|
|
|
|
|
PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN;
|
|
VAR
|
|
res: BOOLEAN;
|
|
label: INTEGER;
|
|
|
|
BEGIN
|
|
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
|
|
res := TRUE;
|
|
IF PROG.arrcomp(e.type, VarType) THEN
|
|
|
|
IF ~PROG.isOpenArray(VarType) THEN
|
|
IL.Const(VarType.length)
|
|
END;
|
|
IL.AddCmd(IL.opCOPYA, VarType.base.size);
|
|
label := IL.NewLabel();
|
|
IL.AddJmpCmd(IL.opJE, label);
|
|
IL.OnError(line, errCOPY);
|
|
IL.SetLabel(label)
|
|
|
|
ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
|
|
IF VarType = tINTEGER THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opSAVE)
|
|
END
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
res := ARITH.range(e.value, 0, 255);
|
|
IF res THEN
|
|
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
|
|
END
|
|
ELSE
|
|
IF chkBYTE IN Options.checking THEN
|
|
label := IL.NewLabel();
|
|
IL.AddCmd2(IL.opCHKBYTE, label, 0);
|
|
IL.OnError(line, errBYTE);
|
|
IL.SetLabel(label)
|
|
END;
|
|
IL.AddCmd0(IL.opSAVE8)
|
|
END
|
|
END
|
|
ELSIF isSet(e) & (VarType = tSET) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opSAVE)
|
|
END
|
|
ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opSBOOL)
|
|
END
|
|
ELSIF isReal(e) & (VarType = tREAL) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e.value))
|
|
END;
|
|
IL.savef(e.obj = eCONST)
|
|
ELSIF isChar(e) & (VarType = tCHAR) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opSAVE8)
|
|
END
|
|
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))
|
|
ELSIF isCharW(e) & (VarType = tWCHAR) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opSAVE16)
|
|
END
|
|
ELSIF PROG.isBaseOf(VarType, e.type) THEN
|
|
IF VarType.typ = PROG.tPOINTER THEN
|
|
IL.AddCmd0(IL.opSAVE)
|
|
ELSE
|
|
IL.AddCmd(IL.opCOPY, VarType.size)
|
|
END
|
|
ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
|
|
IL.AddCmd0(IL.opSAVE32)
|
|
ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN
|
|
IF e.obj = ePROC THEN
|
|
IL.AssignProc(e.ident.proc.label)
|
|
ELSIF e.obj = eIMP THEN
|
|
IL.AssignImpProc(e.ident.import)
|
|
ELSE
|
|
IF VarType.typ = PROG.tPROCEDURE THEN
|
|
IL.AddCmd0(IL.opSAVE)
|
|
ELSE
|
|
IL.AddCmd(IL.opCOPY, VarType.size)
|
|
END
|
|
END
|
|
ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
|
|
IL.AddCmd(IL.opSAVEC, 0)
|
|
ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN
|
|
IL.saves(String(e), strlen(e) + 1)
|
|
ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN
|
|
IL.saves(StringW(e), (utf8strlen(e) + 1) * 2)
|
|
ELSE
|
|
res := FALSE
|
|
END
|
|
ELSE
|
|
res := FALSE
|
|
END
|
|
RETURN res
|
|
END assign;
|
|
|
|
|
|
PROCEDURE LoadConst (e: PARS.EXPR);
|
|
BEGIN
|
|
IL.Const(ARITH.Int(e.value))
|
|
END LoadConst;
|
|
|
|
|
|
PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM);
|
|
VAR
|
|
stroffs: INTEGER;
|
|
|
|
PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
|
|
VAR
|
|
t1, t2: PROG.TYPE_;
|
|
|
|
BEGIN
|
|
t1 := p.type;
|
|
t2 := e.type;
|
|
WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO
|
|
t1 := t1.base;
|
|
t2 := t2.base
|
|
END
|
|
|
|
RETURN PROG.isTypeEq(t1, t2)
|
|
END arrcomp;
|
|
|
|
|
|
PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER;
|
|
VAR
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
REPEAT
|
|
res := t.length;
|
|
t := t.base;
|
|
DEC(n)
|
|
UNTIL (n < 0) OR (t.typ # PROG.tARRAY);
|
|
ASSERT(n < 0)
|
|
RETURN res
|
|
END ArrLen;
|
|
|
|
|
|
PROCEDURE OpenArray (t, t2: PROG.TYPE_);
|
|
VAR
|
|
n, d1, d2: INTEGER;
|
|
|
|
BEGIN
|
|
IF t.length # 0 THEN
|
|
IL.Param1;
|
|
n := PROG.Dim(t2) - 1;
|
|
WHILE n >= 0 DO
|
|
IL.Const(ArrLen(t, n));
|
|
IL.Param1;
|
|
DEC(n)
|
|
END
|
|
ELSE
|
|
d1 := PROG.Dim(t);
|
|
d2 := PROG.Dim(t2);
|
|
IF d1 # d2 THEN
|
|
n := d2 - d1;
|
|
WHILE d2 > d1 DO
|
|
IL.Const(ArrLen(t, d2 - 1));
|
|
DEC(d2)
|
|
END;
|
|
d2 := PROG.Dim(t2);
|
|
WHILE n > 0 DO
|
|
IL.AddCmd(IL.opROT, d2);
|
|
DEC(n)
|
|
END
|
|
END;
|
|
IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1)
|
|
END
|
|
END OpenArray;
|
|
|
|
|
|
BEGIN
|
|
IF p.vPar THEN
|
|
|
|
PARS.check(isVar(e), pos, 93);
|
|
IF p.type.typ = PROG.tRECORD THEN
|
|
PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66);
|
|
IF e.obj = eVREC THEN
|
|
IF e.ident # NIL THEN
|
|
IL.AddCmd(IL.opVADR, e.ident.offset - 1)
|
|
ELSE
|
|
IL.AddCmd0(IL.opPUSHT)
|
|
END
|
|
ELSE
|
|
IL.Const(e.type.num)
|
|
END;
|
|
IL.AddCmd(IL.opPARAM, 2)
|
|
ELSIF PROG.isOpenArray(p.type) THEN
|
|
PARS.check(arrcomp(e, p), pos, 66);
|
|
OpenArray(e.type, p.type)
|
|
ELSE
|
|
PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66);
|
|
IL.Param1
|
|
END;
|
|
PARS.check(~e.readOnly, pos, 94)
|
|
|
|
ELSE
|
|
PARS.check(isExpr(e) OR isProc(e), pos, 66);
|
|
IF PROG.isOpenArray(p.type) THEN
|
|
IF e.type.typ = PROG.tARRAY THEN
|
|
PARS.check(arrcomp(e, p), pos, 66);
|
|
OpenArray(e.type, p.type)
|
|
ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN
|
|
IL.StrAdr(String(e));
|
|
IL.Param1;
|
|
IL.Const(strlen(e) + 1);
|
|
IL.Param1
|
|
ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tWCHAR) THEN
|
|
IL.StrAdr(StringW(e));
|
|
IL.Param1;
|
|
IL.Const(utf8strlen(e) + 1);
|
|
IL.Param1
|
|
ELSE
|
|
PARS.error(pos, 66)
|
|
END
|
|
ELSE
|
|
PARS.check(~PROG.isOpenArray(e.type), pos, 66);
|
|
PARS.check(assigncomp(e, p.type), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
IF e.type = tREAL THEN
|
|
IL.Float(ARITH.Float(e.value));
|
|
IL.pushf
|
|
ELSIF e.type.typ = PROG.tNIL THEN
|
|
IL.Const(0);
|
|
IL.Param1
|
|
ELSIF isStringW1(e) & (p.type = tWCHAR) THEN
|
|
IL.Const(StrToWChar(e.value.string(SCAN.IDENT).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
|
|
IF p.type.base = tCHAR THEN
|
|
stroffs := String(e);
|
|
IL.StrAdr(stroffs);
|
|
IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
|
|
ERRORS.WarningMsg(pos.line, pos.col, 0)
|
|
END
|
|
ELSE (* WCHAR *)
|
|
stroffs := StringW(e);
|
|
IL.StrAdr(stroffs)
|
|
END;
|
|
IL.set_dmin(stroffs + p.type.size);
|
|
IL.Param1
|
|
ELSE
|
|
LoadConst(e);
|
|
IL.Param1
|
|
END
|
|
ELSIF e.obj = ePROC THEN
|
|
PARS.check(e.ident.global, pos, 85);
|
|
IL.PushProc(e.ident.proc.label);
|
|
IL.Param1
|
|
ELSIF e.obj = eIMP THEN
|
|
IL.PushImpProc(e.ident.import);
|
|
IL.Param1
|
|
ELSIF isExpr(e) & (e.type = tREAL) THEN
|
|
IL.pushf
|
|
ELSE
|
|
IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN
|
|
CheckRange(256, pos.line, errBYTE)
|
|
END;
|
|
IL.Param1
|
|
END
|
|
END
|
|
|
|
END
|
|
END paramcomp;
|
|
|
|
|
|
PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
BEGIN
|
|
parser.expression(parser, e)
|
|
END PExpression;
|
|
|
|
|
|
PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
e1, e2: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
proc,
|
|
label,
|
|
n, i: INTEGER;
|
|
code: ARITH.VALUE;
|
|
wchar,
|
|
comma: BOOLEAN;
|
|
cmd1,
|
|
cmd2: IL.COMMAND;
|
|
|
|
|
|
PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
|
|
BEGIN
|
|
parser.designator(parser, e);
|
|
PARS.check(isVar(e), pos, 93);
|
|
PARS.check(isfunc(e), pos, 66);
|
|
IF readOnly THEN
|
|
PARS.check(~e.readOnly, pos, 94)
|
|
END
|
|
END varparam;
|
|
|
|
|
|
PROCEDURE shift_minmax (proc: INTEGER): CHAR;
|
|
VAR
|
|
res: CHAR;
|
|
|
|
BEGIN
|
|
CASE proc OF
|
|
|PROG.stASR: res := "A"
|
|
|PROG.stLSL: res := "L"
|
|
|PROG.stROR: res := "O"
|
|
|PROG.stLSR: res := "R"
|
|
|PROG.stMIN: res := "m"
|
|
|PROG.stMAX: res := "x"
|
|
END
|
|
RETURN res
|
|
END shift_minmax;
|
|
|
|
|
|
BEGIN
|
|
ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC});
|
|
proc := e.stproc;
|
|
|
|
(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
|
|
PARS.checklex(parser, SCAN.lxLROUND);
|
|
PARS.Next(parser);
|
|
(* END; *)
|
|
|
|
getpos(parser, pos);
|
|
|
|
IF e.obj IN {eSYSPROC, eSYSFUNC} THEN
|
|
IF parser.unit.scopeLvl > 0 THEN
|
|
parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE
|
|
END
|
|
END;
|
|
|
|
IF e.obj IN {eSTPROC, eSYSPROC} THEN
|
|
|
|
CASE proc OF
|
|
|PROG.stASSERT:
|
|
PExpression(parser, e);
|
|
PARS.check(isBoolean(e), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
IF ~ARITH.getBool(e.value) THEN
|
|
IL.OnError(pos.line, errASSERT)
|
|
END
|
|
ELSE
|
|
label := IL.NewLabel();
|
|
IL.AddJmpCmd(IL.opJE, label);
|
|
IL.OnError(pos.line, errASSERT);
|
|
IL.SetLabel(label)
|
|
END
|
|
|
|
|PROG.stINC, PROG.stDEC:
|
|
IL.pushBegEnd(begcall, endcall);
|
|
varparam(parser, pos, isInt, TRUE, e);
|
|
IF e.type = tINTEGER THEN
|
|
IF parser.sym = SCAN.lxCOMMA THEN
|
|
NextPos(parser, pos);
|
|
IL.setlast(begcall);
|
|
PExpression(parser, e2);
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
PARS.check(isInt(e2), pos, 66);
|
|
IF e2.obj = eCONST THEN
|
|
IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1))
|
|
ELSE
|
|
IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC))
|
|
END
|
|
ELSE
|
|
IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1)
|
|
END
|
|
ELSE (* e.type = tBYTE *)
|
|
IF parser.sym = SCAN.lxCOMMA THEN
|
|
NextPos(parser, pos);
|
|
IL.setlast(begcall);
|
|
PExpression(parser, e2);
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
PARS.check(isInt(e2), pos, 66);
|
|
IF e2.obj = eCONST THEN
|
|
IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC))
|
|
END
|
|
ELSE
|
|
IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1)
|
|
END
|
|
END;
|
|
IL.popBegEnd(begcall, endcall)
|
|
|
|
|PROG.stINCL, PROG.stEXCL:
|
|
IL.pushBegEnd(begcall, endcall);
|
|
varparam(parser, pos, isSet, TRUE, e);
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos);
|
|
IL.setlast(begcall);
|
|
PExpression(parser, e2);
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
PARS.check(isInt(e2), pos, 66);
|
|
IF e2.obj = eCONST THEN
|
|
PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56);
|
|
IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL))
|
|
END;
|
|
IL.popBegEnd(begcall, endcall)
|
|
|
|
|PROG.stNEW:
|
|
varparam(parser, pos, isPtr, TRUE, e);
|
|
IF CPU = TARGETS.cpuMSP430 THEN
|
|
PARS.check(e.type.base.size + 16 < Options.ram, pos, 63)
|
|
END;
|
|
IL.New(e.type.base.size, e.type.base.num)
|
|
|
|
|PROG.stDISPOSE:
|
|
varparam(parser, pos, isPtr, TRUE, e);
|
|
IL.AddCmd0(IL.opDISP)
|
|
|
|
|PROG.stPACK:
|
|
varparam(parser, pos, isReal, TRUE, e);
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos);
|
|
PExpression(parser, e2);
|
|
PARS.check(isInt(e2), pos, 66);
|
|
IF e2.obj = eCONST THEN
|
|
IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opPACK)
|
|
END
|
|
|
|
|PROG.stUNPK:
|
|
varparam(parser, pos, isReal, TRUE, e);
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos);
|
|
varparam(parser, pos, isInteger, TRUE, e2);
|
|
IL.AddCmd0(IL.opUNPK)
|
|
|
|
|PROG.stCOPY:
|
|
IL.pushBegEnd(begcall, endcall);
|
|
PExpression(parser, e);
|
|
IF isString(e) OR isCharArray(e) THEN
|
|
wchar := FALSE
|
|
ELSIF isStringW(e) OR isCharArrayW(e) THEN
|
|
wchar := TRUE
|
|
ELSE
|
|
PARS.error(pos, 66)
|
|
END;
|
|
|
|
IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN
|
|
IL.Const(e.type.length)
|
|
END;
|
|
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos);
|
|
IL.setlast(begcall);
|
|
|
|
IF wchar THEN
|
|
varparam(parser, pos, isCharArrayW, TRUE, e1)
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
varparam(parser, pos, isCharArrayX, TRUE, e1)
|
|
ELSE
|
|
varparam(parser, pos, isCharArray, TRUE, e1)
|
|
END;
|
|
|
|
wchar := e1.type.base = tWCHAR
|
|
END;
|
|
|
|
IF ~PROG.isOpenArray(e1.type) THEN
|
|
IL.Const(e1.type.length)
|
|
END;
|
|
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
|
|
IF e.obj = eCONST THEN
|
|
IF wchar THEN
|
|
IL.StrAdr(StringW(e));
|
|
IL.Const(utf8strlen(e) + 1)
|
|
ELSE
|
|
IL.StrAdr(String(e));
|
|
IL.Const(strlen(e) + 1)
|
|
END
|
|
END;
|
|
IL.AddCmd(IL.opCOPYS, e1.type.base.size);
|
|
IL.popBegEnd(begcall, endcall)
|
|
|
|
|PROG.sysGET:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos);
|
|
parser.designator(parser, e2);
|
|
PARS.check(isVar(e2), pos, 93);
|
|
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size)
|
|
ELSE
|
|
IL.AddCmd(IL.opGET, e2.type.size)
|
|
END
|
|
|
|
|PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
|
|
IL.pushBegEnd(begcall, endcall);
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
LoadConst(e)
|
|
END;
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos);
|
|
IL.setlast(begcall);
|
|
PExpression(parser, e2);
|
|
PARS.check(isExpr(e2), pos, 66);
|
|
|
|
IF proc = PROG.sysPUT THEN
|
|
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
|
|
IF e2.obj = eCONST THEN
|
|
IF e2.type = tREAL THEN
|
|
IL.Float(ARITH.Float(e2.value));
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
IL.savef(FALSE)
|
|
ELSE
|
|
LoadConst(e2);
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
IL.SysPut(e2.type.size)
|
|
END
|
|
ELSE
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
IF e2.type = tREAL THEN
|
|
IL.savef(FALSE)
|
|
ELSIF e2.type = tBYTE THEN
|
|
IL.SysPut(tINTEGER.size)
|
|
ELSE
|
|
IL.SysPut(e2.type.size)
|
|
END
|
|
END
|
|
|
|
ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
|
|
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
|
|
IF e2.obj = eCONST THEN
|
|
LoadConst(e2)
|
|
END;
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
CASE proc OF
|
|
|PROG.sysPUT8: IL.SysPut(1)
|
|
|PROG.sysPUT16: IL.SysPut(2)
|
|
|PROG.sysPUT32: IL.SysPut(4)
|
|
END
|
|
|
|
END;
|
|
IL.popBegEnd(begcall, endcall)
|
|
|
|
|PROG.sysMOVE:
|
|
FOR i := 1 TO 2 DO
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
LoadConst(e)
|
|
END;
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos)
|
|
END;
|
|
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
LoadConst(e)
|
|
END;
|
|
IL.AddCmd0(IL.opMOVE)
|
|
|
|
|PROG.sysCOPY:
|
|
FOR i := 1 TO 2 DO
|
|
parser.designator(parser, e);
|
|
PARS.check(isVar(e), pos, 93);
|
|
n := PROG.Dim(e.type);
|
|
WHILE n > 0 DO
|
|
IL.drop;
|
|
DEC(n)
|
|
END;
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos)
|
|
END;
|
|
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
LoadConst(e)
|
|
END;
|
|
IL.AddCmd0(IL.opMOVE)
|
|
|
|
|PROG.sysCODE:
|
|
REPEAT
|
|
getpos(parser, pos);
|
|
PARS.ConstExpression(parser, code);
|
|
PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
|
|
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
|
|
PARS.check(ARITH.range(code, 0, 255), pos, 42)
|
|
ELSIF CPU = TARGETS.cpuTHUMB THEN
|
|
PARS.check(ARITH.range(code, 0, 65535), pos, 110)
|
|
END;
|
|
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
|
|
comma := parser.sym = SCAN.lxCOMMA;
|
|
IF comma THEN
|
|
PARS.Next(parser)
|
|
ELSE
|
|
PARS.checklex(parser, SCAN.lxRROUND)
|
|
END
|
|
UNTIL (parser.sym = SCAN.lxRROUND) & ~comma
|
|
(*
|
|
|PROG.sysNOP, PROG.sysDINT, PROG.sysEINT:
|
|
IF parser.sym = SCAN.lxLROUND THEN
|
|
PARS.Next(parser);
|
|
PARS.checklex(parser, SCAN.lxRROUND);
|
|
PARS.Next(parser)
|
|
END;
|
|
ASSERT(CPU = cpuMSP430);
|
|
CASE proc OF
|
|
|PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H)
|
|
|PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H)
|
|
|PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H)
|
|
END
|
|
*)
|
|
END;
|
|
|
|
e.obj := eEXPR;
|
|
e.type := NIL
|
|
|
|
ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN
|
|
|
|
CASE e.stproc OF
|
|
|PROG.stABS:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e) OR isReal(e), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
PARS.check(ARITH.abs(e.value), pos, 39)
|
|
ELSE
|
|
IL.abs(isReal(e))
|
|
END
|
|
|
|
|PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
NextPos(parser, pos);
|
|
PExpression(parser, e2);
|
|
PARS.check(isInt(e2), pos, 66);
|
|
e.type := tINTEGER;
|
|
IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
|
|
ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
|
|
ELSIF e2.obj = eCONST THEN
|
|
IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
|
|
ELSE
|
|
IL.shift_minmax(shift_minmax(proc))
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
|PROG.stCHR:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
e.type := tCHAR;
|
|
IF e.obj = eCONST THEN
|
|
ARITH.setChar(e.value, ARITH.getInt(e.value));
|
|
PARS.check(ARITH.check(e.value), pos, 107)
|
|
ELSE
|
|
IF chkCHR IN Options.checking THEN
|
|
CheckRange(256, pos.line, errCHR)
|
|
ELSE
|
|
IL.AddCmd0(IL.opCHR)
|
|
END
|
|
END
|
|
|
|
|PROG.stWCHR:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
e.type := tWCHAR;
|
|
IF e.obj = eCONST THEN
|
|
ARITH.setWChar(e.value, ARITH.getInt(e.value));
|
|
PARS.check(ARITH.check(e.value), pos, 101)
|
|
ELSE
|
|
IF chkWCHR IN Options.checking THEN
|
|
CheckRange(65536, pos.line, errWCHR)
|
|
ELSE
|
|
IL.AddCmd0(IL.opWCHR)
|
|
END
|
|
END
|
|
|
|
|PROG.stFLOOR:
|
|
PExpression(parser, e);
|
|
PARS.check(isReal(e), pos, 66);
|
|
e.type := tINTEGER;
|
|
IF e.obj = eCONST THEN
|
|
PARS.check(ARITH.floor(e.value), pos, 39)
|
|
ELSE
|
|
IL.floor
|
|
END
|
|
|
|
|PROG.stFLT:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
e.type := tREAL;
|
|
IF e.obj = eCONST THEN
|
|
ARITH.flt(e.value)
|
|
ELSE
|
|
PARS.check(IL.flt(), pos, 41)
|
|
END
|
|
|
|
|PROG.stLEN:
|
|
cmd1 := IL.getlast();
|
|
varparam(parser, pos, isArr, FALSE, e);
|
|
IF e.type.length > 0 THEN
|
|
cmd2 := IL.getlast();
|
|
IL.delete2(cmd1.next, cmd2);
|
|
IL.setlast(cmd1);
|
|
ASSERT(ARITH.setInt(e.value, e.type.length));
|
|
e.obj := eCONST
|
|
ELSE
|
|
IL.len(PROG.Dim(e.type))
|
|
END;
|
|
e.type := tINTEGER
|
|
|
|
|PROG.stLENGTH:
|
|
PExpression(parser, e);
|
|
IF isCharArray(e) THEN
|
|
IF e.type.length > 0 THEN
|
|
IL.Const(e.type.length)
|
|
END;
|
|
IL.AddCmd0(IL.opLENGTH)
|
|
ELSIF isCharArrayW(e) THEN
|
|
IF e.type.length > 0 THEN
|
|
IL.Const(e.type.length)
|
|
END;
|
|
IL.AddCmd0(IL.opLENGTHW)
|
|
ELSE
|
|
PARS.error(pos, 66);
|
|
END;
|
|
e.type := tINTEGER
|
|
|
|
|PROG.stODD:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
e.type := tBOOLEAN;
|
|
IF e.obj = eCONST THEN
|
|
ARITH.odd(e.value)
|
|
ELSE
|
|
IL.AddCmd(IL.opMODR, 2)
|
|
END
|
|
|
|
|PROG.stORD:
|
|
PExpression(parser, e);
|
|
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)))
|
|
ELSE
|
|
ARITH.ord(e.value)
|
|
END
|
|
ELSE
|
|
IF isBoolean(e) THEN
|
|
IL.AddCmd0(IL.opORD)
|
|
END
|
|
END;
|
|
e.type := tINTEGER
|
|
|
|
|PROG.stBITS:
|
|
PExpression(parser, e);
|
|
PARS.check(isInt(e), pos, 66);
|
|
IF e.obj = eCONST THEN
|
|
ARITH.bits(e.value)
|
|
END;
|
|
e.type := tSET
|
|
|
|
|PROG.sysADR:
|
|
parser.designator(parser, e);
|
|
IF isVar(e) THEN
|
|
n := PROG.Dim(e.type);
|
|
WHILE n > 0 DO
|
|
IL.drop;
|
|
DEC(n)
|
|
END
|
|
ELSIF e.obj = ePROC THEN
|
|
IL.PushProc(e.ident.proc.label)
|
|
ELSIF e.obj = eIMP THEN
|
|
IL.PushImpProc(e.ident.import)
|
|
ELSE
|
|
PARS.error(pos, 108)
|
|
END;
|
|
e.type := tINTEGER
|
|
|
|
|PROG.sysSADR:
|
|
PExpression(parser, e);
|
|
PARS.check(isString(e), pos, 66);
|
|
IL.StrAdr(String(e));
|
|
e.type := tINTEGER;
|
|
e.obj := eEXPR
|
|
|
|
|PROG.sysWSADR:
|
|
PExpression(parser, e);
|
|
PARS.check(isStringW(e), pos, 66);
|
|
IL.StrAdr(StringW(e));
|
|
e.type := tINTEGER;
|
|
e.obj := eEXPR
|
|
|
|
|PROG.sysTYPEID:
|
|
PExpression(parser, e);
|
|
PARS.check(e.obj = eTYPE, pos, 68);
|
|
IF e.type.typ = PROG.tRECORD THEN
|
|
ASSERT(ARITH.setInt(e.value, e.type.num))
|
|
ELSIF e.type.typ = PROG.tPOINTER THEN
|
|
ASSERT(ARITH.setInt(e.value, e.type.base.num))
|
|
ELSE
|
|
PARS.error(pos, 52)
|
|
END;
|
|
e.obj := eCONST;
|
|
e.type := tINTEGER
|
|
|
|
|PROG.sysINF:
|
|
PARS.check(IL.inf(), pos, 41);
|
|
e.obj := eEXPR;
|
|
e.type := tREAL
|
|
|
|
|PROG.sysSIZE:
|
|
PExpression(parser, e);
|
|
PARS.check(e.obj = eTYPE, pos, 68);
|
|
ASSERT(ARITH.setInt(e.value, e.type.size));
|
|
e.obj := eCONST;
|
|
e.type := tINTEGER
|
|
|
|
END
|
|
|
|
END;
|
|
|
|
(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
|
|
PARS.checklex(parser, SCAN.lxRROUND);
|
|
PARS.Next(parser);
|
|
(* END; *)
|
|
|
|
IF e.obj # eCONST THEN
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
END stProc;
|
|
|
|
|
|
PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
proc: PROG.TYPE_;
|
|
param: LISTS.ITEM;
|
|
e1: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
|
|
BEGIN
|
|
ASSERT(parser.sym = SCAN.lxLROUND);
|
|
|
|
IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN
|
|
proc := e.type;
|
|
PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86);
|
|
PARS.Next(parser);
|
|
|
|
param := proc.params.first;
|
|
WHILE param # NIL DO
|
|
getpos(parser, pos);
|
|
|
|
IL.setlast(begcall);
|
|
|
|
IF param(PROG.PARAM).vPar THEN
|
|
parser.designator(parser, e1)
|
|
ELSE
|
|
PExpression(parser, e1)
|
|
END;
|
|
paramcomp(parser, pos, e1, param(PROG.PARAM));
|
|
param := param.next;
|
|
IF param # NIL THEN
|
|
PARS.checklex(parser, SCAN.lxCOMMA);
|
|
PARS.Next(parser)
|
|
END
|
|
END;
|
|
|
|
PARS.checklex(parser, SCAN.lxRROUND);
|
|
PARS.Next(parser);
|
|
|
|
e.obj := eEXPR;
|
|
e.type := proc.base
|
|
|
|
ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
|
|
stProc(parser, e)
|
|
ELSE
|
|
PARS.check1(FALSE, parser, 86)
|
|
END
|
|
|
|
END ActualParameters;
|
|
|
|
|
|
PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
ident: PROG.IDENT;
|
|
import: BOOLEAN;
|
|
pos: PARS.POSITION;
|
|
|
|
BEGIN
|
|
PARS.checklex(parser, SCAN.lxIDENT);
|
|
getpos(parser, pos);
|
|
import := FALSE;
|
|
ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
|
|
PARS.check1(ident # NIL, parser, 48);
|
|
IF ident.typ = PROG.idMODULE THEN
|
|
PARS.ExpectSym(parser, SCAN.lxPOINT);
|
|
PARS.ExpectSym(parser, SCAN.lxIDENT);
|
|
ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
|
|
PARS.check1((ident # NIL) & ident.export, parser, 48);
|
|
import := TRUE
|
|
END;
|
|
PARS.Next(parser);
|
|
|
|
e.readOnly := FALSE;
|
|
e.ident := ident;
|
|
|
|
CASE ident.typ OF
|
|
|PROG.idCONST:
|
|
e.obj := eCONST;
|
|
e.type := ident.type;
|
|
e.value := ident.value
|
|
|PROG.idTYPE:
|
|
e.obj := eTYPE;
|
|
e.type := ident.type
|
|
|PROG.idVAR:
|
|
e.obj := eVAR;
|
|
e.type := ident.type;
|
|
e.readOnly := import
|
|
|PROG.idPROC:
|
|
e.obj := ePROC;
|
|
e.type := ident.type
|
|
|PROG.idIMP:
|
|
e.obj := eIMP;
|
|
e.type := ident.type
|
|
|PROG.idVPAR:
|
|
e.type := ident.type;
|
|
IF e.type.typ = PROG.tRECORD THEN
|
|
e.obj := eVREC
|
|
ELSE
|
|
e.obj := eVPAR
|
|
END
|
|
|PROG.idPARAM:
|
|
e.obj := ePARAM;
|
|
e.type := ident.type;
|
|
e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY})
|
|
|PROG.idSTPROC:
|
|
e.obj := eSTPROC;
|
|
e.stproc := ident.stproc
|
|
|PROG.idSTFUNC:
|
|
e.obj := eSTFUNC;
|
|
e.stproc := ident.stproc
|
|
|PROG.idSYSPROC:
|
|
e.obj := eSYSPROC;
|
|
e.stproc := ident.stproc
|
|
|PROG.idSYSFUNC:
|
|
PARS.check(~parser.constexp, pos, 109);
|
|
e.obj := eSYSFUNC;
|
|
e.stproc := ident.stproc
|
|
|PROG.idNONE:
|
|
PARS.error(pos, 115)
|
|
END;
|
|
|
|
IF isVar(e) THEN
|
|
PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105)
|
|
END
|
|
|
|
END qualident;
|
|
|
|
|
|
PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
|
|
VAR
|
|
label: INTEGER;
|
|
|
|
BEGIN
|
|
IF load THEN
|
|
IL.load(e.type.size)
|
|
END;
|
|
|
|
IF chkPTR IN Options.checking THEN
|
|
label := IL.NewLabel();
|
|
IL.AddJmpCmd(IL.opJNZ, label);
|
|
IL.OnError(pos.line, error);
|
|
IL.SetLabel(label)
|
|
END
|
|
END deref;
|
|
|
|
|
|
PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
field: PROG.FIELD;
|
|
pos: PARS.POSITION;
|
|
t, idx: PARS.EXPR;
|
|
|
|
|
|
PROCEDURE LoadAdr (e: PARS.EXPR);
|
|
VAR
|
|
offset: INTEGER;
|
|
|
|
PROCEDURE OpenArray (e: PARS.EXPR);
|
|
VAR
|
|
offset, n: INTEGER;
|
|
BEGIN
|
|
offset := e.ident.offset;
|
|
n := PROG.Dim(e.type);
|
|
WHILE n >= 0 DO
|
|
IL.AddCmd(IL.opVADR, offset);
|
|
DEC(offset);
|
|
DEC(n)
|
|
END
|
|
END OpenArray;
|
|
|
|
|
|
BEGIN
|
|
IF e.obj = eVAR THEN
|
|
offset := PROG.getOffset(PARS.program, e.ident);
|
|
IF e.ident.global THEN
|
|
IL.AddCmd(IL.opGADR, offset)
|
|
ELSE
|
|
IL.AddCmd(IL.opLADR, -offset)
|
|
END
|
|
ELSIF e.obj = ePARAM THEN
|
|
IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN
|
|
IL.AddCmd(IL.opVADR, e.ident.offset)
|
|
ELSIF PROG.isOpenArray(e.type) THEN
|
|
OpenArray(e)
|
|
ELSE
|
|
IL.AddCmd(IL.opLADR, e.ident.offset)
|
|
END
|
|
ELSIF e.obj IN {eVPAR, eVREC} THEN
|
|
IF PROG.isOpenArray(e.type) THEN
|
|
OpenArray(e)
|
|
ELSE
|
|
IL.AddCmd(IL.opVADR, e.ident.offset)
|
|
END
|
|
END
|
|
END LoadAdr;
|
|
|
|
|
|
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
|
|
VAR
|
|
label, offset, n, k: INTEGER;
|
|
type: PROG.TYPE_;
|
|
|
|
BEGIN
|
|
|
|
IF chkIDX IN Options.checking THEN
|
|
label := IL.NewLabel();
|
|
IL.AddCmd2(IL.opCHKIDX2, label, 0);
|
|
IL.OnError(pos.line, errIDX);
|
|
IL.SetLabel(label)
|
|
ELSE
|
|
IL.AddCmd(IL.opCHKIDX2, -1)
|
|
END;
|
|
|
|
type := PROG.OpenBase(e.type);
|
|
IF type.size # 1 THEN
|
|
IL.AddCmd(IL.opMULC, type.size)
|
|
END;
|
|
n := PROG.Dim(e.type) - 1;
|
|
k := n;
|
|
WHILE n > 0 DO
|
|
IL.AddCmd0(IL.opMUL);
|
|
DEC(n)
|
|
END;
|
|
IL.AddCmd0(IL.opADD);
|
|
offset := e.ident.offset - 1;
|
|
n := k;
|
|
WHILE n > 0 DO
|
|
IL.AddCmd(IL.opVADR, offset);
|
|
DEC(offset);
|
|
DEC(n)
|
|
END
|
|
END OpenIdx;
|
|
|
|
|
|
BEGIN
|
|
qualident(parser, e);
|
|
|
|
IF e.obj IN {ePROC, eIMP} THEN
|
|
PROG.UseProc(parser.unit, e.ident.proc)
|
|
END;
|
|
|
|
IF isVar(e) THEN
|
|
LoadAdr(e)
|
|
END;
|
|
|
|
WHILE parser.sym = SCAN.lxPOINT DO
|
|
getpos(parser, pos);
|
|
PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
|
|
IF e.type.typ = PROG.tPOINTER THEN
|
|
deref(pos, e, TRUE, errPTR)
|
|
END;
|
|
PARS.ExpectSym(parser, SCAN.lxIDENT);
|
|
IF e.type.typ = PROG.tPOINTER THEN
|
|
e.type := e.type.base;
|
|
e.readOnly := FALSE
|
|
END;
|
|
field := PROG.getField(e.type, parser.lex.ident, parser.unit);
|
|
PARS.check1(field # NIL, parser, 74);
|
|
e.type := field.type;
|
|
IF e.obj = eVREC THEN
|
|
e.obj := eVPAR
|
|
END;
|
|
IF field.offset # 0 THEN
|
|
IL.AddCmd(IL.opADDR, field.offset)
|
|
END;
|
|
PARS.Next(parser);
|
|
e.ident := NIL
|
|
|
|
ELSIF parser.sym = SCAN.lxLSQUARE DO
|
|
|
|
REPEAT
|
|
|
|
PARS.check1(isArr(e), parser, 75);
|
|
NextPos(parser, pos);
|
|
PExpression(parser, idx);
|
|
PARS.check(isInt(idx), pos, 76);
|
|
|
|
IF idx.obj = eCONST THEN
|
|
IF e.type.length > 0 THEN
|
|
PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83);
|
|
IF ARITH.Int(idx.value) > 0 THEN
|
|
IL.AddCmd(IL.opADDR, ARITH.Int(idx.value) * e.type.base.size)
|
|
END
|
|
ELSE
|
|
PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83);
|
|
LoadConst(idx);
|
|
OpenIdx(parser, pos, e)
|
|
END
|
|
ELSE
|
|
IF e.type.length > 0 THEN
|
|
IF chkIDX IN Options.checking THEN
|
|
CheckRange(e.type.length, pos.line, errIDX)
|
|
END;
|
|
IF e.type.base.size # 1 THEN
|
|
IL.AddCmd(IL.opMULC, e.type.base.size)
|
|
END;
|
|
IL.AddCmd0(IL.opADD)
|
|
ELSE
|
|
OpenIdx(parser, pos, e)
|
|
END
|
|
END;
|
|
|
|
e.type := e.type.base
|
|
|
|
UNTIL parser.sym # SCAN.lxCOMMA;
|
|
|
|
PARS.checklex(parser, SCAN.lxRSQUARE);
|
|
PARS.Next(parser);
|
|
e.ident := NIL
|
|
|
|
ELSIF parser.sym = SCAN.lxCARET DO
|
|
getpos(parser, pos);
|
|
PARS.check1(isPtr(e), parser, 77);
|
|
deref(pos, e, TRUE, errPTR);
|
|
e.type := e.type.base;
|
|
e.readOnly := FALSE;
|
|
PARS.Next(parser);
|
|
e.ident := NIL;
|
|
e.obj := eVREC
|
|
|
|
ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO
|
|
|
|
IF e.type.typ = PROG.tRECORD THEN
|
|
PARS.check1(e.obj = eVREC, parser, 78)
|
|
END;
|
|
NextPos(parser, pos);
|
|
qualident(parser, t);
|
|
PARS.check(t.obj = eTYPE, pos, 79);
|
|
|
|
IF e.type.typ = PROG.tRECORD THEN
|
|
PARS.check(t.type.typ = PROG.tRECORD, pos, 80);
|
|
IF chkGUARD IN Options.checking THEN
|
|
IF e.ident = NIL THEN
|
|
IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD)
|
|
ELSE
|
|
IL.AddCmd(IL.opVADR, e.ident.offset - 1);
|
|
IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD)
|
|
END
|
|
END;
|
|
ELSE
|
|
PARS.check(t.type.typ = PROG.tPOINTER, pos, 81);
|
|
IF chkGUARD IN Options.checking THEN
|
|
IL.TypeGuard(IL.opTYPEGP, t.type.base.num, pos.line, errGUARD)
|
|
END
|
|
END;
|
|
|
|
PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82);
|
|
|
|
e.type := t.type;
|
|
|
|
PARS.checklex(parser, SCAN.lxRROUND);
|
|
PARS.Next(parser)
|
|
|
|
END
|
|
|
|
END designator;
|
|
|
|
|
|
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
|
|
VAR
|
|
cconv,
|
|
parSize,
|
|
callconv,
|
|
fparSize,
|
|
int, flt,
|
|
stk_par: INTEGER;
|
|
|
|
BEGIN
|
|
cconv := procType.call;
|
|
parSize := procType.parSize;
|
|
|
|
IF cconv IN {PROG._win64, PROG.win64} THEN
|
|
callconv := IL.call_win64;
|
|
fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4)
|
|
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
|
|
callconv := IL.call_sysv;
|
|
fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize;
|
|
stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
|
|
ELSE
|
|
callconv := IL.call_stack;
|
|
fparSize := 0
|
|
END;
|
|
IL.setlast(begcall);
|
|
fregs := IL.precall(isfloat);
|
|
|
|
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
|
|
IL.AddCmd(IL.opALIGN16, parSize)
|
|
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
|
|
IL.AddCmd(IL.opWIN64ALIGN16, parSize)
|
|
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
|
|
IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par)
|
|
END;
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
|
|
IF e.obj = eIMP THEN
|
|
IL.CallImp(e.ident.import, callconv, fparSize)
|
|
ELSIF e.obj = ePROC THEN
|
|
IL.Call(e.ident.proc.label, callconv, fparSize)
|
|
ELSIF isExpr(e) THEN
|
|
deref(pos, e, CallStat, errPROC);
|
|
IL.CallP(callconv, fparSize)
|
|
END;
|
|
|
|
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
|
|
IL.AddCmd(IL.opCLEANUP, parSize);
|
|
IL.AddCmd0(IL.opPOPSP)
|
|
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
|
|
IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1);
|
|
IL.AddCmd0(IL.opPOPSP)
|
|
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
|
|
IL.AddCmd(IL.opCLEANUP, parSize + stk_par);
|
|
IL.AddCmd0(IL.opPOPSP)
|
|
ELSIF cconv IN {PROG._ccall, PROG.ccall, PROG.default16, PROG.code, PROG._code} THEN
|
|
IL.AddCmd(IL.opCLEANUP, parSize)
|
|
END;
|
|
|
|
IF ~CallStat THEN
|
|
IF isfloat THEN
|
|
PARS.check(IL.resf(fregs), pos, 41)
|
|
ELSE
|
|
IL.res(fregs)
|
|
END
|
|
END
|
|
END ProcCall;
|
|
|
|
|
|
PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
pos, pos0, pos1: PARS.POSITION;
|
|
|
|
op: INTEGER;
|
|
e1: PARS.EXPR;
|
|
constant: BOOLEAN;
|
|
operator: ARITH.RELATION;
|
|
error: INTEGER;
|
|
|
|
|
|
PROCEDURE relation (sym: INTEGER): BOOLEAN;
|
|
RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR
|
|
(sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR
|
|
(sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR
|
|
(sym = SCAN.lxIN) OR (sym = SCAN.lxIS)
|
|
END relation;
|
|
|
|
|
|
PROCEDURE AddOperator (sym: INTEGER): BOOLEAN;
|
|
RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR
|
|
(sym = SCAN.lxOR)
|
|
END AddOperator;
|
|
|
|
|
|
PROCEDURE MulOperator (sym: INTEGER): BOOLEAN;
|
|
RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR
|
|
(sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR
|
|
(sym = SCAN.lxAND)
|
|
END MulOperator;
|
|
|
|
|
|
PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
e1, e2: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
range: BOOLEAN;
|
|
|
|
BEGIN
|
|
range := FALSE;
|
|
getpos(parser, pos);
|
|
expression(parser, e1);
|
|
PARS.check(isInt(e1), pos, 76);
|
|
|
|
IF e1.obj = eCONST THEN
|
|
PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44)
|
|
END;
|
|
|
|
range := parser.sym = SCAN.lxRANGE;
|
|
|
|
IF range THEN
|
|
NextPos(parser, pos);
|
|
expression(parser, e2);
|
|
PARS.check(isInt(e2), pos, 76);
|
|
|
|
IF e2.obj = eCONST THEN
|
|
PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44)
|
|
END
|
|
ELSE
|
|
IF e1.obj = eCONST THEN
|
|
e2 := e1
|
|
END
|
|
END;
|
|
|
|
e.type := tSET;
|
|
|
|
IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
|
|
ARITH.constrSet(e.value, e1.value, e2.value);
|
|
e.obj := eCONST
|
|
ELSE
|
|
IF range THEN
|
|
IF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value))
|
|
ELSIF e2.obj = eCONST THEN
|
|
IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opRSET)
|
|
END
|
|
ELSE
|
|
IL.AddCmd0(IL.opRSET1)
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
END element;
|
|
|
|
|
|
PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
e1: PARS.EXPR;
|
|
|
|
BEGIN
|
|
ASSERT(parser.sym = SCAN.lxLCURLY);
|
|
|
|
e.obj := eCONST;
|
|
e.type := tSET;
|
|
ARITH.emptySet(e.value);
|
|
|
|
PARS.Next(parser);
|
|
IF parser.sym # SCAN.lxRCURLY THEN
|
|
element(parser, e1);
|
|
|
|
IF e1.obj = eCONST THEN
|
|
ARITH.opSet(e.value, e1.value, "+")
|
|
ELSE
|
|
e.obj := eEXPR
|
|
END;
|
|
|
|
WHILE parser.sym = SCAN.lxCOMMA DO
|
|
PARS.Next(parser);
|
|
element(parser, e1);
|
|
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
|
ARITH.opSet(e.value, e1.value, "+")
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opADDSL, ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opADDS)
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
END;
|
|
PARS.checklex(parser, SCAN.lxRCURLY)
|
|
END;
|
|
PARS.Next(parser);
|
|
END set;
|
|
|
|
|
|
PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
sym: INTEGER;
|
|
pos: PARS.POSITION;
|
|
e1: PARS.EXPR;
|
|
isfloat: BOOLEAN;
|
|
fregs: INTEGER;
|
|
|
|
|
|
PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
|
|
BEGIN
|
|
IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
|
|
IF e.type = tREAL THEN
|
|
PARS.check(IL.loadf(), pos, 41)
|
|
ELSE
|
|
IL.load(e.type.size)
|
|
END
|
|
END
|
|
END LoadVar;
|
|
|
|
|
|
BEGIN
|
|
sym := parser.sym;
|
|
|
|
IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
|
|
e.obj := eCONST;
|
|
e.value := parser.lex.value;
|
|
e.type := PROG.getType(PARS.program, e.value.typ);
|
|
PARS.Next(parser)
|
|
|
|
ELSIF sym = SCAN.lxNIL THEN
|
|
e.obj := eCONST;
|
|
e.type := PARS.program.stTypes.tNIL;
|
|
PARS.Next(parser)
|
|
|
|
ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
|
|
e.obj := eCONST;
|
|
ARITH.setbool(e.value, sym = SCAN.lxTRUE);
|
|
e.type := tBOOLEAN;
|
|
PARS.Next(parser)
|
|
|
|
ELSIF sym = SCAN.lxLCURLY THEN
|
|
set(parser, e)
|
|
|
|
ELSIF sym = SCAN.lxIDENT THEN
|
|
getpos(parser, pos);
|
|
|
|
IL.pushBegEnd(begcall, endcall);
|
|
|
|
designator(parser, e);
|
|
IF isVar(e) THEN
|
|
LoadVar(e, parser, pos)
|
|
END;
|
|
IF parser.sym = SCAN.lxLROUND THEN
|
|
e1 := e;
|
|
ActualParameters(parser, e);
|
|
PARS.check(e.type # NIL, pos, 59);
|
|
isfloat := e.type = tREAL;
|
|
IF e1.obj IN {ePROC, eIMP} THEN
|
|
ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE)
|
|
ELSIF isExpr(e1) THEN
|
|
ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE)
|
|
END
|
|
END;
|
|
IL.popBegEnd(begcall, endcall)
|
|
|
|
ELSIF sym = SCAN.lxLROUND THEN
|
|
PARS.Next(parser);
|
|
expression(parser, e);
|
|
PARS.checklex(parser, SCAN.lxRROUND);
|
|
PARS.Next(parser);
|
|
IF isExpr(e) & (e.obj # eCONST) THEN
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
ELSIF sym = SCAN.lxNOT THEN
|
|
NextPos(parser, pos);
|
|
factor(parser, e);
|
|
PARS.check(isBoolean(e), pos, 72);
|
|
IF e.obj # eCONST THEN
|
|
IL.not;
|
|
e.obj := eEXPR
|
|
ELSE
|
|
ASSERT(ARITH.neg(e.value))
|
|
END
|
|
|
|
ELSE
|
|
PARS.check1(FALSE, parser, 34)
|
|
END
|
|
END factor;
|
|
|
|
|
|
PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
pos: PARS.POSITION;
|
|
e1: PARS.EXPR;
|
|
op, label, label1: INTEGER;
|
|
|
|
BEGIN
|
|
factor(parser, e);
|
|
label := -1;
|
|
|
|
WHILE MulOperator(parser.sym) DO
|
|
op := parser.sym;
|
|
getpos(parser, pos);
|
|
PARS.Next(parser);
|
|
|
|
IF op = SCAN.lxAND THEN
|
|
IF ~parser.constexp THEN
|
|
|
|
IF label = -1 THEN
|
|
label := IL.NewLabel()
|
|
END;
|
|
|
|
IF e.obj = eCONST THEN
|
|
IL.Const(ORD(ARITH.getBool(e.value)))
|
|
END;
|
|
IL.AddCmd0(IL.opACC);
|
|
IL.AddJmpCmd(IL.opJZ, label);
|
|
IL.drop
|
|
END
|
|
END;
|
|
|
|
factor(parser, e1);
|
|
|
|
CASE op OF
|
|
|SCAN.lxMUL:
|
|
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
|
|
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
|
|
|
CASE e.value.typ OF
|
|
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39)
|
|
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40)
|
|
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "*")
|
|
END
|
|
|
|
ELSE
|
|
IF isInt(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opMULC, ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opMULC, ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opMUL)
|
|
END
|
|
ELSIF isReal(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e1.value))
|
|
END;
|
|
IL.fbinop(IL.opMULF)
|
|
ELSIF isSet(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opMULSC, ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opMULS)
|
|
END
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
|SCAN.lxSLASH:
|
|
PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
|
|
IF (e1.obj = eCONST) & isReal(e1) THEN
|
|
PARS.check(~ARITH.isZero(e1.value), pos, 45)
|
|
END;
|
|
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
|
|
|
CASE e.value.typ OF
|
|
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40)
|
|
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "/")
|
|
END
|
|
|
|
ELSE
|
|
IF isReal(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e.value));
|
|
IL.fbinop(IL.opDIVFI)
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e1.value));
|
|
IL.fbinop(IL.opDIVF)
|
|
ELSE
|
|
IL.fbinop(IL.opDIVF)
|
|
END
|
|
ELSIF isSet(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opDIVS)
|
|
END
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
|SCAN.lxDIV, SCAN.lxMOD:
|
|
PARS.check(isInt(e) & isInt(e1), pos, 37);
|
|
IF e1.obj = eCONST THEN
|
|
PARS.check(ARITH.Int(e1.value) > 0, pos, 122)
|
|
END;
|
|
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
|
|
|
IF op = SCAN.lxDIV THEN
|
|
PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39)
|
|
ELSE
|
|
ASSERT(ARITH.opInt(e.value, e1.value, "M"))
|
|
END
|
|
|
|
ELSE
|
|
IF e1.obj # eCONST THEN
|
|
label1 := IL.NewLabel();
|
|
IL.AddJmpCmd(IL.opJG, label1)
|
|
END;
|
|
IF e.obj = eCONST THEN
|
|
IL.OnError(pos.line, errDIV);
|
|
IL.SetLabel(label1);
|
|
IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.OnError(pos.line, errDIV);
|
|
IL.SetLabel(label1);
|
|
IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD))
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
|SCAN.lxAND:
|
|
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
|
|
|
|
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
|
ARITH.opBoolean(e.value, e1.value, "&")
|
|
ELSE
|
|
e.obj := eEXPR;
|
|
IF e1.obj = eCONST THEN
|
|
IL.Const(ORD(ARITH.getBool(e1.value)))
|
|
END;
|
|
IL.AddCmd0(IL.opACC)
|
|
END
|
|
|
|
END
|
|
END;
|
|
|
|
IF label # -1 THEN
|
|
IL.SetLabel(label)
|
|
END
|
|
END term;
|
|
|
|
|
|
PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
|
|
VAR
|
|
pos: PARS.POSITION;
|
|
op: INTEGER;
|
|
e1: PARS.EXPR;
|
|
|
|
plus, minus: BOOLEAN;
|
|
|
|
label: INTEGER;
|
|
|
|
BEGIN
|
|
plus := parser.sym = SCAN.lxPLUS;
|
|
minus := parser.sym = SCAN.lxMINUS;
|
|
|
|
IF plus OR minus THEN
|
|
getpos(parser, pos);
|
|
PARS.Next(parser)
|
|
END;
|
|
|
|
term(parser, e);
|
|
|
|
IF plus OR minus THEN
|
|
PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36);
|
|
|
|
IF minus & (e.obj = eCONST) THEN
|
|
PARS.check(ARITH.neg(e.value), pos, 39)
|
|
END;
|
|
|
|
IF e.obj # eCONST THEN
|
|
IF minus THEN
|
|
IF isInt(e) THEN
|
|
IL.AddCmd0(IL.opUMINUS)
|
|
ELSIF isReal(e) THEN
|
|
IL.AddCmd0(IL.opUMINF)
|
|
ELSIF isSet(e) THEN
|
|
IL.AddCmd0(IL.opUMINS)
|
|
END
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
END;
|
|
|
|
label := -1;
|
|
|
|
WHILE AddOperator(parser.sym) DO
|
|
|
|
op := parser.sym;
|
|
getpos(parser, pos);
|
|
PARS.Next(parser);
|
|
|
|
IF op = SCAN.lxOR THEN
|
|
|
|
IF ~parser.constexp THEN
|
|
|
|
IF label = -1 THEN
|
|
label := IL.NewLabel()
|
|
END;
|
|
|
|
IF e.obj = eCONST THEN
|
|
IL.Const(ORD(ARITH.getBool(e.value)))
|
|
END;
|
|
IL.AddCmd0(IL.opACC);
|
|
IL.AddJmpCmd(IL.opJNZ, label);
|
|
IL.drop
|
|
END
|
|
|
|
END;
|
|
|
|
term(parser, e1);
|
|
|
|
CASE op OF
|
|
|SCAN.lxPLUS, SCAN.lxMINUS:
|
|
|
|
IF op = SCAN.lxPLUS THEN
|
|
op := ORD("+")
|
|
ELSE
|
|
op := ORD("-")
|
|
END;
|
|
|
|
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
|
|
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
|
|
|
CASE e.value.typ OF
|
|
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
|
|
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
|
|
|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op))
|
|
END
|
|
|
|
ELSE
|
|
IF isInt(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opADD + ORD(op = ORD("-")))
|
|
END
|
|
ELSIF isReal(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e.value));
|
|
IL.fbinop(IL.opADDFI + ORD(op = ORD("-")))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e1.value));
|
|
IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
|
|
ELSE
|
|
IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
|
|
END
|
|
ELSIF isSet(e) THEN
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opADDS + ORD(op = ORD("-")))
|
|
END
|
|
END;
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
|SCAN.lxOR:
|
|
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
|
|
|
|
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
|
ARITH.opBoolean(e.value, e1.value, "|")
|
|
ELSE
|
|
e.obj := eEXPR;
|
|
IF e1.obj = eCONST THEN
|
|
IL.Const(ORD(ARITH.getBool(e1.value)))
|
|
END;
|
|
IL.AddCmd0(IL.opACC)
|
|
END
|
|
|
|
END
|
|
END;
|
|
|
|
IF label # -1 THEN
|
|
IL.SetLabel(label)
|
|
END
|
|
|
|
END SimpleExpression;
|
|
|
|
|
|
PROCEDURE cmpcode (op: INTEGER): INTEGER;
|
|
VAR
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
CASE op OF
|
|
|SCAN.lxEQ: res := 0
|
|
|SCAN.lxNE: res := 1
|
|
|SCAN.lxLT: res := 2
|
|
|SCAN.lxLE: res := 3
|
|
|SCAN.lxGT: res := 4
|
|
|SCAN.lxGE: res := 5
|
|
END
|
|
|
|
RETURN res
|
|
END cmpcode;
|
|
|
|
|
|
PROCEDURE invcmpcode (op: INTEGER): INTEGER;
|
|
VAR
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
CASE op OF
|
|
|SCAN.lxEQ: res := 0
|
|
|SCAN.lxNE: res := 1
|
|
|SCAN.lxLT: res := 4
|
|
|SCAN.lxLE: res := 5
|
|
|SCAN.lxGT: res := 2
|
|
|SCAN.lxGE: res := 3
|
|
END
|
|
|
|
RETURN res
|
|
END invcmpcode;
|
|
|
|
|
|
PROCEDURE BoolCmp (eq, val: BOOLEAN);
|
|
BEGIN
|
|
IF eq = val THEN
|
|
IL.AddCmd0(IL.opNEC)
|
|
ELSE
|
|
IL.AddCmd0(IL.opEQC)
|
|
END
|
|
END BoolCmp;
|
|
|
|
|
|
PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
|
|
VAR
|
|
res: BOOLEAN;
|
|
|
|
BEGIN
|
|
res := TRUE;
|
|
|
|
IF isString(e) & isCharArray(e1) THEN
|
|
IL.StrAdr(String(e));
|
|
IL.Const(strlen(e) + 1);
|
|
IL.AddCmd0(IL.opEQS + invcmpcode(op))
|
|
|
|
ELSIF isString(e) & isCharArrayW(e1) THEN
|
|
IL.StrAdr(StringW(e));
|
|
IL.Const(utf8strlen(e) + 1);
|
|
IL.AddCmd0(IL.opEQSW + invcmpcode(op))
|
|
|
|
ELSIF isStringW(e) & isCharArrayW(e1) THEN
|
|
IL.StrAdr(StringW(e));
|
|
IL.Const(utf8strlen(e) + 1);
|
|
IL.AddCmd0(IL.opEQSW + invcmpcode(op))
|
|
|
|
ELSIF isCharArray(e) & isString(e1) THEN
|
|
IL.StrAdr(String(e1));
|
|
IL.Const(strlen(e1) + 1);
|
|
IL.AddCmd0(IL.opEQS + cmpcode(op))
|
|
|
|
ELSIF isCharArrayW(e) & isString(e1) THEN
|
|
IL.StrAdr(StringW(e1));
|
|
IL.Const(utf8strlen(e1) + 1);
|
|
IL.AddCmd0(IL.opEQSW + cmpcode(op))
|
|
|
|
ELSIF isCharArrayW(e) & isStringW(e1) THEN
|
|
IL.StrAdr(StringW(e1));
|
|
IL.Const(utf8strlen(e1) + 1);
|
|
IL.AddCmd0(IL.opEQSW + cmpcode(op))
|
|
|
|
ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
|
|
IL.AddCmd0(IL.opEQSW + cmpcode(op))
|
|
|
|
ELSIF isCharArray(e) & isCharArray(e1) THEN
|
|
IL.AddCmd0(IL.opEQS + cmpcode(op))
|
|
|
|
ELSIF isString(e) & isString(e1) THEN
|
|
PARS.strcmp(e.value, e1.value, op)
|
|
|
|
ELSE
|
|
res := FALSE
|
|
|
|
END
|
|
|
|
RETURN res
|
|
END strcmp;
|
|
|
|
|
|
BEGIN
|
|
getpos(parser, pos0);
|
|
SimpleExpression(parser, e);
|
|
IF relation(parser.sym) THEN
|
|
IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN
|
|
IL.Const(e.type.length)
|
|
END;
|
|
op := parser.sym;
|
|
getpos(parser, pos);
|
|
PARS.Next(parser);
|
|
|
|
getpos(parser, pos1);
|
|
SimpleExpression(parser, e1);
|
|
|
|
IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
|
|
IL.Const(e1.type.length)
|
|
END;
|
|
|
|
constant := (e.obj = eCONST) & (e1.obj = eCONST);
|
|
|
|
CASE op OF
|
|
|SCAN.lxEQ: operator := "="
|
|
|SCAN.lxNE: operator := "#"
|
|
|SCAN.lxLT: operator := "<"
|
|
|SCAN.lxLE: operator := "<="
|
|
|SCAN.lxGT: operator := ">"
|
|
|SCAN.lxGE: operator := ">="
|
|
|SCAN.lxIN: operator := "IN"
|
|
|SCAN.lxIS: operator := ""
|
|
END;
|
|
|
|
error := 0;
|
|
|
|
CASE op OF
|
|
|SCAN.lxEQ, SCAN.lxNE:
|
|
|
|
IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
|
|
isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
|
|
isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
|
|
isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
|
|
isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN
|
|
IF constant THEN
|
|
ARITH.relation(e.value, e1.value, operator, error)
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opEQ + cmpcode(op))
|
|
END
|
|
END
|
|
|
|
ELSIF isStringW1(e) & isCharW(e1) THEN
|
|
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
|
|
|
|
ELSIF isStringW1(e1) & isCharW(e) THEN
|
|
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
|
|
|
|
ELSIF isBoolean(e) & isBoolean(e1) THEN
|
|
IF constant THEN
|
|
ARITH.relation(e.value, e1.value, operator, error)
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0)
|
|
ELSIF e1.obj = eCONST THEN
|
|
BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
|
|
ELSE
|
|
IF op = SCAN.lxEQ THEN
|
|
IL.AddCmd0(IL.opEQB)
|
|
ELSE
|
|
IL.AddCmd0(IL.opNEB)
|
|
END
|
|
END
|
|
END
|
|
|
|
ELSIF isReal(e) & isReal(e1) THEN
|
|
IF constant THEN
|
|
ARITH.relation(e.value, e1.value, operator, error)
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e1.value))
|
|
END;
|
|
IL.fcmp(IL.opEQF + cmpcode(op))
|
|
END
|
|
|
|
ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
|
|
IF ~strcmp(e, e1, op) THEN
|
|
PARS.error(pos, 37)
|
|
END
|
|
|
|
ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
|
|
IL.AddCmd0(IL.opEQC + cmpcode(op))
|
|
|
|
ELSIF isProc(e) & isNil(e1) THEN
|
|
IF e.obj IN {ePROC, eIMP} THEN
|
|
PARS.check(e.ident.global, pos0, 85);
|
|
constant := TRUE;
|
|
e.obj := eCONST;
|
|
ARITH.setbool(e.value, op = SCAN.lxNE)
|
|
ELSE
|
|
IL.AddCmd0(IL.opEQC + cmpcode(op))
|
|
END
|
|
|
|
ELSIF isNil(e) & isProc(e1) THEN
|
|
IF e1.obj IN {ePROC, eIMP} THEN
|
|
PARS.check(e1.ident.global, pos1, 85);
|
|
constant := TRUE;
|
|
e.obj := eCONST;
|
|
ARITH.setbool(e.value, op = SCAN.lxNE)
|
|
ELSE
|
|
IL.AddCmd0(IL.opEQC + cmpcode(op))
|
|
END
|
|
|
|
ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
|
|
IF e.obj = ePROC THEN
|
|
PARS.check(e.ident.global, pos0, 85)
|
|
END;
|
|
IF e1.obj = ePROC THEN
|
|
PARS.check(e1.ident.global, pos1, 85)
|
|
END;
|
|
IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
|
|
constant := TRUE;
|
|
e.obj := eCONST;
|
|
IF op = SCAN.lxEQ THEN
|
|
ARITH.setbool(e.value, e.ident = e1.ident)
|
|
ELSE
|
|
ARITH.setbool(e.value, e.ident # e1.ident)
|
|
END
|
|
ELSIF e.obj = ePROC THEN
|
|
IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ)
|
|
ELSIF e1.obj = ePROC THEN
|
|
IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ)
|
|
ELSIF e.obj = eIMP THEN
|
|
IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ)
|
|
ELSIF e1.obj = eIMP THEN
|
|
IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ)
|
|
ELSE
|
|
IL.AddCmd0(IL.opEQ + cmpcode(op))
|
|
END
|
|
|
|
ELSIF isNil(e) & isNil(e1) THEN
|
|
constant := TRUE;
|
|
e.obj := eCONST;
|
|
ARITH.setbool(e.value, op = SCAN.lxEQ)
|
|
|
|
ELSE
|
|
PARS.error(pos, 37)
|
|
END
|
|
|
|
|SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
|
|
IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
|
|
isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
|
|
isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
|
|
isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
|
|
|
|
IF constant THEN
|
|
ARITH.relation(e.value, e1.value, operator, error)
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opEQ + cmpcode(op))
|
|
END
|
|
END
|
|
|
|
ELSIF isStringW1(e) & isCharW(e1) THEN
|
|
IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
|
|
|
|
ELSIF isStringW1(e1) & isCharW(e) THEN
|
|
IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
|
|
|
|
ELSIF isReal(e) & isReal(e1) THEN
|
|
IF constant THEN
|
|
ARITH.relation(e.value, e1.value, operator, error)
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e.value));
|
|
IL.fcmp(IL.opEQF + invcmpcode(op))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.Float(ARITH.Float(e1.value));
|
|
IL.fcmp(IL.opEQF + cmpcode(op))
|
|
ELSE
|
|
IL.fcmp(IL.opEQF + cmpcode(op))
|
|
END
|
|
END
|
|
|
|
ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
|
|
IF ~strcmp(e, e1, op) THEN
|
|
PARS.error(pos, 37)
|
|
END
|
|
|
|
ELSE
|
|
PARS.error(pos, 37)
|
|
END
|
|
|
|
|SCAN.lxIN:
|
|
PARS.check(isInt(e) & isSet(e1), pos, 37);
|
|
IF e.obj = eCONST THEN
|
|
PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56)
|
|
END;
|
|
IF constant THEN
|
|
ARITH.relation(e.value, e1.value, operator, error)
|
|
ELSE
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opINL, ARITH.Int(e.value))
|
|
ELSIF e1.obj = eCONST THEN
|
|
IL.AddCmd(IL.opINR, ARITH.Int(e1.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opIN)
|
|
END
|
|
END
|
|
|
|
|SCAN.lxIS:
|
|
PARS.check(isRecPtr(e), pos, 73);
|
|
PARS.check(e1.obj = eTYPE, pos1, 79);
|
|
|
|
IF isRec(e) THEN
|
|
PARS.check(e.obj = eVREC, pos0, 78);
|
|
PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80);
|
|
IF e.ident = NIL THEN
|
|
IL.TypeCheck(e1.type.num)
|
|
ELSE
|
|
IL.AddCmd(IL.opVADR, e.ident.offset - 1);
|
|
IL.TypeCheckRec(e1.type.num)
|
|
END
|
|
ELSE
|
|
PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81);
|
|
IL.TypeCheck(e1.type.base.num)
|
|
END;
|
|
|
|
PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82)
|
|
|
|
END;
|
|
|
|
ASSERT(error = 0);
|
|
|
|
e.type := tBOOLEAN;
|
|
|
|
IF ~constant THEN
|
|
e.obj := eEXPR
|
|
END
|
|
|
|
END
|
|
END expression;
|
|
|
|
|
|
PROCEDURE ElementaryStatement (parser: PARS.PARSER);
|
|
VAR
|
|
e, e1: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
line: INTEGER;
|
|
call: BOOLEAN;
|
|
fregs: INTEGER;
|
|
|
|
BEGIN
|
|
getpos(parser, pos);
|
|
|
|
IL.pushBegEnd(begcall, endcall);
|
|
|
|
designator(parser, e);
|
|
|
|
IF parser.sym = SCAN.lxASSIGN THEN
|
|
line := parser.lex.pos.line;
|
|
PARS.check(isVar(e), pos, 93);
|
|
PARS.check(~e.readOnly, pos, 94);
|
|
|
|
IL.setlast(begcall);
|
|
|
|
NextPos(parser, pos);
|
|
expression(parser, e1);
|
|
|
|
IL.setlast(endcall.prev(IL.COMMAND));
|
|
|
|
PARS.check(assign(e1, e.type, line), pos, 91);
|
|
IF e1.obj = ePROC THEN
|
|
PARS.check(e1.ident.global, pos, 85)
|
|
END;
|
|
call := FALSE
|
|
ELSIF parser.sym = SCAN.lxEQ THEN
|
|
PARS.check1(FALSE, parser, 96)
|
|
ELSIF parser.sym = SCAN.lxLROUND THEN
|
|
e1 := e;
|
|
ActualParameters(parser, e1);
|
|
PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92);
|
|
call := TRUE
|
|
ELSE
|
|
IF e.obj IN {eSYSPROC, eSTPROC} THEN
|
|
stProc(parser, e);
|
|
call := FALSE
|
|
ELSE
|
|
PARS.check(isProc(e), pos, 86);
|
|
PARS.check((e.type.base = NIL) OR ODD(e.type.call), pos, 92);
|
|
PARS.check1(e.type.params.first = NIL, parser, 64);
|
|
call := TRUE
|
|
END
|
|
END;
|
|
|
|
IF call THEN
|
|
IF e.obj IN {ePROC, eIMP} THEN
|
|
ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE)
|
|
ELSIF isExpr(e) THEN
|
|
ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE)
|
|
END
|
|
END;
|
|
|
|
IL.popBegEnd(begcall, endcall)
|
|
END ElementaryStatement;
|
|
|
|
|
|
PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN);
|
|
VAR
|
|
e: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
|
|
label, L: INTEGER;
|
|
|
|
BEGIN
|
|
L := IL.NewLabel();
|
|
|
|
IF ~if THEN
|
|
IL.AddCmd0(IL.opLOOP);
|
|
IL.SetLabel(L)
|
|
END;
|
|
|
|
REPEAT
|
|
NextPos(parser, pos);
|
|
|
|
label := IL.NewLabel();
|
|
|
|
expression(parser, e);
|
|
PARS.check(isBoolean(e), pos, 72);
|
|
|
|
IF e.obj = eCONST THEN
|
|
IF ~ARITH.getBool(e.value) THEN
|
|
IL.AddJmpCmd(IL.opJMP, label)
|
|
END
|
|
ELSE
|
|
IL.AddJmpCmd(IL.opJNE, label)
|
|
END;
|
|
|
|
IF if THEN
|
|
PARS.checklex(parser, SCAN.lxTHEN)
|
|
ELSE
|
|
PARS.checklex(parser, SCAN.lxDO)
|
|
END;
|
|
|
|
PARS.Next(parser);
|
|
parser.StatSeq(parser);
|
|
|
|
IL.AddJmpCmd(IL.opJMP, L);
|
|
IL.SetLabel(label)
|
|
|
|
UNTIL parser.sym # SCAN.lxELSIF;
|
|
|
|
IF if THEN
|
|
IF parser.sym = SCAN.lxELSE THEN
|
|
PARS.Next(parser);
|
|
parser.StatSeq(parser)
|
|
END;
|
|
IL.SetLabel(L)
|
|
END;
|
|
|
|
PARS.checklex(parser, SCAN.lxEND);
|
|
|
|
IF ~if THEN
|
|
IL.AddCmd0(IL.opENDLOOP)
|
|
END;
|
|
|
|
PARS.Next(parser)
|
|
END IfStatement;
|
|
|
|
|
|
PROCEDURE RepeatStatement (parser: PARS.PARSER);
|
|
VAR
|
|
e: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
label: INTEGER;
|
|
|
|
BEGIN
|
|
IL.AddCmd0(IL.opLOOP);
|
|
|
|
label := IL.NewLabel();
|
|
IL.SetLabel(label);
|
|
|
|
PARS.Next(parser);
|
|
parser.StatSeq(parser);
|
|
PARS.checklex(parser, SCAN.lxUNTIL);
|
|
NextPos(parser, pos);
|
|
expression(parser, e);
|
|
PARS.check(isBoolean(e), pos, 72);
|
|
|
|
IF e.obj = eCONST THEN
|
|
IF ~ARITH.getBool(e.value) THEN
|
|
IL.AddJmpCmd(IL.opJMP, label)
|
|
END
|
|
ELSE
|
|
IL.AddJmpCmd(IL.opJNE, label)
|
|
END;
|
|
|
|
IL.AddCmd0(IL.opENDLOOP)
|
|
END RepeatStatement;
|
|
|
|
|
|
PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
|
|
VAR
|
|
La, Ra, Lb, Rb, res: INTEGER;
|
|
|
|
BEGIN
|
|
La := a(CASE_LABEL).range.a;
|
|
Ra := a(CASE_LABEL).range.b;
|
|
Lb := b(CASE_LABEL).range.a;
|
|
Rb := b(CASE_LABEL).range.b;
|
|
IF (Ra < Lb) OR (La > Rb) THEN
|
|
res := ORD(La > Lb) - ORD(La < Lb)
|
|
ELSE
|
|
res := 0
|
|
END
|
|
|
|
RETURN res
|
|
END LabelCmp;
|
|
|
|
|
|
PROCEDURE DestroyLabel (VAR label: AVL.DATA);
|
|
BEGIN
|
|
C.push(CaseLabels, label);
|
|
label := NIL
|
|
END DestroyLabel;
|
|
|
|
|
|
PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT;
|
|
VAR
|
|
res: CASE_VARIANT;
|
|
citem: C.ITEM;
|
|
|
|
BEGIN
|
|
citem := C.pop(CaseVar);
|
|
IF citem = NIL THEN
|
|
NEW(res)
|
|
ELSE
|
|
res := citem(CASE_VARIANT)
|
|
END;
|
|
|
|
res.label := label;
|
|
res.cmd := cmd;
|
|
res.processed := FALSE
|
|
|
|
RETURN res
|
|
END NewVariant;
|
|
|
|
|
|
PROCEDURE CaseStatement (parser: PARS.PARSER);
|
|
VAR
|
|
e: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
|
|
|
|
PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER;
|
|
VAR
|
|
a: INTEGER;
|
|
label: PARS.EXPR;
|
|
pos: PARS.POSITION;
|
|
value: ARITH.VALUE;
|
|
|
|
BEGIN
|
|
getpos(parser, pos);
|
|
type := NIL;
|
|
|
|
IF isChar(caseExpr) THEN
|
|
PARS.ConstExpression(parser, value);
|
|
PARS.check(value.typ = ARITH.tCHAR, pos, 99);
|
|
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)))
|
|
ELSE
|
|
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
|
|
END;
|
|
a := ARITH.getInt(value)
|
|
ELSIF isInt(caseExpr) THEN
|
|
PARS.ConstExpression(parser, value);
|
|
PARS.check(value.typ = ARITH.tINTEGER, pos, 99);
|
|
a := ARITH.getInt(value)
|
|
ELSIF isRecPtr(caseExpr) THEN
|
|
qualident(parser, label);
|
|
PARS.check(label.obj = eTYPE, pos, 79);
|
|
PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99);
|
|
IF isRec(caseExpr) THEN
|
|
a := label.type.num
|
|
ELSE
|
|
a := label.type.base.num
|
|
END;
|
|
type := label.type
|
|
END
|
|
|
|
RETURN a
|
|
END Label;
|
|
|
|
|
|
PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.POSITION);
|
|
BEGIN
|
|
IF node # NIL THEN
|
|
PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), pos, 100);
|
|
CheckType(node.left, type, parser, pos);
|
|
CheckType(node.right, type, parser, pos)
|
|
END
|
|
END CheckType;
|
|
|
|
|
|
PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
|
|
VAR
|
|
label: CASE_LABEL;
|
|
citem: C.ITEM;
|
|
pos, pos1: PARS.POSITION;
|
|
node: AVL.NODE;
|
|
newnode: BOOLEAN;
|
|
range: RANGE;
|
|
|
|
BEGIN
|
|
citem := C.pop(CaseLabels);
|
|
IF citem = NIL THEN
|
|
NEW(label)
|
|
ELSE
|
|
label := citem(CASE_LABEL)
|
|
END;
|
|
|
|
label.variant := variant;
|
|
label.self := IL.NewLabel();
|
|
|
|
getpos(parser, pos1);
|
|
range.a := Label(parser, caseExpr, label.type);
|
|
|
|
IF parser.sym = SCAN.lxRANGE THEN
|
|
PARS.check1(~isRecPtr(caseExpr), parser, 53);
|
|
NextPos(parser, pos);
|
|
range.b := Label(parser, caseExpr, label.type);
|
|
PARS.check(range.a <= range.b, pos, 103)
|
|
ELSE
|
|
range.b := range.a
|
|
END;
|
|
|
|
label.range := range;
|
|
|
|
IF isRecPtr(caseExpr) THEN
|
|
CheckType(tree, label.type, parser, pos1)
|
|
END;
|
|
tree := AVL.insert(tree, label, LabelCmp, newnode, node);
|
|
PARS.check(newnode, pos1, 100)
|
|
|
|
RETURN node
|
|
|
|
END LabelRange;
|
|
|
|
|
|
PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
|
|
VAR
|
|
exit: BOOLEAN;
|
|
res: AVL.NODE;
|
|
|
|
BEGIN
|
|
exit := FALSE;
|
|
REPEAT
|
|
res := LabelRange(parser, caseExpr, tree, variant);
|
|
IF parser.sym = SCAN.lxCOMMA THEN
|
|
PARS.check1(~isRecPtr(caseExpr), parser, 53);
|
|
PARS.Next(parser)
|
|
ELSE
|
|
exit := TRUE
|
|
END
|
|
UNTIL exit
|
|
|
|
RETURN res
|
|
END CaseLabelList;
|
|
|
|
|
|
PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER);
|
|
VAR
|
|
sym: INTEGER;
|
|
t: PROG.TYPE_;
|
|
variant: INTEGER;
|
|
node: AVL.NODE;
|
|
last: IL.COMMAND;
|
|
|
|
BEGIN
|
|
sym := parser.sym;
|
|
IF sym # SCAN.lxBAR THEN
|
|
variant := IL.NewLabel();
|
|
node := CaseLabelList(parser, caseExpr, tree, variant);
|
|
PARS.checklex(parser, SCAN.lxCOLON);
|
|
PARS.Next(parser);
|
|
IF isRecPtr(caseExpr) THEN
|
|
t := caseExpr.type;
|
|
caseExpr.ident.type := node.data(CASE_LABEL).type
|
|
END;
|
|
|
|
last := IL.getlast();
|
|
IL.SetLabel(variant);
|
|
|
|
IF ~isRecPtr(caseExpr) THEN
|
|
LISTS.push(CaseVariants, NewVariant(variant, last))
|
|
END;
|
|
|
|
parser.StatSeq(parser);
|
|
IL.AddJmpCmd(IL.opJMP, end);
|
|
|
|
IF isRecPtr(caseExpr) THEN
|
|
caseExpr.ident.type := t
|
|
END
|
|
END
|
|
END case;
|
|
|
|
|
|
PROCEDURE Table (node: AVL.NODE; else: INTEGER);
|
|
VAR
|
|
L, R: INTEGER;
|
|
range: RANGE;
|
|
left, right: AVL.NODE;
|
|
last: IL.COMMAND;
|
|
v: CASE_VARIANT;
|
|
|
|
BEGIN
|
|
IF node # NIL THEN
|
|
|
|
range := node.data(CASE_LABEL).range;
|
|
|
|
left := node.left;
|
|
IF left # NIL THEN
|
|
L := left.data(CASE_LABEL).self
|
|
ELSE
|
|
L := else
|
|
END;
|
|
|
|
right := node.right;
|
|
IF right # NIL THEN
|
|
R := right.data(CASE_LABEL).self
|
|
ELSE
|
|
R := else
|
|
END;
|
|
|
|
last := IL.getlast();
|
|
|
|
v := CaseVariants.last(CASE_VARIANT);
|
|
WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
|
|
v := v.prev(CASE_VARIANT)
|
|
END;
|
|
|
|
ASSERT((v # NIL) & (v.label # 0));
|
|
IL.setlast(v.cmd);
|
|
|
|
IL.SetLabel(node.data(CASE_LABEL).self);
|
|
IL.case(range.a, range.b, L, R);
|
|
IF v.processed THEN
|
|
IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant)
|
|
END;
|
|
v.processed := TRUE;
|
|
|
|
IL.setlast(last);
|
|
|
|
Table(left, else);
|
|
Table(right, else)
|
|
END
|
|
END Table;
|
|
|
|
|
|
PROCEDURE TableT (node: AVL.NODE);
|
|
BEGIN
|
|
IF node # NIL THEN
|
|
IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
|
|
|
|
TableT(node.left);
|
|
TableT(node.right)
|
|
END
|
|
END TableT;
|
|
|
|
|
|
PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION);
|
|
VAR
|
|
table, end, else: INTEGER;
|
|
tree: AVL.NODE;
|
|
item: LISTS.ITEM;
|
|
|
|
BEGIN
|
|
LISTS.push(CaseVariants, NewVariant(0, NIL));
|
|
end := IL.NewLabel();
|
|
else := IL.NewLabel();
|
|
table := IL.NewLabel();
|
|
IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
|
|
IL.AddJmpCmd(IL.opJMP, table);
|
|
|
|
tree := NIL;
|
|
|
|
case(parser, e, tree, end);
|
|
WHILE parser.sym = SCAN.lxBAR DO
|
|
PARS.Next(parser);
|
|
case(parser, e, tree, end)
|
|
END;
|
|
|
|
IL.SetLabel(else);
|
|
IF parser.sym = SCAN.lxELSE THEN
|
|
PARS.Next(parser);
|
|
parser.StatSeq(parser);
|
|
IL.AddJmpCmd(IL.opJMP, end)
|
|
ELSE
|
|
IL.OnError(pos.line, errCASE)
|
|
END;
|
|
|
|
PARS.checklex(parser, SCAN.lxEND);
|
|
PARS.Next(parser);
|
|
|
|
IF isRecPtr(e) THEN
|
|
IL.SetLabel(table);
|
|
TableT(tree);
|
|
IL.AddJmpCmd(IL.opJMP, else)
|
|
ELSE
|
|
tree.data(CASE_LABEL).self := table;
|
|
Table(tree, else)
|
|
END;
|
|
|
|
AVL.destroy(tree, DestroyLabel);
|
|
IL.SetLabel(end);
|
|
IL.AddCmd0(IL.opENDSW);
|
|
|
|
REPEAT
|
|
item := LISTS.pop(CaseVariants);
|
|
C.push(CaseVar, item)
|
|
UNTIL item(CASE_VARIANT).cmd = NIL
|
|
|
|
END ParseCase;
|
|
|
|
|
|
BEGIN
|
|
NextPos(parser, pos);
|
|
expression(parser, e);
|
|
PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95);
|
|
IF isRecPtr(e) THEN
|
|
PARS.check(isVar(e), pos, 93);
|
|
PARS.check(e.ident # NIL, pos, 106)
|
|
END;
|
|
IF isRec(e) THEN
|
|
PARS.check(e.obj = eVREC, pos, 78)
|
|
END;
|
|
|
|
IF e.obj = eCONST THEN
|
|
LoadConst(e)
|
|
ELSIF isRec(e) THEN
|
|
IL.drop;
|
|
IL.AddCmd(IL.opLADR, e.ident.offset - 1);
|
|
IL.load(TARGETS.WordSize)
|
|
ELSIF isPtr(e) THEN
|
|
deref(pos, e, FALSE, errPTR);
|
|
IL.AddCmd(IL.opSUBR, TARGETS.WordSize);
|
|
IL.load(TARGETS.WordSize)
|
|
END;
|
|
|
|
PARS.checklex(parser, SCAN.lxOF);
|
|
PARS.Next(parser);
|
|
ParseCase(parser, e, pos)
|
|
END CaseStatement;
|
|
|
|
|
|
PROCEDURE ForStatement (parser: PARS.PARSER);
|
|
VAR
|
|
e: PARS.EXPR;
|
|
pos, pos2: PARS.POSITION;
|
|
step: ARITH.VALUE;
|
|
st: INTEGER;
|
|
ident: PROG.IDENT;
|
|
offset: INTEGER;
|
|
L1, L2: INTEGER;
|
|
|
|
BEGIN
|
|
IL.AddCmd0(IL.opLOOP);
|
|
|
|
L1 := IL.NewLabel();
|
|
L2 := IL.NewLabel();
|
|
|
|
PARS.ExpectSym(parser, SCAN.lxIDENT);
|
|
ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE);
|
|
PARS.check1(ident # NIL, parser, 48);
|
|
PARS.check1(ident.typ = PROG.idVAR, parser, 93);
|
|
PARS.check1(ident.type = tINTEGER, parser, 97);
|
|
PARS.ExpectSym(parser, SCAN.lxASSIGN);
|
|
NextPos(parser, pos);
|
|
expression(parser, e);
|
|
PARS.check(isInt(e), pos, 76);
|
|
|
|
offset := PROG.getOffset(PARS.program, ident);
|
|
|
|
IF ident.global THEN
|
|
IL.AddCmd(IL.opGADR, offset)
|
|
ELSE
|
|
IL.AddCmd(IL.opLADR, -offset)
|
|
END;
|
|
|
|
IF e.obj = eCONST THEN
|
|
IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
|
|
ELSE
|
|
IL.AddCmd0(IL.opSAVE)
|
|
END;
|
|
|
|
IL.SetLabel(L1);
|
|
|
|
IF ident.global THEN
|
|
IL.AddCmd(IL.opGADR, offset)
|
|
ELSE
|
|
IL.AddCmd(IL.opLADR, -offset)
|
|
END;
|
|
IL.load(ident.type.size);
|
|
|
|
PARS.checklex(parser, SCAN.lxTO);
|
|
NextPos(parser, pos2);
|
|
expression(parser, e);
|
|
PARS.check(isInt(e), pos2, 76);
|
|
|
|
IF parser.sym = SCAN.lxBY THEN
|
|
NextPos(parser, pos);
|
|
PARS.ConstExpression(parser, step);
|
|
PARS.check(step.typ = ARITH.tINTEGER, pos, 76);
|
|
st := ARITH.getInt(step);
|
|
PARS.check(st # 0, pos, 98)
|
|
ELSE
|
|
st := 1
|
|
END;
|
|
|
|
IF e.obj = eCONST THEN
|
|
IF st > 0 THEN
|
|
IL.AddCmd(IL.opLEC, ARITH.Int(e.value));
|
|
IF ARITH.Int(e.value) = UTILS.target.maxInt THEN
|
|
ERRORS.WarningMsg(pos2.line, pos2.col, 1)
|
|
END
|
|
ELSE
|
|
IL.AddCmd(IL.opGEC, ARITH.Int(e.value));
|
|
IF ARITH.Int(e.value) = UTILS.target.minInt THEN
|
|
ERRORS.WarningMsg(pos2.line, pos2.col, 1)
|
|
END
|
|
END
|
|
ELSE
|
|
IF st > 0 THEN
|
|
IL.AddCmd0(IL.opLE)
|
|
ELSE
|
|
IL.AddCmd0(IL.opGE)
|
|
END
|
|
END;
|
|
|
|
IL.AddJmpCmd(IL.opJNE, L2);
|
|
|
|
PARS.checklex(parser, SCAN.lxDO);
|
|
PARS.Next(parser);
|
|
parser.StatSeq(parser);
|
|
|
|
IF ident.global THEN
|
|
IL.AddCmd(IL.opGADR, offset)
|
|
ELSE
|
|
IL.AddCmd(IL.opLADR, -offset)
|
|
END;
|
|
|
|
IL.AddCmd(IL.opINCC, st);
|
|
|
|
IL.AddJmpCmd(IL.opJMP, L1);
|
|
|
|
PARS.checklex(parser, SCAN.lxEND);
|
|
PARS.Next(parser);
|
|
|
|
IL.SetLabel(L2);
|
|
|
|
IL.AddCmd0(IL.opENDLOOP)
|
|
|
|
END ForStatement;
|
|
|
|
|
|
PROCEDURE statement (parser: PARS.PARSER);
|
|
VAR
|
|
sym: INTEGER;
|
|
|
|
BEGIN
|
|
sym := parser.sym;
|
|
|
|
IF sym = SCAN.lxIDENT THEN
|
|
ElementaryStatement(parser)
|
|
ELSIF sym = SCAN.lxIF THEN
|
|
IfStatement(parser, TRUE)
|
|
ELSIF sym = SCAN.lxWHILE THEN
|
|
IfStatement(parser, FALSE)
|
|
ELSIF sym = SCAN.lxREPEAT THEN
|
|
RepeatStatement(parser)
|
|
ELSIF sym = SCAN.lxCASE THEN
|
|
CaseStatement(parser)
|
|
ELSIF sym = SCAN.lxFOR THEN
|
|
ForStatement(parser)
|
|
END
|
|
END statement;
|
|
|
|
|
|
PROCEDURE StatSeq (parser: PARS.PARSER);
|
|
BEGIN
|
|
statement(parser);
|
|
WHILE parser.sym = SCAN.lxSEMI DO
|
|
PARS.Next(parser);
|
|
statement(parser)
|
|
END
|
|
END StatSeq;
|
|
|
|
|
|
PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN;
|
|
VAR
|
|
res: BOOLEAN;
|
|
|
|
BEGIN
|
|
res := assigncomp(e, t);
|
|
IF res THEN
|
|
IF e.obj = eCONST THEN
|
|
IF e.type = tREAL THEN
|
|
IL.Float(ARITH.Float(e.value))
|
|
ELSIF e.type.typ = PROG.tNIL THEN
|
|
IL.Const(0)
|
|
ELSE
|
|
LoadConst(e)
|
|
END
|
|
ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
|
|
CheckRange(256, pos.line, errBYTE)
|
|
ELSIF e.obj = ePROC THEN
|
|
PARS.check(e.ident.global, pos, 85);
|
|
IL.PushProc(e.ident.proc.label)
|
|
ELSIF e.obj = eIMP THEN
|
|
IL.PushImpProc(e.ident.import)
|
|
END;
|
|
|
|
IF e.type = tREAL THEN
|
|
IL.retf
|
|
END
|
|
END
|
|
|
|
RETURN res
|
|
END chkreturn;
|
|
|
|
|
|
PROCEDURE setrtl;
|
|
VAR
|
|
rtl: PROG.UNIT;
|
|
|
|
|
|
PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
|
|
VAR
|
|
id: PROG.IDENT;
|
|
|
|
BEGIN
|
|
id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
|
|
|
|
IF (id # NIL) & (id.import # NIL) THEN
|
|
IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label);
|
|
id.proc.used := TRUE
|
|
ELSIF (id # NIL) & (id.proc # NIL) THEN
|
|
IL.set_rtl(idx, id.proc.label);
|
|
id.proc.used := TRUE
|
|
ELSE
|
|
ERRORS.WrongRTL(name)
|
|
END
|
|
END getproc;
|
|
|
|
|
|
BEGIN
|
|
rtl := PARS.program.rtl;
|
|
ASSERT(rtl # NIL);
|
|
|
|
getproc(rtl, "_strcmp", IL._strcmp);
|
|
getproc(rtl, "_length", IL._length);
|
|
getproc(rtl, "_arrcpy", IL._arrcpy);
|
|
getproc(rtl, "_is", IL._is);
|
|
getproc(rtl, "_guard", IL._guard);
|
|
getproc(rtl, "_guardrec", IL._guardrec);
|
|
getproc(rtl, "_new", IL._new);
|
|
getproc(rtl, "_rot", IL._rot);
|
|
getproc(rtl, "_strcpy", IL._strcpy);
|
|
getproc(rtl, "_move", IL._move);
|
|
getproc(rtl, "_set", IL._set);
|
|
getproc(rtl, "_set1", IL._set1);
|
|
getproc(rtl, "_lengthw", IL._lengthw);
|
|
getproc(rtl, "_strcmpw", IL._strcmpw);
|
|
getproc(rtl, "_init", IL._init);
|
|
|
|
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
|
|
getproc(rtl, "_error", IL._error);
|
|
getproc(rtl, "_divmod", IL._divmod);
|
|
getproc(rtl, "_exit", IL._exit);
|
|
getproc(rtl, "_dispose", IL._dispose);
|
|
getproc(rtl, "_isrec", IL._isrec);
|
|
getproc(rtl, "_dllentry", IL._dllentry);
|
|
getproc(rtl, "_sofinit", IL._sofinit)
|
|
ELSIF CPU = TARGETS.cpuTHUMB THEN
|
|
getproc(rtl, "_fmul", IL._fmul);
|
|
getproc(rtl, "_fdiv", IL._fdiv);
|
|
getproc(rtl, "_fdivi", IL._fdivi);
|
|
getproc(rtl, "_fadd", IL._fadd);
|
|
getproc(rtl, "_fsub", IL._fsub);
|
|
getproc(rtl, "_fsubi", IL._fsubi);
|
|
getproc(rtl, "_fcmp", IL._fcmp);
|
|
getproc(rtl, "_floor", IL._floor);
|
|
getproc(rtl, "_flt", IL._flt);
|
|
getproc(rtl, "_pack", IL._pack);
|
|
getproc(rtl, "_unpk", IL._unpk)
|
|
END
|
|
|
|
END setrtl;
|
|
|
|
|
|
PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS);
|
|
VAR
|
|
parser: PARS.PARSER;
|
|
ext: PARS.PATH;
|
|
|
|
BEGIN
|
|
tINTEGER := PARS.program.stTypes.tINTEGER;
|
|
tBYTE := PARS.program.stTypes.tBYTE;
|
|
tCHAR := PARS.program.stTypes.tCHAR;
|
|
tSET := PARS.program.stTypes.tSET;
|
|
tBOOLEAN := PARS.program.stTypes.tBOOLEAN;
|
|
tWCHAR := PARS.program.stTypes.tWCHAR;
|
|
tREAL := PARS.program.stTypes.tREAL;
|
|
|
|
Options := options;
|
|
CPU := TARGETS.CPU;
|
|
|
|
ext := UTILS.FILE_EXT;
|
|
CaseLabels := C.create();
|
|
CaseVar := C.create();
|
|
|
|
CaseVariants := LISTS.create(NIL);
|
|
LISTS.push(CaseVariants, NewVariant(0, NIL));
|
|
|
|
IL.init(CPU);
|
|
|
|
IF CPU # TARGETS.cpuMSP430 THEN
|
|
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
|
|
IF parser.open(parser, UTILS.RTL_NAME) THEN
|
|
parser.parse(parser);
|
|
PARS.destroy(parser)
|
|
ELSE
|
|
PARS.destroy(parser);
|
|
parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
|
|
IF parser.open(parser, UTILS.RTL_NAME) THEN
|
|
parser.parse(parser);
|
|
PARS.destroy(parser)
|
|
ELSE
|
|
ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT)
|
|
END
|
|
END
|
|
END;
|
|
|
|
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
|
|
parser.main := TRUE;
|
|
|
|
IF parser.open(parser, modname) THEN
|
|
parser.parse(parser)
|
|
ELSE
|
|
ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
|
|
END;
|
|
|
|
PARS.destroy(parser);
|
|
|
|
IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
|
|
ERRORS.Error(204)
|
|
END;
|
|
|
|
IF CPU # TARGETS.cpuMSP430 THEN
|
|
setrtl
|
|
END;
|
|
|
|
PROG.DelUnused(PARS.program, IL.DelImport);
|
|
|
|
IL.set_bss(PARS.program.bss);
|
|
|
|
CASE CPU OF
|
|
|TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options)
|
|
|TARGETS.cpuX86: X86.CodeGen(outname, target, options)
|
|
|TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
|
|
|TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
|
|
END
|
|
|
|
END compile;
|
|
|
|
|
|
END STATEMENTS. |