File:  [Coherent Logic Development] / freem / mlib / %SYSINIT.m
Revision 1.8: download - view: text, annotated - select for diffs
Mon May 5 04:46:35 2025 UTC (2 months, 4 weeks ago) by snw
Branches: MAIN
CVS tags: HEAD
Documentation fixes; make FreeM more standards compliant

    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>