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