Subversion Repositories Kolibri OS

Rev

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

  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 <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;
  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.