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

Subversion Repositories Kolibri OS

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