pico.h (19190B)
1 /* 31jul13abu 2 * (c) Software Lab. Alexander Burger 3 */ 4 5 #include <stdio.h> 6 #include <stdint.h> 7 #include <stdlib.h> 8 #include <stdarg.h> 9 #include <unistd.h> 10 #include <limits.h> 11 #include <ctype.h> 12 #include <string.h> 13 #include <math.h> 14 #include <errno.h> 15 #include <fcntl.h> 16 #include <dirent.h> 17 #include <termios.h> 18 #include <setjmp.h> 19 #include <signal.h> 20 #include <dlfcn.h> 21 #include <time.h> 22 #include <sys/types.h> 23 #include <sys/time.h> 24 #include <sys/times.h> 25 #include <sys/stat.h> 26 #include <sys/resource.h> 27 #ifndef NOWAIT 28 #include <sys/wait.h> // tcc doen't like it 29 #endif 30 31 #ifndef __CYGWIN__ 32 #define MAIN main 33 #else 34 #define MAIN main2 35 #endif 36 37 #define WORD ((int)sizeof(long)) 38 #define BITS (8*WORD) 39 #define MASK ((word)-1) 40 #define CELLS (1024*1024/sizeof(cell)) // Heap allocation unit 1MB 41 #define IHASH 4999 // Internal hash table size (should be prime) 42 #define EHASH 49999 // External hash table size (should be prime) 43 #define TOP 0x10000 // Character Top 44 45 typedef unsigned long word; 46 typedef unsigned char byte; 47 typedef unsigned char *ptr; 48 typedef unsigned long long word2; 49 typedef long long adr; 50 51 #undef bool 52 typedef enum {NO,YES} bool; 53 54 typedef struct cell { // PicoLisp primary data type 55 struct cell *car; 56 struct cell *cdr; 57 } cell, *any; 58 59 typedef any (*fun)(any); 60 61 typedef struct heap { 62 cell cells[CELLS]; 63 struct heap *next; 64 } heap; 65 66 typedef struct child { 67 pid_t pid; 68 int hear, tell; 69 int ofs, cnt; 70 byte *buf; 71 } child; 72 73 typedef struct bindFrame { 74 struct bindFrame *link; 75 int i, cnt; 76 struct {any sym; any val;} bnd[1]; 77 } bindFrame; 78 79 typedef struct inFile { 80 int fd, ix, cnt, next; 81 int line, src; 82 char *name; 83 byte buf[BUFSIZ]; 84 } inFile; 85 86 typedef struct outFile { 87 int fd, ix; 88 bool tty; 89 byte buf[BUFSIZ]; 90 } outFile; 91 92 typedef struct inFrame { 93 struct inFrame *link; 94 void (*get)(void); 95 pid_t pid; 96 int fd; 97 } inFrame; 98 99 typedef struct outFrame { 100 struct outFrame *link; 101 void (*put)(int); 102 pid_t pid; 103 int fd; 104 } outFrame; 105 106 typedef struct errFrame { 107 struct errFrame *link; 108 int fd; 109 } errFrame; 110 111 typedef struct ctlFrame { 112 struct ctlFrame *link; 113 int fd; 114 } ctlFrame; 115 116 typedef struct parseFrame { 117 any name; 118 word dig, eof; 119 } parseFrame; 120 121 typedef struct stkEnv { 122 cell *stack, *arg; 123 bindFrame *bind; 124 int next, protect, trace; 125 any cls, key, task, *make, *yoke; 126 inFrame *inFrames; 127 outFrame *outFrames; 128 errFrame *errFrames; 129 ctlFrame *ctlFrames; 130 parseFrame *parser; 131 void (*get)(void); 132 void (*put)(int); 133 } stkEnv; 134 135 typedef struct catchFrame { 136 struct catchFrame *link; 137 any tag, fin; 138 stkEnv env; 139 jmp_buf rst; 140 } catchFrame; 141 142 /*** Macros ***/ 143 #define Free(p) ((p)->car=Avail, Avail=(p)) 144 #define cellPtr(x) ((any)((word)(x) & ~(2*WORD-1))) 145 146 /* Number access */ 147 #define num(x) ((word)(x)) 148 #define numPtr(x) ((any)(num(x)+(WORD/2))) 149 #define numCell(n) ((any)(num(n)-(WORD/2))) 150 #define box(n) (consNum(n,Nil)) 151 #define unDig(x) num(car(numCell(x))) 152 #define setDig(x,v) (car(numCell(x))=(any)(v)) 153 #define isNeg(x) (unDig(x) & 1) 154 #define pos(x) (car(numCell(x)) = (any)(unDig(x) & ~1)) 155 #define neg(x) (car(numCell(x)) = (any)(unDig(x) ^ 1)) 156 #define lo(w) num((w)&MASK) 157 #define hi(w) num((w)>>BITS) 158 159 /* Symbol access */ 160 #define symPtr(x) ((any)&(x)->cdr) 161 #define val(x) ((x)->car) 162 #define tail(s) (((s)-1)->cdr) 163 #define tail1(s) ((any)(num(tail(s)) & ~1)) 164 #define Tail(s,v) (tail(s) = (any)(num(v) | num(tail(s)) & 1)) 165 #define ext(x) ((any)(num(x) | 1)) 166 #define mkExt(s) (*(word*)&tail(s) |= 1) 167 168 /* Cell access */ 169 #define car(x) ((x)->car) 170 #define cdr(x) ((x)->cdr) 171 #define caar(x) (car(car(x))) 172 #define cadr(x) (car(cdr(x))) 173 #define cdar(x) (cdr(car(x))) 174 #define cddr(x) (cdr(cdr(x))) 175 #define caaar(x) (car(car(car(x)))) 176 #define caadr(x) (car(car(cdr(x)))) 177 #define cadar(x) (car(cdr(car(x)))) 178 #define caddr(x) (car(cdr(cdr(x)))) 179 #define cdaar(x) (cdr(car(car(x)))) 180 #define cdadr(x) (cdr(car(cdr(x)))) 181 #define cddar(x) (cdr(cdr(car(x)))) 182 #define cdddr(x) (cdr(cdr(cdr(x)))) 183 #define caaaar(x) (car(car(car(car(x))))) 184 #define caaadr(x) (car(car(car(cdr(x))))) 185 #define caadar(x) (car(car(cdr(car(x))))) 186 #define caaddr(x) (car(car(cdr(cdr(x))))) 187 #define cadaar(x) (car(cdr(car(car(x))))) 188 #define cadadr(x) (car(cdr(car(cdr(x))))) 189 #define caddar(x) (car(cdr(cdr(car(x))))) 190 #define cadddr(x) (car(cdr(cdr(cdr(x))))) 191 #define cdaaar(x) (cdr(car(car(car(x))))) 192 #define cdaadr(x) (cdr(car(car(cdr(x))))) 193 #define cdadar(x) (cdr(car(cdr(car(x))))) 194 #define cdaddr(x) (cdr(car(cdr(cdr(x))))) 195 #define cddaar(x) (cdr(cdr(car(car(x))))) 196 #define cddadr(x) (cdr(cdr(car(cdr(x))))) 197 #define cdddar(x) (cdr(cdr(cdr(car(x))))) 198 #define cddddr(x) (cdr(cdr(cdr(cdr(x))))) 199 200 #define data(c) ((c).car) 201 #define Save(c) ((c).cdr=Env.stack, Env.stack=&(c)) 202 #define drop(c) (Env.stack=(c).cdr) 203 #define Push(c,x) (data(c)=(x), Save(c)) 204 #define Tuck(c1,c2,x) (data(c1)=(x), (c1).cdr=(c2).cdr, (c2).cdr=&(c1)) 205 #define Pop(c) (drop(c), data(c)) 206 207 #define Bind(s,f) ((f).i=0, (f).cnt=1, (f).bnd[0].sym=(s), (f).bnd[0].val=val(s), (f).link=Env.bind, Env.bind=&(f)) 208 #define Unbind(f) (val((f).bnd[0].sym)=(f).bnd[0].val, Env.bind=(f).link) 209 210 /* Predicates */ 211 #define isNil(x) ((x)==Nil) 212 #define isNum(x) (num(x)&(WORD/2)) 213 #define isSym(x) (num(x)&WORD) 214 #define isCell(x) (!(num(x)&(2*WORD-2))) 215 #define isExt(s) (num(tail(s))&1) 216 #define IsZero(n) (!unDig(n) && !isNum(cdr(numCell(n)))) 217 218 /* Evaluation */ 219 #define EVAL(x) (isNum(x)? x : isSym(x)? val(x) : evList(x)) 220 #define evSubr(f,x) (*(fun)unDig(f))(x) 221 222 /* Error checking */ 223 #define NeedNum(ex,x) if (!isNum(x)) numError(ex,x) 224 #define NeedCnt(ex,x) if (!isNum(x) || isNum(cdr(numCell(x)))) cntError(ex,x) 225 #define NeedSym(ex,x) if (!isSym(x)) symError(ex,x) 226 #define NeedExt(ex,x) if (!isSym(x) || !isExt(x)) extError(ex,x) 227 #define NeedPair(ex,x) if (!isCell(x)) pairError(ex,x) 228 #define NeedAtom(ex,x) if (isCell(x)) atomError(ex,x) 229 #define NeedLst(ex,x) if (!isCell(x) && !isNil(x)) lstError(ex,x) 230 #define NeedVar(ex,x) if (isNum(x)) varError(ex,x) 231 #define CheckNil(ex,x) if (isNil(x)) protError(ex,x) 232 #define CheckVar(ex,x) if ((x)>=Nil && (x)<=T) protError(ex,x) 233 234 /* External symbol access */ 235 #define Fetch(ex,x) if (isExt(x)) db(ex,x,1) 236 #define Touch(ex,x) if (isExt(x)) db(ex,x,2) 237 238 /* Globals */ 239 extern int Repl, Chr, Slot, Spkr, Mic, Hear, Tell, Children, ExtN; 240 extern char **AV, *AV0, *Home; 241 extern child *Child; 242 extern heap *Heaps; 243 extern cell *Avail; 244 extern stkEnv Env; 245 extern catchFrame *CatchPtr; 246 extern struct termios OrgTermio, *Termio; 247 extern int InFDs, OutFDs; 248 extern inFile *InFile, **InFiles; 249 extern outFile *OutFile, **OutFiles; 250 extern int (*getBin)(void); 251 extern void (*putBin)(int); 252 extern any TheKey, TheCls, Thrown; 253 extern any Alarm, Sigio, Line, Zero, One; 254 extern any Intern[IHASH], Transient[IHASH], Extern[EHASH]; 255 extern any ApplyArgs, ApplyBody, DbVal, DbTail; 256 extern any Nil, DB, Meth, Quote, T; 257 extern any Solo, PPid, Pid, At, At2, At3, This, Prompt, Dbg, Zap, Ext, Scl, Class; 258 extern any Run, Hup, Sig1, Sig2, Up, Err, Msg, Uni, Led, Tsm, Adr, Fork, Bye; 259 extern bool Break; 260 extern sig_atomic_t Signal[NSIG]; 261 262 /* Prototypes */ 263 void *alloc(void*,size_t); 264 any apply(any,any,bool,int,cell*); 265 void argError(any,any) __attribute__ ((noreturn)); 266 void atomError(any,any) __attribute__ ((noreturn)); 267 void begString(void); 268 void bigAdd(any,any); 269 int bigCompare(any,any); 270 any bigCopy(any); 271 void bigSub(any,any); 272 void binPrint(int,any); 273 any binRead(int); 274 int binSize(any); 275 adr blk64(any); 276 any boxChar(int,int*,any*); 277 any boxWord2(word2); 278 any brkLoad(any); 279 int bufSize(any); 280 void bufString(any,char*); 281 void bye(int) __attribute__ ((noreturn)); 282 void byteSym(int,int*,any*); 283 void pairError(any,any) __attribute__ ((noreturn)); 284 void charSym(int,int*,any*); 285 any circ(any); 286 void closeInFile(int); 287 void closeOnExec(any,int); 288 void closeOutFile(int); 289 void cntError(any,any) __attribute__ ((noreturn)); 290 int compare(any,any); 291 any cons(any,any); 292 any consNum(word,any); 293 any consStr(any); 294 any consSym(any,any); 295 void newline(void); 296 void ctOpen(any,any,ctlFrame*); 297 void db(any,any,int); 298 int dbSize(any,any); 299 void digAdd(any,word); 300 void digDiv2(any); 301 void digMul(any,word); 302 void digMul2(any); 303 void digSub1(any); 304 any doubleToNum(double); 305 unsigned long ehash(any); 306 any endString(void); 307 bool eol(void); 308 bool equal(any,any); 309 void erOpen(any,any,errFrame*); 310 void err(any,any,char*,...) __attribute__ ((noreturn)); 311 any evExpr(any,any); 312 long evCnt(any,any); 313 double evDouble(any,any); 314 any evList(any); 315 any evSym(any); 316 void execError(char*) __attribute__ ((noreturn)); 317 void extError(any,any) __attribute__ ((noreturn)); 318 any extOffs(int,any); 319 any findHash(any,any*); 320 int firstByte(any); 321 bool flush(outFile*); 322 void flushAll(void); 323 pid_t forkLisp(any); 324 any funq(any); 325 any get(any,any); 326 int getChar(void); 327 void getStdin(void); 328 void giveup(char*) __attribute__ ((noreturn)); 329 bool hashed(any,any); 330 void heapAlloc(void); 331 any idx(any,any,int); 332 unsigned long ihash(any); 333 inFile *initInFile(int,char*); 334 outFile *initOutFile(int); 335 void initSymbols(void); 336 any intern(char*); 337 bool isBlank(any); 338 bool isLife(any); 339 void lstError(any,any) __attribute__ ((noreturn)); 340 any load(any,int,any); 341 any loadAll(any); 342 any method(any); 343 any mkChar(int); 344 any mkDat(int,int,int); 345 any mkName(char*); 346 any mkStr(char*); 347 any mkTime(int,int,int); 348 any name(any); 349 any new64(adr,any); 350 any newId(any,int); 351 int nonblocking(int); 352 int numBytes(any); 353 void numError(any,any) __attribute__ ((noreturn)); 354 double numToDouble(any); 355 any numToSym(any,int,int,int); 356 void outName(any); 357 void outNum(any); 358 void outString(char*); 359 void outWord(word); 360 void pack(any,int*,any*,cell*); 361 int pathSize(any); 362 void pathString(any,char*); 363 void pipeError(any,char*); 364 void popCtlFiles(void); 365 void popInFiles(void); 366 void popErrFiles(void); 367 void popOutFiles(void); 368 void pr(int,any); 369 void prin(any); 370 void prin1(any); 371 void print(any); 372 void print1(any); 373 void prn(long); 374 void protError(any,any) __attribute__ ((noreturn)); 375 void pushCtlFiles(ctlFrame*); 376 void pushInFiles(inFrame*); 377 void pushErrFiles(errFrame*); 378 void pushOutFiles(outFrame*); 379 void put(any,any,any); 380 void putStdout(int); 381 void rdOpen(any,any,inFrame*); 382 any read1(int); 383 int rdBytes(int,byte*,int,bool); 384 int secondByte(any); 385 void setCooked(void); 386 void setRaw(void); 387 bool sharedLib(any); 388 void sighandler(any); 389 int slow(inFile*,bool); 390 void space(void); 391 bool subStr(any,any); 392 int symByte(any); 393 int symChar(any); 394 void symError(any,any) __attribute__ ((noreturn)); 395 any symToNum(any,int,int,int); 396 word2 unBoxWord2(any); 397 void undefined(any,any); 398 void unintern(any,any*); 399 void unwind (catchFrame*); 400 void varError(any,any) __attribute__ ((noreturn)); 401 long waitFd(any,int,long); 402 bool wrBytes(int,byte*,int); 403 void wrOpen(any,any,outFrame*); 404 long xCnt(any,any); 405 any xSym(any); 406 void zapZero(any); 407 408 any doAbs(any); 409 any doAccept(any); 410 any doAdd(any); 411 any doAdr(any); 412 any doAlarm(any); 413 any doAll(any); 414 any doAnd(any); 415 any doAny(any); 416 any doAppend(any); 417 any doApply(any); 418 any doArg(any); 419 any doArgs(any); 420 any doArgv(any); 421 any doArrow(any); 422 any doAsoq(any); 423 any doAs(any); 424 any doAssoc(any); 425 any doAt(any); 426 any doAtom(any); 427 any doBind(any); 428 any doBitAnd(any); 429 any doBitOr(any); 430 any doBitQ(any); 431 any doBitXor(any); 432 any doBool(any); 433 any doBox(any); 434 any doBoxQ(any); 435 any doBreak(any); 436 any doBy(any); 437 any doBye(any) __attribute__ ((noreturn)); 438 any doBytes(any); 439 any doCaaaar(any); 440 any doCaaadr(any); 441 any doCaaar(any); 442 any doCaadar(any); 443 any doCaaddr(any); 444 any doCaadr(any); 445 any doCaar(any); 446 any doCadaar(any); 447 any doCadadr(any); 448 any doCadar(any); 449 any doCaddar(any); 450 any doCadddr(any); 451 any doCaddr(any); 452 any doCadr(any); 453 any doCall(any); 454 any doCar(any); 455 any doCase(any); 456 any doCasq(any); 457 any doCatch(any); 458 any doCdaaar(any); 459 any doCdaadr(any); 460 any doCdaar(any); 461 any doCdadar(any); 462 any doCdaddr(any); 463 any doCdadr(any); 464 any doCd(any); 465 any doCdar(any); 466 any doCddaar(any); 467 any doCddadr(any); 468 any doCddar(any); 469 any doCdddar(any); 470 any doCddddr(any); 471 any doCdddr(any); 472 any doCddr(any); 473 any doCdr(any); 474 any doChain(any); 475 any doChar(any); 476 any doChop(any); 477 any doCirc(any); 478 any doCircQ(any); 479 any doClip(any); 480 any doClose(any); 481 any doCmd(any); 482 any doCnt(any); 483 any doCol(any); 484 any doCommit(any); 485 any doCon(any); 486 any doConc(any); 487 any doCond(any); 488 any doConnect(any); 489 any doCons(any); 490 any doCopy(any); 491 any doCtl(any); 492 any doCtty(any); 493 any doCut(any); 494 any doDate(any); 495 any doDbck(any); 496 any doDe(any); 497 any doDec(any); 498 any doDef(any); 499 any doDefault(any); 500 any doDel(any); 501 any doDelete(any); 502 any doDelq(any); 503 any doDiff(any); 504 any doDir(any); 505 any doDiv(any); 506 any doDm(any); 507 any doDo(any); 508 any doE(any); 509 any doEcho(any); 510 any doEnv(any); 511 any doEof(any); 512 any doEol(any); 513 any doEq(any); 514 any doEq0(any); 515 any doEqT(any); 516 any doEqual(any); 517 any doErr(any); 518 any doEval(any); 519 any doExt(any); 520 any doExtern(any); 521 any doExtQ(any); 522 any doExtra(any); 523 any doExtract(any); 524 any doFifo(any); 525 any doFile(any); 526 any doFill(any); 527 any doFilter(any); 528 any doFin(any); 529 any doFinally(any); 530 any doFind(any); 531 any doFish(any); 532 any doFlgQ(any); 533 any doFlip(any); 534 any doFlush(any); 535 any doFold(any); 536 any doFor(any); 537 any doFork(any); 538 any doFormat(any); 539 any doFree(any); 540 any doFrom(any); 541 any doFull(any); 542 any doFunQ(any); 543 any doGc(any); 544 any doGe(any); 545 any doGe0(any); 546 any doGet(any); 547 any doGetd(any); 548 any doGetl(any); 549 any doGlue(any); 550 any doGt(any); 551 any doGt0(any); 552 any doHash(any); 553 any doHead(any); 554 any doHeap(any); 555 any doHear(any); 556 any doHide(any); 557 any doHost(any); 558 any doId(any); 559 any doIdx(any); 560 any doIf(any); 561 any doIf2(any); 562 any doIfn(any); 563 any doIn(any); 564 any doInc(any); 565 any doIndex(any); 566 any doInfo(any); 567 any doIntern(any); 568 any doIpid(any); 569 any doIsa(any); 570 any doJob(any); 571 any doJournal(any); 572 any doKey(any); 573 any doKill(any); 574 any doLast(any); 575 any doLe(any); 576 any doLe0(any); 577 any doLength(any); 578 any doLet(any); 579 any doLetQ(any); 580 any doLieu(any); 581 any doLine(any); 582 any doLines(any); 583 any doLink(any); 584 any doList(any); 585 any doListen(any); 586 any doLit(any); 587 any doLstQ(any); 588 any doLoad(any); 589 any doLock(any); 590 any doLoop(any); 591 any doLowQ(any); 592 any doLowc(any); 593 any doLt(any); 594 any doLt0(any); 595 any doLup(any); 596 any doMade(any); 597 any doMake(any); 598 any doMap(any); 599 any doMapc(any); 600 any doMapcan(any); 601 any doMapcar(any); 602 any doMapcon(any); 603 any doMaplist(any); 604 any doMaps(any); 605 any doMark(any); 606 any doMatch(any); 607 any doMax(any); 608 any doMaxi(any); 609 any doMember(any); 610 any doMemq(any); 611 any doMeta(any); 612 any doMeth(any); 613 any doMethod(any); 614 any doMin(any); 615 any doMini(any); 616 any doMix(any); 617 any doMmeq(any); 618 any doMul(any); 619 any doMulDiv(any); 620 any doName(any); 621 any doNand(any); 622 any doNEq(any); 623 any doNEq0(any); 624 any doNEqT(any); 625 any doNEqual(any); 626 any doNeed(any); 627 any doNew(any); 628 any doNext(any); 629 any doNil(any); 630 any doNond(any); 631 any doNor(any); 632 any doNot(any); 633 any doNth(any); 634 any doNumQ(any); 635 any doOff(any); 636 any doOffset(any); 637 any doOn(any); 638 any doOne(any); 639 any doOnOff(any); 640 any doOpen(any); 641 any doOpid(any); 642 any doOpt(any); 643 any doOr(any); 644 any doOut(any); 645 any doPack(any); 646 any doPair(any); 647 any doPass(any); 648 any doPath(any); 649 any doPatQ(any); 650 any doPeek(any); 651 any doPick(any); 652 any doPipe(any); 653 any doPoll(any); 654 any doPool(any); 655 any doPop(any); 656 any doPort(any); 657 any doPr(any); 658 any doPreQ(any); 659 any doPrin(any); 660 any doPrinl(any); 661 any doPrint(any); 662 any doPrintln(any); 663 any doPrintsp(any); 664 any doPrior(any); 665 any doProg(any); 666 any doProg1(any); 667 any doProg2(any); 668 any doProp(any); 669 any doPropCol(any); 670 any doProtect(any); 671 any doProve(any); 672 any doPush(any); 673 any doPush1(any); 674 any doPut(any); 675 any doPutl(any); 676 any doPwd(any); 677 any doQueue(any); 678 any doQuit(any); 679 any doQuote(any); 680 any doRand(any); 681 any doRange(any); 682 any doRank(any); 683 any doRaw(any); 684 any doRd(any); 685 any doRead(any); 686 any doRem(any); 687 any doReplace(any); 688 any doRest(any); 689 any doReverse(any); 690 any doRewind(any); 691 any doRollback(any); 692 any doRot(any); 693 any doRun(any); 694 any doSect(any); 695 any doSeed(any); 696 any doSeek(any); 697 any doSemicol(any); 698 any doSend(any); 699 any doSeq(any); 700 any doSet(any); 701 any doSetCol(any); 702 any doSetq(any); 703 any doShift(any); 704 any doSigio(any); 705 any doSize(any); 706 any doSkip(any); 707 any doSort(any); 708 any doSpace(any); 709 any doSplit(any); 710 any doSpQ(any); 711 any doState(any); 712 any doStem(any); 713 any doStr(any); 714 any doStrip(any); 715 any doStrQ(any); 716 any doSub(any); 717 any doSubQ(any); 718 any doSum(any); 719 any doSuper(any); 720 any doSym(any); 721 any doSymQ(any); 722 any doSync(any); 723 any doSys(any); 724 any doT(any); 725 any doTail(any); 726 any doTell(any); 727 any doText(any); 728 any doThrow(any); 729 any doTick(any); 730 any doTill(any); 731 any doTime(any); 732 any doTouch(any); 733 any doTrace(any); 734 any doTrim(any); 735 any doTry(any); 736 any doType(any); 737 any doUdp(any); 738 any doUnify(any); 739 any doUnless(any); 740 any doUntil(any); 741 any doUp(any); 742 any doUppQ(any); 743 any doUppc(any); 744 any doUse(any); 745 any doUsec(any); 746 any doVal(any); 747 any doVersion(any); 748 any doWait(any); 749 any doWhen(any); 750 any doWhile(any); 751 any doWipe(any); 752 any doWith(any); 753 any doWr(any); 754 any doXchg(any); 755 any doXor(any); 756 any doYoke(any); 757 any doZap(any); 758 any doZero(any); 759 760 static inline long unBox(any x) { 761 long n = unDig(x) / 2; 762 return unDig(x) & 1? -n : n; 763 } 764 765 static inline any boxCnt(long n) {return box(n>=0? n*2 : -n*2+1);} 766 767 /* List element access */ 768 static inline any nCdr(int n, any x) { 769 while (--n >= 0) 770 x = cdr(x); 771 return x; 772 } 773 774 static inline any nth(int n, any x) { 775 if (--n < 0) 776 return Nil; 777 return nCdr(n,x); 778 } 779 780 static inline any getn(any x, any y) { 781 if (isNum(x)) { 782 long n = unDig(x) / 2; 783 784 if (isNeg(x)) { 785 while (--n) 786 y = cdr(y); 787 return cdr(y); 788 } 789 if (n == 0) 790 return Nil; 791 while (--n) 792 y = cdr(y); 793 return car(y); 794 } 795 do 796 if (isCell(car(y)) && x == caar(y)) 797 return cdar(y); 798 while (isCell(y = cdr(y))); 799 return Nil; 800 } 801 802 /* List length calculation */ 803 static inline int length(any x) { 804 int n; 805 806 for (n = 0; isCell(x); x = cdr(x)) 807 ++n; 808 return n; 809 } 810 811 /* Membership */ 812 static inline any member(any x, any y) { 813 any z = y; 814 815 while (isCell(y)) { 816 if (equal(x, car(y))) 817 return y; 818 if (z == (y = cdr(y))) 819 return NULL; 820 } 821 return isNil(y) || !equal(x,y)? NULL : y; 822 } 823 824 static inline any memq(any x, any y) { 825 any z = y; 826 827 while (isCell(y)) { 828 if (x == car(y)) 829 return y; 830 if (z == (y = cdr(y))) 831 return NULL; 832 } 833 return isNil(y) || x != y? NULL : y; 834 } 835 836 static inline int indx(any x, any y) { 837 int n = 1; 838 any z = y; 839 840 while (isCell(y)) { 841 if (equal(x, car(y))) 842 return n; 843 ++n; 844 if (z == (y = cdr(y))) 845 return 0; 846 } 847 return 0; 848 } 849 850 /* List interpreter */ 851 static inline any prog(any x) { 852 any y; 853 854 do 855 y = EVAL(car(x)); 856 while (isCell(x = cdr(x))); 857 return y; 858 } 859 860 static inline any run(any x) { 861 any y; 862 cell at; 863 864 Push(at,val(At)); 865 do 866 y = EVAL(car(x)); 867 while (isCell(x = cdr(x))); 868 val(At) = Pop(at); 869 return y; 870 }