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