#include #include #include #include "apl9.h" Datum *getquad(void); int setquad(Datum); Datum *getio(void); int setio(Datum); Datum *getpp(void); int setpp(Datum); Array *runfile(Array *); QuadnameDef quadnames[] = { {L"⎕", NameTag, getquad, setquad, nil, nil}, {L"⎕IO", NameTag, getio, setio, nil, nil}, {L"⎕PP", NameTag, getpp, setpp, nil, nil}, {L"⎕RUN", FunctionTag, nil, nil, runfile, nil}, {nil, 0, nil, nil, nil, nil} /* MUST BE LAST */ }; Datum quadnamedatum(QuadnameDef q) { Datum d; d.tag = q.tag; switch(q.tag){ case NameTag: d.symbol = getsym(currentsymtab, q.name); d.symbol->getfn = q.get; d.symbol->setfn = q.set; d.symbol->undefined = 0; break; case FunctionTag: d.func.type = FunctypeQuad; d.func.quad = malloc(sizeof(QuadnameDef)); *d.func.quad = q; d.func.left = nil; break; case MonadicOpTag: case DyadicOpTag: default: print("Can't use quad names with type=%d\n", q.tag); exits("quadname"); } return d; } /* ⎕ */ Datum * getquad(void) { Rune *input = prompt(L"⎕:\n\t"); Datum *result = evalline(input, 1); /* TODO check that the expression doesn't fail */ return result; } int setquad(Datum new) { print("%S\n", ppdatum(new)); return 1; } /* ⎕IO */ Datum * getio(void) { Datum *d = mallocz(sizeof(Datum), 1); d->tag = ArrayTag; d->array = mkscalarint(currentsymtab->io); return d; } int setio(Datum new) { if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || (new.array->intdata[0] != 0 && new.array->intdata[0] != 1)){ print("⎕IO: domain error\n"); return 0; }else{ currentsymtab->io = new.array->intdata[0]; return 1; } } /* ⎕PP */ Datum * getpp(void) { Datum *d = mallocz(sizeof(Datum), 1); d->tag = ArrayTag; d->array = mkscalarint(printprecision); return d; } int setpp(Datum new) { if(new.tag != ArrayTag || new.array->rank != 0 || new.array->type != AtypeInt || new.array->intdata[0] < 0){ print("⎕PP: domain error\n"); return 0; }else{ printprecision = new.array->intdata[0]; return 1; } } /* ⎕RUN */ Array * runfile(Array *a) { print("Loading file %S\n", pparray(a)); if(a->type != AtypeRune || a->rank > 1){ return mkscalarint(0); } char *filename = smprint("%S", pparray(a)); Biobuf *bio = Bopen(filename, OREAD); if(bio == nil) return mkscalarint(0); char *charcode = Brdstr(bio, Beof, 1); Rune *code = runesmprint("%s", charcode); evalline(code, 1); free(charcode); free(code); Bterm(bio); return mkscalarint(1); }