0,0 → 1,3297 |
(* |
BSD 2-Clause License |
|
Copyright (c) 2018, 2019, Anton Krotov |
All rights reserved. |
*) |
|
MODULE STATEMENTS; |
|
IMPORT |
|
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, CODE, X86, AMD64, |
ERRORS, MACHINE, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; |
|
|
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: CODE.COMMAND; |
processed: BOOLEAN |
|
END; |
|
|
VAR |
|
begcall, endcall: CODE.COMMAND; |
|
checking: SET; |
|
CaseLabels, CaseVar: C.COLLECTION; |
|
CaseVariants: LISTS.LIST; |
|
|
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.typ = PROG.tBOOLEAN) |
END isBoolean; |
|
|
PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tINTEGER) |
END isInteger; |
|
|
PROCEDURE isByte (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.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.typ = PROG.tREAL) |
END isReal; |
|
|
PROCEDURE isSet (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.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.typ = PROG.tCHAR) |
END isChar; |
|
|
PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tCHAR) |
END isCharArray; |
|
|
PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tWCHAR) |
END isCharW; |
|
|
PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tWCHAR) |
END isCharArrayW; |
|
|
PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN; |
RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) |
END isCharArrayX; |
|
|
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 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 getpos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); |
BEGIN |
pos := parser.lex.pos |
END getpos; |
|
|
PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); |
BEGIN |
PARS.NextPos(parser, pos) |
END NextPos; |
|
|
PROCEDURE strlen (e: PARS.EXPR): INTEGER; |
VAR |
res: INTEGER; |
|
BEGIN |
ASSERT(isString(e)); |
IF e.type.typ = PROG.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; |
|
|
PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN; |
RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) & |
~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) & |
PROG.isTypeEq(src.base, dst.base) |
END arrcomp; |
|
|
BEGIN |
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN |
IF arrcomp(e.type, t) THEN |
res := TRUE |
ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN |
IF (e.obj = eCONST) & (t.typ = PROG.tBYTE) THEN |
res := ARITH.range(e.value, 0, 255) |
ELSE |
res := TRUE |
END |
ELSIF isSet(e) & (t.typ = PROG.tSET) THEN |
res := TRUE |
ELSIF isBoolean(e) & (t.typ = PROG.tBOOLEAN) THEN |
res := TRUE |
ELSIF isReal(e) & (t.typ = PROG.tREAL) THEN |
res := TRUE |
ELSIF isChar(e) & (t.typ = PROG.tCHAR) THEN |
res := TRUE |
ELSIF (e.obj = eCONST) & isChar(e) & (t.typ = PROG.tWCHAR) THEN |
res := TRUE |
ELSIF isStringW1(e) & (t.typ = PROG.tWCHAR) THEN |
res := TRUE |
ELSIF isCharW(e) & (t.typ = PROG.tWCHAR) THEN |
res := TRUE |
ELSIF PROG.isBaseOf(t, e.type) THEN |
res := TRUE |
ELSIF ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) THEN |
res := TRUE |
ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN |
res := TRUE |
ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tCHAR) & (t.length > strlen(e))) THEN |
res := TRUE |
ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.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 := CODE.putstr(string.s); |
END; |
offset := string.offset |
ELSE |
offset := CODE.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 := CODE.putstrW(string.s); |
END; |
offset := string.offsetW |
ELSE |
IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN |
offset := CODE.putstrW1(ARITH.Int(e.value)) |
ELSE (* e.type.typ = PROG.tSTRING *) |
string := e.value.string(SCAN.IDENT); |
IF string.offsetW = -1 THEN |
string.offsetW := CODE.putstrW(string.s); |
END; |
offset := string.offsetW |
END |
END |
|
RETURN offset |
END StringW; |
|
|
PROCEDURE CheckRange (range, line, errno: INTEGER); |
VAR |
label: INTEGER; |
|
BEGIN |
label := CODE.NewLabel(); |
CODE.AddCmd2(CODE.opCHKIDX, label, range); |
CODE.OnError(line, errno); |
CODE.SetLabel(label) |
END CheckRange; |
|
|
PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN; |
VAR |
res: BOOLEAN; |
label: INTEGER; |
|
|
PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN; |
RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) & |
~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) & |
PROG.isTypeEq(src.base, dst.base) |
END arrcomp; |
|
|
BEGIN |
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN |
res := TRUE; |
IF arrcomp(e.type, VarType) THEN |
|
IF ~PROG.isOpenArray(VarType) THEN |
CODE.AddCmd(CODE.opCONST, VarType.length) |
END; |
CODE.AddCmd(CODE.opCOPYA, VarType.base.size); |
label := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJE, label); |
CODE.OnError(line, errCOPY); |
CODE.SetLabel(label) |
|
ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN |
IF VarType.typ = PROG.tINTEGER THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE) |
END |
ELSE |
IF e.obj = eCONST THEN |
res := ARITH.range(e.value, 0, 255); |
IF res THEN |
CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) |
END |
ELSE |
IF chkBYTE IN checking THEN |
label := CODE.NewLabel(); |
CODE.AddCmd2(CODE.opCHKBYTE, label, 0); |
CODE.OnError(line, errBYTE); |
CODE.SetLabel(label) |
END; |
CODE.AddCmd0(CODE.opSAVE8) |
END |
END |
ELSIF isSet(e) & (VarType.typ = PROG.tSET) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE) |
END |
ELSIF isBoolean(e) & (VarType.typ = PROG.tBOOLEAN) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSBOOLC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSBOOL) |
END |
ELSIF isReal(e) & (VarType.typ = PROG.tREAL) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)) |
END; |
CODE.savef |
ELSIF isChar(e) & (VarType.typ = PROG.tCHAR) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE8) |
END |
ELSIF (e.obj = eCONST) & isChar(e) & (VarType.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) |
ELSIF isStringW1(e) & (VarType.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s)) |
ELSIF isCharW(e) & (VarType.typ = PROG.tWCHAR) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE16) |
END |
ELSIF PROG.isBaseOf(VarType, e.type) THEN |
IF VarType.typ = PROG.tPOINTER THEN |
CODE.AddCmd0(CODE.opSAVE) |
ELSE |
CODE.AddCmd(CODE.opCOPY, VarType.size) |
END |
ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN |
CODE.AddCmd0(CODE.opSAVE32) |
ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN |
CODE.AddCmd0(CODE.opSAVE16) |
ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN |
IF e.obj = ePROC THEN |
CODE.AssignProc(e.ident.proc.label) |
ELSIF e.obj = eIMP THEN |
CODE.AssignImpProc(e.ident.import) |
ELSE |
IF VarType.typ = PROG.tPROCEDURE THEN |
CODE.AddCmd0(CODE.opSAVE) |
ELSE |
CODE.AddCmd(CODE.opCOPY, VarType.size) |
END |
END |
ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN |
CODE.AddCmd(CODE.opSAVEC, 0) |
ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tCHAR) & (VarType.length > strlen(e))) THEN |
CODE.saves(String(e), strlen(e) + 1) |
ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tWCHAR) & (VarType.length > utf8strlen(e))) THEN |
CODE.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 |
CODE.AddCmd(CODE.opCONST, ARITH.Int(e.value)) |
END LoadConst; |
|
|
PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: PROG.PARAM); |
|
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: INTEGER; |
d1, d2: INTEGER; |
BEGIN |
IF t.length # 0 THEN |
CODE.AddCmd(CODE.opPARAM, 1); |
n := PROG.Dim(t2) - 1; |
WHILE n >= 0 DO |
CODE.AddCmd(CODE.opCONST, ArrLen(t, n)); |
CODE.AddCmd(CODE.opPARAM, 1); |
DEC(n) |
END |
ELSE |
d1 := PROG.Dim(t); |
d2 := PROG.Dim(t2); |
IF d1 # d2 THEN |
n := d2 - d1; |
WHILE d2 > d1 DO |
CODE.AddCmd(CODE.opCONST, ArrLen(t, d2 - 1)); |
DEC(d2) |
END; |
d2 := PROG.Dim(t2); |
WHILE n > 0 DO |
CODE.AddCmd(CODE.opROT, d2); |
DEC(n) |
END |
END; |
CODE.AddCmd(CODE.opPARAM, PROG.Dim(t2) + 1) |
END |
END OpenArray; |
|
|
BEGIN |
IF p.vPar THEN |
|
PARS.check(isVar(e), parser, pos, 93); |
IF p.type.typ = PROG.tRECORD THEN |
PARS.check(PROG.isBaseOf(p.type, e.type), parser, pos, 66); |
IF e.obj = eVREC THEN |
IF e.ident # NIL THEN |
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1) |
ELSE |
CODE.AddCmd0(CODE.opPUSHT) |
END |
ELSE |
CODE.AddCmd(CODE.opCONST, e.type.num) |
END; |
CODE.AddCmd(CODE.opPARAM, 2) |
ELSIF PROG.isOpenArray(p.type) THEN |
PARS.check(arrcomp(e, p), parser, pos, 66); |
OpenArray(e.type, p.type) |
ELSE |
PARS.check(PROG.isTypeEq(e.type, p.type), parser, pos, 66); |
CODE.AddCmd(CODE.opPARAM, 1) |
END; |
PARS.check(~e.readOnly, parser, pos, 94) |
|
ELSE |
PARS.check(isExpr(e) OR isProc(e), parser, pos, 66); |
IF PROG.isOpenArray(p.type) THEN |
IF e.type.typ = PROG.tARRAY THEN |
PARS.check(arrcomp(e, p), parser, pos, 66); |
OpenArray(e.type, p.type) |
ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tCHAR) THEN |
CODE.AddCmd(CODE.opSADR, String(e)); |
CODE.AddCmd(CODE.opPARAM, 1); |
CODE.AddCmd(CODE.opCONST, strlen(e) + 1); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opPARAM, 1); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSE |
PARS.error(parser, pos, 66) |
END |
ELSE |
PARS.check(~PROG.isOpenArray(e.type), parser, pos, 66); |
PARS.check(assigncomp(e, p.type), parser, pos, 66); |
IF e.obj = eCONST THEN |
IF e.type.typ = PROG.tREAL THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.pushf |
ELSIF e.type.typ = PROG.tNIL THEN |
CODE.AddCmd(CODE.opCONST, 0); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF isStringW1(e) & (p.type.typ = PROG.tWCHAR) THEN |
CODE.AddCmd(CODE.opCONST, StrToWChar(e.value.string(SCAN.IDENT).s)); |
CODE.AddCmd(CODE.opPARAM, 1) |
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 |
CODE.SetMinDataSize(p.type.size); |
IF p.type.base.typ = PROG.tCHAR THEN |
CODE.AddCmd(CODE.opSADR, String(e)) |
ELSE (* WCHAR *) |
CODE.AddCmd(CODE.opSADR, StringW(e)) |
END; |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSE |
LoadConst(e); |
CODE.AddCmd(CODE.opPARAM, 1) |
END |
ELSIF e.obj = ePROC THEN |
PARS.check(e.ident.global, parser, pos, 85); |
CODE.PushProc(e.ident.proc.label); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF e.obj = eIMP THEN |
CODE.PushImpProc(e.ident.import); |
CODE.AddCmd(CODE.opPARAM, 1) |
ELSIF isExpr(e) & (e.type.typ = PROG.tREAL) THEN |
CODE.pushf |
ELSE |
IF (p.type.typ = PROG.tBYTE) & (e.type.typ = PROG.tINTEGER) & (chkBYTE IN checking) THEN |
CheckRange(256, pos.line, errBYTE) |
END; |
CODE.AddCmd(CODE.opPARAM, 1) |
END |
END |
|
END |
END paramcomp; |
|
|
PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
e2: PARS.EXPR; |
pos: SCAN.POSITION; |
proc: INTEGER; |
label: INTEGER; |
n, i: INTEGER; |
code: ARITH.VALUE; |
e1: PARS.EXPR; |
wchar: BOOLEAN; |
cmd1, |
cmd2: CODE.COMMAND; |
|
|
PROCEDURE varparam (parser: PARS.PARSER; pos: SCAN.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); |
BEGIN |
parser.designator(parser, e); |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(isfunc(e), parser, pos, 66); |
IF readOnly THEN |
PARS.check(~e.readOnly, parser, 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}); |
|
getpos(parser, pos); |
proc := e.stproc; |
|
IF e.obj IN {eSYSPROC, eSYSFUNC} THEN |
IF parser.unit.scopeLvl > 0 THEN |
parser.unit.scopes[parser.unit.scopeLvl].enter(CODE.COMMAND).allocReg := FALSE |
END |
END; |
|
IF e.obj IN {eSTPROC, eSYSPROC} THEN |
|
CASE proc OF |
|PROG.stASSERT: |
parser.expression(parser, e); |
PARS.check(isBoolean(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
IF ~ARITH.getBool(e.value) THEN |
CODE.OnError(pos.line, errASSERT) |
END |
ELSE |
label := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJE, label); |
CODE.OnError(pos.line, errASSERT); |
CODE.SetLabel(label) |
END |
|
|PROG.stINC, PROG.stDEC: |
CODE.pushBegEnd(begcall, endcall); |
varparam(parser, pos, isInt, TRUE, e); |
IF e.type.typ = PROG.tINTEGER THEN |
IF parser.sym = SCAN.lxCOMMA THEN |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
PARS.check(isInt(e2), parser, pos, 66); |
IF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opINCC + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opINC + ORD(proc = PROG.stDEC)) |
END |
ELSE |
CODE.AddCmd0(CODE.opINC1 + ORD(proc = PROG.stDEC)) |
END |
ELSE (* e.type.typ = PROG.tBYTE *) |
IF parser.sym = SCAN.lxCOMMA THEN |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
PARS.check(isInt(e2), parser, pos, 66); |
IF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opINCB + ORD(proc = PROG.stDEC)) |
END |
ELSE |
CODE.AddCmd0(CODE.opINC1B + ORD(proc = PROG.stDEC)) |
END |
END; |
CODE.popBegEnd(begcall, endcall) |
|
|PROG.stINCL, PROG.stEXCL: |
CODE.pushBegEnd(begcall, endcall); |
varparam(parser, pos, isSet, TRUE, e); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
PARS.check(isInt(e2), parser, pos, 66); |
IF e2.obj = eCONST THEN |
PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 56); |
CODE.AddCmd(CODE.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opINCL + ORD(proc = PROG.stEXCL)) |
END; |
CODE.popBegEnd(begcall, endcall) |
|
|PROG.stNEW: |
varparam(parser, pos, isPtr, TRUE, e); |
CODE.New(e.type.base.size, e.type.base.num) |
|
|PROG.stDISPOSE: |
varparam(parser, pos, isPtr, TRUE, e); |
CODE.AddCmd0(CODE.opDISP) |
|
|PROG.stPACK: |
varparam(parser, pos, isReal, TRUE, e); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
parser.expression(parser, e2); |
PARS.check(isInt(e2), parser, pos, 66); |
IF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opPACKC, ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opPACK) |
END |
|
|PROG.stUNPK: |
varparam(parser, pos, isReal, TRUE, e); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
varparam(parser, pos, isInteger, TRUE, e2); |
CODE.AddCmd0(CODE.opUNPK) |
|
|PROG.stCOPY: |
parser.expression(parser, e); |
IF isString(e) OR isCharArray(e) THEN |
wchar := FALSE |
ELSIF isStringW(e) OR isCharArrayW(e) THEN |
wchar := TRUE |
ELSE |
PARS.check(FALSE, parser, pos, 66) |
END; |
|
IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN |
CODE.AddCmd(CODE.opCONST, e.type.length) |
END; |
|
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
|
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.typ = PROG.tWCHAR |
END; |
|
IF ~PROG.isOpenArray(e1.type) THEN |
CODE.AddCmd(CODE.opCONST, e1.type.length) |
END; |
|
IF e.obj = eCONST THEN |
IF wchar THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1) |
ELSE |
CODE.AddCmd(CODE.opSADR, String(e)); |
CODE.AddCmd(CODE.opCONST, strlen(e) + 1) |
END; |
CODE.AddCmd(CODE.opCOPYS2, e1.type.base.size) |
ELSE |
CODE.AddCmd(CODE.opCOPYS, e1.type.base.size) |
END |
|
|PROG.sysGET: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
parser.designator(parser, e2); |
PARS.check(isVar(e2), parser, pos, 93); |
PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); |
CODE.SysGet(e2.type.size) |
|
|PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32: |
CODE.pushBegEnd(begcall, endcall); |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
CODE.setlast(begcall); |
parser.expression(parser, e2); |
PARS.check(isExpr(e2), parser, pos, 66); |
|
IF proc = PROG.sysPUT THEN |
PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); |
IF e2.obj = eCONST THEN |
IF e2.type.typ = PROG.tREAL THEN |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
CODE.Float(ARITH.Float(e2.value)); |
CODE.savef |
ELSE |
LoadConst(e2); |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
CODE.SysPut(e2.type.size) |
END |
ELSE |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
IF e2.type.typ = PROG.tREAL THEN |
CODE.savef |
ELSIF e2.type.typ = PROG.tBYTE THEN |
CODE.SysPut(PARS.program.stTypes.tINTEGER.size) |
ELSE |
CODE.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.tWCHAR, PROG.tCARD16, PROG.tCARD32}, parser, pos, 66); |
IF e2.obj = eCONST THEN |
LoadConst(e2) |
END; |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
IF proc = PROG.sysPUT8 THEN |
CODE.SysPut(1) |
ELSIF proc = PROG.sysPUT16 THEN |
CODE.SysPut(2) |
ELSIF proc = PROG.sysPUT32 THEN |
CODE.SysPut(4) |
END |
|
END; |
CODE.popBegEnd(begcall, endcall) |
|
|PROG.sysMOVE: |
FOR i := 1 TO 2 DO |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos) |
END; |
|
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
CODE.AddCmd0(CODE.opMOVE) |
|
|PROG.sysCOPY: |
FOR i := 1 TO 2 DO |
parser.designator(parser, e); |
PARS.check(isVar(e), parser, pos, 93); |
n := PROG.Dim(e.type); |
WHILE n > 0 DO |
CODE.drop; |
DEC(n) |
END; |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos) |
END; |
|
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
LoadConst(e) |
END; |
CODE.AddCmd0(CODE.opMOVE) |
|
|PROG.sysCODE: |
REPEAT |
getpos(parser, pos); |
PARS.ConstExpression(parser, code); |
PARS.check(code.typ = ARITH.tINTEGER, parser, pos, 43); |
PARS.check(ARITH.range(code, 0, 255), parser, pos, 42); |
IF parser.sym = SCAN.lxCOMMA THEN |
PARS.Next(parser) |
ELSE |
PARS.checklex(parser, SCAN.lxRROUND) |
END; |
CODE.AddCmd(CODE.opCODE, ARITH.getInt(code)) |
UNTIL parser.sym = SCAN.lxRROUND |
|
END; |
|
e.obj := eEXPR; |
e.type := NIL |
|
ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN |
|
CASE e.stproc OF |
|PROG.stABS: |
parser.expression(parser, e); |
PARS.check(isInt(e) OR isReal(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
PARS.check(ARITH.abs(e.value), parser, pos, 39) |
ELSE |
CODE.abs(isReal(e)) |
END |
|
|PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
PARS.checklex(parser, SCAN.lxCOMMA); |
NextPos(parser, pos); |
parser.expression(parser, e2); |
PARS.check(isInt(e2), parser, pos, 66); |
e.type := PARS.program.stTypes.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 |
CODE.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value)) |
ELSIF e2.obj = eCONST THEN |
CODE.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value)) |
ELSE |
CODE.shift_minmax(shift_minmax(proc)) |
END; |
e.obj := eEXPR |
END |
|
|PROG.stCHR: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tCHAR; |
IF e.obj = eCONST THEN |
ARITH.setChar(e.value, ARITH.getInt(e.value)); |
PARS.check(ARITH.check(e.value), parser, pos, 107) |
ELSE |
IF chkCHR IN checking THEN |
CheckRange(256, pos.line, errCHR) |
ELSE |
CODE.AddCmd0(CODE.opCHR) |
END |
END |
|
|PROG.stWCHR: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tWCHAR; |
IF e.obj = eCONST THEN |
ARITH.setWChar(e.value, ARITH.getInt(e.value)); |
PARS.check(ARITH.check(e.value), parser, pos, 101) |
ELSE |
IF chkWCHR IN checking THEN |
CheckRange(65536, pos.line, errWCHR) |
ELSE |
CODE.AddCmd0(CODE.opWCHR) |
END |
END |
|
|PROG.stFLOOR: |
parser.expression(parser, e); |
PARS.check(isReal(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tINTEGER; |
IF e.obj = eCONST THEN |
PARS.check(ARITH.floor(e.value), parser, pos, 39) |
ELSE |
CODE.floor |
END |
|
|PROG.stFLT: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tREAL; |
IF e.obj = eCONST THEN |
ARITH.flt(e.value) |
ELSE |
PARS.check(CODE.flt(), parser, pos, 41) |
END |
|
|PROG.stLEN: |
cmd1 := CODE.getlast(); |
varparam(parser, pos, isArr, FALSE, e); |
IF e.type.length > 0 THEN |
cmd2 := CODE.getlast(); |
CODE.delete2(cmd1.next, cmd2); |
CODE.setlast(cmd1); |
ASSERT(ARITH.setInt(e.value, e.type.length)); |
e.obj := eCONST |
ELSE |
CODE.len(PROG.Dim(e.type)) |
END; |
e.type := PARS.program.stTypes.tINTEGER |
|
|PROG.stLENGTH: |
parser.expression(parser, e); |
IF isCharArray(e) THEN |
IF e.type.length > 0 THEN |
CODE.AddCmd(CODE.opCONST, e.type.length) |
END; |
CODE.AddCmd0(CODE.opLENGTH) |
ELSIF isCharArrayW(e) THEN |
IF e.type.length > 0 THEN |
CODE.AddCmd(CODE.opCONST, e.type.length) |
END; |
CODE.AddCmd0(CODE.opLENGTHW) |
ELSE |
PARS.check(FALSE, parser, pos, 66); |
END; |
e.type := PARS.program.stTypes.tINTEGER |
|
|PROG.stODD: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
e.type := PARS.program.stTypes.tBOOLEAN; |
IF e.obj = eCONST THEN |
ARITH.odd(e.value) |
ELSE |
CODE.odd |
END |
|
|PROG.stORD: |
parser.expression(parser, e); |
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), parser, 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 |
CODE.ord |
END |
END; |
e.type := PARS.program.stTypes.tINTEGER |
|
|PROG.stBITS: |
parser.expression(parser, e); |
PARS.check(isInt(e), parser, pos, 66); |
IF e.obj = eCONST THEN |
ARITH.bits(e.value) |
END; |
e.type := PARS.program.stTypes.tSET |
|
|PROG.sysADR: |
parser.designator(parser, e); |
IF isVar(e) THEN |
n := PROG.Dim(e.type); |
WHILE n > 0 DO |
CODE.drop; |
DEC(n) |
END |
ELSIF e.obj = ePROC THEN |
CODE.PushProc(e.ident.proc.label) |
ELSIF e.obj = eIMP THEN |
CODE.PushImpProc(e.ident.import) |
ELSE |
PARS.check(FALSE, parser, pos, 108) |
END; |
e.type := PARS.program.stTypes.tINTEGER |
|
|PROG.sysSADR: |
parser.expression(parser, e); |
PARS.check(isString(e), parser, pos, 66); |
CODE.AddCmd(CODE.opSADR, String(e)); |
e.type := PARS.program.stTypes.tINTEGER; |
e.obj := eEXPR |
|
|PROG.sysWSADR: |
parser.expression(parser, e); |
PARS.check(isStringW(e), parser, pos, 66); |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
e.type := PARS.program.stTypes.tINTEGER; |
e.obj := eEXPR |
|
|PROG.sysTYPEID: |
parser.expression(parser, e); |
PARS.check(e.obj = eTYPE, parser, 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.check(FALSE, parser, pos, 52) |
END; |
e.obj := eCONST; |
e.type := PARS.program.stTypes.tINTEGER |
|
|PROG.sysINF: |
PARS.check(CODE.inf(), parser, pos, 41); |
e.obj := eEXPR; |
e.type := PARS.program.stTypes.tREAL |
|
|PROG.sysSIZE: |
parser.expression(parser, e); |
PARS.check(e.obj = eTYPE, parser, pos, 68); |
ASSERT(ARITH.setInt(e.value, e.type.size)); |
e.obj := eCONST; |
e.type := PARS.program.stTypes.tINTEGER |
|
END |
|
END; |
|
PARS.checklex(parser, SCAN.lxRROUND); |
PARS.Next(parser); |
|
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: SCAN.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); |
|
CODE.setlast(begcall); |
|
IF param(PROG.PARAM).vPar THEN |
parser.designator(parser, e1) |
ELSE |
parser.expression(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 |
PARS.Next(parser); |
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: SCAN.POSITION; |
|
BEGIN |
PARS.checklex(parser, SCAN.lxIDENT); |
getpos(parser, pos); |
import := FALSE; |
ident := parser.unit.idents.get(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 := ident.unit.idents.get(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, parser, pos, 109); |
e.obj := eSYSFUNC; |
e.stproc := ident.stproc |
|PROG.idNONE: |
PARS.check(FALSE, parser, pos, 115) |
END; |
|
IF isVar(e) THEN |
PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), parser, pos, 105) |
END |
|
END qualident; |
|
|
PROCEDURE deref (pos: SCAN.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); |
VAR |
label: INTEGER; |
|
BEGIN |
IF load THEN |
CODE.load(e.type.size) |
END; |
|
IF chkPTR IN checking THEN |
label := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJNZ, label); |
CODE.OnError(pos.line, error); |
CODE.SetLabel(label) |
END |
END deref; |
|
|
PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
field: PROG.FIELD; |
pos: SCAN.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 |
CODE.AddCmd(CODE.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 |
CODE.AddCmd(CODE.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.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 |
CODE.AddCmd(CODE.opVADR, e.ident.offset) |
ELSIF PROG.isOpenArray(e.type) THEN |
OpenArray(e) |
ELSE |
CODE.AddCmd(CODE.opLADR, e.ident.offset) |
END |
ELSIF e.obj IN {eVPAR, eVREC} THEN |
IF PROG.isOpenArray(e.type) THEN |
OpenArray(e) |
ELSE |
CODE.AddCmd(CODE.opVADR, e.ident.offset) |
END |
END |
END LoadAdr; |
|
|
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR); |
VAR |
label: INTEGER; |
type: PROG.TYPE_; |
n, offset, k: INTEGER; |
|
BEGIN |
|
IF chkIDX IN checking THEN |
label := CODE.NewLabel(); |
CODE.AddCmd2(CODE.opCHKIDX2, label, 0); |
CODE.OnError(pos.line, errIDX); |
CODE.SetLabel(label) |
ELSE |
CODE.AddCmd(CODE.opCHKIDX2, -1) |
END; |
|
type := PROG.OpenBase(e.type); |
IF type.size # 1 THEN |
CODE.AddCmd(CODE.opMULC, type.size) |
END; |
n := PROG.Dim(e.type) - 1; |
k := n; |
WHILE n > 0 DO |
CODE.AddCmd0(CODE.opMUL); |
DEC(n) |
END; |
CODE.AddCmd0(CODE.opADD); |
offset := e.ident.offset - 1; |
n := k; |
WHILE n > 0 DO |
CODE.AddCmd(CODE.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 := e.type.fields.get(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 |
CODE.AddCmd(CODE.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); |
parser.expression(parser, idx); |
PARS.check(isInt(idx), parser, pos, 76); |
|
IF idx.obj = eCONST THEN |
IF e.type.length > 0 THEN |
PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), parser, pos, 83); |
IF ARITH.Int(idx.value) > 0 THEN |
CODE.AddCmd(CODE.opADDR, ARITH.Int(idx.value) * e.type.base.size) |
END |
ELSE |
PARS.check(ARITH.range(idx.value, 0, MACHINE.target.maxInt), parser, pos, 83); |
LoadConst(idx); |
OpenIdx(parser, pos, e) |
END |
ELSE |
IF e.type.length > 0 THEN |
IF chkIDX IN checking THEN |
CheckRange(e.type.length, pos.line, errIDX) |
END; |
IF e.type.base.size # 1 THEN |
CODE.AddCmd(CODE.opMULC, e.type.base.size) |
END; |
CODE.AddCmd0(CODE.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, parser, pos, 79); |
|
IF e.type.typ = PROG.tRECORD THEN |
PARS.check(t.type.typ = PROG.tRECORD, parser, pos, 80); |
IF chkGUARD IN checking THEN |
IF e.ident = NIL THEN |
CODE.TypeGuard(CODE.opTYPEGD, t.type.num, pos.line, errGUARD) |
ELSE |
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); |
CODE.TypeGuard(CODE.opTYPEGR, t.type.num, pos.line, errGUARD) |
END |
END; |
ELSE |
PARS.check(t.type.typ = PROG.tPOINTER, parser, pos, 81); |
IF chkGUARD IN checking THEN |
CODE.TypeGuard(CODE.opTYPEGP, t.type.base.num, pos.line, errGUARD) |
END |
END; |
|
PARS.check(PROG.isBaseOf(e.type, t.type), parser, 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: SCAN.POSITION; CallStat: BOOLEAN); |
VAR |
cconv: INTEGER; |
params: INTEGER; |
callconv: INTEGER; |
fparams: INTEGER; |
int, flt: INTEGER; |
stk_par: INTEGER; |
|
BEGIN |
cconv := procType.call; |
params := procType.params.size; |
|
IF cconv IN {PROG._win64, PROG.win64} THEN |
callconv := CODE.call_win64; |
fparams := LSL(ORD(procType.params.getfparams(procType, 3, int, flt)), 5) + MIN(params, 4) |
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
callconv := CODE.call_sysv; |
fparams := LSL(ORD(procType.params.getfparams(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + params; |
stk_par := MAX(0, int - 6) + MAX(0, flt - 8) |
ELSE |
callconv := CODE.call_stack; |
fparams := 0 |
END; |
CODE.setlast(begcall); |
fregs := CODE.precall(isfloat); |
|
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN |
CODE.AddCmd(CODE.opALIGN16, params) |
ELSIF cconv IN {PROG._win64, PROG.win64} THEN |
CODE.AddCmd(CODE.opWIN64ALIGN16, params) |
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
CODE.AddCmd(CODE.opSYSVALIGN16, params + stk_par) |
END; |
CODE.setlast(endcall.prev(CODE.COMMAND)); |
|
IF e.obj = eIMP THEN |
CODE.CallImp(e.ident.import, callconv, fparams) |
ELSIF e.obj = ePROC THEN |
CODE.Call(e.ident.proc.label, callconv, fparams) |
ELSIF isExpr(e) THEN |
deref(pos, e, CallStat, errPROC); |
CODE.CallP(callconv, fparams) |
END; |
|
IF cconv IN {PROG._ccall16, PROG.ccall16} THEN |
CODE.AddCmd(CODE.opCLEANUP, params); |
CODE.AddCmd0(CODE.opPOPSP) |
ELSIF cconv IN {PROG._win64, PROG.win64} THEN |
CODE.AddCmd(CODE.opCLEANUP, MAX(params + params MOD 2, 4) + 1); |
CODE.AddCmd0(CODE.opPOPSP) |
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
CODE.AddCmd(CODE.opCLEANUP, params + stk_par); |
CODE.AddCmd0(CODE.opPOPSP) |
ELSIF cconv IN {PROG._ccall, PROG.ccall} THEN |
CODE.AddCmd(CODE.opCLEANUP, params) |
END; |
|
IF ~CallStat THEN |
IF isfloat THEN |
PARS.check(CODE.resf(fregs), parser, pos, 41) |
ELSE |
CODE.res(fregs) |
END |
END |
END ProcCall; |
|
|
PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
pos, pos0, pos1: SCAN.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: SCAN.POSITION; |
range: BOOLEAN; |
|
BEGIN |
range := FALSE; |
getpos(parser, pos); |
expression(parser, e1); |
PARS.check(isInt(e1), parser, pos, 76); |
|
IF e1.obj = eCONST THEN |
PARS.check(ARITH.range(e1.value, 0, MACHINE.target.maxSet), parser, pos, 44) |
END; |
|
range := parser.sym = SCAN.lxRANGE; |
|
IF range THEN |
NextPos(parser, pos); |
expression(parser, e2); |
PARS.check(isInt(e2), parser, pos, 76); |
|
IF e2.obj = eCONST THEN |
PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 44) |
END |
ELSE |
IF e1.obj = eCONST THEN |
e2 := e1 |
END |
END; |
|
e.type := PARS.program.stTypes.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 |
CODE.AddCmd(CODE.opRSETL, ARITH.Int(e1.value)) |
ELSIF e2.obj = eCONST THEN |
CODE.AddCmd(CODE.opRSETR, ARITH.Int(e2.value)) |
ELSE |
CODE.AddCmd0(CODE.opRSET) |
END |
ELSE |
CODE.AddCmd0(CODE.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 := PARS.program.stTypes.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 |
CODE.AddCmd(CODE.opADDSL, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDSR, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.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: SCAN.POSITION; |
e1: PARS.EXPR; |
isfloat: BOOLEAN; |
fregs: INTEGER; |
|
|
PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: SCAN.POSITION); |
BEGIN |
IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN |
IF e.type.typ = PROG.tREAL THEN |
PARS.check(CODE.loadf(), parser, pos, 41) |
ELSE |
CODE.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 := PARS.program.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 := PARS.program.stTypes.tBOOLEAN; |
PARS.Next(parser) |
|
ELSIF sym = SCAN.lxLCURLY THEN |
set(parser, e) |
|
ELSIF sym = SCAN.lxIDENT THEN |
getpos(parser, pos); |
|
CODE.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, parser, pos, 59); |
isfloat := e.type.typ = PROG.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; |
CODE.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), parser, pos, 72); |
IF e.obj # eCONST THEN |
CODE.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: SCAN.POSITION; |
op: INTEGER; |
e1: PARS.EXPR; |
|
label: INTEGER; |
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 := CODE.NewLabel() |
END; |
|
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) |
END; |
CODE.AddJmpCmd(CODE.opJZ, label); |
CODE.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), parser, 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, "*"), parser, pos, 39) |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40) |
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "*") |
END |
|
ELSE |
IF isInt(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opMUL) |
END |
ELSIF isReal(e) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)) |
END; |
CODE.fbinop(CODE.opMULF) |
ELSIF isSet(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opMULS) |
END |
END; |
e.obj := eEXPR |
END |
|
|SCAN.lxSLASH: |
PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); |
IF (e1.obj = eCONST) & isReal(e1) THEN |
PARS.check(~ARITH.isZero(e1.value), parser, 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, "/"), parser, pos, 40) |
|ARITH.tSET: ARITH.opSet(e.value, e1.value, "/") |
END |
|
ELSE |
IF isReal(e) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.fbinop(CODE.opDIVFI) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fbinop(CODE.opDIVF) |
ELSE |
CODE.fbinop(CODE.opDIVF) |
END |
ELSIF isSet(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opDIVS) |
END |
END; |
e.obj := eEXPR |
END |
|
|SCAN.lxDIV, SCAN.lxMOD: |
PARS.check(isInt(e) & isInt(e1), parser, pos, 37); |
IF e1.obj = eCONST THEN |
PARS.check(~ARITH.isZero(e1.value), parser, pos, 46) |
END; |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
|
IF op = SCAN.lxDIV THEN |
PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39) |
ELSE |
ASSERT(ARITH.opInt(e.value, e1.value, "M")) |
END |
|
ELSE |
IF e1.obj # eCONST THEN |
label1 := CODE.NewLabel(); |
CODE.AddJmpCmd(CODE.opJNZ, label1) |
END; |
IF e.obj = eCONST THEN |
CODE.OnError(pos.line, errDIV); |
CODE.SetLabel(label1); |
CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value)) |
ELSE |
CODE.OnError(pos.line, errDIV); |
CODE.SetLabel(label1); |
CODE.AddCmd0(CODE.opDIV + ORD(op = SCAN.lxMOD)) |
END; |
e.obj := eEXPR |
END |
|
|SCAN.lxAND: |
PARS.check(isBoolean(e) & isBoolean(e1), parser, 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 |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) |
END |
END |
|
END |
END; |
|
IF label # -1 THEN |
CODE.SetLabel(label) |
END |
END term; |
|
|
PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
pos: SCAN.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), parser, pos, 36); |
|
IF minus & (e.obj = eCONST) THEN |
PARS.check(ARITH.neg(e.value), parser, pos, 39) |
END; |
|
IF e.obj # eCONST THEN |
IF minus THEN |
IF isInt(e) THEN |
CODE.AddCmd0(CODE.opUMINUS) |
ELSIF isReal(e) THEN |
CODE.AddCmd0(CODE.opUMINF) |
ELSIF isSet(e) THEN |
CODE.AddCmd0(CODE.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 := CODE.NewLabel() |
END; |
|
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) |
END; |
CODE.AddJmpCmd(CODE.opJNZ, label); |
CODE.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), parser, 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)), parser, pos, 39) |
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40) |
|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op)) |
END |
|
ELSE |
IF isInt(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opADD + ORD(op = ORD("-"))) |
END |
ELSIF isReal(e) THEN |
IF e.obj = eCONST THEN |
CODE.Float(ARITH.Float(e.value)); |
CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-"))) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) |
ELSE |
CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) |
END |
ELSIF isSet(e) THEN |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opADDS + ORD(op = ORD("-"))) |
END |
END; |
e.obj := eEXPR |
END |
|
|SCAN.lxOR: |
PARS.check(isBoolean(e) & isBoolean(e1), parser, 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 |
CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) |
END |
END |
|
END |
END; |
|
IF label # -1 THEN |
CODE.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 BoolCmp (eq, val: BOOLEAN); |
BEGIN |
IF eq = val THEN |
CODE.AddCmd0(CODE.opNER) |
ELSE |
CODE.AddCmd0(CODE.opEQR) |
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 |
CODE.AddCmd(CODE.opSADR, String(e)); |
CODE.AddCmd(CODE.opCONST, strlen(e) + 1); |
CODE.AddCmd0(CODE.opEQS2 + cmpcode(op)) |
|
ELSIF isString(e) & isCharArrayW(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); |
CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) |
|
ELSIF isStringW(e) & isCharArrayW(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); |
CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) |
|
ELSIF isCharArray(e) & isString(e1) THEN |
CODE.AddCmd(CODE.opSADR, String(e1)); |
CODE.AddCmd(CODE.opCONST, strlen(e1) + 1); |
CODE.AddCmd0(CODE.opEQS + cmpcode(op)) |
|
ELSIF isCharArrayW(e) & isString(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e1)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); |
CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) |
|
ELSIF isCharArrayW(e) & isStringW(e1) THEN |
CODE.AddCmd(CODE.opSADR, StringW(e1)); |
CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); |
CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) |
|
ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN |
CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) |
|
ELSIF isCharArray(e) & isCharArray(e1) THEN |
CODE.AddCmd0(CODE.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 |
CODE.AddCmd(CODE.opCONST, e.type.length) |
END; |
op := parser.sym; |
getpos(parser, pos); |
PARS.Next(parser); |
|
pos1 := parser.lex.pos; |
SimpleExpression(parser, e1); |
|
IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN |
CODE.AddCmd(CODE.opCONST, 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 |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op)) |
END |
END |
|
ELSIF isStringW1(e) & isCharW(e1) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s)) |
|
ELSIF isStringW1(e1) & isCharW(e) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, 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 |
CODE.AddCmd0(CODE.opEQB) |
ELSE |
CODE.AddCmd0(CODE.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 |
CODE.Float(ARITH.Float(e.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op)) |
ELSE |
CODE.fcmp(CODE.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(parser, pos, 37) |
END |
|
ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN |
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) |
|
ELSIF isProc(e) & isNil(e1) THEN |
IF e.obj IN {ePROC, eIMP} THEN |
PARS.check(e.ident.global, parser, pos0, 85); |
constant := TRUE; |
e.obj := eCONST; |
ARITH.setbool(e.value, op = SCAN.lxNE) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) |
END |
|
ELSIF isNil(e) & isProc(e1) THEN |
IF e1.obj IN {ePROC, eIMP} THEN |
PARS.check(e1.ident.global, parser, pos1, 85); |
constant := TRUE; |
e.obj := eCONST; |
ARITH.setbool(e.value, op = SCAN.lxNE) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) |
END |
|
ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN |
IF e.obj = ePROC THEN |
PARS.check(e.ident.global, parser, pos0, 85) |
END; |
IF e1.obj = ePROC THEN |
PARS.check(e1.ident.global, parser, 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 |
CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0) |
ELSIF e1.obj = ePROC THEN |
CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0) |
ELSIF e.obj = eIMP THEN |
CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0) |
ELSIF e1.obj = eIMP THEN |
CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0) |
ELSE |
CODE.AddCmd0(CODE.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(parser, 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 |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opEQ + cmpcode(op)) |
END |
END |
|
ELSIF isStringW1(e) & isCharW(e1) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s)) |
|
ELSIF isStringW1(e1) & isCharW(e) THEN |
CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, 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 |
CODE.Float(ARITH.Float(e.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) |
ELSIF e1.obj = eCONST THEN |
CODE.Float(ARITH.Float(e1.value)); |
CODE.fcmp(CODE.opEQF + cmpcode(op)) |
ELSE |
CODE.fcmp(CODE.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(parser, pos, 37) |
END |
|
ELSE |
PARS.error(parser, pos, 37) |
END |
|
|SCAN.lxIN: |
PARS.check(isInt(e) & isSet(e1), parser, pos, 37); |
IF e.obj = eCONST THEN |
PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56) |
END; |
IF constant THEN |
ARITH.relation(e.value, e1.value, operator, error) |
ELSE |
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opINL, ARITH.Int(e.value)) |
ELSIF e1.obj = eCONST THEN |
CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value)) |
ELSE |
CODE.AddCmd0(CODE.opIN) |
END |
END |
|
|SCAN.lxIS: |
PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73); |
IF e.type.typ = PROG.tRECORD THEN |
PARS.check(e.obj = eVREC, parser, pos0, 78) |
END; |
PARS.check(e1.obj = eTYPE, parser, pos1, 79); |
|
IF e.type.typ = PROG.tRECORD THEN |
PARS.check(e1.type.typ = PROG.tRECORD, parser, pos1, 80); |
IF e.ident = NIL THEN |
CODE.TypeCheck(e1.type.num) |
ELSE |
CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); |
CODE.TypeCheckRec(e1.type.num) |
END |
ELSE |
PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81); |
CODE.TypeCheck(e1.type.base.num) |
END; |
|
PARS.check(PROG.isBaseOf(e.type, e1.type), parser, pos1, 82) |
|
END; |
|
ASSERT(error = 0); |
|
e.type := PARS.program.stTypes.tBOOLEAN; |
|
IF ~constant THEN |
e.obj := eEXPR |
END |
|
END |
END expression; |
|
|
PROCEDURE ElementaryStatement (parser: PARS.PARSER); |
VAR |
e, e1: PARS.EXPR; |
pos: SCAN.POSITION; |
line: INTEGER; |
call: BOOLEAN; |
fregs: INTEGER; |
|
BEGIN |
getpos(parser, pos); |
|
CODE.pushBegEnd(begcall, endcall); |
|
designator(parser, e); |
|
IF parser.sym = SCAN.lxASSIGN THEN |
line := parser.lex.pos.line; |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(~e.readOnly, parser, pos, 94); |
|
CODE.setlast(begcall); |
|
NextPos(parser, pos); |
expression(parser, e1); |
|
CODE.setlast(endcall.prev(CODE.COMMAND)); |
|
PARS.check(assign(e1, e.type, line), parser, pos, 91); |
IF e1.obj = ePROC THEN |
PARS.check(e1.ident.global, parser, 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), parser, pos, 92); |
call := TRUE |
ELSE |
PARS.check(isProc(e), parser, pos, 86); |
PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92); |
PARS.check1(e.type.params.first = NIL, parser, 64); |
call := TRUE |
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; |
|
CODE.popBegEnd(begcall, endcall) |
END ElementaryStatement; |
|
|
PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); |
VAR |
e: PARS.EXPR; |
pos: SCAN.POSITION; |
|
label, L: INTEGER; |
|
BEGIN |
L := CODE.NewLabel(); |
|
IF ~if THEN |
CODE.AddCmd0(CODE.opLOOP); |
CODE.SetLabel(L) |
END; |
|
REPEAT |
NextPos(parser, pos); |
|
label := CODE.NewLabel(); |
|
expression(parser, e); |
PARS.check(isBoolean(e), parser, pos, 72); |
|
IF e.obj = eCONST THEN |
IF ~ARITH.getBool(e.value) THEN |
CODE.AddJmpCmd(CODE.opJMP, label) |
END |
ELSE |
CODE.AddJmpCmd(CODE.opJNE, label) |
END; |
|
IF if THEN |
PARS.checklex(parser, SCAN.lxTHEN) |
ELSE |
PARS.checklex(parser, SCAN.lxDO) |
END; |
|
PARS.Next(parser); |
parser.StatSeq(parser); |
|
CODE.AddJmpCmd(CODE.opJMP, L); |
CODE.SetLabel(label) |
|
UNTIL parser.sym # SCAN.lxELSIF; |
|
IF if THEN |
IF parser.sym = SCAN.lxELSE THEN |
PARS.Next(parser); |
parser.StatSeq(parser) |
END; |
CODE.SetLabel(L) |
END; |
|
PARS.checklex(parser, SCAN.lxEND); |
|
IF ~if THEN |
CODE.AddCmd0(CODE.opENDLOOP) |
END; |
|
PARS.Next(parser) |
END IfStatement; |
|
|
PROCEDURE RepeatStatement (parser: PARS.PARSER); |
VAR |
e: PARS.EXPR; |
pos: SCAN.POSITION; |
label: INTEGER; |
|
BEGIN |
CODE.AddCmd0(CODE.opLOOP); |
|
label := CODE.NewLabel(); |
CODE.SetLabel(label); |
|
PARS.Next(parser); |
parser.StatSeq(parser); |
PARS.checklex(parser, SCAN.lxUNTIL); |
NextPos(parser, pos); |
expression(parser, e); |
PARS.check(isBoolean(e), parser, pos, 72); |
|
IF e.obj = eCONST THEN |
IF ~ARITH.getBool(e.value) THEN |
CODE.AddJmpCmd(CODE.opJMP, label) |
END |
ELSE |
CODE.AddJmpCmd(CODE.opJNE, label) |
END; |
|
CODE.AddCmd0(CODE.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: CODE.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: SCAN.POSITION; |
|
|
PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN; |
RETURN isRec(caseExpr) OR isPtr(caseExpr) |
END isRecPtr; |
|
|
PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; |
VAR |
a: INTEGER; |
label: PARS.EXPR; |
pos: SCAN.POSITION; |
value: ARITH.VALUE; |
|
BEGIN |
getpos(parser, pos); |
type := NIL; |
|
IF isChar(caseExpr) THEN |
PARS.ConstExpression(parser, value); |
PARS.check(value.typ = ARITH.tCHAR, parser, 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}, parser, pos, 99) |
END; |
a := ARITH.getInt(value) |
ELSIF isInt(caseExpr) THEN |
PARS.ConstExpression(parser, value); |
PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99); |
a := ARITH.getInt(value) |
ELSIF isRecPtr(caseExpr) THEN |
qualident(parser, label); |
PARS.check(label.obj = eTYPE, parser, pos, 79); |
PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, 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: SCAN.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)), parser, 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: SCAN.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 := CODE.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, parser, 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, parser, 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: CODE.COMMAND; |
|
BEGIN |
sym := parser.sym; |
IF sym # SCAN.lxBAR THEN |
variant := CODE.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 := CODE.getlast(); |
CODE.SetLabel(variant); |
|
IF ~isRecPtr(caseExpr) THEN |
LISTS.push(CaseVariants, NewVariant(variant, last)) |
END; |
|
parser.StatSeq(parser); |
CODE.AddJmpCmd(CODE.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: CODE.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 := CODE.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)); |
CODE.setlast(v.cmd); |
|
CODE.SetLabel(node.data(CASE_LABEL).self); |
CODE.case(range.a, range.b, L, R); |
IF v.processed THEN |
CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant) |
END; |
v.processed := TRUE; |
|
CODE.setlast(last); |
|
Table(left, else); |
Table(right, else) |
END |
END Table; |
|
|
PROCEDURE TableT (node: AVL.NODE); |
BEGIN |
IF node # NIL THEN |
CODE.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: SCAN.POSITION); |
VAR |
table, end, else: INTEGER; |
tree: AVL.NODE; |
item: LISTS.ITEM; |
|
BEGIN |
LISTS.push(CaseVariants, NewVariant(0, NIL)); |
end := CODE.NewLabel(); |
else := CODE.NewLabel(); |
table := CODE.NewLabel(); |
CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e))); |
CODE.AddJmpCmd(CODE.opJMP, table); |
|
tree := NIL; |
|
case(parser, e, tree, end); |
WHILE parser.sym = SCAN.lxBAR DO |
PARS.Next(parser); |
case(parser, e, tree, end) |
END; |
|
CODE.SetLabel(else); |
IF parser.sym = SCAN.lxELSE THEN |
PARS.Next(parser); |
parser.StatSeq(parser); |
CODE.AddJmpCmd(CODE.opJMP, end) |
ELSE |
CODE.OnError(pos.line, errCASE) |
END; |
|
PARS.checklex(parser, SCAN.lxEND); |
PARS.Next(parser); |
|
IF isRecPtr(e) THEN |
CODE.SetLabel(table); |
TableT(tree); |
CODE.AddJmpCmd(CODE.opJMP, else) |
ELSE |
tree.data(CASE_LABEL).self := table; |
Table(tree, else) |
END; |
|
AVL.destroy(tree, DestroyLabel); |
CODE.SetLabel(end); |
CODE.AddCmd0(CODE.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), parser, pos, 95); |
IF isRecPtr(e) THEN |
PARS.check(isVar(e), parser, pos, 93); |
PARS.check(e.ident # NIL, parser, pos, 106) |
END; |
IF isRec(e) THEN |
PARS.check(e.obj = eVREC, parser, pos, 78) |
END; |
|
IF e.obj = eCONST THEN |
LoadConst(e) |
ELSIF isRec(e) THEN |
CODE.drop; |
CODE.AddCmd(CODE.opLADR, e.ident.offset - 1); |
CODE.load(PARS.program.target.word) |
ELSIF isPtr(e) THEN |
deref(pos, e, FALSE, errPTR); |
CODE.AddCmd(CODE.opSUBR, PARS.program.target.word); |
CODE.load(PARS.program.target.word) |
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: SCAN.POSITION; |
step: ARITH.VALUE; |
st: INTEGER; |
ident: PROG.IDENT; |
offset: INTEGER; |
L1, L2: INTEGER; |
|
BEGIN |
CODE.AddCmd0(CODE.opLOOP); |
|
L1 := CODE.NewLabel(); |
L2 := CODE.NewLabel(); |
|
PARS.ExpectSym(parser, SCAN.lxIDENT); |
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE); |
PARS.check1(ident # NIL, parser, 48); |
PARS.check1(ident.typ = PROG.idVAR, parser, 93); |
PARS.check1(ident.type.typ = PROG.tINTEGER, parser, 97); |
PARS.ExpectSym(parser, SCAN.lxASSIGN); |
NextPos(parser, pos); |
expression(parser, e); |
PARS.check(isInt(e), parser, pos, 76); |
|
offset := PROG.getOffset(PARS.program, ident); |
|
IF ident.global THEN |
CODE.AddCmd(CODE.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.opLADR, -offset) |
END; |
|
IF e.obj = eCONST THEN |
CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd0(CODE.opSAVE) |
END; |
|
CODE.SetLabel(L1); |
|
IF ident.global THEN |
CODE.AddCmd(CODE.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.opLADR, -offset) |
END; |
CODE.load(ident.type.size); |
|
PARS.checklex(parser, SCAN.lxTO); |
NextPos(parser, pos); |
expression(parser, e); |
PARS.check(isInt(e), parser, pos, 76); |
|
IF parser.sym = SCAN.lxBY THEN |
NextPos(parser, pos); |
PARS.ConstExpression(parser, step); |
PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76); |
st := ARITH.getInt(step); |
PARS.check(st # 0, parser, pos, 98) |
ELSE |
st := 1 |
END; |
|
IF e.obj = eCONST THEN |
IF st > 0 THEN |
CODE.AddCmd(CODE.opLER, ARITH.Int(e.value)) |
ELSE |
CODE.AddCmd(CODE.opGER, ARITH.Int(e.value)) |
END |
ELSE |
IF st > 0 THEN |
CODE.AddCmd0(CODE.opLE) |
ELSE |
CODE.AddCmd0(CODE.opGE) |
END |
END; |
|
CODE.AddJmpCmd(CODE.opJNE, L2); |
|
PARS.checklex(parser, SCAN.lxDO); |
PARS.Next(parser); |
parser.StatSeq(parser); |
|
IF ident.global THEN |
CODE.AddCmd(CODE.opGADR, offset) |
ELSE |
CODE.AddCmd(CODE.opLADR, -offset) |
END; |
|
IF st = 1 THEN |
CODE.AddCmd0(CODE.opINC1) |
ELSIF st = -1 THEN |
CODE.AddCmd0(CODE.opDEC1) |
ELSE |
IF st > 0 THEN |
CODE.AddCmd(CODE.opINCC, st) |
ELSE |
CODE.AddCmd(CODE.opDECC, -st) |
END |
END; |
|
CODE.AddJmpCmd(CODE.opJMP, L1); |
|
PARS.checklex(parser, SCAN.lxEND); |
PARS.Next(parser); |
|
CODE.SetLabel(L2); |
|
CODE.AddCmd0(CODE.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: SCAN.POSITION): BOOLEAN; |
VAR |
res: BOOLEAN; |
|
BEGIN |
res := assigncomp(e, t); |
IF res THEN |
IF e.obj = eCONST THEN |
IF e.type.typ = PROG.tREAL THEN |
CODE.Float(ARITH.Float(e.value)) |
ELSIF e.type.typ = PROG.tNIL THEN |
CODE.AddCmd(CODE.opCONST, 0) |
ELSE |
LoadConst(e) |
END |
ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN checking) THEN |
CheckRange(256, pos.line, errBYTE) |
ELSIF e.obj = ePROC THEN |
PARS.check(e.ident.global, parser, pos, 85); |
CODE.PushProc(e.ident.proc.label) |
ELSIF e.obj = eIMP THEN |
CODE.PushImpProc(e.ident.import) |
END; |
|
IF e.type.typ = PROG.tREAL THEN |
CODE.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 := rtl.idents.get(rtl, SCAN.enterid(name), FALSE); |
|
IF (id # NIL) & (id.import # NIL) THEN |
CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label; |
id.proc.used := TRUE |
ELSIF (id # NIL) & (id.proc # NIL) THEN |
CODE.codes.rtl[idx] := id.proc.label; |
id.proc.used := TRUE |
ELSE |
ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found") |
END |
END getproc; |
|
|
BEGIN |
rtl := PARS.program.rtl; |
ASSERT(rtl # NIL); |
|
getproc(rtl, "_move", CODE._move); |
getproc(rtl, "_move2", CODE._move2); |
getproc(rtl, "_set", CODE._set); |
getproc(rtl, "_set2", CODE._set2); |
getproc(rtl, "_div", CODE._div); |
getproc(rtl, "_mod", CODE._mod); |
getproc(rtl, "_div2", CODE._div2); |
getproc(rtl, "_mod2", CODE._mod2); |
getproc(rtl, "_arrcpy", CODE._arrcpy); |
getproc(rtl, "_rot", CODE._rot); |
getproc(rtl, "_new", CODE._new); |
getproc(rtl, "_dispose", CODE._dispose); |
getproc(rtl, "_strcmp", CODE._strcmp); |
getproc(rtl, "_error", CODE._error); |
getproc(rtl, "_is", CODE._is); |
getproc(rtl, "_isrec", CODE._isrec); |
getproc(rtl, "_guard", CODE._guard); |
getproc(rtl, "_guardrec", CODE._guardrec); |
getproc(rtl, "_length", CODE._length); |
getproc(rtl, "_init", CODE._init); |
getproc(rtl, "_dllentry", CODE._dllentry); |
getproc(rtl, "_strcpy", CODE._strcpy); |
getproc(rtl, "_exit", CODE._exit); |
getproc(rtl, "_strcpy2", CODE._strcpy2); |
getproc(rtl, "_lengthw", CODE._lengthw); |
getproc(rtl, "_strcmp2", CODE._strcmp2); |
getproc(rtl, "_strcmpw", CODE._strcmpw); |
getproc(rtl, "_strcmpw2", CODE._strcmpw2); |
|
END setrtl; |
|
|
PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET); |
VAR |
parser: PARS.PARSER; |
ext: PARS.PATH; |
amd64: BOOLEAN; |
|
BEGIN |
amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; |
ext := mConst.FILE_EXT; |
CaseLabels := C.create(); |
CaseVar := C.create(); |
|
CaseVariants := LISTS.create(NIL); |
LISTS.push(CaseVariants, NewVariant(0, NIL)); |
|
checking := chk; |
|
IF amd64 THEN |
CODE.init(6, CODE.little_endian) |
ELSE |
CODE.init(8, CODE.little_endian) |
END; |
|
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); |
IF parser.open(parser, mConst.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, mConst.RTL_NAME) THEN |
parser.parse(parser); |
PARS.destroy(parser) |
ELSE |
ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found") |
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.error5("file ", path, modname, mConst.FILE_EXT, " not found") |
END; |
|
PARS.destroy(parser); |
|
IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN |
ERRORS.error1("size of global variables is too large") |
END; |
|
setrtl; |
|
PROG.DelUnused(PARS.program, CODE.DelImport); |
|
CODE.codes.bss := PARS.program.bss; |
IF amd64 THEN |
AMD64.CodeGen(CODE.codes, outname, target, stack, base) |
ELSE |
X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic) |
END |
END compile; |
|
|
END STATEMENTS. |