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

Subversion Repositories Kolibri OS

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