Portage 680x0.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1093 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

7 files changed, 1455 insertions, 0 deletions

diff --git a/asmcomp/arch_m68k.ml b/asmcomp/arch_m68k.ml
new file mode 100644
index 0000000000..3eff0a6e31
--- /dev/null
+++ b/asmcomp/arch_m68k.ml
@@ -0,0 +1,108 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  Automatique.  Distributed only by permission.                      *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Specific operations for the Motorola 68020 processor *)
+
+type addressing_mode =
+    Ibased of string * int              (* symbol + displ *)
+  | Iindexed of int                     (* reg + displ *)
+  | Iindexed2 of int                    (* reg + reg + displ *)
+  | Iscaled of int * int                (* reg * scale + displ *)
+  | Iindexed2scaled of int * int        (* reg + reg * scale + displ *)
+
+type specific_operation =
+    Ilea of addressing_mode             (* Lea gives scaled adds *)
+  | Istore_int of int * addressing_mode (* Store an integer constant *)
+  | Istore_symbol of string * addressing_mode (* Store a symbol *)
+  | Ipush                               (* Push regs on stack *)
+  | Ipush_int of int                    (* Push an integer constant *)
+  | Ipush_symbol of string              (* Push a symbol *)
+  | Ipush_load of addressing_mode       (* Load a scalar and push *)
+  | Ipush_load_float of addressing_mode (* Load a float and push *)
+
+(* Sizes, endianness *)
+
+let big_endian = true
+
+let size_addr = 4
+let size_int = 4
+let size_float = 8
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing addr delta =
+  match addr with
+    Ibased(s, n) -> Ibased(s, n + delta)
+  | Iindexed n -> Iindexed(n + delta)
+  | Iindexed2 n -> Iindexed2(n + delta)
+  | Iscaled(scale, n) -> Iscaled(scale, n + delta)
+  | Iindexed2scaled(scale, n) -> Iindexed2scaled(scale, n + delta)
+
+let num_args_addressing = function
+    Ibased(s, n) -> 0
+  | Iindexed n -> 1
+  | Iindexed2 n -> 2
+  | Iscaled(scale, n) -> 1
+  | Iindexed2scaled(scale, n) -> 2
+
+(* Printing operations and addressing modes *)
+
+open Format
+
+let print_addressing printreg addr arg =
+  match addr with
+    Ibased(s, 0) ->
+      print_string "\""; print_string s; print_string "\""
+  | Ibased(s, n) ->
+      print_string "\""; print_string s; print_string "\" + "; print_int n
+  | Iindexed n ->
+      printreg arg.(0);
+      if n <> 0 then begin print_string " + "; print_int n end
+  | Iindexed2 n ->
+      printreg arg.(0); print_string " + "; printreg arg.(1);
+      if n <> 0 then begin print_string " + "; print_int n end
+  | Iscaled(scale, n) ->
+      printreg arg.(0); print_string " * "; print_int scale;
+      if n <> 0 then begin print_string " + "; print_int n end
+  | Iindexed2scaled(scale, n) ->
+      printreg arg.(0); print_string " + "; printreg arg.(1);
+      print_string " * "; print_int scale;
+      if n <> 0 then begin print_string " + "; print_int n end
+
+let print_specific_operation printreg op arg =
+  match op with
+    Ilea addr -> print_addressing printreg addr arg
+  | Istore_int(n, addr) ->
+      print_string "["; print_addressing printreg addr arg;
+      print_string "] := "; print_int n
+  | Istore_symbol(lbl, addr) ->
+      print_string "["; print_addressing printreg addr arg;
+      print_string "] := \""; print_string lbl; print_string "\""
+  | Ipush ->
+      print_string "push ";
+      for i = 0 to Array.length arg - 1 do
+        if i > 0 then print_string ", ";
+        printreg arg.(i)
+      done
+  | Ipush_int n ->
+      print_string "push "; print_int n
+  | Ipush_symbol s ->
+      print_string "push \""; print_string s; print_string "\""
+  | Ipush_load addr ->
+      print_string "push ["; print_addressing printreg addr arg;
+      print_string "]"
+  | Ipush_load_float addr ->
+      print_string "pushfloat ["; print_addressing printreg addr arg;
+      print_string "]"
diff --git a/asmcomp/emit_m68k.mlp b/asmcomp/emit_m68k.mlp
new file mode 100644
index 0000000000..71ec17dc2a
--- /dev/null
+++ b/asmcomp/emit_m68k.mlp
@@ -0,0 +1,723 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  Automatique.  Distributed only by permission.                      *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Emission of Motorola 68020 assembly code (MIT syntax) *)
+
+open Misc
+open Cmm
+open Arch
+open Proc
+open Reg
+open Mach
+open Linearize
+open Emitaux
+
+(* Tradeoff between code size and code speed *)
+
+let fastcode_flag = ref true
+
+let stack_offset = ref 0
+
+(* Layout of the stack frame *)
+
+let frame_size () =                     (* includes return address *)
+  !stack_offset +
+  4 * (num_stack_slots.(0) + num_stack_slots.(1)) +
+  8 * num_stack_slots.(2) +
+  4 (* return address *)
+
+let slot_offset loc cl =
+  match loc with
+    Incoming n -> frame_size() + n
+  | Local n ->
+      if cl = 0
+      then !stack_offset + n * 4
+      else if cl = 1
+      then !stack_offset + num_stack_slots.(0) * 4 + n * 4
+      else !stack_offset +
+           (num_stack_slots.(0) + num_stack_slots.(1)) * 4 + n * 8
+  | Outgoing n -> n
+
+(* Output a symbol *)
+
+let emit_symbol s =
+  emit_char '_'; Emitaux.emit_symbol '$' s
+
+(* Output a label *)
+
+let emit_label lbl =
+  emit_char 'L'; emit_int lbl
+
+(* Output an align directive *)
+
+let emit_align n =
+  `	.align	{emit_int n}\n`
+
+(* Output a pseudo-register *)
+
+let emit_reg = function
+    { loc = Reg r } ->
+      emit_string (register_name r)
+  | { loc = Stack s } as r ->
+      let ofs = slot_offset s (register_class r) in
+      if ofs = 0
+      then `a7@`
+      else `a7@({emit_int ofs})`
+  | { loc = Unknown } ->
+      fatal_error "Emit_m68k.emit_reg"
+
+(* Check if the given register is an address register *)
+
+let is_address_reg = function { loc = Reg _; typ = Addr } -> true | _ -> false
+
+(* Check if the given register overlaps (same location) with the given
+   array of registers *)
+
+let register_overlap reg arr =
+  try
+    for i = 0 to Array.length arr - 1 do
+      if reg.loc = arr.(i).loc then raise Exit
+    done;
+    false
+  with Exit ->
+    true
+
+(* Output a suffix for a floating-point instruction -- either .x if
+   the argument is a register or .d if it's in memory. *)
+
+let emit_float_size r =
+  match r.loc with
+    Reg _ -> `x`
+  | _ -> `d`
+
+let emit_float_size2 r1 r2 =
+  match (r1.loc, r2.loc) with
+    (Reg _, Reg _) -> `x`
+  | _ -> `d`
+
+(* Output an addressing mode *)
+
+let emit_displacement d =
+  if d <> 0 then `{emit_int d}, `
+
+let emit_addressing addr r n =
+  match addr with
+    Ibased(s, d) ->
+      `{emit_symbol s}`;
+      if d <> 0 then ` + {emit_int d}`
+  | Iindexed d ->
+      `{emit_reg r.(n)}@`;
+      if d <> 0 then `({emit_int d})`
+  | Iindexed2 d ->
+      `{emit_reg r.(n)}@({emit_int d}, {emit_reg r.(n+1)}:l)`
+  | Iscaled(scale, d) ->
+      `@({emit_int d}, {emit_reg r.(n)}:l:{emit_int scale})`
+  | Iindexed2scaled(scale, d) ->
+      `{emit_reg r.(n)}@({emit_int d}, {emit_reg r.(n+1)}:l:{emit_int scale})`
+
+(* Record live pointers at call points *)
+
+type frame_descr =
+  { fd_lbl: int;                        (* Return address *)
+    fd_frame_size: int;                 (* Size of stack frame *)
+    fd_live_offset: int list }          (* Offsets/regs of live addresses *)
+
+let frame_descriptors = ref([] : frame_descr list)
+
+let record_frame_label live =
+  let lbl = new_label() in
+  let live_offset = ref [] in
+  Reg.Set.iter
+    (function
+        {typ = Addr; loc = Reg r} ->
+          live_offset := ((r lsl 1) + 1) :: !live_offset
+      | {typ = Addr; loc = Stack s} as reg ->
+          live_offset := slot_offset s (register_class reg) :: !live_offset
+      | _ -> ())
+    live;
+  frame_descriptors :=
+    { fd_lbl = lbl;
+      fd_frame_size = frame_size();
+      fd_live_offset = !live_offset } :: !frame_descriptors;
+  lbl
+
+let record_frame live =
+  let lbl = record_frame_label live in `{emit_label lbl}:\n`
+
+let emit_frame fd =
+  `	.long	{emit_label fd.fd_lbl}\n`;
+  `	.word	{emit_int fd.fd_frame_size}\n`;
+  `	.word	{emit_int (List.length fd.fd_live_offset)}\n`;
+  List.iter
+    (fun n ->
+      `	.word	{emit_int n}\n`)
+    fd.fd_live_offset;
+  emit_align 4
+
+(* Names for instructions *)
+
+let instr_for_intop = function
+    Iadd -> "addl"
+  | Isub -> "subl"
+  | Imul -> "mulsl"
+  | Idiv -> "divsl"
+  | Iand -> "andl"
+  | Ior -> "orl"
+  | Ixor -> "eorl"
+  | Ilsl -> "lsll"
+  | Ilsr -> "lsrl"
+  | Iasr -> "asrl"
+  | _ -> fatal_error "Emit_m68k: instr_for_intop"
+
+let instr_for_floatop = function
+    Inegf -> "fneg"
+  | Iabsf -> "fabs"
+  | Iaddf -> "fadd"
+  | Isubf -> "fsub"
+  | Imulf -> "fmul"
+  | Idivf -> "fdiv"
+  | _ -> fatal_error "Emit_m68k: instr_for_floatop"
+
+let name_for_cond_branch = function
+    Isigned Ceq -> "eq"    | Isigned Cne -> "ne"
+  | Isigned Cle -> "le"    | Isigned Cgt -> "gt"
+  | Isigned Clt -> "lt"    | Isigned Cge -> "ge"
+  | Iunsigned Ceq -> "eq"  | Iunsigned Cne -> "ne"
+  | Iunsigned Cle -> "ls"  | Iunsigned Cgt -> "hi"
+  | Iunsigned Clt -> "cs"  | Iunsigned Cge -> "cc"
+    
+let name_for_float_cond_branch cond neg =
+  match cond with
+    Ceq -> if neg then "ne" else "eq"
+  | Cne -> if neg then "eq" else "ne"
+  | Cle -> if neg then "ugt" else "ole"
+  | Cgt -> if neg then "ule" else "ogt"
+  | Clt -> if neg then "uge" else "olt"
+  | Cge -> if neg then "ult" else "oge"
+
+(* Emit an immediate move in the given data register *)
+
+let emit_move_immediate n dreg =
+  if n >= -128 && n < 128
+  then `	moveq	#{emit_int n}, {emit_string dreg}\n`
+  else `	movel	#{emit_int n}, {emit_string dreg}\n`
+
+(* Offset the stack by the given amount of bytes *)
+
+let output_stack_offset n =
+  if n > 0 && n <= 8 then
+    `	subql	#{emit_int(n)}, a7\n`
+  else if n < 0 && n >= -8 then
+    `	addql	#{emit_int(-n)}, a7\n`
+  else
+    `	addw	#{emit_int(-n)}, a7\n`
+
+(* Deallocate the stack frame before a return or tail call *)
+
+let output_epilogue () =
+  let n = frame_size() - 4 in
+  if n > 0 then output_stack_offset (-n)
+
+(* Record the state of the condition codes *)
+
+type condition_code = CCundefined | CCreflect of Reg.t
+
+let cc_state = ref CCundefined
+
+let undef_cc () =
+  cc_state := CCundefined
+
+let set_cc reg =
+  cc_state := CCreflect reg
+
+let output_test reg =
+  match !cc_state with
+    CCreflect r when r.loc = reg.loc -> ()
+  | _ ->
+      `	tstl	{emit_reg reg}\n`;
+      cc_state := CCreflect reg
+
+(* Output the assembly code for an instruction *)
+
+(* Name of current function *)
+let function_name = ref ""
+(* Entry point for tail recursive calls *)
+let tailrec_entry_point = ref 0
+(* Label of trap for out-of-range accesses *)
+let range_check_trap = ref 0
+
+let emit_instr i =
+    match i.desc with
+      Lend -> ()
+    | Lop(Imove | Ispill | Ireload) ->
+        let src = i.arg.(0) and dst = i.res.(0) in
+        if src.loc <> dst.loc then begin
+          match (src, dst) with
+            ({typ = Float; loc = Stack ss}, {loc = Stack sd}) ->
+              let os = slot_offset ss 2 in
+              let od = slot_offset sd 2 in
+              `	movel	({emit_int os}, a7), ({emit_int od}, a7)\n`;
+              `	movel	({emit_int (os+4)}, a7), ({emit_int (od+4)}, a7)\n`;
+              undef_cc()
+          | ({typ = Float}, _) ->
+              `	fmove{emit_float_size2 src dst}	{emit_reg src}, {emit_reg dst}\n`
+          | (_, _) ->
+              `	movel	{emit_reg src}, {emit_reg dst}\n`;
+              set_cc dst
+        end
+    | Lop(Iconst_int n) ->
+        begin match i.res.(0) with
+          {typ = Addr; loc = Reg _} ->
+            if n >= -32768 && n < 32768 then
+              `	movew	#{emit_int n}, {emit_reg i.res.(0)}\n`
+            else
+              `	movel	#{emit_int n}, {emit_reg i.res.(0)}\n`
+        | _ when n = 0 ->
+            `	clrl	{emit_reg i.res.(0)}\n`;
+            set_cc i.res.(0)
+        | {typ = Int; loc = Reg _} when n >= -128 && n < 128 ->
+            `	moveq	#{emit_int n}, {emit_reg i.res.(0)}\n`;
+            set_cc i.res.(0)
+        | _ ->
+            `	movel	#{emit_int n}, {emit_reg i.res.(0)}\n`;
+            set_cc i.res.(0)
+        end
+    | Lop(Iconst_float s) ->
+        let f = float_of_string s in
+        if f = 0.0 then
+          `	fmovecr	#0x0F, {emit_reg i.res.(0)}\n`
+        else if f = 1.0 then
+          `	fmovecr	#0x32, {emit_reg i.res.(0)}\n`
+        else
+          `	fmoved	#0r{emit_string s}, {emit_reg i.res.(0)}\n`
+    | Lop(Iconst_symbol s) ->
+        `	lea	{emit_symbol s}, {emit_reg i.res.(0)}\n`
+    | Lop(Icall_ind) ->
+        `	jbsr	{emit_reg i.arg.(0)}@\n`;
+        record_frame i.live;
+        undef_cc()
+    | Lop(Icall_imm s) ->
+        `	jbsr	{emit_symbol s}\n`;
+        record_frame i.live;
+        undef_cc()
+    | Lop(Itailcall_ind) ->
+        output_epilogue();
+        `	jmp	{emit_reg i.arg.(0)}@\n`;
+        undef_cc()
+    | Lop(Itailcall_imm s) ->
+        if s = !function_name then
+          `	bra	{emit_label !tailrec_entry_point}\n`
+        else begin
+          output_epilogue();
+          `	jmp	{emit_symbol s}\n`
+        end;
+        undef_cc()
+    | Lop(Iextcall(s, alloc)) ->
+        if alloc then begin
+          `	lea	{emit_symbol s}, a0\n`;
+          `	jbsr	{emit_symbol "caml_c_call"}\n`;
+          record_frame i.live
+        end else begin
+          `	jbsr	{emit_symbol s}\n`
+        end;
+        if Array.length i.res > 0 && i.res.(0).typ = Float then begin
+          `	movel	d1, a7@-\n`;
+          `	movel	d0, a7@-\n`;
+          `	fmoved	a7@+, {emit_reg i.res.(0)}\n`
+        end;
+        undef_cc()
+    | Lop(Istackoffset n) ->
+        output_stack_offset n;
+        stack_offset := !stack_offset + n;
+        undef_cc()
+    | Lop(Iload(chunk, addr)) ->
+        let dest = i.res.(0) in
+        begin match dest.typ with
+          Int | Addr ->
+            begin match chunk with
+              Word ->
+                `	movel	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+            | Byte_unsigned when not (register_overlap dest i.arg) ->
+                `	clrl	{emit_reg dest}\n`;
+                `	moveb	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+            | Byte_unsigned ->
+                `	moveb	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`;
+                `	andl	#0xFF, {emit_reg dest}\n`
+            | Byte_signed ->
+                `	moveb	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`;
+                `	extbl	{emit_reg dest}\n`
+            | Sixteen_unsigned when not (register_overlap dest i.arg) ->
+                `	clrl	{emit_reg dest}\n`;
+                `	movew	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+            | Sixteen_unsigned ->
+                `	movew	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`;
+                `	andl	#0xFFFF, {emit_reg dest}\n`
+            | Sixteen_signed ->
+                `	movew	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`;
+                `	extl	{emit_reg dest}\n`
+            end;
+            set_cc dest
+        | Float ->
+            `	fmoved	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
+        end
+    | Lop(Istore(chunk, addr)) ->
+        let src = i.arg.(0) in
+        let instr =
+          match src.typ with
+            Int ->
+              begin match chunk with
+                Word -> "movel"
+              | Byte_unsigned | Byte_signed -> "moveb"
+              | Sixteen_unsigned | Sixteen_signed -> "movew"
+              end
+          | Addr -> "movel"
+          | Float -> "fmoved" in
+        `	{emit_string instr}	{emit_reg src}, {emit_addressing addr i.arg 1}\n`;
+        undef_cc()
+    | Lop(Ialloc n) ->
+        if !fastcode_flag then begin
+          let lbl_frame = record_frame_label i.live in
+          `	subl	#{emit_int n}, d6\n`;
+          `	cmpl	{emit_symbol "young_limit"}, d6\n`;
+          `	bcc	{emit_label lbl_frame}\n`;
+          emit_move_immediate n "d5";
+          `	jbsr	{emit_symbol "caml_call_gc"}\n`;
+          `{emit_label lbl_frame}:	movel	d6, {emit_reg i.res.(0)}\n`;
+          `	addql	#4, {emit_reg i.res.(0)}\n`
+        end else begin
+          begin match n with
+            8  -> `	jbsr	{emit_symbol "caml_alloc1"}\n`
+          | 12 -> `	jbsr	{emit_symbol "caml_alloc2"}\n`
+          | 16 -> `	jbsr	{emit_symbol "caml_alloc3"}\n`
+          | _  -> emit_move_immediate n "d5";
+                  `	jbsr	{emit_symbol "caml_alloc"}\n`
+          end;
+          `{record_frame i.live}	movel	d6, {emit_reg i.res.(0)}\n`;
+          `	addql	#4, {emit_reg i.res.(0)}\n`
+        end;
+        undef_cc()
+    | Lop(Iintop(Icomp cmp)) ->
+        `	cmpl	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
+        let b = name_for_cond_branch cmp in
+        `	s{emit_string b}	{emit_reg i.res.(0)}\n`;
+        `	negb	{emit_reg i.res.(0)}\n`;
+        `	extbl	{emit_reg i.res.(0)}\n`;
+        set_cc i.res.(0)
+    | Lop(Iintop_imm(Icomp cmp, n)) ->
+        `	cmpl	#{emit_int n}, {emit_reg i.arg.(0)}\n`;
+        let b = name_for_cond_branch cmp in
+        `	s{emit_string b}	{emit_reg i.res.(0)}\n`;
+        `	negb	{emit_reg i.res.(0)}\n`;
+        `	extbl	{emit_reg i.res.(0)}\n`;
+        set_cc i.res.(0)
+    | Lop(Iintop Icheckbound) ->
+        if !range_check_trap = 0 then range_check_trap := new_label();
+        `	cmpl	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
+        `	bls	{emit_label !range_check_trap}\n`
+    | Lop(Iintop_imm(Icheckbound, n)) ->
+        if !range_check_trap = 0 then range_check_trap := new_label();
+        `	cmpl	#{emit_int n}, {emit_reg i.arg.(0)}\n`;
+        `	bls	{emit_label !range_check_trap}\n`
+    | Lop(Iintop_imm(Iadd, n)) -> 
+        let dest = i.res.(0) in
+        begin match dest with
+          {loc = Reg _} when n > 0 && n <= 8 ->
+            `	addql	#{emit_int n}, {emit_reg dest}\n`;
+            set_cc i.res.(0)
+        | {loc = Reg _} when n < 0 && n >= -8 ->
+            `	subql	#{emit_int(-n)}, {emit_reg dest}\n`;
+            set_cc i.res.(0)
+        | _ ->
+            `	addl	#{emit_int n}, {emit_reg dest}\n`;
+            set_cc i.res.(0)
+        end
+    | Lop(Iintop_imm(Isub, n)) -> 
+        let dest = i.res.(0) in
+        begin match dest with
+          {loc = Reg _} when n > 0 && n <= 8 ->
+            `	subql	#{emit_int n}, {emit_reg dest}\n`;
+            set_cc i.res.(0)
+        | {loc = Reg _} when n < 0 && n >= -8 ->
+            `	addql	#{emit_int(-n)}, {emit_reg dest}\n`;
+            set_cc i.res.(0)
+        | _ ->
+            `	subl	#{emit_int n}, {emit_reg dest}\n`;
+            set_cc i.res.(0)
+        end
+    | Lop(Iintop_imm(Idiv, n)) when n = 1 lsl (Misc.log2 n) ->
+        let l = Misc.log2 n in
+        let lbl = new_label() in
+        output_test i.arg.(0);
+        `	bge	{emit_label lbl}\n`;
+        `	addl	#{emit_int(n-1)}, {emit_reg i.arg.(0)}\n`;
+        `{emit_label lbl}:`;
+        if l <= 8 then
+          `	asrl	#{emit_int l}, {emit_reg i.arg.(0)}\n`
+        else begin
+          `	moveq	#{emit_int l}, d5\n`;
+          `	asrl	d0, {emit_reg i.arg.(0)}\n`
+        end;
+        set_cc i.res.(0)
+    | Lop(Iintop Imod) ->
+        `	movel	{emit_reg i.arg.(0)}, d5\n`;
+        `	divsll	{emit_reg i.arg.(1)}, {emit_reg i.res.(0)}:d5\n`;
+        undef_cc()
+    | Lop(Iintop_imm(Imod, n)) when n = 1 lsl (Misc.log2 n) ->
+        let l = Misc.log2 n in
+        let lbl = new_label() in
+        `	movel	{emit_reg i.arg.(0)}, d5\n`;
+          `	bge	{emit_label lbl}\n`;
+          `	addl	#{emit_int(n-1)}, d5\n`;
+          `{emit_label lbl}:	andl	#{emit_int(-n)}, d5\n`;
+          `	subl	d5, {emit_reg i.arg.(0)}\n`;
+        set_cc i.res.(0)
+    | Lop(Iintop_imm(Imod, n)) ->
+        `	movel	{emit_reg i.arg.(0)}, d5\n`;
+        `	divsll	#{emit_int n}, {emit_reg i.res.(0)}:d5\n`;
+        undef_cc()
+    | Lop(Iintop op) ->
+        (* We have i.arg.(0) = i.res.(0) *)
+        `	{emit_string(instr_for_intop op)}	{emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`;
+        set_cc i.res.(0)
+    | Lop(Iintop_imm(op, n)) ->
+        (* We have i.arg.(0) = i.res.(0) *)
+        `	{emit_string(instr_for_intop op)}	#{emit_int n}, {emit_reg i.res.(0)}\n`;
+        set_cc i.res.(0)
+    | Lop(Inegf | Iabsf as floatop) ->
+        `	{emit_string(instr_for_floatop floatop)}{emit_float_size i.arg.(0)}	{emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
+    | Lop(Iaddf | Isubf | Imulf | Idivf as floatop) ->
+        `	{emit_string(instr_for_floatop floatop)}{emit_float_size i.arg.(1)}	{emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
+    | Lop(Ifloatofint) ->
+        `	fmovel	{emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
+    | Lop(Iintoffloat) ->
+        `	fintrz{emit_float_size i.arg.(0)} {emit_reg i.arg.(0)}, fp0\n`;
+        `	fmovel	fp0, {emit_reg i.res.(0)}\n`;
+        undef_cc()
+    | Lop(Ispecific(Ilea addr)) ->
+        `	lea	{emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
+    | Lop(Ispecific(Istore_int(n, addr))) ->
+        if n = 0 then
+          `	clrl	{emit_addressing addr i.arg 0}\n`
+        else
+          `	movel	#{emit_int n}, {emit_addressing addr i.arg 0}\n`;
+        undef_cc()
+    | Lop(Ispecific(Istore_symbol(s, addr))) ->
+        `	movel	#{emit_symbol s}, {emit_addressing addr i.arg 0}\n`;
+        undef_cc()
+    | Lop(Ispecific(Ipush)) ->
+        (* Push arguments in reverse order *)
+        for n = Array.length i.arg - 1 downto 0 do
+          let r = i.arg.(n) in
+          match r with
+            {loc = Reg _; typ = Float} ->
+              `	fmoved	{emit_reg r}, a7@-\n`;
+              stack_offset := !stack_offset + 8
+          | {loc = Stack sl; typ = Float} ->
+              let ofs = slot_offset sl 2 in
+              `	movel	({emit_int(ofs + 4)}, a7), a7@-\n`;
+              `	movel	({emit_int(ofs + 4)}, a7), a7@-\n`;
+              stack_offset := !stack_offset + 8
+          | _ ->
+              `	movel	{emit_reg r}, a7@-\n`;
+              stack_offset := !stack_offset + 4
+        done;
+        undef_cc()
+    | Lop(Ispecific(Ipush_int n)) ->
+        `	movel	#{emit_int n}, a7@-\n`;
+        stack_offset := !stack_offset + 4;
+        undef_cc()
+    | Lop(Ispecific(Ipush_symbol s)) ->
+        `	pea	{emit_symbol s}\n`;
+        stack_offset := !stack_offset + 4;
+        undef_cc()
+    | Lop(Ispecific(Ipush_load addr)) ->
+        `	movel	{emit_addressing addr i.arg 0}, a7@-\n`;
+        stack_offset := !stack_offset + 4;
+        undef_cc()
+    | Lop(Ispecific(Ipush_load_float addr)) ->
+        `	movel	{emit_addressing (offset_addressing addr 4) i.arg 0}, a7@-\n`;
+        `	movel	{emit_addressing addr i.arg 0}, a7@-\n`;
+        stack_offset := !stack_offset + 8;
+        undef_cc()
+    | Lreloadretaddr ->
+        ()
+    | Lreturn ->
+        output_epilogue();
+        `	rts\n`;
+        undef_cc()
+    | Llabel lbl ->
+        `{emit_label lbl}:\n`;
+        undef_cc()
+    | Lbranch lbl ->
+        `	bra	{emit_label lbl}\n`
+    | Lcondbranch(tst, lbl) ->
+        begin match tst with
+          Itruetest ->
+            output_test i.arg.(0);
+            `	bne	{emit_label lbl}\n`
+        | Ifalsetest ->
+            output_test i.arg.(0);
+            `	beq	{emit_label lbl}\n`
+        | Iinttest cmp ->
+            `	cmpl	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
+            let b = name_for_cond_branch cmp in
+            `	b{emit_string b}	{emit_label lbl}\n`
+        | Iinttest_imm(cmp, 0) ->
+            output_test i.arg.(0);
+            let b = name_for_cond_branch cmp in
+            `	b{emit_string b}	{emit_label lbl}\n`
+        | Iinttest_imm(cmp, n) ->
+            `	cmpl	#{emit_int n}, {emit_reg i.arg.(0)}\n`;
+            let b = name_for_cond_branch cmp in
+            `	b{emit_string b}	{emit_label lbl}\n`
+        | Ifloattest(cmp, neg) ->
+            `	fcmp{emit_float_size2 i.arg.(0) i.arg.(1)}	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
+            let b = name_for_float_cond_branch cmp neg in
+            `	fb{emit_string b}	{emit_label lbl}\n`
+        | Ioddtest ->
+            begin match i.arg.(0) with
+              {typ = Addr; loc = Reg _} as arg ->
+                `	movel	{emit_reg arg}, d5\n`;
+                `	btst	#0, d5\n`
+            | arg ->
+                `	btst	#0, {emit_reg arg}\n`
+            end;
+            `	bne	{emit_label lbl}\n`
+        | Ieventest ->
+            begin match i.arg.(0) with
+              {typ = Addr; loc = Reg _} as arg ->
+                `	movel	{emit_reg arg}, d5\n`;
+                `	btst	#0, d5\n`
+            | arg ->
+                `	btst	#0, {emit_reg arg}\n`
+            end;
+            `	beq	{emit_label lbl}\n`
+        end;
+        undef_cc()
+    | Lcondbranch3(lbl0, lbl1, lbl2) ->
+        `	cmpl	#1, {emit_reg i.arg.(0)}\n`;
+        begin match lbl0 with
+          None -> ()
+        | Some lbl -> `	blt	{emit_label lbl}\n`
+        end;
+        begin match lbl1 with
+          None -> ()
+        | Some lbl -> `	beq	{emit_label lbl}\n`
+        end;
+        begin match lbl2 with
+          None -> ()
+        | Some lbl -> `	bgt	{emit_label lbl}\n`
+        end;
+        undef_cc()
+    | Lswitch jumptbl ->
+        let lbl_load = new_label() in
+        let lbl_table = new_label() in
+        `{emit_label lbl_load}:	movew	pc@({emit_label lbl_table}-{emit_label lbl_load}-2:b, {emit_reg i.arg.(0)}:l:2), d0\n`;
+        `	jmp	pc@(2, d0:w)\n`;
+        `{emit_label lbl_table}:`;
+        for i = 0 to Array.length jumptbl - 1 do
+          `	.word	{emit_label jumptbl.(i)} - {emit_label lbl_table}\n`
+        done;
+        undef_cc()
+    | Lsetuptrap lbl ->
+        `	bsr	{emit_label lbl}\n`
+    | Lpushtrap ->
+        `	movel	d7, a7@-\n`;
+        `	movel	a7, d7\n`;
+        stack_offset := !stack_offset + 8;
+        undef_cc()
+    | Lpoptrap ->
+        `	movel	a7@+, d7\n`;
+        `	addql	#4, a7\n`;
+        stack_offset := !stack_offset - 8;
+        undef_cc()
+    | Lraise ->
+        `	movel	d7, a7\n`;
+        `	movel	a7@+, d7\n`;
+        `	rts\n`
+
+let rec emit_all i =
+  match i.desc with Lend -> () | _ -> emit_instr i; emit_all i.next
+
+(* Emission of a function declaration *)
+
+let fundecl fundecl =
+  function_name := fundecl.fun_name;
+  fastcode_flag := fundecl.fun_fast;
+  tailrec_entry_point := new_label();
+  stack_offset := 0;
+  range_check_trap := 0;
+  undef_cc();
+  `	.text\n`;
+  `	.globl	{emit_symbol fundecl.fun_name}\n`;
+  `{emit_symbol fundecl.fun_name}:\n`;
+  let n = frame_size() - 4 in
+  if n > 0 then output_stack_offset n;
+  `{emit_label !tailrec_entry_point}:\n`;
+  emit_all fundecl.fun_body;
+  if !range_check_trap > 0 then
+    `{emit_label !range_check_trap}:	jbsr	{emit_symbol "array_bound_error"}\n`
+
+(* Emission of data *)
+
+let emit_item = function
+    Cdefine_symbol s ->
+      `	.globl	{emit_symbol s}\n`;
+      `{emit_symbol s}:\n`
+  | Cdefine_label lbl ->
+      `{emit_label (10000 + lbl)}:\n`
+  | Cint8 n ->
+      `	.byte	{emit_int n}\n`
+  | Cint16 n ->
+      `	.word	{emit_int n}\n`
+  | Cint n ->
+      `	.long	{emit_int n}\n`
+  | Cintlit n ->
+      `	.long	{emit_string n}\n`
+  | Cfloat f ->
+      `	.double	0r{emit_string f}\n`
+  | Csymbol_address s ->
+      `	.long	{emit_symbol s}\n`
+  | Clabel_address lbl ->
+      `	.long	{emit_label (10000 + lbl)}\n`
+  | Cstring s ->
+      emit_string_directive "	.ascii	" s
+  | Cskip n ->
+      if n > 0 then `	.skip	{emit_int n}\n`
+  | Calign n ->
+      emit_align n
+
+let data l =
+  `	.data\n`;
+  List.iter emit_item l
+
+(* Beginning / end of an assembly file *)
+
+let begin_assembly() =
+  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
+  `	.data\n`;
+  `	.globl	{emit_symbol lbl_begin}\n`;
+  `{emit_symbol lbl_begin}:\n`
+
+let end_assembly() =
+  `	.data\n`;
+  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
+  `	.globl	{emit_symbol lbl_end}\n`;
+  `{emit_symbol lbl_end}:\n`;
+  `	.long	0\n`;
+  let lbl = Compilenv.current_unit_name() ^ "_frametable" in
+  `	.globl	{emit_symbol lbl}\n`;
+  `{emit_symbol lbl}:\n`;
+  `	.long	{emit_int (List.length !frame_descriptors)}\n`;
+  List.iter emit_frame !frame_descriptors;
+  frame_descriptors := []
diff --git a/asmcomp/proc_m68k.ml b/asmcomp/proc_m68k.ml
new file mode 100644
index 0000000000..3a2261ec6b
--- /dev/null
+++ b/asmcomp/proc_m68k.ml
@@ -0,0 +1,353 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  Automatique.  Distributed only by permission.                      *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Description of the Motorola 68020 processor *)
+
+open Misc
+open Arch
+open Format
+open Cmm
+open Reg
+open Mach
+
+(* Registers available for register allocation *)
+
+(* Register map:
+    A0 - A6     0-6     address registers (A2-A6 callee-save)
+    A7                  stack pointer
+    D0 - D4     7-11    data registers (D2 - D7 callee-save)
+    D5                  temporary
+    D6                  allocation pointer
+    D7                  trap pointer
+    FP0 - FP7   12-19   floating-point registers (FP2 - FP7 callee-save)
+*)
+
+let register_names =
+  [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6";
+     "d0"; "d1"; "d2"; "d3"; "d4";
+     "fp0"; "fp1"; "fp2"; "fp3"; "fp4"; "fp5"; "fp6"; "fp7" |]
+
+let num_register_classes = 3
+
+let register_class r =
+  match r.typ with
+    Addr -> 0
+  | Int -> 1
+  | Float -> 2
+
+let num_available_registers = [| 7; 5; 8 |]
+
+let first_available_register = [| 0; 7; 12 |]
+
+let register_name r = register_names.(r)
+
+(* There is no scheduling, so just pack registers. *)
+
+let rotate_registers = false
+
+(* Representation of hard registers by pseudo-registers *)
+
+let all_phys_regs =
+  let v = Array.create 20 Reg.dummy in
+  for i = 0 to 6 do v.(i) <- Reg.at_location Addr (Reg i) done;
+  for i = 7 to 11 do v.(i) <- Reg.at_location Int (Reg i) done;
+  for i = 12 to 19 do v.(i) <- Reg.at_location Float (Reg i) done;
+  v
+
+let phys_reg n = all_phys_regs.(n)
+
+let stack_slot slot ty = Reg.at_location ty (Stack slot)
+
+let reg_A0 = phys_reg 0
+let reg_FP0 = phys_reg 12
+
+(* Exceptions raised to signal cases not handled here *)
+
+exception Use_default
+
+(* Instruction selection *)
+
+(* Auxiliary for recognizing addressing modes *)
+
+type addressing_expr =
+    Asymbol of string
+  | Alinear of expression
+  | Aadd of expression * expression
+  | Ascale of expression * int
+  | Ascaledadd of expression * expression * int
+
+let rec select_addr exp =
+  match exp with
+    Cconst_symbol s ->
+      (Asymbol s, 0)
+  | Cop((Caddi | Cadda), [arg; Cconst_int m]) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop((Csubi | Csuba), [arg; Cconst_int m]) ->
+      let (a, n) = select_addr arg in (a, n - m)
+  | Cop((Caddi | Cadda), [Cconst_int m; arg]) ->
+      let (a, n) = select_addr arg in (a, n + m)
+  | Cop(Clsl, [arg; Cconst_int(1|2|3 as shift)]) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, 1 lsl shift), n lsl shift)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop(Cmuli, [arg; Cconst_int(2|4|8 as mult)]) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, mult), n * mult)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop(Cmuli, [Cconst_int(2|4|8 as mult); arg]) ->
+      begin match select_addr arg with
+        (Alinear e, n) -> (Ascale(e, mult), n * mult)
+      | _ -> (Alinear exp, 0)
+      end
+  | Cop((Caddi | Cadda), [arg1; arg2]) ->
+      begin match (select_addr arg1, select_addr arg2) with
+          ((Alinear e1, n1), (Alinear e2, n2)) ->
+              (Aadd(e1, e2), n1 + n2)
+        | ((Alinear e1, n1), (Ascale(e2, scale), n2)) ->
+              (Ascaledadd(e1, e2, scale), n1 + n2)
+        | ((Ascale(e1, scale), n1), (Alinear e2, n2)) ->
+              (Ascaledadd(e2, e1, scale), n1 + n2)
+        | (_, (Ascale(e2, scale), n2)) ->
+              (Ascaledadd(arg1, e2, scale), n2)
+        | ((Ascale(e1, scale), n1), _) ->
+              (Ascaledadd(arg2, e1, scale), n1)
+        | _ ->
+              (Aadd(arg1, arg2), 0)
+      end
+  | arg ->
+      (Alinear arg, 0)
+    
+let select_addressing exp =
+  match select_addr exp with
+    (Asymbol s, d) ->
+      (Ibased(s, d), Ctuple [])
+  | (Alinear e, d) ->
+      (Iindexed d, e)
+  | (Aadd(e1, e2), d) ->
+      (Iindexed2 d, Ctuple[e1; e2])
+  | (Ascale(e, scale), d) ->
+      (Iscaled(scale, d), e)
+  | (Ascaledadd(e1, e2, scale), d) ->
+      (Iindexed2scaled(scale, d), Ctuple[e1; e2])
+
+(* Selection of immediate shifts *)
+
+let select_shift op args =
+  match args with
+    [arg1; Cconst_int n] when n >= 1 && n <= 8 -> (Iintop_imm(op, n), [arg1])
+  | _ -> (Iintop op, args)
+
+(* Main instruction selection functions *)
+
+let select_oper op args =
+  match op with
+  (* Recognize the LEA instruction *)
+    Cadda | Csuba ->
+      begin match select_addressing (Cop(op, args)) with
+        (Iindexed d, _) -> raise Use_default
+      | (addr, arg) -> (Ispecific(Ilea addr), [arg])
+      end
+  (* Recognize immediate shifts only if 1 <= count <= 8 *)
+  | Clsl -> select_shift Ilsl args
+  | Clsr -> select_shift Ilsr args
+  | Casr -> select_shift Iasr args
+  (* Recognize store instructions *)
+  | Cstore ->
+      begin match args with
+        [loc; Cconst_int n] ->
+          let (addr, arg) = select_addressing loc in
+          (Ispecific(Istore_int(n, addr)), [arg])
+      | [loc; Cconst_pointer n] ->
+          let (addr, arg) = select_addressing loc in
+          (Ispecific(Istore_int(n, addr)), [arg])
+      | [loc; Cconst_symbol s] ->
+          let (addr, arg) = select_addressing loc in
+          (Ispecific(Istore_symbol(s, addr)), [arg])
+      | _ ->
+          raise Use_default
+      end
+  | _ -> raise Use_default
+
+let select_store addr exp =
+  match exp with
+    Cconst_int n -> (Ispecific(Istore_int(n, addr)), Ctuple [])
+  | Cconst_pointer n -> (Ispecific(Istore_int(n, addr)), Ctuple [])
+  | Cconst_symbol s -> (Ispecific(Istore_symbol(s, addr)), Ctuple [])
+  | _ -> raise Use_default
+
+let select_push exp =
+  match exp with
+    Cconst_int n -> (Ispecific(Ipush_int n), Ctuple [])
+  | Cconst_pointer n -> (Ispecific(Ipush_int n), Ctuple [])
+  | Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple [])
+  | Cop(Cload ty, [loc]) when ty = typ_float ->
+      let (addr, arg) = select_addressing loc in
+      (Ispecific(Ipush_load_float addr), arg)
+  | Cop(Cload ty, [loc]) when ty = typ_addr or ty = typ_int ->
+      let (addr, arg) = select_addressing loc in
+      (Ispecific(Ipush_load addr), arg)
+  | _ -> (Ispecific(Ipush), exp)
+
+let pseudoregs_for_operation op arg res =
+  match op with
+  (* Two-address binary operations *)
+    Iintop(Iadd | Isub | Imul | Idiv | Imod | Ilsl | Ilsr | Iasr) |
+    Iaddf | Isubf | Imulf | Idivf ->
+      ([|res.(0); arg.(1)|], res, false)
+  (* Two-address binary operations, forcing the second argument to be
+     in a data register *)
+  | Iintop(Iand | Ior | Ixor) ->
+      let newarg1 = Reg.create Int in
+      ([|res.(0); newarg1|], res, false)
+  (* Two-address unary operations *)
+  | Iintop_imm((Iadd | Isub | Imul | Idiv | Imod | Iand | Ior | Ixor |
+                Ilsl | Ilsr | Iasr), _) ->
+      (res, res, false)
+  (* Other instructions are regular *)
+  | _ -> raise Use_default
+
+let is_immediate (n: int) = true
+
+let word_addressed = false
+
+(* Calling conventions *)
+
+let calling_conventions first_addr last_addr first_float last_float
+                        make_stack arg =
+  let loc = Array.create (Array.length arg) Reg.dummy in
+  let addr = ref first_addr in
+  let float = ref first_float in
+  let ofs = ref 0 in
+  for i = 0 to Array.length arg - 1 do
+    match arg.(i).typ with
+      (Addr | Int) as ty ->
+        if !addr <= last_addr then begin
+          loc.(i) <- phys_reg !addr;
+          incr addr
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) ty;
+          ofs := !ofs + size_addr
+        end
+    | Float ->
+        if !float <= last_float then begin
+          loc.(i) <- phys_reg !float;
+          incr float
+        end else begin
+          loc.(i) <- stack_slot (make_stack !ofs) Float;
+          ofs := !ofs + size_float
+        end
+  done;
+  (loc, !ofs)
+
+let incoming ofs = Incoming ofs
+let outgoing ofs = Outgoing ofs
+let not_supported ofs = fatal_error "Proc.loc_results: cannot call"
+
+let loc_arguments arg =
+  calling_conventions 0 5 12 18 outgoing arg
+let loc_parameters arg =
+  let (loc, ofs) = calling_conventions 0 5 12 18 incoming arg in loc
+let loc_results res =
+  let (loc, ofs) = calling_conventions 0 5 12 18 not_supported res in loc
+let extcall_use_push = true
+let loc_external_arguments arg =
+  fatal_error "Proc.loc_external_arguments"
+let loc_external_results res =
+  let (loc, ofs) = calling_conventions 7 7 12 12 not_supported res in loc
+
+let loc_exn_bucket = reg_A0
+
+(* Registers destroyed by operations *)
+
+let destroyed_at_c_call =
+  Array.of_list(List.map phys_reg [0; 1; 7; 8; 12; 13])
+
+let destroyed_at_oper = function
+    Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs
+  | Iop(Iextcall(_, false)) -> destroyed_at_c_call
+  | Iop(Iintoffloat) -> [| reg_FP0 |]
+  | _ -> [||]
+
+let destroyed_at_raise = all_phys_regs
+
+(* Maximal register pressure *)
+
+let safe_register_pressure op = 5
+
+let max_register_pressure = function
+    Iextcall(_, _) -> [| 5; 3; 6 |]
+  | Iintoffloat -> [| 7; 5; 7 |]
+  | _ -> num_available_registers
+
+(* Reloading of instruction arguments, storing of instruction results. *)
+
+let stackp r =
+  match r.loc with
+    Stack _ -> true
+  | _ -> false
+
+let reload_test makereg round tst arg =
+  match tst with
+    Iinttest _ | Ifloattest _ ->
+      (* The second argument can be on stack *)
+      [| makereg arg.(0); arg.(1) |]
+  | _ ->
+      (* The argument can be on stack *)
+      arg
+
+let reload_operation makereg round op arg res =
+  match op with
+    Imove | Ireload | Ispill | 
+    Iintop_imm((Iadd | Isub | Iand | Ior | Ixor |
+                Icomp _ | Ilsl | Ilsr | Iasr), _) |
+    Ifloatofint | Iintoffloat | Ispecific(Ipush) ->
+      (* The argument(s) can be either in register or on stack *)
+      (arg, res)
+  | Iintop(Iadd | Isub | Iand | Ior | Ixor | Icomp _) ->
+      (* One of the two arguments can reside in the stack *)
+      if stackp arg.(0) && stackp arg.(1)
+      then ([|arg.(0); makereg arg.(1)|], res)
+      else (arg, res)
+  | Iintop(Ilsl | Ilsr | Iasr) ->
+      (* The first argument and result can reside in the stack *)
+      ([|arg.(0); makereg arg.(1)|], res)
+  | Iintop(Imul | Idiv | Imod) | Iaddf | Isubf | Imulf | Idivf ->
+      (* The second argument can reside in the stack *)
+      let r = makereg arg.(0) in ([|r; arg.(1)|], [|r|])
+  | _ -> (* Other operations: all args and results in registers *)
+      raise Use_default
+
+(* Scheduling is turned off. *)
+
+let need_scheduling = false
+
+let oper_latency _ = 0
+
+(* Layout of the stack frame *)
+
+let num_stack_slots = [| 0; 0; 0 |]
+let contains_calls = ref false
+
+(* Calling the assembler *)
+
+let assemble_file infile outfile =
+  Sys.command ("as -o " ^ outfile ^ " " ^ infile)
+
+(* Calling the archiver *)
+
+let create_archive archive file_list =
+  Misc.remove_file archive;
+  Sys.command ("ar rc " ^ archive ^ " " ^ String.concat " " file_list ^
+               " && ranlib " ^ archive)
diff --git a/asmrun/m68k.S b/asmrun/m68k.S
new file mode 100644
index 0000000000..100f249732
--- /dev/null
+++ b/asmrun/m68k.S
@@ -0,0 +1,259 @@
+|***********************************************************************
+|*                                                                     *
+|*                           Objective Caml                            *
+|*                                                                     *
+|*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *
+|*                                                                     *
+|*  Copyright 1996 Institut National de Recherche en Informatique et   *
+|*  Automatique.  Distributed only by permission.                      *
+|*                                                                     *
+|***********************************************************************
+
+| $Id$
+
+| Asm part of the runtime system, Motorola 68k processor
+
+        .comm   _young_limit, 4
+        .comm   _young_ptr, 4
+        .comm   _gc_entry_regs, 48
+        .comm   _caml_bottom_of_stack, 4
+        .comm   _caml_top_of_stack, 4
+        .comm   _caml_last_return_address, 4
+        .comm   _caml_exception_pointer, 4
+        .comm   _caml_requested_size, 4
+
+| Allocation
+
+        .text
+	.globl  _caml_call_gc
+        .globl  _caml_alloc1
+        .globl  _caml_alloc2
+        .globl  _caml_alloc3
+        .globl  _caml_alloc
+
+_caml_call_gc:
+    | Save desired size
+        movel   d5, _caml_requested_size
+    | Record lowest stack address and return address
+        movel   a7@, _caml_last_return_address
+        movel   a7, d5
+        addql   #4, d5
+        movel   d5, _caml_bottom_of_stack
+    | Record current allocation pointer (for debugging)
+        movel   d6, _young_ptr
+    | Save all regs used by the code generator
+        movel   a0, _gc_entry_regs
+        movel   a1, _gc_entry_regs + 4
+        movel   a2, _gc_entry_regs + 8
+        movel   a3, _gc_entry_regs + 12
+        movel   a4, _gc_entry_regs + 16
+        movel   a5, _gc_entry_regs + 20
+        movel   a6, _gc_entry_regs + 24
+        movel   d0, _gc_entry_regs + 28
+        movel   d1, _gc_entry_regs + 32
+        movel   d2, _gc_entry_regs + 36
+        movel   d3, _gc_entry_regs + 40
+        movel   d4, _gc_entry_regs + 44
+        fmovem  fp0-fp7, a7@-
+    | Call the garbage collector
+        jbsr    _garbage_collection
+    | Restore all regs used by the code generator
+        fmovem  a7@+, fp0-fp7
+        movel   _gc_entry_regs, a0
+        movel   _gc_entry_regs + 4, a1
+        movel   _gc_entry_regs + 8, a2
+        movel   _gc_entry_regs + 12, a3
+        movel   _gc_entry_regs + 16, a4
+        movel   _gc_entry_regs + 20, a5
+        movel   _gc_entry_regs + 24, a6
+        movel   _gc_entry_regs + 28, d0
+        movel   _gc_entry_regs + 32, d1
+        movel   _gc_entry_regs + 36, d2
+        movel   _gc_entry_regs + 40, d3
+        movel   _gc_entry_regs + 44, d4
+    | Reload allocation pointer and allocate block
+        movel   _young_ptr, d6
+        subl    _caml_requested_size, d6
+    | Return to caller
+        rts
+
+_caml_alloc1:
+        subql   #8, d6
+        cmpl    _young_limit, d6
+        bcs     L100
+        rts
+L100:   moveq   #8, d5
+        bra     _caml_call_gc
+
+_caml_alloc2:
+        subl    #12, d6
+        cmpl    _young_limit, d6
+        bcs     L101
+        rts
+L101:   moveq   #12, d5
+        bra     _caml_call_gc
+
+_caml_alloc3:
+        subl    #16, d6
+        cmpl    _young_limit, d6
+        bcs     L102
+        rts
+L102:   moveq   #16, d5
+        bra     _caml_call_gc
+
+_caml_alloc:
+        subl    d5, d6
+        cmpl    _young_limit, d6
+        bcs     _caml_call_gc
+        rts
+
+| Call a C function from Caml
+
+        .globl  _caml_c_call
+
+_caml_c_call:
+    | Record lowest stack address and return address
+        movel   a7@+, _caml_last_return_address
+        movel   a7, _caml_bottom_of_stack
+    | Save allocation pointer and exception pointer
+        movel   d6, _young_ptr
+        movel   d7, _caml_exception_pointer
+    | Call the function (address in a0)
+        jbsr    a0@
+    | Reload allocation pointer
+        movel   _young_ptr, d6
+    | Return to caller
+        movel   _caml_last_return_address, a1
+        jmp     a1@
+
+| Start the Caml program
+
+        .globl  _caml_start_program
+
+_caml_start_program:
+    | Save callee-save registers
+        moveml  a2-a6/d2-d7, a7@-
+        fmovem  fp2-fp7, a7@-
+    | Build an exception handler
+        pea     L103
+        pea     0
+        movel   a7, d7
+    | Record highest stack address
+        movel   a7, _caml_top_of_stack
+    | Load allocation pointer
+        movel   _young_ptr, d6
+    | Go for it
+        jbsr    _caml_program
+    | Pop handler
+        addql   #8, a7
+    | Zero return code
+        clrl    d0
+        bra     L104
+L103:
+    | Return exception bucket
+        movel   a0, d0
+L104:
+    | Restore registers and return
+        fmovem  a7@+, fp2-fp7
+        moveml  a7@+, a2-a6/d2-d7
+        rts
+
+| Raise an exception from C
+
+        .globl  _raise_caml_exception
+_raise_caml_exception:
+        movel   a7@(4), a0     | exception bucket
+        movel   _young_ptr, d6
+        movel   _caml_exception_pointer, a7
+        movel   a7@+, d7
+        rts
+
+| Callback from C to Caml
+
+        .globl  _callback
+_callback:
+        link    a6, #0
+    | Save callee-save registers
+        moveml  a2-a6/d2-d7, a7@-
+        fmovem  fp2-fp7, a7@-
+    | Initial loading of arguments
+        movel   a6@(8), a1     | closure
+        movel   a6@(12), a0    | argument
+        movel   a1@(0), a5     | code pointer
+L106:
+    | Build a callback link
+        movel   _caml_last_return_address, a7@-
+        movel   _caml_bottom_of_stack, a7@-
+    | Build an exception handler
+        pea     L108
+        movel   _caml_exception_pointer, a7@-
+        movel   a7, d7
+    | Load allocation pointer
+        movel   _young_ptr, d6
+    | Call the Caml code
+        jbsr    a5@
+L107:
+    | Move result where C code expects it
+        movel   a0, d0
+    | Save allocation pointer
+        movel   d6, _young_ptr
+    | Pop the exception handler
+        movel   a7@+, _caml_exception_pointer
+        addql   #4, a7
+    | Pop the callback link, restoring the global variables
+    | used by caml_c_call
+        movel   a7@+, _caml_bottom_of_stack
+        movel   a7@+, _caml_last_return_address
+    | Restore callee-save registers and return
+        fmovem  a7@+, fp2-fp7
+        moveml  a7@+, a2-a6/d2-d7
+        unlk    a6
+        rts
+L108:
+    | Exception handler
+    | Save allocation pointer and exception pointer
+        movel   d6, _young_ptr
+        movel   d7, _caml_exception_pointer
+    | Pop the callback link, restoring the global variables
+    | used by caml_c_call
+        movel   a7@+, _caml_bottom_of_stack
+        movel   a7@+, _caml_last_return_address
+    | Re-raise the exception through mlraise,
+    | so that local C roots are cleaned up correctly.
+        movel   a0, a7@-       | exn bucket is the argument
+        jbsr    _mlraise        | never returns
+
+        .globl  _callback2
+_callback2:
+        link    a6, #0
+    | Save callee-save registers
+        moveml  a2-a6/d2-d7, a7@-
+        fmovem  fp2-fp7, a7@-
+    | Initial loading of arguments
+        movel   a6@(8), a2     | closure
+        movel   a6@(12), a0    | first argument
+        movel   a6@(16), a1    | second argument
+        lea     _caml_apply2, a5 | code pointer
+        bra     L106
+
+        .globl  _callback3
+_callback3:
+        link    a6, #0
+    | Save callee-save registers
+        moveml  a2-a6/d2-d7, a7@-
+        fmovem  fp2-fp7, a7@-
+    | Initial loading of arguments
+        movel   a6@(8), a3     | closure
+        movel   a6@(12), a0    | first argument
+        movel   a6@(16), a1    | second argument
+        movel   a6@(20), a2    | third argument
+        lea     _caml_apply3, a5 | code pointer
+        bra     L106
+
+        .data
+        .globl  _system_frametable
+_system_frametable:
+        .long   1               | one descriptor
+        .long   L107            | return address into callback
+        .word   -1              | negative frame size => use callback link
+        .word   0               | no roots here
diff --git a/asmrun/stack.h b/asmrun/stack.h
index 406ecfa654..233cb41b2a 100644
--- a/asmrun/stack.h
+++ b/asmrun/stack.h
@@ -59,5 +59,10 @@
 #define Callback_link(sp) ((struct callback_link *)(sp + Trap_frame_size))
 #endif
 
+#ifdef TARGET_m68k
+#define Saved_return_address(sp) *((long *)(sp - 4))
+#define Callback_link(sp) ((struct callback_link *)(sp + 8))
+#endif
+
 
 #endif /* _stack_ */
diff --git a/byterun/interp.c b/byterun/interp.c
index 0b60954bd4..e493c8a331 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -99,6 +99,11 @@ int callback_depth = 0;
 #define SP_REG asm("%r17")
 #define ACCU_REG asm("%r16")
 #endif
+#ifdef __mc68000__
+#define PC_REG asm("a5")
+#define SP_REG asm("a4")
+#define ACCU_REG asm("d7")
+#endif
 #endif
 
 /* The interpreter itself */
diff --git a/configure b/configure
index 4a9f3e309d..30f42509ec 100755
--- a/configure
+++ b/configure
@@ -195,6 +195,7 @@ case "$host" in
   rs6000-*-aix*)                arch=power; model=rs6000; system=aix;;
   powerpc-*-aix*)               arch=power; model=ppc; system=aix;;
   powerpc-*-linux*)             arch=power; model=ppc; system=elf;;
+  m68k-*-sunos*)                arch=m68k; system=sunos;;
 esac
 
 case "$arch" in
@@ -501,6 +502,7 @@ case "$host" in
   sparc-*-sunos*) bignum_arch=supersparc;;
   sparc-*-solaris*) bignum_arch=supersparc-solaris;;
   sparc-*-*bsd*) bignum_arch=sparc;;
+  m68k-*-sunos*) bignum_arch=68K;;
   *) bignum_arch=C
 esac