]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/bootstrap/image/image.factor
use radix literals
[factor.git] / basis / bootstrap / image / image.factor
index ca6535206540bad8b1fba840b7c1e4a9903ca860..dc8343e6fae6c3177175ff2c504623ee8f157457 100755 (executable)
@@ -48,7 +48,7 @@ M: eql-wrapper hashcode* obj>> hashcode* ;
 GENERIC: (eql?) ( obj1 obj2 -- ? )
 
 : eql? ( obj1 obj2 -- ? )
-    { [ [ class ] bi@ = ] [ (eql?) ] } 2&& ;
+    { [ [ class-of ] bi@ = ] [ (eql?) ] } 2&& ;
 
 M: fixnum (eql?) eq? ;
 
@@ -87,12 +87,12 @@ SYMBOL: objects
 
 ! Constants
 
-CONSTANT: image-magic HEX: 0f0e0d0c
+CONSTANT: image-magic 0x0f0e0d0c
 CONSTANT: image-version 4
 
 CONSTANT: data-base 1024
 
-CONSTANT: special-objects-size 70
+CONSTANT: special-objects-size 80
 
 CONSTANT: header-size 10
 
@@ -166,44 +166,49 @@ SPECIAL-OBJECT: jit-word-jump 26
 SPECIAL-OBJECT: jit-word-call 27
 SPECIAL-OBJECT: jit-if-word 28
 SPECIAL-OBJECT: jit-if 29
-SPECIAL-OBJECT: jit-epilog 30
-SPECIAL-OBJECT: jit-return 31
-SPECIAL-OBJECT: jit-profiling 32
-SPECIAL-OBJECT: jit-push 33
-SPECIAL-OBJECT: jit-dip-word 34
-SPECIAL-OBJECT: jit-dip 35
-SPECIAL-OBJECT: jit-2dip-word 36
-SPECIAL-OBJECT: jit-2dip 37
-SPECIAL-OBJECT: jit-3dip-word 38
-SPECIAL-OBJECT: jit-3dip 39
-SPECIAL-OBJECT: jit-execute 40
-SPECIAL-OBJECT: jit-declare-word 41
-
-SPECIAL-OBJECT: c-to-factor-word 42
-SPECIAL-OBJECT: lazy-jit-compile-word 43
-SPECIAL-OBJECT: unwind-native-frames-word 44
-SPECIAL-OBJECT: fpu-state-word 45
-SPECIAL-OBJECT: set-fpu-state-word 46
-
-SPECIAL-OBJECT: callback-stub 48
+SPECIAL-OBJECT: jit-safepoint 30
+SPECIAL-OBJECT: jit-epilog 31
+SPECIAL-OBJECT: jit-return 32
+SPECIAL-OBJECT: jit-profiling 33
+SPECIAL-OBJECT: jit-push 34
+SPECIAL-OBJECT: jit-dip-word 35
+SPECIAL-OBJECT: jit-dip 36
+SPECIAL-OBJECT: jit-2dip-word 37
+SPECIAL-OBJECT: jit-2dip 38
+SPECIAL-OBJECT: jit-3dip-word 39
+SPECIAL-OBJECT: jit-3dip 40
+SPECIAL-OBJECT: jit-execute 41
+SPECIAL-OBJECT: jit-declare-word 42
+
+SPECIAL-OBJECT: c-to-factor-word 43
+SPECIAL-OBJECT: lazy-jit-compile-word 44
+SPECIAL-OBJECT: unwind-native-frames-word 45
+SPECIAL-OBJECT: fpu-state-word 46
+SPECIAL-OBJECT: set-fpu-state-word 47
+SPECIAL-OBJECT: signal-handler-word 48
+SPECIAL-OBJECT: leaf-signal-handler-word 49
+SPECIAL-OBJECT: ffi-signal-handler-word 50
+SPECIAL-OBJECT: ffi-leaf-signal-handler-word 51
+
+SPECIAL-OBJECT: callback-stub 53
 
 ! PIC stubs
-SPECIAL-OBJECT: pic-load 49
-SPECIAL-OBJECT: pic-tag 50
-SPECIAL-OBJECT: pic-tuple 51
-SPECIAL-OBJECT: pic-check-tag 52
-SPECIAL-OBJECT: pic-check-tuple 53
-SPECIAL-OBJECT: pic-hit 54
-SPECIAL-OBJECT: pic-miss-word 55
-SPECIAL-OBJECT: pic-miss-tail-word 56
+SPECIAL-OBJECT: pic-load 54
+SPECIAL-OBJECT: pic-tag 55
+SPECIAL-OBJECT: pic-tuple 56
+SPECIAL-OBJECT: pic-check-tag 57
+SPECIAL-OBJECT: pic-check-tuple 58
+SPECIAL-OBJECT: pic-hit 59
+SPECIAL-OBJECT: pic-miss-word 60
+SPECIAL-OBJECT: pic-miss-tail-word 61
 
 ! Megamorphic dispatch
-SPECIAL-OBJECT: mega-lookup 57
-SPECIAL-OBJECT: mega-lookup-word 58
-SPECIAL-OBJECT: mega-miss-word 59
+SPECIAL-OBJECT: mega-lookup 62
+SPECIAL-OBJECT: mega-lookup-word 63
+SPECIAL-OBJECT: mega-miss-word 64
 
 ! Default definition for undefined words
-SPECIAL-OBJECT: undefined-quot 60
+SPECIAL-OBJECT: undefined-quot 65
 
 : special-object-offset ( symbol -- n )
     special-objects get at header-size + ;
@@ -345,11 +350,8 @@ M: f ' drop \ f type-number ;
                     [ props>> , ]
                     [ pic-def>> , ]
                     [ pic-tail-def>> , ]
-                    [ drop 0 , ] ! count
                     [ word-sub-primitive , ]
-                    [ drop 0 , ] ! xt
-                    [ drop 0 , ] ! code
-                    [ drop 0 , ] ! profiling
+                    [ drop 0 , ] ! entry point
                 } cleave
             ] { } make [ ' ] map
         ] bi
@@ -440,11 +442,11 @@ ERROR: tuple-removed class ;
 
 : (emit-tuple) ( tuple -- pointer )
     [ tuple-slots ]
-    [ class transfer-word require-tuple-layout ] bi prefix [ ' ] map
+    [ class-of transfer-word require-tuple-layout ] bi prefix [ ' ] map
     tuple [ emit-seq ] emit-object ;
 
 : emit-tuple ( tuple -- pointer )
-    dup class name>> "tombstone" =
+    dup class-of name>> "tombstone" =
     [ [ (emit-tuple) ] cache-eql-object ]
     [ [ (emit-tuple) ] cache-eq-object ]
     if ;
@@ -453,7 +455,7 @@ M: tuple ' emit-tuple ;
 
 M: tombstone '
     state>> "((tombstone))" "((empty))" ?
-    "hashtables.private" lookup def>> first
+    "hashtables.private" lookup-word def>> first
     [ emit-tuple ] cache-eql-object ;
 
 ! Arrays
@@ -488,8 +490,7 @@ M: quotation '
             emit ! array
             f ' emit ! cached-effect
             f ' emit ! cache-counter
-            0 emit ! xt
-            0 emit ! code
+            0 emit ! entry point
         ] emit-object
     ] cache-eql-object ;
 
@@ -525,6 +526,10 @@ M: quotation '
     \ unwind-native-frames unwind-native-frames-word set
     \ fpu-state fpu-state-word set
     \ set-fpu-state set-fpu-state-word set
+    \ signal-handler signal-handler-word set
+    \ leaf-signal-handler leaf-signal-handler-word set
+    \ ffi-signal-handler ffi-signal-handler-word set
+    \ ffi-leaf-signal-handler ffi-leaf-signal-handler-word set
     undefined-def undefined-quot set ;
 
 : emit-special-objects ( -- )