Skip to content

Commit

Permalink
This commit was manufactured by cvs2svn to create branch 'poly_meth2'.
Browse files Browse the repository at this point in the history 
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/poly_meth2@4215 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information
No author committed Jan 4, 2002
1 parent 953a344 commit a8bf6e6
Show file tree
Hide file tree
Showing 140 changed files with 21,108 additions and 0 deletions.
824 changes: 824 additions & 0 deletions bytecomp/bytegen.ml
View file

Large diffs are not rendered by default.

427 changes: 427 additions & 0 deletions bytecomp/emitcode.ml
View file

Large diffs are not rendered by default.

108 changes: 108 additions & 0 deletions bytecomp/instruct.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,108 @@
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)

(* $Id$ *)

open Lambda

type compilation_env =
{ ce_stack: int Ident.tbl;
ce_heap: int Ident.tbl;
ce_rec: int Ident.tbl }

type debug_event =
{ mutable ev_pos: int; (* Position in bytecode *)
ev_module: string; (* Name of defining module *)
ev_char: int; (* Location in source file *)
ev_kind: debug_event_kind; (* Before/after event *)
ev_info: debug_event_info; (* Extra information *)
ev_typenv: Env.summary; (* Typing environment *)
ev_compenv: compilation_env; (* Compilation environment *)
ev_stacksize: int; (* Size of stack frame *)
ev_repr: debug_event_repr } (* Position of the representative *)

and debug_event_kind =
Event_before
| Event_after of Types.type_expr
| Event_pseudo

and debug_event_info =
Event_function
| Event_return of int
| Event_other

and debug_event_repr =
Event_none
| Event_parent of int ref
| Event_child of int ref

type label = int (* Symbolic code labels *)

type instruction =
Klabel of label
| Kacc of int
| Kenvacc of int
| Kpush
| Kpop of int
| Kassign of int
| Kpush_retaddr of label
| Kapply of int (* number of arguments *)
| Kappterm of int * int (* number of arguments, slot size *)
| Kreturn of int (* slot size *)
| Krestart
| Kgrab of int (* number of arguments *)
| Kclosure of label * int
| Kclosurerec of label list * int
| Koffsetclosure of int
| Kgetglobal of Ident.t
| Ksetglobal of Ident.t
| Kconst of structured_constant
| Kmakeblock of int * int (* size, tag *)
| Kmakefloatblock of int
| Kgetfield of int
| Ksetfield of int
| Kgetfloatfield of int
| Ksetfloatfield of int
| Kvectlength
| Kgetvectitem
| Ksetvectitem
| Kgetstringchar
| Ksetstringchar
| Kbranch of label
| Kbranchif of label
| Kbranchifnot of label
| Kstrictbranchif of label
| Kstrictbranchifnot of label
| Kswitch of label array * label array
| Kboolnot
| Kpushtrap of label
| Kpoptrap
| Kraise
| Kcheck_signals
| Kccall of string * int
| Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint
| Kandint | Korint | Kxorint | Klslint | Klsrint | Kasrint
| Kintcomp of comparison
| Koffsetint of int
| Koffsetref of int
| Kisint
| Kisout
| Kgetmethod
| Kevent of debug_event
| Kstop

let immed_min = -0x40000000
and immed_max = 0x3FFFFFFF

(* Actually the abstract machine accomodates -0x80000000 to 0x7FFFFFFF,
but these numbers overflow the Caml type int if the compiler runs on
a 32-bit processor. *)
123 changes: 123 additions & 0 deletions bytecomp/instruct.mli
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,123 @@
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)

(* $Id$ *)

(* The type of the instructions of the abstract machine *)

open Lambda

(* Structure of compilation environments *)

type compilation_env =
{ ce_stack: int Ident.tbl; (* Positions of variables in the stack *)
ce_heap: int Ident.tbl; (* Structure of the heap-allocated env *)
ce_rec: int Ident.tbl } (* Functions bound by the same let rec *)

(* The ce_stack component gives locations of variables residing
in the stack. The locations are offsets w.r.t. the origin of the
stack frame.
The ce_heap component gives the positions of variables residing in the
heap-allocated environment.
The ce_rec component associate offsets to identifiers for functions
bound by the same let rec as the current function. The offsets
are used by the OFFSETCLOSURE instruction to recover the closure
pointer of the desired function from the env register (which
points to the closure for the current function). *)

(* Debugging events *)

type debug_event =
{ mutable ev_pos: int; (* Position in bytecode *)
ev_module: string; (* Name of defining module *)
ev_char: int; (* Location in source file *)
ev_kind: debug_event_kind; (* Before/after event *)
ev_info: debug_event_info; (* Extra information *)
ev_typenv: Env.summary; (* Typing environment *)
ev_compenv: compilation_env; (* Compilation environment *)
ev_stacksize: int; (* Size of stack frame *)
ev_repr: debug_event_repr } (* Position of the representative *)

and debug_event_kind =
Event_before
| Event_after of Types.type_expr
| Event_pseudo

and debug_event_info =
Event_function
| Event_return of int
| Event_other

and debug_event_repr =
Event_none
| Event_parent of int ref
| Event_child of int ref

(* Abstract machine instructions *)

type label = int (* Symbolic code labels *)

type instruction =
Klabel of label
| Kacc of int
| Kenvacc of int
| Kpush
| Kpop of int
| Kassign of int
| Kpush_retaddr of label
| Kapply of int (* number of arguments *)
| Kappterm of int * int (* number of arguments, slot size *)
| Kreturn of int (* slot size *)
| Krestart
| Kgrab of int (* number of arguments *)
| Kclosure of label * int
| Kclosurerec of label list * int
| Koffsetclosure of int
| Kgetglobal of Ident.t
| Ksetglobal of Ident.t
| Kconst of structured_constant
| Kmakeblock of int * int (* size, tag *)
| Kmakefloatblock of int
| Kgetfield of int
| Ksetfield of int
| Kgetfloatfield of int
| Ksetfloatfield of int
| Kvectlength
| Kgetvectitem
| Ksetvectitem
| Kgetstringchar
| Ksetstringchar
| Kbranch of label
| Kbranchif of label
| Kbranchifnot of label
| Kstrictbranchif of label
| Kstrictbranchifnot of label
| Kswitch of label array * label array
| Kboolnot
| Kpushtrap of label
| Kpoptrap
| Kraise
| Kcheck_signals
| Kccall of string * int
| Knegint | Kaddint | Ksubint | Kmulint | Kdivint | Kmodint
| Kandint | Korint | Kxorint | Klslint | Klsrint | Kasrint
| Kintcomp of comparison
| Koffsetint of int
| Koffsetref of int
| Kisint
| Kisout
| Kgetmethod
| Kevent of debug_event
| Kstop

val immed_min: int
val immed_max: int
110 changes: 110 additions & 0 deletions bytecomp/printinstr.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,110 @@
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)

(* $Id$ *)

(* Pretty-print lists of instructions *)

open Format
open Lambda
open Instruct

let instruction ppf = function
| Klabel lbl -> fprintf ppf "L%i:" lbl
| Kacc n -> fprintf ppf "\tacc %i" n
| Kenvacc n -> fprintf ppf "\tenvacc %i" n
| Kpush -> fprintf ppf "\tpush"
| Kpop n -> fprintf ppf "\tpop %i" n
| Kassign n -> fprintf ppf "\tassign %i" n
| Kpush_retaddr lbl -> fprintf ppf "\tpush_retaddr L%i" lbl
| Kapply n -> fprintf ppf "\tapply %i" n
| Kappterm(n, m) ->
fprintf ppf "\tappterm %i, %i" n m
| Kreturn n -> fprintf ppf "\treturn %i" n
| Krestart -> fprintf ppf "\trestart"
| Kgrab n -> fprintf ppf "\tgrab %i" n
| Kclosure(lbl, n) ->
fprintf ppf "\tclosure L%i, %i" lbl n
| Kclosurerec(lbls, n) ->
fprintf ppf "\tclosurerec";
List.iter (fun lbl -> fprintf ppf " %i" lbl) lbls;
fprintf ppf ", %i" n
| Koffsetclosure n -> fprintf ppf "\toffsetclosure %i" n
| Kgetglobal id -> fprintf ppf "\tgetglobal %a" Ident.print id
| Ksetglobal id -> fprintf ppf "\tsetglobal %a" Ident.print id
| Kconst cst ->
fprintf ppf "@[<10>\tconst@ %a@]" Printlambda.structured_constant cst
| Kmakeblock(n, m) ->
fprintf ppf "\tmakeblock %i, %i" n m
| Kmakefloatblock(n) ->
fprintf ppf "\tmakefloatblock %i" n
| Kgetfield n -> fprintf ppf "\tgetfield %i" n
| Ksetfield n -> fprintf ppf "\tsetfield %i" n
| Kgetfloatfield n -> fprintf ppf "\tgetfloatfield %i" n
| Ksetfloatfield n -> fprintf ppf "\tsetfloatfield %i" n
| Kvectlength -> fprintf ppf "\tvectlength"
| Kgetvectitem -> fprintf ppf "\tgetvectitem"
| Ksetvectitem -> fprintf ppf "\tsetvectitem"
| Kgetstringchar -> fprintf ppf "\tgetstringchar"
| Ksetstringchar -> fprintf ppf "\tsetstringchar"
| Kbranch lbl -> fprintf ppf "\tbranch L%i" lbl
| Kbranchif lbl -> fprintf ppf "\tbranchif L%i" lbl
| Kbranchifnot lbl -> fprintf ppf "\tbranchifnot L%i" lbl
| Kstrictbranchif lbl -> fprintf ppf "\tstrictbranchif L%i" lbl
| Kstrictbranchifnot lbl ->
fprintf ppf "\tstrictbranchifnot L%i" lbl
| Kswitch(consts, blocks) ->
let labels ppf labs =
Array.iter (fun lbl -> fprintf ppf "@ %i" lbl) labs in
fprintf ppf "@[<10>\tswitch%a/%a@]" labels consts labels blocks
| Kboolnot -> fprintf ppf "\tboolnot"
| Kpushtrap lbl -> fprintf ppf "\tpushtrap L%i" lbl
| Kpoptrap -> fprintf ppf "\tpoptrap"
| Kraise -> fprintf ppf "\traise"
| Kcheck_signals -> fprintf ppf "\tcheck_signals"
| Kccall(s, n) ->
fprintf ppf "\tccall %s, %i" s n
| Knegint -> fprintf ppf "\tnegint"
| Kaddint -> fprintf ppf "\taddint"
| Ksubint -> fprintf ppf "\tsubint"
| Kmulint -> fprintf ppf "\tmulint"
| Kdivint -> fprintf ppf "\tdivint"
| Kmodint -> fprintf ppf "\tmodint"
| Kandint -> fprintf ppf "\tandint"
| Korint -> fprintf ppf "\torint"
| Kxorint -> fprintf ppf "\txorint"
| Klslint -> fprintf ppf "\tlslint"
| Klsrint -> fprintf ppf "\tlsrint"
| Kasrint -> fprintf ppf "\tasrint"
| Kintcomp Ceq -> fprintf ppf "\teqint"
| Kintcomp Cneq -> fprintf ppf "\tneqint"
| Kintcomp Clt -> fprintf ppf "\tltint"
| Kintcomp Cgt -> fprintf ppf "\tgtint"
| Kintcomp Cle -> fprintf ppf "\tleint"
| Kintcomp Cge -> fprintf ppf "\tgeint"
| Koffsetint n -> fprintf ppf "\toffsetint %i" n
| Koffsetref n -> fprintf ppf "\toffsetref %i" n
| Kisint -> fprintf ppf "\tisint"
| Kisout -> fprintf ppf "\tisout"
| Kgetmethod -> fprintf ppf "\tgetmethod"
| Kstop -> fprintf ppf "\tstop"
| Kevent ev -> fprintf ppf "\tevent %i" ev.ev_char

let rec instruction_list ppf = function
[] -> ()
| Klabel lbl :: il ->
fprintf ppf "L%i:%a" lbl instruction_list il
| instr :: il ->
fprintf ppf "%a@ %a" instruction instr instruction_list il

let instrlist ppf il =
fprintf ppf "@[<v 0>%a@]" instruction_list il
Loading

0 comments on commit a8bf6e6

Please sign in to comment.