Annotation of freem/src/routine.c, revision 1.1
1.1 ! snw 1: /*
! 2: * *
! 3: * * *
! 4: * * *
! 5: * ***************
! 6: * * * * *
! 7: * * MUMPS *
! 8: * * * * *
! 9: * ***************
! 10: * * *
! 11: * * *
! 12: * *
! 13: *
! 14: * routine.c
! 15: * Routine buffer management
! 16: *
! 17: *
! 18: * Author: Serena Willis <jpw@coherent-logic.com>
! 19: * Copyright (C) 1998 MUG Deutschland
! 20: * Copyright (C) 2023 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 <string.h>
! 41: #include <errno.h>
! 42: #include <sys/types.h>
! 43:
! 44: #if !defined(__OpenBSD__) && !defined(__FreeBSD__)
! 45: # include <sys/timeb.h>
! 46: #endif
! 47:
! 48: #include <sys/ioctl.h>
! 49: #include <unistd.h>
! 50: #include <stdlib.h>
! 51: #include <ctype.h>
! 52:
! 53: #ifdef AMIGA68K
! 54: #include <sys/fcntl.h>
! 55: #endif
! 56:
! 57: #include "mpsdef.h"
! 58:
! 59: #include <time.h>
! 60:
! 61: #ifdef USE_SYS_TIME_H
! 62: #include <sys/time.h>
! 63: #endif
! 64:
! 65: #include "events.h"
! 66:
! 67: short rtn_get_offset(char *buf)
! 68: {
! 69: char *rp;
! 70: char *rc;
! 71: char *p;
! 72: char otag[256];
! 73: char ortn[256];
! 74: char oline[256];
! 75:
! 76: register int i = 0;
! 77: register int j = 0;
! 78: register int k = 0;
! 79:
! 80: int os = 0;
! 81:
! 82: stcpy (ortn, rou_name);
! 83:
! 84: rp = rouptr;
! 85: rc = roucur;
! 86:
! 87: stcnv_m2c (ortn);
! 88:
! 89: while (rp < rc) {
! 90:
! 91: i = 0;
! 92: for (p = rp + 1; p < rc && *p != EOL && *p != '\0'; p++) {
! 93: if (i < 256) {
! 94: oline[i++] = *p;
! 95: }
! 96: }
! 97: oline[i] = '\0';
! 98:
! 99: if (isalpha (oline[0]) || oline[0] == '%') {
! 100:
! 101: os = 0;
! 102: k = 0;
! 103:
! 104: for (j = 0; j < strlen (oline); j++) {
! 105:
! 106: switch (oline[j]) {
! 107:
! 108: case ' ':
! 109: case '(':
! 110: case ';':
! 111: case EOL:
! 112: otag[k] = '\0';
! 113:
! 114: break;
! 115:
! 116: default:
! 117: otag[k++] = oline[j];
! 118: }
! 119:
! 120: if (oline[j] == ' ' || oline[j] == '(' || oline[j] == ';' || oline[j] == EOL) break;
! 121: }
! 122: }
! 123: else {
! 124: os++;
! 125: }
! 126:
! 127: rp = p + 1;
! 128: }
! 129:
! 130: if (os) {
! 131: sprintf (buf, "%s+%d^%s\201", otag, os, ortn);
! 132: }
! 133: else {
! 134: sprintf (buf, "%s^%s\201", otag, ortn);
! 135: }
! 136:
! 137:
! 138: return TRUE;
! 139: }
! 140:
! 141: char *rtn_resolve(char *rou, char *tag, char *buf)
! 142: {
! 143: char superclass[255];
! 144:
! 145: if (rtn_has_tag (rou, tag)) {
! 146: strcpy (buf, rou);
! 147: return buf;
! 148: }
! 149: else {
! 150: if (rtn_get_superclass (rou, superclass)) {
! 151: return rtn_resolve (superclass, tag, buf);
! 152: }
! 153: else {
! 154: buf = NULL;
! 155: return NULL;
! 156: }
! 157: }
! 158:
! 159: }
! 160:
! 161: short rtn_get_superclass(char *rou, char *buf)
! 162: {
! 163: FILE *fp;
! 164: char pth[PATHLEN];
! 165: char line[255];
! 166: char *s;
! 167: short rtn_exists;
! 168: short after_parens;
! 169: short found_super;
! 170: char *p;
! 171: register char ch;
! 172:
! 173: if (strcmp (rou, "%OBJECT") == 0) {
! 174: buf = NULL;
! 175: return FALSE;
! 176: }
! 177:
! 178: rtn_exists = rtn_get_path (rou, pth);
! 179:
! 180: if (rtn_exists == FALSE) {
! 181: buf = NULL;
! 182: return FALSE;
! 183: }
! 184:
! 185: fp = fopen (pth, "r");
! 186: if (fp == NULL) {
! 187: buf = NULL;
! 188: return FALSE;
! 189: }
! 190:
! 191: s = fgets (line, 255, fp);
! 192:
! 193: fclose (fp);
! 194:
! 195: if (s == NULL) {
! 196: buf = NULL;
! 197: return FALSE;
! 198: }
! 199:
! 200: if ((!isalpha (line[0])) && (line[0] != '%')) {
! 201: buf = NULL;
! 202: return FALSE;
! 203: }
! 204:
! 205: p = line;
! 206: after_parens = FALSE;
! 207: found_super = FALSE;
! 208:
! 209: while ((ch = *p++) != '\0') {
! 210:
! 211: if (ch == ')') after_parens = TRUE;
! 212:
! 213: if (ch == ':' && after_parens == TRUE) {
! 214: strcpy (buf, p);
! 215: found_super = TRUE;
! 216: break;
! 217: }
! 218:
! 219: }
! 220:
! 221: if (!found_super) {
! 222: sprintf (buf, "%%OBJECT");
! 223: return TRUE;
! 224: }
! 225:
! 226: p = buf;
! 227: for (;;) {
! 228: ch = *p;
! 229:
! 230: if (ch == SP || ch == TAB || ch == ';' || ch == '\0' || ch == '\r' || ch == '\n') {
! 231: *p = '\0';
! 232: break;
! 233: }
! 234:
! 235: p++;
! 236: }
! 237:
! 238: return TRUE;
! 239: }
! 240:
! 241: short rtn_get_path(char *rou, char *buf)
! 242: {
! 243: FILE *fp;
! 244: char pth[PATHLEN];
! 245:
! 246: if (rou[0] == '%') {
! 247: stcpy (pth, rou0plib);
! 248: stcnv_m2c (pth);
! 249: }
! 250: else {
! 251: stcpy (pth, rou0path);
! 252: stcnv_m2c (pth);
! 253: }
! 254:
! 255: snprintf (buf, PATHLEN, "%s/%s.m", pth, rou);
! 256:
! 257: if ((fp = fopen (buf, "r")) != NULL) {
! 258: (void) fclose (fp);
! 259:
! 260: return TRUE;
! 261: }
! 262: else {
! 263: return FALSE;
! 264: }
! 265:
! 266: }
! 267:
! 268: short rtn_has_tag(char *rou, char *tag)
! 269: {
! 270: m_entry *entries;
! 271: m_entry *e;
! 272:
! 273: entries = rtn_get_entries (rou);
! 274:
! 275: for (e = entries; e != NULL; e = e->next) {
! 276: if (strcmp (tag, e->tag) == 0) {
! 277: rtn_free_entries (entries);
! 278: return TRUE;
! 279: }
! 280: }
! 281:
! 282: rtn_free_entries (entries);
! 283: return FALSE;
! 284: }
! 285:
! 286: void rtn_free_entries(m_entry *head)
! 287: {
! 288: m_entry *tmp;
! 289:
! 290: while (head != NULL) {
! 291: tmp = head;
! 292: head = head->next;
! 293: free (tmp);
! 294: }
! 295:
! 296: head = NULL;
! 297: }
! 298:
! 299: m_entry *rtn_get_entries(char *rou)
! 300: {
! 301: FILE *fp;
! 302: char rou_path[PATHLEN];
! 303: m_entry *head = NULL;
! 304: m_entry *t;
! 305: register char ch;
! 306: register int i = 0;
! 307: register int j = 0;
! 308: char cur_line[255];
! 309: char cur_label[255];
! 310: int has_args = 0;
! 311: char *paren_pos;
! 312: char *curarg;
! 313:
! 314: if (rtn_get_path (rou, rou_path) == FALSE) {
! 315: return (m_entry *) NULL;
! 316: }
! 317:
! 318: fp = fopen (rou_path, "r");
! 319:
! 320: while (fgets (cur_line, 255, fp) != NULL) {
! 321:
! 322: if (isalpha (cur_line[0]) || cur_line[0] == '%') {
! 323: has_args = 0;
! 324: j = 0;
! 325:
! 326: for (i = 0; i < strlen (cur_line); i++) {
! 327: ch = cur_line[i];
! 328:
! 329: switch (ch) {
! 330:
! 331: case ')':
! 332: cur_label[j++] = ')';
! 333:
! 334: case SP:
! 335: case TAB:
! 336: case EOL:
! 337: cur_label[j] = '\0';
! 338: j = 0;
! 339: if (strlen (cur_label)) {
! 340: t = (m_entry *) malloc (sizeof (m_entry));
! 341: NULLPTRCHK(t,"rtn_get_entries");
! 342:
! 343: paren_pos = strchr (cur_label, '(');
! 344: if (paren_pos == NULL) {
! 345: /* not a formallist */
! 346: t->tag = (char *) malloc (sizeof (char) * (strlen (cur_label) + 1));
! 347: NULLPTRCHK(t->tag,"rtn_get_entries");
! 348:
! 349: strcpy (t->tag, cur_label);
! 350: }
! 351: else {
! 352: /* a formallist */
! 353: char *toktmp;
! 354:
! 355: toktmp = strdup (cur_label);
! 356: NULLPTRCHK(toktmp,"rtn_get_entries");
! 357:
! 358: (void) strtok (toktmp, "(");
! 359:
! 360: t->tag = malloc (sizeof (char) * (strlen (toktmp) + 1));
! 361: NULLPTRCHK(t->tag,"rtn_get_entries");
! 362:
! 363: strcpy (t->tag, toktmp);
! 364:
! 365: free (toktmp);
! 366: }
! 367:
! 368: t->next = head;
! 369: head = t;
! 370: }
! 371: break;
! 372:
! 373: case '(':
! 374: has_args++;
! 375: default:
! 376: cur_label[j++] = ch;
! 377: }
! 378:
! 379: if (ch == SP || ch == TAB || ch == EOL) break;
! 380: }
! 381: }
! 382: }
! 383:
! 384: fclose (fp);
! 385: return head;
! 386:
! 387: }
! 388:
! 389: void zload (char *rou) /* load routine in buffer */
! 390: {
! 391: FILE *infile;
! 392: short linelen;
! 393: char pgm[256];
! 394: char tmp1[256];
! 395:
! 396: register long int i;
! 397: register long int j;
! 398: register long int ch;
! 399:
! 400: char *savptr; /* save routine pointer */
! 401: long timex;
! 402: short altern = 0;
! 403:
! 404: /* Routines are stored in routine buffers. If a routine is called
! 405: * we first look whether it's already loaded. If not, we look for
! 406: * the least recently used buffer and load it there. Besides
! 407: * dramatically improved performance there is little effect on
! 408: * the user. Sometimes you see an effect: if the program is changed
! 409: * by some other user or by yourself using the 'ced' editor you
! 410: * may get the old version for some time with DO, GOTO or ZLOAD.
! 411: * A ZREMOVE makes sure the routine is loaded from disk.
! 412: */
! 413: if (*rou == EOL || *rou == 0) { /* routine name empty */
! 414:
! 415: pgms[0][0] = EOL;
! 416: rouend = rouins = rouptr = buff;
! 417: roucur = buff + (NO_OF_RBUF * PSIZE0 + 1);
! 418:
! 419: *rouptr = EOL;
! 420: *(rouptr + 1) = EOL;
! 421: *(rouptr + 2) = EOL;
! 422:
! 423: dosave[0] = 0;
! 424:
! 425: return;
! 426:
! 427: }
! 428:
! 429: savptr = rouptr;
! 430:
! 431: /* what time is it ? */
! 432: timex = time (0L);
! 433:
! 434: /* FreeM: it takes a lickin' and keeps on tickin' */
! 435:
! 436: /* let's have a look whether we already have the stuff */
! 437: for (i = 0; i < NO_OF_RBUF; i++) {
! 438:
! 439: if (pgms[i][0] == 0) {
! 440: altern = i;
! 441: break;
! 442: } /* buffer empty */
! 443:
! 444: j = 0;
! 445:
! 446: while (rou[j] == pgms[i][j]) {
! 447:
! 448: if (rou[j++] == EOL) {
! 449:
! 450: rouptr = buff + (i * PSIZE0);
! 451: ages[i] = time (0L);
! 452: rouend = ends[i];
! 453: rouins = rouend - 1;
! 454:
! 455: return;
! 456:
! 457: }
! 458:
! 459: }
! 460:
! 461: if (ages[i] <= timex) timex = ages[altern = i];
! 462:
! 463: }
! 464:
! 465: /* clear DO-label stored under FOR */
! 466: dosave[0] = 0;
! 467: j = 0;
! 468: ch = EOL; /* init for multiple path search */
! 469: tmp1[0] = EOL;
! 470:
! 471:
! 472: nextpath: /* entry point for retry */
! 473:
! 474: i = 0;
! 475:
! 476: if (rou[0] == '%') { /* %_routines are in special directory */
! 477:
! 478: if (mcmnd >= 'a') { /* DO GOTO JOB */
! 479:
! 480: if (rou0plib[j] != EOL) {
! 481: while ((ch = pgm[i++] = rou0plib[j++]) != ':' && ch != EOL);
! 482: }
! 483:
! 484: }
! 485: else if (rou1plib[j] != EOL) {
! 486: while ((ch = pgm[i++] = rou1plib[j++]) != ':' && ch != EOL);
! 487: }
! 488:
! 489: }
! 490: else {
! 491:
! 492: if (mcmnd >= 'a') { /* DO GOTO JOB */
! 493:
! 494: if (rou0path[j] != EOL) {
! 495: while ((ch = pgm[i++] = rou0path[j++]) != ':' && ch != EOL);
! 496: }
! 497:
! 498: }
! 499: else if (rou1path[j] != EOL) {
! 500: while ((ch = pgm[i++] = rou1path[j++]) != ':' && ch != EOL);
! 501: }
! 502:
! 503: }
! 504:
! 505: if (i > 0) {
! 506:
! 507: if (i == 1 || (i == 2 && pgm[0] == '.')) {
! 508: i = 0;
! 509: }
! 510: else {
! 511: pgm[i - 1] = '/';
! 512: }
! 513:
! 514: }
! 515:
! 516: pgm[i] = EOL;
! 517:
! 518: stcpy (tmp1, pgm); /* directory where we search for the routine */
! 519: stcpy (&pgm[i], rou);
! 520:
! 521: rouptr = buff + (altern * PSIZE0);
! 522:
! 523: stcat (pgm, rou_ext);
! 524:
! 525: pgm[stlen (pgm)] = NUL; /* append routine extension */
! 526:
! 527: if ((infile = fopen (pgm, "r")) == NULL) {
! 528:
! 529: rouptr = savptr;
! 530:
! 531: if (ch != EOL) goto nextpath; /* try next access path */
! 532:
! 533: stcpy (varerr, rou);
! 534:
! 535: merr_raise (NOPGM);
! 536:
! 537: return;
! 538:
! 539: }
! 540:
! 541: again:
! 542:
! 543: linelen = 0;
! 544: savptr = rouend = rouptr;
! 545:
! 546: for (i = 1; i < (PSIZE0 - 1); i++) {
! 547:
! 548: *++rouend = ch = getc (infile);
! 549:
! 550: if (ch == LF || ch == EOF) {
! 551:
! 552: *rouend++ = EOL;
! 553: i++;
! 554: *savptr = i - linelen - 2;
! 555:
! 556: savptr = rouend;
! 557: linelen = i;
! 558:
! 559: if (ch == EOF) {
! 560:
! 561: fclose (infile);
! 562:
! 563: *rouend-- = EOL;
! 564: rouins = rouend - 1;
! 565: ends[altern] = rouend;
! 566: ages[altern] = time (0L);
! 567:
! 568: stcpy (pgms[altern], rou);
! 569: stcpy (path[altern], tmp1);
! 570:
! 571: rbuf_flags[altern].dialect = standard;
! 572: if (standard == D_FREEM) {
! 573: rbuf_flags[altern].standard = FALSE;
! 574: }
! 575: else {
! 576: rbuf_flags[altern].standard = TRUE;
! 577: }
! 578:
! 579: return;
! 580: }
! 581: }
! 582: }
! 583:
! 584: rouptr = savptr;
! 585:
! 586: if (autorsize) {
! 587:
! 588: while ((ch = getc (infile)) != EOF) {
! 589:
! 590: i++;
! 591:
! 592: if (ch == LF) i++;
! 593:
! 594: } /* how big? */
! 595:
! 596: i = ((i + 3) & ~01777) + 02000; /* round for full kB; */
! 597:
! 598: if (newrsize (i, NO_OF_RBUF) == 0) { /* try to get more routine space. */
! 599:
! 600: altern = 0;
! 601: ch = EOL;
! 602:
! 603: fseek (infile, 0L, 0);
! 604:
! 605: goto again;
! 606:
! 607: }
! 608:
! 609: }
! 610:
! 611: fclose (infile);
! 612:
! 613: goto pgmov;
! 614:
! 615: pgmov:
! 616:
! 617: /* program overflow error */
! 618: rouptr = rouins = rouend = savptr;
! 619: (*savptr++) = EOL;
! 620: *savptr = EOL;
! 621:
! 622: for (i = 0; i < NO_OF_RBUF; i++) {
! 623: ages[i] = 0;
! 624: pgms[i][0] = 0;
! 625: }
! 626:
! 627: pgms[i][0] = EOL;
! 628: rou_name[0] = EOL;
! 629: merr_raise (PGMOV);
! 630:
! 631: return;
! 632:
! 633: } /* end of zload() */
! 634:
! 635: void zsave (char *rou) /* save routine on disk */
! 636: {
! 637: register int i;
! 638: register int j;
! 639: register int ch;
! 640: char tmp[256];
! 641:
! 642: stcpy (tmp, rou); /* save name without path */
! 643:
! 644: /* look whether we know where the routine came from */
! 645:
! 646: if (zsavestrategy) { /* VIEW 133: remember ZLOAD directory on ZSAVE */
! 647:
! 648: for (i = 0; i < NO_OF_RBUF; i++) {
! 649:
! 650: if (pgms[i][0] == 0) break; /* buffer empty */
! 651:
! 652: j = 0;
! 653:
! 654: while (rou[j] == pgms[i][j]) {
! 655:
! 656: if (rou[j++] == EOL) {
! 657:
! 658: stcpy (rou, path[i]);
! 659: stcat (rou, tmp);
! 660:
! 661: j = 0;
! 662: ch = 1; /* init for multiple path search */
! 663:
! 664: goto try;
! 665:
! 666: }
! 667:
! 668: }
! 669:
! 670: }
! 671:
! 672: }
! 673:
! 674: /* not found */
! 675: j = 0;
! 676: ch = EOL; /* init for multiple path search */
! 677:
! 678:
! 679: nextpath: /* entry point for retry */
! 680:
! 681: if (tmp[0] == '%') {
! 682:
! 683: if (rou1plib[0] != EOL) {
! 684:
! 685: i = 0;
! 686:
! 687: while ((ch = rou[i++] = rou1plib[j++]) != ':' && ch != EOL);
! 688:
! 689: if (i == 1 || (i == 2 && rou[0] == '.')) {
! 690: i = 0;
! 691: }
! 692: else {
! 693: rou[i - 1] = '/';
! 694: }
! 695:
! 696: stcpy (&rou[i], tmp);
! 697:
! 698: }
! 699:
! 700: }
! 701: else {
! 702:
! 703: if (rou1path[0] != EOL) {
! 704:
! 705: i = 0;
! 706:
! 707: while ((ch = rou[i++] = rou1path[j++]) != ':' && ch != EOL);
! 708:
! 709: if (i == 1 || (i == 2 && rou[0] == '.')) {
! 710: i = 0;
! 711: }
! 712: else {
! 713: rou[i - 1] = '/';
! 714: }
! 715:
! 716: stcpy (&rou[i], tmp);
! 717:
! 718: }
! 719:
! 720: }
! 721:
! 722:
! 723: try:
! 724:
! 725: stcat (rou, rou_ext);
! 726: rou[stlen (rou)] = NUL; /* append routine extention */
! 727:
! 728: if (rouend <= rouptr) {
! 729: unlink (rou);
! 730: rou_name[0] = EOL;
! 731: }
! 732: else {
! 733: FILE *outfile;
! 734: char *i0;
! 735:
! 736: for (;;) {
! 737:
! 738: errno = 0;
! 739:
! 740: if ((outfile = fopen (rou, "w")) != NULL) break;
! 741:
! 742: if (errno == EINTR) continue; /* interrupt */
! 743:
! 744: if (errno == EMFILE || errno == ENFILE) {
! 745: close_all_globals ();
! 746: continue;
! 747: } /* free file_des */
! 748:
! 749: if (ch != EOL) goto nextpath; /* try next access path */
! 750:
! 751: merr_raise (PROTECT);
! 752: return;
! 753:
! 754: }
! 755:
! 756: i0 = rouptr;
! 757:
! 758: while (++i0 < (rouend - 1)) {
! 759:
! 760: if ((ch = (*(i0))) == EOL) {
! 761: ch = LF;
! 762: i0++;
! 763: }
! 764:
! 765: putc (ch, outfile);
! 766:
! 767: }
! 768:
! 769: if (ch != LF) putc (LF, outfile);
! 770:
! 771: fclose (outfile);
! 772:
! 773: }
! 774:
! 775: return;
! 776:
! 777: } /* end of zsave() */
! 778:
! 779: /* insert 'line' in routine at 'position' */
! 780: void zi (char *line, char *position)
! 781: {
! 782: short offset;
! 783: short label;
! 784: short i;
! 785: short i0;
! 786: short ch;
! 787: char *reg;
! 788: char *end;
! 789: char line0[256];
! 790:
! 791: if (rouend - rouptr + stlen (line) + 1 > PSIZE0) { /* sufficient space ??? */
! 792:
! 793: reg = buff;
! 794:
! 795: if (getrmore () == 0L) return; /* PGMOV */
! 796:
! 797: position += buff - reg;
! 798:
! 799: }
! 800:
! 801: label = TRUE;
! 802: i = 0;
! 803: i0 = 0;
! 804:
! 805: while ((ch = line[i]) != EOL) {
! 806:
! 807: if (label) {
! 808:
! 809: if (ch == SP) ch = TAB;
! 810:
! 811: if (ch == TAB) {
! 812: label = FALSE;
! 813: }
! 814: else if (ch == '(') {
! 815:
! 816: line0[i0++] = ch;
! 817: i++;
! 818:
! 819: while (((ch = line[i]) >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9') || ch == '%' || ch == ',') {
! 820: line0[i0++] = ch;
! 821: i++;
! 822: }
! 823:
! 824: if (ch != ')') {
! 825: merr_raise (ISYNTX);
! 826: return;
! 827: }
! 828:
! 829: line0[i0++] = ch;
! 830: i++;
! 831:
! 832: if ((ch = line[i]) != SP && ch != TAB) {
! 833: merr_raise (ISYNTX);
! 834: return;
! 835: }
! 836:
! 837: continue;
! 838:
! 839: }
! 840: else if ((ch < 'a' || ch > 'z') && (ch < 'A' || ch > 'Z') && (ch < '0' || ch > '9') && (ch != '%' || i)) {
! 841: merr_raise (ISYNTX);
! 842: return;
! 843: }
! 844:
! 845: line0[i0++] = ch;
! 846: i++;
! 847:
! 848: continue;
! 849:
! 850: }
! 851:
! 852: if (ch < SP || (ch >= DEL && (eightbit == FALSE))) {
! 853: merr_raise (ISYNTX);
! 854: return;
! 855: }
! 856:
! 857: line0[i0++] = ch;
! 858: i++;
! 859:
! 860: }
! 861:
! 862: if (label) {
! 863: merr_raise (ISYNTX);
! 864: return;
! 865: }
! 866:
! 867: line0[i0] = EOL;
! 868: offset = i0;
! 869:
! 870: if (offset > 0) {
! 871:
! 872: offset += 2;
! 873: end = rouend;
! 874: rouend += offset;
! 875:
! 876: if (roucur > position || roucur > end) roucur += offset;
! 877:
! 878: reg = rouend;
! 879:
! 880: while (position <= end) {
! 881: (*reg--) = (*end--);
! 882: }
! 883:
! 884: (*(position++)) = (UNSIGN (offset) - 2);
! 885:
! 886: reg = line0;
! 887:
! 888: while (((*(position++)) = (*(reg++))) != EOL);
! 889:
! 890: *(rouend + 1) = EOL;
! 891: *(rouend + 2) = EOL;
! 892:
! 893: for (i = 0; i < NO_OF_RBUF; i++) {
! 894:
! 895: if (rouptr == (buff + (i * PSIZE0))) {
! 896: ends[i] = rouend;
! 897: break;
! 898: }
! 899:
! 900: }
! 901:
! 902: }
! 903:
! 904: rouins = position;
! 905:
! 906: return;
! 907: } /* end of zi() */
! 908:
! 909: /*
! 910: * getraddress(char *a, short lvl):
! 911: *
! 912: * returns the 'canonical' address of the line at the specified DO/FOR/XEC level
! 913: *
! 914: * char *a (out param): pointer to the address of the line
! 915: * short lvl: process this level
! 916: *
! 917: */
! 918: void getraddress (char *a, short lvl)
! 919: {
! 920:
! 921: char *rcur; /* cursor into routine */
! 922: short f;
! 923: char tmp3[256];
! 924: char *j0;
! 925: char *j1;
! 926: short rlvl; /* lower level, where to find routine name */
! 927: register int i;
! 928: register int j;
! 929:
! 930: f = mcmnd;
! 931: mcmnd = 'd'; /* make load use standard-path */
! 932: rlvl = lvl;
! 933:
! 934: if (nestn[rlvl] == 0 && rlvl < nstx) rlvl++;
! 935:
! 936: if (nestn[rlvl]) zload (nestn[rlvl]);
! 937:
! 938: mcmnd = f;
! 939:
! 940: /* command on stack: 2 == DO_BLOCK; other: make uppercase */
! 941: i = nestc[lvl];
! 942:
! 943: if (i != '$') i = ((i == 2) ? 'd' : i - 32);
! 944:
! 945: a[0] = '(';
! 946: a[1] = i;
! 947: a[2] = ')';
! 948: a[3] = EOL; /* command */
! 949:
! 950: rcur = nestr[lvl] + rouptr; /* restore rcur */
! 951: j0 = (rouptr - 1);
! 952: j = 0;
! 953: tmp3[0] = EOL;
! 954:
! 955: j0++;
! 956:
! 957: if (rcur < rouend) {
! 958:
! 959: while (j0 < (rcur - 1)) {
! 960:
! 961: j1 = j0++;
! 962: j++;
! 963:
! 964: if ((*j0 != TAB) && (*j0 != SP)) {
! 965:
! 966: j = 0;
! 967:
! 968: while ((tmp3[j] = (*(j0++))) > SP) {
! 969:
! 970: if (tmp3[j] == '(') tmp3[j] = EOL;
! 971:
! 972: j++;
! 973:
! 974: }
! 975:
! 976: tmp3[j] = EOL;
! 977: j = 0;
! 978:
! 979: }
! 980:
! 981: j0 = j1;
! 982: j0 += (UNSIGN (*j1)) + 2;
! 983:
! 984: }
! 985:
! 986: }
! 987:
! 988: stcat (a, tmp3);
! 989:
! 990: if (j > 0) {
! 991:
! 992: i = stlen (a);
! 993: a[i++] = '+';
! 994:
! 995: intstr (&a[i], j);
! 996:
! 997: }
! 998:
! 999: if (nestn[rlvl]) {
! 1000:
! 1001: stcat (a, "^\201");
! 1002: stcat (a, nestn[rlvl]);
! 1003:
! 1004: }
! 1005: else if (rou_name[0] != EOL) {
! 1006:
! 1007: stcat (a, "^\201");
! 1008: stcat (a, rou_name);
! 1009:
! 1010: }
! 1011:
! 1012: f = mcmnd;
! 1013: mcmnd = 'd'; /* make load use standard-path */
! 1014:
! 1015: zload (rou_name);
! 1016:
! 1017: mcmnd = f;
! 1018:
! 1019: return;
! 1020:
! 1021: } /* end getraddress() */
! 1022:
! 1023: /* parse lineref and return pos.in routine */
! 1024: /* result: [pointer to] pointer to line */
! 1025: void lineref (char **adrr)
! 1026: {
! 1027: long offset;
! 1028: long j;
! 1029: char *reg;
! 1030: char *beg;
! 1031:
! 1032: while (*codptr == '@') { /* handle indirection */
! 1033:
! 1034: codptr++;
! 1035:
! 1036: expr (ARGIND);
! 1037:
! 1038: if (merr () > 0) return;
! 1039:
! 1040: stcat (argptr, codptr);
! 1041: stcpy (code, argptr);
! 1042:
! 1043: codptr = code;
! 1044:
! 1045: }
! 1046:
! 1047: offset = 0;
! 1048: beg = rouptr;
! 1049:
! 1050: if (*codptr == '+') {
! 1051:
! 1052: codptr++;
! 1053:
! 1054: expr (STRING);
! 1055:
! 1056: if (merr () > 0) return;
! 1057:
! 1058: if ((offset = intexpr (argptr)) <= 0) {
! 1059: *adrr = 0;
! 1060: return;
! 1061: }
! 1062:
! 1063: offset--;
! 1064:
! 1065: }
! 1066: else {
! 1067:
! 1068: expr (LABEL);
! 1069:
! 1070: if (merr () > 0) return;
! 1071:
! 1072: reg = beg;
! 1073:
! 1074: while (beg < rouend) {
! 1075:
! 1076: reg++;
! 1077:
! 1078: if ((*reg) != TAB && (*reg) != SP) {
! 1079:
! 1080: j = 0;
! 1081:
! 1082: while ((*reg) == varnam[j]) {
! 1083: reg++;
! 1084: j++;
! 1085: }
! 1086:
! 1087: if (((*reg) == TAB || (*reg) == SP || (*reg) == '(') && varnam[j] == EOL) break;
! 1088:
! 1089: }
! 1090:
! 1091: reg = (beg = beg + UNSIGN (*beg) + 2);
! 1092:
! 1093: }
! 1094:
! 1095: stcpy (varerr, varnam);
! 1096:
! 1097: varnam[0] = EOL;
! 1098: codptr++;
! 1099:
! 1100: if (*codptr == '+') {
! 1101:
! 1102: codptr++;
! 1103:
! 1104: expr (STRING);
! 1105:
! 1106: if (merr () > 0) return;
! 1107:
! 1108: offset = intexpr (argptr);
! 1109:
! 1110: }
! 1111:
! 1112: }
! 1113:
! 1114: if (offset < 0) {
! 1115:
! 1116: reg = rouptr;
! 1117:
! 1118: while (reg < beg) {
! 1119: reg += UNSIGN (*reg) + 2;
! 1120: offset++;
! 1121: }
! 1122:
! 1123: if (offset < 0) {
! 1124: *adrr = 0;
! 1125: return;
! 1126: }
! 1127:
! 1128: beg = rouptr;
! 1129:
! 1130: }
! 1131:
! 1132: while (offset-- > 0 && beg <= rouend) beg += UNSIGN (*beg) + 2;
! 1133:
! 1134: *adrr = beg;
! 1135:
! 1136: return;
! 1137: } /* end of lineref() */
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to routine.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem / src