[Wisp-cvs] wisp/src/native vectors.s,1.1,1.2 vectors.wth,1.1,1.2

[<di...@us...>]

Update of /cvsroot/wisp/wisp/src/native
In directory usw-pr-cvs1:/tmp/cvs-serv1563/src/native

Modified Files:
	vectors.s vectors.wth 
Log Message:
Implemented |<u8vector>|.

Index: vectors.s
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/vectors.s,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- vectors.s	18 Sep 2002 21:12:38 -0000	1.1
+++ vectors.s	18 Sep 2002 21:15:23 -0000	1.2
@@ -1,5 +1,134 @@
 .section .text
 .align 16
+N_make_u8vector:
+.byte 144,81,131,249,1,15,133,5,0,0,0,88,64,106,7,80,88,80,61,2,0,0,0,15
+.byte 132,8,0,0,0,88,137,193,233
+.long N_signal_argcount - (.+4)
+.byte 88,88,80,104,0,1,0,0,104
+.long N_make_u8vector.L2
+.byte 80,233
+.long decui$1 - (.+4)
+.byte 91,80,57,216,15,140,13,0,0,0,88,88,104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,91,80,83,104
+.long N_make_u8vector.L4
+.byte 83,233
+.long decui$1 - (.+4)
+.byte 80,61,0,0,0,192,15,130,13,0,0,0,88,88,104
+.long WB_out_of_memory
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,137,195,131,195,8,80,104
+.long N_make_u8vector.L6
+.byte 83,233
+.long salloc$1 - (.+4)
+.byte 199,0
+.long RT_u8vector
+.byte 91,137,193,131,193,4,137,25,91,137,193,131,193,8,137,199,131,199,4
+.byte 139,63,80,137,216,137,203,137,249,137,223,252,243,170,88,195
+.global N_make_u8vector,NN_make_u8vector,N_make_u8vector.L2,N_make_u8vector.L4,N_make_u8vector.L6
+.equiv NN_make_u8vector, N_make_u8vector + 1
+.equiv N_make_u8vector.L2, N_make_u8vector + 56
+.equiv N_make_u8vector.L4, N_make_u8vector + 95
+.equiv N_make_u8vector.L6, N_make_u8vector + 139
+.section .text
+.align 16
+N_u8vector_length:
+.byte 144,81,131,249,1,15,132,8,0,0,0,88,137,193,233
+.long N_signal_argcount - (.+4)
+.byte 88,88,137,195,131,227,3,80,80,133,219,15,132,8,0,0,0,88,106,19,233
+.byte 22,0,0,0,88,80,133,192,15,133,8,0,0,0,88,106,19,233,4,0,0,0,88,139
+.byte 0,80,88,61
+.long RT_u8vector
+.byte 15,132,12,0,0,0,88,104
+.long WB_u8vector_huh
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,5,4,0,0,0,139,0,80,233
+.long encui$1 - (.+4)
+.global N_u8vector_length,NN_u8vector_length
+.equiv NN_u8vector_length, N_u8vector_length + 1
+.section .text
+.align 16
+N_u8vector_ref:
+.byte 144,81,131,249,2,15,133,160,0,0,0,88,88,80,104
+.long N_u8vector_ref.L1
+.byte 80,233
+.long decsi$1 - (.+4)
+.byte 91,89,137,207,131,231,3,83,80,81,81,133,255,15,132,8,0,0,0,88,106
+.byte 19,233,22,0,0,0,88,80,133,192,15,133,8,0,0,0,88,106,19,233,4,0,0,0
+.byte 88,139,0,80,88,61
+.long RT_u8vector
+.byte 15,132,12,0,0,0,88,104
+.long WB_u8vector_huh
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,137,195,131,195,8,5,4,0,0,0,139,0,89,83,80,81,133,201,15,141,6
+.byte 0,0,0,88,91,1,216,83,80,88,91,83,80,57,216,15,130,15,0,0,0,88,88
+.byte 88,88,104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,91,89,1,195,15,182,27,83,233
+.long encui$1 - (.+4)
+.byte 88,80,61,253,255,255,255,15,132,8,0,0,0,88,137,193,233
+.long N_signal_argcount - (.+4)
+.byte 88,88,80,104,0,1,0,0,104
+.long N_u8vector_ref.L11
+.byte 80,233
+.long decui$1 - (.+4)
+.byte 91,80,57,216,15,140,13,0,0,0,88,88,104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,91,89,80,81,83,104
+.long N_u8vector_ref.L13
+.byte 83,233
+.long decsi$1 - (.+4)
+.byte 91,89,137,207,131,231,3,83,80,81,81,133,255,15,132,8,0,0,0,88,106
+.byte 19,233,22,0,0,0,88,80,133,192,15,133,8,0,0,0,88,106,19,233,4,0,0,0
+.byte 88,139,0,80,88,61
+.long RT_u8vector
+.byte 15,132,12,0,0,0,88,104
+.long WB_u8vector_huh
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,137,195,131,195,8,5,4,0,0,0,139,0,89,83,80,81,133,201,15,141,6
+.byte 0,0,0,88,91,1,216,83,80,88,91,83,80,57,216,15,130,15,0,0,0,88,88
+.byte 88,88,104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,91,89,1,195,88,136,3,106,27,88,195
+.global N_u8vector_ref,NN_u8vector_ref,N_u8vector_ref.L1,N_u8vector_ref.L11,N_u8vector_ref.L13
+.equiv NN_u8vector_ref, N_u8vector_ref + 1
+.equiv N_u8vector_ref.L1, N_u8vector_ref + 25
+.equiv N_u8vector_ref.L11, N_u8vector_ref + 211
+.equiv N_u8vector_ref.L13, N_u8vector_ref + 252
+.section .text
+.align 16
+N_u8vector_huh:
+.byte 144,186
+.long RT_u8vector
+.byte 233
+.long discriminator_body - (.+4)
+.global N_u8vector_huh,NN_u8vector_huh
+.equiv NN_u8vector_huh, N_u8vector_huh + 1
+.section .text
+.align 16
+RT_u8vector:
+.long RT_record_type
+.byte 1,0,0,0
+.long NN_u8vector_huh
+.long NN_u8vector_ref
+.long NN_u8vector_length
+.long NN_make_u8vector
+.byte 19,0,0,0,19,0,0,0
+.global RT_u8vector
+.section .text
+.align 16
 N_vector_move:
 .byte 144,81,131,249,5,15,132,8,0,0,0,88,137,193,233
 .long N_signal_argcount - (.+4)

Index: vectors.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/vectors.wth,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- vectors.wth	18 Sep 2002 21:12:38 -0000	1.1
+++ vectors.wth	18 Sep 2002 21:15:23 -0000	1.2
@@ -1,4 +1,4 @@
-;;;; vectors.wth - generic vectors
+;;;; vectors.wth - vectors
 ;;
 ;; Copyleft © 2002 by Andres Soolo (di...@us...)
 ;; This file is licensed under the GNU GPL v2.  If you
@@ -10,19 +10,26 @@
 
 (extern WB_out_of_memory)
 (extern WB_range)
+(extern WB_u8vector_huh)
 (extern WB_vector_huh)
 (extern decsi$1)
 (extern decui$1)
 (extern encsi$1)
 (extern encui$1)
+(extern salloc$1)
 (extern valloc$1)
 
 (macro decsi <: swap (flush) 'decsi$1 jump :>)
 (macro decui <: swap (flush) 'decui$1 jump :>)
 (macro encsi <: swap (flush) 'encsi$1 jump :>)
 (macro encui <: swap (flush) 'encui$1 jump :>)
+(macro salloc <: swap (flush) 'salloc$1 jump :>)
 (macro valloc <: swap (flush) 'valloc$1 jump :>)
 
+(macro rdecui ; (node limit)
+  over decui swap over swap
+  >= if drop 'WB_range swap go-raise then nip)
+
 (extern RT_vector)
 (assemble RT_vector
   (tetra RT_record_type)
@@ -94,5 +101,59 @@
 
   -rot cells swap vector-data + 2swap cells swap vector-data +
   rot tetramove VOID)
+
+(extern RT_u8vector)
+(assemble RT_u8vector
+  (tetra RT_record_type)
+  (tetra 1)
+  (tetra NN_u8vector_huh)
+  (tetra NN_u8vector_ref)
+  (tetra NN_u8vector_length)
+  (tetra NN_make_u8vector)
+  (tetra 19)  ; FALSE
+  (tetra 19)) ; FALSE
+
+(native u8vector_huh 'RT_u8vector go-discriminate)
+
+(native u8vector_ref
+  dup 2 = if
+    drop dup decsi rot ; (nindex index vec)
+    require-u8vector dup vector-data swap vector-length
+    rot ; (nindex vecdata veclen index)
+    dup 0 < if over + then
+    2dup swap u>= if ; catches negative indices too
+      drop drop drop 'WB_range swap go-raise
+    then
+    nip rot drop + byte@ (flush) 'encui$1 jump
+  else
+    dup -3 = argc drop ; (vec nindex obj)
+    256 rdecui
+    -rot dup decsi rot ; (obj nindex index vec)
+    require-u8vector dup vector-data swap vector-length
+    rot ; (obj nindex vecdata veclen index)
+    dup 0 < if over + then
+    2dup swap u>= if ; catches negative indices too
+      drop drop drop 'WB_range swap go-raise
+    then
+    nip rot drop + byte! VOID
+  then)
+
+(native u8vector_length dup 1 = argc drop
+  require-u8vector u8vector-length (flush) 'encui$1 jump)
+
+; Note that the only pointer in an u8vector is the type indicator.
+; However, the type resides in static, non-gc:ible memory, so
+; we can safely allocate u8vectors nonscannably.
+(native make_u8vector dup 1 = if ZERO swap 1+ then dup 2 = argc drop
+  ; (nlength object)
+  256 rdecui
+  swap dup decui ; (object nlength length)
+  dup #xC0000000 u>= if
+    drop 'WB_out_of_memory swap go-raise
+  then nip dup 2 cells + salloc ; (object length body node)
+  'RT_u8vector over cell! ; store type
+  tuck 1 cells + cell! ; store length
+  tuck swap ; (node node object)
+  swap dup u8vector-data swap u8vector-length rot bytefill)
 
 ; vim: ft=worth