ruberon/source/IL.ob07

MODULE IL;

IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS, PATHS;


CONST

    call_stack* = 0;
    call_win64* = 1;
    call_sysv*  = 2;
    call_fast1* = 3;
    call_fast2* = 4;

    begin_loop* = 1; end_loop* = 2;

    opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5;
    opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11;
    opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16;
    opADD* = 17; opSUB* = 18; opONERR* = 19; opSUBL* = 20; opADDC* = 21; opSUBR* = 22;
    opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; (*opCHKBYTE* = 27;*) opDROP* = 28;
    opNOT* = 29;

    opEQ*  = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *);
    opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *)
    opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *)
    opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *)
    opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *);

    opVLOAD32* = 60; opGLOAD32* = 61;

    opJZ* = 62; opJNZ* = 63;

    opSAVE32* = 64; opLLOAD8* = 65;

    opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71;
    opUMINF* = 72; opSAVEFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76;

    opJNZ1* = 77; opJG* = 78;
    opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82;

    opCASEL* = 83; opCASER* = 84; opCASELR* = 85;

    opPOPSP* = 86;
    opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opAND* = 90; opOR* = 91;

    opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97;
    opPUSHC* = 98; opSWITCH* = 99;

    opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102;

    opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106;
    opADDS* = 107; opSUBS* = 108; opERR* = 109; opSUBSL* = 110; opADDSC* = 111; opSUBSR* = 112;
    opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116;
    opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121;

    opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124;
    opINCC* = 125; opINC* = 126; opDEC* = 127;
    opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133;
    opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139;
    opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145;
    opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151;
    opGETC* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156;
    opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162;
    opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168;
    opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173;
    opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opLENGTHW* = 179;

    (*opCHR* = 180;*) opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184;
    opLSR* = 185; opLSR1* = 186; opLSR2* = 187;
    opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opSYSVALIGN16* = 192;
    opEQB* = 193; opNEB* = 194; opINF* = 195; opWIN64ALIGN16* = 196; opVLOAD8* = 197; opGLOAD8* = 198;
    opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201;
    opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206;

    opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212;
    opSAVE16C* = 213; (*opWCHR* = 214;*) opHANDLER* = 215;

    opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; opFASTCALL* = 220;


    opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4;
    opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8;
    opLOAD32_PARAM* = -9;

    opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12;

    opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15;
    opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19;
    opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23;
    opLADR_UNPK* = -24;


    _init      *=   0;
    _move      *=   1;
    _strcmpw   *=   2;
    _exit      *=   3;
    _set       *=   4;
    _set1      *=   5;
    _lengthw   *=   6;
    _strcpy    *=   7;
    _length    *=   8;
    _divmod    *=   9;
    _dllentry  *=  10;
    _sofinit   *=  11;
    _arrcpy    *=  12;
    _rot       *=  13;
    _new       *=  14;
    _dispose   *=  15;
    _strcmp    *=  16;
    _error     *=  17;
    _is        *=  18;
    _isrec     *=  19;
    _guard     *=  20;
    _guardrec  *=  21;

    _fmul      *=  22;
    _fdiv      *=  23;
    _fdivi     *=  24;
    _fadd      *=  25;
    _fsub      *=  26;
    _fsubi     *=  27;
    _fcmp      *=  28;
    _floor     *=  29;
    _flt       *=  30;
    _pack      *=  31;
    _unpk      *=  32;


TYPE

    COMMAND* = POINTER TO RECORD (LISTS.ITEM)

        opcode*:    INTEGER;
        param1*:    INTEGER;
        param2*:    INTEGER;
        param3*:    INTEGER;
        float*:     REAL

    END;

    FNAMECMD* = POINTER TO RECORD (COMMAND)

        fname*: PATHS.PATH

    END;

    CMDSTACK = POINTER TO RECORD

        data: ARRAY 1000 OF COMMAND;
        top:  INTEGER

    END;

    EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)

        label*: INTEGER;
        name*:  SCAN.IDSTR

    END;

    IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM)

        name*:   SCAN.TEXTSTR;
        procs*:  LISTS.LIST

    END;

    IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)

        label*: INTEGER;
        lib*:   IMPORT_LIB;
        name*:  SCAN.TEXTSTR;
        count:  INTEGER

    END;


    CODES = RECORD

        last:       COMMAND;
        begcall:    CMDSTACK;
        endcall:    CMDSTACK;
        commands*:  LISTS.LIST;
        export*:    LISTS.LIST;
        _import*:   LISTS.LIST;
        types*:     CHL.INTLIST;
        data*:      CHL.BYTELIST;
        dmin*:      INTEGER;
        lcount*:    INTEGER;
        bss*:       INTEGER;
        rtl*:       ARRAY 33 OF INTEGER;
        errlabels*: ARRAY 12 OF INTEGER;

        charoffs:   ARRAY 256 OF INTEGER;
        wcharoffs:  ARRAY 65536 OF INTEGER;

        wstr:       ARRAY 4*1024 OF WCHAR
    END;


VAR

    codes*: CODES;
    CPU: INTEGER;

    commands: C.COLLECTION;


PROCEDURE set_dmin* (value: INTEGER);
    BEGIN
        codes.dmin := value
    END set_dmin;


PROCEDURE set_bss* (value: INTEGER);
    BEGIN
        codes.bss := value
    END set_bss;


PROCEDURE set_rtl* (idx, label: INTEGER);
    BEGIN
        codes.rtl[idx] := label
    END set_rtl;


PROCEDURE NewCmd (): COMMAND;
    VAR
        cmd:   COMMAND;
        citem: C.ITEM;

    BEGIN
        citem := C.pop(commands);
        IF citem = NIL THEN
            NEW(cmd)
        ELSE
            cmd := citem(COMMAND)
        END

        RETURN cmd
    END NewCmd;


PROCEDURE setlast* (cmd: COMMAND);
    BEGIN
        codes.last := cmd
    END setlast;


PROCEDURE getlast* (): COMMAND;
        RETURN codes.last
    END getlast;


PROCEDURE PutByte (b: BYTE);
    BEGIN
        CHL.PushByte(codes.data, b)
    END PutByte;


PROCEDURE AlignData (n: INTEGER);
    BEGIN
        WHILE CHL.Length(codes.data) MOD n # 0 DO
            PutByte(0)
        END
    END AlignData;


PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER;
    VAR
        i, n, res: INTEGER;
    BEGIN
        IF TARGETS.WinLin THEN
            AlignData(16)
        END;
        res := CHL.Length(codes.data);
        i := 0;
        n := LENGTH(s);
        WHILE i < n DO
            PutByte(ORD(s[i]));
            INC(i)
        END;

        PutByte(0)

        RETURN res
    END putstr;


PROCEDURE putstr1* (c: INTEGER): INTEGER;
    VAR
        res: INTEGER;

    BEGIN
        IF codes.charoffs[c] = -1 THEN
            IF TARGETS.WinLin THEN
                AlignData(16)
            END;
            res := CHL.Length(codes.data);
            PutByte(c);
            PutByte(0);
            codes.charoffs[c] := res
        ELSE
            res := codes.charoffs[c]
        END

        RETURN res
    END putstr1;


PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER;
    VAR
        i, n, res: INTEGER;

    BEGIN
        IF TARGETS.WinLin THEN
            AlignData(16)
        ELSE
            AlignData(2)
        END;
        res := CHL.Length(codes.data);

        n := STRINGS.Utf8To16(s, codes.wstr);

        i := 0;
        WHILE i < n DO
            IF TARGETS.LittleEndian THEN
                PutByte(ORD(codes.wstr[i]) MOD 256);
                PutByte(ORD(codes.wstr[i]) DIV 256)
            ELSE
                PutByte(ORD(codes.wstr[i]) DIV 256);
                PutByte(ORD(codes.wstr[i]) MOD 256)
            END;
            INC(i)
        END;

        PutByte(0);
        PutByte(0)

        RETURN res
    END putstrW;


PROCEDURE putstrW1* (c: INTEGER): INTEGER;
    VAR
        res: INTEGER;

    BEGIN
        IF codes.wcharoffs[c] = -1 THEN
            IF TARGETS.WinLin THEN
                AlignData(16)
            ELSE
                AlignData(2)
            END;
            res := CHL.Length(codes.data);

            IF TARGETS.LittleEndian THEN
                PutByte(c MOD 256);
                PutByte(c DIV 256)
            ELSE
                PutByte(c DIV 256);
                PutByte(c MOD 256)
            END;

            PutByte(0);
            PutByte(0);

            codes.wcharoffs[c] := res
        ELSE
            res := codes.wcharoffs[c]
        END

        RETURN res
    END putstrW1;


PROCEDURE push (stk: CMDSTACK; cmd: COMMAND);
    BEGIN
        INC(stk.top);
        stk.data[stk.top] := cmd
    END push;


PROCEDURE pop (stk: CMDSTACK): COMMAND;
    VAR
        res: COMMAND;
    BEGIN
        res := stk.data[stk.top];
        DEC(stk.top)
        RETURN res
    END pop;


PROCEDURE pushBegEnd* (VAR beg, _end: COMMAND);
    BEGIN
        push(codes.begcall, beg);
        push(codes.endcall, _end);
        beg := codes.last;
        _end := beg.next(COMMAND)
    END pushBegEnd;


PROCEDURE popBegEnd* (VAR beg, _end: COMMAND);
    BEGIN
        beg := pop(codes.begcall);
        _end := pop(codes.endcall)
    END popBegEnd;


PROCEDURE AddRec* (base: INTEGER);
    BEGIN
        CHL.PushInt(codes.types, base)
    END AddRec;


PROCEDURE insert (cur, nov: COMMAND);
    VAR
        old_opcode, param2: INTEGER;


        PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER);
        BEGIN
            cur.opcode := opcode;
            cur.param1 := cur.param2;
            cur.param2 := param2
        END set;


    BEGIN
        IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN

            old_opcode := cur.opcode;
            param2 := nov.param2;

            IF (nov.opcode = opPARAM) & (param2 = 1) THEN

                CASE old_opcode OF
                |opGLOAD64: cur.opcode := opGLOAD64_PARAM
                |opLLOAD64: cur.opcode := opLLOAD64_PARAM
                |opLOAD64:  cur.opcode := opLOAD64_PARAM
                |opGLOAD32: cur.opcode := opGLOAD32_PARAM
                |opLLOAD32: cur.opcode := opLLOAD32_PARAM
                |opLOAD32:  cur.opcode := opLOAD32_PARAM
                |opSADR:    cur.opcode := opSADR_PARAM
                |opVADR:    cur.opcode := opVADR_PARAM
                |opCONST:   cur.opcode := opCONST_PARAM
                ELSE
                    old_opcode := -1
                END

            ELSIF old_opcode = opLADR THEN

                CASE nov.opcode OF
                |opSAVEC: set(cur, opLADR_SAVEC, param2)
                |opSAVE:  cur.opcode := opLADR_SAVE
                |opINC:   cur.opcode := opLADR_INC
                |opDEC:   cur.opcode := opLADR_DEC
                |opINCB:  cur.opcode := opLADR_INCB
                |opDECB:  cur.opcode := opLADR_DECB
                |opINCL:  cur.opcode := opLADR_INCL
                |opEXCL:  cur.opcode := opLADR_EXCL
                |opUNPK:  cur.opcode := opLADR_UNPK
                |opINCC:  set(cur, opLADR_INCC, param2)
                |opINCCB: set(cur, opLADR_INCCB, param2)
                |opDECCB: set(cur, opLADR_DECCB, param2)
                |opINCLC: set(cur, opLADR_INCLC, param2)
                |opEXCLC: set(cur, opLADR_EXCLC, param2)
                ELSE
                    old_opcode := -1
                END

            ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN
                set(cur, opGADR_SAVEC, param2)

            ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
                cur.param2 := cur.param2 * param2

            ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
                INC(cur.param2, param2)

            ELSE
                old_opcode := -1
            END

        ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN

            old_opcode := cur.opcode;
            param2 := nov.param2;

            IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN
                cur.opcode := opLADR_SAVE
            ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN
                set(cur, opLADR_INCC, param2)
            ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
                cur.param2 := cur.param2 * param2
            ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
                INC(cur.param2, param2)
            ELSE
                old_opcode := -1
            END

        ELSE
            old_opcode := -1
        END;

        IF old_opcode = -1 THEN
            LISTS.insert(codes.commands, cur, nov);
            codes.last := nov
        ELSE
            C.push(commands, nov);
            codes.last := cur
        END
    END insert;


PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER);
    VAR
        cmd: COMMAND;
    BEGIN
        cmd := NewCmd();
        cmd.opcode := opcode;
        cmd.param1 := 0;
        cmd.param2 := param;
        insert(codes.last, cmd)
    END AddCmd;


PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER);
    VAR
        cmd: COMMAND;
    BEGIN
        cmd := NewCmd();
        cmd.opcode := opcode;
        cmd.param1 := param1;
        cmd.param2 := param2;
        insert(codes.last, cmd)
    END AddCmd2;


PROCEDURE Const* (val: INTEGER);
    BEGIN
        AddCmd(opCONST, val)
    END Const;


PROCEDURE StrAdr* (adr: INTEGER);
    BEGIN
        AddCmd(opSADR, adr)
    END StrAdr;


PROCEDURE Param1*;
    BEGIN
        AddCmd(opPARAM, 1)
    END Param1;


PROCEDURE NewLabel* (): INTEGER;
    BEGIN
        INC(codes.lcount)
        RETURN codes.lcount - 1
    END NewLabel;


PROCEDURE SetLabel* (label: INTEGER);
    BEGIN
        AddCmd2(opLABEL, label, 0)
    END SetLabel;


PROCEDURE SetErrLabel* (errno: INTEGER);
    BEGIN
        codes.errlabels[errno] := NewLabel();
        SetLabel(codes.errlabels[errno])
    END SetErrLabel;


PROCEDURE AddCmd0* (opcode: INTEGER);
    BEGIN
        AddCmd(opcode, 0)
    END AddCmd0;


PROCEDURE delete (cmd: COMMAND);
    BEGIN
        LISTS.delete(codes.commands, cmd);
        C.push(commands, cmd)
    END delete;


PROCEDURE delete2* (first, last: LISTS.ITEM);
    VAR
        cur, next: LISTS.ITEM;

    BEGIN
        cur := first;

        IF first # last THEN
            REPEAT
                next := cur.next;
                LISTS.delete(codes.commands, cur);
                C.push(commands, cur);
                cur := next
            UNTIL cur = last
        END;

        LISTS.delete(codes.commands, cur);
        C.push(commands, cur)
    END delete2;


PROCEDURE Jmp* (opcode: INTEGER; label: INTEGER);
    VAR
        prev: COMMAND;
        not:  BOOLEAN;

    BEGIN
        prev := codes.last;
        not := prev.opcode = opNOT;
        IF not THEN
            IF opcode = opJNZ THEN
                opcode := opJZ
            ELSIF opcode = opJZ THEN
                opcode := opJNZ
            ELSE
                not := FALSE
            END
        END;

        AddCmd2(opcode, label, label);

        IF not THEN
            delete(prev)
        END
    END Jmp;


PROCEDURE AndOrOpt* (VAR label: INTEGER);
    VAR
        cur, prev: COMMAND;
        i, op, l: INTEGER;
        jz, not: BOOLEAN;

    BEGIN
        cur := codes.last;
        not := cur.opcode = opNOT;
        IF not THEN
            cur := cur.prev(COMMAND)
        END;

        IF cur.opcode = opAND THEN
            op := opAND
        ELSIF cur.opcode = opOR THEN
            op := opOR
        ELSE
            op := -1
        END;

        cur := codes.last;

        IF op # -1 THEN
            IF not THEN
                IF op = opAND THEN
                    op := opOR
                ELSE (* op = opOR *)
                    op := opAND
                END;
                prev := cur.prev(COMMAND);
                delete(cur);
                cur := prev
            END;

            FOR i := 1 TO 9 DO
                IF i = 8 THEN
                    l := cur.param1
                ELSIF i = 9 THEN
                    jz := cur.opcode = opJZ
                END;
                prev := cur.prev(COMMAND);
                delete(cur);
                cur := prev
            END;

            setlast(cur);

            IF op = opAND THEN
                label := l;
                jz := ~jz
            END;

            IF jz THEN
                Jmp(opJZ, label)
            ELSE
                Jmp(opJNZ, label)
            END;

            IF op = opOR THEN
                SetLabel(l)
            END
        ELSE
            Jmp(opJZ, label)
        END;

        setlast(codes.last)
    END AndOrOpt;


PROCEDURE OnError* (line, error: INTEGER);
    BEGIN
        AddCmd2(opONERR, codes.errlabels[error], line)
    END OnError;


PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER);
    VAR
        label: INTEGER;
    BEGIN
        AddCmd(op, t);
        label := NewLabel();
        Jmp(opJNZ, label);
        OnError(line, error);
        SetLabel(label)
    END TypeGuard;


PROCEDURE TypeCheck* (t: INTEGER);
    BEGIN
        AddCmd(opIS, t)
    END TypeCheck;


PROCEDURE TypeCheckRec* (t: INTEGER);
    BEGIN
        AddCmd(opISREC, t)
    END TypeCheckRec;


PROCEDURE New* (size, typenum: INTEGER);
    BEGIN
        AddCmd2(opNEW, typenum, size)
    END New;


PROCEDURE not*;
    VAR
        prev: COMMAND;
    BEGIN
        prev := codes.last;
        IF prev.opcode = opNOT THEN
            codes.last := prev.prev(COMMAND);
            delete(prev)
        ELSE
            AddCmd0(opNOT)
        END
    END not;


PROCEDURE _ord*;
    BEGIN
        IF (codes.last.opcode # opAND) & (codes.last.opcode # opOR) THEN
            AddCmd0(opORD)
        END
    END _ord;


PROCEDURE Enter* (label, params: INTEGER): COMMAND;
    VAR
        cmd: COMMAND;

    BEGIN
        cmd := NewCmd();
        cmd.opcode := opENTER;
        cmd.param1 := label;
        cmd.param3 := params;
        insert(codes.last, cmd)

        RETURN codes.last
    END Enter;


PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND;
    BEGIN
        IF result THEN
            IF float THEN
                AddCmd2(opLEAVEF, locsize, paramsize)
            ELSE
                AddCmd2(opLEAVER, locsize, paramsize)
            END
        ELSE
            AddCmd2(opLEAVE, locsize, paramsize)
        END

        RETURN codes.last
    END Leave;


PROCEDURE EnterC* (label: INTEGER): COMMAND;
    BEGIN
        SetLabel(label)
        RETURN codes.last
    END EnterC;


PROCEDURE LeaveC* (): COMMAND;
    BEGIN
        AddCmd0(opLEAVEC)
        RETURN codes.last
    END LeaveC;


PROCEDURE fastcall (VAR callconv: INTEGER);
    BEGIN
        IF callconv = call_fast1 THEN
            AddCmd(opFASTCALL, 1);
            callconv := call_stack
        ELSIF callconv = call_fast2 THEN
            AddCmd(opFASTCALL, 2);
            callconv := call_stack
        END
    END fastcall;


PROCEDURE Call* (proc, callconv, fparams: INTEGER);
    BEGIN
        fastcall(callconv);
        CASE callconv OF
        |call_stack: Jmp(opCALL, proc)
        |call_win64: Jmp(opWIN64CALL, proc)
        |call_sysv:  Jmp(opSYSVCALL, proc)
        END;
        codes.last(COMMAND).param2 := fparams
    END Call;


PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
    BEGIN
        fastcall(callconv);
        CASE callconv OF
        |call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label)
        |call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label)
        |call_sysv:  Jmp(opSYSVCALLI, proc(IMPORT_PROC).label)
        END;
        codes.last(COMMAND).param2 := fparams
    END CallImp;


PROCEDURE CallP* (callconv, fparams: INTEGER);
    BEGIN
        fastcall(callconv);
        CASE callconv OF
        |call_stack: AddCmd0(opCALLP)
        |call_win64: AddCmd(opWIN64CALLP, fparams)
        |call_sysv:  AddCmd(opSYSVCALLP, fparams)
        END
    END CallP;


PROCEDURE AssignProc* (proc: INTEGER);
    BEGIN
        Jmp(opSAVEP, proc)
    END AssignProc;


PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
    BEGIN
        Jmp(opSAVEIP, proc(IMPORT_PROC).label)
    END AssignImpProc;


PROCEDURE PushProc* (proc: INTEGER);
    BEGIN
        Jmp(opPUSHP, proc)
    END PushProc;


PROCEDURE PushImpProc* (proc: LISTS.ITEM);
    BEGIN
        Jmp(opPUSHIP, proc(IMPORT_PROC).label)
    END PushImpProc;


PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
    BEGIN
        IF eq THEN
            Jmp(opEQP, proc)
        ELSE
            Jmp(opNEP, proc)
        END
    END ProcCmp;


PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
    BEGIN
        IF eq THEN
            Jmp(opEQIP, proc(IMPORT_PROC).label)
        ELSE
            Jmp(opNEIP, proc(IMPORT_PROC).label)
        END
    END ProcImpCmp;


PROCEDURE load* (size: INTEGER);
    VAR
        last: COMMAND;

    BEGIN
        last := codes.last;
        CASE size OF
        |1:
            IF last.opcode = opLADR THEN
                last.opcode := opLLOAD8
            ELSIF last.opcode = opVADR THEN
                last.opcode := opVLOAD8
            ELSIF last.opcode = opGADR THEN
                last.opcode := opGLOAD8
            ELSE
                AddCmd0(opLOAD8)
            END

        |2:
            IF last.opcode = opLADR THEN
                last.opcode := opLLOAD16
            ELSIF last.opcode = opVADR THEN
                last.opcode := opVLOAD16
            ELSIF last.opcode = opGADR THEN
                last.opcode := opGLOAD16
            ELSE
                AddCmd0(opLOAD16)
            END

        |4:
            IF last.opcode = opLADR THEN
                last.opcode := opLLOAD32
            ELSIF last.opcode = opVADR THEN
                last.opcode := opVLOAD32
            ELSIF last.opcode = opGADR THEN
                last.opcode := opGLOAD32
            ELSE
                AddCmd0(opLOAD32)
            END

        |8:
            IF last.opcode = opLADR THEN
                last.opcode := opLLOAD64
            ELSIF last.opcode = opVADR THEN
                last.opcode := opVLOAD64
            ELSIF last.opcode = opGADR THEN
                last.opcode := opGLOAD64
            ELSE
                AddCmd0(opLOAD64)
            END
        END
    END load;


PROCEDURE SysPut* (size: INTEGER);
    BEGIN
        CASE size OF
        |1: AddCmd0(opSAVE8)
        |2: AddCmd0(opSAVE16)
        |4: AddCmd0(opSAVE32)
        |8: AddCmd0(opSAVE64)
        END
    END SysPut;


PROCEDURE savef* (inv: BOOLEAN);
    BEGIN
        IF inv THEN
            AddCmd0(opSAVEFI)
        ELSE
            AddCmd0(opSAVEF)
        END
    END savef;


PROCEDURE saves* (offset, length: INTEGER);
    BEGIN
        AddCmd2(opSAVES, length, offset)
    END saves;


PROCEDURE abs* (real: BOOLEAN);
    BEGIN
        IF real THEN
            AddCmd0(opFABS)
        ELSE
            AddCmd0(opABS)
        END
    END abs;


PROCEDURE shift_minmax* (op: CHAR);
    BEGIN
        CASE op OF
        |"A": AddCmd0(opASR)
        |"L": AddCmd0(opLSL)
        |"O": AddCmd0(opROR)
        |"R": AddCmd0(opLSR)
        |"m": AddCmd0(opMIN)
        |"x": AddCmd0(opMAX)
        END
    END shift_minmax;


PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER);
    BEGIN
        CASE op OF
        |"A": AddCmd(opASR1, x)
        |"L": AddCmd(opLSL1, x)
        |"O": AddCmd(opROR1, x)
        |"R": AddCmd(opLSR1, x)
        |"m": AddCmd(opMINC, x)
        |"x": AddCmd(opMAXC, x)
        END
    END shift_minmax1;


PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER);
    BEGIN
        CASE op OF
        |"A": AddCmd(opASR2, x)
        |"L": AddCmd(opLSL2, x)
        |"O": AddCmd(opROR2, x)
        |"R": AddCmd(opLSR2, x)
        |"m": AddCmd(opMINC, x)
        |"x": AddCmd(opMAXC, x)
        END
    END shift_minmax2;


PROCEDURE len* (dim: INTEGER);
    BEGIN
        AddCmd(opLEN, dim)
    END len;


PROCEDURE Float* (r: REAL; line, col: INTEGER);
    VAR
        cmd: COMMAND;

    BEGIN
        cmd := NewCmd();
        cmd.opcode := opCONSTF;
        cmd.float := r;
        cmd.param1 := line;
        cmd.param2 := col;
        insert(codes.last, cmd)
    END Float;


PROCEDURE drop*;
    BEGIN
        AddCmd0(opDROP)
    END drop;


PROCEDURE _case* (a, b, L, R: INTEGER);
    VAR
        cmd: COMMAND;

    BEGIN
        IF a = b THEN
            cmd := NewCmd();
            cmd.opcode := opCASELR;
            cmd.param1 := a;
            cmd.param2 := L;
            cmd.param3 := R;
            insert(codes.last, cmd)
        ELSE
            AddCmd2(opCASEL, a, L);
            AddCmd2(opCASER, b, R)
        END
    END _case;


PROCEDURE fname* (name: PATHS.PATH);
    VAR
        cmd: FNAMECMD;

    BEGIN
        NEW(cmd);
        cmd.opcode := opFNAME;
        cmd.fname := name;
        insert(codes.last, cmd)
    END fname;


PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR);
    VAR
        exp: EXPORT_PROC;

    BEGIN
        NEW(exp);
        exp.label := label;
        exp.name  := name;
        LISTS.push(codes.export, exp)
    END AddExp;


PROCEDURE AddImp* (dll, proc: SCAN.TEXTSTR): IMPORT_PROC;
    VAR
        lib: IMPORT_LIB;
        p:   IMPORT_PROC;

    BEGIN
        lib := codes._import.first(IMPORT_LIB);
        WHILE (lib # NIL) & (lib.name # dll) DO
            lib := lib.next(IMPORT_LIB)
        END;

        IF lib = NIL THEN
            NEW(lib);
            lib.name := dll;
            lib.procs := LISTS.create(NIL);
            LISTS.push(codes._import, lib)
        END;

        p := lib.procs.first(IMPORT_PROC);
        WHILE (p # NIL) & (p.name # proc) DO
            p := p.next(IMPORT_PROC)
        END;

        IF p = NIL THEN
            NEW(p);
            p.name  := proc;
            p.label := NewLabel();
            p.lib   := lib;
            p.count := 1;
            LISTS.push(lib.procs, p)
        ELSE
            INC(p.count)
        END

        RETURN p
    END AddImp;


PROCEDURE DelImport* (imp: LISTS.ITEM);
    VAR
        lib: IMPORT_LIB;

    BEGIN
        DEC(imp(IMPORT_PROC).count);
        IF imp(IMPORT_PROC).count = 0 THEN
            lib := imp(IMPORT_PROC).lib;
            LISTS.delete(lib.procs, imp);
            IF lib.procs.first = NIL THEN
                LISTS.delete(codes._import, lib)
            END
        END
    END DelImport;


PROCEDURE init* (pCPU: INTEGER);
    VAR
        cmd: COMMAND;
        i:   INTEGER;

    BEGIN
        commands := C.create();

        CPU := pCPU;

        NEW(codes.begcall);
        codes.begcall.top := -1;
        NEW(codes.endcall);
        codes.endcall.top := -1;
        codes.commands := LISTS.create(NIL);
        codes.export   := LISTS.create(NIL);
        codes._import  := LISTS.create(NIL);
        codes.types    := CHL.CreateIntList();
        codes.data     := CHL.CreateByteList();

        NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);
        codes.last := cmd;
        NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd);

        AddRec(0);

        codes.lcount := 0;

        FOR i := 0 TO LEN(codes.charoffs) - 1 DO
            codes.charoffs[i] := -1
        END;

        FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO
            codes.wcharoffs[i] := -1
        END

    END init;


END IL.