1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2%
3% File:         PXK:EXTERNALS.SL
4% Description:  Definitions of foreign language functions
5% Author:       Brian Beach, Hewlett-Packard CRC
6% Created:      19-Apr-84
7% Modified:     15-Feb-85 13:25:43
8% Mode:         Lisp
9% Package:
10% Status:       Open Source: BSD License
11%
12%
13%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
14% (c) Copyright 1983, Hewlett-Packard Company, see the file
15%            HP_disclaimer at the root of the PSL file tree
16%
17%
18% (c) Copyright 1982, University of Utah
19%
20% Redistribution and use in source and binary forms, with or without
21% modification, are permitted provided that the following conditions are met:
22%
23%    * Redistributions of source code must retain the relevant copyright
24%      notice, this list of conditions and the following disclaimer.
25%
26%    * Redistributions in binary form must reproduce the above copyright
27%      notice, this list of conditions and the following disclaimer in the
28%      documentation and/or other materials provided with the distribution.
29%
30% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
31% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
32% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
33% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
34% CONTRIBUTORS
35% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
36% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
37% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
38% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
39% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
40% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
41% POSSIBILITY OF SUCH DAMAGE.
42%
43%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
44%
45%
46%
47% Revisions:
48%
49% 17-Feb-89 (Chris Burdorf)
50% Changed name of sigset to sun3_sigset for sun os/4.
51% 05-Apr-88 (Julian Padget)
52%  Once more reinstated handle for alarm and ualarm.
53% 29-May-87 (Harold Carr & Leigh Stoller)
54%  Added external definition for setenv.
55% 05-May-87 (Leigh Stoller)
56%  Added external definitions for fast-math.sl. They are in float.c
57% 13-Apr-87 (Leigh Stoller & Harold Carr)
58%  Added external definition of allocatemorebps, defined in bpsheap.c.
59% 26-Sep-86 (Leigh Stoller)
60%  Added external entry for exit which is needed on the sun to pass an exit
61%  code back to unix.
62% 01-Sep-86 (Leigh Stoller)
63%  Added external-system to do a standard system call from C.
64% 19-Aug-86 (Leigh Stoller)
65%  Added entries for get_file_status, sigrelse, and sigset.
66% 15-Feb-85 13:25:18 (Brian Beach)
67%  Commented out a couple of functions for Pisces.
68% 01-Feb-85 (Bill Williams)
69%  Add external entries for Lisp terminal emulator.
70% 24-Jan-85 (Vicki O'Day)
71%  Added sleep entry.
72% 7-Jan-85 (Vicki O'Day)
73%  Removed nmodekeys entry.
74% 17-Dec-84 (Vicki O'Day)
75%  Added setlinebuf entry.
76%  Added syscall entry, for access to HP-UX system calls.  The syntax
77%  of this command is (syscall <system call #> <arg1> <arg2> ...).
78%  Currently, a limit of four arguments to the system call is imposed,
79%  since no system calls that we can use have more than this.  The
80%  various forms of execl do, but since we can't use fork now, we don't
81%  need this.  When we can use fork, the number of arguments allowed
82%  by syscall should be increased.
83% 7-Dec-84 (Vicki O'Day)
84%  Added nmodekeys entry, so 9836-users can call it.
85% 27-Sep-84 19:57:38 (Dave Matthews)
86%  Added an external function declaration for the new alterheapsize function.
87% 17-Jul-84 22:51:12 (RAM)
88%  Changed chdir to unixcd and time to external_time.
89%  Added external_stat, link, and unlink.
90%
91%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
92
93(compiletime
94 (setf *foreign-functions* nil)
95 )
96
97(compiletime
98  (flag '(unixfread unixfputc unixfgetc unixfgets unixfwrite unixfflush
99          whatsup ) % WN
100	'protected))
101
102
103(compiletime
104 (defmacro external-function (name args)
105    (let ((*lower t))
106     (setf *foreign-functions* (cons name *foreign-functions*))
107     (flag1 name 'foreignfunction)
108     (when (null (get name 'symbol))
109	   (put name 'symbol (bldmsg "_%w" name)))
110     (if (flagp name 'protected)
111
112     `(de ,name ,args
113	(if (wlessp bruch_bruch 0)
114	    (terminal-interrupt)
115	    (,name ,@args))
116      )
117
118     `(de ,name ,args
119	(,name ,@args)
120	)
121     )
122 )))
123
124(off r2i)
125%
126% For asking for interrupts
127%
128(external-function whatsup             (x))
129
130(external-function getpid               ())
131
132% Defined in echo.c
133%
134(external-function echoon               ())
135(external-function echooff              ())
136(external-function external_charsininputbuffer    (chan))
137(external-function flushstdoutputbuffer ())
138(external-function external_user_homedir_string    ())
139% (external-function external_anyuser_homedir_stringgggggg (user))
140
141
142% Defined in bpsheap.c
143%
144(external-function alterheapsize        (integer))
145(external-function allocatemorebps      (amount))
146(external-function get_imagefilepath    ())
147
148% Defined in file-status.c
149%
150(external-function get_file_status      (filename block flag))
151
152
153% Defined in os-hooks.c
154%
155(external-function os_startup_hook      (pargc pargv))
156(external-function os_cleanup_hook      ())
157(external-function get_execfilepath     ())
158
159
160% Defined in pslextras.c
161%
162(external-function external_alarm      (sec))
163(external-function external_ualarm     (usec repeat))
164(external-function external_time       (buffer))
165(external-function external_timc       (buffer))
166(external-function external_stat       (path buf))
167(external-function external_mkdir      (path mode))
168(external-function external_rmdir      (path))
169(external-function external_link       (path1 path2))
170(external-function external_unlink     (path))
171%  (external-function external_strlen     (strptr))
172(external-function external_setenv     (varstring valstring))
173(external-function external_getenv     (envstring))
174(external-function uxfloat             (buffer integer))
175(external-function uxfix               (buffer))
176(external-function uxassign            (arg1-buffer arg2-buffere))
177(external-function uxplus2             (result-buffer arg1-buffer arg2-buffer))
178(external-function uxdifference        (result-buffer arg1-buffer arg2-buffer))
179(external-function uxtimes2            (result-buffer arg1-buffer arg2-buffer))
180(external-function uxquotient          (result-buffer arg1-buffer arg2-buffer))
181(external-function uxgreaterp          (arg1-buffer arg2-buffer tee nill))
182(external-function uxlessp             (arg1-buffer arg2-buffer tee nill))
183(external-function uxwritefloat        (buffer floatptr convstr))
184(external-function uuxdoubletofloat    (x y))
185(external-function uuxfloattodouble    (y y))
186(external-function uuxsin              (r x))
187(external-function uuxcos              (r x))
188(external-function uuxtan              (r x))
189(external-function uuxasin             (r x))
190(external-function uuxacos             (r x))
191(external-function uuxatan             (r x))
192(external-function uuxsqrt             (r x))
193(external-function uuxexp              (r x))
194(external-function uuxlog              (r x))
195(external-function uuxatan2            (r y x))
196
197(external-function get_registry_value  (key subkey name infobuffer))
198
199% Defined in pwd-fn.c
200%
201(external-function external_pwd         ())
202
203
204% Defined in sigs.c
205%
206(external-function sun3_sigset               (signame handler))
207(external-function sigrelse             (signame handler))
208
209
210% Defined In unexec.c
211%
212(external-function unexec               (newname aname dstart bstart))
213
214
215% Defined in unix-io.c
216%
217(external-function unixputc             (ch))
218(external-function unixputs             (str))
219(external-function unixputn             (num))
220(external-function unixcleario          ())
221(external-function expand_file_name     (str))
222(external-function unixopen             (name mode))
223(external-function unixcd               (dir))
224
225(external-function unixfread                (buf size count fp))
226(external-function unixfputc                (ch fp))
227(external-function unixfgetc                (fp))
228(external-function unixfgets                (buf count fp))
229(external-function unixfwrite               (str strlen count fp))
230(external-function unixfflush               (fp))
231
232(external-function ctime                (buffer))
233(external-function external_system      (command))
234(external-function external_fullpath	(relpath))
235
236
237% Defined In the C Library
238%
239(external-function external_exit        (status))
240(external-function fopen                (name mode))
241(external-function fclose               (fp))
242(external-function fseek                (fp offset ptrname))
243(external-function clearerr             (fp))
244(external-function getw                 (fp))
245(external-function putw                 (w fp))
246(external-function signal               (signame handler))
247(external-function sleep        (sec))
248(external-function ieee_handler (str1 str2 handl))
249(external-function ieee_flags           (str1 str2 str3 str4))
250
251%% See $pxnk/sys-io.sl for the call to this. In SYS V, it may have to be
252%% moved into the microkernel since it is not directly supported. Under
253%% SYS V, buffering can only be changed before any writes on the stream,
254%% which means it must be called before setupbpsandheap. Also, under BSD,
255%% setlinebuf is a system call, while under SYS V, it must be written using
256%% setbuf and setvbuf. See the Bobcat version of setlinebuf.c in $pb.
257(external-function setlinebuf           (iobuff))
258
259%% popen, pclose
260
261(external-function popen                (cmd mode))
262(external-function pclose               (stream))
263
264
265(external-function profil               (a b c d))
266
267(external-function datetag() )
268
269% for windows interfacing
270
271(external-function psll_call (p1 p2 p3 p4))
272
273(on r2i)
274
275(compiletime
276 (for (in name *foreign-functions*)
277      (do (remflag1 name 'foreignfunction))
278      ))
279
280 (de unix-profile(a b c d)(profil a b c d))
281
282% redirect file io to routines with names prefixed by "unix"
283
284(de fread(buf size count fp) (unixfread buf size count fp))
285(de fputc(ch fp) (unixfputc ch fp))
286(de fgetc(fp) (unixfgetc fp))
287(de fgets (buf count fp) (unixfgets buf count fp))
288(de fwrite (str strlen count fp) (unixfwrite str strlen count fp))
289(de fflush (fp) (unixfflush fp))
290
291