images referencing libraries that could not be found no longer fail to load

library/bootstrap/boot-stage1.factor

@@ -118,6 +118,7 @@ parser prettyprint sequences io vectors words ;
 ] make-list
 
 "object" [ "generic" ] search
+"tuple" [ "generic" ] search
 "null" [ "generic" ] search
 "typemap" [ "generic" ] search
 "builtins" [ "generic" ] search
@@ -128,6 +129,7 @@ reveal
 reveal
 reveal
 reveal
+reveal
 
 [
     [
@@ -137,10 +139,6 @@ reveal
 
         [ hashtable? ] instances
         [ dup hash-size 1 max swap set-bucket-count ] each
-    
-        "Building cross-reference database..." print
-        
-        recrossref
     ] %
 
     {
@@ -158,12 +156,6 @@ reveal
     
         "/library/bootstrap/init.factor"
     } pull-in
-
-    [
-        "Building generics..." print
-    
-        all-words [ generic? ] subset [ make-generic ] each
-    ] %
 ] make-list
 
 swap

library/bootstrap/boot-stage3.factor

@@ -114,6 +114,9 @@ compile? [
     ] pull-in
 ] when
 
+"Building cross-reference database..." print
+recrossref
+
 compile? [
     "Compiling system..." print
     compile-all

library/compiler/intrinsics.factor

@@ -59,8 +59,6 @@ sequences vectors words ;
 : peek-2 dup length 2 - swap nth ;
 : node-peek-2 ( node -- obj ) node-in-d peek-2 ;
 
-: value-types drop f ;
-
 : typed? ( value -- ? ) value-types length 1 = ;
 
 : slot@ ( node -- n )
@@ -109,7 +107,15 @@ sequences vectors words ;
     drop
     in-1
     0 %type ,
-    0 %tag-fixnum ,
+    0 %retag-fixnum ,
+    out-1
+] "intrinsic" set-word-prop
+
+\ tag [
+    drop
+    in-1
+    0 %tag ,
+    0 %retag-fixnum ,
     out-1
 ] "intrinsic" set-word-prop
 

library/compiler/ppc/generator.factor

@@ -86,7 +86,7 @@ M: %untag-fixnum generate-node ( vop -- )
 
 : tag-fixnum ( dest src -- ) tag-bits SLWI ;
 
-M: %tag-fixnum generate-node ( vop -- )
+M: %retag-fixnum generate-node ( vop -- )
     ! todo: formalize scratch register usage
     dest/src tag-fixnum ;
 
@@ -124,3 +124,6 @@ M: %type generate-node ( vop -- )
     f type 18 LI
     "end" get save-xt
     17 18 MR ;
+
+M: %tag generate-node ( vop -- )
+    dup vop-in-1 swap vop-out-1 tag-mask ANDI ;

library/compiler/simplifier.factor

@@ -71,7 +71,7 @@ M: %inc-d simplify-node ( linear vop -- linear ? )
     [ over first operands= [ cdr cdr t ] [ f ] ifte ]
     [ drop f ] ifte ;
 
-M: %tag-fixnum simplify-node ( linear vop -- linear ? )
+M: %retag-fixnum simplify-node ( linear vop -- linear ? )
     drop \ %untag-fixnum cancel ;
 
 : basic-block ( linear quot -- | quot: vop -- ? )

library/compiler/vops.factor

@@ -302,10 +302,15 @@ C: %type make-vop ;
 : %type ( vreg ) <vreg> dest-vop <%type> ;
 M: %type basic-block? drop t ;
 
-TUPLE: %tag-fixnum ;
-C: %tag-fixnum make-vop ;
-: %tag-fixnum <vreg> dest-vop <%tag-fixnum> ;
-M: %tag-fixnum basic-block? drop t ;
+TUPLE: %tag ;
+C: %tag make-vop ;
+: %tag ( vreg ) <vreg> dest-vop <%tag> ;
+M: %tag basic-block? drop t ;
+
+TUPLE: %retag-fixnum ;
+C: %retag-fixnum make-vop ;
+: %retag-fixnum <vreg> dest-vop <%retag-fixnum> ;
+M: %retag-fixnum basic-block? drop t ;
 
 TUPLE: %untag-fixnum ;
 C: %untag-fixnum make-vop ;

library/compiler/x86/generator.factor

@@ -43,7 +43,7 @@ M: %return generate-node ( vop -- )
 M: %untag generate-node ( vop -- )
     vop-out-1 v>operand BIN: 111 bitnot AND ;
 
-M: %tag-fixnum generate-node ( vop -- )
+M: %retag-fixnum generate-node ( vop -- )
     vop-out-1 v>operand 3 SHL ;
 
 M: %untag-fixnum generate-node ( vop -- )
@@ -92,3 +92,7 @@ M: %type generate-node ( vop -- )
     ! The pointer is equal to 3. Load F_TYPE (9).
     f type MOV
     "end" get save-xt ;
+
+M: %tag generate-node ( vop -- )
+    dup dup vop-in-1 check-dest
+    vop-in-1 v>operand tag-mask AND ;

library/generic/generic.factor

@@ -76,7 +76,7 @@ SYMBOL: null
     dup init-methods make-generic ;
 
 PREDICATE: compound generic ( word -- ? )
-    "picker" word-prop ;
+    "combination" word-prop ;
 
 M: generic definer drop \ G: ;
 

library/tools/debugger.factor

@@ -38,6 +38,10 @@ vectors words ;
 : heap-scan-error. ( obj -- )
     "Cannot do next-object outside begin/end-scan" print drop ;
 
+: undefined-symbol-error. ( obj -- )
+    "The image refers to a library or symbol that was not found"
+    " at load time" append print drop ;
+
 PREDICATE: cons kernel-error ( obj -- ? )
     car kernel-error = ;
 
@@ -54,6 +58,7 @@ M: kernel-error error. ( error -- )
         c-string-error.
         ffi-error.
         heap-scan-error.
+        undefined-symbol-error.
     } nth execute ;
 
 M: no-method error. ( error -- )

library/words.factor

@@ -49,7 +49,11 @@ SYMBOL: crossref
 : add-crossref ( word -- )
     #! Marks each word in the quotation as being a dependency
     #! of the word.
-    dup word-def [ (add-crossref) ] tree-each-with ;
+    crossref get [
+        dup word-def [ (add-crossref) ] tree-each-with
+    ] [
+        drop
+    ] ifte ;
 
 : (remove-crossref)
     dup word? [
@@ -61,16 +65,20 @@ SYMBOL: crossref
 : remove-crossref ( word -- )
     #! Marks each word in the quotation as not being a
     #! dependency of the word.
-    dup word-def [ (remove-crossref) ] tree-each-with ;
+    crossref get [
+        dup word-def [ (remove-crossref) ] tree-each-with
+    ] [
+        drop
+    ] ifte ;
 
 : usages ( word -- deps )
     #! List all usages of a word. This is a transitive closure,
     #! so indirect usages are reported.
-    crossref get closure word-sort ;
+    crossref get dup [ closure word-sort ] [ 2drop { } ] ifte ;
 
 : usage ( word -- list )
     #! List all direct usages of a word.
-    crossref get hash dup [ hash-keys ] when word-sort ;
+    crossref get ?hash dup [ hash-keys ] when word-sort ;
 
 GENERIC: (uncrossref) ( word -- )
 M: word (uncrossref) drop ;

native/dll.c

@@ -10,7 +10,7 @@ void primitive_dlopen(void)
 	path = untag_string(dpop());
 	dll = allot_object(DLL_TYPE,sizeof(DLL));
 	dll->path = tag_object(path);
-	ffi_dlopen(dll);
+	ffi_dlopen(dll,true);
 
 	dpush(tag_object(dll));
 }
@@ -18,16 +18,25 @@ void primitive_dlopen(void)
 void primitive_dlsym(void)
 {
 	CELL dll;
-	F_STRING* sym;
+	F_STRING *sym;
+	void *handle;
 
 	maybe_gc(0);
 
 	dll = dpop();
 	sym = untag_string(dpop());
 	
-	dpush(tag_cell((CELL)ffi_dlsym(
-		dll == F ? NULL : untag_dll(dll),
-		sym)));
+	if(dll == F)
+		handle = NULL;
+	else
+	{
+		DLL *d = untag_dll(dll);
+		if(d->dll == NULL)
+			general_error(ERROR_EXPIRED,dll);
+		handle = d->dll;
+	}
+
+	dpush(tag_cell((CELL)ffi_dlsym(handle,sym,true)));
 }
 
 void primitive_dlclose(void)
@@ -35,19 +44,10 @@ void primitive_dlclose(void)
 	ffi_dlclose(untag_dll(dpop()));
 }
 
-DLL* untag_dll(CELL tagged)
-{
-	DLL* dll = (DLL*)UNTAG(tagged);
-	type_check(DLL_TYPE,tagged);
-	if(dll->dll == NULL)
-		general_error(ERROR_EXPIRED,tagged);
-	return (DLL*)UNTAG(tagged);
-}
-
 void fixup_dll(DLL* dll)
 {
 	data_fixup(&dll->path);
-	ffi_dlopen(dll);
+	ffi_dlopen(dll,false);
 }
 
 void collect_dll(DLL* dll)

native/dll.h

@@ -6,12 +6,16 @@ typedef struct {
 	void* dll;
 } DLL;
 
-DLL* untag_dll(CELL tagged);
+INLINE DLL* untag_dll(CELL tagged)
+{
+	type_check(DLL_TYPE,tagged);
+	return (DLL*)UNTAG(tagged);
+}
 
 void init_ffi(void);
 
-void ffi_dlopen(DLL *dll);
-void *ffi_dlsym(DLL *dll, F_STRING *symbol);
+void ffi_dlopen(DLL *dll, bool error);
+void *ffi_dlsym(DLL *dll, F_STRING *symbol, bool error);
 void ffi_dlclose(DLL *dll);
 
 void primitive_dlopen(void);

native/error.h

@@ -8,6 +8,7 @@
 #define ERROR_C_STRING (7<<3)
 #define ERROR_FFI (8<<3)
 #define ERROR_HEAP_SCAN (9<<3)
+#define ERROR_UNDEFINED_SYMBOL (10<<3)
 
 /* When throw_error throws an error, it sets this global and
 longjmps back to the top-level. */

native/relocate.c

@@ -85,12 +85,27 @@ void relocate_data()
 	}
 }
 
+void undefined_symbol(void)
+{
+	
+}
+
 CELL get_rel_symbol(F_REL* rel)
 {
 	F_CONS* cons = untag_cons(get(rel->argument));
 	F_STRING* symbol = untag_string(cons->car);
 	DLL* dll = (cons->cdr == F ? NULL : untag_dll(cons->cdr));
-	return (CELL)ffi_dlsym(dll,symbol);
+	CELL sym;
+
+	if(!dll)
+		return (CELL)undefined_symbol;
+
+	sym = (CELL)ffi_dlsym(dll,symbol,false);
+
+	if(!sym)
+		return (CELL)undefined_symbol;
+
+	return sym;
 }
 
 INLINE CELL compute_code_rel(F_REL *rel, CELL original)

native/unix/ffi.c

@@ -7,27 +7,39 @@ void init_ffi(void)
 	null_dll = dlopen(NULL,RTLD_LAZY);
 }
 
-void ffi_dlopen(DLL *dll)
+void ffi_dlopen(DLL *dll, bool error)
 {
 	void *dllptr = dlopen(to_c_string(untag_string(dll->path)), RTLD_LAZY);
 
 	if(dllptr == NULL)
 	{
-		general_error(ERROR_FFI,tag_object(
-			from_c_string(dlerror())));
+		if(error)
+		{
+			general_error(ERROR_FFI,tag_object(
+				from_c_string(dlerror())));
+		}
+		else
+			dll->dll = NULL;
+
+		return;
 	}
 
 	dll->dll = dllptr;
 }
 
-void *ffi_dlsym(DLL *dll, F_STRING *symbol)
+void *ffi_dlsym(DLL *dll, F_STRING *symbol, bool error)
 {
 	void *handle = (dll == NULL ? null_dll : dll->dll);
 	void *sym = dlsym(handle,to_c_string(symbol));
 	if(sym == NULL)
 	{
-		general_error(ERROR_FFI,tag_object(
-			from_c_string(dlerror())));
+		if(error)
+		{
+			general_error(ERROR_FFI,tag_object(
+				from_c_string(dlerror())));
+		}
+
+		return NULL;
 	}
 	return sym;
 }

native/win32/ffi.c

@@ -4,7 +4,7 @@ void init_ffi (void)
 {
 }
 
-void ffi_dlopen (DLL *dll)
+void ffi_dlopen (DLL *dll, bool error)
 {
 	HMODULE module;
 	char *path = to_c_string(untag_string(dll->path));
@@ -12,18 +12,28 @@ void ffi_dlopen (DLL *dll)
 	module = LoadLibrary(path);
 
 	if (!module)
-		general_error(ERROR_FFI, tag_object(last_error()));
+	{
+		if(error)
+			general_error(ERROR_FFI, tag_object(last_error()));
+		else
+			return;
+	}
 
 	dll->dll = module;
 }
 
-void *ffi_dlsym (DLL *dll, F_STRING *symbol)
+void *ffi_dlsym (DLL *dll, F_STRING *symbol, bool error)
 {
 	void *sym = GetProcAddress(dll ? (HMODULE)dll->dll : GetModuleHandle(NULL),
 		to_c_string(symbol));
 
 	if (!sym)
-		general_error(ERROR_FFI, tag_object(last_error()));
+	{
+		if(error)
+			general_error(ERROR_FFI, tag_object(last_error()));
+		else
+			return NULL;
+	}
 
 	return sym;
 }