bootstrap.image: remove some duplication from emit-object callers

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index 059d76a38824373c13827fe122354cfc9c74633b..a83b81d3f9420b1f096d0166ab8460b50cb13f9f 100644 (file)
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -247,8 +247,8 @@ SYMBOL: undefined-quot
 
 : emit-fixnum ( n -- ) tag-fixnum emit ;
 
-: emit-object ( header tag quot -- addr )
-    swap here-as [ swap tag-fixnum emit call align-here ] dip ;
+: emit-object ( class quot -- addr )
+    over tag-number here-as [ swap type-number tag-fixnum emit call align-here ] dip ;
     inline
 
 ! Write an object to the image.
@@ -293,7 +293,7 @@ GENERIC: ' ( obj -- ptr )
 
 M: bignum '
     [
-        bignum tag-number dup [ emit-bignum ] emit-object
+        bignum [ emit-bignum ] emit-object
     ] cache-object ;
 
 ! Fixnums
@@ -316,7 +316,7 @@ M: fake-bignum ' n>> tag-fixnum ;
 
 M: float '
     [
-        float tag-number dup [
+        float [
             align-here double>bits emit-64
         ] emit-object
     ] cache-object ;
@@ -360,8 +360,7 @@ M: f '
                 } cleave
             ] { } make [ ' ] map
         ] bi
-        \ word type-number object tag-number
-        [ emit-seq ] emit-object
+        \ word [ emit-seq ] emit-object
     ] keep put-object ;
 
 : word-error ( word msg -- * )
@@ -382,8 +381,7 @@ M: word ' ;
 ! Wrappers
 
 M: wrapper '
-    wrapped>> ' wrapper type-number object tag-number
-    [ emit ] emit-object ;
+    wrapped>> ' wrapper [ emit ] emit-object ;
 
 ! Strings
 : native> ( object -- object )
@@ -412,7 +410,7 @@ M: wrapper '
 
 : emit-string ( string -- ptr )
     [ length ] [ extended-part ' ] [ ] tri
-    string type-number object tag-number [
+    string [
         [ emit-fixnum ]
         [ emit ]
         [ f ' emit ascii-part pad-bytes emit-bytes ]
@@ -429,12 +427,11 @@ M: string '
 
 : emit-dummy-array ( obj type -- ptr )
     [ assert-empty ] [
-        type-number object tag-number
         [ 0 emit-fixnum ] emit-object
     ] bi* ;
 
 M: byte-array '
-    byte-array type-number object tag-number [
+    byte-array [
         dup length emit-fixnum
         pad-bytes emit-bytes
     ] emit-object ;
@@ -448,7 +445,7 @@ ERROR: tuple-removed class ;
 : (emit-tuple) ( tuple -- pointer )
     [ tuple-slots ]
     [ class transfer-word require-tuple-layout ] bi prefix [ ' ] map
-    tuple type-number dup [ emit-seq ] emit-object ;
+    tuple [ emit-seq ] emit-object ;
 
 : emit-tuple ( tuple -- pointer )
     dup class name>> "tombstone" =
@@ -463,8 +460,7 @@ M: tombstone '
 
 ! Arrays
 : emit-array ( array -- offset )
-    [ ' ] map array type-number object tag-number
-    [ [ length emit-fixnum ] [ emit-seq ] bi ] emit-object ;
+    [ ' ] map array [ [ length emit-fixnum ] [ emit-seq ] bi ] emit-object ;
 
 M: array ' emit-array ;
 
@@ -490,7 +486,7 @@ M: tuple-layout-array '
 M: quotation '
     [
         array>> '
-        quotation type-number object tag-number [
+        quotation [
             emit ! array
             f ' emit ! compiled
             f ' emit ! cached-effect

diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index 0a69f313c178b836394f0099ae2f66f813f5070e..d384109cee11357c6c77dd4a9fd77a833f1c597f 100644 (file)
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: math kernel layouts system strings ;
+USING: math kernel layouts system strings words quotations byte-arrays alien ;
 IN: compiler.constants
 
 ! These constants must match vm/memory.h
@@ -11,16 +11,15 @@ CONSTANT: deck-bits 18
 ! These constants must match vm/layouts.h
 : header-offset ( -- n ) object tag-number neg ; inline
 : float-offset ( -- n ) 8 float tag-number - ; inline
-: string-offset ( -- n ) 4 bootstrap-cells object tag-number - ; inline
+: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline
 : string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
-: profile-count-offset ( -- n ) 7 bootstrap-cells object tag-number - ; inline
-: byte-array-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
-: alien-offset ( -- n ) 3 bootstrap-cells object tag-number - ; inline
-: underlying-alien-offset ( -- n ) bootstrap-cell object tag-number - ; inline
+: profile-count-offset ( -- n ) 7 bootstrap-cells \ word tag-number - ; inline
+: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline
+: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline
+: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
 : tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
-: class-hash-offset ( -- n ) bootstrap-cell object tag-number - ; inline
-: word-xt-offset ( -- n ) 9 bootstrap-cells object tag-number - ; inline
-: quot-xt-offset ( -- n ) 5 bootstrap-cells object tag-number - ; inline
+: word-xt-offset ( -- n ) 9 bootstrap-cells \ word tag-number - ; inline
+: quot-xt-offset ( -- n ) 5 bootstrap-cells quotation tag-number - ; inline
 : word-code-offset ( -- n ) 10 bootstrap-cells object tag-number - ; inline
 : array-start-offset ( -- n ) 2 bootstrap-cells object tag-number - ; inline
 : compiled-header-size ( -- n ) 5 bootstrap-cells ; inline