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

Rev	Author	Line No.	Line
7983	leency	1	(*
7597	akron1	2	BSD 2-Clause License
		3
7983	leency	4	Copyright (c) 2018-2020, Anton Krotov
7597	akron1	5	All rights reserved.
		6	*)
		7
		8	MODULE STATEMENTS;
		9
		10	IMPORT
		11
7983	leency	12	PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB,
		13	ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
7597	akron1	14
		15
		16	CONST
		17
		18	eCONST = PARS.eCONST; eTYPE = PARS.eTYPE; eVAR = PARS.eVAR;
		19	eEXPR = PARS.eEXPR; eVREC = PARS.eVREC; ePROC = PARS.ePROC;
		20	eVPAR = PARS.eVPAR; ePARAM = PARS.ePARAM; eSTPROC = PARS.eSTPROC;
		21	eSTFUNC = PARS.eSTFUNC; eSYSFUNC = PARS.eSYSFUNC; eSYSPROC = PARS.eSYSPROC;
		22	eIMP = PARS.eIMP;
		23
7693	akron1	24	errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4;
		25	errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8;
7597	akron1	26	errCHR = 9; errWCHR = 10; errBYTE = 11;
		27
		28	chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
		29
		30	chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};
		31
		32
		33	TYPE
		34
		35	isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;
		36
		37	RANGE = RECORD
		38
		39	a, b: INTEGER
		40
		41	END;
		42
		43	CASE_LABEL = POINTER TO rCASE_LABEL;
		44
		45	rCASE_LABEL = RECORD (AVL.DATA)
		46
		47	range: RANGE;
		48
		49	variant, self: INTEGER;
		50
		51	type: PROG.TYPE_;
		52
		53	prev: CASE_LABEL
		54
		55	END;
		56
		57	CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)
		58
7693	akron1	59	label: INTEGER;
		60	cmd: IL.COMMAND;
		61	processed: BOOLEAN
7597	akron1	62
		63	END;
		64
		65
		66	VAR
		67
7693	akron1	68	Options: PROG.OPTIONS;
7597	akron1	69
7693	akron1	70	begcall, endcall: IL.COMMAND;
7597	akron1	71
		72	CaseLabels, CaseVar: C.COLLECTION;
		73
		74	CaseVariants: LISTS.LIST;
		75
7693	akron1	76	CPU: INTEGER;
7597	akron1	77
7693	akron1	78	tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_;
		79
		80
7597	akron1	81	PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
		82	RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}
		83	END isExpr;
		84
		85
		86	PROCEDURE isVar (e: PARS.EXPR): BOOLEAN;
		87	RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC}
		88	END isVar;
		89
		90
		91	PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
7693	akron1	92	RETURN isExpr(e) & (e.type = tBOOLEAN)
7597	akron1	93	END isBoolean;
		94
		95
		96	PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
7693	akron1	97	RETURN isExpr(e) & (e.type = tINTEGER)
7597	akron1	98	END isInteger;
		99
		100
		101	PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
7693	akron1	102	RETURN isExpr(e) & (e.type = tBYTE)
7597	akron1	103	END isByte;
		104
		105
		106	PROCEDURE isInt (e: PARS.EXPR): BOOLEAN;
		107	RETURN isByte(e) OR isInteger(e)
		108	END isInt;
		109
		110
		111	PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
7693	akron1	112	RETURN isExpr(e) & (e.type = tREAL)
7597	akron1	113	END isReal;
		114
		115
		116	PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
7693	akron1	117	RETURN isExpr(e) & (e.type = tSET)
7597	akron1	118	END isSet;
		119
		120
		121	PROCEDURE isString (e: PARS.EXPR): BOOLEAN;
		122	RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR})
		123	END isString;
		124
		125
		126	PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;
		127	RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
		128	END isStringW;
		129
		130
		131	PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
7693	akron1	132	RETURN isExpr(e) & (e.type = tCHAR)
7597	akron1	133	END isChar;
		134
		135
		136	PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
7693	akron1	137	RETURN isExpr(e) & (e.type = tWCHAR)
7597	akron1	138	END isCharW;
		139
		140
		141	PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
		142	RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER)
		143	END isPtr;
		144
		145
		146	PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;
		147	RETURN isExpr(e) & (e.type.typ = PROG.tRECORD)
		148	END isRec;
		149
		150
7693	akron1	151	PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN;
		152	RETURN isRec(e) OR isPtr(e)
		153	END isRecPtr;
		154
		155
7597	akron1	156	PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
		157	RETURN isExpr(e) & (e.type.typ = PROG.tARRAY)
		158	END isArr;
		159
		160
		161	PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;
		162	RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
		163	END isProc;
		164
		165
		166	PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;
		167	RETURN e.type.typ = PROG.tNIL
		168	END isNil;
		169
		170
7693	akron1	171	PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
		172	RETURN isArr(e) & (e.type.base = tCHAR)
		173	END isCharArray;
		174
		175
		176	PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
		177	RETURN isArr(e) & (e.type.base = tWCHAR)
		178	END isCharArrayW;
		179
		180
		181	PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
		182	RETURN isCharArray(e) OR isCharArrayW(e)
		183	END isCharArrayX;
		184
		185
		186	PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
7597	akron1	187	BEGIN
7693	akron1	188	pos.line := parser.lex.pos.line;
		189	pos.col := parser.lex.pos.col;
		190	pos.parser := parser
7597	akron1	191	END getpos;
		192
		193
7693	akron1	194	PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
7597	akron1	195	BEGIN
7693	akron1	196	PARS.Next(parser);
		197	getpos(parser, pos)
7597	akron1	198	END NextPos;
		199
		200
		201	PROCEDURE strlen (e: PARS.EXPR): INTEGER;
		202	VAR
		203	res: INTEGER;
		204
		205	BEGIN
		206	ASSERT(isString(e));
7693	akron1	207	IF e.type = tCHAR THEN
7597	akron1	208	res := 1
		209	ELSE
		210	res := LENGTH(e.value.string(SCAN.IDENT).s)
		211	END
		212	RETURN res
		213	END strlen;
		214
		215
		216	PROCEDURE _length (s: ARRAY OF CHAR): INTEGER;
		217	VAR
		218	i, res: INTEGER;
		219
		220	BEGIN
		221	i := 0;
		222	res := 0;
		223	WHILE (i < LEN(s)) & (s[i] # 0X) DO
		224	IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN
		225	INC(res)
		226	END;
		227	INC(i)
		228	END
		229
		230	RETURN res
		231	END _length;
		232
		233
		234	PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER;
		235	VAR
		236	res: INTEGER;
		237
		238	BEGIN
		239	ASSERT(isStringW(e));
		240	IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
		241	res := 1
		242	ELSE
		243	res := _length(e.value.string(SCAN.IDENT).s)
		244	END
		245	RETURN res
		246	END utf8strlen;
		247
		248
		249	PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER;
		250	VAR
		251	res: ARRAY 2 OF WCHAR;
		252
		253	BEGIN
		254	ASSERT(STRINGS.Utf8To16(s, res) = 1)
		255	RETURN ORD(res[0])
		256	END StrToWChar;
		257
		258
		259	PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN;
		260	RETURN (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
		261	END isStringW1;
		262
		263
		264	PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN;
		265	VAR
		266	res: BOOLEAN;
		267
		268	BEGIN
		269	IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
7696	akron1	270
		271	IF t = e.type THEN
7597	akron1	272	res := TRUE
		273	ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
7693	akron1	274	IF (e.obj = eCONST) & (t = tBYTE) THEN
7597	akron1	275	res := ARITH.range(e.value, 0, 255)
		276	ELSE
		277	res := TRUE
		278	END
7696	akron1	279	ELSIF
		280	(e.obj = eCONST) & isChar(e) & (t = tWCHAR)
		281	OR isStringW1(e) & (t = tWCHAR)
		282	OR PROG.isBaseOf(t, e.type)
		283	OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type)
		284	OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE})
		285	OR PROG.arrcomp(e.type, t)
		286	OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))
		287	OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))
		288	THEN
7597	akron1	289	res := TRUE
		290	ELSE
		291	res := FALSE
		292	END
		293	ELSE
		294	res := FALSE
		295	END
7696	akron1	296
7597	akron1	297	RETURN res
		298	END assigncomp;
		299
		300
		301	PROCEDURE String (e: PARS.EXPR): INTEGER;
		302	VAR
		303	offset: INTEGER;
		304	string: SCAN.IDENT;
		305
		306	BEGIN
		307	IF strlen(e) # 1 THEN
		308	string := e.value.string(SCAN.IDENT);
		309	IF string.offset = -1 THEN
7693	akron1	310	string.offset := IL.putstr(string.s);
7597	akron1	311	END;
		312	offset := string.offset
		313	ELSE
7693	akron1	314	offset := IL.putstr1(ARITH.Int(e.value))
7597	akron1	315	END
		316
		317	RETURN offset
		318	END String;
		319
		320
		321	PROCEDURE StringW (e: PARS.EXPR): INTEGER;
		322	VAR
		323	offset: INTEGER;
		324	string: SCAN.IDENT;
		325
		326	BEGIN
		327	IF utf8strlen(e) # 1 THEN
		328	string := e.value.string(SCAN.IDENT);
		329	IF string.offsetW = -1 THEN
7693	akron1	330	string.offsetW := IL.putstrW(string.s);
7597	akron1	331	END;
		332	offset := string.offsetW
		333	ELSE
		334	IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
7693	akron1	335	offset := IL.putstrW1(ARITH.Int(e.value))
7597	akron1	336	ELSE (* e.type.typ = PROG.tSTRING *)
		337	string := e.value.string(SCAN.IDENT);
		338	IF string.offsetW = -1 THEN
7693	akron1	339	string.offsetW := IL.putstrW(string.s);
7597	akron1	340	END;
		341	offset := string.offsetW
		342	END
		343	END
		344
		345	RETURN offset
		346	END StringW;
		347
		348
		349	PROCEDURE CheckRange (range, line, errno: INTEGER);
		350	VAR
		351	label: INTEGER;
		352
		353	BEGIN
7693	akron1	354	label := IL.NewLabel();
		355	IL.AddCmd2(IL.opCHKIDX, label, range);
		356	IL.OnError(line, errno);
		357	IL.SetLabel(label)
7597	akron1	358	END CheckRange;
		359
		360
		361	PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN;
		362	VAR
7983	leency	363	res: BOOLEAN;
		364	label: INTEGER;
7597	akron1	365
		366	BEGIN
		367	IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
		368	res := TRUE;
7696	akron1	369	IF PROG.arrcomp(e.type, VarType) THEN
7597	akron1	370
		371	IF ~PROG.isOpenArray(VarType) THEN
7693	akron1	372	IL.Const(VarType.length)
7597	akron1	373	END;
7693	akron1	374	IL.AddCmd(IL.opCOPYA, VarType.base.size);
		375	label := IL.NewLabel();
		376	IL.AddJmpCmd(IL.opJE, label);
		377	IL.OnError(line, errCOPY);
		378	IL.SetLabel(label)
7597	akron1	379
		380	ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
7693	akron1	381	IF VarType = tINTEGER THEN
7597	akron1	382	IF e.obj = eCONST THEN
7693	akron1	383	IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
7597	akron1	384	ELSE
7693	akron1	385	IL.AddCmd0(IL.opSAVE)
7597	akron1	386	END
		387	ELSE
		388	IF e.obj = eCONST THEN
		389	res := ARITH.range(e.value, 0, 255);
		390	IF res THEN
7693	akron1	391	IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
7597	akron1	392	END
		393	ELSE
7693	akron1	394	IF chkBYTE IN Options.checking THEN
		395	label := IL.NewLabel();
		396	IL.AddCmd2(IL.opCHKBYTE, label, 0);
		397	IL.OnError(line, errBYTE);
		398	IL.SetLabel(label)
7597	akron1	399	END;
7693	akron1	400	IL.AddCmd0(IL.opSAVE8)
7597	akron1	401	END
		402	END
7693	akron1	403	ELSIF isSet(e) & (VarType = tSET) THEN
7597	akron1	404	IF e.obj = eCONST THEN
7693	akron1	405	IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
7597	akron1	406	ELSE
7693	akron1	407	IL.AddCmd0(IL.opSAVE)
7597	akron1	408	END
7693	akron1	409	ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN
7597	akron1	410	IF e.obj = eCONST THEN
7693	akron1	411	IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value))
7597	akron1	412	ELSE
7693	akron1	413	IL.AddCmd0(IL.opSBOOL)
7597	akron1	414	END
7693	akron1	415	ELSIF isReal(e) & (VarType = tREAL) THEN
7597	akron1	416	IF e.obj = eCONST THEN
7693	akron1	417	IL.Float(ARITH.Float(e.value))
7597	akron1	418	END;
7983	leency	419	IL.savef(e.obj = eCONST)
7693	akron1	420	ELSIF isChar(e) & (VarType = tCHAR) THEN
7597	akron1	421	IF e.obj = eCONST THEN
7693	akron1	422	IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
7597	akron1	423	ELSE
7693	akron1	424	IL.AddCmd0(IL.opSAVE8)
7597	akron1	425	END
7693	akron1	426	ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN
		427	IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
		428	ELSIF isStringW1(e) & (VarType = tWCHAR) THEN
		429	IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s))
		430	ELSIF isCharW(e) & (VarType = tWCHAR) THEN
7597	akron1	431	IF e.obj = eCONST THEN
7693	akron1	432	IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
7597	akron1	433	ELSE
7693	akron1	434	IL.AddCmd0(IL.opSAVE16)
7597	akron1	435	END
		436	ELSIF PROG.isBaseOf(VarType, e.type) THEN
		437	IF VarType.typ = PROG.tPOINTER THEN
7693	akron1	438	IL.AddCmd0(IL.opSAVE)
7597	akron1	439	ELSE
7693	akron1	440	IL.AddCmd(IL.opCOPY, VarType.size)
7597	akron1	441	END
		442	ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
7693	akron1	443	IL.AddCmd0(IL.opSAVE32)
7597	akron1	444	ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN
		445	IF e.obj = ePROC THEN
7693	akron1	446	IL.AssignProc(e.ident.proc.label)
7597	akron1	447	ELSIF e.obj = eIMP THEN
7693	akron1	448	IL.AssignImpProc(e.ident.import)
7597	akron1	449	ELSE
		450	IF VarType.typ = PROG.tPROCEDURE THEN
7693	akron1	451	IL.AddCmd0(IL.opSAVE)
7597	akron1	452	ELSE
7693	akron1	453	IL.AddCmd(IL.opCOPY, VarType.size)
7597	akron1	454	END
		455	END
		456	ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
7693	akron1	457	IL.AddCmd(IL.opSAVEC, 0)
		458	ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN
		459	IL.saves(String(e), strlen(e) + 1)
		460	ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN
		461	IL.saves(StringW(e), (utf8strlen(e) + 1) * 2)
7597	akron1	462	ELSE
		463	res := FALSE
		464	END
		465	ELSE
		466	res := FALSE
		467	END
		468	RETURN res
		469	END assign;
		470
		471
		472	PROCEDURE LoadConst (e: PARS.EXPR);
		473	BEGIN
7693	akron1	474	IL.Const(ARITH.Int(e.value))
7597	akron1	475	END LoadConst;
		476
		477
7693	akron1	478	PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM);
		479	VAR
		480	stroffs: INTEGER;
7597	akron1	481
		482	PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
		483	VAR
		484	t1, t2: PROG.TYPE_;
		485
		486	BEGIN
		487	t1 := p.type;
		488	t2 := e.type;
		489	WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO
		490	t1 := t1.base;
		491	t2 := t2.base
		492	END
		493
		494	RETURN PROG.isTypeEq(t1, t2)
		495	END arrcomp;
		496
		497
		498	PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER;
		499	VAR
		500	res: INTEGER;
7983	leency	501
7597	akron1	502	BEGIN
		503	REPEAT
		504	res := t.length;
		505	t := t.base;
		506	DEC(n)
		507	UNTIL (n < 0) OR (t.typ # PROG.tARRAY);
		508	ASSERT(n < 0)
		509	RETURN res
		510	END ArrLen;
		511
		512
		513	PROCEDURE OpenArray (t, t2: PROG.TYPE_);
		514	VAR
7983	leency	515	n, d1, d2: INTEGER;
		516
7597	akron1	517	BEGIN
		518	IF t.length # 0 THEN
7693	akron1	519	IL.Param1;
7597	akron1	520	n := PROG.Dim(t2) - 1;
		521	WHILE n >= 0 DO
7693	akron1	522	IL.Const(ArrLen(t, n));
		523	IL.Param1;
7597	akron1	524	DEC(n)
		525	END
		526	ELSE
		527	d1 := PROG.Dim(t);
		528	d2 := PROG.Dim(t2);
		529	IF d1 # d2 THEN
		530	n := d2 - d1;
		531	WHILE d2 > d1 DO
7693	akron1	532	IL.Const(ArrLen(t, d2 - 1));
7597	akron1	533	DEC(d2)
		534	END;
		535	d2 := PROG.Dim(t2);
		536	WHILE n > 0 DO
7693	akron1	537	IL.AddCmd(IL.opROT, d2);
7597	akron1	538	DEC(n)
		539	END
		540	END;
7693	akron1	541	IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1)
7597	akron1	542	END
		543	END OpenArray;
		544
		545
		546	BEGIN
		547	IF p.vPar THEN
		548
7693	akron1	549	PARS.check(isVar(e), pos, 93);
7597	akron1	550	IF p.type.typ = PROG.tRECORD THEN
7693	akron1	551	PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66);
7597	akron1	552	IF e.obj = eVREC THEN
		553	IF e.ident # NIL THEN
7693	akron1	554	IL.AddCmd(IL.opVADR, e.ident.offset - 1)
7597	akron1	555	ELSE
7693	akron1	556	IL.AddCmd0(IL.opPUSHT)
7597	akron1	557	END
		558	ELSE
7693	akron1	559	IL.Const(e.type.num)
7597	akron1	560	END;
7693	akron1	561	IL.AddCmd(IL.opPARAM, 2)
7597	akron1	562	ELSIF PROG.isOpenArray(p.type) THEN
7693	akron1	563	PARS.check(arrcomp(e, p), pos, 66);
7597	akron1	564	OpenArray(e.type, p.type)
		565	ELSE
7693	akron1	566	PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66);
		567	IL.Param1
7597	akron1	568	END;
7693	akron1	569	PARS.check(~e.readOnly, pos, 94)
7597	akron1	570
		571	ELSE
7693	akron1	572	PARS.check(isExpr(e) OR isProc(e), pos, 66);
7597	akron1	573	IF PROG.isOpenArray(p.type) THEN
		574	IF e.type.typ = PROG.tARRAY THEN
7693	akron1	575	PARS.check(arrcomp(e, p), pos, 66);
7597	akron1	576	OpenArray(e.type, p.type)
7693	akron1	577	ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN
		578	IL.StrAdr(String(e));
		579	IL.Param1;
		580	IL.Const(strlen(e) + 1);
		581	IL.Param1
		582	ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tWCHAR) THEN
		583	IL.StrAdr(StringW(e));
		584	IL.Param1;
		585	IL.Const(utf8strlen(e) + 1);
		586	IL.Param1
7597	akron1	587	ELSE
7693	akron1	588	PARS.error(pos, 66)
7597	akron1	589	END
		590	ELSE
7693	akron1	591	PARS.check(~PROG.isOpenArray(e.type), pos, 66);
		592	PARS.check(assigncomp(e, p.type), pos, 66);
7597	akron1	593	IF e.obj = eCONST THEN
7693	akron1	594	IF e.type = tREAL THEN
		595	IL.Float(ARITH.Float(e.value));
		596	IL.pushf
7597	akron1	597	ELSIF e.type.typ = PROG.tNIL THEN
7693	akron1	598	IL.Const(0);
		599	IL.Param1
		600	ELSIF isStringW1(e) & (p.type = tWCHAR) THEN
		601	IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s));
		602	IL.Param1
7597	akron1	603	ELSIF (e.type.typ = PROG.tSTRING) OR
		604	(e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
7693	akron1	605	IF p.type.base = tCHAR THEN
		606	stroffs := String(e);
		607	IL.StrAdr(stroffs);
7983	leency	608	IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
7693	akron1	609	ERRORS.WarningMsg(pos.line, pos.col, 0)
		610	END
7597	akron1	611	ELSE (* WCHAR *)
7693	akron1	612	stroffs := StringW(e);
		613	IL.StrAdr(stroffs)
7597	akron1	614	END;
7696	akron1	615	IL.set_dmin(stroffs + p.type.size);
7693	akron1	616	IL.Param1
7597	akron1	617	ELSE
		618	LoadConst(e);
7693	akron1	619	IL.Param1
7597	akron1	620	END
		621	ELSIF e.obj = ePROC THEN
7693	akron1	622	PARS.check(e.ident.global, pos, 85);
		623	IL.PushProc(e.ident.proc.label);
		624	IL.Param1
7597	akron1	625	ELSIF e.obj = eIMP THEN
7693	akron1	626	IL.PushImpProc(e.ident.import);
		627	IL.Param1
		628	ELSIF isExpr(e) & (e.type = tREAL) THEN
		629	IL.pushf
7597	akron1	630	ELSE
7693	akron1	631	IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN
7597	akron1	632	CheckRange(256, pos.line, errBYTE)
		633	END;
7693	akron1	634	IL.Param1
7597	akron1	635	END
		636	END
		637
		638	END
		639	END paramcomp;
		640
		641
7693	akron1	642	PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
		643	BEGIN
		644	parser.expression(parser, e)
		645	END PExpression;
		646
		647
7597	akron1	648	PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
		649	VAR
7983	leency	650	e1, e2: PARS.EXPR;
		651	pos: PARS.POSITION;
		652	proc,
		653	label,
		654	n, i: INTEGER;
		655	code: ARITH.VALUE;
		656	wchar,
		657	comma: BOOLEAN;
7597	akron1	658	cmd1,
7983	leency	659	cmd2: IL.COMMAND;
7597	akron1	660
		661
7693	akron1	662	PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
7597	akron1	663	BEGIN
		664	parser.designator(parser, e);
7693	akron1	665	PARS.check(isVar(e), pos, 93);
		666	PARS.check(isfunc(e), pos, 66);
7597	akron1	667	IF readOnly THEN
7693	akron1	668	PARS.check(~e.readOnly, pos, 94)
7597	akron1	669	END
		670	END varparam;
		671
		672
		673	PROCEDURE shift_minmax (proc: INTEGER): CHAR;
		674	VAR
		675	res: CHAR;
7983	leency	676
7597	akron1	677	BEGIN
		678	CASE proc OF
		679	\|PROG.stASR: res := "A"
		680	\|PROG.stLSL: res := "L"
		681	\|PROG.stROR: res := "O"
		682	\|PROG.stLSR: res := "R"
		683	\|PROG.stMIN: res := "m"
		684	\|PROG.stMAX: res := "x"
		685	END
		686	RETURN res
		687	END shift_minmax;
		688
		689
		690	BEGIN
		691	ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC});
7693	akron1	692	proc := e.stproc;
7597	akron1	693
7693	akron1	694	(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
		695	PARS.checklex(parser, SCAN.lxLROUND);
		696	PARS.Next(parser);
		697	(* END; *)
		698
7597	akron1	699	getpos(parser, pos);
		700
		701	IF e.obj IN {eSYSPROC, eSYSFUNC} THEN
		702	IF parser.unit.scopeLvl > 0 THEN
7693	akron1	703	parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE
7597	akron1	704	END
		705	END;
		706
		707	IF e.obj IN {eSTPROC, eSYSPROC} THEN
		708
		709	CASE proc OF
		710	\|PROG.stASSERT:
7693	akron1	711	PExpression(parser, e);
		712	PARS.check(isBoolean(e), pos, 66);
7597	akron1	713	IF e.obj = eCONST THEN
		714	IF ~ARITH.getBool(e.value) THEN
7693	akron1	715	IL.OnError(pos.line, errASSERT)
7597	akron1	716	END
		717	ELSE
7693	akron1	718	label := IL.NewLabel();
		719	IL.AddJmpCmd(IL.opJE, label);
		720	IL.OnError(pos.line, errASSERT);
		721	IL.SetLabel(label)
7597	akron1	722	END
		723
		724	\|PROG.stINC, PROG.stDEC:
7693	akron1	725	IL.pushBegEnd(begcall, endcall);
7597	akron1	726	varparam(parser, pos, isInt, TRUE, e);
7693	akron1	727	IF e.type = tINTEGER THEN
7597	akron1	728	IF parser.sym = SCAN.lxCOMMA THEN
		729	NextPos(parser, pos);
7693	akron1	730	IL.setlast(begcall);
		731	PExpression(parser, e2);
		732	IL.setlast(endcall.prev(IL.COMMAND));
		733	PARS.check(isInt(e2), pos, 66);
7597	akron1	734	IF e2.obj = eCONST THEN
7693	akron1	735	IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1))
7597	akron1	736	ELSE
7693	akron1	737	IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC))
7597	akron1	738	END
		739	ELSE
7693	akron1	740	IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1)
7597	akron1	741	END
7693	akron1	742	ELSE (* e.type = tBYTE *)
7597	akron1	743	IF parser.sym = SCAN.lxCOMMA THEN
		744	NextPos(parser, pos);
7693	akron1	745	IL.setlast(begcall);
		746	PExpression(parser, e2);
		747	IL.setlast(endcall.prev(IL.COMMAND));
		748	PARS.check(isInt(e2), pos, 66);
7597	akron1	749	IF e2.obj = eCONST THEN
7693	akron1	750	IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
7597	akron1	751	ELSE
7693	akron1	752	IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC))
7597	akron1	753	END
		754	ELSE
7693	akron1	755	IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1)
7597	akron1	756	END
		757	END;
7693	akron1	758	IL.popBegEnd(begcall, endcall)
7597	akron1	759
		760	\|PROG.stINCL, PROG.stEXCL:
7693	akron1	761	IL.pushBegEnd(begcall, endcall);
7597	akron1	762	varparam(parser, pos, isSet, TRUE, e);
		763	PARS.checklex(parser, SCAN.lxCOMMA);
		764	NextPos(parser, pos);
7693	akron1	765	IL.setlast(begcall);
		766	PExpression(parser, e2);
		767	IL.setlast(endcall.prev(IL.COMMAND));
		768	PARS.check(isInt(e2), pos, 66);
7597	akron1	769	IF e2.obj = eCONST THEN
7693	akron1	770	PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56);
		771	IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
7597	akron1	772	ELSE
7693	akron1	773	IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL))
7597	akron1	774	END;
7693	akron1	775	IL.popBegEnd(begcall, endcall)
7597	akron1	776
		777	\|PROG.stNEW:
		778	varparam(parser, pos, isPtr, TRUE, e);
7983	leency	779	IF CPU = TARGETS.cpuMSP430 THEN
7693	akron1	780	PARS.check(e.type.base.size + 16 < Options.ram, pos, 63)
		781	END;
		782	IL.New(e.type.base.size, e.type.base.num)
7597	akron1	783
		784	\|PROG.stDISPOSE:
		785	varparam(parser, pos, isPtr, TRUE, e);
7693	akron1	786	IL.AddCmd0(IL.opDISP)
7597	akron1	787
		788	\|PROG.stPACK:
		789	varparam(parser, pos, isReal, TRUE, e);
		790	PARS.checklex(parser, SCAN.lxCOMMA);
		791	NextPos(parser, pos);
7693	akron1	792	PExpression(parser, e2);
		793	PARS.check(isInt(e2), pos, 66);
7597	akron1	794	IF e2.obj = eCONST THEN
7693	akron1	795	IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value))
7597	akron1	796	ELSE
7693	akron1	797	IL.AddCmd0(IL.opPACK)
7597	akron1	798	END
		799
		800	\|PROG.stUNPK:
		801	varparam(parser, pos, isReal, TRUE, e);
		802	PARS.checklex(parser, SCAN.lxCOMMA);
		803	NextPos(parser, pos);
		804	varparam(parser, pos, isInteger, TRUE, e2);
7693	akron1	805	IL.AddCmd0(IL.opUNPK)
7597	akron1	806
		807	\|PROG.stCOPY:
7693	akron1	808	IL.pushBegEnd(begcall, endcall);
		809	PExpression(parser, e);
7597	akron1	810	IF isString(e) OR isCharArray(e) THEN
		811	wchar := FALSE
		812	ELSIF isStringW(e) OR isCharArrayW(e) THEN
		813	wchar := TRUE
		814	ELSE
7693	akron1	815	PARS.error(pos, 66)
7597	akron1	816	END;
		817
		818	IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN
7693	akron1	819	IL.Const(e.type.length)
7597	akron1	820	END;
		821
		822	PARS.checklex(parser, SCAN.lxCOMMA);
		823	NextPos(parser, pos);
7693	akron1	824	IL.setlast(begcall);
7597	akron1	825
		826	IF wchar THEN
		827	varparam(parser, pos, isCharArrayW, TRUE, e1)
		828	ELSE
		829	IF e.obj = eCONST THEN
		830	varparam(parser, pos, isCharArrayX, TRUE, e1)
		831	ELSE
		832	varparam(parser, pos, isCharArray, TRUE, e1)
		833	END;
		834
7693	akron1	835	wchar := e1.type.base = tWCHAR
7597	akron1	836	END;
		837
		838	IF ~PROG.isOpenArray(e1.type) THEN
7693	akron1	839	IL.Const(e1.type.length)
7597	akron1	840	END;
		841
7693	akron1	842	IL.setlast(endcall.prev(IL.COMMAND));
		843
7597	akron1	844	IF e.obj = eCONST THEN
		845	IF wchar THEN
7693	akron1	846	IL.StrAdr(StringW(e));
		847	IL.Const(utf8strlen(e) + 1)
7597	akron1	848	ELSE
7693	akron1	849	IL.StrAdr(String(e));
		850	IL.Const(strlen(e) + 1)
		851	END
		852	END;
		853	IL.AddCmd(IL.opCOPYS, e1.type.base.size);
		854	IL.popBegEnd(begcall, endcall)
7597	akron1	855
		856	\|PROG.sysGET:
7693	akron1	857	PExpression(parser, e);
		858	PARS.check(isInt(e), pos, 66);
7597	akron1	859	PARS.checklex(parser, SCAN.lxCOMMA);
		860	NextPos(parser, pos);
		861	parser.designator(parser, e2);
7693	akron1	862	PARS.check(isVar(e2), pos, 93);
		863	PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
		864	IF e.obj = eCONST THEN
		865	IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size)
		866	ELSE
		867	IL.AddCmd(IL.opGET, e2.type.size)
		868	END
7597	akron1	869
		870	\|PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
7693	akron1	871	IL.pushBegEnd(begcall, endcall);
		872	PExpression(parser, e);
		873	PARS.check(isInt(e), pos, 66);
7597	akron1	874	IF e.obj = eCONST THEN
		875	LoadConst(e)
		876	END;
		877	PARS.checklex(parser, SCAN.lxCOMMA);
		878	NextPos(parser, pos);
7693	akron1	879	IL.setlast(begcall);
		880	PExpression(parser, e2);
		881	PARS.check(isExpr(e2), pos, 66);
7597	akron1	882
		883	IF proc = PROG.sysPUT THEN
7693	akron1	884	PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
7597	akron1	885	IF e2.obj = eCONST THEN
7693	akron1	886	IF e2.type = tREAL THEN
7983	leency	887	IL.Float(ARITH.Float(e2.value));
7693	akron1	888	IL.setlast(endcall.prev(IL.COMMAND));
7983	leency	889	IL.savef(FALSE)
7597	akron1	890	ELSE
		891	LoadConst(e2);
7693	akron1	892	IL.setlast(endcall.prev(IL.COMMAND));
		893	IL.SysPut(e2.type.size)
7597	akron1	894	END
		895	ELSE
7693	akron1	896	IL.setlast(endcall.prev(IL.COMMAND));
		897	IF e2.type = tREAL THEN
7983	leency	898	IL.savef(FALSE)
7693	akron1	899	ELSIF e2.type = tBYTE THEN
		900	IL.SysPut(tINTEGER.size)
7597	akron1	901	ELSE
7693	akron1	902	IL.SysPut(e2.type.size)
7597	akron1	903	END
		904	END
		905
		906	ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
7696	akron1	907	PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
7597	akron1	908	IF e2.obj = eCONST THEN
		909	LoadConst(e2)
		910	END;
7693	akron1	911	IL.setlast(endcall.prev(IL.COMMAND));
		912	CASE proc OF
		913	\|PROG.sysPUT8: IL.SysPut(1)
		914	\|PROG.sysPUT16: IL.SysPut(2)
		915	\|PROG.sysPUT32: IL.SysPut(4)
7597	akron1	916	END
		917
		918	END;
7693	akron1	919	IL.popBegEnd(begcall, endcall)
7597	akron1	920
		921	\|PROG.sysMOVE:
		922	FOR i := 1 TO 2 DO
7693	akron1	923	PExpression(parser, e);
		924	PARS.check(isInt(e), pos, 66);
7597	akron1	925	IF e.obj = eCONST THEN
		926	LoadConst(e)
		927	END;
		928	PARS.checklex(parser, SCAN.lxCOMMA);
		929	NextPos(parser, pos)
		930	END;
		931
7693	akron1	932	PExpression(parser, e);
		933	PARS.check(isInt(e), pos, 66);
7597	akron1	934	IF e.obj = eCONST THEN
		935	LoadConst(e)
		936	END;
7693	akron1	937	IL.AddCmd0(IL.opMOVE)
7597	akron1	938
		939	\|PROG.sysCOPY:
		940	FOR i := 1 TO 2 DO
		941	parser.designator(parser, e);
7693	akron1	942	PARS.check(isVar(e), pos, 93);
7597	akron1	943	n := PROG.Dim(e.type);
		944	WHILE n > 0 DO
7693	akron1	945	IL.drop;
7597	akron1	946	DEC(n)
		947	END;
		948	PARS.checklex(parser, SCAN.lxCOMMA);
		949	NextPos(parser, pos)
		950	END;
		951
7693	akron1	952	PExpression(parser, e);
		953	PARS.check(isInt(e), pos, 66);
7597	akron1	954	IF e.obj = eCONST THEN
		955	LoadConst(e)
		956	END;
7693	akron1	957	IL.AddCmd0(IL.opMOVE)
7597	akron1	958
		959	\|PROG.sysCODE:
		960	REPEAT
		961	getpos(parser, pos);
		962	PARS.ConstExpression(parser, code);
7693	akron1	963	PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
7983	leency	964	IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
7693	akron1	965	PARS.check(ARITH.range(code, 0, 255), pos, 42)
7983	leency	966	ELSIF CPU = TARGETS.cpuTHUMB THEN
		967	PARS.check(ARITH.range(code, 0, 65535), pos, 110)
7693	akron1	968	END;
		969	IL.AddCmd(IL.opCODE, ARITH.getInt(code));
		970	comma := parser.sym = SCAN.lxCOMMA;
		971	IF comma THEN
7597	akron1	972	PARS.Next(parser)
		973	ELSE
		974	PARS.checklex(parser, SCAN.lxRROUND)
7693	akron1	975	END
		976	UNTIL (parser.sym = SCAN.lxRROUND) & ~comma
		977	(*
		978	\|PROG.sysNOP, PROG.sysDINT, PROG.sysEINT:
		979	IF parser.sym = SCAN.lxLROUND THEN
		980	PARS.Next(parser);
		981	PARS.checklex(parser, SCAN.lxRROUND);
		982	PARS.Next(parser)
		983	END;
		984	ASSERT(CPU = cpuMSP430);
		985	CASE proc OF
		986	\|PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H)
		987	\|PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H)
		988	\|PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H)
		989	END
		990	*)
7597	akron1	991	END;
		992
		993	e.obj := eEXPR;
		994	e.type := NIL
		995
		996	ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN
		997
		998	CASE e.stproc OF
		999	\|PROG.stABS:
7693	akron1	1000	PExpression(parser, e);
		1001	PARS.check(isInt(e) OR isReal(e), pos, 66);
7597	akron1	1002	IF e.obj = eCONST THEN
7693	akron1	1003	PARS.check(ARITH.abs(e.value), pos, 39)
7597	akron1	1004	ELSE
7693	akron1	1005	IL.abs(isReal(e))
7597	akron1	1006	END
		1007
		1008	\|PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
7693	akron1	1009	PExpression(parser, e);
		1010	PARS.check(isInt(e), pos, 66);
7597	akron1	1011	PARS.checklex(parser, SCAN.lxCOMMA);
		1012	NextPos(parser, pos);
7693	akron1	1013	PExpression(parser, e2);
		1014	PARS.check(isInt(e2), pos, 66);
		1015	e.type := tINTEGER;
7597	akron1	1016	IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
		1017	ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
		1018	ELSE
		1019	IF e.obj = eCONST THEN
7693	akron1	1020	IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
7597	akron1	1021	ELSIF e2.obj = eCONST THEN
7693	akron1	1022	IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
7597	akron1	1023	ELSE
7693	akron1	1024	IL.shift_minmax(shift_minmax(proc))
7597	akron1	1025	END;
		1026	e.obj := eEXPR
		1027	END
		1028
		1029	\|PROG.stCHR:
7693	akron1	1030	PExpression(parser, e);
		1031	PARS.check(isInt(e), pos, 66);
		1032	e.type := tCHAR;
7597	akron1	1033	IF e.obj = eCONST THEN
		1034	ARITH.setChar(e.value, ARITH.getInt(e.value));
7693	akron1	1035	PARS.check(ARITH.check(e.value), pos, 107)
7597	akron1	1036	ELSE
7693	akron1	1037	IF chkCHR IN Options.checking THEN
7597	akron1	1038	CheckRange(256, pos.line, errCHR)
		1039	ELSE
7693	akron1	1040	IL.AddCmd0(IL.opCHR)
7597	akron1	1041	END
		1042	END
		1043
		1044	\|PROG.stWCHR:
7693	akron1	1045	PExpression(parser, e);
		1046	PARS.check(isInt(e), pos, 66);
		1047	e.type := tWCHAR;
7597	akron1	1048	IF e.obj = eCONST THEN
		1049	ARITH.setWChar(e.value, ARITH.getInt(e.value));
7693	akron1	1050	PARS.check(ARITH.check(e.value), pos, 101)
7597	akron1	1051	ELSE
7693	akron1	1052	IF chkWCHR IN Options.checking THEN
7597	akron1	1053	CheckRange(65536, pos.line, errWCHR)
		1054	ELSE
7693	akron1	1055	IL.AddCmd0(IL.opWCHR)
7597	akron1	1056	END
		1057	END
		1058
		1059	\|PROG.stFLOOR:
7693	akron1	1060	PExpression(parser, e);
		1061	PARS.check(isReal(e), pos, 66);
		1062	e.type := tINTEGER;
7597	akron1	1063	IF e.obj = eCONST THEN
7693	akron1	1064	PARS.check(ARITH.floor(e.value), pos, 39)
7597	akron1	1065	ELSE
7693	akron1	1066	IL.floor
7597	akron1	1067	END
		1068
		1069	\|PROG.stFLT:
7693	akron1	1070	PExpression(parser, e);
		1071	PARS.check(isInt(e), pos, 66);
		1072	e.type := tREAL;
7597	akron1	1073	IF e.obj = eCONST THEN
		1074	ARITH.flt(e.value)
		1075	ELSE
7693	akron1	1076	PARS.check(IL.flt(), pos, 41)
7597	akron1	1077	END
		1078
		1079	\|PROG.stLEN:
7693	akron1	1080	cmd1 := IL.getlast();
7597	akron1	1081	varparam(parser, pos, isArr, FALSE, e);
		1082	IF e.type.length > 0 THEN
7693	akron1	1083	cmd2 := IL.getlast();
		1084	IL.delete2(cmd1.next, cmd2);
		1085	IL.setlast(cmd1);
7597	akron1	1086	ASSERT(ARITH.setInt(e.value, e.type.length));
		1087	e.obj := eCONST
		1088	ELSE
7693	akron1	1089	IL.len(PROG.Dim(e.type))
7597	akron1	1090	END;
7693	akron1	1091	e.type := tINTEGER
7597	akron1	1092
		1093	\|PROG.stLENGTH:
7693	akron1	1094	PExpression(parser, e);
7597	akron1	1095	IF isCharArray(e) THEN
		1096	IF e.type.length > 0 THEN
7693	akron1	1097	IL.Const(e.type.length)
7597	akron1	1098	END;
7693	akron1	1099	IL.AddCmd0(IL.opLENGTH)
7597	akron1	1100	ELSIF isCharArrayW(e) THEN
		1101	IF e.type.length > 0 THEN
7693	akron1	1102	IL.Const(e.type.length)
7597	akron1	1103	END;
7693	akron1	1104	IL.AddCmd0(IL.opLENGTHW)
7597	akron1	1105	ELSE
7693	akron1	1106	PARS.error(pos, 66);
7597	akron1	1107	END;
7693	akron1	1108	e.type := tINTEGER
7597	akron1	1109
		1110	\|PROG.stODD:
7693	akron1	1111	PExpression(parser, e);
		1112	PARS.check(isInt(e), pos, 66);
		1113	e.type := tBOOLEAN;
7597	akron1	1114	IF e.obj = eCONST THEN
		1115	ARITH.odd(e.value)
		1116	ELSE
7983	leency	1117	IL.AddCmd(IL.opMODR, 2)
7597	akron1	1118	END
		1119
		1120	\|PROG.stORD:
7693	akron1	1121	PExpression(parser, e);
		1122	PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
7597	akron1	1123	IF e.obj = eCONST THEN
		1124	IF isStringW1(e) THEN
		1125	ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s)))
		1126	ELSE
		1127	ARITH.ord(e.value)
		1128	END
		1129	ELSE
		1130	IF isBoolean(e) THEN
7696	akron1	1131	IL.AddCmd0(IL.opORD)
7597	akron1	1132	END
		1133	END;
7693	akron1	1134	e.type := tINTEGER
7597	akron1	1135
		1136	\|PROG.stBITS:
7693	akron1	1137	PExpression(parser, e);
		1138	PARS.check(isInt(e), pos, 66);
7597	akron1	1139	IF e.obj = eCONST THEN
		1140	ARITH.bits(e.value)
		1141	END;
7693	akron1	1142	e.type := tSET
7597	akron1	1143
		1144	\|PROG.sysADR:
		1145	parser.designator(parser, e);
		1146	IF isVar(e) THEN
		1147	n := PROG.Dim(e.type);
		1148	WHILE n > 0 DO
7693	akron1	1149	IL.drop;
7597	akron1	1150	DEC(n)
		1151	END
		1152	ELSIF e.obj = ePROC THEN
7693	akron1	1153	IL.PushProc(e.ident.proc.label)
7597	akron1	1154	ELSIF e.obj = eIMP THEN
7693	akron1	1155	IL.PushImpProc(e.ident.import)
7597	akron1	1156	ELSE
7693	akron1	1157	PARS.error(pos, 108)
7597	akron1	1158	END;
7693	akron1	1159	e.type := tINTEGER
7597	akron1	1160
		1161	\|PROG.sysSADR:
7693	akron1	1162	PExpression(parser, e);
		1163	PARS.check(isString(e), pos, 66);
		1164	IL.StrAdr(String(e));
		1165	e.type := tINTEGER;
7597	akron1	1166	e.obj := eEXPR
		1167
		1168	\|PROG.sysWSADR:
7693	akron1	1169	PExpression(parser, e);
		1170	PARS.check(isStringW(e), pos, 66);
		1171	IL.StrAdr(StringW(e));
		1172	e.type := tINTEGER;
7597	akron1	1173	e.obj := eEXPR
		1174
		1175	\|PROG.sysTYPEID:
7693	akron1	1176	PExpression(parser, e);
		1177	PARS.check(e.obj = eTYPE, pos, 68);
7597	akron1	1178	IF e.type.typ = PROG.tRECORD THEN
		1179	ASSERT(ARITH.setInt(e.value, e.type.num))
7693	akron1	1180	ELSIF e.type.typ = PROG.tPOINTER THEN
7597	akron1	1181	ASSERT(ARITH.setInt(e.value, e.type.base.num))
		1182	ELSE
7693	akron1	1183	PARS.error(pos, 52)
7597	akron1	1184	END;
		1185	e.obj := eCONST;
7693	akron1	1186	e.type := tINTEGER
7597	akron1	1187
		1188	\|PROG.sysINF:
7693	akron1	1189	PARS.check(IL.inf(), pos, 41);
7597	akron1	1190	e.obj := eEXPR;
7693	akron1	1191	e.type := tREAL
7597	akron1	1192
		1193	\|PROG.sysSIZE:
7693	akron1	1194	PExpression(parser, e);
		1195	PARS.check(e.obj = eTYPE, pos, 68);
7597	akron1	1196	ASSERT(ARITH.setInt(e.value, e.type.size));
		1197	e.obj := eCONST;
7693	akron1	1198	e.type := tINTEGER
7597	akron1	1199
		1200	END
		1201
		1202	END;
		1203
7693	akron1	1204	(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
		1205	PARS.checklex(parser, SCAN.lxRROUND);
		1206	PARS.Next(parser);
		1207	(* END; *)
7597	akron1	1208
		1209	IF e.obj # eCONST THEN
		1210	e.obj := eEXPR
		1211	END
		1212
		1213	END stProc;
		1214
		1215
		1216	PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1217	VAR
		1218	proc: PROG.TYPE_;
		1219	param: LISTS.ITEM;
		1220	e1: PARS.EXPR;
7693	akron1	1221	pos: PARS.POSITION;
7597	akron1	1222
		1223	BEGIN
		1224	ASSERT(parser.sym = SCAN.lxLROUND);
		1225
		1226	IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN
		1227	proc := e.type;
		1228	PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86);
		1229	PARS.Next(parser);
		1230
		1231	param := proc.params.first;
		1232	WHILE param # NIL DO
		1233	getpos(parser, pos);
		1234
7693	akron1	1235	IL.setlast(begcall);
7597	akron1	1236
		1237	IF param(PROG.PARAM).vPar THEN
		1238	parser.designator(parser, e1)
		1239	ELSE
7693	akron1	1240	PExpression(parser, e1)
7597	akron1	1241	END;
		1242	paramcomp(parser, pos, e1, param(PROG.PARAM));
		1243	param := param.next;
		1244	IF param # NIL THEN
		1245	PARS.checklex(parser, SCAN.lxCOMMA);
		1246	PARS.Next(parser)
		1247	END
		1248	END;
		1249
		1250	PARS.checklex(parser, SCAN.lxRROUND);
		1251	PARS.Next(parser);
		1252
		1253	e.obj := eEXPR;
		1254	e.type := proc.base
		1255
		1256	ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
		1257	stProc(parser, e)
		1258	ELSE
		1259	PARS.check1(FALSE, parser, 86)
		1260	END
		1261
		1262	END ActualParameters;
		1263
		1264
		1265	PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1266	VAR
		1267	ident: PROG.IDENT;
		1268	import: BOOLEAN;
7693	akron1	1269	pos: PARS.POSITION;
7597	akron1	1270
		1271	BEGIN
		1272	PARS.checklex(parser, SCAN.lxIDENT);
		1273	getpos(parser, pos);
		1274	import := FALSE;
7693	akron1	1275	ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
7597	akron1	1276	PARS.check1(ident # NIL, parser, 48);
		1277	IF ident.typ = PROG.idMODULE THEN
		1278	PARS.ExpectSym(parser, SCAN.lxPOINT);
		1279	PARS.ExpectSym(parser, SCAN.lxIDENT);
7693	akron1	1280	ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
7597	akron1	1281	PARS.check1((ident # NIL) & ident.export, parser, 48);
		1282	import := TRUE
		1283	END;
		1284	PARS.Next(parser);
		1285
		1286	e.readOnly := FALSE;
		1287	e.ident := ident;
		1288
		1289	CASE ident.typ OF
		1290	\|PROG.idCONST:
		1291	e.obj := eCONST;
		1292	e.type := ident.type;
		1293	e.value := ident.value
		1294	\|PROG.idTYPE:
		1295	e.obj := eTYPE;
		1296	e.type := ident.type
		1297	\|PROG.idVAR:
		1298	e.obj := eVAR;
		1299	e.type := ident.type;
		1300	e.readOnly := import
		1301	\|PROG.idPROC:
		1302	e.obj := ePROC;
		1303	e.type := ident.type
		1304	\|PROG.idIMP:
		1305	e.obj := eIMP;
		1306	e.type := ident.type
		1307	\|PROG.idVPAR:
		1308	e.type := ident.type;
		1309	IF e.type.typ = PROG.tRECORD THEN
		1310	e.obj := eVREC
		1311	ELSE
		1312	e.obj := eVPAR
		1313	END
		1314	\|PROG.idPARAM:
		1315	e.obj := ePARAM;
		1316	e.type := ident.type;
		1317	e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY})
		1318	\|PROG.idSTPROC:
		1319	e.obj := eSTPROC;
		1320	e.stproc := ident.stproc
		1321	\|PROG.idSTFUNC:
		1322	e.obj := eSTFUNC;
		1323	e.stproc := ident.stproc
		1324	\|PROG.idSYSPROC:
		1325	e.obj := eSYSPROC;
		1326	e.stproc := ident.stproc
		1327	\|PROG.idSYSFUNC:
7693	akron1	1328	PARS.check(~parser.constexp, pos, 109);
7597	akron1	1329	e.obj := eSYSFUNC;
		1330	e.stproc := ident.stproc
		1331	\|PROG.idNONE:
7693	akron1	1332	PARS.error(pos, 115)
7597	akron1	1333	END;
		1334
		1335	IF isVar(e) THEN
7693	akron1	1336	PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105)
7597	akron1	1337	END
		1338
		1339	END qualident;
		1340
		1341
7693	akron1	1342	PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
7597	akron1	1343	VAR
7983	leency	1344	label: INTEGER;
7597	akron1	1345
		1346	BEGIN
		1347	IF load THEN
7693	akron1	1348	IL.load(e.type.size)
7597	akron1	1349	END;
		1350
7693	akron1	1351	IF chkPTR IN Options.checking THEN
		1352	label := IL.NewLabel();
		1353	IL.AddJmpCmd(IL.opJNZ, label);
		1354	IL.OnError(pos.line, error);
		1355	IL.SetLabel(label)
7597	akron1	1356	END
		1357	END deref;
		1358
		1359
		1360	PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1361	VAR
		1362	field: PROG.FIELD;
7693	akron1	1363	pos: PARS.POSITION;
7597	akron1	1364	t, idx: PARS.EXPR;
		1365
		1366
		1367	PROCEDURE LoadAdr (e: PARS.EXPR);
		1368	VAR
		1369	offset: INTEGER;
		1370
		1371	PROCEDURE OpenArray (e: PARS.EXPR);
		1372	VAR
		1373	offset, n: INTEGER;
		1374	BEGIN
		1375	offset := e.ident.offset;
		1376	n := PROG.Dim(e.type);
		1377	WHILE n >= 0 DO
7693	akron1	1378	IL.AddCmd(IL.opVADR, offset);
7597	akron1	1379	DEC(offset);
		1380	DEC(n)
		1381	END
		1382	END OpenArray;
		1383
		1384
		1385	BEGIN
		1386	IF e.obj = eVAR THEN
		1387	offset := PROG.getOffset(PARS.program, e.ident);
		1388	IF e.ident.global THEN
7693	akron1	1389	IL.AddCmd(IL.opGADR, offset)
7597	akron1	1390	ELSE
7693	akron1	1391	IL.AddCmd(IL.opLADR, -offset)
7597	akron1	1392	END
		1393	ELSIF e.obj = ePARAM THEN
		1394	IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN
7693	akron1	1395	IL.AddCmd(IL.opVADR, e.ident.offset)
7597	akron1	1396	ELSIF PROG.isOpenArray(e.type) THEN
		1397	OpenArray(e)
		1398	ELSE
7693	akron1	1399	IL.AddCmd(IL.opLADR, e.ident.offset)
7597	akron1	1400	END
		1401	ELSIF e.obj IN {eVPAR, eVREC} THEN
		1402	IF PROG.isOpenArray(e.type) THEN
		1403	OpenArray(e)
		1404	ELSE
7693	akron1	1405	IL.AddCmd(IL.opVADR, e.ident.offset)
7597	akron1	1406	END
		1407	END
		1408	END LoadAdr;
		1409
		1410
7693	akron1	1411	PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
7597	akron1	1412	VAR
7983	leency	1413	label, offset, n, k: INTEGER;
		1414	type: PROG.TYPE_;
7597	akron1	1415
		1416	BEGIN
		1417
7693	akron1	1418	IF chkIDX IN Options.checking THEN
		1419	label := IL.NewLabel();
		1420	IL.AddCmd2(IL.opCHKIDX2, label, 0);
		1421	IL.OnError(pos.line, errIDX);
		1422	IL.SetLabel(label)
7597	akron1	1423	ELSE
7693	akron1	1424	IL.AddCmd(IL.opCHKIDX2, -1)
7597	akron1	1425	END;
		1426
		1427	type := PROG.OpenBase(e.type);
		1428	IF type.size # 1 THEN
7693	akron1	1429	IL.AddCmd(IL.opMULC, type.size)
7597	akron1	1430	END;
		1431	n := PROG.Dim(e.type) - 1;
		1432	k := n;
		1433	WHILE n > 0 DO
7693	akron1	1434	IL.AddCmd0(IL.opMUL);
7597	akron1	1435	DEC(n)
		1436	END;
7693	akron1	1437	IL.AddCmd0(IL.opADD);
7597	akron1	1438	offset := e.ident.offset - 1;
		1439	n := k;
		1440	WHILE n > 0 DO
7693	akron1	1441	IL.AddCmd(IL.opVADR, offset);
7597	akron1	1442	DEC(offset);
		1443	DEC(n)
		1444	END
		1445	END OpenIdx;
		1446
		1447
		1448	BEGIN
		1449	qualident(parser, e);
		1450
		1451	IF e.obj IN {ePROC, eIMP} THEN
		1452	PROG.UseProc(parser.unit, e.ident.proc)
		1453	END;
		1454
		1455	IF isVar(e) THEN
		1456	LoadAdr(e)
		1457	END;
		1458
		1459	WHILE parser.sym = SCAN.lxPOINT DO
		1460	getpos(parser, pos);
		1461	PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
		1462	IF e.type.typ = PROG.tPOINTER THEN
		1463	deref(pos, e, TRUE, errPTR)
		1464	END;
		1465	PARS.ExpectSym(parser, SCAN.lxIDENT);
		1466	IF e.type.typ = PROG.tPOINTER THEN
		1467	e.type := e.type.base;
		1468	e.readOnly := FALSE
		1469	END;
7693	akron1	1470	field := PROG.getField(e.type, parser.lex.ident, parser.unit);
7597	akron1	1471	PARS.check1(field # NIL, parser, 74);
		1472	e.type := field.type;
		1473	IF e.obj = eVREC THEN
		1474	e.obj := eVPAR
		1475	END;
		1476	IF field.offset # 0 THEN
7693	akron1	1477	IL.AddCmd(IL.opADDR, field.offset)
7597	akron1	1478	END;
		1479	PARS.Next(parser);
		1480	e.ident := NIL
		1481
		1482	ELSIF parser.sym = SCAN.lxLSQUARE DO
		1483
		1484	REPEAT
		1485
		1486	PARS.check1(isArr(e), parser, 75);
		1487	NextPos(parser, pos);
7693	akron1	1488	PExpression(parser, idx);
		1489	PARS.check(isInt(idx), pos, 76);
7597	akron1	1490
		1491	IF idx.obj = eCONST THEN
		1492	IF e.type.length > 0 THEN
7693	akron1	1493	PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83);
7597	akron1	1494	IF ARITH.Int(idx.value) > 0 THEN
7693	akron1	1495	IL.AddCmd(IL.opADDR, ARITH.Int(idx.value) * e.type.base.size)
7597	akron1	1496	END
		1497	ELSE
7693	akron1	1498	PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83);
7597	akron1	1499	LoadConst(idx);
		1500	OpenIdx(parser, pos, e)
		1501	END
		1502	ELSE
		1503	IF e.type.length > 0 THEN
7693	akron1	1504	IF chkIDX IN Options.checking THEN
7597	akron1	1505	CheckRange(e.type.length, pos.line, errIDX)
		1506	END;
		1507	IF e.type.base.size # 1 THEN
7693	akron1	1508	IL.AddCmd(IL.opMULC, e.type.base.size)
7597	akron1	1509	END;
7693	akron1	1510	IL.AddCmd0(IL.opADD)
7597	akron1	1511	ELSE
		1512	OpenIdx(parser, pos, e)
		1513	END
		1514	END;
		1515
		1516	e.type := e.type.base
		1517
		1518	UNTIL parser.sym # SCAN.lxCOMMA;
		1519
		1520	PARS.checklex(parser, SCAN.lxRSQUARE);
		1521	PARS.Next(parser);
		1522	e.ident := NIL
		1523
		1524	ELSIF parser.sym = SCAN.lxCARET DO
		1525	getpos(parser, pos);
		1526	PARS.check1(isPtr(e), parser, 77);
		1527	deref(pos, e, TRUE, errPTR);
		1528	e.type := e.type.base;
		1529	e.readOnly := FALSE;
		1530	PARS.Next(parser);
		1531	e.ident := NIL;
		1532	e.obj := eVREC
		1533
		1534	ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO
		1535
		1536	IF e.type.typ = PROG.tRECORD THEN
		1537	PARS.check1(e.obj = eVREC, parser, 78)
		1538	END;
		1539	NextPos(parser, pos);
		1540	qualident(parser, t);
7693	akron1	1541	PARS.check(t.obj = eTYPE, pos, 79);
7597	akron1	1542
		1543	IF e.type.typ = PROG.tRECORD THEN
7693	akron1	1544	PARS.check(t.type.typ = PROG.tRECORD, pos, 80);
		1545	IF chkGUARD IN Options.checking THEN
7597	akron1	1546	IF e.ident = NIL THEN
7693	akron1	1547	IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD)
7597	akron1	1548	ELSE
7693	akron1	1549	IL.AddCmd(IL.opVADR, e.ident.offset - 1);
		1550	IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD)
7597	akron1	1551	END
		1552	END;
		1553	ELSE
7693	akron1	1554	PARS.check(t.type.typ = PROG.tPOINTER, pos, 81);
		1555	IF chkGUARD IN Options.checking THEN
		1556	IL.TypeGuard(IL.opTYPEGP, t.type.base.num, pos.line, errGUARD)
7597	akron1	1557	END
		1558	END;
		1559
7693	akron1	1560	PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82);
7597	akron1	1561
		1562	e.type := t.type;
		1563
		1564	PARS.checklex(parser, SCAN.lxRROUND);
		1565	PARS.Next(parser)
		1566
		1567	END
		1568
		1569	END designator;
		1570
		1571
7693	akron1	1572	PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
7597	akron1	1573	VAR
7983	leency	1574	cconv,
		1575	parSize,
		1576	callconv,
		1577	fparSize,
		1578	int, flt,
		1579	stk_par: INTEGER;
7597	akron1	1580
		1581	BEGIN
		1582	cconv := procType.call;
7693	akron1	1583	parSize := procType.parSize;
7597	akron1	1584
		1585	IF cconv IN {PROG._win64, PROG.win64} THEN
7693	akron1	1586	callconv := IL.call_win64;
		1587	fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4)
7597	akron1	1588	ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
7693	akron1	1589	callconv := IL.call_sysv;
		1590	fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize;
7597	akron1	1591	stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
		1592	ELSE
7693	akron1	1593	callconv := IL.call_stack;
		1594	fparSize := 0
7597	akron1	1595	END;
7693	akron1	1596	IL.setlast(begcall);
		1597	fregs := IL.precall(isfloat);
7597	akron1	1598
		1599	IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
7693	akron1	1600	IL.AddCmd(IL.opALIGN16, parSize)
7597	akron1	1601	ELSIF cconv IN {PROG._win64, PROG.win64} THEN
7693	akron1	1602	IL.AddCmd(IL.opWIN64ALIGN16, parSize)
7597	akron1	1603	ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
7693	akron1	1604	IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par)
7597	akron1	1605	END;
7693	akron1	1606	IL.setlast(endcall.prev(IL.COMMAND));
7597	akron1	1607
		1608	IF e.obj = eIMP THEN
7693	akron1	1609	IL.CallImp(e.ident.import, callconv, fparSize)
7597	akron1	1610	ELSIF e.obj = ePROC THEN
7693	akron1	1611	IL.Call(e.ident.proc.label, callconv, fparSize)
7597	akron1	1612	ELSIF isExpr(e) THEN
		1613	deref(pos, e, CallStat, errPROC);
7693	akron1	1614	IL.CallP(callconv, fparSize)
7597	akron1	1615	END;
		1616
		1617	IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
7693	akron1	1618	IL.AddCmd(IL.opCLEANUP, parSize);
		1619	IL.AddCmd0(IL.opPOPSP)
7597	akron1	1620	ELSIF cconv IN {PROG._win64, PROG.win64} THEN
7693	akron1	1621	IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1);
		1622	IL.AddCmd0(IL.opPOPSP)
7597	akron1	1623	ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
7693	akron1	1624	IL.AddCmd(IL.opCLEANUP, parSize + stk_par);
		1625	IL.AddCmd0(IL.opPOPSP)
		1626	ELSIF cconv IN {PROG._ccall, PROG.ccall, PROG.default16, PROG.code, PROG._code} THEN
		1627	IL.AddCmd(IL.opCLEANUP, parSize)
7597	akron1	1628	END;
		1629
		1630	IF ~CallStat THEN
		1631	IF isfloat THEN
7693	akron1	1632	PARS.check(IL.resf(fregs), pos, 41)
7597	akron1	1633	ELSE
7693	akron1	1634	IL.res(fregs)
7597	akron1	1635	END
		1636	END
		1637	END ProcCall;
		1638
		1639
		1640	PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1641	VAR
7693	akron1	1642	pos, pos0, pos1: PARS.POSITION;
7597	akron1	1643
		1644	op: INTEGER;
		1645	e1: PARS.EXPR;
		1646	constant: BOOLEAN;
		1647	operator: ARITH.RELATION;
		1648	error: INTEGER;
		1649
		1650
		1651	PROCEDURE relation (sym: INTEGER): BOOLEAN;
		1652	RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR
		1653	(sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR
		1654	(sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR
		1655	(sym = SCAN.lxIN) OR (sym = SCAN.lxIS)
		1656	END relation;
		1657
		1658
		1659	PROCEDURE AddOperator (sym: INTEGER): BOOLEAN;
		1660	RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR
		1661	(sym = SCAN.lxOR)
		1662	END AddOperator;
		1663
		1664
		1665	PROCEDURE MulOperator (sym: INTEGER): BOOLEAN;
		1666	RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR
		1667	(sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR
		1668	(sym = SCAN.lxAND)
		1669	END MulOperator;
		1670
		1671
		1672	PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1673	VAR
		1674	e1, e2: PARS.EXPR;
7693	akron1	1675	pos: PARS.POSITION;
7597	akron1	1676	range: BOOLEAN;
		1677
		1678	BEGIN
		1679	range := FALSE;
		1680	getpos(parser, pos);
		1681	expression(parser, e1);
7693	akron1	1682	PARS.check(isInt(e1), pos, 76);
7597	akron1	1683
		1684	IF e1.obj = eCONST THEN
7693	akron1	1685	PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44)
7597	akron1	1686	END;
		1687
		1688	range := parser.sym = SCAN.lxRANGE;
		1689
		1690	IF range THEN
		1691	NextPos(parser, pos);
		1692	expression(parser, e2);
7693	akron1	1693	PARS.check(isInt(e2), pos, 76);
7597	akron1	1694
		1695	IF e2.obj = eCONST THEN
7693	akron1	1696	PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44)
7597	akron1	1697	END
		1698	ELSE
		1699	IF e1.obj = eCONST THEN
		1700	e2 := e1
		1701	END
		1702	END;
		1703
7693	akron1	1704	e.type := tSET;
7597	akron1	1705
		1706	IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
		1707	ARITH.constrSet(e.value, e1.value, e2.value);
		1708	e.obj := eCONST
		1709	ELSE
		1710	IF range THEN
		1711	IF e1.obj = eCONST THEN
7693	akron1	1712	IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value))
7597	akron1	1713	ELSIF e2.obj = eCONST THEN
7693	akron1	1714	IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value))
7597	akron1	1715	ELSE
7693	akron1	1716	IL.AddCmd0(IL.opRSET)
7597	akron1	1717	END
		1718	ELSE
7693	akron1	1719	IL.AddCmd0(IL.opRSET1)
7597	akron1	1720	END;
		1721	e.obj := eEXPR
		1722	END
		1723
		1724	END element;
		1725
		1726
		1727	PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1728	VAR
		1729	e1: PARS.EXPR;
		1730
		1731	BEGIN
		1732	ASSERT(parser.sym = SCAN.lxLCURLY);
		1733
		1734	e.obj := eCONST;
7693	akron1	1735	e.type := tSET;
7597	akron1	1736	ARITH.emptySet(e.value);
		1737
		1738	PARS.Next(parser);
		1739	IF parser.sym # SCAN.lxRCURLY THEN
		1740	element(parser, e1);
		1741
		1742	IF e1.obj = eCONST THEN
		1743	ARITH.opSet(e.value, e1.value, "+")
		1744	ELSE
		1745	e.obj := eEXPR
		1746	END;
		1747
		1748	WHILE parser.sym = SCAN.lxCOMMA DO
		1749	PARS.Next(parser);
		1750	element(parser, e1);
		1751	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1752	ARITH.opSet(e.value, e1.value, "+")
		1753	ELSE
		1754	IF e.obj = eCONST THEN
7693	akron1	1755	IL.AddCmd(IL.opADDSL, ARITH.Int(e.value))
7597	akron1	1756	ELSIF e1.obj = eCONST THEN
7693	akron1	1757	IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value))
7597	akron1	1758	ELSE
7693	akron1	1759	IL.AddCmd0(IL.opADDS)
7597	akron1	1760	END;
		1761	e.obj := eEXPR
		1762	END
		1763	END;
		1764	PARS.checklex(parser, SCAN.lxRCURLY)
		1765	END;
		1766	PARS.Next(parser);
		1767	END set;
		1768
		1769
		1770	PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1771	VAR
		1772	sym: INTEGER;
7693	akron1	1773	pos: PARS.POSITION;
7597	akron1	1774	e1: PARS.EXPR;
		1775	isfloat: BOOLEAN;
		1776	fregs: INTEGER;
		1777
		1778
7693	akron1	1779	PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
7597	akron1	1780	BEGIN
		1781	IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
7693	akron1	1782	IF e.type = tREAL THEN
		1783	PARS.check(IL.loadf(), pos, 41)
7597	akron1	1784	ELSE
7693	akron1	1785	IL.load(e.type.size)
7597	akron1	1786	END
		1787	END
		1788	END LoadVar;
		1789
		1790
		1791	BEGIN
		1792	sym := parser.sym;
		1793
		1794	IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
		1795	e.obj := eCONST;
		1796	e.value := parser.lex.value;
7693	akron1	1797	e.type := PROG.getType(PARS.program, e.value.typ);
7597	akron1	1798	PARS.Next(parser)
		1799
		1800	ELSIF sym = SCAN.lxNIL THEN
7693	akron1	1801	e.obj := eCONST;
		1802	e.type := PARS.program.stTypes.tNIL;
7597	akron1	1803	PARS.Next(parser)
		1804
		1805	ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
7693	akron1	1806	e.obj := eCONST;
7597	akron1	1807	ARITH.setbool(e.value, sym = SCAN.lxTRUE);
7693	akron1	1808	e.type := tBOOLEAN;
7597	akron1	1809	PARS.Next(parser)
		1810
		1811	ELSIF sym = SCAN.lxLCURLY THEN
		1812	set(parser, e)
		1813
		1814	ELSIF sym = SCAN.lxIDENT THEN
		1815	getpos(parser, pos);
		1816
7693	akron1	1817	IL.pushBegEnd(begcall, endcall);
7597	akron1	1818
		1819	designator(parser, e);
		1820	IF isVar(e) THEN
		1821	LoadVar(e, parser, pos)
		1822	END;
		1823	IF parser.sym = SCAN.lxLROUND THEN
		1824	e1 := e;
		1825	ActualParameters(parser, e);
7693	akron1	1826	PARS.check(e.type # NIL, pos, 59);
		1827	isfloat := e.type = tREAL;
7597	akron1	1828	IF e1.obj IN {ePROC, eIMP} THEN
		1829	ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE)
		1830	ELSIF isExpr(e1) THEN
		1831	ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE)
		1832	END
		1833	END;
7693	akron1	1834	IL.popBegEnd(begcall, endcall)
7597	akron1	1835
		1836	ELSIF sym = SCAN.lxLROUND THEN
		1837	PARS.Next(parser);
		1838	expression(parser, e);
		1839	PARS.checklex(parser, SCAN.lxRROUND);
		1840	PARS.Next(parser);
		1841	IF isExpr(e) & (e.obj # eCONST) THEN
		1842	e.obj := eEXPR
		1843	END
		1844
		1845	ELSIF sym = SCAN.lxNOT THEN
		1846	NextPos(parser, pos);
		1847	factor(parser, e);
7693	akron1	1848	PARS.check(isBoolean(e), pos, 72);
7597	akron1	1849	IF e.obj # eCONST THEN
7693	akron1	1850	IL.not;
7597	akron1	1851	e.obj := eEXPR
		1852	ELSE
		1853	ASSERT(ARITH.neg(e.value))
		1854	END
		1855
		1856	ELSE
		1857	PARS.check1(FALSE, parser, 34)
		1858	END
		1859	END factor;
		1860
		1861
		1862	PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1863	VAR
7693	akron1	1864	pos: PARS.POSITION;
7597	akron1	1865	e1: PARS.EXPR;
7983	leency	1866	op, label, label1: INTEGER;
7597	akron1	1867
		1868	BEGIN
		1869	factor(parser, e);
		1870	label := -1;
		1871
		1872	WHILE MulOperator(parser.sym) DO
		1873	op := parser.sym;
		1874	getpos(parser, pos);
		1875	PARS.Next(parser);
		1876
		1877	IF op = SCAN.lxAND THEN
		1878	IF ~parser.constexp THEN
		1879
		1880	IF label = -1 THEN
7693	akron1	1881	label := IL.NewLabel()
7597	akron1	1882	END;
		1883
		1884	IF e.obj = eCONST THEN
7693	akron1	1885	IL.Const(ORD(ARITH.getBool(e.value)))
		1886	END;
		1887	IL.AddCmd0(IL.opACC);
		1888	IL.AddJmpCmd(IL.opJZ, label);
		1889	IL.drop
7597	akron1	1890	END
		1891	END;
		1892
		1893	factor(parser, e1);
		1894
		1895	CASE op OF
		1896	\|SCAN.lxMUL:
7693	akron1	1897	PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
7597	akron1	1898	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1899
		1900	CASE e.value.typ OF
7693	akron1	1901	\|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39)
		1902	\|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40)
7597	akron1	1903	\|ARITH.tSET: ARITH.opSet(e.value, e1.value, "*")
		1904	END
		1905
		1906	ELSE
		1907	IF isInt(e) THEN
		1908	IF e.obj = eCONST THEN
7693	akron1	1909	IL.AddCmd(IL.opMULC, ARITH.Int(e.value))
7597	akron1	1910	ELSIF e1.obj = eCONST THEN
7693	akron1	1911	IL.AddCmd(IL.opMULC, ARITH.Int(e1.value))
7597	akron1	1912	ELSE
7693	akron1	1913	IL.AddCmd0(IL.opMUL)
7597	akron1	1914	END
		1915	ELSIF isReal(e) THEN
		1916	IF e.obj = eCONST THEN
7693	akron1	1917	IL.Float(ARITH.Float(e.value))
7597	akron1	1918	ELSIF e1.obj = eCONST THEN
7693	akron1	1919	IL.Float(ARITH.Float(e1.value))
7597	akron1	1920	END;
7693	akron1	1921	IL.fbinop(IL.opMULF)
7597	akron1	1922	ELSIF isSet(e) THEN
		1923	IF e.obj = eCONST THEN
7693	akron1	1924	IL.AddCmd(IL.opMULSC, ARITH.Int(e.value))
7597	akron1	1925	ELSIF e1.obj = eCONST THEN
7693	akron1	1926	IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value))
7597	akron1	1927	ELSE
7693	akron1	1928	IL.AddCmd0(IL.opMULS)
7597	akron1	1929	END
		1930	END;
		1931	e.obj := eEXPR
		1932	END
		1933
		1934	\|SCAN.lxSLASH:
7693	akron1	1935	PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
7597	akron1	1936	IF (e1.obj = eCONST) & isReal(e1) THEN
7693	akron1	1937	PARS.check(~ARITH.isZero(e1.value), pos, 45)
7597	akron1	1938	END;
		1939	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1940
		1941	CASE e.value.typ OF
7693	akron1	1942	\|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40)
7597	akron1	1943	\|ARITH.tSET: ARITH.opSet(e.value, e1.value, "/")
		1944	END
		1945
		1946	ELSE
		1947	IF isReal(e) THEN
		1948	IF e.obj = eCONST THEN
7693	akron1	1949	IL.Float(ARITH.Float(e.value));
		1950	IL.fbinop(IL.opDIVFI)
7597	akron1	1951	ELSIF e1.obj = eCONST THEN
7693	akron1	1952	IL.Float(ARITH.Float(e1.value));
		1953	IL.fbinop(IL.opDIVF)
7597	akron1	1954	ELSE
7693	akron1	1955	IL.fbinop(IL.opDIVF)
7597	akron1	1956	END
		1957	ELSIF isSet(e) THEN
		1958	IF e.obj = eCONST THEN
7693	akron1	1959	IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value))
7597	akron1	1960	ELSIF e1.obj = eCONST THEN
7693	akron1	1961	IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value))
7597	akron1	1962	ELSE
7693	akron1	1963	IL.AddCmd0(IL.opDIVS)
7597	akron1	1964	END
		1965	END;
		1966	e.obj := eEXPR
		1967	END
		1968
		1969	\|SCAN.lxDIV, SCAN.lxMOD:
7693	akron1	1970	PARS.check(isInt(e) & isInt(e1), pos, 37);
7597	akron1	1971	IF e1.obj = eCONST THEN
7983	leency	1972	PARS.check(ARITH.Int(e1.value) > 0, pos, 122)
7597	akron1	1973	END;
		1974	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1975
		1976	IF op = SCAN.lxDIV THEN
7693	akron1	1977	PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39)
7597	akron1	1978	ELSE
		1979	ASSERT(ARITH.opInt(e.value, e1.value, "M"))
		1980	END
		1981
		1982	ELSE
		1983	IF e1.obj # eCONST THEN
7693	akron1	1984	label1 := IL.NewLabel();
7983	leency	1985	IL.AddJmpCmd(IL.opJG, label1)
7597	akron1	1986	END;
		1987	IF e.obj = eCONST THEN
7693	akron1	1988	IL.OnError(pos.line, errDIV);
		1989	IL.SetLabel(label1);
		1990	IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
7597	akron1	1991	ELSIF e1.obj = eCONST THEN
7693	akron1	1992	IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
7597	akron1	1993	ELSE
7693	akron1	1994	IL.OnError(pos.line, errDIV);
		1995	IL.SetLabel(label1);
		1996	IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD))
7597	akron1	1997	END;
		1998	e.obj := eEXPR
		1999	END
		2000
		2001	\|SCAN.lxAND:
7693	akron1	2002	PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
7597	akron1	2003
		2004	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		2005	ARITH.opBoolean(e.value, e1.value, "&")
		2006	ELSE
		2007	e.obj := eEXPR;
		2008	IF e1.obj = eCONST THEN
7693	akron1	2009	IL.Const(ORD(ARITH.getBool(e1.value)))
7667	akron1	2010	END;
7693	akron1	2011	IL.AddCmd0(IL.opACC)
7597	akron1	2012	END
		2013
		2014	END
		2015	END;
		2016
		2017	IF label # -1 THEN
7693	akron1	2018	IL.SetLabel(label)
7597	akron1	2019	END
		2020	END term;
		2021
		2022
		2023	PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
		2024	VAR
7693	akron1	2025	pos: PARS.POSITION;
7597	akron1	2026	op: INTEGER;
		2027	e1: PARS.EXPR;
		2028
		2029	plus, minus: BOOLEAN;
		2030
		2031	label: INTEGER;
		2032
		2033	BEGIN
		2034	plus := parser.sym = SCAN.lxPLUS;
		2035	minus := parser.sym = SCAN.lxMINUS;
		2036
		2037	IF plus OR minus THEN
		2038	getpos(parser, pos);
		2039	PARS.Next(parser)
		2040	END;
		2041
		2042	term(parser, e);
		2043
		2044	IF plus OR minus THEN
7693	akron1	2045	PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36);
7597	akron1	2046
		2047	IF minus & (e.obj = eCONST) THEN
7693	akron1	2048	PARS.check(ARITH.neg(e.value), pos, 39)
7597	akron1	2049	END;
		2050
		2051	IF e.obj # eCONST THEN
		2052	IF minus THEN
		2053	IF isInt(e) THEN
7693	akron1	2054	IL.AddCmd0(IL.opUMINUS)
7597	akron1	2055	ELSIF isReal(e) THEN
7693	akron1	2056	IL.AddCmd0(IL.opUMINF)
7597	akron1	2057	ELSIF isSet(e) THEN
7693	akron1	2058	IL.AddCmd0(IL.opUMINS)
7597	akron1	2059	END
		2060	END;
		2061	e.obj := eEXPR
		2062	END
		2063	END;
		2064
		2065	label := -1;
		2066
		2067	WHILE AddOperator(parser.sym) DO
		2068
		2069	op := parser.sym;
		2070	getpos(parser, pos);
		2071	PARS.Next(parser);
		2072
		2073	IF op = SCAN.lxOR THEN
		2074
		2075	IF ~parser.constexp THEN
		2076
		2077	IF label = -1 THEN
7693	akron1	2078	label := IL.NewLabel()
7597	akron1	2079	END;
		2080
		2081	IF e.obj = eCONST THEN
7693	akron1	2082	IL.Const(ORD(ARITH.getBool(e.value)))
		2083	END;
		2084	IL.AddCmd0(IL.opACC);
		2085	IL.AddJmpCmd(IL.opJNZ, label);
		2086	IL.drop
7597	akron1	2087	END
		2088
		2089	END;
		2090
		2091	term(parser, e1);
		2092
		2093	CASE op OF
		2094	\|SCAN.lxPLUS, SCAN.lxMINUS:
		2095
		2096	IF op = SCAN.lxPLUS THEN
		2097	op := ORD("+")
		2098	ELSE
		2099	op := ORD("-")
		2100	END;
		2101
7693	akron1	2102	PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
7597	akron1	2103	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		2104
		2105	CASE e.value.typ OF
7693	akron1	2106	\|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
		2107	\|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
7597	akron1	2108	\|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op))
		2109	END
		2110
		2111	ELSE
		2112	IF isInt(e) THEN
		2113	IF e.obj = eCONST THEN
7693	akron1	2114	IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
7597	akron1	2115	ELSIF e1.obj = eCONST THEN
7693	akron1	2116	IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
7597	akron1	2117	ELSE
7693	akron1	2118	IL.AddCmd0(IL.opADD + ORD(op = ORD("-")))
7597	akron1	2119	END
		2120	ELSIF isReal(e) THEN
		2121	IF e.obj = eCONST THEN
7693	akron1	2122	IL.Float(ARITH.Float(e.value));
		2123	IL.fbinop(IL.opADDFI + ORD(op = ORD("-")))
7597	akron1	2124	ELSIF e1.obj = eCONST THEN
7693	akron1	2125	IL.Float(ARITH.Float(e1.value));
		2126	IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
7597	akron1	2127	ELSE
7693	akron1	2128	IL.fbinop(IL.opADDF + ORD(op = ORD("-")))
7597	akron1	2129	END
		2130	ELSIF isSet(e) THEN
		2131	IF e.obj = eCONST THEN
7693	akron1	2132	IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
7597	akron1	2133	ELSIF e1.obj = eCONST THEN
7693	akron1	2134	IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
7597	akron1	2135	ELSE
7693	akron1	2136	IL.AddCmd0(IL.opADDS + ORD(op = ORD("-")))
7597	akron1	2137	END
		2138	END;
		2139	e.obj := eEXPR
		2140	END
		2141
		2142	\|SCAN.lxOR:
7693	akron1	2143	PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
7597	akron1	2144
		2145	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		2146	ARITH.opBoolean(e.value, e1.value, "\|")
		2147	ELSE
		2148	e.obj := eEXPR;
		2149	IF e1.obj = eCONST THEN
7693	akron1	2150	IL.Const(ORD(ARITH.getBool(e1.value)))
7667	akron1	2151	END;
7693	akron1	2152	IL.AddCmd0(IL.opACC)
7597	akron1	2153	END
		2154
		2155	END
		2156	END;
		2157
		2158	IF label # -1 THEN
7693	akron1	2159	IL.SetLabel(label)
7597	akron1	2160	END
		2161
		2162	END SimpleExpression;
		2163
		2164
		2165	PROCEDURE cmpcode (op: INTEGER): INTEGER;
		2166	VAR
		2167	res: INTEGER;
7693	akron1	2168
7597	akron1	2169	BEGIN
		2170	CASE op OF
		2171	\|SCAN.lxEQ: res := 0
		2172	\|SCAN.lxNE: res := 1
		2173	\|SCAN.lxLT: res := 2
		2174	\|SCAN.lxLE: res := 3
		2175	\|SCAN.lxGT: res := 4
		2176	\|SCAN.lxGE: res := 5
		2177	END
		2178
		2179	RETURN res
		2180	END cmpcode;
		2181
		2182
7693	akron1	2183	PROCEDURE invcmpcode (op: INTEGER): INTEGER;
		2184	VAR
		2185	res: INTEGER;
		2186
		2187	BEGIN
		2188	CASE op OF
		2189	\|SCAN.lxEQ: res := 0
		2190	\|SCAN.lxNE: res := 1
		2191	\|SCAN.lxLT: res := 4
		2192	\|SCAN.lxLE: res := 5
		2193	\|SCAN.lxGT: res := 2
		2194	\|SCAN.lxGE: res := 3
		2195	END
		2196
		2197	RETURN res
		2198	END invcmpcode;
		2199
		2200
7597	akron1	2201	PROCEDURE BoolCmp (eq, val: BOOLEAN);
		2202	BEGIN
		2203	IF eq = val THEN
7693	akron1	2204	IL.AddCmd0(IL.opNEC)
7597	akron1	2205	ELSE
7693	akron1	2206	IL.AddCmd0(IL.opEQC)
7597	akron1	2207	END
		2208	END BoolCmp;
		2209
		2210
		2211	PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
		2212	VAR
		2213	res: BOOLEAN;
		2214
		2215	BEGIN
		2216	res := TRUE;
		2217
		2218	IF isString(e) & isCharArray(e1) THEN
7693	akron1	2219	IL.StrAdr(String(e));
		2220	IL.Const(strlen(e) + 1);
		2221	IL.AddCmd0(IL.opEQS + invcmpcode(op))
7597	akron1	2222
		2223	ELSIF isString(e) & isCharArrayW(e1) THEN
7693	akron1	2224	IL.StrAdr(StringW(e));
		2225	IL.Const(utf8strlen(e) + 1);
		2226	IL.AddCmd0(IL.opEQSW + invcmpcode(op))
7597	akron1	2227
		2228	ELSIF isStringW(e) & isCharArrayW(e1) THEN
7693	akron1	2229	IL.StrAdr(StringW(e));
		2230	IL.Const(utf8strlen(e) + 1);
		2231	IL.AddCmd0(IL.opEQSW + invcmpcode(op))
7597	akron1	2232
		2233	ELSIF isCharArray(e) & isString(e1) THEN
7693	akron1	2234	IL.StrAdr(String(e1));
		2235	IL.Const(strlen(e1) + 1);
		2236	IL.AddCmd0(IL.opEQS + cmpcode(op))
7597	akron1	2237
		2238	ELSIF isCharArrayW(e) & isString(e1) THEN
7693	akron1	2239	IL.StrAdr(StringW(e1));
		2240	IL.Const(utf8strlen(e1) + 1);
		2241	IL.AddCmd0(IL.opEQSW + cmpcode(op))
7597	akron1	2242
		2243	ELSIF isCharArrayW(e) & isStringW(e1) THEN
7693	akron1	2244	IL.StrAdr(StringW(e1));
		2245	IL.Const(utf8strlen(e1) + 1);
		2246	IL.AddCmd0(IL.opEQSW + cmpcode(op))
7597	akron1	2247
		2248	ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
7693	akron1	2249	IL.AddCmd0(IL.opEQSW + cmpcode(op))
7597	akron1	2250
		2251	ELSIF isCharArray(e) & isCharArray(e1) THEN
7693	akron1	2252	IL.AddCmd0(IL.opEQS + cmpcode(op))
7597	akron1	2253
		2254	ELSIF isString(e) & isString(e1) THEN
		2255	PARS.strcmp(e.value, e1.value, op)
		2256
		2257	ELSE
		2258	res := FALSE
		2259
		2260	END
		2261
		2262	RETURN res
		2263	END strcmp;
		2264
		2265
		2266	BEGIN
		2267	getpos(parser, pos0);
		2268	SimpleExpression(parser, e);
		2269	IF relation(parser.sym) THEN
		2270	IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN
7693	akron1	2271	IL.Const(e.type.length)
7597	akron1	2272	END;
		2273	op := parser.sym;
		2274	getpos(parser, pos);
		2275	PARS.Next(parser);
		2276
7693	akron1	2277	getpos(parser, pos1);
7597	akron1	2278	SimpleExpression(parser, e1);
		2279
		2280	IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
7693	akron1	2281	IL.Const(e1.type.length)
7597	akron1	2282	END;
		2283
		2284	constant := (e.obj = eCONST) & (e1.obj = eCONST);
		2285
		2286	CASE op OF
		2287	\|SCAN.lxEQ: operator := "="
		2288	\|SCAN.lxNE: operator := "#"
		2289	\|SCAN.lxLT: operator := "<"
		2290	\|SCAN.lxLE: operator := "<="
		2291	\|SCAN.lxGT: operator := ">"
		2292	\|SCAN.lxGE: operator := ">="
		2293	\|SCAN.lxIN: operator := "IN"
		2294	\|SCAN.lxIS: operator := ""
		2295	END;
		2296
		2297	error := 0;
		2298
		2299	CASE op OF
		2300	\|SCAN.lxEQ, SCAN.lxNE:
		2301
		2302	IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
		2303	isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
		2304	isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
		2305	isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
		2306	isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN
		2307	IF constant THEN
		2308	ARITH.relation(e.value, e1.value, operator, error)
		2309	ELSE
		2310	IF e.obj = eCONST THEN
7693	akron1	2311	IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value))
7597	akron1	2312	ELSIF e1.obj = eCONST THEN
7693	akron1	2313	IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
7597	akron1	2314	ELSE
7693	akron1	2315	IL.AddCmd0(IL.opEQ + cmpcode(op))
7597	akron1	2316	END
		2317	END
		2318
		2319	ELSIF isStringW1(e) & isCharW(e1) THEN
7693	akron1	2320	IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
7597	akron1	2321
		2322	ELSIF isStringW1(e1) & isCharW(e) THEN
7693	akron1	2323	IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
7597	akron1	2324
		2325	ELSIF isBoolean(e) & isBoolean(e1) THEN
		2326	IF constant THEN
		2327	ARITH.relation(e.value, e1.value, operator, error)
		2328	ELSE
		2329	IF e.obj = eCONST THEN
		2330	BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0)
		2331	ELSIF e1.obj = eCONST THEN
		2332	BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
		2333	ELSE
		2334	IF op = SCAN.lxEQ THEN
7693	akron1	2335	IL.AddCmd0(IL.opEQB)
7597	akron1	2336	ELSE
7693	akron1	2337	IL.AddCmd0(IL.opNEB)
7597	akron1	2338	END
		2339	END
		2340	END
		2341
		2342	ELSIF isReal(e) & isReal(e1) THEN
		2343	IF constant THEN
		2344	ARITH.relation(e.value, e1.value, operator, error)
		2345	ELSE
		2346	IF e.obj = eCONST THEN
7693	akron1	2347	IL.Float(ARITH.Float(e.value))
7597	akron1	2348	ELSIF e1.obj = eCONST THEN
7693	akron1	2349	IL.Float(ARITH.Float(e1.value))
		2350	END;
		2351	IL.fcmp(IL.opEQF + cmpcode(op))
7597	akron1	2352	END
		2353
		2354	ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
		2355	IF ~strcmp(e, e1, op) THEN
7693	akron1	2356	PARS.error(pos, 37)
7597	akron1	2357	END
		2358
		2359	ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
7693	akron1	2360	IL.AddCmd0(IL.opEQC + cmpcode(op))
7597	akron1	2361
		2362	ELSIF isProc(e) & isNil(e1) THEN
		2363	IF e.obj IN {ePROC, eIMP} THEN
7693	akron1	2364	PARS.check(e.ident.global, pos0, 85);
7597	akron1	2365	constant := TRUE;
		2366	e.obj := eCONST;
		2367	ARITH.setbool(e.value, op = SCAN.lxNE)
		2368	ELSE
7693	akron1	2369	IL.AddCmd0(IL.opEQC + cmpcode(op))
7597	akron1	2370	END
		2371
		2372	ELSIF isNil(e) & isProc(e1) THEN
		2373	IF e1.obj IN {ePROC, eIMP} THEN
7693	akron1	2374	PARS.check(e1.ident.global, pos1, 85);
7597	akron1	2375	constant := TRUE;
		2376	e.obj := eCONST;
		2377	ARITH.setbool(e.value, op = SCAN.lxNE)
		2378	ELSE
7693	akron1	2379	IL.AddCmd0(IL.opEQC + cmpcode(op))
7597	akron1	2380	END
		2381
		2382	ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
		2383	IF e.obj = ePROC THEN
7693	akron1	2384	PARS.check(e.ident.global, pos0, 85)
7597	akron1	2385	END;
		2386	IF e1.obj = ePROC THEN
7693	akron1	2387	PARS.check(e1.ident.global, pos1, 85)
7597	akron1	2388	END;
		2389	IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
		2390	constant := TRUE;
		2391	e.obj := eCONST;
		2392	IF op = SCAN.lxEQ THEN
		2393	ARITH.setbool(e.value, e.ident = e1.ident)
		2394	ELSE
		2395	ARITH.setbool(e.value, e.ident # e1.ident)
		2396	END
		2397	ELSIF e.obj = ePROC THEN
7693	akron1	2398	IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ)
7597	akron1	2399	ELSIF e1.obj = ePROC THEN
7693	akron1	2400	IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ)
7597	akron1	2401	ELSIF e.obj = eIMP THEN
7693	akron1	2402	IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ)
7597	akron1	2403	ELSIF e1.obj = eIMP THEN
7693	akron1	2404	IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ)
7597	akron1	2405	ELSE
7693	akron1	2406	IL.AddCmd0(IL.opEQ + cmpcode(op))
7597	akron1	2407	END
		2408
		2409	ELSIF isNil(e) & isNil(e1) THEN
		2410	constant := TRUE;
		2411	e.obj := eCONST;
		2412	ARITH.setbool(e.value, op = SCAN.lxEQ)
		2413
		2414	ELSE
7693	akron1	2415	PARS.error(pos, 37)
7597	akron1	2416	END
		2417
		2418	\|SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
		2419	IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
		2420	isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
		2421	isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
		2422	isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
		2423
		2424	IF constant THEN
		2425	ARITH.relation(e.value, e1.value, operator, error)
		2426	ELSE
		2427	IF e.obj = eCONST THEN
7693	akron1	2428	IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
7597	akron1	2429	ELSIF e1.obj = eCONST THEN
7693	akron1	2430	IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
7597	akron1	2431	ELSE
7693	akron1	2432	IL.AddCmd0(IL.opEQ + cmpcode(op))
7597	akron1	2433	END
		2434	END
		2435
		2436	ELSIF isStringW1(e) & isCharW(e1) THEN
7693	akron1	2437	IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
7597	akron1	2438
		2439	ELSIF isStringW1(e1) & isCharW(e) THEN
7693	akron1	2440	IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s))
7597	akron1	2441
		2442	ELSIF isReal(e) & isReal(e1) THEN
		2443	IF constant THEN
		2444	ARITH.relation(e.value, e1.value, operator, error)
		2445	ELSE
		2446	IF e.obj = eCONST THEN
7693	akron1	2447	IL.Float(ARITH.Float(e.value));
		2448	IL.fcmp(IL.opEQF + invcmpcode(op))
7597	akron1	2449	ELSIF e1.obj = eCONST THEN
7693	akron1	2450	IL.Float(ARITH.Float(e1.value));
		2451	IL.fcmp(IL.opEQF + cmpcode(op))
7597	akron1	2452	ELSE
7693	akron1	2453	IL.fcmp(IL.opEQF + cmpcode(op))
7597	akron1	2454	END
		2455	END
		2456
		2457	ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
		2458	IF ~strcmp(e, e1, op) THEN
7693	akron1	2459	PARS.error(pos, 37)
7597	akron1	2460	END
		2461
		2462	ELSE
7693	akron1	2463	PARS.error(pos, 37)
7597	akron1	2464	END
		2465
		2466	\|SCAN.lxIN:
7693	akron1	2467	PARS.check(isInt(e) & isSet(e1), pos, 37);
7597	akron1	2468	IF e.obj = eCONST THEN
7693	akron1	2469	PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56)
7597	akron1	2470	END;
		2471	IF constant THEN
		2472	ARITH.relation(e.value, e1.value, operator, error)
		2473	ELSE
		2474	IF e.obj = eCONST THEN
7693	akron1	2475	IL.AddCmd(IL.opINL, ARITH.Int(e.value))
7597	akron1	2476	ELSIF e1.obj = eCONST THEN
7693	akron1	2477	IL.AddCmd(IL.opINR, ARITH.Int(e1.value))
7597	akron1	2478	ELSE
7693	akron1	2479	IL.AddCmd0(IL.opIN)
7597	akron1	2480	END
		2481	END
		2482
		2483	\|SCAN.lxIS:
7693	akron1	2484	PARS.check(isRecPtr(e), pos, 73);
		2485	PARS.check(e1.obj = eTYPE, pos1, 79);
7597	akron1	2486
7693	akron1	2487	IF isRec(e) THEN
		2488	PARS.check(e.obj = eVREC, pos0, 78);
		2489	PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80);
7597	akron1	2490	IF e.ident = NIL THEN
7693	akron1	2491	IL.TypeCheck(e1.type.num)
7597	akron1	2492	ELSE
7693	akron1	2493	IL.AddCmd(IL.opVADR, e.ident.offset - 1);
		2494	IL.TypeCheckRec(e1.type.num)
7597	akron1	2495	END
		2496	ELSE
7693	akron1	2497	PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81);
		2498	IL.TypeCheck(e1.type.base.num)
7597	akron1	2499	END;
		2500
7693	akron1	2501	PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82)
7597	akron1	2502
		2503	END;
		2504
		2505	ASSERT(error = 0);
		2506
7693	akron1	2507	e.type := tBOOLEAN;
7597	akron1	2508
		2509	IF ~constant THEN
		2510	e.obj := eEXPR
		2511	END
		2512
		2513	END
		2514	END expression;
		2515
		2516
		2517	PROCEDURE ElementaryStatement (parser: PARS.PARSER);
		2518	VAR
7983	leency	2519	e, e1: PARS.EXPR;
		2520	pos: PARS.POSITION;
		2521	line: INTEGER;
		2522	call: BOOLEAN;
		2523	fregs: INTEGER;
7597	akron1	2524
		2525	BEGIN
		2526	getpos(parser, pos);
		2527
7693	akron1	2528	IL.pushBegEnd(begcall, endcall);
7597	akron1	2529
		2530	designator(parser, e);
		2531
		2532	IF parser.sym = SCAN.lxASSIGN THEN
		2533	line := parser.lex.pos.line;
7693	akron1	2534	PARS.check(isVar(e), pos, 93);
		2535	PARS.check(~e.readOnly, pos, 94);
7597	akron1	2536
7693	akron1	2537	IL.setlast(begcall);
7597	akron1	2538
		2539	NextPos(parser, pos);
		2540	expression(parser, e1);
		2541
7693	akron1	2542	IL.setlast(endcall.prev(IL.COMMAND));
7597	akron1	2543
7693	akron1	2544	PARS.check(assign(e1, e.type, line), pos, 91);
7597	akron1	2545	IF e1.obj = ePROC THEN
7693	akron1	2546	PARS.check(e1.ident.global, pos, 85)
7597	akron1	2547	END;
		2548	call := FALSE
		2549	ELSIF parser.sym = SCAN.lxEQ THEN
		2550	PARS.check1(FALSE, parser, 96)
		2551	ELSIF parser.sym = SCAN.lxLROUND THEN
		2552	e1 := e;
		2553	ActualParameters(parser, e1);
7693	akron1	2554	PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92);
7597	akron1	2555	call := TRUE
		2556	ELSE
7693	akron1	2557	IF e.obj IN {eSYSPROC, eSTPROC} THEN
		2558	stProc(parser, e);
		2559	call := FALSE
		2560	ELSE
		2561	PARS.check(isProc(e), pos, 86);
		2562	PARS.check((e.type.base = NIL) OR ODD(e.type.call), pos, 92);
		2563	PARS.check1(e.type.params.first = NIL, parser, 64);
		2564	call := TRUE
		2565	END
7597	akron1	2566	END;
		2567
		2568	IF call THEN
		2569	IF e.obj IN {ePROC, eIMP} THEN
		2570	ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE)
		2571	ELSIF isExpr(e) THEN
		2572	ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE)
		2573	END
		2574	END;
		2575
7693	akron1	2576	IL.popBegEnd(begcall, endcall)
7597	akron1	2577	END ElementaryStatement;
		2578
		2579
		2580	PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN);
		2581	VAR
7983	leency	2582	e: PARS.EXPR;
		2583	pos: PARS.POSITION;
7597	akron1	2584
		2585	label, L: INTEGER;
		2586
		2587	BEGIN
7693	akron1	2588	L := IL.NewLabel();
7597	akron1	2589
		2590	IF ~if THEN
7693	akron1	2591	IL.AddCmd0(IL.opLOOP);
		2592	IL.SetLabel(L)
7597	akron1	2593	END;
		2594
		2595	REPEAT
		2596	NextPos(parser, pos);
		2597
7693	akron1	2598	label := IL.NewLabel();
7597	akron1	2599
		2600	expression(parser, e);
7693	akron1	2601	PARS.check(isBoolean(e), pos, 72);
7597	akron1	2602
		2603	IF e.obj = eCONST THEN
		2604	IF ~ARITH.getBool(e.value) THEN
7693	akron1	2605	IL.AddJmpCmd(IL.opJMP, label)
7597	akron1	2606	END
		2607	ELSE
7693	akron1	2608	IL.AddJmpCmd(IL.opJNE, label)
7597	akron1	2609	END;
		2610
		2611	IF if THEN
		2612	PARS.checklex(parser, SCAN.lxTHEN)
		2613	ELSE
		2614	PARS.checklex(parser, SCAN.lxDO)
		2615	END;
		2616
		2617	PARS.Next(parser);
		2618	parser.StatSeq(parser);
		2619
7693	akron1	2620	IL.AddJmpCmd(IL.opJMP, L);
		2621	IL.SetLabel(label)
7597	akron1	2622
		2623	UNTIL parser.sym # SCAN.lxELSIF;
		2624
		2625	IF if THEN
		2626	IF parser.sym = SCAN.lxELSE THEN
		2627	PARS.Next(parser);
		2628	parser.StatSeq(parser)
		2629	END;
7693	akron1	2630	IL.SetLabel(L)
7597	akron1	2631	END;
		2632
		2633	PARS.checklex(parser, SCAN.lxEND);
		2634
		2635	IF ~if THEN
7693	akron1	2636	IL.AddCmd0(IL.opENDLOOP)
7597	akron1	2637	END;
		2638
		2639	PARS.Next(parser)
		2640	END IfStatement;
		2641
		2642
		2643	PROCEDURE RepeatStatement (parser: PARS.PARSER);
		2644	VAR
		2645	e: PARS.EXPR;
7693	akron1	2646	pos: PARS.POSITION;
7597	akron1	2647	label: INTEGER;
		2648
		2649	BEGIN
7693	akron1	2650	IL.AddCmd0(IL.opLOOP);
7597	akron1	2651
7693	akron1	2652	label := IL.NewLabel();
		2653	IL.SetLabel(label);
7597	akron1	2654
		2655	PARS.Next(parser);
		2656	parser.StatSeq(parser);
		2657	PARS.checklex(parser, SCAN.lxUNTIL);
		2658	NextPos(parser, pos);
		2659	expression(parser, e);
7693	akron1	2660	PARS.check(isBoolean(e), pos, 72);
7597	akron1	2661
		2662	IF e.obj = eCONST THEN
		2663	IF ~ARITH.getBool(e.value) THEN
7693	akron1	2664	IL.AddJmpCmd(IL.opJMP, label)
7597	akron1	2665	END
		2666	ELSE
7693	akron1	2667	IL.AddJmpCmd(IL.opJNE, label)
7597	akron1	2668	END;
		2669
7693	akron1	2670	IL.AddCmd0(IL.opENDLOOP)
7597	akron1	2671	END RepeatStatement;
		2672
		2673
		2674	PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
		2675	VAR
		2676	La, Ra, Lb, Rb, res: INTEGER;
		2677
		2678	BEGIN
		2679	La := a(CASE_LABEL).range.a;
		2680	Ra := a(CASE_LABEL).range.b;
		2681	Lb := b(CASE_LABEL).range.a;
		2682	Rb := b(CASE_LABEL).range.b;
		2683	IF (Ra < Lb) OR (La > Rb) THEN
		2684	res := ORD(La > Lb) - ORD(La < Lb)
		2685	ELSE
		2686	res := 0
		2687	END
		2688
		2689	RETURN res
		2690	END LabelCmp;
		2691
		2692
		2693	PROCEDURE DestroyLabel (VAR label: AVL.DATA);
		2694	BEGIN
		2695	C.push(CaseLabels, label);
		2696	label := NIL
		2697	END DestroyLabel;
		2698
		2699
7693	akron1	2700	PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT;
7597	akron1	2701	VAR
		2702	res: CASE_VARIANT;
		2703	citem: C.ITEM;
		2704
		2705	BEGIN
		2706	citem := C.pop(CaseVar);
		2707	IF citem = NIL THEN
		2708	NEW(res)
		2709	ELSE
		2710	res := citem(CASE_VARIANT)
		2711	END;
		2712
		2713	res.label := label;
		2714	res.cmd := cmd;
		2715	res.processed := FALSE
		2716
		2717	RETURN res
		2718	END NewVariant;
		2719
		2720
		2721	PROCEDURE CaseStatement (parser: PARS.PARSER);
		2722	VAR
7983	leency	2723	e: PARS.EXPR;
		2724	pos: PARS.POSITION;
7597	akron1	2725
		2726
		2727	PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER;
		2728	VAR
7983	leency	2729	a: INTEGER;
		2730	label: PARS.EXPR;
		2731	pos: PARS.POSITION;
		2732	value: ARITH.VALUE;
7597	akron1	2733
		2734	BEGIN
		2735	getpos(parser, pos);
		2736	type := NIL;
		2737
		2738	IF isChar(caseExpr) THEN
		2739	PARS.ConstExpression(parser, value);
7693	akron1	2740	PARS.check(value.typ = ARITH.tCHAR, pos, 99);
7597	akron1	2741	a := ARITH.getInt(value)
		2742	ELSIF isCharW(caseExpr) THEN
		2743	PARS.ConstExpression(parser, value);
		2744	IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
		2745	ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
		2746	ELSE
7693	akron1	2747	PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
7597	akron1	2748	END;
		2749	a := ARITH.getInt(value)
		2750	ELSIF isInt(caseExpr) THEN
		2751	PARS.ConstExpression(parser, value);
7693	akron1	2752	PARS.check(value.typ = ARITH.tINTEGER, pos, 99);
7597	akron1	2753	a := ARITH.getInt(value)
		2754	ELSIF isRecPtr(caseExpr) THEN
		2755	qualident(parser, label);
7693	akron1	2756	PARS.check(label.obj = eTYPE, pos, 79);
		2757	PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99);
7597	akron1	2758	IF isRec(caseExpr) THEN
		2759	a := label.type.num
		2760	ELSE
		2761	a := label.type.base.num
		2762	END;
		2763	type := label.type
		2764	END
		2765
		2766	RETURN a
		2767	END Label;
		2768
		2769
7693	akron1	2770	PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.POSITION);
7597	akron1	2771	BEGIN
		2772	IF node # NIL THEN
7693	akron1	2773	PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), pos, 100);
7597	akron1	2774	CheckType(node.left, type, parser, pos);
		2775	CheckType(node.right, type, parser, pos)
		2776	END
		2777	END CheckType;
		2778
		2779
		2780	PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
		2781	VAR
		2782	label: CASE_LABEL;
		2783	citem: C.ITEM;
7693	akron1	2784	pos, pos1: PARS.POSITION;
7597	akron1	2785	node: AVL.NODE;
		2786	newnode: BOOLEAN;
		2787	range: RANGE;
		2788
		2789	BEGIN
		2790	citem := C.pop(CaseLabels);
		2791	IF citem = NIL THEN
		2792	NEW(label)
		2793	ELSE
		2794	label := citem(CASE_LABEL)
		2795	END;
		2796
		2797	label.variant := variant;
7693	akron1	2798	label.self := IL.NewLabel();
7597	akron1	2799
		2800	getpos(parser, pos1);
		2801	range.a := Label(parser, caseExpr, label.type);
		2802
		2803	IF parser.sym = SCAN.lxRANGE THEN
		2804	PARS.check1(~isRecPtr(caseExpr), parser, 53);
		2805	NextPos(parser, pos);
		2806	range.b := Label(parser, caseExpr, label.type);
7693	akron1	2807	PARS.check(range.a <= range.b, pos, 103)
7597	akron1	2808	ELSE
		2809	range.b := range.a
		2810	END;
		2811
		2812	label.range := range;
		2813
		2814	IF isRecPtr(caseExpr) THEN
		2815	CheckType(tree, label.type, parser, pos1)
		2816	END;
		2817	tree := AVL.insert(tree, label, LabelCmp, newnode, node);
7693	akron1	2818	PARS.check(newnode, pos1, 100)
7597	akron1	2819
		2820	RETURN node
		2821
		2822	END LabelRange;
		2823
		2824
		2825	PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
		2826	VAR
		2827	exit: BOOLEAN;
		2828	res: AVL.NODE;
		2829
		2830	BEGIN
		2831	exit := FALSE;
		2832	REPEAT
		2833	res := LabelRange(parser, caseExpr, tree, variant);
		2834	IF parser.sym = SCAN.lxCOMMA THEN
		2835	PARS.check1(~isRecPtr(caseExpr), parser, 53);
		2836	PARS.Next(parser)
		2837	ELSE
		2838	exit := TRUE
		2839	END
		2840	UNTIL exit
		2841
		2842	RETURN res
		2843	END CaseLabelList;
		2844
		2845
		2846	PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER);
		2847	VAR
7983	leency	2848	sym: INTEGER;
		2849	t: PROG.TYPE_;
		2850	variant: INTEGER;
		2851	node: AVL.NODE;
		2852	last: IL.COMMAND;
7597	akron1	2853
		2854	BEGIN
		2855	sym := parser.sym;
		2856	IF sym # SCAN.lxBAR THEN
7693	akron1	2857	variant := IL.NewLabel();
7597	akron1	2858	node := CaseLabelList(parser, caseExpr, tree, variant);
		2859	PARS.checklex(parser, SCAN.lxCOLON);
		2860	PARS.Next(parser);
		2861	IF isRecPtr(caseExpr) THEN
		2862	t := caseExpr.type;
		2863	caseExpr.ident.type := node.data(CASE_LABEL).type
		2864	END;
		2865
7693	akron1	2866	last := IL.getlast();
		2867	IL.SetLabel(variant);
7597	akron1	2868
		2869	IF ~isRecPtr(caseExpr) THEN
		2870	LISTS.push(CaseVariants, NewVariant(variant, last))
		2871	END;
		2872
		2873	parser.StatSeq(parser);
7693	akron1	2874	IL.AddJmpCmd(IL.opJMP, end);
7597	akron1	2875
		2876	IF isRecPtr(caseExpr) THEN
		2877	caseExpr.ident.type := t
		2878	END
		2879	END
		2880	END case;
		2881
		2882
		2883	PROCEDURE Table (node: AVL.NODE; else: INTEGER);
		2884	VAR
		2885	L, R: INTEGER;
		2886	range: RANGE;
		2887	left, right: AVL.NODE;
7693	akron1	2888	last: IL.COMMAND;
7597	akron1	2889	v: CASE_VARIANT;
		2890
		2891	BEGIN
		2892	IF node # NIL THEN
		2893
		2894	range := node.data(CASE_LABEL).range;
		2895
		2896	left := node.left;
		2897	IF left # NIL THEN
		2898	L := left.data(CASE_LABEL).self
		2899	ELSE
		2900	L := else
		2901	END;
		2902
		2903	right := node.right;
		2904	IF right # NIL THEN
		2905	R := right.data(CASE_LABEL).self
		2906	ELSE
		2907	R := else
		2908	END;
		2909
7693	akron1	2910	last := IL.getlast();
7597	akron1	2911
		2912	v := CaseVariants.last(CASE_VARIANT);
		2913	WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
		2914	v := v.prev(CASE_VARIANT)
		2915	END;
		2916
		2917	ASSERT((v # NIL) & (v.label # 0));
7693	akron1	2918	IL.setlast(v.cmd);
7597	akron1	2919
7693	akron1	2920	IL.SetLabel(node.data(CASE_LABEL).self);
		2921	IL.case(range.a, range.b, L, R);
7597	akron1	2922	IF v.processed THEN
7693	akron1	2923	IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant)
7597	akron1	2924	END;
		2925	v.processed := TRUE;
		2926
7693	akron1	2927	IL.setlast(last);
7597	akron1	2928
		2929	Table(left, else);
		2930	Table(right, else)
		2931	END
		2932	END Table;
		2933
		2934
		2935	PROCEDURE TableT (node: AVL.NODE);
		2936	BEGIN
		2937	IF node # NIL THEN
7693	akron1	2938	IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
7597	akron1	2939
		2940	TableT(node.left);
		2941	TableT(node.right)
		2942	END
		2943	END TableT;
		2944
		2945
7693	akron1	2946	PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION);
7597	akron1	2947	VAR
		2948	table, end, else: INTEGER;
		2949	tree: AVL.NODE;
7983	leency	2950	item: LISTS.ITEM;
7597	akron1	2951
		2952	BEGIN
		2953	LISTS.push(CaseVariants, NewVariant(0, NIL));
7693	akron1	2954	end := IL.NewLabel();
		2955	else := IL.NewLabel();
		2956	table := IL.NewLabel();
		2957	IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
		2958	IL.AddJmpCmd(IL.opJMP, table);
7597	akron1	2959
		2960	tree := NIL;
		2961
		2962	case(parser, e, tree, end);
		2963	WHILE parser.sym = SCAN.lxBAR DO
		2964	PARS.Next(parser);
		2965	case(parser, e, tree, end)
		2966	END;
		2967
7693	akron1	2968	IL.SetLabel(else);
7597	akron1	2969	IF parser.sym = SCAN.lxELSE THEN
		2970	PARS.Next(parser);
		2971	parser.StatSeq(parser);
7693	akron1	2972	IL.AddJmpCmd(IL.opJMP, end)
7597	akron1	2973	ELSE
7693	akron1	2974	IL.OnError(pos.line, errCASE)
7597	akron1	2975	END;
		2976
		2977	PARS.checklex(parser, SCAN.lxEND);
		2978	PARS.Next(parser);
		2979
		2980	IF isRecPtr(e) THEN
7693	akron1	2981	IL.SetLabel(table);
7597	akron1	2982	TableT(tree);
7693	akron1	2983	IL.AddJmpCmd(IL.opJMP, else)
7597	akron1	2984	ELSE
		2985	tree.data(CASE_LABEL).self := table;
		2986	Table(tree, else)
		2987	END;
		2988
		2989	AVL.destroy(tree, DestroyLabel);
7693	akron1	2990	IL.SetLabel(end);
		2991	IL.AddCmd0(IL.opENDSW);
7597	akron1	2992
		2993	REPEAT
		2994	item := LISTS.pop(CaseVariants);
		2995	C.push(CaseVar, item)
		2996	UNTIL item(CASE_VARIANT).cmd = NIL
		2997
		2998	END ParseCase;
		2999
		3000
		3001	BEGIN
		3002	NextPos(parser, pos);
		3003	expression(parser, e);
7693	akron1	3004	PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95);
7597	akron1	3005	IF isRecPtr(e) THEN
7693	akron1	3006	PARS.check(isVar(e), pos, 93);
		3007	PARS.check(e.ident # NIL, pos, 106)
7597	akron1	3008	END;
		3009	IF isRec(e) THEN
7693	akron1	3010	PARS.check(e.obj = eVREC, pos, 78)
7597	akron1	3011	END;
		3012
		3013	IF e.obj = eCONST THEN
		3014	LoadConst(e)
		3015	ELSIF isRec(e) THEN
7693	akron1	3016	IL.drop;
		3017	IL.AddCmd(IL.opLADR, e.ident.offset - 1);
7983	leency	3018	IL.load(TARGETS.WordSize)
7597	akron1	3019	ELSIF isPtr(e) THEN
		3020	deref(pos, e, FALSE, errPTR);
7983	leency	3021	IL.AddCmd(IL.opSUBR, TARGETS.WordSize);
		3022	IL.load(TARGETS.WordSize)
7597	akron1	3023	END;
		3024
		3025	PARS.checklex(parser, SCAN.lxOF);
		3026	PARS.Next(parser);
		3027	ParseCase(parser, e, pos)
		3028	END CaseStatement;
		3029
		3030
		3031	PROCEDURE ForStatement (parser: PARS.PARSER);
		3032	VAR
7693	akron1	3033	e: PARS.EXPR;
		3034	pos, pos2: PARS.POSITION;
		3035	step: ARITH.VALUE;
		3036	st: INTEGER;
		3037	ident: PROG.IDENT;
		3038	offset: INTEGER;
		3039	L1, L2: INTEGER;
7597	akron1	3040
		3041	BEGIN
7693	akron1	3042	IL.AddCmd0(IL.opLOOP);
7597	akron1	3043
7693	akron1	3044	L1 := IL.NewLabel();
		3045	L2 := IL.NewLabel();
7597	akron1	3046
		3047	PARS.ExpectSym(parser, SCAN.lxIDENT);
7693	akron1	3048	ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE);
7597	akron1	3049	PARS.check1(ident # NIL, parser, 48);
		3050	PARS.check1(ident.typ = PROG.idVAR, parser, 93);
7693	akron1	3051	PARS.check1(ident.type = tINTEGER, parser, 97);
7597	akron1	3052	PARS.ExpectSym(parser, SCAN.lxASSIGN);
		3053	NextPos(parser, pos);
		3054	expression(parser, e);
7693	akron1	3055	PARS.check(isInt(e), pos, 76);
7597	akron1	3056
		3057	offset := PROG.getOffset(PARS.program, ident);
		3058
		3059	IF ident.global THEN
7693	akron1	3060	IL.AddCmd(IL.opGADR, offset)
7597	akron1	3061	ELSE
7693	akron1	3062	IL.AddCmd(IL.opLADR, -offset)
7597	akron1	3063	END;
		3064
		3065	IF e.obj = eCONST THEN
7693	akron1	3066	IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
7597	akron1	3067	ELSE
7693	akron1	3068	IL.AddCmd0(IL.opSAVE)
7597	akron1	3069	END;
		3070
7693	akron1	3071	IL.SetLabel(L1);
7597	akron1	3072
		3073	IF ident.global THEN
7693	akron1	3074	IL.AddCmd(IL.opGADR, offset)
7597	akron1	3075	ELSE
7693	akron1	3076	IL.AddCmd(IL.opLADR, -offset)
7597	akron1	3077	END;
7693	akron1	3078	IL.load(ident.type.size);
7597	akron1	3079
		3080	PARS.checklex(parser, SCAN.lxTO);
7693	akron1	3081	NextPos(parser, pos2);
7597	akron1	3082	expression(parser, e);
7693	akron1	3083	PARS.check(isInt(e), pos2, 76);
7597	akron1	3084
		3085	IF parser.sym = SCAN.lxBY THEN
		3086	NextPos(parser, pos);
		3087	PARS.ConstExpression(parser, step);
7693	akron1	3088	PARS.check(step.typ = ARITH.tINTEGER, pos, 76);
7597	akron1	3089	st := ARITH.getInt(step);
7693	akron1	3090	PARS.check(st # 0, pos, 98)
7597	akron1	3091	ELSE
		3092	st := 1
		3093	END;
		3094
		3095	IF e.obj = eCONST THEN
		3096	IF st > 0 THEN
7693	akron1	3097	IL.AddCmd(IL.opLEC, ARITH.Int(e.value));
		3098	IF ARITH.Int(e.value) = UTILS.target.maxInt THEN
		3099	ERRORS.WarningMsg(pos2.line, pos2.col, 1)
		3100	END
7597	akron1	3101	ELSE
7693	akron1	3102	IL.AddCmd(IL.opGEC, ARITH.Int(e.value));
		3103	IF ARITH.Int(e.value) = UTILS.target.minInt THEN
		3104	ERRORS.WarningMsg(pos2.line, pos2.col, 1)
		3105	END
7597	akron1	3106	END
		3107	ELSE
		3108	IF st > 0 THEN
7693	akron1	3109	IL.AddCmd0(IL.opLE)
7597	akron1	3110	ELSE
7693	akron1	3111	IL.AddCmd0(IL.opGE)
7597	akron1	3112	END
		3113	END;
		3114
7693	akron1	3115	IL.AddJmpCmd(IL.opJNE, L2);
7597	akron1	3116
		3117	PARS.checklex(parser, SCAN.lxDO);
		3118	PARS.Next(parser);
		3119	parser.StatSeq(parser);
		3120
		3121	IF ident.global THEN
7693	akron1	3122	IL.AddCmd(IL.opGADR, offset)
7597	akron1	3123	ELSE
7693	akron1	3124	IL.AddCmd(IL.opLADR, -offset)
7597	akron1	3125	END;
		3126
7693	akron1	3127	IL.AddCmd(IL.opINCC, st);
7597	akron1	3128
7693	akron1	3129	IL.AddJmpCmd(IL.opJMP, L1);
7597	akron1	3130
		3131	PARS.checklex(parser, SCAN.lxEND);
		3132	PARS.Next(parser);
		3133
7693	akron1	3134	IL.SetLabel(L2);
7597	akron1	3135
7693	akron1	3136	IL.AddCmd0(IL.opENDLOOP)
7597	akron1	3137
		3138	END ForStatement;
		3139
		3140
		3141	PROCEDURE statement (parser: PARS.PARSER);
		3142	VAR
		3143	sym: INTEGER;
		3144
		3145	BEGIN
		3146	sym := parser.sym;
		3147
		3148	IF sym = SCAN.lxIDENT THEN
		3149	ElementaryStatement(parser)
		3150	ELSIF sym = SCAN.lxIF THEN
		3151	IfStatement(parser, TRUE)
		3152	ELSIF sym = SCAN.lxWHILE THEN
		3153	IfStatement(parser, FALSE)
		3154	ELSIF sym = SCAN.lxREPEAT THEN
		3155	RepeatStatement(parser)
		3156	ELSIF sym = SCAN.lxCASE THEN
		3157	CaseStatement(parser)
		3158	ELSIF sym = SCAN.lxFOR THEN
		3159	ForStatement(parser)
		3160	END
		3161	END statement;
		3162
		3163
		3164	PROCEDURE StatSeq (parser: PARS.PARSER);
		3165	BEGIN
		3166	statement(parser);
		3167	WHILE parser.sym = SCAN.lxSEMI DO
		3168	PARS.Next(parser);
		3169	statement(parser)
		3170	END
		3171	END StatSeq;
		3172
		3173
7693	akron1	3174	PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN;
7597	akron1	3175	VAR
		3176	res: BOOLEAN;
		3177
		3178	BEGIN
		3179	res := assigncomp(e, t);
		3180	IF res THEN
		3181	IF e.obj = eCONST THEN
7693	akron1	3182	IF e.type = tREAL THEN
		3183	IL.Float(ARITH.Float(e.value))
7597	akron1	3184	ELSIF e.type.typ = PROG.tNIL THEN
7693	akron1	3185	IL.Const(0)
7597	akron1	3186	ELSE
		3187	LoadConst(e)
		3188	END
7693	akron1	3189	ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
7597	akron1	3190	CheckRange(256, pos.line, errBYTE)
		3191	ELSIF e.obj = ePROC THEN
7693	akron1	3192	PARS.check(e.ident.global, pos, 85);
		3193	IL.PushProc(e.ident.proc.label)
7597	akron1	3194	ELSIF e.obj = eIMP THEN
7693	akron1	3195	IL.PushImpProc(e.ident.import)
7597	akron1	3196	END;
		3197
7693	akron1	3198	IF e.type = tREAL THEN
		3199	IL.retf
7597	akron1	3200	END
		3201	END
		3202
		3203	RETURN res
		3204	END chkreturn;
		3205
		3206
		3207	PROCEDURE setrtl;
		3208	VAR
		3209	rtl: PROG.UNIT;
		3210
		3211
		3212	PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
		3213	VAR
7983	leency	3214	id: PROG.IDENT;
7597	akron1	3215
		3216	BEGIN
7693	akron1	3217	id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
7597	akron1	3218
		3219	IF (id # NIL) & (id.import # NIL) THEN
7696	akron1	3220	IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label);
7597	akron1	3221	id.proc.used := TRUE
		3222	ELSIF (id # NIL) & (id.proc # NIL) THEN
7696	akron1	3223	IL.set_rtl(idx, id.proc.label);
7597	akron1	3224	id.proc.used := TRUE
		3225	ELSE
7693	akron1	3226	ERRORS.WrongRTL(name)
7597	akron1	3227	END
		3228	END getproc;
		3229
		3230
		3231	BEGIN
		3232	rtl := PARS.program.rtl;
		3233	ASSERT(rtl # NIL);
		3234
7983	leency	3235	getproc(rtl, "_strcmp", IL._strcmp);
		3236	getproc(rtl, "_length", IL._length);
		3237	getproc(rtl, "_arrcpy", IL._arrcpy);
		3238	getproc(rtl, "_is", IL._is);
		3239	getproc(rtl, "_guard", IL._guard);
		3240	getproc(rtl, "_guardrec", IL._guardrec);
		3241	getproc(rtl, "_new", IL._new);
		3242	getproc(rtl, "_rot", IL._rot);
		3243	getproc(rtl, "_strcpy", IL._strcpy);
		3244	getproc(rtl, "_move", IL._move);
		3245	getproc(rtl, "_set", IL._set);
		3246	getproc(rtl, "_set1", IL._set1);
		3247	getproc(rtl, "_lengthw", IL._lengthw);
		3248	getproc(rtl, "_strcmpw", IL._strcmpw);
		3249	getproc(rtl, "_init", IL._init);
		3250
		3251	IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
		3252	getproc(rtl, "_error", IL._error);
		3253	getproc(rtl, "_divmod", IL._divmod);
		3254	getproc(rtl, "_exit", IL._exit);
		3255	getproc(rtl, "_dispose", IL._dispose);
		3256	getproc(rtl, "_isrec", IL._isrec);
		3257	getproc(rtl, "_dllentry", IL._dllentry);
		3258	getproc(rtl, "_sofinit", IL._sofinit)
		3259	ELSIF CPU = TARGETS.cpuTHUMB THEN
		3260	getproc(rtl, "_fmul", IL._fmul);
		3261	getproc(rtl, "_fdiv", IL._fdiv);
		3262	getproc(rtl, "_fdivi", IL._fdivi);
		3263	getproc(rtl, "_fadd", IL._fadd);
		3264	getproc(rtl, "_fsub", IL._fsub);
		3265	getproc(rtl, "_fsubi", IL._fsubi);
		3266	getproc(rtl, "_fcmp", IL._fcmp);
		3267	getproc(rtl, "_floor", IL._floor);
		3268	getproc(rtl, "_flt", IL._flt);
		3269	getproc(rtl, "_pack", IL._pack);
		3270	getproc(rtl, "_unpk", IL._unpk)
7693	akron1	3271	END
7597	akron1	3272
		3273	END setrtl;
		3274
		3275
7693	akron1	3276	PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS);
7597	akron1	3277	VAR
7693	akron1	3278	parser: PARS.PARSER;
7597	akron1	3279	ext: PARS.PATH;
		3280
		3281	BEGIN
7693	akron1	3282	tINTEGER := PARS.program.stTypes.tINTEGER;
		3283	tBYTE := PARS.program.stTypes.tBYTE;
		3284	tCHAR := PARS.program.stTypes.tCHAR;
		3285	tSET := PARS.program.stTypes.tSET;
		3286	tBOOLEAN := PARS.program.stTypes.tBOOLEAN;
		3287	tWCHAR := PARS.program.stTypes.tWCHAR;
		3288	tREAL := PARS.program.stTypes.tREAL;
		3289
		3290	Options := options;
7983	leency	3291	CPU := TARGETS.CPU;
7693	akron1	3292
7983	leency	3293	ext := UTILS.FILE_EXT;
7597	akron1	3294	CaseLabels := C.create();
		3295	CaseVar := C.create();
		3296
		3297	CaseVariants := LISTS.create(NIL);
		3298	LISTS.push(CaseVariants, NewVariant(0, NIL));
		3299
7983	leency	3300	IL.init(CPU);
7597	akron1	3301
7983	leency	3302	IF CPU # TARGETS.cpuMSP430 THEN
7693	akron1	3303	parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
7983	leency	3304	IF parser.open(parser, UTILS.RTL_NAME) THEN
7597	akron1	3305	parser.parse(parser);
		3306	PARS.destroy(parser)
		3307	ELSE
7693	akron1	3308	PARS.destroy(parser);
		3309	parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
7983	leency	3310	IF parser.open(parser, UTILS.RTL_NAME) THEN
7693	akron1	3311	parser.parse(parser);
		3312	PARS.destroy(parser)
		3313	ELSE
7983	leency	3314	ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT)
7693	akron1	3315	END
7597	akron1	3316	END
		3317	END;
		3318
		3319	parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
		3320	parser.main := TRUE;
		3321
		3322	IF parser.open(parser, modname) THEN
		3323	parser.parse(parser)
		3324	ELSE
7983	leency	3325	ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
7597	akron1	3326	END;
		3327
		3328	PARS.destroy(parser);
		3329
7983	leency	3330	IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
7693	akron1	3331	ERRORS.Error(204)
7597	akron1	3332	END;
		3333
7983	leency	3334	IF CPU # TARGETS.cpuMSP430 THEN
7693	akron1	3335	setrtl
		3336	END;
7597	akron1	3337
7693	akron1	3338	PROG.DelUnused(PARS.program, IL.DelImport);
7597	akron1	3339
7696	akron1	3340	IL.set_bss(PARS.program.bss);
7693	akron1	3341
		3342	CASE CPU OF
7983	leency	3343	\|TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options)
		3344	\|TARGETS.cpuX86: X86.CodeGen(outname, target, options)
		3345	\|TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
		3346	\|TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
7597	akron1	3347	END
7693	akron1	3348
7597	akron1	3349	END compile;
		3350
		3351
7983	leency	3352	END STATEMENTS.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/STATEMENTS.ob07 – Rev 7983