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

Rev	Author	Line No.	Line
6613	leency	1	(*
		2	Copyright 2016 Anton Krotov
		3
		4	This file is part of Compiler.
		5
		6	Compiler is free software: you can redistribute it and/or modify
		7	it under the terms of the GNU General Public License as published by
		8	the Free Software Foundation, either version 3 of the License, or
		9	(at your option) any later version.
		10
		11	Compiler is distributed in the hope that it will be useful,
		12	but WITHOUT ANY WARRANTY; without even the implied warranty of
		13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
		14	GNU General Public License for more details.
		15
		16	You should have received a copy of the GNU General Public License
		17	along with Compiler. If not, see .
		18	*)
		19
		20	MODULE X86;
		21
		22	IMPORT UTILS, sys := SYSTEM, SCAN, ELF;
		23
		24	CONST
		25
		26	ADIM* = 5;
		27
		28	lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54;
		29	lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76;
		30
		31	TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7;
		32	TNIL = 8; TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14;
		33
		34	stABS* = 1; stODD* = 2; stLEN* = 3; stLSL* = 4; stASR* = 5; stROR* = 6; stFLOOR* = 7;
		35	stFLT* = 8; stORD* = 9; stCHR* = 10; stLONG* = 11; stSHORT* = 12; stINC* = 13;
		36	stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19;
		37	stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24;
		38	stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29;
		39	stLENGTH* = 30;
		40
		41	sysMOVE* = 108;
		42
		43	JMP* = 0E9X; CALL = 0E8X;
		44	JE = 84X; JNE = 85X; JLE = 8EX; JGE = 8DX; JG = 8FX; JL = 8CX;
		45
		46	JCMD = 1; LCMD = 2; GCMD = 3; OCMD = 4; ECMD = 5;
		47	PUSHEAX = 6; PUSHECX = 7; PUSHEDX = 8; POPEAX = 9; POPECX = 10; POPEDX = 11;
		48	ICMP1 = 13; ICMP2 = 14;
		49
		50	defcall = 0; stdcall = 1; cdecl = 2; winapi = 3;
		51
		52	_rset* = 0; _inset* = 1; _saverec* = 2; _length* = 3; _checktype* = 4; _strcmp* = 5;
		53	_lstrcmp* = 6; _rstrcmp* = 7; _savearr* = 8; _newrec* = 9; _disprec* = 10; _arrayidx* = 11;
		54	_arrayrot* = 12; _assrt* = 13; _strcopy* = 14; _arrayidx1* = 15; _init* = 16; _close* = 17; _halt* = 18;
		55	ASSRT = 19; hInstance = 20; SELFNAME = 21; RTABLE = 22;LoadLibrary = 23; GetProcAddress = 24;
		56	Exports = 25; szSTART = 26; START = 27; szversion = 28; _floor = 29; HALT = 30;
		57
		58	FREGS = 8;
		59
		60	TYPE
		61
		62	ASMLINE* = POINTER TO RECORD (UTILS.rITEM)
		63	cmd, clen, varadr, adr, tcmd, codeadr: INTEGER; short: BOOLEAN
		64	END;
		65
		66	TFLT = ARRAY 2 OF INTEGER;
		67
		68	TIDX* = ARRAY ADIM OF INTEGER;
		69
		70	SECTIONNAME = ARRAY 8 OF CHAR;
		71
		72	SECTION = RECORD
		73	name: SECTIONNAME;
		74	size, adr, sizealign, OAPfile, reserved6, reserved7, reserved8, attrflags: INTEGER
		75	END;
		76
		77	HEADER = RECORD
		78	msdos: ARRAY 180 OF CHAR;
		79	typecomp, seccount: sys.CARD16;
		80	time, reserved1, reserved2: INTEGER;
		81	PEoptsize, infflags, PEfile, compver: sys.CARD16;
		82	codesize, datasize, initdatasize, startadr,
		83	codeadr, rdataadr, loadadr, secalign, filealign,
		84	oldestver, version, oldestverNT, reserved3,
		85	filesize, headersize, dllcrc: INTEGER;
		86	UI, reserved4: sys.CARD16;
		87	stksize, stkalloc, heapsize, heapalloc, reserved5, structcount: INTEGER;
		88	structs: ARRAY 16 OF RECORD adr, size: INTEGER END;
		89	sections: ARRAY 3 OF SECTION
		90	END;
		91
		92	COFFHEADER = RECORD
		93	Machine: sys.CARD16;
		94	NumberOfSections: sys.CARD16;
		95	TimeDateStamp,
		96	PointerToSymbolTable,
		97	NumberOfSymbols: INTEGER;
		98	SizeOfOptionalHeader,
		99	Characteristics: sys.CARD16;
		100	text, data, bss: SECTION
		101	END;
		102
		103	KOSHEADER = RECORD
		104	menuet01: ARRAY 8 OF CHAR;
		105	ver, start, size, mem, sp, param, path: INTEGER
		106	END;
		107
		108	ETABLE = RECORD
		109	reserved1, time, reserved2, dllnameoffset, firstnum, adrcount,
		110	namecount, arradroffset, arrnameptroffset, arrnumoffset: INTEGER;
		111	arradr, arrnameptr: ARRAY 10000H OF INTEGER;
		112	arrnum: ARRAY 10000H OF sys.CARD16;
		113	text: ARRAY 1000000 OF CHAR;
		114	textlen, size: INTEGER
		115	END;
		116
		117	RELOC = RECORD
		118	Page, Size: INTEGER;
		119	reloc: ARRAY 1024 OF sys.CARD16
		120	END;
		121
		122	VAR asmlist: UTILS.LIST; start: ASMLINE; dll, con, gui, kos, elf, obj: BOOLEAN;
		123	Lcount, reccount, topstk: INTEGER; recarray: ARRAY 2048 OF INTEGER; current*: ASMLINE;
		124	callstk: ARRAY 1024, 2 OF ASMLINE; OutFile: UTILS.STRING;
		125	Code: ARRAY 4000000 OF CHAR; ccount: INTEGER; Data: ARRAY 1000000 OF CHAR; dcount: INTEGER;
		126	Labels: ARRAY 200000 OF INTEGER; rdata: ARRAY 400H OF INTEGER; Header: HEADER; etable: ETABLE;
		127	ExecName: UTILS.STRING; LoadAdr: INTEGER; Reloc: ARRAY 200000 OF CHAR; rcount: INTEGER;
		128	RtlProc: ARRAY 20 OF INTEGER; OutFilePos: INTEGER; RelocSection: SECTION;
		129	fpu*: INTEGER; isfpu: BOOLEAN; maxfpu: INTEGER; fpucmd: ASMLINE;
		130	kosexp: ARRAY 65536 OF RECORD Name: SCAN.NODE; Adr, NameLabel: INTEGER END; kosexpcount: INTEGER;
		131
		132	PROCEDURE AddRtlProc*(idx, proc: INTEGER);
		133	BEGIN
		134	RtlProc[idx] := proc
		135	END AddRtlProc;
		136
		137	PROCEDURE IntToCard16(i: INTEGER): sys.CARD16;
		138	VAR w: sys.CARD16;
		139	BEGIN
		140	sys.GET(sys.ADR(i), w)
		141	RETURN w
		142	END IntToCard16;
		143
		144	PROCEDURE CopyStr(VAR Dest: ARRAY OF CHAR; Source: ARRAY OF CHAR; VAR di: INTEGER; si: INTEGER);
		145	BEGIN
		146	DEC(di);
		147	REPEAT
		148	INC(di);
		149	Dest[di] := Source[si];
		150	INC(si)
		151	UNTIL Dest[di] = 0X
		152	END CopyStr;
		153
		154	PROCEDURE exch(VAR a, b: INTEGER);
		155	VAR c: INTEGER;
		156	BEGIN
		157	c := a;
		158	a := b;
		159	b := c
		160	END exch;
		161
		162	PROCEDURE Sort(VAR NamePtr, Adr: ARRAY OF INTEGER; Text: ARRAY OF CHAR; LB, RB: INTEGER);
		163	VAR L, R: INTEGER;
		164
		165	PROCEDURE strle(s1, s2: INTEGER): BOOLEAN;
		166	VAR S1, S2: ARRAY 256 OF CHAR; i: INTEGER;
		167	BEGIN
		168	i := 0;
		169	CopyStr(S1, Text, i, s1);
		170	i := 0;
		171	CopyStr(S2, Text, i, s2)
		172	RETURN S1 <= S2
		173	END strle;
		174
		175	BEGIN
		176	IF LB < RB THEN
		177	L := LB;
		178	R := RB;
		179	REPEAT
		180	WHILE (L < RB) & strle(NamePtr[L], NamePtr[LB]) DO
		181	INC(L)
		182	END;
		183	WHILE (R > LB) & strle(NamePtr[LB], NamePtr[R]) DO
		184	DEC(R)
		185	END;
		186	IF L < R THEN
		187	exch(NamePtr[L], NamePtr[R]);
		188	exch(Adr[L], Adr[R])
		189	END
		190	UNTIL L >= R;
		191	IF R > LB THEN
		192	exch(NamePtr[LB], NamePtr[R]);
		193	exch(Adr[LB], Adr[R]);
		194	Sort(NamePtr, Adr, Text, LB, R - 1)
		195	END;
		196	Sort(NamePtr, Adr, Text, R + 1, RB)
		197	END
		198	END Sort;
		199
		200	PROCEDURE PackExport(Name: ARRAY OF CHAR);
		201	VAR i: INTEGER;
		202	BEGIN
		203	Sort(etable.arrnameptr, etable.arradr, etable.text, 0, etable.namecount - 1);
		204	FOR i := 0 TO etable.namecount - 1 DO
		205	etable.arrnum[i] := IntToCard16(i)
		206	END;
		207	etable.size := 40 + etable.adrcount * 4 + etable.namecount * 6;
		208	etable.arradroffset := 40;
		209	etable.arrnameptroffset := 40 + etable.adrcount * 4;
		210	etable.arrnumoffset := etable.arrnameptroffset + etable.namecount * 4;
		211	etable.dllnameoffset := etable.size + etable.textlen;
		212	CopyStr(etable.text, Name, etable.textlen, 0);
		213	INC(etable.textlen);
		214	FOR i := 0 TO etable.namecount - 1 DO
		215	etable.arrnameptr[i] := etable.arrnameptr[i] + etable.size
		216	END;
		217	etable.size := etable.size + etable.textlen
		218	END PackExport;
		219
		220	PROCEDURE ProcExport*(Number: INTEGER; Name: SCAN.NODE; NameLabel: INTEGER);
		221	BEGIN
		222	IF dll THEN
		223	etable.arradr[etable.adrcount] := Number;
		224	INC(etable.adrcount);
		225	etable.arrnameptr[etable.namecount] := etable.textlen;
		226	INC(etable.namecount);
		227	CopyStr(etable.text, Name.Name, etable.textlen, 0);
		228	INC(etable.textlen)
		229	ELSIF obj THEN
		230	kosexp[kosexpcount].Name := Name;
		231	kosexp[kosexpcount].Adr := Number;
		232	kosexp[kosexpcount].NameLabel := NameLabel;
		233	INC(kosexpcount)
		234	END
		235	END ProcExport;
		236
		237	PROCEDURE Err(code: INTEGER);
		238	BEGIN
		239	CASE code OF
		240	\|1: UTILS.ErrMsg(67); UTILS.OutString(OutFile)
		241	\|2: UTILS.ErrMsg(69); UTILS.OutString(OutFile)
		242	ELSE
		243	END;
		244	UTILS.Ln;
		245	UTILS.HALT(1)
		246	END Err;
		247
		248	PROCEDURE Align*(n, m: INTEGER): INTEGER;
		249	RETURN n + (m - n MOD m) MOD m
		250	END Align;
		251
		252	PROCEDURE PutReloc(R: RELOC);
		253	VAR i: INTEGER;
		254	BEGIN
		255	sys.PUT(sys.ADR(Reloc[rcount]), R.Page);
		256	INC(rcount, 4);
		257	sys.PUT(sys.ADR(Reloc[rcount]), R.Size);
		258	INC(rcount, 4);
		259	FOR i := 0 TO ASR(R.Size - 8, 1) - 1 DO
		260	sys.PUT(sys.ADR(Reloc[rcount]), R.reloc[i]);
		261	INC(rcount, 2)
		262	END
		263	END PutReloc;
		264
		265	PROCEDURE InitArray(VAR adr: INTEGER; chars: UTILS.STRING);
		266	VAR i, x, n: INTEGER;
		267	BEGIN
		268	n := LEN(chars) - 1;
		269	i := 0;
		270	WHILE (i < n) & (chars[i] # 0X) DO
		271	x := SCAN.hex(chars[i]) * 16 + SCAN.hex(chars[i + 1]);
		272	sys.PUT(adr, CHR(x));
		273	INC(adr);
		274	INC(i, 2)
		275	END
		276	END InitArray;
		277
		278	PROCEDURE WriteF(F, A, N: INTEGER);
		279	BEGIN
		280	IF UTILS.Write(F, A, N) # N THEN
		281	Err(2)
		282	END
		283	END WriteF;
		284
		285	PROCEDURE Write(A, N: INTEGER);
		286	BEGIN
		287	sys.MOVE(A, OutFilePos, N);
		288	OutFilePos := OutFilePos + N
		289	END Write;
		290
		291	PROCEDURE Fill(n: INTEGER; c: CHAR);
		292	VAR i: INTEGER;
		293	BEGIN
		294	FOR i := 1 TO n DO
		295	Write(sys.ADR(c), 1)
		296	END
		297	END Fill;
		298
		299	PROCEDURE SetSection(VAR Section: SECTION; name: SECTIONNAME; size, adr, sizealign, OAPfile, attrflags: INTEGER);
		300	BEGIN
		301	Section.name := name;
		302	Section.size := size;
		303	Section.adr := adr;
		304	Section.sizealign := sizealign;
		305	Section.OAPfile := OAPfile;
		306	Section.attrflags := attrflags;
		307	END SetSection;
		308
		309	PROCEDURE WritePE(FName: ARRAY OF CHAR; stksize, codesize, datasize, rdatasize, gsize: INTEGER);
		310	CONST textattr = 60000020H; rdataattr = 40000040H; dataattr = 0C0000040H; relocattr = 42000040H;
		311	VAR i, F, adr, acodesize, compver, version, stkalloc, heapsize, heapalloc, filesize, filebuf: INTEGER;
		312	cur: ASMLINE;
		313	BEGIN
		314
		315	compver := 0;
		316	version := 0;
		317	stkalloc := stksize;
		318	heapsize := 100000H;
		319	heapalloc := 100000H;
		320	acodesize := Align(codesize, 1000H) + 1000H;
		321	adr := sys.ADR(rdata);
		322	filesize := acodesize + Align(rdatasize, 1000H) + Align(datasize, 1000H) + Align(rcount, 1000H);
		323
		324	InitArray(adr, "5000000040000000000000003400000000000000000000006200000000000000");
		325	InitArray(adr, "0000000000000000000000000000000000000000500000004000000000000000");
		326	InitArray(adr, "A4014C6F61644C6962726172794100001F0147657450726F6341646472657373");
		327	InitArray(adr, "00006B65726E656C33322E646C6C0000");
		328
		329	rdata[ 0] := acodesize + 50H;
		330	rdata[ 1] := acodesize + 40H;
		331	rdata[ 3] := acodesize + 34H;
		332	rdata[ 6] := acodesize + 62H;
		333	rdata[ 7] := acodesize;
		334	rdata[13] := acodesize + 50H;
		335	rdata[14] := acodesize + 40H;
		336
		337	adr := sys.ADR(Header.msdos);
		338	InitArray(adr, "4D5A90000300000004000000FFFF0000B8000000000000004000000000000000");
		339	InitArray(adr, "00000000000000000000000000000000000000000000000000000000B0000000");
		340	InitArray(adr, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F");
		341	InitArray(adr, "742062652072756E20696E20444F53206D6F64652E0D0D0A2400000000000000");
		342	InitArray(adr, "5DCF9F8719AEF1D419AEF1D419AEF1D497B1E2D413AEF1D4E58EE3D418AEF1D4");
		343	InitArray(adr, "5269636819AEF1D4000000000000000050450000");
		344	Header.typecomp := IntToCard16(014CH);
		345	IF dll THEN
		346	Header.seccount := IntToCard16(0004H);
		347	Header.infflags := IntToCard16(210EH)
		348	ELSE
		349	Header.seccount := IntToCard16(0003H);
		350	Header.infflags := IntToCard16(010FH)
		351	END;
		352	Header.time := UTILS.Date;
		353	Header.PEoptsize := IntToCard16(00E0H);
		354	Header.PEfile := IntToCard16(010BH);
		355	Header.compver := IntToCard16(compver);
		356	Header.codesize := Align(codesize, 200H);
		357	Header.datasize := Align(datasize + gsize, 200H) + Align(rdatasize, 200H) + Align(rcount, 200H);
		358	Header.startadr := 1000H;
		359	Header.codeadr := 1000H;
		360	Header.rdataadr := Header.codeadr + Align(codesize, 1000H);
		361	Header.loadadr := LoadAdr;
		362	Header.secalign := 1000H;
		363	Header.filealign := 0200H;
		364	Header.oldestver := 0004H;
		365	Header.version := version;
		366	Header.oldestverNT := 0004H;
		367	Header.filesize := Align(codesize, 1000H) + Align(datasize + gsize, 1000H) + Align(rdatasize, 1000H) + Align(rcount, 1000H) + 1000H;
		368	Header.headersize := 0400H;
		369	Header.UI := IntToCard16(ORD(con) + 2);
		370	Header.stksize := stksize;
		371	Header.stkalloc := stkalloc;
		372	Header.heapsize := heapsize;
		373	Header.heapalloc := heapalloc;
		374	Header.structcount := 10H;
		375	IF dll THEN
		376	Header.structs[0].adr := Header.rdataadr + 0DAH;
		377	Header.structs[0].size := etable.size
		378	END;
		379
		380	Header.structs[1].adr := Header.rdataadr + 0CH;
		381	Header.structs[1].size := 28H;
		382	Header.structs[12].adr := Header.rdataadr;
		383	Header.structs[12].size := 0CH;
		384
		385	SetSection(Header.sections[0], ".text", codesize, 1000H, Align(codesize, 200H), 400H, textattr);
		386	SetSection(Header.sections[1], ".rdata", rdatasize, Align(codesize, 1000H) + 1000H, Align(rdatasize, 200H),
		387	Align(codesize, 200H) + 400H, rdataattr);
		388	SetSection(Header.sections[2], ".data", datasize + gsize, Align(codesize, 1000H) + Align(rdatasize, 1000H) + 1000H,
		389	Align(datasize, 200H), Align(codesize, 200H) + Align(rdatasize, 200H) + 400H, dataattr);
		390
		391	IF dll THEN
		392	SetSection(RelocSection, ".reloc", rcount, Header.sections[2].adr + Align(datasize + gsize, 1000H), Align(rcount, 200H),
		393	Header.sections[2].OAPfile + Align(datasize, 200H), relocattr);
		394	Header.structs[5].adr := RelocSection.adr;
		395	Header.structs[5].size := rcount
		396	END;
		397
		398	F := UTILS.CreateF(FName);
		399	IF F = 0 THEN
		400	Err(1)
		401	END;
		402	OutFilePos := UTILS.GetMem(filesize);
		403	filebuf := OutFilePos;
		404	UTILS.MemErr(OutFilePos = 0);
		405
		406	Write(sys.ADR(Header), sys.SIZE(HEADER));
		407	IF dll THEN
		408	Write(sys.ADR(RelocSection), sys.SIZE(SECTION));
		409	Fill(Align(sys.SIZE(HEADER) + sys.SIZE(SECTION), 200H) - (sys.SIZE(HEADER) + sys.SIZE(SECTION)), 0X)
		410	ELSE
		411	Fill(Align(sys.SIZE(HEADER), 200H) - sys.SIZE(HEADER), 0X)
		412	END;
		413
		414	cur := asmlist.First(ASMLINE);
		415	WHILE cur # NIL DO
		416	Write(sys.ADR(Code[cur.cmd]), cur.clen);
		417	cur := cur.Next(ASMLINE)
		418	END;
		419	Fill(Align(codesize, 200H) - codesize, 0X);
		420	Write(sys.ADR(rdata), 0DAH);
		421	IF dll THEN
		422	etable.time := Header.time;
		423	Write(sys.ADR(etable), 40);
		424	Write(sys.ADR(etable.arradr), etable.adrcount * 4);
		425	Write(sys.ADR(etable.arrnameptr), etable.namecount * 4);
		426	Write(sys.ADR(etable.arrnum), etable.namecount * 2);
		427	Write(sys.ADR(etable.text), etable.textlen)
		428	END;
		429	Fill(Align(rdatasize, 200H) - rdatasize, 0X);
		430	Write(sys.ADR(Data), datasize);
		431	Fill(Align(datasize, 200H) - datasize, 0X);
		432	IF dll THEN
		433	Write(sys.ADR(Reloc), rcount);
		434	Fill(Align(rcount, 200H) - rcount, 0X)
		435	END;
		436	WriteF(F, filebuf, OutFilePos - filebuf);
		437	UTILS.CloseF(F)
		438	END WritePE;
		439
		440	PROCEDURE New;
		441	VAR nov: ASMLINE;
		442	BEGIN
		443	NEW(nov);
		444	UTILS.MemErr(nov = NIL);
		445	nov.cmd := ccount;
		446	UTILS.Insert(asmlist, nov, current);
		447	current := current.Next(ASMLINE)
		448	END New;
		449
		450	PROCEDURE Empty(varadr: INTEGER);
		451	BEGIN
		452	New;
		453	current.clen := 0;
		454	current.tcmd := ECMD;
		455	current.varadr := varadr
		456	END Empty;
		457
		458	PROCEDURE OutByte(byte: INTEGER);
		459	BEGIN
		460	New;
		461	current.clen := 1;
		462	Code[ccount] := CHR(byte);
		463	INC(ccount)
		464	END OutByte;
		465
		466	PROCEDURE OutInt(int: INTEGER);
		467	BEGIN
		468	New;
		469	current.clen := 4;
		470	sys.PUT(sys.ADR(Code[ccount]), int);
		471	INC(ccount, 4)
		472	END OutInt;
		473
		474	PROCEDURE PushEAX;
		475	BEGIN
		476	OutByte(50H);
		477	current.tcmd := PUSHEAX
		478	END PushEAX;
		479
		480	PROCEDURE PushECX;
		481	BEGIN
		482	OutByte(51H);
		483	current.tcmd := PUSHECX
		484	END PushECX;
		485
		486	PROCEDURE PushEDX;
		487	BEGIN
		488	OutByte(52H);
		489	current.tcmd := PUSHEDX
		490	END PushEDX;
		491
		492	PROCEDURE PopEAX;
		493	BEGIN
		494	OutByte(58H);
		495	current.tcmd := POPEAX
		496	END PopEAX;
		497
		498	PROCEDURE PopECX;
		499	BEGIN
		500	OutByte(59H);
		501	current.tcmd := POPECX
		502	END PopECX;
		503
		504	PROCEDURE PopEDX;
		505	BEGIN
		506	OutByte(5AH);
		507	current.tcmd := POPEDX
		508	END PopEDX;
		509
		510	PROCEDURE OutCode(cmd: UTILS.STRING);
		511	VAR a, b: INTEGER;
		512	BEGIN
		513	New;
		514	a := sys.ADR(Code[ccount]);
		515	b := a;
		516	InitArray(a, cmd);
		517	ccount := a - b + ccount;
		518	current.clen := a - b
		519	END OutCode;
		520
		521	PROCEDURE Del*(last: ASMLINE);
		522	BEGIN
		523	last.Next := current.Next;
		524	IF current = asmlist.Last THEN
		525	asmlist.Last := last
		526	END;
		527	current := last
		528	END Del;
		529
		530	PROCEDURE NewLabel*(): INTEGER;
		531	BEGIN
		532	INC(Lcount)
		533	RETURN Lcount
		534	END NewLabel;
		535
		536	PROCEDURE PushCall*(asmline: ASMLINE);
		537	BEGIN
		538	New;
		539	callstk[topstk][0] := asmline;
		540	callstk[topstk][1] := current;
		541	INC(topstk)
		542	END PushCall;
		543
		544	PROCEDURE Param*;
		545	BEGIN
		546	current := callstk[topstk - 1][0]
		547	END Param;
		548
		549	PROCEDURE EndCall*;
		550	BEGIN
		551	current := callstk[topstk - 1][1];
		552	DEC(topstk)
		553	END EndCall;
		554
		555	PROCEDURE Init*(UI: INTEGER);
		556	VAR nov: ASMLINE;
		557	BEGIN
		558	dcount := 4;
		559	dll := UI = 1;
		560	gui := UI = 2;
		561	con := UI = 3;
		562	kos := UI = 4;
		563	elf := UI = 5;
		564	obj := UI = 6;
		565	Lcount := HALT;
		566	asmlist := UTILS.CreateList();
		567	NEW(nov);
		568	UTILS.MemErr(nov = NIL);
		569	UTILS.Push(asmlist, nov);
		570	current := nov;
		571	END Init;
		572
		573	PROCEDURE datastr(str: UTILS.STRING);
		574	VAR i, n: INTEGER;
		575	BEGIN
		576	i := 0;
		577	n := LEN(str);
		578	WHILE (i < n) & (str[i] # 0X) DO
		579	Data[dcount] := str[i];
		580	INC(dcount);
		581	INC(i)
		582	END;
		583	Data[dcount] := 0X;
		584	INC(dcount)
		585	END datastr;
		586
		587	PROCEDURE dataint(n: INTEGER);
		588	BEGIN
		589	sys.PUT(sys.ADR(Data[dcount]), n);
		590	INC(dcount, 4)
		591	END dataint;
		592
		593	PROCEDURE jmp*(jamp: CHAR; label: INTEGER);
		594	VAR n: INTEGER;
		595	BEGIN
		596	New;
		597	CASE jamp OF
		598	\|JMP, CALL:
		599	n := 5
		600	\|JE, JLE, JGE, JG, JL, JNE:
		601	Code[ccount] := 0FX;
		602	INC(ccount);
		603	n := 6
		604	ELSE
		605	END;
		606	current.clen := n;
		607	Code[ccount] := jamp;
		608	INC(ccount);
		609	current.codeadr := sys.ADR(Code[ccount]);
		610	current.varadr := sys.ADR(Labels[label]);
		611	current.tcmd := JCMD;
		612	current.short := TRUE;
		613	INC(ccount, 4)
		614	END jmp;
		615
		616	PROCEDURE jmplong(jamp: CHAR; label: INTEGER);
		617	BEGIN
		618	jmp(jamp, label);
		619	current.short := FALSE
		620	END jmplong;
		621
		622	PROCEDURE Label*(label: INTEGER);
		623	BEGIN
		624	New;
		625	current.varadr := sys.ADR(Labels[label]);
		626	current.tcmd := LCMD
		627	END Label;
		628
		629	PROCEDURE CmdN(Number: INTEGER);
		630	BEGIN
		631	New;
		632	current.clen := 4;
		633	current.codeadr := sys.ADR(Code[ccount]);
		634	current.varadr := sys.ADR(Labels[Number]);
		635	current.tcmd := OCMD;
		636	INC(ccount, 4)
		637	END CmdN;
		638
		639	PROCEDURE IntByte(bytecode, intcode: UTILS.STRING; n: INTEGER);
		640	BEGIN
		641	IF (n <= 127) & (n >= -128) THEN
		642	OutCode(bytecode);
		643	OutByte(n)
		644	ELSE
		645	OutCode(intcode);
		646	OutInt(n)
		647	END
		648	END IntByte;
		649
		650	PROCEDURE DropFpu*(long: BOOLEAN);
		651	BEGIN
		652	IF long THEN
		653	OutCode("83EC08DD1C24")
		654	ELSE
		655	OutCode("83EC04D91C24")
		656	END;
		657	DEC(fpu)
		658	END DropFpu;
		659
		660	PROCEDURE AfterRet(func, float: BOOLEAN; callconv, parsize: INTEGER);
		661	BEGIN
		662	IF callconv = cdecl THEN
		663	OutCode("81C4");
		664	OutInt(parsize)
		665	END;
		666	IF func THEN
		667	IF float THEN
		668	OutCode("83EC08DD1C24")
		669	ELSE
		670	PushEAX
		671	END
		672	END
		673	END AfterRet;
		674
		675	PROCEDURE FpuSave(local: INTEGER);
		676	VAR i: INTEGER;
		677	BEGIN
		678	IF fpu > maxfpu THEN
		679	maxfpu := fpu
		680	END;
		681	FOR i := 1 TO fpu DO
		682	IntByte("DD5D", "DD9D", -local - i * 8)
		683	END
		684	END FpuSave;
		685
		686	PROCEDURE Incfpu;
		687	BEGIN
		688	IF fpu >= FREGS THEN
		689	UTILS.ErrMsgPos(SCAN.coord.line, SCAN.coord.col, 97);
		690	UTILS.HALT(1)
		691	END;
		692	INC(fpu);
		693	isfpu := TRUE
		694	END Incfpu;
		695
		696	PROCEDURE FpuLoad(local: INTEGER; float: BOOLEAN);
		697	VAR i: INTEGER;
		698	BEGIN
		699	FOR i := fpu TO 1 BY -1 DO
		700	IntByte("DD45", "DD85", -local - i * 8)
		701	END;
		702	IF float THEN
		703	Incfpu;
		704	OutCode("DD042483C408")
		705	END
		706	END FpuLoad;
		707
		708	PROCEDURE Call*(proc: INTEGER; func, float: BOOLEAN; callconv, ccall, bases, level, parsize, local: INTEGER);
		709	VAR i: INTEGER;
		710	BEGIN
		711	IF ccall # 0 THEN
		712	FOR i := level TO level - bases + ORD(ccall = 1) + 1 BY -1 DO
		713	IntByte("FF75", "FFB5", 4 * i + 4)
		714	END;
		715	IF ccall = 1 THEN
		716	OutByte(55H)
		717	END
		718	END;
		719	FpuSave(local);
		720	jmplong(CALL, proc);
		721	AfterRet(func, float, callconv, parsize);
		722	FpuLoad(local, func & float)
		723	END Call;
		724
		725	PROCEDURE CallRTL(Proc: INTEGER);
		726	BEGIN
		727	New;
		728	current.clen := 5;
		729	Code[ccount] := CALL;
		730	INC(ccount);
		731	current.codeadr := sys.ADR(Code[ccount]);
		732	current.varadr := sys.ADR(RtlProc[Proc]);
		733	current.tcmd := JCMD;
		734	INC(ccount, 4)
		735	END CallRTL;
		736
		737	PROCEDURE PushInt*(n: INTEGER);
		738	BEGIN
		739	OutByte(68H);
		740	CmdN(n)
		741	END PushInt;
		742
		743	PROCEDURE Prolog*(exename: UTILS.STRING);
		744	BEGIN
		745	ExecName := exename;
		746	Labels[hInstance] := -dcount;
		747	dataint(0);
		748	Labels[SELFNAME] := -dcount;
		749	datastr(exename);
		750	Label(START);
		751	IF dll THEN
		752	OutCode("558BEC837D0C007507");
		753	CallRTL(_close);
		754	OutCode("EB06837D0C017409B801000000C9C20C00")
		755	ELSIF obj THEN
		756	OutCode("558BEC")
		757	END;
		758	start := asmlist.Last(ASMLINE)
		759	END Prolog;
		760
		761	PROCEDURE AddRec*(base: INTEGER);
		762	BEGIN
		763	INC(reccount);
		764	recarray[reccount] := base
		765	END AddRec;
		766
		767	PROCEDURE CmpOpt(inv: BOOLEAN): INTEGER;
		768	VAR cur: ASMLINE; c: INTEGER;
		769	BEGIN
		770	c := ORD(Code[current.Prev.Prev(ASMLINE).cmd]);
		771	IF inv THEN
		772	IF ODD(c) THEN
		773	DEC(c)
		774	ELSE
		775	INC(c)
		776	END
		777	END;
		778	cur := current;
		779	REPEAT
		780	cur.tcmd := 0;
		781	cur.clen := 0;
		782	cur := cur.Prev(ASMLINE)
		783	UNTIL cur.tcmd = ICMP1;
		784	cur.tcmd := 0;
		785	cur.clen := 0
		786	RETURN c - 16
		787	END CmpOpt;
		788
		789	PROCEDURE ifwh*(L: INTEGER);
		790	VAR c: INTEGER;
		791	BEGIN
		792	IF current.Prev(ASMLINE).tcmd = ICMP2 THEN
		793	c := CmpOpt(TRUE);
		794	OutCode("5A583BC2");
		795	jmp(CHR(c), L)
		796	ELSE
		797	PopECX;
		798	OutCode("85C9");
		799	jmp(JE, L)
		800	END
		801	END ifwh;
		802
		803	PROCEDURE PushConst*(Number: INTEGER);
		804	BEGIN
		805	IntByte("6A", "68", Number);
		806	current.Prev(ASMLINE).varadr := Number
		807	END PushConst;
		808
		809	PROCEDURE IfWhile*(L: INTEGER; orop: BOOLEAN);
		810	VAR c, L1: INTEGER;
		811	BEGIN
		812	L1 := NewLabel();
		813	IF current.Prev(ASMLINE).tcmd = ICMP2 THEN
		814	c := CmpOpt(orop);
		815	OutCode("5A583BC2");
		816	jmp(CHR(c), L1);
		817	PushConst(ORD(orop))
		818	ELSE
		819	PopECX;
		820	OutCode("85C9");
		821	IF orop THEN
		822	jmp(JE, L1)
		823	ELSE
		824	jmp(JNE, L1)
		825	END;
		826	PushECX
		827	END;
		828	jmp(JMP, L);
		829	Label(L1)
		830	END IfWhile;
		831
		832	PROCEDURE newrec*;
		833	BEGIN
		834	CallRTL(_newrec)
		835	END newrec;
		836
		837	PROCEDURE disprec*;
		838	BEGIN
		839	CallRTL(_disprec)
		840	END disprec;
		841
		842	PROCEDURE String*(Number, Len: INTEGER; str: UTILS.STRING);
		843	BEGIN
		844	Labels[Number] := -dcount;
		845	IF Len > 1 THEN
		846	datastr(str)
		847	ELSIF Len = 1 THEN
		848	dataint(ORD(str[0]))
		849	ELSE
		850	dataint(0)
		851	END
		852	END String;
		853
		854	PROCEDURE InsertFpuInit;
		855	VAR t: ASMLINE;
		856	BEGIN
		857	IF isfpu THEN
		858	t := current;
		859	current := fpucmd;
		860	IF maxfpu > 0 THEN
		861	OutCode("83EC");
		862	OutByte(maxfpu * 8)
		863	END;
		864	OutCode("DBE3");
		865	current := t
		866	END
		867	END InsertFpuInit;
		868
		869	PROCEDURE ProcBeg*(Number, Local: INTEGER; Module: BOOLEAN);
		870	VAR i: INTEGER;
		871	BEGIN
		872	IF Module THEN
		873	OutCode("EB0C");
		874	Label(Number + 3);
		875	PushInt(Number + 2);
		876	jmplong(JMP, HALT);
		877	Label(Number + 1)
		878	ELSE
		879	Label(Number)
		880	END;
		881	OutCode("558BEC");
		882	IF Local > 12 THEN
		883	IntByte("83EC", "81EC", Local);
		884	OutCode("8BD733C08BFCB9");
		885	OutInt(ASR(Local, 2));
		886	OutCode("9CFCF3AB8BFA9D")
		887	ELSE
		888	FOR i := 4 TO Local BY 4 DO
		889	OutCode("6A00")
		890	END
		891	END;
		892	fpucmd := current;
		893	fpu := 0;
		894	maxfpu := 0;
		895	isfpu := FALSE
		896	END ProcBeg;
		897
		898	PROCEDURE Leave*;
		899	BEGIN
		900	OutByte(0C9H);
		901	InsertFpuInit
		902	END Leave;
		903
		904	PROCEDURE ProcEnd*(Number, Param: INTEGER; func, float: BOOLEAN);
		905	BEGIN
		906	IF func & ~float THEN
		907	PopEAX
		908	END;
		909	OutByte(0C9H);
		910	IF Param = 0 THEN
		911	OutByte(0C3H)
		912	ELSE
		913	OutByte(0C2H);
		914	OutByte(Param MOD 256);
		915	OutByte(ASR(Param, 8))
		916	END;
		917	InsertFpuInit
		918	END ProcEnd;
		919
		920	PROCEDURE Module*(Name: UTILS.STRING; Number: INTEGER);
		921	BEGIN
		922	String(Number + 2, LENGTH(Name), Name);
		923	jmplong(JMP, Number + 1)
		924	END Module;
		925
		926	PROCEDURE Asm*(s: UTILS.STRING);
		927	BEGIN
		928	OutCode(s)
		929	END Asm;
		930
		931	PROCEDURE GlobalAdr*(offset: INTEGER);
		932	BEGIN
		933	OutByte(0BAH);
		934	OutInt(offset);
		935	current.codeadr := sys.ADR(Code[ccount - 4]);
		936	current.tcmd := GCMD;
		937	PushEDX
		938	END GlobalAdr;
		939
		940	PROCEDURE Mono*(Number: INTEGER);
		941	BEGIN
		942	PopEDX;
		943	PushInt(Number)
		944	END Mono;
		945
		946	PROCEDURE StrMono*;
		947	BEGIN
		948	PopEDX;
		949	OutCode("6A02");
		950	PushEDX
		951	END StrMono;
		952
		953	PROCEDURE Not*;
		954	BEGIN
		955	PopECX;
		956	OutCode("85C90F94C1");
		957	PushECX
		958	END Not;
		959
		960	PROCEDURE NegSet*;
		961	BEGIN
		962	OutCode("F71424")
		963	END NegSet;
		964
		965	PROCEDURE Int*(Op: INTEGER);
		966	BEGIN
		967	PopEDX;
		968	CASE Op OF
		969	\|lxPlus: OutCode("011424")
		970	\|lxMinus: OutCode("291424")
		971	\|lxMult: OutCode("58F7EA"); PushEAX
		972	ELSE
		973	END
		974	END Int;
		975
		976	PROCEDURE Set*(Op: INTEGER);
		977	BEGIN
		978	PopEDX;
		979	OutByte(58H);
		980	CASE Op OF
		981	\|lxPlus: OutByte(0BH)
		982	\|lxMinus: OutCode("F7D223")
		983	\|lxMult: OutByte(23H)
		984	\|lxSlash: OutByte(33H)
		985	ELSE
		986	END;
		987	OutByte(0C2H);
		988	PushEAX
		989	END Set;
		990
		991	PROCEDURE Setfpu*(newfpu: INTEGER);
		992	BEGIN
		993	fpu := newfpu
		994	END Setfpu;
		995
		996	PROCEDURE PushFlt*(x: LONGREAL);
		997	VAR f: TFLT; L: INTEGER;
		998	BEGIN
		999	sys.PUT(sys.ADR(f), x);
		1000	Incfpu;
		1001	IF x = 0.0D0 THEN
		1002	OutCode("D9EE")
		1003	ELSIF x = 1.0D0 THEN
		1004	OutCode("D9E8")
		1005	ELSE
		1006	L := NewLabel();
		1007	Labels[L] := -dcount;
		1008	dataint(f[0]);
		1009	dataint(f[1]);
		1010	OutByte(0BAH);
		1011	CmdN(L);
		1012	OutCode("DD02")
		1013	END
		1014	END PushFlt;
		1015
		1016	PROCEDURE farith*(op: INTEGER);
		1017	VAR n: INTEGER;
		1018	BEGIN
		1019	OutByte(0DEH);
		1020	CASE op OF
		1021	\|lxPlus: n := 0C1H
		1022	\|lxMinus: n := 0E9H
		1023	\|lxMult: n := 0C9H
		1024	\|lxSlash: n := 0F9H
		1025	ELSE
		1026	END;
		1027	OutByte(n);
		1028	DEC(fpu)
		1029	END farith;
		1030
		1031	PROCEDURE fcmp*(Op: INTEGER);
		1032	VAR n: INTEGER;
		1033	BEGIN
		1034	OutCode("33C9DED9DFE09E0F");
		1035	CASE Op OF
		1036	\|lxEQ: n := 94H
		1037	\|lxNE: n := 95H
		1038	\|lxLT: n := 97H
		1039	\|lxGT: n := 92H
		1040	\|lxLE: n := 93H
		1041	\|lxGE: n := 96H
		1042	ELSE
		1043	END;
		1044	DEC(fpu, 2);
		1045	OutByte(n);
		1046	OutByte(0C1H);
		1047	PushECX
		1048	END fcmp;
		1049
		1050	PROCEDURE fneg*;
		1051	BEGIN
		1052	OutCode("D9E0")
		1053	END fneg;
		1054
		1055	PROCEDURE OnError*(n: INTEGER);
		1056	BEGIN
		1057	OutByte(68H);
		1058	OutInt(LSL(UTILS.Line, 4) + n);
		1059	jmplong(JMP, UTILS.Unit + 3)
		1060	END OnError;
		1061
		1062	PROCEDURE idivmod*(opmod: BOOLEAN);
		1063	BEGIN
		1064	PopECX;
		1065	IF opmod THEN
		1066	OutCode("58E32E538BD833D9C1FB1F8BD0C1FA1F83F9FF750C3D0000008075055B6A00EB1AF7F985DB740685D2740203D15B52EB0A")
		1067	ELSE
		1068	OutCode("58E32C538BD833D9C1FB1F8BD0C1FA1F83F9FF750B3D0000008075045B50EB19F7F985DB740585D27401485B50EB0A")
		1069	END;
		1070	OnError(8)
		1071	END idivmod;
		1072
		1073	PROCEDURE rset*;
		1074	BEGIN
		1075	CallRTL(_rset);
		1076	PushEAX
		1077	END rset;
		1078
		1079	PROCEDURE inset*;
		1080	BEGIN
		1081	CallRTL(_inset);
		1082	PushEAX
		1083	END inset;
		1084
		1085	PROCEDURE Dup*;
		1086	BEGIN
		1087	PopEDX;
		1088	PushEDX;
		1089	PushEDX
		1090	END Dup;
		1091
		1092	PROCEDURE Inclusion*(Op: INTEGER);
		1093	BEGIN
		1094	PopEDX;
		1095	PopEAX;
		1096	IF Op = lxLE THEN
		1097	PushEDX
		1098	ELSE
		1099	PushEAX
		1100	END;
		1101	OutCode("0BC25933C8E3046A00EB026A01")
		1102	END Inclusion;
		1103
		1104	PROCEDURE NegInt*;
		1105	BEGIN
		1106	OutCode("F71C24")
		1107	END NegInt;
		1108
		1109	PROCEDURE CmpInt*(Op: INTEGER);
		1110	VAR n: INTEGER;
		1111	BEGIN
		1112	OutCode("33C95A583BC20F"); current.tcmd := ICMP1;
		1113	CASE Op OF
		1114	\|lxEQ: n := 94H
		1115	\|lxNE: n := 95H
		1116	\|lxLT: n := 9CH
		1117	\|lxGT: n := 9FH
		1118	\|lxLE: n := 9EH
		1119	\|lxGE: n := 9DH
		1120	ELSE
		1121	END;
		1122	OutByte(n);
		1123	OutByte(0C1H); current.tcmd := ICMP2;
		1124	PushECX;
		1125	END CmpInt;
		1126
		1127	PROCEDURE CallVar*(func, float: BOOLEAN; callconv, parsize, local: INTEGER);
		1128	BEGIN
		1129	PopEDX;
		1130	OutCode("8B1285D2750A");
		1131	OnError(2);
		1132	FpuSave(local);
		1133	OutCode("FFD2");
		1134	AfterRet(func, float, callconv, parsize);
		1135	FpuLoad(local, func & float)
		1136	END CallVar;
		1137
		1138	PROCEDURE LocalAdr*(offset, bases: INTEGER);
		1139	BEGIN
		1140	IF bases = 0 THEN
		1141	Empty(offset);
		1142	OutCode("8BD5")
		1143	ELSE
		1144	IntByte("8B55", "8B95", 4 * bases + 4)
		1145	END;
		1146	IntByte("83C2", "81C2", offset);
		1147	PushEDX;
		1148	IF bases = 0 THEN
		1149	Empty(offset)
		1150	END
		1151	END LocalAdr;
		1152
		1153	PROCEDURE Field*(offset: INTEGER);
		1154	BEGIN
		1155	IF offset # 0 THEN
		1156	IntByte("830424", "810424", offset)
		1157	END
		1158	END Field;
		1159
		1160	PROCEDURE DerefType*(n: INTEGER);
		1161	BEGIN
		1162	IntByte("8B5424", "8B9424", n);
		1163	OutCode("FF72FC")
		1164	END DerefType;
		1165
		1166	PROCEDURE Guard*(T: INTEGER; Check: BOOLEAN);
		1167	BEGIN
		1168	IF Check THEN
		1169	PopEAX;
		1170	OutCode("85C074");
		1171	IF T <= 127 THEN
		1172	OutByte(9)
		1173	ELSE
		1174	OutByte(12)
		1175	END;
		1176	PushEAX
		1177	END;
		1178	PushConst(T);
		1179	PushEAX;
		1180	CallRTL(_checktype);
		1181	IF Check THEN
		1182	PushEAX
		1183	ELSE
		1184	OutCode("85C0750A");
		1185	OnError(3)
		1186	END
		1187	END Guard;
		1188
		1189	PROCEDURE StProc*(proc: INTEGER);
		1190	BEGIN
		1191	CASE proc OF
		1192	\|stINC: PopEDX; OutCode("590111")
		1193	\|stDEC: PopEDX; OutCode("592911")
		1194	\|stINC1: PopEDX; OutCode("FF02")
		1195	\|stDEC1: PopEDX; OutCode("FF0A")
		1196	\|stINCL: PopEDX; OutCode("580910")
		1197	\|stEXCL: PopEDX; OutCode("582110")
		1198	\|stPACK: OutCode("DB04245A5ADD02D9FDDD1A"); isfpu := TRUE
		1199	\|stPACK1: OutCode("DB04245A5AD902D9FDD91A"); isfpu := TRUE
		1200	\|stUNPK: PopEDX; OutCode("59DD01D9F4DD19DB1A"); isfpu := TRUE
		1201	\|stUNPK1: PopEDX; OutCode("59D901D9F4D919DB1A"); isfpu := TRUE
		1202	\|stCOPY: CallRTL(_strcopy)
		1203	\|sysMOVE: CallRTL(_savearr)
		1204	ELSE
		1205	END
		1206	END StProc;
		1207
		1208	PROCEDURE Assert*(proc, assrt: INTEGER);
		1209	BEGIN
		1210	PopEDX;
		1211	OutCode("85D2751368");
		1212	OutInt(UTILS.Line * 16 + 1);
		1213	PushInt(UTILS.Unit + 2);
		1214	IF proc = stASSERT THEN
		1215	OutCode("6A026A")
		1216	ELSE
		1217	OutCode("6A016A")
		1218	END;
		1219	OutByte(assrt);
		1220	jmplong(JMP, ASSRT)
		1221	END Assert;
		1222
		1223	PROCEDURE StFunc*(func: INTEGER);
		1224	BEGIN
		1225	CASE func OF
		1226	\|stABS: PopEDX; OutCode("85D27D02F7DA"); PushEDX
		1227	\|stFABS: OutCode("D9E1")
		1228	\|stFLT: OutCode("DB0424"); PopEAX; Incfpu;
		1229	\|stFLOOR: jmplong(CALL, _floor); PushEAX; DEC(fpu)
		1230	\|stODD: OutCode("83242401")
		1231	\|stROR: PopECX; OutCode("58D3C8"); PushEAX
		1232	\|stASR: PopECX; OutCode("58D3F8"); PushEAX
		1233	\|stLSL: PopECX; OutCode("58D3E0"); PushEAX
		1234	\|stLSR: PopECX; OutCode("58D3E8"); PushEAX
		1235	\|stORD: PopEDX; OutCode("85D274036A015A"); PushEDX
		1236	\|stLENGTH: CallRTL(_length); PushEAX
		1237	ELSE
		1238	END
		1239	END StFunc;
		1240
		1241	PROCEDURE Load*(T: INTEGER);
		1242	VAR lastcmd: ASMLINE; offset: INTEGER;
		1243
		1244	PROCEDURE del;
		1245	BEGIN
		1246	lastcmd.tcmd := 0;
		1247	offset := lastcmd.varadr;
		1248	lastcmd := lastcmd.Prev(ASMLINE);
		1249	WHILE lastcmd.tcmd # ECMD DO
		1250	lastcmd.clen := 0;
		1251	lastcmd.tcmd := 0;
		1252	lastcmd := lastcmd.Prev(ASMLINE)
		1253	END;
		1254	lastcmd.tcmd := 0
		1255	END del;
		1256
		1257	BEGIN
		1258	lastcmd := current;
		1259	CASE T OF
		1260	\|TINTEGER, TSET, TPOINTER, TPROC:
		1261	IF lastcmd.tcmd = ECMD THEN
		1262	del;
		1263	IntByte("8B55", "8B95", offset);
		1264	PushEDX
		1265	ELSE
		1266	PopEDX;
		1267	OutCode("FF32")
		1268	END
		1269	\|TCHAR, TBOOLEAN:
		1270	IF lastcmd.tcmd = ECMD THEN
		1271	del;
		1272	OutCode("33D28A");
		1273	IntByte("55", "95", offset);
		1274	PushEDX
		1275	ELSE
		1276	PopEDX;
		1277	OutCode("33C98A0A");
		1278	PushECX
		1279	END
		1280	\|TLONGREAL:
		1281	IF lastcmd.tcmd = ECMD THEN
		1282	del;
		1283	IntByte("DD45", "DD85", offset)
		1284	ELSE
		1285	PopEDX;
		1286	OutCode("DD02")
		1287	END;
		1288	Incfpu
		1289	\|TREAL:
		1290	IF lastcmd.tcmd = ECMD THEN
		1291	del;
		1292	IntByte("D945", "D985", offset)
		1293	ELSE
		1294	PopEDX;
		1295	OutCode("D902")
		1296	END;
		1297	Incfpu
		1298	\|TCARD16:
		1299	IF lastcmd.tcmd = ECMD THEN
		1300	del;
		1301	OutCode("33D2668B");
		1302	IntByte("55", "95", offset);
		1303	PushEDX
		1304	ELSE
		1305	PopEDX;
		1306	OutCode("33C9668B0A");
		1307	PushECX
		1308	END
		1309	ELSE
		1310	END
		1311	END Load;
		1312
		1313	PROCEDURE Save*(T: INTEGER);
		1314	BEGIN
		1315	CASE T OF
		1316	\|TINTEGER, TSET, TPOINTER, TPROC:
		1317	PopEDX;
		1318	OutCode("588910")
		1319	\|TCHAR, TSTRING, TBOOLEAN:
		1320	PopEDX;
		1321	OutCode("588810")
		1322	\|TCARD16:
		1323	PopEDX;
		1324	OutCode("58668910")
		1325	\|TLONGREAL:
		1326	PopEDX;
		1327	OutCode("DD1A");
		1328	DEC(fpu)
		1329	\|TREAL:
		1330	PopEDX;
		1331	OutCode("D91A");
		1332	DEC(fpu)
		1333	\|TRECORD:
		1334	CallRTL(_saverec);
		1335	OutCode("85C0750A");
		1336	OnError(4)
		1337	\|TARRAY:
		1338	CallRTL(_savearr)
		1339	ELSE
		1340	END
		1341	END Save;
		1342
		1343	PROCEDURE OpenArray*(A: TIDX; n: INTEGER);
		1344	VAR i: INTEGER;
		1345	BEGIN
		1346	PopEDX;
		1347	FOR i := n - 1 TO 0 BY -1 DO
		1348	PushConst(A[i])
		1349	END;
		1350	PushEDX
		1351	END OpenArray;
		1352
		1353	PROCEDURE OpenIdx*(n: INTEGER);
		1354	BEGIN
		1355	OutByte(54H);
		1356	IF n > 1 THEN
		1357	PushConst(n);
		1358	CallRTL(_arrayidx)
		1359	ELSE
		1360	CallRTL(_arrayidx1)
		1361	END;
		1362	PopEDX;
		1363	OutCode("85D2750A");
		1364	OnError(5);
		1365	PushEDX;
		1366	END OpenIdx;
		1367
		1368	PROCEDURE FixIdx*(len, size: INTEGER);
		1369	BEGIN
		1370	PopEDX;
		1371	IntByte("5983FA", "5981FA", len);
		1372	OutCode("720A");
		1373	OnError(5);
		1374	IF size > 1 THEN
		1375	IntByte("6BD2", "69D2", size)
		1376	END;
		1377	OutCode("03D1");
		1378	PushEDX
		1379	END FixIdx;
		1380
		1381	PROCEDURE Idx*;
		1382	BEGIN
		1383	PopEDX;
		1384	PopECX;
		1385	OutCode("03D1");
		1386	PushEDX
		1387	END Idx;
		1388
		1389	PROCEDURE DupLoadCheck*;
		1390	BEGIN
		1391	PopEDX;
		1392	OutCode("528B125285D2750A");
		1393	OnError(6)
		1394	END DupLoadCheck;
		1395
		1396	PROCEDURE DupLoad*;
		1397	BEGIN
		1398	PopEDX;
		1399	OutCode("528B12");
		1400	PushEDX;
		1401	END DupLoad;
		1402
		1403	PROCEDURE CheckNIL*;
		1404	BEGIN
		1405	PopEDX;
		1406	OutCode("85D2750A");
		1407	OnError(6);
		1408	PushEDX;
		1409	END CheckNIL;
		1410
		1411	PROCEDURE ExtArray*(A: TIDX; n, m: INTEGER);
		1412	VAR i: INTEGER;
		1413	BEGIN
		1414	FOR i := n - 1 TO 0 BY -1 DO
		1415	PushConst(A[i])
		1416	END;
		1417	OutByte(54H);
		1418	PushConst(n);
		1419	PushConst(m);
		1420	CallRTL(_arrayrot)
		1421	END ExtArray;
		1422
		1423	PROCEDURE ADR*(dim: INTEGER);
		1424	BEGIN
		1425	IF dim > 0 THEN
		1426	PopEDX;
		1427	OutCode("83C4");
		1428	OutByte(dim * 4);
		1429	PushEDX
		1430	END
		1431	END ADR;
		1432
		1433	PROCEDURE Len*(dim: INTEGER);
		1434	BEGIN
		1435	PopEDX;
		1436	IF dim < 0 THEN
		1437	PushConst(-dim)
		1438	ELSIF dim > 1 THEN
		1439	PopEDX;
		1440	OutCode("83C4");
		1441	OutByte((dim - 1) * 4);
		1442	PushEDX
		1443	END
		1444	END Len;
		1445
		1446	PROCEDURE For*(inc: BOOLEAN; VAR LBeg, LEnd: INTEGER);
		1447	BEGIN
		1448	LEnd := NewLabel();
		1449	LBeg := NewLabel();
		1450	Label(LBeg);
		1451	OutCode("8B14248B4424043910");
		1452	IF inc THEN
		1453	jmp(JG, LEnd)
		1454	ELSE
		1455	jmp(JL, LEnd)
		1456	END
		1457	END For;
		1458
		1459	PROCEDURE NextFor*(step, LBeg, LEnd: INTEGER);
		1460	BEGIN
		1461	OutCode("8B542404");
		1462	IF step = 1 THEN
		1463	OutCode("FF02")
		1464	ELSIF step = -1 THEN
		1465	OutCode("FF0A")
		1466	ELSE
		1467	IntByte("8302", "8102", step)
		1468	END;
		1469	jmp(JMP, LBeg);
		1470	Label(LEnd);
		1471	OutCode("83C408")
		1472	END NextFor;
		1473
		1474	PROCEDURE CaseLabel*(a, b, LBeg: INTEGER);
		1475	VAR L: INTEGER;
		1476	BEGIN
		1477	L := NewLabel();
		1478	IntByte("83FA", "81FA", a);
		1479	IF a = b THEN
		1480	jmp(JNE, L)
		1481	ELSE
		1482	jmp(JL, L);
		1483	IntByte("83FA", "81FA", b);
		1484	jmp(JG, L)
		1485	END;
		1486	jmp(JMP, LBeg);
		1487	Label(L)
		1488	END CaseLabel;
		1489
		1490	PROCEDURE Drop*;
		1491	BEGIN
		1492	PopEDX
		1493	END Drop;
		1494
		1495	PROCEDURE strcmp*(Op, LR: INTEGER);
		1496	BEGIN
		1497	CASE Op OF
		1498	\|lxEQ: PushConst(0)
		1499	\|lxNE: PushConst(1)
		1500	\|lxLT: PushConst(2)
		1501	\|lxGT: PushConst(3)
		1502	\|lxLE: PushConst(4)
		1503	\|lxGE: PushConst(5)
		1504	ELSE
		1505	END;
		1506	CASE LR OF
		1507	\|-1: CallRTL(_lstrcmp)
		1508	\| 0: CallRTL(_strcmp)
		1509	\| 1: CallRTL(_rstrcmp)
		1510	ELSE
		1511	END;
		1512	PushEAX
		1513	END strcmp;
		1514
		1515	PROCEDURE Optimization;
		1516	VAR cur: ASMLINE; flag: BOOLEAN;
		1517	BEGIN
		1518	cur := asmlist.First(ASMLINE);
		1519	WHILE cur # NIL DO
		1520	flag := FALSE;
		1521	CASE cur.tcmd OF
		1522	\|PUSHEAX:
		1523	flag := cur.Next(ASMLINE).tcmd = POPEAX
		1524	\|PUSHECX:
		1525	flag := cur.Next(ASMLINE).tcmd = POPECX
		1526	\|PUSHEDX:
		1527	flag := cur.Next(ASMLINE).tcmd = POPEDX
		1528	ELSE
		1529	END;
		1530	IF flag THEN
		1531	cur.clen := 0;
		1532	cur.tcmd := 0;
		1533	cur := cur.Next(ASMLINE);
		1534	cur.clen := 0;
		1535	cur.tcmd := 0
		1536	END;
		1537	cur := cur.Next(ASMLINE)
		1538	END
		1539	END Optimization;
		1540
		1541	PROCEDURE WriteKOS(FName: ARRAY OF CHAR; stk, size, datasize, gsize: INTEGER; obj: BOOLEAN);
		1542	CONST strsize = 2048;
		1543	VAR Header: KOSHEADER; F, i, filesize, filebuf, a, sec, adr, size2: INTEGER; cur: ASMLINE;
		1544	Coff: COFFHEADER; sym: ARRAY 18 * 4 OF CHAR; FileName: UTILS.STRING;
		1545	BEGIN
		1546	F := UTILS.CreateF(FName);
		1547	IF F <= 0 THEN
		1548	Err(1)
		1549	END;
		1550	OutFilePos := UTILS.GetMem(Align(size, 4) + datasize + 1000H);
		1551	filebuf := OutFilePos;
		1552	UTILS.MemErr(OutFilePos = 0);
		1553
		1554	IF ~obj THEN
		1555	Header.menuet01 := "MENUET01";
		1556	Header.ver := 1;
		1557	Header.start := sys.SIZE(KOSHEADER);
		1558	Header.size := Align(size, 4) + datasize;
		1559	Header.mem := Header.size + stk + gsize + strsize * 2 + 1000H;
		1560	Header.sp := Header.size + gsize + stk;
		1561	Header.param := Header.sp;
		1562	Header.path := Header.param + strsize;
		1563
		1564	Write(sys.ADR(Header), sys.SIZE(KOSHEADER));
		1565
		1566	cur := asmlist.First(ASMLINE);
		1567	WHILE cur # NIL DO
		1568	Write(sys.ADR(Code[cur.cmd]), cur.clen);
		1569	cur := cur.Next(ASMLINE)
		1570	END;
		1571	Fill(Align(size, 4) - size, 0X);
		1572	Write(sys.ADR(Data), datasize);
		1573	WriteF(F, filebuf, OutFilePos - filebuf)
		1574
		1575	ELSE
		1576
		1577	size2 := size;
		1578	size := Align(size, 4) - sys.SIZE(KOSHEADER);
		1579	Coff.Machine := IntToCard16(014CH);
		1580	Coff.NumberOfSections := IntToCard16(3);
		1581	Coff.TimeDateStamp := UTILS.Date;
		1582	Coff.SizeOfOptionalHeader := IntToCard16(0);
		1583	Coff.Characteristics := IntToCard16(0184H);
		1584
		1585	Coff.text.name := ".flat";
		1586	Coff.text.size := 0;
		1587	Coff.text.adr := 0;
		1588	Coff.text.sizealign := size;
		1589	Coff.text.OAPfile := 8CH;
		1590	Coff.text.reserved6 := size + datasize + 8CH;
		1591	Coff.text.reserved7 := 0;
		1592	Coff.text.attrflags := 40300020H;
		1593
		1594	Coff.data.name := ".data";
		1595	Coff.data.size := 0;
		1596	Coff.data.adr := 0;
		1597	Coff.data.sizealign := datasize;
		1598	Coff.data.OAPfile := size + 8CH;
		1599	Coff.data.reserved6 := 0;
		1600	Coff.data.reserved7 := 0;
		1601	Coff.data.reserved8 := 0;
		1602	Coff.data.attrflags := 0C0300040H;
		1603
		1604	Coff.bss.name := ".bss";
		1605	Coff.bss.size := 0;
		1606	Coff.bss.adr := 0;
		1607	Coff.bss.sizealign := gsize;
		1608	Coff.bss.OAPfile := 0;
		1609	Coff.bss.reserved6 := 0;
		1610	Coff.bss.reserved7 := 0;
		1611	Coff.bss.reserved8 := 0;
		1612	Coff.bss.attrflags := 0C03000C0H;
		1613
		1614	size := Align(size2, 4);
		1615	rcount := 0;
		1616	cur := asmlist.First(ASMLINE);
		1617	WHILE cur # NIL DO
		1618	IF cur.tcmd IN {OCMD, GCMD} THEN
		1619	sys.GET(sys.ADR(Code[cur.cmd]), a);
		1620	IF a < size THEN
		1621	a := a - sys.SIZE(KOSHEADER);
		1622	sec := 1
		1623	ELSIF a < size + datasize THEN
		1624	a := a - size;
		1625	sec := 2
		1626	ELSE
		1627	a := a - size - datasize;
		1628	sec := 3
		1629	END;
		1630	sys.PUT(sys.ADR(Code[cur.cmd]), a);
		1631	sys.PUT(sys.ADR(Reloc[rcount]), cur.adr - sys.SIZE(KOSHEADER));
		1632	INC(rcount, 4);
		1633	sys.PUT(sys.ADR(Reloc[rcount]), sec);
		1634	INC(rcount, 4);
		1635	sys.PUT(sys.ADR(Reloc[rcount]), 06X); INC(rcount);
		1636	sys.PUT(sys.ADR(Reloc[rcount]), 00X); INC(rcount);
		1637	END;
		1638	Write(sys.ADR(Code[cur.cmd]), cur.clen);
		1639	cur := cur.Next(ASMLINE)
		1640	END;
		1641	size := size2;
		1642	Fill(Align(size, 4) - size2, 0X);
		1643	Write(sys.ADR(Data), datasize);
		1644	Coff.text.reserved8 := rcount DIV 10;
		1645	Coff.PointerToSymbolTable := Coff.text.reserved6 + rcount;
		1646	Coff.NumberOfSymbols := 4;
		1647
		1648	WriteF(F, sys.ADR(Coff), sys.SIZE(COFFHEADER));
		1649	WriteF(F, filebuf, OutFilePos - filebuf);
		1650	WriteF(F, sys.ADR(Reloc), rcount);
		1651
		1652	adr := sys.ADR(sym);
		1653	InitArray(adr, "4558504F52545300000000000100000002002E666C617400000000000000010000000300");
		1654	InitArray(adr, "2E64617461000000000000000200000003002E6273730000000000000000030000000300");
		1655	sys.PUT(sys.ADR(sym) + 8, Labels[Exports] - sys.SIZE(KOSHEADER));
		1656
		1657	WriteF(F, sys.ADR(sym), LEN(sym));
		1658	i := 4;
		1659	WriteF(F, sys.ADR(i), 4)
		1660	END;
		1661	UTILS.CloseF(F)
		1662	END WriteKOS;
		1663
		1664	PROCEDURE WriteELF(FName: ARRAY OF CHAR; code, data, glob: INTEGER);
		1665	VAR F, delta, filebuf: INTEGER; cur: ASMLINE; bytes: ARRAY 817H + 55FH + 4900 OF CHAR;
		1666
		1667	PROCEDURE Add(offset: INTEGER);
		1668	VAR m: INTEGER;
		1669	BEGIN
		1670	sys.GET(sys.ADR(bytes[offset]), m);
		1671	sys.PUT(sys.ADR(bytes[offset]), m + delta)
		1672	END Add;
		1673
		1674	PROCEDURE Sub(offset: INTEGER);
		1675	VAR m: INTEGER;
		1676	BEGIN
		1677	sys.GET(sys.ADR(bytes[offset]), m);
		1678	sys.PUT(sys.ADR(bytes[offset]), m - delta)
		1679	END Sub;
		1680
		1681	PROCEDURE Add8(a1, a2, a3, a4, a5, a6, a7, a8: INTEGER);
		1682	BEGIN
		1683	Add(a1); Add(a2); Add(a3); Add(a4);
		1684	Add(a5); Add(a6); Add(a7); Add(a8)
		1685	END Add8;
		1686
		1687	BEGIN
		1688	sys.MOVE(ELF.get(), sys.ADR(bytes[0]), ELF.size);
		1689
		1690	DEC(code, 13);
		1691
		1692	delta := Align(data, 1000H) - 100000H;
		1693	Add8(0020H, 00A4H, 00A8H, 0258H, 02B8H, 0308H, 0494H, 049CH);
		1694	Add8(04A4H, 0679H, 0681H, 06A4H, 06B0H, 06BAH, 0703H, 0762H);
		1695	Add8(0774H, 0786H, 0819H, 0823H, 17C5H, 17E5H, 17E9H, 1811H);
		1696	Add8(1839H, 1861H, 1889H, 1A25H, 1A95H, 1AA5H, 1C05H, 1C55H);
		1697	Add(1CE5H); Add(1D09H); Add(1D15H); Add(1D25H); Add(1D35H); Add(1D55H);
		1698
		1699	delta := Align(glob, 1000H) - 3200000H;
		1700	Add(00A8H); Add(17EDH); Add(1C09H); Add(1D25H);
		1701
		1702	delta := Align(code, 1000H) - 100000H;
		1703	Add8(0020H, 0084H, 0088H, 0098H, 009CH, 00A0H, 00B8H, 00BCH);
		1704	Add8(00C0H, 0118H, 011CH, 0120H, 0258H, 0278H, 02B8H, 0308H);
		1705	Add8(048CH, 0494H, 049CH, 04A4H, 04ACH, 04B4H, 04BCH, 04C4H);
		1706	Add8(04CCH, 04D4H, 04DCH, 04E4H, 04ECH, 04F4H, 04FCH, 0504H);
		1707	Add8(050CH, 0514H, 052BH, 0544H, 054EH, 0554H, 055EH, 056EH);
		1708	Add8(057EH, 058EH, 059EH, 05AEH, 05BEH, 05CEH, 05DEH, 05EEH);
		1709	Add8(05FEH, 060EH, 061EH, 062EH, 064CH, 0651H, 0679H, 0681H);
		1710	Add8(0686H, 068CH, 06A4H, 06ABH, 06B0H, 06BAH, 06D7H, 06EBH);
		1711	Add8(0703H, 0762H, 0774H, 0786H, 0819H, 0823H, 0828H, 082DH);
		1712	Add8(1635H, 1655H, 1659H, 167DH, 1681H, 16A5H, 16A9H, 16CDH);
		1713	Add8(16D1H, 16F5H, 16F9H, 171DH, 1721H, 1745H, 1749H, 176DH);
		1714	Add8(1771H, 1795H, 1799H, 17BDH, 17C1H, 17E5H, 17E9H, 1811H);
		1715	Add8(1839H, 1861H, 1889H, 1985H, 1995H, 19A5H, 19B5H, 19C5H);
		1716	Add8(19D5H, 19E5H, 19F5H, 1A05H, 1A15H, 1A25H, 1A55H, 1A65H);
		1717	Add8(1A75H, 1A95H, 1AA5H, 1AD5H, 1AE5H, 1AF5H, 1B05H, 1B25H);
		1718	Add8(1B35H, 1B45H, 1B55H, 1B65H, 1B75H, 1BB5H, 1BC5H, 1BE5H);
		1719	Add8(1C05H, 1C15H, 1C55H, 1C75H, 1CA5H, 1CB5H, 1CE5H, 1D05H);
		1720	Add8(1D15H, 1D25H, 1D35H, 1D55H, 1D75H, 1D89H, 08DEH, 08E8H);
		1721	Sub(0845H); Sub(087BH); Sub(0916H); Add(0C52H); Add(0C8AH); Add(0D0AH);
		1722
		1723	OutFilePos := UTILS.GetMem(code + data + 8000H);
		1724	filebuf := OutFilePos;
		1725	UTILS.MemErr(OutFilePos = 0);
		1726
		1727	Write(sys.ADR(bytes), 817H);
		1728	Fill(2DDH, 90X);
		1729	cur := asmlist.First(ASMLINE);
		1730	WHILE cur # NIL DO
		1731	Write(sys.ADR(Code[cur.cmd]), cur.clen);
		1732	cur := cur.Next(ASMLINE)
		1733	END;
		1734	Fill(Align(code, 1000H) - code, 90X);
		1735	Write(sys.ADR(bytes[817H]), 55FH);
		1736	Write(sys.ADR(Data), data);
		1737	Fill(Align(data, 1000H) - data, 0X);
		1738	Write(sys.ADR(bytes[817H + 55FH + 55FH]), 0DC5H);
		1739
		1740	F := UTILS.CreateF(FName);
		1741	IF F <= 0 THEN
		1742	Err(1)
		1743	END;
		1744	WriteF(F, filebuf, OutFilePos - filebuf);
		1745	UTILS.CloseF(F)
		1746	END WriteELF;
		1747
		1748	PROCEDURE DelProc*(beg, end: ASMLINE);
		1749	BEGIN
		1750	WHILE beg # end DO
		1751	beg.clen := 0;
		1752	beg.tcmd := 0;
		1753	beg := beg.Next(ASMLINE)
		1754	END;
		1755	beg.clen := 0;
		1756	beg.tcmd := 0
		1757	END DelProc;
		1758
		1759	PROCEDURE FixLabels*(FName: ARRAY OF CHAR; stk, gsize, glob: INTEGER);
		1760	VAR size, asize, i, rdatasize, RCount, n, temp, temp2, temp3: INTEGER; cur: ASMLINE; R: RELOC; c: CHAR;
		1761	BEGIN
		1762	dcount := Align(dcount, 4);
		1763	IF dll THEN
		1764	LoadAdr := 10000000H;
		1765	PackExport(ExecName)
		1766	ELSIF con OR gui THEN
		1767	LoadAdr := 400000H
		1768	ELSIF kos OR obj THEN
		1769	LoadAdr := sys.SIZE(KOSHEADER)
		1770	ELSIF elf THEN
		1771	LoadAdr := 134514420 + 1024;
		1772	INC(gsize, 1024)
		1773	END;
		1774
		1775	IF dll OR con OR gui THEN
		1776	rdatasize := 0DAH + etable.size;
		1777	size := 1000H + LoadAdr;
		1778	ELSIF kos OR elf OR obj THEN
		1779	rdatasize := 0;
		1780	size := LoadAdr
		1781	END;
		1782
		1783	Optimization;
		1784	temp2 := size;
		1785	cur := asmlist.First(ASMLINE);
		1786	WHILE cur # NIL DO
		1787	cur.adr := size;
		1788	IF cur.tcmd = LCMD THEN
		1789	sys.PUT(cur.varadr, size)
		1790	END;
		1791	size := size + cur.clen;
		1792	cur := cur.Next(ASMLINE)
		1793	END;
		1794
		1795	size := temp2;
		1796	cur := asmlist.First(ASMLINE);
		1797	WHILE cur # NIL DO
		1798	cur.adr := size;
		1799	IF cur.tcmd = LCMD THEN
		1800	sys.PUT(cur.varadr, size)
		1801	ELSIF (cur.tcmd = JCMD) & cur.short THEN
		1802	sys.GET(cur.varadr, i);
		1803	temp3 := i - cur.Next(ASMLINE).adr;
		1804	IF (-131 <= temp3) & (temp3 <= 123) THEN
		1805	sys.GET(cur(ASMLINE).codeadr - 1, c);
		1806	IF c = JMP THEN
		1807	sys.PUT(cur(ASMLINE).codeadr - 1, 0EBX)
		1808	ELSE (JE, JNE, JLE, JGE, JG, JL)
		1809	sys.PUT(cur(ASMLINE).codeadr - 2, ORD(c) - 16);
		1810	sys.PUT(cur(ASMLINE).codeadr - 1, temp3);
		1811	DEC(cur(ASMLINE).codeadr)
		1812	END;
		1813	cur.clen := 2
		1814	END
		1815	END;
		1816	size := size + cur.clen;
		1817	cur := cur.Next(ASMLINE)
		1818	END;
		1819
		1820	IF dll OR con OR gui THEN
		1821	asize := Align(size, 1000H)
		1822	ELSIF kos OR obj THEN
		1823	asize := Align(size, 4)
		1824	ELSIF elf THEN
		1825	asize := 134514420 + 6508 + Align(size - 13 - LoadAdr, 1000H)
		1826	END;
		1827
		1828	FOR i := 0 TO Lcount DO
		1829	IF Labels[i] < 0 THEN
		1830	Labels[i] := -Labels[i] + asize + Align(rdatasize, 1000H)
		1831	END
		1832	END;
		1833
		1834	temp := dcount;
		1835	IF elf THEN
		1836	asize := asize + Align(dcount, 1000H) + 64 + 1024;
		1837	sys.PUT(sys.ADR(Code[glob + 1]), asize - 1024);
		1838	dcount := 0
		1839	END;
		1840
		1841	IF dll THEN
		1842	asize := asize - LoadAdr + 0DAH;
		1843	FOR i := 0 TO etable.namecount - 1 DO
		1844	etable.arradr[i] := Labels[etable.arradr[i]] - LoadAdr;
		1845	etable.arrnameptr[i] := etable.arrnameptr[i] + asize
		1846	END;
		1847	etable.arradroffset := etable.arradroffset + asize;
		1848	etable.arrnameptroffset := etable.arrnameptroffset + asize;
		1849	etable.arrnumoffset := etable.arrnumoffset + asize;
		1850	etable.dllnameoffset := etable.dllnameoffset + asize;
		1851	asize := asize + LoadAdr - 0DAH
		1852	END;
		1853	IF dll OR con OR gui THEN
		1854	Labels[LoadLibrary] := asize + 4;
		1855	Labels[GetProcAddress] := asize;
		1856	R.Page := 0;
		1857	R.Size := 0;
		1858	RCount := 0;
		1859	END;
		1860	cur := asmlist.First(ASMLINE);
		1861
		1862	FOR i := 0 TO LEN(RtlProc) - 1 DO
		1863	RtlProc[i] := Labels[RtlProc[i]]
		1864	END;
		1865
		1866	temp3 := asize + Align(rdatasize, 1000H) + dcount;
		1867	WHILE cur # NIL DO
		1868	CASE cur.tcmd OF
		1869	\|JCMD:
		1870	sys.GET(cur.varadr, i);
		1871	sys.PUT(cur.codeadr, i - cur.Next(ASMLINE).adr)
		1872	\|GCMD:
		1873	sys.GET(cur.codeadr, i);
		1874	sys.PUT(cur.codeadr, i + temp3)
		1875	\|OCMD:
		1876	sys.MOVE(cur.varadr, cur.codeadr, 4)
		1877	ELSE
		1878	END;
		1879	IF dll & (cur.tcmd IN {GCMD, OCMD}) THEN
		1880	n := cur.adr - LoadAdr;
		1881	IF ASR(n, 12) = ASR(R.Page, 12) THEN
		1882	R.reloc[RCount] := IntToCard16(n MOD 1000H + 3000H);
		1883	INC(RCount);
		1884	INC(R.Size, 2)
		1885	ELSE
		1886	IF R.Size # 0 THEN
		1887	PutReloc(R)
		1888	END;
		1889	R.Page := ASR(n, 12) * 1000H;
		1890	R.Size := 10;
		1891	R.reloc[0] := IntToCard16(n MOD 1000H + 3000H);
		1892	RCount := 1
		1893	END
		1894	END;
		1895	cur := cur.Next(ASMLINE)
		1896	END;
		1897	IF R.Size # 0 THEN
		1898	PutReloc(R)
		1899	END;
		1900	IF dll OR con OR gui THEN
		1901	WritePE(FName, stk, size - 1000H - LoadAdr, dcount, rdatasize, gsize)
		1902	ELSIF kos OR obj THEN
		1903	WriteKOS(FName, Align(stk, 4), size, dcount, gsize, obj)
		1904	ELSIF elf THEN
		1905	WriteELF(FName, size - LoadAdr, temp, gsize)
		1906	END
		1907	END FixLabels;
		1908
		1909	PROCEDURE OutStringZ(str: ARRAY OF CHAR);
		1910	VAR i: INTEGER;
		1911	BEGIN
		1912	New;
		1913	current.clen := LENGTH(str);
		1914	FOR i := 0 TO current.clen - 1 DO
		1915	Code[ccount] := str[i];
		1916	INC(ccount)
		1917	END;
		1918	Code[ccount] := 0X;
		1919	INC(ccount);
		1920	INC(current.clen)
		1921	END OutStringZ;
		1922
		1923	PROCEDURE Epilog*(gsize: INTEGER; FName: ARRAY OF CHAR; stk: INTEGER);
		1924	VAR i, glob: INTEGER;
		1925	BEGIN
		1926	glob := 0;
		1927	gsize := Align(gsize, 4) + 4;
		1928	COPY(FName, OutFile);
		1929	Labels[RTABLE] := -dcount;
		1930	dataint(recarray[0]);
		1931	FOR i := 1 TO reccount DO
		1932	dataint(recarray[i])
		1933	END;
		1934	current := start;
		1935	IF con OR gui OR dll THEN
		1936	PushInt(LoadLibrary);
		1937	PushInt(GetProcAddress);
		1938	OutCode("5859FF31FF3054")
		1939	ELSIF elf THEN
		1940	OutCode("6800000000");
		1941	glob := current.cmd;
		1942	ELSIF kos OR obj THEN
		1943	OutByte(54H)
		1944	END;
		1945	GlobalAdr(0);
		1946	PushConst(ASR(gsize, 2));
		1947	PushInt(RTABLE);
		1948	PushInt(SELFNAME);
		1949	CallRTL(_init);
		1950	current := asmlist.Last(ASMLINE);
		1951	IF dll THEN
		1952	OutCode("B801000000C9C20C00")
		1953	END;
		1954	IF obj THEN
		1955	OutCode("B801000000C9C20000")
		1956	END;
		1957	OutCode("EB05");
		1958	Label(ASSRT);
		1959	CallRTL(_assrt);
		1960	OutCode("EB09");
		1961	Label(HALT);
		1962	OutCode("6A006A00");
		1963	CallRTL(_assrt);
		1964	OutCode("6A00");
		1965	CallRTL(_halt);
		1966	Label(_floor);
		1967	OutCode("83EC06D93C2466812424FFF366810C24FFF7D92C2483C402D9FCDB1C2458C3");
		1968	IF obj THEN
		1969	Label(Exports);
		1970	CmdN(szSTART); CmdN(START);
		1971	CmdN(szversion); OutInt(stk);
		1972	FOR i := 0 TO kosexpcount - 1 DO
		1973	CmdN(kosexp[i].NameLabel); CmdN(kosexp[i].Adr)
		1974	END;
		1975	OutInt(0);
		1976	Label(szSTART); OutStringZ("lib_init");
		1977	Label(szversion); OutStringZ("version");
		1978	FOR i := 0 TO kosexpcount - 1 DO
		1979	Label(kosexp[i].NameLabel);
		1980	OutStringZ(kosexp[i].Name.Name)
		1981	END
		1982	END;
		1983	FixLabels(FName, stk, gsize, glob)
		1984	END Epilog;
		1985
		1986	END X86.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/X86.ob07 @ 7693 – Rev 6613