Subversion Repositories Kolibri OS

Rev

Rev 8097 | Rev 9177 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

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