(*
    BSD 2-Clause License

    Copyright (c) 2018-2023, Anton Krotov
    All rights reserved.
*)

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.