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