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

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

Subversion Repositories Kolibri OS

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