Hi, attached is my first attempt for the Tcl/Tk binding, which in turn will bring Tk interface for parrot. The file Tcl.pir should go into the ./runtime/parrot/library/ directory
I am planning to make more subsequent patches on the matter, so I will appreciate if this first part will be considered for inclusion. Also, a typo. Thanks in advance, Vadim.
# Copyright (C) 2008, The Perl Foundation. # vkon =head1 TITLE libtcl.pir - NCI interface to Tcl language (http://www.tcl.tk) =head1 DESCRIPTION This module implements Tcl/Tk interface for Parrot. =cut .namespace ['Tcl'] .sub try :main .local pmc interp .local int b interp = get_global '_tcl_interp' b = isnull interp unless b goto ok_interp die "NO interp\n" ok_interp: .local string res res = 'eval'(0,"puts this") res = 'eval'(0,"expr {2+3}") print "res=" print res print "\n" res = 'eval'(0,<<"EOS") # does not work yet package require Tk pack [button .b] update EOS res = 'eval'(0,"expr {3+3}") print "res=" print res print "\n" .end .sub eval :method .param string str .local pmc interp, f_eval, f_getobjresult, f_getstringresult interp = get_global '_tcl_interp' f_eval = get_global '_tcl_eval' f_getobjresult = get_global '_tcl_getobjresult' f_getstringresult = get_global '_tcl_getstringresult' .local int res res = f_eval(interp,str) .local string str str = f_getstringresult(interp,0) .return(str) .end .sub _tcl_init :init # load shared library .local pmc libnames libnames = new 'ResizableStringArray' push libnames, 'tcl85' push libnames, 'tcl84' push libnames, 'libtcl8.5' push libnames, 'libtcl8.4' .local pmc libtcl libtcl = _load_lib_with_fallbacks('tcl', libnames) set_global '_libtcl', libtcl # initialize Tcl library .local pmc func_findexec func_findexec = dlfunc libtcl, "Tcl_FindExecutable", "vp" func_findexec(0) # get interpreter, store it globally .local pmc interp, func_createinterp func_createinterp = dlfunc libtcl, "Tcl_CreateInterp", "p" interp = func_createinterp() set_global '_tcl_interp', interp .local int b b = isnull interp unless b goto ok_interp die "NO interp\n" ok_interp: # few more functions, store them globally .local pmc func func = dlfunc libtcl, "Tcl_Eval", "ipt" set_global '_tcl_eval', func func = dlfunc libtcl, "Tcl_GetStringFromObj", "tpp" # should be "tp3" set_global '_tcl_getstringfromobj', func func = dlfunc libtcl, "Tcl_GetStringResult", "tp" set_global '_tcl_getstringresult', func func = dlfunc libtcl, "Tcl_GetObjResult", "pp" set_global '_tcl_getobjresult', func .end =item _load_lib_with_fallbacks(string friendly_name, pmc fallback_list) This function is more generally useful than just for this module -- it implements the search for a particular libary that may appear under any of several different filenames. The C<fallback_list> should be a simple array of strings, each naming one of the possible filenames, I<without> the trailing shared library extension (e.g. C<.dll> or C<.so>). The C<friendly_name> is only used to fill in the error message in case no match can be found on the system. BORROWED from OpenGL.pir - keep an eye on it (e.g. if it will be organized elsewhere - reuse it from there) =cut .sub _load_lib_with_fallbacks .param string friendly_name .param pmc fallback_list .local pmc list_iter list_iter = iter fallback_list .local string libname .local pmc library iter_loop: unless list_iter goto failed libname = shift list_iter library = loadlib libname unless library goto iter_loop loaded: .return (library) failed: .local string message message = 'Could not find a suitable ' message .= friendly_name message .= ' shared library!' die message .end =head1 SEE ALSO http://www.tcl.tk =head1 AUTHORS TBD =cut # Local Variables: # mode: pir # fill-column: 100 # End: # vim: expandtab shiftwidth=4 ft=pir:
diff -ru parrot-32666-orig/docs/art/pp002-pmc.pod parrot-32666/docs/art/pp002-pmc.pod --- parrot-32666-orig/docs/art/pp002-pmc.pod 2008-11-18 07:45:05.000000000 +0000 +++ parrot-32666/docs/art/pp002-pmc.pod 2008-11-15 18:07:38.000000000 +0000 @@ -15,7 +15,7 @@ a register-based virtual machine with 4 register types: Integer, String, Number, PMC. Registers are referenced by a capital letter signifying the register type -followed by the register number (C<$S15> is String register +followed by the register number (C<S15> is String register number 15). Parrot programs consist of lines of text where each line contains one opcode and its arguments.
_______________________________________________ http://lists.parrot.org/mailman/listinfo/parrot-dev
