Subversion Repositories Kolibri OS

Rev

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

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