0,0 → 1,1171 |
(* |
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 |
|
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. |