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

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

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