Author: coke
Date: Wed Aug 17 08:17:17 2005
New Revision: 8976
Added:
trunk/languages/tcl/lib/commands/gets.pir
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles/tcl.in
trunk/languages/tcl/lib/commands/open.pir
Log:
Add rudimentary support for [gets]
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Wed Aug 17 08:17:17 2005
@@ -1384,6 +1384,7 @@ languages/tcl/lib/commands/expr.pir
languages/tcl/lib/commands/for.pir [tcl]
languages/tcl/lib/commands/foreach.pir [tcl]
languages/tcl/lib/commands/format.pir [tcl]
+languages/tcl/lib/commands/gets.pir [tcl]
languages/tcl/lib/commands/global.pir [tcl]
languages/tcl/lib/commands/if.pir [tcl]
languages/tcl/lib/commands/join.pir [tcl]
Modified: trunk/config/gen/makefiles/tcl.in
==============================================================================
--- trunk/config/gen/makefiles/tcl.in (original)
+++ trunk/config/gen/makefiles/tcl.in Wed Aug 17 08:17:17 2005
@@ -30,6 +30,7 @@ lib${slash}commands${slash}expr.pir \
lib${slash}commands${slash}for.pir \
lib${slash}commands${slash}foreach.pir \
lib${slash}commands${slash}format.pir \
+lib${slash}commands${slash}gets.pir \
lib${slash}commands${slash}global.pir \
lib${slash}commands${slash}if.pir \
lib${slash}commands${slash}incr.pir \
Added: trunk/languages/tcl/lib/commands/gets.pir
==============================================================================
--- (empty file)
+++ trunk/languages/tcl/lib/commands/gets.pir Wed Aug 17 08:17:17 2005
@@ -0,0 +1,26 @@
+=head1 [gets]
+
+read a line from a channel
+
+=cut
+
+.namespace [ "Tcl" ]
+
+.sub "&gets"
+ .local pmc argv
+ argv = foldup
+
+ $S1 = shift argv
+
+ $P2 = find_global "_Tcl", "channels"
+
+ .local pmc io
+ io = $P2[$S1]
+
+ .local string line
+ line = readline io
+
+ $P1 = new TclString
+ $P1 = line
+ .return (TCL_OK,$P1)
+.end
Modified: trunk/languages/tcl/lib/commands/open.pir
==============================================================================
--- trunk/languages/tcl/lib/commands/open.pir (original)
+++ trunk/languages/tcl/lib/commands/open.pir Wed Aug 17 08:17:17 2005
@@ -1,10 +1,3 @@
-###
-# [open]
-
-# XXX These variants of open are not supported.
-# open filename access
-# open filename access permissions
-
.namespace [ "Tcl" ]
.sub "&open"
@@ -12,40 +5,41 @@
argv = foldup
.local int return_type
- .local pmc retval
+ .local pmc retval,channel,next_channel_id,channels
+ .local string channel_id
+
retval = new String
.local int argc
argc = argv
if argc != 1 goto error
- $S1 = argv[0]
- open $P1, $S1, ">"
- $I0 = typeof $P1
+ channel_id = argv[0]
+ open channel, channel_id, "<"
+ $I0 = typeof channel
if $I0 == .Undef goto file_error
- retval = "file"
- $P2 = find_global "_Tcl", "channels"
+ channel_id = "file"
+ channels = find_global "_Tcl", "channels"
# get a new file channel name
- $P3 = find_global "_Tcl", "next_channel_id"
- $S0 = $P3
- retval = retval . $S0
- $P3 = $P3 + 1
- $P2[retval] = $P1
- #print "retval is:"
- #print retval
- #print "\n"
+ next_channel_id = find_global "_Tcl", "next_channel_id"
+ $S0 = next_channel_id
+ channel_id .= $S0
+ next_channel_id += 1
+ channels[channel_id] = channel
goto done
file_error:
- return_type = TCL_ERROR
+ retval = new String
retval = "unable to open specified file"
- goto done
+ .return(TCL_ERROR,retval)
error:
- return_type = TCL_ERROR
+ retval = new String
retval = "bad call to open"
- goto done
+ .return(TCL_ERROR,retval)
done:
+ retval = new String
+ retval = channel_id
.return(return_type,retval)
.end
