Return to %SYSINIT.m CVS log

Up to [Coherent Logic Development] / freem / mlib

Phase 3 of REUSE compliance and header reformatting

%SYSINIT ;VCL/JPW-FREEM STARTUP ROUTINE; 10/23/2020 6:55 PM
    ;0.0;FreeM;****FREEM**;Serena Willis @2020
    ;
    ;   $Id: %SYSINIT.m,v 1.3 2025/03/10 00:38:15 snw Exp $
    ;    FreeM Startup Routine
    ;
    ;  
    ;   Author: Serena Willis <snw@coherent-logic.com>
    ;    Copyright (C) 1998 MUG Deutschland
    ;    Copyright (C) 2020, 2022 Coherent Logic Development LLC
    ;
    ;
    ;   This file is part of FreeM.
    ;
    ;   FreeM is free software: you can redistribute it and/or modify
    ;   it under the terms of the GNU Affero Public License as published by
    ;   the Free Software Foundation, either version 3 of the License, or
    ;   (at your option) any later version.
    ;
    ;   FreeM is distributed in the hope that it will be useful,
    ;   but WITHOUT ANY WARRANTY; without even the implied warranty of
    ;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    ;   GNU Affero Public License for more details.
    ;
    ;   You should have received a copy of the GNU Affero Public License
    ;   along with FreeM.  If not, see <https://www.gnu.org/licenses/>.
    ;
    ;   $Log: %SYSINIT.m,v $
    ;   Revision 1.3  2025/03/10 00:38:15  snw
    ;   Phase 3 of REUSE compliance and header reformatting
    ;
    ;
    ; SPDX-FileCopyrightText:  (C) 2025 Coherent Logic Development LLC
    ; SPDX-License-Identifier: AGPL-3.0-or-later    
    S %DIA=$DIALECT
    S $DIALECT="FREEM"
    CONST %MATH.PI=3.141592653589793238462
    CONST %MATH.E=2.71828182845904523536
    CONST %MATH.GAMMA=0.57721566490153286060
    CONST %MATH.DEGPERRAD=57.29577951308232087680
    CONST %MATH.PHI=1.61803398874989484820
    CONST %IO.CRLF=$C(13,10)
    CONST %SYS.SIGNAL.HUP=1
    CONST %SYS.SIGNAL.INT=2
    CONST %SYS.SIGNAL.KILL=9
    CONST %SYS.SIGNAL.TERM=15
    ASTART "TRIGGER"
    S $ZTRAP="NOLS^%SYSINIT"
    D ^LCLINIT
NOLS ;
    S $ZTRAP=""
    S $DIALECT=%DIA
    K %DIA
    I $D(%TMPINITROUTINE) D @%TMPINITROUTINE G RTNDONE
    I $D(%TMPINITMCODE) @%TMPINITMCODE
RTNDONE ;    
    Q
copyright ;
COPYRIGHT ;
    S %DIA=$DIALECT
    S $DIALECT="FREEM"
    W "Coherent Logic Development ",$ZVERSION,!
    W "Copyright (C) 2014, 2020, 2021 Coherent Logic Development LLC",!,!
    W "License AGPLv3+: GNU AGPL version 3 or later <https://gnu.org/license/agpl-3.0.html>",!
    W "This is free software: you are free to change and redistribute it.",!
    W "There is NO WARRANTY, to the extent permitted by law.",!,!
    S $DIALECT=%DIA
    K %DIA
    Q
limits ;
LIMITS ;
    S %DIA=$DIALECT
    S $DIALECT="FREEM"
    N MWAPI S MWAPI="<<DISABLED>>"
    S:^$SYSTEM("MWAPI") MWAPI=^$DISPLAY($PDISPLAY,"PLATFORM")
    W !,$ZVERSION," - System Limits",!!
    W " MAX NAME LENGTH:  ",^$SYSTEM("NAME_LENGTH"),!
    W " MAX NODE LENGTH:  ",^$SYSTEM("STRING_MAX"),!
    W " MWAPI SUPPORT:    ",MWAPI,!
    I MWAPI'="<<DISABLED>>" THEN  D
    . W " DISPLAY:          ",$PDISPLAY,!
    . W " RESOLUTION:       ",^$DISPLAY($PDISPLAY,"SIZE"),!
    . W " COLOR SPECTRUM:   ",^$DISPLAY($PDISPLAY,"SPECTRUM"),!
    . W " COLOR TYPE:       ",^$DISPLAY($PDISPLAY,"COLORTYPE"),!
    . W " SCREEN UNITS:     ",^$DISPLAY($PDISPLAY,"UNITS"),!
    S $DIALECT=%DIA
    K %DIA
    Q
info ;
INFO ;
    S %DIA=$DIALECT
    S $DIALECT="FREEM"
    N NS S NS=^$JOB($JOB,"NAMESPACE")
    W $ZVERSION," (Namespace ",^$JOB($JOB,"NAMESPACE"),")",!,!
    W "USER-DEFINED LANGUAGE ELEMENTS:",!
    W " Intrinsic Z-Commands:                                 ",!
    W " Intrinsic Z-Functions:                                ",!
    W " Intrinsic Special Variables:                          ",!!
    W "EVENT MANAGEMENT:",!
    W " BREAK Service Code:                                  '",!!
    W "GLOBAL DATABASE:",!
    W " Global Handler:                                       ","[",NS,"]  ",?65,^$JOB($JOB,"ENGINES","GLOBAL",NS),!
    S NS="SYSTEM"
    W " ->                                                    ","[",NS,"]  ",?65,^$JOB($JOB,"ENGINES","GLOBAL",NS),!
    W " Last Referenced Global:                               ",$REFERENCE,!
    W " Characters in Unique Name:                            ",^$JOB($JOB,"GVN_UNIQUE_CHARS"),!
    W " Case Sensitivity:                                     ",^$JOB($JOB,"GVN_CASE_SENSITIVE"),!
    W " Max Length (Global Name + Subscripts):                ",^$JOB($JOB,"GVN_NAME_SUB_LENGTH"),!
    W " Max Length (Each Subscript):                          ",^$JOB($JOB,"GVN_SUB_LENGTH"),!
    S $DIALECT=%DIA
    K %DIA
    Q
jobs ;
JOBS ;
    S %DIA=$DIALECT
    S $DIALECT="FREEM"
    W " -== ",$ZVERSION," Job Manager ==-",!,!
jmmnu ;%DIALECT FREEM   
    W "PID",?7,"NAMESPACE",?20,"ROUTINE",?41,"$PRINCIPAL",?63,"UID:GID",!
    W "---",?7,"---------",?20,"-------",?41,"----------",?63,"-------",!
    S PID=""
    F  S PID=$O(^$JOB(PID)) Q:PID=""  D
    . W PID,?7,^$JOB(PID,"NAMESPACE"),?20,^$JOB(PID,"ROUTINE"),?41,^$JOB(PID,"$PRINCIPAL")
    . W ?63,^$JOB(PID,"USER"),":",^$JOB(PID,"GROUP")
    . I PID=$JOB W "*",!
    . I PID'=$JOB W !
    W !
    W "'*' represents the current process.",!
    W "Type 'quit' at the prompt to quit the Job Manager.",!,!
gpid ;  
    W "PID> " R PID W !
    I PID="quit" S $DIALECT=%DIA K %DIA QUIT
    I '$D(^$JOB(PID)) W "Invalid PID",! G gpid
    W "Job PID "_PID_":",!
    W "  Current Namespace:     ",^$JOB(PID,"NAMESPACE"),!
    W "  Current Routine:       ",^$JOB(PID,"ROUTINE"),!
    W "  Value of $PRINCIPAL:   ",^$JOB(PID,"$PRINCIPAL"),!
    W "  Value of $IO:          ",^$JOB(PID,"$IO"),!
    W "  Process Owner:         ",^$JOB(PID,"USER"),!
    W "  Process Group:         ",^$JOB(PID,"GROUP"),!
    W "  Process $TLEVEL:       ",^$JOB(PID,"$TLEVEL"),!,!
jsel ;
    W "h)alt PID "_PID_" or c)hoose another? " R ACT#1
    I (ACT="h")!(ACT="H") K ^$JOB(PID) W !,"Sent SIGTERM to process "_PID_".",! G jmmnu
    W !,! G jmmnu
    S $DIALECT=%DIA
    K %DIA
    Q
TRMSTAT ;
trmstat ;
    S %DIA=$DIALECT
    S $DIALECT="FREEM"
    W !,"FreeM Terminal Status",!
    W "---------------------",!,!
    W "ECHOON = "_^$DEVICE($P,"ECHOON")_" DELMODE = "_^$DEVICE($P,"DELMODE")_" ESCSEQPROC = "_^$DEVICE($P,"ESCSEQPROC"),!
    W "CONVUPPER = "_^$DEVICE($P,"CONVUPPER")_" DELEMPTY = "_^$DEVICE($P,"DELEMPTY")_" NOCTRLS = "_^$DEVICE($P,"NOCTRLS"),!
    W "CTRLOPROC = "_^$DEVICE($P,"CTRLOPROC")_" NOTYPEAHEAD = "_^$DEVICE($P,"NOTYPEAHEAD")_" TERMID = "_^$DEVICE($P,"TERMID"),!,!
    W "Device Status Word is "_^$DEVICE($P,"DSW"),!,!
    S $DIALECT=%DIA K %DIA
    Q
GLOBAL ;
global ;
    S %DIA=$DIALECT
    S $DIALECT="FREEM"
    N GBLNAM,G
    W !,"Which global (including ^)? "
    R GBLNAM W !!
    I '$D(GBLNAM) W "Invalid global?",! G GLOBAL
    S G=$E(GBLNAM,2,$L(GBLNAM))
    W "GLOBAL:       ",GBLNAM,!
    W "NAMESPACE:    ",^$GLOBAL(G,"NAMESPACE")
    I $D(^$SYSTEM("MAPPINGS","GLOBAL",GBLNAM)) W " [mapped]",!
    E  W !
    W "DATA FILE:    ",^$GLOBAL(G,"FILE"),!
    S $DIALECT=%DIA K %DIA
    Q
rw ;
   S %DIA=$DIALECT
   S $DIALECT="FREEM"
   W !,"---=== PROFESSOR RICHARD WALTERS ===---",!!
   W "UC Davis professor Richard Walters, the former director of the",!
   W "FreeM project, died on January 18, 2021 at the age of 90.",!,!
   W "The FreeM project--and the M community--owes him a great debt",!
   W "of gratitude.",!,!
   W "Rest in power, Professor Walters.",!,!
   W "Sincerely,",!
   W " - The FreeM Project",!,!
   S $DIALECT=%DIA K %DIA
   Q