[Wisp-cvs] wisp/modules universal.wrti,1.12,1.13 wisptyp.wrti,1.9,1.10

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

Update of /cvsroot/wisp/wisp/modules
In directory usw-pr-cvs1:/tmp/cvs-serv6849/modules

Modified Files:
	universal.wrti wisptyp.wrti 
Log Message:
Started the string format transition.

Index: universal.wrti
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/universal.wrti,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- universal.wrti	4 Sep 2002 14:26:24 -0000	1.12
+++ universal.wrti	7 Sep 2002 22:02:40 -0000	1.13
@@ -93,51 +93,61 @@
 
   (macro \=?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?e ,0))
 
   (macro \<>?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?-e ,0))
 
   (macro \<?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?l ,0))
 
   (macro \<=?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?le ,0))
 
   (macro \>?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?g ,0))
 
   (macro \>=?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?ge ,0))
 
   (macro \u<?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?b ,0))
 
   (macro \u<=?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?be ,0))
 
   (macro \u>?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?a ,0))
 
   (macro \u>=?j
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(jmp %?ae ,0))
 
@@ -178,6 +188,7 @@
   (macro \=?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?e) ,(neg ,0)
     nip nip)
@@ -185,6 +196,7 @@
   (macro \<>?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?-e) ,(neg ,0)
     nip nip)
@@ -192,6 +204,7 @@
   (macro \<?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?l) ,(neg ,0)
     nip nip)
@@ -199,6 +212,7 @@
   (macro \<=?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?le) ,(neg ,0)
     nip nip)
@@ -206,6 +220,7 @@
   (macro \>?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?g) ,(neg ,0)
     nip nip)
@@ -213,6 +228,7 @@
   (macro \>=?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?ge) ,(neg ,0)
     nip nip)
@@ -220,6 +236,7 @@
   (macro \u<?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?b) ,(neg ,0)
     nip nip)
@@ -227,6 +244,7 @@
   (macro \u<=?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?be) ,(neg ,0)
     nip nip)
@@ -234,6 +252,7 @@
   (macro \u>?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?a) ,(neg ,0)
     nip nip)
@@ -241,6 +260,7 @@
   (macro \u>=?v
     (register %eax %ebx %ecx %edx)
     (->reg 2)
+    (->/expr 1)
     ,(cmp ,2 ,1)
     ,(mov ,0 %?ae) ,(neg ,0)
     nip nip)
@@ -293,25 +313,26 @@
   (macro +
     (binary +
       (->ureg 1)
+      (->/expr 0)
       ,(add ,1 ,0)
       drop))
 
   (macro -
     (binary -
       (->ureg 1)
+      (->/expr 0)
       ,(sub ,1 ,0)
       drop))
 
   (macro *
     (binary *
       (->ureg 1)
+      (->/expr 0)
       ,(imul ,1 ,0)
       drop))
 
   (macro /mod
-    (flush)
-    ,(pop %ebx)
-    ,(pop %eax)
+    (conform %eax %ebx)
     ,(sex %edx:eax %eax)
     ,(idiv %ebx)
     (believe %edx %eax))
@@ -350,6 +371,8 @@
     (stack>=! 4)
     (->ureg 3)
     (->ureg 2)
+    (->/expr 1)
+    (->/expr 0)
     ,(add ,3 ,1)
     ,(adc ,2 ,0)
     2drop)
@@ -358,6 +381,8 @@
     (stack>=! 4)
     (->ureg 3)
     (->ureg 2)
+    (->/expr 1)
+    (->/expr 0)
     ,(sub ,3 ,1)
     ,(sbb ,2 ,0)
     2drop)
@@ -379,21 +404,25 @@
   ;; Boolean arithmetics
   (macro and
     (->ureg 1)
+    (->/expr 0)
     ,(and ,1 ,0)
     drop)
 
   (macro or
     (->ureg 1)
+    (->/expr 0)
     ,(or ,1 ,0)
     drop)
 
   (macro xor
     (->ureg 1)
+    (->/expr 0)
     ,(xor ,1 ,0)
     drop)
 
   (macro not
     (->ureg 0)
+    (->/expr 0)
     ,(not ,0))
 
   (macro 0=

Index: wisptyp.wrti
===================================================================
RCS file: /cvsroot/wisp/wisp/modules/wisptyp.wrti,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- wisptyp.wrti	7 Sep 2002 21:51:45 -0000	1.9
+++ wisptyp.wrti	7 Sep 2002 22:02:40 -0000	1.10
@@ -79,6 +79,11 @@
   (macro untag-fixnum
     3 arshift)
 
+  (macro typetag
+    dup 3 and if drop FALSE else
+      dup if drop FALSE else
+        cell@ then then)
+
   ;; Type tags
 
   (macro NC_INTEGER 0)
@@ -139,20 +144,20 @@
 
   ;; Records
 
+  (extern discriminator_body)
   (extern record_constructor_body)
   (extern slot_accessor_body)
 
+  (macro go-discriminate ; takes: arg ... count rectype
+    (conform %ecx %edx)
+    'discriminator_body jump)
+
   (macro go-construct-record ; takes: arg ... count rectype
-    (stack=! 2)
-    (->reg 1 %ecx)
-    (->reg 0 %edx)
+    (conform %ecx %edx)
     'record_constructor_body jump)
 
   (macro go-access-slot ; takes: arg ... count rectype index
-    (stack=! 3)
-    (->reg 2 %ecx)
-    (->reg 1 %edx)
-    (->reg 0 %ebx)
+    (conform %ecx %edx %ebx)
     'slot_accessor_body jump))
 
 ; vim: ft=worth