Subversion Repositories Kolibri OS

Rev

Rev 6613 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
6613 leency 1
(*
7107 akron1 2
    Copyright 2016, 2017 Anton Krotov
6613 leency 3
 
4
    This file is part of Compiler.
5
 
6
    Compiler is free software: you can redistribute it and/or modify
7
    it under the terms of the GNU General Public License as published by
8
    the Free Software Foundation, either version 3 of the License, or
9
    (at your option) any later version.
10
 
11
    Compiler is distributed in the hope that it will be useful,
12
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14
    GNU General Public License for more details.
15
 
16
    You should have received a copy of the GNU General Public License
17
    along with Compiler. If not, see .
18
*)
19
 
20
MODULE X86;
21
 
22
IMPORT UTILS, sys := SYSTEM, SCAN, ELF;
23
 
24
CONST
25
 
26
  ADIM* = 5;
27
 
28
  lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54;
29
  lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76;
30
 
31
  TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7;
32
  TNIL = 8; TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14;
33
 
34
  stABS* = 1; stODD* = 2; stLEN* = 3; stLSL* = 4; stASR* = 5; stROR* = 6; stFLOOR* = 7;
35
  stFLT* = 8; stORD* = 9; stCHR* = 10; stLONG* = 11; stSHORT* = 12; stINC* = 13;
36
  stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19;
37
  stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24;
38
  stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29;
7107 akron1 39
  stLENGTH* = 30; stMIN* = 31; stMAX* = 32;
6613 leency 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
7107 akron1 1235
  |stORD:    PopEDX; OutCode("85D274036A015A"); PushEDX;
1236
  |stMIN:    PopEDX; OutCode("3914247E025852");
1237
  |stMAX:    PopEDX; OutCode("3B14247E025852");
6613 leency 1238
  |stLENGTH: CallRTL(_length); PushEAX
1239
  ELSE
1240
  END
1241
END StFunc;
1242
 
1243
PROCEDURE Load*(T: INTEGER);
1244
VAR lastcmd: ASMLINE; offset: INTEGER;
1245
 
1246
  PROCEDURE del;
1247
  BEGIN
1248
    lastcmd.tcmd := 0;
1249
    offset := lastcmd.varadr;
1250
    lastcmd := lastcmd.Prev(ASMLINE);
1251
    WHILE lastcmd.tcmd # ECMD DO
1252
      lastcmd.clen := 0;
1253
      lastcmd.tcmd := 0;
1254
      lastcmd := lastcmd.Prev(ASMLINE)
1255
    END;
1256
    lastcmd.tcmd := 0
1257
  END del;
1258
 
1259
BEGIN
1260
  lastcmd := current;
1261
  CASE T OF
1262
  |TINTEGER, TSET, TPOINTER, TPROC:
1263
    IF lastcmd.tcmd = ECMD THEN
1264
      del;
1265
      IntByte("8B55", "8B95", offset);
1266
      PushEDX
1267
    ELSE
1268
      PopEDX;
1269
      OutCode("FF32")
1270
    END
1271
  |TCHAR, TBOOLEAN:
1272
    IF lastcmd.tcmd = ECMD THEN
1273
      del;
7107 akron1 1274
      OutCode("0FB6");
6613 leency 1275
      IntByte("55", "95", offset);
1276
      PushEDX
1277
    ELSE
1278
      PopEDX;
7107 akron1 1279
      OutCode("0FB60A");
6613 leency 1280
      PushECX
1281
    END
1282
  |TLONGREAL:
1283
    IF lastcmd.tcmd = ECMD THEN
1284
      del;
1285
      IntByte("DD45", "DD85", offset)
1286
    ELSE
1287
      PopEDX;
1288
      OutCode("DD02")
1289
    END;
1290
    Incfpu
1291
  |TREAL:
1292
    IF lastcmd.tcmd = ECMD THEN
1293
      del;
1294
      IntByte("D945", "D985", offset)
1295
    ELSE
1296
      PopEDX;
1297
      OutCode("D902")
1298
    END;
1299
    Incfpu
1300
  |TCARD16:
1301
    IF lastcmd.tcmd = ECMD THEN
1302
      del;
1303
      OutCode("33D2668B");
1304
      IntByte("55", "95", offset);
1305
      PushEDX
1306
    ELSE
1307
      PopEDX;
1308
      OutCode("33C9668B0A");
1309
      PushECX
1310
    END
1311
  ELSE
1312
  END
1313
END Load;
1314
 
1315
PROCEDURE Save*(T: INTEGER);
1316
BEGIN
1317
  CASE T OF
1318
  |TINTEGER, TSET, TPOINTER, TPROC:
1319
    PopEDX;
1320
    OutCode("588910")
1321
  |TCHAR, TSTRING, TBOOLEAN:
1322
    PopEDX;
1323
    OutCode("588810")
1324
  |TCARD16:
1325
    PopEDX;
1326
    OutCode("58668910")
1327
  |TLONGREAL:
1328
    PopEDX;
1329
    OutCode("DD1A");
1330
    DEC(fpu)
1331
  |TREAL:
1332
    PopEDX;
1333
    OutCode("D91A");
1334
    DEC(fpu)
1335
  |TRECORD:
1336
    CallRTL(_saverec);
1337
    OutCode("85C0750A");
1338
    OnError(4)
1339
  |TARRAY:
1340
    CallRTL(_savearr)
1341
  ELSE
1342
  END
1343
END Save;
1344
 
1345
PROCEDURE OpenArray*(A: TIDX; n: INTEGER);
1346
VAR i: INTEGER;
1347
BEGIN
1348
  PopEDX;
1349
  FOR i := n - 1 TO 0 BY -1 DO
1350
    PushConst(A[i])
1351
  END;
1352
  PushEDX
1353
END OpenArray;
1354
 
1355
PROCEDURE OpenIdx*(n: INTEGER);
1356
BEGIN
1357
  OutByte(54H);
1358
  IF n > 1 THEN
1359
    PushConst(n);
1360
    CallRTL(_arrayidx)
1361
  ELSE
1362
    CallRTL(_arrayidx1)
1363
  END;
1364
  PopEDX;
1365
  OutCode("85D2750A");
1366
  OnError(5);
1367
  PushEDX;
1368
END OpenIdx;
1369
 
1370
PROCEDURE FixIdx*(len, size: INTEGER);
1371
BEGIN
1372
  PopEDX;
1373
  IntByte("5983FA", "5981FA", len);
1374
  OutCode("720A");
1375
  OnError(5);
1376
  IF size > 1 THEN
1377
    IntByte("6BD2", "69D2", size)
1378
  END;
1379
  OutCode("03D1");
1380
  PushEDX
1381
END FixIdx;
1382
 
1383
PROCEDURE Idx*;
1384
BEGIN
1385
  PopEDX;
1386
  PopECX;
1387
  OutCode("03D1");
1388
  PushEDX
1389
END Idx;
1390
 
1391
PROCEDURE DupLoadCheck*;
1392
BEGIN
1393
  PopEDX;
1394
  OutCode("528B125285D2750A");
1395
  OnError(6)
1396
END DupLoadCheck;
1397
 
1398
PROCEDURE DupLoad*;
1399
BEGIN
1400
  PopEDX;
1401
  OutCode("528B12");
1402
  PushEDX;
1403
END DupLoad;
1404
 
1405
PROCEDURE CheckNIL*;
1406
BEGIN
1407
  PopEDX;
1408
  OutCode("85D2750A");
1409
  OnError(6);
1410
  PushEDX;
1411
END CheckNIL;
1412
 
1413
PROCEDURE ExtArray*(A: TIDX; n, m: INTEGER);
1414
VAR i: INTEGER;
1415
BEGIN
1416
  FOR i := n - 1 TO 0 BY -1 DO
1417
    PushConst(A[i])
1418
  END;
1419
  OutByte(54H);
1420
  PushConst(n);
1421
  PushConst(m);
1422
  CallRTL(_arrayrot)
1423
END ExtArray;
1424
 
1425
PROCEDURE ADR*(dim: INTEGER);
1426
BEGIN
1427
  IF dim > 0 THEN
1428
    PopEDX;
1429
    OutCode("83C4");
1430
    OutByte(dim * 4);
1431
    PushEDX
1432
  END
1433
END ADR;
1434
 
1435
PROCEDURE Len*(dim: INTEGER);
1436
BEGIN
1437
  PopEDX;
1438
  IF dim < 0 THEN
1439
    PushConst(-dim)
1440
  ELSIF dim > 1 THEN
1441
    PopEDX;
1442
    OutCode("83C4");
1443
    OutByte((dim - 1) * 4);
1444
    PushEDX
1445
  END
1446
END Len;
1447
 
1448
PROCEDURE For*(inc: BOOLEAN; VAR LBeg, LEnd: INTEGER);
1449
BEGIN
1450
  LEnd := NewLabel();
1451
  LBeg := NewLabel();
1452
  Label(LBeg);
1453
  OutCode("8B14248B4424043910");
1454
  IF inc THEN
1455
    jmp(JG, LEnd)
1456
  ELSE
1457
    jmp(JL, LEnd)
1458
  END
1459
END For;
1460
 
1461
PROCEDURE NextFor*(step, LBeg, LEnd: INTEGER);
1462
BEGIN
1463
  OutCode("8B542404");
1464
  IF step = 1 THEN
1465
    OutCode("FF02")
1466
  ELSIF step = -1 THEN
1467
    OutCode("FF0A")
1468
  ELSE
1469
    IntByte("8302", "8102", step)
1470
  END;
1471
  jmp(JMP, LBeg);
1472
  Label(LEnd);
1473
  OutCode("83C408")
1474
END NextFor;
1475
 
1476
PROCEDURE CaseLabel*(a, b, LBeg: INTEGER);
1477
VAR L: INTEGER;
1478
BEGIN
1479
  L := NewLabel();
1480
  IntByte("83FA", "81FA", a);
1481
  IF a = b THEN
1482
    jmp(JNE, L)
1483
  ELSE
1484
    jmp(JL, L);
1485
    IntByte("83FA", "81FA", b);
1486
    jmp(JG, L)
1487
  END;
1488
  jmp(JMP, LBeg);
1489
  Label(L)
1490
END CaseLabel;
1491
 
1492
PROCEDURE Drop*;
1493
BEGIN
1494
  PopEDX
1495
END Drop;
1496
 
1497
PROCEDURE strcmp*(Op, LR: INTEGER);
1498
BEGIN
1499
  CASE Op OF
1500
  |lxEQ: PushConst(0)
1501
  |lxNE: PushConst(1)
1502
  |lxLT: PushConst(2)
1503
  |lxGT: PushConst(3)
1504
  |lxLE: PushConst(4)
1505
  |lxGE: PushConst(5)
1506
  ELSE
1507
  END;
1508
  CASE LR OF
1509
  |-1: CallRTL(_lstrcmp)
1510
  | 0: CallRTL(_strcmp)
1511
  | 1: CallRTL(_rstrcmp)
1512
  ELSE
1513
  END;
1514
  PushEAX
1515
END strcmp;
1516
 
1517
PROCEDURE Optimization;
1518
VAR cur: ASMLINE; flag: BOOLEAN;
1519
BEGIN
1520
  cur := asmlist.First(ASMLINE);
1521
  WHILE cur # NIL DO
1522
    flag := FALSE;
1523
    CASE cur.tcmd OF
1524
    |PUSHEAX:
1525
      flag := cur.Next(ASMLINE).tcmd = POPEAX
1526
    |PUSHECX:
1527
      flag := cur.Next(ASMLINE).tcmd = POPECX
1528
    |PUSHEDX:
1529
      flag := cur.Next(ASMLINE).tcmd = POPEDX
1530
    ELSE
1531
    END;
1532
    IF flag THEN
1533
      cur.clen := 0;
1534
      cur.tcmd := 0;
1535
      cur := cur.Next(ASMLINE);
1536
      cur.clen := 0;
1537
      cur.tcmd := 0
1538
    END;
1539
    cur := cur.Next(ASMLINE)
1540
  END
1541
END Optimization;
1542
 
1543
PROCEDURE WriteKOS(FName: ARRAY OF CHAR; stk, size, datasize, gsize: INTEGER; obj: BOOLEAN);
1544
CONST strsize = 2048;
1545
VAR Header: KOSHEADER; F, i, filesize, filebuf, a, sec, adr, size2: INTEGER; cur: ASMLINE;
1546
    Coff: COFFHEADER; sym: ARRAY 18 * 4 OF CHAR; FileName: UTILS.STRING;
1547
BEGIN
1548
  F := UTILS.CreateF(FName);
1549
  IF F <= 0 THEN
1550
    Err(1)
1551
  END;
1552
  OutFilePos := UTILS.GetMem(Align(size, 4) + datasize + 1000H);
1553
  filebuf := OutFilePos;
1554
  UTILS.MemErr(OutFilePos = 0);
1555
 
1556
  IF ~obj THEN
1557
    Header.menuet01 := "MENUET01";
1558
    Header.ver := 1;
1559
    Header.start := sys.SIZE(KOSHEADER);
1560
    Header.size := Align(size, 4) + datasize;
1561
    Header.mem := Header.size + stk + gsize + strsize * 2 + 1000H;
1562
    Header.sp := Header.size + gsize + stk;
1563
    Header.param := Header.sp;
1564
    Header.path := Header.param + strsize;
1565
 
1566
    Write(sys.ADR(Header), sys.SIZE(KOSHEADER));
1567
 
1568
    cur := asmlist.First(ASMLINE);
1569
    WHILE cur # NIL DO
1570
      Write(sys.ADR(Code[cur.cmd]), cur.clen);
1571
      cur := cur.Next(ASMLINE)
1572
    END;
1573
    Fill(Align(size, 4) - size, 0X);
1574
    Write(sys.ADR(Data), datasize);
1575
    WriteF(F, filebuf, OutFilePos - filebuf)
1576
 
1577
  ELSE
1578
 
1579
    size2 := size;
1580
    size := Align(size, 4) - sys.SIZE(KOSHEADER);
1581
    Coff.Machine := IntToCard16(014CH);
1582
    Coff.NumberOfSections := IntToCard16(3);
1583
    Coff.TimeDateStamp := UTILS.Date;
1584
    Coff.SizeOfOptionalHeader := IntToCard16(0);
1585
    Coff.Characteristics := IntToCard16(0184H);
1586
 
1587
    Coff.text.name := ".flat";
1588
    Coff.text.size := 0;
1589
    Coff.text.adr := 0;
1590
    Coff.text.sizealign := size;
1591
    Coff.text.OAPfile := 8CH;
1592
    Coff.text.reserved6 := size + datasize + 8CH;
1593
    Coff.text.reserved7 := 0;
1594
    Coff.text.attrflags := 40300020H;
1595
 
1596
    Coff.data.name := ".data";
1597
    Coff.data.size := 0;
1598
    Coff.data.adr := 0;
1599
    Coff.data.sizealign := datasize;
1600
    Coff.data.OAPfile := size + 8CH;
1601
    Coff.data.reserved6 := 0;
1602
    Coff.data.reserved7 := 0;
1603
    Coff.data.reserved8 := 0;
1604
    Coff.data.attrflags := 0C0300040H;
1605
 
1606
    Coff.bss.name := ".bss";
1607
    Coff.bss.size := 0;
1608
    Coff.bss.adr := 0;
1609
    Coff.bss.sizealign := gsize;
1610
    Coff.bss.OAPfile := 0;
1611
    Coff.bss.reserved6 := 0;
1612
    Coff.bss.reserved7 := 0;
1613
    Coff.bss.reserved8 := 0;
1614
    Coff.bss.attrflags := 0C03000C0H;
1615
 
1616
    size := Align(size2, 4);
1617
    rcount := 0;
1618
    cur := asmlist.First(ASMLINE);
1619
    WHILE cur # NIL DO
1620
      IF cur.tcmd IN {OCMD, GCMD} THEN
1621
        sys.GET(sys.ADR(Code[cur.cmd]), a);
1622
        IF a < size THEN
1623
          a := a - sys.SIZE(KOSHEADER);
1624
          sec := 1
1625
        ELSIF a < size + datasize THEN
1626
          a := a - size;
1627
          sec := 2
1628
        ELSE
1629
          a := a - size - datasize;
1630
          sec := 3
1631
        END;
1632
        sys.PUT(sys.ADR(Code[cur.cmd]), a);
1633
        sys.PUT(sys.ADR(Reloc[rcount]), cur.adr - sys.SIZE(KOSHEADER));
1634
        INC(rcount, 4);
1635
        sys.PUT(sys.ADR(Reloc[rcount]), sec);
1636
        INC(rcount, 4);
1637
        sys.PUT(sys.ADR(Reloc[rcount]), 06X); INC(rcount);
1638
        sys.PUT(sys.ADR(Reloc[rcount]), 00X); INC(rcount);
1639
      END;
1640
      Write(sys.ADR(Code[cur.cmd]), cur.clen);
1641
      cur := cur.Next(ASMLINE)
1642
    END;
1643
    size := size2;
1644
    Fill(Align(size, 4) - size2, 0X);
1645
    Write(sys.ADR(Data), datasize);
1646
    Coff.text.reserved8 := rcount DIV 10;
1647
    Coff.PointerToSymbolTable := Coff.text.reserved6 + rcount;
1648
    Coff.NumberOfSymbols := 4;
1649
 
1650
    WriteF(F, sys.ADR(Coff), sys.SIZE(COFFHEADER));
1651
    WriteF(F, filebuf, OutFilePos - filebuf);
1652
    WriteF(F, sys.ADR(Reloc), rcount);
1653
 
1654
    adr := sys.ADR(sym);
1655
    InitArray(adr, "4558504F52545300000000000100000002002E666C617400000000000000010000000300");
1656
    InitArray(adr, "2E64617461000000000000000200000003002E6273730000000000000000030000000300");
1657
    sys.PUT(sys.ADR(sym) + 8, Labels[Exports] - sys.SIZE(KOSHEADER));
1658
 
1659
    WriteF(F, sys.ADR(sym), LEN(sym));
1660
    i := 4;
1661
    WriteF(F, sys.ADR(i), 4)
1662
  END;
1663
  UTILS.CloseF(F)
1664
END WriteKOS;
1665
 
1666
PROCEDURE WriteELF(FName: ARRAY OF CHAR; code, data, glob: INTEGER);
1667
VAR F, delta, filebuf: INTEGER; cur: ASMLINE; bytes: ARRAY 817H + 55FH + 4900 OF CHAR;
1668
 
1669
  PROCEDURE Add(offset: INTEGER);
1670
  VAR m: INTEGER;
1671
  BEGIN
1672
    sys.GET(sys.ADR(bytes[offset]), m);
1673
    sys.PUT(sys.ADR(bytes[offset]), m + delta)
1674
  END Add;
1675
 
1676
  PROCEDURE Sub(offset: INTEGER);
1677
  VAR m: INTEGER;
1678
  BEGIN
1679
    sys.GET(sys.ADR(bytes[offset]), m);
1680
    sys.PUT(sys.ADR(bytes[offset]), m - delta)
1681
  END Sub;
1682
 
1683
  PROCEDURE Add8(a1, a2, a3, a4, a5, a6, a7, a8: INTEGER);
1684
  BEGIN
1685
    Add(a1); Add(a2); Add(a3); Add(a4);
1686
    Add(a5); Add(a6); Add(a7); Add(a8)
1687
  END Add8;
1688
 
1689
BEGIN
1690
  sys.MOVE(ELF.get(), sys.ADR(bytes[0]), ELF.size);
1691
 
1692
  DEC(code, 13);
1693
 
1694
  delta := Align(data, 1000H) - 100000H;
1695
  Add8(0020H, 00A4H, 00A8H, 0258H, 02B8H, 0308H, 0494H, 049CH);
1696
  Add8(04A4H, 0679H, 0681H, 06A4H, 06B0H, 06BAH, 0703H, 0762H);
1697
  Add8(0774H, 0786H, 0819H, 0823H, 17C5H, 17E5H, 17E9H, 1811H);
1698
  Add8(1839H, 1861H, 1889H, 1A25H, 1A95H, 1AA5H, 1C05H, 1C55H);
1699
  Add(1CE5H); Add(1D09H); Add(1D15H); Add(1D25H); Add(1D35H); Add(1D55H);
1700
 
1701
  delta := Align(glob, 1000H) - 3200000H;
1702
  Add(00A8H); Add(17EDH); Add(1C09H); Add(1D25H);
1703
 
1704
  delta := Align(code, 1000H) - 100000H;
1705
  Add8(0020H, 0084H, 0088H, 0098H, 009CH, 00A0H, 00B8H, 00BCH);
1706
  Add8(00C0H, 0118H, 011CH, 0120H, 0258H, 0278H, 02B8H, 0308H);
1707
  Add8(048CH, 0494H, 049CH, 04A4H, 04ACH, 04B4H, 04BCH, 04C4H);
1708
  Add8(04CCH, 04D4H, 04DCH, 04E4H, 04ECH, 04F4H, 04FCH, 0504H);
1709
  Add8(050CH, 0514H, 052BH, 0544H, 054EH, 0554H, 055EH, 056EH);
1710
  Add8(057EH, 058EH, 059EH, 05AEH, 05BEH, 05CEH, 05DEH, 05EEH);
1711
  Add8(05FEH, 060EH, 061EH, 062EH, 064CH, 0651H, 0679H, 0681H);
1712
  Add8(0686H, 068CH, 06A4H, 06ABH, 06B0H, 06BAH, 06D7H, 06EBH);
1713
  Add8(0703H, 0762H, 0774H, 0786H, 0819H, 0823H, 0828H, 082DH);
1714
  Add8(1635H, 1655H, 1659H, 167DH, 1681H, 16A5H, 16A9H, 16CDH);
1715
  Add8(16D1H, 16F5H, 16F9H, 171DH, 1721H, 1745H, 1749H, 176DH);
1716
  Add8(1771H, 1795H, 1799H, 17BDH, 17C1H, 17E5H, 17E9H, 1811H);
1717
  Add8(1839H, 1861H, 1889H, 1985H, 1995H, 19A5H, 19B5H, 19C5H);
1718
  Add8(19D5H, 19E5H, 19F5H, 1A05H, 1A15H, 1A25H, 1A55H, 1A65H);
1719
  Add8(1A75H, 1A95H, 1AA5H, 1AD5H, 1AE5H, 1AF5H, 1B05H, 1B25H);
1720
  Add8(1B35H, 1B45H, 1B55H, 1B65H, 1B75H, 1BB5H, 1BC5H, 1BE5H);
1721
  Add8(1C05H, 1C15H, 1C55H, 1C75H, 1CA5H, 1CB5H, 1CE5H, 1D05H);
1722
  Add8(1D15H, 1D25H, 1D35H, 1D55H, 1D75H, 1D89H, 08DEH, 08E8H);
1723
  Sub(0845H); Sub(087BH); Sub(0916H); Add(0C52H); Add(0C8AH); Add(0D0AH);
1724
 
1725
  OutFilePos := UTILS.GetMem(code + data + 8000H);
1726
  filebuf := OutFilePos;
1727
  UTILS.MemErr(OutFilePos = 0);
1728
 
1729
  Write(sys.ADR(bytes), 817H);
1730
  Fill(2DDH, 90X);
1731
  cur := asmlist.First(ASMLINE);
1732
  WHILE cur # NIL DO
1733
    Write(sys.ADR(Code[cur.cmd]), cur.clen);
1734
    cur := cur.Next(ASMLINE)
1735
  END;
1736
  Fill(Align(code, 1000H) - code, 90X);
1737
  Write(sys.ADR(bytes[817H]), 55FH);
1738
  Write(sys.ADR(Data), data);
1739
  Fill(Align(data, 1000H) - data, 0X);
1740
  Write(sys.ADR(bytes[817H + 55FH + 55FH]), 0DC5H);
1741
 
1742
  F := UTILS.CreateF(FName);
1743
  IF F <= 0 THEN
1744
    Err(1)
1745
  END;
1746
  WriteF(F, filebuf, OutFilePos - filebuf);
1747
  UTILS.CloseF(F)
1748
END WriteELF;
1749
 
1750
PROCEDURE DelProc*(beg, end: ASMLINE);
1751
BEGIN
1752
  WHILE beg # end DO
1753
    beg.clen := 0;
1754
    beg.tcmd := 0;
1755
    beg := beg.Next(ASMLINE)
1756
  END;
1757
  beg.clen := 0;
1758
  beg.tcmd := 0
1759
END DelProc;
1760
 
1761
PROCEDURE FixLabels*(FName: ARRAY OF CHAR; stk, gsize, glob: INTEGER);
1762
VAR size, asize, i, rdatasize, RCount, n, temp, temp2, temp3: INTEGER; cur: ASMLINE; R: RELOC; c: CHAR;
1763
BEGIN
1764
  dcount := Align(dcount, 4);
1765
  IF dll THEN
1766
    LoadAdr := 10000000H;
1767
    PackExport(ExecName)
1768
  ELSIF con OR gui THEN
1769
    LoadAdr := 400000H
1770
  ELSIF kos OR obj THEN
1771
    LoadAdr := sys.SIZE(KOSHEADER)
1772
  ELSIF elf THEN
1773
    LoadAdr := 134514420 + 1024;
1774
    INC(gsize, 1024)
1775
  END;
1776
 
1777
  IF dll OR con OR gui THEN
1778
    rdatasize := 0DAH + etable.size;
1779
    size := 1000H + LoadAdr;
1780
  ELSIF kos OR elf OR obj THEN
1781
    rdatasize := 0;
1782
    size := LoadAdr
1783
  END;
1784
 
1785
  Optimization;
1786
  temp2 := size;
1787
  cur := asmlist.First(ASMLINE);
1788
  WHILE cur # NIL DO
1789
    cur.adr := size;
1790
    IF cur.tcmd = LCMD THEN
1791
      sys.PUT(cur.varadr, size)
1792
    END;
1793
    size := size + cur.clen;
1794
    cur := cur.Next(ASMLINE)
1795
  END;
1796
 
1797
  size := temp2;
1798
  cur := asmlist.First(ASMLINE);
1799
  WHILE cur # NIL DO
1800
    cur.adr := size;
1801
    IF cur.tcmd = LCMD THEN
1802
      sys.PUT(cur.varadr, size)
1803
    ELSIF (cur.tcmd = JCMD) & cur.short THEN
1804
      sys.GET(cur.varadr, i);
1805
      temp3 := i - cur.Next(ASMLINE).adr;
1806
      IF (-131 <= temp3) & (temp3 <= 123) THEN
1807
        sys.GET(cur(ASMLINE).codeadr - 1, c);
1808
        IF c = JMP THEN
1809
          sys.PUT(cur(ASMLINE).codeadr - 1, 0EBX)
1810
        ELSE (*JE, JNE, JLE, JGE, JG, JL*)
1811
          sys.PUT(cur(ASMLINE).codeadr - 2, ORD(c) - 16);
1812
          sys.PUT(cur(ASMLINE).codeadr - 1, temp3);
1813
          DEC(cur(ASMLINE).codeadr)
1814
        END;
1815
        cur.clen := 2
1816
      END
1817
    END;
1818
    size := size + cur.clen;
1819
    cur := cur.Next(ASMLINE)
1820
  END;
1821
 
1822
  IF dll OR con OR gui THEN
1823
    asize := Align(size, 1000H)
1824
  ELSIF kos OR obj THEN
1825
    asize := Align(size, 4)
1826
  ELSIF elf THEN
1827
    asize := 134514420 + 6508 + Align(size - 13 - LoadAdr, 1000H)
1828
  END;
1829
 
1830
  FOR i := 0 TO Lcount DO
1831
    IF Labels[i] < 0 THEN
1832
      Labels[i] := -Labels[i] + asize + Align(rdatasize, 1000H)
1833
    END
1834
  END;
1835
 
1836
  temp := dcount;
1837
  IF elf THEN
1838
    asize := asize + Align(dcount, 1000H) + 64 + 1024;
1839
    sys.PUT(sys.ADR(Code[glob + 1]), asize - 1024);
1840
    dcount := 0
1841
  END;
1842
 
1843
  IF dll THEN
1844
    asize := asize - LoadAdr + 0DAH;
1845
    FOR i := 0 TO etable.namecount - 1 DO
1846
      etable.arradr[i] := Labels[etable.arradr[i]] - LoadAdr;
1847
      etable.arrnameptr[i] := etable.arrnameptr[i] + asize
1848
    END;
1849
    etable.arradroffset := etable.arradroffset + asize;
1850
    etable.arrnameptroffset := etable.arrnameptroffset + asize;
1851
    etable.arrnumoffset := etable.arrnumoffset + asize;
1852
    etable.dllnameoffset := etable.dllnameoffset + asize;
1853
    asize := asize + LoadAdr - 0DAH
1854
  END;
1855
  IF dll OR con OR gui THEN
1856
    Labels[LoadLibrary] := asize + 4;
1857
    Labels[GetProcAddress] := asize;
1858
    R.Page := 0;
1859
    R.Size := 0;
1860
    RCount := 0;
1861
  END;
1862
  cur := asmlist.First(ASMLINE);
1863
 
1864
  FOR i := 0 TO LEN(RtlProc) - 1 DO
1865
    RtlProc[i] := Labels[RtlProc[i]]
1866
  END;
1867
 
1868
  temp3 := asize + Align(rdatasize, 1000H) + dcount;
1869
  WHILE cur # NIL DO
1870
    CASE cur.tcmd OF
1871
    |JCMD:
1872
      sys.GET(cur.varadr, i);
1873
      sys.PUT(cur.codeadr, i - cur.Next(ASMLINE).adr)
1874
    |GCMD:
1875
      sys.GET(cur.codeadr, i);
1876
      sys.PUT(cur.codeadr, i + temp3)
1877
    |OCMD:
1878
      sys.MOVE(cur.varadr, cur.codeadr, 4)
1879
    ELSE
1880
    END;
1881
    IF dll & (cur.tcmd IN {GCMD, OCMD}) THEN
1882
      n := cur.adr - LoadAdr;
1883
      IF ASR(n, 12) = ASR(R.Page, 12) THEN
1884
        R.reloc[RCount] := IntToCard16(n MOD 1000H + 3000H);
1885
        INC(RCount);
1886
        INC(R.Size, 2)
1887
      ELSE
1888
        IF R.Size # 0 THEN
1889
          PutReloc(R)
1890
        END;
1891
        R.Page := ASR(n, 12) * 1000H;
1892
        R.Size := 10;
1893
        R.reloc[0] := IntToCard16(n MOD 1000H + 3000H);
1894
        RCount := 1
1895
      END
1896
    END;
1897
    cur := cur.Next(ASMLINE)
1898
  END;
1899
  IF R.Size # 0 THEN
1900
    PutReloc(R)
1901
  END;
1902
  IF dll OR con OR gui THEN
1903
    WritePE(FName, stk, size - 1000H - LoadAdr, dcount, rdatasize, gsize)
1904
  ELSIF kos OR obj THEN
1905
    WriteKOS(FName, Align(stk, 4), size, dcount, gsize, obj)
1906
  ELSIF elf THEN
1907
    WriteELF(FName, size - LoadAdr, temp, gsize)
1908
  END
1909
END FixLabels;
1910
 
1911
PROCEDURE OutStringZ(str: ARRAY OF CHAR);
1912
VAR i: INTEGER;
1913
BEGIN
1914
  New;
1915
  current.clen := LENGTH(str);
1916
  FOR i := 0 TO current.clen - 1 DO
1917
    Code[ccount] := str[i];
1918
    INC(ccount)
1919
  END;
1920
  Code[ccount] := 0X;
1921
  INC(ccount);
1922
  INC(current.clen)
1923
END OutStringZ;
1924
 
1925
PROCEDURE Epilog*(gsize: INTEGER; FName: ARRAY OF CHAR; stk: INTEGER);
1926
VAR i, glob: INTEGER;
1927
BEGIN
1928
  glob := 0;
1929
  gsize := Align(gsize, 4) + 4;
1930
  COPY(FName, OutFile);
1931
  Labels[RTABLE] := -dcount;
1932
  dataint(recarray[0]);
1933
  FOR i := 1 TO reccount DO
1934
    dataint(recarray[i])
1935
  END;
1936
  current := start;
1937
  IF con OR gui OR dll THEN
1938
    PushInt(LoadLibrary);
1939
    PushInt(GetProcAddress);
1940
    OutCode("5859FF31FF3054")
1941
  ELSIF elf THEN
1942
    OutCode("6800000000");
1943
    glob := current.cmd;
1944
  ELSIF kos OR obj THEN
1945
    OutByte(54H)
1946
  END;
1947
  GlobalAdr(0);
1948
  PushConst(ASR(gsize, 2));
1949
  PushInt(RTABLE);
1950
  PushInt(SELFNAME);
1951
  CallRTL(_init);
1952
  current := asmlist.Last(ASMLINE);
1953
  IF dll THEN
1954
    OutCode("B801000000C9C20C00")
1955
  END;
1956
  IF obj THEN
1957
    OutCode("B801000000C9C20000")
1958
  END;
1959
  OutCode("EB05");
1960
  Label(ASSRT);
1961
  CallRTL(_assrt);
1962
  OutCode("EB09");
1963
  Label(HALT);
1964
  OutCode("6A006A00");
1965
  CallRTL(_assrt);
1966
  OutCode("6A00");
1967
  CallRTL(_halt);
1968
  Label(_floor);
1969
  OutCode("83EC06D93C2466812424FFF366810C24FFF7D92C2483C402D9FCDB1C2458C3");
1970
  IF obj THEN
1971
    Label(Exports);
1972
    CmdN(szSTART); CmdN(START);
1973
    CmdN(szversion); OutInt(stk);
1974
    FOR i := 0 TO kosexpcount - 1 DO
1975
      CmdN(kosexp[i].NameLabel); CmdN(kosexp[i].Adr)
1976
    END;
1977
    OutInt(0);
1978
    Label(szSTART); OutStringZ("lib_init");
1979
    Label(szversion); OutStringZ("version");
1980
    FOR i := 0 TO kosexpcount - 1 DO
1981
      Label(kosexp[i].NameLabel);
1982
      OutStringZ(kosexp[i].Name.Name)
1983
    END
1984
  END;
1985
  FixLabels(FName, stk, gsize, glob)
1986
END Epilog;
1987
 
1988
END X86.