1 /*****************************************************************/
2 /* file mainloop.c
3
4 ARIBAS interpreter for Arithmetic
5 Copyright (C) 1996-2010 O.Forster
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
21 Address of the author
22
23 Otto Forster
24 Math. Institut der LMU
25 Theresienstr. 39
26 D-80333 Muenchen, Germany
27
28 Email forster@mathematik.uni-muenchen.de
29 WWW http://www.mathematik.uni-muenchen.de/~forster
30
31 The latest version of ARIBAS can be obtained by anonymous ftp from
32
33 ftp.mathematik.uni-muenchen.de
34
35 directory
36
37 pub/forster/aribas
38 */
39 /*****************************************************************/
40 /*
41 ** mainloop.c
42 ** mainloop, error handling and help system
43 **
44 ** date of last change
45 ** 96-10-18: architec[]
46 ** 97-01-26: aripath, argload
47 ** 97-04-11: changed findhelpfile(), helptopic(), cfgfile()
48 ** 97-04-18: changed Fsystem()
49 ** 97-05-27: option -b (batch mode)
50 ** 97-07-12: reorg commandline options
51 ** 97-08-02: getenv
52 ** 97-08-28: improved findhelpfile()
53 */
54 /*------------------------------------------------------------*/
55 #include "common.h"
56 #include <setjmp.h>
57
58
59 #ifdef DOSorUNiX
60 #include <signal.h>
61 #endif
62 #ifdef MsDOS
63 #define genDOS
64 #endif
65 #ifdef DjGPP
66 #define genDOS
67 #endif
68 /*------------------------------------------------------------*/
69
70 #ifdef ARCHITEC
71 static char architec[] = ARCHITEC;
72 #else
73 static char architec[] = "???";
74 #endif
75
76 static char Version[] = VERSION_STRING;
77 static int version_no = VERSION_NO;
78 static char versionyear[] = VERSION_YEAR;
79 static char Email[] = "forster@mathematik.uni-muenchen.de";
80
81 #ifdef DTRACE
82 PUBLIC FILE *DTraceF;
83 PUBLIC int DTraceWrite(char *mess);
84 PUBLIC char DTraceZeile[80];
85 #endif
86 /*--------------------------------------------------------------*/
87
88 /********* prototypes of exported functions ************/
89 PUBLIC int error _((truc source, char *message, truc obj));
90 PUBLIC void setinterrupt _((int flg));
91 PUBLIC void reset _((char *message));
92 PUBLIC void faterr _((char *mess));
93
94 #ifdef DOSorUNiX
95 PUBLIC void ctrlcreset _((int sig));
96 #endif
97
98 PUBLIC int Unterbrech = 0;
99 PUBLIC truc *res1Ptr, *res2Ptr, *res3Ptr;
100 PUBLIC truc helpsym;
101 PUBLIC truc apathsym;
102
103 /*-----------------------------------------------------*/
104 PRIVATE char *HelpFile = "aribas.hlp";
105 PRIVATE char *InitLabel = "-init";
106
107 #ifdef genUNiX
108 #define MAXCMDLEN 256
109 PRIVATE char *CfgFile = ".arirc";
110 #else
111 #define MAXCMDLEN 128
112 PRIVATE char *CfgFile = "aribas.cfg";
113 #endif
114
115 struct options {
116 int mem;
117 int cols;
118 int verbose;
119 int batchflg;
120 char *helppath;
121 char *aripath;
122 char *loadinit;
123 char *loadname;
124 char *home;
125 int argc;
126 char **argv;
127 char helpbuf[MAXPFADLEN+2];
128 char pathbuf[MAXPFADLEN+4];
129 char inibuf[MAXPFADLEN+2];
130 char homebuf[MAXPFADLEN+2];
131 };
132
133 PRIVATE FILE *findcfg _((struct options *popt));
134 PRIVATE void iniopt _((struct options *popt, char *argv0));
135 PRIVATE int cfgfile _((struct options *popt));
136 PRIVATE int main0 _((int argc, char *argv[]));
137 PRIVATE int commandline _((int argc, char *argv[], struct options *popt));
138 PRIVATE int findhelpfile _((struct options *popt));
139 PRIVATE void initialize _((struct options *popt));
140 PRIVATE void inimain _((struct options *popt));
141 PRIVATE void title _((void));
142 PRIVATE int argload _((char *fil, int verb));
143 PRIVATE int mainloop _((void));
144 PRIVATE void toprespush _((truc obj));
145 PRIVATE truc Fhalt _((int argn));
146 PRIVATE truc Fversion _((int argn));
147 PRIVATE void resetcleanup _((char *message));
148
149 PRIVATE truc Shelp _((void));
150 PRIVATE int helpintro _((void));
151 PRIVATE int helptopic _((char *topic));
152 PRIVATE void displaypage _((char *txtarr[]));
153
154 #ifdef DOSorUNiX
155 PRIVATE truc systemsym;
156 PRIVATE truc Fsystem _((void));
157 PRIVATE truc getenvsym;
158 PRIVATE truc Fgetenv _((void));
159 #endif
160
161 PRIVATE truc hlpfilsym;
162
163 PRIVATE truc res1sym, res2sym, res3sym;
164 PRIVATE truc verssym;
165 PRIVATE truc haltsym;
166 PRIVATE truc haltret;
167
168 PRIVATE jmp_buf globenv;
169 PRIVATE int setjumpflg = 0;
170 PRIVATE int mainret = 0;
171
172 #ifdef TT /* nur fuer Test-Zwecke */
173 PRIVATE truc ttsym;
174 PRIVATE truc Ftt _((void));
175 #endif /* TT */
176
177 /*---------------------------------------------------------------*/
main(argc,argv)178 main(argc,argv)
179 int argc;
180 char *argv[];
181 {
182 int ret;
183
184 ret = main0(argc,argv);
185 #ifdef DTRACE
186 DTraceF = fopen("DTraceF.txt","w");
187 if(DTraceF == NULL) {
188 ret = EXITREQ;
189 }
190 #endif
191 if(ret != EXITREQ)
192 ret = mainloop();
193 else
194 ret = 0;
195 #ifdef DTRACE
196 if(DTraceF)
197 fclose(DTraceF);
198 #endif
199 closelog();
200 dealloc();
201 epilogue();
202 exit(ret);
203 }
204 /*------------------------------------------------------------------*/
main0(argc,argv)205 PRIVATE int main0(argc,argv)
206 int argc;
207 char *argv[];
208 {
209 struct options opt;
210 int ret;
211 int verb;
212
213 iniopt(&opt,argv[0]);
214 cfgfile(&opt);
215 commandline(argc,argv,&opt);
216 findhelpfile(&opt);
217
218 prologue();
219 initialize(&opt);
220
221 verb = opt.verbose;
222 if(verb)
223 title();
224 if(opt.loadinit) {
225 if(verb) {
226 fnewline(tstdout);
227 fprintline(tstdout,"(** loading init code **)");
228 }
229 ret = loadaux(opt.loadinit,verb,InitLabel);
230 }
231 iniargv(opt.argc,opt.argv);
232 if(opt.loadname) {
233 ret = argload(opt.loadname,verb);
234 if(opt.batchflg)
235 ret = EXITREQ;
236 }
237 else
238 ret = 0;
239 return(ret);
240 }
241 /*------------------------------------------------------------------*/
242 #ifdef DTRACE
DTraceWrite(mess)243 PUBLIC DTraceWrite(mess)
244 char *mess;
245 {
246 fprintf(DTraceF,mess);
247 }
248 #endif
249 /*------------------------------------------------------------------*/
iniopt(popt,argv0)250 PRIVATE void iniopt(popt,argv0)
251 struct options *popt;
252 char *argv0;
253 {
254 char *home;
255 char *str;
256 int n;
257
258 home = popt->homebuf;
259 home[0] = 0;
260 #ifdef genUNiX
261 str = getenv("HOME");
262 if(str != NULL)
263 strncopy(home,str,MAXPFADLEN);
264 #endif
265 #ifdef genDOS
266 if(argv0 != NULL) {
267 n = strncopy(home,argv0,MAXPFADLEN);
268 while((--n >= 0) && !issepdir(home[n]))
269 ;
270 home[n] = 0;
271 }
272 #endif
273 popt->home = home;
274 popt->mem = popt->cols = 0;
275 popt->verbose = 1;
276 popt->batchflg = 0;
277 popt->loadname = NULL;
278 popt->helppath = NULL;
279 popt->aripath = NULL;
280 popt->loadinit = NULL;
281 }
282 /*------------------------------------------------------------------*/
findcfg(popt)283 PRIVATE FILE *findcfg(popt)
284 struct options *popt;
285 {
286 FILE *fil;
287 char *buf, *str;
288 int n;
289
290 buf = popt->inibuf;
291 fil = fopen(CfgFile,"r");
292 if(fil) {
293 strcopy(buf,CfgFile);
294 return(fil);
295 }
296 n = strncopy(buf,popt->home,MAXPFADLEN);
297 buf[n] = SEP_DIR[0];
298 strncopy(buf+n+1,CfgFile,MAXPFADLEN-n);
299 fil = fopen(buf,"r");
300 if(fil)
301 return(fil);
302 #ifdef genUNiX
303 str = getenv("ARIRC");
304 if(str != NULL) {
305 strncopy(buf,str,MAXPFADLEN);
306 fil = fopen(buf,"r");
307 }
308 if(fil) {
309 return(fil);
310 }
311 #endif
312 return(NULL);
313 }
314 /*------------------------------------------------------------------*/
cfgfile(popt)315 PRIVATE int cfgfile(popt)
316 struct options *popt;
317 {
318 FILE *fil;
319 char linebuf[IOBUFSIZE+2];
320 char *str0, *str, *buf;
321 int n, ch;
322
323 fil = findcfg(popt);
324 if(fil == NULL) {
325 return(0);
326 }
327 while(fgets(linebuf,IOBUFSIZE,fil)) {
328 str0 = trimblanks(linebuf,0);
329 if(str0[0] == '-') {
330 ch = toupcase(str0[1]);
331 str = trimblanks(str0 + 2,1);
332 switch(ch) {
333 case 'M':
334 popt->mem = str2int(str,&n);
335 break;
336 case 'C':
337 popt->cols = str2int(str,&n);
338 break;
339 case 'P':
340 buf = popt->pathbuf;
341 strncopy(buf,str,MAXPFADLEN);
342 popt->aripath = buf;
343 break;
344 case 'H':
345 buf = popt->helpbuf;
346 strncopy(buf,str,MAXPFADLEN);
347 popt->helppath = buf;
348 break;
349 case 'Q':
350 popt->verbose = 0;
351 break;
352 case 'V':
353 popt->verbose = 1;
354 break;
355 case 'I':
356 if(strcmp(str0,InitLabel) == 0) {
357 popt->loadinit = popt->inibuf;
358 }
359 break;
360 }
361 }
362 if(popt->loadinit)
363 break;
364 }
365 fclose(fil);
366 return 0;
367 }
368 /*------------------------------------------------------------------*/
commandline(argc,argv,popt)369 PRIVATE int commandline(argc,argv,popt)
370 int argc;
371 char *argv[];
372 struct options *popt;
373 {
374 char *str, *buf;
375 int ch;
376 int n, k;
377
378 k = 0;
379 while(++k < argc && argv[k][0] == '-') {
380 ch = argv[k][1];
381 str = argv[k] + 2;
382 nochmal:
383 switch(toupcase(ch)) {
384 case 'M': /* memory for heap */
385 if(str[0] == 0 && k+1 < argc && argv[k+1][0] != '-')
386 str = argv[++k];
387 popt->mem = str2int(str,&n);
388 break;
389 case 'C': /* columns */
390 if(str[0] == 0 && k+1 < argc && argv[k+1][0] != '-')
391 str = argv[++k];
392 popt->cols = str2int(str,&n);
393 break;
394 case 'H': /* helppath */
395 if(str[0] == 0 && k+1 < argc && argv[k+1][0] != '-')
396 str = argv[++k];
397 buf = popt->helpbuf;
398 strncopy(buf,str,MAXPFADLEN);
399 popt->helppath = buf;
400 break;
401 case 'P': /* aripath */
402 if(str[0] == 0 && k+1 < argc && argv[k+1][0] != '-')
403 str = argv[++k];
404 buf = popt->pathbuf;
405 strncopy(buf,str,MAXPFADLEN);
406 popt->aripath = buf;
407 break;
408 case 'Q':
409 popt->verbose = 0;
410 if((ch = *str++))
411 goto nochmal;
412 break;
413 case 'V':
414 popt->verbose = 1;
415 if((ch = *str++))
416 goto nochmal;
417 break;
418 case 'B': /* batch mode */
419 popt->batchflg = 1;
420 if((ch = *str++))
421 goto nochmal;
422 break;
423 default:
424 ;
425 }
426 }
427 if(k < argc) {
428 popt->loadname = argv[k];
429 }
430 popt->argc = argc - k;
431 popt->argv = argv + k;
432 return(argc);
433 }
434 /*------------------------------------------------------------------*/
findhelpfile(popt)435 PRIVATE int findhelpfile(popt)
436 struct options *popt;
437 {
438 FILE *fil;
439 char *searchpath;
440 char path[MAXPFADLEN+2];
441 int n, erf;
442
443 if(popt->helppath != NULL) {
444 n = strcopy(path,popt->helppath);
445 path[n] = SEP_DIR[0];
446 strncopy(path+n+1,HelpFile,MAXPFADLEN-n);
447 fil = fopen(path,"r");
448 if(fil != NULL) {
449 goto found;
450 }
451 else {
452 path[n] = 0;
453 fil = fopen(path,"r");
454 if((fil != NULL) && (getc(fil) > 0)) {
455 goto found;
456 }
457 }
458 }
459 #ifdef genDOS
460 if(strlen(popt->home) > 0) {
461 n = strcopy(path,popt->home);
462 path[n] = SEP_DIR[0];
463 strncopy(path+n+1,HelpFile,MAXPFADLEN-n);
464 fil = fopen(path,"r");
465 if(fil != NULL)
466 goto found;
467 }
468 #endif
469 #ifdef genUNiX
470 searchpath = getenv("PATH");
471 if(searchpath == NULL || *searchpath == 0) {
472 goto notfound;
473 }
474 erf = findfile(searchpath,HelpFile,path);
475 if(erf) {
476 goto found1;
477 }
478 #endif
479 notfound:
480 popt->helppath = NULL;
481 return(aERROR);
482 found:
483 fclose(fil);
484 found1:
485 strcopy(popt->helpbuf,path);
486 popt->helppath = popt->helpbuf;
487 return(0);
488 }
489 /*------------------------------------------------------------------*/
initialize(popt)490 PRIVATE void initialize(popt)
491 struct options *popt;
492 {
493 memalloc(popt->mem);
494 inicont(); /* must be called first */
495 inialloc();
496 inistore();
497 inisyntchk();
498 iniarith();
499 inianalys();
500 inieval();
501 inifile();
502 iniarray();
503 initerm();
504 iniscan();
505 iniparse();
506 iniprint(popt->cols);
507 inimain(popt);
508 #ifdef MYFUN
509 inimyfun();
510 #endif
511 initend();
512 }
513 /*------------------------------------------------------------------*/
inimain(popt)514 PRIVATE void inimain(popt)
515 struct options *popt;
516 {
517 int sflg;
518 char *str;
519
520 helpsym = newsymsig("help",sSBINARY, (wtruc)Shelp, s_01);
521
522 if(popt->helppath != NULL)
523 str = popt->helppath;
524 else
525 str = HelpFile;
526 hlpfilsym = mksym(str,&sflg);
527
528 if(popt->pathbuf != NULL)
529 str = popt->pathbuf;
530 else
531 str = "";
532 apathsym = mksym(str,&sflg);
533
534 res1sym = newsym("_", sSYSTEMVAR, zero);
535 res1Ptr = SYMBINDPTR(&res1sym);
536 res2sym = newsym("__", sSYSTEMVAR, zero);
537 res2Ptr = SYMBINDPTR(&res2sym);
538 res3sym = newsym("___",sSYSTEMVAR, zero);
539 res3Ptr = SYMBINDPTR(&res3sym);
540
541 haltsym = newsymsig("halt", sFBINARY, (wtruc)Fhalt, s_01);
542 verssym = newsymsig("version", sFBINARY, (wtruc)Fversion, s_01);
543
544 #ifdef DOSorUNiX
545 systemsym = newsymsig("system",sFBINARY,(wtruc)Fsystem,s_1);
546 getenvsym = newsymsig("getenv",sFBINARY,(wtruc)Fgetenv,s_1);
547 #endif
548
549 #ifdef TT
550 ttsym = newsymsig("tt",sFBINARY,(wtruc)Ftt,s_0);
551 #endif
552 }
553 /*------------------------------------------------------------------*/
554 #ifdef TT
Ftt()555 PRIVATE truc Ftt()
556 {
557 char *str;
558
559 str = tmpnam(NULL);
560 return(mkstr(str));
561 }
562 #endif /* TT */
563 /*------------------------------------------------------------------*/
564 static char *gpltxt[] = {
565 "ARIBAS comes with ABSOLUTELY NO WARRANTY. This is free software,",
566 "and you are welcome to redistribute it under the terms of the GNU",
567 "General Public License as published by the Free Software Foundation.\n",
568 NULL
569 };
570 /*------------------------------------------------------------------*/
title()571 PRIVATE void title()
572 {
573 s2form(OutBuf,"~%ARIBAS Interpreter for Arithmetic, ~A (~A)",
574 (wtruc)Version,(wtruc)architec);
575 fprintline(tstdout,OutBuf);
576 s2form(OutBuf,"Copyright (C) 1996-~A O.Forster <~A>",
577 (wtruc)versionyear,(wtruc)Email);
578 fprintline(tstdout,OutBuf);
579 displaypage(gpltxt);
580 fnewline(tstdout);
581 fnewline(tstdout);
582 fprintline(tstdout,"for help, type\040\040?");
583 fprintline(tstdout,"to return from ARIBAS, type\040\040exit");
584 }
585 /*------------------------------------------------------------------*/
argload(fil,verb)586 PRIVATE int argload(fil,verb)
587 char *fil;
588 int verb;
589 {
590 char name[MAXPFADLEN+4];
591 int ret;
592
593 ret = findarifile(fil,name);
594 if(verb) {
595 fnewline(tstdout);
596 s1form(OutBuf,"(** loading ~A **)",(wtruc)name);
597 fprintline(tstdout,OutBuf);
598 }
599 ret = loadaux(name,verb,NULL);
600 if(ret == aERROR) {
601 s1form(OutBuf,"error while loading file ~A",(wtruc)name);
602 fprintline(tstderr,OutBuf);
603 }
604 return(ret);
605 }
606 /*------------------------------------------------------------------*/
mainloop()607 PRIVATE int mainloop()
608 {
609 static char resprompt[] = "-: ";
610 truc obj;
611 int jres;
612
613 setjumpflg = 1;
614 for( ; ; ) {
615 jres = setjmp(globenv);
616 if(jres == HALTRET) {
617 obj = haltret;
618 goto printres;
619 }
620 if(STREAMtok(tstdin) == EOLTOK || jres) {
621 inputprompt();
622 }
623 obj = tread(&tstdin,TERMINALINP);
624 if(obj == exitsym || obj == eofsym)
625 break;
626 if(obj == historsym) {
627 historyout(1);
628 continue;
629 }
630 flinepos0(tstdout);
631 obj = eval(&obj);
632 printres:
633 toprespush(obj);
634 if(obj == breaksym) {
635 if(*brkmodePtr == exitsym)
636 break;
637 else
638 obj = errsym;
639 }
640 ffreshline(tstdout);
641 if(obj != voidsym) {
642 fprintstr(tstdout,resprompt);
643 tprint(tstdout,obj);
644 fnewline(tstdout);
645 }
646 }
647 return(mainret);
648 }
649 /*------------------------------------------------------------------*/
toprespush(obj)650 PRIVATE void toprespush(obj)
651 truc obj;
652 {
653 *res3Ptr = *res2Ptr;
654 *res2Ptr = *res1Ptr;
655 *res1Ptr = obj;
656 }
657 /*------------------------------------------------------------------*/
Fversion(argn)658 PRIVATE truc Fversion(argn)
659 int argn;
660 {
661 if(argn == 0 || *argStkPtr != zero) {
662 s2form(OutBuf,"ARIBAS Version ~A (~A)",
663 (wtruc)Version,(wtruc)architec);
664 fprintline(tstdout,OutBuf);
665 }
666 return(mkfixnum(version_no));
667 }
668 /*------------------------------------------------------------------*/
669 #ifdef DOSorUNiX
Fsystem()670 PRIVATE truc Fsystem()
671 {
672 char command[MAXCMDLEN+2];
673 int res;
674
675 if(*FLAGPTR(argStkPtr) != fSTRING) {
676 error(systemsym,err_str,*argStkPtr);
677 goto errexit;
678 }
679 if(tempfree(1) == 0) {
680 error(systemsym,err_memev,voidsym);
681 goto errexit;
682 }
683 strncopy(command,STRINGPTR(argStkPtr),MAXCMDLEN);
684 res = system(command);
685 if(tempfree(0) == 0) {
686 mainret = error(scratch("\nFATAL ERROR"),err_memory,voidsym);
687 return(Sexit());
688 }
689
690 return(mksfixnum(res));
691 errexit:
692 return(mksfixnum(-1));
693 }
694 #endif
695 /*------------------------------------------------------------------*/
696 #ifdef DOSorUNiX
Fgetenv()697 PRIVATE truc Fgetenv()
698 {
699 char *estr;
700
701 if(*FLAGPTR(argStkPtr) != fSTRING) {
702 error(getenvsym,err_str,*argStkPtr);
703 return(brkerr());
704 }
705 estr = getenv(STRINGPTR(argStkPtr));
706 if(estr == NULL) {
707 return(nullstring);
708 }
709 else {
710 return(mkstr(estr));
711 }
712 }
713 #endif
714 /*------------------------------------------------------------------*/
error(source,message,obj)715 PUBLIC int error(source,message,obj)
716 truc source;
717 char *message;
718 truc obj;
719 {
720 if(source != voidsym) {
721 tprint(tstderr,source);
722 fprintstr(tstderr,": ");
723 }
724 fprintstr(tstderr,message);
725 if(obj != voidsym) {
726 fprintstr(tstderr,": ");
727 tprint(tstderr,obj);
728 }
729 fnewline(tstderr);
730 return(aERROR);
731 }
732 /*------------------------------------------------------------------*/
Fhalt(argn)733 PRIVATE truc Fhalt(argn)
734 int argn;
735 {
736 if(argn == 1 && *FLAGPTR(argStkPtr) == fFIXNUM)
737 haltret = *argStkPtr;
738 else
739 haltret = zero;
740 resetarr();
741 if(setjumpflg)
742 longjmp(globenv,HALTRET);
743 else
744 exit(-2);
745 return(haltret);
746 }
747 /*------------------------------------------------------------------*/
setinterrupt(flg)748 PUBLIC void setinterrupt(flg)
749 int flg;
750 {
751 Unterbrech = flg;
752 }
753 /*------------------------------------------------------------------*/
754 #ifdef DOSorUNiX
ctrlcreset(sig)755 PUBLIC void ctrlcreset(sig)
756 int sig;
757 {
758 signal(sig,SIG_IGN);
759 #ifdef UNiXorGCC
760 setinterrupt(1);
761 signal(SIGINT,ctrlcreset);
762 #else
763 resetcleanup("interrupted by CTRL-C");
764 signal(SIGINT,ctrlcreset);
765 if(setjumpflg)
766 longjmp(globenv,RESET);
767 else
768 exit(-2);
769 #endif /* ?genUNiX */
770 }
771 #endif /* DOSorUNiX */
772 /*------------------------------------------------------------------*/
resetcleanup(message)773 PRIVATE void resetcleanup(message)
774 char *message;
775 {
776 *brkbindPtr = zero;
777 resetarr();
778 clearcompile();
779 historyout(0);
780 fnewline(tstderr);
781 fprintline(tstderr,message);
782 fprintline(tstderr,"** RESET **");
783 }
784 /*------------------------------------------------------------------*/
reset(message)785 PUBLIC void reset(message)
786 char *message;
787 {
788 resetcleanup(message);
789 if(setjumpflg)
790 longjmp(globenv,RESET);
791 else
792 exit(-2);
793 }
794 /*------------------------------------------------------------------*/
faterr(mess)795 PUBLIC void faterr(mess)
796 char *mess;
797 {
798 fputs("\n FATAL ERROR: ",stderr);
799 fputs(mess,stderr);
800 fputs("\n",stderr);
801 exit(aERROR);
802 }
803 /*------------------------------------------------------------------*/
804 /********************************************************************/
805 /*
806 ** Text for help introduction
807 */
808 static char *help1txt[] = {
809 "The simplest way to use ARIBAS is as a calculator for big integer arithmetic",
810 "\t+, -, *\t have the usual meaning",
811 "\t**\t denotes exponentiation",
812 "\tdiv, mod calculate the quotient resp. remainder of integer division",
813 "\t/\t denotes floating point division",
814 "Simply enter the expression you want to calculate at the ARIBAS prompt ==>",
815 "followed by a full stop, for example",
816 "\t==> (23*57 - 13) div 7.",
817 "After pressing RETURN, the result (here 185) will appear.",
818 "You can also assign the result of a calculation to a variable, as in",
819 "\tp := 2**127 - 1.",
820 "and later use this variable, for example",
821 "\tx := 1234**(p-1) mod p.",
822 "The three most recent results are stored in the pseudo variables",
823 "_, __, and ___. Suppose you have calculated",
824 "\t==> sqrt(2).",
825 "\t-: 1.41421356",
826 "Then you can use the result at the next prompt for example in the",
827 "expression arcsin(_/2).",
828 "IMPORTANT: To mark the end of your input, you must type a full stop '.'",
829 "\t and then press the RETURN (ENTER) key.\n",
830 NULL};
831 /*------------------------------------------------------------------*/
832 static char *help2txt[] = {
833 "The for loop and while loop in ARIBAS have a syntax similar to",
834 "MODULA-2. For example, the sequence",
835 "\tx := 1;",
836 "\tfor i := 2 to 100 do",
837 "\t x := x*i;",
838 "\tend;",
839 "\tx.",
840 "calculates the factorial of 100.",
841 "You can define your own functions in ARIBAS. For example, a recursive",
842 "version of the factorial function can be defined by",
843 "\tfunction fac(n: integer): integer;",
844 "\tbegin",
845 "\t if n <= 1 then",
846 "\t\treturn 1;",
847 "\t else",
848 "\t\treturn n*fac(n-1);",
849 "\t end;",
850 "\tend.",
851 "After you have entered this, the function fac will be at your disposal and",
852 "\t==> fac(100).",
853 "will calculate the factorial of 100.\n",
854 NULL};
855 /*------------------------------------------------------------------*/
856 static char *help3txt[] = {
857 "A list of all keywords and names of builtin functions is returned",
858 "by the command\n",
859 "\t==> symbols(aribas).\n",
860 "For most of the symbols in this list, you can get a short online",
861 "help using the help function. For example\n",
862 "\t==> help(factor16).\n",
863 "will print an information on the function factor16 to the screen.\n",
864 "For more information, read the documentation.\n",
865 "To leave ARIBAS, type\040\040exit",
866 NULL};
867 /*------------------------------------------------------------------*/
Shelp()868 PRIVATE truc Shelp()
869 {
870 truc *ptr;
871 char *topic;
872 int argn;
873
874 argn = *ARGCOUNTPTR(evalStkPtr);
875 if(argn >= 1) {
876 ptr = ARG1PTR(evalStkPtr);
877 if(*FLAGPTR(ptr) == fSYMBOL) {
878 topic = SYMNAMEPTR(ptr);
879 helptopic(topic);
880 return(voidsym);
881 }
882 }
883 helpintro();
884 return(voidsym);
885 }
886 /*------------------------------------------------------------------*/
helpintro()887 PRIVATE int helpintro()
888 {
889 static char *gotonext = "Press RETURN to see the next help screen.";
890
891 displaypage(help1txt);
892 fnewline(tstdout);
893 fprintstr(tstdout,gotonext); fflush(stdout);
894 getchar();
895
896 displaypage(help2txt);
897 fnewline(tstdout);
898 fprintstr(tstdout,gotonext); fflush(stdout);
899 getchar();
900
901 displaypage(help3txt);
902 return(0);
903 }
904 /*------------------------------------------------------------------*/
displaypage(txtarr)905 PRIVATE void displaypage(txtarr)
906 char *txtarr[];
907 {
908 char *str;
909 int i = 0;
910
911 while((str = txtarr[i]) != NULL) {
912 fnewline(tstdout);
913 fprintstr(tstdout,str);
914 i++;
915 }
916 }
917 /*------------------------------------------------------------------*/
918 #define TOPICMARKER '?'
919 #define TOPICEND '#'
920 #define PAGEFULL 25
921
helptopic(topic)922 PRIVATE int helptopic(topic)
923 char *topic;
924 {
925 FILE *hfile;
926 char *path;
927 int i, len;
928 int found = 0;
929
930 path = SYMname(hlpfilsym);
931 hfile = fopen(path,"r");
932 if(hfile == NULL) {
933 error(helpsym,err_open,scratch(path));
934 return(aERROR);
935 }
936 len = strlen(topic);
937 while(fgets(OutBuf,IOBUFSIZE,hfile)) {
938 if(OutBuf[0] == TOPICMARKER &&
939 strncmp(OutBuf+1,topic,len) == 0 &&
940 OutBuf[len+1] <= ' ') {
941 found = 1;
942 break;
943 }
944 }
945 if(found) {
946 while(fgets(OutBuf,IOBUFSIZE,hfile) &&
947 OutBuf[0] == TOPICMARKER)
948 ;
949 fprintstr(tstdout,OutBuf);
950 for(i=0; i<PAGEFULL; i++) {
951 if(!fgets(OutBuf,IOBUFSIZE,hfile) ||
952 OutBuf[0] == TOPICEND)
953 break;
954 fprintstr(tstdout,OutBuf);
955 }
956 }
957 else {
958 s1form(OutBuf,"no help available for ~A",(wtruc)topic);
959 fprintline(tstdout,OutBuf);
960 }
961 fclose(hfile);
962 return(0);
963 }
964 /********************************************************************/
965
966
967
968
969
970