Copyright (C) 1994, Digital Equipment Corp.
MODULE Codex86;
IMPORT TargetMap, M3x86Rep, M3ID, M3CG_Ops, Word, M3ObjFile, Wrx86, Target;
IMPORT TInt AS TargetInt;
FROM TargetMap IMPORT CG_Bytes;
FROM M3CG IMPORT ByteOffset, ByteSize;
FROM M3CG IMPORT Type, MType, Label, Alignment;
FROM M3CG_Ops IMPORT ErrorHandler;
FROM M3x86Rep IMPORT Operand, MVar, Regno, OLoc, VLoc, x86Var, x86Proc, NRegs;
FROM M3x86Rep IMPORT RegSet;
FROM M3ObjFile IMPORT Seg;
REVEAL T = Public BRANDED "Codex86.T" OBJECT
parent : M3x86Rep.U := NIL;
obj : M3ObjFile.T := NIL;
debug := FALSE;
Err : ErrorHandler := NIL;
opcode : ARRAY [0 .. NRegs] OF Operand;
current_proc : x86Proc;
textsym : INTEGER;
tempsize := 0;
temparr : REF ARRAY OF MVar;
templimit := 0;
fspilltop := 0;
fspillhigh := 0;
fstackspill : REF ARRAY OF Operand;
fspilllimit := 0;
fstacksize := 0;
fstackloaded := 0;
ftop_mem : MVar;
labarr : REF ARRAY OF x86Label;
lablimit := 0;
next_label_id := 0;
f_litlist : FLiteral := NIL;
abscall_list : AbsCall := NIL;
internal_list : Internal := NIL;
flitvar : x86Var := NIL;
OVERRIDES
init := init;
end := end;
wrFlush := wrFlush;
set_obj := set_obj;
set_current_proc := set_current_proc;
set_textsym := set_textsym;
intCall := intCall;
relCall := relCall;
absCall := absCall;
rmCall := rmCall;
cleanretOp := cleanretOp;
brOp := brOp;
setccOp := setccOp;
noargOp := noargOp;
noargFOp := noargFOp;
immFOp := immFOp;
binFOp := binFOp;
memFOp := memFOp;
assert_fstack := assert_fstack;
f_ensureloaded := f_ensureloaded;
f_pushnew := f_pushnew;
f_exitproc := f_exitproc;
fstack_push := fstack_push;
fstack_pop := fstack_pop;
fstack_swap := fstack_swap;
fstack_discard := fstack_discard;
f_loadlit := f_loadlit;
immOp := immOp;
binOp := binOp;
tableOp := tableOp;
swapOp := swapOp;
movOp := movOp;
movDummyReloc := movDummyReloc;
movImm := movImm;
MOVSWOp := MOVSWOp;
STOSWOp := STOSWOp;
pushOp := pushOp;
popOp := popOp;
decOp := decOp;
unOp := unOp;
mulOp := mulOp;
imulOp := imulOp;
imulImm := imulImm;
divOp := divOp;
idivOp := idivOp;
diffdivOp := diffdivOp;
diffmodOp := diffmodOp;
must_extend := must_extend;
get_addsize := get_addsize;
aligned := aligned;
reserve_labels := reserve_labels;
set_label := set_label;
case_jump := case_jump;
load_ind := load_ind;
fast_load_ind := fast_load_ind;
store_ind := store_ind;
f_loadind := f_loadind;
f_storeind := f_storeind;
log_label_init := log_label_init;
get_frame := get_frame;
set_error_handler := set_error_handler;
END;
TYPE FLiteral = REF RECORD
arr: ARRAY [0 .. 1] OF INTEGER;
size: INTEGER;
loc: ByteOffset;
link: FLiteral;
END;
TYPE Internal = REF RECORD
ivar: IntnlVar;
loc: ByteOffset;
link: Internal;
END;
PROCEDURE intCall (t: T; l: Label) =
VAR rel: INTEGER;
BEGIN
check_label(t, l, "intCall");
WITH lab = t.labarr[l], curs = t.obj.cursor(Seg.Text) DO
IF lab.no_address THEN
rel := 0;
ELSE
rel := lab.offset - (curs + 5);
END;
Mn(t, "CALL rel32");
writecode(t, FALSE, 16_E8, 0, FALSE, 0, FALSE, rel, 4, 0, 0);
IF lab.no_address THEN
log_unknown_label(t, l, t.obj.cursor(Seg.Text) - 4, FALSE);
END
END
END intCall;
PROCEDURE relCall (t: T; rel: INTEGER) =
BEGIN
Mn(t, "CALL rel32");
writecode(t, FALSE, 16_E8, 0, FALSE, 0, FALSE, rel, 4, 0, 0);
END relCall;
TYPE AbsCall = REF RECORD
sym: INTEGER;
loc: ByteOffset;
link: AbsCall;
END;
PROCEDURE absCall (t: T; p: x86Proc) =
BEGIN
Mn(t, "CALL rel32");
writecode(t, FALSE, 16_FF, 16_15, TRUE, 0, FALSE, 0, 4, 0, 0);
t.abscall_list := NEW(AbsCall, loc := t.obj.cursor(Seg.Text) - 4,
sym := p.symbol, link := t.abscall_list);
END absCall;
PROCEDURE rmCall (t: T; READONLY op: Operand) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
<* ASSERT op.loc = OLoc.register OR op.loc = OLoc.mem *>
Mn(t, "CALL r/m32");
build_modrm(t, op, t.opcode[2], modrm, disp, dsize);
writecode(t, FALSE, 16_FF, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF op.loc = OLoc.mem THEN
log_global_var(t, op.mvar, -4);
END
END rmCall;
PROCEDURE cleanretOp (t: T; psize: INTEGER) =
BEGIN
<* ASSERT psize < 16_8000 *>
writecode(t, FALSE, 16_C2, 0, FALSE, 0, FALSE, 0, 0, psize, 2);
END cleanretOp;
PROCEDURE brOp (t: T; br: Cond; l: Label) =
VAR rel: ByteOffset := 0;
BEGIN
check_label(t, l, "brOp");
WITH lab = t.labarr[l], curs = t.obj.cursor(Seg.Text) DO
IF lab.no_address THEN
rel := 0;
ELSE
rel := lab.offset - (curs + 2);
END;
IF rel > 16_7F OR rel < -16_80 OR lab.no_address AND NOT lab.short THEN
IF lab.no_address THEN
rel := 0;
ELSE
rel := lab.offset - (curs + 5);
END;
Mn(t, bropcode[br].name, " rel32");
IF br # Cond.Always THEN
DEC(rel);
writecode(t, FALSE, 16_0F, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
writecode(t, FALSE, bropcode[br].rel8 + 16_10, 0, FALSE, 0, FALSE,
rel, 4, 0, 0);
ELSE
writecode(t, FALSE, 16_E9, 0, FALSE, 0, FALSE, rel, 4,
0, 0);
END
ELSE
Mn(t, bropcode[br].name, " rel8");
IF br # Cond.Always THEN
writecode(t, FALSE, bropcode[br].rel8, 0, FALSE, 0, FALSE, rel, 1,
0, 0);
ELSE
writecode(t, FALSE, 16_EB, 0, FALSE, 0, FALSE, rel, 1,
0, 0);
END
END;
IF lab.no_address THEN
IF lab.short THEN
log_unknown_label(t, l, t.obj.cursor(Seg.Text) - 1, FALSE);
ELSE
log_unknown_label(t, l, t.obj.cursor(Seg.Text) - 4, FALSE);
END
END
END
END brOp;
PROCEDURE setccOp (t: T; READONLY op: Operand; cond: Cond) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
<* ASSERT (op.loc = OLoc.register AND
op.reg IN RegSet { EAX, EBX, ECX, EDX } ) OR
(op.loc = OLoc.mem AND CG_Bytes[op.mvar.t] = 1) *>
IF op.loc = OLoc.register THEN
movImm(t, op, 0);
END;
build_modrm(t, op, t.opcode[0], modrm, disp, dsize);
Mn(t, "SETCC ");
writecode(t, FALSE, 16_0F, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
writecode(t, FALSE, condopcode[cond].opc, modrm, TRUE, 0, FALSE, disp,
dsize, 0, 0);
IF op.loc = OLoc.mem THEN
log_global_var(t, op.mvar, -4);
END
END setccOp;
PROCEDURE prepare_stack (t: T; op: FOp; forcenomem := FALSE) =
BEGIN
WITH opc = fopcode[op] DO
IF (NOT opc.takesmem) OR forcenomem THEN
IF (opc.stackin > 0 OR opc.stackdiff # 0) AND t.ftop_inmem THEN
fstack_loadtop(t);
END;
IF opc.stackdiff > 0 THEN
fstack_ensure(t, opc.stackdiff);
END;
fstack_check(t, opc.stackin, "prepare_stack");
ELSE
IF t.ftop_inmem THEN
IF opc.memdiff > 0 THEN
fstack_ensure(t, opc.memdiff);
END;
fstack_check(t, opc.min, "prepare_stack");
ELSE
IF opc.stackdiff > 0 THEN
fstack_ensure(t, opc.stackdiff);
END;
fstack_check(t, opc.stackin, "prepare_stack");
END
END
END
END prepare_stack;
PROCEDURE noargFOp (t: T; op: FOp) =
BEGIN
prepare_stack(t, op);
Mn(t, fopcode[op].name);
writecode(t, FALSE, fopcode[op].stbase, fopcode[op].stmodrm, TRUE,
0, FALSE, 0, 0, 0, 0);
INC(t.fstacksize, fopcode[op].stackdiff);
INC(t.fstackloaded, fopcode[op].stackdiff);
END noargFOp;
PROCEDURE immFOp (t: T; op: FOp; im: FIm) =
BEGIN
prepare_stack(t, op, TRUE);
Mn(t, imcode[im].name);
writecode(t, FALSE, imcode[im].opcode, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
Mn(t, fopcode[op].name, " ST1");
writecode(t, FALSE, fopcode[op].stbase, fopcode[op].stmodrm+1, TRUE,
0, FALSE, 0, 0, 0, 0);
INC(t.fstacksize, fopcode[op].stackdiff);
INC(t.fstackloaded, fopcode[op].stackdiff);
END immFOp;
PROCEDURE binFOp (t: T; op: FOp; st: INTEGER) =
VAR modrm, disp, dsize, opc: INTEGER;
BEGIN
<* ASSERT st < 8 *>
prepare_stack(t, op);
IF t.ftop_inmem THEN
Mn(t, fopcode[op].name, " ST, ");
IF t.ftop_mem.t = Type.Reel THEN
IF t.debug THEN
t.wr.OutT("m32real");
END;
opc := fopcode[op].m32;
ELSE
IF t.debug THEN
t.wr.OutT("m64real");
END;
opc := fopcode[op].m64;
END;
build_modrm(t, Operand {loc := OLoc.mem, mvar := t.ftop_mem},
t.opcode[fopcode[op].memop], modrm, disp, dsize);
writecode(t, FALSE, opc, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
log_global_var(t, t.ftop_mem, -4);
INC(t.fstacksize, fopcode[op].stackdiff);
INC(t.fstackloaded, fopcode[op].memdiff);
t.ftop_inmem := FALSE;
RETURN;
END;
IF t.debug THEN
Mn(t, fopcode[op].name, "P ST, ST");
t.wr.Int(st);
END;
writecode(t, FALSE, fopcode[op].stbase, fopcode[op].stmodrm+st, TRUE,
0, FALSE, 0, 0, 0, 0);
INC(t.fstacksize, fopcode[op].stackdiff);
INC(t.fstackloaded, fopcode[op].stackdiff);
END binFOp;
PROCEDURE memFOp (t: T; op: FOp; mvar: MVar) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
prepare_stack(t, op);
Mn(t, fopcode[op].name, " m");
build_modrm(t, Operand {loc := OLoc.mem, mvar := mvar},
t.opcode[fopcode[op].memop], modrm, disp, dsize);
writecode(t, FALSE, fopcode[op].m32, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
log_global_var(t, mvar, -4);
INC(t.fstacksize, fopcode[op].memdiff);
INC(t.fstackloaded, fopcode[op].memdiff);
END memFOp;
PROCEDURE noargOp (t: T; op: Op) =
BEGIN
Mn(t, opcode[op].name);
writecode(t, FALSE, opcode[op].imm32, 0, FALSE, 0, FALSE, 0, 0,
0, 0);
END noargOp;
PROCEDURE immOp (t: T; op: Op; READONLY dest: Operand; imm: INTEGER) =
VAR modrm, disp, dsize: INTEGER;
imsize := 4;
BEGIN
<* ASSERT dest.loc = OLoc.register OR dest.loc = OLoc.mem *>
IF imm < 16_80 AND imm > -16_81 THEN
imsize := 1;
END;
IF dest.loc = OLoc.register AND dest.reg = EAX
AND imsize = 4 THEN
Mn(t, opcode[op].name, " EAX,Aimm32");
writecode(t, FALSE, opcode[op].Aimm32, 0, FALSE, 0, FALSE, 0, 0,
imm, imsize);
ELSE
build_modrm(t, dest, t.opcode[opcode[op].immop],
modrm, disp, dsize);
IF imsize = 1 THEN
IF dest.loc = OLoc.mem AND CG_Bytes[dest.mvar.t] = 1 THEN
Mn(t, opcode[op].name, " r/m8, imm8");
writecode(t, FALSE, opcode[op].imm32 - 1, modrm, TRUE, 0, FALSE,
disp, dsize, imm, 1);
log_global_var(t, dest.mvar, -5);
ELSIF dest.loc = OLoc.mem AND CG_Bytes[dest.mvar.t] = 2 THEN
Mn(t, opcode[op].name, " r/m16, imm8");
writecode(t, TRUE, opcode[op].imm8, modrm, TRUE, 0, FALSE,
disp, dsize, imm, 1);
log_global_var(t, dest.mvar, -5);
ELSE
Mn(t, opcode[op].name, " r/m32,imm8");
writecode(t, FALSE, opcode[op].imm8, modrm, TRUE, 0, FALSE,
disp, dsize, imm, 1);
IF dest.loc = OLoc.mem THEN
log_global_var(t, dest.mvar, -5);
END
END
ELSE
<* ASSERT dest.loc # OLoc.mem OR CG_Bytes[dest.mvar.t] = 4 *>
Mn(t, opcode[op].name, " r/m32,imm32");
writecode(t, FALSE, opcode[op].imm32, modrm, TRUE, 0, FALSE,
disp, dsize, imm, 4);
IF dest.loc = OLoc.mem THEN
log_global_var(t, dest.mvar, -8);
END
END
END
END immOp;
PROCEDURE binOp (t: T; op: Op; READONLY dest, src: Operand) =
VAR modrm, disp, dsize, opc: INTEGER;
mnemonic: TEXT := NIL;
BEGIN
<* ASSERT dest.loc = OLoc.register OR dest.loc = OLoc.mem *>
IF src.loc = OLoc.imm THEN
immOp(t, op, dest, src.imm);
RETURN;
END;
IF dest.loc = OLoc.register THEN
build_modrm(t, src, dest, modrm, disp, dsize);
opc := opcode[op].rrm + 1;
IF src.loc = OLoc.mem THEN
<* ASSERT CG_Bytes[src.mvar.t] = 4 *>
mnemonic := "rm32";
ELSE
mnemonic := "rr32";
END
ELSE
<* ASSERT src.loc = OLoc.register AND CG_Bytes[src.mvar.t] = 4 *>
build_modrm(t, dest, src, modrm, disp, dsize);
opc := opcode[op].rmr + 1;
mnemonic := "mr32";
END;
Mn(t, opcode[op].name, mnemonic);
varloc(t, dest);
varloc(t, src);
writecode(t, FALSE, opc, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF dest.loc = OLoc.mem THEN
log_global_var(t, dest.mvar, -4);
ELSIF src.loc = OLoc.mem THEN
log_global_var(t, src.mvar, -4);
END;
END binOp;
PROCEDURE tableOp (t: T; op: Op; READONLY dest, index: Operand;
scale: INTEGER; table: MVar) =
VAR offset, modrm, sib, disp, dsize: INTEGER;
fully_known := FALSE;
BEGIN
<* ASSERT dest.loc = OLoc.register AND index.loc = OLoc.register *>
IF table.var = t.internalvar THEN
offset := Word.Shift(table.o, -16);
table.o := Word.And(table.o, 16_FFFF);
ELSE
offset := table.o;
END;
IF table.var.loc = VLoc.temp THEN
<* ASSERT table.var.parent = t.current_proc *>
INC(offset, table.var.offset);
fully_known := TRUE;
END;
IF (NOT fully_known) OR
(offset > 16_7f) OR (offset < -16_80) THEN
disp := offset;
dsize := 4;
IF NOT fully_known THEN
modrm := dest.reg*8 + 4;
ELSE
modrm := 16_80 + dest.reg*8 + 4;
END;
ELSE
disp := offset;
dsize := 1;
modrm := 16_40 + dest.reg*8 + 4;
END;
CASE scale OF
1 => sib := 0;
| 2 => sib := 16_40;
| 4 => sib := 16_80;
| 8 => sib := 16_C0;
ELSE
t.Err("tableOp called with invalid scale parameter");
END;
INC(sib, index.reg*8);
INC(sib, 5);
Mn(t, opcode[op].name, " r32, table[r32*scale]");
writecode(t, FALSE, opcode[op].rrm+1, modrm, TRUE, sib, TRUE, disp, dsize,
0, 0);
log_global_var(t, table, -4);
END tableOp;
PROCEDURE swapOp (t: T; READONLY dest, src: Operand) =
VAR modrm, disp, dsize: INTEGER;
mnemonic: TEXT := NIL;
otherreg: Regno;
BEGIN
<* ASSERT (dest.loc = OLoc.register OR dest.loc = OLoc.mem) AND
(src.loc = OLoc.register OR src.loc = OLoc.mem) *>
IF dest.loc = OLoc.register AND src.loc = OLoc.register AND
(dest.reg = EAX OR src.reg = EAX) THEN
IF dest.reg = EAX THEN
otherreg := src.reg;
ELSE
otherreg := dest.reg;
END;
Mn(t, "XCHG ");
varloc(t, dest);
varloc(t, src);
writecode(t, FALSE, 16_90 + otherreg, 0, FALSE,
0, FALSE, 0, 0, 0, 0);
RETURN;
END;
IF dest.loc = OLoc.register THEN
<* ASSERT CG_Bytes[src.mvar.t] = 4 *>
build_modrm(t, src, dest, modrm, disp, dsize);
IF src.loc # OLoc.register THEN
mnemonic := "rm32";
ELSE
mnemonic := "rr";
END
ELSE
<* ASSERT src.loc = OLoc.register *>
<* ASSERT CG_Bytes[dest.mvar.t] = 4 *>
build_modrm(t, dest, src, modrm, disp, dsize);
mnemonic := "mr32";
END;
Mn(t, "XCHG ", mnemonic);
varloc(t, dest);
varloc(t, src);
writecode(t, FALSE, 16_87, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF dest.loc = OLoc.mem THEN
log_global_var(t, dest.mvar, -4);
ELSIF src.loc = OLoc.mem THEN
log_global_var(t, src.mvar, -4);
END;
END swapOp;
PROCEDURE MOVSWOp (t: T) =
BEGIN
Mn(t, "MOVSW");
writecode(t, TRUE, 16_A5, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
END MOVSWOp;
PROCEDURE STOSWOp (t: T) =
BEGIN
Mn(t, "STOSW");
writecode(t, TRUE, 16_AB, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
END STOSWOp;
PROCEDURE movOp (t: T; READONLY dest, src: Operand) =
VAR modrm, disp, dsize, opcode: INTEGER;
mnemonic: TEXT := NIL;
prefix := FALSE;
BEGIN
<* ASSERT dest.loc = OLoc.register OR dest.loc = OLoc.mem *>
IF src.loc = OLoc.imm THEN
movImm(t, dest, src.imm);
RETURN;
END;
IF dest.loc = OLoc.register AND dest.reg = EAX AND
src.loc = OLoc.mem AND CG_Bytes[src.mvar.t] = 4 AND
src.mvar.var.loc = VLoc.global THEN
opcode := 16_A1;
mnemonic := "MOV EAX,moffs32";
Mn(t, mnemonic);
writecode(t, prefix, opcode, 0, FALSE, 0, FALSE, src.mvar.o, 4, 0, 0);
log_global_var(t, src.mvar, -4);
RETURN;
END;
IF src.loc = OLoc.register AND src.reg = EAX AND
dest.loc = OLoc.mem AND dest.mvar.var.loc = VLoc.global THEN
opcode := 16_A2;
mnemonic := "MOV moffs";
get_op_size(t, dest.mvar.t, opcode, prefix);
Mn(t, mnemonic, ",EAX");
writecode(t, prefix, opcode, 0, FALSE, 0, FALSE, dest.mvar.o, 4, 0, 0);
log_global_var(t, dest.mvar, -4);
RETURN;
END;
IF dest.loc = OLoc.register AND src.loc = OLoc.mem AND
CG_Bytes[src.mvar.t] # 4 THEN
CASE src.mvar.t OF
Type.Word_A => opcode := 16_8A;
mnemonic := "MOV r32, m8";
binOp(t, Op.oXOR, t.reg[dest.reg], t.reg[dest.reg]);
| Type.Word_B => opcode := 16_8B;
prefix := TRUE;
mnemonic := "MOV r32, m16";
binOp(t, Op.oXOR, t.reg[dest.reg], t.reg[dest.reg]);
| Type.Int_A => opcode := 16_BE;
mnemonic := "MOVSX r32, m8";
writecode(t, FALSE, 16_0F, 0, FALSE, 0, FALSE,
0, 0, 0, 0);
| Type.Int_B => opcode := 16_BF;
mnemonic := "MOVSX r32, m16";
writecode(t, FALSE, 16_0F, 0, FALSE, 0, FALSE,
0, 0, 0, 0);
ELSE
t.Err("Unknown type of size other than dword in movOp");
END;
build_modrm(t, src, dest, modrm, disp, dsize);
Mn(t, mnemonic);
writecode(t, prefix, opcode, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
log_global_var(t, src.mvar, -4);
RETURN;
END;
IF dest.loc = OLoc.register THEN
build_modrm(t, src, dest, modrm, disp, dsize);
opcode := 16_8A;
IF src.loc # OLoc.register THEN
mnemonic := "rm";
get_op_size(t, src.mvar.t, opcode, prefix);
ELSE
mnemonic := "rr";
INC(opcode);
END
ELSE
<* ASSERT src.loc = OLoc.register *>
build_modrm(t, dest, src, modrm, disp, dsize);
opcode := 16_88;
mnemonic := "mr";
get_op_size(t, dest.mvar.t, opcode, prefix);
END;
Mn(t, "MOV ", mnemonic);
varloc(t, dest);
varloc(t, src);
writecode(t, prefix, opcode, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF dest.loc = OLoc.mem THEN
log_global_var(t, dest.mvar, -4);
ELSIF src.loc = OLoc.mem THEN
log_global_var(t, src.mvar, -4);
END;
END movOp;
PROCEDURE movDummyReloc(t: T; READONLY dest: Operand; sym: INTEGER) =
BEGIN
<* ASSERT dest.loc = OLoc.register *>
Mn(t, "MOV reg32, imm32");
writecode(t, FALSE, 16_B8 + dest.reg, 0, FALSE, 0, FALSE, 0, 0, 0, 4);
t.obj.relocate(t.textsym, t.obj.cursor(Seg.Text) - 4, sym);
END movDummyReloc;
PROCEDURE movImm (t: T; READONLY dest: Operand; imm: INTEGER) =
VAR modrm, disp, dsize: INTEGER;
prefix := FALSE;
mnemonic := "m";
opcode := 16_C6;
BEGIN
IF dest.loc = OLoc.register THEN
IF imm = 0 THEN
binOp(t, Op.oXOR, dest, dest);
ELSE
Mn(t, "MOV reg32, imm32");
writecode(t, FALSE, 16_B8 + dest.reg, 0, FALSE, 0, FALSE,
0, 0, imm, 4);
END
ELSE
<* ASSERT dest.loc = OLoc.mem *>
get_op_size(t, dest.mvar.t, opcode, prefix);
build_modrm(t, dest, t.opcode[0], modrm, disp, dsize);
Mn(t, "MOV ", mnemonic, " imm");
writecode(t, prefix, opcode, modrm, TRUE, 0, FALSE, disp, dsize,
imm, CG_Bytes[dest.mvar.t]);
log_global_var(t, dest.mvar, -4 - CG_Bytes[dest.mvar.t]);
END
END movImm;
PROCEDURE pushOp (t: T; READONLY src: Operand) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
CASE src.loc OF
OLoc.imm =>
Mn(t, "PUSH imm32");
writecode(t, FALSE, 16_68, 0, FALSE, 0, FALSE, 0, 0, src.imm, 4);
| OLoc.register =>
Mn(t, "PUSH r32");
writecode(t, FALSE, 16_50 + src.reg, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
| OLoc.mem =>
<* ASSERT CG_Bytes[src.mvar.t] = 4 *>
Mn(t, "PUSH m32");
build_modrm(t, src, t.opcode[6], modrm, disp, dsize);
writecode(t, FALSE, 16_FF, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
log_global_var(t, src.mvar, -4);
ELSE
t.Err("Tried to push an fstack element to the integer stack");
END
END pushOp;
PROCEDURE popOp (t: T; READONLY dest: Operand) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
CASE dest.loc OF
OLoc.imm =>
t.Err("Tried to pop into an immediate stack element");
| OLoc.register =>
Mn(t, "POP r32");
writecode(t, FALSE, 16_58 + dest.reg, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
| OLoc.mem =>
<* ASSERT CG_Bytes[dest.mvar.t] = 4 *>
Mn(t, "POP m32");
build_modrm(t, dest, t.opcode[6], modrm, disp, dsize);
writecode(t, FALSE, 16_FF, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
log_global_var(t, dest.mvar, -4);
ELSE
t.Err("Tried to pop an fstack element from the integer stack");
END
END popOp;
PROCEDURE decOp (t: T; READONLY op: Operand) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
<* ASSERT op.loc = OLoc.mem OR op.loc = OLoc.register *>
IF op.loc = OLoc.register THEN
Mn(t, "DEC r32");
writecode(t, FALSE, 16_48 + op.reg, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
ELSE
<* ASSERT op.loc = OLoc.mem AND CG_Bytes[op.mvar.t] = 4 *>
Mn(t, "DEC m32");
build_modrm(t, op, t.opcode[1], modrm, disp, dsize);
writecode(t, FALSE, 16_FF, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
log_global_var(t, op.mvar, -4);
END
END decOp;
PROCEDURE unOp (t: T; op: Op; READONLY dest: Operand) =
VAR modrm, disp, dsize: INTEGER;
prefix := FALSE;
opc := opcode[op].imm32;
mnemonic := "rm";
BEGIN
IF dest.loc = OLoc.mem THEN
get_op_size(t, dest.mvar.t, opc, prefix);
ELSE
<* ASSERT dest.loc = OLoc.register *>
INC(opc);
mnemonic := "rm32";
END;
build_modrm(t, dest, t.opcode[opcode[op].immop], modrm, disp, dsize);
Mn(t, opcode[op].name, mnemonic);
writecode(t, prefix, opc, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF dest.loc = OLoc.mem THEN
log_global_var(t, dest.mvar, -4);
END
END unOp;
PROCEDURE mulOp (t: T; READONLY src: Operand) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
<* ASSERT src.loc = OLoc.register OR (src.loc = OLoc.mem AND
CG_Bytes[src.mvar.t] = 4) *>
build_modrm(t, src, t.opcode[4], modrm, disp, dsize);
Mn(t, "MUL r32, rm32");
writecode(t, FALSE, 16_F7, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF src.loc = OLoc.mem THEN
log_global_var(t, src.mvar, -4);
END
END mulOp;
PROCEDURE imulOp (t: T; READONLY dest, src: Operand) =
VAR modrm, disp, dsize: INTEGER;
imsize := 0;
BEGIN
<* ASSERT dest.loc = OLoc.register *>
<* ASSERT src.loc # OLoc.mem OR CG_Bytes[src.mvar.t] = 4 *>
IF src.loc = OLoc.imm THEN
build_modrm(t, t.reg[dest.reg], dest, modrm, disp, dsize);
Mn(t, "IMUL r32, imm32");
imsize := 4;
writecode(t, FALSE, 16_69, modrm, TRUE, 0, FALSE, disp, dsize,
src.imm, imsize);
ELSE
build_modrm(t, src, dest, modrm, disp, dsize);
Mn(t, "IMUL r32, rm32");
writecode(t, FALSE, 16_0F, 0, FALSE, 0, FALSE, 0, 0, 0, 0);
writecode(t, FALSE, 16_AF, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
END;
IF src.loc = OLoc.mem THEN
log_global_var(t, src.mvar, -4 - imsize);
END
END imulOp;
PROCEDURE imulImm (t: T; READONLY dest, src: Operand; imm, imsize: INTEGER) =
VAR modrm, disp, dsize, opc: INTEGER;
BEGIN
<* ASSERT dest.loc = OLoc.register *>
<* ASSERT src.loc # OLoc.mem OR CG_Bytes[src.mvar.t] = 4 *>
build_modrm(t, src, dest, modrm, disp, dsize);
Mn(t, "IMUL r32, rm32, imm");
IF imsize = 1 THEN
opc := 16_6B;
ELSE
opc := 16_69;
END;
writecode(t, FALSE, opc, modrm, TRUE, 0, FALSE, disp, dsize, imm,
imsize);
IF src.loc = OLoc.mem THEN
log_global_var(t, src.mvar, -4 - imsize);
END
END imulImm;
PROCEDURE divOp (t: T; READONLY divisor: Operand) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
<* ASSERT divisor.loc = OLoc.register OR (divisor.loc = OLoc.mem
AND CG_Bytes[divisor.mvar.t] = 4) *>
build_modrm(t, divisor, t.opcode[6], modrm, disp, dsize);
Mn(t, "DIV EAX, rm32");
writecode(t, FALSE, 16_F7, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF divisor.loc = OLoc.mem THEN
log_global_var(t, divisor.mvar, -4);
END
END divOp;
PROCEDURE idivOp (t: T; READONLY divisor: Operand) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
<* ASSERT divisor.loc = OLoc.register OR (divisor.loc = OLoc.mem
AND CG_Bytes[divisor.mvar.t] = 4) *>
build_modrm(t, divisor, t.opcode[7], modrm, disp, dsize);
Mn(t, "IDIV EAX, rm32");
writecode(t, FALSE, 16_F7, modrm, TRUE, 0, FALSE, disp, dsize, 0, 0);
IF divisor.loc = OLoc.mem THEN
log_global_var(t, divisor.mvar, -4);
END
END idivOp;
PROCEDURE diffdivOp (t: T; READONLY divisor: Operand; apos: BOOLEAN) =
VAR diffsignlab, endlab: Label;
BEGIN
<* ASSERT divisor.loc = OLoc.register *>
diffsignlab := reserve_labels(t, 1, TRUE);
endlab := reserve_labels(t, 1, TRUE);
movOp(t, t.reg[EDX], t.reg[EAX]);
(* MOV EDX, EAX *)
binOp(t, Op.oXOR, t.reg[EDX], divisor);
(* XOR EDX, divisor *)
brOp(t, Cond.L, diffsignlab);
(* JL diffsignlab *)
IF apos THEN
binOp(t, Op.oXOR, t.reg[EDX], t.reg[EDX]);
ELSE (* XOR EDX, EDX *)
noargOp(t, Op.oCDQ);
END;
(* CDQ *)
idivOp(t, divisor);
(* IDIV EAX, divisor *)
brOp(t, Cond.Always, endlab);
(* JMP endlab *)
set_label(t, diffsignlab);
(* .diffsignlab *)
noargOp(t, Op.oCDQ);
(* CDQ *)
idivOp(t, divisor);
(* IDIV EAX, divisor *)
immOp(t, Op.oCMP, t.reg[EDX], 0);
(* CMP EDX, #0 *)
brOp(t, Cond.E, endlab);
(* JE endlab *)
decOp(t, t.reg[EAX]);
(* DEC EAX *)
set_label(t, endlab);
(* .endlab *)
END diffdivOp;
PROCEDURE diffmodOp (t: T; READONLY divisor: Operand; apos: BOOLEAN) =
VAR diffsignlab, endlab: Label;
BEGIN
<* ASSERT divisor.loc = OLoc.register *>
diffsignlab := reserve_labels(t, 1, TRUE);
endlab := reserve_labels(t, 1, TRUE);
movOp(t, t.reg[EDX], t.reg[EAX]);
(* MOV EDX, EAX *)
binOp(t, Op.oXOR, t.reg[EDX], divisor);
(* XOR EDX, divisor *)
brOp(t, Cond.L, diffsignlab);
(* JL diffsignlab *)
IF apos THEN
binOp(t, Op.oXOR, t.reg[EDX], t.reg[EDX]);
ELSE (* XOR EDX, EDX *)
noargOp(t, Op.oCDQ);
END;
(* CDQ *)
idivOp(t, divisor);
(* IDIV EAX, divisor *)
brOp(t, Cond.Always, endlab);
(* JMP endlab *)
set_label(t, diffsignlab);
(* .diffsignlab *)
noargOp(t, Op.oCDQ);
(* CDQ *)
idivOp(t, divisor);
(* IDIV EAX, divisor *)
immOp(t, Op.oCMP, t.reg[EDX], 0);
(* CMP EDX, #0 *)
brOp(t, Cond.E, endlab);
(* JE endlab *)
binOp(t, Op.oADD, t.reg[EDX], divisor);
(* ADD EDX, divisor *)
set_label(t, endlab);
(* .endlab *)
END diffmodOp;
PROCEDURE must_extend (<*UNUSED*> t: T; READONLY src: Operand):
BOOLEAN =
BEGIN
IF src.loc # OLoc.mem THEN
RETURN FALSE;
END;
IF src.mvar.t = Type.Word_A OR src.mvar.t = Type.Word_B OR
src.mvar.t = Type.Int_A OR src.mvar.t = Type.Int_B THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END
END must_extend;
PROCEDURE get_addsize (<*UNUSED*> t: T; READONLY op: Operand): INTEGER =
BEGIN
IF op.loc # OLoc.mem THEN
RETURN 0;
END;
IF op.mvar.var.loc = VLoc.global THEN
RETURN 4;
END;
WITH offset = op.mvar.o + op.mvar.var.offset DO
IF offset > 16_7F OR offset < -16_80 THEN
RETURN 4;
ELSE
RETURN 1;
END
END
END get_addsize;
PROCEDURE get_op_size (<*UNUSED*> t: T; type: MType;
VAR opcode: INTEGER;
VAR prefix: BOOLEAN) =
BEGIN
<* ASSERT opcode # -1 *>
CASE type OF
Type.Int_A, Type.Word_A =>
prefix := FALSE;
| Type.Int_B, Type.Word_B =>
INC(opcode);
prefix := TRUE;
ELSE
INC(opcode);
prefix := FALSE;
END
END get_op_size;
PROCEDURE build_modrm (t: T; READONLY mem, reg: Operand;
VAR modrm, disp, dsize: INTEGER) =
VAR offset: ByteOffset;
fully_known := FALSE;
BEGIN
<* ASSERT reg.loc = OLoc.register *>
IF mem.loc = OLoc.register THEN
disp := 0;
dsize := 0;
modrm := 16_C0 + reg.reg*8 + mem.reg;
RETURN;
END;
<* ASSERT mem.loc = OLoc.mem *>
<* ASSERT CG_Bytes[mem.mvar.t] # 1 OR reg.opcode OR
reg.reg IN RegSet { EAX, EBX, ECX, EDX } *>
offset := mem.mvar.o;
IF mem.mvar.var.loc = VLoc.temp THEN
<* ASSERT mem.mvar.var.parent = t.current_proc *>
INC(offset, mem.mvar.var.offset);
fully_known := TRUE;
END;
IF (NOT fully_known) OR
(offset > 16_7f) OR (offset < -16_80) THEN
disp := offset;
dsize := 4;
IF NOT fully_known THEN
modrm := reg.reg*8 + 5;
ELSE
modrm := 16_80 + reg.reg*8 + EBP;
END;
ELSE
disp := offset;
dsize := 1;
modrm := 16_40 + reg.reg*8 + EBP;
END;
END build_modrm;
PROCEDURE varloc(t: T; READONLY op: Operand) =
BEGIN
IF t.debug THEN
CASE op.loc OF
OLoc.fstack => t.wr.OutT(" FST");
| OLoc.mem => t.wr.VName(op.mvar.var);
| OLoc.register => t.wr.OutT(" r"); t.wr.OutI(op.reg);
| OLoc.imm => t.wr.OutT(" i"); t.wr.OutI(op.imm);
END
END
END varloc;
PROCEDURE writecode (t: T; prefix: BOOLEAN; opcode, modrm: INTEGER;
mrmpres: BOOLEAN; sib: INTEGER; sibpres: BOOLEAN;
disp, dsize, imm, imsize: INTEGER) =
BEGIN
IF t.debug THEN
t.wr.OutT(" ");
IF prefix THEN
Byte(t, 16_66);
END;
Byte(t, opcode);
IF mrmpres THEN
Byte(t, modrm);
END;
IF sibpres THEN
Byte(t, sib);
END;
IF dsize # 0 THEN
Hexbe(t, disp, dsize);
t.wr.OutT(" ");
END;
IF imsize # 0 THEN
Hexbe(t, imm, imsize);
t.wr.OutT(" ");
END;
t.wr.NL();
END;
<* ASSERT dsize = 0 OR dsize = 1 OR dsize = 4 *>
IF prefix THEN
t.obj.append(Seg.Text, 16_66, 1);
END;
<* ASSERT opcode >= 0 AND opcode <= 255 *>
t.obj.append(Seg.Text, opcode, 1);
IF mrmpres THEN
t.obj.append(Seg.Text, modrm, 1);
END;
IF sibpres THEN
t.obj.append(Seg.Text, sib, 1);
END;
IF dsize # 0 THEN
t.obj.append(Seg.Text, disp, dsize);
END;
IF imsize # 0 THEN
t.obj.append(Seg.Text, imm, imsize);
END;
END writecode;
--------------------------------------------------------- jump routines ---
PROCEDURE case_jump (t: T; index: Operand; READONLY labels: ARRAY OF Label) =
BEGIN
<* ASSERT index.loc = OLoc.register *>
WITH curs = t.obj.cursor(Seg.Text) DO
writecode(t, FALSE, 16_FF, 16_24, TRUE, 16_85 + index.reg * 8, TRUE,
curs + 7, 4, 0, 0); (* Jump to abs address indexed by
register 'index'*4 *)
t.obj.relocate(t.textsym, curs + 3, t.textsym);
FOR i := 0 TO NUMBER(labels) - 1 DO
check_label(t, labels[i], "case_jump");
WITH lab = t.labarr[labels[i]] DO
IF lab.no_address THEN
t.obj.append(Seg.Text, 0, 4);
log_unknown_label(t, labels[i], curs + 7 + i * 4, TRUE);
ELSE
t.obj.append(Seg.Text, lab.offset, 4);
t.obj.relocate(t.textsym, curs + 7 + i * 4, t.textsym);
END
END
END
END
END case_jump;
PROCEDURE load_ind (t: T; r: Regno; READONLY ind: Operand; o: ByteOffset;
type: MType) =
VAR opcode := 16_8B;
mnemonic := "MOV r32, m32";
modrm, dsize: INTEGER;
prefix := FALSE;
BEGIN
<* ASSERT ind.loc = OLoc.register *>
IF CG_Bytes[type] # 4 THEN
CASE type OF
Type.Word_A => opcode := 16_8A;
mnemonic := "MOV r32, m8";
binOp(t, Op.oXOR, t.reg[r], t.reg[r]);
| Type.Word_B => opcode := 16_8B;
prefix := TRUE;
mnemonic := "MOV r32, m16";
binOp(t, Op.oXOR, t.reg[r], t.reg[r]);
| Type.Int_A => opcode := 16_BE;
mnemonic := "MOVSX r32, m8";
writecode(t, FALSE, 16_0F, 0, FALSE, 0, FALSE,
0, 0, 0, 0);
| Type.Int_B => opcode := 16_BF;
mnemonic := "MOVSX r32, m16";
writecode(t, FALSE, 16_0F, 0, FALSE, 0, FALSE,
0, 0, 0, 0);
ELSE
t.Err("Unknown type of size other than dword in load_ind");
END;
END;
Mn(t, mnemonic);
IF o > -16_81 AND o < 16_80 THEN
modrm := 16_40 + r * 8 + ind.reg;
dsize := 1;
ELSE
modrm := 16_80 + r * 8 + ind.reg;
dsize := 4;
END;
IF ind.reg = ESP THEN
writecode(t, prefix, opcode, modrm, TRUE, 16_24, TRUE, o, dsize, 0, 0);
ELSE
writecode(t, prefix, opcode, modrm, TRUE, 0, FALSE, o, dsize, 0, 0);
END
END load_ind;
PROCEDURE fast_load_ind (t: T; r: Regno; READONLY ind: Operand; o: ByteOffset;
size: INTEGER) =
VAR opcode := 16_8B;
mnemonic := "MOV r32, m32";
modrm, dsize: INTEGER;
prefix := FALSE;
BEGIN
<* ASSERT ind.loc = OLoc.register *>
CASE size OF
1 => opcode := 16_8A;
mnemonic := "MOV r32, m8";
| 2 => opcode := 16_8B;
prefix := TRUE;
mnemonic := "MOV r32, m16";
| 4 => opcode := 16_8B;
mnemonic := "MOV r32, m32";
ELSE
t.Err("Illegal size in fast_load_ind");
END;
Mn(t, mnemonic);
IF o > -16_81 AND o < 16_80 THEN
modrm := 16_40 + r * 8 + ind.reg;
dsize := 1;
ELSE
modrm := 16_80 + r * 8 + ind.reg;
dsize := 4;
END;
IF ind.reg = ESP THEN
writecode(t, prefix, opcode, modrm, TRUE, 16_24, TRUE, o, dsize, 0, 0);
ELSE
writecode(t, prefix, opcode, modrm, TRUE, 0, FALSE, o, dsize, 0, 0);
END
END fast_load_ind;
PROCEDURE store_ind (t: T; READONLY val, ind: Operand; o: ByteOffset;
type: MType) =
VAR opcode := 16_88;
mnemonic := "mr";
prefix := FALSE;
modrm, dsize: INTEGER;
imm := 0;
immsize := 0;
BEGIN
<* ASSERT ind.loc = OLoc.register AND val.loc # OLoc.mem *>
IF val.loc = OLoc.imm THEN
opcode := 16_C6;
imm := val.imm;
immsize := CG_Bytes[type];
END;
get_op_size(t, type, opcode, prefix);
Mn(t, "MOV ", mnemonic);
IF o >= -16_80 AND o <= 16_7F THEN
dsize := 1;
modrm := 16_40 + ind.reg;
ELSE
dsize := 4;
modrm := 16_80 + ind.reg;
END;
IF val.loc # OLoc.imm THEN
INC(modrm, val.reg * 8);
END;
IF ind.reg = ESP THEN
writecode(t, prefix, opcode, modrm, TRUE, 16_24, TRUE, o, dsize,
imm, immsize);
ELSE
writecode(t, prefix, opcode, modrm, TRUE, 0, FALSE, o, dsize,
imm, immsize);
END
END store_ind;
PROCEDURE f_loadind (t: T; READONLY ind: Operand; o: ByteOffset; type: MType) =
VAR opcode, modrm, dsize: INTEGER;
BEGIN
<* ASSERT ind.loc = OLoc.register *>
prepare_stack(t, FOp.fLD, TRUE);
Mn(t, "FLD ");
IF type = Type.Reel THEN
IF t.debug THEN
t.wr.OutT("m32real");
END;
opcode := fopcode[FOp.fLD].m32;
ELSE
<* ASSERT type = Type.LReel OR type = Type.XReel *>
IF t.debug THEN
t.wr.OutT("m64real");
END;
opcode := fopcode[FOp.fLD].m64;
END;
IF o >= -16_80 AND o <= 16_7F THEN
dsize := 1;
modrm := 16_40 + fopcode[FOp.fLD].memop * 8 + ind.reg;
ELSE
dsize := 4;
modrm := 16_80 + fopcode[FOp.fLD].memop * 8 + ind.reg;
END;
IF ind.reg = ESP THEN
writecode(t, FALSE, opcode, modrm, TRUE, 16_24, TRUE, o, dsize, 0, 0);
ELSE
writecode(t, FALSE, opcode, modrm, TRUE, 0, FALSE, o, dsize, 0, 0);
END;
INC(t.fstacksize);
INC(t.fstackloaded);
END f_loadind;
PROCEDURE f_storeind (t: T; READONLY ind: Operand; o: ByteOffset;
type: MType) =
VAR opcode, modrm, dsize: INTEGER;
BEGIN
<* ASSERT ind.loc = OLoc.register *>
fstack_check(t, 1, "f_storeind");
IF t.ftop_inmem THEN
fstack_loadtop(t);
END;
Mn(t, "FSTP ");
IF type = Type.Reel THEN
IF t.debug THEN
t.wr.OutT("m32real");
END;
opcode := fopcode[FOp.fSTP].m32;
ELSE
<* ASSERT type = Type.LReel OR type = Type.XReel *>
IF t.debug THEN
t.wr.OutT("m64real");
END;
opcode := fopcode[FOp.fSTP].m64;
END;
IF o >= -16_80 AND o <= 16_7F THEN
dsize := 1;
modrm := 16_40 + fopcode[FOp.fSTP].memop * 8 + ind.reg;
ELSE
dsize := 4;
modrm := 16_80 + fopcode[FOp.fSTP].memop * 8 + ind.reg;
END;
IF ind.reg = ESP THEN
writecode(t, FALSE, opcode, modrm, TRUE, 16_24, TRUE, o, dsize, 0, 0);
ELSE
writecode(t, FALSE, opcode, modrm, TRUE, 0, FALSE, o, dsize, 0, 0);
END;
DEC(t.fstacksize);
DEC(t.fstackloaded);
END f_storeind;
----------------------------------------------------------- label stuff ---
TYPE
x86Label = RECORD
offset: ByteOffset := 0;
no_address := TRUE;
usage: LabList := NIL;
short := FALSE;
END;
TYPE
LabList = OBJECT
seg: Seg;
offs: INTEGER;
abs: BOOLEAN;
link: LabList;
END;
PROCEDURE reserve_labels (t: T; n: INTEGER; short := FALSE): Label =
VAR lab := t.next_label_id;
BEGIN
IF t.next_label_id+n >= t.lablimit THEN
expand_labels(t);
END;
FOR i := lab TO lab + n - 1 DO
t.labarr[i].no_address := TRUE;
t.labarr[i].usage := NIL;
t.labarr[i].short := short;
END;
INC(t.next_label_id, n);
RETURN lab;
END reserve_labels;
PROCEDURE expand_labels(t: T) =
VAR newarr := NEW(REF ARRAY OF x86Label, t.lablimit * 2);
BEGIN
FOR i := 0 TO t.lablimit - 1 DO
newarr[i] := t.labarr[i];
END;
t.labarr := newarr;
t.lablimit := t.lablimit * 2;
END expand_labels;
PROCEDURE log_unknown_label (t: T; l: Label; loc: ByteOffset; abs: BOOLEAN) =
BEGIN
check_label(t, l, "log_unknown_label");
t.labarr[l].usage := NEW(LabList, seg := Seg.Text,
offs := loc, abs := abs,
link := t.labarr[l].usage);
END log_unknown_label;
PROCEDURE log_label_init (t: T; var: x86Var; o: ByteOffset; lab: Label) =
BEGIN
check_label(t, lab, "log_label_init");
t.obj.relocate(var.symbol, o, t.textsym);
IF t.labarr[lab].no_address THEN
t.labarr[lab].usage := NEW(LabList, seg := Seg.Data,
offs := t.obj.cursor(Seg.Data), abs := TRUE,
link := t.labarr[lab].usage);
t.obj.append(Seg.Data, 0, 4);
ELSE
t.obj.append(Seg.Data, t.labarr[lab].offset, 4);
END;
END log_label_init;
PROCEDURE get_frame (t: T; r: Regno; target, current: x86Proc) =
BEGIN
IF current = target THEN
movOp(t, t.reg[r], t.reg[EBP]);
RETURN;
END;
load_ind(t, r, t.reg[EBP], -4, Type.Addr);
current := current.parent;
WHILE current # target DO
load_ind(t, r, t.reg[r], -4, Type.Addr);
current := current.parent;
END
END get_frame;
PROCEDURE set_label (t: T; l: Label; offset := 0) =
BEGIN
check_label(t, l, "set_label");
WITH lab = t.labarr[l] DO
IF NOT lab.no_address THEN
t.Err("Duplicate label definition");
END;
lab.offset := t.obj.cursor(Seg.Text) + offset;
lab.no_address := FALSE;
IF lab.usage # NIL THEN
fill_in_label_thread(t, lab.usage, lab.offset, lab.short);
lab.usage := NIL;
END
END
END set_label;
PROCEDURE check_label(t: T; l: Label; place: TEXT) =
BEGIN
IF l >= t.next_label_id THEN
t.Err("Tried to reference unknown label in " & place);
END
END check_label;
PROCEDURE fill_in_label_thread (t: T; ptr: LabList; val: INTEGER;
short: BOOLEAN) =
BEGIN
WHILE ptr # NIL DO
IF ptr.abs THEN
t.obj.relocate(t.textsym, ptr.offs, t.textsym);
t.obj.patch(ptr.seg, ptr.offs, val, 4);
ELSE
<* ASSERT ptr.seg = Seg.Text *>
IF short THEN
<* ASSERT val - (ptr.offs + 1) <= 16_7F AND
val - (ptr.offs + 1) >= -16_80 *>
t.obj.patch(ptr.seg, ptr.offs, val - (ptr.offs + 1), 1);
ELSE
t.obj.patch(ptr.seg, ptr.offs, val - (ptr.offs + 4), 4);
END
END;
ptr := ptr.link;
END;
END fill_in_label_thread;
-------------------------------------------------- floating stack stuff ---
PROCEDURE fstack_loadtop (t: T) =
VAR modrm, disp, dsize, opc: INTEGER;
BEGIN
<* ASSERT t.ftop_inmem *>
fstack_ensure(t, 0); (* ensure will allow an extra space for the item
in memory, so height can be 0 not 1 *)
Mn(t, "FLD ST, ");
IF t.ftop_mem.t = Type.Reel THEN
IF t.debug THEN
t.wr.OutT("m32real");
END;
opc := fopcode[FOp.fLD].m32;
ELSE
IF t.debug THEN
t.wr.OutT("m64real");
END;
opc := fopcode[FOp.fLD].m64;
END;
build_modrm(t, Operand {loc := OLoc.mem, mvar := t.ftop_mem},
t.opcode[fopcode[FOp.fLD].memop], modrm, disp, dsize);
writecode(t, FALSE, opc, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
log_global_var(t, t.ftop_mem, -4);
t.ftop_inmem := FALSE;
INC(t.fstackloaded);
END fstack_loadtop;
PROCEDURE assert_fstack (t: T; count: INTEGER) =
BEGIN
<* ASSERT t.fstacksize = count *>
END assert_fstack;
PROCEDURE f_ensureloaded (t: T) =
BEGIN
IF t.ftop_inmem THEN
fstack_loadtop(t);
END
END f_ensureloaded;
PROCEDURE f_exitproc (t: T) =
BEGIN
IF t.ftop_inmem THEN
fstack_loadtop(t);
END;
<* ASSERT t.fstacksize = 1 *>
<* ASSERT t.fstackloaded = 1 *>
t.fstacksize := 0;
t.fstackloaded := 0;
END f_exitproc;
PROCEDURE f_pushnew (t: T) =
BEGIN
INC(t.fstacksize);
INC(t.fstackloaded);
END f_pushnew;
PROCEDURE fstack_push (t: T; READONLY mvar: MVar; nomem := FALSE) =
BEGIN
IF t.ftop_inmem THEN
fstack_loadtop(t);
END;
t.ftop_inmem := TRUE;
t.ftop_mem := mvar;
INC(t.fstacksize);
IF nomem THEN
fstack_loadtop(t);
END
END fstack_push;
PROCEDURE fstack_pop (t: T; READONLY mvar: MVar) =
VAR modrm, disp, dsize, opc: INTEGER;
BEGIN
IF t.ftop_inmem THEN
IF mvar = t.ftop_mem THEN
t.ftop_inmem := FALSE;
DEC(t.fstacksize);
RETURN;
END;
fstack_loadtop(t);
END;
Mn(t, "FSTP ST, ");
IF mvar.t = Type.Reel THEN
IF t.debug THEN
t.wr.OutT("m32real");
END;
opc := fopcode[FOp.fSTP].m32;
ELSE
<* ASSERT mvar.t = Type.LReel OR mvar.t = Type.XReel *>
IF t.debug THEN
t.wr.OutT("m64real");
END;
opc := fopcode[FOp.fSTP].m64;
END;
build_modrm(t, Operand {loc := OLoc.mem, mvar:= mvar},
t.opcode[fopcode[FOp.fSTP].memop], modrm, disp, dsize);
writecode(t, FALSE, opc, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
log_global_var(t, mvar, -4);
DEC(t.fstacksize);
DEC(t.fstackloaded);
t.ftop_inmem := FALSE;
END fstack_pop;
PROCEDURE fstack_swap (t: T) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
IF t.ftop_inmem THEN
fstack_loadtop(t);
END;
get_temp(t);
get_temp(t);
Mn(t, "FLD ST, m80real");
build_modrm(t, t.fstackspill[t.fspilltop-2], t.opcode[5],
modrm, disp, dsize);
writecode(t, FALSE, 16_DB, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
Mn(t, "FLD ST, m80real");
build_modrm(t, t.fstackspill[t.fspilltop-1], t.opcode[5],
modrm, disp, dsize);
writecode(t, FALSE, 16_DB, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
DEC(t.fspilltop, 2);
END fstack_swap;
PROCEDURE fstack_discard (t: T) =
BEGIN
fstack_check(t, 1, "fstack_discard");
IF t.ftop_inmem THEN
t.ftop_inmem := FALSE;
ELSE
binFOp(t, FOp.fFREE, 0);
noargFOp(t, FOp.fINCSTP);
DEC(t.fstackloaded);
END;
DEC(t.fstacksize);
END fstack_discard;
PROCEDURE f_loadlit (t: T; READONLY flarr: ARRAY OF INTEGER; type: MType) =
BEGIN
IF t.ftop_inmem THEN
fstack_loadtop(t);
END;
t.ftop_inmem := TRUE;
WITH mvar = t.ftop_mem DO
mvar.var := t.flitvar;
mvar.t := type;
mvar.o := 0;
END;
INC(t.fstacksize);
t.f_litlist := NEW(FLiteral, arr := flarr, size := CG_Bytes[type],
loc := 0, link := t.f_litlist);
END f_loadlit;
PROCEDURE fstack_check (t: T; depth: INTEGER; place: TEXT) =
BEGIN
IF t.fstacksize < depth THEN
t.Err("Floating stack underflow in " & place);
END;
IF t.ftop_inmem THEN
IF t.fstackloaded + 1 < depth THEN
fstack_wipeup(t, depth-t.fstackloaded-1);
END
ELSE
IF t.fstackloaded < depth THEN
fstack_wipeup(t, depth-t.fstackloaded);
END
END
END fstack_check;
PROCEDURE fstack_ensure (t: T; height: INTEGER) =
VAR spill: INTEGER;
BEGIN
spill := t.fstackloaded + height - 8;
IF t.ftop_inmem THEN
INC(spill);
END;
IF spill > 0 THEN
FOR i := 1 TO spill DO
noargFOp(t, FOp.fDECSTP);
END;
FOR i := 1 TO spill DO
get_temp(t);
END;
t.fstackloaded := t.fstackloaded - spill;
END
END fstack_ensure;
PROCEDURE fstack_wipeup(t: T; wipeup: INTEGER) =
BEGIN
IF wipeup + t.fstackloaded > 8 THEN
t.Err("Stack overflow in fstack_wipeup");
END;
IF wipeup > t.fspilltop THEN
t.Err("Not enough spilled fstack elements to replace in fstack_wipeup");
END;
FOR i := 1 TO wipeup DO
retrieve_temp(t);
END;
FOR i := 1 TO wipeup DO
noargFOp(t, FOp.fINCSTP);
END;
t.fstackloaded := t.fstackloaded + wipeup;
END fstack_wipeup;
------------------------------------------------------- code writing i/o---
PROCEDURE Mn (t: T; mn1, mn2, mn3: TEXT := NIL) =
BEGIN
IF t.debug THEN
Hexbe(t, t.obj.cursor(Seg.Text), 4);
t.wr.OutT(":");
IF mn1 # NIL THEN t.wr.OutT(mn1); END;
IF mn2 # NIL THEN t.wr.OutT(mn2); END;
IF mn3 # NIL THEN t.wr.OutT(mn3); END;
END;
END Mn;
PROCEDURE Hexbe (t: T; val: INTEGER; size: INTEGER) =
BEGIN
t.wr.OutT(" ");
Hexberec(t, val, size);
END Hexbe;
PROCEDURE Hexberec (t: T; val: INTEGER; size: INTEGER) =
Output a hex value as a single number (high byte first)
BEGIN
<* ASSERT size>0 *>
IF size # 1 THEN
Hexbe(t, val DIV 16_100, size-1);
END;
Byte(t, Word.And(val,16_ff));
END Hexberec;
PROCEDURE Byte (t: T; val: INTEGER) =
CONST Digits = ARRAY [0 .. 15] OF TEXT
{"0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A",
"B", "C", "D", "E", "F"};
BEGIN
t.wr.OutT(Digits[val DIV 16_10]);
t.wr.OutT(Digits[Word.And(val,16_f)]);
END Byte;
--------------------------------------------------- temporary var stuff ---
PROCEDURE get_temp (t: T) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
IF t.fspilltop = t.fspilllimit THEN
expand_spill(t);
END;
WITH spill = t.fstackspill[t.fspilltop] DO
IF t.fspilltop = t.fspillhigh THEN
spill.loc := OLoc.mem;
spill.mvar.var := t.parent.declare_temp(10, 4, Type.Void, FALSE);
INC (t.fspillhigh);
END;
Mn(t, "FSTP ST, m80real");
build_modrm(t, spill, t.opcode[7], modrm, disp, dsize);
writecode(t, FALSE, 16_DB, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
END;
INC(t.fspilltop);
END get_temp;
PROCEDURE retrieve_temp (t: T) =
VAR modrm, disp, dsize: INTEGER;
BEGIN
<* ASSERT t.fspilltop > 0 *>
DEC(t.fspilltop);
WITH spill = t.fstackspill[t.fspilltop] DO
Mn(t, "FLD ST, m80real");
build_modrm(t, spill, t.opcode[5], modrm, disp, dsize);
writecode(t, FALSE, 16_DB, modrm, TRUE, 0, FALSE, disp, dsize,
0, 0);
END;
END retrieve_temp;
PROCEDURE expand_spill (t: T) =
VAR newspill := NEW(REF ARRAY OF Operand, t.fspilllimit * 2);
BEGIN
FOR i := 0 TO t.fspilllimit DO
newspill[i] := t.fstackspill[i];
END;
t.fstackspill := newspill;
t.fspilllimit := t.fspilllimit * 2;
END expand_spill;
------------------------------------------------------- alignment stuff ---
PROCEDURE aligned (<*UNUSED*> t: T; READONLY var: MVar;
align: Alignment): BOOLEAN =
BEGIN
IF Word.And(var.o + var.var.offset, align - 1) = 0 THEN
RETURN TRUE;
ELSE
RETURN FALSE;
END
END aligned;
---------------------------------------------- future update list stuff ---
PROCEDURE log_global_var (t: T; var: MVar; reltocurs: INTEGER) =
BEGIN
IF var.var.loc # VLoc.global THEN
RETURN;
END;
IF var.var = t.flitvar THEN
<* ASSERT t.f_litlist # NIL AND t.f_litlist.loc = 0 AND
t.f_litlist.size = CG_Bytes[var.t] AND
(var.t = Type.Reel OR var.t = Type.LReel OR
var.t = Type.XReel) *>
t.f_litlist.loc := t.obj.cursor(Seg.Text) + reltocurs;
ELSIF var.var = t.internalvar THEN
t.internal_list := NEW(Internal, ivar := VAL(var.o, IntnlVar),
loc := t.obj.cursor(Seg.Text) + reltocurs,
link := t.internal_list);
ELSE
t.obj.patch(Seg.Text, t.obj.cursor(Seg.Text) + reltocurs,
var.o + var.var.offset, 4);
t.obj.relocate(t.textsym, t.obj.cursor(Seg.Text) + reltocurs,
var.var.symbol);
END
END log_global_var;
----------------------------------------------------------------- misc. ---
PROCEDURE set_error_handler (t: T; err: ErrorHandler) =
BEGIN
t.Err := err;
END set_error_handler;
---------------------------------------------------------------------------
PROCEDURE init (t: T) =
BEGIN
t.tempsize := 0;
t.fspilltop := 0;
t.fstacksize := 0;
t.fstackloaded := 0;
t.ftop_inmem := FALSE;
t.next_label_id := 0;
t.f_litlist := NIL;
t.abscall_list := NIL;
t.internal_list := NIL;
t.flitvar := t.parent.NewVar(Type.Struct, 0, 0, 4);
t.flitvar.loc := VLoc.global;
t.internalvar := t.parent.NewVar(Type.Struct, 0, 0, 4);
t.internalvar.loc := VLoc.global;
t.current_proc := NIL;
t.textsym := 0;
END init;
PROCEDURE end (t: T) =
BEGIN
tidy_internals(t);
END end;
TYPE LocList = REF RECORD
loc: ByteOffset;
link: LocList;
END;
PROCEDURE find_flit (<*UNUSED*> t: T; flarr: ARRAY [0 .. 1] OF INTEGER;
size: INTEGER;
used: FLiteral; VAR loc: ByteOffset): BOOLEAN =
BEGIN
WHILE used # NIL DO
IF flarr[0] = used.arr[0] AND
(size = 4 OR (flarr[1] = used.arr[1])) THEN
loc := used.loc;
RETURN TRUE;
END;
used := used.link;
END;
RETURN FALSE;
END find_flit;
PROCEDURE find_abscall (<*UNUSED *> t: T; internal: INTEGER;
used: AbsCall; VAR loc: ByteOffset): BOOLEAN =
BEGIN
WHILE used # NIL DO
IF internal = used.sym THEN
loc := used.loc;
RETURN TRUE;
END;
used := used.link;
END;
RETURN FALSE;
END find_abscall;
PROCEDURE find_internal (<*UNUSED *> t: T; internal: IntnlVar;
used: Internal; VAR loc: ByteOffset): BOOLEAN =
BEGIN
WHILE used # NIL DO
IF internal = used.ivar THEN
loc := used.loc;
RETURN TRUE;
END;
used := used.link;
END;
RETURN FALSE;
END find_internal;
PROCEDURE tidy_internals (t: T) =
VAR internal_size := 0;
fl_used: FLiteral;
abscall_used: AbsCall;
int_used: Internal;
fl_locs, abscall_locs, int_locs: LocList;
intvar: x86Var;
flptr := t.f_litlist;
abscallptr := t.abscall_list;
intptr := t.internal_list;
BEGIN
fl_used := log_flit_use(t, internal_size, fl_locs);
abscall_used := log_abscall_use(t, internal_size, abscall_locs);
int_used := log_int_use(t, internal_size, int_locs);
IF internal_size # 0 THEN
intvar := init_intvar(t, internal_size, fl_used, abscall_used, int_used);
WHILE flptr # NIL DO
t.obj.patch(Seg.Text, flptr.loc, fl_locs.loc, 4);
t.obj.relocate(t.textsym, flptr.loc, intvar.symbol);
fl_locs := fl_locs.link;
flptr := flptr.link;
END;
<* ASSERT fl_locs = NIL *>
WHILE abscallptr # NIL DO
t.obj.patch(Seg.Text, abscallptr.loc, abscall_locs.loc, 4);
t.obj.relocate(t.textsym, abscallptr.loc, intvar.symbol);
abscall_locs := abscall_locs.link;
abscallptr := abscallptr.link;
END;
<* ASSERT abscall_locs = NIL *>
WHILE intptr # NIL DO
t.obj.patch(Seg.Text, intptr.loc, int_locs.loc, 4);
t.obj.relocate(t.textsym, intptr.loc, intvar.symbol);
int_locs := int_locs.link;
intptr := intptr.link;
END;
<* ASSERT int_locs = NIL *>
END
END tidy_internals;
PROCEDURE log_flit_use (t: T; VAR internal_size: INTEGER; VAR flloc: LocList):
FLiteral =
VAR flptr := t.f_litlist;
f_lit, f_littail: FLiteral := NIL;
flloctail: LocList := NIL;
f_litloc: ByteOffset;
BEGIN
WHILE flptr # NIL DO
IF NOT find_flit(t, flptr.arr, flptr.size, f_lit, f_litloc) THEN
f_litloc := internal_size;
IF f_littail = NIL THEN
f_littail := NEW(FLiteral, arr := flptr.arr, size := flptr.size,
loc := f_litloc, link := NIL);
f_lit := f_littail;
ELSE
f_littail.link := NEW(FLiteral, arr := flptr.arr, size := flptr.size,
loc := f_litloc, link := NIL);
f_littail := f_littail.link;
END;
INC(internal_size, flptr.size);
END;
IF flloctail = NIL THEN
flloctail := NEW(LocList, loc := f_litloc, link := NIL);
flloc := flloctail;
ELSE
flloctail.link := NEW(LocList, loc := f_litloc, link := NIL);
flloctail := flloctail.link;
END;
flptr := flptr.link;
END;
RETURN f_lit;
END log_flit_use;
PROCEDURE log_abscall_use (t: T; VAR internal_size: INTEGER;
VAR abscallloc: LocList):
AbsCall =
VAR abscallptr := t.abscall_list;
abscall, abscalltail: AbsCall := NIL;
absloctail: LocList := NIL;
abcloc: ByteOffset;
BEGIN
WHILE abscallptr # NIL DO
IF NOT find_abscall(t, abscallptr.sym, abscall, abcloc) THEN
abcloc := internal_size;
IF abscalltail = NIL THEN
abscalltail := NEW(AbsCall, sym := abscallptr.sym,
loc := abcloc, link := NIL);
abscall := abscalltail;
ELSE
abscalltail.link := NEW(AbsCall, sym := abscallptr.sym,
loc := abcloc, link := NIL);
abscalltail := abscalltail.link;
END;
INC(internal_size, 4);
END;
IF absloctail = NIL THEN
absloctail := NEW(LocList, loc := abcloc, link := NIL);
abscallloc := absloctail;
ELSE
absloctail.link := NEW(LocList, loc := abcloc, link := NIL);
absloctail := absloctail.link;
END;
abscallptr := abscallptr.link;
END;
RETURN abscall;
END log_abscall_use;
PROCEDURE log_int_use (t: T; VAR internal_size: INTEGER; VAR inloc: LocList):
Internal =
VAR intptr := t.internal_list;
int, inttail: Internal := NIL;
inloctail: LocList := NIL;
intloc: ByteOffset;
BEGIN
WHILE intptr # NIL DO
IF NOT find_internal(t, intptr.ivar, int, intloc) THEN
intloc := internal_size;
IF inttail = NIL THEN
inttail := NEW(Internal, ivar := intptr.ivar, loc := intloc,
link := NIL);
int := inttail;
ELSE
inttail.link := NEW(Internal, ivar := intptr.ivar,
loc := intloc, link := NIL);
inttail := inttail.link;
END;
INC(internal_size, InternalSize[intptr.ivar]);
END;
IF inloctail = NIL THEN
inloctail := NEW(LocList, loc := intloc, link := NIL);
inloc := inloctail;
ELSE
inloctail.link := NEW(LocList, loc := intloc, link := NIL);
inloctail := inloctail.link;
END;
intptr := intptr.link;
END;
RETURN int;
END log_int_use;
PROCEDURE init_intvar (t: T; size: ByteSize; f_lit: FLiteral; abscall: AbsCall;
int: Internal):
x86Var =
VAR intvar: x86Var;
tint: Target.Int;
BEGIN
intvar := t.parent.declare_global(M3ID.NoID, size, 4,
Type.Struct, 0, FALSE, TRUE);
t.parent.begin_init(intvar);
WHILE f_lit # NIL DO
EVAL TargetInt.FromInt(f_lit.arr[0], tint);
t.parent.init_int(f_lit.loc, tint, Type.Int);
IF f_lit.size = 8 THEN
EVAL TargetInt.FromInt(f_lit.arr[1], tint);
t.parent.init_int(f_lit.loc + 4, tint, Type.Int);
END;
f_lit := f_lit.link;
END;
WHILE abscall # NIL DO
t.parent.init_int(abscall.loc, TargetInt.Zero, Type.Int);
t.obj.relocate(intvar.symbol, abscall.loc, abscall.sym);
abscall := abscall.link;
END;
WHILE int # NIL DO
init_internal(t, int.ivar, int.loc);
int := int.link;
END;
t.parent.end_init(intvar);
RETURN intvar;
END init_intvar;
CONST InternalSize = ARRAY IntnlVar OF ByteSize
{ 33 * 4, 33 * 4 };
PROCEDURE init_internal(t: T; internal: IntnlVar; o: ByteOffset) =
VAR tint: Target.Int;
mask: Word.T;
BEGIN
CASE internal OF
IntnlVar.Lowset_table =>
mask := 0;
FOR i := 0 TO 32 DO
EVAL TargetInt.FromInt(mask, tint);
mask := Word.Shift(mask, 1);
mask := Word.Or(mask, 1);
t.parent.init_int(o + i * 4, tint, Type.Word);
END;
| IntnlVar.Highset_table =>
mask := 16_FFFFFFFF;
FOR i := 0 TO 32 DO
EVAL TargetInt.FromInt(mask, tint);
t.parent.init_int(o + i * 4, tint, Type.Word);
mask := Word.Shift(mask, 1);
END
END
END init_internal;
PROCEDURE set_current_proc (t: T; p: x86Proc) =
BEGIN
t.current_proc := p;
<* ASSERT t.fspilltop = 0 *>
t.fspillhigh := 0;
END set_current_proc;
PROCEDURE set_textsym (t: T; sym: INTEGER) =
BEGIN
t.textsym := sym;
END set_textsym;
PROCEDURE set_obj (t: T; obj: M3ObjFile.T) =
BEGIN
t.obj := obj;
END set_obj;
PROCEDURE wrFlush (t: T) =
BEGIN
IF t.debug THEN
t.wr.Flush();
END
END wrFlush;
PROCEDURE New (parent: M3x86Rep.U; wr: Wrx86.T): T =
VAR code := NEW(T, parent := parent, wr := wr);
BEGIN
IF wr # NIL THEN
code.debug := TRUE;
END;
code.templimit := 32;
code.temparr := NEW(REF ARRAY OF MVar, code.templimit);
code.fspilllimit := 16;
code.fstackspill := NEW(REF ARRAY OF Operand, code.fspilllimit);
code.lablimit := 256;
code.labarr := NEW(REF ARRAY OF x86Label, code.lablimit);
FOR i := 0 TO NRegs DO
code.reg[i].loc := OLoc.register;
code.reg[i].reg := i;
code.reg[i].opcode := FALSE;
code.opcode[i].loc := OLoc.register;
code.opcode[i].reg := i;
code.opcode[i].opcode := TRUE;
END;
RETURN code;
END New;
BEGIN
END Codex86.