## convert-nextcode-fun-args-to-treecode-g.pkg --- parameter passing convention for standard and known functions.
# Compiled by:
# src/lib/compiler/core.sublib### "Thomas Godfrey, a self-taught mathematician,
### great in his way . . . knew little out of
### his way, and was not a pleasing companion;
### as, like most great mathematicians I have met with,
### he expected universal precision in everything said,
### or was forever denying or distinguishing upon trifles,
### to the disturbance of all conversation."
###
### -- Benjamin Franklin (1706-1790), Autobiography
# We are invoked from:
#
# src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg # Machine_Properties is from src/lib/compiler/back/low/main/main/machine-properties.apistipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package ncf = nextcode_form; # nextcode_form is from src/lib/compiler/back/top/nextcode/nextcode-form.pkgherein
# This generic is invoked (only) in:
#
# src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg #
generic package convert_nextcode_fun_args_to_treecode_g (
# =======================================
#
package pri: Platform_Register_Info; # Platform_Register_Info is from src/lib/compiler/back/low/main/nextcode/platform-register-info.api # platform_register_info_intel32 is from src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg # platform_register_info_pwrpw32 is from src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg # platform_register_info_sparc32 is from src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg # machine_properties_intel32 is from src/lib/compiler/back/low/main/intel32/machine-properties-intel32.pkg package mp: Machine_Properties; # Machine_Properties is from src/lib/compiler/back/low/main/main/machine-properties.api )
: (weak) Convert_Nextcode_Fun_Args_To_Treecode # Convert_Nextcode_Fun_Args_To_Treecode is from src/lib/compiler/back/low/main/nextcode/convert-nextcode-fun-args-to-treecode.api {
# Export to client packages:
#
package tcf = pri::tcf; # "tcf" == "treecode_form".
stipulate
fun error msg
=
err::impossible ("ArgPassing." + msg);
fun stdlink use_virtual_framepointer = tcf::INT_EXPRESSION (pri::stdlink use_virtual_framepointer);
fun stdclos use_virtual_framepointer = tcf::INT_EXPRESSION (pri::stdclos use_virtual_framepointer);
fun stdarg use_virtual_framepointer = tcf::INT_EXPRESSION (pri::stdarg use_virtual_framepointer);
fun stdfate use_virtual_framepointer = tcf::INT_EXPRESSION (pri::stdfate use_virtual_framepointer);
fun gpregs use_virtual_framepointer
#
= stdlink use_virtual_framepointer # vreg 0 on Intel32.
! stdclos use_virtual_framepointer # vreg 1 on Intel32.
! stdarg use_virtual_framepointer # epb on Intel32.
! stdfate use_virtual_framepointer # esi on Intel32.
! map tcf::INT_EXPRESSION pri::miscregs # On Intel32, miscregs = { ebx, ecx, edx, r10, r11, ... r31 }
;
fpregs
=
map tcf::FLOAT_EXPRESSION (pri::savedfpregs @ pri::floatregs);
fun fromto (i, j, regs) # fromto(i,j,[x0,x1,...xn]) returns [xi,...,xj] (or [xi,...xn] if n<j).
=
to (i, from (i, regs))
where
fun from (0, xs) => xs; # from(i,list) drops first 'i' elements from list and returns the rest -- error if not enough elements to do so.
from (n, x ! xs) => from (n - 1, xs);
from (n, [] ) => error "fromto";
end;
fun to (k, r ! rs) => if (k <= j) r ! to (k+1, rs); # to(k,list) returns first j-k elements from list, or as many as possible
else [];
fi;
to (k, [] ) => [];
end;
end;
fun gprfromto (i, j, use_virtual_framepointer) = fromto (i, j, gpregs use_virtual_framepointer);
fun fprfromto (i, j, use_virtual_framepointer) = fromto (i, j, fpregs);
fun calleesaveregs use_virtual_framepointer
=
gprfromto (4, mp::num_callee_saves + 3, use_virtual_framepointer) @
fprfromto (0, mp::num_float_callee_saves - 1, use_virtual_framepointer);
fun drop_first_n_from_list (n, l) # This looks identical to from() above, up to error text.
=
if (n == 0)
#
l;
else
case l
#
a ! r => drop_first_n_from_list (n - 1, r);
_ => error "coder cuthead 444";
esac;
fi;
stipulate
fun is_float ncf::typ::FLOAT64 => TRUE;
is_float _ => FALSE;
end;
herein
fun scan (t ! z, gp, fp)
=>
if (is_float t) (head fp) ! (scan (z, gp, tail fp));
else (head gp) ! (scan (z, tail gp, fp));
fi;
scan ([], _, _)
=>
[];
end;
end;
fun standard_escape (use_virtual_framepointer, args) # Used whenever ncftype_for_fun != ncf::typ::FATE
=
{ rest = drop_first_n_from_list (mp::num_callee_saves + mp::num_float_callee_saves + 3, args);
len = length args;
gpr = stdarg use_virtual_framepointer
! gprfromto (mp::num_callee_saves+4, len, use_virtual_framepointer)
;
fpr = fprfromto (mp::num_float_callee_saves, len, use_virtual_framepointer);
stdlink use_virtual_framepointer
! stdclos use_virtual_framepointer
! stdfate use_virtual_framepointer
! calleesaveregs use_virtual_framepointer
@ scan (rest, gpr, fpr)
;
};
fun standard_cont (use_virtual_framepointer, args) # Used (only) when ncftype_for_fun == ncf::typ::FATE
=
{ rest = if (mp::num_callee_saves > 0) drop_first_n_from_list (mp::num_callee_saves + mp::num_float_callee_saves + 1, args);
else drop_first_n_from_list ( 2, args);
fi;
len = length args;
gpr = stdarg use_virtual_framepointer ! gprfromto (mp::num_callee_saves+4, 1+len, use_virtual_framepointer);
fpr = fprfromto (mp::num_float_callee_saves, len, use_virtual_framepointer);
if (mp::num_callee_saves > 0) stdfate use_virtual_framepointer ! (calleesaveregs use_virtual_framepointer @ scan (rest, gpr, fpr));
else stdlink use_virtual_framepointer ! (stdfate use_virtual_framepointer ! scan (rest, gpr, fpr));
fi;
};
herein
# This fun is called (only) from:
#
# src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg #
fun convert_nextcode_public_fun_args_to_treecode { use_virtual_framepointer, ncftypes_for_args, ncftype_for_fun => ncf::typ::FATE } # This is one of our two external entrypoints.
=>
standard_cont (use_virtual_framepointer, ncftypes_for_args);
convert_nextcode_public_fun_args_to_treecode { use_virtual_framepointer, ncftypes_for_args, ... } # Empirically, ncftype_for_fun is either FUN or (POINTER VPT) here.
=>
standard_escape (use_virtual_framepointer, ncftypes_for_args);
end;
# Use an arbitrary but fixed set of registers.
#
# This fun is called (only) from:
#
# src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg #
fun convert_fixed_nextcode_fun_args_to_treecode { use_virtual_framepointer, ncftypes_for_args } # This is the other of our two external entrypoints.
=
iter (ncftypes_for_args, gpregs use_virtual_framepointer, fpregs)
where
fun iter (ncf::typ::FLOAT64 ! rest, regs, f ! fregs)
=>
f ! iter (rest, regs, fregs);
iter (_ ! rest, r ! regs, fregs)
=>
r ! iter (rest, regs, fregs);
iter ([], _, _)
=>
[];
iter _
=>
error "fixed: out of registers";
end;
end;
end; # stipulate
}; # generic package convert_nextcode_fun_args_to_treecode_g
end; # stipulate
## COPYRIGHT (c) 1996 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.