[Wisp-cvs] wisp/src/native boxes.wth,1.9,1.10 cons.wth,1.1,1.2 death.wth,1.1,1.2 misc.wth,1.13,1.14 sys.wth,1.14,1.15 vectors.wth,1.4,1.5

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

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

Modified Files:
	boxes.wth cons.wth death.wth misc.wth sys.wth vectors.wth 
Log Message:
Created the beginnings of Worth-level assemblying.

Index: boxes.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/boxes.wth,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- boxes.wth	18 Sep 2002 21:18:04 -0000	1.9
+++ boxes.wth	30 Sep 2002 18:24:55 -0000	1.10
@@ -34,7 +34,7 @@
   'RT_box go-construct-record)
 
 (defun box_ref.final
-  (believe %eax)
+  believe %eax
   dup UNDEF = if drop 'WB_undefined swap go-raise then
   nip
   wisp-epilogue)
@@ -44,7 +44,7 @@
   'RT_box 1 go-access-slot)
 
 (native box_empty dup 1 = argc drop
-  UNDEF -2 (stack=! 1) (->reg 0 %ecx) 'N_box_ref jump)
+  UNDEF -2 1 stack=! (->reg 0 %ecx) 'N_box_ref jump)
 
 (native box_empty_huh dup 1 = argc drop
   <: swap 1 'RT_box 1 go-access-slot :>

Index: cons.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/cons.wth,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- cons.wth	26 Aug 2002 15:59:43 -0000	1.1
+++ cons.wth	30 Sep 2002 18:24:55 -0000	1.2
@@ -16,7 +16,7 @@
 (native cons
   dup 2 = argc drop
   (flush) ,cons$2 ; an extra entry point
-  8 GC_malloc (believe %eax) nip
+  8 GC_malloc believe %eax nip
   swap over utcdr!
   swap over utcar!
   tag-cons)

Index: death.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/death.wth,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- death.wth	4 Sep 2002 14:26:57 -0000	1.1
+++ death.wth	30 Sep 2002 18:24:55 -0000	1.2
@@ -12,7 +12,7 @@
 
 (defun die ; one argument: a null-terminated string
   drop ; we aren't going to return
-  (flush) strlen (believe %eax)
+  (flush) strlen believe %eax
   1 "wisp engine: " sys.write drop
   1 -rot sys.write drop
   1 "\n" sys.write drop

Index: misc.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/misc.wth,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- misc.wth	18 Sep 2002 21:18:04 -0000	1.13
+++ misc.wth	30 Sep 2002 18:24:55 -0000	1.14
@@ -108,14 +108,14 @@
 
 ; Note that |new| is not supposed to work in setter context.
 (native new dup 0 > argc
-  (stack=! 1) sp@ over cells + cell- dup cell@
+  1 stack=! 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))
+  $ %ecx %eax conform ,(jmp funcall))
 
 ; The supposed usage of |%get-argument-list| and |%get-environment| is
 ; once, during the initialization phase of the run-time library.

Index: sys.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/sys.wth,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- sys.wth	18 Sep 2002 21:12:38 -0000	1.14
+++ sys.wth	30 Sep 2002 18:24:55 -0000	1.15
@@ -37,8 +37,8 @@
 (macro encsi <: swap (flush) 'encsi$1 jump :>)
 (macro encui <: swap (flush) 'encui$1 jump :>)
 (macro salloc <: swap (flush) 'salloc$1 jump :>)
-(macro ws->zt (flush) ws2zt (believe %eax) nip)
-(macro zt->ws (flush) zt2ws (believe %eax) nip)
+(macro ws->zt (flush) ws2zt believe %eax nip)
+(macro zt->ws (flush) zt2ws believe %eax nip)
 
 (macro cons <: -rot (flush) 'cons$2 jump :>)
 
@@ -183,15 +183,13 @@
       NULL
     then
     ; ( pid status res )
-    over WIFEXITED if
+    cond over WIFEXITED if
       swap WEXITSTATUS encui swap cons 'WB_exit swap cons
-    else
-      over WIFSTOPPED if
-        swap WTERMSIG encui swap cons 'WB_stop swap cons
-      else ; assume WIFSIGNALED
-        swap WTERMSIG encui swap cons 'WB_signal swap cons
-      then
-    then
+    else over WIFSTOPPED if
+      swap WTERMSIG encui swap cons 'WB_stop swap cons
+    else ; assume WIFSIGNALED
+      swap WTERMSIG encui swap cons 'WB_signal swap cons
+    thens
     swap encui swap cons
   else
     dup 0 = if
@@ -287,19 +285,15 @@
 
 (native sys_low_tcsetattr dup 3 = argc drop
   rot decui rot
-  dup 'WB_now = if
+  cond dup 'WB_now = if
     drop TCSETS
+  else dup 'WB_drain = if
+    drop TCSETSW
+  else dup 'WB_flush = if
+    drop TCSETSF
   else
-    dup 'WB_drain = if
-      drop TCSETSW
-    else
-      dup 'WB_flush = if
-        drop TCSETSF
-      else
-        'WB_unknown swap go-raise
-      then
-    then
-  then
+    'WB_unknown swap go-raise
+  thens
   rot require-c8string
   sizeof.struct-termios require-string-length
   string-data sys.ioctl (flush) 'encsi$1 jump)
@@ -364,7 +358,7 @@
     begin over while
       dup dirent.name zt->ws
       over dirent.ino@ encui
-      <: -rot 2 8 dig (conform %ecx %eax) ,(jmp funcall) :> (believe %eax)
+      <: -rot 2 8 dig $ %ecx %eax conform ,(jmp funcall) :> believe %eax
       drop dup dirent.reclen@ swap over + -rot - swap
     repeat
     drop drop
@@ -376,7 +370,7 @@
 (native sys_ns_execve dup 3 = argc drop
   (flush) sp@ drop
   rot ws->zt -rot
-  (stack=! 3) ; so that all arguments are in registers
+  3 stack=! ; so that all arguments are in registers
   sp@ ; this is the stack pointer we're going to return with
   (stack<=! 1)
   ; sp[-1 cells] is filename, sp[-2 cells] is argvp and
@@ -395,7 +389,7 @@
     2swap ; (datum data sp len)
     rot ; (datum sp len data)
   repeat drop drop
-  (stack=! 1) sp@ over 2 cells - cell!
+  1 stack=! sp@ over 2 cells - cell!
 
   ; Process the environment:
   0 swap
@@ -409,13 +403,13 @@
     2swap ; (datum data sp len)
     rot ; (datum sp len data)
   repeat drop drop
-  (stack=! 1) sp@ over 3 cells - cell!
+  1 stack=! sp@ over 3 cells - cell!
 
   dup dup dup ; (sp sp sp sp)
   rot 1 cells - cell@
   rot 2 cells - cell@
   rot 3 cells - cell@
   sys.execve swap ; (result sp)
-  (stack=! 2) sp! (flush) 'encsi$1 jump)
+  2 stack=! sp! (flush) 'encsi$1 jump)
 
 ; vim: ft=worth

Index: vectors.wth
===================================================================
RCS file: /cvsroot/wisp/wisp/src/native/vectors.wth,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- vectors.wth	18 Sep 2002 21:18:04 -0000	1.4
+++ vectors.wth	30 Sep 2002 18:24:55 -0000	1.5
@@ -87,7 +87,7 @@
   'RT_vector over cell! ; store type
   tuck 1 cells + cell! ; store length
   tuck swap ; (node node object)
-  <: -rot 2 (conform %ecx) 'N_vector_fill jump :> (believe %eax)
+  <: -rot 2 $ %ecx conform 'N_vector_fill jump :> believe %eax
   drop)
 
 (native vector_move dup 5 = argc drop