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