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

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

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/Compiler.ob07 – Rev 7209