Subversion Repositories Kolibri OS

Rev

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

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