Annotation of freem/mlib/%SYSINIT.m, revision 1.6

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>