/*****************************************************************************\
* *
* 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 <signal.h>
#include <stdio.h>
#ifdef SYSV
#include <sys/types.h>
#endif /* SYSV */
#include <sys/file.h>
#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);
}
syntax highlighted by Code2HTML, v. 0.9.1