/* This is a simple demo program for the S-Lang interpreter. It would * take very little work to make this demo *really* useful. */ #include #include #ifndef NO_STDLIB_H #include #endif #include "slang.h" int Read_Only_Array [100]; int Writable_Array [100]; FLOAT XXX; void help() { puts("ALL statements MUST be terminated with a ';' character, e.g., quit();\n"); puts("Available functions:"); puts(" cos, sin, tan, atan, acos, asin, exp, log, sqrt, fabs, log10, pow, PI, E"); puts(" print -- prints string, e.g. print(\"hello world!\\n\");"); puts("\nas well as intrinsic S-Lang functions."); puts("See S-Lang language documentation for further details.\n"); SLang_run_hooks ("calc_help", NULL, NULL); } /* The following three functions will be callable from the interpreter */ void quit_calc() { SLang_reset_tty (); exit(0); } void print(char *s) { fputs(s, stdout); } void error(char *s) { fprintf(stderr, "%s\n", s); SLang_Error = 1; } /* Now here is a table that provides the link between the above functions and the S-Lang interpreter */ SLang_Name_Type Calc_Intrinsics[] = { MAKE_INTRINSIC(".print", print, VOID_TYPE, 1), MAKE_INTRINSIC(".quit", quit_calc, VOID_TYPE, 0), MAKE_INTRINSIC(".help", help, VOID_TYPE, 0), MAKE_INTRINSIC(".error", error, VOID_TYPE, 1), MAKE_VARIABLE(".XXX", &XXX, FLOAT_TYPE, 0), SLANG_END_TABLE }; #ifdef unix #define EOF_CHAR 4 #else #define EOF_CHAR 26 #endif int test (int argc, SLcmd_Cmd_Table_Type *table) { fprintf (stdout, "f = %s, argc = %d\n", table->string_args[0], argc); switch (argc) { default: fprintf(stdout, "Argc out of range!\n"); return -1; case 4: fprintf (stdout, "arg[%d] = %f\n", argc, table->float_args[argc - 1]); argc--; case 3: fprintf (stdout, "arg[%d] = %d\n", argc, table->int_args[argc - 1]); argc--; case 2: fprintf (stdout, "arg[%d] = %s\n", argc, table->string_args[argc - 1]); argc--; case 1: break; } return 0; } SLcmd_Cmd_Type Cmd_Table[] = { {test, "test0", ""}, {test, "test1", "S"}, {test, "test2", "SI"}, {test, "test3", "SIF"}, {NULL, "", ""} }; SLcmd_Cmd_Table_Type The_Cmd_Table; static SLang_RLine_Info_Type *init_readline (void); int main (int argc, char **argv) { SLang_RLine_Info_Type *rli; int nread; char *status; if (!init_SLang() /* basic interpreter functions */ || !init_SLmath() /* sin, cos, etc... */ #ifdef unix || !init_SLunix() #endif || !init_SLfiles() /* file i/o */ /* || !init_SLmatrix() */ /* matrix manipluation */ || !SLang_add_table(Calc_Intrinsics, "Calc")) /* calc specifics */ { fprintf(stderr, "Unable to initialize S-Lang.\n"); exit(1); } if ((-1 == SLang_add_array ("Read_only_array", (long *) Read_Only_Array, 1, 100, 0, 0, 'i', LANG_RVARIABLE)) || (-1 == SLang_add_array ("Writable_array", (long *) Writable_Array, 1, 100, 0, 0, 'i', LANG_IVARIABLE))) { fprintf(stderr, "Failed to add arrays\n"); exit (-1); } rli = init_readline (); if (SLang_init_tty (7, 0, 1)) { fprintf(stderr, "Unable to initialize tty."); exit (-1); } SLang_set_abort_signal (NULL); SLang_Traceback = 1; SLang_load_file("calc.sl"); while (--argc && !SLang_Error) { argv++; SLang_load_file (*argv); } fputs("Type 'help();' for help and a list of available functions.\n", stdout); fputs("Note also that statements end in a ';'\n", stdout); fputs("\nIt is also important to note that most binary operators +, -, *, /,\n", stdout); fputs("as well as the '=' sign must be surrounded by spaces!\n", stdout); The_Cmd_Table.table = Cmd_Table; while(1) { if (SLang_Error) SLang_restart(1); SLKeyBoard_Quit = SLang_Error = 0; nread = SLang_read_line (rli); putc('\n', stdout); if (nread > 0) { if ((nread == 1) && (*rli->buf == EOF_CHAR)) break; if (*rli->buf == '@') { status = NULL; (void) SLcmd_execute_string ((char *) rli->buf + 1, &The_Cmd_Table); } else status = SLang_load_string ((char *) rli->buf); if (SLang_Error == 0) { SLang_rline_save_line (rli); *rli->buf = 0; } else { if (status == NULL) rli->point = 0; else rli->point = (int) (status - (char *) rli->buf); } } } SLang_reset_tty (); return (SLang_Error); } static SLang_RLine_Info_Type *init_readline (void) { SLang_RLine_Info_Type *rli; unsigned char *buf = NULL; if ((NULL == (rli = (SLang_RLine_Info_Type *) MALLOC (sizeof(SLang_RLine_Info_Type)))) || (NULL == (buf = (unsigned char *) MALLOC (256)))) { fprintf(stderr, "malloc error.\n"); exit(-1); } MEMSET ((char *) rli, 0, sizeof (SLang_RLine_Info_Type)); rli->buf = buf; rli->buf_len = 255; rli->tab = 8; rli->edit_width = 79; rli->dhscroll = 20; rli->prompt = "Calc> "; rli->getkey = SLang_getkey; #if !defined(__GO32__) && !defined(msdos) rli->flags = SLRL_USE_ANSI; #endif SLang_init_readline (rli); return rli; }