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

Rev	Author	Line No.	Line
7696	akron1	1	(*
7693	akron1	2	BSD 2-Clause License
		3
7696	akron1	4	Copyright (c) 2018-2019, Anton Krotov
7693	akron1	5	All rights reserved.
		6	*)
		7
		8	MODULE IL;
		9
		10	IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS;
		11
		12
		13	CONST
		14
		15	little_endian* = 0;
		16	big_endian* = 1;
		17
		18	call_stack* = 0;
		19	call_win64* = 1;
		20	call_sysv* = 2;
		21
		22	opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5;
		23	opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11;
		24	opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16;
		25	opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22;
		26	opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28;
		27	opNOT* = 29;
		28
		29	opEQ* = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *);
		30	opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *)
		31	opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *)
		32	opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *)
		33	opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *);
		34
		35	opVLOAD32* = 60; opGLOAD32* = 61;
		36
		37	opJNE* = 62; opJE* = 63;
		38
		39	opSAVE32* = 64; opLLOAD8* = 65;
		40
		41	opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71;
		42	opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76;
		43
		44	opACC* = 77; opJG* = 78;
		45	opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82;
		46
		47	opCASEL* = 83; opCASER* = 84; opCASELR* = 85;
		48
		49	opPOPSP* = 86;
		50	opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91;
		51
		52	opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97;
		53	opPUSHC* = 98; opSWITCH* = 99;
		54
		55	opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102;
		56
		57	opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106;
		58	opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112;
		59	opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116;
		60	opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121;
		61
		62	opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124;
		63	opINCC* = 125; opINC* = 126; opDEC* = 127;
		64	opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133;
		65	opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139;
		66	opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145;
		67	opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151;
		68	opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156;
		69	opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162;
		70	opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168;
		71	opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173;
		72	opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179;
		73
		74	opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184;
		75	opLSR* = 185; opLSR1* = 186; opLSR2* = 187;
		76	opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192;
		77	opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198;
		78	opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201;
		79	opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206;
		80
		81	opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212;
		82	opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216;
		83
		84	opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221;
		85
		86
		87	opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4;
		88	opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8;
		89	opLOAD32_PARAM* = -9;
		90
		91	opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12;
		92
		93	opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15;
		94	opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19;
		95	opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23;
		96	opLADR_UNPK* = -24;
		97
		98
7696	akron1	99	_init *= 0;
		100	_move *= 1;
7693	akron1	101	_strcmpw *= 2;
		102	_exit *= 3;
		103	_set *= 4;
7696	akron1	104	_set1 *= 5;
7693	akron1	105	_lengthw *= 6;
		106	_strcpy *= 7;
7696	akron1	107	_length *= 8;
		108	_divmod *= 9;
		109	_dllentry *= 10;
		110	_sofinit *= 11;
7693	akron1	111	_arrcpy *= 12;
		112	_rot *= 13;
		113	_new *= 14;
		114	_dispose *= 15;
		115	_strcmp *= 16;
		116	_error *= 17;
		117	_is *= 18;
		118	_isrec *= 19;
		119	_guard *= 20;
		120	_guardrec *= 21;
		121
		122
		123	TYPE
		124
		125	LOCALVAR* = POINTER TO RECORD (LISTS.ITEM)
		126
		127	offset, size, count*: INTEGER
		128
		129	END;
		130
		131	COMMAND* = POINTER TO RECORD (LISTS.ITEM)
		132
		133	opcode*: INTEGER;
		134	param1*: INTEGER;
		135	param2*: INTEGER;
		136	param3*: INTEGER;
		137	float*: REAL;
		138	variables*: LISTS.LIST;
		139	allocReg*: BOOLEAN
		140
		141	END;
		142
		143	CMDSTACK = POINTER TO RECORD
		144
		145	data: ARRAY 1000 OF COMMAND;
		146	top: INTEGER
		147
		148	END;
		149
		150	EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
		151
		152	label*: INTEGER;
		153	name*: SCAN.LEXSTR
		154
		155	END;
		156
		157	IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM)
		158
		159	name*: SCAN.LEXSTR;
		160	procs*: LISTS.LIST
		161
		162	END;
		163
		164	IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
		165
		166	label*: INTEGER;
		167	lib*: IMPORT_LIB;
		168	name*: SCAN.LEXSTR;
		169	count: INTEGER
		170
		171	END;
		172
		173
7696	akron1	174	CODES = RECORD
7693	akron1	175
		176	last: COMMAND;
		177	begcall: CMDSTACK;
		178	endcall: CMDSTACK;
		179	commands*: LISTS.LIST;
		180	export*: LISTS.LIST;
		181	import*: LISTS.LIST;
		182	types*: CHL.INTLIST;
		183	data*: CHL.BYTELIST;
		184	dmin*: INTEGER;
		185	lcount*: INTEGER;
		186	bss*: INTEGER;
7696	akron1	187	rtl*: ARRAY 22 OF INTEGER;
7693	akron1	188	errlabels*: ARRAY 12 OF INTEGER;
		189
		190	charoffs: ARRAY 256 OF INTEGER;
		191	wcharoffs: ARRAY 65536 OF INTEGER;
		192
		193	fregs: INTEGER;
		194	wstr: ARRAY 4*1024 OF WCHAR
		195	END;
		196
		197
		198	VAR
		199
		200	codes*: CODES;
		201	endianness: INTEGER;
		202	numRegsFloat: INTEGER;
		203
		204	commands, variables: C.COLLECTION;
		205
		206
7696	akron1	207	PROCEDURE set_dmin* (value: INTEGER);
		208	BEGIN
		209	codes.dmin := value
		210	END set_dmin;
		211
		212
		213	PROCEDURE set_bss* (value: INTEGER);
		214	BEGIN
		215	codes.bss := value
		216	END set_bss;
		217
		218
		219	PROCEDURE set_rtl* (idx, label: INTEGER);
		220	BEGIN
		221	codes.rtl[idx] := label
		222	END set_rtl;
		223
		224
7693	akron1	225	PROCEDURE NewCmd (): COMMAND;
		226	VAR
		227	cmd: COMMAND;
		228	citem: C.ITEM;
		229
		230	BEGIN
		231	citem := C.pop(commands);
		232	IF citem = NIL THEN
		233	NEW(cmd)
		234	ELSE
		235	cmd := citem(COMMAND)
		236	END;
		237
		238	cmd.allocReg := FALSE
		239
		240	RETURN cmd
		241	END NewCmd;
		242
		243
		244	PROCEDURE NewVar* (): LOCALVAR;
		245	VAR
		246	lvar: LOCALVAR;
		247	citem: C.ITEM;
		248
		249	BEGIN
		250	citem := C.pop(variables);
		251	IF citem = NIL THEN
		252	NEW(lvar)
		253	ELSE
		254	lvar := citem(LOCALVAR)
		255	END;
		256
		257	lvar.count := 0
		258
		259	RETURN lvar
		260	END NewVar;
		261
		262
		263	PROCEDURE setlast* (cmd: COMMAND);
		264	BEGIN
		265	codes.last := cmd
		266	END setlast;
		267
		268
		269	PROCEDURE getlast* (): COMMAND;
		270	RETURN codes.last
		271	END getlast;
		272
		273
7696	akron1	274	PROCEDURE PutByte (b: BYTE);
7693	akron1	275	BEGIN
		276	CHL.PushByte(codes.data, b)
		277	END PutByte;
		278
		279
		280	PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER;
		281	VAR
		282	i, n, res: INTEGER;
		283	BEGIN
		284	res := CHL.Length(codes.data);
		285
		286	i := 0;
		287	n := LENGTH(s);
		288	WHILE i < n DO
7696	akron1	289	PutByte(ORD(s[i]));
7693	akron1	290	INC(i)
		291	END;
		292
7696	akron1	293	PutByte(0)
7693	akron1	294
		295	RETURN res
		296	END putstr;
		297
		298
		299	PROCEDURE putstr1* (c: INTEGER): INTEGER;
		300	VAR
		301	res: INTEGER;
		302
		303	BEGIN
		304	IF codes.charoffs[c] = -1 THEN
		305	res := CHL.Length(codes.data);
7696	akron1	306	PutByte(c);
		307	PutByte(0);
7693	akron1	308	codes.charoffs[c] := res
		309	ELSE
		310	res := codes.charoffs[c]
		311	END
		312
		313	RETURN res
		314	END putstr1;
		315
		316
		317	PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER;
		318	VAR
		319	i, n, res: INTEGER;
		320
		321	BEGIN
		322	res := CHL.Length(codes.data);
		323
		324	IF ODD(res) THEN
7696	akron1	325	PutByte(0);
7693	akron1	326	INC(res)
		327	END;
		328
		329	n := STRINGS.Utf8To16(s, codes.wstr);
		330
		331	i := 0;
		332	WHILE i < n DO
		333	IF endianness = little_endian THEN
7696	akron1	334	PutByte(ORD(codes.wstr[i]) MOD 256);
		335	PutByte(ORD(codes.wstr[i]) DIV 256)
7693	akron1	336	ELSIF endianness = big_endian THEN
7696	akron1	337	PutByte(ORD(codes.wstr[i]) DIV 256);
		338	PutByte(ORD(codes.wstr[i]) MOD 256)
7693	akron1	339	END;
		340	INC(i)
		341	END;
		342
7696	akron1	343	PutByte(0);
		344	PutByte(0)
7693	akron1	345
		346	RETURN res
		347	END putstrW;
		348
		349
		350	PROCEDURE putstrW1* (c: INTEGER): INTEGER;
		351	VAR
		352	res: INTEGER;
		353
		354	BEGIN
		355	IF codes.wcharoffs[c] = -1 THEN
		356	res := CHL.Length(codes.data);
		357
		358	IF ODD(res) THEN
7696	akron1	359	PutByte(0);
7693	akron1	360	INC(res)
		361	END;
		362
		363	IF endianness = little_endian THEN
7696	akron1	364	PutByte(c MOD 256);
		365	PutByte(c DIV 256)
7693	akron1	366	ELSIF endianness = big_endian THEN
7696	akron1	367	PutByte(c DIV 256);
		368	PutByte(c MOD 256)
7693	akron1	369	END;
		370
7696	akron1	371	PutByte(0);
		372	PutByte(0);
7693	akron1	373
		374	codes.wcharoffs[c] := res
		375	ELSE
		376	res := codes.wcharoffs[c]
		377	END
		378
		379	RETURN res
		380	END putstrW1;
		381
		382
		383	PROCEDURE push (stk: CMDSTACK; cmd: COMMAND);
		384	BEGIN
		385	INC(stk.top);
		386	stk.data[stk.top] := cmd
		387	END push;
		388
		389
		390	PROCEDURE pop (stk: CMDSTACK): COMMAND;
		391	VAR
		392	res: COMMAND;
		393	BEGIN
		394	res := stk.data[stk.top];
		395	DEC(stk.top)
		396	RETURN res
		397	END pop;
		398
		399
		400	PROCEDURE pushBegEnd* (VAR beg, end: COMMAND);
		401	BEGIN
		402	push(codes.begcall, beg);
		403	push(codes.endcall, end);
		404	beg := codes.last;
		405	end := beg.next(COMMAND)
		406	END pushBegEnd;
		407
		408
		409	PROCEDURE popBegEnd* (VAR beg, end: COMMAND);
		410	BEGIN
		411	beg := pop(codes.begcall);
		412	end := pop(codes.endcall)
		413	END popBegEnd;
		414
		415
		416	PROCEDURE AddRec* (base: INTEGER);
		417	BEGIN
		418	CHL.PushInt(codes.types, base)
		419	END AddRec;
		420
		421
		422	PROCEDURE insert (cur, nov: COMMAND);
		423	VAR
		424	old_opcode, param2: INTEGER;
		425
		426
		427	PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER);
		428	BEGIN
		429	cur.opcode := opcode;
		430	cur.param1 := cur.param2;
		431	cur.param2 := param2
		432	END set;
		433
		434
		435	BEGIN
		436	old_opcode := cur.opcode;
		437	param2 := nov.param2;
		438
		439	IF (nov.opcode = opPARAM) & (param2 = 1) THEN
		440
		441	CASE old_opcode OF
		442	\|opGLOAD64: cur.opcode := opGLOAD64_PARAM
		443	\|opLLOAD64: cur.opcode := opLLOAD64_PARAM
		444	\|opLOAD64: cur.opcode := opLOAD64_PARAM
		445	\|opGLOAD32: cur.opcode := opGLOAD32_PARAM
		446	\|opLLOAD32: cur.opcode := opLLOAD32_PARAM
		447	\|opLOAD32: cur.opcode := opLOAD32_PARAM
		448	\|opSADR: cur.opcode := opSADR_PARAM
		449	\|opVADR: cur.opcode := opVADR_PARAM
		450	\|opCONST: cur.opcode := opCONST_PARAM
		451	ELSE
		452	old_opcode := -1
		453	END
		454
		455	ELSIF old_opcode = opLADR THEN
		456
		457	CASE nov.opcode OF
		458	\|opSAVEC: set(cur, opLADR_SAVEC, param2)
		459	\|opSAVE: cur.opcode := opLADR_SAVE
		460	\|opINC: cur.opcode := opLADR_INC
		461	\|opDEC: cur.opcode := opLADR_DEC
		462	\|opINCB: cur.opcode := opLADR_INCB
		463	\|opDECB: cur.opcode := opLADR_DECB
		464	\|opINCL: cur.opcode := opLADR_INCL
		465	\|opEXCL: cur.opcode := opLADR_EXCL
		466	\|opUNPK: cur.opcode := opLADR_UNPK
		467	\|opINCC: set(cur, opLADR_INCC, param2)
		468	\|opINCCB: set(cur, opLADR_INCCB, param2)
		469	\|opDECCB: set(cur, opLADR_DECCB, param2)
		470	\|opINCLC: set(cur, opLADR_INCLC, param2)
		471	\|opEXCLC: set(cur, opLADR_EXCLC, param2)
		472	ELSE
		473	old_opcode := -1
		474	END
		475
		476	ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN
		477	set(cur, opGADR_SAVEC, param2)
		478
		479	ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
		480	cur.param2 := param2 * cur.param2
		481
		482	ELSE
		483	old_opcode := -1
		484	END;
		485
		486	IF old_opcode = -1 THEN
		487	LISTS.insert(codes.commands, cur, nov);
		488	codes.last := nov
		489	ELSE
		490	C.push(commands, nov);
		491	codes.last := cur
		492	END
		493	END insert;
		494
		495
		496	PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER);
		497	VAR
		498	cmd: COMMAND;
		499	BEGIN
		500	cmd := NewCmd();
		501	cmd.opcode := opcode;
		502	cmd.param1 := 0;
		503	cmd.param2 := param;
		504	insert(codes.last, cmd)
		505	END AddCmd;
		506
		507
		508	PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER);
		509	VAR
		510	cmd: COMMAND;
		511	BEGIN
		512	cmd := NewCmd();
		513	cmd.opcode := opcode;
		514	cmd.param1 := param1;
		515	cmd.param2 := param2;
		516	insert(codes.last, cmd)
		517	END AddCmd2;
		518
		519
		520	PROCEDURE Const* (val: INTEGER);
		521	BEGIN
		522	AddCmd(opCONST, val)
		523	END Const;
		524
		525
		526	PROCEDURE StrAdr* (adr: INTEGER);
		527	BEGIN
		528	AddCmd(opSADR, adr)
		529	END StrAdr;
		530
		531
		532	PROCEDURE Param1*;
		533	BEGIN
		534	AddCmd(opPARAM, 1)
		535	END Param1;
		536
		537
		538	PROCEDURE NewLabel* (): INTEGER;
		539	BEGIN
		540	INC(codes.lcount)
		541	RETURN codes.lcount - 1
		542	END NewLabel;
		543
		544
		545	PROCEDURE SetLabel* (label: INTEGER);
		546	BEGIN
		547	AddCmd2(opLABEL, label, 0)
		548	END SetLabel;
		549
		550
		551	PROCEDURE SetErrLabel* (errno: INTEGER);
		552	BEGIN
		553	codes.errlabels[errno] := NewLabel();
		554	SetLabel(codes.errlabels[errno])
		555	END SetErrLabel;
		556
		557
		558	PROCEDURE AddCmd0* (opcode: INTEGER);
		559	BEGIN
		560	AddCmd(opcode, 0)
		561	END AddCmd0;
		562
		563
		564	PROCEDURE deleteVarList (list: LISTS.LIST);
		565	VAR
		566	last: LISTS.ITEM;
		567
		568	BEGIN
		569	WHILE list.last # NIL DO
		570	last := LISTS.pop(list);
		571	C.push(variables, last)
		572	END
		573	END deleteVarList;
		574
		575
		576	PROCEDURE delete (cmd: COMMAND);
		577	BEGIN
		578	IF cmd.variables # NIL THEN
		579	deleteVarList(cmd.variables)
		580	END;
		581	LISTS.delete(codes.commands, cmd);
		582	C.push(commands, cmd)
		583	END delete;
		584
		585
		586	PROCEDURE delete2* (first, last: LISTS.ITEM);
		587	VAR
		588	cur, next: LISTS.ITEM;
		589
		590	BEGIN
		591	cur := first;
		592
		593	IF first # last THEN
		594	REPEAT
		595	next := cur.next;
		596	LISTS.delete(codes.commands, cur);
		597	C.push(commands, cur);
		598	cur := next
		599	UNTIL cur = last
		600	END;
		601
		602	LISTS.delete(codes.commands, cur);
		603	C.push(commands, cur)
		604	END delete2;
		605
		606
		607	PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER);
		608	VAR
		609	prev: COMMAND;
		610	not: BOOLEAN;
		611
		612	BEGIN
		613	prev := codes.last;
		614	not := prev.opcode = opNOT;
		615	IF not THEN
		616	IF opcode = opJE THEN
		617	opcode := opJNE
		618	ELSIF opcode = opJNE THEN
		619	opcode := opJE
		620	ELSE
		621	not := FALSE
		622	END
		623	END;
		624
		625	AddCmd2(opcode, label, label);
		626
		627	IF not THEN
		628	delete(prev)
		629	END
		630
		631	END AddJmpCmd;
		632
		633
		634	PROCEDURE OnError* (line, error: INTEGER);
		635	BEGIN
		636	AddCmd(opPUSHC, line);
		637	AddJmpCmd(opJMP, codes.errlabels[error])
		638	END OnError;
		639
		640
		641	PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER);
		642	VAR
		643	label: INTEGER;
		644	BEGIN
		645	AddCmd(op, t);
		646	label := NewLabel();
		647	AddJmpCmd(opJE, label);
		648	OnError(line, error);
		649	SetLabel(label)
		650	END TypeGuard;
		651
		652
		653	PROCEDURE TypeCheck* (t: INTEGER);
		654	BEGIN
		655	AddCmd(opIS, t)
		656	END TypeCheck;
		657
		658
		659	PROCEDURE TypeCheckRec* (t: INTEGER);
		660	BEGIN
		661	AddCmd(opISREC, t)
		662	END TypeCheckRec;
		663
		664
		665	PROCEDURE New* (size, typenum: INTEGER);
		666	BEGIN
		667	AddCmd2(opNEW, typenum, size)
		668	END New;
		669
		670
		671	PROCEDURE fcmp* (opcode: INTEGER);
		672	BEGIN
		673	AddCmd(opcode, 0);
		674	DEC(codes.fregs, 2);
		675	ASSERT(codes.fregs >= 0)
		676	END fcmp;
		677
		678
		679	PROCEDURE not*;
		680	VAR
		681	prev: COMMAND;
		682	BEGIN
		683	prev := codes.last;
		684	IF prev.opcode = opNOT THEN
		685	codes.last := prev.prev(COMMAND);
		686	delete(prev)
		687	ELSE
		688	AddCmd0(opNOT)
		689	END
		690	END not;
		691
		692
		693	PROCEDURE Enter* (label, params: INTEGER): COMMAND;
		694	VAR
		695	cmd: COMMAND;
		696
		697	BEGIN
		698	cmd := NewCmd();
		699	cmd.opcode := opENTER;
		700	cmd.param1 := label;
		701	cmd.param3 := params;
		702	cmd.allocReg := TRUE;
		703	insert(codes.last, cmd)
		704
		705	RETURN codes.last
		706	END Enter;
		707
		708
		709	PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND;
		710	BEGIN
		711	IF result THEN
		712	IF float THEN
		713	AddCmd2(opLEAVEF, locsize, paramsize)
		714	ELSE
		715	AddCmd2(opLEAVER, locsize, paramsize)
		716	END
		717	ELSE
		718	AddCmd2(opLEAVE, locsize, paramsize)
		719	END
		720
		721	RETURN codes.last
		722	END Leave;
		723
		724
		725	PROCEDURE EnterC* (label: INTEGER): COMMAND;
		726	BEGIN
		727	SetLabel(label)
		728	RETURN codes.last
		729	END EnterC;
		730
		731
		732	PROCEDURE LeaveC* (): COMMAND;
		733	BEGIN
		734	AddCmd0(opLEAVEC)
		735	RETURN codes.last
		736	END LeaveC;
		737
		738
		739	PROCEDURE Call* (proc, callconv, fparams: INTEGER);
		740	BEGIN
		741	CASE callconv OF
		742	\|call_stack: AddJmpCmd(opCALL, proc)
		743	\|call_win64: AddJmpCmd(opWIN64CALL, proc)
		744	\|call_sysv: AddJmpCmd(opSYSVCALL, proc)
		745	END;
		746	codes.last(COMMAND).param2 := fparams
		747	END Call;
		748
		749
		750	PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
		751	BEGIN
		752	CASE callconv OF
		753	\|call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label)
		754	\|call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label)
		755	\|call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label)
		756	END;
		757	codes.last(COMMAND).param2 := fparams
		758	END CallImp;
		759
		760
		761	PROCEDURE CallP* (callconv, fparams: INTEGER);
		762	BEGIN
		763	CASE callconv OF
		764	\|call_stack: AddCmd0(opCALLP)
		765	\|call_win64: AddCmd(opWIN64CALLP, fparams)
		766	\|call_sysv: AddCmd(opSYSVCALLP, fparams)
		767	END
		768	END CallP;
		769
		770
		771	PROCEDURE AssignProc* (proc: INTEGER);
		772	BEGIN
		773	AddJmpCmd(opSAVEP, proc)
		774	END AssignProc;
		775
		776
		777	PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
		778	BEGIN
		779	AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label)
		780	END AssignImpProc;
		781
		782
		783	PROCEDURE PushProc* (proc: INTEGER);
		784	BEGIN
		785	AddJmpCmd(opPUSHP, proc)
		786	END PushProc;
		787
		788
		789	PROCEDURE PushImpProc* (proc: LISTS.ITEM);
		790	BEGIN
		791	AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label)
		792	END PushImpProc;
		793
		794
		795	PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
		796	BEGIN
		797	IF eq THEN
		798	AddJmpCmd(opEQP, proc)
		799	ELSE
		800	AddJmpCmd(opNEP, proc)
		801	END
		802	END ProcCmp;
		803
		804
		805	PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
		806	BEGIN
		807	IF eq THEN
		808	AddJmpCmd(opEQIP, proc(IMPORT_PROC).label)
		809	ELSE
		810	AddJmpCmd(opNEIP, proc(IMPORT_PROC).label)
		811	END
		812	END ProcImpCmp;
		813
		814
		815	PROCEDURE load* (size: INTEGER);
		816	VAR
		817	last: COMMAND;
		818
		819	BEGIN
		820	last := codes.last;
		821	CASE size OF
		822	\|1:
		823	IF last.opcode = opLADR THEN
		824	last.opcode := opLLOAD8
		825	ELSIF last.opcode = opVADR THEN
		826	last.opcode := opVLOAD8
		827	ELSIF last.opcode = opGADR THEN
		828	last.opcode := opGLOAD8
		829	ELSE
		830	AddCmd0(opLOAD8)
		831	END
		832
		833	\|2:
		834	IF last.opcode = opLADR THEN
		835	last.opcode := opLLOAD16
		836	ELSIF last.opcode = opVADR THEN
		837	last.opcode := opVLOAD16
		838	ELSIF last.opcode = opGADR THEN
		839	last.opcode := opGLOAD16
		840	ELSE
		841	AddCmd0(opLOAD16)
		842	END
		843
		844	\|4:
		845	IF last.opcode = opLADR THEN
		846	last.opcode := opLLOAD32
		847	ELSIF last.opcode = opVADR THEN
		848	last.opcode := opVLOAD32
		849	ELSIF last.opcode = opGADR THEN
		850	last.opcode := opGLOAD32
		851	ELSE
		852	AddCmd0(opLOAD32)
		853	END
		854
		855	\|8:
		856	IF last.opcode = opLADR THEN
		857	last.opcode := opLLOAD64
		858	ELSIF last.opcode = opVADR THEN
		859	last.opcode := opVLOAD64
		860	ELSIF last.opcode = opGADR THEN
		861	last.opcode := opGLOAD64
		862	ELSE
		863	AddCmd0(opLOAD64)
		864	END
		865	END
		866	END load;
		867
		868
		869	PROCEDURE SysPut* (size: INTEGER);
		870	BEGIN
		871	CASE size OF
		872	\|1: AddCmd0(opSAVE8)
		873	\|2: AddCmd0(opSAVE16)
		874	\|4: AddCmd0(opSAVE32)
		875	\|8: AddCmd0(opSAVE64)
		876	END
		877	END SysPut;
		878
		879
		880	PROCEDURE savef*;
		881	BEGIN
		882	AddCmd0(opSAVEF);
		883	DEC(codes.fregs);
		884	ASSERT(codes.fregs >= 0)
		885	END savef;
		886
		887
		888	PROCEDURE pushf*;
		889	BEGIN
		890	AddCmd0(opPUSHF);
		891	DEC(codes.fregs);
		892	ASSERT(codes.fregs >= 0)
		893	END pushf;
		894
		895
		896	PROCEDURE loadf* (): BOOLEAN;
		897	BEGIN
		898	AddCmd0(opLOADF);
		899	INC(codes.fregs)
		900	RETURN codes.fregs < numRegsFloat
		901	END loadf;
		902
		903
		904	PROCEDURE inf* (): BOOLEAN;
		905	BEGIN
		906	AddCmd0(opINF);
		907	INC(codes.fregs)
		908	RETURN codes.fregs < numRegsFloat
		909	END inf;
		910
		911
		912	PROCEDURE fbinop* (opcode: INTEGER);
		913	BEGIN
		914	AddCmd0(opcode);
		915	DEC(codes.fregs);
		916	ASSERT(codes.fregs > 0)
		917	END fbinop;
		918
		919
		920	PROCEDURE saves* (offset, length: INTEGER);
		921	BEGIN
		922	AddCmd2(opSAVES, length, offset)
		923	END saves;
		924
		925
		926	PROCEDURE abs* (real: BOOLEAN);
		927	BEGIN
		928	IF real THEN
		929	AddCmd0(opFABS)
		930	ELSE
		931	AddCmd0(opABS)
		932	END
		933	END abs;
		934
		935
		936	PROCEDURE floor*;
		937	BEGIN
		938	AddCmd0(opFLOOR);
		939	DEC(codes.fregs);
		940	ASSERT(codes.fregs >= 0)
		941	END floor;
		942
		943
		944	PROCEDURE flt* (): BOOLEAN;
		945	BEGIN
		946	AddCmd0(opFLT);
		947	INC(codes.fregs)
		948	RETURN codes.fregs < numRegsFloat
		949	END flt;
		950
		951
		952	PROCEDURE shift_minmax* (op: CHAR);
		953	BEGIN
		954	CASE op OF
		955	\|"A": AddCmd0(opASR)
		956	\|"L": AddCmd0(opLSL)
		957	\|"O": AddCmd0(opROR)
		958	\|"R": AddCmd0(opLSR)
		959	\|"m": AddCmd0(opMIN)
		960	\|"x": AddCmd0(opMAX)
		961	END
		962	END shift_minmax;
		963
		964
		965	PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER);
		966	BEGIN
		967	CASE op OF
		968	\|"A": AddCmd(opASR1, x)
		969	\|"L": AddCmd(opLSL1, x)
		970	\|"O": AddCmd(opROR1, x)
		971	\|"R": AddCmd(opLSR1, x)
		972	\|"m": AddCmd(opMINC, x)
		973	\|"x": AddCmd(opMAXC, x)
		974	END
		975	END shift_minmax1;
		976
		977
		978	PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER);
		979	BEGIN
		980	CASE op OF
		981	\|"A": AddCmd(opASR2, x)
		982	\|"L": AddCmd(opLSL2, x)
		983	\|"O": AddCmd(opROR2, x)
		984	\|"R": AddCmd(opLSR2, x)
		985	\|"m": AddCmd(opMINC, x)
		986	\|"x": AddCmd(opMAXC, x)
		987	END
		988	END shift_minmax2;
		989
		990
		991	PROCEDURE len* (dim: INTEGER);
		992	BEGIN
		993	AddCmd(opLEN, dim)
		994	END len;
		995
		996
		997	PROCEDURE Float* (r: REAL);
		998	VAR
		999	cmd: COMMAND;
		1000
		1001	BEGIN
		1002	cmd := NewCmd();
		1003	cmd.opcode := opCONSTF;
		1004	cmd.float := r;
		1005	insert(codes.last, cmd);
		1006	INC(codes.fregs);
		1007	ASSERT(codes.fregs <= numRegsFloat)
		1008	END Float;
		1009
		1010
		1011	PROCEDURE precall* (flt: BOOLEAN): INTEGER;
		1012	VAR
		1013	res: INTEGER;
		1014	BEGIN
		1015	res := codes.fregs;
		1016	AddCmd2(opPRECALL, ORD(flt), res);
		1017	codes.fregs := 0
		1018	RETURN res
		1019	END precall;
		1020
		1021
		1022	PROCEDURE resf* (fregs: INTEGER): BOOLEAN;
		1023	BEGIN
		1024	AddCmd(opRESF, fregs);
		1025	codes.fregs := fregs + 1
		1026	RETURN codes.fregs < numRegsFloat
		1027	END resf;
		1028
		1029
		1030	PROCEDURE res* (fregs: INTEGER);
		1031	BEGIN
		1032	AddCmd(opRES, fregs);
		1033	codes.fregs := fregs
		1034	END res;
		1035
		1036
		1037	PROCEDURE retf*;
		1038	BEGIN
		1039	DEC(codes.fregs);
		1040	ASSERT(codes.fregs = 0)
		1041	END retf;
		1042
		1043
		1044	PROCEDURE drop*;
		1045	BEGIN
		1046	AddCmd0(opDROP)
		1047	END drop;
		1048
		1049
		1050	PROCEDURE case* (a, b, L, R: INTEGER);
		1051	VAR
		1052	cmd: COMMAND;
		1053
		1054	BEGIN
		1055	IF a = b THEN
		1056	cmd := NewCmd();
		1057	cmd.opcode := opCASELR;
		1058	cmd.param1 := a;
		1059	cmd.param2 := L;
		1060	cmd.param3 := R;
		1061	insert(codes.last, cmd)
		1062	ELSE
		1063	AddCmd2(opCASEL, a, L);
		1064	AddCmd2(opCASER, b, R)
		1065	END
		1066	END case;
		1067
		1068
		1069	PROCEDURE caset* (a, label: INTEGER);
		1070	BEGIN
		1071	AddCmd2(opCASET, label, a)
		1072	END caset;
		1073
		1074
		1075	PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR);
		1076	VAR
		1077	exp: EXPORT_PROC;
		1078
		1079	BEGIN
		1080	NEW(exp);
		1081	exp.label := label;
		1082	exp.name := name;
		1083	LISTS.push(codes.export, exp)
		1084	END AddExp;
		1085
		1086
		1087	PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC;
		1088	VAR
		1089	lib: IMPORT_LIB;
		1090	p: IMPORT_PROC;
		1091
		1092	BEGIN
		1093	lib := codes.import.first(IMPORT_LIB);
		1094	WHILE (lib # NIL) & (lib.name # dll) DO
		1095	lib := lib.next(IMPORT_LIB)
		1096	END;
		1097
		1098	IF lib = NIL THEN
		1099	NEW(lib);
		1100	lib.name := dll;
		1101	lib.procs := LISTS.create(NIL);
		1102	LISTS.push(codes.import, lib)
		1103	END;
		1104
		1105	p := lib.procs.first(IMPORT_PROC);
		1106	WHILE (p # NIL) & (p.name # proc) DO
		1107	p := p.next(IMPORT_PROC)
		1108	END;
		1109
		1110	IF p = NIL THEN
		1111	NEW(p);
		1112	p.name := proc;
		1113	p.label := NewLabel();
		1114	p.lib := lib;
		1115	p.count := 1;
		1116	LISTS.push(lib.procs, p)
		1117	ELSE
		1118	INC(p.count)
		1119	END
		1120
		1121	RETURN p
		1122	END AddImp;
		1123
		1124
		1125	PROCEDURE DelImport* (imp: LISTS.ITEM);
		1126	VAR
		1127	lib: IMPORT_LIB;
		1128
		1129	BEGIN
		1130	DEC(imp(IMPORT_PROC).count);
		1131	IF imp(IMPORT_PROC).count = 0 THEN
		1132	lib := imp(IMPORT_PROC).lib;
		1133	LISTS.delete(lib.procs, imp);
		1134	IF lib.procs.first = NIL THEN
		1135	LISTS.delete(codes.import, lib)
		1136	END
		1137	END
		1138	END DelImport;
		1139
		1140
		1141	PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER);
		1142	VAR
		1143	cmd: COMMAND;
		1144	i: INTEGER;
		1145
		1146	BEGIN
		1147	commands := C.create();
		1148	variables := C.create();
		1149	numRegsFloat := pNumRegsFloat;
		1150	endianness := pEndianness;
		1151
		1152	NEW(codes.begcall);
		1153	codes.begcall.top := -1;
		1154	NEW(codes.endcall);
		1155	codes.endcall.top := -1;
		1156	codes.commands := LISTS.create(NIL);
		1157	codes.export := LISTS.create(NIL);
		1158	codes.import := LISTS.create(NIL);
		1159	codes.types := CHL.CreateIntList();
		1160	codes.data := CHL.CreateByteList();
		1161
		1162	NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
		1163	codes.last := cmd;
		1164	NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
		1165
		1166	AddRec(0);
		1167
		1168	codes.lcount := 0;
		1169
		1170	codes.fregs := 0;
		1171
		1172	FOR i := 0 TO LEN(codes.charoffs) - 1 DO
		1173	codes.charoffs[i] := -1
		1174	END;
		1175
		1176	FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO
		1177	codes.wcharoffs[i] := -1
		1178	END
		1179
		1180	END init;
		1181
		1182
7696	akron1	1183	END IL.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/IL.ob07 – Rev 7696