wisp-cvs

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

Update of /cvsroot/wisp/wisp/src/builtin
In directory usw-pr-cvs1:/tmp/cvs-serv703/src/builtin

Modified Files:
	assembler.wisp dictbase.wisp filing.wisp lists.wisp 
	objects.wisp stdenv.wisp 
Log Message:
Dropped NC_VECTOR in favour of the new |<vector>| type, thereby reducing the allocation block count of vectors from 2 to 1.

Index: assembler.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/assembler.wisp,v
retrieving revision 1.159
retrieving revision 1.160
diff -u -d -r1.159 -r1.160
--- assembler.wisp	18 Sep 2002 21:03:06 -0000	1.159
+++ assembler.wisp	18 Sep 2002 21:12:38 -0000	1.160
@@ -113,12 +113,12 @@
                    `(cons ,name ',name))
                  (quote
                    (* + - / /= < <= <box> <c16string> <macro>
-                    <record-type> = > >= apply assq assv car catch cdr
-                    char->integer char<=? char<? char=? char>=? char>?
-                    circular-list collect cons dict-ref eighth eq? eqv?
-                    fifth find find-tail for-each list map memq memv
-                    ninth not null? procedure? raise seventh sixth
-                    tenth)))
+                    <record-type> <vector> = > >= apply assq assv car
+                    catch cdr char->integer char<=? char<? char=?
+                    char>=? char>? circular-list collect cons dict-ref
+                    eighth eq? eqv? fifth find find-tail for-each list
+                    map memq memv ninth not null? procedure? raise
+                    seventh sixth tenth)))
             (map (lambda (middle)
                    `(cons ,(string->symbol "c$,[middle]r")
                           '(serial . ,(map (lambda (middle)

Index: dictbase.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/dictbase.wisp,v
retrieving revision 1.252
retrieving revision 1.253
diff -u -d -r1.252 -r1.253
--- dictbase.wisp	18 Sep 2002 21:09:00 -0000	1.252
+++ dictbase.wisp	18 Sep 2002 21:12:38 -0000	1.253
@@ -21,6 +21,7 @@
 (local <box> (asm RT_box))
 (local <c16string> (asm RT_c16string))
 (local <record-type> (asm RT_record_type))
+(local <vector> (asm RT_vector))
 (local address-of (asm NN_encui))
 (local apply (asm NN_apply))
 (local big-integer? (asm NN_big_integer_huh))
@@ -156,7 +157,6 @@
 (local utf-8-first-byte->length (asm NN_utf_8_first_byte2length))
 (local valloc (asm NN_valloc))
 (local vector-fill! (asm NN_vector_fill))
-(local vector-length (asm NN_vector_length))
 (local vector-move! (asm NN_vector_move))
 (local vector? (asm NN_vector_huh))
 (local wisp-string-hash (asm NN_wisp_string_hash))

Index: filing.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/filing.wisp,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -d -r1.108 -r1.109
--- filing.wisp	18 Sep 2002 21:11:14 -0000	1.108
+++ filing.wisp	18 Sep 2002 21:12:38 -0000	1.109
@@ -348,13 +348,16 @@
                         bitfield) mode))
       port)))
 
-(define *stdin* (make-instance <file>))  (init-input-file *stdin* 0)
-(define *stdout* (make-instance <file>)) (init-output-file *stdout* #f 1)
-(define *stderr* (make-instance <file>)) (init-output-file *stderr* #f 2)
+(let ((*stdin* (make-instance <file>))
+      (*stdout* (make-instance <file>))
+      (*stderr* (make-instance <file>)))
+  (init-input-file *stdin* 0)
+  (init-output-file *stdout* #f 1)
+  (init-output-file *stderr* #f 2)
 
-(define stdin$ (make-fluid *stdin*))
-(define stdout$ (make-fluid *stdout*))
-(define stderr$ (make-fluid *stderr*))
+  (define stdin$ (make-fluid *stdin*))
+  (define stdout$ (make-fluid *stdout*))
+  (define stderr$ (make-fluid *stderr*)))
 
 (define (current-input-port)  (ref stdin$))
 (define (current-output-port) (ref stdout$))
@@ -395,11 +398,8 @@
               (if (not (zero? limit))
                 (loop)))))))))
 
-(define (write-string string (port (current-output-port)))
- (port-write-string port string))
-
 (define (char-ready? (port (current-input-port)))
- (port-ready? port))
+  (port-ready? port))
 
 (defmacro (my-port var opener . body)
   `(my ,var ,opener
@@ -455,22 +455,17 @@
     (%read-char port)
     (((asm NN_pr_record_type_read_char_slot) (type-of port)) port)))
 
-; Note that Scheme's |write-char| takes the port argument *last*;
-; most likely because it's been historically easier to implement
-; optional arguments at the end of the argument list.  This does
-; not work well with the idea that the object argument (upon which
-; dispatching is decided) should be the first, so we're going to
-; change it.  During the conversion period, *both* orderings are
-; allowed.
-(define (write-char (port (current-output-port)) object)
-  (if (char? port)
-    (my x port
-      (set! port object)
-      (set! object x)))
+; Note that Scheme's |write-char| takes the port argument *last*
+; whereas the |write-char| hooks take it *first*.
+(define (write-char object (port (current-output-port)))
   (if (instance? port)
     (write-string (string object) port)
     (((asm NN_pr_record_type_write_char_slot) (type-of port))
       port object)))
+
+; See the comment near |write-char|.
+(define (write-string s (port (current-output-port)))
+  (port-write-string port s))
 
 (define (newline (port (current-output-port)))
   (write-char #\newline port)

Index: lists.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/lists.wisp,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -d -r1.107 -r1.108
--- lists.wisp	18 Sep 2002 21:05:08 -0000	1.107
+++ lists.wisp	18 Sep 2002 21:12:38 -0000	1.108
@@ -128,7 +128,6 @@
   (case x
     (null?   0)
     (string? (string-length x))
-    (vector? (vector-length x))
     (cons?   (my l 0
                (while (cons? x)
                  (incr! l)

Index: objects.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/objects.wisp,v
retrieving revision 1.161
retrieving revision 1.162
diff -u -d -r1.161 -r1.162
--- objects.wisp	18 Sep 2002 20:57:26 -0000	1.161
+++ objects.wisp	18 Sep 2002 21:12:38 -0000	1.162
@@ -85,11 +85,8 @@
   (if superclass
     (type class superclass))
   (my cl (make-instance <class>)
-    (asm (#f (if superclass
-               (asm superclass (l . 4))
-               '())
-          slots superclass . cl)
-         pt (st . 2) pt (st . 3) pt (st . 4) pt (st . 5))
+    (asm (slots superclass . cl)
+         pt (st . 2) pt (st . 3))
     cl))
 
 ; Note that the returned class discriminator returns either

Index: stdenv.wisp
===================================================================
RCS file: /cvsroot/wisp/wisp/src/builtin/stdenv.wisp,v
retrieving revision 1.368
retrieving revision 1.369
diff -u -d -r1.368 -r1.369
--- stdenv.wisp	18 Sep 2002 21:11:14 -0000	1.368
+++ stdenv.wisp	18 Sep 2002 21:12:38 -0000	1.369
@@ -12,7 +12,7 @@
        (cons 'list
          (map (lambda (x) `(cons ',x ,x))
            '(* + - / /= < << <= <box> <c16string> <class> <file>
-             <macro> <port> <record-type> = > >= >> abs acons!
+             <macro> <port> <record-type> <vector> = > >= >> abs acons!
              address-of alist->dict alist-copy analyse and append
              append-reverse apply assert assert-object-type assoc assq
              assv atom? big-integer? bind bit? boolean? box-empty!