primitives: Change PRIMITIVE: to check that the word is in that vocabulary and the...

Use PRIMITIVE: in core/ and basis/

diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor
index 0fcb197335b4c462a0c47c407cbaa5c16d2dd9f3..91d6494c217e9a0d168bad1821f3d4f07e23208b 100755 (executable)
--- a/basis/alien/libraries/libraries.factor
+++ b/basis/alien/libraries/libraries.factor
@@ -5,6 +5,12 @@ kernel namespaces destructors sequences strings
 system io.pathnames fry combinators vocabs ;
 IN: alien.libraries
 
+PRIMITIVE: dll-valid? ( dll -- ? )
+PRIMITIVE: (dlopen) ( path -- dll )
+PRIMITIVE: (dlsym) ( name dll -- alien )
+PRIMITIVE: dlclose ( dll -- )
+PRIMITIVE: (dlsym-raw) ( name dll -- alien )
+
 : dlopen ( path -- dll ) native-string>alien (dlopen) ;
 
 : dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;

diff --git a/basis/locals/backend/backend.factor b/basis/locals/backend/backend.factor
index 1c1f288797924b5428463c32733c5ff0814ee100..5f0cf9963f72c4853e4201811d036217da44a2c3 100644 (file)
--- a/basis/locals/backend/backend.factor
+++ b/basis/locals/backend/backend.factor
@@ -3,6 +3,11 @@
 USING: slots.private ;
 IN: locals.backend
 
+PRIMITIVE: drop-locals ( n -- )
+PRIMITIVE: get-local ( n -- obj )
+PRIMITIVE: load-local ( obj -- )
+PRIMITIVE: load-locals ( ... n -- )
+
 : local-value ( box -- value ) 2 slot ; inline
 
 : set-local-value ( value box -- ) 2 set-slot ; inline

diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor
index d8bccf9f8ad45bab661e3f20af0ae9f03ff3cdb3..51097a604393e682dcda7c405a5341769ae47b43 100644 (file)
--- a/basis/threads/threads.factor
+++ b/basis/threads/threads.factor
@@ -9,6 +9,15 @@ FROM: assocs => change-at ;
 IN: threads
 
 <PRIVATE
+PRIMITIVE: (set-context) ( obj context -- obj' )
+PRIMITIVE: (set-context-and-delete) ( obj context -- * )
+PRIMITIVE: (sleep) ( nanos -- )
+PRIMITIVE: (start-context) ( obj quot -- obj' )
+PRIMITIVE: (start-context-and-delete) ( obj quot -- * )
+PRIMITIVE: callstack-for ( context -- array )
+PRIMITIVE: context-object-for ( n context -- obj )
+PRIMITIVE: datastack-for ( context -- array )
+PRIMITIVE: retainstack-for ( context -- array )
 
 ! Wrap sub-primitives; we don't want them inlined into callers
 ! since their behavior depends on what frames are on the callstack

diff --git a/basis/tools/dispatch/dispatch.factor b/basis/tools/dispatch/dispatch.factor
index 72830b29b44a28d7f724021f6116864989582d55..9ec8954b0bf041d3fa9f116c39a6334b8fdac163 100644 (file)
--- a/basis/tools/dispatch/dispatch.factor
+++ b/basis/tools/dispatch/dispatch.factor
@@ -4,6 +4,11 @@ USING: accessors kernel namespaces prettyprint classes.struct
 vm tools.dispatch.private ;
 IN: tools.dispatch
 
+<PRIVATE
+PRIMITIVE: dispatch-stats ( -- stats )
+PRIMITIVE: reset-dispatch-stats ( -- )
+PRIVATE>
+
 SYMBOL: last-dispatch-stats
 
 : dispatch-stats. ( -- )

diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor
index 7250c47edda90a283050e2a513cd0895b9218195..d8e692110530aa8d12d8dd29938fa570a26c9e97 100644 (file)
--- a/basis/tools/memory/memory.factor
+++ b/basis/tools/memory/memory.factor
@@ -9,6 +9,12 @@ splitting strings system vm words hints hashtables ;
 IN: tools.memory
 
 <PRIVATE
+PRIMITIVE: (callback-room) ( -- allocator-room )
+PRIMITIVE: (code-blocks) ( -- array )
+PRIMITIVE: (code-room) ( -- allocator-room )
+PRIMITIVE: (data-room) ( -- data-room )
+PRIMITIVE: disable-gc-events ( -- events )
+PRIMITIVE: enable-gc-events ( -- )
 
 : commas ( n -- str )
     dup 0 < [ neg commas "-" prepend ] [

diff --git a/basis/tools/profiler/sampling/sampling.factor b/basis/tools/profiler/sampling/sampling.factor
index 4a6e6f7a5b1e2eaa1a9450315ed12ffa927a8c78..d54f24c7cd78dd58b1df07ec166bdd4461a18310 100644 (file)
--- a/basis/tools/profiler/sampling/sampling.factor
+++ b/basis/tools/profiler/sampling/sampling.factor
@@ -8,6 +8,12 @@ FROM: sequences => change-nth ;
 FROM: assocs => change-at ;
 IN: tools.profiler.sampling
 
+<PRIVATE
+PRIMITIVE: (get-samples) ( -- samples/f )
+PRIMITIVE: profiling ( ? -- )
+PRIMITIVE: (clear-samples) ( -- )
+PRIVATE>
+
 SYMBOL: samples-per-second
 
 samples-per-second [ 1,000 ] initialize

diff --git a/core/alien/accessors/accessors.factor b/core/alien/accessors/accessors.factor
new file mode 100644 (file)
index 0000000..c439b1d
--- /dev/null
+++ b/core/alien/accessors/accessors.factor
@@ -0,0 +1,30 @@
+! Copyright (C) 2015 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+IN: alien.accessors
+
+PRIMITIVE: alien-cell ( c-ptr n -- value )
+PRIMITIVE: alien-double ( c-ptr n -- value )
+PRIMITIVE: alien-float ( c-ptr n -- value )
+PRIMITIVE: alien-signed-1 ( c-ptr n -- value )
+PRIMITIVE: alien-signed-2 ( c-ptr n -- value )
+PRIMITIVE: alien-signed-4 ( c-ptr n -- value )
+PRIMITIVE: alien-signed-8 ( c-ptr n -- value )
+PRIMITIVE: alien-signed-cell ( c-ptr n -- value )
+PRIMITIVE: alien-unsigned-1 ( c-ptr n -- value )
+PRIMITIVE: alien-unsigned-2 ( c-ptr n -- value )
+PRIMITIVE: alien-unsigned-4 ( c-ptr n -- value )
+PRIMITIVE: alien-unsigned-8 ( c-ptr n -- value )
+PRIMITIVE: alien-unsigned-cell ( c-ptr n -- value )
+PRIMITIVE: set-alien-cell ( value c-ptr n -- )
+PRIMITIVE: set-alien-double ( value c-ptr n -- )
+PRIMITIVE: set-alien-float ( value c-ptr n -- )
+PRIMITIVE: set-alien-signed-1 ( value c-ptr n -- )
+PRIMITIVE: set-alien-signed-2 ( value c-ptr n -- )
+PRIMITIVE: set-alien-signed-4 ( value c-ptr n -- )
+PRIMITIVE: set-alien-signed-8 ( value c-ptr n -- )
+PRIMITIVE: set-alien-signed-cell ( value c-ptr n -- )
+PRIMITIVE: set-alien-unsigned-1 ( value c-ptr n -- )
+PRIMITIVE: set-alien-unsigned-2 ( value c-ptr n -- )
+PRIMITIVE: set-alien-unsigned-4 ( value c-ptr n -- )
+PRIMITIVE: set-alien-unsigned-8 ( value c-ptr n -- )
+PRIMITIVE: set-alien-unsigned-cell ( value c-ptr n -- )

diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index 15db70913705052b1fbc374fe5d696de97a468c1..b60331d8cb3b6ea6d4a01258cd0bfe60da2a1d5e 100755 (executable)
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -8,6 +8,15 @@ IN: alien
 BUILTIN: alien { underlying c-ptr read-only initial: f } expired ;
 BUILTIN: dll { path byte-array read-only initial: B{ } } ;
 
+PRIMITIVE: <callback> ( word return-rewind -- alien )
+PRIMITIVE: <displaced-alien> ( displacement c-ptr -- alien )
+PRIMITIVE: alien-address ( c-ptr -- addr )
+PRIMITIVE: free-callback ( alien -- )
+
+<PRIVATE
+PRIMITIVE: current-callback ( -- n )
+PRIVATE>
+
 PREDICATE: pinned-alien < alien underlying>> not ;
 
 UNION: pinned-c-ptr pinned-alien POSTPONE: f ;

diff --git a/core/arrays/arrays.factor b/core/arrays/arrays.factor
index 384f0af67817e43d6e3ef0ae9107de93019b5e12..8fc2f88b6526a6e9fb0847ea2fe22c18adc34722 100644 (file)
--- a/core/arrays/arrays.factor
+++ b/core/arrays/arrays.factor
@@ -5,6 +5,9 @@ IN: arrays
 
 BUILTIN: array { length array-capacity read-only initial: 0 } ;
 
+PRIMITIVE: <array> ( n elt -- array )
+PRIMITIVE: resize-array ( n array -- new-array )
+
 M: array clone (clone) ; inline
 M: array length length>> ; inline
 M: array nth-unsafe [ integer>fixnum ] dip array-nth ; inline

diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor
index d5d61c2980d185b037debe2004056a0db56afc44..36a54b9515b96e4413b1ee24b23aa090185b61fd 100644 (file)
--- a/core/byte-arrays/byte-arrays.factor
+++ b/core/byte-arrays/byte-arrays.factor
@@ -7,6 +7,10 @@ IN: byte-arrays
 BUILTIN: byte-array
 { length array-capacity read-only initial: 0 } ;
 
+PRIMITIVE: (byte-array) ( n -- byte-array )
+PRIMITIVE: <byte-array> ( n -- byte-array )
+PRIMITIVE: resize-byte-array ( n byte-array -- new-byte-array )
+
 M: byte-array clone (clone) ; inline
 M: byte-array clone-like
     over byte-array? [ drop clone ] [ call-next-method ] if ; inline

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 4c9102e4f9a4d601055593b49242e9c2968dab1e..d8ea8b02d4b261ce0350c62577b8527acf60fbe3 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -7,6 +7,11 @@ make math math.private memory namespaces quotations sequences
 sequences.private slots slots.private strings words ;
 IN: classes.tuple
 
+<PRIVATE
+PRIMITIVE: <tuple> ( layout -- tuple )
+PRIMITIVE: <tuple-boa> ( slots... layout -- tuple )
+PRIVATE>
+
 PREDICATE: tuple-class < class
     "metaclass" word-prop tuple-class eq? ;
 

diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index 0c0d05b52db59cbc1c94dd2bb52c36d566325384..b3430175fd4067f5f047c6cd96ceb48578b944a4 100644 (file)
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -8,6 +8,8 @@ FROM: namespaces => set ;
 FROM: sets => members ;
 IN: compiler.units
 
+PRIMITIVE: modify-code-heap ( alist update-existing? reset-pics? -- )
+
 SYMBOL: old-definitions
 SYMBOL: new-definitions
 

diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor
index 938e56bb36671c31623c40106a4050c92e94493a..a89444bb6d6bc45d61189be6350d22cd3b0654a5 100644 (file)
--- a/core/generic/single/single.factor
+++ b/core/generic/single/single.factor
@@ -7,6 +7,14 @@ sequences words ;
 FROM: assocs => change-at ;
 IN: generic.single
 
+<PRIVATE
+PRIMITIVE: inline-cache-miss ( generic methods index cache -- )
+PRIMITIVE: inline-cache-miss-tail ( generic methods index cache -- )
+PRIMITIVE: lookup-method ( object methods -- method )
+PRIMITIVE: mega-cache-lookup ( methods index cache -- )
+PRIMITIVE: mega-cache-miss ( methods index cache -- method )
+PRIVATE>
+
 ERROR: no-method object generic ;
 
 ERROR: inconsistent-next-method class generic ;

diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index aa77ebd15dcb528a2fed589daca9359d79a30bb8..96f9b92eaddfcb19d41d937e8869b0cf64a8132e 100644 (file)
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -5,6 +5,10 @@ io.encodings io.encodings.utf8 io.files.private io.pathnames
 kernel kernel.private namespaces sequences splitting system ;
 IN: io.files
 
+<PRIVATE
+PRIMITIVE: (exists?) ( path -- ? )
+PRIVATE>
+
 SYMBOL: +retry+ ! just try the operation again without blocking
 SYMBOL: +input+
 SYMBOL: +output+

diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor
index 59f009194e8a8c28c97aeb4cc700e8523125738e..455b1176a33f2ac966e790b46b97d8420b74dce0 100644 (file)
--- a/core/io/streams/c/c.factor
+++ b/core/io/streams/c/c.factor
@@ -5,6 +5,16 @@ destructors io io.backend io.encodings.utf8 io.files kernel
 kernel.private math sequences threads.private ;
 IN: io.streams.c
 
+PRIMITIVE: (fopen) ( path mode -- alien )
+PRIMITIVE: fclose ( alien -- )
+PRIMITIVE: fflush ( alien -- )
+PRIMITIVE: fgetc ( alien -- byte/f )
+PRIMITIVE: fputc ( byte alien -- )
+PRIMITIVE: fread-unsafe ( n buf alien -- count )
+PRIMITIVE: fseek ( alien offset whence -- )
+PRIMITIVE: ftell ( alien -- n )
+PRIMITIVE: fwrite ( data length alien -- )
+
 TUPLE: c-stream < disposable handle ;
 
 : new-c-stream ( handle class -- c-stream )

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index f7ac28dec7a029ebdfc1668edb828376702b0576..1f83aeb316eb05cbb6fd17ceaaaf77251e499041 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -7,6 +7,65 @@ BUILTIN: callstack ;
 BUILTIN: tuple ;
 BUILTIN: wrapper { wrapped read-only } ;
 
+PRIMITIVE: -rot ( x y z -- z x y )
+PRIMITIVE: dup ( x -- x x )
+PRIMITIVE: dupd ( x y -- x x y )
+PRIMITIVE: drop ( x -- )
+PRIMITIVE: nip ( x y -- y )
+PRIMITIVE: over ( x y -- x y x )
+PRIMITIVE: pick ( x y z -- x y z x )
+PRIMITIVE: rot ( x y z -- y z x )
+PRIMITIVE: swap ( x y -- y x )
+PRIMITIVE: swapd ( x y z -- y x z )
+PRIMITIVE: 2drop ( x y -- )
+PRIMITIVE: 2dup ( x y -- x y x y )
+PRIMITIVE: 2nip ( x y z -- z )
+PRIMITIVE: 3drop ( x y z -- )
+PRIMITIVE: 3dup ( x y z -- x y z x y z )
+PRIMITIVE: 4drop ( w x y z -- )
+PRIMITIVE: 4dup ( w x y z -- w x y z w x y z )
+
+PRIMITIVE: (clone) ( obj -- newobj )
+PRIMITIVE: eq? ( obj1 obj2 -- ? )
+PRIMITIVE: <wrapper> ( obj -- wrapper )
+PRIMITIVE: callstack ( -- callstack )
+PRIMITIVE: datastack ( -- array )
+PRIMITIVE: retainstack ( -- array )
+PRIMITIVE: die ( -- )
+PRIMITIVE: callstack>array ( callstack -- array )
+
+<PRIVATE
+PRIMITIVE: (call) ( quot -- )
+PRIMITIVE: (execute) ( word -- )
+PRIMITIVE: (identity-hashcode) ( obj -- code )
+PRIMITIVE: become ( old new -- )
+PRIMITIVE: c-to-factor ( -- )
+PRIMITIVE: callstack-bounds ( -- start end )
+PRIMITIVE: check-datastack ( array in# out# -- ? )
+PRIMITIVE: compute-identity-hashcode ( obj -- )
+PRIMITIVE: context-object ( n -- obj )
+PRIMITIVE: ffi-leaf-signal-handler ( -- )
+PRIMITIVE: ffi-signal-handler ( -- )
+PRIMITIVE: fpu-state ( -- )
+PRIMITIVE: innermost-frame-executing ( callstack -- obj )
+PRIMITIVE: innermost-frame-scan ( callstack -- n )
+PRIMITIVE: lazy-jit-compile ( -- )
+PRIMITIVE: leaf-signal-handler ( -- )
+PRIMITIVE: set-callstack ( callstack -- * )
+PRIMITIVE: set-context-object ( obj n -- )
+PRIMITIVE: set-datastack ( array -- )
+PRIMITIVE: set-fpu-state ( -- )
+PRIMITIVE: set-innermost-frame-quot ( n callstack -- )
+PRIMITIVE: set-retainstack ( array -- )
+PRIMITIVE: set-special-object ( obj n -- )
+PRIMITIVE: signal-handler ( -- )
+PRIMITIVE: special-object ( n -- obj )
+PRIMITIVE: strip-stack-traces ( -- )
+PRIMITIVE: tag ( object -- n )
+PRIMITIVE: unimplemented ( -- * )
+PRIMITIVE: unwind-native-frames ( -- )
+PRIVATE>
+
 DEFER: dip
 DEFER: 2dip
 DEFER: 3dip

diff --git a/core/math/math.factor b/core/math/math.factor
index d1c8b801f0bc82754968afee7aa0ae987990ebfc..600c1d7efcd64b37367b0a0b09139d3a113d0a97 100644 (file)
--- a/core/math/math.factor
+++ b/core/math/math.factor
@@ -7,6 +7,74 @@ BUILTIN: fixnum ;
 BUILTIN: bignum ;
 BUILTIN: float ;
 
+PRIMITIVE: bits>double ( n -- x )
+PRIMITIVE: bits>float ( n -- x )
+PRIMITIVE: double>bits ( x -- n )
+PRIMITIVE: float>bits ( x -- n )
+
+<PRIVATE
+PRIMITIVE: bignum* ( x y -- z )
+PRIMITIVE: bignum+ ( x y -- z )
+PRIMITIVE: bignum- ( x y -- z )
+PRIMITIVE: bignum-bit? ( x n -- ? )
+PRIMITIVE: bignum-bitand ( x y -- z )
+PRIMITIVE: bignum-bitnot ( x -- y )
+PRIMITIVE: bignum-bitor ( x y -- z )
+PRIMITIVE: bignum-bitxor ( x y -- z )
+PRIMITIVE: bignum-gcd ( x y -- z )
+PRIMITIVE: bignum-log2 ( x -- n )
+PRIMITIVE: bignum-mod ( x y -- z )
+PRIMITIVE: bignum-shift ( x y -- z )
+PRIMITIVE: bignum/i ( x y -- z )
+PRIMITIVE: bignum/mod ( x y -- z w )
+PRIMITIVE: bignum< ( x y -- ? )
+PRIMITIVE: bignum<= ( x y -- ? )
+PRIMITIVE: bignum= ( x y -- ? )
+PRIMITIVE: bignum> ( x y -- ? )
+PRIMITIVE: bignum>= ( x y -- ? )
+PRIMITIVE: bignum>fixnum ( x -- y )
+PRIMITIVE: bignum>fixnum-strict ( x -- y )
+PRIMITIVE: both-fixnums? ( x y -- ? )
+PRIMITIVE: fixnum* ( x y -- z )
+PRIMITIVE: fixnum*fast ( x y -- z )
+PRIMITIVE: fixnum+ ( x y -- z )
+PRIMITIVE: fixnum+fast ( x y -- z )
+PRIMITIVE: fixnum- ( x y -- z )
+PRIMITIVE: fixnum-bitand ( x y -- z )
+PRIMITIVE: fixnum-bitnot ( x -- y )
+PRIMITIVE: fixnum-bitor ( x y -- z )
+PRIMITIVE: fixnum-bitxor ( x y -- z )
+PRIMITIVE: fixnum-fast ( x y -- z )
+PRIMITIVE: fixnum-mod ( x y -- z )
+PRIMITIVE: fixnum-shift ( x y -- z )
+PRIMITIVE: fixnum-shift-fast ( x y -- z )
+PRIMITIVE: fixnum/i ( x y -- z )
+PRIMITIVE: fixnum/i-fast ( x y -- z )
+PRIMITIVE: fixnum/mod ( x y -- z w )
+PRIMITIVE: fixnum/mod-fast ( x y -- z w )
+PRIMITIVE: fixnum< ( x y -- ? )
+PRIMITIVE: fixnum<= ( x y -- z )
+PRIMITIVE: fixnum> ( x y -- ? )
+PRIMITIVE: fixnum>= ( x y -- ? )
+PRIMITIVE: fixnum>bignum ( x -- y )
+PRIMITIVE: fixnum>float ( x -- y )
+PRIMITIVE: float* ( x y -- z )
+PRIMITIVE: float+ ( x y -- z )
+PRIMITIVE: float- ( x y -- z )
+PRIMITIVE: float-u< ( x y -- ? )
+PRIMITIVE: float-u<= ( x y -- ? )
+PRIMITIVE: float-u> ( x y -- ? )
+PRIMITIVE: float-u>= ( x y -- ? )
+PRIMITIVE: float/f ( x y -- z )
+PRIMITIVE: float< ( x y -- ? )
+PRIMITIVE: float<= ( x y -- ? )
+PRIMITIVE: float= ( x y -- ? )
+PRIMITIVE: float> ( x y -- ? )
+PRIMITIVE: float>= ( x y -- ? )
+PRIMITIVE: float>bignum ( x -- y )
+PRIMITIVE: float>fixnum ( x -- y )
+PRIVATE>
+
 GENERIC: >fixnum ( x -- n ) foldable
 GENERIC: >bignum ( x -- n ) foldable
 GENERIC: >integer ( x -- n ) foldable

diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
index a8b13b9a4157e1c46ebdc0a983f8999398e18551..c10ac80cd5e5d148a231e22d250dbe6abd3925ae 100644 (file)
--- a/core/math/parser/parser.factor
+++ b/core/math/parser/parser.factor
@@ -5,6 +5,10 @@ layouts make math math.private namespaces sbufs sequences
 sequences.private splitting strings strings.private ;
 IN: math.parser
 
+<PRIVATE
+PRIMITIVE: (format-float) ( n format -- byte-array )
+PRIVATE>
+
 : digit> ( ch -- n )
     {
         { [ dup CHAR: 9 <= ] [ CHAR: 0 -      dup  0 < [ drop 255 ] when ] }

diff --git a/core/memory/memory.factor b/core/memory/memory.factor
index c9bef9a23f621e41a43dfb2cfcfb19018bd7c314..f9daf425e81dbac8fd603025179107192dd7fe72 100644 (file)
--- a/core/memory/memory.factor
+++ b/core/memory/memory.factor
@@ -4,6 +4,17 @@ USING: alien.strings io.backend kernel memory.private sequences
 system ;
 IN: memory
 
+PRIMITIVE: all-instances ( -- array )
+PRIMITIVE: compact-gc ( -- )
+PRIMITIVE: gc ( -- )
+PRIMITIVE: minor-gc ( -- )
+PRIMITIVE: size ( obj -- n )
+
+<PRIVATE
+PRIMITIVE: (save-image) ( path1 path2 -- )
+PRIMITIVE: (save-image-and-exit) ( path1 path2 -- )
+PRIVATE>
+
 : instances ( quot -- seq )
     [ all-instances ] dip filter ; inline
 

diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor
index d779f169442917712531377c130bba4d04e16785..1cf8f6ff6478a11fd3749acc2e41ac8f6398d292 100644 (file)
--- a/core/quotations/quotations.factor
+++ b/core/quotations/quotations.factor
@@ -9,7 +9,12 @@ BUILTIN: quotation
     cached-effect
     cache-counter ;
 
+PRIMITIVE: jit-compile ( quot -- )
+PRIMITIVE: quot-compiled? ( quot -- ? )
+PRIMITIVE: quotation-code ( quot -- start end )
+
 <PRIVATE
+PRIMITIVE: array>quotation ( array -- quot )
 
 : uncurry ( curry -- obj quot )
     { curry } declare dup 2 slot swap 3 slot ; inline

diff --git a/core/slots/slots.factor b/core/slots/slots.factor
index aed7499673d8892a85bbff7d1c79a71da12ea985..d31dd93837888f876ae18400f2202d4f98abb660 100644 (file)
--- a/core/slots/slots.factor
+++ b/core/slots/slots.factor
@@ -7,6 +7,11 @@ kernel.private make math quotations sequences sequences.private
 slots.private strings words ;
 IN: slots
 
+<PRIVATE
+PRIMITIVE: set-slot ( value obj n -- )
+PRIMITIVE: slot ( obj m -- value )
+PRIVATE>
+
 TUPLE: slot-spec name offset class initial read-only ;
 
 PREDICATE: reader < word "reader" word-prop ;

diff --git a/core/strings/strings.factor b/core/strings/strings.factor
index 8761335c6fa82c575c003332491483042aa744b9..4bbf642ca0d3312f2fd3508527200a591ed98bc1 100644 (file)
--- a/core/strings/strings.factor
+++ b/core/strings/strings.factor
@@ -7,7 +7,12 @@ IN: strings
 
 BUILTIN: string { length array-capacity read-only initial: 0 } aux ;
 
+PRIMITIVE: <string> ( n ch -- string )
+PRIMITIVE: resize-string ( n str -- newstr )
+
 <PRIVATE
+PRIMITIVE: set-string-nth-fast ( ch n string -- )
+PRIMITIVE: string-nth-fast ( n string -- ch )
 
 : string-hashcode ( str -- n ) 3 slot ; inline
 

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index 2d805a2c4f092f329301868f7c87a552d15121c1..132e09988d54753b8dd95b71624666dab366b30c 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -31,7 +31,8 @@ IN: bootstrap.syntax
     { "]" "}" ";" ">>" } [ define-delimiter ] each
 
     "PRIMITIVE:" [
-        "Primitive definition is not supported" throw
+        current-vocab name>>
+        scan-word scan-effect ensure-primitive
     ] define-core-syntax
 
     "CS{" [

diff --git a/core/system/system.factor b/core/system/system.factor
index f3f847efc8591a248ea006f1c1e3058b99e492fe..3b26353332b6ff46f9be6a82ec4a2c3abceb350e 100644 (file)
--- a/core/system/system.factor
+++ b/core/system/system.factor
@@ -4,6 +4,9 @@ USING: assocs continuations init io kernel kernel.private make
 math.parser namespaces sequences ;
 IN: system
 
+PRIMITIVE: (exit) ( n -- * )
+PRIMITIVE: nano-count ( -- ns )
+
 SINGLETONS: x86.32 x86.64 arm ppc.32 ppc.64 ;
 
 UNION: x86 x86.32 x86.64 ;

diff --git a/core/words/words.factor b/core/words/words.factor
index b71e670e51da7cab6a14123aa9b46051cb8c4e5e..8c7946e2bb53611de0e6a05d4a9f1c92483fab80 100644 (file)
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -11,6 +11,13 @@ BUILTIN: word
 { def quotation initial: [ ] } props pic-def pic-tail-def
 { sub-primitive read-only } ;
 
+PRIMITIVE: optimized? ( word -- ? )
+PRIMITIVE: word-code ( word -- start end )
+
+<PRIVATE
+PRIMITIVE: (word) ( name vocab hashcode -- word )
+PRIVATE>
+
 ! Need a dummy word here because BUILTIN: word is not a real word
 ! and parse-datum looks for things that are actually words instead of
 ! also looking for classes
@@ -68,6 +75,14 @@ PREDICATE: primitive < word "primitive" word-prop ;
 M: primitive definer drop \ PRIMITIVE: f ;
 M: primitive definition drop f ;
 
+ERROR: invalid-primitive vocabulary word effect ;
+: ensure-primitive ( vocabulary word effect -- )
+    3dup
+    [ drop vocabulary>> = ]
+    [ drop nip primitive? ]
+    [ [ nip "declared-effect" word-prop ] dip = ] 3tri and and
+    [ 3drop ] [ invalid-primitive ] if ;
+
 : lookup-word ( name vocab -- word ) vocab-words-assoc at ;
 
 : target-word ( word -- target )