Subversion Repositories Kolibri OS

Rev

Rev 7107 | Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

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