1: %SYSINIT ;VCL/SNW-FREEM STARTUP ROUTINE; 5/1/2025 11:00 AM
2: ;0.0;FreeM;****FREEM**;Serena Willis @2020
3: ;
4: ; $Id: %SYSINIT.m,v 1.8 2025/05/05 04:46:35 snw Exp $
5: ; FreeM Startup Routine
6: ;
7: ;
8: ; Author: Serena Willis <snw@coherent-logic.com>
9: ; Copyright (C) 1998 MUG Deutschland
10: ; Copyright (C) 2020, 2022 Coherent Logic Development LLC
11: ;
12: ;
13: ; This file is part of FreeM.
14: ;
15: ; FreeM is free software: you can redistribute it and/or modify
16: ; it under the terms of the GNU Affero Public License as published by
17: ; the Free Software Foundation, either version 3 of the License, or
18: ; (at your option) any later version.
19: ;
20: ; FreeM is distributed in the hope that it will be useful,
21: ; but WITHOUT ANY WARRANTY; without even the implied warranty of
22: ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23: ; GNU Affero Public License for more details.
24: ;
25: ; You should have received a copy of the GNU Affero Public License
26: ; along with FreeM. If not, see <https://www.gnu.org/licenses/>.
27: ;
28: ; $Log: %SYSINIT.m,v $
29: ; Revision 1.8 2025/05/05 04:46:35 snw
30: ; Documentation fixes; make FreeM more standards compliant
31: ;
32: ; Revision 1.7 2025/05/03 04:05:23 snw
33: ; Fix %SYSINIT
34: ;
35: ; Revision 1.6 2025/05/02 12:44:48 snw
36: ; Documentation updates
37: ;
38: ; Revision 1.5 2025/05/01 17:02:30 snw
39: ; Further debugging improvements
40: ;
41: ; Revision 1.4 2025/04/10 14:37:20 snw
42: ; Updates to manual
43: ;
44: ; Revision 1.3 2025/03/10 00:38:15 snw
45: ; Phase 3 of REUSE compliance and header reformatting
46: ;
47: ;
48: ; SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC
49: ; SPDX-License-Identifier: AGPL-3.0-or-later
50: S %DIA=$DIALECT
51: S $DIALECT="FREEM"
52: ZCONST %MATH("PI")=3.141592653589793238462
53: ZCONST %MATH("E")=2.71828182845904523536
54: ZCONST %MATH("GAMMA")=0.57721566490153286060
55: ZCONST %MATH("DEGPERRAD")=57.29577951308232087680
56: ZCONST %MATH("PHI")=1.61803398874989484820
57: ZCONST %IO("CRLF")=$C(13,10)
58: ZCONST %SYS("SIGNAL","HUP")=1
59: ZCONST %SYS("SIGNAL","INIT")=2
60: ZCONST %SYS("SIGNAL","KILL")=9
61: ZCONST %SYS("SIGNAL","TERM")=15
62: ASTART "TRIGGER"
63: S $ZTRAP="NOLS^%SYSINIT"
64: D ^LCLINIT
65: NOLS ;
66: S $ZTRAP=""
67: S $DIALECT=%DIA
68: K %DIA
69: I $D(%TMPINITROUTINE) D @%TMPINITROUTINE G RTNDONE
70: I $D(%TMPINITMCODE) @%TMPINITMCODE
71: RTNDONE ;
72: Q
73: copyright ;
74: COPYRIGHT ;
75: S %DIA=$DIALECT
76: S $DIALECT="FREEM"
77: W "Coherent Logic Development ",$ZVERSION,!
78: W "Copyright (C) 2014, 2025 Coherent Logic Development LLC",!,!
79: W "License AGPLv3+: GNU AGPL version 3 or later <https://gnu.org/license/agpl-3.0.html>",!
80: W "This is free software: you are free to change and redistribute it.",!
81: W "There is NO WARRANTY, to the extent permitted by law.",!,!
82: S $DIALECT=%DIA
83: K %DIA
84: Q
85: limits ;
86: LIMITS ;
87: S %DIA=$DIALECT
88: S $DIALECT="FREEM"
89: N MWAPI S MWAPI="<<DISABLED>>"
90: S:^$SYSTEM("MWAPI") MWAPI=^$DISPLAY($PDISPLAY,"PLATFORM")
91: W !,$ZVERSION," - System Limits",!!
92: W " MAX NAME LENGTH: ",^$SYSTEM("NAME_LENGTH"),!
93: W " MAX NODE LENGTH: ",^$SYSTEM("STRING_MAX"),!
94: W " MWAPI SUPPORT: ",MWAPI,!
95: I MWAPI'="<<DISABLED>>" THEN D
96: . W " DISPLAY: ",$PDISPLAY,!
97: . W " RESOLUTION: ",^$DISPLAY($PDISPLAY,"SIZE"),!
98: . W " COLOR SPECTRUM: ",^$DISPLAY($PDISPLAY,"SPECTRUM"),!
99: . W " COLOR TYPE: ",^$DISPLAY($PDISPLAY,"COLORTYPE"),!
100: . W " SCREEN UNITS: ",^$DISPLAY($PDISPLAY,"UNITS"),!
101: S $DIALECT=%DIA
102: K %DIA
103: Q
104: info ;
105: INFO ;
106: S %DIA=$DIALECT
107: S $DIALECT="FREEM"
108: N NS S NS=^$JOB($JOB,"NAMESPACE")
109: W $ZVERSION," (Namespace ",^$JOB($JOB,"NAMESPACE"),")",!,!
110: W "USER-DEFINED LANGUAGE ELEMENTS:",!
111: W " Intrinsic Z-Commands: ",!
112: W " Intrinsic Z-Functions: ",!
113: W " Intrinsic Special Variables: ",!!
114: W "EVENT MANAGEMENT:",!
115: W " BREAK Service Code: '",!!
116: W "GLOBAL DATABASE:",!
117: W " Global Handler: ","[",NS,"] ",?65,^$JOB($JOB,"ENGINES","GLOBAL",NS),!
118: S NS="SYSTEM"
119: W " -> ","[",NS,"] ",?65,^$JOB($JOB,"ENGINES","GLOBAL",NS),!
120: W " Last Referenced Global: ",$REFERENCE,!
121: W " Characters in Unique Name: ",^$JOB($JOB,"GVN_UNIQUE_CHARS"),!
122: W " Case Sensitivity: ",^$JOB($JOB,"GVN_CASE_SENSITIVE"),!
123: W " Max Length (Global Name + Subscripts): ",^$JOB($JOB,"GVN_NAME_SUB_LENGTH"),!
124: W " Max Length (Each Subscript): ",^$JOB($JOB,"GVN_SUB_LENGTH"),!
125: S $DIALECT=%DIA
126: K %DIA
127: Q
128: jobs ;
129: JOBS ;
130: S %DIA=$DIALECT
131: S $DIALECT="FREEM"
132: W " -== ",$ZVERSION," Job Manager ==-",!,!
133: jmmnu ;%DIALECT FREEM
134: W "PID",?7,"NAMESPACE",?20,"ROUTINE",?41,"$PRINCIPAL",?63,"UID:GID",!
135: W "---",?7,"---------",?20,"-------",?41,"----------",?63,"-------",!
136: S PID=""
137: F S PID=$O(^$JOB(PID)) Q:PID="" D
138: . W PID,?7,^$JOB(PID,"NAMESPACE"),?20,^$JOB(PID,"ROUTINE"),?41,^$JOB(PID,"$PRINCIPAL")
139: . W ?63,^$JOB(PID,"USER"),":",^$JOB(PID,"GROUP")
140: . I PID=$JOB W "*",!
141: . I PID'=$JOB W !
142: W !
143: W "'*' represents the current process.",!
144: W "Type 'quit' at the prompt to quit the Job Manager.",!,!
145: gpid ;
146: W "PID> " R PID W !
147: I PID="quit" S $DIALECT=%DIA K %DIA QUIT
148: I '$D(^$JOB(PID)) W "Invalid PID",! G gpid
149: W "Job PID "_PID_":",!
150: W " Current Namespace: ",^$JOB(PID,"NAMESPACE"),!
151: W " Current Routine: ",^$JOB(PID,"ROUTINE"),!
152: W " Value of $PRINCIPAL: ",^$JOB(PID,"$PRINCIPAL"),!
153: W " Value of $IO: ",^$JOB(PID,"$IO"),!
154: W " Process Owner: ",^$JOB(PID,"USER"),!
155: W " Process Group: ",^$JOB(PID,"GROUP"),!
156: W " Process $TLEVEL: ",^$JOB(PID,"$TLEVEL"),!,!
157: jsel ;
158: W "h)alt PID "_PID_" or c)hoose another? " R ACT#1
159: I (ACT="h")!(ACT="H") K ^$JOB(PID) W !,"Sent SIGTERM to process "_PID_".",! G jmmnu
160: W !,! G jmmnu
161: S $DIALECT=%DIA
162: K %DIA
163: Q
164: TRMSTAT ;
165: trmstat ;
166: S %DIA=$DIALECT
167: S $DIALECT="FREEM"
168: W !,"FreeM Terminal Status",!
169: W "---------------------",!,!
170: W "ECHOON = "_^$DEVICE($P,"ECHOON")_" DELMODE = "_^$DEVICE($P,"DELMODE")_" ESCSEQPROC = "_^$DEVICE($P,"ESCSEQPROC"),!
171: W "CONVUPPER = "_^$DEVICE($P,"CONVUPPER")_" DELEMPTY = "_^$DEVICE($P,"DELEMPTY")_" NOCTRLS = "_^$DEVICE($P,"NOCTRLS"),!
172: W "CTRLOPROC = "_^$DEVICE($P,"CTRLOPROC")_" NOTYPEAHEAD = "_^$DEVICE($P,"NOTYPEAHEAD")_" TERMID = "_^$DEVICE($P,"TERMID"),!,!
173: W "Device Status Word is "_^$DEVICE($P,"DSW"),!,!
174: S $DIALECT=%DIA K %DIA
175: Q
176: GLOBAL ;
177: global ;
178: S %DIA=$DIALECT
179: S $DIALECT="FREEM"
180: N GBLNAM,G
181: W !,"Which global (including ^)? "
182: R GBLNAM W !!
183: I '$D(GBLNAM) W "Invalid global?",! G GLOBAL
184: S G=$E(GBLNAM,2,$L(GBLNAM))
185: W "GLOBAL: ",GBLNAM,!
186: W "NAMESPACE: ",^$GLOBAL(G,"NAMESPACE")
187: I $D(^$SYSTEM("MAPPINGS","GLOBAL",GBLNAM)) W " [mapped]",!
188: E W !
189: W "DATA FILE: ",^$GLOBAL(G,"FILE"),!
190: S $DIALECT=%DIA K %DIA
191: Q
192: rw ;
193: S %DIA=$DIALECT
194: S $DIALECT="FREEM"
195: W !,"---=== PROFESSOR RICHARD WALTERS ===---",!!
196: W "UC Davis professor Richard Walters, the former director of the",!
197: W "FreeM project, died on January 18, 2021 at the age of 90.",!,!
198: W "The FreeM project--and the M community--owes him a great debt",!
199: W "of gratitude.",!,!
200: W "Rest in power, Professor Walters.",!,!
201: W "Sincerely,",!
202: W " - The FreeM Project",!,!
203: S $DIALECT=%DIA K %DIA
204: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>