various bug fixes

arc.pir

@@ -47,7 +47,8 @@ loop:
     unless iter goto end 
     $S0 = shift iter
     if $S0 == '-e' goto eval_mode # enter evaluation mode
-		unless $S0 == '-pir' goto go_on
+    if $S0 == '-a' goto is_arc
+    unless $S0 == '-pir' goto go_on
 		$S0 = shift iter
 		is_pir = 1
 go_on:
@@ -57,6 +58,9 @@ go_on:
 		$P0 = $P0($S0)
 		$P0()
 		goto loop
+is_arc:
+		is_pir = 0
+		goto loop
 compile_arc:		
     $P0 = 'load'($S0)#_compile_and_eval($S0)
     goto loop
@@ -88,7 +92,7 @@ error_loop:
 		$P3 = shift $P2
 		$P3 = $P3['sub']
 		if_null $P3, error_loop
-		$S0 = $P3.'to_string'()
+		$S0 = $P3#.'to_string'()
 		say $S0
 		goto error_loop
 the_end:        

arc/lib.arc

@@ -0,0 +1,12 @@
+(def newstring (n (o c #\space))
+  (tostring 
+    (repeat n
+      (disp c))))
+
+(def read ((o p (stdin)) (o eof nil))
+  (let r (_read p)
+    (if (is r "#<eof>")
+      eof
+      r)))
+
+(= sread read)

arc/qq.arc

@@ -41,5 +41,5 @@
                  (qq-expand (cdr x))))
       (list 'quote (list x)))))
 
-;(assign quasiquote 
-;  (annotate 'mac qq-expand))
+(assign quasiquote
+  (annotate 'mac qq-expand))

arcall.pir

@@ -120,6 +120,7 @@ tostring:
 go:			
    $P0 = table[$S0]
    if_null $P0, ret_nil # not found
+   $P0 = $P0[1] # 0 -> key, 1 -> val
    .return ($P0)
 ret_nil:	
    $P0 = get_hll_global 'nil'

benchmarks/fib.arc

@@ -1,7 +1,7 @@
-(set fib 
+(assign fib 
   (fn (n) 
     (if (< n 2) 
       1 
       (+ (fib (- n 1)) (fib (- n 2))))))
 
-(fib 28)
+(fib 32)

build/src/ops/Makefile.in

@@ -53,13 +53,13 @@ generate: $(OPS_FILE)
 
 compile: generate
 	$(CC) $(CC_OUT)primitivearc_ops$(O) $(INCLUDES) $(CFLAGS) primitivearc_ops.c
-	$(CC) $(CC_OUT)primitivearc_ops_switch$(O) $(INCLUDES) $(CFLAGS) primitivearc_ops_switch.c
+#	$(CC) $(CC_OUT)primitivearc_ops_switch$(O) $(INCLUDES) $(CFLAGS) primitivearc_ops_switch.c
 #IF(cg_flag):	$(CC) $(CC_OUT)primitivearc_ops_cg$(O) $(INCLUDES) $(CFLAGS) primitivearc_ops_cg.c
 #IF(cg_flag):	$(CC) $(CC_OUT)primitivearc_ops_cgp$(O) $(INCLUDES) $(CFLAGS) primitivearc_ops_cgp.c
 
 linklibs: compile
 	$(LD) $(LD_OUT)primitivearc_ops$(LOAD_EXT) primitivearc_ops$(O) $(LINKARGS)
-	$(LD) $(LD_OUT)primitivearc_ops_switch$(LOAD_EXT) primitivearc_ops_switch$(O) $(LINKARGS)
+#	$(LD) $(LD_OUT)primitivearc_ops_switch$(LOAD_EXT) primitivearc_ops_switch$(O) $(LINKARGS)
 #IF(cg_flag):	$(LD) $(LD_OUT)primitivearc_ops_cg$(LOAD_EXT) primitivearc_ops_cg$(O) $(LINKARGS)
 #IF(cg_flag):	$(LD) $(LD_OUT)primitivearc_ops_cgp$(LOAD_EXT) primitivearc_ops_cgp$(O) $(LINKARGS)
 

builtins.pir

@@ -39,9 +39,9 @@ loop:
 	 .param pmc after
 
 	 push_eh error
-	 $P0 = 'arcall'(during)
+	 'arcall'(during)
 	 pop_eh
-	 .return ($P0)
+	 .tailcall 'arcall'(after)
 error:
 	 .local pmc ex
 	 .get_results(ex)
@@ -94,7 +94,7 @@ end:
 
 ## arithmethic
 
-.macro defmathop(name, op)
+.macro defmathop(name, op, base_value)
 
    ## default sub called if the others fail to match
    .sub .name :multi()
@@ -111,7 +111,7 @@ loop:
 end:
       .return ($P0)
 zero_args:
-      .return (0)
+      .return (.base_value)
    .end
 
    .sub .name :multi(ArcInt, ArcInt)
@@ -156,10 +156,10 @@ zero_args:
 
 .endm
 
-.defmathop('+', +)
-.defmathop('-', -)
-.defmathop('*', *)
-.defmathop('/', /)
+.defmathop('+', +, 0)
+.defmathop('-', -, 0)
+.defmathop('*', *, 1)
+.defmathop('/', /, 1)
 
 .sub 'mod'
    .param int a
@@ -313,6 +313,16 @@ no:
    .defcmp(.name, .op, ArcInt, ArcNum, num)
    .defcmp(.name, .op, ArcNum, ArcInt, num)
    .defcmp(.name, .op, ArcNum, ArcNum, num)
+
+   .sub .name :multi(ArcSym, ArcSym)
+	   .param pmc a1
+	   .param pmc a2
+
+	   $P0 = 'string'(a1)
+	   $P1 = 'string'(a2)
+
+	   .tailcall .name($P0, $P1)
+   .end
 
    .sub .name :multi(_, _)
       .param pmc a1
@@ -395,18 +405,26 @@ end:
    scdr($P1, $P2)
    .return ($P0)
 .end
-   
-.sub '+' :multi(ArcStr, ArcStr)
+
+.sub '+' :multi(ArcStr, ArcNil)
    .param pmc s1
    .param pmc s2
 
-   $S0 = s1
-   $S1 = s2
-   $S0 .= $S1
+   .return (s1)
+.end
 
-   $P0 = new 'ArcStr'
-   $P0 = $S0
-   .return ($P0)
+.sub '+' :multi(ArcStr, _)
+   .param pmc s1
+   .param pmc s2
+
+   .tailcall 'string'(s1, s2)
+#   $S0 = s1
+ #  $S1 = s2
+  # $S0 .= $S1
+
+   #$P0 = new 'ArcStr'
+   #$P0 = $S0
+   #.return ($P0)
 .end
 
 .sub 'rand'
@@ -504,7 +522,7 @@ end:
    $P0(what)
 	 set_hll_global 'stdout*', $P1
    $P1 = compreg 'PIR'
-	 $P0 = 'inside'(out)
+   $P0 = 'inside'(out)
 	 if_null send_pir_to_stdout, execute
 	 'prn'($P0)
 execute:				
@@ -689,6 +707,7 @@ do:
 	 $P0 = new 'ArcChar'
 	 $S0 = inport.'get1'()
 	 $P0 = $S0
+	 $P0 = 'char->int'($P0)
 	 .return ($P0)
 .end
 
@@ -707,6 +726,7 @@ do:
 .sub 'read'
    .param pmc inport :optional
    .param int has_in :opt_flag
+
    if has_in goto do
    inport = get_hll_global 'stdin*'
 do:
@@ -734,7 +754,8 @@ do:
    if has_out goto do
    outport = get_hll_global 'stdout*'
 do:
-   .tailcall 'writec'(c, outport)
+   $P0 = 'int->char'(c)
+   .tailcall 'writec'($P0, outport)
 .end
 
 .sub 'write'
@@ -877,12 +898,14 @@ false:
 
    .local pmc iter
 
-   iter = table
+   iter = new 'HashIterator', table
 loop:
    unless iter goto end
    $P0 = shift iter
-   $P1 = table[$P0]
-	 arcall2(fn, $P0, $P1)
+   $P0 = table[$P0]
+   $P1 = $P0[1]
+   $P2 = $P0[0]
+   arcall2(fn, $P2, $P1)
    goto loop
 end:
    .return (table)
@@ -940,26 +963,6 @@ false:
    .return ($P0)
 .end
 
-.sub 'newstring'
-   .param int n
-   .param string c :optional
-   .param int has_c :opt_flag
-
-   if has_c goto go_on
-   c = " "
-go_on:  
-   $S0 = ""
-loop:
-   if n >= 0 goto end
-   $S0 .= c
-   n = n - 1
-   goto loop
-end:
-   $P0 = new 'ArcStr'
-   $P0 = $S0
-   .return ($P0)
-.end
-
 .sub 'string'
 	 .param pmc args :slurpy
 
@@ -996,6 +999,24 @@ handle_err:
 	 .return ($S0)
 .end
 
+.sub 'timedate'
+	.param pmc secs
+	$I0 = secs
+	$P0 = decodetime $I0
+	$I2 = $P0 # get length
+	$I2 = $I2 - 1
+	$P1 = get_hll_global 'nil'
+loop:
+	if $I2 == -1 goto end
+	$I3 = $P0[$I2]
+	$P2 = new 'ArcInt', $I3
+	$P1 = 'cons'($P2, $P1)
+	$I2 = $I2 - 1
+	goto loop
+end:	
+	.return ($P1)
+.end
+
 ## only stubs
 
 .sub 'msec'

compiler/boot.arc

@@ -73,7 +73,7 @@
     (inside o)])
 
 (dcoerce 'nil 'string (fn (it) ""))
-(dcoerce 'symbol 'string string)
+(dcoerce 'sym 'string string)
 
 (def str>lst (s pos)
   (if (< pos (len s))