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

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

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/STATEMENTS.ob07 @ 7696 – Rev 7693