Annotation of freem/src/views.c, revision 1.1
1.1 ! snw 1: /*
! 2: * *
! 3: * * *
! 4: * * *
! 5: * ***************
! 6: * * * * *
! 7: * * MUMPS *
! 8: * * * * *
! 9: * ***************
! 10: * * *
! 11: * * *
! 12: * *
! 13: *
! 14: * views.c
! 15: * implementation of VIEW command and $VIEW intrinsic function
! 16: *
! 17: *
! 18: * Author: Serena Willis <jpw@coherent-logic.com>
! 19: * Copyright (C) 1998 MUG Deutschland
! 20: * Copyright (C) 2020 Coherent Logic Development LLC
! 21: *
! 22: *
! 23: * This file is part of FreeM.
! 24: *
! 25: * FreeM is free software: you can redistribute it and/or modify
! 26: * it under the terms of the GNU Affero Public License as published by
! 27: * the Free Software Foundation, either version 3 of the License, or
! 28: * (at your option) any later version.
! 29: *
! 30: * FreeM is distributed in the hope that it will be useful,
! 31: * but WITHOUT ANY WARRANTY; without even the implied warranty of
! 32: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 33: * GNU Affero Public License for more details.
! 34: *
! 35: * You should have received a copy of the GNU Affero Public License
! 36: * along with FreeM. If not, see <https://www.gnu.org/licenses/>.
! 37: *
! 38: **/
! 39:
! 40: #include <stdlib.h>
! 41:
! 42: #include "mpsdef.h"
! 43: #include "mwapi_window.h"
! 44:
! 45: #define LOCK 'l'
! 46: #define ZDEALLOCATE 'D'
! 47:
! 48: /* system services */
! 49:
! 50: #include <signal.h>
! 51:
! 52: #if !defined(__APPLE__) && !defined(__gnu_hurd__) && !defined(EMSCRIPTEN)
! 53: # if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__AMIGA)
! 54: # include <termios.h>
! 55: # if !defined(__AMIGA)
! 56: # define TCGETA TIOCGETA
! 57: # define TCSETA TIOCSETA
! 58: # endif
! 59: # define termio termios
! 60: # else
! 61: # if !defined(MSDOS)
! 62: # include <termio.h>
! 63: # endif
! 64: # endif
! 65: #else
! 66: # include <termios.h>
! 67: #endif
! 68:
! 69:
! 70: #ifdef __CYGWIN__
! 71: #include <errno.h>
! 72: #endif /* __CYGWIN__ */
! 73: #include <errno.h> //jpw
! 74:
! 75: #include <fcntl.h>
! 76: #include <unistd.h>
! 77: #include <time.h>
! 78: #include <string.h>
! 79: #include <stdio.h>
! 80: #include "shmmgr.h"
! 81:
! 82: /* 01/18/99 rlf Apparently, tell disappeared with libc-6 */
! 83: #if defined(LINUX_GLIBC) || defined(__APPLE__)
! 84:
! 85: long int tell (int fd)
! 86: {
! 87: return lseek (fd, 0, SEEK_CUR);
! 88: }
! 89:
! 90: #else
! 91: long int tell ();
! 92: #endif /* LINUX_GLIBC */
! 93:
! 94:
! 95: #if defined(MWAPI_GTK)
! 96: void destroy(GtkWidget* widget, gpointer data)
! 97: {
! 98: gtk_main_quit();
! 99: }
! 100: #endif
! 101:
! 102:
! 103: void view_com ()
! 104: {
! 105: /* process VIEW command */
! 106:
! 107: char tmp[256];
! 108: char tmp2[256];
! 109: int arg1;
! 110: register long int i;
! 111: register long int j;
! 112: register long int ch;
! 113:
! 114: if (*codptr == SP || *codptr == EOL) { /* no argument form of VIEW */
! 115: merr_raise (ARGER);
! 116: return;
! 117: }
! 118:
! 119: expr (STRING);
! 120:
! 121: arg1 = intexpr (argptr);
! 122:
! 123: if (merr () > OK) return;
! 124:
! 125: if (*codptr == ':') {
! 126:
! 127: codptr++;
! 128:
! 129: expr (STRING);
! 130:
! 131: if (merr () > OK) return;
! 132:
! 133: switch (arg1) {
! 134:
! 135:
! 136: /* VIEW 52: G0 input translation table */
! 137: case 52:
! 138:
! 139: stcpy0 (G0I[io], argptr, 256L);
! 140:
! 141: for (i = 0; i < 256; i++) {
! 142:
! 143: if (G0I[io][i] == EOL) {
! 144:
! 145: while (i < 256) {
! 146: G0I[io][i] = (char) i;
! 147: i++;
! 148: }
! 149:
! 150: break;
! 151: }
! 152:
! 153: }
! 154:
! 155: break;
! 156:
! 157:
! 158: /* VIEW 53: G0 output translation table */
! 159: case 53:
! 160:
! 161: stcpy0 (G0O[io], argptr, 256L);
! 162:
! 163: for (i = 0; i < 256; i++) {
! 164:
! 165: if (G0O[io][i] == EOL) {
! 166:
! 167: while (i < 256) {
! 168: G0O[io][i] = (char) i;
! 169: i++;
! 170: }
! 171:
! 172: break;
! 173: }
! 174:
! 175: }
! 176:
! 177: break;
! 178:
! 179:
! 180: /* VIEW 54: G1 input translation table */
! 181: case 54:
! 182:
! 183: stcpy0 (G1I[io], argptr, 256L);
! 184:
! 185: for (i = 0; i < 256; i++) {
! 186:
! 187: if (G1I[io][i] == EOL) {
! 188:
! 189: while (i < 256) {
! 190: G1I[io][i] = (char) i;
! 191: i++;
! 192: }
! 193:
! 194: break;
! 195:
! 196: }
! 197:
! 198: }
! 199:
! 200: break;
! 201:
! 202:
! 203: /* VIEW 55: G1 output translation table */
! 204: case 55:
! 205:
! 206: stcpy0 (G1O[io], argptr, 256L);
! 207:
! 208: for (i = 0; i < 256; i++) {
! 209:
! 210: if (G1O[io][i] == EOL) {
! 211:
! 212: while (i < 256) {
! 213: G1O[io][i] = (char) i;
! 214: i++;
! 215: }
! 216:
! 217: break;
! 218:
! 219: }
! 220:
! 221: }
! 222:
! 223: break;
! 224:
! 225:
! 226: /* VIEW 62: random: seed number */
! 227: case 62:
! 228:
! 229: i = intexpr (argptr);
! 230:
! 231: if (merr () == MXNUM) return;
! 232:
! 233: if (i < 0) {
! 234: merr_raise (ARGER);
! 235: }
! 236: else {
! 237: nrandom = i;
! 238: }
! 239:
! 240: break;
! 241:
! 242:
! 243: /* VIEW 63: random: parameter a */
! 244: case 63:
! 245:
! 246: i = intexpr (argptr);
! 247:
! 248: if (merr () == MXNUM) return;
! 249:
! 250: if (i <= 0) {
! 251: merr_raise (ARGER);
! 252: }
! 253: else {
! 254: ran_a = i;
! 255: }
! 256:
! 257: break;
! 258:
! 259:
! 260: /* VIEW 64: random: parameter b */
! 261: case 64:
! 262:
! 263: i = intexpr (argptr);
! 264:
! 265: if (merr () == MXNUM) return;
! 266:
! 267: if (i < 0) {
! 268: merr_raise (ARGER);
! 269: }
! 270: else {
! 271: ran_b = i;
! 272: }
! 273:
! 274: break;
! 275:
! 276:
! 277: /* VIEW 65: random: parameter c */
! 278: case 65:
! 279:
! 280: i = intexpr (argptr);
! 281:
! 282: if (merr () == MXNUM) return;
! 283:
! 284: if (i <= 0) {
! 285: merr_raise (ARGER);
! 286: }
! 287: else {
! 288: ran_c = i;
! 289: }
! 290:
! 291: break;
! 292:
! 293:
! 294: /* VIEW 66: SIGTERM handling flag */
! 295: case 66:
! 296:
! 297: killerflag = tvexpr (argptr);
! 298:
! 299: break;
! 300:
! 301:
! 302: /* VIEW 67: SIGHUP handling flag */
! 303: case 67:
! 304:
! 305: huperflag = tvexpr (argptr);
! 306:
! 307: break;
! 308:
! 309:
! 310: /* ... reserved ... */
! 311:
! 312: /* VIEW 70: ZSORT/ZSYNTAX flag */
! 313: case 70:
! 314:
! 315: s_fun_flag = tvexpr (argptr);
! 316:
! 317: break;
! 318:
! 319:
! 320: /* VIEW 71: ZNEXT/ZNAME flag */
! 321: case 71:
! 322:
! 323: n_fun_flag = tvexpr (argptr);
! 324:
! 325: break;
! 326:
! 327:
! 328: /* VIEW 72: ZPREVIOUS/ZPIECE flag */
! 329: case 72:
! 330:
! 331: p_fun_flag = tvexpr (argptr);
! 332:
! 333: break;
! 334:
! 335:
! 336: /* VIEW 73: ZDATA/ZDATE flag */
! 337: case 73:
! 338:
! 339: d_fun_flag = tvexpr (argptr);
! 340:
! 341: break;
! 342:
! 343:
! 344: /* VIEW 79: old ZJOB vs. new ZJOB flag */
! 345: case 79:
! 346:
! 347: zjobflag = tvexpr (argptr);
! 348:
! 349: break;
! 350:
! 351:
! 352: /* VIEW 80: 7 vs. 8 bit flag */
! 353: case 80:
! 354:
! 355: eightbit = tvexpr (argptr);
! 356:
! 357: break;
! 358:
! 359:
! 360: /* VIEW 81: PF1 flag */
! 361: case 81:
! 362:
! 363: PF1flag = tvexpr (argptr);
! 364:
! 365: break;
! 366:
! 367:
! 368: /* VIEW 82: not used */
! 369: /* VIEW 83: text in $ZE flag */
! 370: case 83:
! 371:
! 372: etxtflag = tvexpr (argptr);
! 373:
! 374: break;
! 375:
! 376:
! 377: /* VIEW 84: not used */
! 378: /* VIEW 85: not used */
! 379: /* VIEW 86: not used */
! 380:
! 381: case 87: /* VIEW 87: date type definition */
! 382:
! 383: i = intexpr (argptr);
! 384:
! 385: if (i < 0 || i >= NO_DATETYPE) {
! 386: merr_raise (ARGER);
! 387: return;
! 388: }
! 389:
! 390: if (*codptr != ':') {
! 391: datetype = i;
! 392: break;
! 393: }
! 394:
! 395: if (i == 0) {
! 396: merr_raise (ARGER);
! 397: return;
! 398: }
! 399:
! 400: codptr++;
! 401:
! 402: expr (STRING);
! 403:
! 404: j = intexpr (argptr);
! 405:
! 406: if (*codptr != ':') {
! 407: merr_raise (ARGER);
! 408: return;
! 409: }
! 410:
! 411: codptr++;
! 412:
! 413: expr (STRING);
! 414:
! 415: if (j > 0 && j < 15 && stlen (argptr) > MONTH_LEN) {
! 416: merr_raise (M75);
! 417: }
! 418: else if (j > 0 && j < 13) {
! 419: stcpy (month[i][j - 1], argptr);
! 420: }
! 421: else if (j == 13) {
! 422: stcpy (dat1char[i], argptr);
! 423: }
! 424: else if (j == 14) {
! 425: stcpy (dat2char[i], argptr);
! 426: }
! 427: else if (j == 15) {
! 428: dat3char[i] = (*argptr);
! 429: }
! 430: else if (j == 16) {
! 431:
! 432: if ((j = intexpr (argptr)) < 0 || j > 2) {
! 433: merr_raise (ARGER);
! 434: return;
! 435: }
! 436:
! 437: dat4flag[i] = j;
! 438:
! 439: }
! 440: else if (j == 17) {
! 441: dat5flag[i] = tvexpr (argptr);
! 442: }
! 443: else if (j == 18) {
! 444: if ((j = intexpr (argptr) + 672411L) <= 0L) {
! 445: merr_raise (ARGER);
! 446: return;
! 447: }
! 448: datGRbeg[i] = j;
! 449: }
! 450: else {
! 451: merr_raise (ARGER);
! 452: }
! 453:
! 454: if (merr () > OK) return;
! 455:
! 456: break;
! 457:
! 458:
! 459: case 88: /* VIEW 88: time type definition */
! 460:
! 461: i = intexpr (argptr);
! 462:
! 463: if (i < 0 || i >= NO_TIMETYPE) {
! 464: merr_raise (ARGER);
! 465: return;
! 466: }
! 467:
! 468: if (*codptr != ':') {
! 469: timetype = i;
! 470: break;
! 471: }
! 472:
! 473: codptr++;
! 474:
! 475: expr (STRING);
! 476:
! 477: j = intexpr (argptr);
! 478:
! 479: if (*codptr != ':') {
! 480: merr_raise (ARGER);
! 481: return;
! 482: }
! 483:
! 484: codptr++;
! 485:
! 486: expr (STRING);
! 487:
! 488: if (j == 1) {
! 489: tim1char[i] = (*argptr);
! 490: }
! 491: else if (j == 2) {
! 492: tim2char[i] = (*argptr);
! 493: }
! 494: else if (j == 3) {
! 495: tim3char[i] = (*argptr);
! 496: }
! 497: else if (j == 4) {
! 498: tim4flag[i] = tvexpr (argptr);
! 499: }
! 500: else if (j == 5) {
! 501: tim5flag[i] = tvexpr (argptr);
! 502: }
! 503: else {
! 504: merr_raise (ARGER);
! 505: }
! 506:
! 507: if (merr () > OK) return;
! 508:
! 509: break;
! 510:
! 511:
! 512: case 91: /* VIEW 91: missing QUIT expr default expression */
! 513:
! 514: stcpy (exfdefault, argptr);
! 515:
! 516: break;
! 517:
! 518:
! 519: case 92: /* VIEW 92: EUR2DEM: type mismatch error */
! 520:
! 521: typemmflag = tvexpr (argptr);
! 522:
! 523: break;
! 524:
! 525:
! 526: case 93: /* VIEW 93: zkey production rule definition */
! 527:
! 528: i = intexpr (argptr);
! 529:
! 530: if (i < 1 || i > NO_V93) {
! 531: merr_raise (ARGER);
! 532: return;
! 533: }
! 534:
! 535: if (*codptr != ':') {
! 536: v93 = i;
! 537: break;
! 538: }
! 539:
! 540: codptr++;
! 541:
! 542: expr (STRING);
! 543:
! 544: stcpy (v93a[i - 1], argptr);
! 545:
! 546: break;
! 547:
! 548:
! 549: case 96: /* VIEW 96: global prefix */
! 550:
! 551: if (stlen (argptr) > MONTH_LEN) {
! 552: merr_raise (M75);
! 553: }
! 554: else {
! 555: stcpy (glo_prefix, argptr);
! 556: }
! 557:
! 558: break;
! 559:
! 560:
! 561: case 97: /* VIEW 97: global postfix */
! 562:
! 563: if (stlen (argptr) > MONTH_LEN) {
! 564: merr_raise (M75);
! 565: }
! 566: else {
! 567: stcpy (glo_ext, argptr);
! 568: }
! 569:
! 570: break;
! 571:
! 572:
! 573: case 98: /* VIEW 98: routine extension */
! 574:
! 575: if (stlen (argptr) > MONTH_LEN) {
! 576: merr_raise (M75);
! 577: }
! 578: else {
! 579: stcpy (rou_ext, argptr);
! 580: }
! 581:
! 582: break;
! 583:
! 584:
! 585: case 101: /* VIEW 101: set ierr */
! 586:
! 587: merr_raise (intexpr (argptr));
! 588:
! 589: break;
! 590:
! 591: case 102: /* VIEW 102 set deferred_ierr */
! 592:
! 593: deferred_ierr = intexpr (argptr);
! 594:
! 595: break;
! 596:
! 597:
! 598: case 103: /* MERGE to ^$WINDOW complete. Parameter is empty (for all windows) or string for window name in subscript 1 */
! 599: #if defined(MWAPI_GTK)
! 600: mwapi_on_merge_complete (argptr);
! 601: #endif
! 602: break;
! 603:
! 604:
! 605:
! 606: #if !defined(__APPLE__) && !defined(__gnu_hurd__) && !defined(__AMIGA) && !defined(EMSCRIPTEN) && !defined(MSDOS)
! 607:
! 608: case 113: /* VIEW 113: set termio infos */
! 609: {
! 610:
! 611: struct termio tpara;
! 612:
! 613: i = intexpr (argptr);
! 614:
! 615: if (i < 1 || i > MAXDEV) {
! 616: merr_raise (NODEVICE);
! 617: }
! 618: else if (devopen[i] == 0) {
! 619: merr_raise (NOPEN);
! 620: }
! 621: else if (*codptr != ':') {
! 622: merr_raise (ARGER);
! 623: }
! 624: else {
! 625:
! 626: codptr++;
! 627:
! 628: expr (STRING);
! 629:
! 630: j = intexpr (argptr);
! 631:
! 632: }
! 633:
! 634: if (merr () > OK) return;
! 635:
! 636: ioctl (fileno (opnfile[i]), TCGETA, &tpara);
! 637:
! 638: j = 0;
! 639:
! 640: tpara.c_iflag = intexpr (argptr);
! 641:
! 642: while ((ch = argptr[j]) != EOL) {
! 643:
! 644: j++;
! 645:
! 646: if (ch == ':') break;
! 647:
! 648: }
! 649:
! 650: tpara.c_oflag = intexpr (&argptr[j]);
! 651:
! 652: while ((ch = argptr[j]) != EOL) {
! 653:
! 654: j++;
! 655:
! 656: if (ch == ':') break;
! 657:
! 658: }
! 659:
! 660: tpara.c_cflag = intexpr (&argptr[j]);
! 661:
! 662: while ((ch = argptr[j]) != EOL) {
! 663:
! 664: j++;
! 665:
! 666: if (ch == ':') break;
! 667:
! 668: }
! 669:
! 670: tpara.c_lflag = intexpr (&argptr[j]);
! 671:
! 672: ioctl (fileno (opnfile[i]), TCSETA, &tpara);
! 673:
! 674: return;
! 675:
! 676: }
! 677:
! 678: #endif /* __APPLE__ */
! 679:
! 680:
! 681: /* VIEW 133: remember ZLOAD directory on ZSAVE */
! 682: case 133:
! 683:
! 684: zsavestrategy = tvexpr (argptr);
! 685:
! 686: return;
! 687:
! 688:
! 689: default:
! 690:
! 691: merr_raise (ARGER);
! 692: return;
! 693:
! 694: } /* end switch one parameter VIEWs */
! 695: }
! 696: else { /* no parameters VIEWs */
! 697:
! 698: switch (arg1) {
! 699:
! 700:
! 701: /* VIEW 21: close all globals */
! 702: case 21:
! 703:
! 704: close_all_globals ();
! 705:
! 706: return;
! 707:
! 708:
! 709:
! 710: /* VIEW 29: symtab copy */
! 711: case 29: /* get space if needed */
! 712:
! 713: if (apartition == NULL) apartition = calloc ((unsigned) (PSIZE + 1), 1);
! 714:
! 715: for (i = 0; i <= PSIZE; i++) apartition[i] = partition[i];
! 716:
! 717: asymlen = symlen;
! 718:
! 719: for (i = 0; i < 128; i++) aalphptr[i] = alphptr[i];
! 720:
! 721: return;
! 722:
! 723: }
! 724:
! 725: merr_raise (ARGER);
! 726: return;
! 727:
! 728: }
! 729:
! 730: return;
! 731: } /* end view_com() */
! 732:
! 733: /*
! 734: * f = number of arguments
! 735: * a = the arguments
! 736: */
! 737: void view_fun (int f, char *a) /* process VIEW function */
! 738: {
! 739: int i;
! 740:
! 741: if (standard) {
! 742: merr_raise (NOSTAND);
! 743: return;
! 744: } /* non_standard */
! 745:
! 746: if (f == 1) {
! 747:
! 748: f = intexpr (a);
! 749:
! 750: switch (f) {
! 751:
! 752: /* $V(21) returns size of last global */
! 753: case 21:
! 754:
! 755: if (oldfil[inuse][0] != NUL) {
! 756:
! 757: lseek (olddes[inuse], 0L, 2);
! 758: lintstr (a, (long) tell (olddes[inuse]));
! 759:
! 760: }
! 761: else {
! 762: *a = EOL;
! 763: }
! 764:
! 765: break;
! 766:
! 767:
! 768: /* $V(22): number of v22_aliases */
! 769: case 22:
! 770:
! 771: i = 0;
! 772: f = 0;
! 773:
! 774: while (f < v22ptr) {
! 775: i++;
! 776: f += UNSIGN (v22ali[f]) + 1;
! 777: }
! 778:
! 779: intstr (a, i);
! 780:
! 781: break;
! 782:
! 783:
! 784: /* $V(23): contents of 'input buffer' */
! 785: case 23:
! 786:
! 787: stcpy (a, ug_buf[io]);
! 788: break;
! 789:
! 790:
! 791: /* $V(24)/$V(25) number of screen lines */
! 792: case 24:
! 793: case 25:
! 794:
! 795: intstr (a, N_LINES);
! 796: break;
! 797:
! 798:
! 799: /* $V(26): DO-FOR-XEC stack pointer */
! 800: case 26:
! 801:
! 802: intstr (a, nstx);
! 803: break;
! 804:
! 805:
! 806: /* $V(27): DO-FOR-XEC stack pointer (copy on error) */
! 807: case 27:
! 808:
! 809: intstr (a, nesterr);
! 810: break;
! 811:
! 812:
! 813: /* $V(30): number of mumps arguments */
! 814: case 30:
! 815:
! 816: intstr (a, m_argc);
! 817: break;
! 818:
! 819:
! 820: /* $V(31): environment variables */
! 821: case 31:
! 822:
! 823: f = 0;
! 824:
! 825: while (m_envp[f] && m_envp[f][0] != NUL) f++;
! 826:
! 827: intstr (a, f);
! 828: break;
! 829:
! 830:
! 831: /* $V(52): G0 input translation table */
! 832: case 52:
! 833:
! 834: stcpy0 (a, G0I[io], 257L);
! 835: a[255] = EOL;
! 836: break;
! 837:
! 838:
! 839: /* $V(53): G0 output translation table */
! 840: case 53:
! 841:
! 842: stcpy0 (a, G0O[io], 257L);
! 843: a[255] = EOL;
! 844:
! 845: break;
! 846:
! 847:
! 848: /* $V(54): G1 input translation table */
! 849: case 54:
! 850:
! 851: stcpy0 (a, G1I[io], 257L);
! 852: a[255] = EOL;
! 853:
! 854: break;
! 855:
! 856:
! 857: /* $V(55): G1 output translation table */
! 858: case 55:
! 859:
! 860: stcpy0 (a, G1O[io], 257L);
! 861: a[255] = EOL;
! 862:
! 863: break;
! 864:
! 865:
! 866: /* $V(60): partial pattern match flag */
! 867: case 60:
! 868:
! 869: intstr (a, pattrnflag);
! 870: break;
! 871:
! 872:
! 873: /* $V(61): partial pattern supplement character */
! 874: case 61:
! 875:
! 876: a[0] = pattrnchar;
! 877: a[1] = EOL;
! 878:
! 879: break;
! 880:
! 881:
! 882: /* $V(62): random: seed number */
! 883: case 62:
! 884:
! 885: lintstr (a, nrandom);
! 886: break;
! 887:
! 888:
! 889: /* $V(63): random: parameter a */
! 890: case 63:
! 891:
! 892: lintstr (a, ran_a);
! 893: break;
! 894:
! 895:
! 896: /* $V(64): random: parameter b */
! 897: case 64:
! 898:
! 899: lintstr (a, ran_b);
! 900: break;
! 901:
! 902:
! 903: /* $V(65): random: parameter c */
! 904: case 65:
! 905:
! 906: lintstr (a, ran_c);
! 907: break;
! 908:
! 909:
! 910: /* $V(66): SIGTERM handling flag */
! 911: case 66:
! 912:
! 913: intstr (a, killerflag);
! 914: break;
! 915:
! 916:
! 917: /* $V(67): SIGHUP handling flag */
! 918: case 67:
! 919:
! 920: intstr (a, huperflag);
! 921: break;
! 922:
! 923:
! 924: /* ... reserved ... */
! 925:
! 926:
! 927: /* $V(70): ZSORT/ZSYNTAX flag */
! 928: case 70:
! 929:
! 930: intstr (a, s_fun_flag);
! 931: break;
! 932:
! 933:
! 934: /* $V(71): ZNEXT/ZNAME flag */
! 935: case 71:
! 936:
! 937: intstr (a, n_fun_flag);
! 938: break;
! 939:
! 940:
! 941: /* $V(72): ZPREVIOUS/ZPIECE flag */
! 942: case 72:
! 943:
! 944: intstr (a, p_fun_flag);
! 945: break;
! 946:
! 947:
! 948: /* $V(73): ZDATA/ZDATE flag */
! 949: case 73:
! 950:
! 951: intstr (a, d_fun_flag);
! 952: break;
! 953:
! 954:
! 955: /* ... reserved ... */
! 956:
! 957:
! 958: /* $V(79): old ZJOB vs. new ZJOB flag */
! 959: case 79:
! 960:
! 961: intstr (a, zjobflag);
! 962: break;
! 963:
! 964:
! 965: /* $V(80): 7 vs. 8 bit flag */
! 966: case 80:
! 967:
! 968: intstr (a, eightbit);
! 969: break;
! 970:
! 971:
! 972: /* $V(81): PF1 flag */
! 973: case 81:
! 974:
! 975: intstr (a, PF1flag);
! 976: break;
! 977:
! 978:
! 979: /* $V(82): order counter */
! 980: case 82:
! 981:
! 982: intstr (a, ordercounter);
! 983: break;
! 984:
! 985:
! 986: /* $V(83): text in $ZE flag */
! 987: case 83:
! 988:
! 989: intstr (a, etxtflag);
! 990: break;
! 991:
! 992:
! 993: /* $V(84): path of current routine */
! 994: case 84: /* look whether we know where the routine came from */
! 995:
! 996: for (i = 0; i < NO_OF_RBUF; i++) {
! 997:
! 998: int j;
! 999:
! 1000: if (pgms[i][0] == 0) {
! 1001: *a = EOL;
! 1002: return;
! 1003: } /* buffer empty */
! 1004:
! 1005: j = 0;
! 1006:
! 1007: while (rou_name[j] == pgms[i][j]) {
! 1008:
! 1009: if (rou_name[j++] == EOL) {
! 1010:
! 1011: stcpy (a, path[i]);
! 1012: i = stlen (a);
! 1013:
! 1014: if (i > 0) a[i - 1] = EOL;
! 1015:
! 1016: return;
! 1017:
! 1018: }
! 1019:
! 1020: }
! 1021:
! 1022: }
! 1023:
! 1024: *a = EOL;
! 1025:
! 1026: break; /* not found */
! 1027:
! 1028:
! 1029: /* $V(85): path of last global */
! 1030: case 85:
! 1031:
! 1032: if (oldfil[inuse][0]) {
! 1033: stcpy (a, oldfil[inuse]);
! 1034: }
! 1035: else {
! 1036: *a = EOL;
! 1037: }
! 1038:
! 1039: i = 0;
! 1040:
! 1041: while (a[i] != EOL) {
! 1042:
! 1043: if (a[i] == '^') {
! 1044:
! 1045: if (i > 0) {
! 1046: i--;
! 1047: }
! 1048:
! 1049: a[i] = EOL;
! 1050:
! 1051: break;
! 1052:
! 1053: }
! 1054:
! 1055: i++;
! 1056:
! 1057: }
! 1058:
! 1059: break;
! 1060:
! 1061:
! 1062: /* $V(86): path of current device */
! 1063: case 86:
! 1064:
! 1065: stcpy (a, act_oucpath[io]);
! 1066: break;
! 1067:
! 1068:
! 1069: /* $V(87): date type definitions */
! 1070: case 87:
! 1071:
! 1072: intstr (a, datetype);
! 1073: break;
! 1074:
! 1075:
! 1076: /* $V(88): date type definitions */
! 1077: case 88:
! 1078:
! 1079: intstr (a, timetype);
! 1080: break;
! 1081:
! 1082:
! 1083: /* $V(91): missig QUIT expr default expression */
! 1084: case 91:
! 1085:
! 1086: stcpy (a, exfdefault);
! 1087: break;
! 1088:
! 1089:
! 1090: /* $V(92): type mismatch error */
! 1091: case 92:
! 1092:
! 1093: intstr (a, typemmflag);
! 1094: break;
! 1095:
! 1096:
! 1097: /* $V(93): zkey production default rule definition */
! 1098: case 93:
! 1099:
! 1100: lintstr (a, v93);
! 1101: break;
! 1102:
! 1103:
! 1104: /* $V(98): routine extention */
! 1105: case 98:
! 1106:
! 1107: stcpy (a, rou_ext);
! 1108: break;
! 1109:
! 1110: /* $V(100): exit status of last kill */
! 1111: case 100:
! 1112:
! 1113: intstr (a, v100);
! 1114: break;
! 1115:
! 1116: /* $V(114): Number of rows in terminal */
! 1117: case 114:
! 1118:
! 1119: intstr (a, n_lines);
! 1120: break;
! 1121:
! 1122:
! 1123: /* $V(115): Number of columns in terminal */
! 1124: case 115:
! 1125:
! 1126: intstr (a, n_columns);
! 1127: break;
! 1128:
! 1129:
! 1130: /* $V(133): remember ZLOAD directory on ZSAVE */
! 1131: case 133:
! 1132:
! 1133: intstr (a, zsavestrategy);
! 1134: break;
! 1135:
! 1136:
! 1137: default:
! 1138:
! 1139: merr_raise (ARGER);
! 1140: return;
! 1141:
! 1142: }
! 1143:
! 1144: return;
! 1145: }
! 1146:
! 1147: if (f == 2) {
! 1148:
! 1149: char tmp[256];
! 1150:
! 1151: stcpy (tmp, argstck[arg + 1]);
! 1152:
! 1153: i = intexpr (argstck[arg + 1]);
! 1154: f = intexpr (a);
! 1155:
! 1156: if (merr () == MXNUM) return;
! 1157:
! 1158: if (f == 16) {
! 1159:
! 1160: if (i <= OK || i >= MAXERR) {
! 1161: merr_raise (ARGER);
! 1162: return;
! 1163: }
! 1164: else {
! 1165: stcpy (a, errmes[i]);
! 1166: }
! 1167:
! 1168: }
! 1169: else if (f == 22) { /* return v22_alias entry */
! 1170:
! 1171: if (i) { /* give one of the names which are aliases */
! 1172:
! 1173: f = 0;
! 1174:
! 1175: while (f < v22ptr) {
! 1176:
! 1177: i--;
! 1178:
! 1179: if (i == 0) {
! 1180: stcpy (a, &v22ali[f + 1]);
! 1181: return;
! 1182: }
! 1183:
! 1184: f += UNSIGN (v22ali[f]) + 1;
! 1185:
! 1186: }
! 1187:
! 1188: a[0] = EOL;
! 1189:
! 1190: return; /* that number had no entry in the table */
! 1191:
! 1192: }
! 1193:
! 1194: if (tstglvn (tmp) == FALSE) {
! 1195: merr_raise (INVREF);
! 1196: return;
! 1197: }
! 1198:
! 1199: if (v22ptr) { /* there are aliases */
! 1200:
! 1201: int k, j;
! 1202:
! 1203: i = 0;
! 1204:
! 1205: while (i < v22ptr) {
! 1206:
! 1207: k = i + UNSIGN (v22ali[i]) + 1;
! 1208: j = 0; /* is current reference an alias ??? */
! 1209:
! 1210: while (v22ali[++i] == tmp[j]) {
! 1211:
! 1212: if (v22ali[i] == EOL) break;
! 1213:
! 1214: j++;
! 1215:
! 1216: }
! 1217:
! 1218: /* yes, it is, return it */
! 1219: if (v22ali[i] == EOL && tmp[j] == EOL) {
! 1220: stcpy (a, &v22ali[i + 1]);
! 1221: return;
! 1222: }
! 1223:
! 1224: i = k;
! 1225:
! 1226: }
! 1227:
! 1228: }
! 1229:
! 1230: a[0] = EOL; /* entry was not in the table */
! 1231:
! 1232: return;
! 1233:
! 1234: }
! 1235: else if (f == 24) { /* return screen line */
! 1236:
! 1237: if (i < -N_LINES || i > N_LINES || i == 0) {
! 1238: *a = EOL;
! 1239: }
! 1240: else if (i < 0) {
! 1241:
! 1242: stcpy0 (a, (*screen).screena[(unsigned int) (*screen).sclines[-i - 1]], (long) N_COLUMNS);
! 1243: a[80] = EOL;
! 1244:
! 1245: return;
! 1246:
! 1247: }
! 1248: else {
! 1249:
! 1250: stcpy0 (a, (*screen).screenx[(unsigned int) (*screen).sclines[i - 1]], (long) N_COLUMNS);
! 1251: a[80] = EOL;
! 1252:
! 1253: return;
! 1254:
! 1255: }
! 1256: }
! 1257: else if (f == 25) { /* return screen line with attribute */
! 1258:
! 1259: i--;
! 1260:
! 1261: if (i < 0 || i >= N_LINES) {
! 1262: *a = EOL;
! 1263: }
! 1264: else {
! 1265: v25 (a, i);
! 1266: }
! 1267:
! 1268: return;
! 1269:
! 1270: }
! 1271: else if (f == 26) { /* $V(26) returns DO-FOR-XEC stack pointer */
! 1272:
! 1273: if (i < 1 || i > nstx) {
! 1274: merr_raise (ARGER);
! 1275: return;
! 1276: }
! 1277:
! 1278: getraddress (a, i);
! 1279:
! 1280: return;
! 1281:
! 1282: } /* $V(27) returns DO-FOR-XEC stack pointer(error state) */
! 1283: else if (f == 27) {
! 1284:
! 1285: if (i < 1 || i > nesterr) {
! 1286: merr_raise (ARGER);
! 1287: return;
! 1288: }
! 1289:
! 1290: stcpy (a, callerr[i]);
! 1291:
! 1292: return;
! 1293:
! 1294: }
! 1295: else if (f == 30) { /* $V(30): arguments of mumps */
! 1296:
! 1297: if (i < 1 || i > m_argc) {
! 1298: merr_raise (ARGER);
! 1299: return;
! 1300: }
! 1301:
! 1302: strcpy (a, m_argv[i - 1]);
! 1303: a[strlen (a)] = EOL;
! 1304:
! 1305: return;
! 1306:
! 1307: /* guard against very long environment name=value entries */
! 1308: }
! 1309: else if (f == 31) { /* $V(31): environment variables */
! 1310:
! 1311: f = 0;
! 1312:
! 1313: while (m_envp[f] && m_envp[f++][0] != NUL) {
! 1314:
! 1315: if (f != i) continue;
! 1316:
! 1317: if ((f = strlen (m_envp[i - 1])) > STRLEN) {
! 1318: merr_raise (M75);
! 1319: return;
! 1320: }
! 1321:
! 1322: strcpy (a, m_envp[i - 1]);
! 1323: a[f] = EOL;
! 1324:
! 1325: return;
! 1326:
! 1327: }
! 1328:
! 1329: merr_raise (ARGER);
! 1330: return;
! 1331:
! 1332: }
! 1333: else if (f == 93) { /* $V(93): zkey production rule definition */
! 1334:
! 1335: if (i <= 0 || i > NO_V93) {
! 1336: merr_raise (ARGER);
! 1337: }
! 1338: else {
! 1339: strcpy (a, v93a[i - 1]);
! 1340: }
! 1341:
! 1342: return;
! 1343:
! 1344: }
! 1345: #if !defined(__APPLE__) && !defined(__gnu_hurd__) && !defined(__AMIGA) && !defined(EMSCRIPTEN) && !defined(MSDOS)
! 1346: else if (f == 113) { /* $V(113): get termio infos */
! 1347:
! 1348: struct termio tpara;
! 1349:
! 1350: if (i < 1 || i > MAXDEV) {
! 1351: merr_raise (NODEVICE);
! 1352: return;
! 1353: }
! 1354:
! 1355: if (devopen[i] == 0) {
! 1356: merr_raise (NOPEN);
! 1357: return;
! 1358: }
! 1359:
! 1360: ioctl (fileno (opnfile[i]), TCGETA, &tpara);
! 1361:
! 1362: intstr (a, tpara.c_iflag);
! 1363: i = stlen (a);
! 1364: a[i++] = ':';
! 1365:
! 1366: intstr (&a[i], tpara.c_oflag);
! 1367: i = stlen (a);
! 1368: a[i++] = ':';
! 1369:
! 1370: intstr (&a[i], tpara.c_cflag);
! 1371: i = stlen (a);
! 1372: a[i++] = ':';
! 1373:
! 1374: intstr (&a[i], tpara.c_lflag);
! 1375:
! 1376: return;
! 1377:
! 1378: }
! 1379: #endif
! 1380: else {
! 1381: merr_raise (ARGER);
! 1382: return;
! 1383: }
! 1384:
! 1385: }
! 1386: else if (f == 3) {
! 1387:
! 1388: char tmp[256];
! 1389:
! 1390: stcpy (tmp, argstck[arg + 2]);
! 1391: i = intexpr (argstck[arg + 1]);
! 1392: f = intexpr (a);
! 1393:
! 1394: if (merr () == MXNUM) return;
! 1395:
! 1396: if (f == 87) { /* $V(87): date type definitions */
! 1397:
! 1398: if (i < 0 || i >= NO_DATETYPE) {
! 1399: merr_raise (ARGER);
! 1400: return;
! 1401: }
! 1402:
! 1403: f = intexpr (tmp);
! 1404:
! 1405: if (f > 0 && f < 13) {
! 1406: stcpy (a, month[i][f - 1]);
! 1407: return;
! 1408: }
! 1409:
! 1410: switch (f) {
! 1411:
! 1412:
! 1413: case 13:
! 1414:
! 1415: {
! 1416: stcpy (a, dat1char[i]);
! 1417: return;
! 1418: }
! 1419:
! 1420:
! 1421: case 14:
! 1422:
! 1423: {
! 1424: stcpy (a, dat2char[i]);
! 1425: return;
! 1426: }
! 1427:
! 1428:
! 1429: case 15:
! 1430:
! 1431: {
! 1432: a[0] = dat3char[i];
! 1433: a[1] = EOL;
! 1434:
! 1435: return;
! 1436: }
! 1437:
! 1438:
! 1439: case 16:
! 1440:
! 1441: {
! 1442: a[0] = dat4flag[i] + '0';
! 1443: a[1] = EOL;
! 1444:
! 1445: return;
! 1446: }
! 1447:
! 1448:
! 1449: case 17:
! 1450:
! 1451: {
! 1452: a[0] = dat5flag[i] + '0';
! 1453: a[1] = EOL;
! 1454:
! 1455: return;
! 1456: }
! 1457:
! 1458:
! 1459: case 18:
! 1460:
! 1461: {
! 1462: lintstr (a, datGRbeg[i] - 672411L);
! 1463: return;
! 1464: }
! 1465:
! 1466:
! 1467: }
! 1468: }
! 1469: else if (f == 88) { /* $V(88): time type definitions */
! 1470:
! 1471: if (i < 0 || i >= NO_TIMETYPE) {
! 1472: merr_raise (ARGER);
! 1473: return;
! 1474: }
! 1475:
! 1476: f = intexpr (tmp);
! 1477:
! 1478: switch (f) {
! 1479: case 1:
! 1480:
! 1481: {
! 1482: a[0] = tim1char[i];
! 1483: a[1] = EOL;
! 1484:
! 1485: return;
! 1486: }
! 1487:
! 1488:
! 1489: case 2:
! 1490:
! 1491: {
! 1492: a[0] = tim2char[i];
! 1493: a[1] = EOL;
! 1494:
! 1495: return;
! 1496: }
! 1497:
! 1498:
! 1499: case 3:
! 1500:
! 1501: {
! 1502: a[0] = tim3char[i];
! 1503: a[1] = EOL;
! 1504:
! 1505: return;
! 1506: }
! 1507:
! 1508:
! 1509: case 4:
! 1510:
! 1511: {
! 1512: a[0] = tim4flag[i] + '0';
! 1513: a[1] = EOL;
! 1514:
! 1515: return;
! 1516: }
! 1517:
! 1518:
! 1519: case 5:
! 1520:
! 1521: {
! 1522: a[0] = tim5flag[i] + '0';
! 1523: a[1] = EOL;
! 1524:
! 1525: return;
! 1526: }
! 1527:
! 1528:
! 1529: }
! 1530:
! 1531: }
! 1532:
! 1533: merr_raise (ARGER);
! 1534: return;
! 1535:
! 1536: }
! 1537: else {
! 1538: merr_raise (FUNARG);
! 1539: return;
! 1540: }
! 1541:
! 1542: return;
! 1543: } /* end view_fun() */
! 1544:
! 1545:
! 1546: void m_tolower (char *str)
! 1547: {
! 1548: int ch;
! 1549:
! 1550: while ((ch = *str) != EOL) {
! 1551:
! 1552: ch = *str;
! 1553:
! 1554: if (ch <= 'Z' && ch >= 'A') {
! 1555: ch += 32;
! 1556: *str = ch;
! 1557: }
! 1558:
! 1559: str++;
! 1560:
! 1561: }
! 1562:
! 1563: return;
! 1564:
! 1565: } /* end tolower() */
! 1566:
! 1567:
! 1568: /*
! 1569: * size = desired size for 'partition'
! 1570: */
! 1571: short int newpsize (long size)
! 1572: {
! 1573: char *newpart = NULL;
! 1574: char *anewpart = NULL;
! 1575: long dif, j;
! 1576:
! 1577: if (size == PSIZE) return 0; /* nothing changes */
! 1578: if (size <= (PSIZE - symlen + 512)) return 0; /* cannot decrease it now */
! 1579: if (apartition && size <= (PSIZE - asymlen + 512)) return 0; /* cannot decrease it now */
! 1580:
! 1581: if (writing_mb) {
! 1582: newpart = shm_alloc ((size_t) (size+1));
! 1583: }
! 1584: else {
! 1585: newpart = calloc ((unsigned) (size + 1), 1);
! 1586: }
! 1587:
! 1588: if (newpart == NULL) return 1; /* could not allocate stuff */
! 1589:
! 1590: if (apartition) {
! 1591:
! 1592: anewpart = calloc ((unsigned) (size + 1), 1);
! 1593:
! 1594: if (anewpart == NULL) {
! 1595: free (newpart);
! 1596: return 1;
! 1597: }
! 1598: /* no more space */
! 1599:
! 1600: }
! 1601:
! 1602: dif = argptr - partition + 256;
! 1603:
! 1604: if (dif > PSIZE) dif = PSIZE;
! 1605:
! 1606: stcpy0 (newpart, partition, dif); /* intermediate results */
! 1607: dif = size - PSIZE;
! 1608: stcpy0 (&newpart[symlen + dif], &partition[symlen], PSIZE - symlen);
! 1609:
! 1610: if (apartition) stcpy0 (&anewpart[asymlen + dif], &apartition[asymlen], PSIZE - asymlen);
! 1611:
! 1612: for (j = '%'; j <= 'z'; j++) { /* update alphpointers */
! 1613:
! 1614: if (alphptr[j]) alphptr[j] += dif;
! 1615: if (aalphptr[j]) aalphptr[j] += dif;
! 1616:
! 1617: }
! 1618:
! 1619: PSIZE = size;
! 1620: symlen += dif;
! 1621: asymlen += dif;
! 1622:
! 1623: if (writing_mb) {
! 1624: shm_free (partition);
! 1625: }
! 1626: else {
! 1627: free (partition); /* free previously allocated space */
! 1628: }
! 1629:
! 1630: if (apartition) free (apartition); /* free previously allocated space */
! 1631:
! 1632: dif = newpart - partition;
! 1633: partition = newpart;
! 1634:
! 1635: if (apartition) apartition = anewpart;
! 1636:
! 1637: s = &partition[symlen] - 256; /* pointer to symlen_offset */
! 1638: argptr += dif; /* pointer to beg of tmp-storage */
! 1639:
! 1640: for (j = 0; j <= PARDEPTH; j++) {
! 1641:
! 1642: if (argstck[j]) argstck[j] += dif;
! 1643:
! 1644: }
! 1645:
! 1646: return 0;
! 1647:
! 1648: } /* end newpsize() */
! 1649:
! 1650: /* change size of svn_table to 'size' */
! 1651: short int newusize (long size)
! 1652: {
! 1653:
! 1654: char *newsvn;
! 1655: long dif, j;
! 1656:
! 1657: if (size <= (UDFSVSIZ - svnlen)) return 0; /* cannot decrease it now */
! 1658: if (size == UDFSVSIZ) return 0; /* nothing changes */
! 1659:
! 1660: newsvn = calloc ((unsigned) (size + 1), 1);
! 1661:
! 1662: if (newsvn == NULL) return 1; /* could not allocate stuff */
! 1663:
! 1664: stcpy0 (newsvn, svntable, svnlen); /* intermediate results */
! 1665: dif = size - UDFSVSIZ;
! 1666: stcpy0 (&newsvn[svnlen + dif], &svntable[svnlen], UDFSVSIZ - svnlen);
! 1667:
! 1668: for (j = '%'; j <= 'z'; j++) { /* update svn_alphpointers */
! 1669: if (svnaptr[j]) svnaptr[j] += dif;
! 1670: }
! 1671:
! 1672: UDFSVSIZ = size;
! 1673: svnlen += dif;
! 1674:
! 1675: free (svntable); /* free previously allocated space */
! 1676:
! 1677: svntable = newsvn;
! 1678:
! 1679: return 0;
! 1680:
! 1681: } /* end newusize() */
! 1682:
! 1683: /*
! 1684: * allocate 'nbrbuf' routine buffers
! 1685: * of 'size' bytes
! 1686: */
! 1687: short int newrsize (long size, long nbrbuf)
! 1688: {
! 1689:
! 1690: char *newrbuf;
! 1691: int i;
! 1692: long dif;
! 1693: unsigned long total;
! 1694:
! 1695: if (size <= (rouend - rouptr + 1)) return 0; /* making it smaller would be a mistake */
! 1696:
! 1697: if (nbrbuf > MAXNO_OF_RBUF) nbrbuf = MAXNO_OF_RBUF;
! 1698:
! 1699: total = (unsigned) nbrbuf *(unsigned) size;
! 1700:
! 1701: /* some overflow ??? */
! 1702: if ((total / (unsigned) size) != (unsigned) nbrbuf) {
! 1703: merr_raise (ARGER);
! 1704: return 1;
! 1705: }
! 1706:
! 1707: newrbuf = calloc (total, 1); /* routine buffer pool */
! 1708:
! 1709: while (newrbuf == NULL) { /* could not allocate stuff... */
! 1710:
! 1711: if (--nbrbuf < 2) return 1; /* ...so try with less buffers */
! 1712:
! 1713: total = (unsigned) nbrbuf *(unsigned) size;
! 1714:
! 1715: newrbuf = calloc (total, 1);
! 1716:
! 1717: }
! 1718:
! 1719: /* clear all routine buffers but one */
! 1720: for (i = 0; i < MAXNO_OF_RBUF; i++) { /* empty routine buffers */
! 1721: pgms[i][0] = 0;
! 1722: ages[i] = 0L;
! 1723: }
! 1724:
! 1725: /* transfer to new buffer */
! 1726: stcpy0 (newrbuf, rouptr, (long) (rouend - rouptr + 1));
! 1727:
! 1728: dif = newrbuf - rouptr;
! 1729: rouend += dif;
! 1730: ends[0] = rouend;
! 1731:
! 1732: stcpy (pgms[0], rou_name);
! 1733:
! 1734: rouins += dif;
! 1735:
! 1736: if (roucur == (buff + (NO_OF_RBUF * PSIZE0 + 1))) {
! 1737: roucur = newrbuf + (nbrbuf * size + 1);
! 1738: }
! 1739: else {
! 1740: roucur += dif;
! 1741: }
! 1742:
! 1743: rouptr = newrbuf;
! 1744:
! 1745: free (buff); /* free previously allocated space */
! 1746:
! 1747: buff = newrbuf;
! 1748: NO_OF_RBUF = nbrbuf;
! 1749: PSIZE0 = size;
! 1750:
! 1751: return 0;
! 1752:
! 1753: } /* end newrsize() */
! 1754:
! 1755:
! 1756: void zreplace (char *a, char *b, char *c)
! 1757: {
! 1758: long int ch, f, l, m, n;
! 1759: char d[256];
! 1760:
! 1761: if (b[0] == EOL) return; /* 2nd argument was empty */
! 1762:
! 1763: l = stlen (c); /* length of 3rd argument */
! 1764: n = 0;
! 1765: f = 0;
! 1766:
! 1767: for (;;) {
! 1768:
! 1769: m = 0;
! 1770:
! 1771: while ((ch = a[f + m]) == b[m] && ch != EOL) m++;
! 1772:
! 1773: if (b[m] == EOL) {
! 1774:
! 1775: if (n + l > STRLEN) {
! 1776: merr_raise (M75);
! 1777: return;
! 1778: }
! 1779:
! 1780: stcpy0 (&d[n], c, l);
! 1781:
! 1782: n += l;
! 1783: f += m;
! 1784:
! 1785: }
! 1786: else {
! 1787:
! 1788: m = 1;
! 1789:
! 1790: if (n + 1 > STRLEN) {
! 1791: merr_raise (M75);
! 1792: return;
! 1793: }
! 1794:
! 1795: d[n++] = a[f++];
! 1796:
! 1797: }
! 1798:
! 1799: if (a[f] == EOL) break;
! 1800:
! 1801: }
! 1802:
! 1803: d[n] = EOL;
! 1804: stcpy (a, d);
! 1805:
! 1806: return;
! 1807:
! 1808: } /* end zreplace() */
! 1809:
! 1810: short int tstglvn (char *a) /* tests whether 'a' is a proper unsubscripted glvn */
! 1811: {
! 1812: int i, ch;
! 1813:
! 1814: i = 0;
! 1815:
! 1816: if (a[0] == '^') {
! 1817:
! 1818: while (((ch = a[++i]) >= 'A' && ch <= 'Z') ||
! 1819: (ch >= 'a' && ch <= 'z') ||
! 1820: (ch >= '0' && ch <= '9') ||
! 1821: ((ch == '%' && i == 1) ||
! 1822: (standard == 0 &&
! 1823: (((ch == '.' || ch == '/') && i == 1) ||
! 1824: (((ch == '/' && a[i - 1] != '/') ||
! 1825: (ch == '%' && a[i - 1] == '/')) &&
! 1826: (a[1] == '.' || a[1] == '/'))))));
! 1827:
! 1828: return a[i] == EOL;
! 1829:
! 1830: }
! 1831:
! 1832: if ((ch = a[i++]) != '%' && (ch < 'A' || ch > 'Z') && (ch < 'a' || ch > 'z')) return FALSE;
! 1833:
! 1834: while ((ch = a[i++]) != EOL) {
! 1835:
! 1836: if ((ch < '0' || ch > '9') && (ch < 'A' || ch > 'Z') && (ch < 'a' || ch > 'z')) {
! 1837: return FALSE;
! 1838: }
! 1839:
! 1840: }
! 1841:
! 1842: return TRUE;
! 1843:
! 1844: } /* end tstnam() */
! 1845:
! 1846: void zname (char *a, char *b)
! 1847: {
! 1848: int i, j, f, n;
! 1849:
! 1850: i = 0;
! 1851: j = 0;
! 1852: f = FALSE; /* we are in name section (vs.subscr.) */
! 1853: n = FALSE; /* part is numeric (vs.alphabetic) */
! 1854:
! 1855: while ((a[i] = b[j++]) != EOL) {
! 1856:
! 1857: if (a[i] == '"') a[++i] = '"';
! 1858:
! 1859: if (a[i] == DELIM) {
! 1860:
! 1861: if (f) {
! 1862:
! 1863: if (n == FALSE) a[i++] = '"';
! 1864:
! 1865: if (i >= (STRLEN-2)/*was 253*/) {
! 1866: a[i] = EOL;
! 1867: merr_raise (M75);
! 1868:
! 1869: return;
! 1870: }
! 1871:
! 1872: a[i] = ',';
! 1873:
! 1874: if ((n = znamenumeric (&b[j])) == FALSE) a[++i] = '"';
! 1875:
! 1876: }
! 1877: else {
! 1878:
! 1879: a[i] = '(';
! 1880: f = TRUE;
! 1881:
! 1882: if ((n = znamenumeric (&b[j])) == FALSE) a[++i] = '"';
! 1883:
! 1884: }
! 1885:
! 1886: }
! 1887:
! 1888: if (++i >= STRLEN) {
! 1889:
! 1890: a[STRLEN] = EOL;
! 1891:
! 1892: if (b[j] != EOL) {
! 1893: merr_raise (M75);
! 1894: return;
! 1895: }
! 1896:
! 1897: }
! 1898:
! 1899: }
! 1900:
! 1901: if (f) {
! 1902:
! 1903: if (i > (STRLEN-2) /* was 253 */) {
! 1904: merr_raise (M75);
! 1905: return;
! 1906: }
! 1907:
! 1908: if (n == FALSE) a[i++] = '"';
! 1909:
! 1910: a[i++] = ')';
! 1911: a[i] = EOL;
! 1912:
! 1913: }
! 1914:
! 1915: return;
! 1916:
! 1917: } /* end zname() */
! 1918:
! 1919: /* boolean function that tests whether str is a canonical numeric */
! 1920: short int znamenumeric (char *str)
! 1921: {
! 1922:
! 1923: register int ptr = 0;
! 1924: register int ch;
! 1925: register int point;
! 1926:
! 1927: if (str[0] == '-') ptr = 1;
! 1928:
! 1929: if (str[ptr] == EOL) return FALSE;
! 1930: if (str[ptr] == DELIM) return FALSE;
! 1931: if (str[ptr] == '0') return str[1] == EOL || str[1] == DELIM; /* leading zero */
! 1932:
! 1933: point = FALSE;
! 1934:
! 1935: while ((ch = str[ptr++]) != EOL && ch != DELIM) {
! 1936:
! 1937: if (ch > '9') return FALSE;
! 1938:
! 1939: if (ch < '0') {
! 1940:
! 1941: if (ch != '.') return FALSE;
! 1942: if (point) return FALSE; /* multiple points */
! 1943:
! 1944: point = TRUE;
! 1945:
! 1946: }
! 1947:
! 1948: }
! 1949:
! 1950: if (point) {
! 1951: if ((ch = str[ptr - 2]) == '0') return FALSE; /* trailing zero */
! 1952: if (ch == '.') return FALSE; /* trailing point */
! 1953: }
! 1954:
! 1955: return TRUE;
! 1956:
! 1957: } /* end of znamenumeric() */
! 1958:
! 1959: void procv22 (char *key) /* process v22 translation */
! 1960: {
! 1961: int i, j, k1;
! 1962: char tmp1[256];
! 1963:
! 1964: if (*key == EOL || *key == 0) return;
! 1965:
! 1966: i = 0;
! 1967: j = 0;
! 1968:
! 1969: while (i < v22ptr) {
! 1970:
! 1971: k1 = i + UNSIGN (v22ali[i]) + 1;
! 1972:
! 1973: /* is current reference an alias ??? */
! 1974:
! 1975: j = 0;
! 1976:
! 1977: while (v22ali[++i] == key[j]) {
! 1978:
! 1979: if (v22ali[i] == EOL) break;
! 1980:
! 1981: j++;
! 1982: }
! 1983:
! 1984: /* yes, it is, so resolve it now! */
! 1985: if (v22ali[i] == EOL && (key[j] == EOL || key[j] == DELIM)) {
! 1986:
! 1987: stcpy (tmp1, key);
! 1988: stcpy (key, &v22ali[i + 1]);
! 1989: stcat (key, &tmp1[j]);
! 1990:
! 1991: i = 0;
! 1992:
! 1993: continue; /* try again, it might be a double alias! */
! 1994:
! 1995: }
! 1996:
! 1997: i = k1;
! 1998:
! 1999: }
! 2000:
! 2001: return;
! 2002:
! 2003: } /* end of procv22() */
! 2004:
! 2005: void v25 (char *a, int i)
! 2006: {
! 2007: short c, exc, k, l, p;
! 2008:
! 2009: k = 0;
! 2010: exc = ~((*screen).screena[(unsigned int) (*screen).sclines[i]][0]);
! 2011:
! 2012: for (l = 0; l < N_COLUMNS; l++) {
! 2013:
! 2014: p = exc;
! 2015: exc = (*screen).screena[(unsigned int) (*screen).sclines[i]][l];
! 2016: c = (*screen).screenx[(unsigned int) (*screen).sclines[i]][l];
! 2017:
! 2018: #ifdef NEVER
! 2019:
! 2020: /* this may result in a problem, when in a system */
! 2021: /* different G0O/G1O sets are in use !!! */
! 2022: if (((exc == 1 && (p == 0)) || ((exc == 0) && (p == 1))) && (G0O[HOME][c] == G1O[HOME][c])) {
! 2023: exc = p; /* if char looks same in SI/SO, delay SI/SO */
! 2024: }
! 2025:
! 2026: #endif /* NEVER */
! 2027:
! 2028: if (exc != p) { /* set attribute */
! 2029:
! 2030: #ifdef SCO
! 2031:
! 2032: p = p & ~04; /* suppress SGR(3) */
! 2033:
! 2034: if (p & 0200) p = p & 0201; /* no display */
! 2035: if (p & 0100) p = p & 0101; /* inverse */
! 2036:
! 2037: #endif /* SCO */
! 2038:
! 2039: if ((p & 01) != (exc & 01)) a[k++] = (exc & 01) ? SO : SI;
! 2040:
! 2041: if ((p & ~01) != (exc & ~01)) {
! 2042:
! 2043: a[k++] = ESC;
! 2044: a[k++] = '[';
! 2045:
! 2046: for (p = 1; p < 8; p++) {
! 2047:
! 2048: if (exc & (1 << p)) {
! 2049:
! 2050: #ifdef SCO
! 2051:
! 2052: if (p == 1) {
! 2053: a[k++] = '1';
! 2054: a[k++] = ';';
! 2055:
! 2056: continue;
! 2057: }
! 2058:
! 2059: #endif /* SCO */
! 2060:
! 2061: a[k++] = '1' + p;
! 2062: a[k++] = ';';
! 2063:
! 2064: }
! 2065:
! 2066: }
! 2067:
! 2068: if (a[k - 1] == ';') k--;
! 2069:
! 2070: a[k++] = 'm';
! 2071: }
! 2072:
! 2073: }
! 2074:
! 2075: a[k++] = c;
! 2076:
! 2077: }
! 2078:
! 2079: if (exc & 01) a[k++] = SI;
! 2080:
! 2081: a[k] = EOL;
! 2082:
! 2083: return;
! 2084:
! 2085: } /* end of v25() */
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to views.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem / src