Subversion Repositories Kolibri OS

Rev

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

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