![[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|
Return to routine.c CVS log | Up to [Coherent Logic Development] / freem / src |
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() */