Author: coke
Date: Sun Jan 29 16:29:28 2006
New Revision: 11376

Modified:
   trunk/languages/tcl/lib/commands/proc.pir
   trunk/languages/tcl/lib/compiler.pir
   trunk/languages/tcl/lib/macros.pir
   trunk/languages/tcl/lib/tclbinaryops.pir
   trunk/languages/tcl/lib/tclfunc.pir
Log:
tcl -

more tcl compiler cleanup - should be using our sprintf<N> macros everywhere
now.



Modified: trunk/languages/tcl/lib/commands/proc.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/proc.pir   (original)
+++ trunk/languages/tcl/lib/commands/proc.pir   Sun Jan 29 16:29:28 2006
@@ -73,11 +73,7 @@ call_level=find_global '_Tcl', 'call_lev
 inc call_level
 END_PIR
 
-  $P1 = new .Array
-  $P1 = 1
-  $P1[0] = name
-
-  proc_body = sprintf temp_code, $P1
+  .sprintf1(proc_body, temp_code, name)
 
   .local int arg_count
   arg_count = args_p
@@ -121,14 +117,10 @@ arg_loop:
   store_lex '$%s', $P1
 END_PIR
 
-  $P1 = new .Array
-  $P1 = 2
-  $P1[0] = ii
   $S0 = args_p[ii]  #Escape this?
-  $P1[1] = $S0
+  .sprintf2($S1, temp_code, ii, $S0) 
 
-  temp_code = sprintf temp_code, $P1
-  proc_body.= temp_code
+  proc_body .= $S1
 
   ii = ii + 1
   goto arg_loop
@@ -159,11 +151,8 @@ DONE:
   store_lex '$args', arg_list
 END_PIR
 
-   $P1 = new .Array
-   $P1 = 1
-   $P1[0] = ii
-   temp_code = sprintf temp_code, $P1
-   proc_body .= temp_code
+   .sprintf1($S1,temp_code, ii)
+   proc_body .= $S1
 
 done_args:
   temp_code = <<"END_PIR"
@@ -174,13 +163,8 @@ ARGS_OK:
   push_eh is_return
 END_PIR
    
-  $P1 = new .Array
-  $P1 = 2
-  $P1[0] = name
-  $P1[1] = args
-  
-  temp_code = sprintf temp_code, $P1
-  proc_body .= temp_code
+  .sprintf2($S1, temp_code, name, args) 
+  proc_body .= $S1
 
   proc_body .= parsed_body
   
@@ -191,14 +175,8 @@ was_ok:
   .return($P%i)
 END_PIR
 
-  $P0 = new .Integer
-  $P0 = body_reg
-  $P1 = new .Array
-  $P1 = 1
-  $P1[0] = $P0 
-
-  temp_code = sprintf temp_code, $P1
-  proc_body .= temp_code
+  .sprintf1($S1, temp_code, body_reg)
+  proc_body .= $S1
 
   proc_body .= <<"END_PIR"
 is_return:

Modified: trunk/languages/tcl/lib/compiler.pir
==============================================================================
--- trunk/languages/tcl/lib/compiler.pir        (original)
+++ trunk/languages/tcl/lib/compiler.pir        Sun Jan 29 16:29:28 2006
@@ -167,16 +167,10 @@ epoch = find_global "_Tcl", "epoch"
 END_PIR
 
 set_args:
-  $P1 = new .Array
-  $P1 = 3
-  $P1[0] = compiled_num
-  $P1[1] = pir_code
-  $P1[2] = result_reg
-
   # The pir_code element above should always end in a \n, so we don't
   # need to add one explicitly before the .return
 
-  pir_code = sprintf stub_code, $P1
+  .sprintf3(pir_code, stub_code, compiled_num, pir_code, result_reg)
 
   unless code_only goto compile_it
   .return (pir_code)

Modified: trunk/languages/tcl/lib/macros.pir
==============================================================================
--- trunk/languages/tcl/lib/macros.pir  (original)
+++ trunk/languages/tcl/lib/macros.pir  Sun Jan 29 16:29:28 2006
@@ -174,15 +174,20 @@ C<val> arguments it's expecting.
 
 =cut
 
+.macro sprintf1(output,format,val1)
+  .sym pmc arglist 
+  arglist = new .Array
+  arglist = 1
+  arglist[0] = .val1
+  .output = sprintf .format, arglist
+.endm
+
 .macro sprintf2(output,format,val1,val2)
   .sym pmc    arglist 
-  .sym string argument
   arglist = new .Array
   arglist = 2
-  argument = .val1 
-  arglist[0] = argument
-  argument = .val2 
-  arglist[1] = argument
+  arglist[0] = .val1
+  arglist[1] = .val2
   .output = sprintf .format, arglist
 .endm
 
@@ -196,6 +201,17 @@ C<val> arguments it's expecting.
   .output = sprintf .format, arglist
 .endm
 
+.macro sprintf4(output,format,val1,val2,val3,val4)
+  .sym pmc arglist 
+  arglist = new .Array
+  arglist = 4
+  arglist[0] = .val1
+  arglist[1] = .val2
+  arglist[2] = .val3
+  arglist[3] = .val4
+  .output = sprintf .format, arglist
+.endm
+
 .macro sprintf6(output,format,val1,val2,val3,val4,val5,val6)
   .sym pmc arglist 
   arglist = new .Array
@@ -209,3 +225,59 @@ C<val> arguments it's expecting.
   .output = sprintf .format, arglist
 .endm
 
+.macro sprintf8(output,format,val1,val2,val3,val4,val5,val6,val7,val8)
+  .sym pmc arglist 
+  arglist = new .Array
+  arglist = 8
+  arglist[0] = .val1
+  arglist[1] = .val2
+  arglist[2] = .val3
+  arglist[3] = .val4
+  arglist[4] = .val5
+  arglist[5] = .val6
+  arglist[6] = .val7
+  arglist[7] = .val8
+  .output = sprintf .format, arglist
+.endm
+
+.macro 
sprintf10(output,format,val1,val2,val3,val4,val5,val6,val7,val8,val9,val10)
+  .sym pmc arglist 
+  arglist = new .Array
+  arglist = 10
+  arglist[0] = .val1
+  arglist[1] = .val2
+  arglist[2] = .val3
+  arglist[3] = .val4
+  arglist[4] = .val5
+  arglist[5] = .val6
+  arglist[6] = .val7
+  arglist[7] = .val8
+  arglist[8] = .val9
+  arglist[9] = .val10
+  .output = sprintf .format, arglist
+.endm
+
+.macro 
sprintf14(output,format,val1,val2,val3,val4,val5,val6,val7,val8,val9,val10,val11,val12,val13,val14)
+  .sym pmc arglist 
+  arglist = new .Array
+  arglist = 14
+  arglist[0] = .val1
+  arglist[1] = .val2
+  arglist[2] = .val3
+  arglist[3] = .val4
+  arglist[4] = .val5
+  arglist[5] = .val6
+  arglist[6] = .val7
+  arglist[7] = .val8
+  arglist[8] = .val9
+  arglist[9] = .val10
+  arglist[10] = .val11
+  arglist[11] = .val12
+  arglist[12] = .val13
+  arglist[13] = .val14
+  .output = sprintf .format, arglist
+.endm
+
+
+
+

Modified: trunk/languages/tcl/lib/tclbinaryops.pir
==============================================================================
--- trunk/languages/tcl/lib/tclbinaryops.pir    (original)
+++ trunk/languages/tcl/lib/tclbinaryops.pir    Sun Jan 29 16:29:28 2006
@@ -29,57 +29,15 @@
   .const int OPERATOR_UNEQUAL= 45 
 
 .macro binary_op(FORMAT)
-  $P1 = new .Array
-  $P1 = 3
-  $P1[0] = register_num
-  $P1[1] = l_reg
-  $P1[2] = r_reg
-  op_code = sprintf .FORMAT, $P1
+  .sprintf3(op_code,.FORMAT,register_num,l_reg,r_reg)
   pir_code = l_code . r_code
   pir_code .= op_code
   goto done
 .endm 
 
-#XXX This macro is unused?
-.macro binary_op2num(FORMAT)
-  $P1 = new .Array
-  $P1 = 6 
-  $P1[0] = register_num
-  $P1[1] = l_reg
-  $P1[2] = r_reg
-  $P1[3] = register_num
-  $P1[4] = register_num
-  $P1[5] = register_num
-  op_code = sprintf .FORMAT, $P1
-  pir_code = l_code . r_code
-  pir_code .= ".local pmc number\n"
-  pir_code .= "number = find_global \"_Tcl\", \"__number\"\n"
-  $S99 = "$P%i = number($P%i)\n"
-  $P1 = 2
-  $P1[0] = l_reg
-  $P1[1] = l_reg
-  $S98 = sprintf $S99, $P1
-  pir_code .= $S98 
-  $P1 = 2
-  $P1[0] = r_reg
-  $P1[1] = r_reg
-  $S98 = sprintf $S99, $P1
-  pir_code .= $S98 
-
-  pir_code .= op_code
-  goto done
-.endm 
-
 .macro binary_op2(FORMAT)
-  $P1 = new .Array
-  $P1 = 6
-  $P1[0] = register_num
-  $P1[1] = l_reg
-  $P1[2] = r_reg
-  $P1[3] = register_num
-  $P1[4] = register_num
-  $P1[5] = register_num
-  op_code = sprintf .FORMAT, $P1
+  .sprintf6(op_code, .FORMAT, register_num, l_reg, r_reg, register_num, 
register_num, register_num)
+
   pir_code = l_code . r_code
 
   pir_code .= op_code
@@ -87,20 +45,8 @@
 .endm
 
 .macro binary_op3(FORMAT)
-  $P1 = new .Array
-  $P1 = 10
-  $P1[0] = l_reg # $S%i=$P%i
-  $P1[1] = l_reg
-  $P1[2] = r_reg # $S%i=$P%i
-  $P1[3] = r_reg
-  $P1[4] = register_num  # $I%i = isne $S%i, $S%i
-  $P1[5] = l_reg
-  $P1[6] = r_reg
-  $P1[7] = register_num # $P%i = new .String
-  $P1[8] = register_num # $P%i = $I%i
-  $P1[9] = register_num
+  .sprintf10(op_code,.FORMAT, l_reg, l_reg, r_reg, r_reg, register_num, l_reg, 
r_reg, register_num, register_num, register_num)
 
-  op_code = sprintf .FORMAT, $P1
   pir_code = l_code . r_code
   pir_code .= op_code
   goto done
@@ -173,13 +119,8 @@ push_eh l_code_check_%s
 clear_eh
 l_code_check_%s:
 END_PIR
-  $P1 = new Array
-  $P1 =8
-  $P1[0] = l_reg 
-  $P1[1] = l_reg
-  $P1[2] = l_reg
-  $P1[3] = l_reg
-  $S0 = sprintf temp_code, $P1
+
+  .sprintf4($S0, temp_code, l_reg, l_reg, l_reg, l_reg)
   l_code .= $S0
 
   temp_code = <<"END_PIR"
@@ -188,13 +129,7 @@ push_eh r_code_check_%s
 clear_eh
 r_code_check_%s:
 END_PIR
-  $P1 = new Array
-  $P1 =8
-  $P1[0] = r_reg
-  $P1[1] = r_reg
-  $P1[2] = r_reg
-  $P1[3] = r_reg
-  $S0 = sprintf temp_code, $P1
+  .sprintf4($S0, temp_code, r_reg, r_reg, r_reg, r_reg)
   r_code .= $S0
 
   ## end numeric_check
@@ -322,24 +257,6 @@ op_and:
   jump_label = register_num
   inc register_num
 
-  .local pmc printf_args
-  printf_args = new .Array
-  printf_args = 14
-  printf_args[0]  = l_code
-  printf_args[1]  = l_reg
-  printf_args[2]  = jump_label
-  printf_args[3]  = r_code
-  printf_args[4]  = r_reg
-  printf_args[5]  = jump_label
-  printf_args[6]  = jump_label
-  printf_args[7]  = register_num
-  printf_args[8]  = register_num
-  printf_args[9]  = jump_label
-  printf_args[10] = jump_label
-  printf_args[11] = register_num
-  printf_args[12] = register_num
-  printf_args[13] = jump_label
-
    $S0 = <<"END_PIR"
 %s
 unless $P%i goto false%i
@@ -355,7 +272,8 @@ $P%i=0
 done%i:
 END_PIR
 
-  $S1 = sprintf $S0, printf_args 
+  .sprintf14($S1, $S0, l_code, l_reg, jump_label, r_code, r_reg, jump_label, 
jump_label, register_num, register_num, jump_label, jump_label, register_num, 
register_num, jump_label)
+
   pir_code .= $S1
 
   goto done
@@ -365,23 +283,6 @@ op_or:
   jump_label = register_num
   inc register_num
 
-  .local pmc printf_args
-  printf_args = new .Array
-  printf_args = 14
-  printf_args[0]  = l_code
-  printf_args[1]  = l_reg
-  printf_args[2]  = jump_label
-  printf_args[3]  = r_code
-  printf_args[4]  = r_reg
-  printf_args[5]  = jump_label
-  printf_args[6]  = jump_label
-  printf_args[7]  = register_num
-  printf_args[8]  = register_num
-  printf_args[9]  = jump_label
-  printf_args[10] = jump_label
-  printf_args[11] = register_num
-  printf_args[12] = register_num
-  printf_args[13] = jump_label
 
   $S0 =<<"END_PIR"
 %s
@@ -398,7 +299,8 @@ $P%i=1
 done%i:
 END_PIR
 
-  $S1 = sprintf $S0, printf_args
+  .sprintf14($S1, $S0, l_code, l_reg, jump_label, r_code, r_reg, jump_label, 
jump_label, register_num, register_num, jump_label, jump_label, register_num, 
register_num, jump_label)
+
   pir_code .= $S1
 
 done:

Modified: trunk/languages/tcl/lib/tclfunc.pir
==============================================================================
--- trunk/languages/tcl/lib/tclfunc.pir (original)
+++ trunk/languages/tcl/lib/tclfunc.pir Sun Jan 29 16:29:28 2006
@@ -92,13 +92,9 @@ Initialize the attributes for an instanc
   if $I0 == FUNCTION_TANH goto func_tanh
   
 func_abs:
-  .local pmc printf_args
-  printf_args = new .Array
-  printf_args = 2
-  printf_args[0] = register_num
-  printf_args[1] = arg_reg
+  .sprintf2($S0,"$P%i = abs $P%i\n",register_num,arg_reg)
 
-  pir_code .= "$P%i = abs $P%i\n"
+  pir_code .= $S0
   goto done_all
 
 func_acos:
@@ -154,28 +150,20 @@ func_tanh:
 
 
 done:
-  .local pmc printf_args
-  printf_args = new .Array
-  printf_args = 8
-  printf_args[0] = register_num
-  printf_args[1] = arg_reg
-  printf_args[2] = register_num
-  printf_args[3] = opcode_name
-  printf_args[4] = register_num
-  printf_args[5] = register_num
-  printf_args[6] = register_num
-  printf_args[7] = register_num
-
-  pir_code .= <<"END_PIR"
+  .local string format
+  format = <<"END_PIR"
 $N%i=$P%i
 $N%i=%s $N%i
 $P%i=new .TclFloat
 $P%i=$N%i
 END_PIR
 
+  .sprintf8($S0,format, register_num, arg_reg, register_num, opcode_name, 
register_num, register_num, register_num, register_num)
+
+  pir_code .= $S0
+
 done_all:
 
-  pir_code = sprintf pir_code, printf_args
   .return(register_num,pir_code)
 
 .end

Reply via email to