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