Subversion Repositories Kolibri OS

Rev

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

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