Subversion Repositories Kolibri OS

Rev

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.AddJmpCmd(CODE.opJZ, label);
  1865.                     CODE.drop
  1866.                 END
  1867.             END;
  1868.  
  1869.             factor(parser, e1);
  1870.  
  1871.             CASE op OF
  1872.             |SCAN.lxMUL:
  1873.                 PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
  1874.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1875.  
  1876.                    CASE e.value.typ OF
  1877.                    |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"),   parser, pos, 39)
  1878.                    |ARITH.tREAL:    PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40)
  1879.                    |ARITH.tSET:     ARITH.opSet(e.value, e1.value, "*")
  1880.                    END
  1881.  
  1882.                 ELSE
  1883.                     IF isInt(e) THEN
  1884.                         IF e.obj = eCONST THEN
  1885.                             CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value))
  1886.                         ELSIF e1.obj = eCONST THEN
  1887.                             CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value))
  1888.                         ELSE
  1889.                             CODE.AddCmd0(CODE.opMUL)
  1890.                         END
  1891.                     ELSIF isReal(e) THEN
  1892.                         IF e.obj = eCONST THEN
  1893.                             CODE.Float(ARITH.Float(e.value))
  1894.                         ELSIF e1.obj = eCONST THEN
  1895.                             CODE.Float(ARITH.Float(e1.value))
  1896.                         END;
  1897.                         CODE.fbinop(CODE.opMULF)
  1898.                     ELSIF isSet(e) THEN
  1899.                         IF e.obj = eCONST THEN
  1900.                             CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value))
  1901.                         ELSIF e1.obj = eCONST THEN
  1902.                             CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value))
  1903.                         ELSE
  1904.                             CODE.AddCmd0(CODE.opMULS)
  1905.                         END
  1906.                     END;
  1907.                     e.obj := eEXPR
  1908.                 END
  1909.  
  1910.             |SCAN.lxSLASH:
  1911.                 PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
  1912.                 IF (e1.obj = eCONST) & isReal(e1) THEN
  1913.                     PARS.check(~ARITH.isZero(e1.value), parser, pos, 45)
  1914.                 END;
  1915.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1916.  
  1917.                     CASE e.value.typ OF
  1918.                     |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), parser, pos, 40)
  1919.                     |ARITH.tSET:  ARITH.opSet(e.value, e1.value, "/")
  1920.                     END
  1921.  
  1922.                 ELSE
  1923.                     IF isReal(e) THEN
  1924.                         IF e.obj = eCONST THEN
  1925.                             CODE.Float(ARITH.Float(e.value));
  1926.                             CODE.fbinop(CODE.opDIVFI)
  1927.                         ELSIF e1.obj = eCONST THEN
  1928.                             CODE.Float(ARITH.Float(e1.value));
  1929.                             CODE.fbinop(CODE.opDIVF)
  1930.                         ELSE
  1931.                             CODE.fbinop(CODE.opDIVF)
  1932.                         END
  1933.                     ELSIF isSet(e) THEN
  1934.                         IF e.obj = eCONST THEN
  1935.                             CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value))
  1936.                         ELSIF e1.obj = eCONST THEN
  1937.                             CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value))
  1938.                         ELSE
  1939.                             CODE.AddCmd0(CODE.opDIVS)
  1940.                         END
  1941.                     END;
  1942.                     e.obj := eEXPR
  1943.                 END
  1944.  
  1945.             |SCAN.lxDIV, SCAN.lxMOD:
  1946.                 PARS.check(isInt(e) & isInt(e1), parser, pos, 37);
  1947.                 IF e1.obj = eCONST THEN
  1948.                     PARS.check(~ARITH.isZero(e1.value), parser, pos, 46)
  1949.                 END;
  1950.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1951.  
  1952.                     IF op = SCAN.lxDIV THEN
  1953.                         PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39)
  1954.                     ELSE
  1955.                         ASSERT(ARITH.opInt(e.value, e1.value, "M"))
  1956.                     END
  1957.  
  1958.                 ELSE
  1959.                     IF e1.obj # eCONST THEN
  1960.                         label1 := CODE.NewLabel();
  1961.                         CODE.AddJmpCmd(CODE.opJNZ, label1)
  1962.                     END;
  1963.                     IF e.obj = eCONST THEN
  1964.                         CODE.OnError(pos.line, errDIV);
  1965.                         CODE.SetLabel(label1);
  1966.                         CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
  1967.                     ELSIF e1.obj = eCONST THEN
  1968.                         CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
  1969.                     ELSE
  1970.                         CODE.OnError(pos.line, errDIV);
  1971.                         CODE.SetLabel(label1);
  1972.                         CODE.AddCmd0(CODE.opDIV  + ORD(op = SCAN.lxMOD))
  1973.                     END;
  1974.                     e.obj := eEXPR
  1975.                 END
  1976.  
  1977.             |SCAN.lxAND:
  1978.                 PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
  1979.  
  1980.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1981.                     ARITH.opBoolean(e.value, e1.value, "&")
  1982.                 ELSE
  1983.                     e.obj := eEXPR;
  1984.                     IF e1.obj = eCONST THEN
  1985.                         CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
  1986.                     END
  1987.                 END
  1988.  
  1989.             END
  1990.         END;
  1991.  
  1992.         IF label # -1 THEN
  1993.             CODE.SetLabel(label)
  1994.         END
  1995.     END term;
  1996.  
  1997.  
  1998.     PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1999.     VAR
  2000.         pos: SCAN.POSITION;
  2001.         op:  INTEGER;
  2002.         e1:  PARS.EXPR;
  2003.  
  2004.         plus, minus: BOOLEAN;
  2005.  
  2006.         label: INTEGER;
  2007.  
  2008.     BEGIN
  2009.         plus  := parser.sym = SCAN.lxPLUS;
  2010.         minus := parser.sym = SCAN.lxMINUS;
  2011.  
  2012.         IF plus OR minus THEN
  2013.             getpos(parser, pos);
  2014.             PARS.Next(parser)
  2015.         END;
  2016.  
  2017.         term(parser, e);
  2018.  
  2019.         IF plus OR minus THEN
  2020.             PARS.check(isInt(e) OR isReal(e) OR isSet(e), parser, pos, 36);
  2021.  
  2022.             IF minus & (e.obj = eCONST) THEN
  2023.                 PARS.check(ARITH.neg(e.value), parser, pos, 39)
  2024.             END;
  2025.  
  2026.             IF e.obj # eCONST THEN
  2027.                 IF minus THEN
  2028.                     IF isInt(e) THEN
  2029.                         CODE.AddCmd0(CODE.opUMINUS)
  2030.                     ELSIF isReal(e) THEN
  2031.                         CODE.AddCmd0(CODE.opUMINF)
  2032.                     ELSIF isSet(e) THEN
  2033.                         CODE.AddCmd0(CODE.opUMINS)
  2034.                     END
  2035.                 END;
  2036.                 e.obj := eEXPR
  2037.             END
  2038.         END;
  2039.  
  2040.         label := -1;
  2041.  
  2042.         WHILE AddOperator(parser.sym) DO
  2043.  
  2044.             op  := parser.sym;
  2045.             getpos(parser, pos);
  2046.             PARS.Next(parser);
  2047.  
  2048.             IF op = SCAN.lxOR THEN
  2049.  
  2050.                 IF ~parser.constexp THEN
  2051.  
  2052.                     IF label = -1 THEN
  2053.                         label := CODE.NewLabel()
  2054.                     END;
  2055.  
  2056.                     IF e.obj = eCONST THEN
  2057.                         CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
  2058.                     END;
  2059.                     CODE.AddJmpCmd(CODE.opJNZ, label);
  2060.                     CODE.drop
  2061.                 END
  2062.  
  2063.             END;
  2064.  
  2065.             term(parser, e1);
  2066.  
  2067.             CASE op OF
  2068.             |SCAN.lxPLUS, SCAN.lxMINUS:
  2069.  
  2070.                 IF op = SCAN.lxPLUS THEN
  2071.                     op := ORD("+")
  2072.                 ELSE
  2073.                     op := ORD("-")
  2074.                 END;
  2075.  
  2076.                 PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
  2077.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  2078.  
  2079.                    CASE e.value.typ OF
  2080.                    |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)),   parser, pos, 39)
  2081.                    |ARITH.tREAL:    PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40)
  2082.                    |ARITH.tSET:     ARITH.opSet(e.value, e1.value, CHR(op))
  2083.                    END
  2084.  
  2085.                 ELSE
  2086.                     IF isInt(e) THEN
  2087.                         IF e.obj = eCONST THEN
  2088.                             CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
  2089.                         ELSIF e1.obj = eCONST THEN
  2090.                             CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
  2091.                         ELSE
  2092.                             CODE.AddCmd0(CODE.opADD  + ORD(op = ORD("-")))
  2093.                         END
  2094.                     ELSIF isReal(e) THEN
  2095.                         IF e.obj = eCONST THEN
  2096.                             CODE.Float(ARITH.Float(e.value));
  2097.                             CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-")))
  2098.                         ELSIF e1.obj = eCONST THEN
  2099.                             CODE.Float(ARITH.Float(e1.value));
  2100.                             CODE.fbinop(CODE.opADDF  + ORD(op = ORD("-")))
  2101.                         ELSE
  2102.                             CODE.fbinop(CODE.opADDF  + ORD(op = ORD("-")))
  2103.                         END
  2104.                     ELSIF isSet(e) THEN
  2105.                         IF e.obj = eCONST THEN
  2106.                             CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
  2107.                         ELSIF e1.obj = eCONST THEN
  2108.                             CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
  2109.                         ELSE
  2110.                             CODE.AddCmd0(CODE.opADDS  + ORD(op = ORD("-")))
  2111.                         END
  2112.                     END;
  2113.                     e.obj := eEXPR
  2114.                 END
  2115.  
  2116.             |SCAN.lxOR:
  2117.                 PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
  2118.  
  2119.                 IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  2120.                     ARITH.opBoolean(e.value, e1.value, "|")
  2121.                 ELSE
  2122.                     e.obj := eEXPR;
  2123.                     IF e1.obj = eCONST THEN
  2124.                         CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
  2125.                     END
  2126.                 END
  2127.  
  2128.             END
  2129.         END;
  2130.  
  2131.         IF label # -1 THEN
  2132.             CODE.SetLabel(label)
  2133.         END
  2134.  
  2135.     END SimpleExpression;
  2136.  
  2137.  
  2138.     PROCEDURE cmpcode (op: INTEGER): INTEGER;
  2139.     VAR
  2140.         res: INTEGER;
  2141.     BEGIN
  2142.         CASE op OF
  2143.         |SCAN.lxEQ: res := 0
  2144.         |SCAN.lxNE: res := 1
  2145.         |SCAN.lxLT: res := 2
  2146.         |SCAN.lxLE: res := 3
  2147.         |SCAN.lxGT: res := 4
  2148.         |SCAN.lxGE: res := 5
  2149.         END
  2150.  
  2151.         RETURN res
  2152.     END cmpcode;
  2153.  
  2154.  
  2155.     PROCEDURE BoolCmp (eq, val: BOOLEAN);
  2156.     BEGIN
  2157.        IF eq = val THEN
  2158.            CODE.AddCmd0(CODE.opNER)
  2159.        ELSE
  2160.            CODE.AddCmd0(CODE.opEQR)
  2161.        END
  2162.     END BoolCmp;
  2163.  
  2164.  
  2165.     PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
  2166.     VAR
  2167.         res: BOOLEAN;
  2168.  
  2169.     BEGIN
  2170.  
  2171.         res := TRUE;
  2172.  
  2173.         IF isString(e) & isCharArray(e1) THEN
  2174.             CODE.AddCmd(CODE.opSADR, String(e));
  2175.             CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
  2176.             CODE.AddCmd0(CODE.opEQS2 + cmpcode(op))
  2177.  
  2178.         ELSIF isString(e) & isCharArrayW(e1) THEN
  2179.             CODE.AddCmd(CODE.opSADR, StringW(e));
  2180.             CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
  2181.             CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
  2182.  
  2183.         ELSIF isStringW(e) & isCharArrayW(e1) THEN
  2184.             CODE.AddCmd(CODE.opSADR, StringW(e));
  2185.             CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
  2186.             CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
  2187.  
  2188.         ELSIF isCharArray(e) & isString(e1) THEN
  2189.             CODE.AddCmd(CODE.opSADR, String(e1));
  2190.             CODE.AddCmd(CODE.opCONST, strlen(e1) + 1);
  2191.             CODE.AddCmd0(CODE.opEQS + cmpcode(op))
  2192.  
  2193.         ELSIF isCharArrayW(e) & isString(e1) THEN
  2194.             CODE.AddCmd(CODE.opSADR, StringW(e1));
  2195.             CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
  2196.             CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
  2197.  
  2198.         ELSIF isCharArrayW(e) & isStringW(e1) THEN
  2199.             CODE.AddCmd(CODE.opSADR, StringW(e1));
  2200.             CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
  2201.             CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
  2202.  
  2203.         ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
  2204.             CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
  2205.  
  2206.         ELSIF isCharArray(e) & isCharArray(e1) THEN
  2207.             CODE.AddCmd0(CODE.opEQS + cmpcode(op))
  2208.  
  2209.         ELSIF isString(e) & isString(e1) THEN
  2210.             PARS.strcmp(e.value, e1.value, op)
  2211.  
  2212.         ELSE
  2213.             res := FALSE
  2214.  
  2215.         END
  2216.  
  2217.         RETURN res
  2218.     END strcmp;
  2219.  
  2220.  
  2221. BEGIN
  2222.     getpos(parser, pos0);
  2223.     SimpleExpression(parser, e);
  2224.     IF relation(parser.sym) THEN
  2225.         IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN
  2226.             CODE.AddCmd(CODE.opCONST, e.type.length)
  2227.         END;
  2228.         op  := parser.sym;
  2229.         getpos(parser, pos);
  2230.         PARS.Next(parser);
  2231.  
  2232.         pos1 := parser.lex.pos;
  2233.         SimpleExpression(parser, e1);
  2234.  
  2235.         IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
  2236.             CODE.AddCmd(CODE.opCONST, e1.type.length)
  2237.         END;
  2238.  
  2239.         constant := (e.obj = eCONST) & (e1.obj = eCONST);
  2240.  
  2241.         CASE op OF
  2242.         |SCAN.lxEQ: operator := "="
  2243.         |SCAN.lxNE: operator := "#"
  2244.         |SCAN.lxLT: operator := "<"
  2245.         |SCAN.lxLE: operator := "<="
  2246.         |SCAN.lxGT: operator := ">"
  2247.         |SCAN.lxGE: operator := ">="
  2248.         |SCAN.lxIN: operator := "IN"
  2249.         |SCAN.lxIS: operator := ""
  2250.         END;
  2251.  
  2252.         error := 0;
  2253.  
  2254.         CASE op OF
  2255.         |SCAN.lxEQ, SCAN.lxNE:
  2256.  
  2257.             IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
  2258.             isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
  2259.             isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
  2260.             isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
  2261.             isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN
  2262.                 IF constant THEN
  2263.                     ARITH.relation(e.value, e1.value, operator, error)
  2264.                 ELSE
  2265.                     IF e.obj = eCONST THEN
  2266.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6,  ARITH.Int(e.value))
  2267.                     ELSIF e1.obj = eCONST THEN
  2268.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
  2269.                     ELSE
  2270.                         CODE.AddCmd0(CODE.opEQ + cmpcode(op))
  2271.                     END
  2272.                 END
  2273.  
  2274.             ELSIF isStringW1(e) & isCharW(e1) THEN
  2275.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
  2276.  
  2277.             ELSIF isStringW1(e1) & isCharW(e) THEN
  2278.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
  2279.  
  2280.             ELSIF isBoolean(e) & isBoolean(e1) THEN
  2281.                 IF constant THEN
  2282.                     ARITH.relation(e.value, e1.value, operator, error)
  2283.                 ELSE
  2284.                     IF e.obj = eCONST THEN
  2285.                         BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0)
  2286.                     ELSIF e1.obj = eCONST THEN
  2287.                         BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
  2288.                     ELSE
  2289.                         IF op = SCAN.lxEQ THEN
  2290.                             CODE.AddCmd0(CODE.opEQB)
  2291.                         ELSE
  2292.                             CODE.AddCmd0(CODE.opNEB)
  2293.                         END
  2294.                     END
  2295.                 END
  2296.  
  2297.             ELSIF isReal(e) & isReal(e1) THEN
  2298.                 IF constant THEN
  2299.                     ARITH.relation(e.value, e1.value, operator, error)
  2300.                 ELSE
  2301.                     IF e.obj = eCONST THEN
  2302.                         CODE.Float(ARITH.Float(e.value));
  2303.                         CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
  2304.                     ELSIF e1.obj = eCONST THEN
  2305.                         CODE.Float(ARITH.Float(e1.value));
  2306.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2307.                     ELSE
  2308.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2309.                     END
  2310.                 END
  2311.  
  2312.             ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
  2313.                 IF ~strcmp(e, e1, op) THEN
  2314.                     PARS.error(parser, pos, 37)
  2315.                 END
  2316.  
  2317.             ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
  2318.                 CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
  2319.  
  2320.             ELSIF isProc(e) & isNil(e1) THEN
  2321.                 IF e.obj IN {ePROC, eIMP} THEN
  2322.                     PARS.check(e.ident.global, parser, pos0, 85);
  2323.                     constant := TRUE;
  2324.                     e.obj := eCONST;
  2325.                     ARITH.setbool(e.value, op = SCAN.lxNE)
  2326.                 ELSE
  2327.                     CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
  2328.                 END
  2329.  
  2330.             ELSIF isNil(e) & isProc(e1) THEN
  2331.                 IF e1.obj IN {ePROC, eIMP} THEN
  2332.                     PARS.check(e1.ident.global, parser, pos1, 85);
  2333.                     constant := TRUE;
  2334.                     e.obj := eCONST;
  2335.                     ARITH.setbool(e.value, op = SCAN.lxNE)
  2336.                 ELSE
  2337.                     CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
  2338.                 END
  2339.  
  2340.             ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
  2341.                 IF e.obj = ePROC THEN
  2342.                     PARS.check(e.ident.global, parser, pos0, 85)
  2343.                 END;
  2344.                 IF e1.obj = ePROC THEN
  2345.                     PARS.check(e1.ident.global, parser, pos1, 85)
  2346.                 END;
  2347.                 IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
  2348.                     constant := TRUE;
  2349.                     e.obj := eCONST;
  2350.                     IF op = SCAN.lxEQ THEN
  2351.                         ARITH.setbool(e.value, e.ident = e1.ident)
  2352.                     ELSE
  2353.                         ARITH.setbool(e.value, e.ident # e1.ident)
  2354.                     END
  2355.                 ELSIF e.obj = ePROC THEN
  2356.                     CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0)
  2357.                 ELSIF e1.obj = ePROC THEN
  2358.                     CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0)
  2359.                 ELSIF e.obj = eIMP THEN
  2360.                     CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0)
  2361.                 ELSIF e1.obj = eIMP THEN
  2362.                     CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0)
  2363.                 ELSE
  2364.                     CODE.AddCmd0(CODE.opEQ + cmpcode(op))
  2365.                 END
  2366.  
  2367.             ELSIF isNil(e) & isNil(e1) THEN
  2368.                 constant := TRUE;
  2369.                 e.obj := eCONST;
  2370.                 ARITH.setbool(e.value, op = SCAN.lxEQ)
  2371.  
  2372.             ELSE
  2373.                 PARS.error(parser, pos, 37)
  2374.             END
  2375.  
  2376.         |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
  2377.             IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
  2378.                 isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
  2379.                 isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
  2380.                 isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
  2381.  
  2382.                 IF constant THEN
  2383.                     ARITH.relation(e.value, e1.value, operator, error)
  2384.                 ELSE
  2385.                     IF e.obj = eCONST THEN
  2386.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value))
  2387.                     ELSIF e1.obj = eCONST THEN
  2388.                         CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
  2389.                     ELSE
  2390.                         CODE.AddCmd0(CODE.opEQ + cmpcode(op))
  2391.                     END
  2392.                 END
  2393.  
  2394.             ELSIF isStringW1(e) & isCharW(e1) THEN
  2395.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
  2396.  
  2397.             ELSIF isStringW1(e1) & isCharW(e) THEN
  2398.                 CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
  2399.  
  2400.             ELSIF isReal(e) & isReal(e1) THEN
  2401.                 IF constant THEN
  2402.                     ARITH.relation(e.value, e1.value, operator, error)
  2403.                 ELSE
  2404.                     IF e.obj = eCONST THEN
  2405.                         CODE.Float(ARITH.Float(e.value));
  2406.                         CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
  2407.                     ELSIF e1.obj = eCONST THEN
  2408.                         CODE.Float(ARITH.Float(e1.value));
  2409.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2410.                     ELSE
  2411.                         CODE.fcmp(CODE.opEQF + cmpcode(op))
  2412.                     END
  2413.                 END
  2414.  
  2415.             ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
  2416.                 IF ~strcmp(e, e1, op) THEN
  2417.                     PARS.error(parser, pos, 37)
  2418.                 END
  2419.  
  2420.             ELSE
  2421.                 PARS.error(parser, pos, 37)
  2422.             END
  2423.  
  2424.         |SCAN.lxIN:
  2425.             PARS.check(isInt(e) & isSet(e1), parser, pos, 37);
  2426.             IF e.obj = eCONST THEN
  2427.                 PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56)
  2428.             END;
  2429.             IF constant THEN
  2430.                 ARITH.relation(e.value, e1.value, operator, error)
  2431.             ELSE
  2432.                 IF e.obj = eCONST THEN
  2433.                     CODE.AddCmd(CODE.opINL, ARITH.Int(e.value))
  2434.                 ELSIF e1.obj = eCONST THEN
  2435.                     CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value))
  2436.                 ELSE
  2437.                     CODE.AddCmd0(CODE.opIN)
  2438.                 END
  2439.             END
  2440.  
  2441.         |SCAN.lxIS:
  2442.             PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73);
  2443.             IF e.type.typ = PROG.tRECORD THEN
  2444.                 PARS.check(e.obj = eVREC, parser, pos0, 78)
  2445.             END;
  2446.             PARS.check(e1.obj = eTYPE, parser, pos1, 79);
  2447.  
  2448.             IF e.type.typ = PROG.tRECORD THEN
  2449.                 PARS.check(e1.type.typ = PROG.tRECORD,  parser, pos1, 80);
  2450.                 IF e.ident = NIL THEN
  2451.                     CODE.TypeCheck(e1.type.num)
  2452.                 ELSE
  2453.                     CODE.AddCmd(CODE.opVADR, e.ident.offset - 1);
  2454.                     CODE.TypeCheckRec(e1.type.num)
  2455.                 END
  2456.             ELSE
  2457.                 PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81);
  2458.                 CODE.TypeCheck(e1.type.base.num)
  2459.             END;
  2460.  
  2461.             PARS.check(PROG.isBaseOf(e.type, e1.type), parser, pos1, 82)
  2462.  
  2463.         END;
  2464.  
  2465.         ASSERT(error = 0);
  2466.  
  2467.         e.type := PARS.program.stTypes.tBOOLEAN;
  2468.  
  2469.         IF ~constant THEN
  2470.             e.obj := eEXPR
  2471.         END
  2472.  
  2473.     END
  2474. END expression;
  2475.  
  2476.  
  2477. PROCEDURE ElementaryStatement (parser: PARS.PARSER);
  2478. VAR
  2479.     e, e1:    PARS.EXPR;
  2480.     pos:      SCAN.POSITION;
  2481.     line:     INTEGER;
  2482.     call:     BOOLEAN;
  2483.     fregs:    INTEGER;
  2484.  
  2485. BEGIN
  2486.     getpos(parser, pos);
  2487.  
  2488.     CODE.pushBegEnd(begcall, endcall);
  2489.  
  2490.     designator(parser, e);
  2491.  
  2492.     IF parser.sym = SCAN.lxASSIGN THEN
  2493.         line := parser.lex.pos.line;
  2494.         PARS.check(isVar(e), parser, pos, 93);
  2495.         PARS.check(~e.readOnly, parser, pos, 94);
  2496.  
  2497.         CODE.setlast(begcall);
  2498.  
  2499.         NextPos(parser, pos);
  2500.         expression(parser, e1);
  2501.  
  2502.         CODE.setlast(endcall.prev(CODE.COMMAND));
  2503.  
  2504.         PARS.check(assign(e1, e.type, line), parser, pos, 91);
  2505.         IF e1.obj = ePROC THEN
  2506.             PARS.check(e1.ident.global, parser, pos, 85)
  2507.         END;
  2508.         call := FALSE
  2509.     ELSIF parser.sym = SCAN.lxEQ THEN
  2510.         PARS.check1(FALSE, parser, 96)
  2511.     ELSIF parser.sym = SCAN.lxLROUND THEN
  2512.         e1 := e;
  2513.         ActualParameters(parser, e1);
  2514.         PARS.check((e1.type = NIL) OR ODD(e.type.call), parser, pos, 92);
  2515.         call := TRUE
  2516.     ELSE
  2517.         PARS.check(isProc(e), parser, pos, 86);
  2518.         PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92);
  2519.         PARS.check1(e.type.params.first = NIL, parser, 64);
  2520.         call := TRUE
  2521.     END;
  2522.  
  2523.     IF call THEN
  2524.         IF e.obj IN {ePROC, eIMP} THEN
  2525.             ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE)
  2526.         ELSIF isExpr(e) THEN
  2527.             ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE)
  2528.         END
  2529.     END;
  2530.  
  2531.     CODE.popBegEnd(begcall, endcall)
  2532. END ElementaryStatement;
  2533.  
  2534.  
  2535. PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN);
  2536. VAR
  2537.     e:     PARS.EXPR;
  2538.     pos:   SCAN.POSITION;
  2539.  
  2540.     label, L: INTEGER;
  2541.  
  2542. BEGIN
  2543.     L := CODE.NewLabel();
  2544.  
  2545.     IF ~if THEN
  2546.         CODE.AddCmd0(CODE.opLOOP);
  2547.         CODE.SetLabel(L)
  2548.     END;
  2549.  
  2550.     REPEAT
  2551.         NextPos(parser, pos);
  2552.  
  2553.         label := CODE.NewLabel();
  2554.  
  2555.         expression(parser, e);
  2556.         PARS.check(isBoolean(e), parser, pos, 72);
  2557.  
  2558.         IF e.obj = eCONST THEN
  2559.             IF ~ARITH.getBool(e.value) THEN
  2560.                 CODE.AddJmpCmd(CODE.opJMP, label)
  2561.             END
  2562.         ELSE
  2563.             CODE.AddJmpCmd(CODE.opJNE, label)
  2564.         END;
  2565.  
  2566.         IF if THEN
  2567.             PARS.checklex(parser, SCAN.lxTHEN)
  2568.         ELSE
  2569.             PARS.checklex(parser, SCAN.lxDO)
  2570.         END;
  2571.  
  2572.         PARS.Next(parser);
  2573.         parser.StatSeq(parser);
  2574.  
  2575.         CODE.AddJmpCmd(CODE.opJMP, L);
  2576.         CODE.SetLabel(label)
  2577.  
  2578.     UNTIL parser.sym # SCAN.lxELSIF;
  2579.  
  2580.     IF if THEN
  2581.         IF parser.sym = SCAN.lxELSE THEN
  2582.             PARS.Next(parser);
  2583.             parser.StatSeq(parser)
  2584.         END;
  2585.         CODE.SetLabel(L)
  2586.     END;
  2587.  
  2588.     PARS.checklex(parser, SCAN.lxEND);
  2589.  
  2590.     IF ~if THEN
  2591.         CODE.AddCmd0(CODE.opENDLOOP)
  2592.     END;
  2593.  
  2594.     PARS.Next(parser)
  2595. END IfStatement;
  2596.  
  2597.  
  2598. PROCEDURE RepeatStatement (parser: PARS.PARSER);
  2599. VAR
  2600.     e:     PARS.EXPR;
  2601.     pos:   SCAN.POSITION;
  2602.     label: INTEGER;
  2603.  
  2604. BEGIN
  2605.     CODE.AddCmd0(CODE.opLOOP);
  2606.  
  2607.     label := CODE.NewLabel();
  2608.     CODE.SetLabel(label);
  2609.  
  2610.     PARS.Next(parser);
  2611.     parser.StatSeq(parser);
  2612.     PARS.checklex(parser, SCAN.lxUNTIL);
  2613.     NextPos(parser, pos);
  2614.     expression(parser, e);
  2615.     PARS.check(isBoolean(e), parser, pos, 72);
  2616.  
  2617.     IF e.obj = eCONST THEN
  2618.         IF ~ARITH.getBool(e.value) THEN
  2619.             CODE.AddJmpCmd(CODE.opJMP, label)
  2620.         END
  2621.     ELSE
  2622.         CODE.AddJmpCmd(CODE.opJNE, label)
  2623.     END;
  2624.  
  2625.     CODE.AddCmd0(CODE.opENDLOOP)
  2626. END RepeatStatement;
  2627.  
  2628.  
  2629. PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
  2630. VAR
  2631.    La, Ra, Lb, Rb, res: INTEGER;
  2632.  
  2633. BEGIN
  2634.     La := a(CASE_LABEL).range.a;
  2635.     Ra := a(CASE_LABEL).range.b;
  2636.     Lb := b(CASE_LABEL).range.a;
  2637.     Rb := b(CASE_LABEL).range.b;
  2638.     IF (Ra < Lb) OR (La > Rb) THEN
  2639.         res := ORD(La > Lb) - ORD(La < Lb)
  2640.     ELSE
  2641.         res := 0
  2642.     END
  2643.  
  2644.     RETURN res
  2645. END LabelCmp;
  2646.  
  2647.  
  2648. PROCEDURE DestroyLabel (VAR label: AVL.DATA);
  2649. BEGIN
  2650.     C.push(CaseLabels, label);
  2651.     label := NIL
  2652. END DestroyLabel;
  2653.  
  2654.  
  2655. PROCEDURE NewVariant (label: INTEGER; cmd: CODE.COMMAND): CASE_VARIANT;
  2656. VAR
  2657.     res:   CASE_VARIANT;
  2658.     citem: C.ITEM;
  2659.  
  2660. BEGIN
  2661.     citem := C.pop(CaseVar);
  2662.     IF citem = NIL THEN
  2663.         NEW(res)
  2664.     ELSE
  2665.         res := citem(CASE_VARIANT)
  2666.     END;
  2667.  
  2668.     res.label := label;
  2669.     res.cmd := cmd;
  2670.     res.processed := FALSE
  2671.  
  2672.     RETURN res
  2673. END NewVariant;
  2674.  
  2675.  
  2676. PROCEDURE CaseStatement (parser: PARS.PARSER);
  2677. VAR
  2678.     e:      PARS.EXPR;
  2679.     pos:    SCAN.POSITION;
  2680.  
  2681.  
  2682.     PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN;
  2683.         RETURN isRec(caseExpr) OR isPtr(caseExpr)
  2684.     END isRecPtr;
  2685.  
  2686.  
  2687.     PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER;
  2688.     VAR
  2689.         a:      INTEGER;
  2690.         label:  PARS.EXPR;
  2691.         pos:    SCAN.POSITION;
  2692.         value:  ARITH.VALUE;
  2693.  
  2694.     BEGIN
  2695.         getpos(parser, pos);
  2696.         type := NIL;
  2697.  
  2698.         IF isChar(caseExpr) THEN
  2699.             PARS.ConstExpression(parser, value);
  2700.             PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99);
  2701.             a := ARITH.getInt(value)
  2702.         ELSIF isCharW(caseExpr) THEN
  2703.             PARS.ConstExpression(parser, value);
  2704.             IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
  2705.                 ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
  2706.             ELSE
  2707.                 PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99)
  2708.             END;
  2709.             a := ARITH.getInt(value)
  2710.         ELSIF isInt(caseExpr) THEN
  2711.             PARS.ConstExpression(parser, value);
  2712.             PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99);
  2713.             a := ARITH.getInt(value)
  2714.         ELSIF isRecPtr(caseExpr) THEN
  2715.             qualident(parser, label);
  2716.             PARS.check(label.obj = eTYPE, parser, pos, 79);
  2717.             PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, pos, 99);
  2718.             IF isRec(caseExpr) THEN
  2719.                 a := label.type.num
  2720.             ELSE
  2721.                 a := label.type.base.num
  2722.             END;
  2723.             type := label.type
  2724.         END
  2725.  
  2726.         RETURN a
  2727.     END Label;
  2728.  
  2729.  
  2730.     PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: SCAN.POSITION);
  2731.     BEGIN
  2732.         IF node # NIL THEN
  2733.             PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), parser, pos, 100);
  2734.             CheckType(node.left, type, parser, pos);
  2735.             CheckType(node.right, type, parser, pos)
  2736.         END
  2737.     END CheckType;
  2738.  
  2739.  
  2740.     PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
  2741.     VAR
  2742.         label:     CASE_LABEL;
  2743.         citem:     C.ITEM;
  2744.         pos, pos1: SCAN.POSITION;
  2745.         node:      AVL.NODE;
  2746.         newnode:   BOOLEAN;
  2747.         range:     RANGE;
  2748.  
  2749.     BEGIN
  2750.         citem := C.pop(CaseLabels);
  2751.         IF citem = NIL THEN
  2752.             NEW(label)
  2753.         ELSE
  2754.             label := citem(CASE_LABEL)
  2755.         END;
  2756.  
  2757.         label.variant := variant;
  2758.         label.self := CODE.NewLabel();
  2759.  
  2760.         getpos(parser, pos1);
  2761.         range.a := Label(parser, caseExpr, label.type);
  2762.  
  2763.         IF parser.sym = SCAN.lxRANGE THEN
  2764.             PARS.check1(~isRecPtr(caseExpr), parser, 53);
  2765.             NextPos(parser, pos);
  2766.             range.b := Label(parser, caseExpr, label.type);
  2767.             PARS.check(range.a <= range.b, parser, pos, 103)
  2768.         ELSE
  2769.             range.b := range.a
  2770.         END;
  2771.  
  2772.         label.range := range;
  2773.  
  2774.         IF isRecPtr(caseExpr) THEN
  2775.             CheckType(tree, label.type, parser, pos1)
  2776.         END;
  2777.         tree := AVL.insert(tree, label, LabelCmp, newnode, node);
  2778.         PARS.check(newnode, parser, pos1, 100)
  2779.  
  2780.         RETURN node
  2781.  
  2782.     END LabelRange;
  2783.  
  2784.  
  2785.     PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
  2786.     VAR
  2787.         exit: BOOLEAN;
  2788.         res:  AVL.NODE;
  2789.  
  2790.     BEGIN
  2791.         exit := FALSE;
  2792.         REPEAT
  2793.             res := LabelRange(parser, caseExpr, tree, variant);
  2794.             IF parser.sym = SCAN.lxCOMMA THEN
  2795.                 PARS.check1(~isRecPtr(caseExpr), parser, 53);
  2796.                 PARS.Next(parser)
  2797.             ELSE
  2798.                 exit := TRUE
  2799.             END
  2800.         UNTIL exit
  2801.  
  2802.         RETURN res
  2803.     END CaseLabelList;
  2804.  
  2805.  
  2806.     PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER);
  2807.     VAR
  2808.         sym:      INTEGER;
  2809.         t:        PROG.TYPE_;
  2810.         variant:  INTEGER;
  2811.         node:     AVL.NODE;
  2812.         last:     CODE.COMMAND;
  2813.  
  2814.     BEGIN
  2815.         sym := parser.sym;
  2816.         IF sym # SCAN.lxBAR THEN
  2817.             variant := CODE.NewLabel();
  2818.             node := CaseLabelList(parser, caseExpr, tree, variant);
  2819.             PARS.checklex(parser, SCAN.lxCOLON);
  2820.             PARS.Next(parser);
  2821.             IF isRecPtr(caseExpr) THEN
  2822.                 t := caseExpr.type;
  2823.                 caseExpr.ident.type := node.data(CASE_LABEL).type
  2824.             END;
  2825.  
  2826.             last := CODE.getlast();
  2827.             CODE.SetLabel(variant);
  2828.  
  2829.             IF ~isRecPtr(caseExpr) THEN
  2830.                 LISTS.push(CaseVariants, NewVariant(variant, last))
  2831.             END;
  2832.  
  2833.             parser.StatSeq(parser);
  2834.             CODE.AddJmpCmd(CODE.opJMP, end);
  2835.  
  2836.             IF isRecPtr(caseExpr) THEN
  2837.                 caseExpr.ident.type := t
  2838.             END
  2839.         END
  2840.     END case;
  2841.  
  2842.  
  2843.     PROCEDURE Table (node: AVL.NODE; else: INTEGER);
  2844.     VAR
  2845.         L, R: INTEGER;
  2846.         range: RANGE;
  2847.         left, right: AVL.NODE;
  2848.         last: CODE.COMMAND;
  2849.         v: CASE_VARIANT;
  2850.  
  2851.     BEGIN
  2852.         IF node # NIL THEN
  2853.  
  2854.             range := node.data(CASE_LABEL).range;
  2855.  
  2856.             left := node.left;
  2857.             IF left # NIL THEN
  2858.                 L := left.data(CASE_LABEL).self
  2859.             ELSE
  2860.                 L := else
  2861.             END;
  2862.  
  2863.             right := node.right;
  2864.             IF right # NIL THEN
  2865.                 R := right.data(CASE_LABEL).self
  2866.             ELSE
  2867.                 R := else
  2868.             END;
  2869.  
  2870.             last := CODE.getlast();
  2871.  
  2872.             v := CaseVariants.last(CASE_VARIANT);
  2873.             WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
  2874.                 v := v.prev(CASE_VARIANT)
  2875.             END;
  2876.  
  2877.             ASSERT((v # NIL) & (v.label # 0));
  2878.             CODE.setlast(v.cmd);
  2879.  
  2880.             CODE.SetLabel(node.data(CASE_LABEL).self);
  2881.             CODE.case(range.a, range.b, L, R);
  2882.             IF v.processed THEN
  2883.                 CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant)
  2884.             END;
  2885.             v.processed := TRUE;
  2886.  
  2887.             CODE.setlast(last);
  2888.  
  2889.             Table(left, else);
  2890.             Table(right, else)
  2891.         END
  2892.     END Table;
  2893.  
  2894.  
  2895.     PROCEDURE TableT (node: AVL.NODE);
  2896.     BEGIN
  2897.         IF node # NIL THEN
  2898.             CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
  2899.  
  2900.             TableT(node.left);
  2901.             TableT(node.right)
  2902.         END
  2903.     END TableT;
  2904.  
  2905.  
  2906.     PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: SCAN.POSITION);
  2907.     VAR
  2908.         table, end, else: INTEGER;
  2909.         tree: AVL.NODE;
  2910.         item:  LISTS.ITEM;
  2911.  
  2912.     BEGIN
  2913.         LISTS.push(CaseVariants, NewVariant(0, NIL));
  2914.         end   := CODE.NewLabel();
  2915.         else  := CODE.NewLabel();
  2916.         table := CODE.NewLabel();
  2917.         CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e)));
  2918.         CODE.AddJmpCmd(CODE.opJMP, table);
  2919.  
  2920.         tree := NIL;
  2921.  
  2922.         case(parser, e, tree, end);
  2923.         WHILE parser.sym = SCAN.lxBAR DO
  2924.             PARS.Next(parser);
  2925.             case(parser, e, tree, end)
  2926.         END;
  2927.  
  2928.         CODE.SetLabel(else);
  2929.         IF parser.sym = SCAN.lxELSE THEN
  2930.             PARS.Next(parser);
  2931.             parser.StatSeq(parser);
  2932.             CODE.AddJmpCmd(CODE.opJMP, end)
  2933.         ELSE
  2934.             CODE.OnError(pos.line, errCASE)
  2935.         END;
  2936.  
  2937.         PARS.checklex(parser, SCAN.lxEND);
  2938.         PARS.Next(parser);
  2939.  
  2940.         IF isRecPtr(e) THEN
  2941.             CODE.SetLabel(table);
  2942.             TableT(tree);
  2943.             CODE.AddJmpCmd(CODE.opJMP, else)
  2944.         ELSE
  2945.             tree.data(CASE_LABEL).self := table;
  2946.             Table(tree, else)
  2947.         END;
  2948.  
  2949.         AVL.destroy(tree, DestroyLabel);
  2950.         CODE.SetLabel(end);
  2951.         CODE.AddCmd0(CODE.opENDSW);
  2952.  
  2953.         REPEAT
  2954.             item := LISTS.pop(CaseVariants);
  2955.             C.push(CaseVar, item)
  2956.         UNTIL item(CASE_VARIANT).cmd = NIL
  2957.  
  2958.     END ParseCase;
  2959.  
  2960.  
  2961. BEGIN
  2962.     NextPos(parser, pos);
  2963.     expression(parser, e);
  2964.     PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), parser, pos, 95);
  2965.     IF isRecPtr(e) THEN
  2966.         PARS.check(isVar(e), parser, pos, 93);
  2967.         PARS.check(e.ident # NIL, parser, pos, 106)
  2968.     END;
  2969.     IF isRec(e) THEN
  2970.         PARS.check(e.obj = eVREC, parser, pos, 78)
  2971.     END;
  2972.  
  2973.     IF e.obj = eCONST THEN
  2974.         LoadConst(e)
  2975.     ELSIF isRec(e) THEN
  2976.         CODE.drop;
  2977.         CODE.AddCmd(CODE.opLADR, e.ident.offset - 1);
  2978.         CODE.load(PARS.program.target.word)
  2979.     ELSIF isPtr(e) THEN
  2980.         deref(pos, e, FALSE, errPTR);
  2981.         CODE.AddCmd(CODE.opSUBR, PARS.program.target.word);
  2982.         CODE.load(PARS.program.target.word)
  2983.     END;
  2984.  
  2985.     PARS.checklex(parser, SCAN.lxOF);
  2986.     PARS.Next(parser);
  2987.     ParseCase(parser, e, pos)
  2988. END CaseStatement;
  2989.  
  2990.  
  2991. PROCEDURE ForStatement (parser: PARS.PARSER);
  2992. VAR
  2993.     e:       PARS.EXPR;
  2994.     pos:     SCAN.POSITION;
  2995.     step:    ARITH.VALUE;
  2996.     st:      INTEGER;
  2997.     ident:   PROG.IDENT;
  2998.     offset:  INTEGER;
  2999.     L1, L2:  INTEGER;
  3000.  
  3001. BEGIN
  3002.     CODE.AddCmd0(CODE.opLOOP);
  3003.  
  3004.     L1 := CODE.NewLabel();
  3005.     L2 := CODE.NewLabel();
  3006.  
  3007.     PARS.ExpectSym(parser, SCAN.lxIDENT);
  3008.     ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE);
  3009.     PARS.check1(ident # NIL, parser, 48);
  3010.     PARS.check1(ident.typ = PROG.idVAR, parser, 93);
  3011.     PARS.check1(ident.type.typ = PROG.tINTEGER, parser, 97);
  3012.     PARS.ExpectSym(parser, SCAN.lxASSIGN);
  3013.     NextPos(parser, pos);
  3014.     expression(parser, e);
  3015.     PARS.check(isInt(e), parser, pos, 76);
  3016.  
  3017.     offset := PROG.getOffset(PARS.program, ident);
  3018.  
  3019.     IF ident.global THEN
  3020.         CODE.AddCmd(CODE.opGADR, offset)
  3021.     ELSE
  3022.         CODE.AddCmd(CODE.opLADR, -offset)
  3023.     END;
  3024.  
  3025.     IF e.obj = eCONST THEN
  3026.         CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
  3027.     ELSE
  3028.         CODE.AddCmd0(CODE.opSAVE)
  3029.     END;
  3030.  
  3031.     CODE.SetLabel(L1);
  3032.  
  3033.     IF ident.global THEN
  3034.         CODE.AddCmd(CODE.opGADR, offset)
  3035.     ELSE
  3036.         CODE.AddCmd(CODE.opLADR, -offset)
  3037.     END;
  3038.     CODE.load(ident.type.size);
  3039.  
  3040.     PARS.checklex(parser, SCAN.lxTO);
  3041.     NextPos(parser, pos);
  3042.     expression(parser, e);
  3043.     PARS.check(isInt(e), parser, pos, 76);
  3044.  
  3045.     IF parser.sym = SCAN.lxBY THEN
  3046.         NextPos(parser, pos);
  3047.         PARS.ConstExpression(parser, step);
  3048.         PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76);
  3049.         st := ARITH.getInt(step);
  3050.         PARS.check(st # 0, parser, pos, 98)
  3051.     ELSE
  3052.         st := 1
  3053.     END;
  3054.  
  3055.     IF e.obj = eCONST THEN
  3056.         IF st > 0 THEN
  3057.             CODE.AddCmd(CODE.opLER, ARITH.Int(e.value))
  3058.         ELSE
  3059.             CODE.AddCmd(CODE.opGER, ARITH.Int(e.value))
  3060.         END
  3061.     ELSE
  3062.         IF st > 0 THEN
  3063.             CODE.AddCmd0(CODE.opLE)
  3064.         ELSE
  3065.             CODE.AddCmd0(CODE.opGE)
  3066.         END
  3067.     END;
  3068.  
  3069.     CODE.AddJmpCmd(CODE.opJNE, L2);
  3070.  
  3071.     PARS.checklex(parser, SCAN.lxDO);
  3072.     PARS.Next(parser);
  3073.     parser.StatSeq(parser);
  3074.  
  3075.     IF ident.global THEN
  3076.         CODE.AddCmd(CODE.opGADR, offset)
  3077.     ELSE
  3078.         CODE.AddCmd(CODE.opLADR, -offset)
  3079.     END;
  3080.  
  3081.     IF st = 1 THEN
  3082.         CODE.AddCmd0(CODE.opINC1)
  3083.     ELSIF st = -1 THEN
  3084.         CODE.AddCmd0(CODE.opDEC1)
  3085.     ELSE
  3086.         IF st > 0 THEN
  3087.             CODE.AddCmd(CODE.opINCC, st)
  3088.         ELSE
  3089.             CODE.AddCmd(CODE.opDECC, -st)
  3090.         END
  3091.     END;
  3092.  
  3093.     CODE.AddJmpCmd(CODE.opJMP, L1);
  3094.  
  3095.     PARS.checklex(parser, SCAN.lxEND);
  3096.     PARS.Next(parser);
  3097.  
  3098.     CODE.SetLabel(L2);
  3099.  
  3100.     CODE.AddCmd0(CODE.opENDLOOP)
  3101.  
  3102. END ForStatement;
  3103.  
  3104.  
  3105. PROCEDURE statement (parser: PARS.PARSER);
  3106. VAR
  3107.     sym: INTEGER;
  3108.  
  3109. BEGIN
  3110.     sym := parser.sym;
  3111.  
  3112.     IF sym = SCAN.lxIDENT THEN
  3113.         ElementaryStatement(parser)
  3114.     ELSIF sym = SCAN.lxIF THEN
  3115.         IfStatement(parser, TRUE)
  3116.     ELSIF sym = SCAN.lxWHILE THEN
  3117.         IfStatement(parser, FALSE)
  3118.     ELSIF sym = SCAN.lxREPEAT THEN
  3119.         RepeatStatement(parser)
  3120.     ELSIF sym = SCAN.lxCASE THEN
  3121.         CaseStatement(parser)
  3122.     ELSIF sym = SCAN.lxFOR THEN
  3123.         ForStatement(parser)
  3124.     END
  3125. END statement;
  3126.  
  3127.  
  3128. PROCEDURE StatSeq (parser: PARS.PARSER);
  3129. BEGIN
  3130.     statement(parser);
  3131.     WHILE parser.sym = SCAN.lxSEMI DO
  3132.         PARS.Next(parser);
  3133.         statement(parser)
  3134.     END
  3135. END StatSeq;
  3136.  
  3137.  
  3138. PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
  3139. VAR
  3140.     res: BOOLEAN;
  3141.  
  3142. BEGIN
  3143.     res := assigncomp(e, t);
  3144.     IF res THEN
  3145.         IF e.obj = eCONST THEN
  3146.             IF e.type.typ = PROG.tREAL THEN
  3147.                 CODE.Float(ARITH.Float(e.value))
  3148.             ELSIF e.type.typ = PROG.tNIL THEN
  3149.                 CODE.AddCmd(CODE.opCONST, 0)
  3150.             ELSE
  3151.                 LoadConst(e)
  3152.             END
  3153.         ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN checking) THEN
  3154.             CheckRange(256, pos.line, errBYTE)
  3155.         ELSIF e.obj = ePROC THEN
  3156.             PARS.check(e.ident.global, parser, pos, 85);
  3157.             CODE.PushProc(e.ident.proc.label)
  3158.         ELSIF e.obj = eIMP THEN
  3159.             CODE.PushImpProc(e.ident.import)
  3160.         END;
  3161.  
  3162.         IF e.type.typ = PROG.tREAL THEN
  3163.             CODE.retf
  3164.         END
  3165.     END
  3166.  
  3167.     RETURN res
  3168. END chkreturn;
  3169.  
  3170.  
  3171. PROCEDURE setrtl;
  3172. VAR
  3173.     rtl: PROG.UNIT;
  3174.  
  3175.  
  3176.     PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
  3177.     VAR
  3178.         id:    PROG.IDENT;
  3179.  
  3180.     BEGIN
  3181.         id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE);
  3182.  
  3183.         IF (id # NIL) & (id.import # NIL) THEN
  3184.             CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label;
  3185.             id.proc.used := TRUE
  3186.         ELSIF (id # NIL) & (id.proc # NIL) THEN
  3187.             CODE.codes.rtl[idx] := id.proc.label;
  3188.             id.proc.used := TRUE
  3189.         ELSE
  3190.             ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found")
  3191.         END
  3192.     END getproc;
  3193.  
  3194.  
  3195. BEGIN
  3196.     rtl := PARS.program.rtl;
  3197.     ASSERT(rtl # NIL);
  3198.  
  3199.     getproc(rtl,  "_move",      CODE._move);
  3200.     getproc(rtl,  "_move2",     CODE._move2);
  3201.     getproc(rtl,  "_set",       CODE._set);
  3202.     getproc(rtl,  "_set2",      CODE._set2);
  3203.     getproc(rtl,  "_div",       CODE._div);
  3204.     getproc(rtl,  "_mod",       CODE._mod);
  3205.     getproc(rtl,  "_div2",      CODE._div2);
  3206.     getproc(rtl,  "_mod2",      CODE._mod2);
  3207.     getproc(rtl,  "_arrcpy",    CODE._arrcpy);
  3208.     getproc(rtl,  "_rot",       CODE._rot);
  3209.     getproc(rtl,  "_new",       CODE._new);
  3210.     getproc(rtl,  "_dispose",   CODE._dispose);
  3211.     getproc(rtl,  "_strcmp",    CODE._strcmp);
  3212.     getproc(rtl,  "_error",     CODE._error);
  3213.     getproc(rtl,  "_is",        CODE._is);
  3214.     getproc(rtl,  "_isrec",     CODE._isrec);
  3215.     getproc(rtl,  "_guard",     CODE._guard);
  3216.     getproc(rtl,  "_guardrec",  CODE._guardrec);
  3217.     getproc(rtl,  "_length",    CODE._length);
  3218.     getproc(rtl,  "_init",      CODE._init);
  3219.     getproc(rtl,  "_dllentry",  CODE._dllentry);
  3220.     getproc(rtl,  "_strcpy",    CODE._strcpy);
  3221.     getproc(rtl,  "_exit",      CODE._exit);
  3222.     getproc(rtl,  "_strcpy2",   CODE._strcpy2);
  3223.     getproc(rtl,  "_lengthw",   CODE._lengthw);
  3224.     getproc(rtl,  "_strcmp2",   CODE._strcmp2);
  3225.     getproc(rtl,  "_strcmpw",   CODE._strcmpw);
  3226.     getproc(rtl,  "_strcmpw2",  CODE._strcmpw2);
  3227.  
  3228. END setrtl;
  3229.  
  3230.  
  3231. PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET);
  3232. VAR
  3233.     parser:  PARS.PARSER;
  3234.     ext: PARS.PATH;
  3235.     amd64: BOOLEAN;
  3236.  
  3237. BEGIN
  3238.     amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
  3239.     ext := mConst.FILE_EXT;
  3240.     CaseLabels := C.create();
  3241.     CaseVar := C.create();
  3242.  
  3243.     CaseVariants := LISTS.create(NIL);
  3244.     LISTS.push(CaseVariants, NewVariant(0, NIL));
  3245.  
  3246.     checking := chk;
  3247.  
  3248.     IF amd64 THEN
  3249.         CODE.init(6, CODE.little_endian)
  3250.     ELSE
  3251.         CODE.init(8, CODE.little_endian)
  3252.     END;
  3253.  
  3254.     parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
  3255.     IF parser.open(parser, mConst.RTL_NAME) THEN
  3256.         parser.parse(parser);
  3257.         PARS.destroy(parser)
  3258.     ELSE
  3259.         PARS.destroy(parser);
  3260.         parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
  3261.         IF parser.open(parser, mConst.RTL_NAME) THEN
  3262.             parser.parse(parser);
  3263.             PARS.destroy(parser)
  3264.         ELSE
  3265.             ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found")
  3266.         END
  3267.     END;
  3268.  
  3269.     parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
  3270.     parser.main := TRUE;
  3271.  
  3272.     IF parser.open(parser, modname) THEN
  3273.         parser.parse(parser)
  3274.     ELSE
  3275.         ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found")
  3276.     END;
  3277.  
  3278.     PARS.destroy(parser);
  3279.  
  3280.     IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN
  3281.         ERRORS.error1("size of global variables is too large")
  3282.     END;
  3283.  
  3284.     setrtl;
  3285.  
  3286.     PROG.DelUnused(PARS.program, CODE.DelImport);
  3287.  
  3288.     CODE.codes.bss := PARS.program.bss;
  3289.     IF amd64 THEN
  3290.         AMD64.CodeGen(CODE.codes, outname, target, stack, base)
  3291.     ELSE
  3292.         X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic)
  3293.     END
  3294. END compile;
  3295.  
  3296.  
  3297. END STATEMENTS.