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)))
|
