WebSVN – Kolibri OS – Blame – /programs/develop/oberon07/source/Compiler.ob07

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

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/source/Compiler.ob07 @ 8859 – Rev 7107