1* $Id: wrapper.sno,v 1.6 2013-11-10 01:32:18 phil Exp $ 2* 3* wrapper.sno -- create C code to wrap a C function for LOAD()'ing 4* Phil Budne, December, 2001 5* 6* TODO: 7* malloc string buffers to right size??? 8* add 'HANDLE' type??? 9* 10* function to invoke C compiler, loader (libtool?) to create so/dl/shl/.. 11* overall wrapper; take prototype, create file, executable, and load it!! 12 13**************** 14* constants for wrapper.proto 15 16 wpmaxstr = 1024 17 wpstrtype = 'STRING' 18 wpinttype = 'INTEGER' 19 wpint32type = 'INT32' 20 wpint64type = 'INT64' 21 wprealtype = 'REAL' 22 wphdltype = 'HANDLE' 23 wppredtype = 'PREDICATE' 24 wpspredtype = 'SYSPRED' 25 wptypes = wpinttype | wprealtype | wpstrtype | 26+ wpint64type | wpint32type 27* | wphdltype 28 wprtypes = wptypes | wpredtype | wpspredtype | '' 29 wpname = ANY(&UCASE &LCASE '_') SPAN(&UCASE &LCASE '0123456789_') 30 wpend = ANY(',)') 31 wp4sp = ' ' 32 wp8sp = ' ' 33 34**************** 35* wrapper.startfile(output_name) 36* 37* output_name: the NAME (STRING) of output variable for C file 38* 39* XXX take filename arg?, return generated name variable?? 40* keep unit in a table, do endfile when endwrapperfile() called? 41 42 define("wrapper.startfile(fn)") :(e.wrapper.startfile) 43wrapper.startfile 44* XXX wrap in '#ifdef HAVE_CONFIG_H'?? 45 $fn = '/* this file generated by wrapper.sno on ' DATE() ' */' 46 $fn = 47 $fn = '#include "config.h"' 48 $fn = '#include "h.h"' 49 $fn = '#include "snotypes.h"' 50 $fn = '#include "macros.h"' 51 $fn = '#include "load.h"' 52 $fn = '#include "equ.h"' 53* XXX include handle.h? 54* XXX output handle list? 55 :(return) 56e.wrapper.startfile 57 58**************** 59* wrapper.proto(prototype,output_name) 60* 61* prototype: a prototype, as passed to SNOBOL LOAD() function 62* C function to call is the lowercase version 63* of the function name. 64* output_name: the NAME (STRING) of output variable for C file 65 66 define("wrapper.proto(proto,fn)types,i,n,c,call") :(e.wrapper.proto) 67wrapper.proto 68 69 $fn = 70 $fn = '/* ' proto ' */' 71 72* get function name 73 proto POS(0) wpname . name '(' = :f(wperr) 74 75**************** 76* loop for each argument, saving types in array 77 n = 0 78 wpcopy = 0 79 80* sigh; max 30 arguments! keep as linked list? 81 types = ARRAY('0:29') 82 proto POS(0) ')' = :s(wpepars) 83wploop proto wptypes . type wpend . c = :f(wperr) 84 types[n] = type :f(wperr) 85* terminal = 'types[' n '] = ' type 86 n = n + 1 87 88* count string/handle typed variables to save time later 89 wpcopy = IDENT(type, wpstrtype) wpcopy + 1 90 wpcopy = IDENT(type, wphdltype) wpcopy + 1 91 92* was terminator a close paren? if so we're done with args, else loop 93 IDENT(c, ')') :s(wpepars)f(wploop) 94 95wperr TERMINAL = 'error in prototype: >' proto '<' :(FRETURN) 96 97* proto should now have return type (or be empty) 98wpepars 99* TERMINAL = 'return type: ' proto 100 proto POS(0) wprtypes RPOS(0) :f(wperr) 101 102* output C function declaration 103 i = 0 104 $fn = name '( LA_ALIST ) LA_DCL' 105 $fn = '{' 106 107**************** 108* loop declaring variables 109 eq(wpcopy,0) :s(wpnostrs) 110wploop2 111* XXX branch based on type? 112 IDENT(types[i],wpstrtype) :f(wpnext2) 113 $fn = wp4sp 'char arg' i '[' wpmaxstr '];' 114wpnext2 i = i + 1 115 LT(i,n) :s(wploop2) 116 117**************** 118* loop copying string variables 119 i = 0 120wpcopy 121* dispatch based on type 122 :($('wpcpy_' types[i])) 123wpcpy_STRING 124 $fn = wp4sp 'getstring(LA_PTR(' i '), arg' i ', sizeof(arg' i '));' 125 :(wpncopy) 126wpcpy_HANDLE 127* XXXX handle HANDLE here!! 128wpcpy_INTEGER 129wpcpy_INT64 130wpcpy_INT32 131wpcpy_REAL 132wpcpy_ 133wpncopy i = i + 1 134 LT(i,n) :s(wpcopy) 135 136**************** 137* construct function call 138wpnostrs 139 call = REPLACE(name,&UCASE,&LCASE) '(' 140 141 i = 0 142wpcall GE(i,n) :s(wpecall) 143 call = GT(i,0) call ',' 144 145* dispatch based on type 146 :($('wparg_' types[i])) 147 148wparg_INTEGER 149wparg_INT32 150 call = call '(int)LA_INT(' i ')' :s(wpncall) 151wparg_INT64 152 call = call '(long long)LA_INT(' i ')' :s(wpncall) 153wparg_REAL 154 call = call '(double)LA_REAL(' i ')' :s(wpncall) 155wparg_STRING 156wparg_HANDLE 157 call = call 'arg' i 158wpncall i = i + 1 :(wpcall) 159 160wpecall call = call ')' 161 162* here with complete invocation in "call"; output w/ proper return 163 164* dispatch based on type 165 :($('wpret_' proto)) 166 167wpret_STRING 168 $fn = wp4sp 'RETSTR((char *)' call ');' :s(wpdone) 169wpret_INT32 170wpret_INT64 171wpret_INTEGER 172 $fn = wp4sp 'RETINT(' call ');' :s(wpdone) 173wpret_REAL 174 $fn = wp4sp 'RETREAL(' call ');' :s(wpdone) 175wpret_PREDICATE 176 $fn = wp4sp 'if (' call ')' 177 $fn = wp8sp 'RETNULL;' 178 $fn = wp4sp 'RETFAIL;' :s(wpdone) 179* system call (< 0 for failure) 180wpret_SYSPRED 181 $fn = wp4sp 'if (' call ' >= 0)' 182 $fn = wp8sp 'RETNULL;' 183 $fn = wp4sp 'RETFAIL;' :s(wpdone) 184wpret_ 185 $fn = wp4sp call ';' 186 $fn = wp4sp 'RETNULL;' 187 188* end of function 189wpdone $fn = '}' :(return) 190 191e.wrapper.proto 192 193**************** test; 194* wrapper.startfile(.OUTPUT) 195* wrapper.proto('FOO(INTEGER,STRING,REAL)STRING', .OUTPUT) 196* wrapper.proto('BAR(INTEGER,REAL)INTEGER', .OUTPUT) 197* wrapper.proto('BAZ(INTEGER,INTEGER,REAL,STRING)', .OUTPUT) 198* wrapper.proto('MUMBLE(STRING,STRING,STRING)REAL', .OUTPUT) 199* 200*end 201