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)))
		1863	END;
		1864	CODE.AddJmpCmd(CODE.opJZ, label);
		1865	CODE.drop
		1866	END
		1867	END;
		1868
		1869	factor(parser, e1);
		1870
		1871	CASE op OF
		1872	\|SCAN.lxMUL:
		1873	PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
		1874	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1875
		1876	CASE e.value.typ OF
		1877	\|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), parser, pos, 39)
		1878	\|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40)
		1879	\|ARITH.tSET: ARITH.opSet(e.value, e1.value, "*")
		1880	END
		1881
		1882	ELSE
		1883	IF isInt(e) THEN
		1884	IF e.obj = eCONST THEN
		1885	CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value))
		1886	ELSIF e1.obj = eCONST THEN
		1887	CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value))
		1888	ELSE
		1889	CODE.AddCmd0(CODE.opMUL)
		1890	END
		1891	ELSIF isReal(e) THEN
		1892	IF e.obj = eCONST THEN
		1893	CODE.Float(ARITH.Float(e.value))
		1894	ELSIF e1.obj = eCONST THEN
		1895	CODE.Float(ARITH.Float(e1.value))
		1896	END;
		1897	CODE.fbinop(CODE.opMULF)
		1898	ELSIF isSet(e) THEN
		1899	IF e.obj = eCONST THEN
		1900	CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value))
		1901	ELSIF e1.obj = eCONST THEN
		1902	CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value))
		1903	ELSE
		1904	CODE.AddCmd0(CODE.opMULS)
		1905	END
		1906	END;
		1907	e.obj := eEXPR
		1908	END
		1909
		1910	\|SCAN.lxSLASH:
		1911	PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
		1912	IF (e1.obj = eCONST) & isReal(e1) THEN
		1913	PARS.check(~ARITH.isZero(e1.value), parser, pos, 45)
		1914	END;
		1915	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1916
		1917	CASE e.value.typ OF
		1918	\|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), parser, pos, 40)
		1919	\|ARITH.tSET: ARITH.opSet(e.value, e1.value, "/")
		1920	END
		1921
		1922	ELSE
		1923	IF isReal(e) THEN
		1924	IF e.obj = eCONST THEN
		1925	CODE.Float(ARITH.Float(e.value));
		1926	CODE.fbinop(CODE.opDIVFI)
		1927	ELSIF e1.obj = eCONST THEN
		1928	CODE.Float(ARITH.Float(e1.value));
		1929	CODE.fbinop(CODE.opDIVF)
		1930	ELSE
		1931	CODE.fbinop(CODE.opDIVF)
		1932	END
		1933	ELSIF isSet(e) THEN
		1934	IF e.obj = eCONST THEN
		1935	CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value))
		1936	ELSIF e1.obj = eCONST THEN
		1937	CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value))
		1938	ELSE
		1939	CODE.AddCmd0(CODE.opDIVS)
		1940	END
		1941	END;
		1942	e.obj := eEXPR
		1943	END
		1944
		1945	\|SCAN.lxDIV, SCAN.lxMOD:
		1946	PARS.check(isInt(e) & isInt(e1), parser, pos, 37);
		1947	IF e1.obj = eCONST THEN
		1948	PARS.check(~ARITH.isZero(e1.value), parser, pos, 46)
		1949	END;
		1950	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1951
		1952	IF op = SCAN.lxDIV THEN
		1953	PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39)
		1954	ELSE
		1955	ASSERT(ARITH.opInt(e.value, e1.value, "M"))
		1956	END
		1957
		1958	ELSE
		1959	IF e1.obj # eCONST THEN
		1960	label1 := CODE.NewLabel();
		1961	CODE.AddJmpCmd(CODE.opJNZ, label1)
		1962	END;
		1963	IF e.obj = eCONST THEN
		1964	CODE.OnError(pos.line, errDIV);
		1965	CODE.SetLabel(label1);
		1966	CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
		1967	ELSIF e1.obj = eCONST THEN
		1968	CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
		1969	ELSE
		1970	CODE.OnError(pos.line, errDIV);
		1971	CODE.SetLabel(label1);
		1972	CODE.AddCmd0(CODE.opDIV + ORD(op = SCAN.lxMOD))
		1973	END;
		1974	e.obj := eEXPR
		1975	END
		1976
		1977	\|SCAN.lxAND:
		1978	PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
		1979
		1980	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		1981	ARITH.opBoolean(e.value, e1.value, "&")
		1982	ELSE
		1983	e.obj := eEXPR;
		1984	IF e1.obj = eCONST THEN
		1985	CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
		1986	END
		1987	END
		1988
		1989	END
		1990	END;
		1991
		1992	IF label # -1 THEN
		1993	CODE.SetLabel(label)
		1994	END
		1995	END term;
		1996
		1997
		1998	PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
		1999	VAR
		2000	pos: SCAN.POSITION;
		2001	op: INTEGER;
		2002	e1: PARS.EXPR;
		2003
		2004	plus, minus: BOOLEAN;
		2005
		2006	label: INTEGER;
		2007
		2008	BEGIN
		2009	plus := parser.sym = SCAN.lxPLUS;
		2010	minus := parser.sym = SCAN.lxMINUS;
		2011
		2012	IF plus OR minus THEN
		2013	getpos(parser, pos);
		2014	PARS.Next(parser)
		2015	END;
		2016
		2017	term(parser, e);
		2018
		2019	IF plus OR minus THEN
		2020	PARS.check(isInt(e) OR isReal(e) OR isSet(e), parser, pos, 36);
		2021
		2022	IF minus & (e.obj = eCONST) THEN
		2023	PARS.check(ARITH.neg(e.value), parser, pos, 39)
		2024	END;
		2025
		2026	IF e.obj # eCONST THEN
		2027	IF minus THEN
		2028	IF isInt(e) THEN
		2029	CODE.AddCmd0(CODE.opUMINUS)
		2030	ELSIF isReal(e) THEN
		2031	CODE.AddCmd0(CODE.opUMINF)
		2032	ELSIF isSet(e) THEN
		2033	CODE.AddCmd0(CODE.opUMINS)
		2034	END
		2035	END;
		2036	e.obj := eEXPR
		2037	END
		2038	END;
		2039
		2040	label := -1;
		2041
		2042	WHILE AddOperator(parser.sym) DO
		2043
		2044	op := parser.sym;
		2045	getpos(parser, pos);
		2046	PARS.Next(parser);
		2047
		2048	IF op = SCAN.lxOR THEN
		2049
		2050	IF ~parser.constexp THEN
		2051
		2052	IF label = -1 THEN
		2053	label := CODE.NewLabel()
		2054	END;
		2055
		2056	IF e.obj = eCONST THEN
		2057	CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
		2058	END;
		2059	CODE.AddJmpCmd(CODE.opJNZ, label);
		2060	CODE.drop
		2061	END
		2062
		2063	END;
		2064
		2065	term(parser, e1);
		2066
		2067	CASE op OF
		2068	\|SCAN.lxPLUS, SCAN.lxMINUS:
		2069
		2070	IF op = SCAN.lxPLUS THEN
		2071	op := ORD("+")
		2072	ELSE
		2073	op := ORD("-")
		2074	END;
		2075
		2076	PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
		2077	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		2078
		2079	CASE e.value.typ OF
		2080	\|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), parser, pos, 39)
		2081	\|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40)
		2082	\|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op))
		2083	END
		2084
		2085	ELSE
		2086	IF isInt(e) THEN
		2087	IF e.obj = eCONST THEN
		2088	CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
		2089	ELSIF e1.obj = eCONST THEN
		2090	CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
		2091	ELSE
		2092	CODE.AddCmd0(CODE.opADD + ORD(op = ORD("-")))
		2093	END
		2094	ELSIF isReal(e) THEN
		2095	IF e.obj = eCONST THEN
		2096	CODE.Float(ARITH.Float(e.value));
		2097	CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-")))
		2098	ELSIF e1.obj = eCONST THEN
		2099	CODE.Float(ARITH.Float(e1.value));
		2100	CODE.fbinop(CODE.opADDF + ORD(op = ORD("-")))
		2101	ELSE
		2102	CODE.fbinop(CODE.opADDF + ORD(op = ORD("-")))
		2103	END
		2104	ELSIF isSet(e) THEN
		2105	IF e.obj = eCONST THEN
		2106	CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
		2107	ELSIF e1.obj = eCONST THEN
		2108	CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
		2109	ELSE
		2110	CODE.AddCmd0(CODE.opADDS + ORD(op = ORD("-")))
		2111	END
		2112	END;
		2113	e.obj := eEXPR
		2114	END
		2115
		2116	\|SCAN.lxOR:
		2117	PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37);
		2118
		2119	IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
		2120	ARITH.opBoolean(e.value, e1.value, "\|")
		2121	ELSE
		2122	e.obj := eEXPR;
		2123	IF e1.obj = eCONST THEN
		2124	CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
		2125	END
		2126	END
		2127
		2128	END
		2129	END;
		2130
		2131	IF label # -1 THEN
		2132	CODE.SetLabel(label)
		2133	END
		2134
		2135	END SimpleExpression;
		2136
		2137
		2138	PROCEDURE cmpcode (op: INTEGER): INTEGER;
		2139	VAR
		2140	res: INTEGER;
		2141	BEGIN
		2142	CASE op OF
		2143	\|SCAN.lxEQ: res := 0
		2144	\|SCAN.lxNE: res := 1
		2145	\|SCAN.lxLT: res := 2
		2146	\|SCAN.lxLE: res := 3
		2147	\|SCAN.lxGT: res := 4
		2148	\|SCAN.lxGE: res := 5
		2149	END
		2150
		2151	RETURN res
		2152	END cmpcode;
		2153
		2154
		2155	PROCEDURE BoolCmp (eq, val: BOOLEAN);
		2156	BEGIN
		2157	IF eq = val THEN
		2158	CODE.AddCmd0(CODE.opNER)
		2159	ELSE
		2160	CODE.AddCmd0(CODE.opEQR)
		2161	END
		2162	END BoolCmp;
		2163
		2164
		2165	PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
		2166	VAR
		2167	res: BOOLEAN;
		2168
		2169	BEGIN
		2170
		2171	res := TRUE;
		2172
		2173	IF isString(e) & isCharArray(e1) THEN
		2174	CODE.AddCmd(CODE.opSADR, String(e));
		2175	CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
		2176	CODE.AddCmd0(CODE.opEQS2 + cmpcode(op))
		2177
		2178	ELSIF isString(e) & isCharArrayW(e1) THEN
		2179	CODE.AddCmd(CODE.opSADR, StringW(e));
		2180	CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
		2181	CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
		2182
		2183	ELSIF isStringW(e) & isCharArrayW(e1) THEN
		2184	CODE.AddCmd(CODE.opSADR, StringW(e));
		2185	CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
		2186	CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))
		2187
		2188	ELSIF isCharArray(e) & isString(e1) THEN
		2189	CODE.AddCmd(CODE.opSADR, String(e1));
		2190	CODE.AddCmd(CODE.opCONST, strlen(e1) + 1);
		2191	CODE.AddCmd0(CODE.opEQS + cmpcode(op))
		2192
		2193	ELSIF isCharArrayW(e) & isString(e1) THEN
		2194	CODE.AddCmd(CODE.opSADR, StringW(e1));
		2195	CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
		2196	CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
		2197
		2198	ELSIF isCharArrayW(e) & isStringW(e1) THEN
		2199	CODE.AddCmd(CODE.opSADR, StringW(e1));
		2200	CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
		2201	CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
		2202
		2203	ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
		2204	CODE.AddCmd0(CODE.opEQSW + cmpcode(op))
		2205
		2206	ELSIF isCharArray(e) & isCharArray(e1) THEN
		2207	CODE.AddCmd0(CODE.opEQS + cmpcode(op))
		2208
		2209	ELSIF isString(e) & isString(e1) THEN
		2210	PARS.strcmp(e.value, e1.value, op)
		2211
		2212	ELSE
		2213	res := FALSE
		2214
		2215	END
		2216
		2217	RETURN res
		2218	END strcmp;
		2219
		2220
		2221	BEGIN
		2222	getpos(parser, pos0);
		2223	SimpleExpression(parser, e);
		2224	IF relation(parser.sym) THEN
		2225	IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN
		2226	CODE.AddCmd(CODE.opCONST, e.type.length)
		2227	END;
		2228	op := parser.sym;
		2229	getpos(parser, pos);
		2230	PARS.Next(parser);
		2231
		2232	pos1 := parser.lex.pos;
		2233	SimpleExpression(parser, e1);
		2234
		2235	IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
		2236	CODE.AddCmd(CODE.opCONST, e1.type.length)
		2237	END;
		2238
		2239	constant := (e.obj = eCONST) & (e1.obj = eCONST);
		2240
		2241	CASE op OF
		2242	\|SCAN.lxEQ: operator := "="
		2243	\|SCAN.lxNE: operator := "#"
		2244	\|SCAN.lxLT: operator := "<"
		2245	\|SCAN.lxLE: operator := "<="
		2246	\|SCAN.lxGT: operator := ">"
		2247	\|SCAN.lxGE: operator := ">="
		2248	\|SCAN.lxIN: operator := "IN"
		2249	\|SCAN.lxIS: operator := ""
		2250	END;
		2251
		2252	error := 0;
		2253
		2254	CASE op OF
		2255	\|SCAN.lxEQ, SCAN.lxNE:
		2256
		2257	IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
		2258	isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
		2259	isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
		2260	isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
		2261	isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN
		2262	IF constant THEN
		2263	ARITH.relation(e.value, e1.value, operator, error)
		2264	ELSE
		2265	IF e.obj = eCONST THEN
		2266	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value))
		2267	ELSIF e1.obj = eCONST THEN
		2268	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
		2269	ELSE
		2270	CODE.AddCmd0(CODE.opEQ + cmpcode(op))
		2271	END
		2272	END
		2273
		2274	ELSIF isStringW1(e) & isCharW(e1) THEN
		2275	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
		2276
		2277	ELSIF isStringW1(e1) & isCharW(e) THEN
		2278	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
		2279
		2280	ELSIF isBoolean(e) & isBoolean(e1) THEN
		2281	IF constant THEN
		2282	ARITH.relation(e.value, e1.value, operator, error)
		2283	ELSE
		2284	IF e.obj = eCONST THEN
		2285	BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0)
		2286	ELSIF e1.obj = eCONST THEN
		2287	BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
		2288	ELSE
		2289	IF op = SCAN.lxEQ THEN
		2290	CODE.AddCmd0(CODE.opEQB)
		2291	ELSE
		2292	CODE.AddCmd0(CODE.opNEB)
		2293	END
		2294	END
		2295	END
		2296
		2297	ELSIF isReal(e) & isReal(e1) THEN
		2298	IF constant THEN
		2299	ARITH.relation(e.value, e1.value, operator, error)
		2300	ELSE
		2301	IF e.obj = eCONST THEN
		2302	CODE.Float(ARITH.Float(e.value));
		2303	CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
		2304	ELSIF e1.obj = eCONST THEN
		2305	CODE.Float(ARITH.Float(e1.value));
		2306	CODE.fcmp(CODE.opEQF + cmpcode(op))
		2307	ELSE
		2308	CODE.fcmp(CODE.opEQF + cmpcode(op))
		2309	END
		2310	END
		2311
		2312	ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
		2313	IF ~strcmp(e, e1, op) THEN
		2314	PARS.error(parser, pos, 37)
		2315	END
		2316
		2317	ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
		2318	CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
		2319
		2320	ELSIF isProc(e) & isNil(e1) THEN
		2321	IF e.obj IN {ePROC, eIMP} THEN
		2322	PARS.check(e.ident.global, parser, pos0, 85);
		2323	constant := TRUE;
		2324	e.obj := eCONST;
		2325	ARITH.setbool(e.value, op = SCAN.lxNE)
		2326	ELSE
		2327	CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
		2328	END
		2329
		2330	ELSIF isNil(e) & isProc(e1) THEN
		2331	IF e1.obj IN {ePROC, eIMP} THEN
		2332	PARS.check(e1.ident.global, parser, pos1, 85);
		2333	constant := TRUE;
		2334	e.obj := eCONST;
		2335	ARITH.setbool(e.value, op = SCAN.lxNE)
		2336	ELSE
		2337	CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
		2338	END
		2339
		2340	ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
		2341	IF e.obj = ePROC THEN
		2342	PARS.check(e.ident.global, parser, pos0, 85)
		2343	END;
		2344	IF e1.obj = ePROC THEN
		2345	PARS.check(e1.ident.global, parser, pos1, 85)
		2346	END;
		2347	IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
		2348	constant := TRUE;
		2349	e.obj := eCONST;
		2350	IF op = SCAN.lxEQ THEN
		2351	ARITH.setbool(e.value, e.ident = e1.ident)
		2352	ELSE
		2353	ARITH.setbool(e.value, e.ident # e1.ident)
		2354	END
		2355	ELSIF e.obj = ePROC THEN
		2356	CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0)
		2357	ELSIF e1.obj = ePROC THEN
		2358	CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0)
		2359	ELSIF e.obj = eIMP THEN
		2360	CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0)
		2361	ELSIF e1.obj = eIMP THEN
		2362	CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0)
		2363	ELSE
		2364	CODE.AddCmd0(CODE.opEQ + cmpcode(op))
		2365	END
		2366
		2367	ELSIF isNil(e) & isNil(e1) THEN
		2368	constant := TRUE;
		2369	e.obj := eCONST;
		2370	ARITH.setbool(e.value, op = SCAN.lxEQ)
		2371
		2372	ELSE
		2373	PARS.error(parser, pos, 37)
		2374	END
		2375
		2376	\|SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
		2377	IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
		2378	isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
		2379	isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
		2380	isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
		2381
		2382	IF constant THEN
		2383	ARITH.relation(e.value, e1.value, operator, error)
		2384	ELSE
		2385	IF e.obj = eCONST THEN
		2386	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value))
		2387	ELSIF e1.obj = eCONST THEN
		2388	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
		2389	ELSE
		2390	CODE.AddCmd0(CODE.opEQ + cmpcode(op))
		2391	END
		2392	END
		2393
		2394	ELSIF isStringW1(e) & isCharW(e1) THEN
		2395	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))
		2396
		2397	ELSIF isStringW1(e1) & isCharW(e) THEN
		2398	CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))
		2399
		2400	ELSIF isReal(e) & isReal(e1) THEN
		2401	IF constant THEN
		2402	ARITH.relation(e.value, e1.value, operator, error)
		2403	ELSE
		2404	IF e.obj = eCONST THEN
		2405	CODE.Float(ARITH.Float(e.value));
		2406	CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
		2407	ELSIF e1.obj = eCONST THEN
		2408	CODE.Float(ARITH.Float(e1.value));
		2409	CODE.fcmp(CODE.opEQF + cmpcode(op))
		2410	ELSE
		2411	CODE.fcmp(CODE.opEQF + cmpcode(op))
		2412	END
		2413	END
		2414
		2415	ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
		2416	IF ~strcmp(e, e1, op) THEN
		2417	PARS.error(parser, pos, 37)
		2418	END
		2419
		2420	ELSE
		2421	PARS.error(parser, pos, 37)
		2422	END
		2423
		2424	\|SCAN.lxIN:
		2425	PARS.check(isInt(e) & isSet(e1), parser, pos, 37);
		2426	IF e.obj = eCONST THEN
		2427	PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56)
		2428	END;
		2429	IF constant THEN
		2430	ARITH.relation(e.value, e1.value, operator, error)
		2431	ELSE
		2432	IF e.obj = eCONST THEN
		2433	CODE.AddCmd(CODE.opINL, ARITH.Int(e.value))
		2434	ELSIF e1.obj = eCONST THEN
		2435	CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value))
		2436	ELSE
		2437	CODE.AddCmd0(CODE.opIN)
		2438	END
		2439	END
		2440
		2441	\|SCAN.lxIS:
		2442	PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73);
		2443	IF e.type.typ = PROG.tRECORD THEN
		2444	PARS.check(e.obj = eVREC, parser, pos0, 78)
		2445	END;
		2446	PARS.check(e1.obj = eTYPE, parser, pos1, 79);
		2447
		2448	IF e.type.typ = PROG.tRECORD THEN
		2449	PARS.check(e1.type.typ = PROG.tRECORD, parser, pos1, 80);
		2450	IF e.ident = NIL THEN
		2451	CODE.TypeCheck(e1.type.num)
		2452	ELSE
		2453	CODE.AddCmd(CODE.opVADR, e.ident.offset - 1);
		2454	CODE.TypeCheckRec(e1.type.num)
		2455	END
		2456	ELSE
		2457	PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81);
		2458	CODE.TypeCheck(e1.type.base.num)
		2459	END;
		2460
		2461	PARS.check(PROG.isBaseOf(e.type, e1.type), parser, pos1, 82)
		2462
		2463	END;
		2464
		2465	ASSERT(error = 0);
		2466
		2467	e.type := PARS.program.stTypes.tBOOLEAN;
		2468
		2469	IF ~constant THEN
		2470	e.obj := eEXPR
		2471	END
		2472
		2473	END
		2474	END expression;
		2475
		2476
		2477	PROCEDURE ElementaryStatement (parser: PARS.PARSER);
		2478	VAR
		2479	e, e1: PARS.EXPR;
		2480	pos: SCAN.POSITION;
		2481	line: INTEGER;
		2482	call: BOOLEAN;
		2483	fregs: INTEGER;
		2484
		2485	BEGIN
		2486	getpos(parser, pos);
		2487
		2488	CODE.pushBegEnd(begcall, endcall);
		2489
		2490	designator(parser, e);
		2491
		2492	IF parser.sym = SCAN.lxASSIGN THEN
		2493	line := parser.lex.pos.line;
		2494	PARS.check(isVar(e), parser, pos, 93);
		2495	PARS.check(~e.readOnly, parser, pos, 94);
		2496
		2497	CODE.setlast(begcall);
		2498
		2499	NextPos(parser, pos);
		2500	expression(parser, e1);
		2501
		2502	CODE.setlast(endcall.prev(CODE.COMMAND));
		2503
		2504	PARS.check(assign(e1, e.type, line), parser, pos, 91);
		2505	IF e1.obj = ePROC THEN
		2506	PARS.check(e1.ident.global, parser, pos, 85)
		2507	END;
		2508	call := FALSE
		2509	ELSIF parser.sym = SCAN.lxEQ THEN
		2510	PARS.check1(FALSE, parser, 96)
		2511	ELSIF parser.sym = SCAN.lxLROUND THEN
		2512	e1 := e;
		2513	ActualParameters(parser, e1);
		2514	PARS.check((e1.type = NIL) OR ODD(e.type.call), parser, pos, 92);
		2515	call := TRUE
		2516	ELSE
		2517	PARS.check(isProc(e), parser, pos, 86);
		2518	PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92);
		2519	PARS.check1(e.type.params.first = NIL, parser, 64);
		2520	call := TRUE
		2521	END;
		2522
		2523	IF call THEN
		2524	IF e.obj IN {ePROC, eIMP} THEN
		2525	ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE)
		2526	ELSIF isExpr(e) THEN
		2527	ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE)
		2528	END
		2529	END;
		2530
		2531	CODE.popBegEnd(begcall, endcall)
		2532	END ElementaryStatement;
		2533
		2534
		2535	PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN);
		2536	VAR
		2537	e: PARS.EXPR;
		2538	pos: SCAN.POSITION;
		2539
		2540	label, L: INTEGER;
		2541
		2542	BEGIN
		2543	L := CODE.NewLabel();
		2544
		2545	IF ~if THEN
		2546	CODE.AddCmd0(CODE.opLOOP);
		2547	CODE.SetLabel(L)
		2548	END;
		2549
		2550	REPEAT
		2551	NextPos(parser, pos);
		2552
		2553	label := CODE.NewLabel();
		2554
		2555	expression(parser, e);
		2556	PARS.check(isBoolean(e), parser, pos, 72);
		2557
		2558	IF e.obj = eCONST THEN
		2559	IF ~ARITH.getBool(e.value) THEN
		2560	CODE.AddJmpCmd(CODE.opJMP, label)
		2561	END
		2562	ELSE
		2563	CODE.AddJmpCmd(CODE.opJNE, label)
		2564	END;
		2565
		2566	IF if THEN
		2567	PARS.checklex(parser, SCAN.lxTHEN)
		2568	ELSE
		2569	PARS.checklex(parser, SCAN.lxDO)
		2570	END;
		2571
		2572	PARS.Next(parser);
		2573	parser.StatSeq(parser);
		2574
		2575	CODE.AddJmpCmd(CODE.opJMP, L);
		2576	CODE.SetLabel(label)
		2577
		2578	UNTIL parser.sym # SCAN.lxELSIF;
		2579
		2580	IF if THEN
		2581	IF parser.sym = SCAN.lxELSE THEN
		2582	PARS.Next(parser);
		2583	parser.StatSeq(parser)
		2584	END;
		2585	CODE.SetLabel(L)
		2586	END;
		2587
		2588	PARS.checklex(parser, SCAN.lxEND);
		2589
		2590	IF ~if THEN
		2591	CODE.AddCmd0(CODE.opENDLOOP)
		2592	END;
		2593
		2594	PARS.Next(parser)
		2595	END IfStatement;
		2596
		2597
		2598	PROCEDURE RepeatStatement (parser: PARS.PARSER);
		2599	VAR
		2600	e: PARS.EXPR;
		2601	pos: SCAN.POSITION;
		2602	label: INTEGER;
		2603
		2604	BEGIN
		2605	CODE.AddCmd0(CODE.opLOOP);
		2606
		2607	label := CODE.NewLabel();
		2608	CODE.SetLabel(label);
		2609
		2610	PARS.Next(parser);
		2611	parser.StatSeq(parser);
		2612	PARS.checklex(parser, SCAN.lxUNTIL);
		2613	NextPos(parser, pos);
		2614	expression(parser, e);
		2615	PARS.check(isBoolean(e), parser, pos, 72);
		2616
		2617	IF e.obj = eCONST THEN
		2618	IF ~ARITH.getBool(e.value) THEN
		2619	CODE.AddJmpCmd(CODE.opJMP, label)
		2620	END
		2621	ELSE
		2622	CODE.AddJmpCmd(CODE.opJNE, label)
		2623	END;
		2624
		2625	CODE.AddCmd0(CODE.opENDLOOP)
		2626	END RepeatStatement;
		2627
		2628
		2629	PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
		2630	VAR
		2631	La, Ra, Lb, Rb, res: INTEGER;
		2632
		2633	BEGIN
		2634	La := a(CASE_LABEL).range.a;
		2635	Ra := a(CASE_LABEL).range.b;
		2636	Lb := b(CASE_LABEL).range.a;
		2637	Rb := b(CASE_LABEL).range.b;
		2638	IF (Ra < Lb) OR (La > Rb) THEN
		2639	res := ORD(La > Lb) - ORD(La < Lb)
		2640	ELSE
		2641	res := 0
		2642	END
		2643
		2644	RETURN res
		2645	END LabelCmp;
		2646
		2647
		2648	PROCEDURE DestroyLabel (VAR label: AVL.DATA);
		2649	BEGIN
		2650	C.push(CaseLabels, label);
		2651	label := NIL
		2652	END DestroyLabel;
		2653
		2654
		2655	PROCEDURE NewVariant (label: INTEGER; cmd: CODE.COMMAND): CASE_VARIANT;
		2656	VAR
		2657	res: CASE_VARIANT;
		2658	citem: C.ITEM;
		2659
		2660	BEGIN
		2661	citem := C.pop(CaseVar);
		2662	IF citem = NIL THEN
		2663	NEW(res)
		2664	ELSE
		2665	res := citem(CASE_VARIANT)
		2666	END;
		2667
		2668	res.label := label;
		2669	res.cmd := cmd;
		2670	res.processed := FALSE
		2671
		2672	RETURN res
		2673	END NewVariant;
		2674
		2675
		2676	PROCEDURE CaseStatement (parser: PARS.PARSER);
		2677	VAR
		2678	e: PARS.EXPR;
		2679	pos: SCAN.POSITION;
		2680
		2681
		2682	PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN;
		2683	RETURN isRec(caseExpr) OR isPtr(caseExpr)
		2684	END isRecPtr;
		2685
		2686
		2687	PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER;
		2688	VAR
		2689	a: INTEGER;
		2690	label: PARS.EXPR;
		2691	pos: SCAN.POSITION;
		2692	value: ARITH.VALUE;
		2693
		2694	BEGIN
		2695	getpos(parser, pos);
		2696	type := NIL;
		2697
		2698	IF isChar(caseExpr) THEN
		2699	PARS.ConstExpression(parser, value);
		2700	PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99);
		2701	a := ARITH.getInt(value)
		2702	ELSIF isCharW(caseExpr) THEN
		2703	PARS.ConstExpression(parser, value);
		2704	IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
		2705	ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
		2706	ELSE
		2707	PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99)
		2708	END;
		2709	a := ARITH.getInt(value)
		2710	ELSIF isInt(caseExpr) THEN
		2711	PARS.ConstExpression(parser, value);
		2712	PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99);
		2713	a := ARITH.getInt(value)
		2714	ELSIF isRecPtr(caseExpr) THEN
		2715	qualident(parser, label);
		2716	PARS.check(label.obj = eTYPE, parser, pos, 79);
		2717	PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, pos, 99);
		2718	IF isRec(caseExpr) THEN
		2719	a := label.type.num
		2720	ELSE
		2721	a := label.type.base.num
		2722	END;
		2723	type := label.type
		2724	END
		2725
		2726	RETURN a
		2727	END Label;
		2728
		2729
		2730	PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: SCAN.POSITION);
		2731	BEGIN
		2732	IF node # NIL THEN
		2733	PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), parser, pos, 100);
		2734	CheckType(node.left, type, parser, pos);
		2735	CheckType(node.right, type, parser, pos)
		2736	END
		2737	END CheckType;
		2738
		2739
		2740	PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
		2741	VAR
		2742	label: CASE_LABEL;
		2743	citem: C.ITEM;
		2744	pos, pos1: SCAN.POSITION;
		2745	node: AVL.NODE;
		2746	newnode: BOOLEAN;
		2747	range: RANGE;
		2748
		2749	BEGIN
		2750	citem := C.pop(CaseLabels);
		2751	IF citem = NIL THEN
		2752	NEW(label)
		2753	ELSE
		2754	label := citem(CASE_LABEL)
		2755	END;
		2756
		2757	label.variant := variant;
		2758	label.self := CODE.NewLabel();
		2759
		2760	getpos(parser, pos1);
		2761	range.a := Label(parser, caseExpr, label.type);
		2762
		2763	IF parser.sym = SCAN.lxRANGE THEN
		2764	PARS.check1(~isRecPtr(caseExpr), parser, 53);
		2765	NextPos(parser, pos);
		2766	range.b := Label(parser, caseExpr, label.type);
		2767	PARS.check(range.a <= range.b, parser, pos, 103)
		2768	ELSE
		2769	range.b := range.a
		2770	END;
		2771
		2772	label.range := range;
		2773
		2774	IF isRecPtr(caseExpr) THEN
		2775	CheckType(tree, label.type, parser, pos1)
		2776	END;
		2777	tree := AVL.insert(tree, label, LabelCmp, newnode, node);
		2778	PARS.check(newnode, parser, pos1, 100)
		2779
		2780	RETURN node
		2781
		2782	END LabelRange;
		2783
		2784
		2785	PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
		2786	VAR
		2787	exit: BOOLEAN;
		2788	res: AVL.NODE;
		2789
		2790	BEGIN
		2791	exit := FALSE;
		2792	REPEAT
		2793	res := LabelRange(parser, caseExpr, tree, variant);
		2794	IF parser.sym = SCAN.lxCOMMA THEN
		2795	PARS.check1(~isRecPtr(caseExpr), parser, 53);
		2796	PARS.Next(parser)
		2797	ELSE
		2798	exit := TRUE
		2799	END
		2800	UNTIL exit
		2801
		2802	RETURN res
		2803	END CaseLabelList;
		2804
		2805
		2806	PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER);
		2807	VAR
		2808	sym: INTEGER;
		2809	t: PROG.TYPE_;
		2810	variant: INTEGER;
		2811	node: AVL.NODE;
		2812	last: CODE.COMMAND;
		2813
		2814	BEGIN
		2815	sym := parser.sym;
		2816	IF sym # SCAN.lxBAR THEN
		2817	variant := CODE.NewLabel();
		2818	node := CaseLabelList(parser, caseExpr, tree, variant);
		2819	PARS.checklex(parser, SCAN.lxCOLON);
		2820	PARS.Next(parser);
		2821	IF isRecPtr(caseExpr) THEN
		2822	t := caseExpr.type;
		2823	caseExpr.ident.type := node.data(CASE_LABEL).type
		2824	END;
		2825
		2826	last := CODE.getlast();
		2827	CODE.SetLabel(variant);
		2828
		2829	IF ~isRecPtr(caseExpr) THEN
		2830	LISTS.push(CaseVariants, NewVariant(variant, last))
		2831	END;
		2832
		2833	parser.StatSeq(parser);
		2834	CODE.AddJmpCmd(CODE.opJMP, end);
		2835
		2836	IF isRecPtr(caseExpr) THEN
		2837	caseExpr.ident.type := t
		2838	END
		2839	END
		2840	END case;
		2841
		2842
		2843	PROCEDURE Table (node: AVL.NODE; else: INTEGER);
		2844	VAR
		2845	L, R: INTEGER;
		2846	range: RANGE;
		2847	left, right: AVL.NODE;
		2848	last: CODE.COMMAND;
		2849	v: CASE_VARIANT;
		2850
		2851	BEGIN
		2852	IF node # NIL THEN
		2853
		2854	range := node.data(CASE_LABEL).range;
		2855
		2856	left := node.left;
		2857	IF left # NIL THEN
		2858	L := left.data(CASE_LABEL).self
		2859	ELSE
		2860	L := else
		2861	END;
		2862
		2863	right := node.right;
		2864	IF right # NIL THEN
		2865	R := right.data(CASE_LABEL).self
		2866	ELSE
		2867	R := else
		2868	END;
		2869
		2870	last := CODE.getlast();
		2871
		2872	v := CaseVariants.last(CASE_VARIANT);
		2873	WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
		2874	v := v.prev(CASE_VARIANT)
		2875	END;
		2876
		2877	ASSERT((v # NIL) & (v.label # 0));
		2878	CODE.setlast(v.cmd);
		2879
		2880	CODE.SetLabel(node.data(CASE_LABEL).self);
		2881	CODE.case(range.a, range.b, L, R);
		2882	IF v.processed THEN
		2883	CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant)
		2884	END;
		2885	v.processed := TRUE;
		2886
		2887	CODE.setlast(last);
		2888
		2889	Table(left, else);
		2890	Table(right, else)
		2891	END
		2892	END Table;
		2893
		2894
		2895	PROCEDURE TableT (node: AVL.NODE);
		2896	BEGIN
		2897	IF node # NIL THEN
		2898	CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);
		2899
		2900	TableT(node.left);
		2901	TableT(node.right)
		2902	END
		2903	END TableT;
		2904
		2905
		2906	PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: SCAN.POSITION);
		2907	VAR
		2908	table, end, else: INTEGER;
		2909	tree: AVL.NODE;
		2910	item: LISTS.ITEM;
		2911
		2912	BEGIN
		2913	LISTS.push(CaseVariants, NewVariant(0, NIL));
		2914	end := CODE.NewLabel();
		2915	else := CODE.NewLabel();
		2916	table := CODE.NewLabel();
		2917	CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e)));
		2918	CODE.AddJmpCmd(CODE.opJMP, table);
		2919
		2920	tree := NIL;
		2921
		2922	case(parser, e, tree, end);
		2923	WHILE parser.sym = SCAN.lxBAR DO
		2924	PARS.Next(parser);
		2925	case(parser, e, tree, end)
		2926	END;
		2927
		2928	CODE.SetLabel(else);
		2929	IF parser.sym = SCAN.lxELSE THEN
		2930	PARS.Next(parser);
		2931	parser.StatSeq(parser);
		2932	CODE.AddJmpCmd(CODE.opJMP, end)
		2933	ELSE
		2934	CODE.OnError(pos.line, errCASE)
		2935	END;
		2936
		2937	PARS.checklex(parser, SCAN.lxEND);
		2938	PARS.Next(parser);
		2939
		2940	IF isRecPtr(e) THEN
		2941	CODE.SetLabel(table);
		2942	TableT(tree);
		2943	CODE.AddJmpCmd(CODE.opJMP, else)
		2944	ELSE
		2945	tree.data(CASE_LABEL).self := table;
		2946	Table(tree, else)
		2947	END;
		2948
		2949	AVL.destroy(tree, DestroyLabel);
		2950	CODE.SetLabel(end);
		2951	CODE.AddCmd0(CODE.opENDSW);
		2952
		2953	REPEAT
		2954	item := LISTS.pop(CaseVariants);
		2955	C.push(CaseVar, item)
		2956	UNTIL item(CASE_VARIANT).cmd = NIL
		2957
		2958	END ParseCase;
		2959
		2960
		2961	BEGIN
		2962	NextPos(parser, pos);
		2963	expression(parser, e);
		2964	PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), parser, pos, 95);
		2965	IF isRecPtr(e) THEN
		2966	PARS.check(isVar(e), parser, pos, 93);
		2967	PARS.check(e.ident # NIL, parser, pos, 106)
		2968	END;
		2969	IF isRec(e) THEN
		2970	PARS.check(e.obj = eVREC, parser, pos, 78)
		2971	END;
		2972
		2973	IF e.obj = eCONST THEN
		2974	LoadConst(e)
		2975	ELSIF isRec(e) THEN
		2976	CODE.drop;
		2977	CODE.AddCmd(CODE.opLADR, e.ident.offset - 1);
		2978	CODE.load(PARS.program.target.word)
		2979	ELSIF isPtr(e) THEN
		2980	deref(pos, e, FALSE, errPTR);
		2981	CODE.AddCmd(CODE.opSUBR, PARS.program.target.word);
		2982	CODE.load(PARS.program.target.word)
		2983	END;
		2984
		2985	PARS.checklex(parser, SCAN.lxOF);
		2986	PARS.Next(parser);
		2987	ParseCase(parser, e, pos)
		2988	END CaseStatement;
		2989
		2990
		2991	PROCEDURE ForStatement (parser: PARS.PARSER);
		2992	VAR
		2993	e: PARS.EXPR;
		2994	pos: SCAN.POSITION;
		2995	step: ARITH.VALUE;
		2996	st: INTEGER;
		2997	ident: PROG.IDENT;
		2998	offset: INTEGER;
		2999	L1, L2: INTEGER;
		3000
		3001	BEGIN
		3002	CODE.AddCmd0(CODE.opLOOP);
		3003
		3004	L1 := CODE.NewLabel();
		3005	L2 := CODE.NewLabel();
		3006
		3007	PARS.ExpectSym(parser, SCAN.lxIDENT);
		3008	ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE);
		3009	PARS.check1(ident # NIL, parser, 48);
		3010	PARS.check1(ident.typ = PROG.idVAR, parser, 93);
		3011	PARS.check1(ident.type.typ = PROG.tINTEGER, parser, 97);
		3012	PARS.ExpectSym(parser, SCAN.lxASSIGN);
		3013	NextPos(parser, pos);
		3014	expression(parser, e);
		3015	PARS.check(isInt(e), parser, pos, 76);
		3016
		3017	offset := PROG.getOffset(PARS.program, ident);
		3018
		3019	IF ident.global THEN
		3020	CODE.AddCmd(CODE.opGADR, offset)
		3021	ELSE
		3022	CODE.AddCmd(CODE.opLADR, -offset)
		3023	END;
		3024
		3025	IF e.obj = eCONST THEN
		3026	CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
		3027	ELSE
		3028	CODE.AddCmd0(CODE.opSAVE)
		3029	END;
		3030
		3031	CODE.SetLabel(L1);
		3032
		3033	IF ident.global THEN
		3034	CODE.AddCmd(CODE.opGADR, offset)
		3035	ELSE
		3036	CODE.AddCmd(CODE.opLADR, -offset)
		3037	END;
		3038	CODE.load(ident.type.size);
		3039
		3040	PARS.checklex(parser, SCAN.lxTO);
		3041	NextPos(parser, pos);
		3042	expression(parser, e);
		3043	PARS.check(isInt(e), parser, pos, 76);
		3044
		3045	IF parser.sym = SCAN.lxBY THEN
		3046	NextPos(parser, pos);
		3047	PARS.ConstExpression(parser, step);
		3048	PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76);
		3049	st := ARITH.getInt(step);
		3050	PARS.check(st # 0, parser, pos, 98)
		3051	ELSE
		3052	st := 1
		3053	END;
		3054
		3055	IF e.obj = eCONST THEN
		3056	IF st > 0 THEN
		3057	CODE.AddCmd(CODE.opLER, ARITH.Int(e.value))
		3058	ELSE
		3059	CODE.AddCmd(CODE.opGER, ARITH.Int(e.value))
		3060	END
		3061	ELSE
		3062	IF st > 0 THEN
		3063	CODE.AddCmd0(CODE.opLE)
		3064	ELSE
		3065	CODE.AddCmd0(CODE.opGE)
		3066	END
		3067	END;
		3068
		3069	CODE.AddJmpCmd(CODE.opJNE, L2);
		3070
		3071	PARS.checklex(parser, SCAN.lxDO);
		3072	PARS.Next(parser);
		3073	parser.StatSeq(parser);
		3074
		3075	IF ident.global THEN
		3076	CODE.AddCmd(CODE.opGADR, offset)
		3077	ELSE
		3078	CODE.AddCmd(CODE.opLADR, -offset)
		3079	END;
		3080
		3081	IF st = 1 THEN
		3082	CODE.AddCmd0(CODE.opINC1)
		3083	ELSIF st = -1 THEN
		3084	CODE.AddCmd0(CODE.opDEC1)
		3085	ELSE
		3086	IF st > 0 THEN
		3087	CODE.AddCmd(CODE.opINCC, st)
		3088	ELSE
		3089	CODE.AddCmd(CODE.opDECC, -st)
		3090	END
		3091	END;
		3092
		3093	CODE.AddJmpCmd(CODE.opJMP, L1);
		3094
		3095	PARS.checklex(parser, SCAN.lxEND);
		3096	PARS.Next(parser);
		3097
		3098	CODE.SetLabel(L2);
		3099
		3100	CODE.AddCmd0(CODE.opENDLOOP)
		3101
		3102	END ForStatement;
		3103
		3104
		3105	PROCEDURE statement (parser: PARS.PARSER);
		3106	VAR
		3107	sym: INTEGER;
		3108
		3109	BEGIN
		3110	sym := parser.sym;
		3111
		3112	IF sym = SCAN.lxIDENT THEN
		3113	ElementaryStatement(parser)
		3114	ELSIF sym = SCAN.lxIF THEN
		3115	IfStatement(parser, TRUE)
		3116	ELSIF sym = SCAN.lxWHILE THEN
		3117	IfStatement(parser, FALSE)
		3118	ELSIF sym = SCAN.lxREPEAT THEN
		3119	RepeatStatement(parser)
		3120	ELSIF sym = SCAN.lxCASE THEN
		3121	CaseStatement(parser)
		3122	ELSIF sym = SCAN.lxFOR THEN
		3123	ForStatement(parser)
		3124	END
		3125	END statement;
		3126
		3127
		3128	PROCEDURE StatSeq (parser: PARS.PARSER);
		3129	BEGIN
		3130	statement(parser);
		3131	WHILE parser.sym = SCAN.lxSEMI DO
		3132	PARS.Next(parser);
		3133	statement(parser)
		3134	END
		3135	END StatSeq;
		3136
		3137
		3138	PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
		3139	VAR
		3140	res: BOOLEAN;
		3141
		3142	BEGIN
		3143	res := assigncomp(e, t);
		3144	IF res THEN
		3145	IF e.obj = eCONST THEN
		3146	IF e.type.typ = PROG.tREAL THEN
		3147	CODE.Float(ARITH.Float(e.value))
		3148	ELSIF e.type.typ = PROG.tNIL THEN
		3149	CODE.AddCmd(CODE.opCONST, 0)
		3150	ELSE
		3151	LoadConst(e)
		3152	END
		3153	ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN checking) THEN
		3154	CheckRange(256, pos.line, errBYTE)
		3155	ELSIF e.obj = ePROC THEN
		3156	PARS.check(e.ident.global, parser, pos, 85);
		3157	CODE.PushProc(e.ident.proc.label)
		3158	ELSIF e.obj = eIMP THEN
		3159	CODE.PushImpProc(e.ident.import)
		3160	END;
		3161
		3162	IF e.type.typ = PROG.tREAL THEN
		3163	CODE.retf
		3164	END
		3165	END
		3166
		3167	RETURN res
		3168	END chkreturn;
		3169
		3170
		3171	PROCEDURE setrtl;
		3172	VAR
		3173	rtl: PROG.UNIT;
		3174
		3175
		3176	PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
		3177	VAR
		3178	id: PROG.IDENT;
		3179
		3180	BEGIN
		3181	id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE);
		3182
		3183	IF (id # NIL) & (id.import # NIL) THEN
		3184	CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label;
		3185	id.proc.used := TRUE
		3186	ELSIF (id # NIL) & (id.proc # NIL) THEN
		3187	CODE.codes.rtl[idx] := id.proc.label;
		3188	id.proc.used := TRUE
		3189	ELSE
		3190	ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found")
		3191	END
		3192	END getproc;
		3193
		3194
		3195	BEGIN
		3196	rtl := PARS.program.rtl;
		3197	ASSERT(rtl # NIL);
		3198
		3199	getproc(rtl, "_move", CODE._move);
		3200	getproc(rtl, "_move2", CODE._move2);
		3201	getproc(rtl, "_set", CODE._set);
		3202	getproc(rtl, "_set2", CODE._set2);
		3203	getproc(rtl, "_div", CODE._div);
		3204	getproc(rtl, "_mod", CODE._mod);
		3205	getproc(rtl, "_div2", CODE._div2);
		3206	getproc(rtl, "_mod2", CODE._mod2);
		3207	getproc(rtl, "_arrcpy", CODE._arrcpy);
		3208	getproc(rtl, "_rot", CODE._rot);
		3209	getproc(rtl, "_new", CODE._new);
		3210	getproc(rtl, "_dispose", CODE._dispose);
		3211	getproc(rtl, "_strcmp", CODE._strcmp);
		3212	getproc(rtl, "_error", CODE._error);
		3213	getproc(rtl, "_is", CODE._is);
		3214	getproc(rtl, "_isrec", CODE._isrec);
		3215	getproc(rtl, "_guard", CODE._guard);
		3216	getproc(rtl, "_guardrec", CODE._guardrec);
		3217	getproc(rtl, "_length", CODE._length);
		3218	getproc(rtl, "_init", CODE._init);
		3219	getproc(rtl, "_dllentry", CODE._dllentry);
		3220	getproc(rtl, "_strcpy", CODE._strcpy);
		3221	getproc(rtl, "_exit", CODE._exit);
		3222	getproc(rtl, "_strcpy2", CODE._strcpy2);
		3223	getproc(rtl, "_lengthw", CODE._lengthw);
		3224	getproc(rtl, "_strcmp2", CODE._strcmp2);
		3225	getproc(rtl, "_strcmpw", CODE._strcmpw);
		3226	getproc(rtl, "_strcmpw2", CODE._strcmpw2);
		3227
		3228	END setrtl;
		3229
		3230
		3231	PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET);
		3232	VAR
		3233	parser: PARS.PARSER;
		3234	ext: PARS.PATH;
		3235	amd64: BOOLEAN;
		3236
		3237	BEGIN
		3238	amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
		3239	ext := mConst.FILE_EXT;
		3240	CaseLabels := C.create();
		3241	CaseVar := C.create();
		3242
		3243	CaseVariants := LISTS.create(NIL);
		3244	LISTS.push(CaseVariants, NewVariant(0, NIL));
		3245
		3246	checking := chk;
		3247
		3248	IF amd64 THEN
		3249	CODE.init(6, CODE.little_endian)
		3250	ELSE
		3251	CODE.init(8, CODE.little_endian)
		3252	END;
		3253
		3254	parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
		3255	IF parser.open(parser, mConst.RTL_NAME) THEN
		3256	parser.parse(parser);
		3257	PARS.destroy(parser)
		3258	ELSE
		3259	PARS.destroy(parser);
		3260	parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
		3261	IF parser.open(parser, mConst.RTL_NAME) THEN
		3262	parser.parse(parser);
		3263	PARS.destroy(parser)
		3264	ELSE
		3265	ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found")
		3266	END
		3267	END;
		3268
		3269	parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
		3270	parser.main := TRUE;
		3271
		3272	IF parser.open(parser, modname) THEN
		3273	parser.parse(parser)
		3274	ELSE
		3275	ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found")
		3276	END;
		3277
		3278	PARS.destroy(parser);
		3279
		3280	IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN
		3281	ERRORS.error1("size of global variables is too large")
		3282	END;
		3283
		3284	setrtl;
		3285
		3286	PROG.DelUnused(PARS.program, CODE.DelImport);
		3287
		3288	CODE.codes.bss := PARS.program.bss;
		3289	IF amd64 THEN
		3290	AMD64.CodeGen(CODE.codes, outname, target, stack, base)
		3291	ELSE
		3292	X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic)
		3293	END
		3294	END compile;
		3295
		3296
		3297	END STATEMENTS.

Subversion Repositories Kolibri OS

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