small fixes, void_obj, better error reporting

i.c

@@ -171,6 +171,7 @@ static void _sck(obj *s) {
 /* small object representation extras */
 #define bool_obj(b) obj_from_bool(b)
 #define char_obj(b) obj_from_char(b)
+#define void_obj() obj_from_void(0)
 #define null_obj() mknull()
 #define eof_obj() mkeof()
 #define fixnum_obj(x) obj_from_fixnum(x)
@@ -413,7 +414,8 @@ jump:
 /* instructions for basic vm machinery */
 
 define_instrhelper(cxi_fail) { 
-  fprintf(stderr, "run-time failure: %s\n", (char*)ac); 
+  fprintf(stderr, "run-time failure: %s\n", (char*)ac);
+  ac = void_obj();
   unwindi(0); 
 }
 
@@ -424,6 +426,7 @@ define_instrhelper(cxi_failactype) {
   oportputcircular(ac, p, 0);
   fputc('\n', stderr);
   spop();
+  ac = void_obj();
   unwindi(0); 
 }
 
@@ -467,6 +470,22 @@ define_instruction(halt) {
   unwindi(0); 
 }
 
+define_instruction(panic) {
+  obj l, p; cks(ac); ckl(sref(0));
+  p = oport_file_obj(stderr);  
+  fprintf(stderr, "error: %s", stringchars(ac));
+  if (ispair(sref(0))) fputs(":\n", stderr); 
+  else fputs("\n", stderr);
+  for (l = sref(0); ispair(l); l = cdr(l)) {
+    oportputcircular(car(l), p, 0);
+    fputc('\n', stderr);
+  }
+  sdrop(1);
+  ac = void_obj();
+  unwindi(0); 
+}
+
+
 define_instruction(lit) { 
   ac = *ip++; 
   gonexti();
@@ -2739,6 +2758,12 @@ define_instruction(cop) {
   gonexti();
 }
 
+define_instruction(fop) {
+  ckw(ac);
+  oportflush(ac);
+  gonexti();
+}
+
 define_instruction(gos) {
   cxtype_oport_t *vt; ckw(ac);
   vt = ckoportvt(ac);
@@ -2789,42 +2814,49 @@ define_instruction(eof) {
 define_instruction(wrc) {
   obj x = ac, y = spop(); ckc(x); ckw(y);
   oportputc(char_from_obj(x), y);
+  ac = void_obj();
   gonexti();
 }
 
 define_instruction(wrs) {
   obj x = ac, y = spop(); cks(x); ckw(y);
   oportputs(stringchars(x), y);
+  ac = void_obj();
   gonexti();
 }
 
 define_instruction(wrcd) {
   obj x = ac, y = spop(); ckw(y);
   oportputcircular(x, y, 1);
+  ac = void_obj();
   gonexti();
 }
 
 define_instruction(wrcw) {
   obj x = ac, y = spop(); ckw(y);
   oportputcircular(x, y, 0);
+  ac = void_obj();
   gonexti();
 }
 
 define_instruction(wrnl) {
   ckw(ac);
   oportputc('\n', ac);
+  ac = void_obj();
   gonexti();
 }
 
 define_instruction(wrhw) {
   obj x = ac, y = spop(); ckw(y);
   oportputshared(x, y, 0);
+  ac = void_obj();
   gonexti();
 }
 
 define_instruction(wriw) {
   obj x = ac, y = spop(); ckw(y);
   oportputsimple(x, y, 0);
+  ac = void_obj();
   gonexti();
 }
 

i.h

@@ -455,6 +455,7 @@ declare_instruction(ois,        "P50",          0,  "open-input-string",   '1',
 declare_instruction(oos,        "P51",          0,  "open-output-string",  '0', AUTOGL)
 declare_instruction(cip,        "P60",          0,  "close-input-port",    '1', AUTOGL)
 declare_instruction(cop,        "P61",          0,  "close-output-port",   '1', AUTOGL)
+declare_instruction(fop,        "P71",          0,  "flush-output-port",   '1', AUTOGL)
 declare_instruction(gos,        "P9",           0,  "get-output-string",   '1', AUTOGL)
 declare_instruction(rdc,        "R0\0P10",      0,  "read-char",           'u', AUTOGL)
 declare_instruction(rdac,       "R1\0P10",      0,  "peek-char",           'u', AUTOGL)
@@ -468,6 +469,7 @@ declare_instruction(wrcw,       "W5\0P11",      0,  "write",               'b',
 declare_instruction(wrnl,       "W6\0P11",      0,  "newline",             'u', AUTOGL)
 declare_instruction(wrhw,       "W7\0P11",      0,  "write-shared",        'b', AUTOGL)
 declare_instruction(wriw,       "W8\0P11",      0,  "write-simple",        'b', AUTOGL)
+declare_instruction(panic,      "Z7",           0,  "%panic",              '2', AUTOGL)
                                                                  
 /* serialization and deserialization instructions */             
 declare_instruction(igp,        "U0",           0,  "integrable?",         '1', AUTOGL)

s.c

@@ -172,6 +172,29 @@ char *s_code[] = {
   "P", "square",
   "%1.0,.1*]1",
 
+  "P", "exact-integer-sqrt",
+  "%1.0It,.0,.1*,.2-,.1,@(y6:values)[22",
+
+  "P", "make-rectangular",
+  "%2'0,.2=?{.0]2}.1,'(s49:make-rectangular: nonzero imag part not suppor"
+  "ted),@(y5:error)[22",
+
+  "P", "make-polar",
+  "%2'0,.2=?{.0]2}'(j3.14159265358979),.2=?{.0-!]2}.1,'(s31:make-polar: a"
+  "ngle not supported),@(y5:error)[22",
+
+  "P", "real-part",
+  "%1.0]1",
+
+  "P", "imag-part",
+  "%1'0]1",
+
+  "P", "magnitude",
+  "%1.0Na]1",
+
+  "P", "angle",
+  "%1.0<0?{'(j3.14159265358979)]1}'0]1",
+
   "P", "%append",
   "%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1aL6]1}.!0.0^_1[1"
   "1",
@@ -427,6 +450,9 @@ char *s_code[] = {
   "I+,:3^[11}.!0.0^_1[41}${.2,.5c,@(y13:%25vector->list),@(y5:%25map1)[02"
   "},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
 
+  "P", "error",
+  "%!1.0,.2Z7]2",
+
   "P", "port?",
   "%1.0P00,.0?{.0]2}.1P01]2",
 
@@ -448,5 +474,23 @@ char *s_code[] = {
   "=}_1?{.0R8?{.1}{f}?{.0]2}:1P9,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,.1W0"
   "f,:0^[21}.!0.0^_1[31",
 
+  "P", "read-substring!",
+  "%4.1,,#0.5,.4,.4,.3,.8,&5{%1:0,.1I<!?{:3,.1I-]1}:4R0,.0R8?{:3,.2I=?{.0"
+  "]2}:3,.2I-]2}.0,.2,:2S5'1,.2I+,:1^[21}.!0.0^_1[41",
+
+  "P", "read-substring",
+  "%2'(c ),.1S2,${.4,.4,'0,.5,@(y15:read-substring!)[04},.0R8?{.0]4}.2,.1"
+  "I=?{.1]4}.0,'0,.3S7]4",
+
+  "C", 0,
+  "&0{%4.1,.4,.4,.3,@(y15:read-substring!)[44}%x,&0{%3.1,.1S3,.4,.3,@(y15"
+  ":read-substring!)[34}%x,&0{%2.1,.1S3,'0,.3,@(y15:read-substring!)[24}%"
+  "x,&0{%1P10,.1S3,'0,.3,@(y15:read-substring!)[14}%x,&4{|10|21|32|43%%}@"
+  "!(y12:read-string!)",
+
+  "C", 0,
+  "&0{%2.1,.1,@(y14:read-substring)[22}%x,&0{%1P10,.1,@(y14:read-substrin"
+  "g)[12}%x,&2{|10|21%%}@!(y11:read-string)",
+
   0, 0, 0
 };

src/k.sf

@@ -1515,7 +1515,7 @@
           (display "DECODE+EXECUTE =>") (newline)
           (set! start (current-jiffy)))
         (let* ([thunk (decode cstr)] [res (execute thunk)])
-          (write res) (newline))
+          (unless (eq? res (void)) (write res) (newline)))
         (when *verbose* 
           (display "Elapsed time: ") (write (* 1000 (/ (- (current-jiffy) start) (jiffies-per-second))))
           (display " ms.") (newline))))))

src/s.scm

@@ -419,18 +419,18 @@
 (define (make-rectangular r i)
   (if (= i 0) r (error "make-rectangular: nonzero imag part not supported" i)))
 
-(inline (make-polar m a)
+(define (make-polar m a)
   (cond [(= a 0) m]
         [(= a 3.141592653589793238462643) (- m)]
         [else (error "make-polar: angle not supported" a)]))
 
-(define-inline (real-part x) x)
+(define (real-part x) x)
 
-(define-inline (imag-part x) 0)
+(define (imag-part x) 0)
 
-(define-inline (magnitude x) (abs x))
+(define (magnitude x) (abs x))
 
-(define-inline (angle x) (if (negative? x) 3.141592653589793238462643 0))
+(define (angle x) (if (negative? x) 3.141592653589793238462643 0))
 
 
 ;---------------------------------------------------------------------------------------------
@@ -956,13 +956,15 @@
 ;with-exception-handler
 ;raise
 ;raise-continuable
-;error
 ;error-object?
 ;error-object-message
 ;error-object-irritants
 ;read-error?
 ;file-error?
 
+(define (error msg . args) (%panic msg args)) ; should work for now
+
+
 ;---------------------------------------------------------------------------------------------
 ; Environments and evaluation
 ;---------------------------------------------------------------------------------------------
@@ -1049,7 +1051,32 @@
               [else (write-char c op) (loop #f)]))))) 
 
 ;read
-;read-string
+
+(define (read-substring! str start end p)
+  (let loop ([i start])
+    (if (fx>=? i end) (fx- i start)
+        (let ([c (read-char p)])
+          (cond [(eof-object? c) (if (fx=? i start) c (fx- i start))]
+                [else (string-set! str i c) (loop (fx+ i 1))])))))
+
+(define (read-substring k p)
+  (let ([str (make-string k)])
+    (let ([r (read-substring! str 0 k p)])
+      (if (eof-object? r) r
+          (if (fx=? r k) str (substring str 0 r))))))
+
+(define read-string!
+  (case-lambda
+    [(str) (read-substring! str 0 (string-length str) (current-input-port))]
+    [(str p) (read-substring! str 0 (string-length str) p)]
+    [(str p start) (read-substring! str start (string-length str) p)]
+    [(str p start end) (read-substring! str start end p)]))
+
+(define read-string
+  (case-lambda
+    [(k) (read-substring k (current-input-port))]
+    [(k p) (read-substring k p)]))
+
 ;read-u8
 ;peek-u8
 ;u8-ready?
@@ -1070,8 +1097,7 @@
 ; (newline (p (current-output-port)))
 ; (write-shared x (p (current-output-port)))
 ; (write-simple x (p (current-output-port)))
-
-;flush-output-port
+; (flush-output-port p)
 
 
 ;---------------------------------------------------------------------------------------------