Subversion Repositories Kolibri OS

(*

    BSD 2-Clause License

    Copyright (c) 2018-2021, 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;

    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;

    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 putstr* (s: ARRAY OF CHAR): INTEGER;

VAR

    i, n, res: INTEGER;

BEGIN

    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

        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

    res := CHL.Length(codes.data);

    IF ODD(res) THEN

        PutByte(0);

        INC(res)

    END;

    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

        res := CHL.Length(codes.data);

        IF ODD(res) THEN

            PutByte(0);

            INC(res)

        END;

        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 Call* (proc, callconv, fparams: INTEGER);

BEGIN

    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

    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

    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