[Wisp-cvs] wisp/tools worth,1.22,1.23

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

Update of /cvsroot/wisp/wisp/tools
In directory usw-pr-cvs1:/tmp/cvs-serv28473/tools

Modified Files:
	worth 
Log Message:
Converted sys.nasm to sys.wth and death.c to death.wth .

Index: worth
===================================================================
RCS file: /cvsroot/wisp/wisp/tools/worth,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- worth	4 Sep 2002 14:25:41 -0000	1.22
+++ worth	4 Sep 2002 14:26:58 -0000	1.23
@@ -625,6 +625,29 @@
                                                  (else (raise 'binary-operator? oper)))
                                                rest)))
                                          (process-word-list code #t))))
+                           ((conform) (my reqs (cdr word)
+                                        (cond
+                                          ((null? reqs) (flush))
+                                          ((and (cons? reqs)
+                                                (null? (cdr reqs))
+                                                reqs -> (reg)
+                                                (assq reg regref#))
+                                            (my (reg) reqs
+                                              (->register 0 reg)
+                                              (stack=! 1)))
+                                          ((and (cons? reqs)
+                                                (cons? (cdr reqs))
+                                                (null? (cddr reqs))
+                                                reqs -> (reg1 reg2)
+                                                (assq reg1 regref#)
+                                                (assq reg2 regref#)
+                                                (not (eq? reg1 reg2)))
+                                            (my (reg1 reg2) reqs
+                                              (stack<=! 2)
+                                              (->register 0 reg2)
+                                              (->register 1 reg1)))
+                                          (else (raise 'unable-to-conform
+                                                       reqs)))))
                            ((believe) (my claim (cdr word)
                                         (set! regstack
                                           (if (and (not (null? claim))
@@ -661,12 +684,13 @@
                              skip-assembly?[] => (cut >= <> 3))
                       (emit (list '() 'stack (reverse regstack))))))
             (for-each (cut process-word <> #f) body)
-            (flush)
             (if (eq? name '_start)
               (begin
                 (process-word 0 #f)
                 (process-word 'sys.exit #f))
-              (process-word ',(ret) #f)))
+              (begin
+                (flush)
+                (process-word ',(ret) #f))))
           (if (not (null? synstack))
             (raise 'unbalanced-syntax name)))))
       (reverse rcode)))