/*****************************************************************************\ * * * MAIN.C * * * * Exemple of an application built with klone: * * "klone" a small command-line interface to klone, * * a toplevel read/eval/print loop * * * \*****************************************************************************/ char *usage = "\n\ klone = interactive, pool, prompt, profile\n\ klone - = same (for no args under gdb)\n\ klone t = run tests in tests/test.kl nopool, noprompt, noprofile\n\ klone T = run tests in kl/t.kl nopool, nprompt, noprofile\n\ klone s = silent, pool, noprompt, profile\n\ klone r = no built-in inits, pool, prompt, profile\n\ klone p = no profile reading\n\ klone q = quiet, raw read of stdin as in file mode (no prompts)\n\ klone file = raw, do not use klone_pool & reads from file\n\ "; #ifndef KLONE_EXTENSIONS #define KLONE_EXTENSIONS #endif #ifndef KLONE_ADDINIT #define KLONE_ADDINIT #endif #define KlPROFILE_USER_VARIABLE "KLONEPROFILE" #define KlPATH_SHELL_VARIABLE "KLONEPATH" #ifndef KLPATH #ifndef AMIGA #define KLPATH ".:kl:../klone/kl" #else #define KLPATH ":kl:/klone" #endif #endif #include #include #ifdef SYSV #include #endif /* SYSV */ #include #ifdef c_plus_plus extern "C" { #endif #include "EXTERN.h" #include "klone.h" #include "kl_atom.h" #include "kl_coll.h" #include "kl_func.h" #include "kl_list.h" #include "kl_number.h" #include "kl_string.h" #include "kl_stream.h" #ifdef c_plus_plus } #endif #include "klone-ic.h" DECLARE_strchr; int noisy = 1; char *input_file = 0; int use_pool = 1; int use_built_in = 1; int script = 0; int KlArgc; char **KlArgv; int toplevel(); int KlPoolToplevel(); main_init() { KlActivePointerToIntMake("stack-level", &KlStackPtr); /* * execution the built-in klone code. made here to be done before the user * profile is read */ if (use_built_in) KlExecuteStringNoReturn(KlStartupCode); /* make klone list of args */ KlDeclareCommandLineArguments(KlArgc, KlArgv); } int toplevel(); main(argc, argv) int argc; char *argv[]; { char *s; extern char *KlFixPath(); KlO result; int normal; int (*toplevel_evaluator)(); #ifdef MONITOR moncontrol(0); /* do not trace inits */ #endif /* MONITOR */ KlMallocInit(); KlUserProfileName = ".klonerc"; KlTextExtension = ".kl"; KlApplicationName = "klone"; /* primitive option parsing */ if (argc > 1) { noisy = 0; if (!strcmp(argv[1], "-")) { noisy = 1; } else if (!strcmp(argv[1], "t")) { KlUserProfileName = 0; input_file = "tests/test.kl"; use_pool = 0; } else if (!strcmp(argv[1], "T")) { KlUserProfileName = 0; input_file = "kl/t.kl"; use_pool = 0; } else if (!strcmp(argv[1], "s")) { ; #ifdef MLEAK } else if (!strcmp(argv[1], "-ms") && argv[2]) { /* malloc stop */ extern int MLEAK_num; MLEAK_num = atoi(argv[2]); noisy = 1; #endif } else if (!strcmp(argv[1], "r")) { noisy = 1; use_built_in = 0; use_pool = 0; } else if (!strcmp(argv[1], "p")) { KlUserProfileName = 0; } else if (!strcmp(argv[1], "-?")) { puts(usage); exit(1); } else { input_file = strcmp(argv[1], "q") ? argv[1] : 0; script = 1; KlUserProfileName = 0; use_pool = 0; } } /* initialize paths (put .:$HOME before built-ins) */ KlPath = KLPATH; if ((s = (char *) getenv(KlPROFILE_USER_VARIABLE)) && (s[0] != '\0')) KlUserProfileName = s; if ((s = (char *) getenv(KlPATH_SHELL_VARIABLE)) && (s[0] != '\0')) KlPath = s; /* set up command line arguments */ KlArgc = argc - script; KlArgv = argv + script; /* first, initialize klone */ KlDeclareExtension("main", 0, 0, main_init); KLONE_EXTENSIONS; /* inserted at compile-time */ KlInit(); KLONE_ADDINIT; /* inserted at compile-time */ /* print version number */ if (noisy) KlPrintBanner(); /* handle the special case of a script given as argument */ if (input_file) { FILE *fd; if (fd = fopen(input_file, "r")) { KlStdyyRedirect(KlStreamMake(fd, 1, input_file)); } else { fprintf(stderr, "Cannot open %s\n", input_file); exit(1); } } /* define a catch-all point */ KlSetNonCaughtErrorPoint(1); /* = 0 for set */ /* check if we closed stdout. in this case, abort */ if (noisy && !KlStdout->direction) KlExit(0); if (use_pool) toplevel_evaluator = KlPoolToplevel; /* normal mainloop */ else toplevel_evaluator = toplevel; #ifdef KLPROFILER { char *dsm = (char *) getenv("DONT_START_MONCONTROL"); if (!dsm || *dsm == '\0') { KlMonControlled = 1; moncontrol(1); /* starts monitor after inits */ } } #endif for (;;) { KlCatch(KlA_ERROR, CFAPPLY(toplevel_evaluator, ()), result, normal); /* aborts if error in scripts */ if (script && !KlContinueReadingOnError) KlExit(1); /* check if we closed stdout. in this case, abort */ if (noisy && !KlStdout->direction) KlExit(0); } } /* simplified mainloop for some tests without any processing overhead * normal apps should use KlPoolToplevel instead */ int toplevel() { /* main routine: read/eval/print */ KlGCMark(); KlO PreviousExpr, result; if (!KlRead()) goto end_empty; PreviousExpr = KlReadExpr; while (KlRead()) { if (KlReadExpr == (KlO) KlA_equal && KlInfixAssigns) { /* x = y, create assign */ if (!(KlRead())) /* x = EOF */ goto end; PreviousExpr = (KlO)KlAssignMake(PreviousExpr, KlReadExpr); } else { /* normal */ if ((result = KlSend_eval(PreviousExpr)) && noisy) { KlPuts(" = "); KlToplevelPrint(result); KlPutchar('\n'); KlFlush(0); } PreviousExpr = KlReadExpr; } } end: if ((result = KlSend_eval(PreviousExpr)) && noisy) { KlPuts(" = "); KlToplevelPrint(result); KlPutchar('\n'); KlFlush(0); } end_empty: KlGC(); KlExit(0); } KlPrintBanner() { printf("KLONE toplevel %s\n", KlVersionNumber); }