Suite portage HPUX
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@890 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Xavier Leroy
parent
49f06f5d9f
commit
54de7f5567
|
|
@ -85,8 +85,8 @@ let emit_reg r =
|
|||
|
||||
(* Output low address / high address prefixes *)
|
||||
|
||||
let low_prefix = if hpux then "RR'" else "R`"
|
||||
let high_prefix = if hpux then "LR'" else "L`"
|
||||
let low_prefix = if hpux then "RR'" else "R\`"
|
||||
let high_prefix = if hpux then "LR'" else "L\`"
|
||||
|
||||
let emit_int_low n = emit_string low_prefix; emit_int n
|
||||
let emit_int_high n = emit_string high_prefix; emit_int n
|
||||
|
|
@ -106,7 +106,7 @@ let load_symbol_offset_high s ofs =
|
|||
then ` addil LR'{emit_symbol s}-$global$+{emit_int ofs}, %r27\n`
|
||||
else ` ldil L\`{emit_symbol s}+{emit_int ofs}, %r1\n`
|
||||
|
||||
(* Record imported symbols *)
|
||||
(* Record imported and defined symbols *)
|
||||
|
||||
let used_symbols = ref StringSet.empty
|
||||
let defined_symbols = ref StringSet.empty
|
||||
|
|
@ -115,7 +115,7 @@ let called_symbols = ref StringSet.empty
|
|||
let use_symbol s =
|
||||
if hpux then used_symbols := StringSet.add s !used_symbols
|
||||
let define_symbol s =
|
||||
if hpux then defined_symbols := StringSet.add s !defined_symbols
|
||||
defined_symbols := StringSet.add s !defined_symbols
|
||||
let call_symbol s =
|
||||
if hpux then begin
|
||||
used_symbols := StringSet.add s !used_symbols;
|
||||
|
|
@ -129,8 +129,8 @@ let emit_import s =
|
|||
if not(StringSet.mem s !defined_symbols) then begin
|
||||
` .import {emit_symbol s}`;
|
||||
if StringSet.mem s !called_symbols or s.[0] < 'A' or s.[0] > 'Z'
|
||||
then `, CODE\n`
|
||||
else `, DATA\n`
|
||||
then `, code\n`
|
||||
else `, data\n`
|
||||
end
|
||||
|
||||
let emit_imports () =
|
||||
|
|
@ -289,19 +289,14 @@ let emit_frame fd =
|
|||
let float_constants = ref ([] : (int * string) list)
|
||||
|
||||
let emit_float_constant (lbl, cst) =
|
||||
if hpux then begin
|
||||
` .SPACE $TEXT$\n`;
|
||||
` .SUBSPA $LIT$\n`
|
||||
end else begin
|
||||
` .literal8\n`
|
||||
end;
|
||||
if hpux
|
||||
then ` .lit\n`
|
||||
else ` .literal8\n`;
|
||||
emit_align 8;
|
||||
`{emit_label lbl}: .double {emit_string cst}\n`
|
||||
|
||||
(* Record external calls and generate stub code for these *)
|
||||
|
||||
let defined_functions = ref StringSet.empty
|
||||
|
||||
let stub_label_table = (Hashtbl.create 19 : (string, int) Hashtbl.t)
|
||||
|
||||
let stub_label symb =
|
||||
|
|
@ -323,16 +318,16 @@ let emit_stubs () =
|
|||
|
||||
(* Output a function call *)
|
||||
|
||||
let emit_call symbol retref =
|
||||
let emit_call s retreg =
|
||||
if hpux then begin
|
||||
` .CALL\n`;
|
||||
` .call\n`;
|
||||
` bl {emit_symbol s}, {emit_string retreg}\n`;
|
||||
call_symbol symbol
|
||||
call_symbol s
|
||||
end else
|
||||
if StringSet.mem s !defined_functions then
|
||||
if StringSet.mem s !defined_symbols then
|
||||
` bl {emit_symbol s}, {emit_string retreg}\n`
|
||||
else begin
|
||||
let lbl = stub_label symbol in
|
||||
let lbl = stub_label s in
|
||||
` jbsr {emit_symbol s}, {emit_string retreg}, {emit_label lbl}\n`
|
||||
end
|
||||
|
||||
|
|
@ -465,7 +460,7 @@ let rec emit_instr i dslot =
|
|||
end else begin
|
||||
if !contains_calls then
|
||||
` ldw {emit_int(-n)}(%r30), %r2\n`;
|
||||
emit_call s "%r0";
|
||||
emit_call s "%r0"
|
||||
end
|
||||
| Lop(Iextcall(s, alloc)) ->
|
||||
if alloc then begin
|
||||
|
|
@ -646,7 +641,7 @@ let rec emit_instr i dslot =
|
|||
as the return address may come from a tailcall. *)
|
||||
` depi 0, 0, 1, %r2\n`;
|
||||
` bv 0(%r2)\n`;
|
||||
` ldo {emit_int(-n)}(%r30), %r30\n`
|
||||
` ldo {emit_int(-n)}(%r30), %r30\n` (* in delay slot *)
|
||||
| Llabel lbl ->
|
||||
`{emit_label lbl}:\n`
|
||||
| Lbranch lbl ->
|
||||
|
|
@ -786,21 +781,20 @@ let fundecl fundecl =
|
|||
tailrec_entry_point := new_label();
|
||||
stack_offset := 0;
|
||||
float_constants := [];
|
||||
defined_functions := StringSet.add fundecl.fun_name !defined_functions;
|
||||
define_symbol fundecl.fun_name;
|
||||
range_check_trap := 0;
|
||||
let n = frame_size() in
|
||||
if hpux then begin
|
||||
` .SPACE $TEXT$\n`;
|
||||
` .SUBSPA $CODE$\n`;
|
||||
` .code\n`;
|
||||
` .align 4\n`;
|
||||
` .EXPORT {emit_symbol fundecl.fun_name}, ENTRY, PRIV_LEV=3\n`;
|
||||
` .export {emit_symbol fundecl.fun_name}, ENTRY, PRIV_LEV=3\n`;
|
||||
`{emit_symbol fundecl.fun_name}:\n`;
|
||||
` .PROC\n`;
|
||||
` .proc\n`;
|
||||
if !contains_calls then
|
||||
` .CALLINFO FRAME={emit_int n}, CALLS, SAVE_RP\n`
|
||||
` .callinfo frame={emit_int n}, calls, save_rp\n`
|
||||
else
|
||||
` .CALLINFO FRAME={emit_int n}, NO_CALLS\n`;
|
||||
` .ENTRY\n`
|
||||
` .callinfo frame={emit_int n}, no_calls\n`;
|
||||
` .entry\n`
|
||||
end else begin
|
||||
` .text\n`;
|
||||
` .align 2\n`;
|
||||
|
|
@ -824,16 +818,22 @@ let fundecl fundecl =
|
|||
end
|
||||
end;
|
||||
if hpux then begin
|
||||
` .EXIT\n`;
|
||||
` .PROCEND\n`
|
||||
` .exit\n`;
|
||||
` .procend\n`
|
||||
end;
|
||||
List.iter emit_float_constant !float_constants
|
||||
|
||||
(* Emission of data *)
|
||||
|
||||
let emit_global s =
|
||||
define_symbol s;
|
||||
if hpux
|
||||
then ` .export {emit_symbol s}, data\n`
|
||||
else ` .globl {emit_symbol s}\n`
|
||||
|
||||
let emit_item = function
|
||||
Cdefine_symbol s ->
|
||||
` .globl {emit_symbol s}\n`;
|
||||
emit_global s;
|
||||
`{emit_symbol s}:\n`
|
||||
| Cdefine_label lbl ->
|
||||
`{emit_label (lbl + 10000)}:\n`
|
||||
|
|
@ -867,7 +867,7 @@ let emit_item = function
|
|||
| Cskip n ->
|
||||
if n > 0 then ` .space {emit_int n}\n`
|
||||
| Calign n ->
|
||||
` .align {emit_int(Misc.log2 n)}\n`
|
||||
emit_align n
|
||||
|
||||
let data l =
|
||||
` .data\n`;
|
||||
|
|
@ -876,23 +876,37 @@ let data l =
|
|||
(* Beginning / end of an assembly file *)
|
||||
|
||||
let begin_assembly() =
|
||||
defined_functions := StringSet.empty;
|
||||
if hpux then begin
|
||||
` .space $PRIVATE$\n`;
|
||||
` .subspa $DATA$,quad=1,align=8,access=31\n`;
|
||||
` .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82\n`;
|
||||
` .space $TEXT$\n`;
|
||||
` .subspa $LIT$,quad=0,align=8,access=44\n`;
|
||||
` .subspa $CODE$,quad=0,align=8,access=44,code_only\n`;
|
||||
` .import $global$, data\n`;
|
||||
` .import $$divI, millicode\n`;
|
||||
` .import $$modI, millicode\n`
|
||||
end;
|
||||
used_symbols := StringSet.empty;
|
||||
defined_symbols := StringSet.empty;
|
||||
called_symbols := StringSet.empty;
|
||||
Hashtbl.clear stub_label_table;
|
||||
let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
|
||||
` .data\n`;
|
||||
` .globl {emit_symbol lbl_begin}\n`;
|
||||
emit_global lbl_begin;
|
||||
`{emit_symbol lbl_begin}:\n`
|
||||
|
||||
let end_assembly() =
|
||||
emit_stubs();
|
||||
` .data\n`;
|
||||
let lbl_end = Compilenv.current_unit_name() ^ "_end" in
|
||||
` .globl {emit_symbol lbl_end}\n`;
|
||||
emit_global lbl_end;
|
||||
`{emit_symbol lbl_end}:\n`;
|
||||
` .long 0\n`;
|
||||
let lbl = Compilenv.current_unit_name() ^ "_frametable" in
|
||||
` .globl {emit_symbol lbl}\n`;
|
||||
emit_global lbl;
|
||||
`{emit_symbol lbl}:\n`;
|
||||
` .long {emit_int (List.length !frame_descriptors)}\n`;
|
||||
List.iter emit_frame !frame_descriptors;
|
||||
frame_descriptors := []
|
||||
frame_descriptors := [];
|
||||
if hpux then emit_imports()
|
||||
|
|
|
|||
Loading…
Reference in New Issue