[Wisp-cvs] wisp/src/native boxes.s,1.9,1.10 boxes.wth,1.5,1.6 misc.s,1.6,1.7 misc.wth,1.6,1.7 records.nasm,1.33,1.34 wstrings.s,1.4,1.5 wstrings.wth,1.4,1.5

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

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

Modified Files:
	boxes.s boxes.wth misc.s misc.wth records.nasm wstrings.s 
	wstrings.wth 
Log Message:
Defined |new| dispatchers for |<c16string>|, |<box>|, and |<collector>|.

Index: boxes.s
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/boxes.s,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- boxes.s	18 Sep 2002 21:05:08 -0000	1.9
+++ boxes.s	18 Sep 2002 21:09:00 -0000	1.10
@@ -68,4 +68,5 @@
 .long NN_box_huh
 .long NN_box_ref
 .byte 19,0,0,0
+.long NN_make_box
 .global RT_box

Index: boxes.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/boxes.wth,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- boxes.wth	18 Sep 2002 21:05:08 -0000	1.5
+++ boxes.wth	18 Sep 2002 21:09:00 -0000	1.6
@@ -13,7 +13,8 @@
   (tetra 1)
   (tetra NN_box_huh)
   (tetra NN_box_ref)
-  (tetra 19)) ; FALSE
+  (tetra 19)  ; FALSE
+  (tetra NN_make_box))
 
 (extern RT_box)
 (extern WB_undefined)

Index: misc.s
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/misc.s,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- misc.s	18 Sep 2002 21:08:14 -0000	1.6
+++ misc.s	18 Sep 2002 21:09:00 -0000	1.7
@@ -1,5 +1,35 @@
 .section .text
 .align 16
+N_new:
+.byte 144,81,133,201,15,143,8,0,0,0,88,137,193,233
+.long N_signal_argcount - (.+4)
+.byte 88,137,227,137,193,193,225,2,1,203,131,235,4,137,217,139,9,137,207
+.byte 131,231,3,80,83,81,81,81,133,255,15,132,8,0,0,0,88,106,19,233,22,0
+.byte 0,0,88,80,133,192,15,133,8,0,0,0,88,106,19,233,4,0,0,0,88,139,0,80
+.byte 88,61
+.long RT_record_type
+.byte 15,132,12,0,0,0,88,104
+.long WB_record_type_huh
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,5,20,0,0,0,139,0,80,61,19,0,0,0,15,133,13,0,0,0,88,88,104
+.long WB_creatable_huh
+.byte 80,233
+.long raise$2 - (.+4)
+.byte 88,91,91,199,3
+.long immediate_return
+.byte 91,75,137,217,233
+.long funcall - (.+4)
+.byte 81,195
+.global N_new,NN_new
+.equiv NN_new, N_new + 1
+.section .text
+.align 16
+immediate_return:
+.byte 195
+.global immediate_return
+.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)
@@ -93,6 +123,15 @@
 .equiv NN_record_type_length, N_record_type_length + 1
 .section .text
 .align 16
+N_pr_record_type_new_slot:
+.byte 144,187,5,0,0,0,186
+.long RT_record_type
+.byte 233
+.long slot_accessor_body - (.+4)
+.global N_pr_record_type_new_slot,NN_pr_record_type_new_slot
+.equiv NN_pr_record_type_new_slot, N_pr_record_type_new_slot + 1
+.section .text
+.align 16
 N_pr_record_type_length_slot:
 .byte 144,187,4,0,0,0,186
 .long RT_record_type
@@ -129,10 +168,11 @@
 .align 16
 RT_record_type:
 .long RT_record_type
-.byte 4,0,0,0
+.byte 5,0,0,0
 .long NN_record_type_huh
 .byte 19,0,0,0
 .long NN_record_type_length
+.byte 19,0,0,0
 .global RT_record_type
 .section .text
 .align 16

Index: misc.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/misc.wth,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- misc.wth	18 Sep 2002 21:08:14 -0000	1.6
+++ misc.wth	18 Sep 2002 21:09:00 -0000	1.7
@@ -9,6 +9,7 @@
 (include wisptyp)
 
 (extern RT_record_type)
+(extern WB_creatable_huh)
 (extern WB_range)
 (extern WB_record_type_huh)
 (extern WB_vector_huh)
@@ -16,6 +17,7 @@
 (extern decui$1)
 (extern encsi$1)
 (extern encui$1)
+(extern funcall)
 (extern rvec)
 
 (macro RVEC_LEN 30)
@@ -30,11 +32,12 @@
   swap RVEC_LEN rdecui cells 'rvec + cell! VOID)
 
 (assemble RT_record_type
-  (tetra RT_record_type)         ; type pointer
-  (tetra 4)                      ; slot count
-  (tetra NN_record_type_huh)     ; discriminator
-  (tetra 19)  ; FALSE            ; |ref|
-  (tetra NN_record_type_length)) ; |length|
+  (tetra RT_record_type)        ; type pointer
+  (tetra 5)                     ; slot count
+  (tetra NN_record_type_huh)    ; discriminator
+  (tetra 19)  ; FALSE           ; |ref|
+  (tetra NN_record_type_length) ; |length|
+  (tetra 19)) ; FALSE           ; |new|
 
 (native record_type_huh
   'RT_record_type go-discriminate)
@@ -52,6 +55,9 @@
 (native pr_record_type_length_slot
   'RT_record_type 4 go-access-slot)
 
+(native pr_record_type_new_slot
+  'RT_record_type 5 go-access-slot)
+
 (native record_type_length dup 1 = argc drop
   dup get-type 'RT_record_type = if
     1 cells + cell@ (flush) 'encui$1 jump
@@ -96,5 +102,20 @@
 
 (native vector_fill dup 2 = argc drop
   swap dup vector-data swap vector-length rot tetrafill VOID)
+
+(extern immediate_return)
+(assemble immediate_return
+  (ret))
+
+; Note that |new| is not supposed to work in setter context.
+(native new dup 0 > argc
+  (stack=! 1) sp@ over cells + cell- dup cell@
+  dup require-record-type 5 cells + cell@
+  dup FALSE = if
+    drop 'WB_creatable_huh swap go-raise
+  then
+  nip swap 'immediate_return swap cell! ; fix the return address
+  swap 1- swap ; decrement argcount
+  (conform %ecx %eax) ,(jmp funcall))
 
 ; vim: ft=worth

Index: records.nasm
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/records.nasm,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- records.nasm	18 Sep 2002 21:06:32 -0000	1.33
+++ records.nasm	18 Sep 2002 21:09:00 -0000	1.34
@@ -28,7 +28,7 @@
     mov [esp], eax
     mov edx, RT_record_type
     ; we don't have a discriminator yet
-    gcall record_constructor_body, eax, FALSE, FALSE, FALSE
+    gcall record_constructor_body, eax, FALSE, FALSE, FALSE, FALSE
     push eax
     ; stack: (slot-count record-type)
     valloc 6

Index: wstrings.s
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/wstrings.s,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- wstrings.s	18 Sep 2002 21:05:09 -0000	1.4
+++ wstrings.s	18 Sep 2002 21:09:00 -0000	1.5
@@ -34,4 +34,5 @@
 .long NN_c16string_huh
 .long NN_c16string_ref
 .byte 19,0,0,0
+.long NN_make_c16string
 .global RT_c16string

Index: wstrings.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/wstrings.wth,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- wstrings.wth	18 Sep 2002 21:05:09 -0000	1.4
+++ wstrings.wth	18 Sep 2002 21:09:00 -0000	1.5
@@ -13,7 +13,8 @@
   (tetra 1)
   (tetra NN_c16string_huh)
   (tetra NN_c16string_ref)
-  (tetra 19)) ; FALSE
+  (tetra 19)  ; FALSE
+  (tetra NN_make_c16string)) ; FALSE
 
 (extern RT_c16string)
 (extern WB_range)