diff options
Diffstat (limited to 'src')
36 files changed, 1282 insertions, 310 deletions
diff --git a/src/Makefile b/src/Makefile index 15bce37e..629150cf 100644 --- a/src/Makefile +++ b/src/Makefile @@ -23,11 +23,7 @@ CFG_GCC_CFLAGS := CFG_GCC_LINK_FLAGS := CFG_VALGRIND := -# Issue #102, LLVM-config logic is assuming "presence of llvm-config" -# means "presence of ocaml bindings". Commenting out for now. -# CFG_LLVM_CONFIG := llvm-config - -CFG_LLVM_CONFIG := +CFG_LLVM_CONFIG := llvm-config CFG_BOOT_FLAGS := $(FLAGS) ifeq ($(CFG_OSTYPE), Linux) @@ -137,6 +133,7 @@ ifdef PROFILE $(info cfg: building with profiling info (forcing native output)) CFG_NATIVE := 1 CFG_OCAMLOPT_PROFILE_FLAGS := -p + NO_LLVM := 1 endif ifdef DEBUG @@ -165,6 +162,10 @@ ifneq ($(CFG_LLVM_CONFIG),) CFG_LLVM_VERSION := $(shell $(CFG_LLVM_CONFIG) --version) ifeq ($(CFG_LLVM_VERSION),2.8svn) $(info cfg: using LLVM version 2.8svn) + WHERE := $(shell ocamlc -where) + ifneq ($(shell test -e $(WHERE)/llvm.cma && echo ok),ok) + CFG_LLVM_CONFIG := $(info cfg: LLVM ocaml bindings not found) + endif else CFG_LLVM_CONFIG := $(info cfg: incompatible LLVM version $(CFG_LLVM_VERSION), \ @@ -173,7 +174,6 @@ ifneq ($(CFG_LLVM_CONFIG),) endif ifdef CFG_LLVM_CONFIG VARIANT=llvm - WHERE := $(shell ocamlc -where) LLVM_LIBS := llvm.cma llvm_bitwriter.cma LLVM_NATIVE_LIBS := llvm.cmxa llvm_bitwiter.cmxa LLVM_CLIBS := $(shell for c in `$(CFG_LLVM_CONFIG) --ldflags --libs` \ @@ -201,8 +201,9 @@ CFG_BOOT_FLAGS += -L . # Boot targets and rules ###################################################################### -ML_INCS := -I boot/fe -I boot/me -I boot/be -I boot/driver/$(VARIANT) \ - -I boot/driver -I boot/util $(LLVM_INCS) +ML_DEP_INCS := -I boot/fe -I boot/me -I boot/be -I boot/driver/$(VARIANT) \ + -I boot/driver -I boot/util +ML_INCS := $(ML_DEP_INCS) $(LLVM_INCS) ML_LIBS := unix.cma nums.cma bigarray.cma ML_NATIVE_LIBS := unix.cmxa nums.cmxa bigarray.cmxa OCAMLC_FLAGS := -g $(ML_INCS) -w Ael -warn-error Ael @@ -413,6 +414,7 @@ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \ item-name-overload.rs \ large-records.rs \ lazy-and-or.rs \ + lazy-init.rs \ lazychan.rs \ linear-for-loop.rs \ list.rs \ @@ -464,6 +466,7 @@ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \ vec-append.rs \ vec-concat.rs \ vec-drop.rs \ + vec-late-init.rs \ vec-slice.rs \ vec.rs \ writealias.rs \ @@ -681,11 +684,11 @@ C_DEPFILES := $(RUNTIME_CS:%.cpp=%.d) %.d: %.ml $(MKFILES) @$(call CFG_ECHO, dep: $<) - $(CFG_QUIET)ocamldep$(OPT) $(ML_INCS) $< $(CFG_PATH_MUNGE) >$@ + $(CFG_QUIET)ocamldep$(OPT) $(ML_DEP_INCS) $< $(CFG_PATH_MUNGE) >$@ %.d: %.mli $(MKFILES) @$(call CFG_ECHO, dep: $<) - $(CFG_QUIET)ocamldep$(OPT) $(ML_INCS) $< $(CFG_PATH_MUNGE) >$@ + $(CFG_QUIET)ocamldep$(OPT) $(ML_DEP_INCS) $< $(CFG_PATH_MUNGE) >$@ ifneq ($(MAKECMDGOALS),clean) -include $(ML_DEPFILES) $(C_DEPFILES) @@ -728,7 +731,7 @@ PKG_3RDPARTY := rt/valgrind.h rt/memcheck.h \ rt/uthash/uthash.h rt/uthash/utlist.h \ rt/bigint/bigint.h rt/bigint/bigint_int.cpp \ rt/bigint/bigint_ext.cpp rt/bigint/low_primes.h -PKG_FILES := README \ +PKG_FILES := README boot/README \ $(wildcard etc/*.*) \ $(MKFILES) $(BOOT_MLS) boot/fe/lexer.mll \ $(COMPILER_INPUTS) \ @@ -3,6 +3,7 @@ This is preliminary version of the Rust compiler. Source layout: boot/ The bootstrap compiler +boot/README - More-detailed guide to it. boot/fe - Front end (lexer, parser, AST) boot/me - Middle end (resolve, check, layout, trans) boot/be - Back end (IL, RA, insns, asm, objfiles) diff --git a/src/boot/README b/src/boot/README new file mode 100644 index 00000000..891e1336 --- /dev/null +++ b/src/boot/README @@ -0,0 +1,405 @@ +An informal guide to reading and working on the rustboot compiler. +================================================================== + +First off, my sincerest apologies for the lightly-commented nature of the +compiler, as well as the general immaturity of the codebase; rustboot is +intended to be discarded in the near future as we transition off it, to a +rust-based, LLVM-backed compiler. It has taken longer than expected for "the +near future" to arrive, and here we are published and attracting contributors +without a good place for them to start. It will be a priority for the next +little while to make new contributors feel welcome and oriented within the +project; best I can do at this point. We were in a tremendous rush even to get +everything organized to this minimal point. + +If you wish to expand on this document, or have one of the +slightly-more-familiar authors add anything else to it, please get in touch or +file a bug. Your concerns are probably the same as someone else's. + + + +High-level concepts, invariants, 30,000-ft view +=============================================== + +Rustboot has 3 main subdirectories: fe, me, and be (front, mid, back +end). Helper modules and ubiquitous types are found in util/. + +The entry-point for the compiler is driver/main.ml, and this file sequences +the various parts together. + + +The 4 central data structures: +------------------------------ + +#1: fe/ast.ml defines the AST. The AST is treated as immutable after parsing + despite containing some mutable types (hashtbl and such). Many -- though + not all -- nodes within this data structure are wrapped in the type 'a + identified. This is important. An "identified" AST node is one that the + parser has marked with a unique node_id value. This node_id is used both + to denote a source location and, more importantly, to key into a large + number of tables later in the compiler. Most additional calculated + properties of a program that the compiler derives are keyed to the node_id + of an identified node. + + The types 'a identified, node_id and such are in util/common.ml + + +#2: me/semant.ml defines the Semant.ctxt structure. This is a record of + tables, almost all of which are keyed by node_id. See previous comment + regrding node_id. The Semant module is open in most of the modules within + the me/ directory, and they all refer liberally to the ctxt tables, either + directly or via helper functions in semant. Semant also defines the + mid-end pass-management logic, lookup routines, type folds, and a variety + of other miscallaneous semantic-analysis helpers. + + +#3: be/il.ml defines the IL. This is a small, typed IL based on a type system + that is relatively LLVM-ish, and a control-flow system that is *not* + expression/SSA based like LLVM. It's much dumber than that. The root of + the interesting types in this file is the type 'emitter', which is a + growable buffer along with a few counters. An emitter is essentially a + buffer of quads. A quad, in turn, is a primitive virtual instruction + ('quad' because it is in its limit a 3-address machine, plus opcode) which + we then ... tend to turn directly into x86 anyways. Sorry; it wasn't clear + during initial construction that we'd wind up stopping at x86, so the IL + is probably superfluous, but there it is. + + The IL types are operand = cell | immediate, and cell = reg | mem. Plus a + certain quantity of special-casing and noise for constant-pointer + propagation and addressing modes and whatnot. + + +#4: be/asm.ml defines the Asm.frag type, which is a "chunk of binary-ish + stuff" to put in an output file. Words, bytes, lazily-resolved fixups, + constant expressions, 0-terminated strings, alignment boundaries, etc. You + will hopefully not need to produce a lot of this yourself; most of this is + already being emitted. + + An important type that gets resolved here is fixup, from util/common.ml. + Fixups are things you can wrap around a frag using an Asm.DEF frag, which + get their size and position (both in-file and in-memory) calculated at + asm-time; but you can refer to them before they're resolved. So any time + the compiler needs to refer to "the place / size this thingy will be, when + it finally gets boiled down to frags and emitted" we generate a fixup and + use that. Functions and static data structures, for example, tend to get + fixups assigned to them early on in the middle-end of the compiler. + + +Control and information flow within the compiler: +------------------------------------------------- + +- driver/main.ml assumes control on startup. Options are parsed, platform is + detected, etc. + + +- fe/lexer.ml does lexing in any case; fe/parser.ml holds the fundamental + parser-state and parser-combinator functions. Parsing rules are split + between 3 files: fe/cexp.ml, fe/pexp.ml, and fe/item.ml. This split + represents the general structure of the grammar(s): + + - The outermost grammar is called "cexp" (crate expression), and is an + expression language that describes the crate directives found in crate + files. It's evaluated inside the compiler. + + - The next grammar is "item", which is a statement language that describes + the directives, declarations and statements found in source files. If + you compile a naked source file, you jump straight to item and then + synthesize a simple crate structure around the result. + + - The innermost grammar is "pexp" (parsed expression), and is an + expression language used for the shared expression grammar within both + cexp and item. Pexps within cexp are evaluated in the compiler + (non-constant, complex cexps are errors) whereas pexps within items are + desugared to statements and primitive expressions. + + - The AST is the output from the item grammar. Pexp and cexp do not escape + the front-end. + + +- driver/main.ml then builds a Semant.ctxt and threads it through the various + middle-end passes. Each pass defines one or more visitors, which is an FRU + copy of the empty_visitor in me/walk.ml. Each visitor performs a particular + task, encapsulates some local state in local variables, and leaves its + results in a table. If the table it's calculating is pass-local, it will be + a local binding within the pass; if it's to be shared with later passes, it + will be a table in Semant.ctxt. Pass order is therefore somewhat important, + so I'll describe it here: + + - me/resolve.ml looks up names and connects them to definitions. This + includes expanding all types (as types can occur within names, as part + of a parametric name) and performing all import/export/visibility + judgments. After resolve, we should not be doing any further name-based + lookups (with one exception: typestate does some more name + lookup. Subtle reason, will return to it). + + Resolve populates several of the tables near the top of Semant.ctxt: + + ctxt_all_cast_types + ctxt_all_defns + ctxt_all_item_names + ctxt_all_item_types + ctxt_all_lvals + ctxt_all_stmts + ctxt_all_type_items + ctxt_block_items + ctxt_block_slots + ctxt_frame_args + ctxt_lval_to_referent + ctxt_node_referenced + ctxt_required_items + ctxt_slot_is_arg + ctxt_slot_keys + + The most obviously critical of these are lval_to_referent and all_defns, + which connect subsequent visitors from a reference node to its referent + node, and catalogue all the possible things a referent may be. + + Part of resolving that is perhaps not obvious is the task of resolving + and normalizing recursive types. This is what TY_iso is for. Recursive + types in rust have to pass through a tag type on their recursive edge; + TY_iso is an iso-recursive group of tags that refer only to one another; + within a TY_iso, the type term "TY_idx n" refers to "the nth member of + the current TY_iso". Resolve is responsible for finding such groups and + tying them into such closed-form knots. + + TY_name should be completely eliminated in any of the types exiting + resolve. + + + - me/type.ml is a unification-based typechecker and inference engine. This + is as textbook-y as we could make it. It rewrites "auto" slots in the + ctxt_all_defns table when it completes (these are the slots with None as + their Ast.slot_ty). + + This file is organized around tyspecs and tyvars. A tyspec is a + constraint on an unknown type that is implied by its use; tyspecs are + generated during the AST-walk, placed in ref cells (tyvars), and the + cells are and unified with one another. If two tyvars unify, then a new + constraint is created with the tighter of the two and the two previous + tyvars are updated to point to the unified spec. Ideally all constraints + eventually run into a source of a concrete type (or a type otherwise + uniquely-determined by its tyspecs). If not, the type is underdetermined + and we get a type error. Similarly if two tyvars that are supposed to + unify clash in some way (integer unify-with string, say) then there is + also a type error. + + + - me/typestate.ml is a dataflow-based typestate checker. It is responsible + for ensuring all preconditions are met, including init-before-use. It + also determines slot lifecycle boundaries, and populates the context + tables: + + ctxt_constr_ids + ctxt_constrs + ctxt_copy_stmt_is_init + ctxt_post_stmt_slot_drops + ctxt_postconditions + ctxt_poststates + ctxt_preconditions + ctxt_prestates + + It is organized around constr_keys, a bunch of bitsets, and a CFG. + + A constr_key is a normalized value representing a single constraint that + we wish to be able to refer to within a typestate. Every constr_key gets + a bit number assigned to it. A condition (and a typestate) is a + bit-vector, in which the set bits indicate the constr_keys (indexed by + associatd number) that hold in the condition/typestate. + + There are 4 such bitsets generated for each node in the CFG: + precondition/postcondition and prestate/poststate. The visitors here + figure out all the constr_keys we'll need, then assign all the pre/post + conditions, generate the CFG, calculate the typestates from the CFG, and + check that every typestate satisfies its precondition. + + (Due to the peculiarity that types are pure terms and are not 'a + identified in our AST, we have to do some name-lookup in here as well + when normalizing the const_keys). + + + - Effect is relatively simple: it calculates the effect of each type and + item, and checks that they either match their declarations or are + authorized to be lying. + + + - Loop is even simpler: it calculates loop-depth information for later use + generating foreach loops. It populates the context tables: + + ctxt_block_is_loop_body + ctxt_slot_loop_depths + ctxt_stmt_loop_depths + + + - Alias checks slot-aliasing to ensure none of the rules are broken about + simultaneous aliases and such. It also populates the table + ctxt_slot_is_aliased. + + + - Layout determines the layout of frames, arguments, objects, closures and + such. This includes deciding which slot should go in a vreg and + generating fixups for all frame-spill regions. It populates the context + tables: + + ctxt_block_is_loop_body + ctxt_call_sizes + ctxt_frame_blocks + ctxt_frame_sizes + ctxt_slot_is_obj_state + ctxt_slot_offsets + ctxt_slot_vregs + ctxt_spill_fixups + + There is a useful chunk of ASCII-art in the leading comment of layout, + if you want to see how a frame goes together, I recommend reading it. + + + - Trans is the big one. This is the "translate AST to IL" pass, and it's a + bit of a dumping ground, sadly. Probably 4x the size of any other + pass. Stuff that is common to the x86 and LLVM backends is factored out + into transutil.ml, but it hardly helps. Suggestions welcome for + splitting it further. + + Trans works *imperatively*. It maintains a stack of emitters, one per + function (or helper-function) and emits Il.quads into the top-of-stack + emitter into while it walks the statements of each function. If at any + point it needs to pause to emit a helper function ("glue function") it + pushes a new emitter onto the stack and emits into that. + + Trans populates the context tables: + + ctxt_all_item_code + ctxt_block_fixups + ctxt_data + ctxt_file_code + ctxt_file_fixups + ctxt_fn_fixups + ctxt_glue_code + + The entries in the tables ending in _code are of type Semant.code, which + is an abstract type covering both function and glue-function code; each + holds an executable block of quads, plus an aggregate count of vregs and + a reference to the spill fixup for that code. + + +- Once it completes trans, driver/main.ml does the "finishing touches": + register allocates each emitted code value (be/ra.ml), emits dwarf for the + crate (me/dwarf.ml), selects instructions (be/x86.ml), then selects one of + the object-file backends (be/elf.ml, be/macho.ml or be/pe.ml) and emits the + selected Asm.frag to it. Hopefully little of this will require further work; + the most incomplete module here is probably dwarf.ml but the remainder are + mostly stable and don't tend to change much, aside from picking bugs out of + them. + + + +Details and curiosities to note along the way: +============================================== + +- Where you might expect there to be a general recursive expression type for + 'expr', you'll find only a very limited non-recursive 3-way switch: binary, + unary, or atom; where atom is either a literal or an lval. This is because + all the "big" expressions (pexps) were boiled off during the desugaring + phase in the frontend. + + +- There are multiple ways to refer to a path. Names, lvals and cargs all + appear to have similar structure (and do). They're all subsets of the + general path grammar, so all follow the rough shape of being either a base + anchor-path or an ext (extension) path with structural recursion to the + left. + + Cargs (constraint arguments) are the sort of paths that can be passed to + constraints in the typestate system, and can contain the special symbol "*" + in the grammar, meaning "thing I am attached to". This is the symbol + BASE_formal in the carg_base type. + + Names are the sort of paths that refer to types or other items. Not slots. + + Lvals are the sort of paths that *might* refer to slots, but we don't + generally know. So they can contain the dynamic-indexing component + COMP_atom. For example, x.(1 + 2).y is an lval. + + +- Only one of these forms is 'a identified: an lval. And moreover, only the + lval *base* is identified; the remainder of the path has to be projected + forward through the referent after lookup. This also means that when you + lookup anything else by name, you have to be using the result immediately, + not storing it in a table for later. + + +- Types are not 'a identified. This means that you (generally) cannot refer to + a *particular* occurrence of a type in the AST and associate information + with it. Instead, we treat types as "pure terms" (not carrying identity) and + calculate properties of them on the fly. For this we use a general fold + defined in me/semant.ml, the family of functions held in a ty_fold + structure, and passed to fold_ty. + + +- There is a possibly-surprising type called "size" in util/common. This is a + type representing a "size expression" that may depend on runtime + information, such as the type descriptors passed to a frame at runtime. This + exists because our type-parameterization scheme is, at the moment, + implemented by passing type descriptors around at runtime, not + code-expansion a la C++ templates. So any time we have a translated indexing + operation or such that depends on a type parameter, we wind up with a size + expression including SIZE_param_size or SIZE_param_align, and have to do + size arithmetic at runtime. Upstream of trans, we generate sizes willy-nilly + and then decide in trans, x86, and dwarf whether they can be emitted + statically or via runtime calculation at the point of use. + + +- Trans generates position-independent code (PIC). This means that it never + refers to the exact position of a fixup in memory at load-time, always the + distance-to-a-fixup from some other fixup, and/or current PC. On x86 this + means we wind up copying the "get next pc thunk" trick used on linux + systems, and/or storing "crate relative" addresses. The runtime and compiler + "know" (unfortunately sometimes quite obscurely) that an immediate pointer + should be encoded as relative-to a given displacement base, and work with + those as necessary. Similarly, they emit code to reify pointer immediates + (add the displacements to displacement-bases) before handing them off to + (say) C library functions that expect "real" pointers. This is all somewhat + messy. + + +- There is one central static data structure, "rust_crate", which is emitted + into the final loadable object and contains pointers to all subsequent + information the runtime may be interested in. It also serves as the + displacement base for a variety of PIC-ish displacements stored + elsewhere. When the runtime loads a crate, it dlsym()s rust_crate, and then + digs around in there. It's the entry-point for crawling the crate's + structure from outside. Importantly: it also contains pointers to the dwarf. + + +- Currently we drive linking off dwarf. That is: when a crate needs to 'use' + an item from another dwarf crate, we dlopen / LoadLibrary and find the + "rust_crate" value, follow its pointers to dwarf tables, and scan around the + dwarf DIE tree resolving the hierarchical name of the used item. This may + change, we decided to recycle dwarf for this purpose early in the language + evolution and may, given the number of simplifications that have occurred + along the way, be able to fall back to C "mangled name" linkage at some + point. Though that decision carries a number of serious constraints, and + should not be taken lightly. + + + +Probably-bad ideas we will want to do differently in the self-hosted compiler: +============================================================================== + +- We desugar too early in rustboot and should preserve the pexp structure + until later. Dherman is likely to argue for movement to a more + expression-focused grammar. This may well happen. + +- Multiple kinds of paths enforced by numerous nearly-isomorphic ML type + constructors is pointless once we're in rust; we can just make type + abbreviations that carry constraints like path : is_name(*) or such. + +- Storing auxiliary information in semant tables is awkward, and we should + figure out a suitably rusty idiom for decorating AST nodes in-place. + Inter-pass dependencies should be managed by augmenting the AST with + ever-more constraints (is_resolved(ast), is_typechecked(ast), etc.) + +- Trans should be organized as pure and value-producing code, not imperatively + emitting quads into emitters. LLVM will enforce this anyways. See what + happened in lltrans.ml if you're curious what it'll look (more) like. + +- The PIC scheme will have to change, hopefully get much easier. + diff --git a/src/boot/be/abi.ml b/src/boot/be/abi.ml index 44f9761b..bd71229d 100644 --- a/src/boot/be/abi.ml +++ b/src/boot/be/abi.ml @@ -68,18 +68,18 @@ let vec_elt_data = 3;; let calltup_elt_out_ptr = 0;; let calltup_elt_task_ptr = 1;; -let calltup_elt_ty_params = 2;; -let calltup_elt_args = 3;; -let calltup_elt_iterator_args = 4;; -let calltup_elt_indirect_args = 5;; +let calltup_elt_indirect_args = 2;; +let calltup_elt_ty_params = 3;; +let calltup_elt_args = 4;; +let calltup_elt_iterator_args = 5;; let iterator_args_elt_block_fn = 0;; let iterator_args_elt_outer_frame_ptr = 1;; let indirect_args_elt_closure = 0;; -(* ty_params, src, dst, tydesc, taskptr. *) -let worst_case_glue_call_args = 5;; +(* dst, taskptr, closure-ptr, ty_params, src, src2=target_task *) +let worst_case_glue_call_args = 6;; type abi = { diff --git a/src/boot/be/x86.ml b/src/boot/be/x86.ml index d18cf11f..811da12a 100644 --- a/src/boot/be/x86.ml +++ b/src/boot/be/x86.ml @@ -536,11 +536,12 @@ let frame_base_sz = Int64.mul (Int64.of_int frame_base_words) word_sz;; let frame_info_words = 2 (* crate ptr, crate-rel frame info disp *) ;; let frame_info_sz = Int64.mul (Int64.of_int frame_info_words) word_sz;; -let implicit_arg_words = 2 (* task ptr,out ptr *);; -let implicit_args_sz = Int64.mul (Int64.of_int implicit_arg_words) word_sz;; +let implicit_arg_words = 3 (* task ptr, out ptr, closure ptr *);; +let implicit_args_sz = Int64.mul (Int64.of_int implicit_arg_words) word_sz;; let out_ptr = wordptr_n (Il.Hreg ebp) (frame_base_words);; let task_ptr = wordptr_n (Il.Hreg ebp) (frame_base_words+1);; +let closure_ptr = wordptr_n (Il.Hreg ebp) (frame_base_words+2);; let ty_param_n i = wordptr_n (Il.Hreg ebp) (frame_base_words + implicit_arg_words + i);; @@ -855,6 +856,7 @@ let sweep_gc_chain (c (ecx_n Abi.tydesc_field_first_param)); push (ro eax); (* Push typarams ptr. *) + push (immi 0L); (* Push null closure-ptr *) push (c task_ptr); (* Push task ptr. *) push (immi 0L); (* Push null outptr. *) @@ -1428,14 +1430,6 @@ let fn_tail_call ;; -let loop_info_field_retpc = 0;; -let loop_info_field_sp = 1;; -let loop_info_field_fp = 2;; - -let self_args_cell (self_args_rty:Il.referent_ty) : Il.cell = - Il.Mem (Il.RegIn (h ebp, Some (Asm.IMM frame_base_sz)), self_args_rty) -;; - let activate_glue (e:Il.emitter) : unit = (* * This is a bit of glue-code. It should be emitted once per diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml index f3991e9b..0f61eec4 100644 --- a/src/boot/fe/ast.ml +++ b/src/boot/fe/ast.ml @@ -35,6 +35,11 @@ type effect = | UNSAFE ;; +type mutability = + MUT_mutable + | MUT_immutable +;; + type name_base = BASE_ident of ident | BASE_temp of temp_id @@ -187,9 +192,9 @@ and ty_obj = (effect * ((ident,ty_fn) Hashtbl.t)) and check_calls = (lval * (atom array)) array -and rec_input = (ident * atom) +and rec_input = (ident * mutability * atom) -and tup_input = atom +and tup_input = (mutability * atom) and stmt' = @@ -197,11 +202,11 @@ and stmt' = STMT_spawn of (lval * domain * lval * (atom array)) | STMT_init_rec of (lval * (rec_input array) * lval option) | STMT_init_tup of (lval * (tup_input array)) - | STMT_init_vec of (lval * atom array) + | STMT_init_vec of (lval * mutability * atom array) | STMT_init_str of (lval * string) | STMT_init_port of lval | STMT_init_chan of (lval * (lval option)) - | STMT_init_box of (lval * atom) + | STMT_init_box of (lval * mutability * atom) | STMT_copy of (lval * expr) | STMT_copy_binop of (lval * binop * atom) | STMT_call of (lval * lval * (atom array)) @@ -283,7 +288,7 @@ and stmt_for_each = and stmt_for = { for_slot: (slot identified * ident); - for_seq: ((stmt array) * lval); + for_seq: lval; for_body: block; } @@ -1018,7 +1023,8 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = do if i != 0 then fmt ff ", "; - let (ident, atom) = entries.(i) in + let (ident, mutability, atom) = entries.(i) in + if mutability = MUT_mutable then fmt ff "mutable "; fmt_ident ff ident; fmt ff " = "; fmt_atom ff atom; @@ -1032,9 +1038,11 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = end; fmt ff ");" - | STMT_init_vec (dst, atoms) -> + | STMT_init_vec (dst, mutability, atoms) -> fmt_lval ff dst; - fmt ff " = vec("; + fmt ff " = vec"; + if mutability = MUT_mutable then fmt ff "[mutable]"; + fmt ff "("; for i = 0 to (Array.length atoms) - 1 do if i != 0 @@ -1050,7 +1058,9 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = do if i != 0 then fmt ff ", "; - fmt_atom ff entries.(i); + let (mutability, atom) = entries.(i) in + if mutability = MUT_mutable then fmt ff "mutable "; + fmt_atom ff atom; done; fmt ff ");"; @@ -1098,7 +1108,7 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = | STMT_for sfor -> let (slot, ident) = sfor.for_slot in - let (stmts, lval) = sfor.for_seq in + let lval = sfor.for_seq in begin fmt_obox ff; fmt ff "for ("; @@ -1106,7 +1116,6 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = fmt ff " "; fmt_ident ff ident; fmt ff " in "; - fmt_stmts ff stmts; fmt_lval ff lval; fmt ff ") "; fmt_obr ff; @@ -1167,9 +1176,10 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit = fmt_lval ff t; fmt ff ";" - | STMT_init_box (lv, at) -> + | STMT_init_box (lv, mutability, at) -> fmt_lval ff lv; fmt ff " = @@"; + if mutability = MUT_mutable then fmt ff " mutable "; fmt_atom ff at; fmt ff ";" @@ -1339,6 +1349,33 @@ and fmt_crate (ff:Format.formatter) (c:crate) : unit = let (view,items) = c.node.crate_items in fmt_mod_view ff view; fmt_mod_items ff items +;; + +let ty_children (ty:ty) : ty array = + let children_of_ty_tag ty_tag = Array.concat (htab_vals ty_tag) in + let children_of_ty_fn ty_fn = + let (ty_sig, _) = ty_fn in + let in_slots = ty_sig.sig_input_slots in + let slots = Array.append in_slots [| ty_sig.sig_output_slot |] in + arr_filter_some (Array.map (fun slot -> slot.slot_ty) slots) + in + match ty with + TY_tup tys -> tys + | TY_vec ty' | TY_chan ty' | TY_port ty' | TY_box ty' | TY_mutable ty' + | TY_constrained (ty', _) -> + [| ty' |] + | TY_rec fields -> Array.map snd fields + | TY_tag ty_tag -> children_of_ty_tag ty_tag + | TY_iso ty_iso -> + children_of_ty_tag (ty_iso.iso_group.(ty_iso.iso_index)) + | TY_fn ty_fn -> children_of_ty_fn ty_fn + | TY_obj (_, methods) -> + Array.concat (List.map children_of_ty_fn (htab_vals methods)) + | TY_any | TY_nil | TY_bool | TY_mach _ | TY_int | TY_uint | TY_char + | TY_str | TY_idx _ | TY_task | TY_native _ | TY_param _ + | TY_named _ | TY_type -> + [| |] +;; let sprintf_expr = sprintf_fmt fmt_expr;; let sprintf_name = sprintf_fmt fmt_name;; diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml index 87604cb0..d0042ebf 100644 --- a/src/boot/fe/item.ml +++ b/src/boot/fe/item.ml @@ -369,17 +369,18 @@ and parse_stmts (ps:pstate) : Ast.stmt array = let inner ps = let slot = (parse_identified_slot_and_ident false ps) in let _ = (expect ps IN) in - let lval = (parse_lval ps) in - (slot, lval) in - let (slot, seq) = + (slot, (parse_lval ps)) + in + let (slot, (stmts, lval)) = ctxt "stmts: for head" (bracketed LPAREN RPAREN inner) ps in let body_block = ctxt "stmts: for body" parse_block ps in let bpos = lexpos ps in - [| span ps apos bpos - (Ast.STMT_for + Array.append stmts + [| span ps apos bpos + (Ast.STMT_for { Ast.for_slot = slot; - Ast.for_seq = seq; + Ast.for_seq = lval; Ast.for_body = body_block; }) |] end @@ -498,7 +499,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array = expect ps SEMI; spans ps stmts apos (Ast.STMT_join lval) - | MOD | OBJ | TYPE | FN | USE | NATIVE -> + | IO | STATE | UNSAFE | MOD | OBJ | TYPE | FN | USE | NATIVE -> let (ident, item) = ctxt "stmt: decl" parse_mod_item ps in let decl = Ast.DECL_mod_item (ident, item) in let stmts = expand_tags_to_stmts ps item in diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml index 14065466..27ec8810 100644 --- a/src/boot/fe/pexp.ml +++ b/src/boot/fe/pexp.ml @@ -20,9 +20,9 @@ type pexp' = PEXP_call of (pexp * pexp array) | PEXP_spawn of (Ast.domain * pexp) | PEXP_bind of (pexp * pexp option array) - | PEXP_rec of ((Ast.ident * pexp) array * pexp option) - | PEXP_tup of (pexp array) - | PEXP_vec of (pexp array) + | PEXP_rec of ((Ast.ident * Ast.mutability * pexp) array * pexp option) + | PEXP_tup of ((Ast.mutability * pexp) array) + | PEXP_vec of Ast.mutability * (pexp array) | PEXP_port | PEXP_chan of (pexp option) | PEXP_binop of (Ast.binop * pexp * pexp) @@ -32,8 +32,7 @@ type pexp' = | PEXP_lval of plval | PEXP_lit of Ast.lit | PEXP_str of string - | PEXP_mutable of pexp - | PEXP_box of pexp + | PEXP_box of Ast.mutability * pexp | PEXP_custom of Ast.name * (pexp array) * (string option) and plval = @@ -177,6 +176,11 @@ and parse_effect (ps:pstate) : Ast.effect = | UNSAFE -> bump ps; Ast.UNSAFE | _ -> Ast.PURE +and parse_mutability (ps:pstate) : Ast.mutability = + match peek ps with + MUTABLE -> bump ps; Ast.MUT_mutable + | _ -> Ast.MUT_immutable + and parse_ty_fn (effect:Ast.effect) (ps:pstate) @@ -421,13 +425,14 @@ and parse_ty (ps:pstate) : Ast.ty = parse_constrained_ty ps -and parse_rec_input (ps:pstate) : (Ast.ident * pexp) = +and parse_rec_input (ps:pstate) : (Ast.ident * Ast.mutability * pexp) = + let mutability = parse_mutability ps in let lab = (ctxt "rec input: label" parse_ident ps) in match peek ps with EQ -> bump ps; let pexp = ctxt "rec input: expr" parse_pexp ps in - (lab, pexp) + (lab, mutability, pexp) | _ -> raise (unexpected ps) @@ -439,7 +444,7 @@ and parse_rec_body (ps:pstate) : pexp' = (*((Ast.ident * pexp) array) =*) | WITH -> raise (err "empty record extension" ps) | _ -> let inputs = one_or_more COMMA parse_rec_input ps in - let labels = Array.map (fun (l, _) -> l) inputs in + let labels = Array.map (fun (l, _, _) -> l) inputs in begin check_dup_rec_labels ps labels; match peek ps with @@ -472,21 +477,18 @@ and parse_bottom_pexp (ps:pstate) : pexp = let apos = lexpos ps in match peek ps with - MUTABLE -> - bump ps; - let inner = parse_pexp ps in - let bpos = lexpos ps in - span ps apos bpos (PEXP_mutable inner) - - | AT -> + AT -> bump ps; + let mutability = parse_mutability ps in let inner = parse_pexp ps in let bpos = lexpos ps in - span ps apos bpos (PEXP_box inner) + span ps apos bpos (PEXP_box (mutability, inner)) | TUP -> bump ps; - let pexps = ctxt "paren pexps(s)" (rstr false parse_pexp_list) ps in + let pexps = + ctxt "paren pexps(s)" (rstr false parse_mutable_and_pexp_list) ps + in let bpos = lexpos ps in span ps apos bpos (PEXP_tup pexps) @@ -498,11 +500,18 @@ and parse_bottom_pexp (ps:pstate) : pexp = | VEC -> bump ps; - begin - let pexps = ctxt "vec pexp: exprs" parse_pexp_list ps in - let bpos = lexpos ps in - span ps apos bpos (PEXP_vec pexps) - end + let mutability = + match peek ps with + LBRACKET -> + bump ps; + expect ps MUTABLE; + expect ps RBRACKET; + Ast.MUT_mutable + | _ -> Ast.MUT_immutable + in + let pexps = ctxt "vec pexp: exprs" parse_pexp_list ps in + let bpos = lexpos ps in + span ps apos bpos (PEXP_vec (mutability, pexps)) | LIT_STR s -> @@ -947,6 +956,9 @@ and parse_as_pexp (ps:pstate) : pexp = and parse_pexp (ps:pstate) : pexp = parse_as_pexp ps +and parse_mutable_and_pexp (ps:pstate) : (Ast.mutability * pexp) = + let mutability = parse_mutability ps in + (mutability, parse_as_pexp ps) and parse_pexp_list (ps:pstate) : pexp array = match peek ps with @@ -955,6 +967,13 @@ and parse_pexp_list (ps:pstate) : pexp array = (ctxt "pexp list" parse_pexp) ps | _ -> raise (unexpected ps) +and parse_mutable_and_pexp_list (ps:pstate) : (Ast.mutability * pexp) array = + match peek ps with + LPAREN -> + bracketed_zero_or_more LPAREN RPAREN (Some COMMA) + (ctxt "mutable-and-pexp list" parse_mutable_and_pexp) ps + | _ -> raise (unexpected ps) + ;; (* @@ -1099,8 +1118,7 @@ and desugar_expr_atom | PEXP_bind _ | PEXP_spawn _ | PEXP_custom _ - | PEXP_box _ - | PEXP_mutable _ -> + | PEXP_box _ -> let (_, tmp, decl_stmt) = build_tmp ps slot_auto apos bpos in let stmts = desugar_expr_init ps tmp pexp in (Array.append [| decl_stmt |] stmts, @@ -1233,11 +1251,11 @@ and desugar_expr_init begin Array.map begin - fun (ident, pexp) -> + fun (ident, mutability, pexp) -> let (stmts, atom) = desugar_expr_atom ps pexp in - (stmts, (ident, atom)) + (stmts, (ident, mutability, atom)) end args end @@ -1259,19 +1277,24 @@ and desugar_expr_init end | PEXP_tup args -> + let muts = Array.to_list (Array.map fst args) in let (arg_stmts, arg_atoms) = - desugar_expr_atoms ps args + desugar_expr_atoms ps (Array.map snd args) in - let stmt = ss (Ast.STMT_init_tup (dst_lval, arg_atoms)) in + let arg_atoms = Array.to_list arg_atoms in + let tup_args = Array.of_list (List.combine muts arg_atoms) in + let stmt = ss (Ast.STMT_init_tup (dst_lval, tup_args)) in aa arg_stmts [| stmt |] | PEXP_str s -> let stmt = ss (Ast.STMT_init_str (dst_lval, s)) in [| stmt |] - | PEXP_vec args -> + | PEXP_vec (mutability, args) -> let (arg_stmts, arg_atoms) = desugar_expr_atoms ps args in - let stmt = ss (Ast.STMT_init_vec (dst_lval, arg_atoms)) in + let stmt = + ss (Ast.STMT_init_vec (dst_lval, mutability, arg_atoms)) + in aa arg_stmts [| stmt |] | PEXP_port -> @@ -1296,20 +1319,15 @@ and desugar_expr_init in aa port_stmts [| chan_stmt |] - | PEXP_box arg -> + | PEXP_box (mutability, arg) -> let (arg_stmts, arg_mode_atom) = desugar_expr_atom ps arg in - let stmt = ss (Ast.STMT_init_box (dst_lval, arg_mode_atom)) in + let stmt = + ss (Ast.STMT_init_box (dst_lval, mutability, arg_mode_atom)) + in aa arg_stmts [| stmt |] - | PEXP_mutable arg -> - (* Initializing a local from a "mutable" atom is the same as - * initializing it from an immutable one; all locals are mutable - * anyways. So this is just a fall-through. - *) - desugar_expr_init ps dst_lval arg - | PEXP_custom (n, a, b) -> let (arg_stmts, args) = desugar_expr_atoms ps a in let stmts = diff --git a/src/boot/llvm/lltrans.ml b/src/boot/llvm/lltrans.ml index a7daa371..1f268fa1 100644 --- a/src/boot/llvm/lltrans.ml +++ b/src/boot/llvm/lltrans.ml @@ -761,10 +761,10 @@ let trans_crate let trans_tail () = trans_tail_with_builder llbuilder in match head.node with - Ast.STMT_init_tup (dest, atoms) -> + Ast.STMT_init_tup (dest, elems) -> let zero = const_i32 0 in let lldest = trans_lval dest in - let trans_tup_atom idx atom = + let trans_tup_elem idx (_, atom) = let indices = [| zero; const_i32 idx |] in let gep_id = anon_llid "init_tup_gep" in let ptr = @@ -772,7 +772,7 @@ let trans_crate in ignore (Llvm.build_store (trans_atom atom) ptr llbuilder) in - Array.iteri trans_tup_atom atoms; + Array.iteri trans_tup_elem elems; trans_tail () | Ast.STMT_copy (dest, src) -> diff --git a/src/boot/me/alias.ml b/src/boot/me/alias.ml index d98316ef..148f1249 100644 --- a/src/boot/me/alias.ml +++ b/src/boot/me/alias.ml @@ -67,7 +67,7 @@ let alias_analysis_visitor | Ast.STMT_recv (dst, _) -> alias dst | Ast.STMT_init_port (dst) -> alias dst | Ast.STMT_init_chan (dst, _) -> alias dst - | Ast.STMT_init_vec (dst, _) -> alias dst + | Ast.STMT_init_vec (dst, _, _) -> alias dst | Ast.STMT_init_str (dst, _) -> alias dst | Ast.STMT_for_each sfe -> let (slot, _) = sfe.Ast.for_each_slot in @@ -118,7 +118,8 @@ let process_crate Walk.empty_visitor); |] in - run_passes cx "alias" path passes (log cx "%s") crate + run_passes cx "alias" path passes + cx.ctxt_sess.Session.sess_log_alias log crate ;; (* diff --git a/src/boot/me/dead.ml b/src/boot/me/dead.ml index 47e56166..61aa846a 100644 --- a/src/boot/me/dead.ml +++ b/src/boot/me/dead.ml @@ -106,7 +106,8 @@ let process_crate |] in - run_passes cx "dead" path passes (log cx "%s") crate; + run_passes cx "dead" path passes + cx.ctxt_sess.Session.sess_log_dead log crate; () ;; diff --git a/src/boot/me/dwarf.ml b/src/boot/me/dwarf.ml index cdc88da7..f1d51f16 100644 --- a/src/boot/me/dwarf.ml +++ b/src/boot/me/dwarf.ml @@ -1450,7 +1450,7 @@ let dwarf_visitor let iso_stack = Stack.create () in - let path_name _ = Fmt.fmt_to_str Ast.fmt_name (Walk.path_to_name path) in + let path_name _ = Fmt.fmt_to_str Ast.fmt_name (path_to_name path) in let (abbrev_table:(abbrev, int) Hashtbl.t) = Hashtbl.create 0 in @@ -2547,7 +2547,8 @@ let process_crate in log cx "emitting DWARF records"; - run_passes cx "dwarf" path passes (log cx "%s") crate; + run_passes cx "dwarf" path passes + cx.ctxt_sess.Session.sess_log_dwarf log crate; (* Terminate the tables. *) { diff --git a/src/boot/me/effect.ml b/src/boot/me/effect.ml index 3ec492c8..9ddef63d 100644 --- a/src/boot/me/effect.ml +++ b/src/boot/me/effect.ml @@ -328,7 +328,8 @@ let process_crate else err (Some id) "auth clause in crate refers to non-item" in Hashtbl.iter auth_effect crate.node.Ast.crate_auth; - run_passes cx "effect" path passes (log cx "%s") crate + run_passes cx "effect" path passes + cx.ctxt_sess.Session.sess_log_effect log crate ;; (* diff --git a/src/boot/me/layout.ml b/src/boot/me/layout.ml index 365acbf9..e1a7ff47 100644 --- a/src/boot/me/layout.ml +++ b/src/boot/me/layout.ml @@ -21,7 +21,8 @@ let layout_visitor * |... | * |... | * +----------------------------+ <-- fp + abi_frame_base_sz - * |task ptr (implicit arg) | + abi_implicit_args_sz + * |closure/obj ptr (impl. arg) | + abi_implicit_args_sz + * |task ptr (implicit arg) | * |output ptr (implicit arg) | * +----------------------------+ <-- fp + abi_frame_base_sz * |return pc | @@ -456,7 +457,8 @@ let process_crate Walk.empty_visitor) |]; in - run_passes cx "layout" path passes (log cx "%s") crate + run_passes cx "layout" path passes + cx.ctxt_sess.Session.sess_log_layout log crate ;; diff --git a/src/boot/me/loop.ml b/src/boot/me/loop.ml index c23c4afd..1fbb8223 100644 --- a/src/boot/me/loop.ml +++ b/src/boot/me/loop.ml @@ -148,8 +148,8 @@ let process_crate |] in - run_passes cx "loop" path passes (log cx "%s") crate; - () + run_passes cx "loop" path passes + cx.ctxt_sess.Session.sess_log_loop log crate ;; diff --git a/src/boot/me/resolve.ml b/src/boot/me/resolve.ml index 77fdbb3b..2c2b1b4b 100644 --- a/src/boot/me/resolve.ml +++ b/src/boot/me/resolve.ml @@ -167,7 +167,7 @@ let all_item_collecting_visitor Array.iter (fun p -> htab_put cx.ctxt_all_defns p.id (DEFN_ty_param p.node)) p; htab_put cx.ctxt_all_defns i.id (DEFN_item i.node); - htab_put cx.ctxt_all_item_names i.id (Walk.path_to_name path); + htab_put cx.ctxt_all_item_names i.id (path_to_name path); log cx "collected item #%d: %s" (int_of_node i.id) n; begin match i.node.Ast.decl_item with @@ -191,14 +191,14 @@ let all_item_collecting_visitor let visit_obj_fn_pre obj ident fn = htab_put cx.ctxt_all_defns fn.id (DEFN_obj_fn (obj.id, fn.node)); - htab_put cx.ctxt_all_item_names fn.id (Walk.path_to_name path); + htab_put cx.ctxt_all_item_names fn.id (path_to_name path); note_header fn.id fn.node.Ast.fn_input_slots; inner.Walk.visit_obj_fn_pre obj ident fn in let visit_obj_drop_pre obj b = htab_put cx.ctxt_all_defns b.id (DEFN_obj_drop obj.id); - htab_put cx.ctxt_all_item_names b.id (Walk.path_to_name path); + htab_put cx.ctxt_all_item_names b.id (path_to_name path); inner.Walk.visit_obj_drop_pre obj b in @@ -210,7 +210,7 @@ let all_item_collecting_visitor htab_put cx.ctxt_all_defns id (DEFN_loop_body (Stack.top items)); htab_put cx.ctxt_all_item_names id - (Walk.path_to_name path); + (path_to_name path); | _ -> () end; inner.Walk.visit_stmt_pre s; @@ -1035,14 +1035,14 @@ let process_crate export_referencing_visitor cx Walk.empty_visitor |] in - + let log_flag = cx.ctxt_sess.Session.sess_log_resolve in log cx "running primary resolve passes"; - run_passes cx "resolve collect" path passes_0 (log cx "%s") crate; + run_passes cx "resolve collect" path passes_0 log_flag log crate; resolve_recursion cx node_to_references recursive_tag_groups; log cx "running secondary resolve passes"; - run_passes cx "resolve bind" path passes_1 (log cx "%s") crate; + run_passes cx "resolve bind" path passes_1 log_flag log crate; log cx "running tertiary resolve passes"; - run_passes cx "resolve patterns" path passes_2 (log cx "%s") crate; + run_passes cx "resolve patterns" path passes_2 log_flag log crate; iflog cx begin diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 64f2c939..434fb025 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -583,13 +583,13 @@ let atoms_slots (cx:ctxt) (az:Ast.atom array) : node_id array = ;; let tup_inputs_slots (cx:ctxt) (az:Ast.tup_input array) : node_id array = - Array.concat (List.map (atom_slots cx) (Array.to_list az)) + Array.concat (List.map (atom_slots cx) (Array.to_list (Array.map snd az))) ;; let rec_inputs_slots (cx:ctxt) (inputs:Ast.rec_input array) : node_id array = Array.concat (List.map - (fun (_, atom) -> atom_slots cx atom) + (fun (_, _, atom) -> atom_slots cx atom) (Array.to_list inputs)) ;; @@ -1506,6 +1506,97 @@ let unreferenced_required_item_ignoring_visitor Walk.visit_obj_drop_post = visit_obj_drop_post; } ;; +let rec name_of ncs = + match ncs with + [] -> bug () "Walk.name_of_ncs: empty path" + | [(Ast.COMP_ident i)] -> Ast.NAME_base (Ast.BASE_ident i) + | [(Ast.COMP_app x)] -> Ast.NAME_base (Ast.BASE_app x) + | [(Ast.COMP_idx _)] -> + bug () "Walk.name_of_ncs: path-name contains COMP_idx" + | nc::ncs -> Ast.NAME_ext (name_of ncs, nc) +;; + +let path_to_name + (path:Ast.name_component Stack.t) + : Ast.name = + name_of (stk_elts_from_top path) +;; + +let mod_item_logging_visitor + (cx:ctxt) + (log_flag:bool) + (log:ctxt -> ('a, unit, string, unit) format4 -> 'a) + (pass:int) + (path:Ast.name_component Stack.t) + (inner:Walk.visitor) + : Walk. +visitor = + let entering _ = + if log_flag + then + log cx "pass %d: entering %a" + pass Ast.sprintf_name (path_to_name path) + in + let entered _ = + if log_flag + then + log cx "pass %d: entered %a" + pass Ast.sprintf_name (path_to_name path) + in + let leaving _ = + if log_flag + then + log cx "pass %d: leaving %a" + pass Ast.sprintf_name (path_to_name path) + in + let left _ = + if log_flag + then + log cx "pass %d: left %a" + pass Ast.sprintf_name (path_to_name path) + in + + let visit_mod_item_pre name params item = + entering(); + inner.Walk.visit_mod_item_pre name params item; + entered(); + in + let visit_mod_item_post name params item = + leaving(); + inner.Walk.visit_mod_item_post name params item; + left(); + in + let visit_obj_fn_pre obj ident fn = + entering(); + inner.Walk.visit_obj_fn_pre obj ident fn; + entered(); + in + let visit_obj_fn_post obj ident fn = + leaving(); + inner.Walk.visit_obj_fn_post obj ident fn; + left(); + in + let visit_obj_drop_pre obj b = + entering(); + inner.Walk.visit_obj_drop_pre obj b; + entered(); + in + let visit_obj_drop_post obj fn = + leaving(); + inner.Walk.visit_obj_drop_post obj fn; + left(); + in + { inner with + Walk.visit_mod_item_pre = visit_mod_item_pre; + Walk.visit_mod_item_post = visit_mod_item_post; + Walk.visit_obj_fn_pre = visit_obj_fn_pre; + Walk.visit_obj_fn_post = visit_obj_fn_post; + Walk.visit_obj_drop_pre = visit_obj_drop_pre; + Walk.visit_obj_drop_post = visit_obj_drop_post; + } +;; + + (* Generic lookup, used for slots, items, types, etc. *) @@ -1752,14 +1843,14 @@ let run_passes (name:string) (path:Ast.name_component Stack.t) (passes:Walk.visitor array) - (log:string->unit) + (log_flag:bool) + (log:ctxt -> ('a, unit, string, unit) format4 -> 'a) (crate:Ast.crate) : unit = let do_pass i pass = - let logger s = log (Printf.sprintf "pass %d: %s" i s) in Walk.walk_crate (Walk.path_managing_visitor path - (Walk.mod_item_logging_visitor logger path pass)) + (mod_item_logging_visitor cx log_flag log i path pass)) crate in let sess = cx.ctxt_sess in @@ -1936,10 +2027,10 @@ let call_args_referent_type_full [| out_ptr_rty; (* Abi.calltup_elt_out_ptr *) task_ptr_rty; (* Abi.calltup_elt_task_ptr *) + Il.StructTy indirect_arg_rtys; (* Abi.calltup_elt_indirect_args *) ty_param_rtys; (* Abi.calltup_elt_ty_params *) arg_rtys; (* Abi.calltup_elt_args *) - Il.StructTy iterator_arg_rtys; (* Abi.calltup_elt_iterator_args *) - Il.StructTy indirect_arg_rtys (* Abi.calltup_elt_indirect_args *) + Il.StructTy iterator_arg_rtys (* Abi.calltup_elt_iterator_args *) |] ;; @@ -1950,13 +2041,12 @@ let call_args_referent_type (closure:Il.referent_ty option) : Il.referent_ty = let indirect_arg_rtys = + (* Abi.indirect_args_elt_closure *) match closure with - None -> [| |] + None -> + [| word_rty cx.ctxt_abi |] | Some c -> - [| - (* Abi.indirect_args_elt_closure *) - Il.ScalarTy (Il.AddrTy c) - |] + [| Il.ScalarTy (Il.AddrTy c) |] in let iterator_arg_rtys _ = [| diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index f77386a9..46329a10 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -225,7 +225,7 @@ let trans_visitor let epilogue_jumps = Stack.create() in let path_name (_:unit) : string = - string_of_name (Walk.path_to_name path) + string_of_name (path_to_name path) in let based (reg:Il.reg) : Il.mem = @@ -1228,8 +1228,8 @@ let trans_visitor (sorted_htab_keys fns)) end - and trans_init_str (dst:Ast.lval) (s:string) : unit = - (* Include null byte. *) + and trans_init_str (dst:Ast.lval) (s:string) : unit = + (* Include null byte. *) let init_sz = Int64.of_int ((String.length s) + 1) in let static = trans_static_string s in let (dst, _) = trans_lval_init dst in @@ -1715,49 +1715,63 @@ let trans_visitor (code:Il.code) (dst:Il.cell option) (args:Il.cell array) + (clo:Il.cell option) : unit = - let inner dst = + let inner dst cloptr = let scratch = next_vreg_cell Il.voidptr_t in let pop _ = emit (Il.Pop scratch) in for i = ((Array.length args) - 1) downto 0 do emit (Il.Push (Il.Cell args.(i))) done; + emit (Il.Push cloptr); emit (Il.Push (Il.Cell abi.Abi.abi_tp_cell)); emit (Il.Push dst); call_code code; pop (); pop (); + pop (); Array.iter (fun _ -> pop()) args; in + let cloptr = + match clo with + None -> zero + | Some cloptr -> Il.Cell cloptr + in match dst with - None -> inner zero - | Some dst -> aliasing true dst (fun dst -> inner (Il.Cell dst)) + None -> inner zero cloptr + | Some dst -> + aliasing true dst (fun dst -> inner (Il.Cell dst) cloptr) and trans_call_static_glue (callee:Il.operand) (dst:Il.cell option) (args:Il.cell array) + (clo:Il.cell option) : unit = - trans_call_glue (code_of_operand callee) dst args + trans_call_glue (code_of_operand callee) dst args clo and trans_call_dynamic_glue (tydesc:Il.cell) (idx:int) (dst:Il.cell option) (args:Il.cell array) + (clo:Il.cell option) : unit = let fptr = get_vtbl_entry_idx tydesc idx in - trans_call_glue (code_of_operand (Il.Cell fptr)) dst args + trans_call_glue (code_of_operand (Il.Cell fptr)) dst args clo and trans_call_simple_static_glue (fix:fixup) (ty_params:Il.cell) - (arg:Il.cell) + (args:Il.cell array) + (clo:Il.cell option) : unit = trans_call_static_glue (code_fixup_to_ptr_operand fix) - None [| alias ty_params; arg |] + None + (Array.append [| alias ty_params |] args) + clo and get_tydesc_params (outer_ty_params:Il.cell) @@ -1779,7 +1793,8 @@ let trans_visitor (ty_param:int) (vtbl_idx:int) (ty_params:Il.cell) - (arg:Il.cell) + (args:Il.cell array) + (clo:Il.cell option) : unit = iflog (fun _ -> annotate (Printf.sprintf "calling tydesc[%d].glue[%d]" @@ -1787,8 +1802,11 @@ let trans_visitor let td = get_ty_param ty_params ty_param in let ty_params_ptr = get_tydesc_params ty_params td in trans_call_dynamic_glue - td vtbl_idx - None [| ty_params_ptr; arg; |] + td + vtbl_idx + None + (Array.append [| ty_params_ptr |] args) + clo (* trans_compare returns a quad number of the cjmp, which the caller patches to the cjmp destination. *) @@ -2453,36 +2471,41 @@ let trans_visitor note_drop_step ty "drop_ty: obj path"; let binding = get_element_ptr cell Abi.binding_field_binding in let null_jmp = null_check binding in + let rc_jmp = drop_refcount_and_cmp binding in let obj = deref binding in - let rc = get_element_ptr obj 0 in - let rc_jmp = drop_refcount_and_cmp rc in let tydesc = get_element_ptr obj 1 in let body = get_element_ptr obj 2 in - let ty_params = - get_element_ptr (deref tydesc) Abi.tydesc_field_first_param - in + let ty_params = get_tydesc_params ty_params tydesc in let dtor = get_element_ptr (deref tydesc) Abi.tydesc_field_obj_drop_glue in let null_dtor_jmp = null_check dtor in (* Call any dtor, if present. *) - note_drop_step ty "drop_ty: calling obj dtor"; - trans_call_dynamic_glue tydesc - Abi.tydesc_field_obj_drop_glue None [| binding |]; - patch null_dtor_jmp; - (* Drop the body. *) - note_drop_step ty "drop_ty: dropping obj body"; - trans_call_dynamic_glue tydesc - Abi.tydesc_field_drop_glue None [| ty_params; alias body |]; - (* FIXME: this will fail if the user has lied about the - * state-ness of their obj. We need to store state-ness in the - * captured tydesc, and use that. *) - note_drop_step ty "drop_ty: freeing obj body"; - trans_free binding (type_has_state ty); - mov binding zero; - patch rc_jmp; - patch null_jmp; - note_drop_step ty "drop_ty: done obj path"; + note_drop_step ty "drop_ty: calling obj dtor"; + trans_call_dynamic_glue + tydesc + Abi.tydesc_field_obj_drop_glue + None + [| binding |] + (Some binding); + patch null_dtor_jmp; + (* Drop the body. *) + note_drop_step ty "drop_ty: dropping obj body"; + trans_call_dynamic_glue + tydesc + Abi.tydesc_field_drop_glue + None + [| ty_params; alias body |] + None; + (* FIXME: this will fail if the user has lied about the + * state-ness of their obj. We need to store state-ness in the + * captured tydesc, and use that. *) + note_drop_step ty "drop_ty: freeing obj body"; + trans_free binding (type_has_state ty); + mov binding zero; + patch rc_jmp; + patch null_jmp; + note_drop_step ty "drop_ty: done obj path"; | Ast.TY_param (i, _) -> @@ -2491,7 +2514,11 @@ let trans_visitor begin fun cell -> trans_call_simple_dynamic_glue - i Abi.tydesc_field_drop_glue ty_params cell + i + Abi.tydesc_field_drop_glue + ty_params + [| cell |] + None end; note_drop_step ty "drop_ty: done parametric-ty path"; @@ -2505,8 +2532,7 @@ let trans_visitor let _ = check_box_rty cell in let null_jmp = null_check cell in - let rc = box_rc_cell cell in - let j = drop_refcount_and_cmp rc in + let j = drop_refcount_and_cmp cell in (* FIXME (issue #25): check to see that the box has * further box members; if it doesn't we can elide the @@ -2514,7 +2540,9 @@ let trans_visitor trans_call_simple_static_glue (get_free_glue ty (mctrl = MEM_gc) curr_iso) - ty_params cell; + ty_params + [| cell |] + None; (* Null the slot out to prevent double-free if the frame * unwinds. @@ -2525,7 +2553,7 @@ let trans_visitor note_drop_step ty "drop_ty: done box-drop path"; | MEM_interior when type_is_structured ty -> - note_drop_step ty "drop:ty structured-interior path"; + note_drop_step ty "drop_ty structured-interior path"; iter_ty_parts ty_params cell ty (drop_ty ty_params) curr_iso; note_drop_step ty "drop_ty: done structured-interior path"; @@ -2603,7 +2631,7 @@ let trans_visitor trans_call_static_glue (code_fixup_to_ptr_operand glue_fix) (Some dst) - [| alias ty_params; src; clone_task |] + [| alias ty_params; src; clone_task |] None | _ -> iter_ty_parts_full ty_params dst src ty (clone_ty ty_params clone_task) curr_iso @@ -2640,7 +2668,10 @@ let trans_visitor lea vr body_mem; trace_word cx.ctxt_sess.Session.sess_trace_drop vr; trans_call_simple_static_glue - (get_drop_glue body_ty curr_iso) ty_params vr; + (get_drop_glue body_ty curr_iso) + ty_params + [| vr |] + None; note_drop_step ty "in free-ty, calling free"; trans_free cell is_gc; end; @@ -2700,7 +2731,9 @@ let trans_visitor lea tmp body_mem; trans_call_simple_static_glue (get_mark_glue ty curr_iso) - ty_params tmp; + ty_params + [| tmp |] + None; List.iter patch marked_jump; | MEM_interior when type_is_structured ty -> @@ -2714,7 +2747,9 @@ let trans_visitor lea tmp mem; trans_call_simple_static_glue (get_mark_glue ty curr_iso) - ty_params tmp + ty_params + [| tmp |] + None | _ -> () @@ -2740,14 +2775,35 @@ let trans_visitor emit (Il.jmp Il.JE Il.CodeNone); j - and drop_refcount_and_cmp (rc:Il.cell) : quad_idx = + and drop_refcount_and_cmp (boxed:Il.cell) : quad_idx = iflog (fun _ -> annotate "drop refcount and maybe free"); + let rc = box_rc_cell boxed in + if cx.ctxt_sess.Session.sess_trace_gc || + cx.ctxt_sess.Session.sess_trace_drop + then + begin + trace_str true "refcount--"; + trace_word true boxed; + trace_word true rc + end; emit (Il.binary Il.SUB rc (Il.Cell rc) one); emit (Il.cmp (Il.Cell rc) zero); let j = mark () in emit (Il.jmp Il.JNE Il.CodeNone); j + and incr_refcount (boxed:Il.cell) : unit = + let rc = box_rc_cell boxed in + if cx.ctxt_sess.Session.sess_trace_gc || + cx.ctxt_sess.Session.sess_trace_drop + then + begin + trace_str true "refcount++"; + trace_word true boxed; + trace_word true rc + end; + add_to rc one + and drop_slot (ty_params:Il.cell) (cell:Il.cell) @@ -2917,7 +2973,7 @@ let trans_visitor | (MEM_rc_struct, MEM_rc_struct) -> (* Lightweight copy: twiddle refcounts, move pointer. *) anno "refcounted light"; - add_to (box_rc_cell src) one; + incr_refcount src; if not initializing then drop_ty ty_params dst dst_ty None; @@ -3012,7 +3068,9 @@ let trans_visitor let ty_params_ptr = get_tydesc_params ty_params td in trans_call_dynamic_glue td Abi.tydesc_field_copy_glue - (Some dst) [| ty_params_ptr; src; |] + (Some dst) + [| ty_params_ptr; src; |] + None end | Ast.TY_fn _ @@ -3186,13 +3244,13 @@ let trans_visitor (dst:Il.cell) (dst_tys:Ast.ty array) (trec:Ast.ty_rec) - (atab:(Ast.ident * Ast.atom) array) + (atab:(Ast.ident * Ast.mutability * Ast.atom) array) (base:Ast.lval) : unit = Array.iteri begin fun i (fml_ident, _) -> - let fml_entry _ (act_ident, atom) = + let fml_entry _ (act_ident, _, atom) = if act_ident = fml_ident then Some atom else None in let dst_ty = dst_tys.(i) in @@ -3537,6 +3595,9 @@ let trans_visitor let callee_task_cell = get_element_ptr all_callee_args_cell Abi.calltup_elt_task_ptr in + let callee_indirect_args = + get_element_ptr all_callee_args_cell Abi.calltup_elt_indirect_args + in let callee_ty_params = get_element_ptr all_callee_args_cell Abi.calltup_elt_ty_params in @@ -3548,10 +3609,6 @@ let trans_visitor get_element_ptr_dyn_in_current_frame all_callee_args_cell Abi.calltup_elt_iterator_args in - let callee_indirect_args = - get_element_ptr_dyn_in_current_frame - all_callee_args_cell Abi.calltup_elt_indirect_args - in let n_args = Array.length call.call_args in let n_iterators = Array.length call.call_iterator_args in @@ -3611,9 +3668,9 @@ let trans_visitor end call.call_callee_ty_params; - trans_arg1 callee_task_cell; + trans_arg1 callee_task_cell; - trans_arg0 callee_output_cell initializing_arg0 call + trans_arg0 callee_output_cell initializing_arg0 call @@ -4002,10 +4059,9 @@ let trans_visitor let dst_slot_id = (fst (fo.Ast.for_slot)).id in let dst_slot = get_slot cx dst_slot_id in let dst_cell = cell_of_block_slot dst_slot_id in - let (head_stmts, seq) = fo.Ast.for_seq in + let seq = fo.Ast.for_seq in let (seq_cell, seq_ty) = trans_lval seq in let unit_ty = seq_unit_ty seq_ty in - Array.iter trans_stmt head_stmts; iter_seq_parts ty_params seq_cell seq_cell unit_ty begin fun _ src_cell unit_ty _ -> @@ -4070,7 +4126,11 @@ let trans_visitor let fp = get_iter_outer_frame_ptr_for_current_frame () in let vr = next_vreg_cell Il.voidptr_t in mov vr zero; - trans_call_glue (code_of_operand block_fptr) None [| vr; fp |] + trans_call_glue + (code_of_operand block_fptr) + None + [| vr; fp |] + None and trans_vec_append dst_cell dst_ty src_oper src_ty = let elt_ty = seq_unit_ty dst_ty in @@ -4255,7 +4315,7 @@ let trans_visitor begin match base with None -> - let atoms = Array.map snd atab in + let atoms = Array.map (fun (_, _, atom) -> atom) atab in trans_init_structural_from_atoms dst_cell dst_tys atoms | Some base_lval -> @@ -4263,7 +4323,7 @@ let trans_visitor dst_cell dst_tys trec atab base_lval end - | Ast.STMT_init_tup (dst, atoms) -> + | Ast.STMT_init_tup (dst, elems) -> let (slot_cell, ty) = trans_lval_init dst in let dst_tys = match ty with @@ -4272,6 +4332,7 @@ let trans_visitor bugi cx stmt.id "non-tup destination type in stmt_init_tup" in + let atoms = Array.map snd elems in let (dst_cell, _) = deref_ty DEREF_none true slot_cell ty in trans_init_structural_from_atoms dst_cell dst_tys atoms @@ -4279,7 +4340,7 @@ let trans_visitor | Ast.STMT_init_str (dst, s) -> trans_init_str dst s - | Ast.STMT_init_vec (dst, atoms) -> + | Ast.STMT_init_vec (dst, _, atoms) -> trans_init_vec dst atoms | Ast.STMT_init_port dst -> @@ -4297,7 +4358,7 @@ let trans_visitor trans_init_chan dst p end - | Ast.STMT_init_box (dst, src) -> + | Ast.STMT_init_box (dst, _, src) -> trans_init_box dst src | Ast.STMT_block block -> @@ -4614,7 +4675,7 @@ let trans_visitor trans_crate_rel_static_string_frag (string_of_name_component nc) in trans_crate_rel_data_operand - (DATA_name (Walk.name_of ncs)) + (DATA_name (name_of ncs)) (fun _ -> Asm.SEQ (Array.append (Array.map f (Array.of_list ncs)) [| Asm.WORD (word_ty_mach, Asm.IMM 0L) |])) @@ -5012,7 +5073,7 @@ let fixup_assigning_visitor : Walk.visitor = let path_name (_:unit) : string = - Fmt.fmt_to_str Ast.fmt_name (Walk.path_to_name path) + Fmt.fmt_to_str Ast.fmt_name (path_to_name path) in let enter_file_for id = @@ -5110,11 +5171,8 @@ let process_crate (fixup_assigning_visitor cx path Walk.empty_visitor)); (unreferenced_required_item_ignoring_visitor cx - (Walk.mod_item_logging_visitor - (log cx "translation pass: %s") - path - (trans_visitor cx path - Walk.empty_visitor))) + (trans_visitor cx path + Walk.empty_visitor)) |]; in log cx "translating crate"; @@ -5123,7 +5181,8 @@ let process_crate None -> () | Some m -> log cx "with main fn %s" m end; - run_passes cx "trans" path passes (log cx "%s") crate; + run_passes cx "trans" path passes + cx.ctxt_sess.Session.sess_log_trans log crate; ;; (* diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index b27e68dc..45570708 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -216,6 +216,20 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = in let retval_tvs = Stack.create () in + let fns = Stack.create () in + + let push_fn fn = + Stack.push fn fns + in + + let pop_fn _ = + ignore (Stack.pop fns) + in + + let fn_is_iter() = + (Stack.top fns).Ast.fn_aux.Ast.fn_is_iter + in + let push_retval_tv tv = Stack.push tv retval_tvs in @@ -1130,7 +1144,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | Ast.STMT_init_rec (dst, fields, Some base) -> let dct = Hashtbl.create 10 in let tvrec = ref (TYSPEC_record dct) in - let add_field (ident, atom) = + let add_field (ident, _, atom) = let tv = any() in unify_atom arg_pass_ctx atom tv; Hashtbl.add dct ident tv @@ -1143,7 +1157,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | Ast.STMT_init_rec (dst, fields, None) -> let dct = Hashtbl.create 10 in - let add_field (ident, atom) = + let add_field (ident, _, atom) = let tv = any() in unify_atom arg_pass_ctx atom tv; Hashtbl.add dct ident tv @@ -1152,7 +1166,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = unify_lval init_ctx dst (ref (TYSPEC_record dct)) | Ast.STMT_init_tup (dst, members) -> - let member_to_tv atom = + let member_to_tv (_, atom) = let tv = any() in unify_atom arg_pass_ctx atom tv; tv @@ -1160,7 +1174,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let member_tvs = Array.map member_to_tv members in unify_lval init_ctx dst (ref (TYSPEC_tuple member_tvs)) - | Ast.STMT_init_vec (dst, atoms) -> + | Ast.STMT_init_vec (dst, _, atoms) -> let tv = any() in let unify_with_tv atom = unify_atom arg_pass_ctx atom tv in Array.iter unify_with_tv atoms; @@ -1215,13 +1229,27 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | Ast.STMT_if { Ast.if_test = if_test } -> unify_expr rval_ctx if_test (ty Ast.TY_bool); - | Ast.STMT_ret atom_opt - | Ast.STMT_put atom_opt -> + | Ast.STMT_ret atom_opt -> begin + if fn_is_iter() + then + match atom_opt with + | None -> () + | Some _ -> err None "Iter returning value" + else + match atom_opt with + | None -> unify_ty arg_pass_ctx Ast.TY_nil (retval_tv()) + | Some atom -> unify_atom arg_pass_ctx atom (retval_tv()) + end + + | Ast.STMT_put atom_opt -> + if fn_is_iter() + then match atom_opt with - None -> unify_ty arg_pass_ctx Ast.TY_nil (retval_tv()) + | None -> unify_ty arg_pass_ctx Ast.TY_nil (retval_tv()) | Some atom -> unify_atom arg_pass_ctx atom (retval_tv()) - end + else + err None "Non-iter function with 'put'" | Ast.STMT_be (callee, args) -> check_callable (retval_tv()) callee args @@ -1263,7 +1291,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let mem_tv = ref TYSPEC_all in let seq_tv = ref (TYSPEC_collection mem_tv) in let (si, _) = fo.Ast.for_slot in - let (_, seq) = fo.Ast.for_seq in + let seq = fo.Ast.for_seq in unify_lval rval_ctx seq seq_tv; unify_slot lval_ctx si.node (Some si.id) mem_tv @@ -1276,7 +1304,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = | Ast.STMT_join lval -> unify_lval rval_ctx lval (ty Ast.TY_task); - | Ast.STMT_init_box (dst, v) -> + | Ast.STMT_init_box (dst, _, v) -> let in_tv = any() in let tv = ref (TYSPEC_mutable (ref (TYSPEC_box in_tv))) in unify_lval strict_ctx dst tv; @@ -1344,11 +1372,17 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = in let enter_fn fn retspec = + push_fn fn; let out = fn.Ast.fn_output_slot in push_retval_tv (ref retspec); unify_slot arg_pass_ctx out.node (Some out.id) (retval_tv()) in + let leave_fn _ = + pop_retval_tv (); + pop_fn (); + in + let visit_obj_fn_pre obj ident fn = enter_fn fn.node TYSPEC_all; inner.Walk.visit_obj_fn_pre obj ident fn @@ -1356,7 +1390,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = let visit_obj_fn_post obj ident fn = inner.Walk.visit_obj_fn_post obj ident fn; - pop_retval_tv (); + leave_fn (); in let visit_mod_item_pre n p mod_item = @@ -1374,7 +1408,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = in let path_name (_:unit) : string = - string_of_name (Walk.path_to_name path) + string_of_name (path_to_name path) in let visit_mod_item_post n p mod_item = @@ -1382,7 +1416,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = match mod_item.node.Ast.decl_item with | Ast.MOD_ITEM_fn _ -> - pop_retval_tv (); + leave_fn (); if (Some (path_name())) = cx.ctxt_main_name then begin @@ -1528,9 +1562,8 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit = Hashtbl.iter init_mod_dict cx.ctxt_all_defns; Walk.walk_crate (Walk.path_managing_visitor path - (Walk.mod_item_logging_visitor - (log cx "typechecking pass: %s") - path + (mod_item_logging_visitor cx + cx.ctxt_sess.Session.sess_log_type log 0 path (visitor cx Walk.empty_visitor))) crate; diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml index 3a13561a..cca548b8 100644 --- a/src/boot/me/typestate.ml +++ b/src/boot/me/typestate.ml @@ -434,7 +434,7 @@ let condition_assigning_visitor raise_pre_post_cond s.id precond; raise_postcondition s.id postcond - | Ast.STMT_init_vec (dst, atoms) -> + | Ast.STMT_init_vec (dst, _, atoms) -> let precond = slot_inits (atoms_slots cx atoms) in let postcond = slot_inits (lval_slots cx dst) in raise_pre_post_cond s.id precond; @@ -454,7 +454,7 @@ let condition_assigning_visitor raise_pre_post_cond s.id precond; raise_postcondition s.id postcond - | Ast.STMT_init_box (dst, src) -> + | Ast.STMT_init_box (dst, _, src) -> let precond = slot_inits (atom_slots cx src) in let postcond = slot_inits (lval_slots cx dst) in raise_pre_post_cond s.id precond; @@ -533,7 +533,7 @@ let condition_assigning_visitor | Ast.STMT_for fo -> let (si, _) = fo.Ast.for_slot in - let (_, lval) = fo.Ast.for_seq in + let lval = fo.Ast.for_seq in let precond = slot_inits (lval_slots cx lval) in let block_entry_state = [| Constr_init si.id |] in raise_pre_post_cond s.id precond; @@ -988,23 +988,30 @@ let lifecycle_visitor * used later on in translation. *) - let (live_block_slots:(node_id Stack.t) Stack.t) = Stack.create () in + let (live_block_slots:(node_id, unit) Hashtbl.t) = Hashtbl.create 0 in + let (block_slots:(node_id Stack.t) Stack.t) = Stack.create () in let (implicit_init_block_slots:(node_id,node_id) Hashtbl.t) = Hashtbl.create 0 in + let push_slot sl = + Stack.push sl (Stack.top block_slots) + in + let mark_slot_init sl = - Stack.push sl (Stack.top live_block_slots) + Hashtbl.replace live_block_slots sl () in let visit_block_pre b = - Stack.push (Stack.create()) live_block_slots; + Stack.push (Stack.create()) block_slots; begin match htab_search implicit_init_block_slots b.id with None -> () - | Some slot -> mark_slot_init slot + | Some slot -> + push_slot slot; + mark_slot_init slot end; inner.Walk.visit_block_pre b in @@ -1026,7 +1033,7 @@ let lifecycle_visitor let visit_block_post b = inner.Walk.visit_block_post b; - let blk_live = Stack.pop live_block_slots in + let blk_slots = Stack.pop block_slots in let stmts = b.node in let len = Array.length stmts in if len > 0 @@ -1037,9 +1044,22 @@ let lifecycle_visitor Ast.STMT_ret _ | Ast.STMT_be _ -> () (* Taken care of in visit_stmt_post below. *) - | _ -> - let slots = stk_elts_from_top blk_live in - note_drops s slots + | _ -> + (* The blk_slots stack we have has accumulated slots in + * declaration order as we walked the block; the top of the + * stack is the last-declared slot. We want to generate + * slot-drop obligations here for the slots in top-down order + * (starting with the last-declared) but only hitting those + * slots that actually got initialized (went live) at some + * point in the block. + *) + let slots = stk_elts_from_top blk_slots in + let live = + List.filter + (fun i -> Hashtbl.mem live_block_slots i) + slots + in + note_drops s live end; in @@ -1081,13 +1101,16 @@ let lifecycle_visitor init_lval lv_dst end; + | Ast.STMT_decl (Ast.DECL_slot (_, sloti)) -> + push_slot sloti.id + | Ast.STMT_init_rec (lv_dst, _, _) | Ast.STMT_init_tup (lv_dst, _) - | Ast.STMT_init_vec (lv_dst, _) + | Ast.STMT_init_vec (lv_dst, _, _) | Ast.STMT_init_str (lv_dst, _) | Ast.STMT_init_port lv_dst | Ast.STMT_init_chan (lv_dst, _) - | Ast.STMT_init_box (lv_dst, _) -> + | Ast.STMT_init_box (lv_dst, _, _) -> init_lval lv_dst | Ast.STMT_for f -> @@ -1107,7 +1130,7 @@ let lifecycle_visitor (fst f.Ast.for_each_slot).id - | _ -> () + | _ -> () end; inner.Walk.visit_stmt_pre s in @@ -1117,9 +1140,14 @@ let lifecycle_visitor match s.node with Ast.STMT_ret _ | Ast.STMT_be _ -> - let stks = stk_elts_from_top live_block_slots in + let stks = stk_elts_from_top block_slots in let slots = List.concat (List.map stk_elts_from_top stks) in - note_drops s slots + let live = + List.filter + (fun i -> Hashtbl.mem live_block_slots i) + slots + in + note_drops s live | _ -> () in @@ -1171,10 +1199,11 @@ let process_crate Walk.empty_visitor) |] in - run_passes cx "typestate setup" path setup_passes (log cx "%s") crate; + let log_flag = cx.ctxt_sess.Session.sess_log_typestate in + run_passes cx "typestate setup" path setup_passes log_flag log crate; run_dataflow cx constr_id graph; - run_passes cx "typestate verify" path verify_passes (log cx "%s") crate; - run_passes cx "typestate aux" path aux_passes (log cx "%s") crate + run_passes cx "typestate verify" path verify_passes log_flag log crate; + run_passes cx "typestate aux" path aux_passes log_flag log crate ;; diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml index 0b60c832..fac44170 100644 --- a/src/boot/me/walk.ml +++ b/src/boot/me/walk.ml @@ -123,69 +123,6 @@ let path_managing_visitor } ;; -let rec name_of ncs = - match ncs with - [] -> bug () "Walk.name_of_ncs: empty path" - | [(Ast.COMP_ident i)] -> Ast.NAME_base (Ast.BASE_ident i) - | [(Ast.COMP_app x)] -> Ast.NAME_base (Ast.BASE_app x) - | [(Ast.COMP_idx _)] -> - bug () "Walk.name_of_ncs: path-name contains COMP_idx" - | nc::ncs -> Ast.NAME_ext (name_of ncs, nc) -;; - -let path_to_name - (path:Ast.name_component Stack.t) - : Ast.name = - name_of (stk_elts_from_top path) -;; - - -let mod_item_logging_visitor - (logfn:string->unit) - (path:Ast.name_component Stack.t) - (inner:visitor) - : visitor = - let path_name _ = Fmt.fmt_to_str Ast.fmt_name (path_to_name path) in - let visit_mod_item_pre name params item = - logfn (Printf.sprintf "entering %s" (path_name())); - inner.visit_mod_item_pre name params item; - logfn (Printf.sprintf "entered %s" (path_name())); - in - let visit_mod_item_post name params item = - logfn (Printf.sprintf "leaving %s" (path_name())); - inner.visit_mod_item_post name params item; - logfn (Printf.sprintf "left %s" (path_name())); - in - let visit_obj_fn_pre obj ident fn = - logfn (Printf.sprintf "entering %s" (path_name())); - inner.visit_obj_fn_pre obj ident fn; - logfn (Printf.sprintf "entered %s" (path_name())); - in - let visit_obj_fn_post obj ident fn = - logfn (Printf.sprintf "leaving %s" (path_name())); - inner.visit_obj_fn_post obj ident fn; - logfn (Printf.sprintf "left %s" (path_name())); - in - let visit_obj_drop_pre obj b = - logfn (Printf.sprintf "entering %s" (path_name())); - inner.visit_obj_drop_pre obj b; - logfn (Printf.sprintf "entered %s" (path_name())); - in - let visit_obj_drop_post obj fn = - logfn (Printf.sprintf "leaving %s" (path_name())); - inner.visit_obj_drop_post obj fn; - logfn (Printf.sprintf "left %s" (path_name())); - in - { inner with - visit_mod_item_pre = visit_mod_item_pre; - visit_mod_item_post = visit_mod_item_post; - visit_obj_fn_pre = visit_obj_fn_pre; - visit_obj_fn_post = visit_obj_fn_post; - visit_obj_drop_pre = visit_obj_drop_pre; - visit_obj_drop_post = visit_obj_drop_post; - } -;; - let walk_bracketed (pre:'a -> unit) @@ -419,9 +356,8 @@ and walk_stmt (s:Ast.stmt_for) : unit = let (si,_) = s.Ast.for_slot in - let (ss,lv) = s.Ast.for_seq in + let lv = s.Ast.for_seq in walk_slot_identified v si; - Array.iter (walk_stmt v) ss; walk_lval v lv; walk_block v s.Ast.for_body in @@ -450,16 +386,16 @@ and walk_stmt | Ast.STMT_init_rec (lv, atab, base) -> walk_lval v lv; - Array.iter (fun (_, a) -> walk_atom v a) atab; + Array.iter (fun (_, _, a) -> walk_atom v a) atab; walk_option (walk_lval v) base; - | Ast.STMT_init_vec (lv, atoms) -> + | Ast.STMT_init_vec (lv, _, atoms) -> walk_lval v lv; Array.iter (walk_atom v) atoms | Ast.STMT_init_tup (lv, mut_atoms) -> walk_lval v lv; - Array.iter (walk_atom v) mut_atoms + Array.iter (fun (_, atom) -> walk_atom v atom) mut_atoms | Ast.STMT_init_str (lv, _) -> walk_lval v lv @@ -471,7 +407,7 @@ and walk_stmt walk_option (walk_lval v) port; walk_lval v chan; - | Ast.STMT_init_box (dst, src) -> + | Ast.STMT_init_box (dst, _, src) -> walk_lval v dst; walk_atom v src diff --git a/src/boot/util/common.ml b/src/boot/util/common.ml index 168c9f0a..0ea39e2d 100644 --- a/src/boot/util/common.ml +++ b/src/boot/util/common.ml @@ -341,7 +341,6 @@ let bool_of_option x = Some _ -> true | None -> false - (* * Auxiliary stack functions. *) diff --git a/src/comp/driver/rustc.rs b/src/comp/driver/rustc.rs index 077bf70d..e5a614ba 100644 --- a/src/comp/driver/rustc.rs +++ b/src/comp/driver/rustc.rs @@ -1,8 +1,22 @@ // -*- rust -*- fn main(vec[str] args) -> () { + log "This is the rust 'self-hosted' compiler."; log "The one written in rust."; log "It does nothing yet, it's a placeholder."; log "You want rustboot, the compiler next door."; + + auto i = 0; + for (str filename in args) { + if (i > 0) { + auto br = std._io.new_buf_reader(filename); + log "opened file: " + filename; + for (u8 b in br.read()) { + log b; + } + } + i += 1; + } + } diff --git a/src/comp/fe/lexer.rs b/src/comp/fe/lexer.rs index e69de29b..37684c22 100644 --- a/src/comp/fe/lexer.rs +++ b/src/comp/fe/lexer.rs @@ -0,0 +1,20 @@ +import std._io.buf_reader; + +iter buffers(buf_reader rdr) -> vec[u8] { + while (true) { + let vec[u8] v = rdr.read(); + if (std._vec.len[u8](v) == uint(0)) { + ret; + } + put v; + } +} + +iter bytes(buf_reader rdr) -> u8 { + for each (vec[u8] buf in buffers(rdr)) { + for (u8 b in buf) { + // FIXME: doesn't compile at the moment. + // put b; + } + } +} diff --git a/src/comp/lib/llvm.rs b/src/comp/lib/llvm.rs new file mode 100644 index 00000000..da748bf3 --- /dev/null +++ b/src/comp/lib/llvm.rs @@ -0,0 +1,277 @@ +import std._str.rustrt.sbuf; +import std._vec.rustrt.vbuf; + +type ULongLong = u64; +type LongLong = i64; +type Long = i32; +type Bool = int; + +native mod llvm = "libLLVM-2.7.so" { + + type ModuleRef; + type ContextRef; + type TypeRef; + type TypeHandleRef; + type ValueRef; + type BasicBlockRef; + type BuilderRef; + type ModuleProviderRef; + type MemoryBufferRef; + type PassManagerRef; + type UseRef; + + + /* Create and destroy contexts. */ + fn ContextCreate() -> ContextRef; + fn GetGlobalContext() -> ContextRef; + fn ContextDispose(ContextRef C); + fn GetMDKindIDInContext(ContextRef C, sbuf Name, uint SLen) -> uint; + fn GetMDKindID(sbuf Name, uint SLen) -> uint; + + /* Create and destroy modules. */ + fn ModuleCreateWithName(sbuf ModuleID) -> ModuleRef; + fn DisposeModule(ModuleRef M); + + /** Data layout. See Module::getDataLayout. */ + fn GetDataLayout(ModuleRef M) -> sbuf; + fn SetDataLayout(ModuleRef M, sbuf Triple); + + /** Target triple. See Module::getTargetTriple. */ + fn GetTarget(ModuleRef M) -> sbuf; + fn SetTarget(ModuleRef M, sbuf Triple); + + /** See Module::addTypeName. */ + fn AddTypeName(ModuleRef M, sbuf Name, TypeRef Ty) -> Bool; + fn DeleteTypeName(ModuleRef M, sbuf Name); + fn GetTypeByName(ModuleRef M, sbuf Name) -> TypeRef; + + /** See Module::dump. */ + fn DumpModule(ModuleRef M); + + /** See Module::setModuleInlineAsm. */ + fn SetModuleInlineAsm(ModuleRef M, sbuf Asm); + + /** See llvm::LLVMType::getContext. */ + fn GetTypeContext(TypeRef Ty) -> ContextRef; + + /* Operations on integer types */ + fn Int1TypeInContext(ContextRef C) -> TypeRef; + fn Int8TypeInContext(ContextRef C) -> TypeRef; + fn Int16TypeInContext(ContextRef C) -> TypeRef; + fn Int32TypeInContext(ContextRef C) -> TypeRef; + fn Int64TypeInContext(ContextRef C) -> TypeRef; + fn IntTypeInContext(ContextRef C, uint NumBits) -> TypeRef; + + fn Int1Type() -> TypeRef; + fn Int8Type() -> TypeRef; + fn Int16Type() -> TypeRef; + fn Int32Type() -> TypeRef; + fn Int64Type() -> TypeRef; + fn IntType(uint NumBits) -> TypeRef; + fn GetIntTypeWidth(TypeRef IntegerTy) -> uint; + + /* Operations on real types */ + fn FloatTypeInContext(ContextRef C) -> TypeRef; + fn DoubleTypeInContext(ContextRef C) -> TypeRef; + fn X86FP80TypeInContext(ContextRef C) -> TypeRef; + fn FP128TypeInContext(ContextRef C) -> TypeRef; + fn PPCFP128TypeInContext(ContextRef C) -> TypeRef; + + fn FloatType() -> TypeRef; + fn DoubleType() -> TypeRef; + fn X86FP80Type() -> TypeRef; + fn FP128Type() -> TypeRef; + fn PPCFP128Type() -> TypeRef; + + /* Operations on function types */ + fn FunctionType(TypeRef ReturnType, vbuf ParamTypes, + uint ParamCount, Bool IsVarArg) -> TypeRef; + fn IsFunctionVarArg(TypeRef FunctionTy) -> Bool; + fn GetReturnType(TypeRef FunctionTy) -> TypeRef; + fn CountParamTypes(TypeRef FunctionTy) -> uint; + fn GetParamTypes(TypeRef FunctionTy, vbuf Dest); + + /* Operations on struct types */ + fn StructTypeInContext(ContextRef C, vbuf ElementTypes, + uint ElementCount, Bool Packed) -> TypeRef; + fn StructType(vbuf ElementTypes, uint ElementCount, + Bool Packed) -> TypeRef; + fn CountStructElementTypes(TypeRef StructTy) -> uint; + fn GetStructElementTypes(TypeRef StructTy, vbuf Dest); + fn IsPackedStruct(TypeRef StructTy) -> Bool; + + /* Operations on union types */ + fn UnionTypeInContext(ContextRef C, vbuf ElementTypes, + uint ElementCount) -> TypeRef; + fn UnionType(vbuf ElementTypes, uint ElementCount) -> TypeRef; + fn CountUnionElementTypes(TypeRef UnionTy) -> uint; + fn GetUnionElementTypes(TypeRef UnionTy, vbuf Dest); + + /* Operations on array, pointer, and vector types (sequence types) */ + fn ArrayType(TypeRef ElementType, uint ElementCount) -> TypeRef; + fn PointerType(TypeRef ElementType, uint AddressSpace) -> TypeRef; + fn VectorType(TypeRef ElementType, uint ElementCount) -> TypeRef; + + fn GetElementType(TypeRef Ty) -> TypeRef; + fn GetArrayLength(TypeRef ArrayTy) -> uint; + fn GetPointerAddressSpace(TypeRef PointerTy) -> uint; + fn GetVectorSize(TypeRef VectorTy) -> uint; + + /* Operations on other types */ + fn VoidTypeInContext(ContextRef C) -> TypeRef; + fn LabelTypeInContext(ContextRef C) -> TypeRef; + fn OpaqueTypeInContext(ContextRef C) -> TypeRef; + + fn VoidType() -> TypeRef; + fn LabelType() -> TypeRef; + fn OpaqueType() -> TypeRef; + + /* Operations on type handles */ + fn CreateTypeHandle(TypeRef PotentiallyAbstractTy) -> TypeHandleRef; + fn RefineType(TypeRef AbstractTy, TypeRef ConcreteTy); + fn ResolveTypeHandle(TypeHandleRef TypeHandle) -> TypeRef; + fn DisposeTypeHandle(TypeHandleRef TypeHandle); + + /* Operations on all values */ + fn TypeOf(ValueRef Val) -> TypeRef; + fn GetValueName(ValueRef Val) -> sbuf; + fn SetValueName(ValueRef Val, sbuf Name); + fn DumpValue(ValueRef Val); + fn ReplaceAllUsesWith(ValueRef OldVal, ValueRef NewVal); + fn HasMetadata(ValueRef Val) -> int; + fn GetMetadata(ValueRef Val, uint KindID) -> ValueRef; + fn SetMetadata(ValueRef Val, uint KindID, ValueRef Node); + + /* Operations on Uses */ + fn GetFirstUse(ValueRef Val) -> UseRef; + fn GetNextUse(UseRef U) -> UseRef; + fn GetUser(UseRef U) -> ValueRef; + fn GetUsedValue(UseRef U) -> ValueRef; + + /* Operations on Users */ + fn GetOperand(ValueRef Val, uint Index) -> ValueRef; + + /* Operations on constants of any type */ + fn ConstNull(TypeRef Ty) -> ValueRef; /* all zeroes */ + fn ConstAllOnes(TypeRef Ty) -> ValueRef; /* only for int/vector */ + fn GetUndef(TypeRef Ty) -> ValueRef; + fn IsConstant(ValueRef Val) -> Bool; + fn IsNull(ValueRef Val) -> Bool; + fn IsUndef(ValueRef Val) -> Bool; + fn ConstPointerNull(TypeRef Ty) -> ValueRef; + + /* Operations on metadata */ + fn MDStringInContext(ContextRef C, sbuf Str, uint SLen) -> ValueRef; + fn MDString(sbuf Str, uint SLen) -> ValueRef; + fn MDNodeInContext(ContextRef C, vbuf Vals, uint Count) -> ValueRef; + fn MDNode(vbuf Vals, uint Count) -> ValueRef; + + /* Operations on scalar constants */ + fn ConstInt(TypeRef IntTy, ULongLong N, Bool SignExtend) -> ValueRef; + fn ConstIntOfString(TypeRef IntTy, sbuf Text, u8 Radix) -> ValueRef; + fn ConstIntOfStringAndSize(TypeRef IntTy, sbuf Text, + uint SLen, u8 Radix) -> ValueRef; + fn ConstReal(TypeRef RealTy, f64 N) -> ValueRef; + fn ConstRealOfString(TypeRef RealTy, sbuf Text) -> ValueRef; + fn ConstRealOfStringAndSize(TypeRef RealTy, sbuf Text, + uint SLen) -> ValueRef; + fn ConstIntGetZExtValue(ValueRef ConstantVal) -> ULongLong; + fn ConstIntGetSExtValue(ValueRef ConstantVal) -> LongLong; + + + /* Operations on composite constants */ + fn ConstStringInContext(ContextRef C, sbuf Str, + uint Length, Bool DontNullTerminate) -> ValueRef; + fn ConstStructInContext(ContextRef C, vbuf ConstantVals, + uint Count, Bool Packed) -> ValueRef; + + fn ConstString(sbuf Str, uint Length, Bool DontNullTerminate) -> ValueRef; + fn ConstArray(TypeRef ElementTy, + vbuf ConstantVals, uint Length) -> ValueRef; + fn ConstStruct(vbuf ConstantVals, uint Count, Bool Packed) -> ValueRef; + fn ConstVector(vbuf ScalarConstantVals, uint Size) -> ValueRef; + fn ConstUnion(TypeRef Ty, ValueRef Val) -> ValueRef; + + /* Constant expressions */ + fn AlignOf(TypeRef Ty) -> ValueRef; + fn SizeOf(TypeRef Ty) -> ValueRef; + fn ConstNeg(ValueRef ConstantVal) -> ValueRef; + fn ConstNSWNeg(ValueRef ConstantVal) -> ValueRef; + fn ConstNUWNeg(ValueRef ConstantVal) -> ValueRef; + fn ConstFNeg(ValueRef ConstantVal) -> ValueRef; + fn ConstNot(ValueRef ConstantVal) -> ValueRef; + fn ConstAdd(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstNSWAdd(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstNUWAdd(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstFAdd(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstSub(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstNSWSub(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstNUWSub(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstFSub(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstMul(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstNSWMul(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstNUWMul(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstFMul(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstUDiv(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstSDiv(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstExactSDiv(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstFDiv(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstURem(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstSRem(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstFRem(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstAnd(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstOr(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstXor(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstShl(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstLShr(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstAShr(ValueRef LHSConstant, ValueRef RHSConstant) -> ValueRef; + fn ConstGEP(ValueRef ConstantVal, + vbuf ConstantIndices, uint NumIndices) -> ValueRef; + fn ConstInBoundsGEP(ValueRef ConstantVal, + vbuf ConstantIndices, + uint NumIndices) -> ValueRef; + fn ConstTrunc(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstSExt(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstZExt(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstFPTrunc(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstFPExt(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstUIToFP(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstSIToFP(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstFPToUI(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstFPToSI(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstPtrToInt(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstIntToPtr(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstBitCast(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstZExtOrBitCast(ValueRef ConstantVal, + TypeRef ToType) -> ValueRef; + fn ConstSExtOrBitCast(ValueRef ConstantVal, + TypeRef ToType) -> ValueRef; + fn ConstTruncOrBitCast(ValueRef ConstantVal, + TypeRef ToType) -> ValueRef; + fn ConstPointerCast(ValueRef ConstantVal, + TypeRef ToType) -> ValueRef; + fn ConstIntCast(ValueRef ConstantVal, TypeRef ToType, + Bool isSigned) -> ValueRef; + fn ConstFPCast(ValueRef ConstantVal, TypeRef ToType) -> ValueRef; + fn ConstSelect(ValueRef ConstantCondition, + ValueRef ConstantIfTrue, + ValueRef ConstantIfFalse) -> ValueRef; + fn ConstExtractElement(ValueRef VectorConstant, + ValueRef IndexConstant) -> ValueRef; + fn ConstInsertElement(ValueRef VectorConstant, + ValueRef ElementValueConstant, + ValueRef IndexConstant) -> ValueRef; + fn ConstShuffleVector(ValueRef VectorAConstant, + ValueRef VectorBConstant, + ValueRef MaskConstant) -> ValueRef; + fn ConstExtractValue(ValueRef AggConstant, vbuf IdxList, + uint NumIdx) -> ValueRef; + fn ConstInsertValue(ValueRef AggConstant, + ValueRef ElementValueConstant, + vbuf IdxList, uint NumIdx) -> ValueRef; + fn ConstInlineAsm(TypeRef Ty, + sbuf AsmString, sbuf Constraints, + Bool HasSideEffects, Bool IsAlignStack) -> ValueRef; + fn BlockAddress(ValueRef F, BasicBlockRef BB) -> ValueRef; + +}
\ No newline at end of file diff --git a/src/comp/rustc.rc b/src/comp/rustc.rc index 3bf3bbcc..7b1f9236 100644 --- a/src/comp/rustc.rc +++ b/src/comp/rustc.rc @@ -12,6 +12,10 @@ mod driver { mod rustc; } +mod lib { + mod llvm; +} + // Local Variables: // fill-column: 78; // indent-tabs-mode: nil diff --git a/src/lib/_io.rs b/src/lib/_io.rs index 1f01c3b3..d41ab132 100644 --- a/src/lib/_io.rs +++ b/src/lib/_io.rs @@ -1,26 +1,46 @@ -type buf_reader = obj { - fn read(vec[u8] buf) -> uint; +type buf_reader = unsafe obj { + fn read() -> vec[u8]; }; -type buf_writer = obj { - fn write(vec[u8] buf) -> uint; -}; +fn default_bufsz() -> uint { + ret uint(4096); +} + +fn new_buf() -> vec[u8] { + let vec[u8] v = vec(); + let uint i = default_bufsz(); + while (i > uint(0)) { + i -= uint(1); + v += vec(u8(0)); + } + // FIXME (issue #93): should be: + // ret _vec.alloc[u8](default_bufsz()); +} + +fn new_buf_reader(str s) -> buf_reader { -fn mk_buf_reader(str s) -> buf_reader { + unsafe obj fd_buf_reader(int fd, mutable vec[u8] buf) { + + fn read() -> vec[u8] { + + // Ensure our buf is singly-referenced. + if (_vec.rustrt.refcount[u8](buf) != uint(1)) { + buf = new_buf(); + } + + auto len = _vec.len[u8](buf); + auto vbuf = _vec.buf[u8](buf); + auto count = os.libc.read(fd, vbuf, len); - obj fd_reader(int fd) { - fn read(vec[u8] v) -> uint { - auto len = _vec.len[u8](v); - auto buf = _vec.buf[u8](v); - auto count = os.libc.read(fd, buf, len); if (count < 0) { log "error filling buffer"; log sys.rustrt.last_os_error(); fail; } else { - ret uint(count); + ret buf; } } + drop { os.libc.close(fd); } @@ -32,5 +52,5 @@ fn mk_buf_reader(str s) -> buf_reader { log sys.rustrt.last_os_error(); fail; } - ret fd_reader(fd); + ret fd_buf_reader(fd, new_buf()); } diff --git a/src/lib/_str.rs b/src/lib/_str.rs index f1de80f1..167b9f67 100644 --- a/src/lib/_str.rs +++ b/src/lib/_str.rs @@ -5,6 +5,7 @@ native "rust" mod rustrt { fn str_buf(str s) -> sbuf; fn str_len(str s) -> uint; fn str_alloc(uint n_bytes) -> str; + fn refcount[T](str s) -> uint; } fn is_utf8(vec[u8] v) -> bool { diff --git a/src/lib/_vec.rs b/src/lib/_vec.rs index 3074df2c..06e738f5 100644 --- a/src/lib/_vec.rs +++ b/src/lib/_vec.rs @@ -6,6 +6,7 @@ native "rust" mod rustrt { fn vec_buf[T](vec[T] v) -> vbuf; fn vec_len[T](vec[T] v) -> uint; fn vec_alloc[T](uint n_elts) -> vec[T]; + fn refcount[T](vec[T] v) -> uint; } fn alloc[T](uint n_elts) -> vec[T] { diff --git a/src/rt/rust.cpp b/src/rt/rust.cpp index 91476bed..235eb8d0 100644 --- a/src/rt/rust.cpp +++ b/src/rt/rust.cpp @@ -236,7 +236,7 @@ rust_start(uintptr_t main_fn, rust_crate const *crate, int argc, char **argv) rust_crate_reader rdr(&dom, crate); } - uintptr_t main_args[3] = { 0, 0, (uintptr_t)args.args }; + uintptr_t main_args[4] = { 0, 0, 0, (uintptr_t)args.args }; dom.root_task->start(crate->get_exit_task_glue(), main_fn, diff --git a/src/rt/rust_task.cpp b/src/rt/rust_task.cpp index 084c8acd..7c92c4ca 100644 --- a/src/rt/rust_task.cpp +++ b/src/rt/rust_task.cpp @@ -130,6 +130,7 @@ rust_task::start(uintptr_t exit_task_glue, uintptr_t *spp = (uintptr_t *)rust_sp; // The exit_task_glue frame we synthesize above the frame we activate: + *spp-- = (uintptr_t) 0; // closure-or-obj *spp-- = (uintptr_t) this; // task *spp-- = (uintptr_t) 0; // output *spp-- = (uintptr_t) 0; // retpc @@ -153,6 +154,7 @@ rust_task::start(uintptr_t exit_task_glue, uintptr_t *src = (uintptr_t *)args; src += 1; // spawn-call output slot src += 1; // spawn-call task slot + src += 1; // spawn-call closure-or-obj slot // Memcpy all but the task and output pointers callsz -= (2 * sizeof(uintptr_t)); spp = (uintptr_t*) (((uintptr_t)spp) - callsz); @@ -168,6 +170,7 @@ rust_task::start(uintptr_t exit_task_glue, // The *implicit* incoming args to the spawnee frame we're // activating: + *spp-- = (uintptr_t) 0; // closure-or-obj *spp-- = (uintptr_t) this; // task *spp-- = (uintptr_t) 0; // output addr *spp-- = (uintptr_t) exit_task_glue; // retpc @@ -423,6 +426,8 @@ rust_task::link_gc(gc_alloc *gcm) { gcm->prev = NULL; gcm->next = gc_alloc_chain; gc_alloc_chain = gcm; + if (gcm->next) + gcm->next->prev = gcm; } void @@ -431,6 +436,8 @@ rust_task::unlink_gc(gc_alloc *gcm) { gcm->prev->next = gcm->next; if (gcm->next) gcm->next->prev = gcm->prev; + if (gc_alloc_chain == gcm) + gc_alloc_chain = gcm->next; gcm->prev = NULL; gcm->next = NULL; } diff --git a/src/test/compile-fail/put-in-fn.rs b/src/test/compile-fail/put-in-fn.rs new file mode 100644 index 00000000..bb6363ac --- /dev/null +++ b/src/test/compile-fail/put-in-fn.rs @@ -0,0 +1,8 @@ +// error-pattern: Non-iter function + +fn f() -> int { + put 10; +} + +fn main() { +}
\ No newline at end of file diff --git a/src/test/run-pass/exterior.rs b/src/test/run-pass/exterior.rs index 0e93e25a..f09ee823 100644 --- a/src/test/run-pass/exterior.rs +++ b/src/test/run-pass/exterior.rs @@ -9,7 +9,7 @@ fn f(@point p) { } fn main() { - let point a = rec(x=10, y=11, z=mutable 12); + let point a = rec(x=10, y=11, mutable z=12); let @point b = @a; check (b.z == 12); f(b); diff --git a/src/test/run-pass/mlist-cycle.rs b/src/test/run-pass/mlist-cycle.rs index 313455f8..c41cd5f5 100644 --- a/src/test/run-pass/mlist-cycle.rs +++ b/src/test/run-pass/mlist-cycle.rs @@ -8,7 +8,7 @@ type list = tag(link(@cell), nil()); fn main() { let @cell first = tup(@nil()); let @cell second = tup(@link(first)); - first._0 = link(second); + first._0 = @link(second); std.sys.rustrt.gc(); let @cell third = tup(@nil()); } diff --git a/src/test/run-pass/vec-late-init.rs b/src/test/run-pass/vec-late-init.rs new file mode 100644 index 00000000..39a0b6e8 --- /dev/null +++ b/src/test/run-pass/vec-late-init.rs @@ -0,0 +1,9 @@ +fn main() { + let vec[int] later; + if (true) { + later = vec(1); + } else { + later = vec(2); + } + log later.(0); +}
\ No newline at end of file diff --git a/src/test/run-pass/writealias.rs b/src/test/run-pass/writealias.rs index 061b1b57..8bf8140f 100644 --- a/src/test/run-pass/writealias.rs +++ b/src/test/run-pass/writealias.rs @@ -7,7 +7,7 @@ fn f(& mutable point p) { } fn main() { - let point x = rec(x=10, y=11, z=mutable 12); + let point x = rec(x=10, y=11, mutable z=12); f(x); check (x.z == 13); } |