bootstrap.image: remove some duplication from emit-object callers
parent
7fae35c414
commit
3bbfc57de3
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue