Author: coke
Date: Mon Apr 18 19:39:53 2005
New Revision: 7875

Modified:
   trunk/languages/tcl/lib/commands/linsert.imc
Log:
Whoops. [linsert] had the wrong code



Modified: trunk/languages/tcl/lib/commands/linsert.imc
==============================================================================
--- trunk/languages/tcl/lib/commands/linsert.imc        (original)
+++ trunk/languages/tcl/lib/commands/linsert.imc        Mon Apr 18 19:39:53 2005
@@ -1,28 +1,74 @@
-# XXX simplified version.
+#
+# [linsert]
+#
 
 .namespace [ "Tcl" ]
 
-.sub "lindex"
+.sub "linsert"
   
   .local pmc argv
   argv = foldup
 
-  .local int argc 
-  argc = argv
+  # XXX need error handling.
 
-  if argc != 1 goto indexed
+  .local pmc the_list
+  the_list = shift argv
+ 
+  .local pmc position
+  position = shift argv
+
+  .local pmc list_index
+  list_index = find_global "_Tcl", "_list_index"
+
+  ($I0,$P0,$I2) = list_index(the_list,position)
+  if $I0 != TCL_OK goto error
+  if $I2 ==0 goto next
+  inc $P0 #linsert treats "end" differently 
+
+next: 
+  .local int the_index
+  the_index = $P0
+
+  # XXX workaround, splice doesn't work on TclList <-> TclList.
+  # Until that's fixed, splice Arrays, then post-covert to a TclList
+  # This is a hideous hack.
+
+  .local int cnt
+  cnt = 0
+  $I1 = the_list
+  .local pmc argv_list
+  argv_list = new Array
+  argv_list = $I1
+LOOP:
+  if cnt >= $I1 goto DONE
+  $P1 = the_list[cnt]
+  argv_list[cnt] = $P1
+  inc cnt
+  goto LOOP
+DONE:
+  argv_list = splice argv, the_index, 0
 
+  .local int TclList
+  TclList = find_type "TclList"
   .local pmc retval
-  retval = argv[0]
+  retval = new TclList
 
-  .return(TCL_OK,retval)
+  .local int cnt
+  cnt = 0
 
-indexed:
-  # The indices could be a list in a pmc or multiple pmcs. Deal with
-  # it either way... For now, assume they are individual... and singular.
-  .local int index
-  index = argv[1]
-  retval = argv[index]
+  .local int argc
+  argc = argv_list
+LOOP2:
+  if cnt >= argc goto DONE2
+  $P0 = argv_list[cnt]
+  retval[cnt] = $P0
+  inc cnt
+  goto LOOP2
+DONE2:
 
   .return (TCL_OK,retval)
+
+error:
+  .return($I0,$P0)
+
 .end

Reply via email to