Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Portage Alpha-Linux 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1672 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 1997-07-30 01:12:19 +00:00
parent 356a4ffb49
commit 64d8dd8c42
7 changed files with 120 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
asmcomp/alpha/emit.mlp
View File

@ -25,14 +25,6 @@ open Mach
open Linearize
open Emitaux
(* Determine if a function label is defined in the current compilation
unit *)
let is_local s =
let cu = Compilenv.current_unit_name() in
let lcu = String.length cu in
String.length s >= lcu + 1 && String.sub s 0 lcu = cu && s.[lcu] = '.'
(* First pass: insert Iloadgp instructions where needed *)
let instr_copy i next =
@ -65,11 +57,11 @@ let insert_load_gp f =
| Lop(Iconst_float s) -> true (* turned into ldq ($gp) *)
| Lop(Iconst_symbol s) -> true (* turned into ldq ($gp) *)
| Lop(Icall_ind) -> false (* does ldgp if needed afterwards *)
| Lop(Icall_imm s) -> (* loads $27 from ($gp) if external *)
not (is_local s)
| Lop(Icall_imm s) -> true (* loads $27 from ($gp) if external, *)
(* and assume $gp set if internal *)
| Lop(Itailcall_ind) -> false
| Lop(Itailcall_imm s) -> (* loads $27 from ($gp) *)
s <> f.fun_name && not(is_local s)
| Lop(Itailcall_imm s) -> true (* loads $27 from ($gp) if external *)
(* and assume $gp set if internal *)
| Lop(Iextcall(_, _)) -> true (* loads $27 from ($gp) *)
| Lop(Iload(_, Ibased(_, _))) -> true (* loads address from ($gp) *)
| Lop(Istore(_, Ibased(_, _))) -> true (* loads address from ($gp) *)
@ -127,9 +119,9 @@ let insert_load_gp f =
(new_instr, instr_needs_gp needs_next i.desc)
end in
{ fun_body = insert_reload_gp f.fun_body;
fun_name = f.fun_name;
fun_fast = f.fun_fast }
let (new_body, uses_gp) = insert_reload_gp f.fun_body in
({fun_body = new_body; fun_name = f.fun_name; fun_fast = f.fun_fast},
uses_gp)
(* Second pass: code generation proper *)
@ -206,7 +198,7 @@ let int_reg_number = [|
let float_reg_number = [|
0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15;
16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29
16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 29; 30
|]
let liveregs instr extra_msk =
@ -267,6 +259,13 @@ let emit_frame fd =
fd.fd_live_offset;
` .align 3\n`
(* Work around a bug in gas regarding the parsing of long decimal constants *)
let emit_nativeint =
if digital_asm
then Emitaux.emit_nativeint
else (fun n -> emit_string(Nativeint.to_hexa_string n))
(* Record calls to the GC -- we've moved them out of the way *)
type gc_call =
@ -340,6 +339,14 @@ let name_for_float_comparison cmp neg =
| Cle -> ("cmptle", false, neg) | Cgt -> ("cmptlt", true, neg)
| Clt -> ("cmptlt", false, neg) | Cge -> ("cmptle", true, neg)
(* Determine if a function label is defined in the current compilation
unit *)
let is_local s =
let cu = Compilenv.current_unit_name() in
let lcu = String.length cu in
String.length s >= lcu + 1 && String.sub s 0 lcu = cu && s.[lcu] = '.'
(* Local entry points for functions defined in the current compilation unit *)
let local_entry_points = (Hashtbl.create 19 : (string, label) Hashtbl.t)
@ -365,6 +372,8 @@ let function_name = ref ""
let tailrec_entry_point = ref 0
(* Label of trap for out-of-range accesses *)
let range_check_trap = ref 0
(* List of floating-point literals (fon non-Digital assemblers) *)
let float_constants = ref ([] : (label * string) list)
let emit_instr i =
match i.desc with
@ -397,7 +406,16 @@ let emit_instr i =
else
` ldiq {emit_reg i.res.(0)}, {emit_nativeint n}\n`
| Lop(Iconst_float s) ->
` ldit {emit_reg i.res.(0)}, {emit_string s}\n`
if digital_asm then
` ldit {emit_reg i.res.(0)}, {emit_string s}\n`
else if float_of_string s = 0.0 then
` fmov $f31, {emit_reg i.res.(0)}\n`
else begin
let lbl = new_label() in
float_constants := (lbl, s) :: !float_constants;
` lda $25, {emit_label lbl}\n`;
` ldt {emit_reg i.res.(0)}, 0($25)\n`
end
| Lop(Iconst_symbol s) ->
` lda {emit_reg i.res.(0)}, {emit_symbol s}\n`
| Lop(Icall_ind) ->
@ -477,7 +495,12 @@ let emit_instr i =
gc_return_lbl = lbl_redo;
gc_frame = lbl_frame;
gc_instr = i } :: !call_gc_sites;
`{emit_label lbl_redo}: subq $13, {emit_int n}, $13\n`;
if is_immediate n then
`{emit_label lbl_redo}: subq $13, {emit_int n}, $13\n`
else begin
`{emit_label lbl_redo}: ldiq $25, {emit_int n}\n`;
` subq $13, $25, $13\n`
end;
` cmpult $13, $14, $25\n`;
` bne $25, {emit_label lbl_call_gc}\n`;
` addq $13, 8, {emit_reg i.res.(0)}\n`
@ -513,7 +536,7 @@ let emit_instr i =
if is_immediate n then
` addq {emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n`
else begin
` ldiq $25, {emit_int n}\n`;
` ldiq $25, {emit_int(n-1)}\n`;
` addq {emit_reg i.arg.(0)}, $25, $25\n`
end;
` cmovge {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}, $25\n`;
@ -521,10 +544,10 @@ let emit_instr i =
| Lop(Iintop_imm(Imod, n)) when n = 1 lsl (Misc.log2 n) ->
let l = Misc.log2 n in
if is_immediate n then
` and {emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n`;
` and {emit_reg i.arg.(0)}, {emit_int(n-1)}, $25\n`
else begin
` ldiq $25, {emit_int n}\n`;
` and {emit_reg i.arg.(0)}, $25, $25\n`;
` ldiq $25, {emit_int (n-1)}\n`;
` and {emit_reg i.arg.(0)}, $25, $25\n`
end;
` subq $25, {emit_int n}, $24\n`;
` cmovge {emit_reg i.arg.(0)}, $25, $24\n`;
@ -550,17 +573,21 @@ let emit_instr i =
let instr = name_for_float_operation op in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
| Lop(Ifloatofint) ->
` .set noat\n`;
` lda $sp, -8($sp)\n`;
` stq {emit_reg i.arg.(0)}, 0($sp)\n`;
` ldt $f30, 0($sp)\n`;
` cvtqt $f30, {emit_reg i.res.(0)}\n`;
` lda $sp, 8($sp)\n`
` ldt $f28, 0($sp)\n`;
` cvtqt $f28, {emit_reg i.res.(0)}\n`;
` lda $sp, 8($sp)\n`;
` .set at\n`
| Lop(Iintoffloat) ->
` .set noat\n`;
` lda $sp, -8($sp)\n`;
` cvttqc {emit_reg i.arg.(0)}, $f30\n`;
` stt $f30, 0($sp)\n`;
` cvttqc {emit_reg i.arg.(0)}, $f28\n`;
` stt $f28, 0($sp)\n`;
` ldq {emit_reg i.res.(0)}, 0($sp)\n`;
` lda $sp, 8($sp)\n`
` lda $sp, 8($sp)\n`;
` .set at\n`
| Lop(Ispecific(Ireloadgp marked_r26)) ->
if marked_r26 then begin
` bic $26, 1, $26\n`;
@ -608,14 +635,16 @@ let emit_instr i =
else
` beq $25, {emit_label lbl}\n`
| Ifloattest(cmp, neg) ->
` .set noat\n`;
let (comp, swap, test) = name_for_float_comparison cmp neg in
` {emit_string comp} `;
if swap
then `{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, $f30\n`
else `{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $f30\n`;
then `{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, $f28\n`
else `{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $f28\n`;
if test
then ` fbeq $f30, {emit_label lbl}\n`
else ` fbne $f30, {emit_label lbl}\n`
then ` fbeq $f28, {emit_label lbl}\n`
else ` fbne $f28, {emit_label lbl}\n`;
` .set at\n`
| Ioddtest ->
` blbs {emit_reg i.arg.(0)}, {emit_label lbl}\n`
| Ieventest ->
@ -681,6 +710,7 @@ let emit_fundecl (fundecl, needs_gp) =
stack_offset := 0;
call_gc_sites := [];
range_check_trap := 0;
float_constants := [];
` .text\n`;
` .align 4\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
@ -715,7 +745,14 @@ let emit_fundecl (fundecl, needs_gp) =
` br $25, call_array_bound_error\n`
(* Keep retaddr in $25 for debugging *)
end;
` .end {emit_symbol fundecl.fun_name}\n`
` .end {emit_symbol fundecl.fun_name}\n`;
if !float_constants <> [] then begin
` .section .rodata\n`;
` .align 3\n`;
List.iter
(fun (lbl, s) -> `{emit_label lbl}: .t_floating {emit_string s}\n`)
!float_constants
end
let fundecl f =
emit_fundecl (insert_load_gp f)
@ -794,7 +831,11 @@ let end_assembly () =
`{emit_symbol lbl_end}:\n`;
` .quad 0\n`;
let lbl_frame = Compilenv.current_unit_name() ^ "_frametable" in
` .rdata\n`;
begin match Config.system with
"digital" -> ` .rdata\n`
| "linux" -> ` .section .rodata\n`
| _ -> assert false
end;
` .globl {emit_symbol lbl_frame}\n`;
`{emit_symbol lbl_frame}:\n`;
` .quad {emit_int (List.length !frame_descriptors)}\n`;

15
asmcomp/alpha/proc.ml
View File

@ -39,8 +39,8 @@ let word_addressed = true
$f0 - $f7 100 - 107 function results
$f8 - $f15 108 - 115 general purpose ($f2 - $f9 preserved by C)
$f16 - $f23 116 - 123 function arguments
$f24 - $f29 124 - 129 general purpose
$f30 temporary
$f24 - $f30 124 - 129 general purpose
$f28 temporary
$f31 always zero *)
let int_reg_name = [|
@ -53,7 +53,7 @@ let float_reg_name = [|
(* 100-107 *) "$f0"; "$f1"; "$f2"; "$f3"; "$f4"; "$f5"; "$f6"; "$f7";
(* 108-115 *) "$f8"; "$f9"; "$f10"; "$f11"; "$f12"; "$f13"; "$f14"; "$f15";
(* 116-123 *) "$f16"; "$f17"; "$f18"; "$f19"; "$f20"; "$f21"; "$f22"; "$f23";
(* 124-129 *) "$f24"; "$f25"; "$f26"; "$f27"; "$f28"; "$f29"
(* 124-129 *) "$f24"; "$f25"; "$f26"; "$f27"; "$f29"; "$f30"
|]
let num_register_classes = 2
@ -204,6 +204,11 @@ let contains_calls = ref false
(* Calling the assembler *)
let assemble_file infile outfile =
Ccomp.command ("as -O2 -nocpp -o " ^ outfile ^ " " ^ infile)
let as_cmd =
if digital_asm
then "as -O2 -nocpp -o "
else "as -o "
let assemble_file infile outfile =
Ccomp.command (as_cmd ^ outfile ^ " " ^ infile)

10
asmcomp/alpha/scheduling.ml
View File

@ -11,6 +11,7 @@
(* $Id$ *)
open Arch
open Mach
(* The Digital Unix assembler does scheduling better than us.
@ -27,7 +28,7 @@ method oper_latency = function
Ireload -> 3
| Iload(_, _) -> 3
| Iconst_symbol _ -> 3 (* turned into a load *)
| Iconst_float _ -> 3 (* turned into a load *)
| Iconst_float _ -> 3 (* ends up in a load *)
| Iintop(Imul) -> 23
| Iintop_imm(Imul, _) -> 23
| Iaddf -> 6
@ -43,7 +44,8 @@ method oper_latency = function
(* Issue cycles. Rough approximations. *)
method oper_issue_cycles = function
Ialloc _ -> 4
Iconst_float _ -> 4 (* load from $gp, then load *)
| Ialloc _ -> 4
| Iintop(Icheckbound) -> 2
| Iintop_imm(Idiv, _) -> 3
| Iintop_imm(Imod, _) -> 5
@ -62,6 +64,6 @@ method oper_in_basic_block = function
end
let fundecl =
if Arch.digital_asm
if digital_asm
then (fun f -> f)
else (new scheduler ())#fundecl
else (new scheduler ())#schedule_fundecl

4
asmcomp/alpha/selection.ml
View File

@ -27,10 +27,10 @@ method is_immediate n = digital_asm || (n >= 0 && n <= 255)
method select_addressing = function
(* Force an explicit lda for non-scheduling assemblers,
this allows our scheduler to do a better job of it. *)
this allows our scheduler to do a better job. *)
Cconst_symbol s when digital_asm ->
(Ibased(s, 0), Ctuple [])
| Cop(Cadda, [Cconst_symbol s; Cconst_int n]) ->
| Cop(Cadda, [Cconst_symbol s; Cconst_int n]) when digital_asm ->
(Ibased(s, n), Ctuple [])
| Cop(Cadda, [arg; Cconst_int n]) ->
(Iindexed n, arg)

4
asmcomp/schedgen.ml
View File

@ -231,15 +231,15 @@ method reschedule ready_queue date cont =
(* Update the start date and number of ancestors emitted of
all descendents of this node. Enter those that become ready
in the queue. *)
let issue_cycles = self#instr_issue_cycles node.instr in
List.iter
(fun (son, delay) ->
let completion_date = date + delay in
let completion_date = date + issue_cycles + delay - 1 in
if son.date < completion_date then son.date <- completion_date;
son.emitted_ancestors <- son.emitted_ancestors + 1;
if son.emitted_ancestors = son.ancestors then
new_queue := son :: !new_queue)
node.sons;
let issue_cycles = self#instr_issue_cycles node.instr in
instr_cons node.instr.desc node.instr.arg node.instr.res
(self#reschedule !new_queue (date + issue_cycles) cont)
end

16
asmrun/alpha.S
View File

@ -59,8 +59,8 @@
stt $f25, 25 * 8 ($24); \
stt $f26, 26 * 8 ($24); \
stt $f27, 27 * 8 ($24); \
stt $f28, 28 * 8 ($24); \
stt $f29, 29 * 8 ($24)
stt $f29, 29 * 8 ($24); \
stt $f30, 30 * 8 ($24)
#define LOAD_ALL_REGS \
lda $24, gc_entry_regs; \
@ -105,8 +105,8 @@
ldt $f25, 25 * 8 ($24); \
ldt $f26, 26 * 8 ($24); \
ldt $f27, 27 * 8 ($24); \
ldt $f28, 28 * 8 ($24); \
ldt $f29, 29 * 8 ($24)
ldt $f29, 29 * 8 ($24); \
ldt $f30, 30 * 8 ($24)
/* Allocation */
@ -424,12 +424,16 @@ callback3:
.ent call_array_bound_error
.align 3
call_array_bound_error:
br $27, $109
$109: ldgp $gp, 0($27)
br $27, $111
$111: ldgp $gp, 0($27)
jsr array_bound_error /* never returns */
.end call_array_bound_error
#ifdef SYS_digital
.rdata
#else
.section .rodata
#endif
.globl system_frametable
system_frametable:
.quad 1 /* one descriptor */

27
configure vendored
View File

@ -207,7 +207,8 @@ model=default
system=unknown
case "$host" in
alpha-*-osf*) arch=alpha;;
alpha-*-osf*) arch=alpha; system=digital;;
alpha-*-linux*) arch=alpha; system=linux;;
sparc-*-sunos4.*) arch=sparc; system=sunos;;
sparc-*-solaris2.*) arch=sparc; system=solaris;;
sparc-*-*bsd*) arch=sparc; system=bsd;;
@ -227,8 +228,9 @@ case "$host" in
m68k-*-sunos*) arch=m68k; system=sunos;;
esac
case "$arch" in
alpha|mips) nativecc=cc;;
case "$arch,$system" in
alpha,digital) nativecc=cc;;
mips,*) nativecc=cc;;
*) nativecc="$bytecc";;
esac
@ -236,13 +238,13 @@ nativecccompopts=''
nativecclinkopts=''
case "$arch,$nativecc,$system" in
alpha,cc,*) nativecccompopts=-std1;;
mips,cc,irix) nativecccompopts=-32
nativecclinkopts="-32 -Wl,-woff,84";;
mips,cc,ultrix) nativecccompopts=-std;;
*,*,nextstep) nativecccompopts="-Wall -U__GNUC__ -posix"
nativecclinkopts="-posix";;
*,gcc,*) nativecccompopts=-Wall;;
alpha,cc,digital) nativecccompopts=-std1;;
mips,cc,irix) nativecccompopts=-32
nativecclinkopts="-32 -Wl,-woff,84";;
mips,cc,ultrix) nativecccompopts=-std;;
*,*,nextstep) nativecccompopts="-Wall -U__GNUC__ -posix"
nativecclinkopts="-posix";;
*,gcc,*) nativecccompopts=-Wall;;
esac
asflags=''
@ -250,7 +252,8 @@ aspp='$(AS)'
asppflags=''
case "$arch,$model,$system" in
alpha,*,*) asflags='-O2'; asppflags="$asflags";;
alpha,*,digital) asflags='-O2'; asppflags='-O2 -DSYS_$(SYSTEM)';;
alpha,*,linux) aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
mips,*,irix) asflags='-32 -O2'; asppflags="$asflags";;
mips,*,ultrix) asflags='-O2'; asppflags="$asflags";;
sparc,*,bsd) aspp='gcc'; asppflags='-c -DSYS_$(SYSTEM)';;
@ -537,7 +540,7 @@ fi
case "$host" in
mips-*-ultrix*) bignum_arch=mips;;
alpha*) bignum_arch=alpha;;
alpha-*-osf*) bignum_arch=alpha;;
i960*) bignum_arch=i960;;
sparc-*-sunos*) bignum_arch=supersparc;;
sparc-*-solaris*) bignum_arch=supersparc-solaris;;