Use DEFINE-PRIMITIVES.

diff --git a/src/runtime/boole.scm b/src/runtime/boole.scm
index bdfb25a09ac94f8bc307d8cc135db5ff6d1f3d96..0eb87ee9ffb99cba5b1f1f90943712e50f71b7bd 100644 (file)
--- a/src/runtime/boole.scm
+++ b/src/runtime/boole.scm
@@ -28,8 +28,7 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define-integrable (not object)
-  ((ucode-primitive not) object))
+(define-integrable not (ucode-primitive not))
 
 (define false #f)
 (define true #t)

diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index 804c53f5b8e60464b9720d2af1aa728e1b84e94f..9bef80844b1dc347dabcac49de73f1fcec434a17 100644 (file)
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -28,14 +28,10 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define-integrable (char? object)
-  ((ucode-primitive char?) object))
-
-(define-integrable (char->integer char)
-  ((ucode-primitive char->integer) char))
-
-(define-integrable (integer->char int)
-  ((ucode-primitive integer->char) int))
+(define-primitives
+  (char? 1)
+  (char->integer 1)
+  (integer->char 1))
 
 (define-integrable char-code-limit #x110000)
 (define-integrable char-bits-limit #x10)

diff --git a/src/runtime/gentag.scm b/src/runtime/gentag.scm
index 7134f9578f984c8e85b394171139f13f8a9b13f1..f734ebfbcc345a8c00225a5dfde5aa437fca5c43 100644 (file)
--- a/src/runtime/gentag.scm
+++ b/src/runtime/gentag.scm
@@ -54,11 +54,9 @@ USA.
 (define-integrable dispatch-tag-index-start 2)
 (define-integrable dispatch-tag-index-end 10)
 
-(define-integrable (dispatch-tag-ref t i)
-  (%record-ref t i))
+(define-integrable dispatch-tag-ref (ucode-primitive %record-ref))
 
-(define-integrable (dispatch-tag-set! t i x)
-  (%record-set! t i x))
+(define-integrable dispatch-tag-set! (ucode-primitive %record-set!))
 
 (define (dispatch-tag-contents tag)
   (guarantee-dispatch-tag tag 'DISPATCH-TAG-CONTENTS)

diff --git a/src/runtime/list.scm b/src/runtime/list.scm
index a3cb276a2b6656ea22ffb840715bec0ba290f057..197bf146b4a7f8206626cd554ad890316cbcbf68 100644 (file)
--- a/src/runtime/list.scm
+++ b/src/runtime/list.scm
@@ -65,29 +65,15 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define-integrable (cons a b)
-  ((ucode-primitive cons) a b))
-
-(define-integrable (pair? object)
-  ((ucode-primitive pair?) object))
-
-(define-integrable (null? object)
-  ((ucode-primitive null?) object))
-
-(define-integrable (car p)
-  ((ucode-primitive car) p))
-
-(define-integrable (cdr p)
-  ((ucode-primitive cdr) p))
-
-(define-integrable (set-car! p v)
-  ((ucode-primitive set-car!) p v))
-
-(define-integrable (set-cdr! p v)
-  ((ucode-primitive set-cdr!) p v))
-
-(define-integrable (general-car-cdr p i)
-  ((ucode-primitive general-car-cdr) p i))
+(define-primitives
+  (car 1)
+  (cdr 1)
+  (cons 2)
+  (general-car-cdr 2)
+  (null? 1)
+  (pair? 1)
+  (set-car! 2)
+  (set-cdr! 2))
 
 (define (list . items)
   items)

diff --git a/src/runtime/record.scm b/src/runtime/record.scm
index 98217fb3e6ced1482847e8915ff05f89948e275b..fc9ec2f4273f80e6364d213da25eff0d525dcd91 100644 (file)
--- a/src/runtime/record.scm
+++ b/src/runtime/record.scm
@@ -33,24 +33,14 @@ USA.
 
 (define-primitives
   (%record -1)
+  (%record? 1)
+  (%record-length 1)
+  (%record-ref 2)
+  (%record-set! 3)
   (primitive-object-ref 2)
   (primitive-object-set! 3)
-  (primitive-object-set-type 2))
-
-(define-integrable (%record? object)
-  ((ucode-primitive %record?) object))
-
-(define-integrable (%record-length record)
-  ((ucode-primitive %record-length) record))
-
-(define-integrable (%record-ref record index)
-  ((ucode-primitive %record-ref) record index))
-
-(define-integrable (%record-set! record index value)
-  ((ucode-primitive %record-set!) record index value))
-
-(define-integrable (vector-cons length object)
-  ((ucode-primitive vector-cons) length object))
+  (primitive-object-set-type 2)
+  (vector-cons 2))
 
 (define-integrable (%make-record length object)
   ((ucode-primitive object-set-type) (ucode-type record)

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 9114ac238ca612e5ed20b7c93d1276343c329743..44906abad6b38582920bb8ab28bb632f67104a05 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -41,65 +41,31 @@ USA.
 \f
 ;;;; Primitives
 
-(define-integrable (string-allocate n)
-  ((ucode-primitive string-allocate) n))
-
-(define-integrable (string? object)
-  ((ucode-primitive string?) object))
-
-(define-integrable (string-length string)
-  ((ucode-primitive string-length) string))
-
-(define-integrable (string-maximum-length string)
-  ((ucode-primitive string-maximum-length) string))
-
-(define-integrable (set-string-length! string length)
-  ((ucode-primitive set-string-length!) string length))
-
-(define-integrable (set-string-maximum-length! string length)
-  ((ucode-primitive set-string-maximum-length!) string length))
-
-(define-integrable (string-ref string index)
-  ((ucode-primitive string-ref) string index))
-
-(define-integrable (string-set! string index char)
-  ((ucode-primitive string-set!) string index char))
-
-(define-integrable (substring-move-left! string1 start1 end1 string2 start2)
-  ((ucode-primitive substring-move-left!) string1 start1 end1 string2 start2))
-
-(define-integrable (substring-move-right! string1 start1 end1 string2 start2)
-  ((ucode-primitive substring-move-right!) string1 start1 end1 string2 start2))
-
-(define-integrable (vector-8b-ref vector-8b index)
-  ((ucode-primitive vector-8b-ref) vector-8b index))
-
-(define-integrable (vector-8b-set! vector-8b index byte)
-  ((ucode-primitive vector-8b-set!) vector-8b index byte))
-
-(define-integrable (vector-8b-fill! string start end ascii)
-  (substring-fill! string start end (ascii->char ascii)))
-
-(define-integrable (vector-8b-find-next-char string start end ascii)
-  (substring-find-next-char string start end (ascii->char ascii)))
-
-(define-integrable (vector-8b-find-previous-char string start end ascii)
-  (substring-find-previous-char string start end (ascii->char ascii)))
-
-(define-integrable (vector-8b-find-next-char-ci string start end ascii)
-  (substring-find-next-char-ci string start end (ascii->char ascii)))
-
-(define-integrable (vector-8b-find-previous-char-ci string start end ascii)
-  (substring-find-previous-char-ci string start end (ascii->char ascii)))
+(define-primitives
+  (set-string-length! 2)
+  (set-string-maximum-length! 2)
+  (string-allocate 1)
+  (string-hash-mod 2)
+  (string-length 1)
+  (string-maximum-length 1)
+  (string-ref 2)
+  (string-set! 3)
+  (string? 1)
+  substring-move-left!
+  substring-move-right!
+  vector-8b-fill!
+  vector-8b-find-next-char
+  vector-8b-find-next-char-ci
+  vector-8b-find-previous-char
+  vector-8b-find-previous-char-ci
+  (vector-8b-ref 2)
+  (vector-8b-set! 3))
 
 (define (string-hash key #!optional modulus)
   (if (default-object? modulus)
       ((ucode-primitive string-hash) key)
       ((ucode-primitive string-hash-mod) key modulus)))
 
-(define (string-hash-mod key modulus)
-  ((ucode-primitive string-hash-mod) key modulus))
-
 (define (string-ci-hash key #!optional modulus)
   (string-hash (string-downcase key) modulus))
 

diff --git a/src/runtime/vector.scm b/src/runtime/vector.scm
index 0f3f66b4652f2f9b7c4217a0a42cb4e30a2f4249..29de2058b27fe677d8d4dae3c8686611dac4c05d 100644 (file)
--- a/src/runtime/vector.scm
+++ b/src/runtime/vector.scm
@@ -28,35 +28,17 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define-integrable vector
-  (ucode-primitive vector))
-
-(define-integrable (vector? object)
-  ((ucode-primitive vector?) object))
-
-(define-integrable (vector-length v)
-  ((ucode-primitive vector-length) v))
-
-(define-integrable (vector-ref v i)
-  ((ucode-primitive vector-ref) v i))
-
-(define-integrable (vector-set! v i x)
-  ((ucode-primitive vector-set!) v i x))
-
-(define-integrable (list->vector list)
-  ((ucode-primitive list->vector) list))
-
-(define-integrable (subvector->list v s e)
-  ((ucode-primitive subvector->list) v s e))
-
-(define-integrable (subvector-fill! v s e x)
-  ((ucode-primitive subvector-fill!) v s e x))
-
-(define-integrable (subvector-move-left! v1 s1 e1 v2 s2)
-  ((ucode-primitive subvector-move-left!) v1 s1 e1 v2 s2))
-
-(define-integrable (subvector-move-right! v1 s1 e1 v2 s2)
-  ((ucode-primitive subvector-move-right!) v1 s1 e1 v2 s2))
+(define-primitives
+  (list->vector 1)
+  (subvector->list 3)
+  (subvector-fill! 4)
+  (subvector-move-left! 5)
+  (subvector-move-right! 5)
+  (vector -1)
+  (vector-length 1)
+  (vector-ref 2)
+  (vector-set! 3)
+  (vector? 1))
 
 (define-integrable (guarantee-vector object procedure)
   (if (not (vector? object))