source: abuse/tags/pd/abuse/src/maker.c @ 49

Last change on this file since 49 was 49, checked in by Sam Hocevar, 11 years ago
  • Imported original public domain release, for future reference.
  • Property svn:keywords set to Id
File size: 6.9 KB
Line 
1#define NO_LIBS 1
2#include <unistd.h>
3#include "lisp.c"
4#include "trig.c"
5#include "lisp_gc.c"
6#include "lisp_opt.c"
7
8
9#include <stdio.h>
10#include <string.h>
11#include <stdlib.h>
12#ifdef __WATCOMC__
13#include <sys\types.h>
14#include <direct.h>
15#define make_dir(dir) mkdir(dir)
16#else
17
18#include <sys/stat.h>
19#define make_dir(dir) mkdir(dir,511)
20#endif
21
22
23
24enum { LINUX, WATCOM, AIX, SUN, SGI };
25
26char *plat_names[] = {"Linux (SVGA & X11)",
27                      "Watcom for MS-DOS",
28                      "IBM AIX for RS6000's",
29                      "Sun OS",
30                      "Silicon Graphics"};
31
32char *plat_name[] = {"LINUX","WATCOM","AIX","SUN","SGI"};
33
34
35int detect_platform()
36{
37#ifdef __linux__
38  return LINUX;
39#endif
40
41#ifdef __WATCOMC__
42  return WATCOM;
43#endif
44
45#ifdef _AIX
46  return AIX;
47#endif
48
49#ifdef sun
50  return SUN;
51#endif
52
53#ifdef SUN3
54  return SUN;
55#endif
56
57#ifdef SUN4
58  return SUN;
59#endif
60
61#ifdef __sgi
62  return SGI;
63#endif
64
65  printf("Cannot detect platform\n");
66  exit(1);
67
68  return 0;
69}
70
71
72 void *l_obj_get(long number) { return NULL; }  // exten lisp function switches on number
73 void l_obj_set(long number, void *arg) { ; }  // exten lisp function switches on number
74 void l_obj_print(long number) { ; }  // exten lisp function switches on number
75
76void clisp_init()
77{                      // external initalizer call by lisp_init()
78  void *platform=make_find_symbol("platform");
79  set_symbol_value(platform,make_find_symbol(plat_name[detect_platform()])); 
80  add_lisp_function("get_depends",3,3,              0);
81  add_lisp_function("split_filename",2,2,           1);
82  add_lisp_function("convert_slashes",2,2,          2);
83  add_lisp_function("make_dir",1,1,                 3);
84  add_lisp_function("extension",1,1,                4);
85  add_lisp_function("system",1,1,                   5);
86  add_lisp_function("get_cwd",0,0,                  6);
87
88  add_lisp_function("mangle_oname",1,1,             7);
89
90  add_c_bool_fun("chdir",1,1,                       1);
91}
92
93
94#ifdef __WATCOMC__
95#include <dos.h>
96#endif
97
98int change_dir(char *path)
99{
100#ifdef __WATCOMC__
101  unsigned cur_drive;
102  _dos_getdrive(&cur_drive);
103  if (path[1]==':')
104  {
105    unsigned total;
106    _dos_setdrive(toupper(path[0])-'A'+1,&total);
107
108
109    unsigned new_drive;
110    _dos_getdrive(&new_drive);
111
112    if (new_drive!=toupper(path[0])-'A'+1)
113    {
114      return 0;
115    }
116
117    path+=2;
118  }
119 
120  int er=chdir(path);
121  if (er)
122  {
123    unsigned total;
124    _dos_setdrive(cur_drive,&total);
125  }
126  return !er;
127#else
128  int ret=chdir(path);    // weird
129  ret=chdir(path);
130  return ret==0;
131#endif 
132}
133
134long c_caller(long number, void *arg) // exten c function switches on number
135{
136  switch (number)
137  {
138    case 1 :
139    {
140      if (change_dir(lstring_value(eval(CAR(arg)))))
141        return 1;
142      else return 0;
143    } break;
144  }
145}
146
147void get_depends(char *fn, char *slash, void *ilist, void *&ret)
148{
149  p_ref r8(ret); 
150  p_ref r1(ilist);
151  void *v=ret;
152  p_ref r2(v);
153  for (;v;v=CDR(v))
154    if (!strcmp(fn,lstring_value(CAR(v)))) return ;     // check to see if file already in list
155
156  char tmp_name[200]; 
157  strcpy(tmp_name,fn);
158  FILE *fp=fopen(fn,"rb");
159  if (!fp)
160  {
161    for (v=ilist;!fp && v;v=CDR(v))     
162    {
163      sprintf(tmp_name,"%s%s%s",lstring_value(CAR(v)),slash,fn);
164      for (void *v=ret;v;v=CDR(v))
165        if (!strcmp(tmp_name,lstring_value(CAR(v)))) return ;
166      // check to see if file already in list
167      fp=fopen(tmp_name,"rb");
168    }
169  }
170  if (fp)
171  {
172    push_onto_list(new_lisp_string(tmp_name),ret);
173
174    char line[200];
175    while (!feof(fp))
176    {
177      fgets(line,200,fp);
178      if (!feof(fp))
179      {
180        if (memcmp(line,"#include",8)==0)
181        {
182          char *ch,*ch2;
183          for (ch=line+8;*ch==' ' || *ch=='\t';ch++);
184          if (*ch=='"')
185          {
186            ch++;
187            for (ch2=line;*ch!='"';ch++,ch2++)
188            { *ch2=*ch; }
189            *ch2=0;
190            get_depends(line,slash,ilist,ret);
191          }
192        }
193      }
194    }
195    fclose(fp);
196  }
197}
198
199void *l_caller(long number, void *arg)
200{
201  p_ref r1(arg);
202  void *ret=NULL;
203  switch (number)
204  {
205    case 0 :
206    {
207      void *fn=eval(CAR(arg));  arg=CDR(arg);
208      p_ref r1(fn);
209      void *sl=eval(CAR(arg));   arg=CDR(arg);
210      p_ref r2(sl);
211
212      void *ilist=eval(CAR(arg));
213      p_ref r3(ilist);
214
215      char filename[200];
216      strcpy(filename,lstring_value(fn));
217
218      char slash[10];
219      strcpy(slash,lstring_value(sl));
220
221      get_depends(filename,slash,ilist,ret);
222      void *v=ret;
223      if (v && CDR(v))
224      {
225        for (;CDR(CDR(v));v=CDR(v)); CDR(v)=NULL;  //chop of self
226      }
227    } break;
228    case 1 :
229    {
230      void *fn=eval(CAR(arg));  arg=CDR(arg);
231      p_ref r1(fn);
232      char *current_dir=lstring_value(eval(CAR(arg)));
233      char *filename=lstring_value(fn);
234
235      char *last=NULL,*s=filename,*dp;
236      char dir[200],name[200];
237      while (*s) { if (*s=='\\' || *s=='/') last=s+1; s++; }
238      if (last)
239      {
240        for (dp=dir,s=filename;s!=last;dp++,s++) { *dp=*s; }
241        *dp=0;
242        strcpy(name,last);
243      } else
244      {
245        strcpy(dir,current_dir);
246        strcpy(name,filename);
247      }
248      void *cs=(void *)new_cons_cell();
249      p_ref r24(cs);
250      ((cons_cell *)cs)->car=new_lisp_string(dir);
251      ((cons_cell *)cs)->cdr=new_lisp_string(name);
252      ret=cs;
253    } break;
254    case 2 :
255    {
256      void *fn=eval(CAR(arg)); arg=CDR(arg);
257      p_ref r1(fn);
258      char *slash=lstring_value(eval(CAR(arg)));
259      char *filename=lstring_value(fn);
260
261      char tmp[200],*s=filename,*tp;
262     
263      for (tp=tmp;*s;s++,tp++)
264      {
265        if (*s=='/' || *s=='\\')
266        {
267          *tp=*slash;
268//        if (*slash=='\\')
269//        { tp++; *tp='\\'; }
270        }
271        else *tp=*s;
272      }
273      *tp=0;
274      ret=new_lisp_string(tmp);
275    } break;
276    case 3 :
277    {
278      char name_so_far[100];
279      char *dir=lstring_value(eval(CAR(arg)));
280      char *d,ch;
281      d=dir;
282      while (*d)
283      {
284        if (*d=='\\' || *d=='/')
285        {
286          ch=*d;
287          *d=0;
288          make_dir(dir);
289          *d=ch;
290         
291        }
292        d++;
293      }
294      ret=NULL;
295    } break;
296    case 4 :
297    {
298      char *fn=lstring_value(eval(CAR(arg)));
299      char *l=NULL,*s=fn;
300      while (*s) { if (*s=='.') l=s; s++; }
301      if (l) ret=new_lisp_string(l);
302      else ret=new_lisp_string("");
303    } break;
304    case 5 :
305    {
306      ret=new_lisp_number(system(lstring_value(eval(CAR(arg)))));
307    } break;
308    case 6 :
309    {
310      char cd[150];
311      getcwd(cd,100);
312      return new_lisp_string(cd);
313    } break;
314    case 7 :
315    {
316      char *fn=lstring_value(eval(CAR(arg)));
317      uchar c1=0,c2=0,c3=0,c4=0;
318      while (*fn)
319      {
320        c1+=*fn;
321        c2+=c1;
322        c3+=c2;
323        c4+=c3;
324        fn++;
325      }
326      char st[15];
327      sprintf(st,"%02x%02x%02x%02x",c1,c2,c3,c4);
328      return new_lisp_string(st);           
329    } break;
330  }
331  return ret;
332}
333
334
335 // exten lisp function switches on number
336
337
338main(int argc, char **argv)
339{
340  lisp_init(5*1000*1024,5*1000*1024);
341  char *use_file="maker.lsp";
342  for (int i=1;i<argc;i++)
343  {
344    if (!strcmp(argv[i],"-f"))
345    {
346      i++;
347      use_file=argv[i];
348    }
349  }
350
351  char prog[100],*s;
352  sprintf(prog,"(compile-file \"%s\")\n",use_file);
353  s=prog;
354  if (!eval(compile(s)))
355  {
356    printf("unable to open file %s",use_file);
357    exit(0);
358  }
359  return 0;
360}
361
362
363
364
365
Note: See TracBrowser for help on using the repository browser.