Annotation of OpenXM_contrib2/asir2000/parse/asir_sm.c, Revision 1.1
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/parse/asir_sm.c,v 1.1.1.1 1999/11/10 08:12:34 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "parse.h"
! 4: #if defined(THINK_C)
! 5: #include <console.h>
! 6: #endif
! 7:
! 8: #if PARI
! 9: #include "genpari.h"
! 10:
! 11: extern jmp_buf environnement;
! 12: #endif
! 13:
! 14: extern jmp_buf env;
! 15: extern int *StackBottom;
! 16: extern int ox_do_copy, ox_do_count, ox_count_length;
! 17: extern char *ox_copy_bptr;
! 18:
! 19: Obj Asir_OperandStack[BUFSIZ];
! 20: char *Asir_DebugStack[BUFSIZ];
! 21: int Asir_OperandStackPtr;
! 22: int Asir_DebugStackPtr;
! 23:
! 24: Asir_Start()
! 25: {
! 26: int tmp;
! 27: FILE *ifp;
! 28: char ifname[BUFSIZ];
! 29: extern int GC_dont_gc;
! 30: extern int read_exec_file;
! 31: extern int do_asirrc;
! 32: char *getenv();
! 33: static ox_asir_initialized = 0;
! 34:
! 35: asir_save_handler();
! 36: if ( ox_asir_initialized )
! 37: return;
! 38: ox_asir_initialized = 1;
! 39: ox_do_copy = 1;
! 40: #if defined(THINK_C)
! 41: param_init();
! 42: #endif
! 43: StackBottom = &tmp + 1; /* XXX */
! 44: rtime_init();
! 45: env_init();
! 46: endian_init();
! 47: #if !defined(TOWNS) && !defined(THINK_C)
! 48: /* check_key(); */
! 49: #endif
! 50: #if defined(TOWNS) && !defined(GO32) && !defined(__WIN32__)
! 51: disable_ctrl_c();
! 52: #endif
! 53: GC_init();
! 54: /* process_args(argc,argv); */
! 55: #if 0
! 56: copyright();
! 57: #endif
! 58: output_init();
! 59: arf_init();
! 60: nglob_init();
! 61: glob_init();
! 62: sig_init();
! 63: tty_init();
! 64: debug_init();
! 65: pf_init();
! 66: sysf_init();
! 67: parif_init();
! 68: #if defined(UINIT)
! 69: reg_sysf();
! 70: #endif
! 71: #if defined(THINK_C) || defined(TOWNS)
! 72: sprintf(ifname,"asirrc");
! 73: #else
! 74: sprintf(ifname,"%s/.asirrc",getenv("HOME"));
! 75: #endif
! 76: asir_set_handler();
! 77: if ( do_asirrc && (ifp = fopen(ifname,"r")) ) {
! 78: input_init(ifp,ifname);
! 79: if ( !setjmp(env) ) {
! 80: read_exec_file = 1;
! 81: read_eval_loop();
! 82: }
! 83: fclose(ifp);
! 84: }
! 85: asir_reset_handler();
! 86: input_init(0,"string");
! 87: Asir_OperandStackPtr = Asir_DebugStackPtr = -1;
! 88: }
! 89:
! 90: char *Asir_PopBinary();
! 91: char *Asir_PopString();
! 92: Obj asir_pop_obj();
! 93:
! 94: extern char *parse_strp;
! 95: extern int ox_do_copy;
! 96:
! 97: int Asir_ExecuteString(s)
! 98: char *s;
! 99: {
! 100: SNODE snode;
! 101: pointer val;
! 102: #if PARI
! 103: static long tloc,listloc;
! 104: extern long avloc;
! 105:
! 106: Asir_Start();
! 107: asir_set_handler();
! 108: avloc = avma; tloc = tglobal; listloc = marklist();
! 109: if ( setjmp(environnement) ) {
! 110: avma = avloc; tglobal = tloc; recover(listloc);
! 111: resetenv("");
! 112: }
! 113: #endif
! 114: if ( setjmp(env) ) {
! 115: asir_reset_handler();
! 116: return -1;
! 117: }
! 118: parse_strp = s;
! 119: if ( mainparse(&snode) ) {
! 120: asir_reset_handler();
! 121: return -1;
! 122: }
! 123: val = evalstat(snode);
! 124: if ( NEXT(asir_infile) ) {
! 125: while ( NEXT(asir_infile) ) {
! 126: if ( mainparse(&snode) ) {
! 127: asir_push_obj(val);
! 128: asir_reset_handler();
! 129: return -1;
! 130: }
! 131: nextbp = 0;
! 132: val = evalstat(snode);
! 133: }
! 134: }
! 135: asir_push_obj(val);
! 136: asir_reset_handler();
! 137: return 0;
! 138: }
! 139:
! 140: char *Asir_PopString()
! 141: {
! 142: Obj val;
! 143: char *buf,*obuf;
! 144: int l;
! 145:
! 146: Asir_Start();
! 147: val = asir_pop_obj();
! 148: if ( !val )
! 149: return 0;
! 150: else {
! 151: l = estimate_length(CO,val);
! 152: buf = (char *)ALLOCA(l+1);
! 153: soutput_init(buf);
! 154: sprintexpr(CO,val);
! 155: l = strlen(buf);
! 156: obuf = (char *)GC_malloc(l+1);
! 157: strcpy(obuf,buf);
! 158: return obuf;
! 159: }
! 160: }
! 161:
! 162: int Asir_Set(name)
! 163: char *name;
! 164: {
! 165: int l,n;
! 166: char *dummy = "=0;";
! 167: SNODE snode;
! 168:
! 169: Asir_Start();
! 170: l = strlen(name);
! 171: n = l+strlen(dummy)+1;
! 172: parse_strp = (char *)ALLOCA(n);
! 173: sprintf(parse_strp,"%s%s",name,dummy);
! 174: if ( mainparse(&snode) )
! 175: return -1;
! 176: FA1((FNODE)FA0(snode)) = (pointer)mkfnode(1,I_FORMULA,asir_pop_obj());
! 177: evalstat(snode);
! 178: return 0;
! 179: }
! 180:
! 181: int Asir_PushBinary(size,data)
! 182: int size;
! 183: char *data;
! 184: {
! 185: Obj val;
! 186:
! 187: Asir_Start();
! 188: ox_copy_bptr = data;
! 189: loadvl(0);
! 190: loadobj(0,&val);
! 191: asir_push_obj(val);
! 192: ox_copy_bptr = 0;
! 193: }
! 194:
! 195: char *Asir_PopBinary(size)
! 196: int *size;
! 197: {
! 198: Obj val;
! 199: char *buf;
! 200: VL vl,t;
! 201:
! 202: Asir_Start();
! 203: val = asir_pop_obj();
! 204: get_vars(val,&vl);
! 205: for ( t = vl; t; t = NEXT(t) )
! 206: if ( t->v->attr == (pointer)V_UC || t->v->attr == (pointer)V_PF )
! 207: error("bsave : not implemented");
! 208: ox_count_length = 0; ox_do_count = 1;
! 209: savevl(0,vl);
! 210: saveobj(0,val);
! 211: *size = ox_count_length;
! 212: ox_count_length = 0; ox_do_count = 0;
! 213: ox_copy_bptr = buf = (char *)GC_malloc(*size);
! 214: savevl(0,vl);
! 215: saveobj(0,val);
! 216: ox_copy_bptr = 0;
! 217: return buf;
! 218: }
! 219:
! 220: asir_push_obj(obj)
! 221: Obj obj;
! 222: {
! 223: Asir_OperandStack[++Asir_OperandStackPtr] = obj;
! 224: }
! 225:
! 226: Obj asir_pop_obj() {
! 227: if ( Asir_OperandStackPtr < 0 )
! 228: return 0;
! 229: else
! 230: return Asir_OperandStack[Asir_OperandStackPtr--];
! 231: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>