marc@athena.mit.edu (09/12/90)
I've been looking through the stuff in usub trying to figure out how to add a new function to perl, but I have been unsuccessful. Is there any documentation (or commented code) using this feature around? Marc
speyer@joy.cad.mcc.com (Bruce Speyer) (09/12/90)
In article <1990Sep11.210203.5608@uvaarpa.Virginia.EDU> marc@mit.edu writes: >I've been looking through the stuff in usub trying to figure out how >to add a new function to perl, but I have been unsuccessful. Is there >any documentation (or commented code) using this feature around? I've seen several of these usub info wanted requests in comp.lang.perl. Here is my experience so far given the usub example as a starting point. The mus script needs to be made a lot smarter. Potentially, the generation of user subroutines could be nearly completed automated. I haven't had any time to hack on mus so I gave up and started modifying the .c code which is error-prone for any substantial sized library. Anybody fix the mus script? I'll try to annotate the usub example: >%less /usr/local/src/perl/src/usub/curses.mus >... >static enum uservars { > UV_curscr, These will become global user variables available to perl scripts. >... >static enum usersubs { US_addch, These are the user subroutines to be added to perl >... > MAGICVAR("curscr", UV_curscr); >... > make_usub("addch", US_addch, usersub, filename); The string definitions which maps perl names to indexes for the usersub CASE statements which then call the c routines being defined. >... >CASE int wgetstr >I WINDOW* win >IO char* str >END > This expands to code which extracts the argument from perl's stack->ary_array and pushes the return arguements back onto the stack. Expanded code look: >... > case US_getyx: > if (items != 3) > fatal("Usage: &getyx($win, $y, $x)"); > else { > int retval; > STR* str = str_new(0); > WINDOW* win = *(WINDOW**) str_get(st[1]); > int y; > int x; > > do_sprintf(str, items - 1, st + 1); > retval = getyx(win, y, x); > str_numset(st[2], (double)y); > str_numset(st[3], (double)x); > str_numset(st[0], (double) retval); > str_free(str); > } > return sp; This pretty much shows everything. Note that the mus script could not create this code automatically. This curse's getyx() is called with a pointer to a curses window structure and returns ints as its second and third argument The str_new(0) line allocates a perl string type (initial size 0). This code doesn't seem to use the results of do_sprintf which buffers up the arguments into the string. However, this is an useful example because you can't allocate a buffer in perl you can only assign strings. C routines expect a buffer. So I used this technique for generating all the buffers my routines needed. You could have passed this string back with something like: STR* buf = str_new(size); /* pass in buffer size from perl */ buf->str_ptr = foo(size); /* call the C routine */ str_set(st[0], (char*) retval); /* return buffer as a perl string */ str_free(buf); Note the field str_ptr. The calls str_get() or str_new() allocate perl strings (defined in "str.h"). Structures have to be allocated as raw bytes in a perl string. That explains the syntax of the following: > WINDOW* win = *(WINDOW**) str_get(st[1]); Remember, str_get() returns a pointer to a perl string. We need what the perl string points to which explains *(WINDOW**). This works the same as the character string style shown above except it is using the knowledge that str_ptr is the first field (slot) in the structure. If str_ptr was ever moved from the first slot this code would break. Return values are either placed into perl integers using str_numset() or as perl strings str_set(). Structures must be returned using str_nset. Example: >... > case US_getch: >... > int retval; > char retch; >... > else { > retch = retval; > str_nset(st[0], &retch, 1); >... A more general calling style would be: /* pass in a pointer to the string to set */ str_nset(st[0], (char*) &retch, sizeof retch); >... userval(ix, str) >... switch (ix) { case UV_COLS: str_numset(str, (double)COLS); break; case UV_Def_term: str_set(str, Def_term); break; >... case UV_stdscr: /* stdscr is an extern WINDOW*, perl str will contain ptr to stdscr */ str_nset(str, &stdscr, sizeof(WINDOW*)); break; >... Userval() sets the values of the user defined global perl variables. The previous shows the style for numbers, strings, and structures. >... userset(ix, str) >... switch (ix) { case UV_COLS: COLS = (int)str_gnum(str); break; >... case UV_ttytype: strcpy(ttytype, str_get(str)); /* hope it fits */ break; The previous shows how the user defined perl variables are set. Userset() will be called whenever a user tries to assign to a variable. (Note: I would change the default case to not just return 0 but rather an error message.) Since the user can not allocate C structs or C pointers to structs from perl you have to do it for them and allow them to assign the values to user defined routines. I've created sets of global variables for this purpose: uptr1, uptr2, uptr3... For example: case UV_uptr1: uptr1 = (void*)str_get(str); ... That's about it. More tips or corrections are welcomed. It works and is a really valuable feature of Perl. My thanks to Larry. Bruce Speyer / MCC CAD Program WORK: [512] 338-3668 3500 W. Balcones Center Dr., Austin, TX. 78759 ARPA: speyer@mcc.com