Subversion Repositories Kolibri OS

Rev

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