1 /******************************************************************************
2 *
3 * File: $PXK/OS-HOOKS.C
4 * Description: OS specific startup and cleanup hooks.
5 * Windows NT, DEC ALpha
6 * Author:
7 * Created: 9-Mar-84
8 * Modified: 15-Jul-85 10:10:51 (RAM)
9 * Mode: Text
10 * Package:
11 * Status: Open Source: BSD License
12 *
13 *
14 ******************************************************************************
15 % (c) Copyright 1983, Hewlett-Packard Company, see the file
16 % HP_disclaimer at the root of the PSL file tree
17 %
18 %
19 % (c) Copyright 1982, University of Utah
20 %
21 % Redistribution and use in source and binary forms, with or without
22 % modification, are permitted provided that the following conditions are met:
23 %
24 % * Redistributions of source code must retain the relevant copyright
25 % notice, this list of conditions and the following disclaimer.
26 %
27 % * Redistributions in binary form must reproduce the above copyright
28 % notice, this list of conditions and the following disclaimer in the
29 % documentation and/or other materials provided with the distribution.
30 %
31 % THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
32 % AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
33 % THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
34 % PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
35 % CONTRIBUTORS
36 % BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
37 % CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
38 % SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
39 % INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
40 % CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
41 % ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
42 % POSSIBILITY OF SUCH DAMAGE.
43 %
44 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
45 %
46 %
47 * Revisions:
48 *
49 *
50 ******************************************************************************
51 */
52
53 #define _CRT_SECURE_NO_WARNINGS
54
55 //////#ifdef WINPSL
56 #include <windows.h>
57 //////#endif
58
59 #include <stdio.h>
60 #include <string.h>
61 #include <setjmp.h>
62 #include <float.h>
63
64 #define _Far16 _far16
65 #define INCL_DOSEXCEPTIONS
66 #define INCL_BASE
67 #define ULONG DWORD
68
69 #define ENDCHAR 4
70
71 extern HANDLE fe2lisp_read,fe2lisp_write, lisp2fe_read, lisp2fe_write;
72
73 FILE * scriptin; FILE * scriptout;
74 int script_mode=0;
75 int win_mode=0;
76 int pipe_mode=0;
77
78 extern int bruch_bruch,psl_callback1;
79
80 extern int firstkernel;
81 extern char bps[];
82
83 #ifndef WINPSL
84 //int hpipe = 0;
85 #endif
86
87 #include <excpt.h>
88
89
90 jmp_buf mainenv,signalenv;
91 char * abs_execfilepath = NULL;
92
93 int Debug = 0;
94 char * cygdrive_prefix = NULL;
95
96 void clear_dtabsize();
97 extern setupbpsandheap();
98 extern my_pexit();
99 extern psl_main(int, char **, int[]);
100 extern HANDLE my_popen_slave(int);
101 void c_signal();
102 void unixinitio();
103 void init_fp();
104
105 /****************** main ***********************/
106
107 extern int symms[];
108
main(argc,argv)109 main(argc,argv)
110
111 int argc;
112 char *argv[];
113 {
114 int val;
115 char * renv;
116 int i;
117
118 for(i=1; i<argc; i++)
119 {
120 if(0==strcmp(argv[i],"-p"))
121 { sscanf(argv[i+1],"%d",&fe2lisp_read);
122 sscanf(argv[i+2],"%d",&lisp2fe_write);
123 my_popen_slave(0);
124 win_mode = 1;
125 pipe_mode = 1;
126 }
127 }
128
129 renv=getenv("reduce");
130 if(renv ==(char*) NULL)
131 { // create path to %reduce%
132 char env[200]="reduce=";
133
134 #ifdef WINPSL
135 int l; char*s;
136 char path[200];
137
138 GetModuleFileName((HMODULE)NULL,path,100L);
139 l=strlen(path);
140 while(l>0 && path[l] != '\\') l--; path[l]='\0';
141 if(s=strstr(path,"\\bin\\")) *s = '\0';
142 strcat(env,path);
143 _putenv(strdup(env));
144 #else
145 // printf("\n+=+=+=+ WARNING: variable reduce not set\n");
146 #endif
147 }
148
149 scriptin = NULL; scriptout = NULL;
150 psl_callback1 = 0;
151 clear_dtabsize();
152 unixinitio();
153 bruch_bruch = 0;
154
155 if (argc > 0)
156 abs_execfilepath = _fullpath(NULL,argv[0],_MAX_PATH);
157
158 cygdrive_prefix = getenv("BPSL_CYGDRIVE_PREFIX");
159 if (getenv("BPSL_DEBUG") != NULL)
160 Debug = 1;
161
162 init_fp(); // initilialize floating point exception handling
163
164 c_signal(); // initizlize Ctrl C
165
166 val=setjmp(mainenv); /* set non-local return point for exit */
167
168 if (val == 0)
169 /* try{*/ psl_main(argc,argv,symms); /* }
170 except(EXCEPTION_EXECUTE_HANDLER)
171 {printf("Error on PSL kernel level\n");};*/
172
173 if (pipe_mode) my_pexit();
174
175 if(scriptin != NULL) fclose(scriptin);
176 if(scriptout != NULL) fclose(scriptout);
177
178 exit(val-1);
179
180 }
181
182
close_all()183 close_all()
184 {
185 if(scriptout != NULL) fclose(scriptout);
186 scriptout = NULL;
187 }
188
os_startup_hook(argc,argv)189 os_startup_hook(argc, argv)
190 int argc;
191 char *argv[];
192 {
193 setupbpsandheap(argc, argv); /* Allocate bps and heap areas. */
194 }
195
os_cleanup_hook()196 os_cleanup_hook()
197 {
198 longjmp(mainenv,1);
199 }
200
get_execfilepath()201 char * get_execfilepath ()
202 {
203 return abs_execfilepath;
204 }
205
clear_iob()206 clear_iob()
207 {
208
209 }
210
211 char winpathbuffer[_MAX_PATH];
212
213 int
pathstringncompare(char * s1,char * s2,size_t len)214 pathstringncompare(char *s1, char *s2, size_t len)
215 {
216 while (*s1 !=0 && *s2 != 0 && len > 0 &&
217 ((*s1 == *s2) || (*s1 == '/' && *s2 == '\\') || (*s1 == '\\' && *s2 == '/'))) {
218 s1++; s2++; len--;
219 }
220 if (len == 0) {
221 return 0;
222 } else if (*s1 > *s2) {
223 return 1;
224 } else if (*s2 > *s1) {
225 return -1;
226 }
227 }
228
229 char *
cygpath2winpath(char * cygpath)230 cygpath2winpath(char * cygpath)
231 {
232 if (Debug > 0) {
233 fprintf(stderr,"input cygpath: %s\n",cygpath);
234 fprintf(stderr,"prefix is %s\n",cygdrive_prefix == NULL ? "(NULL)" : cygdrive_prefix);
235 fflush(stderr);
236 }
237
238 if (cygdrive_prefix != NULL && strlen(cygdrive_prefix) > 1 &&
239 (cygpath[0] == '/' || cygpath[0] == '\\') &&
240 pathstringncompare(cygpath,cygdrive_prefix,strlen(cygdrive_prefix))==0 &&
241 (cygpath[strlen(cygdrive_prefix)] == '/' || cygpath[strlen(cygdrive_prefix)] == '\\')) {
242
243 strcpy(winpathbuffer,cygpath + strlen(cygdrive_prefix));
244 if (Debug > 0) {
245 fprintf(stderr,"prefix found, rest is: %s\n",winpathbuffer);
246 fflush(stderr);
247 }
248
249 if (winpathbuffer[1] != 0 && (winpathbuffer[2] == '/' || winpathbuffer[2] == '\\')) {
250 winpathbuffer[0] = winpathbuffer[1];
251 winpathbuffer[1] = ':';
252 if (Debug > 0) {
253 fprintf(stderr,"windows path is: %s\n",winpathbuffer);
254 fflush(stderr);
255 }
256 return winpathbuffer;
257 }
258 }
259 return cygpath;
260 }
261
262
263 /*
264 * Some static area must be initialized on hot start.
265 * There may be other area to be initialized but we have no idea
266 * to know them.
267 *
268 * _dtabsize ----_end
269 */
270
271
272 extern char *end;
273 /*
274 * Size of dtabsize is 0x34c bytes.
275 */
clear_dtabsize()276 void clear_dtabsize()
277 {
278 }
279
init_fp()280 void init_fp()
281 {
282 unsigned int cw, cwOriginal;
283
284 _clearfp(); // always call _clearfp before setting the control word
285
286 //cw = _controlfp(0, 0); //Get the default control word
287
288 // printf("Control word: %08x\n",cw);
289
290 cw = ~(_EM_OVERFLOW|_EM_ZERODIVIDE|_EM_INVALID);
291
292 // printf("New mask: %08x\n",cw);
293
294 cwOriginal = _controlfp(cw, _MCW_EM); //Set it.
295
296 // cw = _controlfp(0, 0); //Get the default control word
297
298 // printf("Control word: %08x\n",cw);
299 }
300
301 #if 0
302 char * rindex(s,c)
303 /* look for the last occurrence of character c in string s;
304 if found, return pointer to string part, NULL otherwise */
305 char * s; char c;
306 { int i,l; char x;
307 for (i=0; s[i]!='\000'; i++);
308 for (i=i-1; (s[i] !=c) && (i>=0) ; i--);
309 if (i<0) return(NULL); else return(& s[i]);
310 }
311
312 char * index(s,c)
313 /* look for the first occurrence of character c in string s;
314 if found, return pointer to string part, NULL otherwise */
315 char * s; char c;
316 { int i,l;
317 for (i=0; (s[i] !=c) && (s[i]!='\000') ; i++);
318 if (s[i]=='\000') return(NULL); else return(& s[i]);
319 }
320 #endif
321
322 #if 0
323 #ifndef __GNUC__
324
325 bzero (b,length)
326 char * b; int length;
327 { int i;
328 for (i=0; i<length; i++) b[i]='\000' ; }
329
330 #endif
331 #endif
332
333