Subversion Repositories Kolibri OS

Rev

Rev 7209 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

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