Subversion Repositories Kolibri OS

Rev

Rev 7597 | Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. (*
  2.     BSD 2-Clause License
  3.  
  4.     Copyright (c) 2018, 2019, Anton Krotov
  5.     All rights reserved.
  6. *)
  7.  
  8. MODULE STATEMENTS;
  9.  
  10. IMPORT
  11.  
  12.     PARS, PROG, SCAN, ARITH, STRINGS, LISTS, CODE, X86, AMD64,
  13.     ERRORS, MACHINE, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS;
  14.  
  15.  
  16. CONST
  17.  
  18.     eCONST   =  PARS.eCONST;   eTYPE     =  PARS.eTYPE;     eVAR      =  PARS.eVAR;
  19.     eEXPR    =  PARS.eEXPR;    eVREC     =  PARS.eVREC;     ePROC     =  PARS.ePROC;
  20.     eVPAR    =  PARS.eVPAR;    ePARAM    =  PARS.ePARAM;    eSTPROC   =  PARS.eSTPROC;
  21.     eSTFUNC  =  PARS.eSTFUNC;  eSYSFUNC  =  PARS.eSYSFUNC;  eSYSPROC  =  PARS.eSYSPROC;
  22.     eIMP     =  PARS.eIMP;
  23.  
  24.     errASSERT = 1;  errPTR  =  2;  errDIV  =  3;  errPROC = 4;
  25.     errGUARD  = 5;  errIDX  =  6;  errCASE =  7;  errCOPY = 8;
  26.     errCHR    = 9;  errWCHR = 10;  errBYTE = 11;
  27.  
  28.     chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
  29.  
  30.     chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};
  31.  
  32.  
  33. TYPE
  34.  
  35.     isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;
  36.  
  37.     RANGE = RECORD
  38.  
  39.         a, b: INTEGER
  40.  
  41.     END;
  42.  
  43.     CASE_LABEL = POINTER TO rCASE_LABEL;
  44.  
  45.     rCASE_LABEL = RECORD (AVL.DATA)
  46.  
  47.         range: RANGE;
  48.  
  49.         variant, self: INTEGER;
  50.  
  51.         type: PROG.TYPE_;
  52.  
  53.         prev: CASE_LABEL
  54.  
  55.     END;
  56.  
  57.     CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)
  58.  
  59.         label:      INTEGER;
  60.         cmd:        CODE.COMMAND;
  61.         processed:  BOOLEAN
  62.  
  63.     END;
  64.  
  65.  
  66. VAR
  67.  
  68.     begcall, endcall: CODE.COMMAND;
  69.  
  70.     checking: SET;
  71.  
  72.     CaseLabels, CaseVar: C.COLLECTION;
  73.  
  74.     CaseVariants: LISTS.LIST;
  75.  
  76.  
  77. PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
  78.     RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}
  79. END isExpr;
  80.  
  81.  
  82. PROCEDURE isVar (e: PARS.EXPR): BOOLEAN;
  83.     RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC}
  84. END isVar;
  85.  
  86.  
  87. PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
  88.     RETURN isExpr(e) & (e.type.typ = PROG.tBOOLEAN)
  89. END isBoolean;
  90.  
  91.  
  92. PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
  93.     RETURN isExpr(e) & (e.type.typ = PROG.tINTEGER)
  94. END isInteger;
  95.  
  96.  
  97. PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
  98.     RETURN isExpr(e) & (e.type.typ = PROG.tBYTE)
  99. END isByte;
  100.  
  101.  
  102. PROCEDURE isInt (e: PARS.EXPR): BOOLEAN;
  103.     RETURN isByte(e) OR isInteger(e)
  104. END isInt;
  105.  
  106.  
  107. PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
  108.     RETURN isExpr(e) & (e.type.typ = PROG.tREAL)
  109. END isReal;
  110.  
  111.  
  112. PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
  113.     RETURN isExpr(e) & (e.type.typ = PROG.tSET)
  114. END isSet;
  115.  
  116.  
  117. PROCEDURE isString (e: PARS.EXPR): BOOLEAN;
  118.     RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR})
  119. END isString;
  120.  
  121.  
  122. PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;
  123.     RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
  124. END isStringW;
  125.  
  126.  
  127. PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
  128.     RETURN isExpr(e) & (e.type.typ = PROG.tCHAR)
  129. END isChar;
  130.  
  131.  
  132. PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
  133.     RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tCHAR)
  134. END isCharArray;
  135.  
  136.  
  137. PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
  138.     RETURN isExpr(e) & (e.type.typ = PROG.tWCHAR)
  139. END isCharW;
  140.  
  141.  
  142. PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
  143.     RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tWCHAR)
  144. END isCharArrayW;
  145.  
  146.  
  147. PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
  148.     RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR})
  149. END isCharArrayX;
  150.  
  151.  
  152. PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
  153.     RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER)
  154. END isPtr;
  155.  
  156.  
  157. PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;
  158.     RETURN isExpr(e) & (e.type.typ = PROG.tRECORD)
  159. END isRec;
  160.  
  161.  
  162. PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
  163.     RETURN isExpr(e) & (e.type.typ = PROG.tARRAY)
  164. END isArr;
  165.  
  166.  
  167. PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;
  168.     RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
  169. END isProc;
  170.  
  171.  
  172. PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;
  173.     RETURN e.type.typ = PROG.tNIL
  174. END isNil;
  175.  
  176.  
  177. PROCEDURE getpos (parser: PARS.PARSER; VAR pos: SCAN.POSITION);
  178. BEGIN
  179.     pos := parser.lex.pos
  180. END getpos;
  181.  
  182.  
  183. PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: SCAN.POSITION);
  184. BEGIN
  185.     PARS.NextPos(parser, pos)
  186. END NextPos;
  187.  
  188.  
  189. PROCEDURE strlen (e: PARS.EXPR): INTEGER;
  190. VAR
  191.     res: INTEGER;
  192.  
  193. BEGIN
  194.     ASSERT(isString(e));
  195.     IF e.type.typ = PROG.tCHAR THEN
  196.         res := 1
  197.     ELSE
  198.         res := LENGTH(e.value.string(SCAN.IDENT).s)
  199.     END
  200.     RETURN res
  201. END strlen;
  202.  
  203.  
  204. PROCEDURE _length (s: ARRAY OF CHAR): INTEGER;
  205. VAR
  206.     i, res: INTEGER;
  207.  
  208. BEGIN
  209.     i := 0;
  210.     res := 0;
  211.     WHILE (i < LEN(s)) & (s[i] # 0X) DO
  212.         IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN
  213.             INC(res)
  214.         END;
  215.         INC(i)
  216.     END
  217.  
  218.     RETURN res
  219. END _length;
  220.  
  221.  
  222. PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER;
  223. VAR
  224.     res: INTEGER;
  225.  
  226. BEGIN
  227.     ASSERT(isStringW(e));
  228.     IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
  229.         res := 1
  230.     ELSE
  231.         res := _length(e.value.string(SCAN.IDENT).s)
  232.     END
  233.     RETURN res
  234. END utf8strlen;
  235.  
  236.  
  237. PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER;
  238. VAR
  239.     res: ARRAY 2 OF WCHAR;
  240.  
  241. BEGIN
  242.     ASSERT(STRINGS.Utf8To16(s, res) = 1)
  243.     RETURN ORD(res[0])
  244. END StrToWChar;
  245.  
  246.  
  247. PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN;
  248.     RETURN (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
  249. END isStringW1;
  250.  
  251.  
  252. PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN;
  253. VAR
  254.     res: BOOLEAN;
  255.  
  256.  
  257.     PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN;
  258.         RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) &
  259.                 ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) &
  260.                 PROG.isTypeEq(src.base, dst.base)
  261.     END arrcomp;
  262.  
  263.  
  264. BEGIN
  265.     IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
  266.         IF arrcomp(e.type, t) THEN
  267.             res := TRUE
  268.         ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
  269.             IF (e.obj = eCONST) & (t.typ = PROG.tBYTE) THEN
  270.                 res := ARITH.range(e.value, 0, 255)
  271.             ELSE
  272.                 res := TRUE
  273.             END
  274.         ELSIF isSet(e) & (t.typ = PROG.tSET) THEN
  275.             res := TRUE
  276.         ELSIF isBoolean(e) & (t.typ = PROG.tBOOLEAN) THEN
  277.             res := TRUE
  278.         ELSIF isReal(e) & (t.typ = PROG.tREAL) THEN
  279.             res := TRUE
  280.         ELSIF isChar(e) & (t.typ = PROG.tCHAR) THEN
  281.             res := TRUE
  282.         ELSIF (e.obj = eCONST) & isChar(e) & (t.typ = PROG.tWCHAR) THEN
  283.             res := TRUE
  284.         ELSIF isStringW1(e) & (t.typ = PROG.tWCHAR) THEN
  285.             res := TRUE
  286.         ELSIF isCharW(e) & (t.typ = PROG.tWCHAR) THEN
  287.             res := TRUE
  288.         ELSIF PROG.isBaseOf(t, e.type) THEN
  289.             res := TRUE
  290.         ELSIF ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) THEN
  291.             res := TRUE
  292.         ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
  293.             res := TRUE
  294.         ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tCHAR) & (t.length > strlen(e))) THEN
  295.             res := TRUE
  296.         ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tWCHAR) & (t.length > utf8strlen(e))) THEN
  297.             res := TRUE
  298.         ELSE
  299.             res := FALSE
  300.         END
  301.     ELSE
  302.         res := FALSE
  303.     END
  304.     RETURN res
  305. END assigncomp;
  306.  
  307.  
  308. PROCEDURE String (e: PARS.EXPR): INTEGER;
  309. VAR
  310.     offset: INTEGER;
  311.     string: SCAN.IDENT;
  312.  
  313. BEGIN
  314.     IF strlen(e) # 1 THEN
  315.         string := e.value.string(SCAN.IDENT);
  316.         IF string.offset = -1 THEN
  317.             string.offset := CODE.putstr(string.s);
  318.         END;
  319.         offset := string.offset
  320.     ELSE
  321.         offset := CODE.putstr1(ARITH.Int(e.value))
  322.     END
  323.  
  324.     RETURN offset
  325. END String;
  326.  
  327.  
  328. PROCEDURE StringW (e: PARS.EXPR): INTEGER;
  329. VAR
  330.     offset: INTEGER;
  331.     string: SCAN.IDENT;
  332.  
  333. BEGIN
  334.     IF utf8strlen(e) # 1 THEN
  335.         string := e.value.string(SCAN.IDENT);
  336.         IF string.offsetW = -1 THEN
  337.             string.offsetW := CODE.putstrW(string.s);
  338.         END;
  339.         offset := string.offsetW
  340.     ELSE
  341.         IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
  342.             offset := CODE.putstrW1(ARITH.Int(e.value))
  343.         ELSE (* e.type.typ = PROG.tSTRING *)
  344.             string := e.value.string(SCAN.IDENT);
  345.             IF string.offsetW = -1 THEN
  346.                 string.offsetW := CODE.putstrW(string.s);
  347.             END;
  348.             offset := string.offsetW
  349.         END
  350.     END
  351.  
  352.     RETURN offset
  353. END StringW;
  354.  
  355.  
  356. PROCEDURE CheckRange (range, line, errno: INTEGER);
  357. VAR
  358.     label: INTEGER;
  359.  
  360. BEGIN
  361.     label := CODE.NewLabel();
  362.     CODE.AddCmd2(CODE.opCHKIDX, label, range);
  363.     CODE.OnError(line, errno);
  364.     CODE.SetLabel(label)
  365. END CheckRange;
  366.  
  367.  
  368. PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN;
  369. VAR
  370.     res:    BOOLEAN;
  371.     label:  INTEGER;
  372.  
  373.  
  374.     PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN;
  375.         RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) &
  376.                 ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) &
  377.                 PROG.isTypeEq(src.base, dst.base)
  378.     END arrcomp;
  379.  
  380.  
  381. BEGIN
  382.     IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
  383.         res := TRUE;
  384.         IF arrcomp(e.type, VarType) THEN
  385.  
  386.             IF ~PROG.isOpenArray(VarType) THEN
  387.                 CODE.AddCmd(CODE.opCONST, VarType.length)
  388.             END;
  389.             CODE.AddCmd(CODE.opCOPYA, VarType.base.size);
  390.             label := CODE.NewLabel();
  391.             CODE.AddJmpCmd(CODE.opJE, label);
  392.             CODE.OnError(line, errCOPY);
  393.             CODE.SetLabel(label)
  394.  
  395.         ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
  396.             IF VarType.typ = PROG.tINTEGER THEN
  397.                 IF e.obj = eCONST THEN
  398.                     CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
  399.                 ELSE
  400.                     CODE.AddCmd0(CODE.opSAVE)
  401.                 END
  402.             ELSE
  403.                 IF e.obj = eCONST THEN
  404.                     res := ARITH.range(e.value, 0, 255);
  405.                     IF res THEN
  406.                         CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value))
  407.                     END
  408.                 ELSE
  409.                     IF chkBYTE IN checking THEN
  410.                         label := CODE.NewLabel();
  411.                         CODE.AddCmd2(CODE.opCHKBYTE, label, 0);
  412.                         CODE.OnError(line, errBYTE);
  413.                         CODE.SetLabel(label)
  414.                     END;
  415.                     CODE.AddCmd0(CODE.opSAVE8)
  416.                 END
  417.             END
  418.         ELSIF isSet(e) & (VarType.typ = PROG.tSET) THEN
  419.             IF e.obj = eCONST THEN
  420.                 CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
  421.             ELSE
  422.                 CODE.AddCmd0(CODE.opSAVE)
  423.             END
  424.         ELSIF isBoolean(e) & (VarType.typ = PROG.tBOOLEAN) THEN
  425.             IF e.obj = eCONST THEN
  426.                 CODE.AddCmd(CODE.opSBOOLC, ARITH.Int(e.value))
  427.             ELSE
  428.                 CODE.AddCmd0(CODE.opSBOOL)
  429.             END
  430.         ELSIF isReal(e) & (VarType.typ = PROG.tREAL) THEN
  431.             IF e.obj = eCONST THEN
  432.                 CODE.Float(ARITH.Float(e.value))
  433.             END;
  434.             CODE.savef
  435.         ELSIF isChar(e) & (VarType.typ = PROG.tCHAR) THEN
  436.             IF e.obj = eCONST THEN
  437.                 CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value))
  438.             ELSE
  439.                 CODE.AddCmd0(CODE.opSAVE8)
  440.             END
  441.         ELSIF (e.obj = eCONST) & isChar(e) & (VarType.typ = PROG.tWCHAR) THEN
  442.             CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value))
  443.         ELSIF isStringW1(e) & (VarType.typ = PROG.tWCHAR) THEN
  444.             CODE.AddCmd(CODE.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s))
  445.         ELSIF isCharW(e) & (VarType.typ = PROG.tWCHAR) THEN
  446.             IF e.obj = eCONST THEN
  447.                 CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value))
  448.             ELSE
  449.                 CODE.AddCmd0(CODE.opSAVE16)
  450.             END
  451.         ELSIF PROG.isBaseOf(VarType, e.type) THEN
  452.             IF VarType.typ = PROG.tPOINTER THEN
  453.                 CODE.AddCmd0(CODE.opSAVE)
  454.             ELSE
  455.                 CODE.AddCmd(CODE.opCOPY, VarType.size)
  456.             END
  457.         ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
  458.             CODE.AddCmd0(CODE.opSAVE32)
  459.         ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN
  460.             CODE.AddCmd0(CODE.opSAVE16)
  461.         ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN
  462.             IF e.obj = ePROC THEN
  463.                 CODE.AssignProc(e.ident.proc.label)
  464.             ELSIF e.obj = eIMP THEN
  465.                 CODE.AssignImpProc(e.ident.import)
  466.             ELSE
  467.                 IF VarType.typ = PROG.tPROCEDURE THEN
  468.                     CODE.AddCmd0(CODE.opSAVE)
  469.                 ELSE
  470.                     CODE.AddCmd(CODE.opCOPY, VarType.size)
  471.                 END
  472.             END
  473.         ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
  474.             CODE.AddCmd(CODE.opSAVEC, 0)
  475.         ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tCHAR) & (VarType.length > strlen(e))) THEN
  476.             CODE.saves(String(e), strlen(e) + 1)
  477.         ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tWCHAR) & (VarType.length > utf8strlen(e))) THEN
  478.             CODE.saves(StringW(e), (utf8strlen(e) + 1) * 2)
  479.         ELSE
  480.             res := FALSE
  481.         END
  482.     ELSE
  483.         res := FALSE
  484.     END
  485.     RETURN res
  486. END assign;
  487.  
  488.  
  489. PROCEDURE LoadConst (e: PARS.EXPR);
  490. BEGIN
  491.     CODE.AddCmd(CODE.opCONST, ARITH.Int(e.value))
  492. END LoadConst;
  493.  
  494.  
  495. PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: PROG.PARAM);
  496.  
  497.     PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
  498.     VAR
  499.         t1, t2: PROG.TYPE_;
  500.  
  501.     BEGIN
  502.         t1 := p.type;
  503.         t2 := e.type;
  504.         WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO
  505.             t1 := t1.base;
  506.             t2 := t2.base
  507.         END
  508.  
  509.         RETURN PROG.isTypeEq(t1, t2)
  510.     END arrcomp;
  511.  
  512.  
  513.     PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER;
  514.     VAR
  515.         res: INTEGER;
  516.     BEGIN
  517.         REPEAT
  518.             res := t.length;
  519.             t := t.base;
  520.             DEC(n)
  521.         UNTIL (n < 0) OR (t.typ # PROG.tARRAY);
  522.         ASSERT(n < 0)
  523.         RETURN res
  524.     END ArrLen;
  525.  
  526.  
  527.     PROCEDURE OpenArray (t, t2: PROG.TYPE_);
  528.     VAR
  529.         n: INTEGER;
  530.         d1, d2: INTEGER;
  531.     BEGIN
  532.         IF t.length # 0 THEN
  533.             CODE.AddCmd(CODE.opPARAM, 1);
  534.             n := PROG.Dim(t2) - 1;
  535.             WHILE n >= 0 DO
  536.                 CODE.AddCmd(CODE.opCONST, ArrLen(t, n));
  537.                 CODE.AddCmd(CODE.opPARAM, 1);
  538.                 DEC(n)
  539.             END
  540.         ELSE
  541.             d1 := PROG.Dim(t);
  542.             d2 := PROG.Dim(t2);
  543.             IF d1 # d2 THEN
  544.                 n := d2 - d1;
  545.                 WHILE d2 > d1 DO
  546.                     CODE.AddCmd(CODE.opCONST, ArrLen(t, d2 - 1));
  547.                     DEC(d2)
  548.                 END;
  549.                 d2 := PROG.Dim(t2);
  550.                 WHILE n > 0 DO
  551.                     CODE.AddCmd(CODE.opROT, d2);
  552.                     DEC(n)
  553.                 END
  554.             END;
  555.             CODE.AddCmd(CODE.opPARAM, PROG.Dim(t2) + 1)
  556.         END
  557.     END OpenArray;
  558.  
  559.  
  560. BEGIN
  561.     IF p.vPar THEN
  562.  
  563.         PARS.check(isVar(e), parser, pos, 93);
  564.         IF p.type.typ = PROG.tRECORD THEN
  565.             PARS.check(PROG.isBaseOf(p.type, e.type), parser, pos, 66);
  566.             IF e.obj = eVREC THEN
  567.                 IF e.ident # NIL THEN
  568.                     CODE.AddCmd(CODE.opVADR, e.ident.offset - 1)
  569.                 ELSE
  570.                     CODE.AddCmd0(CODE.opPUSHT)
  571.                 END
  572.             ELSE
  573.                 CODE.AddCmd(CODE.opCONST, e.type.num)
  574.             END;
  575.             CODE.AddCmd(CODE.opPARAM, 2)
  576.         ELSIF PROG.isOpenArray(p.type) THEN
  577.             PARS.check(arrcomp(e, p), parser, pos, 66);
  578.             OpenArray(e.type, p.type)
  579.         ELSE
  580.             PARS.check(PROG.isTypeEq(e.type, p.type), parser, pos, 66);
  581.             CODE.AddCmd(CODE.opPARAM, 1)
  582.         END;
  583.         PARS.check(~e.readOnly, parser, pos, 94)
  584.  
  585.     ELSE
  586.         PARS.check(isExpr(e) OR isProc(e), parser, pos, 66);
  587.         IF PROG.isOpenArray(p.type) THEN
  588.             IF e.type.typ = PROG.tARRAY THEN
  589.                 PARS.check(arrcomp(e, p), parser, pos, 66);
  590.                 OpenArray(e.type, p.type)
  591.             ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tCHAR) THEN
  592.                 CODE.AddCmd(CODE.opSADR, String(e));
  593.                 CODE.AddCmd(CODE.opPARAM, 1);
  594.                 CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
  595.                 CODE.AddCmd(CODE.opPARAM, 1)
  596.             ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tWCHAR) THEN
  597.                 CODE.AddCmd(CODE.opSADR, StringW(e));
  598.                 CODE.AddCmd(CODE.opPARAM, 1);
  599.                 CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
  600.                 CODE.AddCmd(CODE.opPARAM, 1)
  601.             ELSE
  602.                 PARS.error(parser, pos, 66)
  603.             END
  604.         ELSE
  605.             PARS.check(~PROG.isOpenArray(e.type), parser, pos, 66);
  606.             PARS.check(assigncomp(e, p.type), parser, pos, 66);
  607.             IF e.obj = eCONST THEN
  608.                 IF e.type.typ = PROG.tREAL THEN
  609.                     CODE.Float(ARITH.Float(e.value));
  610.                     CODE.pushf
  611.                 ELSIF e.type.typ = PROG.tNIL THEN
  612.                     CODE.AddCmd(CODE.opCONST, 0);
  613.                     CODE.AddCmd(CODE.opPARAM, 1)
  614.                 ELSIF isStringW1(e) & (p.type.typ = PROG.tWCHAR) THEN
  615.                     CODE.AddCmd(CODE.opCONST, StrToWChar(e.value.string(SCAN.IDENT).s));
  616.                     CODE.AddCmd(CODE.opPARAM, 1)
  617.                 ELSIF (e.type.typ = PROG.tSTRING) OR
  618.                       (e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
  619.                     CODE.SetMinDataSize(p.type.size);
  620.                     IF p.type.base.typ = PROG.tCHAR THEN
  621.                         CODE.AddCmd(CODE.opSADR, String(e))
  622.                     ELSE (* WCHAR *)
  623.                         CODE.AddCmd(CODE.opSADR, StringW(e))
  624.                     END;
  625.                     CODE.AddCmd(CODE.opPARAM, 1)
  626.                 ELSE
  627.                     LoadConst(e);
  628.                     CODE.AddCmd(CODE.opPARAM, 1)
  629.                 END
  630.             ELSIF e.obj = ePROC THEN
  631.                 PARS.check(e.ident.global, parser, pos, 85);
  632.                 CODE.PushProc(e.ident.proc.label);
  633.                 CODE.AddCmd(CODE.opPARAM, 1)
  634.             ELSIF e.obj = eIMP THEN
  635.                 CODE.PushImpProc(e.ident.import);
  636.                 CODE.AddCmd(CODE.opPARAM, 1)
  637.             ELSIF isExpr(e) & (e.type.typ = PROG.tREAL) THEN
  638.                 CODE.pushf
  639.             ELSE
  640.                 IF (p.type.typ = PROG.tBYTE) & (e.type.typ = PROG.tINTEGER) & (chkBYTE IN checking) THEN
  641.                     CheckRange(256, pos.line, errBYTE)
  642.                 END;
  643.                 CODE.AddCmd(CODE.opPARAM, 1)
  644.             END
  645.         END
  646.  
  647.     END
  648. END paramcomp;
  649.  
  650.  
  651. PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
  652. VAR
  653.     e2:    PARS.EXPR;
  654.     pos:   SCAN.POSITION;
  655.     proc:  INTEGER;
  656.     label: INTEGER;
  657.     n, i:  INTEGER;
  658.     code:  ARITH.VALUE;
  659.     e1:    PARS.EXPR;
  660.     wchar: BOOLEAN;
  661.     cmd1,
  662.     cmd2:  CODE.COMMAND;
  663.  
  664.  
  665.     PROCEDURE varparam (parser: PARS.PARSER; pos: SCAN.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
  666.     BEGIN
  667.         parser.designator(parser, e);
  668.         PARS.check(isVar(e), parser, pos, 93);
  669.         PARS.check(isfunc(e), parser, pos, 66);
  670.         IF readOnly THEN
  671.             PARS.check(~e.readOnly, parser, pos, 94)
  672.         END
  673.     END varparam;
  674.  
  675.  
  676.     PROCEDURE shift_minmax (proc: INTEGER): CHAR;
  677.     VAR
  678.         res: CHAR;
  679.     BEGIN
  680.         CASE proc OF
  681.         |PROG.stASR: res := "A"
  682.         |PROG.stLSL: res := "L"
  683.         |PROG.stROR: res := "O"
  684.         |PROG.stLSR: res := "R"
  685.         |PROG.stMIN: res := "m"
  686.         |PROG.stMAX: res := "x"
  687.         END
  688.         RETURN res
  689.     END shift_minmax;
  690.  
  691.  
  692. BEGIN
  693.     ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC});
  694.  
  695.     getpos(parser, pos);
  696.     proc := e.stproc;
  697.  
  698.     IF e.obj IN {eSYSPROC, eSYSFUNC} THEN
  699.         IF parser.unit.scopeLvl > 0 THEN
  700.             parser.unit.scopes[parser.unit.scopeLvl].enter(CODE.COMMAND).allocReg := FALSE
  701.         END
  702.     END;
  703.  
  704.     IF e.obj IN {eSTPROC, eSYSPROC} THEN
  705.  
  706.         CASE proc OF
  707.         |PROG.stASSERT:
  708.             parser.expression(parser, e);
  709.             PARS.check(isBoolean(e), parser, pos, 66);
  710.             IF e.obj = eCONST THEN
  711.                 IF ~ARITH.getBool(e.value) THEN
  712.                     CODE.OnError(pos.line, errASSERT)
  713.                 END
  714.             ELSE
  715.                 label := CODE.NewLabel();
  716.                 CODE.AddJmpCmd(CODE.opJE, label);
  717.                 CODE.OnError(pos.line, errASSERT);
  718.                 CODE.SetLabel(label)
  719.             END
  720.  
  721.         |PROG.stINC, PROG.stDEC:
  722.             CODE.pushBegEnd(begcall, endcall);
  723.             varparam(parser, pos, isInt, TRUE, e);
  724.             IF e.type.typ = PROG.tINTEGER THEN
  725.                 IF parser.sym = SCAN.lxCOMMA THEN
  726.                     NextPos(parser, pos);
  727.                     CODE.setlast(begcall);
  728.                     parser.expression(parser, e2);
  729.                     CODE.setlast(endcall.prev(CODE.COMMAND));
  730.                     PARS.check(isInt(e2), parser, pos, 66);
  731.                     IF e2.obj = eCONST THEN
  732.                         CODE.AddCmd(CODE.opINCC + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
  733.                     ELSE
  734.                         CODE.AddCmd0(CODE.opINC + ORD(proc = PROG.stDEC))
  735.                     END
  736.                 ELSE
  737.                     CODE.AddCmd0(CODE.opINC1 + ORD(proc = PROG.stDEC))
  738.                 END
  739.             ELSE  (* e.type.typ = PROG.tBYTE *)
  740.                 IF parser.sym = SCAN.lxCOMMA THEN
  741.                     NextPos(parser, pos);
  742.                     CODE.setlast(begcall);
  743.                     parser.expression(parser, e2);
  744.                     CODE.setlast(endcall.prev(CODE.COMMAND));
  745.                     PARS.check(isInt(e2), parser, pos, 66);
  746.                     IF e2.obj = eCONST THEN
  747.                         CODE.AddCmd(CODE.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
  748.                     ELSE
  749.                         CODE.AddCmd0(CODE.opINCB + ORD(proc = PROG.stDEC))
  750.                     END
  751.                 ELSE
  752.                     CODE.AddCmd0(CODE.opINC1B + ORD(proc = PROG.stDEC))
  753.                 END
  754.             END;
  755.             CODE.popBegEnd(begcall, endcall)
  756.  
  757.         |PROG.stINCL, PROG.stEXCL:
  758.             CODE.pushBegEnd(begcall, endcall);
  759.             varparam(parser, pos, isSet, TRUE, e);
  760.             PARS.checklex(parser, SCAN.lxCOMMA);
  761.             NextPos(parser, pos);
  762.             CODE.setlast(begcall);
  763.             parser.expression(parser, e2);
  764.             CODE.setlast(endcall.prev(CODE.COMMAND));
  765.             PARS.check(isInt(e2), parser, pos, 66);
  766.             IF e2.obj = eCONST THEN
  767.                 PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 56);
  768.                 CODE.AddCmd(CODE.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
  769.             ELSE
  770.                 CODE.AddCmd0(CODE.opINCL + ORD(proc = PROG.stEXCL))
  771.             END;
  772.             CODE.popBegEnd(begcall, endcall)
  773.  
  774.         |PROG.stNEW:
  775.             varparam(parser, pos, isPtr, TRUE, e);
  776.             CODE.New(e.type.base.size, e.type.base.num)
  777.  
  778.         |PROG.stDISPOSE:
  779.             varparam(parser, pos, isPtr, TRUE, e);
  780.             CODE.AddCmd0(CODE.opDISP)
  781.  
  782.         |PROG.stPACK:
  783.             varparam(parser, pos, isReal, TRUE, e);
  784.             PARS.checklex(parser, SCAN.lxCOMMA);
  785.             NextPos(parser, pos);
  786.             parser.expression(parser, e2);
  787.             PARS.check(isInt(e2), parser, pos, 66);
  788.             IF e2.obj = eCONST THEN
  789.                 CODE.AddCmd(CODE.opPACKC, ARITH.Int(e2.value))
  790.             ELSE
  791.                 CODE.AddCmd0(CODE.opPACK)
  792.             END
  793.  
  794.         |PROG.stUNPK:
  795.             varparam(parser, pos, isReal, TRUE, e);
  796.             PARS.checklex(parser, SCAN.lxCOMMA);
  797.             NextPos(parser, pos);
  798.             varparam(parser, pos, isInteger, TRUE, e2);
  799.             CODE.AddCmd0(CODE.opUNPK)
  800.  
  801.         |PROG.stCOPY:
  802.             parser.expression(parser, e);
  803.             IF isString(e) OR isCharArray(e) THEN
  804.                 wchar := FALSE
  805.             ELSIF isStringW(e) OR isCharArrayW(e) THEN
  806.                 wchar := TRUE
  807.             ELSE
  808.                 PARS.check(FALSE, parser, pos, 66)
  809.             END;
  810.  
  811.             IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN
  812.                 CODE.AddCmd(CODE.opCONST, e.type.length)
  813.             END;
  814.  
  815.             PARS.checklex(parser, SCAN.lxCOMMA);
  816.             NextPos(parser, pos);
  817.  
  818.             IF wchar THEN
  819.                 varparam(parser, pos, isCharArrayW, TRUE, e1)
  820.             ELSE
  821.                 IF e.obj = eCONST THEN
  822.                     varparam(parser, pos, isCharArrayX, TRUE, e1)
  823.                 ELSE
  824.                     varparam(parser, pos, isCharArray, TRUE, e1)
  825.                 END;
  826.  
  827.                 wchar := e1.type.base.typ = PROG.tWCHAR
  828.             END;
  829.  
  830.             IF ~PROG.isOpenArray(e1.type) THEN
  831.                 CODE.AddCmd(CODE.opCONST, e1.type.length)
  832.             END;
  833.  
  834.             IF e.obj = eCONST THEN
  835.                 IF wchar THEN
  836.                     CODE.AddCmd(CODE.opSADR, StringW(e));
  837.                     CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1)
  838.                 ELSE
  839.                     CODE.AddCmd(CODE.opSADR, String(e));
  840.                     CODE.AddCmd(CODE.opCONST, strlen(e) + 1)
  841.                 END;
  842.                 CODE.AddCmd(CODE.opCOPYS2, e1.type.base.size)
  843.             ELSE
  844.                 CODE.AddCmd(CODE.opCOPYS, e1.type.base.size)
  845.             END
  846.  
  847.         |PROG.sysGET:
  848.             parser.expression(parser, e);
  849.             PARS.check(isInt(e), parser, pos, 66);
  850.             IF e.obj = eCONST THEN
  851.                 LoadConst(e)
  852.             END;
  853.             PARS.checklex(parser, SCAN.lxCOMMA);
  854.             NextPos(parser, pos);
  855.             parser.designator(parser, e2);
  856.             PARS.check(isVar(e2), parser, pos, 93);
  857.             PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66);
  858.             CODE.SysGet(e2.type.size)
  859.  
  860.         |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
  861.             CODE.pushBegEnd(begcall, endcall);
  862.             parser.expression(parser, e);
  863.             PARS.check(isInt(e), parser, pos, 66);
  864.             IF e.obj = eCONST THEN
  865.                 LoadConst(e)
  866.             END;
  867.             PARS.checklex(parser, SCAN.lxCOMMA);
  868.             NextPos(parser, pos);
  869.             CODE.setlast(begcall);
  870.             parser.expression(parser, e2);
  871.             PARS.check(isExpr(e2), parser, pos, 66);
  872.  
  873.             IF proc = PROG.sysPUT THEN
  874.                 PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66);
  875.                 IF e2.obj = eCONST THEN
  876.                     IF e2.type.typ = PROG.tREAL THEN
  877.                         CODE.setlast(endcall.prev(CODE.COMMAND));
  878.                         CODE.Float(ARITH.Float(e2.value));
  879.                         CODE.savef
  880.                     ELSE
  881.                         LoadConst(e2);
  882.                         CODE.setlast(endcall.prev(CODE.COMMAND));
  883.                         CODE.SysPut(e2.type.size)
  884.                     END
  885.                 ELSE
  886.                     CODE.setlast(endcall.prev(CODE.COMMAND));
  887.                     IF e2.type.typ = PROG.tREAL THEN
  888.                         CODE.savef
  889.                     ELSIF e2.type.typ = PROG.tBYTE THEN
  890.                         CODE.SysPut(PARS.program.stTypes.tINTEGER.size)
  891.                     ELSE
  892.                         CODE.SysPut(e2.type.size)
  893.                     END
  894.                 END
  895.  
  896.             ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
  897.                 PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, parser, pos, 66);
  898.                 IF e2.obj = eCONST THEN
  899.                     LoadConst(e2)
  900.                 END;
  901.                 CODE.setlast(endcall.prev(CODE.COMMAND));
  902.                 IF proc = PROG.sysPUT8 THEN
  903.                     CODE.SysPut(1)
  904.                 ELSIF proc = PROG.sysPUT16 THEN
  905.                     CODE.SysPut(2)
  906.                 ELSIF proc = PROG.sysPUT32 THEN
  907.                     CODE.SysPut(4)
  908.                 END
  909.  
  910.             END;
  911.             CODE.popBegEnd(begcall, endcall)
  912.  
  913.         |PROG.sysMOVE:
  914.             FOR i := 1 TO 2 DO
  915.                 parser.expression(parser, e);
  916.                 PARS.check(isInt(e), parser, pos, 66);
  917.                 IF e.obj = eCONST THEN
  918.                     LoadConst(e)
  919.                 END;
  920.                 PARS.checklex(parser, SCAN.lxCOMMA);
  921.                 NextPos(parser, pos)
  922.             END;
  923.  
  924.             parser.expression(parser, e);
  925.             PARS.check(isInt(e), parser, pos, 66);
  926.             IF e.obj = eCONST THEN
  927.                 LoadConst(e)
  928.             END;
  929.             CODE.AddCmd0(CODE.opMOVE)
  930.  
  931.         |PROG.sysCOPY:
  932.             FOR i := 1 TO 2 DO
  933.                 parser.designator(parser, e);
  934.                 PARS.check(isVar(e), parser, pos, 93);
  935.                 n := PROG.Dim(e.type);
  936.                 WHILE n > 0 DO
  937.                     CODE.drop;
  938.                     DEC(n)
  939.                 END;
  940.                 PARS.checklex(parser, SCAN.lxCOMMA);
  941.                 NextPos(parser, pos)
  942.             END;
  943.  
  944.             parser.expression(parser, e);
  945.             PARS.check(isInt(e), parser, pos, 66);
  946.             IF e.obj = eCONST THEN
  947.                 LoadConst(e)
  948.             END;
  949.             CODE.AddCmd0(CODE.opMOVE)
  950.  
  951.         |PROG.sysCODE:
  952.             REPEAT
  953.                 getpos(parser, pos);
  954.                 PARS.ConstExpression(parser, code);
  955.                 PARS.check(code.typ = ARITH.tINTEGER, parser, pos, 43);
  956.                 PARS.check(ARITH.range(code, 0, 255), parser, pos, 42);
  957.                 IF parser.sym = SCAN.lxCOMMA THEN
  958.                     PARS.Next(parser)
  959.                 ELSE
  960.                     PARS.checklex(parser, SCAN.lxRROUND)
  961.                 END;
  962.                 CODE.AddCmd(CODE.opCODE, ARITH.getInt(code))
  963.             UNTIL parser.sym = SCAN.lxRROUND
  964.  
  965.         END;
  966.  
  967.         e.obj := eEXPR;
  968.         e.type := NIL
  969.  
  970.     ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN
  971.  
  972.         CASE e.stproc OF
  973.         |PROG.stABS:
  974.             parser.expression(parser, e);
  975.             PARS.check(isInt(e) OR isReal(e), parser, pos, 66);
  976.             IF e.obj = eCONST THEN
  977.                 PARS.check(ARITH.abs(e.value), parser, pos, 39)
  978.             ELSE
  979.                 CODE.abs(isReal(e))
  980.             END
  981.  
  982.         |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
  983.             parser.expression(parser, e);
  984.             PARS.check(isInt(e), parser, pos, 66);
  985.             PARS.checklex(parser, SCAN.lxCOMMA);
  986.             NextPos(parser, pos);
  987.             parser.expression(parser, e2);
  988.             PARS.check(isInt(e2), parser, pos, 66);
  989.             e.type := PARS.program.stTypes.tINTEGER;
  990.             IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
  991.                 ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
  992.             ELSE
  993.                 IF e.obj = eCONST THEN
  994.                     CODE.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
  995.                 ELSIF e2.obj = eCONST THEN
  996.                     CODE.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
  997.                 ELSE
  998.                     CODE.shift_minmax(shift_minmax(proc))
  999.                 END;
  1000.                 e.obj := eEXPR
  1001.             END
  1002.  
  1003.         |PROG.stCHR:
  1004.             parser.expression(parser, e);
  1005.             PARS.check(isInt(e), parser, pos, 66);
  1006.             e.type := PARS.program.stTypes.tCHAR;
  1007.             IF e.obj = eCONST THEN
  1008.                 ARITH.setChar(e.value, ARITH.getInt(e.value));
  1009.                 PARS.check(ARITH.check(e.value), parser, pos, 107)
  1010.             ELSE
  1011.                 IF chkCHR IN checking THEN
  1012.                     CheckRange(256, pos.line, errCHR)
  1013.                 ELSE
  1014.                     CODE.AddCmd0(CODE.opCHR)
  1015.                 END
  1016.             END
  1017.  
  1018.         |PROG.stWCHR:
  1019.             parser.expression(parser, e);
  1020.             PARS.check(isInt(e), parser, pos, 66);
  1021.             e.type := PARS.program.stTypes.tWCHAR;
  1022.             IF e.obj = eCONST THEN
  1023.                 ARITH.setWChar(e.value, ARITH.getInt(e.value));
  1024.                 PARS.check(ARITH.check(e.value), parser, pos, 101)
  1025.             ELSE
  1026.                 IF chkWCHR IN checking THEN
  1027.                     CheckRange(65536, pos.line, errWCHR)
  1028.                 ELSE
  1029.                     CODE.AddCmd0(CODE.opWCHR)
  1030.                 END
  1031.             END
  1032.  
  1033.         |PROG.stFLOOR:
  1034.             parser.expression(parser, e);
  1035.             PARS.check(isReal(e), parser, pos, 66);
  1036.             e.type := PARS.program.stTypes.tINTEGER;
  1037.             IF e.obj = eCONST THEN
  1038.                 PARS.check(ARITH.floor(e.value), parser, pos, 39)
  1039.             ELSE
  1040.                 CODE.floor
  1041.             END
  1042.  
  1043.         |PROG.stFLT:
  1044.             parser.expression(parser, e);
  1045.             PARS.check(isInt(e), parser, pos, 66);
  1046.             e.type := PARS.program.stTypes.tREAL;
  1047.             IF e.obj = eCONST THEN
  1048.                 ARITH.flt(e.value)
  1049.             ELSE
  1050.                 PARS.check(CODE.flt(), parser, pos, 41)
  1051.             END
  1052.  
  1053.         |PROG.stLEN:
  1054.             cmd1 := CODE.getlast();
  1055.             varparam(parser, pos, isArr, FALSE, e);
  1056.             IF e.type.length > 0 THEN
  1057.                 cmd2 := CODE.getlast();
  1058.                 CODE.delete2(cmd1.next, cmd2);
  1059.                 CODE.setlast(cmd1);
  1060.                 ASSERT(ARITH.setInt(e.value, e.type.length));
  1061.                 e.obj := eCONST
  1062.             ELSE
  1063.                 CODE.len(PROG.Dim(e.type))
  1064.             END;
  1065.             e.type := PARS.program.stTypes.tINTEGER
  1066.  
  1067.         |PROG.stLENGTH:
  1068.             parser.expression(parser, e);
  1069.             IF isCharArray(e) THEN
  1070.                 IF e.type.length > 0 THEN
  1071.                     CODE.AddCmd(CODE.opCONST, e.type.length)
  1072.                 END;
  1073.                 CODE.AddCmd0(CODE.opLENGTH)
  1074.             ELSIF isCharArrayW(e) THEN
  1075.                 IF e.type.length > 0 THEN
  1076.                     CODE.AddCmd(CODE.opCONST, e.type.length)
  1077.                 END;
  1078.                 CODE.AddCmd0(CODE.opLENGTHW)
  1079.             ELSE
  1080.                 PARS.check(FALSE, parser, pos, 66);
  1081.             END;
  1082.             e.type := PARS.program.stTypes.tINTEGER
  1083.  
  1084.         |PROG.stODD:
  1085.             parser.expression(parser, e);
  1086.             PARS.check(isInt(e), parser, pos, 66);
  1087.             e.type := PARS.program.stTypes.tBOOLEAN;
  1088.             IF e.obj = eCONST THEN
  1089.                 ARITH.odd(e.value)
  1090.             ELSE
  1091.                 CODE.odd
  1092.             END
  1093.  
  1094.         |PROG.stORD:
  1095.             parser.expression(parser, e);
  1096.             PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), parser, pos, 66);
  1097.             IF e.obj = eCONST THEN
  1098.                 IF isStringW1(e) THEN
  1099.                     ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s)))
  1100.                 ELSE
  1101.                     ARITH.ord(e.value)
  1102.                 END
  1103.             ELSE
  1104.                 IF isBoolean(e) THEN
  1105.                     CODE.ord
  1106.                 END
  1107.             END;
  1108.             e.type := PARS.program.stTypes.tINTEGER
  1109.  
  1110.         |PROG.stBITS:
  1111.             parser.expression(parser, e);
  1112.             PARS.check(isInt(e), parser, pos, 66);
  1113.             IF e.obj = eCONST THEN
  1114.                 ARITH.bits(e.value)
  1115.             END;
  1116.             e.type := PARS.program.stTypes.tSET
  1117.  
  1118.         |PROG.sysADR:
  1119.             parser.designator(parser, e);
  1120.             IF isVar(e) THEN
  1121.                n := PROG.Dim(e.type);
  1122.                WHILE n > 0 DO
  1123.                     CODE.drop;
  1124.                     DEC(n)
  1125.                END
  1126.             ELSIF e.obj = ePROC THEN
  1127.                 CODE.PushProc(e.ident.proc.label)
  1128.             ELSIF e.obj = eIMP THEN
  1129.                 CODE.PushImpProc(e.ident.import)
  1130.             ELSE
  1131.                 PARS.check(FALSE, parser, pos, 108)
  1132.             END;
  1133.             e.type := PARS.program.stTypes.tINTEGER
  1134.  
  1135.         |PROG.sysSADR:
  1136.             parser.expression(parser, e);
  1137.             PARS.check(isString(e), parser, pos, 66);
  1138.             CODE.AddCmd(CODE.opSADR, String(e));
  1139.             e.type := PARS.program.stTypes.tINTEGER;
  1140.             e.obj := eEXPR
  1141.  
  1142.         |PROG.sysWSADR:
  1143.             parser.expression(parser, e);
  1144.             PARS.check(isStringW(e), parser, pos, 66);
  1145.             CODE.AddCmd(CODE.opSADR, StringW(e));
  1146.             e.type := PARS.program.stTypes.tINTEGER;
  1147.             e.obj := eEXPR
  1148.  
  1149.         |PROG.sysTYPEID:
  1150.             parser.expression(parser, e);
  1151.             PARS.check(e.obj = eTYPE, parser, pos, 68);
  1152.             IF e.type.typ = PROG.tRECORD THEN
  1153.                 ASSERT(ARITH.setInt(e.value, e.type.num))
  1154.             ELSIF e.type.typ = PROG.tPOINTER THEN
  1155.                 ASSERT(ARITH.setInt(e.value, e.type.base.num))
  1156.             ELSE
  1157.                 PARS.check(FALSE, parser, pos, 52)
  1158.             END;
  1159.             e.obj := eCONST;
  1160.             e.type := PARS.program.stTypes.tINTEGER
  1161.  
  1162.         |PROG.sysINF:
  1163.             PARS.check(CODE.inf(), parser, pos, 41);
  1164.             e.obj := eEXPR;
  1165.             e.type := PARS.program.stTypes.tREAL
  1166.  
  1167.         |PROG.sysSIZE:
  1168.             parser.expression(parser, e);
  1169.             PARS.check(e.obj = eTYPE, parser, pos, 68);
  1170.             ASSERT(ARITH.setInt(e.value, e.type.size));
  1171.             e.obj := eCONST;
  1172.             e.type := PARS.program.stTypes.tINTEGER
  1173.  
  1174.         END
  1175.  
  1176.     END;
  1177.  
  1178.     PARS.checklex(parser, SCAN.lxRROUND);
  1179.     PARS.Next(parser);
  1180.  
  1181.     IF e.obj # eCONST THEN
  1182.         e.obj := eEXPR
  1183.     END
  1184.  
  1185. END stProc;
  1186.  
  1187.  
  1188. PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1189. VAR
  1190.     proc:  PROG.TYPE_;
  1191.     param: LISTS.ITEM;
  1192.     e1:    PARS.EXPR;
  1193.     pos:   SCAN.POSITION;
  1194.  
  1195. BEGIN
  1196.     ASSERT(parser.sym = SCAN.lxLROUND);
  1197.  
  1198.     IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN
  1199.         proc := e.type;
  1200.         PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86);
  1201.         PARS.Next(parser);
  1202.  
  1203.         param := proc.params.first;
  1204.         WHILE param # NIL DO
  1205.             getpos(parser, pos);
  1206.  
  1207.             CODE.setlast(begcall);
  1208.  
  1209.             IF param(PROG.PARAM).vPar THEN
  1210.                 parser.designator(parser, e1)
  1211.             ELSE
  1212.                 parser.expression(parser, e1)
  1213.             END;
  1214.             paramcomp(parser, pos, e1, param(PROG.PARAM));
  1215.             param := param.next;
  1216.             IF param # NIL THEN
  1217.                 PARS.checklex(parser, SCAN.lxCOMMA);
  1218.                 PARS.Next(parser)
  1219.             END
  1220.         END;
  1221.  
  1222.         PARS.checklex(parser, SCAN.lxRROUND);
  1223.         PARS.Next(parser);
  1224.  
  1225.         e.obj := eEXPR;
  1226.         e.type := proc.base
  1227.  
  1228.     ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
  1229.         PARS.Next(parser);
  1230.         stProc(parser, e)
  1231.     ELSE
  1232.         PARS.check1(FALSE, parser, 86)
  1233.     END
  1234.  
  1235. END ActualParameters;
  1236.  
  1237.  
  1238. PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1239. VAR
  1240.     ident:  PROG.IDENT;
  1241.     import: BOOLEAN;
  1242.     pos:    SCAN.POSITION;
  1243.  
  1244. BEGIN
  1245.     PARS.checklex(parser, SCAN.lxIDENT);
  1246.     getpos(parser, pos);
  1247.     import := FALSE;
  1248.     ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE);
  1249.     PARS.check1(ident # NIL, parser, 48);
  1250.     IF ident.typ = PROG.idMODULE THEN
  1251.         PARS.ExpectSym(parser, SCAN.lxPOINT);
  1252.         PARS.ExpectSym(parser, SCAN.lxIDENT);
  1253.         ident := ident.unit.idents.get(ident.unit, parser.lex.ident, FALSE);
  1254.         PARS.check1((ident # NIL) & ident.export, parser, 48);
  1255.         import := TRUE
  1256.     END;
  1257.     PARS.Next(parser);
  1258.  
  1259.     e.readOnly := FALSE;
  1260.     e.ident := ident;
  1261.  
  1262.     CASE ident.typ OF
  1263.     |PROG.idCONST:
  1264.         e.obj   := eCONST;
  1265.         e.type  := ident.type;
  1266.         e.value := ident.value
  1267.     |PROG.idTYPE:
  1268.         e.obj  := eTYPE;
  1269.         e.type := ident.type
  1270.     |PROG.idVAR:
  1271.         e.obj  := eVAR;
  1272.         e.type := ident.type;
  1273.         e.readOnly := import
  1274.     |PROG.idPROC:
  1275.         e.obj   := ePROC;
  1276.         e.type  := ident.type
  1277.     |PROG.idIMP:
  1278.         e.obj   := eIMP;
  1279.         e.type  := ident.type
  1280.     |PROG.idVPAR:
  1281.         e.type := ident.type;
  1282.         IF e.type.typ = PROG.tRECORD THEN
  1283.             e.obj := eVREC
  1284.         ELSE
  1285.             e.obj := eVPAR
  1286.         END
  1287.     |PROG.idPARAM:
  1288.         e.obj  := ePARAM;
  1289.         e.type := ident.type;
  1290.         e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY})
  1291.     |PROG.idSTPROC:
  1292.         e.obj    := eSTPROC;
  1293.         e.stproc := ident.stproc
  1294.     |PROG.idSTFUNC:
  1295.         e.obj    := eSTFUNC;
  1296.         e.stproc := ident.stproc
  1297.     |PROG.idSYSPROC:
  1298.         e.obj    := eSYSPROC;
  1299.         e.stproc := ident.stproc
  1300.     |PROG.idSYSFUNC:
  1301.         PARS.check(~parser.constexp, parser, pos, 109);
  1302.         e.obj    := eSYSFUNC;
  1303.         e.stproc := ident.stproc
  1304.     |PROG.idNONE:
  1305.         PARS.check(FALSE, parser, pos, 115)
  1306.     END;
  1307.  
  1308.     IF isVar(e) THEN
  1309.         PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), parser, pos, 105)
  1310.     END
  1311.  
  1312. END qualident;
  1313.  
  1314.  
  1315. PROCEDURE deref (pos: SCAN.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
  1316. VAR
  1317.     label:  INTEGER;
  1318.  
  1319. BEGIN
  1320.     IF load THEN
  1321.         CODE.load(e.type.size)
  1322.     END;
  1323.  
  1324.     IF chkPTR IN checking THEN
  1325.         label := CODE.NewLabel();
  1326.         CODE.AddJmpCmd(CODE.opJNZ, label);
  1327.         CODE.OnError(pos.line, error);
  1328.         CODE.SetLabel(label)
  1329.     END
  1330. END deref;
  1331.  
  1332.  
  1333. PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1334. VAR
  1335.     field:  PROG.FIELD;
  1336.     pos:    SCAN.POSITION;
  1337.     t, idx: PARS.EXPR;
  1338.  
  1339.  
  1340.     PROCEDURE LoadAdr (e: PARS.EXPR);
  1341.     VAR
  1342.         offset: INTEGER;
  1343.  
  1344.         PROCEDURE OpenArray (e: PARS.EXPR);
  1345.         VAR
  1346.             offset, n: INTEGER;
  1347.         BEGIN
  1348.             offset := e.ident.offset;
  1349.             n := PROG.Dim(e.type);
  1350.             WHILE n >= 0 DO
  1351.                 CODE.AddCmd(CODE.opVADR, offset);
  1352.                 DEC(offset);
  1353.                 DEC(n)
  1354.             END
  1355.         END OpenArray;
  1356.  
  1357.  
  1358.     BEGIN
  1359.         IF e.obj = eVAR THEN
  1360.             offset := PROG.getOffset(PARS.program, e.ident);
  1361.             IF e.ident.global THEN
  1362.                 CODE.AddCmd(CODE.opGADR, offset)
  1363.             ELSE
  1364.                 CODE.AddCmd(CODE.opLADR, -offset)
  1365.             END
  1366.         ELSIF e.obj = ePARAM THEN
  1367.             IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN
  1368.                 CODE.AddCmd(CODE.opVADR, e.ident.offset)
  1369.             ELSIF PROG.isOpenArray(e.type) THEN
  1370.                 OpenArray(e)
  1371.             ELSE
  1372.                 CODE.AddCmd(CODE.opLADR, e.ident.offset)
  1373.             END
  1374.         ELSIF e.obj IN {eVPAR, eVREC} THEN
  1375.             IF PROG.isOpenArray(e.type) THEN
  1376.                 OpenArray(e)
  1377.             ELSE
  1378.                 CODE.AddCmd(CODE.opVADR, e.ident.offset)
  1379.             END
  1380.         END
  1381.     END LoadAdr;
  1382.  
  1383.  
  1384.     PROCEDURE OpenIdx (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR);
  1385.     VAR
  1386.         label:  INTEGER;
  1387.         type:   PROG.TYPE_;
  1388.         n, offset, k: INTEGER;
  1389.  
  1390.     BEGIN
  1391.  
  1392.         IF chkIDX IN checking THEN
  1393.             label := CODE.NewLabel();
  1394.             CODE.AddCmd2(CODE.opCHKIDX2, label, 0);
  1395.             CODE.OnError(pos.line, errIDX);
  1396.             CODE.SetLabel(label)
  1397.         ELSE
  1398.             CODE.AddCmd(CODE.opCHKIDX2, -1)
  1399.         END;
  1400.  
  1401.         type := PROG.OpenBase(e.type);
  1402.         IF type.size # 1 THEN
  1403.             CODE.AddCmd(CODE.opMULC, type.size)
  1404.         END;
  1405.         n := PROG.Dim(e.type) - 1;
  1406.         k := n;
  1407.         WHILE n > 0 DO
  1408.             CODE.AddCmd0(CODE.opMUL);
  1409.             DEC(n)
  1410.         END;
  1411.         CODE.AddCmd0(CODE.opADD);
  1412.         offset := e.ident.offset - 1;
  1413.         n := k;
  1414.         WHILE n > 0 DO
  1415.             CODE.AddCmd(CODE.opVADR, offset);
  1416.             DEC(offset);
  1417.             DEC(n)
  1418.         END
  1419.     END OpenIdx;
  1420.  
  1421.  
  1422. BEGIN
  1423.     qualident(parser, e);
  1424.  
  1425.     IF e.obj IN {ePROC, eIMP} THEN
  1426.         PROG.UseProc(parser.unit, e.ident.proc)
  1427.     END;
  1428.  
  1429.     IF isVar(e) THEN
  1430.         LoadAdr(e)
  1431.     END;
  1432.  
  1433.     WHILE parser.sym = SCAN.lxPOINT DO
  1434.         getpos(parser, pos);
  1435.         PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
  1436.         IF e.type.typ = PROG.tPOINTER THEN
  1437.             deref(pos, e, TRUE, errPTR)
  1438.         END;
  1439.         PARS.ExpectSym(parser, SCAN.lxIDENT);
  1440.         IF e.type.typ = PROG.tPOINTER THEN
  1441.             e.type := e.type.base;
  1442.             e.readOnly := FALSE
  1443.         END;
  1444.         field := e.type.fields.get(e.type, parser.lex.ident, parser.unit);
  1445.         PARS.check1(field # NIL, parser, 74);
  1446.         e.type := field.type;
  1447.         IF e.obj = eVREC THEN
  1448.             e.obj := eVPAR
  1449.         END;
  1450.         IF field.offset # 0 THEN
  1451.             CODE.AddCmd(CODE.opADDR, field.offset)
  1452.         END;
  1453.         PARS.Next(parser);
  1454.         e.ident := NIL
  1455.  
  1456.     ELSIF parser.sym = SCAN.lxLSQUARE DO
  1457.  
  1458.         REPEAT
  1459.  
  1460.             PARS.check1(isArr(e), parser, 75);
  1461.             NextPos(parser, pos);
  1462.             parser.expression(parser, idx);
  1463.             PARS.check(isInt(idx), parser, pos, 76);
  1464.  
  1465.             IF idx.obj = eCONST THEN
  1466.                 IF e.type.length > 0 THEN
  1467.                     PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), parser, pos, 83);
  1468.                     IF ARITH.Int(idx.value) > 0 THEN
  1469.                         CODE.AddCmd(CODE.opADDR, ARITH.Int(idx.value) * e.type.base.size)
  1470.                     END
  1471.                 ELSE
  1472.                     PARS.check(ARITH.range(idx.value, 0, MACHINE.target.maxInt), parser, pos, 83);
  1473.                     LoadConst(idx);
  1474.                     OpenIdx(parser, pos, e)
  1475.                 END
  1476.             ELSE
  1477.                 IF e.type.length > 0 THEN
  1478.                     IF chkIDX IN checking THEN
  1479.                         CheckRange(e.type.length, pos.line, errIDX)
  1480.                     END;
  1481.                     IF e.type.base.size # 1 THEN
  1482.                         CODE.AddCmd(CODE.opMULC, e.type.base.size)
  1483.                     END;
  1484.                     CODE.AddCmd0(CODE.opADD)
  1485.                 ELSE
  1486.                     OpenIdx(parser, pos, e)
  1487.                 END
  1488.             END;
  1489.  
  1490.             e.type := e.type.base
  1491.  
  1492.         UNTIL parser.sym # SCAN.lxCOMMA;
  1493.  
  1494.         PARS.checklex(parser, SCAN.lxRSQUARE);
  1495.         PARS.Next(parser);
  1496.         e.ident := NIL
  1497.  
  1498.     ELSIF parser.sym = SCAN.lxCARET DO
  1499.         getpos(parser, pos);
  1500.         PARS.check1(isPtr(e), parser, 77);
  1501.         deref(pos, e, TRUE, errPTR);
  1502.         e.type := e.type.base;
  1503.         e.readOnly := FALSE;
  1504.         PARS.Next(parser);
  1505.         e.ident := NIL;
  1506.         e.obj := eVREC
  1507.  
  1508.     ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO
  1509.  
  1510.         IF e.type.typ = PROG.tRECORD THEN
  1511.             PARS.check1(e.obj = eVREC, parser, 78)
  1512.         END;
  1513.         NextPos(parser, pos);
  1514.         qualident(parser, t);
  1515.         PARS.check(t.obj = eTYPE, parser, pos, 79);
  1516.  
  1517.         IF e.type.typ = PROG.tRECORD THEN
  1518.             PARS.check(t.type.typ = PROG.tRECORD, parser, pos, 80);
  1519.             IF chkGUARD IN checking THEN
  1520.                 IF e.ident = NIL THEN
  1521.                     CODE.TypeGuard(CODE.opTYPEGD, t.type.num, pos.line, errGUARD)
  1522.                 ELSE
  1523.                     CODE.AddCmd(CODE.opVADR, e.ident.offset - 1);
  1524.                     CODE.TypeGuard(CODE.opTYPEGR, t.type.num, pos.line, errGUARD)
  1525.                 END
  1526.             END;
  1527.         ELSE
  1528.             PARS.check(t.type.typ = PROG.tPOINTER, parser, pos, 81);
  1529.             IF chkGUARD IN checking THEN
  1530.                 CODE.TypeGuard(CODE.opTYPEGP, t.type.base.num, pos.line, errGUARD)
  1531.             END
  1532.         END;
  1533.  
  1534.         PARS.check(PROG.isBaseOf(e.type, t.type), parser, pos, 82);
  1535.  
  1536.         e.type := t.type;
  1537.  
  1538.         PARS.checklex(parser, SCAN.lxRROUND);
  1539.         PARS.Next(parser)
  1540.  
  1541.     END
  1542.  
  1543. END designator;
  1544.  
  1545.  
  1546. PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: SCAN.POSITION; CallStat: BOOLEAN);
  1547. VAR
  1548.     cconv:    INTEGER;
  1549.     params:   INTEGER;
  1550.     callconv: INTEGER;
  1551.     fparams:  INTEGER;
  1552.     int, flt: INTEGER;
  1553.     stk_par:  INTEGER;
  1554.  
  1555. BEGIN
  1556.     cconv := procType.call;
  1557.     params := procType.params.size;
  1558.  
  1559.     IF cconv IN {PROG._win64, PROG.win64} THEN
  1560.         callconv := CODE.call_win64;
  1561.         fparams := LSL(ORD(procType.params.getfparams(procType, 3, int, flt)), 5) + MIN(params, 4)
  1562.     ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
  1563.         callconv := CODE.call_sysv;
  1564.         fparams := LSL(ORD(procType.params.getfparams(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + params;
  1565.         stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
  1566.     ELSE
  1567.         callconv := CODE.call_stack;
  1568.         fparams := 0
  1569.     END;
  1570.     CODE.setlast(begcall);
  1571.     fregs := CODE.precall(isfloat);
  1572.  
  1573.     IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
  1574.         CODE.AddCmd(CODE.opALIGN16, params)
  1575.     ELSIF cconv IN {PROG._win64, PROG.win64} THEN
  1576.         CODE.AddCmd(CODE.opWIN64ALIGN16, params)
  1577.     ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
  1578.         CODE.AddCmd(CODE.opSYSVALIGN16, params + stk_par)
  1579.     END;
  1580.     CODE.setlast(endcall.prev(CODE.COMMAND));
  1581.  
  1582.     IF e.obj = eIMP THEN
  1583.         CODE.CallImp(e.ident.import, callconv, fparams)
  1584.     ELSIF e.obj = ePROC THEN
  1585.         CODE.Call(e.ident.proc.label, callconv, fparams)
  1586.     ELSIF isExpr(e) THEN
  1587.         deref(pos, e, CallStat, errPROC);
  1588.         CODE.CallP(callconv, fparams)
  1589.     END;
  1590.  
  1591.     IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
  1592.         CODE.AddCmd(CODE.opCLEANUP, params);
  1593.         CODE.AddCmd0(CODE.opPOPSP)
  1594.     ELSIF cconv IN {PROG._win64, PROG.win64} THEN
  1595.         CODE.AddCmd(CODE.opCLEANUP, MAX(params + params MOD 2, 4) + 1);
  1596.         CODE.AddCmd0(CODE.opPOPSP)
  1597.     ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
  1598.         CODE.AddCmd(CODE.opCLEANUP, params + stk_par);
  1599.         CODE.AddCmd0(CODE.opPOPSP)
  1600.     ELSIF cconv IN {PROG._ccall, PROG.ccall} THEN
  1601.         CODE.AddCmd(CODE.opCLEANUP, params)
  1602.     END;
  1603.  
  1604.     IF ~CallStat THEN
  1605.         IF isfloat THEN
  1606.             PARS.check(CODE.resf(fregs), parser, pos, 41)
  1607.         ELSE
  1608.             CODE.res(fregs)
  1609.         END
  1610.     END
  1611. END ProcCall;
  1612.  
  1613.  
  1614. PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1615. VAR
  1616.     pos, pos0, pos1: SCAN.POSITION;
  1617.  
  1618.     op:        INTEGER;
  1619.     e1:        PARS.EXPR;
  1620.     constant:  BOOLEAN;
  1621.     operator:  ARITH.RELATION;
  1622.     error:     INTEGER;
  1623.  
  1624.  
  1625.     PROCEDURE relation (sym: INTEGER): BOOLEAN;
  1626.         RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR
  1627.                (sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR
  1628.                (sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR
  1629.                (sym = SCAN.lxIN) OR (sym = SCAN.lxIS)
  1630.     END relation;
  1631.  
  1632.  
  1633.     PROCEDURE AddOperator (sym: INTEGER): BOOLEAN;
  1634.         RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR
  1635.                (sym = SCAN.lxOR)
  1636.     END AddOperator;
  1637.  
  1638.  
  1639.     PROCEDURE MulOperator (sym: INTEGER): BOOLEAN;
  1640.         RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR
  1641.                (sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR
  1642.                (sym = SCAN.lxAND)
  1643.     END MulOperator;
  1644.  
  1645.  
  1646.     PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1647.     VAR
  1648.         e1, e2: PARS.EXPR;
  1649.         pos:    SCAN.POSITION;
  1650.         range:  BOOLEAN;
  1651.  
  1652.     BEGIN
  1653.         range := FALSE;
  1654.         getpos(parser, pos);
  1655.         expression(parser, e1);
  1656.         PARS.check(isInt(e1), parser, pos, 76);
  1657.  
  1658.         IF e1.obj = eCONST THEN
  1659.             PARS.check(ARITH.range(e1.value, 0, MACHINE.target.maxSet), parser, pos, 44)
  1660.         END;
  1661.  
  1662.         range := parser.sym = SCAN.lxRANGE;
  1663.  
  1664.         IF range THEN
  1665.             NextPos(parser, pos);
  1666.             expression(parser, e2);
  1667.             PARS.check(isInt(e2), parser, pos, 76);
  1668.  
  1669.             IF e2.obj = eCONST THEN
  1670.                 PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 44)
  1671.             END
  1672.         ELSE
  1673.             IF e1.obj = eCONST THEN
  1674.                 e2 := e1
  1675.             END
  1676.         END;
  1677.  
  1678.         e.type := PARS.program.stTypes.tSET;
  1679.  
  1680.         IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
  1681.             ARITH.constrSet(e.value, e1.value, e2.value);
  1682.             e.obj := eCONST
  1683.         ELSE
  1684.             IF range THEN
  1685.                 IF e1.obj = eCONST THEN
  1686.                     CODE.AddCmd(CODE.opRSETL, ARITH.Int(e1.value))
  1687.                 ELSIF e2.obj = eCONST THEN
  1688.                     CODE.AddCmd(CODE.opRSETR, ARITH.Int(e2.value))
  1689.                 ELSE
  1690.                     CODE.AddCmd0(CODE.opRSET)
  1691.                 END
  1692.             ELSE
  1693.                 CODE.AddCmd0(CODE.opRSET1)
  1694.             END;
  1695.             e.obj := eEXPR
  1696.         END
  1697.  
  1698.     END element;
  1699.  
  1700.  
  1701.     PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1702.     VAR
  1703.         e1: PARS.EXPR;
  1704.  
  1705.     BEGIN
  1706.         ASSERT(parser.sym = SCAN.lxLCURLY);
  1707.  
  1708.         e.obj := eCONST;
  1709.         e.type := PARS.program.stTypes.tSET;
  1710.         ARITH.emptySet(e.value);
  1711.  
  1712.         PARS.Next(parser);
  1713.         IF parser.sym # SCAN.lxRCURLY THEN
  1714.             element(parser, e1);
  1715.  
  1716.             IF e1.obj = eCONST THEN
  1717.                 ARITH.opSet(e.value, e1.value, "+")
  1718.             ELSE
  1719.                 e.obj := eEXPR
  1720.             END;
  1721.  
  1722.             WHILE parser.sym = SCAN.lxCOMMA DO
  1723.                 PARS.Next(parser);
  1724.                 element(parser, e1);
  1725.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1726.                     ARITH.opSet(e.value, e1.value, "+")
  1727.                 ELSE
  1728.                     IF e.obj = eCONST THEN
  1729.                         CODE.AddCmd(CODE.opADDSL, ARITH.Int(e.value))
  1730.                     ELSIF e1.obj = eCONST THEN
  1731.                         CODE.AddCmd(CODE.opADDSR, ARITH.Int(e1.value))
  1732.                     ELSE
  1733.                         CODE.AddCmd0(CODE.opADDS)
  1734.                     END;
  1735.                     e.obj := eEXPR
  1736.                 END
  1737.             END;
  1738.             PARS.checklex(parser, SCAN.lxRCURLY)
  1739.         END;
  1740.         PARS.Next(parser);
  1741.     END set;
  1742.  
  1743.  
  1744.     PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1745.     VAR
  1746.         sym:      INTEGER;
  1747.         pos:      SCAN.POSITION;
  1748.         e1:       PARS.EXPR;
  1749.         isfloat:  BOOLEAN;
  1750.         fregs:    INTEGER;
  1751.  
  1752.  
  1753.         PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: SCAN.POSITION);
  1754.         BEGIN
  1755.             IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
  1756.                 IF e.type.typ = PROG.tREAL THEN
  1757.                     PARS.check(CODE.loadf(), parser, pos, 41)
  1758.                 ELSE
  1759.                     CODE.load(e.type.size)
  1760.                 END
  1761.             END
  1762.         END LoadVar;
  1763.  
  1764.  
  1765.     BEGIN
  1766.         sym := parser.sym;
  1767.  
  1768.         IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
  1769.             e.obj := eCONST;
  1770.             e.value := parser.lex.value;
  1771.             e.type := PARS.program.getType(PARS.program, e.value.typ);
  1772.             PARS.Next(parser)
  1773.  
  1774.         ELSIF sym = SCAN.lxNIL THEN
  1775.             e.obj   := eCONST;
  1776.             e.type  := PARS.program.stTypes.tNIL;
  1777.             PARS.Next(parser)
  1778.  
  1779.         ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
  1780.             e.obj   := eCONST;
  1781.             ARITH.setbool(e.value, sym = SCAN.lxTRUE);
  1782.             e.type  := PARS.program.stTypes.tBOOLEAN;
  1783.             PARS.Next(parser)
  1784.  
  1785.         ELSIF sym = SCAN.lxLCURLY THEN
  1786.             set(parser, e)
  1787.  
  1788.         ELSIF sym = SCAN.lxIDENT THEN
  1789.             getpos(parser, pos);
  1790.  
  1791.             CODE.pushBegEnd(begcall, endcall);
  1792.  
  1793.             designator(parser, e);
  1794.             IF isVar(e) THEN
  1795.                 LoadVar(e, parser, pos)
  1796.             END;
  1797.             IF parser.sym = SCAN.lxLROUND THEN
  1798.                 e1 := e;
  1799.                 ActualParameters(parser, e);
  1800.                 PARS.check(e.type # NIL, parser, pos, 59);
  1801.                 isfloat := e.type.typ = PROG.tREAL;
  1802.                 IF e1.obj IN {ePROC, eIMP} THEN
  1803.                     ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE)
  1804.                 ELSIF isExpr(e1) THEN
  1805.                     ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE)
  1806.                 END
  1807.             END;
  1808.             CODE.popBegEnd(begcall, endcall)
  1809.  
  1810.         ELSIF sym = SCAN.lxLROUND THEN
  1811.             PARS.Next(parser);
  1812.             expression(parser, e);
  1813.             PARS.checklex(parser, SCAN.lxRROUND);
  1814.             PARS.Next(parser);
  1815.             IF isExpr(e) & (e.obj # eCONST) THEN
  1816.                 e.obj := eEXPR
  1817.             END
  1818.  
  1819.         ELSIF sym = SCAN.lxNOT THEN
  1820.             NextPos(parser, pos);
  1821.             factor(parser, e);
  1822.             PARS.check(isBoolean(e), parser, pos, 72);
  1823.             IF e.obj # eCONST THEN
  1824.                 CODE.not;
  1825.                 e.obj := eEXPR
  1826.             ELSE
  1827.                 ASSERT(ARITH.neg(e.value))
  1828.             END
  1829.  
  1830.         ELSE
  1831.             PARS.check1(FALSE, parser, 34)
  1832.         END
  1833.     END factor;
  1834.  
  1835.  
  1836.     PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1837.     VAR
  1838.         pos: SCAN.POSITION;
  1839.         op:  INTEGER;
  1840.         e1:  PARS.EXPR;
  1841.  
  1842.         label:  INTEGER;
  1843.         label1: INTEGER;
  1844.  
  1845.     BEGIN
  1846.         factor(parser, e);
  1847.         label := -1;
  1848.  
  1849.         WHILE MulOperator(parser.sym) DO
  1850.             op  := parser.sym;
  1851.             getpos(parser, pos);
  1852.             PARS.Next(parser);
  1853.  
  1854.             IF op = SCAN.lxAND THEN
  1855.                 IF ~parser.constexp THEN
  1856.  
  1857.                     IF label = -1 THEN
  1858.                         label := CODE.NewLabel()
  1859.                     END;
  1860.  
  1861.                     IF e.obj = eCONST THEN
  1862.                         CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
  1863.                     END;            
  1864.                     CODE.AddCmd0(CODE.opACC);
  1865.                     CODE.AddJmpCmd(CODE.opJZ, label);
  1866.                     CODE.drop
  1867.                 END
  1868.             END;
  1869.  
  1870.             factor(parser, e1);
  1871.  
  1872.             CASE op OF
  1873.             |SCAN.lxMUL:
  1874.                 PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
  1875.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1876.  
  1877.                    CASE e.value.typ OF
  1878.                    |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"),   parser, pos, 39)
  1879.                    |ARITH.tREAL:    PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40)
  1880.                    |ARITH.tSET:     ARITH.opSet(e.value, e1.value, "*")
  1881.                    END
  1882.  
  1883.                 ELSE
  1884.                     IF isInt(e) THEN
  1885.                         IF e.obj = eCONST THEN
  1886.                             CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value))
  1887.                         ELSIF e1.obj = eCONST THEN
  1888.                             CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value))
  1889.                         ELSE
  1890.                             CODE.AddCmd0(CODE.opMUL)
  1891.                         END
  1892.                     ELSIF isReal(e) THEN
  1893.                         IF e.obj = eCONST THEN
  1894.                             CODE.Float(ARITH.Float(e.value))
  1895.                         ELSIF e1.obj = eCONST THEN
  1896.                             CODE.Float(ARITH.Float(e1.value))
  1897.                         END;
  1898.                         CODE.fbinop(CODE.opMULF)
  1899.                     ELSIF isSet(e) THEN
  1900.                         IF e.obj = eCONST THEN
  1901.                             CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value))
  1902.                         ELSIF e1.obj = eCONST THEN
  1903.                             CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value))
  1904.                         ELSE
  1905.                             CODE.AddCmd0(CODE.opMULS)
  1906.                         END
  1907.                     END;
  1908.                     e.obj := eEXPR
  1909.                 END
  1910.  
  1911.             |SCAN.lxSLASH:
  1912.                 PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
  1913.                 IF (e1.obj = eCONST) & isReal(e1) THEN
  1914.                     PARS.check(~ARITH.isZero(e1.value), parser, pos, 45)
  1915.                 END;
  1916.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1917.  
  1918.                     CASE e.value.typ OF
  1919.                     |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), parser, pos, 40)
  1920.                     |ARITH.tSET:  ARITH.opSet(e.value, e1.value, "/")
  1921.                     END
  1922.  
  1923.                 ELSE
  1924.                     IF isReal(e) THEN
  1925.                         IF e.obj = eCONST THEN
  1926.                             CODE.Float(ARITH.Float(e.value));
  1927.                             CODE.fbinop(CODE.opDIVFI)
  1928.                         ELSIF e1.obj = eCONST THEN
  1929.                             CODE.Float(ARITH.Float(e1.value));
  1930.                             CODE.fbinop(CODE.opDIVF)
  1931.                         ELSE
  1932.                             CODE.fbinop(CODE.opDIVF)
  1933.                         END
  1934.                     ELSIF isSet(e) THEN
  1935.                         IF e.obj = eCONST THEN
  1936.                             CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value))
  1937.                         ELSIF e1.obj = eCONST THEN
  1938.                             CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value))
  1939.                         ELSE
  1940.                             CODE.AddCmd0(CODE.opDIVS)
  1941.                         END
  1942.                     END;
  1943.                     e.obj := eEXPR
  1944.                 END
  1945.  
  1946.             |SCAN.lxDIV, SCAN.lxMOD:
  1947.                 PARS.check(isInt(e) & isInt(e1), parser, pos, 37);
  1948.                 IF e1.obj = eCONST THEN
  1949.                     PARS.check(~ARITH.isZero(e1.value), parser, pos, 46)
  1950.                 END;
  1951.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1952.  
  1953.                     IF op = SCAN.lxDIV THEN
  1954.                         PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39)
  1955.                     ELSE
  1956.                         ASSERT(ARITH.opInt(e.value, e1.value, "M"))
  1957.                     END
  1958.  
  1959.                 ELSE
  1960.                     IF e1.obj # eCONST THEN
  1961.                         label1 := CODE.NewLabel();
  1962.                         CODE.AddJmpCmd(CODE.opJNZ, label1)
  1963.                     END;
  1964.                     IF e.obj = eCONST THEN
  1965.                         CODE.OnError(pos.line, errDIV);
  1966.                         CODE.SetLabel(label1);
  1967.                         CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
  1968.                     ELSIF e1.obj = eCONST THEN
  1969.                         CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
  1970.                     ELSE
  1971.                         CODE.OnError(pos.line, errDIV);
  1972.                         CODE.SetLabel(label1);
  1973.                         CODE.AddCmd0(CODE.opDIV  + ORD(op = SCAN.lxMOD))
  1974.                     END;
  1975.                     e.obj := eEXPR
  1976.                 END
  1977.  
  1978.             |SCAN.lxAND:
  1979.                 PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
  1980.  
  1981.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1982.                     ARITH.opBoolean(e.value, e1.value, "&")
  1983.                 ELSE
  1984.                     e.obj := eEXPR;
  1985.                     IF e1.obj = eCONST THEN
  1986.                         CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
  1987.                     END;
  1988.                     CODE.AddCmd0(CODE.opACC)
  1989.                 END
  1990.  
  1991.             END
  1992.         END;
  1993.  
  1994.         IF label # -1 THEN
  1995.             CODE.SetLabel(label)
  1996.         END
  1997.     END term;
  1998.  
  1999.  
  2000.     PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
  2001.     VAR
  2002.         pos: SCAN.POSITION;
  2003.         op:  INTEGER;
  2004.         e1:  PARS.EXPR;
  2005.  
  2006.         plus, minus: BOOLEAN;
  2007.  
  2008.         label: INTEGER;
  2009.  
  2010.     BEGIN
  2011.         plus  := parser.sym = SCAN.lxPLUS;
  2012.         minus := parser.sym = SCAN.lxMINUS;
  2013.  
  2014.         IF plus OR minus THEN
  2015.             getpos(parser, pos);
  2016.             PARS.Next(parser)
  2017.         END;
  2018.  
  2019.         term(parser, e);
  2020.  
  2021.         IF plus OR minus THEN
  2022.             PARS.check(isInt(e) OR isReal(e) OR isSet(e), parser, pos, 36);
  2023.  
  2024.             IF minus & (e.obj = eCONST) THEN
  2025.                 PARS.check(ARITH.neg(e.value), parser, pos, 39)
  2026.             END;
  2027.  
  2028.             IF e.obj # eCONST THEN
  2029.                 IF minus THEN
  2030.                     IF isInt(e) THEN
  2031.                         CODE.AddCmd0(CODE.opUMINUS)
  2032.                     ELSIF isReal(e) THEN
  2033.                         CODE.AddCmd0(CODE.opUMINF)
  2034.                     ELSIF isSet(e) THEN
  2035.                         CODE.AddCmd0(CODE.opUMINS)
  2036.                     END
  2037.                 END;
  2038.                 e.obj := eEXPR
  2039.             END
  2040.         END;
  2041.  
  2042.         label := -1;
  2043.  
  2044.         WHILE AddOperator(parser.sym) DO
  2045.  
  2046.             op  := parser.sym;
  2047.             getpos(parser, pos);
  2048.             PARS.Next(parser);
  2049.  
  2050.             IF op = SCAN.lxOR THEN
  2051.  
  2052.                 IF ~parser.constexp THEN
  2053.  
  2054.                     IF label = -1 THEN
  2055.                         label := CODE.NewLabel()
  2056.                     END;
  2057.  
  2058.                     IF e.obj = eCONST THEN
  2059.                         CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
  2060.                     END;        
  2061.                     CODE.AddCmd0(CODE.opACC);
  2062.                     CODE.AddJmpCmd(CODE.opJNZ, label);
  2063.                     CODE.drop
  2064.                 END
  2065.  
  2066.             END;
  2067.  
  2068.             term(parser, e1);
  2069.  
  2070.             CASE op OF
  2071.             |SCAN.lxPLUS, SCAN.lxMINUS:
  2072.  
  2073.                 IF op = SCAN.lxPLUS THEN
  2074.                     op := ORD("+")
  2075.                 ELSE
  2076.                     op := ORD("-")
  2077.                 END;
  2078.  
  2079.                 PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
  2080.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  2081.  
  2082.                    CASE e.value.typ OF
  2083.                    |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)),   parser, pos, 39)
  2084.                    |ARITH.tREAL:    PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40)
  2085.                    |ARITH.tSET:     ARITH.opSet(e.value, e1.value, CHR(op))
  2086.                    END
  2087.  
  2088.                 ELSE
  2089.                     IF isInt(e) THEN
  2090.                         IF e.obj = eCONST THEN
  2091.                             CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
  2092.                         ELSIF e1.obj = eCONST THEN
  2093.                             CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
  2094.                         ELSE
  2095.                             CODE.AddCmd0(CODE.opADD  + ORD(op = ORD("-")))
  2096.                         END
  2097.                     ELSIF isReal(e) THEN
  2098.                         IF e.obj = eCONST THEN
  2099.                             CODE.Float(ARITH.Float(e.value));
  2100.                             CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-")))
  2101.                         ELSIF e1.obj = eCONST THEN
  2102.                             CODE.Float(ARITH.Float(e1.value));
  2103.                             CODE.fbinop(CODE.opADDF  + ORD(op = ORD("-")))
  2104.                         ELSE
  2105.                             CODE.fbinop(CODE.opADDF  + ORD(op = ORD("-")))
  2106.                         END
  2107.                     ELSIF isSet(e) THEN
  2108.                         IF e.obj = eCONST THEN
  2109.                             CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
  2110.                         ELSIF e1.obj = eCONST THEN
  2111.                             CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
  2112.                         ELSE
  2113.                             CODE.AddCmd0(CODE.opADDS  + ORD(op = ORD("-")))
  2114.                         END
  2115.                     END;
  2116.                     e.obj := eEXPR
  2117.                 END
  2118.  
  2119.             |SCAN.lxOR:
  2120.                 PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
  2121.  
  2122.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  2123.                     ARITH.opBoolean(e.value, e1.value, "|")
  2124.                 ELSE
  2125.                     e.obj := eEXPR;
  2126.                     IF e1.obj = eCONST THEN
  2127.                         CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
  2128.                     END;
  2129.                     CODE.AddCmd0(CODE.opACC)
  2130.                 END
  2131.  
  2132.             END
  2133.         END;
  2134.  
  2135.         IF label # -1 THEN
  2136.             CODE.SetLabel(label)
  2137.         END
  2138.  
  2139.     END SimpleExpression;
  2140.  
  2141.  
  2142.     PROCEDURE cmpcode (op: INTEGER): INTEGER;
  2143.     VAR
  2144.         res: INTEGER;
  2145.     BEGIN
  2146.         CASE op OF
  2147.         |SCAN.lxEQ: res := 0
  2148.         |SCAN.lxNE: res := 1
  2149.         |SCAN.lxLT: res := 2
  2150.         |SCAN.lxLE: res := 3
  2151.         |SCAN.lxGT: res := 4
  2152.         |SCAN.lxGE: res := 5
  2153.         END
  2154.  
  2155.         RETURN res
  2156.     END cmpcode;
  2157.  
  2158.  
  2159.     PROCEDURE BoolCmp (eq, val: BOOLEAN);
  2160.     BEGIN
  2161.        IF eq = val THEN
  2162.            CODE.AddCmd0(CODE.opNER)
  2163.        ELSE
  2164.            CODE.AddCmd0(CODE.opEQR)
  2165.        END
  2166.     END BoolCmp;
  2167.  
  2168.  
  2169.     PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
  2170.     VAR
  2171.         res: BOOLEAN;
  2172.  
  2173.     BEGIN
  2174.  
  2175.         res := TRUE;
  2176.  
  2177.         IF isString(e) & isCharArray(e1) THEN
  2178.             CODE.AddCmd(CODE.opSADR, String(e));
  2179.             CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
  2180.             CODE.AddCmd0(CODE.opEQS2 + cmpcode(op))
  2181.  
  2182.         ELSIF isString(e) & isCharArrayW(e1) THEN
  2183.             CODE.AddCmd(CODE.opSADR, StringW(e));
  2184.             CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
  2185.             CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
  2186.  
  2187.         ELSIF isStringW(e) & isCharArrayW(e1) THEN
  2188.             CODE.AddCmd(CODE.opSADR, StringW(e));
  2189.             CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
  2190.             CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
  2191.  
  2192.         ELSIF isCharArray(e) & isString(e1) THEN
  2193.             CODE.AddCmd(CODE.opSADR, String(e1));
  2194.             CODE.AddCmd(CODE.opCONST, strlen(e1) + 1);
  2195.             CODE.AddCmd0(CODE.opEQS + cmpcode(op))
  2196.  
  2197.         ELSIF isCharArrayW(e) & isString(e1) THEN
  2198.             CODE.AddCmd(CODE.opSADR, StringW(e1));
  2199.             CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
  2200.             CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
  2201.  
  2202.         ELSIF isCharArrayW(e) & isStringW(e1) THEN
  2203.             CODE.AddCmd(CODE.opSADR, StringW(e1));
  2204.             CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
  2205.             CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
  2206.  
  2207.         ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
  2208.             CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
  2209.  
  2210.         ELSIF isCharArray(e) & isCharArray(e1) THEN
  2211.             CODE.AddCmd0(CODE.opEQS + cmpcode(op))
  2212.  
  2213.         ELSIF isString(e) & isString(e1) THEN
  2214.             PARS.strcmp(e.value, e1.value, op)
  2215.  
  2216.         ELSE
  2217.             res := FALSE
  2218.  
  2219.         END
  2220.  
  2221.         RETURN res
  2222.     END strcmp;
  2223.  
  2224.  
  2225. BEGIN
  2226.     getpos(parser, pos0);
  2227.     SimpleExpression(parser, e);
  2228.     IF relation(parser.sym) THEN
  2229.         IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN
  2230.             CODE.AddCmd(CODE.opCONST, e.type.length)
  2231.         END;
  2232.         op  := parser.sym;
  2233.         getpos(parser, pos);
  2234.         PARS.Next(parser);
  2235.  
  2236.         pos1 := parser.lex.pos;
  2237.         SimpleExpression(parser, e1);
  2238.  
  2239.         IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
  2240.             CODE.AddCmd(CODE.opCONST, e1.type.length)
  2241.         END;
  2242.  
  2243.         constant := (e.obj = eCONST) & (e1.obj = eCONST);
  2244.  
  2245.         CASE op OF
  2246.         |SCAN.lxEQ: operator := "="
  2247.         |SCAN.lxNE: operator := "#"
  2248.         |SCAN.lxLT: operator := "<"
  2249.         |SCAN.lxLE: operator := "<="
  2250.         |SCAN.lxGT: operator := ">"
  2251.         |SCAN.lxGE: operator := ">="
  2252.         |SCAN.lxIN: operator := "IN"
  2253.         |SCAN.lxIS: operator := ""
  2254.         END;
  2255.  
  2256.         error := 0;
  2257.  
  2258.         CASE op OF
  2259.         |SCAN.lxEQ, SCAN.lxNE:
  2260.  
  2261.             IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
  2262.             isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
  2263.             isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
  2264.             isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
  2265.             isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN
  2266.                 IF constant THEN
  2267.                     ARITH.relation(e.value, e1.value, operator, error)
  2268.                 ELSE
  2269.                     IF e.obj = eCONST THEN
  2270.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6,  ARITH.Int(e.value))
  2271.                     ELSIF e1.obj = eCONST THEN
  2272.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
  2273.                     ELSE
  2274.                         CODE.AddCmd0(CODE.opEQ + cmpcode(op))
  2275.                     END
  2276.                 END
  2277.  
  2278.             ELSIF isStringW1(e) & isCharW(e1) THEN
  2279.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
  2280.  
  2281.             ELSIF isStringW1(e1) & isCharW(e) THEN
  2282.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
  2283.  
  2284.             ELSIF isBoolean(e) & isBoolean(e1) THEN
  2285.                 IF constant THEN
  2286.                     ARITH.relation(e.value, e1.value, operator, error)
  2287.                 ELSE
  2288.                     IF e.obj = eCONST THEN
  2289.                         BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0)
  2290.                     ELSIF e1.obj = eCONST THEN
  2291.                         BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
  2292.                     ELSE
  2293.                         IF op = SCAN.lxEQ THEN
  2294.                             CODE.AddCmd0(CODE.opEQB)
  2295.                         ELSE
  2296.                             CODE.AddCmd0(CODE.opNEB)
  2297.                         END
  2298.                     END
  2299.                 END
  2300.  
  2301.             ELSIF isReal(e) & isReal(e1) THEN
  2302.                 IF constant THEN
  2303.                     ARITH.relation(e.value, e1.value, operator, error)
  2304.                 ELSE
  2305.                     IF e.obj = eCONST THEN
  2306.                         CODE.Float(ARITH.Float(e.value));
  2307.                         CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
  2308.                     ELSIF e1.obj = eCONST THEN
  2309.                         CODE.Float(ARITH.Float(e1.value));
  2310.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2311.                     ELSE
  2312.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2313.                     END
  2314.                 END
  2315.  
  2316.             ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
  2317.                 IF ~strcmp(e, e1, op) THEN
  2318.                     PARS.error(parser, pos, 37)
  2319.                 END
  2320.  
  2321.             ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
  2322.                 CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
  2323.  
  2324.             ELSIF isProc(e) & isNil(e1) THEN
  2325.                 IF e.obj IN {ePROC, eIMP} THEN
  2326.                     PARS.check(e.ident.global, parser, pos0, 85);
  2327.                     constant := TRUE;
  2328.                     e.obj := eCONST;
  2329.                     ARITH.setbool(e.value, op = SCAN.lxNE)
  2330.                 ELSE
  2331.                     CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
  2332.                 END
  2333.  
  2334.             ELSIF isNil(e) & isProc(e1) THEN
  2335.                 IF e1.obj IN {ePROC, eIMP} THEN
  2336.                     PARS.check(e1.ident.global, parser, pos1, 85);
  2337.                     constant := TRUE;
  2338.                     e.obj := eCONST;
  2339.                     ARITH.setbool(e.value, op = SCAN.lxNE)
  2340.                 ELSE
  2341.                     CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
  2342.                 END
  2343.  
  2344.             ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
  2345.                 IF e.obj = ePROC THEN
  2346.                     PARS.check(e.ident.global, parser, pos0, 85)
  2347.                 END;
  2348.                 IF e1.obj = ePROC THEN
  2349.                     PARS.check(e1.ident.global, parser, pos1, 85)
  2350.                 END;
  2351.                 IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
  2352.                     constant := TRUE;
  2353.                     e.obj := eCONST;
  2354.                     IF op = SCAN.lxEQ THEN
  2355.                         ARITH.setbool(e.value, e.ident = e1.ident)
  2356.                     ELSE
  2357.                         ARITH.setbool(e.value, e.ident # e1.ident)
  2358.                     END
  2359.                 ELSIF e.obj = ePROC THEN
  2360.                     CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0)
  2361.                 ELSIF e1.obj = ePROC THEN
  2362.                     CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0)
  2363.                 ELSIF e.obj = eIMP THEN
  2364.                     CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0)
  2365.                 ELSIF e1.obj = eIMP THEN
  2366.                     CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0)
  2367.                 ELSE
  2368.                     CODE.AddCmd0(CODE.opEQ + cmpcode(op))
  2369.                 END
  2370.  
  2371.             ELSIF isNil(e) & isNil(e1) THEN
  2372.                 constant := TRUE;
  2373.                 e.obj := eCONST;
  2374.                 ARITH.setbool(e.value, op = SCAN.lxEQ)
  2375.  
  2376.             ELSE
  2377.                 PARS.error(parser, pos, 37)
  2378.             END
  2379.  
  2380.         |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
  2381.             IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
  2382.                 isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
  2383.                 isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
  2384.                 isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
  2385.  
  2386.                 IF constant THEN
  2387.                     ARITH.relation(e.value, e1.value, operator, error)
  2388.                 ELSE
  2389.                     IF e.obj = eCONST THEN
  2390.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value))
  2391.                     ELSIF e1.obj = eCONST THEN
  2392.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
  2393.                     ELSE
  2394.                         CODE.AddCmd0(CODE.opEQ + cmpcode(op))
  2395.                     END
  2396.                 END
  2397.  
  2398.             ELSIF isStringW1(e) & isCharW(e1) THEN
  2399.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
  2400.  
  2401.             ELSIF isStringW1(e1) & isCharW(e) THEN
  2402.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
  2403.  
  2404.             ELSIF isReal(e) & isReal(e1) THEN
  2405.                 IF constant THEN
  2406.                     ARITH.relation(e.value, e1.value, operator, error)
  2407.                 ELSE
  2408.                     IF e.obj = eCONST THEN
  2409.                         CODE.Float(ARITH.Float(e.value));
  2410.                         CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
  2411.                     ELSIF e1.obj = eCONST THEN
  2412.                         CODE.Float(ARITH.Float(e1.value));
  2413.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2414.                     ELSE
  2415.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2416.                     END
  2417.                 END
  2418.  
  2419.             ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
  2420.                 IF ~strcmp(e, e1, op) THEN
  2421.                     PARS.error(parser, pos, 37)
  2422.                 END
  2423.  
  2424.             ELSE
  2425.                 PARS.error(parser, pos, 37)
  2426.             END
  2427.  
  2428.         |SCAN.lxIN:
  2429.             PARS.check(isInt(e) & isSet(e1), parser, pos, 37);
  2430.             IF e.obj = eCONST THEN
  2431.                 PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56)
  2432.             END;
  2433.             IF constant THEN
  2434.                 ARITH.relation(e.value, e1.value, operator, error)
  2435.             ELSE
  2436.                 IF e.obj = eCONST THEN
  2437.                     CODE.AddCmd(CODE.opINL, ARITH.Int(e.value))
  2438.                 ELSIF e1.obj = eCONST THEN
  2439.                     CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value))
  2440.                 ELSE
  2441.                     CODE.AddCmd0(CODE.opIN)
  2442.                 END
  2443.             END
  2444.  
  2445.         |SCAN.lxIS:
  2446.             PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73);
  2447.             IF e.type.typ = PROG.tRECORD THEN
  2448.                 PARS.check(e.obj = eVREC, parser, pos0, 78)
  2449.             END;
  2450.             PARS.check(e1.obj = eTYPE, parser, pos1, 79);
  2451.  
  2452.             IF e.type.typ = PROG.tRECORD THEN
  2453.                 PARS.check(e1.type.typ = PROG.tRECORD,  parser, pos1, 80);
  2454.                 IF e.ident = NIL THEN
  2455.                     CODE.TypeCheck(e1.type.num)
  2456.                 ELSE
  2457.                     CODE.AddCmd(CODE.opVADR, e.ident.offset - 1);
  2458.                     CODE.TypeCheckRec(e1.type.num)
  2459.                 END
  2460.             ELSE
  2461.                 PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81);
  2462.                 CODE.TypeCheck(e1.type.base.num)
  2463.             END;
  2464.  
  2465.             PARS.check(PROG.isBaseOf(e.type, e1.type), parser, pos1, 82)
  2466.  
  2467.         END;
  2468.  
  2469.         ASSERT(error = 0);
  2470.  
  2471.         e.type := PARS.program.stTypes.tBOOLEAN;
  2472.  
  2473.         IF ~constant THEN
  2474.             e.obj := eEXPR
  2475.         END
  2476.  
  2477.     END
  2478. END expression;
  2479.  
  2480.  
  2481. PROCEDURE ElementaryStatement (parser: PARS.PARSER);
  2482. VAR
  2483.     e, e1:    PARS.EXPR;
  2484.     pos:      SCAN.POSITION;
  2485.     line:     INTEGER;
  2486.     call:     BOOLEAN;
  2487.     fregs:    INTEGER;
  2488.  
  2489. BEGIN
  2490.     getpos(parser, pos);
  2491.  
  2492.     CODE.pushBegEnd(begcall, endcall);
  2493.  
  2494.     designator(parser, e);
  2495.  
  2496.     IF parser.sym = SCAN.lxASSIGN THEN
  2497.         line := parser.lex.pos.line;
  2498.         PARS.check(isVar(e), parser, pos, 93);
  2499.         PARS.check(~e.readOnly, parser, pos, 94);
  2500.  
  2501.         CODE.setlast(begcall);
  2502.  
  2503.         NextPos(parser, pos);
  2504.         expression(parser, e1);
  2505.  
  2506.         CODE.setlast(endcall.prev(CODE.COMMAND));
  2507.  
  2508.         PARS.check(assign(e1, e.type, line), parser, pos, 91);
  2509.         IF e1.obj = ePROC THEN
  2510.             PARS.check(e1.ident.global, parser, pos, 85)
  2511.         END;
  2512.         call := FALSE
  2513.     ELSIF parser.sym = SCAN.lxEQ THEN
  2514.         PARS.check1(FALSE, parser, 96)
  2515.     ELSIF parser.sym = SCAN.lxLROUND THEN
  2516.         e1 := e;
  2517.         ActualParameters(parser, e1);
  2518.         PARS.check((e1.type = NIL) OR ODD(e.type.call), parser, pos, 92);
  2519.         call := TRUE
  2520.     ELSE
  2521.         PARS.check(isProc(e), parser, pos, 86);
  2522.         PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92);
  2523.         PARS.check1(e.type.params.first = NIL, parser, 64);
  2524.         call := TRUE
  2525.     END;
  2526.  
  2527.     IF call THEN
  2528.         IF e.obj IN {ePROC, eIMP} THEN
  2529.             ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE)
  2530.         ELSIF isExpr(e) THEN
  2531.             ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE)
  2532.         END
  2533.     END;
  2534.  
  2535.     CODE.popBegEnd(begcall, endcall)
  2536. END ElementaryStatement;
  2537.  
  2538.  
  2539. PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN);
  2540. VAR
  2541.     e:     PARS.EXPR;
  2542.     pos:   SCAN.POSITION;
  2543.  
  2544.     label, L: INTEGER;
  2545.  
  2546. BEGIN
  2547.     L := CODE.NewLabel();
  2548.  
  2549.     IF ~if THEN
  2550.         CODE.AddCmd0(CODE.opLOOP);
  2551.         CODE.SetLabel(L)
  2552.     END;
  2553.  
  2554.     REPEAT
  2555.         NextPos(parser, pos);
  2556.  
  2557.         label := CODE.NewLabel();
  2558.  
  2559.         expression(parser, e);
  2560.         PARS.check(isBoolean(e), parser, pos, 72);
  2561.  
  2562.         IF e.obj = eCONST THEN
  2563.             IF ~ARITH.getBool(e.value) THEN
  2564.                 CODE.AddJmpCmd(CODE.opJMP, label)
  2565.             END
  2566.         ELSE
  2567.             CODE.AddJmpCmd(CODE.opJNE, label)
  2568.         END;
  2569.  
  2570.         IF if THEN
  2571.             PARS.checklex(parser, SCAN.lxTHEN)
  2572.         ELSE
  2573.             PARS.checklex(parser, SCAN.lxDO)
  2574.         END;
  2575.  
  2576.         PARS.Next(parser);
  2577.         parser.StatSeq(parser);
  2578.  
  2579.         CODE.AddJmpCmd(CODE.opJMP, L);
  2580.         CODE.SetLabel(label)
  2581.  
  2582.     UNTIL parser.sym # SCAN.lxELSIF;
  2583.  
  2584.     IF if THEN
  2585.         IF parser.sym = SCAN.lxELSE THEN
  2586.             PARS.Next(parser);
  2587.             parser.StatSeq(parser)
  2588.         END;
  2589.         CODE.SetLabel(L)
  2590.     END;
  2591.  
  2592.     PARS.checklex(parser, SCAN.lxEND);
  2593.  
  2594.     IF ~if THEN
  2595.         CODE.AddCmd0(CODE.opENDLOOP)
  2596.     END;
  2597.  
  2598.     PARS.Next(parser)
  2599. END IfStatement;
  2600.  
  2601.  
  2602. PROCEDURE RepeatStatement (parser: PARS.PARSER);
  2603. VAR
  2604.     e:     PARS.EXPR;
  2605.     pos:   SCAN.POSITION;
  2606.     label: INTEGER;
  2607.  
  2608. BEGIN
  2609.     CODE.AddCmd0(CODE.opLOOP);
  2610.  
  2611.     label := CODE.NewLabel();
  2612.     CODE.SetLabel(label);
  2613.  
  2614.     PARS.Next(parser);
  2615.     parser.StatSeq(parser);
  2616.     PARS.checklex(parser, SCAN.lxUNTIL);
  2617.     NextPos(parser, pos);
  2618.     expression(parser, e);
  2619.     PARS.check(isBoolean(e), parser, pos, 72);
  2620.  
  2621.     IF e.obj = eCONST THEN
  2622.         IF ~ARITH.getBool(e.value) THEN
  2623.             CODE.AddJmpCmd(CODE.opJMP, label)
  2624.         END
  2625.     ELSE
  2626.         CODE.AddJmpCmd(CODE.opJNE, label)
  2627.     END;
  2628.  
  2629.     CODE.AddCmd0(CODE.opENDLOOP)
  2630. END RepeatStatement;
  2631.  
  2632.  
  2633. PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
  2634. VAR
  2635.    La, Ra, Lb, Rb, res: INTEGER;
  2636.  
  2637. BEGIN
  2638.     La := a(CASE_LABEL).range.a;
  2639.     Ra := a(CASE_LABEL).range.b;
  2640.     Lb := b(CASE_LABEL).range.a;
  2641.     Rb := b(CASE_LABEL).range.b;
  2642.     IF (Ra < Lb) OR (La > Rb) THEN
  2643.         res := ORD(La > Lb) - ORD(La < Lb)
  2644.     ELSE
  2645.         res := 0
  2646.     END
  2647.  
  2648.     RETURN res
  2649. END LabelCmp;
  2650.  
  2651.  
  2652. PROCEDURE DestroyLabel (VAR label: AVL.DATA);
  2653. BEGIN
  2654.     C.push(CaseLabels, label);
  2655.     label := NIL
  2656. END DestroyLabel;
  2657.  
  2658.  
  2659. PROCEDURE NewVariant (label: INTEGER; cmd: CODE.COMMAND): CASE_VARIANT;
  2660. VAR
  2661.     res:   CASE_VARIANT;
  2662.     citem: C.ITEM;
  2663.  
  2664. BEGIN
  2665.     citem := C.pop(CaseVar);
  2666.     IF citem = NIL THEN
  2667.         NEW(res)
  2668.     ELSE
  2669.         res := citem(CASE_VARIANT)
  2670.     END;
  2671.  
  2672.     res.label := label;
  2673.     res.cmd := cmd;
  2674.     res.processed := FALSE
  2675.  
  2676.     RETURN res
  2677. END NewVariant;
  2678.  
  2679.  
  2680. PROCEDURE CaseStatement (parser: PARS.PARSER);
  2681. VAR
  2682.     e:      PARS.EXPR;
  2683.     pos:    SCAN.POSITION;
  2684.  
  2685.  
  2686.     PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN;
  2687.         RETURN isRec(caseExpr) OR isPtr(caseExpr)
  2688.     END isRecPtr;
  2689.  
  2690.  
  2691.     PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER;
  2692.     VAR
  2693.         a:      INTEGER;
  2694.         label:  PARS.EXPR;
  2695.         pos:    SCAN.POSITION;
  2696.         value:  ARITH.VALUE;
  2697.  
  2698.     BEGIN
  2699.         getpos(parser, pos);
  2700.         type := NIL;
  2701.  
  2702.         IF isChar(caseExpr) THEN
  2703.             PARS.ConstExpression(parser, value);
  2704.             PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99);
  2705.             a := ARITH.getInt(value)
  2706.         ELSIF isCharW(caseExpr) THEN
  2707.             PARS.ConstExpression(parser, value);
  2708.             IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
  2709.                 ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
  2710.             ELSE
  2711.                 PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99)
  2712.             END;
  2713.             a := ARITH.getInt(value)
  2714.         ELSIF isInt(caseExpr) THEN
  2715.             PARS.ConstExpression(parser, value);
  2716.             PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99);
  2717.             a := ARITH.getInt(value)
  2718.         ELSIF isRecPtr(caseExpr) THEN
  2719.             qualident(parser, label);
  2720.             PARS.check(label.obj = eTYPE, parser, pos, 79);
  2721.             PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, pos, 99);
  2722.             IF isRec(caseExpr) THEN
  2723.                 a := label.type.num
  2724.             ELSE
  2725.                 a := label.type.base.num
  2726.             END;
  2727.             type := label.type
  2728.         END
  2729.  
  2730.         RETURN a
  2731.     END Label;
  2732.  
  2733.  
  2734.     PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: SCAN.POSITION);
  2735.     BEGIN
  2736.         IF node # NIL THEN
  2737.             PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), parser, pos, 100);
  2738.             CheckType(node.left, type, parser, pos);
  2739.             CheckType(node.right, type, parser, pos)
  2740.         END
  2741.     END CheckType;
  2742.  
  2743.  
  2744.     PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
  2745.     VAR
  2746.         label:     CASE_LABEL;
  2747.         citem:     C.ITEM;
  2748.         pos, pos1: SCAN.POSITION;
  2749.         node:      AVL.NODE;
  2750.         newnode:   BOOLEAN;
  2751.         range:     RANGE;
  2752.  
  2753.     BEGIN
  2754.         citem := C.pop(CaseLabels);
  2755.         IF citem = NIL THEN
  2756.             NEW(label)
  2757.         ELSE
  2758.             label := citem(CASE_LABEL)
  2759.         END;
  2760.  
  2761.         label.variant := variant;
  2762.         label.self := CODE.NewLabel();
  2763.  
  2764.         getpos(parser, pos1);
  2765.         range.a := Label(parser, caseExpr, label.type);
  2766.  
  2767.         IF parser.sym = SCAN.lxRANGE THEN
  2768.             PARS.check1(~isRecPtr(caseExpr), parser, 53);
  2769.             NextPos(parser, pos);
  2770.             range.b := Label(parser, caseExpr, label.type);
  2771.             PARS.check(range.a <= range.b, parser, pos, 103)
  2772.         ELSE
  2773.             range.b := range.a
  2774.         END;
  2775.  
  2776.         label.range := range;
  2777.  
  2778.         IF isRecPtr(caseExpr) THEN
  2779.             CheckType(tree, label.type, parser, pos1)
  2780.         END;
  2781.         tree := AVL.insert(tree, label, LabelCmp, newnode, node);
  2782.         PARS.check(newnode, parser, pos1, 100)
  2783.  
  2784.         RETURN node
  2785.  
  2786.     END LabelRange;
  2787.  
  2788.  
  2789.     PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
  2790.     VAR
  2791.         exit: BOOLEAN;
  2792.         res:  AVL.NODE;
  2793.  
  2794.     BEGIN
  2795.         exit := FALSE;
  2796.         REPEAT
  2797.             res := LabelRange(parser, caseExpr, tree, variant);
  2798.             IF parser.sym = SCAN.lxCOMMA THEN
  2799.                 PARS.check1(~isRecPtr(caseExpr), parser, 53);
  2800.                 PARS.Next(parser)
  2801.             ELSE
  2802.                 exit := TRUE
  2803.             END
  2804.         UNTIL exit
  2805.  
  2806.         RETURN res
  2807.     END CaseLabelList;
  2808.  
  2809.  
  2810.     PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER);
  2811.     VAR
  2812.         sym:      INTEGER;
  2813.         t:        PROG.TYPE_;
  2814.         variant:  INTEGER;
  2815.         node:     AVL.NODE;
  2816.         last:     CODE.COMMAND;
  2817.  
  2818.     BEGIN
  2819.         sym := parser.sym;
  2820.         IF sym # SCAN.lxBAR THEN
  2821.             variant := CODE.NewLabel();
  2822.             node := CaseLabelList(parser, caseExpr, tree, variant);
  2823.             PARS.checklex(parser, SCAN.lxCOLON);
  2824.             PARS.Next(parser);
  2825.             IF isRecPtr(caseExpr) THEN
  2826.                 t := caseExpr.type;
  2827.                 caseExpr.ident.type := node.data(CASE_LABEL).type
  2828.             END;
  2829.  
  2830.             last := CODE.getlast();
  2831.             CODE.SetLabel(variant);
  2832.  
  2833.             IF ~isRecPtr(caseExpr) THEN
  2834.                 LISTS.push(CaseVariants, NewVariant(variant, last))
  2835.             END;
  2836.  
  2837.             parser.StatSeq(parser);
  2838.             CODE.AddJmpCmd(CODE.opJMP, end);
  2839.  
  2840.             IF isRecPtr(caseExpr) THEN
  2841.                 caseExpr.ident.type := t
  2842.             END
  2843.         END
  2844.     END case;
  2845.  
  2846.  
  2847.     PROCEDURE Table (node: AVL.NODE; else: INTEGER);
  2848.     VAR
  2849.         L, R: INTEGER;
  2850.         range: RANGE;
  2851.         left, right: AVL.NODE;
  2852.         last: CODE.COMMAND;
  2853.         v: CASE_VARIANT;
  2854.  
  2855.     BEGIN
  2856.         IF node # NIL THEN
  2857.  
  2858.             range := node.data(CASE_LABEL).range;
  2859.  
  2860.             left := node.left;
  2861.             IF left # NIL THEN
  2862.                 L := left.data(CASE_LABEL).self
  2863.             ELSE
  2864.                 L := else
  2865.             END;
  2866.  
  2867.             right := node.right;
  2868.             IF right # NIL THEN
  2869.                 R := right.data(CASE_LABEL).self
  2870.             ELSE
  2871.                 R := else
  2872.             END;
  2873.  
  2874.             last := CODE.getlast();
  2875.  
  2876.             v := CaseVariants.last(CASE_VARIANT);
  2877.             WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
  2878.                 v := v.prev(CASE_VARIANT)
  2879.             END;
  2880.  
  2881.             ASSERT((v # NIL) & (v.label # 0));
  2882.             CODE.setlast(v.cmd);
  2883.  
  2884.             CODE.SetLabel(node.data(CASE_LABEL).self);
  2885.             CODE.case(range.a, range.b, L, R);
  2886.             IF v.processed THEN
  2887.                 CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant)
  2888.             END;
  2889.             v.processed := TRUE;
  2890.  
  2891.             CODE.setlast(last);
  2892.  
  2893.             Table(left, else);
  2894.             Table(right, else)
  2895.         END
  2896.     END Table;
  2897.  
  2898.  
  2899.     PROCEDURE TableT (node: AVL.NODE);
  2900.     BEGIN
  2901.         IF node # NIL THEN
  2902.             CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
  2903.  
  2904.             TableT(node.left);
  2905.             TableT(node.right)
  2906.         END
  2907.     END TableT;
  2908.  
  2909.  
  2910.     PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: SCAN.POSITION);
  2911.     VAR
  2912.         table, end, else: INTEGER;
  2913.         tree: AVL.NODE;
  2914.         item:  LISTS.ITEM;
  2915.  
  2916.     BEGIN
  2917.         LISTS.push(CaseVariants, NewVariant(0, NIL));
  2918.         end   := CODE.NewLabel();
  2919.         else  := CODE.NewLabel();
  2920.         table := CODE.NewLabel();
  2921.         CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e)));
  2922.         CODE.AddJmpCmd(CODE.opJMP, table);
  2923.  
  2924.         tree := NIL;
  2925.  
  2926.         case(parser, e, tree, end);
  2927.         WHILE parser.sym = SCAN.lxBAR DO
  2928.             PARS.Next(parser);
  2929.             case(parser, e, tree, end)
  2930.         END;
  2931.  
  2932.         CODE.SetLabel(else);
  2933.         IF parser.sym = SCAN.lxELSE THEN
  2934.             PARS.Next(parser);
  2935.             parser.StatSeq(parser);
  2936.             CODE.AddJmpCmd(CODE.opJMP, end)
  2937.         ELSE
  2938.             CODE.OnError(pos.line, errCASE)
  2939.         END;
  2940.  
  2941.         PARS.checklex(parser, SCAN.lxEND);
  2942.         PARS.Next(parser);
  2943.  
  2944.         IF isRecPtr(e) THEN
  2945.             CODE.SetLabel(table);
  2946.             TableT(tree);
  2947.             CODE.AddJmpCmd(CODE.opJMP, else)
  2948.         ELSE
  2949.             tree.data(CASE_LABEL).self := table;
  2950.             Table(tree, else)
  2951.         END;
  2952.  
  2953.         AVL.destroy(tree, DestroyLabel);
  2954.         CODE.SetLabel(end);
  2955.         CODE.AddCmd0(CODE.opENDSW);
  2956.  
  2957.         REPEAT
  2958.             item := LISTS.pop(CaseVariants);
  2959.             C.push(CaseVar, item)
  2960.         UNTIL item(CASE_VARIANT).cmd = NIL
  2961.  
  2962.     END ParseCase;
  2963.  
  2964.  
  2965. BEGIN
  2966.     NextPos(parser, pos);
  2967.     expression(parser, e);
  2968.     PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), parser, pos, 95);
  2969.     IF isRecPtr(e) THEN
  2970.         PARS.check(isVar(e), parser, pos, 93);
  2971.         PARS.check(e.ident # NIL, parser, pos, 106)
  2972.     END;
  2973.     IF isRec(e) THEN
  2974.         PARS.check(e.obj = eVREC, parser, pos, 78)
  2975.     END;
  2976.  
  2977.     IF e.obj = eCONST THEN
  2978.         LoadConst(e)
  2979.     ELSIF isRec(e) THEN
  2980.         CODE.drop;
  2981.         CODE.AddCmd(CODE.opLADR, e.ident.offset - 1);
  2982.         CODE.load(PARS.program.target.word)
  2983.     ELSIF isPtr(e) THEN
  2984.         deref(pos, e, FALSE, errPTR);
  2985.         CODE.AddCmd(CODE.opSUBR, PARS.program.target.word);
  2986.         CODE.load(PARS.program.target.word)
  2987.     END;
  2988.  
  2989.     PARS.checklex(parser, SCAN.lxOF);
  2990.     PARS.Next(parser);
  2991.     ParseCase(parser, e, pos)
  2992. END CaseStatement;
  2993.  
  2994.  
  2995. PROCEDURE ForStatement (parser: PARS.PARSER);
  2996. VAR
  2997.     e:       PARS.EXPR;
  2998.     pos:     SCAN.POSITION;
  2999.     step:    ARITH.VALUE;
  3000.     st:      INTEGER;
  3001.     ident:   PROG.IDENT;
  3002.     offset:  INTEGER;
  3003.     L1, L2:  INTEGER;
  3004.  
  3005. BEGIN
  3006.     CODE.AddCmd0(CODE.opLOOP);
  3007.  
  3008.     L1 := CODE.NewLabel();
  3009.     L2 := CODE.NewLabel();
  3010.  
  3011.     PARS.ExpectSym(parser, SCAN.lxIDENT);
  3012.     ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE);
  3013.     PARS.check1(ident # NIL, parser, 48);
  3014.     PARS.check1(ident.typ = PROG.idVAR, parser, 93);
  3015.     PARS.check1(ident.type.typ = PROG.tINTEGER, parser, 97);
  3016.     PARS.ExpectSym(parser, SCAN.lxASSIGN);
  3017.     NextPos(parser, pos);
  3018.     expression(parser, e);
  3019.     PARS.check(isInt(e), parser, pos, 76);
  3020.  
  3021.     offset := PROG.getOffset(PARS.program, ident);
  3022.  
  3023.     IF ident.global THEN
  3024.         CODE.AddCmd(CODE.opGADR, offset)
  3025.     ELSE
  3026.         CODE.AddCmd(CODE.opLADR, -offset)
  3027.     END;
  3028.  
  3029.     IF e.obj = eCONST THEN
  3030.         CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
  3031.     ELSE
  3032.         CODE.AddCmd0(CODE.opSAVE)
  3033.     END;
  3034.  
  3035.     CODE.SetLabel(L1);
  3036.  
  3037.     IF ident.global THEN
  3038.         CODE.AddCmd(CODE.opGADR, offset)
  3039.     ELSE
  3040.         CODE.AddCmd(CODE.opLADR, -offset)
  3041.     END;
  3042.     CODE.load(ident.type.size);
  3043.  
  3044.     PARS.checklex(parser, SCAN.lxTO);
  3045.     NextPos(parser, pos);
  3046.     expression(parser, e);
  3047.     PARS.check(isInt(e), parser, pos, 76);
  3048.  
  3049.     IF parser.sym = SCAN.lxBY THEN
  3050.         NextPos(parser, pos);
  3051.         PARS.ConstExpression(parser, step);
  3052.         PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76);
  3053.         st := ARITH.getInt(step);
  3054.         PARS.check(st # 0, parser, pos, 98)
  3055.     ELSE
  3056.         st := 1
  3057.     END;
  3058.  
  3059.     IF e.obj = eCONST THEN
  3060.         IF st > 0 THEN
  3061.             CODE.AddCmd(CODE.opLER, ARITH.Int(e.value))
  3062.         ELSE
  3063.             CODE.AddCmd(CODE.opGER, ARITH.Int(e.value))
  3064.         END
  3065.     ELSE
  3066.         IF st > 0 THEN
  3067.             CODE.AddCmd0(CODE.opLE)
  3068.         ELSE
  3069.             CODE.AddCmd0(CODE.opGE)
  3070.         END
  3071.     END;
  3072.  
  3073.     CODE.AddJmpCmd(CODE.opJNE, L2);
  3074.  
  3075.     PARS.checklex(parser, SCAN.lxDO);
  3076.     PARS.Next(parser);
  3077.     parser.StatSeq(parser);
  3078.  
  3079.     IF ident.global THEN
  3080.         CODE.AddCmd(CODE.opGADR, offset)
  3081.     ELSE
  3082.         CODE.AddCmd(CODE.opLADR, -offset)
  3083.     END;
  3084.  
  3085.     IF st = 1 THEN
  3086.         CODE.AddCmd0(CODE.opINC1)
  3087.     ELSIF st = -1 THEN
  3088.         CODE.AddCmd0(CODE.opDEC1)
  3089.     ELSE
  3090.         IF st > 0 THEN
  3091.             CODE.AddCmd(CODE.opINCC, st)
  3092.         ELSE
  3093.             CODE.AddCmd(CODE.opDECC, -st)
  3094.         END
  3095.     END;
  3096.  
  3097.     CODE.AddJmpCmd(CODE.opJMP, L1);
  3098.  
  3099.     PARS.checklex(parser, SCAN.lxEND);
  3100.     PARS.Next(parser);
  3101.  
  3102.     CODE.SetLabel(L2);
  3103.  
  3104.     CODE.AddCmd0(CODE.opENDLOOP)
  3105.  
  3106. END ForStatement;
  3107.  
  3108.  
  3109. PROCEDURE statement (parser: PARS.PARSER);
  3110. VAR
  3111.     sym: INTEGER;
  3112.  
  3113. BEGIN
  3114.     sym := parser.sym;
  3115.  
  3116.     IF sym = SCAN.lxIDENT THEN
  3117.         ElementaryStatement(parser)
  3118.     ELSIF sym = SCAN.lxIF THEN
  3119.         IfStatement(parser, TRUE)
  3120.     ELSIF sym = SCAN.lxWHILE THEN
  3121.         IfStatement(parser, FALSE)
  3122.     ELSIF sym = SCAN.lxREPEAT THEN
  3123.         RepeatStatement(parser)
  3124.     ELSIF sym = SCAN.lxCASE THEN
  3125.         CaseStatement(parser)
  3126.     ELSIF sym = SCAN.lxFOR THEN
  3127.         ForStatement(parser)
  3128.     END
  3129. END statement;
  3130.  
  3131.  
  3132. PROCEDURE StatSeq (parser: PARS.PARSER);
  3133. BEGIN
  3134.     statement(parser);
  3135.     WHILE parser.sym = SCAN.lxSEMI DO
  3136.         PARS.Next(parser);
  3137.         statement(parser)
  3138.     END
  3139. END StatSeq;
  3140.  
  3141.  
  3142. PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
  3143. VAR
  3144.     res: BOOLEAN;
  3145.  
  3146. BEGIN
  3147.     res := assigncomp(e, t);
  3148.     IF res THEN
  3149.         IF e.obj = eCONST THEN
  3150.             IF e.type.typ = PROG.tREAL THEN
  3151.                 CODE.Float(ARITH.Float(e.value))
  3152.             ELSIF e.type.typ = PROG.tNIL THEN
  3153.                 CODE.AddCmd(CODE.opCONST, 0)
  3154.             ELSE
  3155.                 LoadConst(e)
  3156.             END
  3157.         ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN checking) THEN
  3158.             CheckRange(256, pos.line, errBYTE)
  3159.         ELSIF e.obj = ePROC THEN
  3160.             PARS.check(e.ident.global, parser, pos, 85);
  3161.             CODE.PushProc(e.ident.proc.label)
  3162.         ELSIF e.obj = eIMP THEN
  3163.             CODE.PushImpProc(e.ident.import)
  3164.         END;
  3165.  
  3166.         IF e.type.typ = PROG.tREAL THEN
  3167.             CODE.retf
  3168.         END
  3169.     END
  3170.  
  3171.     RETURN res
  3172. END chkreturn;
  3173.  
  3174.  
  3175. PROCEDURE setrtl;
  3176. VAR
  3177.     rtl: PROG.UNIT;
  3178.  
  3179.  
  3180.     PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
  3181.     VAR
  3182.         id:    PROG.IDENT;
  3183.  
  3184.     BEGIN
  3185.         id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE);
  3186.  
  3187.         IF (id # NIL) & (id.import # NIL) THEN
  3188.             CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label;
  3189.             id.proc.used := TRUE
  3190.         ELSIF (id # NIL) & (id.proc # NIL) THEN
  3191.             CODE.codes.rtl[idx] := id.proc.label;
  3192.             id.proc.used := TRUE
  3193.         ELSE
  3194.             ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found")
  3195.         END
  3196.     END getproc;
  3197.  
  3198.  
  3199. BEGIN
  3200.     rtl := PARS.program.rtl;
  3201.     ASSERT(rtl # NIL);
  3202.  
  3203.     getproc(rtl,  "_move",      CODE._move);
  3204.     getproc(rtl,  "_move2",     CODE._move2);
  3205.     getproc(rtl,  "_set",       CODE._set);
  3206.     getproc(rtl,  "_set2",      CODE._set2);
  3207.     getproc(rtl,  "_div",       CODE._div);
  3208.     getproc(rtl,  "_mod",       CODE._mod);
  3209.     getproc(rtl,  "_div2",      CODE._div2);
  3210.     getproc(rtl,  "_mod2",      CODE._mod2);
  3211.     getproc(rtl,  "_arrcpy",    CODE._arrcpy);
  3212.     getproc(rtl,  "_rot",       CODE._rot);
  3213.     getproc(rtl,  "_new",       CODE._new);
  3214.     getproc(rtl,  "_dispose",   CODE._dispose);
  3215.     getproc(rtl,  "_strcmp",    CODE._strcmp);
  3216.     getproc(rtl,  "_error",     CODE._error);
  3217.     getproc(rtl,  "_is",        CODE._is);
  3218.     getproc(rtl,  "_isrec",     CODE._isrec);
  3219.     getproc(rtl,  "_guard",     CODE._guard);
  3220.     getproc(rtl,  "_guardrec",  CODE._guardrec);
  3221.     getproc(rtl,  "_length",    CODE._length);
  3222.     getproc(rtl,  "_init",      CODE._init);
  3223.     getproc(rtl,  "_dllentry",  CODE._dllentry);
  3224.     getproc(rtl,  "_strcpy",    CODE._strcpy);
  3225.     getproc(rtl,  "_exit",      CODE._exit);
  3226.     getproc(rtl,  "_strcpy2",   CODE._strcpy2);
  3227.     getproc(rtl,  "_lengthw",   CODE._lengthw);
  3228.     getproc(rtl,  "_strcmp2",   CODE._strcmp2);
  3229.     getproc(rtl,  "_strcmpw",   CODE._strcmpw);
  3230.     getproc(rtl,  "_strcmpw2",  CODE._strcmpw2);
  3231.  
  3232. END setrtl;
  3233.  
  3234.  
  3235. PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET);
  3236. VAR
  3237.     parser:  PARS.PARSER;
  3238.     ext: PARS.PATH;
  3239.     amd64: BOOLEAN;
  3240.  
  3241. BEGIN
  3242.     amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
  3243.     ext := mConst.FILE_EXT;
  3244.     CaseLabels := C.create();
  3245.     CaseVar := C.create();
  3246.  
  3247.     CaseVariants := LISTS.create(NIL);
  3248.     LISTS.push(CaseVariants, NewVariant(0, NIL));
  3249.  
  3250.     checking := chk;
  3251.  
  3252.     IF amd64 THEN
  3253.         CODE.init(6, CODE.little_endian)
  3254.     ELSE
  3255.         CODE.init(8, CODE.little_endian)
  3256.     END;
  3257.  
  3258.     parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
  3259.     IF parser.open(parser, mConst.RTL_NAME) THEN
  3260.         parser.parse(parser);
  3261.         PARS.destroy(parser)
  3262.     ELSE
  3263.         PARS.destroy(parser);
  3264.         parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
  3265.         IF parser.open(parser, mConst.RTL_NAME) THEN
  3266.             parser.parse(parser);
  3267.             PARS.destroy(parser)
  3268.         ELSE
  3269.             ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found")
  3270.         END
  3271.     END;
  3272.  
  3273.     parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
  3274.     parser.main := TRUE;
  3275.  
  3276.     IF parser.open(parser, modname) THEN
  3277.         parser.parse(parser)
  3278.     ELSE
  3279.         ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found")
  3280.     END;
  3281.  
  3282.     PARS.destroy(parser);
  3283.  
  3284.     IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN
  3285.         ERRORS.error1("size of global variables is too large")
  3286.     END;
  3287.  
  3288.     setrtl;
  3289.  
  3290.     PROG.DelUnused(PARS.program, CODE.DelImport);
  3291.  
  3292.     CODE.codes.bss := PARS.program.bss;
  3293.     IF amd64 THEN
  3294.         AMD64.CodeGen(CODE.codes, outname, target, stack, base)
  3295.     ELSE
  3296.         X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic)
  3297.     END
  3298. END compile;
  3299.  
  3300.  
  3301. END STATEMENTS.