[Wisp-cvs] wisp/src/native misc.s,1.5,1.6 misc.wth,1.5,1.6 vectors.nasm,1.12,1.13

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

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

Modified Files:
	misc.s misc.wth vectors.nasm 
Log Message:
Converted |vector-fill!|, |vector-length|, |vector-ref|, and |vector?| from Nasm to Worth.

Index: misc.s
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/misc.s,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- misc.s	18 Sep 2002 21:05:44 -0000	1.5
+++ misc.s	18 Sep 2002 21:08:14 -0000	1.6
@@ -1,5 +1,80 @@
 .section .text
 .align 16
+N_vector_fill:
+.byte 144,81,131,249,2,15,132,8,0,0,0,88,137,193,233
+.long N_signal_argcount - (.+4)
+.byte 88,88,91,137,217,131,193,8,139,9,131,195,4,139,27,137,207,137,217
+.byte 252,243,171,184,27,0,0,0,195
+.global N_vector_fill,NN_vector_fill
+.equiv NN_vector_fill, N_vector_fill + 1
+.section .text
+.align 16
+N_vector_ref:
+.byte 144,81,131,249,2,15,133,187,0,0,0,88,88,80,104
+.long N_vector_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,8,0,0,0,15,132,12,0,0,0,88,104
+.long WB_vector_huh
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,137,195,131,195,8,139,27,5,4,0,0,0,139,0,89,83,80,81,133,201,15
+.byte 141,29,0,0,0,88,91,1,216,83,80,133,192,15,141,15,0,0,0,88,88,88,88
+.byte 104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,83,80,57,216,15,140,15,0,0,0,88,88,88,88,104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,91,89,193,224,2,1,195,139,27,83,233,209,0,0,0,88,80,61,253
+.byte 255,255,255,15,132,8,0,0,0,88,137,193,233
+.long N_signal_argcount - (.+4)
+.byte 88,88,91,89,80,81,83,104
+.long N_vector_ref.L12
+.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,8,0,0,0,15,132,12,0,0,0,88,104
+.long WB_vector_huh
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,137,195,131,195,8,139,27,5,4,0,0,0,139,0,89,83,80,81,133,201,15
+.byte 141,29,0,0,0,88,91,1,216,83,80,133,192,15,141,15,0,0,0,88,88,88,88
+.byte 104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,83,80,57,216,15,140,15,0,0,0,88,88,88,88,104
+.long WB_range
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,91,89,193,224,2,1,195,88,137,3,106,27,88,195
+.global N_vector_ref,NN_vector_ref,N_vector_ref.L1,N_vector_ref.L12
+.equiv NN_vector_ref, N_vector_ref + 1
+.equiv N_vector_ref.L1, N_vector_ref + 25
+.equiv N_vector_ref.L12, N_vector_ref + 237
+.section .text
+.align 16
+N_vector_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,8,0,0,0,15,132,12,0,0,0,88,104
+.long WB_vector_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_vector_length,NN_vector_length
+.equiv NN_vector_length, N_vector_length + 1
+.section .text
+.align 16
 N_record_type_length:
 .byte 144,81,131,249,1,15,132,8,0,0,0,88,137,193,233
 .long N_signal_argcount - (.+4)
@@ -34,6 +109,13 @@
 .long slot_accessor_body - (.+4)
 .global N_pr_record_type_ref_slot,NN_pr_record_type_ref_slot
 .equiv NN_pr_record_type_ref_slot, N_pr_record_type_ref_slot + 1
+.section .text
+.align 16
+N_vector_huh:
+.byte 144,186,8,0,0,0,233
+.long discriminator_body - (.+4)
+.global N_vector_huh,NN_vector_huh
+.equiv NN_vector_huh, N_vector_huh + 1
 .section .text
 .align 16
 N_record_type_huh:

Index: misc.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/misc.wth,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- misc.wth	18 Sep 2002 21:05:44 -0000	1.5
+++ misc.wth	18 Sep 2002 21:08:14 -0000	1.6
@@ -11,12 +11,16 @@
 (extern RT_record_type)
 (extern WB_range)
 (extern WB_record_type_huh)
-(extern encui$1)
+(extern WB_vector_huh)
+(extern decsi$1)
 (extern decui$1)
+(extern encsi$1)
+(extern encui$1)
 (extern rvec)
 
 (macro RVEC_LEN 30)
 
+(macro decsi <: swap (flush) 'decsi$1 jump :>)
 (macro decui <: swap (flush) 'decui$1 jump :>)
 (macro rdecui ; ( node limit )
   over decui swap over swap
@@ -35,6 +39,9 @@
 (native record_type_huh
   'RT_record_type go-discriminate)
 
+(native vector_huh
+  NC_VECTOR go-discriminate)
+
 ; FOR INTERNAL USE BY |make-record-type| ONLY!
 ; It is an important guarantee that it's safe to share
 ; record-type:s without need to fear undue influence.
@@ -51,5 +58,43 @@
   else
     'WB_record_type_huh swap go-raise
   then)
+
+(native vector_length dup 1 = argc drop
+  require-vector vector-length (flush) 'encui$1 jump)
+
+(native vector_ref
+  dup 2 = if
+    drop dup decsi rot ; (nindex index vec)
+    require-vector dup vector-data swap vector-length
+    rot ; (nindex vecdata veclen index)
+    dup 0 < if
+      over +
+      dup 0 < if
+        drop drop drop 'WB_range swap go-raise
+      then
+    then
+    2dup swap >= if
+      drop drop drop 'WB_range swap go-raise
+    then
+    nip rot drop cells + cell@
+  else
+    dup -3 = argc drop ; (vec nindex obj)
+    -rot dup decsi rot ; (obj nindex index vec)
+    require-vector dup vector-data swap vector-length
+    rot ; (obj nindex vecdata veclen index)
+    dup 0 < if
+      over +
+      dup 0 < if
+        drop drop drop 'WB_range swap go-raise
+      then
+    then
+    2dup swap >= if
+      drop drop drop 'WB_range swap go-raise
+    then
+    nip rot drop cells + cell! VOID
+  then)
+
+(native vector_fill dup 2 = argc drop
+  swap dup vector-data swap vector-length rot tetrafill VOID)
 
 ; vim: ft=worth

Index: vectors.nasm
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/vectors.nasm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- vectors.nasm	26 Aug 2002 16:18:24 -0000	1.12
+++ vectors.nasm	18 Sep 2002 21:08:14 -0000	1.13
@@ -11,89 +11,6 @@
 %define vector#length(x) dword [(x) + 4]
 %define vector#body(x)   dword [(x) + 8]
 
-; {{{ |vector?|
-native vector_huh, any
-    mov edx, NC_VECTOR
-    jmp discriminator_body
-; }}}
-
-; {{{ |vector-ref|
-global N_vector_ref
-native vector_ref, any
-    cmp ecx, -3
-    jz vector_ref$s3
-    cmp ecx, 2
-    jnz near N_signal_argcount
-global vector_ref$2
-vector_ref$2:
-    pop edx ; index
-    pop eax ; vector
-    req_vector
-    push edx ; for later reference on signalling
-    push eax
-    decsi edx
-    pop edx ; vector
-    mov ecx, vector#length(edx)
-    test eax, eax ; sign?
-    if nge
-        add eax, ecx ; wrap around the end
-        jnc signal_range_1
-    endif
-    cmp eax, ecx
-    jnc signal_range_1
-    shl eax, 2 ; multiply by cell size
-    add eax, vector#body(edx)
-    mov eax, [eax]
-    drop
-    ret
-global vector_ref$s3
-vector_ref$s3:
-    dig eax, 1 ; index
-    decsi eax
-    pop ebx ; new object
-    dig edx, 1 ; vector
-    req_vector edx
-    mov ecx, vector#length(edx)
-    test eax, eax ; sign?
-    if nge
-        add eax, ecx ; wrap around the end
-        jnc signal_range_1
-    endif
-    cmp eax, ecx
-    jnc signal_range_1
-    shl eax, 2 ; multiply by cell size
-    add eax, vector#body(edx)
-    mov [eax], ebx
-    drop 2
-    retvoid
-
-signal_range_1:
-    push dword WB_range
-    pick 1
-    jmp raise$2
-; }}}
-
-; {{{ |vector-length|
-native vector_length, 1
-    pop eax
-    req_vector eax
-    mov eax, vector#length(eax)
-    encui eax
-    ret
-; }}}
-
-; {{{ |vector-fill|
-native vector_fill, 2
-    pop eax
-    pop edx
-    req_vector edx
-    mov ecx, vector#length(edx)
-    mov edi, vector#body(edx)
-    rep stosd
-    mov eax, VOID
-    ret
-; }}}
-
 ; {{{ |make-vector|
 native make_vector, any
     cmp ecx, byte 2
@@ -116,7 +33,7 @@
     pop vector#length(eax)
     pop edx
     mov [esp], eax
-    gcall vector_fill$2, eax, edx
+    gcall N_vector_fill, eax, edx
     pop eax
     ret
 ; }}}
@@ -181,6 +98,7 @@
     ret
 ; }}}
 
+extern N_vector_fill
 extern WB_range
 extern _signal_range_encui_eax
 extern _signal_range_encui_ecx