1/* Copyright 1992 NEC Corporation, Tokyo, Japan. 2 * 3 * Permission to use, copy, modify, distribute and sell this software 4 * and its documentation for any purpose is hereby granted without 5 * fee, provided that the above copyright notice appear in all copies 6 * and that both that copyright notice and this permission notice 7 * appear in supporting documentation, and that the name of NEC 8 * Corporation not be used in advertising or publicity pertaining to 9 * distribution of the software without specific, written prior 10 * permission. NEC Corporation makes no representations about the 11 * suitability of this software for any purpose. It is provided "as 12 * is" without express or implied warranty. 13 * 14 * NEC CORPORATION DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, 15 * INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN 16 * NO EVENT SHALL NEC CORPORATION BE LIABLE FOR ANY SPECIAL, INDIRECT OR 17 * CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF 18 * USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR 19 * OTHER TORTUOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 20 * PERFORMANCE OF THIS SOFTWARE. 21 */ 22 23/************************************************************************/ 24/* THIS SOURCE CODE IS MODIFIED FOR TKO BY T.MURAI 1997 25/************************************************************************/ 26 27#if !defined(lint) && !defined(__CODECENTER__) 28static char rcsid[] = "$Id: lisp.c 14875 2005-11-12 21:25:31Z bonefish $"; 29#endif 30 31/* 32** main program of lisp 33*/ 34#if (defined(_WINDOWS) || defined(WIN32)) && !defined(WIN) 35#define WIN 36#endif 37 38#ifdef WIN 39#define WIN_CANLISP 40#endif 41 42#include <InterfaceDefs.h> 43 44#include "lisp.h" 45#include "patchlevel.h" 46 47#include <signal.h> 48 49extern void (*keyconvCallback)(...); 50 51//static int CANNA_mbstowcs(WCHAR_T *dest, char *src, int destlen); 52static void fillMenuEntry(void); 53static void intr(int sig); 54static int initIS(void); 55static void finIS(void); 56static int identifySequence(unsigned c, int *val); 57static int alloccell(void); 58static int allocarea(void); 59static void freearea(void); 60static list getatmz(char *name); 61static list mkatm(char *name); 62static list getatm(char *name, int key); 63static void error(char *msg, list v); 64static void fatal(char *msg, list v); 65static void argnerr(char *msg); 66static void numerr(char *fn, list arg); 67static void lisp_strerr(char *fn, list arg); 68static list Lread(int n); 69static list read1(void); 70static int skipspaces(void); 71static int zaplin(void); 72static list newcons(void); 73static list newsymbol(char *name); 74static void print(list l); 75static list ratom(void); 76static list ratom2(int a); 77static list rstring(void); 78static list rcharacter(void); 79static int isnum(char *name); 80static void untyi(int c); 81static int tyi(void); 82static int tyipeek(void); 83static void prins(char *s); 84static int isterm(int c); 85static void push(list value); 86static void pop(int x); 87static list pop1(void); 88static void epush(list value); 89static list epop(void); 90static void patom(list atm); 91static void gc(void); 92static list allocstring(int n); 93static list copystring(char *s, int n); 94static list copycons(struct cell *l); 95static void markcopycell(list *addr); 96static list bindall(list var, list par, list a, list e); 97static list Lquote(void); 98static list Leval(int n); 99static list assq(list e, list a); 100static int evpsh(list args); 101static list Lprogn(void); 102static list Lcons(int n); 103static list Lncons(int n); 104static list Lxcons(int n); 105static list Lprint(int n); 106static list Lset(int n); 107static list Lsetq(void); 108static list Lequal(int n); 109static int Strncmp(char *x, char *y, int len); 110static char *Strncpy(char *x, char *y, int len); 111static int equal(list x, list y); 112static list Lgreaterp(int n); 113static list Llessp(int n); 114static list Leq(int n); 115static list Lcond(void); 116static list Lnull(int n); 117static list Lor(void); 118static list Land(void); 119static list Lplus(int n); 120static list Ltimes(int n); 121static list Ldiff(int n); 122static list Lquo(int n); 123static list Lrem(int n); 124static list Lgc(int n); 125static list Lusedic(int n); 126static list Llist(int n); 127static list Lcopysym(int n); 128static list Lload(int n); 129static list Lmodestr(int n); 130static int xfseq(char *fname, list l, unsigned char *arr, int arrsize); 131static list Lsetkey(int n); 132static list Lgsetkey(int n); 133static list Lputd(int n); 134static list Ldefun(void); 135static list Ldefmacro(void); 136static list Lcar(int n); 137static list Lcdr(int n); 138static list Latom(int n); 139static list Llet(void); 140static list Lif(void); 141static list Lunbindkey(int n); 142static list Lgunbindkey(int n); 143static list Ldefmode(void); 144static list Ldefsym(void); 145static int getKutenCode(char *data, int *ku, int *ten); 146static int howManyCharsAre(char *tdata, char *edata, int *tku, int *tten, int *codeset); 147static char *pickupChars(int tku, int tten, int num, int kodata); 148static void numtostr(unsigned long num, char *str); 149static list Ldefselection(void); 150static list Ldefmenu(void); 151static list Lsetinifunc(int n); 152static list Lboundp(int n); 153static list Lfboundp(int n); 154static list Lgetenv(int n); 155static list LdefEscSeq(int n); 156static list LdefXKeysym(int n); 157static list Lconcat(int n); 158static void ObtainVersion(void); 159static list VTorNIL(BYTE *var, int setp, list arg); 160static list StrAcc(char **var, int setp, list arg); 161static list NumAcc(int *var, int setp, list arg); 162static list Vnkouhobunsetsu(int setp, list arg); 163static list VProtoVer(int setp, list arg); 164static list VServVer(int setp, list arg); 165static list VServName(int setp, list arg); 166static list VCannaDir(int setp, list arg); 167static list VCodeInput(int setp, list arg); 168static void deflispfunc(void); 169static void defcannavar(void); 170static void defcannamode(void); 171static void defcannafunc(void); 172static void defatms(void); 173static void restoreLocalVariables(void); 174 175static FILE *outstream = (FILE *)0; 176 177#ifdef WIN 178extern int RkwGetProtocolVersion (int *, int *); 179extern int RkwGetServerVersion (int *, int *); 180#endif 181 182static char *celltop, *cellbtm, *freecell; 183static char *memtop; 184 185static int ncells = CELLSIZE; 186 187 188/* parameter stack */ 189 190static list *stack, *sp; 191 192/* environment stack */ 193 194static list *estack, *esp; 195 196/* oblist */ 197 198static list *oblist; /* oblist hashing array */ 199 200#define LISPERROR -1 201 202typedef struct { 203 FILE *f; 204 char *name; 205 unsigned line; 206} lispfile; 207 208static lispfile *files; 209static int filep; 210 211/* lisp read buffer & read pointer */ 212 213static char *readbuf; /* read buffer */ 214static char *readptr; /* read pointer */ 215 216/* error functions */ 217 218static void argnerr(), numerr(), error(); 219 220/* multiple values */ 221 222#define MAXVALUES 16 223static list *values; /* multiple values here */ 224static int valuec; /* number of values here */ 225 226/* symbols */ 227 228static list QUOTE, T, _LAMBDA, _MACRO, COND, USER; 229static list BUSHU, GRAMMAR, RENGO, KATAKANA, HIRAGANA, HYPHEN; 230 231#include <setjmp.h> 232 233static struct lispcenv { 234 jmp_buf jmp_env; 235 int base_stack; 236 int base_estack; 237} *env; /* environment for setjmp & longjmp */ 238static int jmpenvp = MAX_DEPTH; 239 240static jmp_buf fatal_env; 241 242#ifdef WIN_CANLISP 243#include "cannacnf.h" 244 245struct winstruct { 246 struct libconf *conf; 247 struct libconfwrite *confwrite; 248 struct RegInfo *rinfo; 249 char *context; 250} wins; 251#endif 252 253#ifdef WIN_CANLISP 254char *RemoteGroup = (char *)NULL; 255char *LocalGroup = (char *)NULL; 256#endif 257 258/* tyo -- output one character */ 259 260inline 261void tyo(int c) 262{ 263 if (outstream) { 264 (void)putc(c, outstream); 265 } 266} 267 268/* external functions 269 270 ���������������������������������������� 271 272 (1) clisp_init() -- ������������������������������������������������������������������������������������ 273 274 lisp �������������������������������������������������������� allocate ������������ 275 276 (2) clisp_fin() -- �������������������������������������������������������������������������������� 277 278 ������������������������������������������������������������������������ 279 280 (3) YYparse_by_rcfilename((char *)s) -- ���������������������������������������������������������������� 281 282 s ���������������������������������������������������������������������������������������������������������������������������� 283 �������������������������������������������������������������������������������� 1 ���������������������������������������� 284 0 ���������������� 285 286 */ 287 288static list getatmz(char *); 289 290#ifdef WIN_CANLISP 291/* 292 * ������������������������������������������������������������ (from util.c) 293 * 294 */ 295 296static int wchar_type; /* ������������������������������������������������(����������������) */ 297 298#define CANNA_WCTYPE_16 0 /* 16�������������������� */ 299#define CANNA_WCTYPE_32 1 /* 32�������������������� */ 300#define CANNA_WCTYPE_OT 99 /* ������������������������ */ 301 302/* 303 WCinit() -- �������������������������������������������������������������������������������������������������������� 304 305 �������������������������������������������������������� setlocale �������������������������������������������������������� 306 */ 307 308#define TYPE16A 0x0000a4a2 309#define TYPE32A 0x30001222 310 311 312int 313WCinit(void) 314{ 315#if defined(HAVE_WCHAR_OPERATION) && !defined(WIN) 316 extern int locale_insufficient; 317 WCHAR_T wc[24]; 318 char *a = "\244\242"; /* ���� */ /* 0xa4a2 */ 319 320 locale_insufficient = 0; 321 if (mbstowcs(wc, a, sizeof(wc) / sizeof(WCHAR_T)) != 1) { 322 /* �������� setlocale �������������������������������� */ 323 setlocale(LC_CTYPE, ""); 324 if (mbstowcs(wc, a, sizeof(wc) / sizeof(WCHAR_T)) != 1) { 325 setlocale(LC_CTYPE, JAPANESE_LOCALE); 326 if (mbstowcs(wc, a, sizeof(wc) / sizeof(WCHAR_T)) != 1) { 327 locale_insufficient = 1; 328 return -1; 329 } 330 } 331 } 332 switch (wc[0]) { 333 case TYPE16A: 334 wchar_type = CANNA_WCTYPE_16; 335 break; 336 case TYPE32A: 337 wchar_type = CANNA_WCTYPE_32; 338 break; 339 default: 340 wchar_type = CANNA_WCTYPE_OT; 341 break; 342 } 343#else /* !HAVE_WCHAR_OPERATION || WIN */ 344# ifdef WCHAR16 345 346 wchar_type = CANNA_WCTYPE_16; 347 348# else /* !WCHAR16 */ 349 350 if (sizeof(WCHAR_T) == 2) { 351 /* NOTREACHED */ 352 wchar_type = CANNA_WCTYPE_16; 353 } 354 else { 355 /* NOTREACHED */ 356 wchar_type = CANNA_WCTYPE_32; 357 } 358 359# endif /* !WCHAR16 */ 360#endif /* !HAVE_WCHAR_OPERATION || WIN */ 361 362 return 0; 363} 364 365static int 366CANNA_mbstowcs(WCHAR_T *dest, char *src, int destlen) 367{ 368 register int i, j; 369 register unsigned ec; 370 371 if (wchar_type == CANNA_WCTYPE_16) { 372 for (i = 0, j = 0 ; 373 (ec = (unsigned)(unsigned char)src[i]) != 0 && j < destlen ; i++) { 374 if (ec & 0x80) { 375 switch (ec) { 376 case 0x8e: /* SS2 */ 377 dest[j++] = (WCHAR_T)(0x80 | ((unsigned)src[++i] & 0x7f)); 378 break; 379 case 0x8f: /* SS3 */ 380 dest[j++] = (WCHAR_T)(0x8000 381 | (((unsigned)src[i + 1] & 0x7f) << 8) 382 | ((unsigned)src[i + 2] & 0x7f)); 383 i += 2; 384 break; 385 default: 386 dest[j++] = (WCHAR_T)(0x8080 | (((unsigned)src[i] & 0x7f) << 8) 387 | ((unsigned)src[i + 1] & 0x7f)); 388 i++; 389 break; 390 } 391 }else{ 392 dest[j++] = (WCHAR_T)ec; 393 } 394 } 395 if (j < destlen) 396 dest[j] = (WCHAR_T)0; 397 return j; 398 } 399 else if (wchar_type == CANNA_WCTYPE_32) { 400 for (i = 0, j = 0 ; 401 (ec = (unsigned)(unsigned char)src[i]) != 0 && j < destlen ; i++) { 402 if (ec & 0x80) { 403 switch (ec) { 404 case 0x8e: /* SS2 */ 405 dest[j++] = (WCHAR_T)(0x10000000L | ((unsigned)src[++i] & 0x7f)); 406 break; 407 case 0x8f: /* SS3 */ 408 dest[j++] = (WCHAR_T)(0x20000000L 409 | (((unsigned)src[i + 1] & 0x7f) << 7) 410 | ((unsigned)src[i + 2] & 0x7f)); 411 i += 2; 412 break; 413 default: 414 dest[j++] = (WCHAR_T)(0x30000000L | (((unsigned)src[i] & 0x7f) << 7) 415 | ((unsigned)src[i + 1] & 0x7f)); 416 i++; 417 break; 418 } 419 }else{ 420 dest[j++] = (WCHAR_T)ec; 421 } 422 } 423 if (j < destlen) 424 dest[j] = (WCHAR_T)0; 425 return j; 426 } 427 else { 428 return 0; 429 } 430} 431 432#endif /* WIN */ 433 434int 435clisp_init(void) 436{ 437 int i; 438 439#ifdef WIN_CANLISP 440 WCinit(); 441#endif 442 443 if ( !allocarea() ) { 444 return 0; 445 } 446 447 if ( !initIS() ) { 448 freearea(); 449 return 0; 450 } 451 452 /* stack pointer initialization */ 453 sp = stack + STKSIZE; 454 esp = estack + STKSIZE; 455 epush(NIL); 456 457 /* initialize read pointer */ 458 readptr = readbuf; 459 *readptr = '\0'; 460 files[filep = 0].f = stdin; 461 files[filep].name = (char *)0; 462 files[filep].line = 0; 463 464 /* oblist initialization */ 465 for (i = 0; i < BUFSIZE ; i++) 466 oblist[i] = 0; 467 468 /* symbol definitions */ 469 defatms(); 470 return 1; 471} 472 473#ifndef NO_EXTEND_MENU 474static void 475fillMenuEntry(void) 476{ 477 extern extraFunc *extrafuncp; 478 extraFunc *p, *fp; 479 int i, n, fid; 480 menuitem *mb; 481 482 for (p = extrafuncp ; p ; p = p->next) { 483 if (p->keyword == EXTRA_FUNC_DEFMENU) { 484 n = p->u.menuptr->nentries; 485 mb = p->u.menuptr->body; 486 for (i = 0 ; i < n ; i++, mb++) { 487 if (mb->flag == MENU_SUSPEND) { 488 list l = (list)mb->u.misc; 489 fid = symbolpointer(l)->fid; 490 if (fid < CANNA_FN_MAX_FUNC) { 491 goto just_a_func; 492 } 493 else { 494 fp = FindExtraFunc(fid); 495 if (fp && fp->keyword == EXTRA_FUNC_DEFMENU) { 496 mb->u.menu_next = fp->u.menuptr; 497 mb->flag = MENU_MENU; 498 } 499 else { 500 just_a_func: 501 mb->u.fnum = fid; 502 mb->flag = MENU_FUNC; 503 } 504 } 505 } 506 } 507 } 508 } 509} 510#endif /* NO_EXTEND_MENU */ 511 512#define UNTYIUNIT 32 513static char *untyibuf = 0; 514static int untyisize = 0, untyip = 0; 515 516void 517clisp_fin(void) 518{ 519#ifndef NO_EXTEND_MENU 520 /* ��������������������������������menu ���������������������������������������� */ 521 fillMenuEntry(); 522#endif 523 524 finIS(); 525 526 while (filep >= 0) { 527 if (files[filep].f && files[filep].f != stdin) { 528 fclose(files[filep].f); 529 } 530 if (files[filep].name) { 531 free(files[filep].name); 532 } 533 filep--; 534 } 535 536 freearea(); 537 if (untyisize) { 538 free(untyibuf); 539 untyisize = 0; 540 untyibuf = (char *)0; 541 } 542} 543 544int 545YYparse_by_rcfilename(char *s) 546{ 547 extern int ckverbose; 548 int retval = 0; 549 FILE *f; 550 FILE *saved_outstream; 551 552 if (setjmp(fatal_env)) { 553 retval = 0; 554 goto quit_parse_rcfile; 555 } 556 557 if (jmpenvp <= 0) { /* ������������������������������������ */ 558 return 0; 559 } 560 jmpenvp--; 561 562 if (ckverbose >= CANNA_HALF_VERBOSE) { 563 saved_outstream = outstream; 564#ifndef WIN /* what ? */ 565 outstream = stdout; 566#endif 567 } 568 569 f = fopen(s, "r"); 570 if (f) { 571 if (ckverbose == CANNA_FULL_VERBOSE) { 572#ifndef WIN 573 printf("���������������������������������������������������� \"%s\" ������������������������\n", s); 574#endif 575 } 576 files[++filep].f = f; 577 files[filep].name = (char *)malloc(strlen(s) + 1); 578 if (files[filep].name) { 579 strcpy(files[filep].name, s); 580 } 581 else { 582 filep--; 583 fclose(f); 584 goto quit_parse_rcfile; 585 } 586 files[filep].line = 0; 587 588 setjmp(env[jmpenvp].jmp_env); 589 env[jmpenvp].base_stack = sp - stack; 590 env[jmpenvp].base_estack = esp - estack; 591 592 for (;;) { 593 push(Lread(0)); 594 if (valuec > 1 && null(values[1])) { 595 break; 596 } 597 (void)Leval(1); 598 } 599 retval = 1; 600 } 601 602 if (ckverbose >= CANNA_HALF_VERBOSE) { 603 outstream = saved_outstream; 604 } 605 606 jmpenvp++; 607 quit_parse_rcfile: 608 return retval; 609} 610 611#define WITH_MAIN 612#ifdef WITH_MAIN 613 614static void 615intr(int sig) 616/* ARGSUSED */ 617{ 618 error("Interrupt:",NON); 619 /* NOTREACHED */ 620} 621 622/* cfuncdef 623 624 parse_string -- ���������������������������������������� 625 626*/ 627 628int parse_string(char *str) 629{ 630 char *readbufbk; 631 632 if (clisp_init() == 0) { 633 return -1; 634 } 635 636 /* read buffer ���������������������������������������������������� */ 637 readbufbk = readbuf; 638 readptr = readbuf = str; 639 640 if (setjmp(fatal_env)) { 641 goto quit_parse_string; 642 } 643 644 if (jmpenvp <= 0) { /* ������������������������������������ */ 645 return -1; 646 } 647 648 jmpenvp--; 649 files[++filep].f = (FILE *)0; 650 files[filep].name = (char *)0; 651 files[filep].line = 0; 652 653 setjmp(env[jmpenvp].jmp_env); 654 env[jmpenvp].base_stack = sp - stack; 655 env[jmpenvp].base_estack = esp - estack; 656 657 for (;;) { 658 list t; 659 660 t = Lread(0); 661 if (valuec > 1 && null(values[1])) { 662 break; 663 } 664 else { 665 push(t); 666 Leval(1); 667 } 668 } 669 jmpenvp++; 670 quit_parse_string: 671 readbuf = readbufbk; 672 clisp_fin(); 673 return 0; 674} 675 676static void intr(); 677 678void 679clisp_main(void) 680{ 681 if (clisp_init() == 0) { /* initialize data area & etc.. */ 682 fprintf(stderr, "CannaLisp: initialization failed.\n"); 683#ifndef WIN 684 exit(1); 685#endif 686 } 687 688 if (setjmp(fatal_env)) { 689 goto quit_clisp_main; 690 } 691 692 if (jmpenvp <= 0) { /* ������������������������������������ */ 693 return; 694 } 695 jmpenvp--; 696 697 fprintf(stderr,"CannaLisp listener %d.%d%s\n", 698 CANNA_MAJOR_MINOR / 1000, CANNA_MAJOR_MINOR % 1000, 699 CANNA_PATCH_LEVEL); 700 701 outstream = stdout; 702 703 setjmp(env[jmpenvp].jmp_env); 704 env[jmpenvp].base_stack = sp - stack; 705 env[jmpenvp].base_estack = esp - estack; 706 707#ifndef WIN 708 signal(SIGINT, intr); 709#endif 710 for (;;) { 711 prins("-> "); /* prompt */ 712 push(Lread(0)); 713 if (valuec > 1 && null(values[1])) { 714 break; 715 } 716 push(Leval(1)); 717 if (sp[0] == LISPERROR) { 718 (void)pop1(); 719 } 720 else { 721 (void)Lprint(1); 722 prins("\n"); 723 } 724 } 725 jmpenvp++; 726 quit_clisp_main: 727 prins("\nGoodbye.\n"); 728 clisp_fin(); 729} 730 731#endif /* WITH_MAIN */ 732 733static int longestkeywordlen; 734 735typedef struct { 736 char *seq; 737 int id; 738} SeqToID; 739 740/* #include <InterfaceDefs.h> */ 741static SeqToID keywordtable[] = { 742 {"Space" ,' '}, 743 {"Escape" ,'\033'}, 744 {"Tab" ,B_TAB}, 745 {"Nfer" ,CANNA_KEY_Nfer}, 746 {"Xfer" ,CANNA_KEY_Xfer}, 747 {"Backspace" ,B_BACKSPACE}, 748 {"Delete" ,'\177'}, 749 {"Insert" ,CANNA_KEY_Insert}, 750 {"Rollup" ,CANNA_KEY_Rollup}, 751 {"Rolldown" ,CANNA_KEY_Rolldown}, 752 {"Up" ,CANNA_KEY_Up}, 753 {"Left" ,CANNA_KEY_Left}, 754 {"Right" ,CANNA_KEY_Right}, 755 {"Down" ,CANNA_KEY_Down}, 756 {"Home" ,CANNA_KEY_Home}, 757 {"Clear" ,'\013'}, 758 {"Help" ,CANNA_KEY_Help}, 759 {"Enter" ,B_RETURN}, 760 {"Return" ,B_RETURN}, 761/* "F1" is processed by program */ 762 {"F2" ,CANNA_KEY_F2}, 763 {"F3" ,CANNA_KEY_F3}, 764 {"F4" ,CANNA_KEY_F4}, 765 {"F5" ,CANNA_KEY_F5}, 766 {"F6" ,CANNA_KEY_F6}, 767 {"F7" ,CANNA_KEY_F7}, 768 {"F8" ,CANNA_KEY_F8}, 769 {"F9" ,CANNA_KEY_F9}, 770 {"F10" ,CANNA_KEY_F10}, 771/* "Pf1" is processed by program */ 772 {"Pf2" ,CANNA_KEY_PF2}, 773 {"Pf3" ,CANNA_KEY_PF3}, 774 {"Pf4" ,CANNA_KEY_PF4}, 775 {"Pf5" ,CANNA_KEY_PF5}, 776 {"Pf6" ,CANNA_KEY_PF6}, 777 {"Pf7" ,CANNA_KEY_PF7}, 778 {"Pf8" ,CANNA_KEY_PF8}, 779 {"Pf9" ,CANNA_KEY_PF9}, 780 {"Pf10" ,CANNA_KEY_PF10}, 781 {"S-Nfer" ,CANNA_KEY_Shift_Nfer}, 782 {"S-Xfer" ,CANNA_KEY_Shift_Xfer}, 783 {"S-Up" ,CANNA_KEY_Shift_Up}, 784 {"S-Down" ,CANNA_KEY_Shift_Down}, 785 {"S-Left" ,CANNA_KEY_Shift_Left}, 786 {"S-Right" ,CANNA_KEY_Shift_Right}, 787 {"C-Nfer" ,CANNA_KEY_Cntrl_Nfer}, 788 {"C-Xfer" ,CANNA_KEY_Cntrl_Xfer}, 789 {"C-Up" ,CANNA_KEY_Cntrl_Up}, 790 {"C-Down" ,CANNA_KEY_Cntrl_Down}, 791 {"C-Left" ,CANNA_KEY_Cntrl_Left}, 792 {"C-Right" ,CANNA_KEY_Cntrl_Right}, 793 {0 ,0}, 794}; 795 796#define charToNum(c) charToNumTbl[(c) - ' '] 797 798static int *charToNumTbl; 799 800typedef struct { 801 int id; 802 int *tbl; 803} seqlines; 804 805static seqlines *seqTbl; /* ����������������(����������������������������) */ 806static int nseqtbl; /* ������������������������������������������������������������ */ 807static int nseq; 808static int seqline; 809 810static 811int initIS(void) 812{ 813 SeqToID *p; 814 char *s; 815 int i; 816 seqlines seqTbls[1024]; 817 818 seqTbl = (seqlines *)0; 819 seqline = 0; 820 nseqtbl = 0; 821 nseq = 0; 822 longestkeywordlen = 0; 823 for (i = 0 ; i < 1024 ; i++) { 824 seqTbls[i].tbl = (int *)0; 825 seqTbls[i].id = 0; 826 } 827 charToNumTbl = (int *)calloc('~' - ' ' + 1, sizeof(int)); 828 if ( !charToNumTbl ) { 829 return 0; 830 } 831 832 /* �������������������������������������������������������������������� 833 nseq �������������������������������������������������������������������������������� */ 834 for (p = keywordtable ; p->id ; p++) { 835 int len = 0; 836 for (s = p->seq ; *s ; s++) { 837 if ( !charToNumTbl[*s - ' '] ) { 838 charToNumTbl[*s - ' '] = nseq; /* ���������������������������������������������������� */ 839 nseq++; 840 } 841 len ++; 842 } 843 if (len > longestkeywordlen) { 844 longestkeywordlen = len; 845 } 846 } 847 /* ������������������������������������ */ 848 seqTbls[nseqtbl].tbl = (int *)calloc(nseq, sizeof(int)); 849 if ( !seqTbls[nseqtbl].tbl ) { 850 goto initISerr; 851 } 852 nseqtbl++; 853 for (p = keywordtable ; p->id ; p++) { 854 int line, nextline; 855 856 line = 0; 857 for (s = p->seq ; *s ; s++) { 858 if (seqTbls[line].tbl == 0) { /* ���������������������������� */ 859 seqTbls[line].tbl = (int *)calloc(nseq, sizeof(int)); 860 if ( !seqTbls[line].tbl ) { 861 goto initISerr; 862 } 863 } 864 nextline = seqTbls[line].tbl[charToNum(*s)]; 865 /* ��������������������charToNum(*s) ���������������������������������������� */ 866 if ( nextline ) { 867 line = nextline; 868 }else{ /* ������������������������������������ */ 869 line = seqTbls[line].tbl[charToNum(*s)] = nseqtbl++; 870 } 871 } 872 seqTbls[line].id = p->id; 873 } 874 seqTbl = (seqlines *)calloc(nseqtbl, sizeof(seqlines)); 875 if ( !seqTbl ) { 876 goto initISerr; 877 } 878 for (i = 0 ; i < nseqtbl ; i++) { 879 seqTbl[i].id = seqTbls[i].id; 880 seqTbl[i].tbl = seqTbls[i].tbl; 881 } 882 return 1; 883 884 initISerr: 885 free(charToNumTbl); 886 charToNumTbl = (int *)0; 887 if (seqTbl) { 888 free(seqTbl); 889 seqTbl = (seqlines *)0; 890 } 891 for (i = 0 ; i < nseqtbl ; i++) { 892 if (seqTbls[i].tbl) { 893 free(seqTbls[i].tbl); 894 seqTbls[i].tbl = (int *)0; 895 } 896 } 897 return 0; 898} 899 900static void 901finIS(void) /* identifySequence �������������������������������������������������������� */ 902{ 903 int i; 904 905 if (seqTbl) { 906 for (i = 0 ; i < nseqtbl ; i++) { 907 if (seqTbl[i].tbl) free(seqTbl[i].tbl); 908 seqTbl[i].tbl = (int *)0; 909 } 910 free(seqTbl); 911 seqTbl = (seqlines *)0; 912 } 913 if (charToNumTbl) { 914 free(charToNumTbl); 915 charToNumTbl = (int *)0; 916 } 917} 918 919/* cvariable 920 921 seqline: identifySequence �������������������������������������������� 922 923 */ 924 925#define CONTINUE 1 926#define END 0 927 928static 929int identifySequence(unsigned c, int *val) 930{ 931 int nextline; 932 933 if (' ' <= c && c <= '~' && charToNum(c) && 934 (nextline = seqTbl[seqline].tbl[charToNum(c)]) ) { 935 seqline = nextline; 936 *val = seqTbl[seqline].id; 937 if (*val) { 938 seqline = 0; 939 return END; 940 } 941 else { 942 return CONTINUE; /* continue */ 943 } 944 } 945 else { 946 *val = -1; 947 seqline = 0; 948 return END; 949 } 950} 951 952 953static int 954alloccell(void) 955{ 956 int cellsize, odd; 957 char *p; 958 959 cellsize = ncells * sizeof(list); 960 p = (char *)malloc(cellsize); 961 if (p == (char *)0) { 962 return 0; 963 } 964 memtop = p; 965 odd = (int)((pointerint)memtop % sizeof(list)); 966 freecell = celltop = memtop + (odd ? (sizeof(list)) - odd : 0); 967 cellbtm = memtop + cellsize - odd; 968 return 1; 969} 970 971/* �������������������������������������������������������� */ 972 973static 974int allocarea(void) 975{ 976 /* ���������������������������� */ 977 if (alloccell()) { 978 /* ������������������������ */ 979 stack = (list *)calloc(STKSIZE, sizeof(list)); 980 if (stack) { 981 estack = (list *)calloc(STKSIZE, sizeof(list)); 982 if (estack) { 983 /* oblist */ 984 oblist = (list *)calloc(BUFSIZE, sizeof(list)); 985 if (oblist) { 986 /* I/O */ 987 filep = 0; 988 files = (lispfile *)calloc(MAX_DEPTH, sizeof(lispfile)); 989 if (files) { 990 readbuf = (char *)malloc(BUFSIZE); 991 if (readbuf) { 992 /* jump env */ 993 jmpenvp = MAX_DEPTH; 994 env = (struct lispcenv *) 995 calloc(MAX_DEPTH, sizeof(struct lispcenv)); 996 if (env) { 997 /* multiple values returning buffer */ 998 valuec = 1; 999 values = (list *)calloc(MAXVALUES, sizeof(list)); 1000 if (values) { 1001 return 1; 1002 } 1003 free(env); 1004 } 1005 free(readbuf); 1006 } 1007 free(files); 1008 } 1009 free(oblist); 1010 } 1011 free(estack); 1012 } 1013 free(stack); 1014 } 1015 free(memtop); 1016 } 1017 return 0; 1018} 1019 1020static void 1021freearea(void) 1022{ 1023 free(memtop); 1024 free(stack); 1025 free(estack); 1026 free(oblist); 1027 free(files); 1028 free(env); 1029 free(readbuf); 1030 if (values) { 1031 free(values); 1032 values = 0; 1033 } 1034} 1035 1036static list 1037getatmz(char *name) 1038{ 1039 int key; 1040 char *p; 1041 1042 for (p = name, key = 0 ; *p ; p++) 1043 key += *p; 1044 return getatm(name,key); 1045} 1046 1047/* mkatm - 1048 making symbol function */ 1049 1050static list 1051mkatm(char *name) 1052{ 1053 list temp; 1054 struct atomcell *newatom; 1055 1056 temp = newsymbol(name); 1057 newatom = symbolpointer(temp); 1058 newatom->value = (*name == ':') ? (list)temp : (list)UNBOUND; 1059 newatom->plist = NIL; /* set null plist */ 1060 newatom->ftype = UNDEF; /* set undef func-type */ 1061 newatom->func = (list (*)(...))0; /* Don't kill this line */ 1062 newatom->valfunc = (list (*)(...))0; /* Don't kill this line */ 1063 newatom->hlink = NIL; /* no hash linking */ 1064 newatom->mid = -1; 1065 newatom->fid = -1; 1066 1067 return temp; 1068} 1069 1070/* getatm -- get atom from the oblist if possible */ 1071 1072static list 1073getatm(char *name, int key) 1074{ 1075 list p; 1076 struct atomcell *atomp; 1077 1078 key &= 0x00ff; 1079 for (p = oblist[key] ; p ;) { 1080 atomp = symbolpointer(p); 1081 if (!strcmp(atomp->pname, name)) { 1082 return p; 1083 } 1084 p = atomp->hlink; 1085 } 1086 p = mkatm(name); 1087 atomp = symbolpointer(p); 1088 atomp->hlink = oblist[key]; 1089 oblist[key] = p; 1090 return p; 1091} 1092 1093#define MESSAGE_MAX 256 1094 1095static void 1096error(char *msg, list v) 1097/* ARGSUSED */ 1098{ 1099 char buf[MESSAGE_MAX]; 1100 1101 prins(msg); 1102 if (v != (list)NON) 1103 print(v); 1104 if (files[filep].f == stdin) { 1105 prins("\n"); 1106 } 1107 else { 1108 if (files[filep].name) { 1109 sprintf(buf, " (%s near line %d)\n", 1110 files[filep].name, files[filep].line); 1111 } 1112 else { 1113 sprintf(buf, " (near line %d)\n", files[filep].line); 1114 } 1115 prins(buf); 1116 } 1117 sp = &stack[env[jmpenvp].base_stack]; 1118 esp = &estack[env[jmpenvp].base_estack]; 1119/* epush(NIL); */ 1120 longjmp(env[jmpenvp].jmp_env,YES); 1121} 1122 1123static void 1124fatal(char *msg, list v) 1125/* ARGSUSED */ 1126{ 1127 char buf[MESSAGE_MAX]; 1128 1129 prins(msg); 1130 if (v != (list)NON) 1131 print(v); 1132 if (files[filep].f == stdin) { 1133 prins("\n"); 1134 } 1135 else { 1136 if (files[filep].name) { 1137 sprintf(buf, " (%s near line %d)\n", 1138 files[filep].name, files[filep].line); 1139 } 1140 else { 1141 sprintf(buf, " (near line %d)\n", files[filep].line); 1142 } 1143 prins(buf); 1144 } 1145 longjmp(fatal_env, 1); 1146} 1147 1148static void 1149argnerr(char *msg) 1150{ 1151 prins("incorrect number of args to "); 1152 error(msg, NON); 1153 /* NOTREACHED */ 1154} 1155 1156static void 1157numerr(char *fn, list arg) 1158{ 1159 prins("Non-number "); 1160 if (fn) { 1161 prins("to "); 1162 prins(fn); 1163 } 1164 error(": ",arg); 1165 /* NOTREACHED */ 1166} 1167 1168static void 1169lisp_strerr(char *fn, list arg) 1170{ 1171 prins("Non-string "); 1172 if (fn) { 1173 prins("to "); 1174 prins(fn); 1175 } 1176 error(": ",arg); 1177 /* NOTREACHED */ 1178} 1179 1180static list 1181Lread(int n) 1182{ 1183 list t; 1184 1185 argnchk("read",0); 1186 valuec = 1; 1187 if ((t = read1()) == (list)LISPERROR) { 1188 readptr = readbuf; 1189 *readptr = '\0'; 1190 if (files[filep].f != stdin) { 1191 fclose(files[filep].f); 1192 if (files[filep].name) { 1193 free(files[filep].name); 1194 } 1195 filep--; 1196 } 1197 values[0] = NIL; 1198 values[1] = NIL; 1199 valuec = 2; 1200 return(NIL); 1201 } 1202 else { 1203 values[0] = t; 1204 values[1] = T; 1205 valuec = 2; 1206 return(t); 1207 } 1208 /* NOTREACHED */ 1209} 1210 1211static void untyi (int); 1212static list rcharacter (void); 1213 1214static list 1215read1(void) 1216{ 1217 int c; 1218 list p, *pp; 1219 list t; 1220 char *eofmsg = "EOF hit in reading a list : "; 1221 1222 lab: 1223 if ( !skipspaces() ) { 1224 return((list)LISPERROR); 1225 } 1226 switch (c = tyi()) { 1227 case '(': 1228 push(NIL); 1229 p = Lncons(1); /* get a new cell */ 1230 car(p) = p; 1231 push(p); 1232 pp = sp; 1233 1234 for (;;) { 1235 lab2: 1236 if ( !skipspaces() ) { 1237 error(eofmsg,cdr(*pp)); 1238 /* NOTREACHED */ 1239 } 1240 switch (c = tyi()) { 1241 case ';': 1242 zaplin(); 1243 goto lab2; 1244 case ')': 1245 return(cdr(pop1())); 1246 case '.': 1247 if ( !(c = tyipeek()) ) { 1248 error(eofmsg,cdr(*pp)); 1249 /* NOTREACHED */ 1250 } 1251 else if ( !isterm(c) ) { 1252 push(ratom2('.')); 1253 push(NIL); 1254 car(*pp) = cdar(*pp) = Lcons(2); 1255 break; 1256 } 1257 else { 1258 cdar(*pp) = read1(); 1259 if (cdar(*pp) == (list)LISPERROR) { 1260 error(eofmsg,cdr(*pp)); 1261 /* NOTREACHED */ 1262 } 1263 while (')' != (c = tyi())) 1264 if ( !c ) { 1265 error(eofmsg,cdr(*pp)); 1266 /* NOTREACHED */ 1267 } 1268 return(cdr(pop1())); 1269 } 1270 default: 1271 untyi(c); 1272 if ((t = read1()) == (list)LISPERROR) { 1273 error(eofmsg,cdr(*pp)); 1274 /* NOTREACHED */ 1275 } 1276 push(t); 1277 push(NIL); 1278 car(*pp) = cdar(*pp) = Lcons(2); 1279 } 1280 } 1281 case '\'': 1282 push(QUOTE); 1283 if ((t = read1()) == (list)LISPERROR) { 1284 error(eofmsg,NIL); 1285 /* NOTREACHED */ 1286 } 1287 push(t); 1288 push(NIL); 1289 push(Lcons(2)); 1290 return Lcons(2); 1291 case '"': 1292 return rstring(); 1293 case '?': 1294 return rcharacter(); 1295 case ';': 1296 zaplin(); 1297 goto lab; 1298 default: 1299 untyi(c); 1300 return ratom(); 1301 } 1302} 1303 1304/* skipping spaces function - 1305 if eof read then return NO */ 1306 1307static 1308int skipspaces(void) 1309{ 1310 int c; 1311 1312 while ((c = tyi()) <= ' ') { 1313 if ( !c ) { 1314 return(NO); 1315 } 1316#ifdef QUIT_IF_BINARY_CANNARC 1317/* �������� fatal() ���������������������������� read �������������������������������������������������������������������� 1318 ������������������������������������������������������������return ������������������������������������������������������������ 1319 �������������������������������������������������������������������� */ 1320 if (c != '\033' && c != '\n' && c != '\r' && c!= '\t' && c < ' ') { 1321 fatal("read: Binary data read.", NON); 1322 } 1323#endif 1324 } 1325 untyi(c); 1326 return(YES); 1327} 1328 1329/* skip reading until '\n' - 1330 if eof read then return NO */ 1331 1332static 1333int zaplin(void) 1334{ 1335 int c; 1336 1337 while ((c = tyi()) != '\n') 1338 if ( !c ) 1339 return(NO); 1340 return(YES); 1341} 1342 1343static void gc(); 1344 1345static list 1346newcons(void) 1347{ 1348 list retval; 1349 1350 if (freecell + sizeof(struct cell) >= cellbtm) { 1351 gc(); 1352 } 1353 retval = CONS_TAG | (freecell - celltop); 1354 freecell += sizeof(struct cell); 1355 return retval; 1356} 1357 1358static list 1359newsymbol(char *name) 1360{ 1361 list retval; 1362 struct atomcell *temp; 1363 int namesize; 1364 1365 namesize = strlen(name); 1366 namesize = ((namesize / sizeof(list)) + 1) * sizeof(list); /* +1����'\0'�������� */ 1367 if (freecell + (sizeof(struct atomcell)) + namesize >= cellbtm) { 1368 gc(); 1369 } 1370 temp = (struct atomcell *)freecell; 1371 retval = SYMBOL_TAG | (freecell - celltop); 1372 freecell += sizeof(struct atomcell); 1373 (void)strcpy(freecell, name); 1374 temp->pname = freecell; 1375 freecell += namesize; 1376 1377 return retval; 1378} 1379 1380static void patom(); 1381 1382static void 1383print(list l) 1384{ 1385 if ( !l ) /* case NIL */ 1386 prins("nil"); 1387 else if (atom(l)) 1388 patom(l); 1389 else { 1390 tyo('('); 1391 print(car(l)); 1392 for (l = cdr(l) ; l ; l = cdr(l)) { 1393 tyo(' '); 1394 if (atom(l)) { 1395 tyo('.'); 1396 tyo(' '); 1397 patom(l); 1398 break; 1399 } 1400 else 1401 print(car(l)); 1402 } 1403 tyo(')'); 1404 } 1405} 1406 1407 1408 1409/* 1410** read atom 1411*/ 1412 1413 1414static list 1415ratom(void) 1416{ 1417 return(ratom2(tyi())); 1418} 1419 1420/* read atom with the first one character - 1421 check if the token is numeric or pure symbol & return proper value */ 1422 1423static int isnum(); 1424 1425static list 1426ratom2(int a) 1427{ 1428 int i, c, flag; 1429 char atmbuf[BUFSIZE]; 1430 1431 flag = NO; 1432 if (a == '\\') { 1433 flag = YES; 1434 a = tyi(); 1435 } 1436 atmbuf[0] = a; 1437 for (i = 1, c = tyi(); !isterm(c) ; i++, c = tyi()) { 1438 if ( !c ) { 1439 error("Eof hit in reading symbol.", NON); 1440 /* NOTREACHED */ 1441 } 1442 if (c == '\\') { 1443 flag = YES; 1444 } 1445 if (i < BUFSIZE) { 1446 atmbuf[i] = c; 1447 } 1448 else { 1449 error("Too long symbol name read", NON); 1450 /* NOTREACHED */ 1451 } 1452 } 1453 untyi(c); 1454 if (i < BUFSIZE) { 1455 atmbuf[i] = '\0'; 1456 } 1457 else { 1458 error("Too long symbol name read", NON); 1459 /* NOTREACHED */ 1460 } 1461 if ( !flag && isnum(atmbuf)) { 1462 return(mknum(atoi(atmbuf))); 1463 } 1464 else if ( !flag && !strcmp("nil",atmbuf) ) { 1465 return(NIL); 1466 } 1467 else { 1468 return (getatmz(atmbuf)); 1469 } 1470} 1471 1472static list 1473rstring(void) 1474{ 1475 char strb[BUFSIZE]; 1476 int c; 1477 int strp = 0; 1478 1479 while ((c = tyi()) != '"') { 1480 if ( !c ) { 1481 error("Eof hit in reading a string.", NON); 1482 /* NOTREACHED */ 1483 } 1484 if (strp < BUFSIZE) { 1485 if (c == '\\') { 1486 untyi(c); 1487 c = (char)(((unsigned POINTERINT)rcharacter()) & 0xff); 1488 } 1489 strb[strp++] = (char)c; 1490 } 1491 else { 1492 error("Too long string read.", NON); 1493 /* NOTREACHED */ 1494 } 1495 } 1496 if (strp < BUFSIZE) { 1497 strb[strp] = '\0'; 1498 } 1499 else { 1500 error("Too long string read.", NON); 1501 /* NOTREACHED */ 1502 } 1503 1504 return copystring(strb, strp); 1505} 1506 1507/* rcharacter -- ������������������������������������ */ 1508 1509static list 1510rcharacter(void) 1511{ 1512 char *tempbuf; 1513 unsigned ch; 1514 list retval; 1515 int bufp; 1516 1517 tempbuf = (char *)malloc(longestkeywordlen + 1); 1518 if ( !tempbuf ) { 1519 fatal("read: (char *)malloc failed in reading character.", NON); 1520 /* NOTREACHED */ 1521 } 1522 bufp = 0; 1523 1524 ch = tyi(); 1525 if (ch == '\\') { 1526 int code, res; 1527 1528 do { /* ���������������������������������������� */ 1529 tempbuf[bufp++] = ch = tyi(); 1530 res = identifySequence(ch, &code); 1531 } while (res == CONTINUE); 1532 if (code != -1) { /* �������������������������������������������� */ 1533 retval = mknum(code); 1534 } 1535 else if (bufp > 2 && tempbuf[0] == 'C' && tempbuf[1] == '-') { 1536 while (bufp > 3) { 1537 untyi(tempbuf[--bufp]); 1538 } 1539 retval = mknum(tempbuf[2] & (' ' - 1)); 1540 } 1541 else if (bufp == 3 && tempbuf[0] == 'F' && tempbuf[1] == '1') { 1542 untyi(tempbuf[2]); 1543 retval = mknum(CANNA_KEY_F1); 1544 } 1545 else if (bufp == 4 && tempbuf[0] == 'P' && tempbuf[1] == 'f' && 1546 tempbuf[2] == '1') { 1547 untyi(tempbuf[3]); 1548 retval = mknum(CANNA_KEY_PF1); 1549 } 1550 else { /* ���������������� */ 1551 while (bufp > 1) { 1552 untyi(tempbuf[--bufp]); 1553 } 1554 ch = (unsigned)(unsigned char)tempbuf[0]; 1555 goto return_char; 1556 } 1557 } 1558 else { 1559 return_char: 1560 if (ch == 0x8f) { /* SS3 */ 1561 ch <<= 8; 1562 ch += tyi(); 1563 goto shift_more; 1564 } 1565 else if (ch & 0x80) { /* �������������������������������������������������������� */ 1566 shift_more: 1567 ch <<= 8; 1568 ch += tyi(); 1569 } 1570 retval = mknum(ch); 1571 } 1572 1573 free(tempbuf); 1574 return retval; 1575} 1576 1577static int 1578isnum(char *name) 1579{ 1580 if (*name == '-') { 1581 name++; 1582 if ( !*name ) 1583 return(NO); 1584 } 1585 for(; *name ; name++) { 1586 if (*name < '0' || '9' < *name) { 1587 if (*name != '.' || *(name + 1)) { 1588 return(NO); 1589 } 1590 } 1591 } 1592 return(YES); 1593} 1594 1595/* tyi -- input one character from buffered stream */ 1596 1597static void 1598untyi(int c) 1599{ 1600 if (readbuf < readptr) { 1601 *--readptr = c; 1602 } 1603 else { 1604 if (untyip >= untyisize) { 1605 if (untyisize == 0) { 1606 untyibuf = (char *)malloc(UNTYIUNIT); 1607 if (untyibuf) { 1608 untyisize = UNTYIUNIT; 1609 } 1610 }else{ 1611 untyibuf = (char *)realloc(untyibuf, UNTYIUNIT + untyisize); 1612 if (untyibuf) { 1613 untyisize += UNTYIUNIT; 1614 } 1615 } 1616 } 1617 if (untyip < untyisize) { /* ���������������������������������������� */ 1618 untyibuf[untyip++] = c; 1619 } 1620 } 1621} 1622 1623static int 1624tyi(void) 1625{ 1626 if (untyibuf) { 1627 int ret = untyibuf[--untyip]; 1628 if (untyip == 0) { 1629 free(untyibuf); 1630 untyibuf = (char *)0; 1631 untyisize = 0; 1632 } 1633 return ret; 1634 } 1635 1636 if (readptr && *readptr) { 1637 return ((int)(unsigned char)*readptr++); 1638 } 1639 else if (!files[filep].f) { 1640 return NO; 1641 } 1642 else if (files[filep].f == stdin) { 1643 readptr = fgets(readbuf, BUFSIZE, stdin); 1644 files[filep].line++; 1645 if ( !readptr ) { 1646 return NO; 1647 } 1648 else { 1649 return tyi(); 1650 } 1651 } 1652 else { 1653 readptr = fgets(readbuf,BUFSIZE,files[filep].f); 1654 files[filep].line++; 1655 if (readptr) { 1656 return(tyi()); 1657 } 1658 else { 1659 return(NO); 1660 } 1661 } 1662 /* NOTREACHED */ 1663} 1664 1665/* tyipeek -- input one character without advance the read pointer */ 1666 1667static int 1668tyipeek(void) 1669{ 1670 int c = tyi(); 1671 untyi(c); 1672 return c; 1673} 1674 1675 1676 1677/* prins - 1678 print string */ 1679 1680static void prins(char *s) 1681{ 1682 while (*s) { 1683 tyo(*s++); 1684 } 1685} 1686 1687 1688/* isterm - 1689 check if the character is terminating the lisp expression */ 1690 1691static int isterm(int c) 1692{ 1693 if (c <= ' ') 1694 return(YES); 1695 else { 1696 switch (c) 1697 { 1698 case '(': 1699 case ')': 1700 case ';': 1701 return(YES); 1702 default: 1703 return(NO); 1704 } 1705 } 1706} 1707 1708/* push down an S-expression to parameter stack */ 1709 1710static void 1711push(list value) 1712{ 1713 if (sp <= stack) { 1714 error("Stack over flow",NON); 1715 /* NOTREACHED */ 1716 } 1717 else 1718 *--sp = value; 1719} 1720 1721/* pop up n S-expressions from parameter stack */ 1722 1723static void 1724pop(int x) 1725{ 1726 if (0 < x && sp >= &stack[STKSIZE]) { 1727 error("Stack under flow",NON); 1728 /* NOTREACHED */ 1729 } 1730 sp += x; 1731} 1732 1733/* pop up an S-expression from parameter stack */ 1734 1735static list 1736pop1(void) 1737{ 1738 if (sp >= &stack[STKSIZE]) { 1739 error("Stack under flow",NON); 1740 /* NOTREACHED */ 1741 } 1742 return(*sp++); 1743} 1744 1745static void 1746epush(list value) 1747{ 1748 if (esp <= estack) { 1749 error("Estack over flow",NON); 1750 /* NOTREACHED */ 1751 } 1752 else 1753 *--esp = value; 1754} 1755 1756static list 1757epop(void) 1758{ 1759 if (esp >= &estack[STKSIZE]) { 1760 error("Lstack under flow",NON); 1761 /* NOTREACHED */ 1762 } 1763 return(*esp++); 1764} 1765 1766 1767/* 1768** output function for lisp S-Expression 1769*/ 1770 1771 1772/* 1773** print atom function 1774** please make sure it is an atom (not list) 1775** no check is done here. 1776*/ 1777 1778static void 1779patom(list atm) 1780{ 1781 char namebuf[BUFSIZE]; 1782 1783 if (constp(atm)) { 1784 if (numberp(atm)) { 1785 (void)sprintf(namebuf,"%d",xnum(atm)); 1786 prins(namebuf); 1787 } 1788 else { /* this is a string */ 1789 int i, len = xstrlen(atm); 1790 char *s = xstring(atm); 1791 1792 tyo('"'); 1793 for (i = 0 ; i < len ; i++) { 1794 tyo(s[i]); 1795 } 1796 tyo('"'); 1797 } 1798 } 1799 else { 1800 prins(symbolpointer(atm)->pname); 1801 } 1802} 1803 1804static char *oldcelltop; 1805static char *oldcellp; 1806 1807#define oldpointer(x) (oldcelltop + celloffset(x)) 1808 1809static void 1810gc(void) /* ���������������������������������������������������������������������������� */ 1811{ 1812 int i; 1813 list *p; 1814 static int under_gc = 0; 1815 1816 if (under_gc) { 1817 fatal("GC: memory exhausted.", NON); 1818 } 1819 else { 1820 under_gc = 1; 1821 } 1822 1823 oldcellp = memtop; oldcelltop = celltop; 1824 1825 if ( !alloccell() ) { 1826 fatal("GC: failed in allocating new cell area.", NON); 1827 /* NOTREACHED */ 1828 } 1829 1830 for (i = 0 ; i < BUFSIZE ; i++) { 1831 markcopycell(oblist + i); 1832 } 1833 for (p = sp ; p < &stack[STKSIZE] ; p++) { 1834 markcopycell(p); 1835 } 1836 for (p = esp ; p < &estack[STKSIZE] ; p++) { 1837 markcopycell(p); 1838 } 1839 for (i = 0 ; i < valuec ; i++) { 1840 markcopycell(values + i); 1841 } 1842 markcopycell(&T); 1843 markcopycell("E); 1844 markcopycell(&_LAMBDA); 1845 markcopycell(&_MACRO); 1846 markcopycell(&COND); 1847 markcopycell(&USER); 1848 markcopycell(&BUSHU); 1849 markcopycell(&GRAMMAR); 1850 markcopycell(&RENGO); 1851 markcopycell(&KATAKANA); 1852 markcopycell(&HIRAGANA); 1853 markcopycell(&HYPHEN); 1854 free(oldcellp); 1855 if ((freecell - celltop) * 2 > cellbtm -celltop) { 1856 ncells = (freecell - celltop) * 2 / sizeof(list); 1857 } 1858 under_gc = 0; 1859} 1860 1861static char *Strncpy(); 1862 1863static list 1864allocstring(int n) 1865{ 1866 int namesize; 1867 list retval; 1868 1869 namesize = ((n + (sizeof(pointerint)) + 1 + 3)/ sizeof(list)) * sizeof(list); 1870 if (freecell + namesize >= cellbtm) { /* gc ���������������������������������������� */ 1871 gc(); 1872 } 1873 ((struct stringcell *)freecell)->length = n; 1874 retval = STRING_TAG | (freecell - celltop); 1875 freecell += namesize; 1876 return retval; 1877} 1878 1879static list 1880copystring(char *s, int n) 1881{ 1882 list retval; 1883 1884 retval = allocstring(n); 1885 (void)Strncpy(xstring(retval), s, n); 1886 xstring(retval)[n] = '\0'; 1887 return retval; 1888} 1889 1890static list 1891copycons(struct cell *l) 1892{ 1893 list newcell; 1894 1895 newcell = newcons(); 1896 car(newcell) = l->head; 1897 cdr(newcell) = l->tail; 1898 return newcell; 1899} 1900 1901static void 1902markcopycell(list *addr) 1903{ 1904 list temp; 1905 redo: 1906 if (null(*addr) || numberp(*addr)) { 1907 return; 1908 } 1909 else if (alreadycopied(oldpointer(*addr))) { 1910 *addr = newaddr(gcfield(oldpointer(*addr))); 1911 return; 1912 } 1913 else if (stringp(*addr)) { 1914 temp = copystring(((struct stringcell *)oldpointer(*addr))->str, 1915 ((struct stringcell *)oldpointer(*addr))->length); 1916 gcfield(oldpointer(*addr)) = mkcopied(temp); 1917 *addr = temp; 1918 return; 1919 } 1920 else if (consp(*addr)) { 1921 temp = copycons((struct cell *)(oldpointer(*addr))); 1922 gcfield(oldpointer(*addr)) = mkcopied(temp); 1923 *addr = temp; 1924 markcopycell(&car(temp)); 1925 addr = &cdr(temp); 1926 goto redo; 1927 } 1928 else { /* symbol */ 1929 struct atomcell *newatom, *oldatom; 1930 1931 oldatom = (struct atomcell *)(oldpointer(*addr)); 1932 temp = newsymbol(oldatom->pname); 1933 newatom = symbolpointer(temp); 1934 newatom->value = oldatom->value; 1935 newatom->plist = oldatom->plist; 1936 newatom->ftype = oldatom->ftype; 1937 newatom->func = oldatom->func; 1938 newatom->fid = oldatom->fid; 1939 newatom->mid = oldatom->mid; 1940 newatom->valfunc = oldatom->valfunc; 1941 newatom->hlink = oldatom->hlink; 1942 1943 gcfield(oldpointer(*addr)) = mkcopied(temp); 1944 *addr = temp; 1945 1946 if (newatom->value != (list)UNBOUND) { 1947 markcopycell(&newatom->value); 1948 } 1949 markcopycell(&newatom->plist); 1950 if (newatom->ftype == EXPR || newatom->ftype == MACRO) { 1951 markcopycell((list *)&newatom->func); 1952 } 1953 addr = &newatom->hlink; 1954 goto redo; 1955 } 1956} 1957 1958static list 1959bindall(list var, list par, list a, list e) 1960{ 1961 list *pa, *pe, retval; 1962 1963 push(a); pa = sp; 1964 push(e); pe = sp; 1965 retry: 1966 if (constp(var)) { 1967 pop(2); 1968 return(*pa); 1969 } 1970 else if (atom(var)) { 1971 push(var); 1972 push(par); 1973 push(Lcons(2)); 1974 push(*pa); 1975 retval = Lcons(2); 1976 pop(2); 1977 return retval; 1978 } 1979 else if (atom(par)) { 1980 error("Bad macro form ",e); 1981 /* NOTREACHED */ 1982 } 1983 push(par); 1984 push(var); 1985 *pa = bindall(car(var),car(par),*pa,*pe); 1986 var = cdr(pop1()); 1987 par = cdr(pop1()); 1988 goto retry; 1989 /* NOTREACHED */ 1990} 1991 1992static list 1993Lquote(void) 1994{ 1995 list p; 1996 1997 p = pop1(); 1998 if (atom(p)) 1999 return(NIL); 2000 else 2001 return(car(p)); 2002} 2003 2004static list 2005Leval(int n) 2006{ 2007 list e, t, s, tmp, aa, *pe, *pt, *ps, *paa; 2008 list fn, (*cfn)(...), *pfn; 2009 int i, j; 2010 argnchk("eval",1); 2011 e = sp[0]; 2012 pe = sp; 2013 if (atom(e)) { 2014 if (constp(e)) { 2015 pop1(); 2016 return(e); 2017 } 2018 else { 2019 struct atomcell *sym; 2020 2021 t = assq(e, *esp); 2022 if (t) { 2023 (void)pop1(); 2024 return(cdr(t)); 2025 } 2026 else if ((sym = symbolpointer(e))->valfunc) { 2027 (void)pop1(); 2028 return (sym->valfunc)(VALGET, 0); 2029 }else{ 2030 if ((t = (sym->value)) != (list)UNBOUND) { 2031 pop1(); 2032 return(t); 2033 } 2034 else { 2035 error("Unbound variable: ",*pe); 2036 /* NOTREACHED */ 2037 } 2038 } 2039 } 2040 } 2041 else if (constp((fn = car(e)))) { /* not atom */ 2042 error("eval: undefined function ", fn); 2043 /* NOTREACHED */ 2044 } 2045 else if (atom(fn)) { 2046 switch (symbolpointer(fn)->ftype) { 2047 case UNDEF: 2048 error("eval: undefined function ", fn); 2049 /* NOTREACHED */ 2050 break; 2051 case SUBR: 2052 cfn = symbolpointer(fn)->func; 2053 i = evpsh(cdr(e)); 2054 epush(NIL); 2055 t = (*cfn)(i); 2056 epop(); 2057 pop1(); 2058 return (t); 2059 case SPECIAL: 2060 push(cdr(e)); 2061 t = (*(symbolpointer(fn)->func))(); 2062 pop1(); 2063 return (t); 2064 case EXPR: 2065 fn = (list)(symbolpointer(fn)->func); 2066 aa = NIL; /* previous env won't be used */ 2067 expr: 2068 if (atom(fn) || car(fn) != _LAMBDA || atom(cdr(fn))) { 2069 error("eval: bad lambda form ", fn); 2070 /* NOTREACHED */ 2071 } 2072/* Lambda binding begins here ... */ 2073 s = cdr(e); /* actual parameter */ 2074 t = cadr(fn); /* lambda list */ 2075 push(s); ps = sp; 2076 push(t); pt = sp; 2077 push(fn); pfn = sp; 2078 push(aa); paa = sp; 2079 i = 0; /* count of variables */ 2080 for (; consp(*ps) && consp(*pt) ; *ps = cdr(*ps), *pt = cdr(*pt)) { 2081 if (consp(car(*pt))) { 2082 tmp = cdar(*pt); /* push the cdr of element */ 2083 if (!(atom(tmp) || null(cdr(tmp)))) { 2084 push(cdr(tmp)); 2085 push(T); 2086 push(Lcons(2)); 2087 i++; 2088 } 2089 push(caar(*pt)); 2090 } 2091 else { 2092 push(car(*pt)); 2093 } 2094 push(car(*ps)); 2095 push(Leval(1)); 2096 push(Lcons(2)); 2097 i++; 2098 } 2099 for (; consp(*pt) ; *pt = cdr(*pt)) { 2100 if (atom(car(*pt))) { 2101 error("Too few actual parameters ",*pe); 2102 /* NOTREACHED */ 2103 } 2104 else { 2105 tmp = cdar(*pt); 2106 if (!(atom(tmp) || null(cdr(tmp)))) { 2107 push(cdr(tmp)); 2108 push(NIL); 2109 push(Lcons(2)); 2110 i++; 2111 } 2112 push(caar(*pt)); 2113 tmp = cdar(*pt); /* restore for GC */ 2114 if (atom(tmp)) 2115 push(NIL); 2116 else { 2117 push(car(tmp)); 2118 push(Leval(1)); 2119 } 2120 push(Lcons(2)); 2121 i++; 2122 } 2123 } 2124 if (null(*pt) && consp(*ps)) { 2125 error("Too many actual arguments ",*pe); 2126 /* NOTREACHED */ 2127 } 2128 else if (*pt) { 2129 push(*pt); 2130 for (j = 1 ; consp(*ps) ; j++) { 2131 push(car(*ps)); 2132 push(Leval(1)); 2133 *ps = cdr(*ps); 2134 } 2135 push(NIL); 2136 for (; j ; j--) { 2137 push(Lcons(2)); 2138 } 2139 i++; 2140 } 2141 push(*paa); 2142 for (; i ; i--) { 2143 push(Lcons(2)); 2144 } 2145/* Lambda binding finished, and a new environment is established. */ 2146 epush(pop1()); /* set the new environment */ 2147 push(cddr(*pfn)); 2148 t = Lprogn(); 2149 epop(); 2150 pop(5); 2151 return (t); 2152 case MACRO: 2153 fn = (list)(symbolpointer(fn)->func); 2154 if (atom(fn) || car(fn) != _MACRO || atom(cdr(fn))) { 2155 error("eval: bad macro form ",fn); 2156 /* NOTREACHED */ 2157 } 2158 s = cdr(e); /* actual parameter */ 2159 t = cadr(fn); /* lambda list */ 2160 push(fn); 2161 epush(bindall(t,s,NIL,e)); 2162 push(cddr(pop1())); 2163 t = Lprogn(); 2164 epop(); 2165 push(t); 2166 push(t); 2167 s = Leval(1); 2168 t = pop1(); 2169 if (!atom(t)) { 2170 car(*pe) = car(t); 2171 cdr(*pe) = cdr(t); 2172 } 2173 pop1(); 2174 return (s); 2175 case CMACRO: 2176 push(e); 2177 push(t = (*(symbolpointer(fn)->func))()); 2178 push(t); 2179 s = Leval(1); 2180 t = pop1(); 2181 if (!atom(t)) { 2182 car(e) = car(t); 2183 cdr(e) = cdr(t); 2184 } 2185 pop1(); 2186 return (s); 2187 default: 2188 error("eval: unrecognized ftype used in ", fn); 2189 /* NOTREACHED */ 2190 break; 2191 } 2192 /* NOTREACHED */ 2193 } 2194 else { /* fn is list (lambda expression) */ 2195 aa = *esp; /* previous environment is also used */ 2196 goto expr; 2197 } 2198 /* maybe NOTREACHED */ 2199 return NIL; 2200} 2201 2202static list 2203assq(list e, list a) 2204{ 2205 list i; 2206 2207 for (i = a ; i ; i = cdr(i)) { 2208 if (consp(car(i)) && e == caar(i)) { 2209 return(car(i)); 2210 } 2211 } 2212 return((list)NIL); 2213} 2214 2215/* eval each argument and push down each value to parameter stack */ 2216 2217static int 2218evpsh(list args) 2219{ 2220 int counter; 2221 list temp; 2222 2223 counter = 0; 2224 while (consp(args)) { 2225 push(args); 2226 push(car(args)); 2227 temp = Leval(1); 2228 args = cdr(pop1()); 2229 counter++; 2230 push(temp); 2231 } 2232 return (counter); 2233} 2234 2235/* 2236static int 2237psh(args) 2238list args; 2239{ 2240 int counter; 2241 2242 counter = 0; 2243 while (consp(args)) { 2244 push(car(args)); 2245 counter++; 2246 args = cdr(args); 2247 } 2248 return (counter); 2249} 2250*/ 2251 2252static list 2253Lprogn(void) 2254{ 2255 list val, *pf; 2256 2257 val = NIL; 2258 pf = sp; 2259 for (; consp(*pf) ; *pf = cdr(*pf)) { 2260 symbolpointer(T)->value = T; 2261 push(car(*pf)); 2262 val = Leval(1); 2263 } 2264 pop1(); 2265 return (val); 2266} 2267 2268static list 2269Lcons(int n) 2270{ 2271 list temp; 2272 2273 argnchk("cons",2); 2274 temp = newcons(); 2275 cdr(temp) = pop1(); 2276 car(temp) = pop1(); 2277 return(temp); 2278} 2279 2280static list 2281Lncons(int n) 2282{ 2283 list temp; 2284 2285 argnchk("ncons",1); 2286 temp = newcons(); 2287 car(temp) = pop1(); 2288 cdr(temp) = NIL; 2289 return(temp); 2290} 2291 2292static list 2293Lxcons(int n) 2294{ 2295 list temp; 2296 2297 argnchk("cons",2); 2298 temp = newcons(); 2299 car(temp) = pop1(); 2300 cdr(temp) = pop1(); 2301 return(temp); 2302} 2303 2304static list 2305Lprint(int n) 2306{ 2307 print(sp[0]); 2308 pop(n); 2309 return (T); 2310} 2311 2312static list 2313Lset(int n) 2314{ 2315 list val, t; 2316 list var; 2317 struct atomcell *sym; 2318 2319 argnchk("set",2); 2320 val = pop1(); 2321 var = pop1(); 2322 if (!symbolp(var)) { 2323 error("set/setq: bad variable type ",var); 2324 /* NOTREACHED */ 2325 } 2326 sym = symbolpointer(var); 2327 t = assq(var,*esp); 2328 if (t) { 2329 return cdr(t) = val; 2330 } 2331 else if (sym->valfunc) { 2332 return (*(sym->valfunc))(VALSET, val); 2333 } 2334 else { 2335 return sym->value = val; /* global set */ 2336 } 2337} 2338 2339static list 2340Lsetq(void) 2341{ 2342 list a, *pp; 2343 2344 a = NIL; 2345 for (pp = sp; consp(*pp) ; *pp = cdr(*pp)) { 2346 push(car(*pp)); 2347 *pp = cdr(*pp); 2348 if ( atom(*pp) ) { 2349 error("Odd number of args to setq",NON); 2350 /* NOTREACHED */ 2351 } 2352 push(car(*pp)); 2353 push(Leval(1)); 2354 a = Lset(2); 2355 } 2356 pop1(); 2357 return(a); 2358} 2359 2360static int equal(); 2361 2362static list 2363Lequal(int n) 2364{ 2365 argnchk("equal (=)",2); 2366 if (equal(pop1(),pop1())) 2367 return(T); 2368 else 2369 return(NIL); 2370} 2371 2372/* null �������������������������������� strncmp */ 2373 2374static int 2375Strncmp(char *x, char *y, int len) 2376{ 2377 int i; 2378 2379 for (i = 0 ; i < len ; i++) { 2380 if (x[i] != y[i]) { 2381 return (x[i] - y[i]); 2382 } 2383 } 2384 return 0; 2385} 2386 2387/* null �������������������������������� strncpy */ 2388 2389static char * 2390Strncpy(char *x, char *y, int len) 2391{ 2392 int i; 2393 2394 for (i = 0 ; i < len ; i++) { 2395 x[i] = y[i]; 2396 } 2397 return x; 2398} 2399 2400static int 2401equal(list x, list y) 2402{ 2403 equaltop: 2404 if (x == y) 2405 return(YES); 2406 else if (null(x) || null(y)) 2407 return(NO); 2408 else if (numberp(x) || numberp(y)) { 2409 return NO; 2410 } 2411 else if (stringp(x)) { 2412 if (stringp(y)) { 2413 return ((xstrlen(x) == xstrlen(y)) ? 2414 (!Strncmp(xstring(x), xstring(y), xstrlen(x))) : 0); 2415 } 2416 else { 2417 return NO; 2418 } 2419 } 2420 else if (symbolp(x) || symbolp(y)) { 2421 return(NO); 2422 } 2423 else { 2424 if (equal(car(x), car(y))) { 2425 x = cdr(x); 2426 y = cdr(y); 2427 goto equaltop; 2428 } 2429 else 2430 return(NO); 2431 } 2432} 2433 2434static list 2435Lgreaterp(int n) 2436{ 2437 list p; 2438 pointerint x, y; 2439 2440 if ( !n ) 2441 return(T); 2442 else { 2443 p = pop1(); 2444 if (!numberp(p)) { 2445 numerr("greaterp",p); 2446 /* NOTREACHED */ 2447 } 2448 x = xnum(p); 2449 for (n-- ; n ; n--) { 2450 p = pop1(); 2451 if (!numberp(p)) { 2452 numerr("greaterp",p); 2453 /* NOTREACHED */ 2454 } 2455 y = xnum(p); 2456 if (y <= x) /* !(y > x) */ 2457 return(NIL); 2458 x = y; 2459 } 2460 return(T); 2461 } 2462} 2463 2464static list 2465Llessp(int n) 2466{ 2467 list p; 2468 pointerint x, y; 2469 2470 if ( !n ) 2471 return(T); 2472 else { 2473 p = pop1(); 2474 if (!numberp(p)) { 2475 numerr("lessp",p); 2476 /* NOTREACHED */ 2477 } 2478 x = xnum(p); 2479 for (n-- ; n ; n--) { 2480 p = pop1(); 2481 if (!numberp(p)) { 2482 numerr("lessp",p); 2483 /* NOTREACHED */ 2484 } 2485 y = xnum(p); 2486 if (y >= x) /* !(y < x) */ 2487 return(NIL); 2488 x = y; 2489 } 2490 return(T); 2491 } 2492} 2493 2494static list 2495Leq(int n) 2496{ 2497 list f; 2498 2499 argnchk("eq",2); 2500 f = pop1(); 2501 if (f == pop1()) 2502 return(T); 2503 else 2504 return(NIL); 2505} 2506 2507static list 2508Lcond(void) 2509{ 2510 list *pp, t, a, c; 2511 2512 pp = sp; 2513 for (; consp(*pp) ; *pp = cdr(*pp)) { 2514 t = car(*pp); 2515 if (atom(t)) { 2516 pop1(); 2517 return (NIL); 2518 } 2519 else { 2520 push(cdr(t)); 2521 if ((c = car(t)) == T || (push(c), (a = Leval(1)))) { 2522 /* if non NIL */ 2523 t = pop1(); 2524 if (null(t)) { /* if cdr is NIL */ 2525 (void)pop1(); 2526 return (a); 2527 } 2528 else { 2529 (void)pop1(); 2530 push(t); 2531 return(Lprogn()); 2532 } 2533 }else{ 2534 (void)pop1(); 2535 } 2536 } 2537 } 2538 pop1(); 2539 return (NIL); 2540} 2541 2542static list 2543Lnull(int n) 2544{ 2545 argnchk("null",1); 2546 if (pop1()) 2547 return NIL; 2548 else 2549 return T; 2550} 2551 2552static list 2553Lor(void) 2554{ 2555 list *pp, t; 2556 2557 for (pp = sp; consp(*pp) ; *pp = cdr(*pp)) { 2558 push(car(*pp)); 2559 t = Leval(1); 2560 if (t) { 2561 pop1(); 2562 return(t); 2563 } 2564 } 2565 pop1(); 2566 return(NIL); 2567} 2568 2569static list 2570Land(void) 2571{ 2572 list *pp, t; 2573 2574 t = T; 2575 for (pp = sp; consp(*pp) ; *pp = cdr(*pp)) { 2576 push(car(*pp)); 2577 if ( !(t = Leval(1)) ) { 2578 pop1(); 2579 return(NIL); 2580 } 2581 } 2582 pop1(); 2583 return(t); 2584} 2585 2586static list 2587Lplus(int n) 2588{ 2589 list t; 2590 int i; 2591 pointerint sum; 2592 2593 i = n; 2594 sum = 0; 2595 while (i--) { 2596 t = sp[i]; 2597 if ( !numberp(t) ) { 2598 numerr("+",t); 2599 /* NOTREACHED */ 2600 } 2601 else { 2602 sum += xnum(t); 2603 } 2604 } 2605 pop(n); 2606 return(mknum(sum)); 2607} 2608 2609static list 2610Ltimes(int n) 2611{ 2612 list t; 2613 int i; 2614 pointerint sum; 2615 2616 i = n; 2617 sum = 1; 2618 while (i--) { 2619 t = sp[i]; 2620 if ( !numberp(t) ) { 2621 numerr("*",t); 2622 /* NOTREACHED */ 2623 } 2624 else 2625 sum *= xnum(t); 2626 } 2627 pop(n); 2628 return(mknum(sum)); 2629} 2630 2631static list 2632Ldiff(int n) 2633{ 2634 list t; 2635 int i; 2636 pointerint sum; 2637 2638 if ( !n ) 2639 return(mknum(0)); 2640 t = sp[n - 1]; 2641 if ( !numberp(t) ) { 2642 numerr("-",t); 2643 /* NOTREACHED */ 2644 } 2645 sum = xnum(t); 2646 if (n == 1) { 2647 pop1(); 2648 return(mknum(-sum)); 2649 } 2650 else { 2651 i = n - 1; 2652 while (i--) { 2653 t = sp[i]; 2654 if ( !numberp(t) ) { 2655 numerr("-",t); 2656 /* NOTREACHED */ 2657 } 2658 else 2659 sum -= xnum(t); 2660 } 2661 pop(n); 2662 return(mknum(sum)); 2663 } 2664} 2665 2666static list 2667Lquo(int n) 2668{ 2669 list t; 2670 int i; 2671 pointerint sum; 2672 2673 if ( !n ) 2674 return(mknum(1)); 2675 t = sp[n - 1]; 2676 if ( !numberp(t) ) { 2677 numerr("/",t); 2678 /* NOTREACHED */ 2679 } 2680 sum = xnum(t); 2681 i = n - 1; 2682 while (i--) { 2683 t = sp[i]; 2684 if ( !numberp(t) ) { 2685 numerr("/",t); 2686 /* NOTREACHED */ 2687 } 2688 else if (xnum(t) != 0) { 2689 sum = sum / (pointerint)xnum(t); /* CP/M68K is bad... */ 2690 } 2691 else { /* division by zero */ 2692 error("Division by zero",NON); 2693 } 2694 } 2695 pop(n); 2696 return(mknum(sum)); 2697} 2698 2699static list 2700Lrem(int n) 2701{ 2702 list t; 2703 int i; 2704 pointerint sum; 2705 2706 if ( !n ) 2707 return(mknum(0)); 2708 t = sp[n - 1]; 2709 if ( !numberp(t) ) { 2710 numerr("%",t); 2711 /* NOTREACHED */ 2712 } 2713 sum = xnum(t); 2714 i = n - 1; 2715 while (i--) { 2716 t = sp[i]; 2717 if ( !numberp(t) ) { 2718 numerr("%",t); 2719 /* NOTREACHED */ 2720 } 2721 else if (xnum(t) != 0) { 2722 sum = sum % (pointerint)xnum(t); /* CP/M68K is bad .. */ 2723 } 2724 else { /* division by zero */ 2725 error("Division by zero",NON); 2726 } 2727 } 2728 pop(n); 2729 return(mknum(sum)); 2730} 2731 2732/* 2733 * Garbage Collection 2734 */ 2735 2736static list 2737Lgc(int n) 2738{ 2739 argnchk("gc",0); 2740 gc(); 2741 return(NIL); 2742} 2743 2744static list 2745Lusedic(int n) 2746{ 2747 int i; 2748 list retval = NIL, temp; 2749 int dictype; 2750#ifndef WIN_CANLISP 2751 extern struct dicname *kanjidicnames; 2752 struct dicname *kanjidicname; 2753 extern int auto_define; 2754#endif 2755 2756 for (i = n ; i ; i--) { 2757 temp = sp[i - 1]; 2758 dictype = DIC_PLAIN; 2759 if (symbolp(temp) && i - 1 > 0) { 2760 if (temp == USER) { 2761 dictype = DIC_USER; 2762 } 2763 else if (temp == BUSHU) { 2764 dictype = DIC_BUSHU; 2765 } 2766 else if (temp == GRAMMAR) { 2767 dictype = DIC_GRAMMAR; 2768 } 2769 else if (temp == RENGO) { 2770 dictype = DIC_RENGO; 2771 } 2772 else if (temp == KATAKANA) { 2773 dictype = DIC_KATAKANA; 2774#ifndef WIN_CANLISP 2775 auto_define = 1; 2776#endif 2777 } 2778 else if (temp == HIRAGANA) { 2779 dictype = DIC_HIRAGANA; 2780#if defined(HIRAGANAAUTO) && defined(WIN_CANLISP) 2781 auto_define = 1; 2782#endif 2783 } 2784 i--; temp = sp[i - 1]; 2785 } 2786 if (stringp(temp)) { 2787#ifndef WIN_CANLISP 2788 kanjidicname = (struct dicname *)malloc(sizeof(struct dicname)); 2789 if (kanjidicname) { 2790 kanjidicname->name = (char *)malloc(strlen(xstring(temp)) + 1); 2791 if (kanjidicname->name) { 2792 strcpy(kanjidicname->name , xstring(temp)); 2793 kanjidicname->dictype = dictype; 2794 kanjidicname->dicflag = DIC_NOT_MOUNTED; 2795 kanjidicname->next = kanjidicnames; 2796 kanjidicnames = kanjidicname; 2797 retval = T; 2798 continue; 2799 } 2800 free(kanjidicname); 2801 } 2802#else /* if WIN_CANLISP */ 2803 if (wins.conf && wins.conf->dicfn) { 2804 (*wins.conf->dicfn)(xstring(temp), dictype, wins.context); 2805 } 2806#endif /* WIN_CANLISP */ 2807 } 2808 } 2809 pop(n); 2810 return retval; 2811} 2812 2813static list 2814Llist(int n) 2815{ 2816 push(NIL); 2817 for (; n ; n--) { 2818 push(Lcons(2)); 2819 } 2820 return (pop1()); 2821} 2822 2823static list 2824Lcopysym(int n) 2825{ 2826 list src, dst; 2827 struct atomcell *dsta, *srca; 2828 2829 argnchk("copy-symbol",2); 2830 src = pop1(); 2831 dst = pop1(); 2832 if (!symbolp(dst)) { 2833 error("copy-symbol: bad arg ", dst); 2834 /* NOTREACHED */ 2835 } 2836 if (!symbolp(src)) { 2837 error("copy-symbol: bad arg ", src); 2838 /* NOTREACHED */ 2839 } 2840 dsta = symbolpointer(dst); 2841 srca = symbolpointer(src); 2842 dsta->plist = srca->plist; 2843 dsta->value = srca->value; 2844 dsta->ftype = srca->ftype; 2845 dsta->func = srca->func; 2846 dsta->valfunc = srca->valfunc; 2847 dsta->mid = srca->mid; 2848 dsta->fid = srca->fid; 2849 return src; 2850} 2851 2852static list 2853Lload(int n) 2854{ 2855 list p, t; 2856 FILE *instream; 2857 2858 argnchk("load",1); 2859 p = pop1(); 2860 if ( !stringp(p) ) { 2861 error("load: illegal file name ",p); 2862 /* NOTREACHED */ 2863 } 2864 if ((instream = fopen(xstring(p), "r")) == (FILE *)NULL) { 2865 error("load: file not found ",p); 2866 /* NOTREACHED */ 2867 } 2868 prins("[load "); 2869 print(p); 2870 prins("]\n"); 2871 2872 if (jmpenvp <= 0) { /* ������������������������������������ */ 2873 return NIL; 2874 } 2875 jmpenvp--; 2876 files[++filep].f = instream; 2877 files[filep].name = (char *)malloc(xstrlen(p) + 1); 2878 if (files[filep].name) { 2879 strcpy(files[filep].name, xstring(p)); 2880 } 2881 files[filep].line = 0; 2882 2883 setjmp(env[jmpenvp].jmp_env); 2884 env[jmpenvp].base_stack = sp - stack; 2885 env[jmpenvp].base_estack = esp - estack; 2886 2887 for (;;) { 2888 t = Lread(0); 2889 if (valuec > 1 && null(values[1])) { 2890 break; 2891 } 2892 else { 2893 push(t); 2894 Leval(1); 2895 } 2896 } 2897 jmpenvp++; 2898 return(T); 2899} 2900 2901static list 2902Lmodestr(int n) 2903{ 2904 list p; 2905 int mode; 2906 2907 argnchk(S_SetModeDisp, 2); 2908 if ( !null(p = sp[0]) && !stringp(p) ) { 2909 lisp_strerr(S_SetModeDisp, p); 2910 /* NOTREACHED */ 2911 } 2912 if (!symbolp(sp[1]) || (mode = symbolpointer(sp[1])->mid) == -1) { 2913 error("Illegal mode ", sp[1]); 2914 /* NOTREACHED */ 2915 } 2916#ifndef WIN_CANLISP 2917 changeModeName(mode, null(p) ? 0 : xstring(p)); 2918#endif 2919 pop(2); 2920 return p; 2921} 2922 2923/* ������������������������������������������������ */ 2924 2925static int 2926xfseq(char *fname, list l, unsigned char *arr, int arrsize) 2927{ 2928 int i; 2929 2930 if (atom(l)) { 2931 if (symbolp(l) && 2932 (arr[0] = (unsigned char)(symbolpointer(l)->fid)) != 255) { 2933 arr[1] = 0; 2934 } 2935 else { 2936 prins(fname); 2937 error(": illegal function ", l); 2938 /* NOTREACHED */ 2939 } 2940 return 1; 2941 } 2942 else { 2943 for (i = 0 ; i < arrsize - 1 && consp(l) ; i++, l = cdr(l)) { 2944 list temp = car(l); 2945 2946 if (!symbolp(temp) || 2947 (arr[i] = (unsigned char)(symbolpointer(temp)->fid)) == 255) { 2948 prins(fname); 2949 error(": illegal function ", temp); 2950 /* NOTREACHED */ 2951 } 2952 } 2953 arr[i] = 0; 2954 return i; 2955 } 2956} 2957 2958static list 2959Lsetkey(int n) 2960{ 2961 list p; 2962 int mode, slen; 2963 unsigned char fseq[256]; 2964 unsigned char keyseq[256]; 2965#ifndef WIN_CANLISP 2966 int retval; 2967#endif 2968 2969 argnchk(S_SetKey, 3); 2970 if ( !stringp(p = sp[1]) ) { 2971 lisp_strerr(S_SetKey, p); 2972 /* NOTREACHED */ 2973 } 2974 if (!symbolp(sp[2]) || (mode = symbolpointer(sp[2])->mid) < 0 || 2975 (CANNA_MODE_MAX_REAL_MODE <= mode && 2976 mode < CANNA_MODE_MAX_IMAGINARY_MODE && 2977 mode != CANNA_MODE_HenkanNyuryokuMode)) { 2978 error("Illegal mode for set-key ", sp[2]); 2979 /* NOTREACHED */ 2980 } 2981 if (xfseq(S_SetKey, sp[0], fseq, 256)) { 2982 slen = xstrlen(p); 2983 Strncpy((char *)keyseq, xstring(p), slen); 2984 keyseq[slen] = 255; 2985#ifndef WIN_CANLISP 2986 retval = changeKeyfunc(mode, (unsigned)keyseq[0], 2987 slen > 1 ? CANNA_FN_UseOtherKeymap : 2988 (fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0]), 2989 fseq, keyseq); 2990 if (retval == NG) { 2991 error("Insufficient memory.", NON); 2992 /* NOTREACHED */ 2993 } 2994#else 2995 if (wins.conf && wins.conf->keyfn) { 2996 (*wins.conf->keyfn)(mode, keyseq, slen, fseq, strlen(fseq), 2997 wins.context); 2998 } 2999#endif 3000 } 3001 pop(3); 3002 return p; 3003} 3004 3005static list 3006Lgsetkey(int n) 3007{ 3008 list p; 3009 int slen; 3010 unsigned char fseq[256]; 3011 unsigned char keyseq[256]; 3012#ifndef WIN_CANLISP 3013 int retval; 3014#endif 3015 3016 argnchk(S_GSetKey, 2); 3017 if ( !stringp(p = sp[1]) ) { 3018 lisp_strerr(S_GSetKey, p); 3019 /* NOTREACHED */ 3020 } 3021 if (xfseq(S_GSetKey, sp[0], fseq, 256)) { 3022 slen = xstrlen(p); 3023 Strncpy((char *)keyseq, xstring(p), slen); 3024 keyseq[slen] = 255; 3025#ifndef WIN_CANLISP 3026 retval = changeKeyfuncOfAll((unsigned)keyseq[0], 3027 slen > 1 ? CANNA_FN_UseOtherKeymap : 3028 (fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0]), 3029 fseq, keyseq); 3030 if (retval == NG) { 3031 error("Insufficient memory.", NON); 3032 /* NOTREACHED */ 3033 } 3034#else /* if WIN_CANLISP */ 3035 if (wins.conf && wins.conf->keyfn) { 3036 (*wins.conf->keyfn)(255, keyseq, slen, fseq, strlen(fseq), wins.context); 3037 } 3038#endif /* WIN_CANLISP */ 3039 pop(2); 3040 return p; 3041 } 3042 else { 3043 pop(2); 3044 return NIL; 3045 } 3046} 3047 3048static list 3049Lputd(int n) 3050{ 3051 list body, a; 3052 list sym; 3053 struct atomcell *symp; 3054 3055 argnchk("putd",2); 3056 a = body = pop1(); 3057 sym = pop1(); 3058 symp = symbolpointer(sym); 3059 if (constp(sym) || consp(sym)) { 3060 error("putd: function name must be a symbol : ",sym); 3061 /* NOTREACHED */ 3062 } 3063 if (null(body)) { 3064 symp->ftype = UNDEF; 3065 symp->func = (list (*)(...))UNDEF; 3066 } 3067 else if (consp(body)) { 3068 if (car(body) == _MACRO) { 3069 symp->ftype = MACRO; 3070 symp->func = (list (*)(...))body; 3071 } 3072 else { 3073 symp->ftype = EXPR; 3074 symp->func = (list (*)(...))body; 3075 } 3076 } 3077 return(a); 3078} 3079 3080static list 3081Ldefun(void) 3082{ 3083 list form, res; 3084 3085 form = sp[0]; 3086 if (atom(form)) { 3087 error("defun: illegal form ",form); 3088 /* NOTREACHED */ 3089 } 3090 push(car(form)); 3091 push(_LAMBDA); 3092 push(cdr(form)); 3093 push(Lcons(2)); 3094 Lputd(2); 3095 res = car(pop1()); 3096 return (res); 3097} 3098 3099static list 3100Ldefmacro(void) 3101{ 3102 list form, res; 3103 3104 form = sp[0]; 3105 if (atom(form)) { 3106 error("defmacro: illegal form ",form); 3107 /* NOTREACHED */ 3108 } 3109 push(res = car(form)); 3110 push(_MACRO); 3111 push(cdr(form)); 3112 push(Lcons(2)); 3113 Lputd(2); 3114 pop1(); 3115 return (res); 3116} 3117 3118static list 3119Lcar(int n) 3120{ 3121 list f; 3122 3123 argnchk("car",1); 3124 f = pop1(); 3125 if (!f) 3126 return(NIL); 3127 else if (atom(f)) { 3128 error("Bad arg to car ",f); 3129 /* NOTREACHED */ 3130 } 3131 return(car(f)); 3132} 3133 3134static list 3135Lcdr(int n) 3136{ 3137 list f; 3138 3139 argnchk("cdr",1); 3140 f = pop1(); 3141 if (!f) 3142 return(NIL); 3143 else if (atom(f)) { 3144 error("Bad arg to cdr ",f); 3145 /* NOTREACHED */ 3146 } 3147 return(cdr(f)); 3148} 3149 3150static list 3151Latom(int n) 3152{ 3153 list f; 3154 3155 argnchk("atom",1); 3156 f = pop1(); 3157 if (atom(f)) 3158 return(T); 3159 else 3160 return(NIL); 3161} 3162 3163static list 3164Llet(void) 3165{ 3166 list lambda, args, p, *pp, *pq, *pl, *px; 3167 3168 px = sp; 3169 *px = cdr(*px); 3170 if (atom(*px)) { 3171 (void)pop1(); 3172 return(NIL); 3173 } 3174 else { 3175 push(NIL); 3176 args = Lncons(1); 3177 push(args); pq = sp; 3178 push(NIL); 3179 lambda = p = Lncons(1); 3180 push(lambda); 3181 3182 push(p); pp = sp; 3183 push(*pq); pq = sp; 3184 push(NIL); pl = sp; 3185 for (*pl = car(*px) ; consp(*pl) ; *pl = cdr(*pl)) { 3186 if (atom(car(*pl))) { 3187 push(car(*pl)); 3188 *pp = cdr(*pp) = Lncons(1); 3189 push(NIL); 3190 *pq = cdr(*pq) = Lncons(1); 3191 } 3192 else if (atom(cdar(*pl))) { 3193 push(caar(*pl)); 3194 *pp = cdr(*pp) = Lncons(1); 3195 push(NIL); 3196 *pq = cdr(*pq) = Lncons(1); 3197 }else{ 3198 push(caar(*pl)); 3199 *pp = cdr(*pp) = Lncons(1); 3200 push(cadr(car(*pl))); 3201 *pq = cdr(*pq) = Lncons(1); 3202 } 3203 } 3204 pop(3); 3205 sp[0] = cdr(sp[0]); 3206 sp[1] = cdr(sp[1]); 3207 push(cdr(*px)); 3208 push(Lcons(2)); 3209 push(_LAMBDA); 3210 push(Lxcons(2)); 3211 p = Lxcons(2); 3212 (void)pop1(); 3213 return(p); 3214 } 3215} 3216 3217/* (if con tr . falist) -> (cond (con tr) (t . falist))*/ 3218 3219static list 3220Lif(void) 3221{ 3222 list x, *px, retval; 3223 3224 x = cdr(sp[0]); 3225 if (atom(x) || atom(cdr(x))) { 3226 (void)pop1(); 3227 return NIL; 3228 } 3229 else { 3230 push(x); px = sp; 3231 3232 push(COND); 3233 3234 push(car(x)); 3235 push(cadr(x)); 3236 push(Llist(2)); 3237 3238 push(T); 3239 push(cddr(*px)); 3240 push(Lcons(2)); 3241 3242 retval = Llist(3); 3243 pop(2); 3244 return retval; 3245 } 3246} 3247 3248static list 3249Lunbindkey(int n) 3250{ 3251 unsigned char fseq[2]; 3252 static unsigned char keyseq[2] = {(unsigned char)CANNA_KEY_Undefine, 3253 (unsigned char)255}; 3254 int mode; 3255 list retval; 3256 3257 argnchk(S_UnbindKey, 2); 3258 if (!symbolp(sp[1]) || (mode = symbolpointer(sp[1])->mid) == -1) { 3259 error("Illegal mode ", sp[1]); 3260 /* NOTREACHED */ 3261 } 3262 if (xfseq(S_UnbindKey, sp[0], fseq, 2)) { 3263#ifndef WIN_CANLISP 3264 int ret; 3265 ret = changeKeyfunc(mode, CANNA_KEY_Undefine, 3266 fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0], 3267 fseq, keyseq); 3268 if (ret == NG) { 3269 error("Insufficient memory.", NON); 3270 /* NOTREACHED */ 3271 } 3272#else /* if WIN_CANLISP */ 3273 if (wins.conf && wins.conf->keyfn) { 3274 (*wins.conf->keyfn)(mode, keyseq, 1, fseq, 1, wins.context); 3275 } 3276#endif /* WIN_CANLISP */ 3277 retval = T; 3278 } 3279 else { 3280 retval = NIL; 3281 } 3282 pop(2); 3283 return retval; 3284} 3285 3286static list 3287Lgunbindkey(int n) 3288{ 3289 unsigned char fseq[2]; 3290 static unsigned char keyseq[2] = {(unsigned char)CANNA_KEY_Undefine, 3291 (unsigned char)255}; 3292 list retval; 3293 3294 argnchk(S_GUnbindKey, 1); 3295 if (xfseq(S_GUnbindKey, sp[0], fseq, 2)) { 3296#ifndef WIN_CANLISP 3297 int ret; 3298 ret = changeKeyfuncOfAll(CANNA_KEY_Undefine, 3299 fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0], 3300 fseq, keyseq); 3301 if (ret == NG) { 3302 error("Insufficient memory.", NON); 3303 /* NOTREACHED */ 3304 } 3305#else /* if WIN_CANLISP */ 3306 if (wins.conf && wins.conf->keyfn) { 3307 (*wins.conf->keyfn)(255, keyseq, 1, fseq, 1, wins.context); 3308 } 3309#endif /* WIN_CANLISP */ 3310 retval = T; 3311 } 3312 else { 3313 retval = NIL; 3314 } 3315 (void)pop1(); 3316 return retval; 3317} 3318 3319#define DEFMODE_MEMORY 0 3320#define DEFMODE_NOTSTRING 1 3321#define DEFMODE_ILLFUNCTION 2 3322 3323static list 3324Ldefmode(void) 3325{ 3326 list form, *sym, e, *p, fn, rd, md, us; 3327 extern extraFunc *extrafuncp; 3328 extern int nothermodes; 3329 extraFunc *extrafunc = (extraFunc *)0; 3330 int i, j; 3331#ifndef WIN_CANLISP 3332 int ecode; 3333 list l, edata; 3334#endif 3335 3336 form = pop1(); 3337 if (atom(form)) { 3338 error("Bad form ", form); 3339 /* NOTREACHED */ 3340 } 3341 push(car(form)); 3342 sym = sp; 3343 if (!symbolp(*sym)) { 3344 error("Symbol data expected ", *sym); 3345 /* NOTREACHED */ 3346 } 3347 3348 /* ������������������������������������ */ 3349 for (i = 0, e = cdr(form) ; i < 4 ; i++, e = cdr(e)) { 3350 if (atom(e)) { 3351 for (j = i ; j < 4 ; j++) { 3352 push(NIL); 3353 } 3354 break; 3355 } 3356 push(car(e)); 3357 } 3358 if (consp(e)) { 3359 error("Bad form ", form); 3360 /* NOTREACHED */ 3361 } 3362 3363 /* ���������������� */ 3364 for (i = 0, p = sym - 1 ; i < 4 ; i++, p--) { 3365 push(*p); 3366 push(Leval(1)); 3367 } 3368 us = pop1(); 3369 fn = pop1(); 3370 rd = pop1(); 3371 md = pop1(); 3372 pop(4); 3373 3374#ifndef WIN_CANLISP 3375 ecode = DEFMODE_MEMORY; 3376 extrafunc = (extraFunc *)malloc(sizeof(extraFunc)); 3377 if (extrafunc) { 3378 /* �������������������������������������������������������� */ 3379 symbolpointer(*sym)->mid = CANNA_MODE_MAX_IMAGINARY_MODE + nothermodes; 3380 symbolpointer(*sym)->fid = 3381 extrafunc->fnum = CANNA_FN_MAX_FUNC + nothermodes; 3382 3383 /* �������������������������������� */ 3384 extrafunc->display_name = (WCHAR_T *)NULL; 3385 extrafunc->u.modeptr = (newmode *)malloc(sizeof(newmode)); 3386 if (extrafunc->u.modeptr) { 3387 KanjiMode kanjimode; 3388 3389 extrafunc->u.modeptr->romaji_table = (char *)0; 3390 extrafunc->u.modeptr->romdic = (struct RkRxDic *)0; 3391 extrafunc->u.modeptr->romdic_owner = 0; 3392 extrafunc->u.modeptr->flags = CANNA_YOMI_IGNORE_USERSYMBOLS; 3393 extrafunc->u.modeptr->emode = (KanjiMode)0; 3394 3395 /* ������������������������������������ */ 3396 kanjimode = (KanjiMode)malloc(sizeof(KanjiModeRec)); 3397 if (kanjimode) { 3398 extern KanjiModeRec empty_mode; 3399 extern BYTE *emptymap; 3400 3401 kanjimode->func = searchfunc; 3402 kanjimode->keytbl = emptymap; 3403 kanjimode->flags = 3404 CANNA_KANJIMODE_TABLE_SHARED | CANNA_KANJIMODE_EMPTY_MODE; 3405 kanjimode->ftbl = empty_mode.ftbl; 3406 extrafunc->u.modeptr->emode = kanjimode; 3407 3408 /* �������������������������������� */ 3409 ecode = DEFMODE_NOTSTRING; 3410 edata = md; 3411 if (stringp(md) || null(md)) { 3412 if (stringp(md)) { 3413 extrafunc->display_name = WString(xstring(md)); 3414 } 3415 ecode = DEFMODE_MEMORY; 3416 if (null(md) || extrafunc->display_name) { 3417 /* ������������������������������������������������ */ 3418 ecode = DEFMODE_NOTSTRING; 3419 edata = rd; 3420 if (stringp(rd) || null(rd)) { 3421 char *newstr; 3422 long f = extrafunc->u.modeptr->flags; 3423 3424 if (stringp(rd)) { 3425 newstr = (char *)malloc(strlen(xstring(rd)) + 1); 3426 } 3427 ecode = DEFMODE_MEMORY; 3428 if (null(rd) || newstr) { 3429 if (!null(rd)) { 3430 strcpy(newstr, xstring(rd)); 3431 extrafunc->u.modeptr->romaji_table = newstr; 3432 } 3433 /* ���������������� */ 3434 for (e = fn ; consp(e) ; e = cdr(e)) { 3435 l = car(e); 3436 if (symbolp(l) && symbolpointer(l)->fid) { 3437 switch (symbolpointer(l)->fid) { 3438 case CANNA_FN_Kakutei: 3439 f |= CANNA_YOMI_KAKUTEI; 3440 break; 3441 case CANNA_FN_Henkan: 3442 f |= CANNA_YOMI_HENKAN; 3443 break; 3444 case CANNA_FN_Zenkaku: 3445 f |= CANNA_YOMI_ZENKAKU; 3446 break; 3447 case CANNA_FN_Hankaku: 3448 f |= CANNA_YOMI_HANKAKU; 3449 break; 3450 case CANNA_FN_Hiragana: 3451 f |= CANNA_YOMI_HIRAGANA; 3452 break; 3453 case CANNA_FN_Katakana: 3454 f |= CANNA_YOMI_KATAKANA; 3455 break; 3456 case CANNA_FN_Romaji: 3457 f |= CANNA_YOMI_ROMAJI; 3458 break; 3459 /* ���������������������������������������� */ 3460 case CANNA_FN_ToUpper: 3461 break; 3462 case CANNA_FN_Capitalize: 3463 break; 3464 case CANNA_FN_ToLower: 3465 break; 3466 default: 3467 goto defmode_not_function; 3468 } 3469 } 3470 else { 3471 goto defmode_not_function; 3472 } 3473 } 3474 extrafunc->u.modeptr->flags = f; 3475 3476 /* ���������������������������������������������������� */ 3477 if (us) { 3478 extrafunc->u.modeptr->flags &= 3479 ~CANNA_YOMI_IGNORE_USERSYMBOLS; 3480 } 3481 3482 extrafunc->keyword = EXTRA_FUNC_DEFMODE; 3483 extrafunc->next = extrafuncp; 3484 extrafuncp = extrafunc; 3485 nothermodes++; 3486 return pop1(); 3487 3488 defmode_not_function: 3489 ecode = DEFMODE_ILLFUNCTION; 3490 edata = l; 3491 if (!null(rd)) { 3492 free(newstr); 3493 } 3494 } 3495 } 3496 if (extrafunc->display_name) { 3497 WSfree(extrafunc->display_name); 3498 } 3499 } 3500 } 3501 free(kanjimode); 3502 } 3503 free(extrafunc->u.modeptr); 3504 } 3505 free(extrafunc); 3506 } 3507 switch (ecode) { 3508 case DEFMODE_MEMORY: 3509 error("Insufficient memory", NON); 3510 case DEFMODE_NOTSTRING: 3511 error("String data expected ", edata); 3512 case DEFMODE_ILLFUNCTION: 3513 error("defmode: illegal subfunction ", edata); 3514 } 3515 /* NOTREACHED */ 3516#else /* if WIN_CANLISP */ 3517 /* �������������������������������������������������������� */ 3518 symbolpointer(*sym)->mid = CANNA_MODE_MAX_IMAGINARY_MODE + nothermodes; 3519 symbolpointer(*sym)->fid = CANNA_FN_MAX_FUNC + nothermodes; 3520 nothermodes++; 3521 return pop1(); 3522#endif /* WIN_CANLISP */ 3523} 3524 3525static list 3526Ldefsym(void) 3527{ 3528 list form, res, e; 3529 int i, ncand, group; 3530 WCHAR_T cand[1024], *p, *mcand, **acand, key, xkey; 3531 int mcandsize; 3532 extern int nkeysup; 3533 extern keySupplement keysup[]; 3534 3535 form = sp[0]; 3536 if (atom(form)) { 3537 error("Illegal form ",form); 3538 /* NOTREACHED */ 3539 } 3540 /* �������������������������������� */ 3541 for (ncand = 0 ; consp(form) ; ) { 3542 e = car(form); 3543 if (!numberp(e)) { 3544 error("Key data expected ", e); 3545 /* NOTREACHED */ 3546 } 3547 if (null(cdr(form))) { 3548 error("Illegal form ",sp[0]); 3549 /* NOTREACHED */ 3550 } 3551 if (numberp(car(cdr(form)))) { 3552 form = cdr(form); 3553 } 3554 for (i = 0, form = cdr(form) ; consp(form) ; i++, form = cdr(form)) { 3555 e = car(form); 3556 if (!stringp(e)) { 3557 break; 3558 } 3559 } 3560 if (ncand == 0) { 3561 ncand = i; 3562 } 3563 else if (ncand != i) { 3564 error("Inconsist number for each key definition ", sp[0]); 3565 /* NOTREACHED */ 3566 } 3567 } 3568 3569 group = nkeysup; 3570 3571 for (form = sp[0] ; consp(form) ;) { 3572 if (nkeysup >= MAX_KEY_SUP) { 3573 error("Too many symbol definitions", sp[0]); 3574 /* NOTREACHED */ 3575 } 3576 /* The following lines are for xkey translation rule */ 3577 key = (WCHAR_T)xnum(car(form)); 3578 if (numberp(car(cdr(form)))) { 3579 xkey = (WCHAR_T)xnum(car(cdr(form))); 3580 form = cdr(form); 3581 } 3582 else { 3583 xkey = key; 3584 } 3585 p = cand; 3586 for (form = cdr(form) ; consp(form) ; form = cdr(form)) { 3587 int len; 3588 3589 e = car(form); 3590 if (!stringp(e)) { 3591 break; 3592 } 3593 len = MBstowcs(p, xstring(e), 1024 - (p - cand)); 3594 p += len; 3595 *p++ = (WCHAR_T)0; 3596 } 3597 *p++ = (WCHAR_T)0; 3598 mcandsize = p - cand; 3599 mcand = (WCHAR_T *)malloc(mcandsize * sizeof(WCHAR_T)); 3600 if (mcand == 0) { 3601 error("Insufficient memory", NON); 3602 /* NOTREACHED */ 3603 } 3604 acand = (WCHAR_T **)calloc(ncand + 1, sizeof(WCHAR_T *)); 3605 if (acand == 0) { 3606 free(mcand); 3607 error("Insufficient memory", NON); 3608 /* NOTREACHED */ 3609 } 3610 3611 for (i = 0 ; i < p - cand ; i++) { 3612 mcand[i] = cand[i]; 3613 } 3614 for (i = 0, p = mcand ; i < ncand ; i++) { 3615 acand[i] = p; 3616 while (*p++) 3617 /* EMPTY */ 3618 ; 3619 } 3620 acand[i] = 0; 3621 /* ���������������������������� */ 3622 keysup[nkeysup].key = key; 3623 keysup[nkeysup].xkey = xkey; 3624 keysup[nkeysup].groupid = group; 3625 keysup[nkeysup].ncand = ncand; 3626 keysup[nkeysup].cand = acand; 3627 keysup[nkeysup].fullword = mcand; 3628#ifdef WIN_CANLISP 3629 keysup[nkeysup].fullwordsize = mcandsize - 1; /* exclude the extra EOS */ 3630#endif 3631 nkeysup++; 3632 } 3633#ifdef WIN_CANLISP 3634 if (wins.conf && wins.conf->symfn) { 3635 unsigned char *keys, *xkeys; 3636 WCHAR_T *words; 3637 int ngroups = nkeysup - group, fullwordlen, i; 3638 3639 for (fullwordlen = 0, i = group ; i < nkeysup ; i++) { 3640 fullwordlen += keysup[i].fullwordsize; 3641 } 3642 3643 keys = (char *)malloc(ngroups + 1); 3644 if (keys) { 3645 xkeys = (char *)malloc(ngroups + 1); 3646 if (xkeys) { 3647 words = (WCHAR_T *)malloc(fullwordlen * sizeof(WCHAR_T)); 3648 if (words) { 3649 unsigned char *pk = keys, *px = xkeys; 3650 WCHAR_T *pw = words, *ps; 3651 int j, len; 3652 3653 for (i = group ; i < nkeysup ; i++) { 3654 *pk++ = (unsigned char)keysup[i].key; 3655 *px++ = (unsigned char)keysup[i].xkey; 3656 len = keysup[i].fullwordsize; 3657 ps = keysup[i].fullword; 3658 for (j = 0 ; j < len ; j++) { 3659 *pw++ = *ps++; 3660 } 3661 } 3662 *pk = (unsigned char)0; 3663 *px = (unsigned char)0; 3664 3665 (*wins.conf->symfn)(keysup[group].ncand, nkeysup - group, 3666 pw - words, keys, xkeys, words, wins.context); 3667 3668 free(words); 3669 } 3670 free(xkeys); 3671 } 3672 free(keys); 3673 } 3674 } 3675#endif 3676 res = car(pop1()); 3677 return (res); 3678} 3679 3680#ifndef NO_EXTEND_MENU 3681 3682/* 3683 defselection ������������������������������������������������������������������������������������������������������������ 3684 */ 3685 3686#define SS2 ((char)0x8e) 3687#define SS3 ((char)0x8f) 3688 3689#define G0 0 3690#define G1 1 3691#define G2 2 3692#define G3 3 3693 3694static int cswidth[4] = {1, 2, 2, 3}; 3695 3696 3697/* 3698 getKutenCode -- ���������������������������������������������������� 3699 */ 3700 3701static int 3702getKutenCode(char *data, int *ku, int *ten) 3703{ 3704 int codeset; 3705 3706 *ku = (data[0] & 0x7f) - 0x20; 3707 *ten = (data[1] & 0x7f) - 0x20; 3708 if (*data == SS2) { 3709 codeset = G2; 3710 *ku = 0; 3711 } 3712 else if (*data == SS3) { 3713 codeset = G3; 3714 *ku = *ten; 3715 *ten = (data[2] & 0x7f) - 0x20; 3716 } 3717 else if (*data & 0x80) { 3718 codeset = G1; 3719 } 3720 else { 3721 codeset = G0; 3722 *ten = *ku; 3723 *ku = 0; 3724 } 3725 return codeset; 3726} 3727 3728/* 3729 howManuCharsAre -- defselection ���������������������������������������� 3730 ���������������������������������������������������������������� 3731 */ 3732 3733static int 3734howManyCharsAre(char *tdata, char *edata, int *tku, int *tten, int *codeset) 3735{ 3736 int eku, eten, kosdata, koedata; 3737 3738 kosdata = getKutenCode(tdata, tku, tten); 3739 koedata = getKutenCode(edata, &eku, &eten); 3740 if (kosdata != koedata) { 3741 return 0; 3742 } 3743 else { 3744 *codeset = kosdata; 3745 return ((eku - *tku) * 94 + eten - *tten + 1); 3746 } 3747} 3748 3749 3750/* 3751 pickupChars -- ���������������������������������������������������� 3752 */ 3753 3754static char * 3755pickupChars(int tku, int tten, int num, int kodata) 3756{ 3757 char *dptr, *tdptr, *edptr; 3758 3759 dptr = (char *)malloc(num * cswidth[kodata] + 1); 3760 if (dptr) { 3761 tdptr = dptr; 3762 edptr = dptr + num * cswidth[kodata]; 3763 for (; dptr < edptr ; tten++) { 3764 if (tten > 94) { 3765 tku++; 3766 tten = 1; 3767 } 3768 switch(kodata) { 3769 case G0: 3770 *dptr++ = (tten + 0x20); 3771 break; 3772 case G1: 3773 *dptr++ = (tku + 0x20) | 0x80; 3774 *dptr++ = (tten + 0x20) | 0x80; 3775 break; 3776 case G2: 3777 *dptr++ = SS2; 3778 *dptr++ = (tten + 0x20) | 0x80; 3779 break; 3780 case G3: 3781 *dptr++ = SS3; 3782 *dptr++ = (tku + 0x20) | 0x80; 3783 *dptr++ = (tten + 0x20) | 0x80; 3784 break; 3785 default: 3786 break; 3787 } 3788 } 3789 *dptr++ = '\0'; 3790 return tdptr; 3791 } 3792 else { 3793 error("Insufficient memory", NON); 3794 /* NOTREACHED */ 3795 } 3796} 3797 3798/* 3799 numtostr -- Key data ������������������������������������ 3800 */ 3801 3802static void 3803numtostr(unsigned long num, char *str) 3804{ 3805 if (num & 0xff0000) { 3806 *str++ = (char)((num >> 16) & 0xff); 3807 } 3808 if (num & 0xff00) { 3809 *str++ = (char)((num >> 8) & 0xff); 3810 } 3811 *str++ = (char)(num & 0xff); 3812 *str = '\0'; 3813} 3814 3815/* 3816 defselection -- ���������������������������� 3817 3818 ���������������� 3819 (defselection function-symbol "��������������������" '(character-list)) 3820 */ 3821 3822static list 3823Ldefselection(void) 3824{ 3825 list form, sym, e, e2, md, kigo_list, buf; 3826 extern extraFunc *extrafuncp; 3827 extern int nothermodes; 3828 int i, len, cs, nkigo_data = 0, kigolen = 0; 3829 WCHAR_T *p, *kigo_str, **akigo_data; 3830 extraFunc *extrafunc = (extraFunc *)0; 3831 3832 form = sp[0]; 3833 3834 if (atom(form) || atom(cdr(form)) || atom(cdr(cdr(form)))) { 3835 error("Illegal form ",form); 3836 /* NOTREACHED */ 3837 } 3838 3839 sym = car(form); 3840 if (!symbolp(sym)) { 3841 error("Symbol data expected ", sym); 3842 /* NOTREACHED */ 3843 } 3844 3845 md = car(cdr(form)); 3846 if (!stringp(md) && !null(md)) { 3847 error("String data expected ", md); 3848 /* NOTREACHED */ 3849 } 3850 3851 push(car(cdr(cdr(form)))); 3852 push(Leval(1)); 3853 3854 kigo_list = sp[0]; 3855 if (atom(kigo_list)) { 3856 error("Illegal form ", kigo_list); 3857 /* NOTREACHED */ 3858 } 3859 3860 /* ������������������������������������ */ 3861 buf = kigo_list; 3862 while (!atom(buf)) { 3863 if (!atom(cdr(buf)) && (car(cdr(buf)) == HYPHEN)) { 3864 /* ���������������������������� */ 3865 if (atom(cdr(cdr(buf)))) { 3866 error("Illegal form ", buf); 3867 /* NOTREACHED */ 3868 }else{ 3869 int sku, sten, num; 3870 char ss[4], ee[4]; 3871 3872 e = car(buf); 3873 if (!numberp(e)) { 3874 error("Key data expected ", e); 3875 /* NOTREACHED */ 3876 } 3877 e2 = car(cdr(cdr(buf))); 3878 if (!numberp(e2)) { 3879 error("Key data expected ", e2); 3880 /* NOTREACHED */ 3881 } 3882 3883 numtostr(xnum(e), ss); 3884 numtostr(xnum(e2), ee); 3885 num = howManyCharsAre(ss, ee, &sku, &sten, &cs); 3886 if (num <= 0) { 3887 error("Inconsistent range of charcter code ", buf); 3888 /* NOTREACHED */ 3889 } 3890 kigolen = kigolen + (cswidth[cs] + 1) * num; 3891 nkigo_data += num; 3892 } 3893 buf = cdr(cdr(cdr(buf))); 3894 } 3895 else { 3896 /* ���������������������������� */ 3897 char xx[4], *xxp; 3898 3899 e = car(buf); 3900 if (!numberp(e) && !stringp(e)) { 3901 error("Key or string data expected ", e); 3902 /* NOTREACHED */ 3903 } 3904 else if (numberp(e)) { 3905 numtostr(xnum(e), xx); 3906 xxp = xx; 3907 }else{ 3908 xxp = xstring(e); 3909 } 3910 3911 for ( ; *xxp ; xxp += cswidth[cs] ) { 3912 if (*xxp == SS2) { 3913 cs = G2; 3914 } 3915 else if (*xxp == SS3) { 3916 cs = G3; 3917 } 3918 else if (*xxp & 0x80) { 3919 cs = G1; 3920 } 3921 else { 3922 cs = G0; 3923 } 3924 kigolen = kigolen + cswidth[cs]; 3925 } 3926 kigolen += 1; /* ���������������������������� \0 ���������������� */ 3927 nkigo_data++; 3928 buf = cdr(buf); 3929 } 3930 } 3931 3932 kigo_str = (WCHAR_T *)malloc(kigolen * sizeof(WCHAR_T)); 3933 if (!kigo_str) { 3934 error("Insufficient memory ", NON); 3935 /* NOTREACHED */ 3936 } 3937 p = kigo_str; 3938 3939 /* ���������������������������� */ 3940 while (!atom(kigo_list)) { 3941 if (!atom(cdr(kigo_list)) && (car(cdr(kigo_list)) == HYPHEN)) { 3942 /* ���������������������������� */ 3943 int sku, sten, codeset, num; 3944 char *ww, *sww, *eww, ss[4], ee[4], bak; 3945 3946 e = car(kigo_list); 3947 e2 = car(cdr(cdr(kigo_list))); 3948 numtostr(xnum(e), ss); 3949 numtostr(xnum(e2), ee); 3950 num = howManyCharsAre(ss, ee, &sku, &sten, &codeset); 3951 sww = ww = pickupChars(sku, sten, num, codeset); 3952 cs = cswidth[codeset]; 3953 eww = ww + num * cs; 3954 while (ww < eww) { 3955 bak = ww[cs]; 3956 ww[cs] = '\0'; 3957 len = MBstowcs(p, ww, kigolen - (p - kigo_str)); 3958 p += len; 3959 *p++ = (WCHAR_T)0; 3960 ww += cs; 3961 ww[0] = bak; 3962 } 3963 free(sww); 3964 kigo_list = cdr(cdr(cdr(kigo_list))); 3965 } 3966 else { 3967 /* ���������������������������� */ 3968 char xx[4], *xxp; 3969 3970 e = car(kigo_list); 3971 if (numberp(e)) { 3972 numtostr(xnum(e), xx); 3973 xxp = xx; 3974 }else{ 3975 xxp = xstring(e); 3976 } 3977 len = MBstowcs(p, xxp, kigolen - (p - kigo_str)); 3978 p += len; 3979 *p++ = (WCHAR_T)0; 3980 kigo_list = cdr(kigo_list); 3981 } 3982 } 3983 3984 akigo_data = (WCHAR_T **)calloc(nkigo_data + 1, sizeof(WCHAR_T *)); 3985 if (akigo_data == 0) { 3986 free(kigo_str); 3987 error("Insufficient memory", NON); 3988 /* NOTREACHED */ 3989 } 3990 3991 for (i = 0, p = kigo_str ; i < nkigo_data ; i++) { 3992 akigo_data[i] = p; 3993 while (*p++) 3994 /* EMPTY */ 3995 ; 3996 } 3997 3998 /* ���������������������������� */ 3999 extrafunc = (extraFunc *)malloc(sizeof(extraFunc)); 4000 if (!extrafunc) { 4001 free(kigo_str); 4002 free(akigo_data); 4003 error("Insufficient memory", NON); 4004 /* NOTREACHED */ 4005 } 4006 extrafunc->u.kigoptr = (kigoIchiran *)malloc(sizeof(kigoIchiran)); 4007 if (!extrafunc->u.kigoptr) { 4008 free(kigo_str); 4009 free(akigo_data); 4010 free(extrafunc); 4011 error("Insufficient memory", NON); 4012 /* NOTREACHED */ 4013 } 4014 4015 /* �������������������������������������������������������� */ 4016 symbolpointer(sym)->mid = extrafunc->u.kigoptr->kigo_mode 4017 = CANNA_MODE_MAX_IMAGINARY_MODE + nothermodes; 4018 symbolpointer(sym)->fid = extrafunc->fnum 4019 = CANNA_FN_MAX_FUNC + nothermodes; 4020 4021 /* ���������������������������� */ 4022 extrafunc->u.kigoptr->kigo_data = akigo_data; 4023 extrafunc->u.kigoptr->kigo_str = kigo_str; 4024 extrafunc->u.kigoptr->kigo_size = nkigo_data; 4025 if (stringp(md)) { 4026 extrafunc->display_name = WString(xstring(md)); 4027 } 4028 else { 4029 extrafunc->display_name = (WCHAR_T *)0; 4030 } 4031 4032 extrafunc->keyword = EXTRA_FUNC_DEFSELECTION; 4033 extrafunc->next = extrafuncp; 4034 extrafuncp = extrafunc; 4035 pop(2); 4036 nothermodes++; 4037 return sym; 4038} 4039 4040/* 4041 defmenu -- ���������������������������� 4042 4043 ���������������� 4044 (defmenu first-menu 4045 ("��������" touroku) 4046 ("��������������������" server)) 4047 */ 4048 4049static list 4050Ldefmenu(void) 4051{ 4052 list form, sym, e; 4053 extern extraFunc *extrafuncp; 4054 extern int nothermodes; 4055 extraFunc *extrafunc = (extraFunc *)0; 4056 int i, n, clen, len; 4057 WCHAR_T foo[512]; 4058 menustruct *men; 4059 menuitem *menubody; 4060 WCHAR_T *wp, **wpp; 4061 4062 form = sp[0]; 4063 if (atom(form) || atom(cdr(form))) { 4064 error("Bad form ", form); 4065 /* NOTREACHED */ 4066 } 4067 sym = car(form); 4068 if (!symbolp(sym)) { 4069 error("Symbol data expected ", sym); 4070 /* NOTREACHED */ 4071 } 4072 4073 /* ������������������������������������������������������������������������������������������������ */ 4074 for (n = 0, clen = 0, e = cdr(form) ; !atom(e) ; n++, e = cdr(e)) { 4075 list l = car(e), d, fn; 4076 if (atom(l) || atom(cdr(l))) { 4077 error("Bad form ", form); 4078 } 4079 d = car(l); 4080 fn = car(cdr(l)); 4081 if (!stringp(d) || !symbolp(fn)) { 4082 error("Bad form ", form); 4083 } 4084 len = MBstowcs(foo, xstring(d), 512); 4085 if (len >= 0) { 4086 clen += len + 1; 4087 } 4088 } 4089 4090 extrafunc = (extraFunc *)malloc(sizeof(extraFunc)); 4091 if (extrafunc) { 4092 men = allocMenu(n, clen); 4093 if (men) { 4094 menubody = men->body; 4095 /* ������������������������������������������������������������������������ */ 4096 for (i = 0, wp = men->titledata, wpp = men->titles, e = cdr(form) ; 4097 i < n ; i++, e = cdr(e)) { 4098 len = MBstowcs(wp, xstring(car(car(e))), 512); 4099 *wpp++ = wp; 4100 wp += len + 1; 4101 4102 menubody[i].flag = MENU_SUSPEND; 4103 menubody[i].u.misc = (char *)car(cdr(car(e))); 4104 } 4105 men->nentries = n; 4106 4107 /* �������������������������������������������������������� */ 4108 symbolpointer(sym)->mid = 4109 men->modeid = CANNA_MODE_MAX_IMAGINARY_MODE + nothermodes; 4110 symbolpointer(sym)->fid = 4111 extrafunc->fnum = CANNA_FN_MAX_FUNC + nothermodes; 4112 extrafunc->keyword = EXTRA_FUNC_DEFMENU; 4113 extrafunc->display_name = (WCHAR_T *)0; 4114 extrafunc->u.menuptr = men; 4115 4116 extrafunc->next = extrafuncp; 4117 extrafuncp = extrafunc; 4118 nothermodes++; 4119 (void)pop1(); 4120 return sym; 4121 } 4122 free(extrafunc); 4123 } 4124 error("Insufficient memory", NON); 4125 /* NOTREACHED */ 4126} 4127#endif /* NO_EXTEND_MENU */ 4128 4129static list 4130Lsetinifunc(int n) 4131{ 4132 unsigned char fseq[256]; 4133 int i, len; 4134 list ret = NIL; 4135 extern BYTE *initfunc; 4136 4137 argnchk(S_SetInitFunc, 1); 4138 4139 len = xfseq(S_SetInitFunc, sp[0], fseq, 256); 4140 4141 if (len > 0) { 4142 if (initfunc) free(initfunc); 4143 initfunc = (BYTE *)malloc(len + 1); 4144 if (!initfunc) { 4145 error("Insufficient memory", NON); 4146 /* NOTREACHED */ 4147 } 4148 for (i = 0 ; i < len ; i++) { 4149 initfunc[i] = fseq[i]; 4150 } 4151 initfunc[i] = 0; 4152 ret = T; 4153 } 4154 (void)pop1(); 4155 return ret; 4156} 4157 4158static list 4159Lboundp(int n) 4160{ 4161 list e; 4162 struct atomcell *sym; 4163 4164 argnchk("boundp",1); 4165 e = pop1(); 4166 4167 if (!atom(e)) { 4168 error("boundp: bad arg ", e); 4169 /* NOTREACHED */ 4170 } 4171 else if (constp(e)) { 4172 error("boundp: bad arg ", e); 4173 /* NOTREACHED */ 4174 } 4175 4176 if (assq(e, *esp)) { 4177 return T; 4178 } 4179 else if ((sym = symbolpointer(e))->valfunc) { 4180 return T; 4181 } 4182 else { 4183 if (sym->value != (list)UNBOUND) { 4184 return T; 4185 } 4186 else { 4187 return NIL; 4188 } 4189 } 4190} 4191 4192static list 4193Lfboundp(int n) 4194{ 4195 list e; 4196 4197 argnchk("fboundp",1); 4198 e = pop1(); 4199 4200 if (!atom(e)) { 4201 error("fboundp: bad arg ", e); 4202 /* NOTREACHED */ 4203 } 4204 else if (constp(e)) { 4205 error("fboundp: bad arg ", e); 4206 /* NOTREACHED */ 4207 } 4208 if (symbolpointer(e)->ftype == UNDEF) { 4209 return NIL; 4210 } 4211 else { 4212 return T; 4213 } 4214} 4215 4216static list 4217Lgetenv(int n) 4218{ 4219 list e; 4220 char strbuf[256], *ret; 4221 list retval; 4222 4223 argnchk("getenv",1); 4224 e = sp[0]; 4225 4226 if (!stringp(e)) { 4227 error("getenv: bad arg ", e); 4228 /* NOTREACHED */ 4229 } 4230 4231 strncpy(strbuf, xstring(e), xstrlen(e)); 4232 strbuf[xstrlen(e)] = '\0'; 4233 ret = getenv(strbuf); 4234 if (ret) { 4235 retval = copystring(ret, strlen(ret)); 4236 } 4237 else { 4238 retval = NIL; 4239 } 4240 (void)pop1(); 4241 return retval; 4242} 4243 4244static list 4245LdefEscSeq(int n) 4246{ 4247 4248 argnchk("define-esc-sequence",3); 4249 4250 if (!stringp(sp[2])) { 4251 error("define-esc-sequence: bad arg ", sp[2]); 4252 /* NOTREACHED */ 4253 } 4254 if (!stringp(sp[1])) { 4255 error("define-esc-sequence: bad arg ", sp[1]); 4256 /* NOTREACHED */ 4257 } 4258 if (!numberp(sp[0])) { 4259 error("define-esc-sequence: bad arg ", sp[0]); 4260 /* NOTREACHED */ 4261 } 4262 if (keyconvCallback) { 4263 (*keyconvCallback)(CANNA_CTERMINAL, 4264 xstring(sp[2]), xstring(sp[1]), xnum(sp[0])); 4265 } 4266 pop(3); 4267 return NIL; 4268} 4269 4270static list 4271LdefXKeysym(int n) 4272{ 4273 4274 argnchk("define-x-keysym",2); 4275 4276 if (!stringp(sp[1])) { 4277 error("define-esc-sequence: bad arg ", sp[1]); 4278 /* NOTREACHED */ 4279 } 4280 if (!numberp(sp[0])) { 4281 error("define-esc-sequence: bad arg ", sp[0]); 4282 /* NOTREACHED */ 4283 } 4284 if (keyconvCallback) { 4285 (*keyconvCallback)(CANNA_XTERMINAL, 4286 xstring(sp[2]), xstring(sp[1]), xnum(sp[0])); 4287 } 4288 pop(2); 4289 return NIL; 4290} 4291 4292static list 4293Lconcat(int n) 4294{ 4295 list t, res; 4296 int i, len; 4297 char *p; 4298 4299 /* ������������������������������������ */ 4300 for (len= 0, i = n ; i-- ;) { 4301 t = sp[i]; 4302 if (!stringp(t)) { 4303 lisp_strerr("concat", t); 4304 /* NOTREACHED */ 4305 } 4306 len += xstrlen(t); 4307 } 4308 res = allocstring(len); 4309 for (p = xstring(res), i = n ; i-- ;) { 4310 t = sp[i]; 4311 len = xstrlen(t); 4312 Strncpy(p, xstring(t), len); 4313 p += len; 4314 } 4315 *p = '\0'; 4316 pop(n); 4317 return res; 4318} 4319 4320/* lispfuncend */ 4321 4322extern char *RkGetServerHost(); 4323 4324 4325/* ������������������������������������������������ */ 4326 4327static list 4328VTorNIL(BYTE *var, int setp, list arg) 4329{ 4330 if (setp == VALSET) { 4331 *var = (arg == NIL) ? 0 : 1; 4332 return arg; 4333 } 4334 else { /* get */ 4335 return *var ? T : NIL; 4336 } 4337} 4338 4339static list 4340StrAcc(char **var, int setp, list arg) 4341{ 4342 if (setp == VALSET) { 4343 if (null(arg) || stringp(arg)) { 4344 if (*var) { 4345 free(*var); 4346 } 4347 if (stringp(arg)) { 4348 *var = (char *)malloc(strlen(xstring(arg)) + 1); 4349 if (*var) { 4350 strcpy(*var, xstring(arg)); 4351 return arg; 4352 } 4353 else { 4354 error("Insufficient memory.", NON); 4355 /* NOTREACHED */ 4356 } 4357 }else{ 4358 *var = (char *)0; 4359 return NIL; 4360 } 4361 } 4362 else { 4363 lisp_strerr((char *)0, arg); 4364 /* NOTREACHED */ 4365 } 4366 } 4367 /* else { .. */ 4368 if (*var) { 4369 return copystring(*var, strlen(*var)); 4370 } 4371 else { 4372 return NIL; 4373 } 4374 /* end else .. } */ 4375} 4376 4377static list 4378NumAcc(int *var, int setp, list arg) 4379{ 4380 if (setp == VALSET) { 4381 if (numberp(arg)) { 4382 *var = (int)xnum(arg); 4383 return arg; 4384 } 4385 else { 4386 numerr((char *)0, arg); 4387 /* NOTREACHED */ 4388 } 4389 } 4390 return (list)mknum(*var); 4391} 4392 4393#ifdef WIN_CANLISP 4394static struct RegInfo reginfo; 4395#endif 4396 4397/* ������������������������������������������������������������������������������������������������ */ 4398 4399/* ������������������������������������ */ 4400 4401#define DEFVAR(fn, acc, ty, var) \ 4402static list fn(int setp, list arg) { \ 4403 extern ty var; return acc(&var, setp, arg); } 4404 4405#define DEFVAREX(fn, acc, var) \ 4406static list fn(int setp, list arg) { \ 4407 extern struct CannaConfig cannaconf; return acc(&var, setp, arg); } 4408 4409static list Vnkouhobunsetsu(int setp, list arg) 4410{ 4411 extern int nKouhoBunsetsu; 4412 4413 arg = NumAcc(&nKouhoBunsetsu, setp, arg); 4414#ifdef RESTRICT_NKOUHOBUNSETSU 4415 if (nKouhoBunsetsu < 3 || nKouhoBunsetsu > 60) 4416 nKouhoBunsetsu = 16; 4417#else 4418 if (nKouhoBunsetsu < 0) { 4419 nKouhoBunsetsu = 0; 4420 } 4421#endif 4422 return arg; 4423} 4424 4425static list VProtoVer(int setp, list arg) 4426{ 4427} 4428 4429static list VServVer(int setp, list arg) 4430{ 4431} 4432 4433static list VServName(int setp, list arg) 4434{ 4435} 4436 4437static list 4438VCannaDir(int setp, list arg) 4439{ 4440extern char basepath[]; 4441 4442 char *canna_dir = basepath; 4443 4444 if (setp == VALGET) { 4445 return StrAcc(&canna_dir, setp, arg); 4446 } 4447 else { 4448 return NIL; 4449 } 4450} 4451 4452static list VCodeInput(int setp, list arg) 4453{ 4454 extern struct CannaConfig cannaconf; 4455 static char *input_code[CANNA_MAX_CODE] = {"jis", "sjis", "kuten"}; 4456 4457 if (setp == VALSET) { 4458 if (null(arg) || stringp(arg)) { 4459 if (stringp(arg)) { 4460 int i; 4461 char *s = xstring(arg); 4462 4463 for (i = 0 ; i < CANNA_MAX_CODE ; i++) { 4464 if (!strcmp(s, input_code[i])) { 4465 cannaconf.code_input = i; 4466 break; 4467 } 4468 } 4469 if (i < CANNA_MAX_CODE) { 4470 return arg; 4471 } 4472 else { 4473 return NIL; 4474 } 4475 }else{ 4476 cannaconf.code_input = 0; /* use default */ 4477 return copystring(input_code[0], strlen(input_code[0])); 4478 } 4479 } 4480 else { 4481 lisp_strerr((char *)0, arg); 4482 /* NOTREACHED */ 4483 } 4484 } 4485 /* else { .. */ 4486 if (/* 0 <= cannaconf.code_input && /* unsigned �������������������������������������������� */ 4487 cannaconf.code_input <= CANNA_CODE_KUTEN) { 4488 return copystring(input_code[cannaconf.code_input], 4489 strlen(input_code[cannaconf.code_input])); 4490 } 4491 else { 4492 return NIL; 4493 } 4494 /* end else .. } */ 4495} 4496 4497 4498DEFVAR(Vromkana ,StrAcc ,char * ,RomkanaTable) 4499DEFVAR(Venglish ,StrAcc ,char * ,EnglishTable) 4500 4501DEFVAREX(Vnhenkan ,NumAcc ,cannaconf.kouho_threshold) 4502DEFVAREX(Vndisconnect ,NumAcc ,cannaconf.strokelimit) 4503DEFVAREX(VCannaVersion ,NumAcc ,cannaconf.CannaVersion) 4504DEFVAREX(VIndexSeparator,NumAcc ,cannaconf.indexSeparator) 4505 4506DEFVAREX(Vgakushu ,VTorNIL ,cannaconf.Gakushu) 4507DEFVAREX(Vcursorw ,VTorNIL ,cannaconf.CursorWrap) 4508DEFVAREX(Vselectd ,VTorNIL ,cannaconf.SelectDirect) 4509DEFVAREX(Vnumeric ,VTorNIL ,cannaconf.HexkeySelect) 4510DEFVAREX(Vbunsets ,VTorNIL ,cannaconf.BunsetsuKugiri) 4511DEFVAREX(Vcharact ,VTorNIL ,cannaconf.ChBasedMove) 4512DEFVAREX(Vreverse ,VTorNIL ,cannaconf.ReverseWidely) 4513DEFVAREX(VreverseWord ,VTorNIL ,cannaconf.ReverseWord) 4514DEFVAREX(Vquitich ,VTorNIL ,cannaconf.QuitIchiranIfEnd) 4515DEFVAREX(Vkakutei ,VTorNIL ,cannaconf.kakuteiIfEndOfBunsetsu) 4516DEFVAREX(Vstayaft ,VTorNIL ,cannaconf.stayAfterValidate) 4517DEFVAREX(Vbreakin ,VTorNIL ,cannaconf.BreakIntoRoman) 4518DEFVAREX(Vgrammati ,VTorNIL ,cannaconf.grammaticalQuestion) 4519DEFVAREX(Vforceka ,VTorNIL ,cannaconf.forceKana) 4520DEFVAREX(Vkouhoco ,VTorNIL ,cannaconf.kCount) 4521DEFVAREX(Vauto ,VTorNIL ,cannaconf.chikuji) 4522DEFVAREX(VlearnNumTy ,VTorNIL ,cannaconf.LearnNumericalType) 4523DEFVAREX(VBSasQuit ,VTorNIL ,cannaconf.BackspaceBehavesAsQuit) 4524DEFVAREX(Vinhibi ,VTorNIL ,cannaconf.iListCB) 4525DEFVAREX(Vkeepcupos ,VTorNIL ,cannaconf.keepCursorPosition) 4526DEFVAREX(VAbandon ,VTorNIL ,cannaconf.abandonIllegalPhono) 4527DEFVAREX(VHexStyle ,VTorNIL ,cannaconf.hexCharacterDefiningStyle) 4528DEFVAREX(VKojin ,VTorNIL ,cannaconf.kojin) 4529DEFVAREX(VIndexHankaku ,VTorNIL ,cannaconf.indexHankaku) 4530DEFVAREX(VAllowNext ,VTorNIL ,cannaconf.allowNextInput) 4531DEFVAREX(VkanaGaku ,VTorNIL ,cannaconf.doKatakanaGakushu) 4532DEFVAREX(VhiraGaku ,VTorNIL ,cannaconf.doHiraganaGakushu) 4533DEFVAREX(VChikujiContinue ,VTorNIL ,cannaconf.ChikujiContinue) 4534DEFVAREX(VRenbunContinue ,VTorNIL ,cannaconf.RenbunContinue) 4535DEFVAREX(VMojishuContinue ,VTorNIL ,cannaconf.MojishuContinue) 4536DEFVAREX(VcRealBS ,VTorNIL ,cannaconf.chikujiRealBackspace) 4537DEFVAREX(VIgnoreCase ,VTorNIL ,cannaconf.ignore_case) 4538DEFVAREX(VRomajiYuusen ,VTorNIL ,cannaconf.romaji_yuusen) 4539DEFVAREX(VAutoSync ,VTorNIL ,cannaconf.auto_sync) 4540DEFVAREX(VQuicklyEscape ,VTorNIL ,cannaconf.quickly_escape) 4541DEFVAREX(VInhibitHankana,VTorNIL ,cannaconf.InhibitHankakuKana) 4542#ifdef WIN_CANLISP 4543DEFVAR(VremoteGroup ,StrAcc ,char * ,RemoteGroup) 4544DEFVAR(VlocalGroup ,StrAcc ,char * ,LocalGroup) 4545 4546DEFVAREX(VcandInitWidth ,NumAcc ,reginfo.cand_init_width) 4547DEFVAREX(VcandInitHeight ,NumAcc ,reginfo.cand_init_height) 4548DEFVAREX(VcandMaxWidth ,NumAcc ,reginfo.cand_max_width) 4549DEFVAREX(VcandMaxHeight ,NumAcc ,reginfo.cand_max_height) 4550DEFVAREX(VstatusSize ,NumAcc ,reginfo.status_size) 4551#endif 4552 4553#ifdef DEFINE_SOMETHING 4554DEFVAR(Vchikuji_debug, VTorNIL, int, chikuji_debug) 4555#endif 4556 4557/* Lisp ���������������� C ���������������������������� */ 4558 4559static struct atomdefs initatom[] = { 4560 {"quote" ,SPECIAL,(list(*)(...))Lquote }, 4561 {"setq" ,SPECIAL,(list(*)(...))Lsetq }, 4562 {"set" ,SUBR ,(list(*)(...))Lset }, 4563 {"equal" ,SUBR ,(list(*)(...))Lequal }, 4564 {"=" ,SUBR ,(list(*)(...))Lequal }, 4565 {">" ,SUBR ,(list(*)(...))Lgreaterp }, 4566 {"<" ,SUBR ,(list(*)(...))Llessp }, 4567 {"progn" ,SPECIAL,(list(*)(...))Lprogn }, 4568 {"eq" ,SUBR ,(list(*)(...))Leq }, 4569 {"cond" ,SPECIAL,(list(*)(...))Lcond }, 4570 {"null" ,SUBR ,(list(*)(...))Lnull }, 4571 {"not" ,SUBR ,(list(*)(...))Lnull }, 4572 {"and" ,SPECIAL,(list(*)(...))Land }, 4573 {"or" ,SPECIAL,(list(*)(...))Lor }, 4574 {"+" ,SUBR ,(list(*)(...))Lplus }, 4575 {"-" ,SUBR ,(list(*)(...))Ldiff }, 4576 {"*" ,SUBR ,(list(*)(...))Ltimes }, 4577 {"/" ,SUBR ,(list(*)(...))Lquo }, 4578 {"%" ,SUBR ,(list(*)(...))Lrem }, 4579 {"gc" ,SUBR ,(list(*)(...))Lgc }, 4580 {"load" ,SUBR ,(list(*)(...))Lload }, 4581 {"list" ,SUBR ,(list(*)(...))Llist }, 4582 {"sequence" ,SUBR ,(list(*)(...))Llist }, 4583 {"defun" ,SPECIAL,(list(*)(...))Ldefun }, 4584 {"defmacro" ,SPECIAL,(list(*)(...))Ldefmacro }, 4585 {"cons" ,SUBR ,(list(*)(...))Lcons }, 4586 {"car" ,SUBR ,(list(*)(...))Lcar }, 4587 {"cdr" ,SUBR ,(list(*)(...))Lcdr }, 4588 {"atom" ,SUBR ,(list(*)(...))Latom }, 4589 {"let" ,CMACRO ,(list(*)(...))Llet }, 4590 {"if" ,CMACRO ,(list(*)(...))Lif }, 4591 {"boundp" ,SUBR ,(list(*)(...))Lboundp }, 4592 {"fboundp" ,SUBR ,(list(*)(...))Lfboundp }, 4593 {"getenv" ,SUBR ,(list(*)(...))Lgetenv }, 4594 {"copy-symbol" ,SUBR ,(list(*)(...))Lcopysym }, 4595 {"concat" ,SUBR ,(list(*)(...))Lconcat }, 4596 {S_FN_UseDictionary ,SUBR ,(list(*)(...))Lusedic }, 4597 {S_SetModeDisp ,SUBR ,(list(*)(...))Lmodestr }, 4598 {S_SetKey ,SUBR ,(list(*)(...))Lsetkey }, 4599 {S_GSetKey ,SUBR ,(list(*)(...))Lgsetkey }, 4600 {S_UnbindKey ,SUBR ,(list(*)(...))Lunbindkey }, 4601 {S_GUnbindKey ,SUBR ,(list(*)(...))Lgunbindkey }, 4602 {S_DefMode ,SPECIAL,(list(*)(...))Ldefmode }, 4603 {S_DefSymbol ,SPECIAL,(list(*)(...))Ldefsym }, 4604#ifndef NO_EXTEND_MENU 4605 {S_DefSelection ,SPECIAL,(list(*)(...))Ldefselection }, 4606 {S_DefMenu ,SPECIAL,(list(*)(...))Ldefmenu }, 4607#endif 4608 {S_SetInitFunc ,SUBR ,(list(*)(...))Lsetinifunc }, 4609 {S_defEscSequence ,SUBR ,(list(*)(...))LdefEscSeq }, 4610 {S_defXKeysym ,SUBR ,(list(*)(...))LdefXKeysym }, 4611 {0 ,UNDEF ,0 }, /* DUMMY */ 4612}; 4613 4614static void 4615deflispfunc(void) 4616{ 4617 struct atomdefs *p; 4618 4619 for (p = initatom ; p->symname ; p++) { 4620 struct atomcell *atomp; 4621 list temp; 4622 4623 temp = getatmz(p->symname); 4624 atomp = symbolpointer(temp); 4625 atomp->ftype = p->symtype; 4626 if (atomp->ftype != UNDEF) { 4627 atomp->func = p->symfunc; 4628 } 4629 } 4630} 4631 4632 4633/* ������������ */ 4634 4635static struct cannavardefs cannavars[] = { 4636 {S_VA_RomkanaTable ,(list(*)(...))Vromkana}, 4637 {S_VA_EnglishTable ,(list(*)(...))Venglish}, 4638 {S_VA_CursorWrap ,(list(*)(...))Vcursorw}, 4639 {S_VA_SelectDirect ,(list(*)(...))Vselectd}, 4640 {S_VA_NumericalKeySelect ,(list(*)(...))Vnumeric}, 4641 {S_VA_BunsetsuKugiri ,(list(*)(...))Vbunsets}, 4642 {S_VA_CharacterBasedMove ,(list(*)(...))Vcharact}, 4643 {S_VA_ReverseWidely ,(list(*)(...))Vreverse}, 4644 {S_VA_ReverseWord ,(list(*)(...))VreverseWord}, 4645 {S_VA_Gakushu ,(list(*)(...))Vgakushu}, 4646 {S_VA_QuitIfEOIchiran ,(list(*)(...))Vquitich}, 4647 {S_VA_KakuteiIfEOBunsetsu ,(list(*)(...))Vkakutei}, 4648 {S_VA_StayAfterValidate ,(list(*)(...))Vstayaft}, 4649 {S_VA_BreakIntoRoman ,(list(*)(...))Vbreakin}, 4650 {S_VA_NHenkanForIchiran ,(list(*)(...))Vnhenkan}, 4651 {S_VA_GrammaticalQuestion ,(list(*)(...))Vgrammati}, 4652 {"gramatical-question" ,(list(*)(...))Vgrammati}, /* �������������������������������������������� */ 4653 {S_VA_ForceKana ,(list(*)(...))Vforceka}, 4654 {S_VA_KouhoCount ,(list(*)(...))Vkouhoco}, 4655 {S_VA_Auto ,(list(*)(...))Vauto}, 4656 {S_VA_LearnNumericalType ,(list(*)(...))VlearnNumTy}, 4657 {S_VA_BackspaceBehavesAsQuit ,(list(*)(...))VBSasQuit}, 4658 {S_VA_InhibitListCallback ,(list(*)(...))Vinhibi}, 4659 {S_VA_nKouhoBunsetsu ,(list(*)(...))Vnkouhobunsetsu}, 4660 {S_VA_keepCursorPosition ,(list(*)(...))Vkeepcupos}, 4661 {S_VA_CannaVersion ,(list(*)(...))VCannaVersion}, 4662 {S_VA_Abandon ,(list(*)(...))VAbandon}, 4663 {S_VA_HexDirect ,(list(*)(...))VHexStyle}, 4664 {S_VA_ProtocolVersion ,(list(*)(...))VProtoVer}, 4665 {S_VA_ServerVersion ,(list(*)(...))VServVer}, 4666 {S_VA_ServerName ,(list(*)(...))VServName}, 4667 {S_VA_CannaDir ,(list(*)(...))VCannaDir}, 4668 {S_VA_Kojin ,(list(*)(...))VKojin}, 4669 {S_VA_IndexHankaku ,(list(*)(...))VIndexHankaku}, 4670 {S_VA_IndexSeparator ,(list(*)(...))VIndexSeparator}, 4671 {S_VA_AllowNextInput ,(list(*)(...))VAllowNext}, 4672 {S_VA_doKatakanaGakushu ,(list(*)(...))VkanaGaku}, 4673 {S_VA_doHiraganaGakushu ,(list(*)(...))VhiraGaku}, 4674#ifdef DEFINE_SOMETHING 4675 {S_VA_chikuji_debug ,(list(*)(...))Vchikuji_debug}, 4676#endif /* DEFINE_SOMETHING */ 4677 {S_VA_ChikujiContinue ,(list(*)(...))VChikujiContinue}, 4678 {S_VA_RenbunContinue ,(list(*)(...))VRenbunContinue}, 4679 {S_VA_MojishuContinue ,(list(*)(...))VMojishuContinue}, 4680 {S_VA_ChikujiRealBackspace ,(list(*)(...))VcRealBS}, 4681 {S_VA_nDisconnectServer ,(list(*)(...))Vndisconnect}, 4682 {S_VA_ignoreCase ,(list(*)(...))VIgnoreCase}, 4683 {S_VA_RomajiYuusen ,(list(*)(...))VRomajiYuusen}, 4684 {S_VA_AutoSync ,(list(*)(...))VAutoSync}, 4685 {S_VA_QuicklyEscape ,(list(*)(...))VQuicklyEscape}, 4686 {S_VA_InhibitHanKana ,(list(*)(...))VInhibitHankana}, 4687 {S_VA_CodeInput ,(list(*)(...))VCodeInput}, 4688#ifdef WIN_CANLISP 4689 {"remote-group" ,(list(*)(...))VremoteGroup}, 4690 {"local-group" ,(list(*)(...))VlocalGroup}, 4691 {"candlist-initial-width" ,(list(*)(...))VcandInitWidth}, 4692 {"candlist-initial-height" ,(list(*)(...))VcandInitHeight}, 4693 {"candlist-max-width" ,(list(*)(...))VcandMaxWidth}, 4694 {"candlist-max-height" ,(list(*)(...))VcandMaxHeight}, 4695 {"toolbar-icon-size" ,(list(*)(...))VstatusSize}, 4696#endif 4697 {0 ,0}, 4698}; 4699 4700static void 4701defcannavar(void) 4702{ 4703 struct cannavardefs *p; 4704 4705 for (p = cannavars ; p->varname ; p++) { 4706 symbolpointer(getatmz(p->varname))->valfunc = p->varfunc; 4707 } 4708} 4709 4710 4711 4712/* ���������������� */ 4713 4714static struct cannamodedefs cannamodes[] = { 4715 {S_AlphaMode ,CANNA_MODE_AlphaMode}, 4716 {S_YomiganaiMode ,CANNA_MODE_EmptyMode}, 4717 {S_YomiMode ,CANNA_MODE_YomiMode}, 4718 {S_MojishuMode ,CANNA_MODE_JishuMode}, 4719 {S_TankouhoMode ,CANNA_MODE_TankouhoMode}, 4720 {S_IchiranMode ,CANNA_MODE_IchiranMode}, 4721 {S_KigouMode ,CANNA_MODE_KigoMode}, 4722 {S_YesNoMode ,CANNA_MODE_YesNoMode}, 4723 {S_OnOffMode ,CANNA_MODE_OnOffMode}, 4724 {S_ShinshukuMode ,CANNA_MODE_AdjustBunsetsuMode}, 4725 4726 {S_AutoYomiMode ,CANNA_MODE_ChikujiYomiMode}, 4727 {S_AutoBunsetsuMode ,CANNA_MODE_ChikujiTanMode}, 4728 4729 {S_HenkanNyuuryokuMode ,CANNA_MODE_HenkanNyuryokuMode}, 4730 {S_HexMode ,CANNA_MODE_HexMode}, 4731 {S_BushuMode ,CANNA_MODE_BushuMode}, 4732 {S_ExtendMode ,CANNA_MODE_ExtendMode}, 4733 {S_RussianMode ,CANNA_MODE_RussianMode}, 4734 {S_GreekMode ,CANNA_MODE_GreekMode}, 4735 {S_LineMode ,CANNA_MODE_LineMode}, 4736 {S_ChangingServerMode ,CANNA_MODE_ChangingServerMode}, 4737 {S_HenkanMethodMode ,CANNA_MODE_HenkanMethodMode}, 4738 {S_DeleteDicMode ,CANNA_MODE_DeleteDicMode}, 4739 {S_TourokuMode ,CANNA_MODE_TourokuMode}, 4740 {S_TourokuHinshiMode ,CANNA_MODE_TourokuHinshiMode}, 4741 {S_TourokuDicMode ,CANNA_MODE_TourokuDicMode}, 4742 {S_QuotedInsertMode ,CANNA_MODE_QuotedInsertMode}, 4743 {S_BubunMuhenkanMode ,CANNA_MODE_BubunMuhenkanMode}, 4744 {S_MountDicMode ,CANNA_MODE_MountDicMode}, 4745 {S_ZenHiraHenkanMode ,CANNA_MODE_ZenHiraHenkanMode}, 4746 {S_HanHiraHenkanMode ,CANNA_MODE_HanHiraHenkanMode}, 4747 {S_ZenKataHenkanMode ,CANNA_MODE_ZenKataHenkanMode}, 4748 {S_HanKataHenkanMode ,CANNA_MODE_HanKataHenkanMode}, 4749 {S_ZenAlphaHenkanMode ,CANNA_MODE_ZenAlphaHenkanMode}, 4750 {S_HanAlphaHenkanMode ,CANNA_MODE_HanAlphaHenkanMode}, 4751 {S_ZenHiraKakuteiMode ,CANNA_MODE_ZenHiraKakuteiMode}, 4752 {S_HanHiraKakuteiMode ,CANNA_MODE_HanHiraKakuteiMode}, 4753 {S_ZenKataKakuteiMode ,CANNA_MODE_ZenKataKakuteiMode}, 4754 {S_HanKataKakuteiMode ,CANNA_MODE_HanKataKakuteiMode}, 4755 {S_ZenAlphaKakuteiMode ,CANNA_MODE_ZenAlphaKakuteiMode}, 4756 {S_HanAlphaKakuteiMode ,CANNA_MODE_HanAlphaKakuteiMode}, 4757 {0 ,0}, 4758}; 4759 4760static void 4761defcannamode(void) 4762{ 4763 struct cannamodedefs *p; 4764 4765 for (p = cannamodes ; p->mdname ; p++) { 4766 symbolpointer(getatmz(p->mdname))->mid = p->mdid; 4767 } 4768} 4769 4770 4771 4772/* ������������ */ 4773 4774static struct cannafndefs cannafns[] = { 4775 {S_FN_Undefined ,CANNA_FN_Undefined}, 4776 {S_FN_SelfInsert ,CANNA_FN_FunctionalInsert}, 4777 {S_FN_QuotedInsert ,CANNA_FN_QuotedInsert}, 4778 {S_FN_JapaneseMode ,CANNA_FN_JapaneseMode}, 4779 {S_AlphaMode ,CANNA_FN_AlphaMode}, 4780 {S_HenkanNyuuryokuMode ,CANNA_FN_HenkanNyuryokuMode}, 4781 {S_HexMode ,CANNA_FN_HexMode}, 4782 {S_BushuMode ,CANNA_FN_BushuMode}, 4783 {S_KigouMode ,CANNA_FN_KigouMode}, 4784 {S_FN_Forward ,CANNA_FN_Forward}, 4785 {S_FN_Backward ,CANNA_FN_Backward}, 4786 {S_FN_Next ,CANNA_FN_Next}, 4787 {S_FN_Prev ,CANNA_FN_Prev}, 4788 {S_FN_BeginningOfLine ,CANNA_FN_BeginningOfLine}, 4789 {S_FN_EndOfLine ,CANNA_FN_EndOfLine}, 4790 {S_FN_DeleteNext ,CANNA_FN_DeleteNext}, 4791 {S_FN_DeletePrevious ,CANNA_FN_DeletePrevious}, 4792 {S_FN_KillToEndOfLine ,CANNA_FN_KillToEndOfLine}, 4793 {S_FN_Henkan ,CANNA_FN_Henkan}, 4794 {S_FN_HenkanNaive ,CANNA_FN_HenkanOrInsert}, /* for compati */ 4795 {S_FN_HenkanOrSelfInsert ,CANNA_FN_HenkanOrInsert}, 4796 {S_FN_HenkanOrDoNothing ,CANNA_FN_HenkanOrNothing}, 4797 {S_FN_Kakutei ,CANNA_FN_Kakutei}, 4798 {S_FN_Extend ,CANNA_FN_Extend}, 4799 {S_FN_Shrink ,CANNA_FN_Shrink}, 4800 {S_ShinshukuMode ,CANNA_FN_AdjustBunsetsu}, 4801 {S_FN_Quit ,CANNA_FN_Quit}, 4802 {S_ExtendMode ,CANNA_FN_ExtendMode}, 4803 {S_FN_Touroku ,CANNA_FN_Touroku}, 4804 {S_FN_ConvertAsHex ,CANNA_FN_ConvertAsHex}, 4805 {S_FN_ConvertAsBushu ,CANNA_FN_ConvertAsBushu}, 4806 {S_FN_KouhoIchiran ,CANNA_FN_KouhoIchiran}, 4807 {S_FN_BubunMuhenkan ,CANNA_FN_BubunMuhenkan}, 4808 {S_FN_Zenkaku ,CANNA_FN_Zenkaku}, 4809 {S_FN_Hankaku ,CANNA_FN_Hankaku}, 4810 {S_FN_ToUpper ,CANNA_FN_ToUpper}, 4811 {S_FN_Capitalize ,CANNA_FN_Capitalize}, 4812 {S_FN_ToLower ,CANNA_FN_ToLower}, 4813 {S_FN_Hiragana ,CANNA_FN_Hiragana}, 4814 {S_FN_Katakana ,CANNA_FN_Katakana}, 4815 {S_FN_Romaji ,CANNA_FN_Romaji}, 4816 {S_FN_KanaRotate ,CANNA_FN_KanaRotate}, 4817 {S_FN_RomajiRotate ,CANNA_FN_RomajiRotate}, 4818 {S_FN_CaseRotate ,CANNA_FN_CaseRotate}, 4819 {S_FN_BaseHiragana ,CANNA_FN_BaseHiragana}, 4820 {S_FN_BaseKatakana ,CANNA_FN_BaseKatakana}, 4821 {S_FN_BaseKana ,CANNA_FN_BaseKana}, 4822 {S_FN_BaseEisu ,CANNA_FN_BaseEisu}, 4823 {S_FN_BaseZenkaku ,CANNA_FN_BaseZenkaku}, 4824 {S_FN_BaseHankaku ,CANNA_FN_BaseHankaku}, 4825 {S_FN_BaseKakutei ,CANNA_FN_BaseKakutei}, 4826 {S_FN_BaseHenkan ,CANNA_FN_BaseHenkan}, 4827 {S_FN_BaseHiraKataToggle ,CANNA_FN_BaseHiraKataToggle}, 4828 {S_FN_BaseZenHanToggle ,CANNA_FN_BaseZenHanToggle}, 4829 {S_FN_BaseKanaEisuToggle ,CANNA_FN_BaseKanaEisuToggle}, 4830 {S_FN_BaseKakuteiHenkanToggle ,CANNA_FN_BaseKakuteiHenkanToggle}, 4831 {S_FN_BaseRotateForward ,CANNA_FN_BaseRotateForward}, 4832 {S_FN_BaseRotateBackward ,CANNA_FN_BaseRotateBackward}, 4833 {S_FN_Mark ,CANNA_FN_Mark}, 4834 {S_FN_Temporary ,CANNA_FN_TemporalMode}, 4835 {S_FN_SyncDic ,CANNA_FN_SyncDic}, 4836 {S_RussianMode ,CANNA_FN_RussianMode}, 4837 {S_GreekMode ,CANNA_FN_GreekMode}, 4838 {S_LineMode ,CANNA_FN_LineMode}, 4839 {S_FN_DefineDicMode ,CANNA_FN_DefineDicMode}, 4840 {S_FN_DeleteDicMode ,CANNA_FN_DeleteDicMode}, 4841 {S_FN_DicMountMode ,CANNA_FN_DicMountMode}, 4842 {S_FN_EnterChikujiMode ,CANNA_FN_EnterChikujiMode}, 4843 {S_FN_EnterRenbunMode ,CANNA_FN_EnterRenbunMode}, 4844 {S_FN_DisconnectServer ,CANNA_FN_DisconnectServer}, 4845 {S_FN_ChangeServerMode ,CANNA_FN_ChangeServerMode}, 4846 {S_FN_ShowServer ,CANNA_FN_ShowServer}, 4847 {S_FN_ShowGakushu ,CANNA_FN_ShowGakushu}, 4848 {S_FN_ShowVersion ,CANNA_FN_ShowVersion}, 4849 {S_FN_ShowPhonogramFile ,CANNA_FN_ShowPhonogramFile}, 4850 {S_FN_ShowCannaFile ,CANNA_FN_ShowCannaFile}, 4851 {S_FN_PageUp ,CANNA_FN_PageUp}, 4852 {S_FN_PageDown ,CANNA_FN_PageDown}, 4853 {S_FN_Edit ,CANNA_FN_Edit}, 4854 {S_FN_BubunKakutei ,CANNA_FN_BubunKakutei}, 4855 {S_FN_HenkanRegion ,CANNA_FN_HenkanRegion}, 4856 {S_FN_PhonoEdit ,CANNA_FN_PhonoEdit}, 4857 {S_FN_DicEdit ,CANNA_FN_DicEdit}, 4858 {S_FN_Configure ,CANNA_FN_Configure}, 4859 {S_FN_KanaRotate ,CANNA_FN_KanaRotate}, 4860 {S_FN_RomajiRotate ,CANNA_FN_RomajiRotate}, 4861 {S_FN_CaseRotate ,CANNA_FN_CaseRotate}, 4862 {0 ,0}, 4863}; 4864 4865static void 4866defcannafunc(void) 4867{ 4868 struct cannafndefs *p; 4869 4870 for (p = cannafns ; p->fnname ; p++) { 4871 symbolpointer(getatmz(p->fnname))->fid = p->fnid; 4872 } 4873} 4874 4875 4876static void 4877defatms(void) 4878{ 4879 deflispfunc(); 4880 defcannavar(); 4881 defcannamode(); 4882 defcannafunc(); 4883 QUOTE = getatmz("quote"); 4884 T = getatmz("t"); 4885 _LAMBDA = getatmz("lambda"); 4886 _MACRO = getatmz("macro"); 4887 COND = getatmz("cond"); 4888 USER = getatmz(":user"); 4889 BUSHU = getatmz(":bushu"); 4890 RENGO = getatmz(":rengo"); 4891 KATAKANA = getatmz(":katakana"); 4892 HIRAGANA = getatmz(":hiragana"); 4893 GRAMMAR = getatmz(":grammar"); 4894 HYPHEN = getatmz("-"); 4895 symbolpointer(T)->value = T; 4896} 4897 4898