ir_x86.a68

COMMENT

    the ugly side of generating code
    
COMMENT
#TODO: fix the "mov esi, [esi]" bug #

INT num tempor = 5;

FILE asm := stand out;

[0:7]STRUCT( 
    [3]CHAR mnemonic,
    INT usage
) reg table;

reg table[@1] := (
    ("edi", 0),
    ("esi", 0),
    ("ebx", 0),
    ("ecx", 0),
    ("edx", 0),
    ("eax", 0),
    ("ebp", 0),
    ("esp", 0)
);

PROC emit begin = VOID:
BEGIN
    putf (asm, ($
	".intel_syntax noprefix"ll
	".set heap_fixedsize, 0x1000"l
	".lcomm stack_start, 4"l
	".lcomm heap_end, 4"l
	".lcomm heap_ptr, 4"l
	".lcomm heap_mark, heap_fixedsize/8"l
	".lcomm heap_start, heap_fixedsize*8+4"l
    $))
END;

PROC emit code segment = VOID:
    putf (asm, ($ ".text"ll $));

PROC emit data segment = VOID:
    SKIP;

# right now, we apply a very dirty hack to see if a number if an integer or a tuple #
PROC library functions = VOID:
BEGIN
    # memory allocation #
    putf (asm, ($
	"getmem:"l
	4x"mov eax, dword ptr [heap_ptr]"l
	4x"cmp eax, dword ptr [heap_end]"l
	4x"jb .Lsufficient"l
	4x"#call Fgc_collect"l
	4x"mov eax, dword ptr [heap_ptr]"l
	4x"cmp eax, dword ptr [heap_end]"l
	4x"jb .Lsufficient"l
	4x"xor eax, eax"l
	4x"inc eax"l
	4x"mov ebx, eax"l
	4x"int 0x80 # halt with error"l
	".Lsufficient:"l
	4x"push ebx"l
	4x"mov ebx, dword ptr [eax]"l
	4x"test ebx, ebx"l
	4x"jnz .Lrecycled"l
	4x"lea ebx, [eax+8]"l
	".Lrecycled:"l
	4x"mov dword ptr [heap_ptr], ebx"l
	4x"pop ebx"l
	4x"ret"ll
	".include ""gc_lib.s"""ll
    $));

    # printing #
    putf (asm, ($
        "Fprint:"l
	4x"mov eax, [esp+4]"l
	4x"mov edx, eax"l
	4x"shr edx, 24"l
	4x"cmp edx, 0x8"l
	4x"je .Lcompound"l
	".Lmistake:"l
	4x"cdq"l
	4x"xor eax, edx"l
	4x"sub eax, edx"l
	4x"neg edx"l
	4x"lea edx, [43+edx*2]"l
	4x"mov ebx, 10"l
	4x"sub esp, 12"l
	4x"mov [esp], dl"l
	4x"mov [esp+ebx], bl"l
	4x"mov ecx, 9"l

	".Ldivloop:"l
	4x"xor edx, edx"l
	4x"div ebx"l
	4x"add dl, 48"l
	4x"mov [esp+ecx], dl"l
	4x"test eax, eax"l
	4x"loopnz .Ldivloop"l
	4x"jecxz .Lskip"l
	".Lpadloop:"l
	4x"mov byte ptr [esp+ecx], 32"l
	4x"loop .Lpadloop"l
	".Lskip:"l

	4x"mov edx, 11"l
	4x"xor ebx, ebx"l
	4x"inc ebx"l
	4x"lea ecx, [esp]"l
	4x"mov eax, 4"l
	4x"int 0x80"l
	4x"add esp, 12"l
	4x"ret 4"ll

        ".Lcompound:"l
	4x"test eax, 0x3"l
	4x"jnz .Lmistake"l
	4x"push [eax]"l
	4x"mov eax, [eax+4]"l
	4x"mov [esp+8], eax"l
	4x"call Fprint"l
	4x"cmp dword ptr [esp+4], 0"l
	4x"jne Fprint"l
	4x"ret 4"ll
    $))
END;
COMMENT for debugging
    "pusha"l
    "mov eax, dword ptr [heap_ptr]"l
    "and eax, 0xFFFFF"l
    "push eax"l
    "call Fprint"l

    "mov eax, offset heap_start"l
    "and eax, 0xFFFFF"l
    "push eax"l
    "call Fprint"l

    "mov eax, [heap_end]"l
    "and eax, 0xFFFFF"l
    "push eax"l
    "call Fprint"l
    "popa"l
COMMENT


PROC emit global var = (IDENT id)VOID: 
    putf (asm, ($
	".lcomm V"g", 4"ll
    $, name OF id));
PROC emit label = (STRING lbl)VOID: 
    putf (asm, ($
	"L"g":"l
    $, lbl));
PROC emit startup = VOID:
    putf (asm, ($l
	".global _start"l
	"_start:"l
	4x"mov [stack_start], esp"l
	4x"lea eax, heap_start"l
	4x"mov [heap_ptr], eax"l
	4x"add eax, offset heap_fixedsize*8"l
	4x"mov [heap_end], eax"l
    $));
PROC emit end = VOID:
BEGIN
    putf (asm, ($
	4x"xor eax, eax"l
	4x"xor ebx, ebx"l
	4x"inc eax"l
	4x"int 0x80"ll
    $));
    library functions
END;

INT arg counter;

PROC emit prolog = (STRING name, INT args, loc)VOID:
BEGIN
    arg counter := args;
    #putf (asm, ($
	"F"g":"l
	4x"push ebp"l
	4x"mov ebp, esp"l
    $, name));
    IF loc > 0 THEN putf (asm, ($4x"sub esp, "g(0)l$, loc*4)) FI#
    putf (asm, ($
	"F"g":"l
	4x"enter "g(0)", 0"l
    $, name, loc*4))
END;

PROC emit epilog = VOID:
BEGIN
    putf (asm, ($
	4x"leave"l
	4x"ret "g(0)ll
    $, arg counter*4));
    #IF loc > 0 THEN putf (asm, ($4x"mov esp, ebp"l$)) FI;
    putf (asm, ($
	4x"pop ebp"l
	4x"ret "g(0)ll
    $, arg counter*4));#
    discard (REGISTER(num tempor))
END;

PROC emit prepare call = (INT arg size)VOID: 
BEGIN
    reserve register (num tempor);
    # emit code to preserve, but delay using it until call is complete #
    usage OF reg table[num tempor] -:= 1; 
    FOR i FROM 0 TO num tempor-1 DO
	IF usage OF reg table[i] > 0 THEN reserve register (i) FI
    OD
END;

PROC emit call = (STRING name, INT arg size)VOID:
BEGIN
    putf (asm, ($
	4x"call F"gl
    $, name));
    usage OF reg table[num tempor] +:= 1;
    FOR i FROM 0 TO num tempor-1 DO
	IF usage OF reg table[i] > 0 THEN discard (i) FI
    OD
END;

# the 'virtual stack' approach is currently useless, since not all
  pushes and pops are currently tracked; don't use esp-based addressing! #
INT stack counter := 0;
INT esp = 7;
INT ebp = 6;

PROC emit move = (LOCATION dst, src)VOID:
    IF (src | (INDIRECT d): base OF d = esp AND offset OF d = stack counter | FALSE) THEN
	putf (asm, ($
	    4x"pop "gl
	$, REPR dst));
	stack counter -:= 1
    ELIF (dst | (INDIRECT d): base OF d = esp AND offset OF d = stack counter+1 | FALSE) THEN
	putf (asm, ($
	    4x"push "gl
	$, REPR dst));
	stack counter +:= 1;
	discard (src)
    ELIF STRING tmp; (src | (FLAGS f): (tmp:=cond OF f; TRUE) | FALSE) THEN
	IF tmp = "" THEN
	    fatal error ("an inconvenient truth")
	ELSE
	    reserve register (num tempor);
	    putf (asm, ($
		4x"set"g" al"l
		4x"movzx eax, al"l
		4x"mov "g", eax"l
	    $, (tmp="ne"|tmp|tmp[1]), REPR dst));
	    discard (num tempor)
	FI
    ELIF (dst | (REGISTER r): TRUE | FALSE) OR (src | (REGISTER r): TRUE, (IMMEDIATE i): TRUE | FALSE) THEN
	putf (asm, ($
	    4x"mov "g", "gl
	$, REPR dst, REPR src));
	discard (src)
    ELSE
	reserve register (num tempor);
	emit move (num tempor, src);
	emit move (dst, num tempor);
	discard (num tempor)
    FI;

PROC emit push arg = (LOCATION loc, INT arg num)VOID:
BEGIN
    putf (asm, ($
	4x"push "gl
    $, REPR loc));
    discard (loc)
END;

PROC emit jump = (STRING dest, FLAGS f)VOID:
    putf (asm, ($
	4x"j"g" L"gl
    $, IF STRING cc = cond OF f; cc = "" THEN "mp" ELIF cc[UPB cc] = "t" THEN cc[1:UPB cc-1] ELSE cc FI, dest));

PROC emit bin = (STRING op, LOCATION dst,src)LOCATION:
BEGIN
    IF op = "div" OR op = "mod" THEN
	[]REGISTER result = IF op="div" THEN (5,4) ELSE (4,5) FI;
	BOOL direct result = (dst | (REGISTER reg): reg = result[1] | FALSE);
	IF NOT direct result THEN 
	    reserve register (result[1])
	FI;
	reserve register (result[2]);
	putf (asm, ($
	    4x"push ",gl
	    4x"mov eax, "gl
	    4x"cdq"l
	    4x"idiv dword ptr [esp]"l
	    4x"add esp, 4"l
	$, REPR src, REPR dst));
	discard (result[2]);
	IF NOT direct result THEN
	    emit move(dst, result[1])
	FI
    ELIF op = "mul" THEN
	putf (asm, ($4x"imul "g", "gl$, REPR dst, REPR src))
    ELSE
	putf (asm, ($4xgxg", "gl$, op, REPR dst, REPR src))
    FI;
    discard (src); dst
END;

PROC emit mon = (STRING op, LOCATION dst)LOCATION:
IF op = "not" THEN
    putf (asm, ($
	4x"xor "g", 1"l
    $, REPR dst));
    dst
ELSE
    putf (asm, ($
	4xgxgl
    $, op, REPR dst));
    dst
FI;

PROC emit cmp = (STRING op, LOCATION dst,src)LOCATION:
BEGIN
    emit bin ("cmp", dst, src);
    discard (dst);
    FLAGS(op, ~)
END;

OP REPR = (LOCATION mem)STRING:
    CASE mem IN
	(IMMEDIATE imm): whole(val OF imm,0),
	(LABEL str): "dword ptr ["+str+"]",
	(REGISTER reg): mnemonic OF reg table[reg],
	(INDIRECT ind): 
	    IF base OF ind = 7 THEN
		"dword ptr [esp+" + whole((offset OF ind-stack counter)*4,0) + "]"
	    ELSE
		"dword ptr [" + mnemonic OF reg table[base OF ind] + "+" + whole(offset OF ind*4,0) + "]"
	    FI,
	(FLAGS flag): (fatal error("condition has no representation: "+cond OF flag); ~)
    ESAC;

PROC denote parameter = (INT i)LOCATION:
    INDIRECT(ebp, 2+(arg counter-i));
PROC denote local var = (INT i)LOCATION:
    INDIRECT(ebp, -i);
PROC denote global var = (STRING name)LOCATION:
    LABEL("V"+name);
PROC denote int = (INT val)LOCATION:
    IMMEDIATE(val,~);
PROC denote fun result = REGISTER:
    REGISTER(num tempor);

INT label counter := 0;

PROC obtain label = LABEL:
    whole(label counter+:=1,0);

PROC obtain heap = REGISTER:
BEGIN
    REGISTER hnd = obtain temporary;
    reserve register (num tempor);
    putf (asm, ($
	4x"call getmem"l
	4x"mov "g", eax"l
    $, REPR hnd));
    discard (num tempor);
    hnd
END;

INT temp counter := -1;

PROC reserve register = (REGISTER n)VOID:
BEGIN
    5DEBUG (VOID: print (("pre:",reg table, new line)));
    IF usage OF reg table[n] > 0 THEN
	putf (asm, ($4x"push "gl$, mnemonic OF reg table[n]))
    FI;
    usage OF reg table[n] +:= 1;
    5DEBUG (VOID: print (("pst:",reg table, new line)))
END;

PROC obtain temporary = REGISTER:
BEGIN
    INT n = temp counter := (temp counter+1) MOD num tempor;
    reserve register (n);
    n
END;

PROC discard = (LOCATION tmp)VOID:
CASE tmp IN
(REGISTER reg): 
    IF usage OF reg table[reg] > 0 THEN
	IF (usage OF reg table[reg]-:= 1) > 0 THEN
	    putf (asm, ($4x"pop "gl$, mnemonic OF reg table[reg]))
	FI
    FI,
(INDIRECT ind):
    discard (base OF ind)
ESAC;