Subversion Repositories Kolibri OS

Rev

Rev 9847 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

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