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