Subversion Repositories Kolibri OS

Rev

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