(* 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, RVM32I, 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 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 Float (parser: PARS.PARSER; e: PARS.EXPR); VAR pos: PARS.POSITION; BEGIN getpos(parser, pos); IL.Float(ARITH.Float(e.value), pos.line, pos.col) END Float; PROCEDURE assign (parser: PARS.PARSER; 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.opJNZ, 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 Float(parser, e) 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 Float(parser, e); IL.AddCmd0(IL.opPUSHF) 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.AddCmd0(IL.opPUSHF) 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, size, 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.not; IL.AndOrOpt(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, PROG.sysGET8, PROG.sysGET16, PROG.sysGET32: 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); IF proc = PROG.sysGET THEN PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66) ELSE PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66) END; CASE proc OF |PROG.sysGET: size := e2._type.size |PROG.sysGET8: size := 1 |PROG.sysGET16: size := 2 |PROG.sysGET32: size := 4 END; PARS.check(size <= e2._type.size, pos, 66); IF e.obj = eCONST THEN IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), size) ELSE IL.AddCmd(IL.opGET, 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 Float(parser, e2); 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: size := 1 |PROG.sysPUT16: size := 2 |PROG.sysPUT32: size := 4 END; IL.SysPut(size) 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 TARGETS.WordSize > TARGETS.InstrSize THEN CASE TARGETS.InstrSize OF |1: PARS.check(ARITH.range(code, 0, 255), pos, 42) |2: PARS.check(ARITH.range(code, 0, 65535), pos, 110) END 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.AddCmd0(IL.opFLOOR) 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 IL.AddCmd2(IL.opFLT, pos.line, pos.col) 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._ord 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: IL.AddCmd2(IL.opINF, pos.line, pos.col); 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; imp: BOOLEAN; pos: PARS.POSITION; BEGIN PARS.checklex(parser, SCAN.lxIDENT); getpos(parser, pos); imp := 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); imp := 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 := imp |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._type := ident._type; e.stproc := ident.stproc |PROG.idSTFUNC: e.obj := eSTFUNC; e._type := ident._type; e.stproc := ident.stproc |PROG.idSYSPROC: e.obj := eSYSPROC; e._type := ident._type; e.stproc := ident.stproc |PROG.idSYSFUNC: PARS.check(~parser.constexp, pos, 109); e.obj := eSYSFUNC; e._type := ident._type; 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.opJNZ1, 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(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.opADDC, 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.opADDC, 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; 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); IL.AddCmd(IL.opPRECALL, ORD(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 IL.AddCmd0(IL.opRES); IL.drop ELSE IF isfloat THEN IL.AddCmd2(IL.opRESF, pos.line, pos.col) ELSE IL.AddCmd0(IL.opRES) END END END ProcCall; PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR pos, pos0, pos1: PARS.POSITION; e1: PARS.EXPR; op, cmp, error: INTEGER; constant, eq: BOOLEAN; 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.opADDSC, ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN IL.AddCmd(IL.opADDSC, 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; 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 IL.AddCmd2(IL.opLOADF, pos.line, pos.col) 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(e.value.typ); PARS.Next(parser) ELSIF sym = SCAN.lxNIL THEN e.obj := eCONST; e._type := PROG.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, parser, pos, FALSE) ELSIF isExpr(e1) THEN ProcCall(e1, e1._type, isfloat, 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.AndOrOpt(label) 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 Float(parser, e) ELSIF e1.obj = eCONST THEN Float(parser, e1) END; IL.AddCmd0(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 Float(parser, e); IL.AddCmd0(IL.opDIVFI) ELSIF e1.obj = eCONST THEN Float(parser, e1); IL.AddCmd0(IL.opDIVF) ELSE IL.AddCmd0(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 END END END; IF label # -1 THEN label1 := IL.NewLabel(); IL.AddJmpCmd(IL.opJNZ, label1); IL.SetLabel(label); IL.Const(0); IL.drop; label := IL.NewLabel(); IL.AddJmpCmd(IL.opJMP, label); IL.SetLabel(label1); IL.Const(1); IL.SetLabel(label); IL.AddCmd0(IL.opAND) END END term; PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR pos: PARS.POSITION; op: INTEGER; e1: PARS.EXPR; s, s1: SCAN.LEXSTR; plus, minus: BOOLEAN; label, label1: 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.not; IL.AndOrOpt(label) END END; term(parser, e1); CASE op OF |SCAN.lxPLUS, SCAN.lxMINUS: minus := op = SCAN.lxMINUS; IF minus THEN op := ORD("-") ELSE op := ORD("+") END; PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1) OR isString(e) & isString(e1) & ~minus, 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)) |ARITH.tCHAR, ARITH.tSTRING: IF e.value.typ = ARITH.tCHAR THEN ARITH.charToStr(e.value, s) ELSE s := e.value.string(SCAN.IDENT).s END; IF e1.value.typ = ARITH.tCHAR THEN ARITH.charToStr(e1.value, s1) ELSE s1 := e1.value.string(SCAN.IDENT).s END; PARS.check(ARITH.concat(s, s1), pos, 5); e.value.string := SCAN.enterid(s); e.value.typ := ARITH.tSTRING; e._type := PROG.program.stTypes.tSTRING END ELSE IF isInt(e) THEN IF e.obj = eCONST THEN IL.AddCmd(IL.opADDC - ORD(minus), ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN IL.AddCmd(IL.opADDC + ORD(minus), ARITH.Int(e1.value)) ELSE IL.AddCmd0(IL.opADD + ORD(minus)) END ELSIF isReal(e) THEN IF e.obj = eCONST THEN Float(parser, e); IL.AddCmd0(IL.opADDF - ORD(minus)) ELSIF e1.obj = eCONST THEN Float(parser, e1); IL.AddCmd0(IL.opADDF + ORD(minus)) ELSE IL.AddCmd0(IL.opADDF + ORD(minus)) END ELSIF isSet(e) THEN IF e.obj = eCONST THEN IL.AddCmd(IL.opADDSC - ORD(minus), ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN IL.AddCmd(IL.opADDSC + ORD(minus), ARITH.Int(e1.value)) ELSE IL.AddCmd0(IL.opADDS + ORD(minus)) 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 END END END; IF label # -1 THEN label1 := IL.NewLabel(); IL.AddJmpCmd(IL.opJZ, label1); IL.SetLabel(label); IL.Const(1); IL.drop; label := IL.NewLabel(); IL.AddJmpCmd(IL.opJMP, label); IL.SetLabel(label1); IL.Const(0); IL.SetLabel(label); IL.AddCmd0(IL.opOR) END END SimpleExpression; PROCEDURE cmpcode (op: INTEGER): INTEGER; VAR res: INTEGER; BEGIN CASE op OF |SCAN.lxEQ: res := ARITH.opEQ |SCAN.lxNE: res := ARITH.opNE |SCAN.lxLT: res := ARITH.opLT |SCAN.lxLE: res := ARITH.opLE |SCAN.lxGT: res := ARITH.opGT |SCAN.lxGE: res := ARITH.opGE |SCAN.lxIN: res := ARITH.opIN |SCAN.lxIS: res := ARITH.opIS END RETURN res END cmpcode; PROCEDURE invcmpcode (op: INTEGER): INTEGER; VAR res: INTEGER; BEGIN CASE op OF |SCAN.lxEQ: res := ARITH.opEQ |SCAN.lxNE: res := ARITH.opNE |SCAN.lxLT: res := ARITH.opGT |SCAN.lxLE: res := ARITH.opGE |SCAN.lxGT: res := ARITH.opLT |SCAN.lxGE: res := ARITH.opLE |SCAN.lxIN: res := ARITH.opIN |SCAN.lxIS: res := ARITH.opIS 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; cmp: INTEGER; BEGIN res := TRUE; cmp := cmpcode(op); IF isString(e) & isCharArray(e1) THEN IL.StrAdr(String(e)); IL.Const(strlen(e) + 1); IL.AddCmd0(IL.opEQS + invcmpcode(op)) ELSIF (isString(e) OR 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 + cmp) ELSIF isCharArrayW(e) & (isString(e1) OR isStringW(e1)) THEN IL.StrAdr(StringW(e1)); IL.Const(utf8strlen(e1) + 1); IL.AddCmd0(IL.opEQSW + cmp) ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN IL.AddCmd0(IL.opEQSW + cmp) ELSIF isCharArray(e) & isCharArray(e1) THEN IL.AddCmd0(IL.opEQS + cmp) 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); error := 0; cmp := cmpcode(op); CASE op OF |SCAN.lxEQ, SCAN.lxNE: eq := op = SCAN.lxEQ; 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, cmp, error) ELSE IF e.obj = eCONST THEN IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value)) ELSE IL.AddCmd0(IL.opEQ + cmp) END END ELSIF isStringW1(e) & isCharW(e1) THEN IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.IDENT).s)) ELSIF isStringW1(e1) & isCharW(e) THEN IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s)) ELSIF isBoolean(e) & isBoolean(e1) THEN IF constant THEN ARITH.relation(e.value, e1.value, cmp, error) ELSE IF e.obj = eCONST THEN BoolCmp(eq, ARITH.Int(e.value) # 0) ELSIF e1.obj = eCONST THEN BoolCmp(eq, ARITH.Int(e1.value) # 0) ELSE IF eq 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, cmp, error) ELSE IF e.obj = eCONST THEN Float(parser, e) ELSIF e1.obj = eCONST THEN Float(parser, e1) END; IL.AddCmd0(IL.opEQF + cmp) 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 + cmp) 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, ~eq) ELSE IL.AddCmd0(IL.opEQC + cmp) 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, ~eq) ELSE IL.AddCmd0(IL.opEQC + cmp) 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 eq 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, eq) ELSIF e1.obj = ePROC THEN IL.ProcCmp(e1.ident.proc.label, eq) ELSIF e.obj = eIMP THEN IL.ProcImpCmp(e.ident._import, eq) ELSIF e1.obj = eIMP THEN IL.ProcImpCmp(e1.ident._import, eq) ELSE IL.AddCmd0(IL.opEQ + cmp) END ELSIF isNil(e) & isNil(e1) THEN constant := TRUE; e.obj := eCONST; ARITH.setbool(e.value, eq) 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, cmp, 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 + cmp, ARITH.Int(e1.value)) ELSE IL.AddCmd0(IL.opEQ + cmp) 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 + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s)) ELSIF isReal(e) & isReal(e1) THEN IF constant THEN ARITH.relation(e.value, e1.value, cmp, error) ELSE IF e.obj = eCONST THEN Float(parser, e); IL.AddCmd0(IL.opEQF + invcmpcode(op)) ELSIF e1.obj = eCONST THEN Float(parser, e1); IL.AddCmd0(IL.opEQF + cmp) ELSE IL.AddCmd0(IL.opEQF + cmp) 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, ARITH.opIN, 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; 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(parser, 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, parser, pos, TRUE) ELSIF isExpr(e) THEN ProcCall(e, e._type, FALSE, 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.AndOrOpt(label) END; IF _if THEN PARS.checklex(parser, SCAN.lxTHEN) ELSE PARS.checklex(parser, SCAN.lxDO) END; PARS.Next(parser); parser.StatSeq(parser); IF ~_if OR (parser.sym # SCAN.lxEND) THEN IL.AddJmpCmd(IL.opJMP, L) END; 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) ELSE IL.AddCmd0(IL.opENDLOOP) END; PARS.checklex(parser, SCAN.lxEND); PARS.Next(parser) END IfStatement; PROCEDURE RepeatStatement (parser: PARS.PARSER); VAR e: PARS.EXPR; pos: PARS.POSITION; label: INTEGER; L: IL.COMMAND; BEGIN IL.AddCmd0(IL.opLOOP); label := IL.NewLabel(); IL.SetLabel(label); L := IL.getlast(); 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.AndOrOpt(label); L.param1 := 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.AddCmd2(IL.opCASET, node.data(CASE_LABEL).variant, node.data(CASE_LABEL).range.a); 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(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.opJZ, 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 Float(parser, e) 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 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 := PROG.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 IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I} 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); IF CPU = TARGETS.cpuRVM32I THEN getproc(rtl, "_error", IL._error) END 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 := PROG.program.stTypes.tINTEGER; tBYTE := PROG.program.stTypes.tBYTE; tCHAR := PROG.program.stTypes.tCHAR; tSET := PROG.program.stTypes.tSET; tBOOLEAN := PROG.program.stTypes.tBOOLEAN; tWCHAR := PROG.program.stTypes.tWCHAR; tREAL := PROG.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 TARGETS.RTL 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 PROG.program.bss > UTILS.MAX_GLOBAL_SIZE THEN ERRORS.Error(204) END; IF TARGETS.RTL THEN setrtl END; PROG.DelUnused(IL.DelImport); IL.set_bss(PROG.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) |TARGETS.cpuRVM32I: RVM32I.CodeGen(outname, target, options) END END compile; END STATEMENTS.