Subversion Repositories Kolibri OS

Rev

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

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