Subversion Repositories Kolibri OS

Rev

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

  1. (*
  2.     Copyright 2016, 2017, 2018 Anton Krotov
  3.  
  4.     This file is part of Compiler.
  5.  
  6.     Compiler is free software: you can redistribute it and/or modify
  7.     it under the terms of the GNU General Public License as published by
  8.     the Free Software Foundation, either version 3 of the License, or
  9.     (at your option) any later version.
  10.  
  11.     Compiler is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.     GNU General Public License for more details.
  15.  
  16.     You should have received a copy of the GNU General Public License
  17.     along with Compiler. If not, see <http://www.gnu.org/licenses/>.
  18. *)
  19.  
  20. MODULE Compiler;
  21.  
  22. IMPORT DECL, SCAN, UTILS, X86, SYSTEM;
  23.  
  24. CONST
  25.  
  26.   Slash = UTILS.Slash;
  27.  
  28.   lxEOF = 0; lxINT = -1; lxREAL = -2; lxSTRING = -3; lxIDENT = -4; lxHEX = -5; lxCHX = -6; lxLONGREAL = -7;
  29.   lxARRAY = 1; lxBEGIN = 2; lxBY = 3; lxCASE = 4; lxCONST = 5; lxDIV = 6; lxDO = 7; lxELSE = 8;
  30.   lxELSIF = 9; lxEND = 10; lxFALSE = 11; lxFOR = 12; lxIF = 13; lxIMPORT = 14; lxIN = 15; lxIS = 16;
  31.   lxMOD = 17; lxMODULE = 18; lxNIL = 19; lxOF = 20; lxOR = 21; lxPOINTER = 22; lxPROCEDURE = 23;
  32.   lxRECORD = 24; lxREPEAT = 25; lxRETURN = 26; lxTHEN = 27; lxTO = 28; lxTRUE = 29; lxTYPE = 30;
  33.   lxUNTIL = 31; lxVAR = 32; lxWHILE = 33;
  34.  
  35.   lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54; lxNot = 55; lxAnd = 56; lxComma = 57; lxSemi = 58;
  36.   lxStick = 59; lxLRound = 60; lxLSquare = 61; lxLCurly = 62; lxCaret = 63; lxRRound = 64; lxRSquare = 65;
  37.   lxRCurly = 66; lxDot = 67; lxDbl = 68; lxAssign = 69; lxColon = 70;
  38.   lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76;
  39.  
  40.   TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7;
  41.   TNIL = 8; TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14;
  42.  
  43.   TNUM = {TINTEGER, TREAL, TLONGREAL};
  44.   TFLOAT = {TREAL, TLONGREAL};
  45.   TOBJECT = {TRECORD, TPOINTER};
  46.   TSTRUCT = {TARRAY, TRECORD};
  47.  
  48.   eVAR = 1; eCONST = 2; eEXP = 3; ePROC = 4; eSTPROC = 5; eSYSPROC = 6;
  49.  
  50.   IDMOD = 1; IDCONST = 2; IDTYPE = 3; IDVAR = 4; IDPROC = 5; IDSTPROC = 6; IDGUARD = 7; IDPARAM = 8; IDSYSPROC = 9;
  51.  
  52.   stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8;
  53.   stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15;
  54.   stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22;
  55.   stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27;
  56.  
  57.   sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105;
  58.   sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109;
  59.  
  60. TYPE
  61.  
  62.   LABEL = POINTER TO RECORD (UTILS.rITEM)
  63.     a, b: INTEGER
  64.   END;
  65.  
  66. VAR
  67.  
  68.   pExpr, pFactor: PROCEDURE (VAR e: DECL.EXPRESSION);
  69.   pOpSeq: PROCEDURE;
  70.   sttypes: DECL.stTYPES;
  71.   voidtype, inttype, booltype, strtype, settype, realtype, longrealtype, chartype, niltype: DECL.pTYPE;
  72.  
  73. PROCEDURE Load(e: DECL.EXPRESSION);
  74. BEGIN
  75.   IF e.eType = eVAR THEN
  76.     X86.Load(e.T.tType)
  77.   END
  78. END Load;
  79.  
  80. PROCEDURE LenString(adr: LONGREAL): INTEGER;
  81. VAR s: UTILS.STRCONST;
  82. BEGIN
  83.   s := DECL.GetString(adr)
  84.   RETURN s.Len
  85. END LenString;
  86.  
  87. PROCEDURE Assert(cond: BOOLEAN; coord: SCAN.TCoord; code: INTEGER);
  88. BEGIN
  89.   IF ~cond THEN
  90.     DECL.Assert(FALSE, coord, code)
  91.   END
  92. END Assert;
  93.  
  94. PROCEDURE Assert2(cond: BOOLEAN; code: INTEGER);
  95. BEGIN
  96.   IF ~cond THEN
  97.     DECL.Assert(FALSE, SCAN.coord, code)
  98.   END
  99. END Assert2;
  100.  
  101. PROCEDURE IntType(T: DECL.pTYPE; coord: SCAN.TCoord);
  102. BEGIN
  103.   Assert(T.tType = TINTEGER, coord, 52)
  104. END IntType;
  105.  
  106. PROCEDURE Next;
  107. BEGIN
  108.   DECL.Next
  109. END Next;
  110.  
  111. PROCEDURE Coord(VAR coord: SCAN.TCoord);
  112. BEGIN
  113.   coord := SCAN.coord
  114. END Coord;
  115.  
  116. PROCEDURE NextCoord(VAR coord: SCAN.TCoord);
  117. BEGIN
  118.   DECL.Next;
  119.   coord := SCAN.coord
  120. END NextCoord;
  121.  
  122. PROCEDURE Check(key: INTEGER);
  123. BEGIN
  124.   DECL.Check(key)
  125. END Check;
  126.  
  127. PROCEDURE NextCheck(key: INTEGER);
  128. BEGIN
  129.   DECL.Next;
  130.   DECL.Check(key)
  131. END NextCheck;
  132.  
  133. PROCEDURE BaseOf(T0, T1: DECL.pTYPE): BOOLEAN;
  134. BEGIN
  135.   IF (T0.tType = T1.tType) & (T0.tType IN TOBJECT) THEN
  136.     IF T0.tType = TPOINTER THEN
  137.       T0 := T0.Base;
  138.       T1 := T1.Base
  139.     END;
  140.     WHILE (T1 # NIL) & (T1 # T0) DO
  141.       T1 := T1.Base
  142.     END
  143.   END
  144.   RETURN T0 = T1
  145. END BaseOf;
  146.  
  147. PROCEDURE Designator(VAR e: DECL.EXPRESSION);
  148. VAR id, id2: DECL.IDENT; name: SCAN.NODE; e1: DECL.EXPRESSION;
  149.     coord: SCAN.TCoord; i, n, bases, glob, loc, idx: INTEGER;
  150.     imp, break, guard: BOOLEAN; f: DECL.FIELD;
  151.     T, BaseT: DECL.pTYPE; s: UTILS.STRCONST;
  152.  
  153.   PROCEDURE LoadVar;
  154.   BEGIN
  155.     IF glob # -1 THEN
  156.       X86.GlobalAdr(glob);
  157.       glob := -1
  158.     ELSIF loc # -1 THEN
  159.       X86.LocalAdr(loc, bases);
  160.       loc := -1
  161.     END
  162.   END LoadVar;
  163.  
  164. BEGIN
  165.   glob := -1;
  166.   loc := -1;
  167.   Coord(coord);
  168.   Check(lxIDENT);
  169.   name := SCAN.id;
  170.   id := DECL.GetIdent(name);
  171.   IF (id # NIL) & (id.iType = IDMOD) THEN
  172.     NextCheck(lxDot);
  173.     NextCheck(lxIDENT);
  174.     Coord(coord);
  175.     name := SCAN.id;
  176.     imp := id.Unit # DECL.unit;
  177.     id := DECL.GetQIdent(id.Unit, name)
  178.   END;
  179.   Assert(id # NIL, coord, 42);
  180.   e.vparam := FALSE;
  181.   e.deref := FALSE;
  182.   e.id := id;
  183.   Next;
  184.   CASE id.iType OF
  185.   |IDVAR:
  186.     e.eType := eVAR;
  187.     e.T := id.T;
  188.     IF id.VarKind = 0 THEN
  189.       e.Read := imp
  190.     ELSE
  191.       e.Read := (id.VarKind = DECL.param) & (id.T.tType IN TSTRUCT);
  192.       e.vparam := id.VarKind = DECL.paramvar
  193.     END;
  194.     bases := DECL.unit.Level - id.Level;
  195.     IF id.Level = 3 THEN
  196.       glob := id.Offset
  197.     ELSIF (id.VarKind = 0) OR (id.VarKind = DECL.param) & ~(id.T.tType IN TSTRUCT) THEN
  198.       loc := id.Offset
  199.     ELSIF (id.VarKind = DECL.paramvar) OR (id.T.tType IN TSTRUCT) THEN
  200.       IF DECL.Dim(e.T) > 0 THEN
  201.         n := DECL.Dim(e.T);
  202.         FOR i := n TO 1 BY -1 DO
  203.           X86.LocalAdr(id.Offset + i * 4, bases);
  204.           X86.Load(TINTEGER)
  205.         END
  206.       END;
  207.       X86.LocalAdr(id.Offset, bases);
  208.       X86.Load(TINTEGER)
  209.     END
  210.   |IDCONST:
  211.     Assert(id.T # NIL, coord, 75);
  212.     e.eType := eCONST;
  213.     e.T := id.T;
  214.     e.Value := id.Value;
  215.     IF id.T.tType IN {TINTEGER, TSET, TBOOLEAN} THEN
  216.       X86.PushConst(FLOOR(e.Value))
  217.     ELSIF id.T.tType IN TFLOAT THEN
  218.       X86.PushFlt(e.Value)
  219.     ELSIF id.T.tType = TSTRING THEN
  220.       s := DECL.GetString(e.Value);
  221.       IF s.Len = 1 THEN
  222.         X86.PushConst(ORD(s.Str[0]))
  223.       ELSE
  224.         X86.PushInt(s.Number)
  225.       END
  226.     END
  227.   |IDPROC:
  228.     e.eType := ePROC;
  229.     NEW(id2);
  230.     UTILS.MemErr(id2 = NIL);
  231.     id2^ := id^;
  232.     UTILS.Push(DECL.curproc.Procs, id2);
  233.     e.T := voidtype
  234.   |IDTYPE:
  235.     Assert(FALSE, coord, 101)
  236.   |IDSTPROC:
  237.     e.eType := eSTPROC;
  238.     e.T := voidtype
  239.   |IDSYSPROC:
  240.     e.eType := eSYSPROC;
  241.     e.T := voidtype
  242.   ELSE
  243.   END;
  244.   break := FALSE;
  245.   guard := FALSE;
  246.   REPEAT
  247.     CASE SCAN.tLex OF
  248.     |lxDot:
  249.       e.deref := FALSE;
  250.       Assert2(e.T.tType IN TOBJECT, 105);
  251.       IF e.T.tType = TPOINTER THEN
  252.         e.Read := FALSE;
  253.         LoadVar;
  254.         e.T := e.T.Base;
  255.         X86.Load(TINTEGER);
  256.         IF ~guard THEN
  257.           X86.CheckNIL
  258.         END
  259.       END;
  260.       NextCheck(lxIDENT);
  261.       Coord(coord);
  262.       name := SCAN.id;
  263.       T := e.T;
  264.       REPEAT
  265.         f := DECL.GetField(T, name);
  266.         T := T.Base
  267.       UNTIL (f # NIL) OR (T = NIL);
  268.       Assert(f # NIL, coord, 99);
  269.       IF f.Unit # DECL.unit THEN
  270.         Assert(f.Export, coord, 99)
  271.       END;
  272.       IF glob # -1 THEN
  273.         glob := glob + f.Offset
  274.       ELSIF loc # -1 THEN
  275.         loc := loc + f.Offset
  276.       ELSE
  277.         X86.Field(f.Offset)
  278.       END;
  279.       e.T := f.T;
  280.       e.vparam := FALSE;
  281.       guard := FALSE;
  282.       Next
  283.     |lxLSquare:
  284.       LoadVar;
  285.       REPEAT
  286.         Assert2(e.T.tType = TARRAY, 102);
  287.         NextCoord(coord);
  288.         pExpr(e1);
  289.         IntType(e1.T, coord);
  290.         Load(e1);
  291.         IF e.T.Len = 0 THEN
  292.           IF e1.eType = eCONST THEN
  293.             idx := FLOOR(e1.Value);
  294.             Assert(idx >= 0, coord, 159)
  295.           END;
  296.           BaseT := DECL.OpenBase(e.T);
  297.           X86.PushConst(BaseT.Size);
  298.           X86.OpenIdx(DECL.Dim(e.T))
  299.         ELSE
  300.           IF e1.eType = eCONST THEN
  301.             idx := FLOOR(e1.Value);
  302.             Assert((idx >= 0) & (idx < e.T.Len), coord, 159);
  303.             IF e.T.Base.Size # 1 THEN
  304.               X86.Drop;
  305.               X86.PushConst(e.T.Base.Size * idx)
  306.             END;
  307.             X86.Idx
  308.           ELSE
  309.             X86.FixIdx(e.T.Len, e.T.Base.Size)
  310.           END
  311.         END;
  312.         e.T := e.T.Base
  313.       UNTIL SCAN.tLex # lxComma;
  314.       Check(lxRSquare);
  315.       e.vparam := FALSE;
  316.       guard := FALSE;
  317.       Next
  318.     |lxCaret:
  319.       LoadVar;
  320.       Assert2(e.T.tType = TPOINTER, 104);
  321.       e.Read := FALSE;
  322.       X86.Load(TINTEGER);
  323.       IF ~guard THEN
  324.         X86.CheckNIL
  325.       END;
  326.       e.T := e.T.Base;
  327.       e.vparam := FALSE;
  328.       e.deref := TRUE;
  329.       guard := FALSE;
  330.       Next
  331.     |lxLRound:
  332.       LoadVar;
  333.       IF e.T.tType IN TOBJECT THEN
  334.         IF e.T.tType = TRECORD THEN
  335.           Assert2(e.vparam, 108)
  336.         END;
  337.         NextCheck(lxIDENT);
  338.         Coord(coord);
  339.         T := DECL.IdType(coord);
  340.         Assert(T # NIL, coord, 42);
  341.         IF e.T.tType = TRECORD THEN
  342.           Assert(T.tType = TRECORD, coord, 106)
  343.         ELSE
  344.           Assert(T.tType = TPOINTER, coord, 107)
  345.         END;
  346.         Assert(BaseOf(e.T, T), coord, 108);
  347.         e.T := T;
  348.         Check(lxRRound);
  349.         Next;
  350.         IF e.T.tType = TPOINTER THEN
  351.           IF (SCAN.tLex = lxDot) OR (SCAN.tLex = lxCaret) THEN
  352.             X86.DupLoadCheck
  353.           ELSE
  354.             X86.DupLoad
  355.           END;
  356.           guard := TRUE;
  357.           T := T.Base
  358.         ELSE
  359.           X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level)
  360.         END;
  361.         X86.Guard(T.Number, FALSE)
  362.       ELSE
  363.         break := TRUE
  364.       END
  365.     ELSE
  366.       break := TRUE
  367.     END
  368.   UNTIL break;
  369.   LoadVar
  370. END Designator;
  371.  
  372. PROCEDURE Set(VAR e: DECL.EXPRESSION);
  373. VAR a, b: DECL.EXPRESSION; coord: SCAN.TCoord; fpu: INTEGER; s: SET; flag: BOOLEAN;
  374.     beg: X86.ASMLINE;
  375. BEGIN
  376.   Next;
  377.   e.eType := eEXP;
  378.   e.T := settype;
  379.   e.Value := 0.0D0;
  380.   e.vparam := FALSE;
  381.   s := {};
  382.   flag := TRUE;
  383.   fpu := X86.fpu;
  384.   beg := X86.current;
  385.   X86.PushConst(0);
  386.   WHILE SCAN.tLex # lxRCurly DO
  387.     Coord(coord);
  388.     pExpr(a);
  389.     IntType(a.T, coord);
  390.     IF a.eType = eCONST THEN
  391.       Assert(ASR(FLOOR(a.Value), 5) = 0, coord, 53)
  392.     END;
  393.     Load(a);
  394.     b := a;
  395.     IF SCAN.tLex = lxDbl THEN
  396.       NextCoord(coord);
  397.       pExpr(b);
  398.       IntType(b.T, coord);
  399.       IF b.eType = eCONST THEN
  400.         Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53);
  401.         IF a.eType = eCONST THEN
  402.           Assert(a.Value <= b.Value, coord, 54)
  403.         END
  404.       END;
  405.       Load(b)
  406.     ELSE
  407.       X86.Dup
  408.     END;
  409.     X86.rset;
  410.     X86.Set(lxPlus);
  411.     flag := (a.eType = eCONST) & (b.eType = eCONST) & flag;
  412.     IF flag THEN
  413.       s := s + {FLOOR(a.Value) .. FLOOR(b.Value)}
  414.     END;
  415.     IF SCAN.tLex = lxComma THEN
  416.       Next;
  417.       Assert2(SCAN.tLex # lxRCurly, 36)
  418.     ELSE
  419.       Check(lxRCurly)
  420.     END
  421.   END;
  422.   IF flag THEN
  423.     e.Value := LONG(FLT(ORD(s)));
  424.     e.eType := eCONST;
  425.     X86.Del(beg);
  426.     X86.Setfpu(fpu);
  427.     IF ~DECL.Const THEN
  428.       X86.PushConst(ORD(s))
  429.     END
  430.   END;
  431.   Next
  432. END Set;
  433.  
  434. PROCEDURE IsString(a: DECL.EXPRESSION): BOOLEAN;
  435.   RETURN (a.T.tType = TSTRING) OR (a.T.tType = TARRAY) & (a.T.Base.tType = TCHAR)
  436. END IsString;
  437.  
  438. PROCEDURE Str(e: DECL.EXPRESSION);
  439. VAR A: X86.TIDX;
  440. BEGIN
  441.   IF (e.T.tType = TARRAY) & (e.T.Base.tType = TCHAR) & (e.T.Len # 0) THEN
  442.     A[0] := e.T.Len;
  443.     X86.OpenArray(A, 1)
  444.   ELSIF e.T.tType = TSTRING THEN
  445.     A[0] := LenString(e.Value) + 1;
  446.     IF A[0] # 2 THEN
  447.       X86.OpenArray(A, 1)
  448.     END
  449.   END
  450. END Str;
  451.  
  452. PROCEDURE StFunc(VAR e: DECL.EXPRESSION; func: INTEGER);
  453. VAR coord, coord2: SCAN.TCoord; a, b, p: INTEGER; e1, e2: DECL.EXPRESSION;
  454.     T: DECL.pTYPE; str, str2: UTILS.STRCONST;
  455. BEGIN
  456.   e.vparam := FALSE;
  457.   e.eType := eEXP;
  458.   Coord(coord2);
  459.   Check(lxLRound);
  460.   NextCoord(coord);
  461.   CASE func OF
  462.   |stABS:
  463.     pExpr(e1);
  464.     Assert(e1.T.tType IN TNUM, coord, 57);
  465.     Load(e1);
  466.     IF e1.eType = eCONST THEN
  467.       e.Value := ABS(e1.Value);
  468.       e.eType := eCONST;
  469.       Assert(~((e1.T.tType = TINTEGER) & (e1.Value = LONG(FLT(SCAN.minINT)))), coord, DECL.IOVER)
  470.     END;
  471.     IF e1.T.tType = TINTEGER THEN
  472.       X86.StFunc(X86.stABS)
  473.     ELSE
  474.       X86.StFunc(X86.stFABS)
  475.     END;
  476.     e.T := e1.T
  477.   |stODD:
  478.     pExpr(e1);
  479.     IntType(e1.T, coord);
  480.     Load(e1);
  481.     IF e1.eType = eCONST THEN
  482.       e.Value := LONG(FLT(ORD(ODD(FLOOR(e1.Value)))));
  483.       e.eType := eCONST
  484.     END;
  485.     X86.StFunc(X86.stODD);
  486.     e.T := booltype
  487.   |stLEN:
  488.     Designator(e1);
  489.     Assert((e1.eType = eVAR) & (e1.T.tType = TARRAY), coord, 102);
  490.     IF e1.T.Len > 0 THEN
  491.       X86.Len(-e1.T.Len)
  492.     ELSE
  493.       X86.Len(DECL.Dim(e1.T))
  494.     END;
  495.     e.T := inttype
  496.   |stLSL, stASR, stROR, stLSR:
  497.     pExpr(e1);
  498.     IntType(e1.T, coord);
  499.     Load(e1);
  500.     Check(lxComma);
  501.     NextCoord(coord);
  502.     pExpr(e2);
  503.     IntType(e2.T, coord);
  504.     Load(e2);
  505.     IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN
  506.       a := FLOOR(e1.Value);
  507.       b := FLOOR(e2.Value);
  508.       CASE func OF
  509.       |stLSL: a := LSL(a, b)
  510.       |stASR: a := ASR(a, b)
  511.       |stROR: a := ROR(a, b)
  512.       |stLSR: a := LSR(a, b)
  513.       ELSE
  514.       END;
  515.       e.Value := LONG(FLT(a));
  516.       e.eType := eCONST
  517.     END;
  518.     CASE func OF
  519.     |stLSL: X86.StFunc(X86.stLSL)
  520.     |stASR: X86.StFunc(X86.stASR)
  521.     |stROR: X86.StFunc(X86.stROR)
  522.     |stLSR: X86.StFunc(X86.stLSR)
  523.     ELSE
  524.     END;
  525.     e.T := inttype
  526.   |stFLOOR:
  527.     pExpr(e1);
  528.     Assert(e1.T.tType IN TFLOAT, coord, 66);
  529.     Load(e1);
  530.     IF e1.eType = eCONST THEN
  531.       Assert((e1.Value - 1.0D0 < LONG(FLT(SCAN.maxINT))) & (e1.Value >= LONG(FLT(SCAN.minINT))), coord, 74);
  532.       e.Value := LONG(FLT(FLOOR(e1.Value)));
  533.       e.eType := eCONST
  534.     END;
  535.     X86.StFunc(X86.stFLOOR);
  536.     e.T := inttype
  537.   |stFLT:
  538.     pExpr(e1);
  539.     IntType(e1.T, coord);
  540.     Load(e1);
  541.     IF e1.eType = eCONST THEN
  542.       e.Value := e1.Value;
  543.       e.eType := eCONST
  544.     END;
  545.     X86.StFunc(X86.stFLT);
  546.     e.T := realtype
  547.   |stORD:
  548.     pExpr(e1);
  549.     Assert(e1.T.tType IN {TCHAR, TBOOLEAN, TSET, TSTRING}, coord, 68);
  550.     IF e1.T.tType = TSTRING THEN
  551.       Assert(LenString(e1.Value) = 1, coord, 94)
  552.     END;
  553.     Load(e1);
  554.     IF e1.eType = eCONST THEN
  555.       IF e1.T.tType = TSTRING THEN
  556.         str := DECL.GetString(e1.Value);
  557.         e.Value := LONG(FLT(ORD(str.Str[0])))
  558.       ELSE
  559.         e.Value := e1.Value
  560.       END;
  561.       e.eType := eCONST
  562.     END;
  563.     IF e1.T.tType = TBOOLEAN THEN
  564.       X86.StFunc(X86.stORD)
  565.     END;
  566.     e.T := inttype
  567.   |stBITS:
  568.     pExpr(e1);
  569.     IntType(e1.T, coord);
  570.     Load(e1);
  571.     IF e1.eType = eCONST THEN
  572.       e.Value := e1.Value;
  573.       e.eType := eCONST
  574.     END;
  575.     e.T := settype
  576.   |stCHR:
  577.     pExpr(e1);
  578.     IntType(e1.T, coord);
  579.     Load(e1);
  580.     e.T := chartype;
  581.     IF e1.eType = eCONST THEN
  582.       Assert(ASR(FLOOR(e1.Value), 8) = 0, coord, 76);
  583.       str2 := DECL.AddMono(CHR(FLOOR(e1.Value)));
  584.       SYSTEM.GET(SYSTEM.ADR(str2), p);
  585.       e.Value := LONG(FLT(p));
  586.       e.T := strtype;
  587.       e.eType := eCONST
  588.     END
  589.   |stLONG:
  590.     pExpr(e1);
  591.     Assert(e1.T.tType = TREAL, coord, 71);
  592.     IF e1.eType = eCONST THEN
  593.       e.Value := e1.Value;
  594.       e.eType := eCONST
  595.     END;
  596.     Load(e1);
  597.     e.T := longrealtype
  598.   |stSHORT:
  599.     pExpr(e1);
  600.     Assert(e1.T.tType = TLONGREAL, coord, 70);
  601.     IF e1.eType = eCONST THEN
  602.       Assert(ABS(e1.Value) <= LONG(SCAN.maxREAL), coord, DECL.FOVER);
  603.       Assert(ABS(e1.Value) >= LONG(SCAN.minREAL), coord, DECL.UNDER);
  604.       e.Value := e1.Value;
  605.       e.eType := eCONST
  606.     END;
  607.     Load(e1);
  608.     e.T := realtype
  609.   |stLENGTH:
  610.     pExpr(e1);
  611.     Assert(IsString(e1), coord, 141);
  612.     IF e1.T.tType = TSTRING THEN
  613.       str := DECL.GetString(e1.Value);
  614.       IF str.Len = 1 THEN
  615.         X86.Mono(str.Number);
  616.         X86.StrMono
  617.       END;
  618.       e.Value := LONG(FLT(LENGTH(str.Str)));
  619.       e.eType := eCONST
  620.     END;
  621.     Str(e1);
  622.     e.T := inttype;
  623.     X86.StFunc(X86.stLENGTH)
  624.   |stMIN, stMAX:
  625.     pExpr(e1);
  626.     IntType(e1.T, coord);
  627.     Load(e1);
  628.     Check(lxComma);
  629.     NextCoord(coord);
  630.     pExpr(e2);
  631.     IntType(e2.T, coord);
  632.     Load(e2);
  633.     IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN
  634.       a := FLOOR(e1.Value);
  635.       b := FLOOR(e2.Value);
  636.       CASE func OF
  637.       |stMIN: a := MIN(a, b)
  638.       |stMAX: a := MAX(a, b)
  639.       ELSE
  640.       END;
  641.       e.Value := LONG(FLT(a));
  642.       e.eType := eCONST
  643.     END;
  644.     IF func = stMIN THEN
  645.       X86.StFunc(X86.stMIN)
  646.     ELSE
  647.       X86.StFunc(X86.stMAX)
  648.     END;
  649.     e.T := inttype
  650.   |sysADR:
  651.     Assert((SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxSTRING) OR (SCAN.tLex = lxCHX), coord, 43);
  652.     IF SCAN.tLex = lxIDENT THEN
  653.       Designator(e1);
  654.       Assert((e1.eType = eVAR) OR (e1.eType = ePROC) OR (e1.T = strtype), coord, 43);
  655.       IF e1.eType = ePROC THEN
  656.         X86.PushInt(e1.id.Number)
  657.       END
  658.     ELSE
  659.       pFactor(e1)
  660.     END;
  661.     IF e1.T = strtype THEN
  662.       str := DECL.GetString(e1.Value);
  663.       IF str.Len = 1 THEN
  664.         X86.Drop;
  665.         X86.PushInt(str.Number)
  666.       END
  667.     END;
  668.     e.T := inttype;
  669.     X86.ADR(DECL.Dim(e1.T))
  670.   |sysSIZE, sysTYPEID, sysINF:
  671.     DECL.SetSizeFunc;
  672.     Check(lxIDENT);
  673.     T := DECL.IdType(coord);
  674.     Assert(T # NIL, coord, 42);
  675.     e.eType := eCONST;
  676.     IF func = sysTYPEID THEN
  677.       e.T := inttype;
  678.       Assert(T.tType IN TOBJECT, coord, 47);
  679.       IF T.tType = TPOINTER THEN
  680.         T := T.Base
  681.       END;
  682.       e.Value := LONG(FLT(T.Number));
  683.       X86.PushConst(T.Number)
  684.     ELSIF func = sysSIZE THEN
  685.       e.T := inttype;
  686.       e.Value := LONG(FLT(T.Size));
  687.       X86.PushConst(T.Size)
  688.     ELSIF func = sysINF THEN
  689.       Assert(T.tType IN TFLOAT, coord, 91);
  690.       e.T := T;
  691.       e.Value := SYSTEM.INF(LONGREAL);
  692.       X86.PushFlt(e.Value)
  693.     END
  694.   ELSE
  695.     Assert(FALSE, coord2, 73)
  696.   END;
  697.   Check(lxRRound);
  698.   Next
  699. END StFunc;
  700.  
  701. PROCEDURE ProcTypeComp(T1, T2: DECL.pTYPE): BOOLEAN;
  702. VAR sp: INTEGER; stk: ARRAY 100, 2 OF DECL.pTYPE;
  703.  
  704.   PROCEDURE ProcTypeComp1(T1, T2: DECL.pTYPE): BOOLEAN;
  705.   VAR fp, ft: DECL.FIELD; Res: BOOLEAN;
  706.  
  707.     PROCEDURE TypeComp(T1, T2: DECL.pTYPE): BOOLEAN;
  708.     VAR Res: BOOLEAN;
  709.     BEGIN
  710.       IF (T1.tType = TARRAY) & (T2.tType = TARRAY) & (T1.Len = 0) & (T2.Len = 0) THEN
  711.         Res := TypeComp(T1.Base, T2.Base)
  712.       ELSE
  713.         Res := ProcTypeComp1(T1, T2)
  714.       END
  715.       RETURN Res
  716.     END TypeComp;
  717.  
  718.     PROCEDURE Check(): BOOLEAN;
  719.     VAR i: INTEGER; res: BOOLEAN;
  720.     BEGIN
  721.       i := 0;
  722.       res := FALSE;
  723.       WHILE (i < sp) & ~res DO
  724.         res := ((stk[i][0] = T1) & (stk[i][1] = T2)) OR ((stk[i][0] = T2) & (stk[i][1] = T1));
  725.         INC(i)
  726.       END
  727.       RETURN res
  728.     END Check;
  729.  
  730.   BEGIN
  731.     INC(sp);
  732.     stk[sp][0] := T1;
  733.     stk[sp][1] := T2;
  734.     IF Check() THEN
  735.       Res := TRUE
  736.     ELSE
  737.       IF (T1.tType = TPROC) & (T2.tType = TPROC) & (T1 # T2) THEN
  738.         Res := (T1.Call = T2.Call) & (T1.Fields.Count = T2.Fields.Count) & ProcTypeComp1(T1.Base, T2.Base);
  739.         fp := T1.Fields.First(DECL.FIELD);
  740.         ft := T2.Fields.First(DECL.FIELD);
  741.         WHILE Res & (fp # NIL) DO
  742.           Res := (fp.ByRef = ft.ByRef) & TypeComp(fp.T, ft.T);
  743.           fp := fp.Next(DECL.FIELD);
  744.           ft := ft.Next(DECL.FIELD)
  745.         END
  746.       ELSE
  747.         Res := T1 = T2
  748.       END
  749.     END;
  750.     DEC(sp)
  751.     RETURN Res
  752.   END ProcTypeComp1;
  753.  
  754. BEGIN
  755.   sp := -1
  756.   RETURN ProcTypeComp1(T1, T2)
  757. END ProcTypeComp;
  758.  
  759. PROCEDURE ArrComp(Ta, Tf: DECL.pTYPE): BOOLEAN;
  760. VAR Res: BOOLEAN;
  761. BEGIN
  762.   IF (Tf.tType = TARRAY) & (Tf.Len = 0) & (Ta.tType = TARRAY) THEN
  763.     Res := ArrComp(Ta.Base, Tf.Base)
  764.   ELSE
  765.     Res := ProcTypeComp(Ta, Tf)
  766.   END
  767.   RETURN Res
  768. END ArrComp;
  769.  
  770. PROCEDURE AssComp(e: DECL.EXPRESSION; T: DECL.pTYPE; param: BOOLEAN): BOOLEAN;
  771. VAR Res: BOOLEAN;
  772. BEGIN
  773.   CASE T.tType OF
  774.   |TINTEGER, TREAL, TLONGREAL, TSET, TBOOLEAN, TCARD16:
  775.     Res := e.T = T
  776.   |TCHAR:
  777.     IF e.T.tType = TSTRING THEN
  778.       Res := LenString(e.Value) = 1
  779.     ELSE
  780.       Res := e.T.tType = TCHAR
  781.     END
  782.   |TARRAY:
  783.     IF param THEN
  784.       IF T.Len = 0 THEN
  785.         IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
  786.           Res := TRUE
  787.         ELSE
  788.           Res := ArrComp(e.T, T)
  789.         END
  790.       ELSE
  791.         IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
  792.           Res := LenString(e.Value) <= T.Len
  793.         ELSE
  794.           Res := e.T = T
  795.         END
  796.       END
  797.     ELSE
  798.       IF T.Len = 0 THEN
  799.         Res := FALSE
  800.       ELSIF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN
  801.         Res := LenString(e.Value) <= T.Len
  802.       ELSE
  803.         Res := e.T = T
  804.       END
  805.     END
  806.   |TRECORD: Res := BaseOf(T, e.T)
  807.   |TPOINTER: Res := BaseOf(T, e.T) OR (e.T.tType = TNIL)
  808.   |TPROC: Res := (e.T.tType = TNIL) OR (e.eType = ePROC) & ProcTypeComp(e.id.T, T) OR
  809.     (e.eType # ePROC) & ProcTypeComp(e.T, T)
  810.   ELSE
  811.     Res := FALSE
  812.   END
  813.   RETURN Res
  814. END AssComp;
  815.  
  816. PROCEDURE ParamComp(e: DECL.EXPRESSION; T: DECL.pTYPE; ByRef: BOOLEAN): BOOLEAN;
  817. VAR Res: BOOLEAN;
  818. BEGIN
  819.   IF ByRef THEN
  820.     IF e.eType = eVAR THEN
  821.       CASE T.tType OF
  822.       |TINTEGER, TREAL, TLONGREAL, TCHAR,
  823.        TSET, TBOOLEAN, TPOINTER, TCARD16:
  824.         Res := e.T = T
  825.       |TARRAY:
  826.         IF T.Len > 0 THEN
  827.           Res := e.T = T
  828.         ELSE
  829.           Res := ArrComp(e.T, T)
  830.         END
  831.       |TRECORD:
  832.         Res := BaseOf(T, e.T)
  833.       |TPROC:
  834.         Res := ProcTypeComp(e.T, T)
  835.       ELSE
  836.       END
  837.     ELSE
  838.       Res := FALSE
  839.     END
  840.   ELSE
  841.     Res := AssComp(e, T, TRUE)
  842.   END
  843.   RETURN Res
  844. END ParamComp;
  845.  
  846. PROCEDURE Call(param: DECL.FIELD);
  847. VAR coord: SCAN.TCoord; i, n: INTEGER; e1: DECL.EXPRESSION; s: UTILS.STRCONST; A: X86.TIDX; TA: DECL.pTYPE;
  848. BEGIN
  849.   WHILE param # NIL DO
  850.     Coord(coord);
  851.     X86.Param;
  852.     pExpr(e1);
  853.     Assert(ParamComp(e1, param.T, param.ByRef), coord, 114);
  854.     Assert(~(param.ByRef & e1.Read), coord, 115);
  855.     Assert(~((e1.eType = ePROC) & (e1.id.Level > 3)), coord, 116);
  856.     IF (e1.eType = eVAR) & ~param.ByRef THEN
  857.       X86.Load(e1.T.tType)
  858.     END;
  859.     IF param.ByRef & (e1.T.tType = TRECORD) THEN
  860.       IF e1.vparam THEN
  861.         X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level);
  862.         X86.Load(TINTEGER)
  863.       ELSIF e1.deref THEN
  864.         X86.DerefType(0)
  865.       ELSE
  866.         X86.PushConst(e1.T.Number)
  867.       END
  868.     END;
  869.     IF ~param.ByRef & (param.T.tType IN TFLOAT) THEN
  870.       X86.DropFpu(param.T.tType = TLONGREAL)
  871.     END;
  872.     IF (e1.T.tType = TSTRING) & (param.T.tType = TARRAY) THEN
  873.       IF param.T.Len > X86.maxstrlen THEN
  874.           X86.set_maxstrlen(param.T.Len)
  875.       END;
  876.       s := DECL.GetString(e1.Value);
  877.       IF s.Len = 1 THEN
  878.         X86.Mono(s.Number)
  879.       END;
  880.       IF param.T.Len = 0 THEN
  881.         A[0] := s.Len + 1;
  882.         X86.OpenArray(A, 1)
  883.       END
  884.     END;
  885.     IF (e1.T.tType = TARRAY) & (DECL.Dim(param.T) > DECL.Dim(e1.T)) THEN
  886.       n := DECL.Dim(param.T) - DECL.Dim(e1.T);
  887.       TA := DECL.OpenBase(e1.T);
  888.       FOR i := 0 TO n - 1 DO
  889.         A[i] := TA.Len;
  890.         TA := TA.Base
  891.       END;
  892.       IF DECL.Dim(e1.T) = 0 THEN
  893.         X86.OpenArray(A, n)
  894.       ELSE
  895.         X86.ExtArray(A, n, DECL.Dim(e1.T))
  896.       END
  897.     END;
  898.     param := param.Next(DECL.FIELD);
  899.     IF param # NIL THEN
  900.       Check(lxComma);
  901.       Next
  902.     END
  903.   END;
  904.   Check(lxRRound);
  905.   Next
  906. END Call;
  907.  
  908. PROCEDURE Factor(VAR e: DECL.EXPRESSION);
  909. VAR coord: SCAN.TCoord; ccall, p: INTEGER; begcall: X86.ASMLINE; s, str2: UTILS.STRCONST;
  910. BEGIN
  911.   e.eType := eCONST;
  912.   e.vparam := FALSE;
  913.   CASE SCAN.tLex OF
  914.   |lxIDENT:
  915.     begcall := X86.current;
  916.     Designator(e);
  917.     IF e.eType = ePROC THEN
  918.       IF SCAN.tLex = lxLRound THEN
  919.         Assert2(e.id.T.Base.tType # TVOID, 73);
  920.         Next;
  921.         X86.PushCall(begcall);
  922.         Call(e.id.T.Fields.First(DECL.FIELD));
  923.         X86.EndCall;
  924.         e.eType := eEXP;
  925.         e.T := e.id.T.Base;
  926.         IF e.id.Level = 3 THEN
  927.           ccall := 0
  928.         ELSIF e.id.Level > DECL.curBlock.Level THEN
  929.           ccall := 1
  930.         ELSE
  931.           ccall := 2
  932.         END;
  933.         X86.Call(e.id.Number, TRUE, e.T.tType IN TFLOAT, e.id.T.Call, ccall, e.id.Level - 3,
  934.           DECL.curBlock.Level - 3, e.id.ParamSize, DECL.curBlock.LocalSize)
  935.       ELSE
  936.         X86.PushInt(e.id.Number)
  937.       END
  938.     ELSIF (e.eType = eVAR) & (e.T.tType = TPROC) & (SCAN.tLex = lxLRound) THEN
  939.       Assert2(e.T.Base.tType # TVOID, 73);
  940.       Next;
  941.       X86.PushCall(begcall);
  942.       Call(e.T.Fields.First(DECL.FIELD));
  943.       X86.EndCall;
  944.       e.eType := eEXP;
  945.       X86.CallVar(TRUE, e.T.Base.tType IN TFLOAT, e.T.Call, e.T.Len, DECL.curBlock.LocalSize);
  946.       e.T := e.T.Base;
  947.     ELSIF e.eType IN {eSTPROC, eSYSPROC} THEN
  948.       StFunc(e, e.id.StProc)
  949.     END
  950.   |lxNIL:
  951.     e.T := niltype;
  952.     e.Value := 0.0D0;
  953.     X86.PushConst(0);
  954.     Next
  955.   |lxTRUE:
  956.     e.T := booltype;
  957.     e.Value := 1.0D0;
  958.     X86.PushConst(1);
  959.     Next
  960.   |lxFALSE:
  961.     e.T := booltype;
  962.     e.Value := 0.0D0;
  963.     X86.PushConst(0);
  964.     Next
  965.   |lxCHX, lxSTRING:
  966.     IF SCAN.tLex = lxSTRING THEN
  967.       str2 := DECL.AddString(SCAN.Lex);
  968.       SYSTEM.GET(SYSTEM.ADR(str2), p);
  969.       e.Value := LONG(FLT(p));
  970.       s := DECL.GetString(e.Value);
  971.       IF s.Len = 1 THEN
  972.         X86.PushConst(ORD(s.Str[0]))
  973.       ELSE
  974.         X86.PushInt(s.Number)
  975.       END
  976.     ELSE
  977.       str2 := DECL.AddMono(SCAN.vCHX);
  978.       SYSTEM.GET(SYSTEM.ADR(str2), p);
  979.       e.Value := LONG(FLT(p));
  980.       X86.PushConst(ORD(SCAN.vCHX))
  981.     END;
  982.     e.T := strtype;
  983.     Next
  984.   |lxREAL:
  985.     e.T := realtype;
  986.     e.Value := SCAN.vFLT;
  987.     X86.PushFlt(SCAN.vFLT);
  988.     Next
  989.   |lxLONGREAL:
  990.     e.T := longrealtype;
  991.     e.Value := SCAN.vFLT;
  992.     X86.PushFlt(SCAN.vFLT);
  993.     Next
  994.   |lxINT, lxHEX:
  995.     e.T := inttype;
  996.     e.Value := LONG(FLT(SCAN.vINT));
  997.     X86.PushConst(SCAN.vINT);
  998.     Next
  999.   |lxLRound:
  1000.     Next;
  1001.     pExpr(e);
  1002.     Check(lxRRound);
  1003.     Next
  1004.   |lxNot:
  1005.     NextCoord(coord);
  1006.     Factor(e);
  1007.     Assert(e.T.tType = TBOOLEAN, coord, 37);
  1008.     Load(e);
  1009.     IF e.eType = eCONST THEN
  1010.       e.Value := LONG(FLT(ORD(e.Value = 0.0D0)))
  1011.     ELSE
  1012.       e.eType := eEXP
  1013.     END;
  1014.     X86.Not;
  1015.     e.vparam := FALSE
  1016.   |lxLCurly:
  1017.     Set(e)
  1018.   ELSE
  1019.     Assert2(FALSE, 36)
  1020.   END
  1021. END Factor;
  1022.  
  1023. PROCEDURE IsChr(a: DECL.EXPRESSION): BOOLEAN;
  1024.   RETURN (a.T.tType = TSTRING) & (LenString(a.Value) = 1) OR (a.T.tType = TCHAR)
  1025. END IsChr;
  1026.  
  1027. PROCEDURE StrRel(a, b: DECL.EXPRESSION; Op: INTEGER);
  1028. BEGIN
  1029.   IF ~(IsChr(a) OR IsChr(b)) THEN
  1030.     X86.strcmp(Op, 0)
  1031.   ELSIF IsChr(a) & IsChr(b) THEN
  1032.     X86.CmpInt(Op)
  1033.   ELSIF IsChr(a) THEN
  1034.     X86.strcmp(Op, 1)
  1035.   ELSE
  1036.     X86.strcmp(Op, -1)
  1037.   END
  1038. END StrRel;
  1039.  
  1040. PROCEDURE log2(n: INTEGER): INTEGER;
  1041. VAR x, i: INTEGER;
  1042. BEGIN
  1043.   x := 1;
  1044.   i := 0;
  1045.   WHILE (x # n) & (i < 31) DO
  1046.     x := LSL(x, 1);
  1047.     INC(i)
  1048.   END;
  1049.   IF x # n THEN
  1050.     i := -1
  1051.   END
  1052.   RETURN i
  1053. END log2;
  1054.  
  1055. PROCEDURE Operation(VAR a, b: DECL.EXPRESSION; Op: INTEGER; coord: SCAN.TCoord);
  1056. VAR n, m: INTEGER;
  1057. BEGIN
  1058.   CASE Op OF
  1059.   |lxPlus, lxMinus, lxMult, lxSlash:
  1060.     Assert((a.T.tType IN (TNUM + {TSET})) & (a.T.tType = b.T.tType), coord, 37);
  1061.     Assert(~((Op = lxSlash) & (a.T.tType = TINTEGER)), coord, 37);
  1062.     CASE a.T.tType OF
  1063.     |TINTEGER: X86.Int(Op)
  1064.     |TSET: X86.Set(Op)
  1065.     |TREAL, TLONGREAL: X86.farith(Op)
  1066.     ELSE
  1067.     END
  1068.   |lxDIV, lxMOD:
  1069.     Assert((a.T.tType = TINTEGER) & (b.T.tType = TINTEGER), coord, 37);
  1070.     IF b.eType = eCONST THEN
  1071.       m := FLOOR(b.Value);
  1072.       Assert(m # 0, coord, 48);
  1073.       n := log2(m);
  1074.       IF n = -1 THEN
  1075.         X86.idivmod(Op = lxMOD)
  1076.       ELSE
  1077.         X86.Drop;
  1078.         IF Op = lxMOD THEN
  1079.           n := ORD(-BITS(LSL(-1, n)));
  1080.           X86.PushConst(n);
  1081.           X86.Set(lxMult)
  1082.         ELSE
  1083.           X86.PushConst(n);
  1084.           X86.StFunc(X86.stASR)
  1085.         END
  1086.       END
  1087.     ELSE
  1088.       X86.idivmod(Op = lxMOD)
  1089.     END
  1090.   |lxAnd, lxOR:
  1091.     Assert((a.T.tType = TBOOLEAN) & (b.T.tType = TBOOLEAN), coord, 37)
  1092.   |lxIN:
  1093.     Assert((a.T.tType = TINTEGER) & (b.T.tType = TSET), coord, 37);
  1094.     X86.inset
  1095.   |lxLT, lxLE, lxGT, lxGE:
  1096.     Assert(((a.T.tType IN TNUM) & (a.T.tType = b.T.tType)) OR
  1097.       (IsChr(a) OR IsString(a)) & (IsChr(b) OR IsString(b)) OR
  1098.       (a.T.tType = TSET) & (b.T.tType = TSET) & ((Op = lxLE) OR (Op = lxGE)), coord, 37);
  1099.     IF a.T.tType IN TFLOAT THEN
  1100.       X86.fcmp(Op)
  1101.     ELSIF a.T.tType = TSET THEN
  1102.       X86.Inclusion(Op)
  1103.     ELSIF IsString(a) OR IsString(b) THEN
  1104.       StrRel(a, b, Op)
  1105.     ELSE
  1106.       X86.CmpInt(Op)
  1107.     END
  1108.   |lxEQ, lxNE:
  1109.     Assert(((a.T.tType IN (TNUM + {TSET, TBOOLEAN})) & (a.T.tType = b.T.tType)) OR
  1110.       (IsChr(a) OR IsString(a)) & (IsChr(b) OR IsString(b)) OR
  1111.       (a.T.tType IN {TPOINTER, TPROC, TNIL}) & (b.T.tType = TNIL) OR
  1112.       (b.T.tType IN {TPOINTER, TPROC, TNIL}) & (a.T.tType = TNIL) OR
  1113.       (a.T.tType = TPOINTER) & (b.T.tType = TPOINTER) & (BaseOf(a.T, b.T) OR BaseOf(b.T, a.T)) OR
  1114.       (a.T.tType = TPROC) & ProcTypeComp(b.T, a.T) OR (a.eType = ePROC) & ProcTypeComp(b.T, a.id.T) OR
  1115.       (b.eType = ePROC) & ProcTypeComp(a.T, b.id.T), coord, 37);
  1116.     IF a.T.tType IN TFLOAT THEN
  1117.       X86.fcmp(Op)
  1118.     ELSIF IsString(a) OR IsString(b) THEN
  1119.       StrRel(a, b, Op)
  1120.     ELSE
  1121.       X86.CmpInt(Op)
  1122.     END
  1123.   ELSE
  1124.   END;
  1125.   IF (a.eType # eCONST) OR (b.eType # eCONST) THEN
  1126.     a.eType := eEXP;
  1127.     IF DECL.Relation(Op) THEN
  1128.       a.T := booltype
  1129.     END
  1130.   ELSE
  1131.     DECL.Calc(a.Value, b.Value, a.T, b.T, Op, coord, a.Value, a.T)
  1132.   END;
  1133.   a.vparam := FALSE
  1134. END Operation;
  1135.  
  1136. PROCEDURE Term(VAR e: DECL.EXPRESSION);
  1137. VAR a: DECL.EXPRESSION; Op, L: INTEGER; coord: SCAN.TCoord;
  1138. BEGIN
  1139.   Factor(e);
  1140.   WHILE (SCAN.tLex = lxMult) OR (SCAN.tLex = lxSlash) OR
  1141.     (SCAN.tLex = lxDIV) OR (SCAN.tLex = lxMOD) OR
  1142.      (SCAN.tLex = lxAnd) DO
  1143.     Load(e);
  1144.     Coord(coord);
  1145.     Op := SCAN.tLex;
  1146.     Next;
  1147.     IF Op = lxAnd THEN
  1148.       L := X86.NewLabel();
  1149.       X86.IfWhile(L, FALSE)
  1150.     END;
  1151.     Factor(a);
  1152.     Load(a);
  1153.     IF Op = lxAnd THEN
  1154.       X86.Label(L)
  1155.     END;
  1156.     Operation(e, a, Op, coord)
  1157.   END
  1158. END Term;
  1159.  
  1160. PROCEDURE Simple(VAR e: DECL.EXPRESSION);
  1161. VAR a: DECL.EXPRESSION; Op, uOp, L: INTEGER; coord, ucoord: SCAN.TCoord;
  1162. BEGIN
  1163.   uOp := 0;
  1164.   IF (SCAN.tLex = lxPlus) OR (SCAN.tLex = lxMinus) THEN
  1165.     Coord(ucoord);
  1166.     uOp := SCAN.tLex;
  1167.     Next
  1168.   END;
  1169.   Term(e);
  1170.   IF uOp # 0 THEN
  1171.     Assert(e.T.tType IN (TNUM + {TSET}), ucoord, 37);
  1172.     Load(e);
  1173.     IF uOp = lxMinus THEN
  1174.       CASE e.T.tType OF
  1175.       |TINTEGER: X86.NegInt
  1176.       |TSET: X86.NegSet
  1177.       |TREAL, TLONGREAL: X86.fneg
  1178.       ELSE
  1179.       END
  1180.     END;
  1181.     IF (uOp = lxMinus) & (e.eType = eCONST) THEN
  1182.       CASE e.T.tType OF
  1183.       |TINTEGER:
  1184.         Assert(e.Value # LONG(FLT(SCAN.minINT)), ucoord, DECL.IOVER)
  1185.       |TSET:
  1186.         e.Value := -LONG(FLT(ORD(-BITS(FLOOR(e.Value)))))
  1187.       ELSE
  1188.       END;
  1189.       e.Value := -e.Value
  1190.     END;
  1191.     IF e.eType # eCONST THEN
  1192.       e.eType := eEXP
  1193.     END;
  1194.     e.vparam := FALSE
  1195.   END;
  1196.   WHILE (SCAN.tLex = lxPlus) OR (SCAN.tLex = lxMinus) OR (SCAN.tLex = lxOR) DO
  1197.     Load(e);
  1198.     Coord(coord);
  1199.     Op := SCAN.tLex;
  1200.     Next;
  1201.     IF Op = lxOR THEN
  1202.       L := X86.NewLabel();
  1203.       X86.IfWhile(L, TRUE)
  1204.     END;
  1205.     Term(a);
  1206.     Load(a);
  1207.     IF Op = lxOR THEN
  1208.       X86.Label(L)
  1209.     END;
  1210.     Operation(e, a, Op, coord)
  1211.   END
  1212. END Simple;
  1213.  
  1214. PROCEDURE Expr(VAR e: DECL.EXPRESSION);
  1215. VAR a: DECL.EXPRESSION; coord, coord2: SCAN.TCoord; Op, fpu: INTEGER; T: DECL.pTYPE; beg: X86.ASMLINE; s: UTILS.STRCONST;
  1216. BEGIN
  1217.   fpu := X86.fpu;
  1218.   beg := X86.current;
  1219.   Simple(e);
  1220.   IF DECL.Relation(SCAN.tLex) THEN
  1221.     Coord(coord);
  1222.     Op := SCAN.tLex;
  1223.     Next;
  1224.     IF Op = lxIS THEN
  1225.       Assert(e.T.tType IN TOBJECT, coord, 37);
  1226.       IF e.T.tType = TRECORD THEN
  1227.         Assert(e.vparam, coord, 37)
  1228.       END;
  1229.       Check(lxIDENT);
  1230.       Coord(coord2);
  1231.       T := DECL.IdType(coord2);
  1232.       Assert(T # NIL, coord2, 42);
  1233.       IF e.T.tType = TRECORD THEN
  1234.         Assert(T.tType = TRECORD, coord2, 106)
  1235.       ELSE
  1236.         Assert(T.tType = TPOINTER, coord2, 107)
  1237.       END;
  1238.       Assert(BaseOf(e.T, T), coord, 37);
  1239.       IF e.T.tType = TRECORD THEN
  1240.         X86.Drop;
  1241.         X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level)
  1242.       END;
  1243.       Load(e);
  1244.       IF e.T.tType = TPOINTER THEN
  1245.         T := T.Base
  1246.       END;
  1247.       X86.Guard(T.Number, TRUE);
  1248.       e.T := booltype;
  1249.       e.eType := eEXP;
  1250.       e.vparam := FALSE
  1251.     ELSE
  1252.       Load(e);
  1253.       Str(e);
  1254.       Simple(a);
  1255.       Load(a);
  1256.       Str(a);
  1257.       Operation(e, a, Op, coord)
  1258.     END
  1259.   END;
  1260.   IF e.eType = eCONST THEN
  1261.     X86.Del(beg);
  1262.     X86.Setfpu(fpu);
  1263.     IF ~DECL.Const THEN
  1264.       CASE e.T.tType OF
  1265.       |TREAL, TLONGREAL:
  1266.         X86.PushFlt(e.Value)
  1267.       |TINTEGER, TSET, TBOOLEAN, TNIL:
  1268.         X86.PushConst(FLOOR(e.Value))
  1269.       |TSTRING:
  1270.         s := DECL.GetString(e.Value);
  1271.         IF s.Len = 1 THEN
  1272.           X86.PushConst(ORD(s.Str[0]))
  1273.         ELSE
  1274.           X86.PushInt(s.Number)
  1275.         END
  1276.       ELSE
  1277.       END
  1278.     END
  1279.   END
  1280. END Expr;
  1281.  
  1282. PROCEDURE IfWhileOper(wh: BOOLEAN);
  1283. VAR e: DECL.EXPRESSION; coord: SCAN.TCoord; L, L3: INTEGER;
  1284. BEGIN
  1285.   L := X86.NewLabel();
  1286.   IF wh THEN
  1287.     X86.Label(L)
  1288.   END;
  1289.   REPEAT
  1290.     NextCoord(coord);
  1291.     Expr(e);
  1292.     Assert(e.T.tType = TBOOLEAN, coord, 117);
  1293.     Load(e);
  1294.     IF wh THEN
  1295.       Check(lxDO)
  1296.     ELSE
  1297.       Check(lxTHEN)
  1298.     END;
  1299.     L3 := X86.NewLabel();
  1300.     X86.ifwh(L3);
  1301.     Next;
  1302.     pOpSeq;
  1303.     X86.jmp(X86.JMP, L);
  1304.     X86.Label(L3)
  1305.   UNTIL SCAN.tLex # lxELSIF;
  1306.   IF ~wh & (SCAN.tLex = lxELSE) THEN
  1307.     Next;
  1308.     pOpSeq
  1309.   END;
  1310.   Check(lxEND);
  1311.   IF ~wh THEN
  1312.     X86.Label(L)
  1313.   END;
  1314.   Next
  1315. END IfWhileOper;
  1316.  
  1317. PROCEDURE RepeatOper;
  1318. VAR e: DECL.EXPRESSION; coord: SCAN.TCoord; L: INTEGER;
  1319. BEGIN
  1320.   Next;
  1321.   L := X86.NewLabel();
  1322.   X86.Label(L);
  1323.   pOpSeq;
  1324.   Check(lxUNTIL);
  1325.   NextCoord(coord);
  1326.   Expr(e);
  1327.   Assert(e.T.tType = TBOOLEAN, coord, 117);
  1328.   Load(e);
  1329.   X86.ifwh(L)
  1330. END RepeatOper;
  1331.  
  1332. PROCEDURE ForOper;
  1333. VAR e: DECL.EXPRESSION; coord: SCAN.TCoord; LBeg, LEnd, iValue: INTEGER; Value: LONGREAL;
  1334.     T: DECL.pTYPE; name: SCAN.NODE; id: DECL.IDENT;
  1335. BEGIN
  1336.   NextCheck(lxIDENT);
  1337.   name := SCAN.id;
  1338.   id := DECL.GetIdent(name);
  1339.   Assert2(id # NIL, 42);
  1340.   Assert2(id.iType = IDVAR, 126);
  1341.   Assert2(id.VarKind = 0, 127);
  1342.   Assert2(id.T.tType = TINTEGER, 128);
  1343.   Assert2(id.Level = DECL.unit.Level, 129);
  1344.   NextCheck(lxAssign);
  1345.   NextCoord(coord);
  1346.   IF id.Level = 3 THEN
  1347.     X86.GlobalAdr(id.Offset)
  1348.   ELSE
  1349.     X86.LocalAdr(id.Offset, 0)
  1350.   END;
  1351.   X86.Dup;
  1352.   Expr(e);
  1353.   IntType(e.T, coord);
  1354.   Load(e);
  1355.   X86.Save(TINTEGER);
  1356.   Check(lxTO);
  1357.   NextCoord(coord);
  1358.   Expr(e);
  1359.   IntType(e.T, coord);
  1360.   Load(e);
  1361.   iValue := 1;
  1362.   IF SCAN.tLex = lxBY THEN
  1363.     NextCoord(coord);
  1364.     DECL.ConstExpr(Value, T);
  1365.     IntType(T, coord);
  1366.     iValue := FLOOR(Value);
  1367.     Assert(iValue # 0, coord, 122)
  1368.   END;
  1369.   Check(lxDO);
  1370.   Next;
  1371.   X86.For(iValue > 0, LBeg, LEnd);
  1372.   pOpSeq;
  1373.   X86.NextFor(iValue, LBeg, LEnd);
  1374.   Check(lxEND);
  1375.   Next
  1376. END ForOper;
  1377.  
  1378. PROCEDURE CheckLabel(a, b: INTEGER; Labels: UTILS.LIST): BOOLEAN;
  1379. VAR cur: LABEL;
  1380. BEGIN
  1381.   cur := Labels.First(LABEL);
  1382.   WHILE (cur # NIL) & ((b < cur.a) OR (a > cur.b)) DO
  1383.     cur := cur.Next(LABEL)
  1384.   END
  1385.   RETURN cur = NIL
  1386. END CheckLabel;
  1387.  
  1388. PROCEDURE LabelVal(VAR a: INTEGER; int: BOOLEAN);
  1389. VAR Value: LONGREAL; T: DECL.pTYPE; s: UTILS.STRCONST; coord: SCAN.TCoord;
  1390. BEGIN
  1391.   Coord(coord);
  1392.   DECL.ConstExpr(Value, T);
  1393.   IF int THEN
  1394.     Assert(T.tType = TINTEGER, coord, 161);
  1395.     a := FLOOR(Value)
  1396.   ELSE
  1397.     Assert(T.tType = TSTRING, coord, 55);
  1398.     s := DECL.GetString(Value);
  1399.     Assert(s.Len = 1, coord, 94);
  1400.     a := ORD(s.Str[0])
  1401.   END
  1402. END LabelVal;
  1403.  
  1404. PROCEDURE Label(int: BOOLEAN; Labels: UTILS.LIST; LBeg: INTEGER);
  1405. VAR a, b: INTEGER; label: LABEL; coord: SCAN.TCoord;
  1406. BEGIN
  1407.   Coord(coord);
  1408.   LabelVal(a, int);
  1409.   b := a;
  1410.   IF SCAN.tLex = lxDbl THEN
  1411.     Next;
  1412.     LabelVal(b, int)
  1413.   END;
  1414.   Assert(a <= b, coord, 54);
  1415.   Assert(CheckLabel(a, b, Labels), coord, 100);
  1416.   NEW(label);
  1417.   DECL.MemErr(label = NIL);
  1418.   label.a := a;
  1419.   label.b := b;
  1420.   UTILS.Push(Labels, label);
  1421.   X86.CaseLabel(a, b, LBeg)
  1422. END Label;
  1423.  
  1424. PROCEDURE Variant(int: BOOLEAN; Labels: UTILS.LIST; EndCase: INTEGER);
  1425. VAR LBeg, LEnd: INTEGER;
  1426. BEGIN
  1427.   LBeg := X86.NewLabel();
  1428.   LEnd := X86.NewLabel();
  1429.   IF ~((SCAN.tLex = lxStick) OR (SCAN.tLex = lxEND)) THEN
  1430.     Label(int, Labels, LBeg);
  1431.     WHILE SCAN.tLex = lxComma DO
  1432.       Next;
  1433.       Label(int, Labels, LBeg)
  1434.     END;
  1435.     Check(lxColon);
  1436.     Next;
  1437.     X86.jmp(X86.JMP, LEnd);
  1438.     X86.Label(LBeg);
  1439.     pOpSeq;
  1440.     X86.jmp(X86.JMP, EndCase);
  1441.     X86.Label(LEnd)
  1442.   END
  1443. END Variant;
  1444.  
  1445. PROCEDURE CaseOper;
  1446. VAR e: DECL.EXPRESSION; int: BOOLEAN; coord: SCAN.TCoord; EndCase: INTEGER; Labels: UTILS.LIST;
  1447. BEGIN
  1448.   NextCoord(coord);
  1449.   Expr(e);
  1450.   Assert(e.T.tType IN {TCHAR, TSTRING, TINTEGER}, coord, 156);
  1451.   Assert(~((e.T.tType = TSTRING) & (LenString(e.Value) # 1)), coord, 94);
  1452.   int := e.T.tType = TINTEGER;
  1453.   Check(lxOF);
  1454.   Load(e);
  1455.   X86.Drop;
  1456.   Labels := UTILS.CreateList();
  1457.   Next;
  1458.   EndCase := X86.NewLabel();
  1459.   Variant(int, Labels, EndCase);
  1460.   WHILE SCAN.tLex = lxStick DO
  1461.     Next;
  1462.     Variant(int, Labels, EndCase)
  1463.   END;
  1464.   IF SCAN.tLex = lxELSE THEN
  1465.     Next;
  1466.     pOpSeq
  1467.   ELSE
  1468.     UTILS.UnitLine(DECL.UnitNumber, SCAN.coord.line);
  1469.     X86.OnError(7)
  1470.   END;
  1471.   Check(lxEND);
  1472.   X86.Label(EndCase);
  1473.   Next;
  1474.   UTILS.Clear(Labels)
  1475. END CaseOper;
  1476.  
  1477. PROCEDURE CheckCode(Code: UTILS.STRING; Len: INTEGER; coord: SCAN.TCoord);
  1478. VAR i: INTEGER;
  1479. BEGIN
  1480.   Assert(~ODD(Len), coord, 34);
  1481.   FOR i := 0 TO Len - 1 DO
  1482.     Assert(SCAN.HexDigit(Code[i]), coord, 34)
  1483.   END
  1484. END CheckCode;
  1485.  
  1486. PROCEDURE StProc(proc: INTEGER);
  1487. VAR coord, coord2: SCAN.TCoord; iValue: INTEGER; e1, e2: DECL.EXPRESSION; Value: LONGREAL;
  1488.     T: DECL.pTYPE; str: UTILS.STRCONST; begcall: X86.ASMLINE;
  1489. BEGIN
  1490.   Coord(coord2);
  1491.   Check(lxLRound);
  1492.   NextCoord(coord);
  1493.   CASE proc OF
  1494.   |stINC, stDEC:
  1495.     Designator(e1);
  1496.     Assert(e1.eType = eVAR, coord, 63);
  1497.     Assert(~e1.Read, coord, 115);
  1498.     Assert(e1.T.tType = TINTEGER, coord, 128);
  1499.     IF SCAN.tLex = lxComma THEN
  1500.       NextCoord(coord);
  1501.       DECL.ConstExpr(Value, T);
  1502.       IntType(T, coord);
  1503.       iValue := FLOOR(Value);
  1504.       Assert(iValue # 0, coord, 122);
  1505.       IF iValue < 0 THEN
  1506.         IF proc = stINC THEN
  1507.           proc := stDEC
  1508.         ELSE
  1509.           proc := stINC
  1510.         END;
  1511.         iValue := -iValue
  1512.       END;
  1513.       IF iValue # 1 THEN
  1514.         X86.PushConst(iValue);
  1515.         IF proc = stDEC THEN
  1516.           X86.StProc(X86.stDEC)
  1517.         ELSE
  1518.           X86.StProc(X86.stINC)
  1519.         END
  1520.       ELSE
  1521.         IF proc = stDEC THEN
  1522.           X86.StProc(X86.stDEC1)
  1523.         ELSE
  1524.           X86.StProc(X86.stINC1)
  1525.         END
  1526.       END
  1527.     ELSE
  1528.       IF proc = stDEC THEN
  1529.         X86.StProc(X86.stDEC1)
  1530.       ELSE
  1531.         X86.StProc(X86.stINC1)
  1532.       END
  1533.     END
  1534.   |stINCL, stEXCL:
  1535.     Designator(e1);
  1536.     Assert(e1.eType = eVAR, coord, 63);
  1537.     Assert(~e1.Read, coord, 115);
  1538.     Assert(e1.T.tType = TSET, coord, 138);
  1539.     Check(lxComma);
  1540.     NextCoord(coord);
  1541.     DECL.ConstExpr(Value, T);
  1542.     IntType(T, coord);
  1543.     iValue := FLOOR(Value);
  1544.     Assert(ASR(iValue, 5) = 0, coord, 53);
  1545.     IF proc = stINCL THEN
  1546.       X86.PushConst(ORD({iValue}));
  1547.       X86.StProc(X86.stINCL)
  1548.     ELSE
  1549.       X86.PushConst(ORD(-{iValue}));
  1550.       X86.StProc(X86.stEXCL)
  1551.     END
  1552.   |stCOPY:
  1553.     Expr(e1);
  1554.     Assert(IsString(e1), coord, 141);
  1555.     Check(lxComma);
  1556.     IF e1.T.tType = TSTRING THEN
  1557.       str := DECL.GetString(e1.Value);
  1558.       IF str.Len = 1 THEN
  1559.         X86.Mono(str.Number);
  1560.         X86.StrMono
  1561.       END
  1562.     END;
  1563.     Str(e1);
  1564.     NextCoord(coord);
  1565.     Designator(e2);
  1566.     Assert(e2.eType = eVAR, coord, 63);
  1567.     Assert(IsString(e2), coord, 143);
  1568.     Assert(~e2.Read, coord, 115);
  1569.     Str(e2);
  1570.     X86.StProc(X86.stCOPY)
  1571.   |stNEW, stDISPOSE:
  1572.     Designator(e1);
  1573.     Assert(e1.eType = eVAR, coord, 63);
  1574.     Assert(~e1.Read, coord, 115);
  1575.     Assert(e1.T.tType = TPOINTER, coord, 145);
  1576.     IF proc = stNEW THEN
  1577.       X86.PushConst(e1.T.Base.Number);
  1578.       X86.PushConst(X86.Align(e1.T.Base.Size + 8, 32));
  1579.       X86.newrec
  1580.     ELSE
  1581.       X86.disprec
  1582.     END
  1583.   |stASSERT:
  1584.     Expr(e1);
  1585.     Assert(e1.T.tType = TBOOLEAN, coord, 117);
  1586.     Load(e1);
  1587.     IF SCAN.tLex = lxComma THEN
  1588.       NextCoord(coord);
  1589.       DECL.ConstExpr(Value, T);
  1590.       IntType(T, coord);
  1591.       Assert((Value >= 0.0D0) & (Value <= 127.0D0), coord, 95);
  1592.       X86.Assert(X86.stASSERT, FLOOR(Value))
  1593.     ELSE
  1594.       X86.Assert(X86.stASSERT1, 0)
  1595.     END
  1596.   |stPACK, stUNPK:
  1597.     Designator(e1);
  1598.     Assert(e1.eType = eVAR, coord, 63);
  1599.     Assert(e1.T.tType IN TFLOAT, coord, 149);
  1600.     Assert(~e1.Read, coord, 115);
  1601.     Check(lxComma);
  1602.     NextCoord(coord);
  1603.     IF proc = stUNPK THEN
  1604.       Designator(e2);
  1605.       Assert(e2.eType = eVAR, coord, 63);
  1606.       Assert(e2.T.tType = TINTEGER, coord, 128);
  1607.       Assert(~e2.Read, coord, 115);
  1608.       IF e1.T.tType = TLONGREAL THEN
  1609.         X86.StProc(X86.stUNPK)
  1610.       ELSE
  1611.         X86.StProc(X86.stUNPK1)
  1612.       END
  1613.     ELSE
  1614.       Expr(e2);
  1615.       IntType(e2.T, coord);
  1616.       Load(e2);
  1617.       IF e1.T.tType = TLONGREAL THEN
  1618.         X86.StProc(X86.stPACK)
  1619.       ELSE
  1620.         X86.StProc(X86.stPACK1)
  1621.       END
  1622.     END
  1623.   |sysPUT, sysGET:
  1624.     begcall := X86.current;
  1625.     Expr(e1);
  1626.     IntType(e1.T, coord);
  1627.     Load(e1);
  1628.     Check(lxComma);
  1629.     NextCoord(coord);
  1630.     IF proc = sysGET THEN
  1631.       X86.PushCall(begcall);
  1632.       X86.Param;
  1633.       Designator(e2);
  1634.       Assert(e2.eType = eVAR, coord, 63);
  1635.       Assert(~(e2.T.tType IN TSTRUCT), coord, 90);
  1636.       Assert(~e2.Read, coord, 115);
  1637.       X86.EndCall;
  1638.       X86.Load(e2.T.tType);
  1639.       X86.Save(e2.T.tType)
  1640.     ELSE
  1641.       Expr(e2);
  1642.       Assert(~(e2.T.tType IN TSTRUCT), coord, 90);
  1643.       IF e2.T.tType = TSTRING THEN
  1644.         Assert(LenString(e2.Value) = 1, coord, 94)
  1645.       ELSIF e2.T.tType = TVOID THEN
  1646.         e2.T := inttype
  1647.       END;
  1648.       Load(e2);
  1649.       X86.Save(e2.T.tType)
  1650.     END
  1651.   |sysCODE:
  1652.     Assert(SCAN.tLex = lxSTRING, coord, 150);
  1653.     CheckCode(SCAN.Lex, SCAN.count - 1, coord);
  1654.     X86.Asm(SCAN.Lex);
  1655.     Next
  1656.   |sysMOVE:
  1657.     begcall := X86.current;
  1658.     Expr(e1);
  1659.     IntType(e1.T, coord);
  1660.     Load(e1);
  1661.     Check(lxComma);
  1662.     X86.PushCall(begcall);
  1663.     X86.Param;
  1664.     NextCoord(coord);
  1665.     Expr(e1);
  1666.     IntType(e1.T, coord);
  1667.     Load(e1);
  1668.     Check(lxComma);
  1669.     X86.EndCall;
  1670.     NextCoord(coord);
  1671.     Expr(e1);
  1672.     IntType(e1.T, coord);
  1673.     Load(e1);
  1674.   |sysCOPY:
  1675.     begcall := X86.current;
  1676.     Designator(e1);
  1677.     Assert(e1.eType = eVAR, coord, 63);
  1678.     Check(lxComma);
  1679.     X86.PushCall(begcall);
  1680.     X86.Param;
  1681.     NextCoord(coord);
  1682.     Designator(e1);
  1683.     Assert(e1.eType = eVAR, coord, 63);
  1684.     Assert(~e1.Read, coord, 115);
  1685.     Check(lxComma);
  1686.     X86.EndCall;
  1687.     NextCoord(coord);
  1688.     Expr(e1);
  1689.     IntType(e1.T, coord);
  1690.     Load(e1);
  1691.   ELSE
  1692.     Assert(FALSE, coord2, 132)
  1693.   END;
  1694.   Check(lxRRound);
  1695.   Next;
  1696.   IF (proc = sysMOVE) OR (proc = sysCOPY) THEN
  1697.     X86.StProc(X86.sysMOVE)
  1698.   END
  1699. END StProc;
  1700.  
  1701. PROCEDURE IdentOper;
  1702. VAR e1, e2: DECL.EXPRESSION; coord: SCAN.TCoord; ccall: INTEGER; begcall: X86.ASMLINE; s: UTILS.STRCONST;
  1703. BEGIN
  1704.   Coord(coord);
  1705.   begcall := X86.current;
  1706.   Designator(e1);
  1707.   Assert(e1.eType # eCONST, coord, 130);
  1708.   IF (e1.eType = eVAR) & (e1.T.tType # TPROC) THEN
  1709.     Check(lxAssign);
  1710.     Assert(~e1.Read, coord, 115);
  1711.     NextCoord(coord);
  1712.     Expr(e2);
  1713.     Assert(AssComp(e2, e1.T, FALSE), coord, 131);
  1714.     Load(e2);
  1715.     IF e1.T.tType = TRECORD THEN
  1716.       X86.PushConst(e1.T.Size);
  1717.       X86.PushConst(e1.T.Number);
  1718.       IF e1.vparam THEN
  1719.         X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level);
  1720.         X86.Load(TINTEGER)
  1721.       ELSIF e1.deref THEN
  1722.         X86.DerefType(12)
  1723.       ELSE
  1724.         X86.PushConst(e1.T.Number)
  1725.       END
  1726.     ELSIF e2.T.tType = TARRAY THEN
  1727.       X86.PushConst(e2.T.Size)
  1728.     ELSIF (e2.T.tType = TSTRING) & (e1.T.tType = TARRAY) THEN
  1729.       s := DECL.GetString(e2.Value);
  1730.       IF s.Len = 1 THEN
  1731.         X86.Mono(s.Number)
  1732.       END;
  1733.       X86.PushConst(MIN(s.Len + 1, e1.T.Len))
  1734.     END;
  1735.     X86.Save(e1.T.tType)
  1736.   ELSIF e1.eType = ePROC THEN
  1737.     Assert((e1.id.T.Base.tType = TVOID) OR (e1.id.T.Call = DECL.winapi), coord, 132);
  1738.     IF e1.id.ParamCount > 0 THEN
  1739.       Check(lxLRound);
  1740.       Next;
  1741.       X86.PushCall(begcall);
  1742.       Call(e1.id.T.Fields.First(DECL.FIELD));
  1743.       X86.EndCall
  1744.     ELSIF SCAN.tLex = lxLRound THEN
  1745.       NextCheck(lxRRound);
  1746.       Next
  1747.     END;
  1748.     IF e1.id.Level = 3 THEN
  1749.       ccall := 0
  1750.     ELSIF e1.id.Level > DECL.curBlock.Level THEN
  1751.       ccall := 1
  1752.     ELSE
  1753.       ccall := 2
  1754.     END;
  1755.     X86.Call(e1.id.Number, FALSE, FALSE, e1.id.T.Call, ccall, e1.id.Level - 3, DECL.curBlock.Level - 3, e1.id.ParamSize, DECL.curBlock.LocalSize)
  1756.   ELSIF e1.eType IN {eSTPROC, eSYSPROC} THEN
  1757.     StProc(e1.id.StProc)
  1758.   ELSIF (e1.eType = eVAR) & (e1.T.tType = TPROC) THEN
  1759.     IF SCAN.tLex = lxLRound THEN
  1760.       Next;
  1761.       Assert((e1.T.Base.tType = TVOID) OR (e1.T.Call = DECL.winapi), coord, 132);
  1762.       X86.PushCall(begcall);
  1763.       Call(e1.T.Fields.First(DECL.FIELD));
  1764.       X86.EndCall;
  1765.       X86.CallVar(FALSE, FALSE, e1.T.Call, e1.T.Len, DECL.curBlock.LocalSize)
  1766.     ELSIF SCAN.tLex = lxAssign THEN
  1767.       Assert(~e1.Read, coord, 115);
  1768.       NextCoord(coord);
  1769.       Expr(e2);
  1770.       Assert(AssComp(e2, e1.T, FALSE), coord, 131);
  1771.       Assert(~((e2.eType = ePROC) & (e2.id.Level > 3)), coord, 116);
  1772.       IF e2.eType = eVAR THEN
  1773.         X86.Load(TPROC)
  1774.       END;
  1775.       X86.Save(TPROC)
  1776.     ELSE
  1777.       Assert2(e1.T.Fields.Count = 0, 155);
  1778.       Assert((e1.T.Base.tType = TVOID) OR (e1.T.Call = DECL.winapi), coord, 132);
  1779.       X86.CallVar(FALSE, FALSE, e1.T.Call, e1.T.Len, DECL.curBlock.LocalSize)
  1780.     END
  1781.   END
  1782. END IdentOper;
  1783.  
  1784. PROCEDURE Operator;
  1785. BEGIN
  1786.   UTILS.UnitLine(DECL.UnitNumber, SCAN.coord.line);
  1787.   CASE SCAN.tLex OF
  1788.   |lxIDENT: IdentOper
  1789.   |lxIF, lxWHILE: IfWhileOper(SCAN.tLex = lxWHILE)
  1790.   |lxREPEAT: RepeatOper
  1791.   |lxFOR: ForOper
  1792.   |lxCASE: CaseOper
  1793.   ELSE
  1794.   END
  1795. END Operator;
  1796.  
  1797. PROCEDURE OpSeq;
  1798. BEGIN
  1799.   Operator;
  1800.   WHILE SCAN.tLex = lxSemi DO
  1801.     Next;
  1802.     Operator
  1803.   END
  1804. END OpSeq;
  1805.  
  1806. PROCEDURE Start;
  1807. VAR SelfName, SelfPath, CName, CExt, FName, Path, StdPath,
  1808.     Name, Ext, temp, system, stk: UTILS.STRING;
  1809.     platform, stksize: INTEGER;
  1810.  
  1811.   PROCEDURE getstksize(): INTEGER;
  1812.   VAR res, i: INTEGER;
  1813.   BEGIN
  1814.     res := 0;
  1815.     i := 0;
  1816.     WHILE SCAN.Digit(stk[i]) DO
  1817.       INC(i)
  1818.     END;
  1819.     IF stk[i] <= 20X THEN
  1820.       stk[i] := 0X;
  1821.       res := SCAN.StrToInt(stk)
  1822.     END;
  1823.     IF res = 0 THEN
  1824.       res := 1
  1825.     END
  1826.     RETURN res
  1827.   END getstksize;
  1828.  
  1829.   PROCEDURE getver(): INTEGER;
  1830.   VAR res, i: INTEGER; err: BOOLEAN;
  1831.  
  1832.     PROCEDURE hexdgt(c: CHAR): BOOLEAN;
  1833.       RETURN ("0" <= c) & (c <= "9") OR
  1834.              ("A" <= c) & (c <= "F") OR
  1835.              ("a" <= c) & (c <= "f")
  1836.     END hexdgt;
  1837.  
  1838.     PROCEDURE hex(c: CHAR): INTEGER;
  1839.     VAR res: INTEGER;
  1840.     BEGIN
  1841.       IF    ("0" <= c) & (c <= "9") THEN
  1842.         res := ORD(c) - ORD("0")
  1843.       ELSIF ("A" <= c) & (c <= "F") THEN
  1844.         res := ORD(c) - ORD("A") + 10
  1845.       ELSIF ("a" <= c) & (c <= "f") THEN
  1846.         res := ORD(c) - ORD("a") + 10
  1847.       END
  1848.       RETURN res
  1849.     END hex;
  1850.  
  1851.   BEGIN
  1852.     res := 0;
  1853.     i := 0;
  1854.     err := stk[i] # "0"; INC(i);
  1855.     err := err OR (stk[i] # "x"); INC(i);
  1856.     WHILE ~err & hexdgt(stk[i]) DO
  1857.       INC(i)
  1858.     END;
  1859.     err := err OR (i = 2);
  1860.     IF stk[i] <= 20X THEN
  1861.       stk[i] := 0X
  1862.     ELSE
  1863.       err := TRUE
  1864.     END;
  1865.     i := 2;
  1866.     WHILE ~err & (stk[i] # 0X) DO
  1867.       res := LSL(res, 4) + hex(stk[i]);
  1868.       INC(i)
  1869.     END;
  1870.     IF res = 0 THEN
  1871.       res := 65536
  1872.     END
  1873.     RETURN res
  1874.   END getver;
  1875.  
  1876. BEGIN
  1877.   IF UTILS.ParamCount < 2 THEN
  1878.     UTILS.ErrMsg(59);
  1879.     UTILS.HALT(1)
  1880.   END;
  1881.   UTILS.ParamStr(SelfName, 0);
  1882.   UTILS.ParamStr(FName, 1);
  1883.   UTILS.ParamStr(system, 2);
  1884.   UTILS.ParamStr(stk, 3);
  1885.   pExpr := Expr;
  1886.   pFactor := Factor;
  1887.   pOpSeq := OpSeq;
  1888.   UTILS.Split(FName, Path, Name, Ext);
  1889.   IF Ext # UTILS.Ext THEN
  1890.     UTILS.ErrMsg(121);
  1891.     UTILS.HALT(1)
  1892.   END;
  1893.   UTILS.Split(SelfName, SelfPath, CName, CExt);
  1894.   temp := Name;
  1895.   IF UTILS.streq(system, "kem") THEN
  1896.     X86.setkem;
  1897.     platform := 4;
  1898.     UTILS.concat(temp, ".kex")
  1899.   ELSIF UTILS.streq(system, "obj") THEN
  1900.     platform := 6;
  1901.     UTILS.concat(temp, ".obj")
  1902.   ELSIF UTILS.streq(system, "elf") THEN
  1903.     platform := 5
  1904.   ELSIF UTILS.streq(system, "kos") THEN
  1905.     platform := 4;
  1906.     UTILS.concat(temp, ".kex")
  1907.   ELSIF UTILS.streq(system, "con") THEN
  1908.     platform := 3;
  1909.     UTILS.concat(temp, ".exe")
  1910.   ELSIF UTILS.streq(system, "gui") THEN
  1911.     platform := 2;
  1912.     UTILS.concat(temp, ".exe")
  1913.   ELSIF UTILS.streq(system, "dll") THEN
  1914.     platform := 1;
  1915.     UTILS.concat(temp, ".dll")
  1916.   ELSE
  1917.     UTILS.ErrMsg(60);
  1918.     UTILS.HALT(1)
  1919.   END;
  1920.   IF platform IN {1, 2, 3, 4} THEN
  1921.     stksize := getstksize()
  1922.   ELSE
  1923.     stksize := 1
  1924.   END;
  1925.   IF platform = 6 THEN
  1926.     stksize := getver()
  1927.   END;
  1928.   UTILS.concat(SelfPath, "Lib");
  1929.   UTILS.concat(SelfPath, UTILS.Slash);
  1930.   IF platform = 5 THEN
  1931.     UTILS.concat(SelfPath, "Linux32")
  1932.   ELSIF platform IN {4, 6} THEN
  1933.     UTILS.concat(SelfPath, "KolibriOS")
  1934.   ELSIF platform IN {1, 2, 3} THEN
  1935.     UTILS.concat(SelfPath, "Windows32")
  1936.   END;
  1937.   UTILS.concat(SelfPath, UTILS.Slash);
  1938.   X86.set_maxstrlen(0);
  1939.   X86.Init(platform);
  1940.   X86.Prolog(temp);
  1941.   DECL.Program(SelfPath, Path, Name, Ext, platform IN {1, 2, 3}, OpSeq, Expr, AssComp, sttypes);
  1942.   voidtype := sttypes[TVOID];
  1943.   inttype := sttypes[TINTEGER];
  1944.   booltype := sttypes[TBOOLEAN];
  1945.   strtype := sttypes[TSTRING];
  1946.   settype := sttypes[TSET];
  1947.   realtype := sttypes[TREAL];
  1948.   longrealtype := sttypes[TLONGREAL];
  1949.   chartype := sttypes[TCHAR];
  1950.   niltype := sttypes[TNIL];
  1951.   DECL.Compile(platform, stksize);
  1952.   UTILS.OutString("success"); UTILS.Ln;
  1953.   UTILS.HALT(0)
  1954. END Start;
  1955.  
  1956. BEGIN
  1957.   Start
  1958. END Compiler.