Annotation of freem/src/xecline.c, revision 1.30
1.1 snw 1: /*
1.30 ! snw 2: * $Id: xecline.c,v 1.29 2025/05/20 14:56:56 snw Exp $
1.1 snw 3: * freem interpreter proper
4: *
5: *
1.4 snw 6: * Author: Serena Willis <snw@coherent-logic.com>
1.1 snw 7: * Copyright (C) 1998 MUG Deutschland
1.5 snw 8: * Copyright (C) 2020, 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.6 snw 26: * $Log: xecline.c,v $
1.30 ! snw 27: * Revision 1.29 2025/05/20 14:56:56 snw
! 28: * Fix direct-mode interface to online help
! 29: *
1.29 snw 30: * Revision 1.28 2025/05/20 14:36:06 snw
31: * Documentation updates; raise ZCMMND instead of NOSTAND for restricted_mode restrictions
32: *
1.28 snw 33: * Revision 1.27 2025/05/19 21:29:29 snw
34: * Add basic tab completion to direct mode
35: *
1.27 snw 36: * Revision 1.26 2025/05/19 02:03:31 snw
37: * Reverse-engineer and document argumented ZPRINT (thanks to D. Wicksell)
38: *
1.26 snw 39: * Revision 1.25 2025/05/18 18:15:38 snw
40: * Add ZEDIT command for editing routines
41: *
1.25 snw 42: * Revision 1.24 2025/05/14 12:22:04 snw
43: * Further work on shared memory
44: *
1.24 snw 45: * Revision 1.23 2025/05/06 16:10:06 snw
46: * Add extra blank before readline call on NetBSD
47: *
1.23 snw 48: * Revision 1.22 2025/05/05 14:53:17 snw
49: * Modify rpm spec to include documentation TODO
50: *
1.22 snw 51: * Revision 1.21 2025/05/01 17:02:30 snw
52: * Further debugging improvements
53: *
1.21 snw 54: * Revision 1.20 2025/04/30 17:19:16 snw
55: * Improve backtraces in debugger
56: *
1.20 snw 57: * Revision 1.19 2025/04/30 14:41:03 snw
58: * Further debugger work
59: *
1.19 snw 60: * Revision 1.18 2025/04/29 18:46:17 snw
61: * Begin work on interactive debugger
62: *
1.18 snw 63: * Revision 1.17 2025/04/28 19:38:55 snw
64: * Add trace mode
65: *
1.17 snw 66: * Revision 1.16 2025/04/28 14:52:54 snw
67: * Temporarily revert global handler refactor and fix reference regression in xecline
68: *
1.16 snw 69: * Revision 1.15 2025/04/15 16:49:36 snw
70: * Make use of logprintf throughout codebase
71: *
1.15 snw 72: * Revision 1.14 2025/04/13 04:22:43 snw
73: * Fix snprintf calls
74: *
1.14 snw 75: * Revision 1.13 2025/04/10 01:24:39 snw
76: * Remove C++ style comments
77: *
1.13 snw 78: * Revision 1.12 2025/04/09 19:52:02 snw
79: * Eliminate as many warnings as possible while building with -Wall
80: *
1.12 snw 81: * Revision 1.11 2025/04/02 03:02:42 snw
82: * Stop requiring users to pass -e to fmadm when -u or -g are passed
83: *
1.11 snw 84: * Revision 1.10 2025/03/27 03:27:35 snw
85: * Install init scripts to share/freem/examples/init and fix regression in method dispatch
86: *
1.10 snw 87: * Revision 1.9 2025/03/24 04:13:12 snw
88: * Replace action macro dat with fra_dat to avoid symbol conflict on OS/2
89: *
1.9 snw 90: * Revision 1.8 2025/03/24 04:05:36 snw
91: * Replace crlf with frm_crlf to avoid symbol conflict with readline on OS/2
92: *
1.8 snw 93: * Revision 1.7 2025/03/22 22:52:24 snw
94: * Add STRLEN_GBL macro to manage global string length
95: *
1.7 snw 96: * Revision 1.6 2025/03/22 21:44:32 snw
97: * Make the startup messages fewer and add environment name to direct-mode prompt
98: *
1.6 snw 99: * Revision 1.5 2025/03/09 19:50:47 snw
100: * Second phase of REUSE compliance and header reformat
101: *
1.5 snw 102: *
103: * SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC
104: * SPDX-License-Identifier: AGPL-3.0-or-later
1.1 snw 105: **/
106:
107: #include <stdlib.h>
108:
109: #include "mpsdef.h"
110: #include "namespace.h"
111: #include "transact.h"
112: #include "merge.h"
113: #include "sighnd.h"
114: #include "init.h"
115: #include "events.h"
116: #include "mdebug.h"
117: #include "freem.h"
118: #include "mref.h"
119: #include "log.h"
120: #include "consttbl.h"
121: #include "shmmgr.h"
122: #include "locktab.h"
123: #include "jobtab.h"
124: #include "config.h"
125: #include "datatypes.h"
126: #include "objects.h"
127: #include "mcommand.h"
128:
129: #if defined(__linux__)
130: # include <sched.h>
131: #endif
132:
133: #if !defined(MSDOS)
134: # include "io_socket.h"
135: #endif
136:
137: #include "merr.h"
138:
139: #include <errno.h>
140: #include <unistd.h>
141: #include <string.h>
142:
143: #if !defined(MSDOS)
144: # include <syslog.h>
145: #endif
146:
147: #include <stdio.h>
148: #include <ctype.h>
149:
150: #include <time.h>
151: #include <sys/types.h>
152: #include <pwd.h>
153: #if !defined(__OpenBSD__) && !defined(__FreeBSD__)
154: # include <sys/timeb.h>
155: #endif
156: #include <sys/wait.h>
157: #include <sys/time.h>
158: #include <time.h>
159:
160: #ifdef HAVE_LIBREADLINE
161: # if defined(HAVE_READLINE_READLINE_H)
162: # include <readline/readline.h>
163: # elif defined(HAVE_READLINE_H)
164: # include <readline.h>
165: # else /* !defined(HAVE_READLINE_H) */
166: extern char *readline ();
167: # endif /* !defined(HAVE_READLINE_H) */
168: /*char *cmdline = NULL;*/
169: #else /* !defined(HAVE_READLINE_READLINE_H) */
170: /* no readline */
171: #endif /* HAVE_LIBREADLINE */
172:
173: #ifdef HAVE_READLINE_HISTORY
174: # if defined(HAVE_READLINE_HISTORY_H)
175: # include <readline/history.h>
176: # elif defined(HAVE_HISTORY_H)
177: # include <history.h>
178: # else /* !defined(HAVE_HISTORY_H) */
179: extern void add_history ();
180: extern int write_history ();
181: extern int read_history ();
182: # endif /* defined(HAVE_READLINE_HISTORY_H) */
183: /* no history */
184: #endif /* HAVE_READLINE_HISTORY */
185:
186: #include "mwapi_window.h"
187: #include "mwapi_event.h"
188:
189:
190: void on_frame_entry(void);
191: void rbuf_dump(void);
192: short rbuf_slot_from_name(char *);
193: short is_standard(void);
194:
1.27 snw 195: #ifdef HAVE_LIBREADLINE
196: char *m_commands[] = {
1.28 snw 197: "?",
198: "@",
199: "!<",
200: "!>",
201: "!!",
202: "ablock",
203: "astart",
204: "astop",
205: "aunblock",
206: "break",
207: "close",
208: "do",
209: "else",
210: "events",
211: "for",
212: "goto",
213: "halt",
214: "hang",
215: "history",
216: "if",
217: "job",
218: "jobtab",
219: "kill",
220: "ksubscripts",
221: "kvalue",
222: "lock",
223: "locktab",
224: "merge",
225: "new",
226: "open",
227: "quit",
228: "rbuf",
229: "rcl",
230: "read",
231: "set",
232: "shmpages",
233: "shmstat",
234: "tcommit",
235: "then",
236: "trantab",
237: "trollback",
238: "tstart",
239: "use",
240: "view",
241: "wh",
242: "write",
243: "xecute",
244: "zassert",
245: "zbreak",
246: "zconst",
247: "zedit",
248: "zgoto",
249: "zhalt",
250: "zinsert",
251: "zjob",
252: "zload",
253: "zmap",
254: "znew",
255: "zprint",
256: "zquit",
257: "zremove",
258: "zsave",
259: "zthrow",
260: "ztrap",
261: "zunmap",
262: "zwatch",
263: "zwith",
264: "zwrite",
265: "ABLOCK",
266: "ASTART",
267: "ASTOP",
268: "AUNBLOCK",
269: "BREAK",
270: "CLOSE",
271: "DO",
272: "ELSE",
273: "FOR",
274: "GOTO",
275: "HALT",
276: "HANG",
277: "IF",
278: "JOB",
279: "KILL",
280: "KSUBSCRIPTS",
281: "KVALUE",
282: "LOCK",
283: "MERGE",
284: "NEW",
285: "OPEN",
286: "QUIT",
287: "READ",
288: "SET",
289: "TCOMMIT",
290: "THEN",
291: "TROLLBACK",
292: "TSTART",
293: "USE",
294: "VIEW",
295: "WRITE",
296: "XECUTE",
297: "ZASSERT",
298: "ZBREAK",
299: "ZCONST",
300: "ZEDIT",
301: "ZGOTO",
302: "ZHALT",
303: "ZINSERT",
304: "ZJOB",
305: "ZLOAD",
306: "ZMAP",
307: "ZNEW",
308: "ZPRINT",
309: "ZQUIT",
310: "ZREMOVE",
311: "ZSAVE",
312: "ZTHROW",
313: "ZTRAP",
314: "ZUNMAP",
315: "ZWATCH",
316: "ZWITH",
317: "ZWRITE",
318: NULL
1.27 snw 319: };
320:
321: char **command_completion(const char *, int, int);
322: char *command_generator(const char *, int);
323:
324: char **command_completion(const char *text, int start, int end)
325: {
326: if (start > 0) return NULL;
327: rl_attempted_completion_over = 1;
328: return rl_completion_matches(text, command_generator);
329: }
330:
331: char *command_generator(const char *text, int state)
332: {
333: static int list_index, len;
334: char *name;
335:
336: if (!state) {
337: list_index = 0;
338: len = strlen(text);
339: }
340:
341: while ((name = m_commands[list_index++])) {
342: if (strncmp(name, text, len) == 0) {
343: return strdup(name);
344: }
345: }
346:
347: return NULL;
348: }
349: #endif
350:
1.1 snw 351: /*
352: * xecline():
353: * typ (where to go on function entry): 1 = restart
354: * 2 = error
355: *
356: */
357: int xecline(int typ)
358: {
359: MACTION ra;
360: short new_and_set = FALSE;
361: short new_object = FALSE;
362: short destructor_run = FALSE;
363: short libcall = FALSE;
364: char *namold;
365: long rouoldc;
366: unsigned long jobtime;
367: char label[256], routine[256];
368:
1.17 snw 369: char tracestr[512];
370:
1.1 snw 371: char *vn;
372: char *an;
373: char *tmp;
374: char *tmp2;
375: char *tmp3;
376:
377:
378: char *deferrable_codptr;
379: char deferrable_code[512];
380:
381: char *ev_handlers;
382:
383: char *reeval_codptr;
384: char reeval_code[512];
1.21 snw 385: char entryref[256];
1.1 snw 386:
387: int i;
388: int j;
389: register int ch;
390:
391: int then_ctr = 0;
392:
393: #if defined(HAVE_MWAPI_MOTIF)
394: int syn_event_entry_nstx = 0;
395: int in_syn_event_loop = FALSE;
396: #endif
397:
398: # ifdef DEBUG_NEWSTACK
399: int loop;
400: # endif
401:
402: vn = (char *) malloc ((STRLEN + 1) * sizeof (char));
403: an = (char *) malloc ((STRLEN + 1) * sizeof (char));
404: tmp = (char *) malloc ((STRLEN + 1) * sizeof (char));
405: tmp2 = (char *) malloc ((STRLEN + 1) * sizeof (char));
406: tmp3 = (char *) malloc ((STRLEN + 1) * sizeof (char));
407:
408: NULLPTRCHK(vn,"xecline");
409: NULLPTRCHK(an,"xecline");
410: NULLPTRCHK(tmp,"xecline");
411: NULLPTRCHK(tmp2,"xecline");
412: NULLPTRCHK(tmp3,"xecline");
413:
414: deferrable_codptr = deferrable_code;
415:
416: switch (typ) {
417:
418: case 0:
419: goto next_line;
420:
421: case 1:
422: goto restart;
423:
424: case 2:
425: goto err;
426:
427: case 3:
428: libcall = TRUE;
429: goto restart;
430:
431: }
432:
433: next_line: /* entry point for next command line */
434:
1.18 snw 435: if (debug_mode) {
1.21 snw 436: debug_mode = debugger (DEBENTRY_LINE, entryref);
1.18 snw 437: }
1.24 snw 438:
1.1 snw 439: job_set_status (pid, JSTAT_INTERPRETER);
440:
441: if (then_ctr > 0) {
442: test = nestlt[nstx];
443: level--;
444: then_ctr--;
445: }
446:
447: while ((roucur < rouend) && (ch = (*roucur++)) != TAB && ch != SP); /* skip label */
448:
449: if (roucur >= rouend) goto quit0; /* end of routine implies QUIT */
450:
451: while ((ch = *roucur) == TAB || ch == SP) roucur++;
452:
453: i = 0;
454: if (ch == '.') { /* get level count */
455:
456: do {
457: i++;
458: while ((ch = (*++roucur)) == SP || ch == TAB);
459: }
460: while (ch == '.');
461:
462: }
463:
464: if (i != level) {
465:
466: if (mcmnd == GOTO) {
467: merr_raise (M45);
468: goto err;
469: }
470:
471: if (i < level) {
472: goto quit0;
473: }
474: else {
475: roucur += stlen (roucur) + 2;
476: goto next_line;
477: }
478: }
479:
480: i = stcpy (code, roucur) + 1;
481: code[i] = EOL;
482: roucur += i + 1;
483: codptr = code;
484:
485: next_cmnd: /* continue line entry point */
1.21 snw 486: getraddress (entryref, nstx);
1.19 snw 487: if (debug_mode) {
1.21 snw 488: debug_mode = debugger (DEBENTRY_CMD, entryref);
1.19 snw 489: }
490:
1.1 snw 491: if (sigint_in_for) goto for_quit;
492:
493: if (forsw && (forpost[forx][0] != '\0')) {
494:
495: stcpy (reeval_code, code);
496: reeval_codptr = codptr;
497:
498: strcpy (code, forpost[forx]);
499: stcnv_c2m (code);
500: codptr = code;
501:
502: expr (STRING);
503:
504: if (merr () > OK) {
505: stcpy (code, reeval_code);
506: codptr = reeval_codptr;
507:
508: goto err;
509: }
510:
511: if (tvexpr (argptr) == FALSE) {
512: stcpy (code, reeval_code);
513: codptr = reeval_codptr;
514:
515: goto for_quit;
516: }
517:
518: stcpy (code, reeval_code);
519: codptr = reeval_codptr;
520:
521: }
522:
523: job_set_status (pid, JSTAT_INTERPRETER);
524:
525: if (evt_async_enabled == TRUE) {
526:
527: switch (pending_signal_type) {
528:
529: case SIGWINCH:
530: evt_enqueue ("SIGWINCH", EVT_CLS_INTERRUPT, 1);
531: break;
532:
533: case SIGINT:
534: evt_enqueue ("SIGINT", EVT_CLS_INTERRUPT, 0);
535: break;
536:
537: case SIGFPE:
538: evt_enqueue ("SIGFPE", EVT_CLS_INTERRUPT, 0);
539: break;
540:
541: case SIGQUIT:
542: evt_enqueue ("SIGQUIT", EVT_CLS_INTERRUPT, 0);
543: break;
544:
545: }
546:
547: pending_signal_type = -1;
548:
549: /* process async events */
550: ev_handlers = (char *) malloc (STRLEN * sizeof (char));
551: NULLPTRCHK(ev_handlers,"xecline");
552:
553:
554: /* get a comma-delimited list of applicable handlers (e.g. ^HNDL1,^HNDL2,^HNDL3) */
555: ev_handlers[0] = NUL;
556: evt_depth = evt_get_handlers (ev_handlers);
557:
558: stcnv_c2m (ev_handlers);
559: stcpy (tmp3, ev_handlers);
560: free (ev_handlers);
561:
562: /* only execute event handlers if we have at least one such handler registered in ^$JOB($JOB,"EVENTS") */
563: if (evt_depth) {
564:
565: /* per X11-1998/28, async events are to be disabled during the execution of event handlers */
566:
567: /* TODO: this should be done by incrementing the event block counter
568: for all event types, or whatever the event extension says to do.
569:
570: In any event (rimshot here for the obvious pun), turning off all
571: event handlers this way is decidedly non-standard. Or non-what-might-
572: become the standard. Whatever. */
573:
574: evt_async_enabled = FALSE;
575: evt_async_initial = TRUE;
576: evt_async_restore = TRUE;
577:
578: goto evthandler;
579:
580: }
581:
582: }
583:
584:
585: if (merr () > OK) goto err;
586:
587: next0:
588:
589: do {
590: if ((ch = *codptr) == EOL) {
591: if (forsw) goto for_end;
592:
593: goto next_line;
594: }
595:
596: codptr++;
597: }
598: while (ch == SP);
599:
600: /* decode command word */
601:
602: if (ch < 'A') { /* Handle non-alpha first chars */
603:
604: if (ch == ';') { /* COMMENT */
605:
606: ch = *(codptr++);
607:
608: if(ch == '%') { /* DIRECTIVE */
609:
610: int dir_pos = 0;
611: int dir_wc = 0;
612: char dir_words[20][255];
613:
614: while((ch = *(codptr++)) != EOL) {
615:
616: switch (ch) {
617:
618:
619: case SP:
620:
621: dir_words[dir_wc][dir_pos] = NUL;
622:
623: dir_wc++;
624: dir_pos = 0;
625:
626: break;
627:
628:
629: default:
630:
631: dir_words[dir_wc][dir_pos++] = ch;
632:
633: }
634:
635: }
636:
637: dir_words[dir_wc][dir_pos] = NUL;
638:
639: if (strcmp (dir_words[0], "DIALECT") == 0) {
640: short rb_slot;
641:
642: rb_slot = rbuf_slot_from_name (rou_name);
643:
644: if ((strcmp (dir_words[1], "STANDARD") == 0) ||
645: (strcmp (dir_words[1], "MDS") == 0)) {
646: rbuf_flags[rb_slot].standard = TRUE;
647: rbuf_flags[rb_slot].dialect = D_MDS;
648: }
649: else if (strcmp (dir_words[1], "M77") == 0) {
650: rbuf_flags[rb_slot].standard = TRUE;
651: rbuf_flags[rb_slot].dialect = D_M77;
652: }
653: else if (strcmp (dir_words[1], "M84") == 0) {
654: rbuf_flags[rb_slot].standard = TRUE;
655: rbuf_flags[rb_slot].dialect = D_M84;
656: }
657: else if (strcmp (dir_words[1], "M90") == 0) {
658: rbuf_flags[rb_slot].standard = TRUE;
659: rbuf_flags[rb_slot].dialect = D_M90;
660: }
661: else if (strcmp (dir_words[1], "M95") == 0) {
662: rbuf_flags[rb_slot].standard = TRUE;
663: rbuf_flags[rb_slot].dialect = D_M95;
664: }
665: else if (strcmp (dir_words[1], "M5") == 0) {
666: rbuf_flags[rb_slot].standard = TRUE;
667: rbuf_flags[rb_slot].dialect = D_M5;
668: }
669: else if ((strcmp (dir_words[1], "FREEM") == 0) ||
670: (strcmp (dir_words[1], "EXTENDED") == 0)) {
671: rbuf_flags[rb_slot].standard = FALSE;
672: rbuf_flags[rb_slot].dialect = D_FREEM;
673: }
674: else {
675: merr_raise (CMMND);
676: goto err;
677: }
678: goto skip_line;
679: }
680: else {
681: goto skip_line;
682: }
683:
684: }
685:
686: goto skip_line;
687: }
688:
689: if ((!is_standard ()) && (ch == '#')) {
690: goto skip_line;
691: }
692:
693: if ((is_standard ()) && (ch == '#')) {
694: merr_raise (NOSTAND);
695: goto err;
696: }
697:
698: if (ch == '@') {
699: if (!is_standard ()) {
700: goto do_xecute;
701: }
702: else {
703: merr_raise (NOSTAND);
704: goto err;
705: }
706: }
707:
708: if (ch == '!') { /* UNIXCALL */
709:
710: if (restricted_mode) {
1.28 snw 711: merr_raise (CMMND);
1.1 snw 712: goto err;
713: }
714:
715: /* don't catch child dies signal */
716: sig_attach (SIGUSR1, SIG_IGN);
717:
718: tmp2[stcpy (tmp2, codptr)] = NUL;
719:
720: if (demomode) fputc (d1char, stdout);
721:
722: if (tmp2[0] == '!') {
723:
724: uid_t suid;
725: struct passwd *spw;
726:
727: suid = geteuid ();
728: spw = getpwuid (suid);
729:
730: set_io (UNIX);
731:
732: fprintf (stderr, "Type Ctrl-D to exit from the shell\n");
733:
734: if (strlen (spw->pw_shell)) {
735: zsystem = system (spw->pw_shell);
736: }
737: else {
738: zsystem = system ("/bin/sh");
739: }
740:
741: set_io (MUMPS);
742: sig_attach (SIGUSR1, &oncld); /* restore handler */
743:
744: }
745: else if (tmp2[0] == '<') { /* call write output to %-array */
746:
747: FILE *pipdes;
1.14 snw 748: char key[STRLEN];
749: char data[STRLEN];
1.1 snw 750: char data_kill[256];
751: data_kill[255] = EOL;
752:
1.14 snw 753: for (i = 0; i < STRLEN - 1; i++) vn[i] = EOL;
1.1 snw 754:
1.14 snw 755: snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
1.1 snw 756: ssvn (get_sym, key, vn);
757:
758: if (vn[0] == '^') {
759:
760: if (vn[1] == '$') {
761: merr_raise (INVREF);
762: goto err;
763: }
764: else {
765: global (kill_sym, vn, data_kill);
766: }
767:
768: }
769: else {
770: symtab (kill_sym, vn, data);
771: }
772:
1.14 snw 773: snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
1.1 snw 774: ssvn (get_sym, key, vn);
775:
776: data[0] = '0';
777: data[1] = EOL;
778:
779: if (vn[0] == '^') {
780:
781: if (vn[1] == '$') {
782: merr_raise (INVREF);
783: goto err;
784: }
785: else {
786: global (set_sym, vn, data);
787: }
788:
789: }
790: else {
791: symtab (set_sym, vn, data);
792: }
793:
794: set_io (UNIX);
795: if ((pipdes = popen (&tmp2[1], "r")) == NULL) {
796: zsystem = 1;
797: }
798: else {
799: int glvn_len = 0;
800:
801: while (fgets (data, STRLEN, pipdes)) {
1.14 snw 802: snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
1.1 snw 803: ssvn (get_sym, key, vn);
804:
805: glvn_len = stlen (vn);
806: stcpy (key, vn);
807:
808: key[glvn_len] = DELIM;
809:
810: if (vn[0] == '^') {
811:
812: if (vn[1] == '$') {
813: merr_raise (INVREF);
814: goto err;
815: }
816: else {
817: global (getinc, vn, &key[glvn_len + 1]);
818: }
819:
820: }
821: else {
822: symtab (getinc, vn, &key[glvn_len + 1]);
823: }
824:
825: i = strlen (data);
826:
827: data[i] = EOL;
828:
829: if (i > 1 && data[i - 1] == LF) data[i - 1] = EOL;
830:
831: if (vn[0] == '^') {
832:
833: if (vn[1] == '$') {
834: merr_raise (INVREF);
835: goto err;
836: }
837: else {
838: global (set_sym, key, data);
839: }
840:
841: }
842: else {
843: symtab (set_sym, key, data);
844: }
845:
846: if (merr () == STORE) break;
847: }
848:
849: pclose (pipdes);
850:
851: zsystem = 0;
852: }
853: set_io (MUMPS);
854: }
855: else if (tmp2[0] == '>') { /* call read input from %-array */
856: FILE *pipdes;
857: char key[STRLEN + 1 /*was 256 */ ];
858: char data[STRLEN + 1 /*was 256 */ ];
859: int i, k, l;
860:
861: for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL;
862:
1.14 snw 863: snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
1.1 snw 864: ssvn (get_sym, key, vn);
865:
866: if (vn[0] == '^') {
867:
868: if (vn[1] == '$') {
869: merr_raise (INVREF);
870: goto err;
871: }
872: else {
873: global (get_sym, vn, data);
874: }
875:
876: }
877: else {
878: symtab (get_sym, vn, data);
879: }
880:
881: merr_clear ();
882: k = intexpr (data);
883:
884: set_io (UNIX);
885: if (k < 1 || (pipdes = popen (&tmp2[1], "w")) == NULL) {
886: zsystem = 1;
887: }
888: else {
889: int glvn_len = 0;
890:
891: for (i = 1; i <= k; i++) {
1.14 snw 892: snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
1.1 snw 893: ssvn (get_sym, key, vn);
894:
895: glvn_len = stlen (vn);
896: stcpy (key, vn);
897:
898: key[glvn_len] = DELIM;
899:
900: intstr (&key[glvn_len + 1], i);
901:
902: if (vn[0] == '^') {
903:
904: if (vn[1] == '$') {
905: merr_raise (INVREF);
906: goto err;
907: }
908: else {
909: global (get_sym, key, data);
910: }
911:
912: }
913: else {
914: symtab (get_sym, key, data);
915: }
916:
917: l = stlen (data);
918:
919: data[l++] = LF;
920: data[l] = NUL;
921:
922: fputs (data, pipdes);
923: }
924:
925: pclose (pipdes);
926:
927: zsystem = 0;
928: merr_clear ();
929: }
930: set_io (MUMPS);
931:
932: }
933: else {
934: set_io (UNIX);
935: zsystem = system (tmp2);
936: set_io (MUMPS);
937: }
938:
939: if (demomode) fputc (d1char, stdout);
940:
941: sig_attach (SIGUSR1, &oncld); /* restore handler */
942:
943:
944: if (merr () == STORE) {
945: zsystem = 1;
946: goto err;
947: }
948:
949: goto skip_line;
950: }
951:
952: merr_raise (CMMND);
953: goto err;
954: } /* END handling of non-alpha first chars */
955:
956:
957: mcmnd = ch | 0140; /* uppercase to lower case */
958:
959: i = 1;
960:
961: while ((ch = (*codptr)) != SP && ch != ':' && ch != EOL) {
962: tmp3[++i] = ch | 0140;
963: codptr++;
964: }
965:
966: j = i;
967:
968: if (j > 1) {
969: merr_raise (mcmd_tokenize (&ra, tmp3, deferrable_codptr, deferrable_code, &j));
970: MRESCHECK(ra);
971: }
972:
973:
974: if (*codptr == ':') {
975: /* handle postconditional */
976:
977: if (mcmnd == FOR) {
978: char *savcp = codptr;
979:
980: codptr++;
981: i = 0;
982: while ((forpost[forx + 1][i++] = *(codptr++)) != SP);
983:
984: forpost[forx + 1][i - 1] = '\0';
985:
986: codptr = savcp;
987: }
988:
989:
990: /* postcond after FOR,IF,ELSE not allowed in dialects other than D_FREEM */
991:
992:
993: if ((rtn_dialect () != D_FREEM) && (mcmnd == FOR || mcmnd == IF || mcmnd == ELSE)) {
994: merr_raise (NOSTAND);
995: goto err;
996: }
997:
998: codptr++;
999:
1000: expr (STRING);
1001:
1002: if (merr () > OK) goto err;
1003:
1004: ch = *codptr;
1005:
1006: if (ch != SP && ch != EOL) {
1007: merr_raise (SPACER);
1008: goto err;
1009: }
1010:
1011: if (tvexpr (argptr) == FALSE) { /* skip arguments */
1012:
1013: if ((mcmnd == IF) || (mcmnd == THEN) || (mcmnd == ELSE) || (mcmnd == FOR)) {
1014: mcmnd = 0;
1015: goto skip_line;
1016: }
1017:
1018: mcmnd = 0; /* avoid false LEVEL error */
1019:
1020: for (;;) {
1021: if (ch == EOL) goto skip_line;
1022: if ((ch = *++codptr) == SP) goto next_cmnd;
1023: if (ch != '"') continue;
1024:
1025: while (*codptr++ != EOL) {
1026: if (*codptr != ch) continue;
1027: if (*++codptr != ch) break;
1028: }
1029:
1030: if (--codptr == code) goto err;
1031: }
1032: }
1033:
1034: }
1035:
1036: if (*codptr != EOL) { /* beware argumentless cmnds at end of line */
1037: codptr++; /* entry for next argument in list */
1038:
1039: again:
1040: while (*codptr == '@') { /* handle indirection */
1041:
1042: stcpy (tmp, codptr++); /* save code to restore on nameind */
1043: expr (ARGIND);
1044:
1045: if (merr () > OK) goto err;
1046:
1047: if (((ch = (*codptr)) != SP && ch != EOL && ch != ',' && ch != ':' && ch != '=') || (ch == '@' && *(codptr + 1) == '(')) {
1048: stcpy (code, tmp); /* restore code on nameind */
1049: codptr = code;
1050:
1051: break;
1052: }
1053: else {
1054: stcpy (argptr + stlen (argptr), codptr);
1055: stcpy (code, argptr);
1056:
1057: codptr = code;
1058: }
1059: }
1060: }
1061:
1.17 snw 1062: if (trace_mode) tracestr[0] = '\0';
1063:
1.1 snw 1064: switch (mcmnd) {
1065:
1066: case MAP:
1067: merr_raise (cmd_map (&ra));
1068: MRESCHECK(ra);
1069: break;
1070:
1071: case UNMAP:
1072: merr_raise (cmd_unmap (&ra));
1073: MRESCHECK(ra);
1074: break;
1075:
1076: case THEN:
1077: merr_raise (cmd_then (&ra, &then_ctr));
1078: MRESCHECK(ra);
1079: break;
1080:
1081: case THROW:
1082: merr_raise (cmd_throw (&ra));
1083: MRESCHECK(ra);
1084: break;
1085:
1086: case CONST:
1087: merr_raise (cmd_const (&ra));
1088: MRESCHECK(ra);
1089: break;
1090:
1091: case KVALUE:
1092: merr_raise (cmd_kvalue (&ra));
1093: MRESCHECK(ra);
1094: break;
1095:
1096: case KSUBSC:
1097: merr_raise (cmd_ksubscripts (&ra));
1098: MRESCHECK(ra);
1099: break;
1100:
1101: case TSTART:
1102: merr_raise (cmd_tstart (&ra));
1103: MRESCHECK(ra);
1104: break;
1105:
1106: case TCOMMIT:
1107: merr_raise (cmd_tcommit (&ra));
1108: MRESCHECK(ra);
1109: break;
1110:
1111: case TROLLBACK:
1112: merr_raise (cmd_trollback (&ra));
1113: MRESCHECK(ra);
1114: break;
1115:
1116: case SET:
1117:
1118: set0:
1119: if ((ch = (*codptr)) >= 'A') { /* no set$piece nor multiset */
1120: short setref = FALSE;
1121: short stclass = SC_UNCHANGED;
1122:
1123: expr (NAME);
1124: if (merr () > OK) break;
1125: stcpy (vn, varnam);
1126:
1127: if (isalpha (vn[0]) && *(codptr + 1) == ':') {
1128: char sc_string[255];
1.12 snw 1129:
1.1 snw 1130: codptr += 2;
1131: expr (NAME);
1132:
1133: stcpy (sc_string, varnam);
1134: for (i = 0; i < stlen (sc_string); i++) {
1135: sc_string[i] = toupper (sc_string[i]);
1136: }
1137:
1138: stcnv_m2c (sc_string);
1139: if (strcmp (sc_string, "PRIVATE") == 0) {
1140: stclass = SC_PRIVATE;
1141: }
1142: else if (strcmp (sc_string, "PUBLIC") == 0) {
1143: stclass = SC_PUBLIC;
1144: }
1145: else {
1146: merr_raise (OBJACINVALID);
1147: break;
1148: }
1149: }
1150:
1151: if ((*++codptr != '=') || (*(codptr + 1) == '=')) {
1152: ch = *codptr;
1153:
1154: /* double char symbol ** (power) is encoded by ' ' */
1155: if (ch == '*' && *(codptr + 1) == ch) {
1156: codptr++;
1157: ch = ' ';
1158: }
1159:
1160: /* negated boolean operator */
1161: else if ((ch == '\'') && (*(codptr + 2) == '=')) ch = SETBIT (*++codptr);
1162:
1163: if (*++codptr != '=') {
1164:
1.13 snw 1165: /* unary ++/-- */
1.1 snw 1166: if ((ch == '+' || ch == '-') && ch == *codptr) {
1167: codptr++;
1168: setop = ch;
1169: argptr[0] = '1';
1170: argptr[1] = EOL;
1171:
1172: goto set2;
1173: }
1174:
1175: merr_raise (ASSIGNER);
1176: break;
1177: }
1178:
1179: setop = ch;
1180: }
1181:
1182: codptr++;
1183:
1184: ch = *codptr;
1185:
1.16 snw 1186: if (ch == '.') {
1187: if (!isdigit (*(codptr + 1))) {
1188: setref = TRUE;
1189: codptr++;
1190: expr (NAME);
1191: }
1192: else {
1193: expr (STRING);
1194: }
1.1 snw 1195: }
1196: else {
1197: expr (STRING);
1198: }
1199:
1200:
1201: if (merr () > OK) break;
1202:
1203:
1204: set2:
1205:
1206: if (vn[0] == '^') {
1207:
1208: stcpy (an, argptr);
1209:
1210: if (setref == TRUE) {
1211: merr_raise (INVREF);
1212: goto err;
1213: }
1214:
1215: if (vn[1] == '$') {
1216: ssvn (set_sym, vn, an);
1217: }
1218: else {
1219: global (set_sym, vn, an);
1220: }
1221:
1222: }
1223: else {
1224: stcpy (an, argptr);
1225:
1226: if (setref == TRUE) {
1227: symtab (new_sym, vn, "");
1228: symtab (m_alias, vn, varnam);
1229: codptr++;
1230: }
1231: else {
1232: if (new_object == FALSE) {
1233: symtab (set_sym, vn, an);
1234: switch (stclass) {
1235:
1236: case SC_PUBLIC:
1237: obj_set_field_public (vn);
1238: break;
1239:
1240: case SC_PRIVATE:
1241: obj_set_field_private (vn);
1242: break;
1243:
1244: }
1245: }
1246: }
1247: }
1248:
1249: if (merr () > OK) {
1250: stcpy (varerr, vn);
1251: break;
1252: }
1253:
1254: if (((new_and_set == TRUE) || (new_object == TRUE)) && (*codptr != SP) && (*codptr != EOL)) {
1255: new_and_set = FALSE;
1256: new_object = FALSE;
1257:
1258: merr_raise (INEWMUL);
1259: goto err;
1260: }
1261:
1262: if (new_and_set == TRUE) new_and_set = FALSE;
1263: if (new_object == TRUE) new_object = FALSE;
1.12 snw 1264: /*
1.1 snw 1265: set1:
1.12 snw 1266: */
1.1 snw 1267: if (*codptr != ',') break;
1268:
1269: if (*++codptr == '@') goto again;
1270:
1271: goto set0;
1272: }
1273:
1274: /****** special SET syntax: multiple SET, set$piece, special variables */
1275: {
1276: char multiset, vnset[256]; /* multiset variables */
1277: long arg3, arg4; /* 3rd,4th arg in set$piece */
1278:
1279: if ((multiset = (ch == '('))) {
1280: vnset[0] = EOL;
1281: codptr++;
1282: }
1283:
1284: set:
1285: if (*codptr == '$' && (*(codptr + 1) | 0140) == 'p') { /* set$piece */
1286:
1287: if (multiset) {
1288: merr_raise (INVREF);
1289: goto err;
1290: }
1291:
1292: setpiece = 'p';
1293:
1294: while (*++codptr != '(') {
1295:
1296: if (*codptr == EOL) {
1297: merr_raise (INVREF);
1298: goto err;
1299: }
1300:
1301: }
1302:
1303: codptr++;
1304:
1305: expr (NAME);
1306:
1307: if (merr () > OK) goto err;
1308:
1309: stcpy (vn, varnam);
1310:
1311: codptr++;
1312:
1313: if (*codptr++ != ',') {
1314: merr_raise (COMMAER);
1315: goto err;
1316: }
1317:
1.7 snw 1318: expr (STRING);
1319:
1.1 snw 1320: if (merr () > OK) goto err;
1321:
1322: stcpy (tmp2, argptr);
1323:
1324: if (*codptr != ')') {
1325:
1326: codptr++;
1327:
1328: expr (STRING);
1329:
1330: if (merr () > OK) goto err;
1331:
1332: arg3 = intexpr (argptr);
1333:
1334: if (merr () == MXNUM) {
1335: arg3 = 256;
1336: merr_clear ();
1337: }
1338:
1339: }
1340: else {
1341: arg3 = 1;
1342: }
1343:
1344: if (*codptr != ')') {
1345:
1346: codptr++;
1347:
1348: expr (STRING);
1349:
1350: if (merr () > OK) goto err;
1351:
1352: if (*codptr != ')') {
1353: merr_raise (BRAER);
1354: goto err;
1355: }
1356:
1357: arg4 = intexpr (argptr);
1358:
1359: if (merr () == MXNUM) {
1360: arg4 = 256;
1361: merr_clear ();
1362: }
1363:
1364: }
1365: else {
1366: arg4 = arg3;
1367: }
1368: } /* set$piece */
1369: else if (*codptr == '$' && (*(codptr + 1) | 0140) == 'q' && (*(codptr + 2) | 0140) == 's') { /* TODO: verify this works (jpw) was (*codptr == '$q'...*/
1370: /*SET $QSUBSCRIPT */
1371:
1372: if (multiset) {
1373: merr_raise (INVREF);
1374: goto err;
1375: }
1376:
1377: setpiece = 'q';
1378:
1379: while (*++codptr != '(') {
1380:
1381: if (*codptr == EOL) {
1382: merr_raise (INVREF);
1383: goto err;
1384: }
1385:
1386: }
1387:
1388: codptr++;
1389:
1390: expr (NAME);
1391:
1392: if (merr () > OK) goto err;
1393:
1394: stcpy (vn, varnam);
1395:
1396: if (*++codptr == ',') {
1397: codptr++;
1398:
1399: expr (STRING);
1400:
1401: if (merr () > OK) goto err;
1402:
1403: stcpy (tmp2, argptr);
1404: }
1405:
1406: if (*codptr != ')') {
1407: merr_raise (BRAER);
1408: goto err;
1409: }
1410:
1411: }
1412: else if (*codptr == '$' &&
1413: (*(codptr + 1) | 0140) == 'd' &&
1414: (*(codptr + 2) | 0140) == 'i') {
1415:
1416: short rb_slot;
1417:
1418: rb_slot = rbuf_slot_from_name (rou_name);
1419:
1420: while ((*(++codptr)) != '=');
1421:
1422: codptr++;
1423:
1424: expr (STRING);
1425:
1426: stcnv_m2c (argptr);
1427:
1428: if ((strcmp (argptr, "STANDARD") == 0) ||
1429: (strcmp (argptr, "MDS") == 0)) {
1430: rbuf_flags[rb_slot].standard = TRUE;
1431: rbuf_flags[rb_slot].dialect = D_MDS;
1432: }
1433: else if (strcmp (argptr, "M77") == 0) {
1434: rbuf_flags[rb_slot].standard = TRUE;
1435: rbuf_flags[rb_slot].dialect = D_M77;
1436: }
1437: else if (strcmp (argptr, "M84") == 0) {
1438: rbuf_flags[rb_slot].standard = TRUE;
1439: rbuf_flags[rb_slot].dialect = D_M84;
1440: }
1441: else if (strcmp (argptr, "M90") == 0) {
1442: rbuf_flags[rb_slot].standard = TRUE;
1443: rbuf_flags[rb_slot].dialect = D_M90;
1444: }
1445: else if (strcmp (argptr, "M95") == 0) {
1446: rbuf_flags[rb_slot].standard = TRUE;
1447: rbuf_flags[rb_slot].dialect = D_M95;
1448: }
1449: else if (strcmp (argptr, "M5") == 0) {
1450: rbuf_flags[rb_slot].standard = TRUE;
1451: rbuf_flags[rb_slot].dialect = D_M5;
1452: }
1453: else if ((strcmp (argptr, "FREEM") == 0) ||
1454: (strcmp (argptr, "EXTENDED") == 0)) {
1455: rbuf_flags[rb_slot].standard = TRUE;
1456: rbuf_flags[rb_slot].dialect = D_FREEM;
1457: }
1458: else {
1459: merr_raise (CMMND);
1460: goto err;
1461: }
1462:
1463: goto s_end;
1464:
1465: }
1466: else if (*codptr == '$' && (*(codptr + 1) | 0140) == 'e' && (*(codptr + 2) | 0140) != 't' && (*(codptr + 2) | 0140) != 'c') {
1467:
1468: /* set $extract */
1469: if (multiset) {
1470: merr_raise (INVREF);
1471: goto err;
1472: }
1473:
1474: setpiece = 'e';
1475:
1476: while (*++codptr != '(') {
1477:
1478: if (*codptr == EOL) {
1479: merr_raise (INVREF);
1480: goto err;
1481: }
1482:
1483: }
1484:
1485: codptr++;
1486:
1487: expr (NAME);
1488:
1489: if (merr () > OK) goto err;
1490:
1491: stcpy (vn, varnam);
1492:
1493: codptr++;
1494:
1495: if (*codptr != ')') {
1496: codptr++;
1497:
1498: expr (STRING);
1499:
1500: if (merr () > OK) goto err;
1501:
1502: arg3 = intexpr (argptr);
1503:
1504: if (merr () == MXNUM) {
1505: arg3 = 256;
1506: merr_clear ();
1507: }
1508: }
1509: else {
1510: arg3 = 1;
1511: }
1512:
1513: if (*codptr != ')') {
1514: codptr++;
1515:
1516: expr (STRING);
1517:
1518: if (merr () > OK) goto err;
1519:
1520: if (*codptr != ')') {
1521: merr_raise (BRAER);
1522: goto err;
1523: }
1524:
1525: arg4 = intexpr (argptr);
1526:
1527: if (merr () == MXNUM) {
1528: arg4 = 256;
1529: merr_clear ();
1530: }
1531:
1532: }
1533: else {
1534: arg4 = arg3;
1535: }
1536:
1537: }
1538: else if (*codptr == '$' && (*(codptr + 1) | 0140) == 'e' && (*(codptr + 2) | 0140) == 'c') {
1539: /* set $ecode */
1540:
1541: if (multiset) {
1542: merr_raise (INVREF);
1543: goto err;
1544: }
1545:
1546: while ((*(++codptr)) != '=');
1547:
1548: codptr++;
1549:
1550: expr (STRING);
1551:
1552: if (merr () > OK) goto err;
1553:
1554: switch (argptr[0]) {
1555:
1556: case ',':
1557:
1558: switch (argptr[1]) {
1559:
1560: case ',':
1561: merr_raise (M101);
1562: goto err;
1563:
1564: }
1565:
1566: break;
1567:
1568: }
1569:
1570: merr_raise (merr_set_ecode (argptr));
1571:
1572: #if 0
1573: set_io (UNIX);
1574: stcnv_m2c (ecode);
1575: stcnv_m2c (etrap);
1576: printf ("\n\n*** IN SET $ECODE: ecode = '%s' etrap = '%s'\n", ecode, etrap);
1577: stcnv_c2m (etrap);
1578: stcnv_c2m (ecode);
1579: set_io (MUMPS);
1580: #endif
1581:
1582: if (merr () > OK) goto err;
1583:
1584: goto s_end;
1585:
1586: }
1587: else if (*codptr == '$' && (*(codptr + 1) | 0140) == 'e' && (*(codptr + 2) | 0140) == 't') {
1588: /* set $etrap */
1589:
1590: if (multiset) {
1591: merr_raise (INVREF);
1592: goto err;
1593: }
1594:
1595: while ((*(++codptr)) != '=');
1596:
1597: codptr++;
1598:
1599: expr (STRING);
1600:
1601: if (merr () > OK) goto err;
1602:
1603: stcpy (etrap, argptr);
1604:
1605: #if 0
1606: set_io (UNIX);
1607: stcnv_m2c (ecode);
1608: stcnv_m2c (etrap);
1609: printf ("\n\n***IN SET $ETRAP: ecode = '%s' etrap = '%s'\n", ecode, etrap);
1610: stcnv_c2m (etrap);
1611: stcnv_c2m (ecode);
1612: set_io (MUMPS);
1613: #endif
1614:
1615: goto s_end;
1616:
1617: }
1618: else if (*codptr == '$' && (*(codptr + 1) | 0140) == 'g' && cset) { /* set$get */
1619:
1620: if (multiset) {
1621: merr_raise (INVREF);
1622: goto err;
1623: }
1624:
1625: setpiece = 'g';
1626:
1627: while (*++codptr != '(') {
1628:
1629: if (*codptr == EOL) {
1630: merr_raise (INVREF);
1631: goto err;
1632: }
1633: }
1634:
1635: codptr++;
1636:
1637: expr (NAME);
1638:
1639: if (merr () > OK) goto err;
1640:
1641: stcpy (vn, varnam);
1642:
1643: if (*++codptr == ',') {
1644: codptr++;
1645:
1646: expr (STRING);
1647:
1648: if (merr () > OK) goto err;
1649:
1650: stcpy (tmp2, argptr);
1651: }
1652: else {
1653: tmp2[0] = EOL;
1654: }
1655:
1656: if (*codptr != ')') {
1657: merr_raise (BRAER);
1658: goto err;
1659: }
1660: }
1661: else {
1662: if (*codptr == '$') {
1663: codptr++;
1664:
1665: expr (NAME);
1666:
1667: if (merr () > OK) goto err;
1668:
1669: stcpy (tmp, varnam);
1670:
1671: varnam[0] = '$';
1672:
1673: stcpy (&varnam[1], tmp);
1674:
1675: i = 0;
1676: while ((ch = varnam[++i]) != EOL) {
1677: if (ch >= 'A' && ch <= 'Z') {
1678: varnam[i] |= 0140; /*to lowercase */
1679: }
1680: }
1681: }
1682: else {
1683: expr (NAME);
1684:
1685: if (merr () > OK) goto err;
1686: }
1687:
1688: stcpy (vn, varnam);
1689: }
1690:
1691: if (multiset) {
1692: vnset[i = stlen (vnset)] = SOH;
1693:
1694: stcpy (&vnset[++i], vn);
1695:
1696: if (*++codptr == ',') {
1697: codptr++;
1698: goto set;
1699: }
1700:
1701: if (*codptr != ')') {
1702: merr_raise (COMMAER);
1703: goto err;
1704: }
1705: }
1706:
1707: if (*++codptr != '=') {
1708: ch = *codptr;
1709:
1710: if (!cset || *++codptr != '=' || multiset || setpiece || varnam[0] == '$') {
1711: merr_raise (ASSIGNER);
1712: break;
1713: }
1714:
1715: setop = ch;
1716: }
1717:
1718: codptr++;
1719:
1720: expr (STRING);
1721:
1722: if (merr () > OK) goto err;
1723:
1724: if (multiset)
1725: multi:
1726: {
1727: i = 0;
1728: while (vnset[i] == SOH) i++;
1729:
1730: j = 0;
1731: while ((vn[j] = vnset[i]) != SOH && vnset[i] != EOL) {
1732: vnset[i++] = SOH;
1733: j++;
1734: }
1735:
1736: vn[j] = EOL;
1737:
1738: if (j == 0) goto s_end;
1739: }
1740:
1741: if (setpiece == 'p') {
1742: long m, n;
1743:
1744: if (arg4 < arg3 || arg4 < 1) {
1745: setpiece = FALSE;
1746: break;
1747: }
1748:
1749: if (arg3 <= 0) arg3 = 1;
1750:
1751: if (vn[0] == '^') {
1752: if (vn[1] == '$') {
1753: ssvn (get_sym, vn, tmp3);
1754: }
1755: else {
1756: global (get_sym, vn, tmp3);
1757: }
1758: }
1759: else {
1760: symtab (get_sym, vn, tmp3);
1761: }
1762:
1763:
1764: if (merr () == UNDEF || merr () == M6 || merr () == M7) {
1765: tmp3[0] = EOL;
1766: merr_clear ();
1767: }
1768: else if (merr () != OK) {
1769: stcpy (varerr, vn);
1770: }
1771:
1772: ch = 0;
1773: m = 0;
1774: n = 0;
1775:
1776: j = stlen (tmp2);
1777:
1778: while (n < arg3 - 1) {
1779:
1780: if ((ch = find (&tmp3[m], tmp2)) <= 0) {
1781:
1782: while (++n < arg3) {
1783: if (stcat (tmp3, tmp2) == 0) {
1784: merr_raise (M75);
1785: goto err;
1786: }
1787: }
1788:
1789: arg3 = arg4 = stlen (tmp3);
1790:
1791: goto set10;
1792: }
1793:
1794: n++;
1795: m += j + ch - 1;
1796: }
1797:
1798: if (arg3 > 1) {
1799: arg3 = m;
1800: }
1801: else {
1802: arg3 = 0;
1803: }
1804:
1805: while (n++ < arg4) {
1806:
1807: if ((ch = find (&tmp3[m], tmp2)) <= 0) {
1808: arg4 = stlen (tmp3);
1809:
1810: goto set10;
1811: }
1812:
1813: m += j + ch - 1;
1814: }
1815:
1816: arg4 = m - j;
1817:
1818: set10:
1819:
1820: stcpy0 (tmp2, tmp3, (long) arg3);
1821:
1822: tmp2[arg3] = EOL;
1823:
1824: if (stcat (tmp2, argptr) == 0) {
1825: merr_raise (M75);
1826: goto err;
1827: }
1828:
1829: if (stcat (tmp2, &tmp3[arg4]) == 0) {
1.13 snw 1830: merr_raise (M56); /* snw */
1.1 snw 1831: goto err;
1832: }
1833:
1834: stcpy (argptr, tmp2);
1835:
1836: setpiece = FALSE;
1837: }
1838: else if (setpiece == 'q') { /* SET$QSUBSCRIPT */
1839:
1840: setpiece = FALSE;
1841:
1842: if (vn[0] == '^') {
1843: if (vn[1] == '$') {
1844: ssvn (get_sym, vn, tmp3);
1845: }
1846: else {
1847: global (get_sym, vn, tmp3);
1848: }
1849: }
1850: else {
1851: symtab (get_sym, vn, tmp3);
1852: }
1853:
1854: if (merr () == UNDEF || merr () == M6 || merr () == M7) {
1855: tmp3[0] = EOL;
1856: merr_clear ();
1857: }
1858: else if (merr () != OK) {
1859: stcpy (varerr, vn);
1860: }
1861:
1862: if (merr () == OK) {
1863: /* 2nd $QS argument */
1864: if ((arg4 = intexpr (tmp2)) < -1) merr_raise (ARGER);
1865: if (merr () != OK) break;
1866:
1867: /* special if source is empty */
1868: if (tmp3[0] != EOL || (arg4 != 0)) {
1869: /* special: Set env to empty: no |""| */
1870: if ((arg4 == -1) && (*argptr == EOL)) {
1871: tmp2[0] = EOL;
1872: }
1873: else if ((arg4 != 0) && !znamenumeric (argptr)) {
1874: /* put replacement string in tmp2 with */
1875: /* quotes around env or subscript, unless numeric */
1876: i = 0;
1877: j = -1;
1878: tmp2[0] = '"';
1879:
1880: while ((tmp2[++i] = argptr[++j]) != EOL) {
1881: if (tmp2[i] == '"') tmp2[++i] = '"';
1882:
1883: if (i >= (STRLEN - 2)) {
1884: merr_raise (M75);
1885: break;
1886: }
1887: }
1888:
1889: tmp2[i] = '"';
1890: tmp2[++i] = EOL;
1891: }
1892: else {
1893: stcpy (tmp2, argptr);
1894: }
1895:
1896: /* source is tmp3, dest is argptr, replacement is tmp2 */
1897: {
1898: int ch, cpflag, quote, piececounter;
1899:
1900: piececounter = 0;
1901: i = 0;
1902: j = 0;
1903: quote = FALSE;
1904: cpflag = FALSE;
1905:
1906: /* if source has no env, process right now */
1907: if ((arg4 == -1) && (tmp3[tmp3[0] == '^'] != '|') && tmp2[0] != EOL) {
1908:
1909: if (tmp3[0] == '^') {
1910: argptr[j++] = '^';
1911: i = 1;
1912: }
1913:
1914: argptr[j++] = '|';
1915: ch = 0;
1916:
1917: while ((argptr[j] = tmp2[ch++]) != EOL) j++;
1918:
1919: argptr[j++] = '|';
1920:
1921: }
1922: else if (arg4 == 0) { /* '^'+name may be separated by env */
1923: if (tmp2[0] == '^') argptr[j++] = '^';
1924: if (tmp3[0] == '^') i++;
1925: }
1926:
1927: while ((ch = tmp3[i++]) != EOL) {
1928: if (ch == '"') quote = !quote;
1929:
1930: if (!quote) {
1931:
1932: if (ch == ',') {
1933: piececounter++;
1934: argptr[j++] = ch;
1935:
1936: continue;
1937: }
1938:
1939: if ((ch == '(' && piececounter == 0)) {
1940: if (!cpflag && (arg4 == 0)) {
1941: i--;
1942: }
1943: else {
1944: piececounter = 1;
1945: argptr[j++] = ch;
1946:
1947: continue;
1948: }
1949: }
1950:
1951: if (ch == '|') {
1952: if (piececounter == 0) {
1953: piececounter = (-1);
1954: }
1955: else if (piececounter == (-1)) {
1956: piececounter = 0;
1957: }
1958:
1959: if (tmp2[0] != EOL || piececounter > 0) argptr[j++] = ch;
1960:
1961: continue;
1962: }
1963: }
1964:
1965: if (piececounter == arg4) {
1966: if (cpflag) continue;
1967:
1968: cpflag = TRUE;
1969: ch = 0;
1970:
1971: if (arg4 == 0 && tmp2[0] == '^') ch = 1;
1972:
1973: while ((argptr[j] = tmp2[ch++]) != EOL) j++;
1974: }
1975: else {
1976: argptr[j++] = ch;
1977: }
1978:
1979: if (j >= (STRLEN - 1)) {
1980: merr_raise (M75);
1981: break;
1982: }
1983: } /* while ((ch = tmp3[i++]) != EOL) ... */
1984:
1985: if (piececounter && (piececounter == arg4)) argptr[j++] = ')';
1986:
1987: if (piececounter < arg4) {
1988:
1989: if (piececounter == 0) {
1990: argptr[j++] = '(';
1991: }
1992: else {
1993: argptr[j - 1] = ',';
1994: }
1995:
1996: while (++piececounter < arg4) {
1997: argptr[j++] = '"';
1998: argptr[j++] = '"';
1999: argptr[j++] = ',';
2000:
2001: if (j >= STRLEN) {
2002: merr_raise (M75);
2003: break;
2004: }
2005:
2006: }
2007: }
2008:
2009: ch = 0;
2010:
2011: if (argptr[j - 1] != ')') {
2012: while ((argptr[j++] = tmp2[ch++]) != EOL);
2013: argptr[j - 1] = ')';
2014: }
2015: }
2016:
2017: argptr[j] = EOL;
2018:
2019: if (j >= STRLEN) {
2020: merr_raise (M75);
2021: break;
2022: }
2023:
2024: }
2025: }
2026: else {
2027: break;
2028: }
2029: } /* set$qsubscript */
2030: else if (setpiece == 'e') { /* SETtable $EXTRACT *//* parameters ok?? */
2031:
2032: if (arg3 > arg4 || arg4 < 1) {
2033: setpiece = FALSE;
2034: break;
2035: }
2036:
2037: if (arg3 <= 0) arg3 = 1;
2038:
2039: if (arg3 > STRLEN) {
2040: merr_raise (M75);
2041: goto err;
2042: }
2043:
2044: /* get value of glvn */
2045: if (vn[0] == '^') {
2046: if (vn[1] == '$') {
2047: ssvn (get_sym, vn, tmp3);
2048: }
2049: else {
2050: global (get_sym, vn, tmp3);
2051: }
2052: }
2053: else {
2054: symtab (get_sym, vn, tmp3);
2055: }
2056:
2057:
2058: /* if UNDEF assume null string */
2059: if (merr () == UNDEF || merr () == M6 || merr () == M7) {
2060: tmp3[0] = EOL;
2061: merr_clear ();
2062: }
2063: else if (merr () != OK) {
2064: stcpy (varerr, vn);
2065: }
2066:
2067: j = stlen (tmp3);
2068:
2069: /* pad with SPaces if source string is too short */
2070: while (j < arg3) tmp3[j++] = SP;
2071:
2072: tmp3[j] = EOL;
2073:
2074: if (stlen (tmp3) > arg4) {
2075: stcpy (tmp2, &tmp3[arg4]);
2076: }
2077: else {
2078: tmp2[0] = EOL;
2079: }
2080:
2081: tmp3[arg3 - 1] = EOL;
2082:
2083: /* compose new value of glvn */
2084: if (stcat (tmp3, argptr) == 0) {
2085: merr_raise (M75);
2086: goto err;
2087: }
2088:
2089: if (stcat (tmp3, tmp2) == 0) {
2090: merr_raise (M75);
2091: goto err;
2092: }
2093:
2094: stcpy (argptr, tmp3);
2095: setpiece = FALSE;
2096: }
2097: else if (setpiece == 'g') { /* SETtable $GET */
2098: setpiece = FALSE;
2099: ch = (stcmp (tmp2, argptr) == 0) ? killone : set_sym;
2100:
2101: if (vn[0] == '^') {
2102: stcpy (an, argptr);
2103: if (vn[1] == '$') {
2104: ssvn (ch, vn, an);
2105: }
2106: else {
2107: global (ch, vn, an);
2108: }
2109: }
2110: else {
2111: stcpy (an, argptr);
2112: symtab (ch, vn, an);
2113: }
2114:
2115: if (merr () != OK) stcpy (varerr, vn);
2116: break;
2117: }
2118:
2119: if (vn[0] == '^') { /* global variables and SSVNs */
2120: stcpy (an, argptr);
2121:
2122: if (vn[1] == '$') {
2123: ssvn (set_sym, vn, an);
2124: }
2125: else {
2126: global (set_sym, vn, an);
2127: }
2128:
2129:
2130: if (merr () > OK) {
2131: stcpy (varerr, vn);
2132: goto err;
2133: }
2134: }
2135: else if (vn[0] != '$') { /* local variables */
2136: stcpy (an, argptr);
2137: symtab (set_sym, vn, an);
2138:
2139: if (merr () > OK) {
2140: stcpy (varerr, vn);
2141: goto err;
2142: }
2143: }
2144: else { /* $-variables */
2145:
2146: if (vn[1] == 'x') { /* set $X */
2147: j = intexpr (argptr);
2148:
2149: if (merr () == MXNUM) {
2150: j = 256;
2151: merr_clear ();
2152: }
2153:
2154: if (j < 0) {
2155: merr_raise (M43);
2156: goto err;
2157: }
2158:
2159: if (io == HOME) {
2160: argptr[0] = ESC;
2161: argptr[1] = '[';
2162: argptr[2] = EOL;
2163:
2164: if (ypos[HOME] > 1) {
2165: intstr (tmp3, ypos[HOME] + 1);
2166: stcat (argptr, tmp3);
2167: }
2168:
2169: if (j > 0) {
2170: stcat (argptr, ";\201");
2171: intstr (tmp3, j + 1);
2172: stcat (argptr, tmp3);
2173: }
2174:
2175: stcat (argptr, "H\201");
2176: write_m (argptr);
2177: }
2178:
2179: xpos[io] = j;
2180: goto s_end;
2181: }
2182: else if (vn[1] == 'y') { /* set $Y */
2183:
2184: j = intexpr (argptr);
2185:
2186: if (merr () == MXNUM) {
2187: j = 256;
2188: merr_clear ();
2189: }
2190:
2191: if (j < 0) {
2192: merr_raise (M43);
2193: goto err;
2194: }
2195:
2196: if (io == HOME) {
2197:
2198: argptr[0] = ESC;
2199: argptr[1] = '[';
2200: argptr[2] = EOL;
2201:
2202: if (j > 0) {
2203: intstr (tmp3, j + 1);
2204: stcat (argptr, tmp3);
2205: }
2206:
2207: if (xpos[HOME] > 0) {
2208: stcat (argptr, ";\201");
2209: intstr (tmp3, xpos[HOME] + 1);
2210: stcat (argptr, tmp3);
2211: }
2212:
2213: stcat (argptr, "H\201");
2214: write_m (argptr);
2215: }
2216:
2217: ypos[io] = j;
2218: goto s_end;
2219: }
2220: else if (vn[1] == 't') { /* set $t */
2221: test = tvexpr (argptr);
2222: goto s_end;
2223: }
2224: else if (vn[1] == 'j') { /* set $job */
2225: pid = intexpr (argptr);
2226: lock (" \201", -1, 's');
2227: goto s_end;
2228: }
2229: #if !defined(_SCO_DS)
2230: else if (vn[1] == 'h') { /* set $horolog */
2231: long int day;
2232: long int sec;
2233: struct timespec sh_ts;
2234:
2235: if (!is_horolog (argptr)) {
2236: merr_raise (ZINVHORO);
2237: goto err;
2238: }
2239:
2240: sec = 0L;
2241:
2242: for (i = 0; argptr[i] != EOL; i++) {
2243:
2244: if (argptr[i] == ',') {
2245: sec = intexpr (&argptr[i + 1]);
2246: break;
2247: }
2248:
2249: }
2250:
2251: if (sec < 0 || sec >= 86400L) {
2252: merr_raise (ARGER);
2253: goto err;
2254: }
2255:
2256: day = intexpr (argptr) - 47117L;
2257:
2258: if (day < 0 || day > 49710L) {
2259: merr_raise (ARGER);
2260: goto err;
2261: }
2262:
1.3 snw 2263: sec += day * 86400 + FreeM_timezone;
2264: day = FreeM_timezone;
1.1 snw 2265:
2266: sh_ts.tv_sec = sec;
2267:
2268: #if defined(__linux__)
2269: if (clock_settime (CLOCK_REALTIME, &sh_ts) != 0) {
2270: merr_raise (PROTECT);
2271: goto err;
2272: }
2273: #endif
2274:
2275: #ifndef LINUX
2276: /* daylight savings time status may have changed */
2277: {
2278: struct tm *ctdata;
2279: long clock;
2280:
2281: clock = time (0L);
2282: ctdata = localtime (&clock);
2283:
1.3 snw 2284: if (day -= (FreeM_timezone = ctdata->tm_tzadj)) {
1.1 snw 2285: sec -= day;
2286: tzoffset += day;
2287: stime (&sec);
2288: }
2289: }
2290: #endif /* LINUX */
2291: goto s_end;
2292:
2293:
2294: }
2295: #endif /* _SCO_DS */
2296: else if ((vn[1] == 'r') || ((vn[1] == 'z') && (vn[2] == 'r') && vn[3] == EOL)) { /* set $reference */
2297:
2298: if (argptr[0] == EOL) {
2299: zref[0] = EOL;
2300: break;
2301: }
2302:
2303: stcpy (tmp4, codptr);
2304: stcpy (code, argptr);
2305:
2306: codptr = code;
2307:
2308: expr (NAME);
2309: stcpy (code, tmp4);
2310:
2311: codptr = code;
2312:
2313: if (argptr[0] != '^') merr_raise (INVREF);
2314: if (ierr <= OK) nakoffs = stcpy (zref, argptr); /* save reference */ /* SMW - TODO */
2315:
2316: goto s_end;
2317: }
2318: else if (vn[1] == 'z') { /* $Z.. variables *//* if not intrinsic: make it user defined */
2319:
2320: i = stcpy (&tmp[1], &vn[1]) + 1;
2321:
2322: if (vn[3] == DELIM) i = 3; /* set $zf() function keys */
2323:
2324: tmp[0] = SP;
2325: tmp[i] = SP;
2326: tmp[++i] = EOL;
2327:
2328: if (find (zsvn, tmp) == FALSE) {
2329:
2330: i = 2;
2331: while (vn[i] != EOL) {
2332:
2333: if (vn[i++] == DELIM) {
2334: merr_raise (INVREF);
2335: goto err;
2336: }
2337:
2338: }
2339:
2340: udfsvn (set_sym, &vn[2], argptr);
2341: break;
2342: }
2343:
2344: if ((!stcmp (&vn[2], "l\201")) || (!stcmp (&vn[2], "local\201"))) { /* set $zlocal */
2345:
2346: if (argptr[0] == EOL) {
2347: zloc[0] = EOL;
2348: break;
2349: }
2350:
2351: stcpy (tmp4, codptr);
2352: stcpy (code, argptr);
2353:
2354: codptr = code;
2355:
2356: expr (NAME);
2357: stcpy (code, tmp4);
2358:
2359: codptr = code;
2360:
2361: if (argptr[0] == '^') merr_raise (INVREF);
2362: if (ierr <= OK) stcpy (zloc, argptr); /* save reference */
2363:
2364: break;
2365: }
2366: if ((!stcmp (&vn[2], "t\201")) || (!stcmp (&vn[2], "tr\201")) || (!stcmp (&vn[2], "trap\201"))) { /* set $ztrap */
2367:
2368: if (stlen (argptr) > ZTLEN) {
2369: merr_raise (M75);
2370: goto err;
2371: }
2372:
2373: /* DSM V.2 error trapping */
2374: #ifdef DEBUG_NEWSTACK
2375: printf ("Setting Ztrap, DSM2err [%d]\r\n", DSM2err);
2376: #endif
2377:
2378:
2379: if (DSM2err) {
2380: stcpy (ztrap[NESTLEVLS + 1], argptr);
2381: }
2382: else {
2383: stcpy (ztrap[nstx], argptr);
2384: }
2385:
2386: }
2387: else if (!stcmp (&vn[2], "p\201") || !stcmp (&vn[2], "precision\201")) { /* set $zprecision */
2388:
2389: short tmp_zprecise;
2390:
2391: if ((tmp_zprecise = intexpr (argptr)) < 0) {
2392: merr_raise (MXNUM);
2393: goto err;
2394: }
2395:
2396: if (!fp_mode) {
2397:
2398: if (merr () == MXNUM) goto err;
2399:
2400: if (tmp_zprecise > 20000) {
2401: merr_raise (MXNUM);
2402: goto err;
2403: }
2404:
2405: }
2406: #if !defined(_AIX)
2407: else {
2408:
2409: if (tmp_zprecise > DBL_DIG) {
2410: merr_raise (MXNUM);
2411: goto err;
2412: }
2413:
2414: sprintf (fp_conversion, "%%.%df\201", tmp_zprecise);
2415:
2416: }
2417: #endif
2418:
2419: zprecise = tmp_zprecise;
2420:
2421:
2422: }
2423: else if (vn[2] == 'f' && vn[3] == DELIM) { /* set $zf() function keys */
2424:
2425: i = intexpr (&vn[4]) - 1;
2426:
2427: if (i < 0 || i > 43) {
2428: merr_raise (FUNARG);
2429: goto err;
2430: }
2431:
2432: if (stlen (argptr) > FUNLEN) {
2433: merr_raise (M75);
2434: goto err;
2435: }
2436:
2437: stcpy (zfunkey[i], argptr);
2438:
2439: }
2440: else if (vn[2] == 'm' && vn[4] == EOL && (vn[3] == 'c' || vn[3] == 'n' || vn[3] == 'p' || vn[3] == 'l' || vn[3] == 'u')) { /* set $zm_ loadable match; sort match code */
2441:
2442: short k;
2443:
2444: i = 0;
2445:
2446: for (ch = 0; ch <= 255; ch++) {
2447: j = argptr - partition;
2448:
2449: while ((k = partition[j++]) != EOL) {
2450:
2451: if (UNSIGN (k) == ch) {
2452: tmp[i++] = k;
2453: break;
2454: }
2455:
2456: }
2457:
2458: }
2459:
2460: tmp[i] = EOL;
2461:
2462: switch (vn[3]) {
2463:
2464: case 'c':
2465: stcpy (zmc, tmp);
2466: break;
2467:
2468: case 'n':
2469: stcpy (zmn, tmp);
2470: break;
2471:
2472: case 'p':
2473: stcpy (zmp, tmp);
2474: break;
2475: /* 'a': always union of zml+zmu */
2476:
2477: case 'l':
2478: stcpy (zml, tmp);
2479: break;
2480:
2481: case 'u':
2482: stcpy (zmu, tmp);
2483: break;
2484: /* 'e': always 'everything' */
2485: }
2486:
2487: }
2488: else {
2489: merr_raise (INVREF);
2490: break;
2491: }
2492: }
2493: else {
2494: merr_raise (INVREF);
2495: goto err;
2496: } /* end of processing for $Z.. intrinsic special variables */
2497: } /* svns=$vars */
2498:
2499: if (multiset) goto multi;
2500: } /* end of scope for special SET syntaxes */
2501:
2502: s_end:
2503: if (*codptr != ',') break;
2504: if (*++codptr == '@') goto again;
2505:
2506: goto set0;
2507:
2508: case IF:
2509: merr_raise (cmd_if (&ra));
2510: MRESCHECK(ra);
2511: break;
2512:
2513:
2514: case OO_USING:
2515: merr_raise (cmd_using (&ra));
2516: MRESCHECK(ra);
2517: break;
2518:
2519: case OO_WITH:
2520: merr_raise (cmd_with (&ra));
2521: MRESCHECK(ra);
2522: break;
2523:
2524: case WRITE:
2525: merr_raise (cmd_write(&ra, &i));
2526: MRESCHECK(ra);
2527: break;
2528:
2529: case READ:
2530: merr_raise (cmd_read (&ra));
2531: MRESCHECK(ra);
2532: break;
2533:
2534: case ELSE:
2535: merr_raise (cmd_else (&ra));
2536: MRESCHECK(ra);
2537: break;
2538:
2539: case ZQUIT:
2540:
2541: {
2542: int zq_lvlct;
2543:
2544: if (rtn_dialect () != D_FREEM) {
2545: merr_raise (NOSTAND);
2546: goto err;
2547: }
2548:
2549: if (*codptr == EOL) {
2550: zq_lvlct = nstx;
2551: }
2552: else {
2553: expr (STRING);
2554:
2555: zq_lvlct = intexpr (argptr);
2556:
2557: if (merr () > OK) goto err;
2558:
2559: if (zq_lvlct < 0 || zq_lvlct > nstx) {
2560: merr_raise (LVLERR);
2561: goto err;
2562: }
2563: else if (zq_lvlct != nstx) {
2564: repQUIT = nstx - zq_lvlct;
2565: }
2566: else {
2567: merr_raise (LVLERR);
2568: goto err;
2569: }
2570: }
2571:
2572: break;
2573: }
2574:
2575: case QUIT:
2576:
1.17 snw 2577: if (trace_mode) {
2578: fprintf (stderr, ">> TRACE: $STACK = %d QUIT CMD = %c\r\n", nstx, nestc[nstx]);
2579: }
2580:
1.1 snw 2581: if (tp_level > 0) {
2582: merr_raise (M42);
2583: goto err;
2584: }
2585:
2586: #ifdef DEBUG_NEWSTACK
2587: printf ("At QUIT command, checking stack...\r\n");
2588: #endif
2589:
2590:
2591:
2592: #ifdef DEBUG_NEWSTACK
2593: printf ("nestc[nstx] is (%d)\r\n", nestc[nstx]);
2594: #endif
2595:
2596: if (*codptr != EOL && *codptr != SP && nestc[nstx] != '$') {
2597: #ifdef DEBUG_NEWSTACK
2598: printf ("IERR\r\n");
2599: #endif
2600:
2601: merr_raise (ARGER);
2602: break;
2603: }
2604:
2605:
2606:
2607: if (nestc[nstx] == '$') { /* extrinsic function/variable */
2608:
2609:
1.17 snw 2610: if (trace_mode) {
2611: fprintf (stderr, ">> TRACE: QUIT FROM EXTRINSIC\r\n");
2612: }
2613:
1.1 snw 2614: #ifdef DEBUG_NEWSTACK
2615: printf ("EXTRINSIC\r\n");
2616: #endif
2617: if (*codptr == EOL || *codptr == SP) {
2618:
2619: #ifdef DEBUG_NEWSTACK
2620: printf ("CODPTR is [%d]\r\n", *codptr);
2621: #endif
2622:
2623: if (exfdefault[0] == EOL) {
2624: *argptr = EOL;
2625: merr_raise (NOVAL);
2626: }
2627: else { /* there is a default expression... */
2628: stcpy (&code[1], exfdefault);
2629: expr (STRING);
2630:
2631: if (ierr != OK - CTRLB && merr () != OK && merr () != INRPT) {
2632:
2633: #ifdef DEBUG_NEWSTACK
2634: printf ("Break at 1st IERR\r\n");
2635: #endif
2636: break;
2637: }
2638: }
2639: }
2640: else {
2641:
2642: expr (STRING);
1.17 snw 2643:
2644: if (trace_mode) {
2645: fprintf (stderr, ">> TRACE: QUIT FROM SUBROUTINE\r\n");
2646: }
1.1 snw 2647:
2648: if (ierr != OK - CTRLB && merr () != OK && merr () != INRPT) {
2649:
2650: #ifdef DEBUG_NEWSTACK
2651: printf ("Break at 2nd IERR\r\n");
2652: #endif
2653:
2654: break;
2655: }
2656:
2657: if (dt_check (extr_types[nstx], argptr, 0) == FALSE) {
2658: extr_types[nstx] = DT_STRING;
2659: merr_raise (TYPMISMATCH);
2660: break;
2661: }
2662:
2663:
2664: }
2665:
2666: #ifdef DEBUG_NEWSTACK
2667: printf ("CHECK 01 (Stack POP)\r\n");
2668: #endif
2669:
2670:
2671:
2672: if (nestn[nstx]) { /* reload routine */
2673: namptr = nestn[nstx];
2674:
2675: stcpy (rou_name, namptr);
2676: zload (rou_name);
2677:
2678: ssvn_job_update ();
2679:
2680: dosave[0] = 0;
2681:
2682: namptr--;
2683: }
2684:
2685: if (nestnew[nstx]) unnew (); /* un-NEW variables */
2686:
2687: /* restore old pointers */
2688: level = nestlt[nstx]; /* pop level */
2689: roucur = nestr[nstx] + rouptr;
2690:
2691: extr_types[nstx] = DT_STRING;
2692:
2693: stcpy (codptr = code, cmdptr = nestp[nstx--]);
2694: estack--;
2695:
2696: forsw = (nestc[nstx] == FOR);
2697: loadsw = TRUE;
2698:
2699: return 0;
2700:
2701:
2702: }
2703:
2704:
2705: if (nestc[nstx] == BREAK) {
2706: merr_clear ();
2707: merr_set_break ();
2708: goto zgo;
2709: } /*cont. single step */
2710:
2711:
2712: quit0:
2713:
2714: #ifdef DEBUG_NEWSTACK
2715: printf ("CHECK 02 (Stack POP)\r\n");
2716: #endif
2717:
2718: if (evt_depth) {
2719:
2720: evt_depth--;
2721:
2722: if (evt_depth == 0 && evt_async_restore == TRUE) {
2723: evt_async_enabled = TRUE;
2724: evt_async_restore = FALSE;
2725: }
2726:
2727: }
2728:
2729: if (etrap_lvl) etrap_lvl--;
2730:
2731: if (nstx == 0) goto restore; /* nothing to quit */
2732:
2733: if (nestc[nstx] == FOR) {
2734:
2735: stcpy (code, cmdptr = nestp[nstx--]);
2736:
2737: estack--;
2738:
2739: codptr = code;
2740:
2741: ftyp = fortyp[--forx];
2742: fvar = forvar[forx];
2743: finc = forinc[forx];
2744: fpost = forpost[forx];
2745: flim = forlim[forx];
2746: fi = fori[forx];
2747:
2748: if ((forsw = (nestc[nstx] == FOR))) goto for_end;
2749:
2750: goto next_line;
2751: }
2752:
2753: if (nestn[nstx]) { /* reload routine */
2754: namptr = nestn[nstx];
2755:
2756: if ((nestc[nstx] != XECUTE) || loadsw) {
2757:
2758: stcpy (rou_name, namptr);
2759: zload (rou_name);
2760:
2761: ssvn_job_update ();
2762:
2763: dosave[0] = 0;
2764: }
2765:
2766: namptr--;
2767: }
2768:
2769: if (nestnew[nstx]) unnew (); /* un-NEW variables */
2770:
2771: /* restore old pointers */
2772: if ((mcmnd = nestc[nstx]) == BREAK) goto restore; /* cont. single step */
2773:
2774: if (mcmnd == DO_BLOCK) {
2775: test = nestlt[nstx];
2776: level--;
2777: }
2778: else { /* pop $TEST */
2779: level = nestlt[nstx]; /* pop level */
2780: }
2781:
2782: if (nstx) {
2783: roucur = nestr[nstx] + rouptr;
2784: }
2785: else {
2786: roucur = buff + (NO_OF_RBUF * PSIZE0 + 1);
2787: }
2788:
2789: stcpy (codptr = code, cmdptr = nestp[nstx--]);
2790: estack--;
2791: forsw = (nestc[nstx] == FOR);
2792:
2793: loadsw = TRUE;
2794:
2795: if (deferred_ierr > OK) { /* smw - TODO: how to handle deferred_ierr now */
2796: merr_raise (deferred_ierr);
2797: }
2798:
2799: #if defined(HAVE_MWAPI_MOTIF)
2800: if ((in_syn_event_loop == TRUE) && (nstx == syn_event_entry_nstx)) goto syn_evt_loop_bottom;
2801: #endif
2802:
2803: break;
2804:
2805: case FOR:
2806:
2807: if ((ch = *codptr) == EOL) goto skip_line; /* ignore empty line */
2808:
2809: #ifdef DEBUG_NEWSTACK
2810: printf ("CHECK 03 (Stack PUSH)\r\n");
2811: #endif
2812:
2813: if (++nstx > NESTLEVLS) {
2814: nstx--;
2815: merr_raise (STKOV);
2816:
2817: break;
2818: }
2819: else {
2820: estack++;
2821: }
2822:
2823: fvar = forvar[++forx];
2824: finc = forinc[forx];
2825: fpost = forpost[forx];
2826: flim = forlim[forx];
2827: fi = fori[forx];
2828: nestc[nstx] = FOR; /* stack set-up */
2829:
2830: #ifdef DEBUG_NEWSTACK
2831: if (!cmdptr) printf ("CMDPTR is ZERO!\r\n");
2832: #endif
2833:
2834: nestp[nstx] = cmdptr;
2835: nestn[nstx] = 0; /* no overring of routine */
2836: nestr[nstx] = roucur - rouptr; /* save roucur: only for $V(26) needed */
2837: ztrap[nstx][0] = EOL;
1.19 snw 2838:
1.1 snw 2839:
2840: forsw = TRUE;
2841: ftyp = 0; /* no args is FOREVER */
2842:
2843: if (ch == SP) {
2844: goto for_go;
2845: }
2846: else { /* find local variable */
2847:
2848: if (ch == '^') {
2849: merr_raise (GLOBER);
2850: break;
2851: }
2852:
2853: if (ch == '$') {
2854: merr_raise (INVREF);
2855: break;
2856: }
2857:
2858: if (*(codptr + 1) == '=') { /* single char local variable */
2859:
2860: if ((ch < 'A' && ch != '%') || (ch > 'Z' && ch < 'a') || ch > 'z') {
2861: merr_raise (INVREF);
2862: break;
2863: }
2864:
2865: fvar[0] = ch;
2866: fvar[1] = EOL;
2867:
2868: codptr += 2;
2869: }
2870: else {
2871: expr (NAME);
2872:
2873: if (*++codptr != '=') merr_raise (ASSIGNER);
2874: if (merr () != OK) break;
2875:
2876: stcpy (fvar, varnam);
2877:
2878: codptr++;
2879: }
2880:
2881: ftyp++;
2882: }
2883:
2884: for_nxt_arg:
2885:
2886: expr (STRING);
2887:
2888: if (merr () != OK) break;
2889:
2890: stcpy (tmp, argptr);
2891:
2892: if ((ch = *codptr) != ':') {
2893:
2894: if (ch == ',' || ch == SP || ch == EOL) {
2895: ftyp = 1;
2896: goto for_init;
2897: }
2898:
2899: merr_raise (ARGLIST);
2900: break;
2901: }
2902:
2903: numlit (tmp); /* numeric interpretation */
2904:
2905: codptr++;
2906: expr (STRING);
2907:
2908: if (merr () != OK) break;
2909:
2910: numlit (argptr);
2911: stcpy (finc, argptr); /* increment */
2912:
2913: if ((ch = *codptr) != ':') {
2914:
2915: if (ch == ',' || ch == EOL || ch == SP) {
2916: ftyp = 2;
2917: goto for_init;
2918: }
2919:
2920: merr_raise (ARGLIST);
2921: break;
2922:
2923: }
2924:
2925: codptr++;
2926:
2927: expr (STRING);
2928: if (merr () != OK) break;
2929:
2930: numlit (argptr);
2931: stcpy (flim, argptr); /* limit */
2932:
2933: ftyp = 3;
2934:
2935: if ((ch = *codptr) != ',' && ch != SP && ch != EOL) {
2936: merr_raise (ARGLIST);
2937: break;
2938: }
2939:
2940: if ((*finc != '-' && comp (flim, tmp)) || (*finc == '-' && comp (tmp, flim))) {
2941:
2942: symtab (set_sym, fvar, tmp);
2943:
2944: if (merr () > OK) {
2945: stcpy (varerr, vn);
2946: break;
2947: }
2948:
2949: goto for_quit;
2950: }
2951:
2952: for_init:
2953:
2954: symtab (set_sym, fvar, tmp);
2955:
2956: if (merr () > OK) {
2957: stcpy (varerr, fvar);
2958: break;
2959: }
2960:
2961: /* optimize frequent special case: */
2962: /* increment by one and no additional FOR arguments */
2963: /* if limit value it must be a positive integer */
2964: if (ftyp > 1 && finc[0] == '1' && finc[1] == EOL) {
2965: j = TRUE;
2966:
2967: if (ftyp == 3) {
2968: i = 0;
2969:
2970: while ((ch = flim[i]) != EOL) {
2971:
2972: if (ch < '0' || ch > '9') j = FALSE;
2973:
2974: i++;
2975: }
2976:
2977: fi = i;
2978: fori[forx] = i;
2979: }
2980:
2981: if (j && ((ch = *codptr) == SP || ch == EOL)) {
2982: ftyp += 2;
2983: if (ch == SP) codptr++;
2984: }
2985: }
2986:
2987: for_go:
2988:
2989: fortyp[forx] = ftyp;
2990:
2991:
2992: #ifdef DEBUG_NEWSTACK
2993: if (!cmdptr) printf ("CMDPTR is ZERO!\r\n");
2994: #endif
2995:
2996: nestp[nstx] = cmdptr;
2997:
2998: cmdptr += stcpy (cmdptr, codptr) + 1;
2999:
3000: if (ftyp > 3) goto next_cmnd;
3001:
3002: /* skip following for arguments if there are any */
3003:
3004: for10:
3005:
3006: if (*codptr == SP) goto next_cmnd;
3007:
3008: i = 0;
3009:
3010: while ((((ch = *codptr) != SP) || i) && ch != EOL) {
3011: if (ch == '"') i = !i;
3012:
3013: codptr++;
3014: } /* skip rest of FOR list */
3015:
3016: goto next_cmnd;
3017:
3018: for_end: /* end of line return */
3019:
3020: #ifdef DEBUG_NEWSTACK
3021: printf ("For_end: nstx: %d, Nestp: (%d)\r\n", nstx, nestp[nstx]);
3022: #endif
3023:
3024: stcpy (codptr = code, nestp[nstx]); /* restore old pointers */
3025:
3026:
3027:
3028: switch (ftyp) {
3029:
3030: case 5: /* frequent special case: increment 1 */
3031: symtab (getinc, fvar, tmp);
3032:
3033: /* compare fvar-value to flim-value */
3034: /* fi: i=0; while (flim[i]>='0') i++; */
3035: /* Note: EOL<'-'<'.'<'0' tmp has at least one character */
3036: ch = '0';
3037: j = 1;
3038:
3039: while (tmp[j] >= ch) j++;
3040:
3041: if (j < fi) goto next_cmnd;
3042:
3043: if (j == fi) {
3044: j = 0;
3045:
3046: while (tmp[j] == flim[j]) {
3047: if (tmp[j] == EOL) goto next_cmnd;
3048: j++;
3049: }
3050:
3051: if (tmp[j] <= flim[j]) goto next_cmnd;
3052: }
3053:
3054: if (flim[0] != '-' && tmp[0] == '-') goto next_cmnd;
3055:
3056: stcpy (tmp2, "-1\201"); /* correct last inc */
3057: add (tmp, tmp2);
3058: symtab (set_sym, fvar, tmp);
3059:
3060: goto for_quit;
3061:
3062: case 4: /* frequent special case: increment 1 without limit */
3063: symtab (getinc, fvar, tmp);
3064:
3065:
3066: case 0: /* argumentless FOR */
3067:
3068: if(argless_forsw_quit == TRUE) {
3069: /* if we have a positive QUIT condition, bail from the FOR loop */
3070: argless_forsw_quit = FALSE;
3071: goto for_quit;
3072: }
3073: else {
3074:
3075: /* otherwise, just keep on truckin' */
3076: goto next_cmnd;
3077: }
3078:
3079: case 3: /* FOR with increment and limit test */
3080: symtab (get_sym, fvar, tmp);
3081: numlit (tmp);
3082: stcpy (tmp2, finc); /* add may change forinc */
3083: add (tmp, tmp2);
3084:
3085: if (*finc != '-') {
3086: if (comp (flim, tmp)) goto for_quit;
3087: }
3088: else {
3089: if (comp (tmp, flim)) goto for_quit;
3090: }
3091:
3092: symtab (set_sym, fvar, tmp);
3093:
3094: goto for10;
3095:
3096: case 2: /* FOR with increment without limit test */
3097: symtab (get_sym, fvar, tmp);
3098: numlit (tmp);
3099: stcpy (tmp2, finc); /* add may change forinc */
3100: add (tmp, tmp2);
3101:
3102: symtab (set_sym, fvar, tmp);
3103: goto for10;
3104: } /* end switch */
3105:
3106: for_quit:
3107:
3108: cmdptr = nestp[nstx];
3109:
3110:
3111: if (*codptr++ == ',') goto for_nxt_arg;
3112:
3113: forpost[forx][0] = '\0';
3114:
3115: nstx--;
3116: estack--;
3117:
3118: forx--;
3119: ftyp = fortyp[forx];
3120: fvar = forvar[forx];
3121: finc = forinc[forx];
3122: flim = forlim[forx];
3123: fi = fori[forx];
3124:
3125:
3126: if ((forsw = (nestc[nstx] == FOR))) goto for_end;
3127:
3128: if (sigint_in_for) {
3129: merr_raise (INRPT);
3130: sigint_in_for = FALSE;
3131: }
3132:
3133: if (merr () > OK) goto err;
3134: goto next_line;
3135:
3136: case MERGE:
3137:
3138: {
3139: char lhs[256];
3140: char rhs[256];
3141:
3142: char k_buf[STRLEN];
3143:
3144: if ((rtn_dialect () != D_M95) &&
3145: (rtn_dialect () != D_MDS) &&
3146: (rtn_dialect () != D_M5) &&
3147: (rtn_dialect () != D_FREEM)) {
3148: merr_raise (NOSTAND);
3149: goto err;
3150: }
3151:
3152: expr (NAME);
3153: if (merr () > OK) break;
3154:
3155: key_to_name (lhs, varnam, 255);
3156: stcnv_c2m (lhs);
3157:
3158: if (*++codptr != '=') {
3159: merr_raise (ASSIGNER);
3160: break;
3161: }
3162:
3163: codptr++;
3164:
3165: expr (NAME);
3166: if (merr () > OK) break;
3167:
3168: codptr++;
3169:
3170: key_to_name (rhs, varnam, 255);
3171: stcnv_c2m (rhs);
3172:
3173: stcpy (k_buf, "%INTMERGELHS\201\201");
3174: symtab (set_sym, k_buf, lhs);
3175:
3176: stcpy (k_buf, "%INTMERGERHS\201\201");
3177: symtab (set_sym, k_buf, rhs);
3178:
3179: stcpy (&tmp3[1], "SYSWMERGE \201");
3180: goto private;
3181:
3182: break;
3183:
3184: }
3185:
3186:
3187: case RLOAD:
3188: if ((rtn_dialect () != D_MDS) &&
3189: (rtn_dialect () != D_FREEM)) {
3190: merr_raise (NOSTAND);
3191: goto err;
3192: }
3193: stcpy (&tmp3[1], "zrload \201");
3194: goto private;
3195:
3196:
3197: case RSAVE:
3198: if ((rtn_dialect () != D_MDS) &&
3199: (rtn_dialect () != D_FREEM)) {
3200: merr_raise (NOSTAND);
3201: goto err;
3202: }
3203:
3204: stcpy (&tmp3[1], "zrsave \201");
3205: goto private;
3206:
3207:
3208: case XECUTE:
3209:
3210:
3211: do_xecute:
3212: expr (STRING);
3213:
3214: if (merr () > OK) break;
3215:
3216: stcpy (tmp, argptr);
3217:
3218: if (*codptr == ':') { /* argument postcond */
3219: codptr++;
3220: expr (STRING);
3221:
3222: if (merr () > OK) break;
3223: if (tvexpr (argptr) == FALSE) break;
3224: }
3225:
3226: if (++nstx > NESTLEVLS) {
3227: nstx--;
3228: merr_raise (STKOV);
3229:
3230: break;
3231: }
3232: else {
3233: estack++;
3234: }
3235:
3236:
3237: #ifdef DEBUG_NEWSTACK
3238: if (!cmdptr) printf ("CMDPTR is ZERO!\r\n");
3239: #endif
3240:
3241: nestc[nstx] = XECUTE;
3242: nestp[nstx] = cmdptr; /* command stack address */
3243: nestr[nstx] = roucur - rouptr; /* save roucur */
3244: nestlt[nstx] = level;
3245:
3246: level = 0; /* save level */
3247: nestnew[nstx] = 0;
3248: ztrap[nstx][0] = EOL;
3249:
3250: while ((*(namptr++)) != EOL);
3251:
3252: stcpy ((nestn[nstx] = namptr), rou_name); /* save routine name */
3253:
3254: forsw = FALSE;
3255: loadsw = FALSE;
3256: cmdptr += stcpy (cmdptr, codptr) + 1;
3257:
3258: stcpy (code, tmp);
3259:
3260: roucur = buff + (NO_OF_RBUF * PSIZE0 + 1);
3261: codptr = code;
3262:
3263: goto next_cmnd;
3264:
3265:
3266: case DO:
3267:
3268: if (evt_async_initial == TRUE) {
3269: evt_async_initial = FALSE;
3270: }
3271: else {
3272: evt_depth++;
3273: }
3274:
3275: rouoldc = roucur - rouptr;
3276: namold = 0;
3277:
3278: case GOTO:
3279:
3280: do_goto:
3281:
1.17 snw 3282: if (trace_mode) {
3283: char rn[256];
3284: stcpy (rn, rou_name);
3285: stcnv_m2c (rn);
3286:
3287: switch (mcmnd) {
3288: case DO:
3289: snprintf (tracestr, sizeof (tracestr) - 1, "rtn = %s $stack = %d do ", rn, nstx);
3290: break;
3291: case GOTO:
3292: snprintf (tracestr, sizeof (tracestr) - 1, "rtn = %s $stack = %d goto ", rn, nstx);
3293: break;
3294: }
3295: }
3296:
1.1 snw 3297: offset = 0;
3298: label[0] = routine[0] = EOL;
3299: dofram0 = 0;
3300:
3301: if (((ch = *codptr) != '+') && (ch != '^')) { /* parse label */
3302:
3303: if (ch == SP || ch == EOL) { /* no args: blockstructured DO */
3304:
3305: if (mcmnd != DO) {
3306: merr_raise (ARGLIST);
3307: break;
3308: }
3309:
3310: /* direct mode: DO +1 */
3311:
3312:
3313: if (nstx == 0 && roucur >= rouend) {
3314: roucu0 = rouptr;
3315: goto off1;
3316: }
3317:
3318: mcmnd = DO_BLOCK;
3319: roucu0 = roucur; /* continue with next line */
3320: forsw = FALSE;
3321:
3322: goto off2;
3323: }
3324:
3325: expr (LABEL);
3326:
3327: if (merr () > OK) goto err;
3328:
3329: stcpy (label, varnam);
3330:
1.17 snw 3331: if (trace_mode) {
3332: char ttt[256];
3333: stcpy (ttt, label);
3334: stcnv_m2c (ttt);
3335:
3336: strcat (tracestr, ttt);
3337: }
3338:
1.1 snw 3339: ch = *++codptr;
3340: }
3341:
3342: if (ch == '+') { /* parse offset */
3343:
3344: codptr++;
3345: expr (OFFSET);
3346:
3347: if (merr () > OK) goto err;
3348:
3349: offset = intexpr (argptr);
3350: dosave[0] = EOL;
3351:
3352: /* unless argument is numeric, expr returns wrong codptr */
3353: if ((ch = *codptr) != SP && (ch != EOL) && (ch != ',') && (ch != '^')) ch = *++codptr;
1.17 snw 3354:
3355: if (trace_mode) {
3356: char ttt[256];
3357: snprintf (ttt, 255, "+%d", offset);
3358: strcat (tracestr, ttt);
3359: }
1.1 snw 3360: }
3361:
3362: if (ch == '^') { /* parse routine */
3363: codptr++;
3364: expr (LABEL);
3365:
3366: if (merr () > OK) goto err;
3367:
3368: stcpy (routine, varnam);
1.17 snw 3369:
3370: if (trace_mode) {
3371: char ttt[256];
3372: char ttx[256];
3373:
3374: stcpy (ttt, routine);
3375: stcnv_m2c (ttt);
3376: snprintf (ttx, 255, "^%s", ttt);
3377: strcat (tracestr, ttx);
3378: }
1.1 snw 3379:
3380: dosave[0] = EOL;
3381: ch = *++codptr;
3382: loadsw = TRUE;
3383: }
3384:
1.17 snw 3385: if (trace_mode) {
3386: fprintf (stderr, ">> TRACE: %s\r\n", tracestr);
3387: }
3388:
1.1 snw 3389: if (ch == '(' && mcmnd == DO) { /* parse parameter */
3390:
3391: if (offset) {
3392: merr_raise (ARGLIST);
3393: goto err;
3394: }
3395:
3396: if (*++codptr == ')') {
3397: ch = *++codptr;
3398: }
3399: else {
3400: dofram0 = dofrmptr;
3401: i = 0;
3402:
3403: for (;;) {
3404: setpiece = TRUE; /* to avoid error on closing bracket */
3405:
3406: if (*codptr == '.' && (*(codptr + 1) < '0' || *(codptr + 1) > '9')) {
3407: codptr++;
3408:
3409: expr (NAME);
3410: codptr++;
3411:
3412: *dofrmptr++ = DELIM; /* to indicate call by name */
3413: dofrmptr += stcpy (dofrmptr, varnam) + 1;
3414: }
3415: else {
3416: expr (STRING);
3417: dofrmptr += stcpy (dofrmptr, argptr) + 1;
3418: }
3419:
3420: setpiece = FALSE;
3421: i++;
3422:
3423: if (merr () > OK) {
3424: dofrmptr = dofram0;
3425: goto err;
3426: }
3427:
3428: ch = *codptr++;
3429: if (ch == ',') continue;
3430:
3431: if (ch != ')') {
3432: merr_raise (COMMAER);
3433: dofrmptr = dofram0;
3434:
3435: goto err;
3436: }
3437:
3438: ch = *codptr;
3439: break;
3440: }
3441: }
3442: }
3443:
3444: if (ch == ':') { /* parse postcond */
3445:
3446: codptr++;
3447: expr (STRING);
3448:
3449: if (merr () > OK) {
3450: if (dofram0) dofrmptr = dofram0; /* reset frame pointer */
3451: goto err;
3452: }
3453:
3454: if (tvexpr (argptr) == FALSE) {
3455: if (*codptr != ',') mcmnd = 0; /* avoid false LEVEL Error */
3456: if (dofram0) dofrmptr = dofram0; /* reset frame pointer */
3457:
3458: break;
3459: }
3460: }
3461:
3462: if (mcmnd == GOTO) { /* GOTO: clear FORs from stack */
3463:
3464: #ifdef DEBUG_NEWSTACK
3465: printf ("CHECK 05 Multi-POP on FOR\r\n");
3466: #endif
3467:
3468:
3469:
3470: while (nestc[nstx] == FOR) {
3471:
3472: #ifdef DEBUG_NEWSTACK
3473: printf ("POP");
3474: #endif
3475:
3476: cmdptr = nestp[nstx--];
3477: estack--;
3478:
3479: forx--;
3480: ftyp = fortyp[forx];
3481: fvar = forvar[forx];
3482: finc = forinc[forx];
3483: flim = forlim[forx];
3484: fi = fori[forx];
3485: }
3486:
3487: #ifdef DEBUG_NEWSTACK
3488: printf ("\r\n");
3489: #endif
3490:
3491:
3492: loadsw = TRUE;
3493: }
3494:
3495: job_entry: /* entry called from successful JOB */
3496:
3497: if (routine[0] != EOL) {
3498:
3499: #ifdef DEBUG_NEWSTACK
3500: printf ("CHECK 06\r\n");
3501: #endif
3502:
3503: if (mcmnd == DO) {
3504:
3505: while ((*(namptr++)) != EOL);
3506:
3507: namold = namptr;
3508: stcpy (namptr, rou_name);
3509:
3510: ssvn_job_update ();
3511:
3512: }
3513:
3514: /* if (GOTO label^rou) under a (DO label) */
3515: /* save away old routine to restore on quit */
3516:
3517:
3518:
3519: else if (nstx > 0) {
3520:
3521: #ifdef DEBUG_NEWSTACK
3522: printf ("CHECK 06, stack is greater than 0\r\n");
3523: #endif
3524:
3525: while (nestc[nstx] == FOR) {
3526: #ifdef DEBUG_NEWSTACK
3527: printf ("POP");
3528: #endif
3529:
3530: nstx--;
3531: estack--;
3532: forx--;
3533: ftyp = fortyp[forx];
3534: fvar = forvar[forx];
3535: finc = forinc[forx];
3536: flim = forlim[forx];
3537: fi = fori[forx];
3538: }
3539:
3540: if (nestn[nstx] == 0) {
3541: while ((*(namptr++)) != EOL);
3542:
3543: stcpy ((nestn[nstx] = namptr), rou_name);
3544: }
3545: }
3546:
3547: zload (routine);
3548: if (merr () > OK) goto err; /* load file */
3549:
3550: ssvn_job_update ();
3551:
3552: } /* if (routine[0] != EOL) */
3553: {
3554: char *reg, *reg1;
3555:
3556: reg1 = rouptr;
3557: reg = reg1;
3558:
3559: if (label[0] != EOL) {
3560:
3561: if (forsw && mcmnd == DO && stcmp (label, dosave) == 0) {
3562: roucu0 = xdosave;
3563: goto off1;
3564: }
3565:
3566: while (reg < rouend) {
3567: reg++;
3568: j = 0;
3569:
3570: while (*reg == label[j]) {
3571: reg++;
3572: j++;
3573: }
3574:
3575: if (label[j] == EOL) {
3576:
3577: if (*reg == TAB || *reg == SP) goto off;
3578:
3579: /* call of procedure without specifying a parameter list */
3580: if (*reg == '(') {
3581: if (dofram0 == 0) dofram0 = dofrmptr;
3582: goto off;
3583: }
3584:
3585: }
3586:
3587: reg = (reg1 = reg1 + UNSIGN (*reg1) + 2);
3588: }
3589: {
3590: merr_raise (M13);
3591: stcpy (varerr, label); /* to be included in error message */
3592:
3593: if (dofram0) dofrmptr = dofram0; /* reset frame pointer */
3594:
3595: zload (rou_name);
3596: ssvn_job_update ();
3597: goto err;
3598: }
3599: }
3600: off:
3601: if (label[0] == EOL && offset > 0) offset--;
3602: while (offset-- > 0) reg1 = reg1 + (UNSIGN (*reg1) + 2);
3603:
3604: if (forsw) {
3605: xdosave = reg1;
3606: stcpy (dosave, label);
3607: }
3608:
3609: roucu0 = reg1;
3610: }
3611:
3612: if (roucu0 >= rouend) {
3613: merr_raise (M13);
3614: stcpy (varerr, label); /* to be included in error message */
3615:
3616: if (dofram0) dofrmptr = dofram0; /* reset frame pointer */
3617:
3618: zload (rou_name);
3619: ssvn_job_update ();
3620: goto err;
3621: }
3622:
3623: off1:
3624: if (routine[0] != EOL) stcpy (rou_name, routine);
3625:
3626: ssvn_job_update ();
3627:
3628: roucu0++;
3629: forsw = FALSE;
3630:
3631: if (mcmnd != DO) { /* i.e. GOTO or JOB */
3632: roucur = roucu0;
3633: goto off3;
3634: }
3635:
3636: off2:
3637:
3638: #ifdef DEBUG_NEWSTACK
3639: printf ("CHECK 07 (Stack PUSH)\r\n");
3640: #endif
3641:
3642:
3643:
3644: if (++nstx > NESTLEVLS) {
3645: nstx--;
3646: merr_raise (STKOV);
3647:
3648: goto err;
3649: }
3650: else {
3651: on_frame_entry ();
3652: estack++;
3653: }
3654:
3655: nestc[nstx] = mcmnd;
3656:
3657: #ifdef DEBUG_NEWSTACK
3658: if (!cmdptr) printf ("CMDPTR is ZERO!\r\n");
3659: #endif
3660:
3661: nestp[nstx] = cmdptr;
3662: nestn[nstx] = namold;
3663: nestr[nstx] = rouoldc;
3664: nestnew[nstx] = 0;
3665:
3666: if (mcmnd != DO_BLOCK) {
3667: nestlt[nstx] = level;
3668: level = 0;
3669: }
3670: else { /* push level ; clr level */
3671: nestlt[nstx] = test;
3672: level++;
3673: } /* push $TEST ; inc level */
3674:
3675: ztrap[nstx][0] = EOL;
3676:
3677:
3678: cmdptr += stcpy (cmdptr, codptr) + 1;
3679: roucur = roucu0;
3680:
3681: /* processing for private Z-Command: */
3682: if (privflag) {
3683:
3684:
3685:
3686: #ifdef DEBUG_NEWPTR
3687: printf ("Xecline 01 (using NEWPTR): ");
3688: printf ("[nstx] is [%d], [nestnew] is [%d]", nstx, nestnew[nstx]);
3689: printf ("- Initialized to newptr\r\n");
3690: #endif /* Debug */
3691:
3692: nestnew[nstx] = newptr;
3693:
3694:
3695: stcpy (vn, zargdefname);
3696:
3697: /*was: vn[0] = '%'; vn[1] = EOL; */
3698:
3699: symtab (new_sym, vn, "");
3700: /*djw change 'input variable for Z command' to get value of $V(202) */
3701: /*was: vn[0] = '%'; vn[1] = EOL; */
3702:
3703: stcpy (vn, zargdefname);
3704: symtab (set_sym, vn, tmp2);
3705:
3706: privflag = FALSE;
3707: }
3708:
3709: off3:
3710:
3711: if (dofram0) {
3712: char *reg, *reg1;
3713:
3714: reg = roucu0;
3715: reg1 = dofram0;
3716:
3717: while ((ch = (*reg++)) != '(') {
3718: if (ch == SP || ch == TAB || ch == EOL) break;
3719: }
3720:
3721: if (ch != '(') {
3722: merr_raise (TOOPARA);
3723: dofrmptr = dofram0;
3724:
3725: goto err;
3726: }
3727:
3728: j = 0;
3729:
3730: while ((ch = (*reg++)) != EOL) {
3731:
3732: if ((ch == ',' && j) || ch == ')') {
3733: varnam[j] = EOL;
3734:
3735:
3736:
3737: #ifdef DEBUG_NEWPTR
3738: printf ("Xecline 02: ");
3739: printf ("[nstx] is [%d], [nestnew] is [%d]\r\n", nstx, nestnew[nstx]);
3740: #endif
3741:
3742: if (nestnew[nstx] == 0) nestnew[nstx] = newptr;
3743:
3744:
3745:
3746: if (reg1 < dofrmptr) {
3747:
3748: if (*reg1 == DELIM) { /* call by reference */
3749:
3750: if (stcmp (reg1 + 1, varnam)) { /* are they different?? */
3751: symtab (new_sym, varnam, "");
3752: symtab (m_alias, varnam, reg1 + 1);
3753: }
3754:
3755: }
3756: else {
3757: symtab (new_sym, varnam, ""); /* call by value */
3758: symtab (set_sym, varnam, reg1);
3759: }
3760:
3761: reg1 += stlen (reg1) + 1;
3762: }
3763: else {
3764: symtab (new_sym, varnam, "");
3765: }
3766:
3767: if (ch == ')') break;
3768:
3769: j = 0;
3770: continue;
3771: }
3772:
3773: if ((ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9' && j) || (ch == '%' && j == 0)) {
3774: varnam[j++] = ch;
3775: continue;
3776: }
3777:
3778: merr_raise (ARGLIST);
3779: dofrmptr = dofram0; /* reset frame pointer */
3780:
3781: goto err;
3782: }
3783:
3784: if (reg1 < dofrmptr) {
3785: merr_raise (TOOPARA);
3786: dofrmptr = dofram0;
3787:
3788: goto err;
3789: }
3790:
3791: dofrmptr = dofram0;
3792: }
3793:
3794: goto next_line;
3795:
3796: /* ZJOB *//* same as JOB, but without timeout */
3797: /* not recommended; just for backward compatibility */
3798: case ZJOB:
3799: if (is_standard ()) {
3800: merr_raise (NOSTAND);
3801: goto err;
3802: }
3803:
3804: case JOB:
3805:
3806: if (rtn_dialect () == D_M77) {
3807: merr_raise (NOSTAND);
3808: goto err;
3809: }
3810:
3811: if (*codptr == SP || *codptr == EOL) {
3812: merr_raise (M13);
3813: varerr[0] = EOL; /* to be included in error message */
3814:
3815: break;
3816: }
3817:
3818: loadsw = TRUE;
3819: offset = 0;
3820: frm_timeout = (-1L);
3821: label[0] = routine[0] = EOL;
3822:
3823: if (((ch = *codptr) != '+') && (ch != '^')) { /* parse label */
3824: expr (LABEL);
3825: if (merr () > OK) goto err;
3826:
3827: stcpy (label, varnam);
3828:
3829: ch = *++codptr;
3830: }
3831:
3832: if (ch == '+') { /* parse offset */
3833: codptr++;
3834:
3835: expr (OFFSET);
3836: if (merr () > OK) goto err;
3837:
3838: offset = intexpr (argptr);
3839:
3840: /* unless argument is numeric, expr returns wrong codptr */
3841: if ((ch = *codptr) != SP && (ch != EOL) && (ch != ',') && (ch != '^')) ch = *++codptr;
3842:
3843: }
3844:
3845: if (ch == '^') { /* parse routine */
3846: codptr++;
3847:
3848: expr (LABEL);
3849: if (merr () > OK) goto err;
3850:
3851: stcpy (routine, varnam);
3852:
3853: dosave[0] = EOL;
3854: ch = *++codptr;
3855: }
3856:
3857: dofram0 = NULL;
3858: if (ch == '(') { /* parse parameter */
3859:
3860: if (offset) {
3861: merr_raise (ARGLIST);
3862: goto err;
3863: }
3864:
3865: codptr++;
3866: dofram0 = dofrmptr;
3867:
3868: i = 0;
3869: for (;;) {
3870: setpiece = TRUE; /* to avoid error on closing bracket */
3871:
3872: if (*codptr == '.' && (*(codptr + 1) < '0' || *(codptr + 1) > '9')) {
3873: codptr++;
3874:
3875: expr (NAME);
3876:
3877: codptr++;
3878:
3879: *dofrmptr++ = DELIM; /* to indicate call by name */
3880: dofrmptr += stcpy (dofrmptr, varnam) + 1;
3881: }
3882: else {
3883: expr (STRING);
3884: dofrmptr += stcpy (dofrmptr, argptr) + 1;
3885: }
3886:
3887: setpiece = FALSE;
3888: i++;
3889:
3890: if (merr () > OK) {
3891: dofrmptr = dofram0;
3892: goto err;
3893: }
3894:
3895: ch = *codptr++;
3896: if (ch == ',') continue;
3897:
3898: if (ch != ')') {
3899: merr_raise (COMMAER);
3900: dofrmptr = dofram0;
3901:
3902: goto err;
3903: }
3904:
3905: ch = *codptr;
3906: break;
3907: }
3908: }
3909:
3910: if (ch == ':' && *(codptr + 1) == ch) {
3911: codptr++; /* timeout,no jobparams */
3912: }
3913: else if (ch == ':' && *(codptr + 1) == '(') { /* parse any 'job parameters', but ignore them otherwise */
3914: codptr++;
3915: setpiece = TRUE; /* to avoid bracket error at end of jobparameters */
3916:
3917: for (;;) {
3918: if (*++codptr != ':') expr (STRING);
3919: if (*codptr == ':') continue;
3920: if (*codptr++ != ')') merr_raise (ARGER);
3921:
3922: break;
3923: }
3924:
3925: setpiece = FALSE;
3926: ch = (*codptr);
3927: }
3928:
3929: if (ch == ':') { /* timeout */
3930: codptr++;
3931: expr (STRING);
3932:
3933: if ((frm_timeout = intexpr (argptr)) < 0L) frm_timeout = 0L;
3934: if (merr () > OK) goto err;
3935:
3936: test = TRUE;
3937: }
3938:
3939: if (mcmnd == ZJOB) frm_timeout = 0L; /* ZJOB-command has timeout 0 */
3940:
3941: close_all_globals (); /* close all globals */
3942: j = getpid (); /* job number of father process */
3943:
3944: if (lonelyflag) { /* single user */
3945: if (frm_timeout < 0L) {
3946: merr_raise (PROTECT); /* error without timeout */
3947: }
3948: else {
3949: test = FALSE; /* timeout always fails */
3950: }
3951:
3952: break;
3953: }
3954:
3955: while ((i = fork ()) == -1) {
3956:
3957: if (frm_timeout == 0L) {
3958: test = FALSE;
3959: break;
3960: }
3961:
3962: if (frm_timeout > 0L) frm_timeout--;
3963:
3964: sleep (1);
3965:
3966: }
3967:
3968: if (mcmnd == ZJOB && zjobflag) {
3969:
3970: if (i == 0) { /* we are in child process */
3971: intstr (zb, j); /* $JOB of father job */
3972:
3973: father = j;
3974: pid = getpid (); /* this is our new job number */
3975:
3976: jobtime = time (0L);;
3977:
3978:
3979: nstx = 0; /* clear stack */
3980: estack = 0;
3981:
3982: forx = 0;
3983: forsw = FALSE;
3984: level = 0;
3985: cmdptr = cmdstack; /* - command stack pointer */
3986: namptr = namstck; /* - routine name stack pointer */
3987: usermode = 0; /* application mode */
3988: merr_clear ();
3989:
3990: lock (" \201", -1, 'j'); /* tell lock about JOB */
3991: goto job_entry;
3992: }
3993:
3994: /* ignore signal while here */
3995: sig_attach (SIGUSR1, SIG_IGN);
3996:
3997: while (wait (&zsystem) != i);
3998:
3999: sig_attach (SIGUSR1, &oncld); /* restore handler */
4000:
4001: merr_clear (); /* there might be a INRPT from other job */
4002:
4003: set_io (MUMPS);
4004: break;
4005: }
4006:
4007: if (i == 0) { /* we are in child process */
4008:
4009: intstr (zb, j); /* $JOB of father job */
4010: father = j;
4011:
4012: pid = getpid (); /* $J = process ID */
4013: usermode = 0; /* no programmer mode */
4014: DSW |= BIT0; /* disable echo */
4015: zbreakon = DISABLE; /* disable CTRL/B */
4016: breakon = DISABLE; /* disable CTRL/C */
4017: hardcopy = DISABLE; /* disable hardcopy function */
4018:
4019: fclose (stdin); /* close normal input */
4020:
4021: jour_flag = 0; /* no protocol */
4022:
4023:
4024: nstx = 0; /* clear stack */
4025: estack = 0;
4026:
4027: forx = 0;
4028: forsw = FALSE;
4029: level = 0;
4030:
4031: cmdptr = cmdstack; /* - command stack pointer */
4032: namptr = namstck; /* - routine name stack pointer */
4033:
4034: /* init random number */
4035: if ((nrandom = time (0L) * getpid ()) < 0) nrandom = (-nrandom);
4036:
4037: merr_clear ();
4038: lock (" \201", -1, 'j'); /* tell lock about JOB */
4039:
4040: goto job_entry;
4041: }
4042:
4043: intstr (zb, i); /* $JOB of the process just started */
4044: break;
4045:
4046: case KILL:
1.10 snw 4047:
1.1 snw 4048: /* argumentless: KILL all local variables */
4049: if (((ch = *codptr) == SP) || ch == EOL) {
4050: symtab (kill_all, "", "");
4051: break;
4052: }
4053:
4054: if (ch != '(') {
4055: char destc[255];
4056: register int cd;
4057:
4058: destc[0] = '\0';
4059:
4060: expr (NAME);
4061:
4062: /* aviod a disaster if someone types KILL ^PATDAT[TEST] ! */
4063: if (((ch = *++codptr) != SP) && ch != EOL && ch != ',') merr_raise (INVREF);
4064: if (merr () > OK) goto err;
4065:
4066: if (varnam[0] == '^') {
4067: if (varnam[1] != '$') {
4068: global (kill_sym, varnam, tmp);
4069: }
4070: else {
4071: ssvn (kill_sym, varnam, tmp);
4072: }
4073: break;
4074: }
4075:
4076: symtab (kill_sym, varnam, tmp);
4077:
4078: if (destructor_ct) {
4079:
4080: for (cd = 0; cd < destructor_ct; cd++) {
1.10 snw 4081: if (strlen (destructors[cd]) > 0) {
4082: strcat (destc, destructors[cd]);
4083: strcat (destc, ",");
4084: }
1.1 snw 4085: }
4086:
4087: destructor_ct = 0;
4088: destc[strlen(destc) - 1] = '\201';
4089:
4090: stcpy (&tmp3[1], destc);
4091: destructor_run = TRUE;
4092:
4093: goto private;
4094: }
4095:
4096:
4097: break;
4098: }
4099:
4100: /* exclusive kill */
4101: tmp[0] = SP;
4102: tmp[1] = EOL;
4103:
4104: for (;;) {
4105:
4106: codptr++;
4107: expr (NAME);
4108:
4109: if (merr () > OK) goto err;
4110:
4111: if (varnam[0] == '^') {
4112: merr_raise (GLOBER);
4113: goto err;
4114: }
4115:
4116: i = 0;
4117: while (varnam[i] != EOL) {
4118:
4119: if (varnam[i] == DELIM) {
4120: merr_raise (SBSCR);
4121: goto err;
4122: }
4123:
4124: i++;
4125: }
4126:
4127: if (stcat (tmp, varnam) == 0) {
4128: merr_raise (M75);
4129: goto err;
4130: }
4131:
4132: if (stcat (tmp, " \201") == 0) {
4133: merr_raise (M75);
4134: goto err;
4135: }
4136:
4137: if ((ch = *++codptr) == ')') {
4138: codptr++;
4139: break;
4140: }
4141:
4142: if (ch != ',') {
4143: merr_raise (COMMAER);
4144: goto err;
4145: }
4146: }
4147:
4148: symtab (killexcl, tmp, "");
4149: break;
4150:
4151: case NEWCMD:
4152: if ((rtn_dialect () == D_M77) ||
4153: (rtn_dialect () == D_M84)) {
4154: merr_raise (NOSTAND);
4155: goto err;
4156: }
4157: /*case ZNEW:*/
4158:
4159: /* argumentless: NEW all local variables */
4160: if (((ch = *codptr) == SP) || ch == EOL) {
4161: ch = nstx;
4162:
4163: while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */
4164:
4165: #ifdef DEBUG_NEWPTR
4166: printf ("Xecline 03: (TODO - NEW ALL) ");
4167: printf ("[ch] is %d, [nestnew] is %d\r\n", ch, nestnew[ch]);
4168: #endif
4169:
4170: if (nestnew[ch] == 0) nestnew[ch] = newptr;
4171:
4172: symtab (new_all, "", "");
4173: break;
4174: }
4175:
4176: if (ch != '(') {
4177: expr (NAME);
4178:
4179: if (merr () > OK) goto err;
4180:
4181: codptr++;
4182:
4183: if (varnam[0] == '^') {
4184: merr_raise (GLOBER);
4185: goto err;
4186: }
4187:
4188: if (varnam[0] == '$') {
4189: i = 0;
4190:
4191: while ((ch = varnam[++i]) != EOL) if (ch >= 'A' && ch <= 'Z') varnam[i] = ch + 32;
4192:
4193: /* set $reference */
4194: if ((stcmp (&varnam[1], "r\201")) && (stcmp (&varnam[1], "reference\201")) && (stcmp (&varnam[1], "zr\201")) && (stcmp (&varnam[1], "zreference\201")) &&
4195: (stcmp (&varnam[1], "t\201")) && (stcmp (&varnam[1], "test\201")) && (stcmp (&varnam[1], "j\201")) && (stcmp (&varnam[1], "job\201")) &&
4196: (stcmp (&varnam[1], "zi\201")) && (stcmp (&varnam[1], "zinrpt\201")) && (stcmp (&varnam[1], "et\201")) && (stcmp (&varnam[1], "etrap\201")) &&
4197: (stcmp (&varnam[1], "es\201")) && (stcmp (&varnam[1], "estack\201"))) {
4198: merr_raise (INVREF);
4199: goto err;
4200: }
4201: }
4202:
4203: /* new and set, new object */
4204: if (*codptr == '=') {
4205:
4206: if ((rtn_dialect () != D_FREEM)) {
4207: merr_raise (NOSTAND);
4208: goto err;
4209: }
4210:
4211: codptr++;
4212: stcpy (vn, varnam);
4213:
4214: if (*codptr != '$') {
4215: /* this is a new-and-set */
4216: expr (STRING);
4217: new_and_set = TRUE;
4218: }
4219: else {
4220: if ((*codptr == '$') &&
4221: (*(codptr + 1) == '#') &&
4222: (*(codptr + 2) == '^')) {
4223:
4224: char class[255];
4225: char constructor[255];
4226: char objvar[255];
4227: char datres[5];
4228: int dat_res;
4229:
4230: stcpy (objvar, vn);
4231:
1.9 snw 4232: symtab (fra_dat, objvar, datres);
1.1 snw 4233: dat_res = atoi (datres);
4234:
4235: if (dat_res > 0) {
4236: merr_raise (OBJCONFLICT);
4237: goto err;
4238: }
4239:
4240: stcnv_m2c (objvar);
4241:
4242: codptr += 2;
4243:
4244: /* this is probably an object instantiation */
4245: expr (NAME);
4246: if (merr () > OK) goto err;
4247:
4248: stcpy (class, varnam);
4249: stcnv_m2c (class);
4250: new_object = TRUE;
4251: codptr++;
4252:
4253: obj_get_constructor (constructor, class, objvar);
4254:
4255: for (dat_res = 0; dat_res < strlen (class); dat_res++) {
4256: if (class[dat_res] == '\202') {
4257: class[dat_res] = '\0';
4258: break;
4259: }
4260: }
4261:
4262: obj_create_symbols (objvar, class);
4263:
4264: if (merr () > OK) goto err;
4265:
1.14 snw 4266: /* TODO: check this snprintf for proper sizing */
1.1 snw 4267: snprintf (&tmp3[1], 255, "%s\201", &constructor[1]);
4268: goto private;
4269:
4270: }
4271: else {
4272: if (*codptr == '$') {
4273: expr (STRING);
4274: new_and_set = TRUE;
4275: }
4276: else {
4277: merr_raise (ILLFUN);
4278: goto err;
4279: }
4280: }
4281: }
4282:
4283:
4284: goto set2;
4285: }
4286:
1.12 snw 4287: /*
1.1 snw 4288: post_new:
1.12 snw 4289: */
1.1 snw 4290: ch = nstx;
4291:
4292: while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */
4293:
4294: #ifdef DEBUG_NEWPTR
4295: printf ("Xecline 04 (DANGER): ");
4296: printf ("[ch] is %d, [nestnew] is %d\r\n", ch, nestnew[ch]);
4297: #endif
4298:
4299: if (nestnew[ch] == 0) nestnew[ch] = newptr;
4300:
4301: symtab (new_sym, varnam, "");
4302: break;
4303: }
4304:
4305: /* exclusive new */
4306: tmp[0] = SP;
4307: tmp[1] = EOL;
4308:
4309: for (;;) {
4310: codptr++;
4311: expr (NAME);
4312:
4313: if (merr () > OK) goto err;
4314:
4315: if (varnam[0] == '^') {
4316: merr_raise (GLOBER);
4317: goto err;
4318: }
4319:
4320: if (varnam[0] == '$') {
4321: merr_raise (INVREF);
4322: goto err;
4323: }
4324:
4325: i = 0;
4326: while (varnam[i] != EOL) {
4327:
4328: if (varnam[i] == DELIM) {
4329: merr_raise (SBSCR);
4330: goto err;
4331: }
4332:
4333: i++;
4334: }
4335:
4336: if (stcat (tmp, varnam) == 0) {
4337: merr_raise (M75);
4338: goto err;
4339: }
4340:
4341: if (stcat (tmp, " \201") == 0) {
4342: merr_raise (M75);
4343: goto err;
4344: }
4345:
4346: if ((ch = *++codptr) == ')') {
4347: codptr++;
4348: break;
4349: }
4350:
4351: if (ch != ',') {
4352: merr_raise (COMMAER);
4353: goto err;
4354: }
4355: }
4356:
4357: ch = nstx;
4358: while (nestc[ch] == FOR) ch--; /* FOR does not define a NEW level */
4359:
4360: #ifdef DEBUG_NEWPTR
4361: printf ("Xecline 05 (TODO): ");
4362: printf ("[ch] is %d, [nestnew] is %d\r\n", ch, nestnew[ch]);
4363: #endif
4364:
4365: if (nestnew[ch] == 0) nestnew[ch] = newptr;
4366:
4367: symtab (newexcl, tmp, "");
4368: break;
4369:
4370: case LOCK:
4371:
4372: /* argumentless: UNLOCK */
4373: if ((ch = *codptr) == SP || ch == EOL) {
4374: locktab_unlock_all ();
4375: break;
4376: }
4377:
4378: if (ch == '+' || ch == '-') {
4379:
4380: if ((rtn_dialect () == D_M77) ||
4381: (rtn_dialect () == D_M84)) {
4382: merr_raise (NOSTAND);
4383: goto err;
4384: }
4385:
4386: tmp[0] = ch;
4387: ch = (*++codptr);
4388: }
4389: else {
4390: tmp[0] = SP;
4391: }
4392:
4393: if (ch != '(') {
4394: expr (NAME);
4395:
4396: if (merr () > OK) goto err;
4397:
4398: stcpy (&tmp[1], varnam);
4399: stcat (tmp, "\001\201");
4400: }
4401: else { /* multiple lock */
4402: tmp[1] = EOL;
4403:
4404: for (;;) {
4405: codptr++;
4406: expr (NAME);
4407:
4408: if (merr () > OK) goto err;
4409:
4410: stcat (tmp, varnam);
4411: stcat (tmp, "\001\201");
4412:
4413: if ((ch = *++codptr) == ')') break;
4414:
4415: if (ch != ',') {
4416: merr_raise (COMMAER);
4417: goto err;
4418: }
4419: }
4420:
4421: }
4422:
4423: frm_timeout = (-1L); /* no timeout */
4424:
4425: if (*++codptr == ':') {
4426: codptr++;
4427: expr (STRING);
4428:
4429: frm_timeout = intexpr (argptr);
4430:
4431: if (merr () > OK) goto err;
4432: if (frm_timeout < 0L) frm_timeout = 0L;
4433: }
4434:
4435: lock (tmp, frm_timeout, LOCK);
4436: break;
4437:
4438: case USE:
4439:
4440: if (*codptr == SP || *codptr == EOL) {
4441: merr_raise (ARGER);
4442: goto err;
4443: }
4444:
4445: expr (STRING);
4446: j = intexpr (argptr);
4447:
4448: if (j > MAXSEQ && j < MAXDEV) {
4449: io = j;
4450: goto use_socket;
4451: }
4452:
4453: if (j < 0 || j > MAXDEV) {
4454: merr_raise (NODEVICE);
4455: }
4456: else if (j != HOME && devopen[j] == 0) {
4457: merr_raise (NOPEN);
4458: }
4459:
4460: if (merr () > OK) goto err;
4461:
4462: io = j;
4463:
4464: if (io == HOME && *codptr == ':' && *(codptr + 1) == '(') {
4465:
4466: use0: /* entry point for processing of device parameters */
4467:
4468: codptr += 2;
4469: j = 1;
4470: setpiece = TRUE; /* so a surplus closing bracket will not be an error */
4471:
4472: while (*codptr != ')') {
4473:
4474: if (*codptr == ':') {
4475: codptr++;
4476: j++;
4477:
4478: continue;
4479: }
4480:
4481: expr (STRING);
4482:
4483: if (merr () > OK) {
4484: setpiece = FALSE;
4485: goto err;
4486: }
4487:
4488: switch (j) {
4489:
4490: case 1:
4491: i = intexpr (argptr);
4492:
4493: if (i < 0) i = 0;
4494: if (i > 255) i = 255;
4495:
4496: RightMargin = i;
4497: break;
4498:
4499: case 3:
4500: i = intexpr (argptr);
4501:
4502: if (i < 0) i = 0;
4503: if (i > 255) i = 255;
4504:
4505: InFieldLen = i;
4506: break;
4507:
4508: case 5:
4509: DSW = intexpr (argptr);
4510: break;
4511:
4512: case 7:
4513: i = intexpr (argptr);
4514: ypos[HOME] = i / 256;
4515: xpos[HOME] = i % 256;
4516:
4517: if (DSW & BIT7) {
4518:
4519: i = io;
4520: io = HOME;
4521: argptr[0] = ESC;
4522: argptr[1] = '[';
4523: argptr[2] = EOL;
4524:
4525: if (ypos[HOME]) {
4526: intstr (&argptr[2], ypos[HOME] + 1);
4527: }
4528:
4529: if (xpos[HOME]) {
4530: tmp3[0] = ';';
4531:
4532: intstr (&tmp3[1], xpos[HOME] + 1);
4533: stcat (argptr, tmp3);
4534: }
4535:
4536: stcat (argptr, "H\201");
4537: write_m (argptr);
4538:
4539: io = i;
4540: }
4541: break;
4542:
4543: case 9:
4544: i = 0;
4545: j = 0;
4546:
4547: while ((ch = argptr[i++]) != EOL) LineTerm[j++] = ch;
4548:
4549: LineTerm[j] = EOL;
4550: break;
4551:
4552: case 10:
4553: BrkKey = (*argptr);
4554:
4555: /* make new break active */
4556: set_io (UNIX);
4557: set_io (MUMPS);
4558: }
4559: }
4560:
4561: setpiece = FALSE;
4562: codptr++;
4563:
4564: break;
4565: }
4566: else if (*codptr == ':') {
4567: codptr++;
4568:
4569: if (io == HOME) { /* old syntax: enable/disable echo */
4570: expr (STRING);
4571:
4572: if (merr () > OK) goto err;
4573:
4574: if (tvexpr (argptr)) {
4575: DSW &= ~BIT0;
4576: }
4577: else {
4578: DSW |= BIT0;
4579: }
4580:
4581: }
4582: else {
4583:
4584: if (*codptr == '(') {
4585: codptr++;
4586: setpiece = TRUE;
4587: }
4588:
4589: j = 1;
4590:
4591: while (*codptr != ')') {
4592:
4593: if (*codptr == ':') {
4594: codptr++;
4595: j++;
4596:
4597: continue;
4598: }
4599: else if (setpiece == FALSE) {
4600: merr_raise (SPACER);
4601: goto err;
4602: }
4603:
4604: expr (STRING);
4605:
4606: if (merr () > OK) {
4607: setpiece = FALSE;
4608: goto err;
4609: }
4610:
4611: switch (j) {
4612:
4613: case 1:
4614: fseek (opnfile[io], (long) intexpr (argptr), 0);
4615: break;
4616:
4617: case 2:
1.8 snw 4618: frm_crlf[io] = tvexpr (argptr);
1.1 snw 4619: break;
4620:
4621: case 3:
4622: fm_nodelay[io] = tvexpr (argptr);
4623: break;
4624: }
4625:
4626: if (setpiece == FALSE) break;
4627: }
4628:
4629: if (setpiece) {
4630: codptr++;
4631: setpiece = FALSE;
4632: }
4633:
4634: break;
4635: }
4636: }
4637: break;
4638:
4639:
4640: use_socket:
4641: {
4642: char use_parm[256];
4643: int upct = 0;
4644:
4645: if (*codptr == ':') {
4646: codptr++;
4647: }
4648: else {
4649: while ((ch = *(codptr++)) != SP && ch != EOL);
4650: codptr--;
4651: break;
4652: }
4653:
4654: if (*codptr != '/') {
4655: merr_raise (ARGLIST);
4656: goto err;
4657: }
4658:
4659: codptr++;
4660:
4661: while ((ch = *codptr++) != SP && ch != EOL && isalpha (ch)) {
4662: use_parm[upct++] = ch;
4663: }
4664:
4665: use_parm[upct] = NUL;
4666:
4667: for (upct = 0; upct < strlen (use_parm); upct++) {
4668: use_parm[upct] = toupper (use_parm[upct]);
4669: }
4670:
4671: if (strcmp (use_parm, "CONNECT") == 0) {
4672:
4673: msck_connect (io);
4674:
4675: if (merr () > OK) goto err;
4676:
4677: }
4678: else if (strcmp (use_parm, "BIND") == 0) {
4679: write_m("BIND\r\n\201");
4680: }
4681: else {
4682: merr_raise (ARGLIST);
4683: goto err;
4684: }
4685:
4686: break;
4687:
4688: }
4689:
4690: case OPEN:
4691:
4692: {
4693: short k;
4694:
4695: if (*codptr == SP || *codptr == EOL) {
4696: merr_raise (FILERR);
4697: goto err;
4698: }
4699:
4700: expr (STRING);
4701: k = intexpr (argptr);
4702:
4703: if (merr () > OK) goto err;
4704:
4705:
4706: if (k < 0 || k > MAXDEV) {
4707: merr_raise (NODEVICE);
4708: goto err;
4709: }
4710:
4711: if (k > MAXSEQ) goto open_socket;
4712:
4713: if (restricted_mode) {
1.28 snw 4714: merr_raise (CMMND);
1.1 snw 4715: goto err;
4716: }
4717:
4718: /* need to evaluate the following 6 lines carefully - smw 2023-10-15 */
4719: if (k != HOME) {
1.8 snw 4720: frm_crlf[k] = FALSE;
1.1 snw 4721: fm_nodelay[k] = FALSE;
4722: xpos[k] = 0;
4723: ypos[k] = 0;
4724: }
4725:
4726: /* OPEN implies a previous CLOSE on same channel */
4727: if ((k != HOME) && devopen[k]) {
4728:
4729: fclose (opnfile[k]);
4730: devopen[k] = 0;
4731:
4732: if (io == k) io = HOME;
4733: }
4734:
4735: /* process device parameters on HOME at USE command. */
4736: if (k == HOME && *codptr == ':' && *(codptr + 1) == '(') goto use0;
4737:
4738: if (*codptr != ':') {
4739:
4740: if (k == HOME) break;
4741:
4742: if (dev[k][0] == EOL) {
4743: merr_raise (FILERR);
4744: merr_set_iochan_err (k, FILERR, "file not found");
4745: goto err;
4746: }
4747:
4748: goto open10;
4749: }
4750:
4751: codptr++;
4752:
4753: if (k == HOME) {
4754:
4755: if (*codptr != ':') { /* turn echo on/off */
4756:
4757: expr (STRING);
4758:
4759: if (merr () > OK) goto err;
4760:
4761: if (tvexpr (argptr)) {
4762: DSW &= ~BIT0;
4763: }
4764: else {
4765: DSW |= BIT0;
4766: }
4767: }
4768:
4769: if (*codptr == ':') { /* dummy timeout on HOME */
4770: codptr++;
4771:
4772: if (*codptr != SP && *codptr != EOL) {
4773: expr (STRING);
4774:
4775: if (merr () > OK) goto err;
4776:
4777: test = TRUE;
4778: break;
4779: }
4780: else {
4781: merr_raise (INVEXPR);
4782: goto err;
4783: }
4784: }
4785: }
4786: else {
4787: int op_pos;
4788:
4789: expr (STRING);
4790:
4791: if (merr () > OK) goto err;
4792:
4793: stcpy (dev[k], argptr);
4794: frm_timeout = (-1L);
4795:
4796: if (*codptr == ':') {
4797:
4798: codptr++;
4799:
4800: expr (STRING);
4801: frm_timeout = intexpr (argptr);
4802:
4803: if (merr () > OK) goto err;
4804: if (frm_timeout < 0L) frm_timeout = 0L;
4805: }
4806:
4807: open10:
4808:
4809: j = stcpy (tmp, dev[k]);
4810: i = dev[k][j - 1];
4811:
4812: while (--j >= 0) {
4813: if (dev[k][j] == '/') break;
4814: }
4815:
4816: stcpy (tmp2, dev[k]);
4817:
4818: if (j <= 0) {
4819: tmp2[stlen (tmp2)] = NUL;
4820: tmp[1] = 'r';
4821: i = '+';
4822: }
4823: else { /* default is read+write */
4824: tmp2[j] = NUL;
4825:
4826: j = stcpy (&tmp[1], &tmp[j + 1]);
4827:
4828: tmp[0] = SP;
4829: tmp[j + 1] = SP;
4830: tmp[j + 2] = EOL;
4831:
4832: j = 0;
4833:
4834: while ((ch = tmp[++j]) != EOL) if (ch >= 'A' && ch <= 'Z') tmp[j] = ch + 32;
4835:
4836: if (find (" r w a r+ w+ a+ read write append read+ write+ append+ \201", tmp) == FALSE) {
4837: tmp[1] = 'r';
4838: i = '+';
4839:
4840: tmp2[strlen (tmp2)] = '/';
4841: }
4842: }
4843:
4844: tmp[0] = tmp[1];
4845: tmp[1] = NUL; /* NUL not EOL !!! */
4846:
4847: if (i == '+') {
4848: tmp[1] = i;
4849: tmp[2] = NUL;
4850: }
4851:
4852: op_pos = 0;
4853:
4854: open20:
4855:
4856: if (oucpath[op_pos] != EOL) {
4857:
4858: j = stlen (dev[k]);
4859:
4860: while (--j >= 0) if (dev[k][j] == '/') break;
4861: while (--j >= 0) if (dev[k][j] == '/') break;
4862:
4863: if (j < 0) {
4864:
4865: strcpy (tmp3, tmp2);
4866: stcpy (tmp2, &oucpath[op_pos]);
4867:
4868: j = 0;
4869: while (tmp2[j] != ':' && tmp2[j] != EOL) j++;
4870:
4871: tmp2[j] = EOL;
4872:
4873: stcpy (act_oucpath[k], tmp2);
4874: op_pos += j;
4875:
4876: if (j) tmp2[j++] = '/';
4877:
4878: strcpy (&tmp2[j], tmp3);
4879: }
4880: }
4881:
4882: /* r = READ only access;
4883: * w = WRITE new file;
4884: * a = WRITE append;
4885: * r+ = READ/WRITE access;
4886: * w+ = WRITE new file;
4887: * a+ = WRITE append;
4888: */
4889: j = tmp[0];
4890: sq_modes[k] = j;
4891:
4892: if (j == 'r' && tmp[1] == '+') {
4893: sq_modes[k] = '+';
4894: }
4895:
4896: if (j == 'r' && frm_timeout < 0L) {
4897:
4898: errno = 0;
4899:
4900: while ((opnfile[k] = fopen (tmp2, tmp)) == NULL) {
4901:
4902: if (errno == EINTR) {
4903: errno = 0;
4904: continue;
4905: } /* interrupt */
4906:
4907: if (errno == EMFILE || errno == ENFILE) {
4908: close_all_globals ();
4909: continue;
4910: }
4911:
4912: if (dev[k][0] != '/' && oucpath[op_pos++] != EOL) {
4913: strcpy (tmp2, tmp3);
4914: goto open20;
4915: }
4916:
4917: act_oucpath[k][0] = EOL;
4918: merr_raise ((errno == ENOENT ? FILERR : PROTECT));
4919:
4920: switch (merr ()) {
4921:
4922: case FILERR:
4923: merr_set_iochan_err (k, FILERR, "file not found");
4924: break;
4925:
4926: case PROTECT:
4927: merr_set_iochan_err (k, PROTECT, "file protection violation");
4928: break;
4929:
4930: }
4931:
4932: goto err;
4933: }
4934:
4935: ssvn_job_add_device (k, tmp2);
4936:
4937: devopen[k] = ((i == '+') ? i : j);
4938: break;
4939: }
4940:
4941: if (j == 'r' || j == 'w' || j == 'a') {
4942:
4943: if (frm_timeout >= 0L) {
4944:
4945: test = TRUE;
4946:
4947: if (setjmp (sjbuf)) {
4948: test = FALSE;
4949: goto endopn;
4950: }
4951:
4952: sig_attach (SIGALRM, &ontimo);
4953: alarm ((unsigned) (frm_timeout < 3 ? 3 : frm_timeout));
4954: }
4955:
4956: for (;;) {
4957: errno = 0;
4958:
4959: if ((opnfile[k] = fopen (tmp2, tmp)) != NULL) break;
4960: if (merr () == INRPT) goto err;
4961: if (errno == EINTR) continue; /* interrupt */
4962:
4963: if (errno == EMFILE || errno == ENFILE) {
4964: close_all_globals ();
4965: continue;
4966: }
4967:
4968: if (frm_timeout < 0L) {
4969:
4970: if (dev[k][0] != '/' && oucpath[op_pos++] != EOL) {
4971: strcpy (tmp2, tmp3);
4972: goto open20;
4973: }
4974:
4975: if (errno == ENOENT) continue;
4976:
4977: act_oucpath[k][0] = EOL;
4978: merr_raise (PROTECT);
4979:
4980: merr_set_iochan_err (k, PROTECT, "file protection violation");
4981:
4982: goto err;
4983: }
4984:
4985: if (frm_timeout == 0L) {
4986: test = FALSE;
4987: goto endopn;
4988: }
4989:
4990: sleep (1);
4991: frm_timeout--;
4992: }
4993:
4994: devopen[k] = ((i == '+') ? i : j);
4995: endopn:;
4996:
4997: alarm (0); /* reset alarm request */
4998: }
4999: else {
5000: merr_raise (ARGLIST);
5001: merr_set_iochan_err (k, ARGLIST, "invalid argument");
5002: goto err;
5003: }
5004: }
5005:
5006:
5007: open_socket:
5008: if (*codptr != ':') {
5009: if (j == 'w') {
5010: merr_raise (FILEXWR);
5011: merr_set_iochan_err (k, FILEXWR, "cannot open existing file for WRITE");
5012: }
5013: else {
5014: merr_raise (ARGLIST);
5015: merr_set_iochan_err (k, ARGLIST, "invalid argument");
5016: }
5017: goto err;
5018: }
5019:
5020: codptr++;
5021: expr (STRING);
5022:
5023: if (merr () > OK) goto err;
5024:
5025:
5026: stcpy (vn, argptr);
5027: stcnv_m2c (vn);
5028:
5029: msck_open (k, vn);
5030:
5031: if (merr () > OK) goto err;
5032:
5033: ssvn_job_add_device (k, vn);
5034:
5035: break;
5036: }
5037: break;
5038:
5039:
5040:
5041:
5042:
5043: case CLOSE:
5044:
5045: /* no arguments: close all exept HOME */
5046: if (*codptr == SP || *codptr == EOL) {
5047:
5048: if (rtn_dialect () != D_FREEM) {
5049: merr_raise (NOSTAND);
5050: break;
5051: }
5052:
5053: j = 1;
5054:
5055: while (j <= MAXDEV) {
5056:
5057: if (j < FIRSTSCK) {
5058: if (jour_flag && (j == 2)) {
5059: j++;
5060: continue;
5061: }
5062:
5063: if (devopen[j]) fclose (opnfile[j]);
5064:
5065: ssvn_job_remove_device (j);
5066:
5067: devopen[j++] = 0;
5068: }
5069: else {
5070: msck_close (j++);
5071: }
5072:
5073: }
5074:
5075: io = HOME;
5076: break;
5077: }
5078:
5079: expr (STRING);
5080: j = intexpr (argptr);
5081:
5082: if (merr () > OK) break;
5083:
5084: if (j >= FIRSTSCK && j < MAXDEV) {
5085: msck_close (j);
5086: ssvn_job_remove_device (j);
5087: break;
5088: }
5089:
5090: /*ignore close on illgal units */
5091: if ((j >= 0 && j <= MAXDEV && j != HOME) && (jour_flag == 0 || (j != 2))) { /*ignore close on protocol channel */
5092:
5093: if (devopen[j]) fclose (opnfile[j]);
5094:
5095: devopen[j] = 0;
5096:
5097: ssvn_job_remove_device (j);
5098:
5099: if (io == j) io = HOME;
5100:
5101: }
5102:
5103: /* parse any 'device parameters', but ignore them otherwise */
5104: if (*codptr == ':') {
5105: if (*++codptr != '(') {
5106: expr (STRING);
5107: }
5108: else {
5109: setpiece = TRUE; /* to avoid bracket error at end of deviceparameters */
5110: for (;;)
5111: {
5112: if (*++codptr != ':')
5113: expr (STRING);
5114: if (*codptr == ':')
5115: continue;
5116: if (*codptr++ != ')')
5117: merr_raise (ARGER);
5118: break;
5119: }
5120: setpiece = FALSE;
5121: }
5122: }
5123:
5124: break;
5125:
5126: case ZHALT: /* ZHALT */
5127:
5128: if (is_standard ()) {
5129: merr_raise (NOSTAND);
5130: goto err;
5131: }
5132:
5133: case HA: /* HALT or HANG */
5134:
5135:
5136: /* no arguments: HALT */
5137: if (*codptr == SP || *codptr == EOL || mcmnd == ZHALT) {
5138:
5139: if (mcmnd == ZHALT && *codptr != SP && *codptr != EOL) {
5140: expr (STRING);
5141: i = intexpr (argptr);
5142:
5143: if (merr () > OK) break;
5144: }
5145: else {
1.22 snw 5146: halt:
5147: i = 0;
1.1 snw 5148: }
5149:
5150: cleanup ();
5151:
5152: if (father) { /* advertise death to parent *//* make sure father is waiting !!! */
5153: if ((time (0L) - jobtime) < 120) sleep (2);
5154:
5155: kill (father, SIGUSR1);
5156: }
5157:
5158: exit (i); /* terminate mumps */
5159: };
5160: /* with arguments: HANG */
5161:
5162:
5163: case HANG: /* HANG */
5164:
5165: {
5166: unsigned long int waitsec;
5167: int millisec;
5168:
5169: #ifdef USE_GETTIMEOFDAY
5170: struct timeval timebuffer;
5171: #else
5172: struct timeb timebuffer;
5173: #endif
5174:
5175: expr (STRING);
5176: numlit (argptr);
5177:
5178: if (merr () > OK) break;
5179:
5180: #if !defined(__linux__)
5181: if (argptr[0] == '-') break; /* negative values without effect */
5182: if (argptr[0] == '0') break; /* zero without effect */
5183: #else
5184: /* on linux, return scheduler timeslice to kernel scheduler for hang 0 and hang with negative values
5185: for compatibility with Reference Standard M, only when process is using a realtime scheduling policy */
5186: if ((argptr[0] == '-') || (argptr[0] == '0')) {
5187: int policy;
5188:
5189: policy = sched_getscheduler (0);
5190: if ((policy == -1) || ((policy != SCHED_FIFO) && (policy != SCHED_RR))) break;
5191:
5192: sched_yield ();
5193: }
5194: #endif
5195:
5196: waitsec = 0;
5197: millisec = 0;
5198: i = 0;
5199:
5200: for (;;) { /* get integer and fractional part */
5201:
5202: if ((ch = argptr[i++]) == EOL) break;
5203:
5204: if (ch == '.') {
5205: millisec = (argptr[i++] - '0') * 100;
5206:
5207: if ((ch = argptr[i++]) != EOL) {
5208: millisec += (ch - '0') * 10;
5209:
5210: if ((ch = argptr[i]) != EOL) {
5211: millisec += (ch - '0');
5212: }
5213: }
5214:
5215: break;
5216: }
5217:
5218: waitsec = waitsec * 10 + ch - '0';
5219: }
5220:
5221: if ((i = waitsec) > 2) i -= 2;
5222:
5223: #ifdef USE_GETTIMEOFDAY
5224: gettimeofday (&timebuffer, NULL); /* get current time */
5225:
5226: waitsec += timebuffer.tv_sec; /* calculate target time */
5227: millisec += timebuffer.tv_usec;
5228: #else
5229: ftime (&timebuffer); /* get current time */
5230:
5231: waitsec += timebuffer.time; /* calculate target time */
5232: millisec += timebuffer.millitm;
5233: #endif
5234:
5235: if (millisec >= 1000) {
5236: waitsec++;
5237: millisec -= 1000;
5238: }
5239:
5240: /* do the bulk of the waiting with sleep() */
5241: while (i > 0) {
5242: j = time (0L);
5243: sleep ((unsigned) (i > 32767 ? 32767 : i)); /* sleep max. 2**15-1 sec */
5244: i -= time (0L) - j; /* subtract actual sleeping time */
5245:
5246: if (merr () == INRPT) goto err;
5247:
5248: if (evt_async_enabled && (merr () == ASYNC)) goto err;
5249: }
5250:
5251: /* do the remainder of the waiting watching the clock */
5252: for (;;) {
5253:
5254: #ifdef USE_GETTIMEOFDAY
5255:
5256: gettimeofday (&timebuffer, NULL);
5257:
5258: if (timebuffer.tv_sec > waitsec) break;
5259: if (timebuffer.tv_sec == waitsec && timebuffer.tv_usec >= millisec) break;
5260: #else
5261: ftime (&timebuffer);
5262:
5263: if (timebuffer.time > waitsec) break;
5264: if (timebuffer.time == waitsec && timebuffer.millitm >= millisec) break;
5265: #endif
5266: if (merr () == INRPT) goto err;
5267:
5268: }
5269: }
5270: break;
5271:
5272:
5273: case HALT: /* HALT */
5274:
5275: if (*codptr == SP || *codptr == EOL) goto halt;
5276:
5277: merr_raise (ARGLIST);
5278: break;
5279:
5280:
5281: case BREAK:
5282:
5283:
5284: if (*codptr == SP || *codptr == EOL) {
5285:
5286: if (breakon == FALSE) break; /* ignore BREAK */
5287:
5288: if (usermode == 0) {
5289: merr_raise (BKERR);
5290: goto err;
5291: }
5292:
5293: zbflag = TRUE;
5294: merr_raise (OK - CTRLB);
5295: zb_entry:loadsw = TRUE;
5296:
5297: #ifdef DEBUG_NEWSTACK
5298: printf ("CHECK 08 (Stack PUSH)\r\n");
5299: #endif
5300:
5301:
5302:
5303: if (++nstx > NESTLEVLS) {
5304: nstx--;
5305: merr_raise (STKOV);
5306:
5307: goto err;
5308: }
5309: else {
5310: estack++;
5311: }
5312:
5313: nestc[nstx] = BREAK;
5314:
5315: #ifdef DEBUG_NEWSTACK
5316:
5317: if (!cmdptr) printf ("CMDPTR is ZERO!\r\n");
5318:
5319: #endif
5320:
5321: nestp[nstx] = cmdptr; /* command stack address */
5322: nestn[nstx] = 0; /*!!! save name */
5323: nestr[nstx] = roucur - rouptr; /* save roucur */
5324: nestnew[nstx] = 0;
5325: ztrap[nstx][0] = EOL;
5326: nestlt[nstx] = level;
5327: level = 0; /* save level */
5328: /* save BREAK information */
5329: brkstk[nstx] = (((ECHOON ? 1 : 0) << 1) | test) << 3 | io;
5330:
5331: io = HOME;
5332: forsw = FALSE;
5333: cmdptr += stcpy (cmdptr, codptr) + 1;
5334: zerr = BKERR;
5335: goto restart;
5336: }
5337:
5338: if (is_standard ()) {
5339: merr_raise (NOSTAND);
5340: goto err;
5341: }
5342:
5343: expr (STRING);
5344: if (merr () > OK) break;
5345:
1.18 snw 5346: {
5347: char brkstr[256];
5348:
5349: stcpy (brkstr, argptr);
5350: stcnv_m2c (brkstr);
5351:
5352: if (strcmp (brkstr, "DEBUG") == 0) {
5353: debug_mode = TRUE;
5354: }
5355: else {
5356: switch (intexpr (argptr)) {
5357:
5358: case 2:
5359: DSM2err = TRUE;
5360: break; /* enable DSM V 2 error processing */
5361:
5362: case -2:
5363: DSM2err = FALSE;
5364: break; /* enable normal error processing */
5365:
5366: case 0:
5367: breakon = FALSE;
5368: break; /* disable CTRL/C */
5369:
5370: default:
5371: breakon = TRUE;
5372: break; /* enable CTRL/C */
5373: }
5374: }
1.1 snw 5375: }
1.18 snw 5376:
1.1 snw 5377: break;
5378:
5379: case VIEW:
5380:
5381: view_com ();
5382:
5383: if (repQUIT) { /* VIEW 26: repeated QUIT action */
5384:
5385: while (repQUIT-- > 0) {
5386:
5387: #ifdef DEBUG_NEWSTACK
5388: printf ("CHECK 09 (Stack POP)\r\n");
5389: #endif
5390:
5391: if (nestc[nstx] == BREAK) {
5392: if (repQUIT) continue;
5393: merr_raise (OK - CTRLB);
5394:
5395: goto zgo; /*cont. single step */
5396: }
5397:
5398: if (nestc[nstx] == FOR) {
5399:
5400: stcpy (code, cmdptr = nestp[nstx--]);
5401: estack--;
5402:
5403: codptr = code;
5404: ftyp = fortyp[--forx];
5405: fvar = forvar[forx];
5406: finc = forinc[forx];
5407: flim = forlim[forx];
5408: fi = fori[forx];
5409:
5410: if (repQUIT) continue;
5411: if ((forsw = (nestc[nstx] == FOR))) goto for_end;
5412:
5413: goto next_line;
5414: }
5415:
5416: if (nestn[nstx]) { /* reload routine */
5417: namptr = nestn[nstx];
5418:
5419: if ((nestc[nstx] != XECUTE) || loadsw) {
5420: stcpy (rou_name, namptr);
5421: zload (rou_name);
5422:
5423: ssvn_job_update ();
5424:
5425: dosave[0] = 0;
5426: }
5427:
5428: namptr--;
5429: }
5430:
5431: if (nestnew[nstx]) unnew (); /* un-NEW variables */
5432:
5433: /* restore old pointers */
5434: if ((mcmnd = nestc[nstx]) == BREAK) {
5435: if (repQUIT) continue;
5436:
5437: goto restore;
5438: } /*cont. single step */
5439:
5440: if (mcmnd == DO_BLOCK) {
5441: test = nestlt[nstx];
5442: level--;
5443: }
5444: else { /* pop $TEST */
5445: level = nestlt[nstx]; /* pop level */
5446: }
5447:
5448: roucur = nestr[nstx] + rouptr;
5449: stcpy (codptr = code, cmdptr = nestp[nstx--]);
5450: estack--;
5451: forsw = (nestc[nstx] == FOR);
5452:
5453:
5454: loadsw = TRUE;
5455:
5456: if (mcmnd == '$') {
5457: if (repQUIT) return 0;
5458: merr_raise (NOVAL);
5459: }
5460: }
5461: repQUIT = 0;
5462: }
5463: break;
5464:
5465: /* Z-COMMANDS */
1.25 snw 5466: case ZEDIT:
5467: merr_raise (cmd_zedit (&ra));
5468: MRESCHECK(ra);
5469: break;
5470:
1.1 snw 5471: case ZGO:
5472:
5473: /* ZGO with arguments: same as GOTO but with BREAK on */
5474: if (*codptr != EOL && *codptr != SP) {
5475: mcmnd = GOTO;
5476: zbflag = TRUE;
5477: merr_raise (OK - CTRLB);
5478:
5479: goto do_goto;
5480: }
5481:
5482: /* argumentless ZGO resume execution after BREAK */
5483:
5484: if (nestc[nstx] != BREAK) {
5485: merr_raise (LVLERR);
5486: break;
5487: }
5488:
5489:
5490:
5491: merr_clear (); /* stop BREAKing */
5492:
5493: zgo:
5494:
5495: #ifdef DEBUG_NEWSTACK
5496: printf ("Zgoing: (Stack POP)\r\n");
5497: #endif
5498:
5499:
5500:
5501: if (nestn[nstx]) { /* reload routine */
5502: stcpy (rou_name, (namptr = nestn[nstx]));
5503: zload (rou_name);
5504:
5505: ssvn_job_update ();
5506:
5507: if (merr () > OK) break;
5508: }
5509:
5510: level = nestlt[nstx];
5511: roucur = nestr[nstx] + rouptr;
5512: io = brkstk[nstx];
5513:
5514: if (io & 020) {
5515: DSW &= ~BIT0;
5516: }
5517: else {
5518: DSW |= BIT0; /* restore echo state */
5519: }
5520:
5521: test = (io & 010) >> 3; /* restore $TEST */
5522:
5523: /* restore $IO; default to HOME if channel not OPEN */
5524: if ((io &= 07) != HOME && devopen[io] == 0) io = HOME;
5525:
5526: stcpy (codptr = code, cmdptr = nestp[nstx--]);
5527: estack--;
5528:
5529: forsw = (nestc[nstx] == FOR);
5530:
5531:
5532: loadsw = TRUE;
5533: zbflag = FALSE;
5534:
5535: goto next0;
5536:
5537:
5538: case ZBREAK:
5539:
5540: if (*codptr == SP || *codptr == EOL) {
5541: merr_raise (ARGLIST);
5542: break;
5543: }
5544:
5545: expr (STRING);
5546: if (merr () > OK) break;
5547:
5548: zbreakon = tvexpr (argptr);
5549: if (hardcopy == DISABLE) set_zbreak (zbreakon ? STX : -1); /* enable/disable CTRL/B */
5550:
5551: zbflag = FALSE;
5552: break;
5553:
5554:
5555:
5556:
5557: case ZLOAD:
5558:
5559: if (*codptr == EOL || *codptr == SP) {
5560: stcpy (varnam, rou_name);
5561: }
5562: else {
5563: expr (NAME);
5564:
5565: if (merr () > OK) break;
5566:
5567: codptr++;
5568: }
5569:
5570: dosave[0] = EOL;
5571:
5572: if (varnam[0] == EOL) {
5573: varerr[0] = EOL;
5574: merr_raise (NOPGM);
5575: break;
5576: } /*error */
5577:
5578: loadsw = TRUE;
5579:
5580: /* a ZLOAD on the active routine always loads from disk */
5581: if (stcmp (varnam, rou_name) == 0) {
5582: for (i = 0; i < NO_OF_RBUF; i++) {
5583:
5584: if (rouptr == (buff + (i * PSIZE0))) {
5585: pgms[i][0] = EOL;
5586:
5587: break;
5588: }
5589: }
5590: }
5591:
5592: zload (varnam);
5593:
5594: if (merr () > OK) break; /* load file */
5595:
5596: stcpy (rou_name, varnam);
5597: ssvn_job_update ();
5598:
5599: break;
5600:
5601: case ZSAVE:
5602:
5603: if (*codptr == EOL || *codptr == SP) {
5604:
5605: if (rou_name[0] == EOL) {
5606: varerr[0] = EOL;
5607: merr_raise (NOPGM);
5608:
5609: break;
1.26 snw 5610: } /* error */
1.1 snw 5611:
5612: stcpy (varnam, rou_name);
5613: }
5614: else {
5615: expr (NAME);
5616:
5617: if (varnam[0] == '^') merr_raise (GLOBER);
5618: if (varnam[0] == '$') merr_raise (INVREF);
5619: if (merr () > OK) break;
5620:
5621: stcpy (rou_name, varnam);
5622: ssvn_job_update ();
5623:
5624: codptr++;
5625: }
5626:
5627: zsave (varnam);
1.30 ! snw 5628: ssvn_routine_update ();
1.1 snw 5629: break;
5630:
5631:
5632: case ZREMOVE:
5633:
5634: {
5635: char *beg, *end;
5636:
5637: dosave[0] = EOL;
5638:
5639: if (*codptr == SP || *codptr == EOL) { /* no args is ZREMOVE all */
5640: loadsw = TRUE;
5641:
5642: for (i = 0; i < NO_OF_RBUF; i++) {
5643:
5644: if (rouptr == buff + (i * PSIZE0)) {
5645: pgms[i][0] = EOL;
5646: break;
5647: }
5648:
5649: }
5650:
5651: rouptr = buff + (i * PSIZE0);
5652: rouend = rouins = rouptr;
5653: roucur = buff + (NO_OF_RBUF * PSIZE0 + 1);
5654:
5655: *(rouptr) = EOL;
5656: *(rouptr + 1) = EOL;
5657: *(rouptr + 2) = EOL;
5658:
5659: argptr = partition;
5660: rou_name[0] = EOL;
5661:
5662: ssvn_job_update ();
5663:
5664: break;
5665: }
5666: if (*codptr == ':') {
5667: beg = rouptr;
5668: }
5669: else if (*codptr == '*') {
5670: beg = rouptr;
5671:
5672: while ((end = (beg + UNSIGN (*beg) + 2)) < rouins) beg = end;
5673:
5674: codptr++;
5675: }
5676: else {
5677: lineref (&beg);
5678: if (merr () > OK) break;
5679: }
5680:
5681: if ((end = beg) == 0) {
5682: merr_raise (M13);
5683: break;
5684: }
5685:
5686: if (*codptr == ':') { /* same as above */
5687: codptr++;
5688:
5689: if (*codptr == '*') {
5690: end = rouins;
5691: codptr++;
5692: }
5693: else if (*codptr == ',' || *codptr == SP || *codptr == EOL) {
5694: end = rouend;
5695: }
5696: else {
5697: lineref (&end);
5698:
5699: if (end == 0) merr_raise (M13);
5700: if (merr () > OK) break;
5701:
5702: end = end + UNSIGN (*end) + 2;
5703: }
5704: }
5705: else {
5706: end = end + UNSIGN (*end) + 2;
5707: }
5708:
5709: if (beg < rouend) { /* else there's nothing to zremove */
5710:
5711: if (end >= rouend) {
5712: end = rouend = beg;
5713: }
5714: else {
5715: rouins = beg;
5716:
5717: while (end <= rouend) *beg++ = (*end++);
5718:
5719: i = beg - end;
5720: rouend += i;
5721:
5722: if (roucur > end) roucur += i;
5723: }
5724:
5725: *end = EOL;
5726: *(end + 1) = EOL;
5727:
5728: for (i = 0; i < NO_OF_RBUF; i++) {
5729: if (rouptr == (buff + (i * PSIZE0))) {
5730: ends[i] = rouend;
5731: break;
5732: }
5733: }
5734:
5735: }
5736: break;
5737: }
5738:
5739: case ZINSERT:
5740:
5741: {
5742: char *beg;
5743:
5744: if (*codptr == EOL || *codptr == SP) {
5745: merr_raise (ARGLIST);
5746: break;
1.26 snw 5747: } /* error */
1.1 snw 5748:
5749: dosave[0] = EOL;
5750:
1.26 snw 5751: /* parse strlit */
1.1 snw 5752: expr (STRING);
5753:
5754: if (merr () > OK) break;
5755:
5756: if (*codptr != ':') {
5757: zi (argptr, rouins);
5758: break;
5759: }
5760:
5761: stcpy (tmp, argptr);
5762: codptr++;
5763: lineref (&beg);
5764:
5765: if (merr () > OK) break; /* parse label */
5766:
5767: if (beg) {
5768: beg = beg + UNSIGN (*beg) + 2;
5769: }
5770: else {
5771: beg = rouptr;
5772: }
5773:
5774: if (beg > rouend + 1) {
5775: merr_raise (M13);
5776: break;
5777: }
5778:
5779: /* insert stuff */
5780: zi (tmp, beg);
5781: break;
5782: }
5783:
5784:
5785: /* PRINT is convenient -
5786: * but non-standard ZPRINT should be used instead */
5787: case 'p':
5788:
5789: if (is_standard ()) {
5790: merr_raise (NOSTAND);
5791: break;
5792: }
5793:
5794:
5795: case ZPRINT:
5796:
5797: {
5798: char *beg, *end;
5799:
5800: if (*codptr == SP || *codptr == EOL) { /* no args is ZPRINT all */
5801: beg = rouptr;
5802: end = rouend;
5803: }
5804: else {
5805: if (*codptr == ':') {
5806: beg = rouptr; /* from begin */
5807: }
5808: else if (*codptr == '*') { /* from 'linepointer' */
5809: beg = rouptr;
5810:
5811: while ((end = (beg + UNSIGN (*beg) + 2)) < rouins) beg = end;
5812: codptr++;
5813: }
5814: else {
5815: lineref (&beg);
5816: if (merr () > OK) break;
5817: } /* line reference */
5818:
5819: if (beg == 0) {
5820: beg = rouptr;
5821: rouins = beg;
5822:
5823: if (*codptr != ':') break;
5824: }
5825:
5826: if (*codptr == ':') {
5827: codptr++; /* to end */
5828:
5829: if (*codptr == SP || *codptr == ',' || *codptr == EOL)
5830: end = rouend;
5831: else {
5832: if (*codptr == '*') {
5833: end = rouins;
5834: codptr++;
5835: }
5836: else { /* to 'linepointer' */
5837: lineref (&end);
5838:
5839: if (merr () > OK) break; /* line reference */
5840: end = end + UNSIGN (*end) + 2;
5841: }
5842: }
5843: }
5844: else {
5845: end = beg + 1;
5846: }
5847: }
5848: if (rouend < end) end = rouend - 1;
5849:
5850: for (; beg < end; beg += UNSIGN (*beg) + 2) {
5851:
1.8 snw 5852: if (frm_crlf[io]) {
1.1 snw 5853: write_m ("\012\201");
5854: }
5855: else {
5856: write_m ("\012\015\201");
5857: }
5858:
5859: if ((*(beg + 1)) == EOL) break;
1.28 snw 5860:
1.1 snw 5861: write_m (beg + 1);
5862: if (merr () > OK) break;
5863: }
5864:
5865: rouins = beg;
5866: }
5867:
1.8 snw 5868: if (frm_crlf[io]) {
1.1 snw 5869: write_m ("\012\201");
5870: }
5871: else {
5872: write_m ("\012\015\201");
5873: }
5874:
5875: break;
5876:
5877: case WATCH:
5878: {
5879: char op;
5880:
5881:
5882: if (((ch = *codptr) == SP) || ch == EOL) {
5883:
5884: set_io(UNIX);
5885:
5886: if (dbg_enable_watch) {
5887: printf ("Watchpoints disabled.\n");
5888: dbg_enable_watch = 0;
5889: }
5890: else {
5891: printf ("Watchpoints enabled.\n");
5892: dbg_enable_watch = 1;
5893: }
5894:
5895: break;
5896:
5897: }
5898:
5899: if ((ch = *codptr) == '(') {
5900: merr_raise (ARGLIST);
5901: goto err;
5902: }
5903:
5904: for (;;) {
5905:
5906: switch (ch) {
5907:
5908: case '?':
5909: case '+':
5910: case '-':
5911: op = ch;
5912: codptr++;
5913: break;
5914:
5915: default:
5916: merr_raise (ARGLIST);
5917: goto err;
5918: }
5919:
5920: expr (NAME); /* try to interpret an mname */
5921:
5922: if (merr () > OK) goto err;
5923:
5924: stcpy (vn, varnam);
5925:
5926: switch (op) {
5927:
5928: case '+':
5929: dbg_add_watch (vn);
5930: break;
5931:
5932: case '-':
5933: dbg_remove_watch (vn);
5934: break;
5935:
5936: case '?':
5937: dbg_dump_watch (vn);
5938: break;
5939:
5940: }
5941:
5942: if (merr () > OK) goto err;
5943:
5944: if ((ch = *(codptr + 1)) == EOL) {
5945: codptr++;
5946: break;
5947: }
5948: else if ((ch = *(codptr + 1)) == ',') {
5949: codptr += 2;
5950: ch = *codptr;
5951: }
5952: else {
5953: merr_raise (ARGLIST);
5954: goto err;
5955: }
5956: }
5957:
5958:
5959: break;
5960: }
5961:
5962:
5963: case ASSERT_TKN:
5964: {
5965: expr (STRING);
5966:
5967: if (merr () > OK) goto err;
5968:
5969: if (tvexpr (argptr) == 0) {
5970: merr_raise (ASSERT);
5971: goto err;
5972: }
5973:
5974: break;
5975: }
5976:
5977: case ZWRITE:
5978: {
5979: short k;
5980: char w_tmp[512];
5981: char zwmode;
5982:
5983:
5984: if (io != HOME && devopen[io] == 'r') {
5985: merr_raise (NOWRITE);
5986: goto err;
5987: }
5988:
5989: tmp3[0] = SP;
5990: tmp3[1] = EOL;
5991:
5992: if ((ch = (*codptr)) == '(') { /* exclusive zwrite */
5993:
5994: for (;;) {
5995:
5996: codptr++;
5997: expr (NAME);
5998:
5999: if (merr () > OK) goto err;
6000: if (varnam[0] == '^') {
6001: merr_raise (GLOBER);
6002: goto err;
6003: }
6004:
6005: i = 0;
6006:
6007: while (varnam[i] != EOL) {
6008:
6009: if (varnam[i] == DELIM) {
6010: merr_raise (SBSCR);
6011: goto err;
6012: }
6013:
6014: i++;
6015: }
6016:
6017: if (stcat (tmp3, varnam) == 0) {
6018: merr_raise (M75);
6019: goto err;
6020: }
6021:
6022: if (stcat (tmp3, " \201") == 0) {
6023: merr_raise (M75);
6024: goto err;
6025: }
6026:
6027: if ((ch = *++codptr) == ')') {
6028: codptr++;
6029: break;
6030: }
6031:
6032: if (ch != ',') {
6033: merr_raise (COMMAER);
6034: goto err;
6035: }
6036: }
6037: }
6038: else {
6039: if (ch != SP && ch != EOL) goto zwritep;
6040: }
6041:
6042: /* no arguments: write local symbol table. */
6043: stcpy (tmp, " $\201");
6044:
6045: for (;;) {
6046: ordercnt = 1L;
6047:
6048: symtab (bigquery, &tmp[1], tmp2);
6049:
6050: if (*tmp2 == EOL || merr () == INRPT) break;
6051: w_tmp[0] = '=';
6052:
6053: /* subscripts: internal format different from external one */
6054: k = 0;
6055: i = 1;
6056: j = 0;
6057:
6058: while ((ch = tmp2[k++]) != EOL) {
6059:
6060: if (ch == '"') {
6061:
6062: if (j && tmp2[k] == ch) {
6063: k++;
6064: }
6065: else {
6066: toggle (j);
6067: continue;
6068: }
6069:
6070: }
6071:
6072: if (j == 0) {
6073:
6074: if (ch == '(' || ch == ',') {
6075: tmp[i++] = DELIM;
6076:
6077: continue;
6078: }
6079:
6080: if (ch == ')') break;
6081: }
6082:
6083: tmp[i++] = ch;
6084: }
6085:
6086: tmp[i] = EOL;
6087: if (kill_ok (tmp3, tmp) == 0) continue;
6088:
6089: write_m (tmp2);
6090: symtab (get_sym, &tmp[1], &w_tmp[1]);
6091: write_m (w_tmp);
6092: write_m ("\012\015\201");
6093: }
6094:
6095: break;
6096:
6097: zwritep:
6098:
6099: expr (NAME);
6100:
6101: if (merr () > OK) goto err;
6102:
6103: codptr++;
6104:
6105: if (varnam[0] == '$') {
6106:
6107: if ((varnam[1] | 0140) == 'z' && (varnam[2] | 0140) == 'f') {
6108: w_tmp[0] = '$';
6109: w_tmp[1] = 'Z';
6110: w_tmp[2] = 'F';
6111: w_tmp[3] = '(';
6112:
6113: for (i = 0; i < 44; i++) {
6114:
6115: if (zfunkey[i][0] != EOL) {
6116: intstr (&w_tmp[4], i + 1);
6117: stcat (w_tmp, ")=\201");
6118: write_m (w_tmp);
6119: write_m (zfunkey[i]);
6120: write_m ("\012\015\201");
6121: }
6122:
6123: }
6124:
6125: break;
6126: }
6127: else {
6128: break; /* do not zwrite special variables etc. other than $ZF */
6129: }
6130: }
6131:
6132: if (varnam[0] != '^') {
1.9 snw 6133: symtab (fra_dat, varnam, tmp2);
1.1 snw 6134: zwmode = 'L';
6135: }
6136: else {
6137: if (varnam[1] == '$') {
1.9 snw 6138: ssvn (fra_dat, varnam, tmp2);
1.1 snw 6139: zwmode = '$';
6140: }
6141: else {
1.9 snw 6142: global (fra_dat, varnam, tmp2);
1.1 snw 6143: zwmode = '^';
6144: }
6145: }
6146:
6147: if (tmp2[0] == '0') break; /* variable not defined */
6148:
6149: /* if $D(@varnam)=10 get next entry */
6150: if (tmp2[1] == '0') {
6151: ordercnt = 1L;
6152:
6153: if (varnam[0] != '^') {
6154: symtab (fra_query, varnam, tmp2);
6155: zwmode = 'L';
6156: }
6157: else {
6158: if (varnam[1] == '$') {
6159: ssvn (fra_query, varnam, tmp2);
6160: zwmode = '$';
6161: }
6162: else {
6163: global (fra_query, varnam, tmp2);
6164: zwmode = '^';
6165: }
6166: }
6167: }
6168: else {
6169: k = 0;
6170: i = 0;
6171: j = 0;
6172:
6173: while ((ch = varnam[k++]) != EOL) {
6174:
6175: if (ch == DELIM) {
6176:
6177: if (j) {
6178: tmp2[i++] = '"';
6179: tmp2[i++] = ',';
6180: tmp2[i++] = '"';
6181:
6182: continue;
6183: }
6184:
6185: j++;
6186:
6187: tmp2[i++] = '(';
6188: tmp2[i++] = '"';
6189:
6190: continue;
6191: }
6192:
6193: if ((tmp2[i++] = ch) == '"')
6194: tmp2[i++] = ch;
6195: }
6196:
6197: if (j) {
6198: tmp[i++] = '"';
6199: tmp2[i++] = ')';
6200: }
6201:
6202: tmp2[i] = EOL;
6203: }
6204:
6205: for (;;) { /* subscripts: internal format different from external one */
6206: k = 0;
6207: i = 0;
6208: j = 0;
6209:
6210: while ((ch = tmp2[k++]) != EOL) {
6211:
6212: if (ch == '"') {
6213: if (j && tmp2[k] == ch)
6214: k++;
6215: else {
6216: toggle (j);
6217: continue;
6218: }
6219: }
6220:
6221: if (j == 0) {
6222:
6223: if (ch == '(' || ch == ',') {
6224: tmp[i++] = DELIM;
6225:
6226: continue;
6227: }
6228:
6229: if (ch == ')') break;
6230: }
6231:
6232: tmp[i++] = ch;
6233: }
6234:
6235: tmp[i] = EOL;
6236: i = 0;
6237:
6238: while (tmp[i] == varnam[i]) {
6239:
6240: if (varnam[i] == EOL) break;
6241:
6242: i++;
6243: }
6244:
6245: if (varnam[i] != EOL) break;
6246: if (tmp[i] != EOL && tmp[i] != DELIM) break;
6247:
6248: tmp3[0] = EOL;
6249:
6250: switch (zwmode) {
6251:
6252: case 'L':
1.9 snw 6253: symtab (fra_dat, tmp, tmp3);
1.1 snw 6254: symtab (get_sym, tmp, &w_tmp[1]);
6255:
6256: break;
6257:
6258:
6259: case '$':
1.9 snw 6260: ssvn (fra_dat, tmp, tmp3);
1.1 snw 6261: ssvn (get_sym, tmp, &w_tmp[1]);
6262:
6263: break;
6264:
6265:
6266: case '^':
1.9 snw 6267: global (fra_dat, tmp, tmp3);
1.1 snw 6268: global (get_sym, tmp, &w_tmp[1]);
6269:
6270: break;
6271: }
6272:
6273: if (tmp3[0] != '0' && tmp3[1] != '0') {
6274:
6275: write_m (tmp2);
6276:
6277: w_tmp[0] = '=';
6278:
6279: write_m (w_tmp);
6280: write_m ("\012\015\201");
6281:
6282: }
6283:
6284: ordercnt = 1L;
6285:
6286: switch (zwmode) {
6287:
6288: case 'L':
6289: symtab (fra_query, tmp, tmp2);
6290:
6291: break;
6292:
6293:
6294: case '$':
6295: ssvn (fra_query, tmp, tmp2);
6296:
6297: break;
6298:
6299:
6300: case '^':
6301: global (fra_query, tmp, tmp2);
6302:
6303: break;
6304:
6305: }
6306:
6307: if (merr () == INRPT) break;
6308: }
6309:
6310: break;
6311: }
6312:
6313:
6314: case ZTRAP:
6315:
6316: if (*codptr == SP || *codptr == EOL) {
6317: merr_raise (ZTERR);
6318: varnam[0] = EOL;
6319:
6320: break;
6321: }
6322:
6323: expr (NAME);
6324: stcpy (varerr, varnam);
6325:
6326: if (merr ()) break;
6327:
6328: if (*++codptr == ':') { /* parse postcond */
6329: codptr++;
6330:
6331: expr (STRING);
6332:
6333: if (merr () > OK) goto err;
6334:
6335: if (tvexpr (argptr) == FALSE) break;
6336: }
6337:
6338: merr_raise (ZTERR);
6339: break;
6340:
6341:
1.11 snw 6342: /* user defined Z-COMMAND */
1.1 snw 6343: case PRIVATE:
6344:
6345: private: /* for in-MUMPS defined commands */
6346: i = 0;
6347: j = 0;
6348: ch = 0;
6349:
6350: while ((tmp2[i] = *codptr) != EOL) {
6351:
6352: if (tmp2[i] == SP && !j) {
6353: tmp2[i] = EOL;
6354: break;
6355: }
6356:
6357: if (tmp2[i] == '"') j = (!j);
6358:
6359: if (!j) {
6360:
6361: if (tmp2[i] == '(') ch++;
6362: if (tmp2[i] == ')') ch--;
6363:
6364: if (!ch && tmp2[i] == ',') { /* next argument: */
6365:
6366: tmp2[i] = EOL; /* call afterwards again */
6367: i = 0;
6368:
6369: while (tmp3[i] != EOL) i++;
6370:
6371: j = i;
6372: ch = 1;
6373:
6374: while (ch < i) tmp3[j++] = tmp3[ch++];
6375:
6376: tmp3[j - 1] = SP;
6377: tmp3[j] = EOL;
6378:
6379: codptr++;
6380:
6381: j = 0;
6382: ch = 0;
6383:
6384: break;
6385: }
6386: }
6387:
6388: i++;
6389: codptr++;
6390: }
6391:
6392: if (j || ch) {
6393: merr_raise (INVREF);
6394: goto err;
6395: }
6396:
6397: stcat (tmp3, codptr);
6398:
6399: if (destructor_run) {
6400: stcpy (code, "d \201");
6401: destructor_run = FALSE;
6402: }
6403: else {
6404: if (new_object) {
6405: stcpy (code, "d ^\201");
6406: new_object = FALSE;
6407: }
6408: else {
6409: stcpy (code, "d ^%\201");
6410: }
6411: }
6412:
6413: stcat (code, &tmp3[1]);
6414:
6415: codptr = code;
6416: privflag = TRUE;
6417:
6418: goto next_cmnd;
6419:
6420: evthandler: /* for event handlers */
6421: i = 0;
6422: j = 0;
6423: ch = 0;
6424:
6425: while ((tmp2[i] = *codptr) != EOL) {
6426:
6427: if (tmp2[i] == SP && !j) {
6428: tmp2[i] = EOL;
6429: break;
6430: }
6431:
6432: if (tmp2[i] == '"') j = (!j);
6433:
6434: if (!j) {
6435:
6436: if (tmp2[i] == '(') ch++;
6437: if (tmp2[i] == ')') ch--;
6438:
6439: if (!ch && tmp2[i] == ',') { /* next argument: */
6440:
6441: tmp2[i] = EOL; /* call afterwards again */
6442: i = 0;
6443:
6444: while (tmp3[i] != EOL) i++;
6445:
6446: j = i;
6447: ch = 1;
6448:
6449: while (ch < i) tmp3[j++] = tmp3[ch++];
6450:
6451: tmp3[j - 1] = SP;
6452: tmp3[j] = EOL;
6453:
6454: codptr++;
6455:
6456: j = 0;
6457: ch = 0;
6458:
6459: break;
6460: }
6461: }
6462:
6463: i++;
6464: codptr++;
6465: }
6466:
6467: if (j || ch) {
6468: merr_raise (INVREF);
6469: goto err;
6470: }
6471:
6472: stcpy (code, "d \201");
6473: stcat (code, tmp3);
6474:
6475: codptr = code;
6476: privflag = TRUE;
6477:
6478: goto next_cmnd;
6479:
6480: case ABLOCK:
6481: case AUNBLOCK:
6482: {
6483: short evt_mask[EVT_MAX];
6484:
6485: if ((rtn_dialect () != D_MDS) &&
6486: (rtn_dialect () != D_FREEM)) {
6487: merr_raise (NOSTAND);
6488: goto err;
6489: }
6490:
6491: /* declare and initialize table of events to be blocked/unblocked with this command */
6492:
6493:
6494: for (i = 0; i < EVT_MAX; i++) evt_mask[i] = 0;
6495:
6496:
6497: /* argumentless ABLOCK/AUNBLOCK: block/unblock everything */
6498: if (((ch = *codptr) == SP) || ch == EOL) {
6499:
6500: for (i = 0; i < EVT_MAX; i++) evt_mask[i] = 1;
6501:
6502: }
6503: else if (*codptr == '(') {
6504: /* exclusive ABLOCK/AUNBLOCK */
6505:
6506: short evt_exclusions[EVT_MAX];
6507:
6508: codptr++;
6509:
6510:
6511: for (i = 0; i < EVT_MAX; i++) evt_exclusions[i] = FALSE;
6512:
6513: for (;;) {
6514:
6515: expr (STRING);
6516:
6517: if (merr () == BRAER) merr_clear ();
6518: if (merr () > OK) goto err;
6519:
6520: codptr++;
6521:
6522: stcpy (vn, argptr);
6523:
6524: if (stcmp (vn, "COMM\201") == 0) {
6525: evt_exclusions[EVT_CLS_COMM] = TRUE;
6526: }
6527: else if (stcmp (vn, "HALT\201") == 0) {
6528: evt_exclusions[EVT_CLS_HALT] = TRUE;
6529: }
6530: else if (stcmp (vn, "IPC\201") == 0) {
6531: evt_exclusions[EVT_CLS_IPC] = TRUE;
6532: }
6533: else if (stcmp (vn, "INTERRUPT\201") == 0) {
6534: evt_exclusions[EVT_CLS_INTERRUPT] = TRUE;
6535: }
6536: else if (stcmp (vn, "POWER\201") == 0) {
6537: evt_exclusions[EVT_CLS_POWER] = TRUE;
6538: }
6539: else if (stcmp (vn, "TIMER\201") == 0) {
6540: evt_exclusions[EVT_CLS_TIMER] = TRUE;
6541: }
6542: else if (stcmp (vn, "USER\201") == 0) {
6543: evt_exclusions[EVT_CLS_USER] = TRUE;
6544: }
6545: else if (stcmp (vn, "WAPI\201") == 0) {
6546: evt_exclusions[EVT_CLS_WAPI] = TRUE;
6547: }
6548: else {
6549: merr_raise (CMMND);
6550: goto err;
6551: }
6552:
6553: if ((ch = *(codptr + 1)) == EOL || ch == SP) {
6554: codptr++;
6555: break;
6556: }
6557: if ((ch = *(codptr + 1)) == ')') {
6558: codptr++;
6559: break;
6560: }
6561:
6562: }
6563:
6564: for (i = 0; i < EVT_MAX; i++) {
6565:
6566: if (evt_exclusions[i] == FALSE) evt_mask[i] = 1;
6567:
6568: }
6569:
6570: }
6571: else {
6572: /* inclusive ABLOCK/AUNBLOCK */
6573:
6574: for (;;) {
6575:
6576: expr (STRING); /* try to interpret a string */
6577: if (merr () > OK) goto err;
6578:
6579: codptr++;
6580:
6581: stcpy (vn, argptr);
6582:
6583: if (stcmp (vn, "COMM\201") == 0) {
6584: evt_mask[EVT_CLS_COMM] = 1;
6585: }
6586: else if (stcmp (vn, "HALT\201") == 0) {
6587: evt_mask[EVT_CLS_HALT] = 1;
6588: }
6589: else if (stcmp (vn, "IPC\201") == 0) {
6590: evt_mask[EVT_CLS_IPC] = 1;
6591: }
6592: else if (stcmp (vn, "INTERRUPT\201") == 0) {
6593: evt_mask[EVT_CLS_INTERRUPT] = 1;
6594: }
6595: else if (stcmp (vn, "POWER\201") == 0) {
6596: evt_mask[EVT_CLS_POWER] = 1;
6597: }
6598: else if (stcmp (vn, "TIMER\201") == 0) {
6599: evt_mask[EVT_CLS_TIMER] = 1;
6600: }
6601: else if (stcmp (vn, "TRIGGER\201") == 0) {
6602: evt_mask[EVT_CLS_TRIGGER] = 1;
6603: }
6604: else if (stcmp (vn, "USER\201") == 0) {
6605: evt_mask[EVT_CLS_USER] = 1;
6606: }
6607: else if (stcmp (vn, "WAPI\201") == 0) {
6608: evt_mask[EVT_CLS_WAPI] = 1;
6609: }
6610: else {
6611: merr_raise (CMMND);
6612: goto err;
6613: }
6614:
6615: if (merr () > OK) goto err;
6616:
6617:
6618: if ((ch = *(codptr)) == EOL || ch == SP) {
6619: break;
6620: }
6621:
6622: }
6623:
6624: }
6625:
6626: for (i = 0; i < EVT_MAX; i++) {
6627:
6628: if (evt_mask[i] > 0) {
6629:
6630: if (mcmnd == ABLOCK) {
6631: evt_ablock (i);
6632: }
6633: else {
6634: evt_aunblock (i);
6635: }
6636: }
6637:
6638: }
6639:
6640:
6641: break;
6642: }
6643:
6644:
6645: case ASSIGN:
6646: merr_raise (CMMND);
6647: break;
6648:
6649:
6650: case ASTOP:
6651: case ASTART:
6652: {
6653: short evt_mask[EVT_MAX];
6654: short new_status;
6655:
6656: if ((rtn_dialect () != D_MDS) &&
6657: (rtn_dialect () != D_FREEM)) {
6658: merr_raise (NOSTAND);
6659: goto err;
6660: }
6661:
6662: /* declare and initialize table of events to be enabled with this command */
6663:
6664: if (mcmnd == ASTART) {
6665: new_status = EVT_S_ASYNC;
6666: }
6667: else {
6668: new_status = EVT_S_DISABLED;
6669: }
6670:
6671:
6672: for (i = 0; i < EVT_MAX; i++) evt_mask[i] = EVT_S_NOMODIFY;
6673:
6674:
6675: /* argumentless ASTART/ASTOP: enable/disable everything */
6676: if (((ch = *codptr) == SP) || ch == EOL) {
6677:
6678: for (i = 0; i < EVT_MAX; i++) evt_mask[i] = new_status;
6679:
6680: }
6681: else if (*codptr == '(') {
6682: /* exclusive ASTART */
6683:
6684: short evt_exclusions[EVT_MAX];
6685:
6686: codptr++;
6687:
6688: for (i = 0; i < EVT_MAX; i++) evt_exclusions[i] = FALSE;
6689:
6690: for (;;) {
6691:
6692: expr (STRING);
6693:
6694: if (merr () == BRAER) merr_clear ();
6695: if (merr () > OK) goto err;
6696:
6697: codptr++;
6698:
6699: stcpy (vn, argptr);
6700:
6701: if (stcmp (vn, "COMM\201") == 0) {
6702: evt_exclusions[EVT_CLS_COMM] = TRUE;
6703: }
6704: else if (stcmp (vn, "HALT\201") == 0) {
6705: evt_exclusions[EVT_CLS_HALT] = TRUE;
6706: }
6707: else if (stcmp (vn, "IPC\201") == 0) {
6708: evt_exclusions[EVT_CLS_IPC] = TRUE;
6709: }
6710: else if (stcmp (vn, "INTERRUPT\201") == 0) {
6711: evt_exclusions[EVT_CLS_INTERRUPT] = TRUE;
6712: }
6713: else if (stcmp (vn, "POWER\201") == 0) {
6714: evt_exclusions[EVT_CLS_POWER] = TRUE;
6715: }
6716: else if (stcmp (vn, "TIMER\201") == 0) {
6717: evt_exclusions[EVT_CLS_TIMER] = TRUE;
6718: }
6719: else if (stcmp (vn, "USER\201") == 0) {
6720: evt_exclusions[EVT_CLS_USER] = TRUE;
6721: }
6722: else if (stcmp (vn, "WAPI\201") == 0) {
6723: evt_exclusions[EVT_CLS_WAPI] = TRUE;
6724: }
6725: else if (stcmp (vn, "TRIGGER\201") == 0) {
6726: evt_exclusions[EVT_CLS_TRIGGER] = TRUE;
6727: }
6728: else {
6729: merr_raise (CMMND);
6730: goto err;
6731: }
6732:
6733: if ((ch = *(codptr + 1)) == EOL || ch == SP) {
6734: codptr++;
6735: break;
6736: }
6737: if ((ch = *(codptr + 1)) == ')') {
6738: codptr++;
6739: break;
6740: }
6741:
6742: }
6743:
6744: for (i = 0; i < EVT_MAX; i++) {
6745:
6746: if (evt_exclusions[i] == FALSE) evt_mask[i] = new_status;
6747:
6748: }
6749:
6750: }
6751: else {
6752: /* inclusive ASTART */
6753:
6754: for (;;) {
6755:
6756: expr (STRING); /* try to interpret a string */
6757: if (merr () > OK) goto err;
6758:
6759: codptr++;
6760:
6761: stcpy (vn, argptr);
6762:
6763: if (stcmp (vn, "COMM\201") == 0) {
6764: evt_mask[EVT_CLS_COMM] = new_status;
6765: }
6766: else if (stcmp (vn, "HALT\201") == 0) {
6767: evt_mask[EVT_CLS_HALT] = new_status;
6768: }
6769: else if (stcmp (vn, "IPC\201") == 0) {
6770: evt_mask[EVT_CLS_IPC] = new_status;
6771: }
6772: else if (stcmp (vn, "INTERRUPT\201") == 0) {
6773: evt_mask[EVT_CLS_INTERRUPT] = new_status;
6774: }
6775: else if (stcmp (vn, "POWER\201") == 0) {
6776: evt_mask[EVT_CLS_POWER] = new_status;
6777: }
6778: else if (stcmp (vn, "TIMER\201") == 0) {
6779: evt_mask[EVT_CLS_TIMER] = new_status;
6780: }
6781: else if (stcmp (vn, "USER\201") == 0) {
6782: evt_mask[EVT_CLS_USER] = new_status;
6783: }
6784: else if (stcmp (vn, "WAPI\201") == 0) {
6785: evt_mask[EVT_CLS_WAPI] = new_status;
6786: }
6787: else if (stcmp (vn, "TRIGGER\201") == 0) {
6788: evt_mask[EVT_CLS_TRIGGER] = new_status;
6789: }
6790: else {
6791: merr_raise (CMMND);
6792: goto err;
6793: }
6794:
6795: if (merr () > OK) goto err;
6796:
6797:
6798: if ((ch = *(codptr)) == EOL || ch == SP) {
6799: break;
6800: }
6801:
6802: }
6803:
6804: }
6805:
6806: for (i = 0; i < EVT_MAX; i++) {
6807:
6808: if (evt_status[i] == EVT_S_SYNC && evt_mask[i] == EVT_S_ASYNC) {
6809:
6810: /* cannot enable both synchronous and asynchronous
6811: event processing on the same event class at the
6812: same time */
6813:
6814: merr_raise (M102);
6815: goto err;
6816:
6817: }
6818: else {
6819:
6820: if (evt_mask[i] > EVT_S_NOMODIFY) {
6821: evt_status[i] = evt_mask[i];
6822: }
6823:
6824: }
6825:
6826: }
6827:
6828: if (mcmnd == ASTART) {
6829: evt_async_enabled = TRUE;
6830: }
6831: else {
6832: short disabled_evt_count = 0;
6833:
6834: for (i = 0; i < EVT_MAX; i++) {
6835: if (evt_status[i] == EVT_S_DISABLED) {
6836: disabled_evt_count++;
6837: }
6838: }
6839:
6840: if (disabled_evt_count == (EVT_MAX - 1)) evt_async_enabled = FALSE;
6841:
6842: }
6843:
6844: break;
6845: }
6846:
6847:
6848:
6849:
6850: case ETRIGGER:
6851:
6852: merr_raise (CMMND);
6853: break;
6854:
6855:
6856: #if defined(HAVE_MWAPI_MOTIF)
6857: case ESTART:
6858: if ((rtn_dialect () != D_MDS) &&
6859: (rtn_dialect () != D_FREEM)) {
6860: merr_raise (NOSTAND);
6861: goto err;
6862: }
6863:
6864: {
6865: if (in_syn_event_loop == TRUE) break;
6866:
6867: int evt_count;
6868: char *syn_handlers = (char *) malloc (STRLEN * sizeof (char));
6869:
6870: /* stack ^$EVENT */
6871: char key[100] = "^$EVENT\202\201";
6872: symtab (new_sym, key, " \201");
6873:
6874: evt_sync_enabled = TRUE;
6875: in_syn_event_loop = TRUE;
6876:
6877: while (evt_sync_enabled) {
6878:
6879:
6880: /* run the next iteration of GTK's event loop */
1.13 snw 6881: /* TODO: replace with libXt event loop */
6882: /* gtk_main_iteration_do (TRUE); */
1.1 snw 6883:
6884: /* dequeue any events */
6885: evt_count = mwapi_dequeue_events (syn_handlers);
6886:
6887: if (evt_count) {
6888: /* write them out */
1.13 snw 6889: /* printf ("event handlers = '%s'\r\n", syn_handlers); */
1.1 snw 6890:
6891: syn_event_entry_nstx = nstx;
6892:
6893: stcnv_c2m (syn_handlers);
6894: stcpy (tmp3, syn_handlers);
6895:
6896: syn_handlers[0] = '\0';
6897:
6898: goto evthandler;
6899: }
6900:
6901: syn_evt_loop_bottom:
6902: continue;
6903: }
6904:
6905: in_syn_event_loop = FALSE;
6906: evt_sync_enabled = FALSE;
6907:
6908: break;
6909: }
6910:
6911:
6912: case ESTOP:
6913: if ((rtn_dialect () != D_MDS) &&
6914: (rtn_dialect () != D_FREEM)) {
6915: merr_raise (NOSTAND);
6916: goto err;
6917: }
6918:
6919: evt_sync_enabled = FALSE;
6920: break;
6921: #endif
6922:
6923:
6924: default:
6925: merr_raise (CMMND);
6926:
6927: } /* command switch */
6928:
6929: if ((ch = *codptr) == EOL) {
6930: if (merr () != OK) goto err;
6931: if (forsw) goto for_end;
6932:
6933: mcmnd = 0;
6934:
6935: goto next_line;
6936: }
6937:
6938: if (ch == SP) {
6939: if (merr () == OK) goto next0;
6940:
6941: goto err;
6942: }
6943:
6944: if (ch != ',' && merr () == OK) {
6945: merr_raise (SPACER);
6946: }
1.19 snw 6947: else if (ierr <= OK) {
1.1 snw 6948: if (*++codptr != SP && *codptr != EOL) goto again;
6949:
6950: merr_raise (ARGLIST);
6951: }
6952:
6953: /* else goto err; */
6954:
6955: /* error */
6956: err:
6957:
6958: /* avoid infinite loops resulting from errors in argumentless FOR loops */
6959: if (merr () != OK && merr () != ASYNC && forsw && ftyp == 0) {
6960: argless_forsw_quit = TRUE;
6961: goto for_end;
6962: }
6963:
6964: /*
6965: * ierr == ASYNC means that the previous command was interrupted by
6966: * an async event. It is not a real error, so just go on to the next
6967: * command after resetting ierr = OK.
6968: */
6969: if (merr () == ASYNC) {
6970: merr_clear ();
6971: goto next_cmnd;
6972: }
6973:
6974: if (merr () > OK) {
6975: job_set_status (pid, JSTAT_ERROR);
6976: }
6977:
6978: if (ierr < 0) {
6979:
6980: ierr += CTRLB;
6981:
6982: if (merr () == OK) {
6983: zbflag = TRUE;
6984:
6985: goto zb_entry;
6986: }
6987: }
6988:
1.19 snw 6989:
1.1 snw 6990: if (merr () > OK ) {
6991:
6992: char er_buf[ERRLEN];
6993:
6994: merr_set_ecode_ierr ();
6995:
6996: stcpy (er_buf, errmes[merr ()]);
6997: stcnv_m2c (er_buf);
6998:
1.19 snw 6999:
1.1 snw 7000: #if !defined(MSDOS)
1.15 snw 7001: logprintf (FM_LOG_DEBUG, "xecline: interpreter error %d [%s]", ierr, er_buf);
1.1 snw 7002: #endif
7003:
7004: }
7005:
7006: zerr = ierr;
7007: merr_clear ();
7008:
7009: /* goto restart; */
7010:
7011:
7012: restart:
7013:
7014: if (param) goto restore;
7015:
7016: dosave[0] = EOL;
7017: setpiece = FALSE;
7018: setop = 0;
7019: privflag = FALSE;
7020:
7021: if (merr () == INRPT) goto err;
7022: if (zerr == STORE) symtab (kill_all, "", "");
7023:
7024: if (errfunlvl > 0) {
7025: errfunlvl--;
7026: }
7027: else {
7028:
7029: if (zerr == OK) {
7030: zerror[0] = EOL; /* reset error */
7031: }
7032: else {
7033:
7034: #ifdef DEBUG_STACK
7035: printf ("Storing NESTERR\r\n");
7036: #endif
7037:
7038: nesterr = nstx; /* save stack information at error */
7039:
7040: for (i = 1; i <= nstx; i++) getraddress (callerr[i], i);
7041:
7042: zerror[0] = '<';
7043:
7044: if (etxtflag) {
7045: stcpy (&zerror[1], errmes[zerr]);
7046: }
7047: else {
7048: intstr (&zerror[1], zerr);
7049: }
7050:
7051: stcat (zerror, ">\201");
7052:
7053: if (rou_name[0] != EOL) {
7054: char *j0;
7055: char *j1;
7056: char tmp1[256];
7057:
7058:
7059:
7060: if (nestc[nstx] == XECUTE) {
7061:
7062: if (nestn[nstx]) { /* reload routine */
7063: zload (nestn[nstx]);
7064: merr_clear ();
7065: }
7066:
7067: roucur = nestr[nstx] + rouptr; /* restore roucur */
7068: }
7069:
7070:
7071:
7072: j0 = (rouptr - 1);
7073: j = 0;
7074: tmp1[0] = EOL;
7075: j0++;
7076:
7077: if (roucur < rouend) {
7078:
7079: while (j0 < (roucur - 1)) {
7080:
7081: j1 = j0++;
7082: j++;
7083:
7084: if ((*j0 != TAB) && (*j0 != SP)) {
7085:
7086: j = 0;
7087:
7088: while ((tmp1[j] = (*(j0++))) > SP) {
7089:
7090: if (tmp1[j] == '(') tmp1[j] = EOL;
7091:
7092: j++;
7093: }
7094:
7095: tmp1[j] = EOL;
7096: j = 0;
7097: }
7098:
7099: j0 = j1;
7100: j0 += (UNSIGN (*j1)) + 2;
7101: }
7102: }
7103:
7104: stcat (zerror, tmp1);
7105:
7106: if (j > 0) {
7107: i = stlen (zerror);
7108: zerror[i++] = '+';
7109:
7110: intstr (&zerror[i], j);
7111: }
7112:
7113: stcat (zerror, "^\201");
7114:
7115:
7116:
7117: if (nestc[nstx] == XECUTE) {
7118:
7119: if (nestn[nstx]) { /* reload routine */
7120: zload (rou_name);
7121:
7122: ssvn_job_update ();
7123:
7124: merr_clear ();
7125: }
7126:
7127: stcat (zerror, nestn[nstx]);
7128: }
7129: else
7130: stcat (zerror, rou_name);
7131: }
7132:
7133: if (zerr == UNDEF) zerr = M6;
7134:
7135: /* undefined: report variable name */
7136: if (zerr == UNDEF || zerr == SBSCR || zerr == NAKED || zerr == ZTERR || zerr == DBDGD || zerr == LBLUNDEF || zerr == NOPGM || zerr == M6 || zerr == M7 || zerr == M13) {
7137:
7138: int f; /* include erroneous reference */
7139:
7140: f = stlen (zerror);
7141: zerror[f++] = SP;
7142: zname (&zerror[f], varerr);
7143: } /* end varnam section */
7144: }
7145: }
7146:
7147: roucur = buff + (NO_OF_RBUF * PSIZE0 + 1);
7148: tmp4[0] = EOL;
7149:
7150: while (ierr != (OK - CTRLB)) {
7151:
7152:
7153: /* standard error handling */
7154: if (etrap[0] != EOL && stcmp (ecode, "") != 0) {
7155:
7156: on_frame_entry ();
7157:
7158: /* disable $ZTRAP error handling */
7159: ztrap[nstx][0] = EOL;
7160:
7161: stcpy (tmp4, etrap);
7162: stcat (tmp4, " quit:$quit \"\" quit\201");
7163:
7164: if (etrap_lvl > 1) {
7165: /* we've encountered an error within an error handler.
7166: save off the error code at merr_stack[nstx + 1].ECODE */
7167:
7168: stcpy (merr_stack[nstx + 1].ECODE, ecode);
7169: merr_topstk = nstx + 1;
7170: etrap_lvl++;
7171:
7172: }
7173: else {
7174: merr_topstk = nstx;
7175: etrap_lvl++;
7176: }
7177:
7178: break;
7179:
7180: }
7181:
7182:
7183:
7184: if (ztrap[nstx][0] != EOL && !DSM2err) {
7185:
7186: #ifdef DEBUG_NEWSTACK
7187:
7188: printf ("Dropped into Ztrap [");
7189:
7190: for (loop = 0; loop < 20 && ztrap[nstx][loop] != EOL; loop++) {
7191: printf ("%c", ztrap[nstx][loop]);
7192: }
7193:
7194: printf ("]\r\n");
7195:
7196: #endif
7197:
7198: tmp4[0] = GOTO;
7199: tmp4[1] = SP;
7200: stcpy (&tmp4[2], ztrap[nstx]);
7201: ztrap[nstx][0] = EOL;
7202:
7203: #ifdef DEBUG_NEWSTACK
7204:
7205: printf ("Set tmp4 to [");
7206: for (loop = 0; tmp4[loop] != EOL; loop++) printf ("%c", tmp4[loop]);
7207: printf ("]\r\n");
7208:
7209: #endif
7210:
7211: break;
7212: }
7213:
7214:
7215:
7216: if (nstx == 0) {
7217:
7218: #ifdef DEBUG_NEWSTACK
7219: printf ("Nestx was Zero\r\n");
7220: #endif
7221:
7222: forx = 0;
7223: cmdptr = cmdstack;
7224: namptr = namstck;
7225: level = 0;
7226: errfunlvl = 0;
7227: io = HOME; /* trap to direct mode: USE 0 */
7228:
7229: if (zerr == INRPT && frm_filter) {
7230: tmp4[0] = 'h';
7231: tmp4[1] = EOL;
7232: }
7233:
7234: if (DSM2err && (ztrap[NESTLEVLS + 1][0] != EOL)) { /* DSM V.2 error trapping */
7235:
7236: #ifdef DEBUG_NEWSTACK
7237: printf ("Ztrap 2\r\n");
7238: #endif
7239:
7240: tmp4[0] = GOTO;
7241: tmp4[1] = SP; /* GOTO errorhandling */
7242:
7243: stcpy (&tmp4[2], ztrap[NESTLEVLS + 1]);
7244: ztrap[NESTLEVLS + 1][0] = EOL;
7245:
7246: }
7247:
7248: break;
7249: }
7250:
7251: #ifdef DEBUG_NEWSTACK
7252: printf ("Nestc[nstx] is [%d]\r\n", nestc[nstx]);
7253: #endif
7254:
7255: if (nestc[nstx] == BREAK) break;
7256:
7257: if (merr () > OK) goto err;
7258:
7259: if (nestc[nstx] == FOR) {
7260: if (forx == 0) goto for_quit;
7261: ftyp = fortyp[--forx];
7262: fvar = forvar[forx];
7263: finc = forinc[forx];
7264: flim = forlim[forx];
7265: fi = fori[forx];
7266: }
7267: else {
7268:
7269: if (nestc[nstx] == DO_BLOCK) {
7270: test = nestlt[nstx];
7271: level--;
7272: }
7273: else { /* pop $TEST */
7274: level = nestlt[nstx]; /* pop level */
7275: }
7276:
7277: #ifdef DEBUG_NEWSTACK
7278: printf ("Nestn[nstx] is [%d]\r\n", nestn[nstx]);
7279: #endif
7280:
7281: if (nestn[nstx]) { /* 'reload' routine */
7282: namptr = nestn[nstx];
7283: stcpy (rou_name, namptr);
7284: zload (rou_name);
7285:
7286: ssvn_job_update ();
7287:
7288: dosave[0] = 0;
7289:
7290: namptr--;
7291: }
7292:
7293: #ifdef DEBUG_NEWSTACK
7294: printf ("Execcing the rest...\r\n");
7295: #endif
7296:
7297: roucur = nestr[nstx] + rouptr;
7298:
7299: if (nestnew[nstx]) unnew (); /* un-NEW variables */
7300:
7301: cmdptr = nestp[nstx];
7302:
7303: if (nestc[nstx--] == '$') { /* extrinsic function/variable */
7304: *argptr = EOL;
7305: merr_raise (zerr);
7306: errfunlvl++;
7307:
7308: return 0;
7309: }
7310: estack--;
7311: }
7312: }
7313:
7314: forsw = FALSE;
7315:
7316: /* PRINTING ERROR MESSAGES */
7317: if (tmp4[0] == EOL) {
7318:
7319: if (zerr == BKERR && brkaction[0] != EOL) {
7320: stcpy (code, brkaction);
7321: codptr = code;
7322:
7323: if (libcall == TRUE) {
7324: return zerr;
7325: }
7326: else {
7327: goto next_cmnd;
7328: }
7329: }
7330:
7331: if (libcall == TRUE) return zerr;
7332:
7333: DSW &= ~BIT0; /* enable ECHO */
7334:
1.13 snw 7335: /* print here */
1.1 snw 7336: {
7337: char *t_rtn;
7338: char *t_nsn = (char *) malloc (STRLEN * sizeof (char));
7339: char *t_cod;
7340: int t_pos;
7341:
7342: NULLPTRCHK(t_nsn,"xecline");
7343:
7344: t_rtn = strtok (zerror, ">");
7345: t_rtn = strtok (NULL, ">");
7346:
7347: if (t_rtn != NULL && t_rtn[1] == '%') {
7348: strcpy (t_nsn, "SYSTEM");
7349: }
7350: else {
7351: strcpy (t_nsn, nsname);
7352: }
7353:
7354: if (deferred_ierr > OK) {
7355: t_cod = deferrable_code;
7356: t_pos = deferrable_codptr - code + 3;
7357: }
7358: else {
7359: t_cod = code;
7360: t_pos = codptr - code + 3;
7361: }
7362:
7363: if (t_rtn != NULL) {
7364: merr_dump (zerr, t_rtn, t_nsn, t_cod, t_pos);
7365: }
7366: else {
7367: merr_dump (zerr, "<UNKNOWN>", t_nsn, t_cod, t_pos);
7368: }
7369:
7370:
7371: free (t_nsn);
1.19 snw 7372:
1.1 snw 7373: }
7374:
7375:
7376: }
7377: else {
7378: stcpy (code, tmp4);
7379:
7380: codptr = code;
7381: tmp4[0] = EOL;
7382:
7383: goto next_cmnd;
7384: }
7385:
7386: restore:
7387:
7388: io = HOME;
7389: codptr = code;
7390:
7391: if (param > 0) {
7392:
7393: j = 0;
7394: ch = 0;
7395: paramx++;
7396: param--;
7397:
7398: for (;;) {
7399: if (m_argv[++j][0] == '-') {
7400: i = 0;
7401:
7402: while ((m_argv[j][++i] != 0) && (m_argv[j][i] != 'x'));
7403:
7404: if (m_argv[j][i] != 'x') continue;
7405:
7406: j++;
7407:
7408: if (++ch < paramx) continue;
7409:
7410: strcpy (code, m_argv[j]);
7411: break;
7412: }
7413: else {
7414: if (++ch < paramx) continue;
7415:
7416: strcpy (code, "d ");
7417: strcpy (&code[2], m_argv[j]);
7418: break;
7419: }
7420: }
7421: code[strlen (code)] = EOL;
7422: codptr = code;
7423: goto next_cmnd;
7424:
7425: }
7426:
7427: if (usermode == 0) { /* application mode: direct mode implies HALT */
7428: code[0] = 'H';
7429: code[1] = EOL;
7430: codptr = code;
7431:
7432: goto next_cmnd;
7433: }
7434:
7435: if (libcall == TRUE) { /* library mode: don't go to direct mode, just return */
7436: return merr ();
7437: }
7438:
7439:
7440: do {
7441:
7442: if (frm_filter == FALSE && promflag) {
7443: stcpy (code, " \201");
7444: stcpy (&code[2], " \201");
7445: promflag = FALSE;
7446: }
7447: else {
7448:
7449: direct_mode:
7450:
7451: if (dbg_enable_watch && dbg_pending_watches) dbg_dump_watchlist ();
7452:
7453: /* DIRECT-MODE PROMPT HERE */
7454: #if defined(HAVE_LIBREADLINE) && !defined(_AIX)
7455: {
7456: char *fmrl_buf;
7457: char fmrl_prompt[256];
7458: HIST_ENTRY **hist_list;
7459: int hist_idx;
7460: HIST_ENTRY *hist_ent;
7461:
1.27 snw 7462: rl_attempted_completion_function = command_completion;
7463:
1.1 snw 7464: if (quiet_mode == FALSE) {
7465: if (tp_level == 0) {
1.14 snw 7466: snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s.%s> ", shm_env, nsname);
1.1 snw 7467: }
7468: else {
1.14 snw 7469: snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1 , "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname);
1.1 snw 7470: }
7471: }
7472: set_io (UNIX);
7473:
7474: job_set_status (pid, JSTAT_DIRECTMODE);
1.23 snw 7475:
7476: #if defined(__NetBSD__)
7477: printf ("\r\n");
7478: #endif
7479:
1.1 snw 7480: /* readline() does its own malloc() */
7481: fmrl_buf = readline (fmrl_prompt);
7482:
7483: if (!fmrl_buf) {
7484: set_io (UNIX);
7485: printf ("\n");
7486: set_io (MUMPS);
7487:
7488: goto halt;
7489: }
1.23 snw 7490:
1.1 snw 7491:
7492: if (strlen (fmrl_buf) > 0) {
7493: add_history (fmrl_buf);
7494: }
7495:
7496: if (fmrl_buf[0] == '?') {
7497:
7498: char kb[20];
1.14 snw 7499: char db[STRLEN];
1.1 snw 7500:
1.29 snw 7501: snprintf (kb, sizeof (kb) - 1, "%%SYSHLP\201");
1.14 snw 7502: snprintf (db, STRLEN - 1, "\201");
1.1 snw 7503:
7504: symtab (kill_sym, kb, db);
7505:
7506: /* Invoke Online Help */
7507:
7508: set_io (MUMPS);
7509: stcpy (code, "DO ^%ZHELP\201");
7510:
7511: if (strlen (fmrl_buf) > 1) {
1.14 snw 7512: snprintf (db, STRLEN - 1, "%s\201", &fmrl_buf[1]);
1.1 snw 7513: symtab (set_sym, kb, db);
7514: }
7515:
7516: }
7517: else if (strcmp (fmrl_buf, "rbuf") == 0) {
7518: rbuf_dump ();
7519: }
7520: else if (strcmp (fmrl_buf, "jobtab") == 0) {
7521: job_dump ();
7522: }
7523: else if (strcmp (fmrl_buf, "locktab") == 0) {
7524: locktab_dump ();
7525: code[0] = '\201';
7526: codptr = code;
7527: }
7528: else if (strcmp (fmrl_buf, "shmstat") == 0) {
7529: shm_dump ();
7530: }
7531: else if (strcmp (fmrl_buf, "shmpages") == 0) {
7532: shm_dump_pages ();
7533: }
7534: else if (strcmp (fmrl_buf, "glstat") == 0) {
7535: gbl_dump_stat ();
7536: }
7537: else if (strcmp (fmrl_buf, "events") == 0) {
7538:
7539: char stat_desc[30];
7540: char *evclass_name;
7541:
7542: printf ("\n%-20s %-15s %s\n", "Event Class", "Processing Mode", "ABLOCK Count");
7543: printf ("%-20s %-15s %s\n", "-----------", "---------------", "------------");
7544:
7545: for (i = 0; i < EVT_MAX; i++) {
7546:
7547: evclass_name = evt_class_name_c (i);
7548:
7549: switch (evt_status[i]) {
7550: case EVT_S_DISABLED:
7551: strcpy (stat_desc, "Disabled");
7552: break;
7553: case EVT_S_ASYNC:
7554: strcpy (stat_desc, "Asynchronous");
7555: break;
7556: case EVT_S_SYNC:
7557: strcpy (stat_desc, "Synchronous");
7558: }
7559:
7560: printf ("%-20s %-15s %d\n", evclass_name, stat_desc, evt_blocks[i]);
7561:
7562: }
7563:
7564:
7565: }
7566: else if (strcmp (fmrl_buf, "wh") == 0) {
7567: write_history (history_file);
7568: }
7569: else if (strcmp (fmrl_buf, "trantab") == 0) {
7570: tp_tdump();
7571: }
7572: else if (isdigit(fmrl_buf[0]) || (fmrl_buf[0] == '(') || (fmrl_buf[0] == '-') || (fmrl_buf[0] == '\'') || (fmrl_buf[0] == '+') || (fmrl_buf[0] == '$') || (fmrl_buf[0] == '^')) {
7573:
1.14 snw 7574: snprintf (code, STRLEN - 1, "W %s", fmrl_buf);
1.1 snw 7575: stcnv_c2m (code);
7576:
7577: set_io (MUMPS);
7578:
7579: }
7580: #if !defined(__APPLE__)
7581: else if (strcmp (fmrl_buf, "history") == 0) {
7582:
7583: /* History List */
7584:
7585: hist_list = history_list ();
7586: if (hist_list) {
7587:
7588: for (i = 0; hist_list[i]; i++) {
7589: printf("%d: %s\n", i + history_base, hist_list[i]->line);
7590: }
7591:
7592: }
7593:
7594: stcpy (code, " \201");
7595:
7596: set_io (MUMPS);
7597:
7598: }
7599: #endif
7600: else if (strncmp (fmrl_buf, "rcl", 3) == 0) {
7601:
7602: /* Recall History Item */
7603:
7604:
7605:
7606: if (!isdigit (fmrl_buf[4])) {
7607: fprintf (stderr, "invalid history index '%s'\n", &fmrl_buf[4]);
7608:
7609: set_io (MUMPS);
7610: stcpy (code, " \201");
7611:
7612: break;
7613: }
7614:
7615: hist_idx = atoi (&fmrl_buf[4]);
7616:
7617: if ((hist_idx > history_length) || (hist_idx < 1)) {
7618: fprintf (stderr, "history entry %d out of range (valid entries are 1-%d)\n", hist_idx, history_length);
7619:
7620: set_io (MUMPS);
7621: stcpy (code, " \201");
7622:
7623: break;
7624: }
7625:
7626: hist_ent = history_get (hist_idx);
7627:
7628: printf ("%s\n", hist_ent->line);
7629:
7630: strncpy (code, hist_ent->line, 255);
7631: stcnv_c2m (code);
7632:
7633: set_io (MUMPS);
7634:
7635: }
7636: else {
7637:
7638: /* Pass to M Interpreter */
7639:
7640: set_io (MUMPS);
7641:
7642: strncpy (code, fmrl_buf, 255);
7643: stcnv_c2m (code);
7644:
7645: }
7646:
7647: /* free the buffer malloc()'d by readline() */
7648: if (fmrl_buf) free (fmrl_buf);
7649: }
7650: #else
7651:
7652: {
7653: char fmrl_prompt[256];
7654:
7655: if (tp_level == 0) {
1.14 snw 7656: snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s> \201", nsname);
1.1 snw 7657: }
7658: else {
1.14 snw 7659: snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\nTL%d:%s> \201", tp_level, nsname);
1.1 snw 7660: }
7661:
7662: write_m (fmrl_prompt);
7663:
7664: read_m (code, -1L, 0, 255); /* Not necessarily STRLEN? */
7665: }
7666:
7667: promflag = TRUE;
7668: #endif
7669:
7670: if (merr () > OK) goto err;
7671:
7672: if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) {
7673:
7674: debug_mode = TRUE;
7675: merr_raise (OK - CTRLB);
7676:
7677: goto zgo;
7678: } /* single step */
7679: }
7680: }
7681: while (code[0] == EOL);
7682:
7683: if (promflag) write_m ("\r\n\201");
7684:
7685: /* automatic ZI in direct mode: insert an entry with TAB */
7686: i = (-1);
7687: j = 0;
7688: merr_clear ();
7689:
7690: while (code[++i] != EOL) {
7691: if (code[i] == '"') toggle (j);
7692:
7693: if (code[i] == TAB && j == 0) {
7694: dosave[0] = EOL;
7695:
7696: zi (code, rouins);
7697: if (merr ()) goto err;
7698: goto restore;
7699: }
7700: }
7701:
7702: code[++i] = EOL;
7703: code[++i] = EOL;
7704:
7705: roucur = buff + (NO_OF_RBUF * PSIZE0 + 1);
7706:
7707: goto next_cmnd;
7708:
7709: skip_line:
7710:
7711: if (forsw) goto for_end;
7712: goto next_line;
7713:
7714: } /*end of xecline() */
7715:
7716: void on_frame_entry(void)
7717: {
7718: return;
7719: }
7720:
7721: void rbuf_dump(void)
7722: {
7723: register int i;
7724: char rnam[256];
7725: char rpth[256];
7726: char ldtime[80];
7727: char flgs[80];
7728: time_t ag;
7729: struct tm tld;
7730:
7731:
7732: printf ("ROUTINE BUFFER CONFIGURATION\r\n");
1.2 snw 7733: printf (" ROUTINE BUFFER COUNT: %ld\r\n", NO_OF_RBUF);
1.1 snw 7734: printf (" MAX. ROUTINE BUFFER COUNT: %d\r\n", MAXNO_OF_RBUF);
7735: printf (" DEFAULT ROUTINE BUFFER SIZE (EACH): %d BYTES\r\n", DEFPSIZE0 - 1);
1.2 snw 7736: printf (" CURRENT ROUTINE BUFFER SIZE (EACH): %ld BYTES\r\n\r\n", PSIZE0 - 1);
1.1 snw 7737: printf ("BUFFERS IN USE:\r\n\r\n");
7738:
7739:
7740: for (i = 0; i < NO_OF_RBUF; i++) {
7741:
1.12 snw 7742: flgs[0] = '\0';
1.1 snw 7743:
7744: if (ages[i] == 0) {
7745: sprintf (rnam, "---------");
7746: sprintf (rpth, "[buffer empty]");
7747: sprintf (ldtime, "n/a");
7748: sprintf (flgs, "n/a");
7749: }
7750: else {
7751: stcpy (rnam, pgms[i]);
7752: stcnv_m2c (rnam);
7753:
7754: stcpy (rpth, path[i]);
7755: stcnv_m2c (rpth);
7756:
7757: ag = ages[i];
7758: tld = *localtime (&ag);
7759:
7760: strftime (ldtime, 80, "%a %Y-%m-%d %H:%M:%S %Z", &tld);
7761: if (rbuf_flags[i].dialect != D_FREEM) {
7762: strcat (flgs, "STANDARD");
7763:
7764: switch (rbuf_flags[i].dialect) {
7765:
7766: case D_M77:
7767: strcat (flgs, " [M 1977]");
7768: break;
7769:
7770: case D_M84:
7771: strcat (flgs, " [M 1984]");
7772: break;
7773:
7774: case D_M90:
7775: strcat (flgs, " [M 1990]");
7776: break;
7777:
7778: case D_M95:
7779: strcat (flgs, " [M 1995]");
7780: break;
7781:
7782: case D_MDS:
7783: strcat (flgs, " [MILLENNIUM DRAFT]");
7784: break;
7785:
7786: case D_M5:
7787: strcat (flgs, " [M5]");
7788: break;
7789: }
7790:
7791: }
7792: else {
7793: strcat (flgs, "FREEM");
7794: }
7795: }
7796:
7797: if (ages[i] != 0) {
7798: printf ("#%d [ROUTINE '%s']\r\n", i, rnam);
7799: printf (" UNIX PATH: %s\r\n", rpth);
7800: printf (" LAST ACCESS: %s\r\n", ldtime);
7801: printf (" DIALECT: %s\r\n", flgs);
7802: }
7803:
7804: }
7805:
7806: }
7807:
7808: short rbuf_slot_from_name(char *rnam)
7809: {
7810: register short i;
7811:
7812: for (i = 0; i < NO_OF_RBUF; i++) {
7813: if (stcmp (rnam, pgms[i]) == 0) {
7814: return i;
7815: }
7816: }
7817:
7818: return -1;
7819: }
7820:
7821: short is_standard(void)
7822: {
7823:
7824: if (rtn_dialect () == D_FREEM) {
7825: return FALSE;
7826: }
7827: else {
7828: return TRUE;
7829: }
7830:
7831: }
7832:
7833: int rtn_dialect(void)
7834: {
7835: short slot;
7836:
7837: slot = rbuf_slot_from_name (rou_name);
7838:
7839: return rbuf_flags[slot].dialect;
7840: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to xecline.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem / src