Retro1.org codex

*DECK     NMI=ENV 
          IDENT  SIERRA 
*CALL     NMI=VER 
          TITLE  SIERRA - SYSTEM / NAMI "VERSN" ENVIRONMENT 
          COMMENT SIERRA - ENVIRONMENT DETERMINATION
          ENTRY  SIERRA,SENDMSG,CFOWAIT 
          ENTRY  CFOBSET,CFOBCLR
          ENTRY  SETNUN 
          ENTRY  ABTRUN 
          ENTRY  CHEKORG
          SPACE  4,8
          USE    /SIERRAC/
P.CM      BSS    1            CENTRAL MEMORY IN USE 
P.DATE    BSS    1            TODAYS DATE (BMM.DD.YY.)
P.JDATE   BSS    1            TODAYS JULIAN DATE (00000YYDDD) 
P.CLOCK   BSS    1            CURRENT TIME
P.SECS    BSS    1            CPU SECS
P.USER    BSS    1            JOB USER NAME (UUUUUUU000)
P.MID     BSS    1            MACHINE ID (00000000MM) 
          USE 
 
          USE    /MSGCOM/ 
MSGBUFR   BSS    9
          USE 
 
RA        EQU    0
CFOBIT    EQU    14           CFO BIT IN RA+0 
 
MEMREQ    VFD    30/0,30/0
          EJECT 
**        SIERRA
*         GENERAL PURPOSE COMPASS ROUTINES USED TO
*         RETURN DATE, TIME AND CM ENVIRONMENT INFORMATION
*         TO THE USER.
* 
 
SIERRA    EQ     *+1S17       ENTRY/EXIT
          DATE   P.DATE 
          JDATE  P.JDATE
          CLOCK  P.CLOCK
          TIME   P.SECS 
          USERNUM P.USER
          MACHID  P.MID 
          SA1    MEMREQ 
          BX6    X1 
          SA6    P.CM 
          MEMORY CM,P.CM,R
          MX0    54 
          SA1    P.DATE 
          BX3    X0*X1        REPLACE TRAILING . WITH BLANK 
          SX2    1R 
          BX6    X3+X2
          SA6    A1 
          SA4    P.CLOCK
          BX5    X0*X4        DITTO 
          BX7    X5+X2
          SA7    A4 
          EQ     SIERRA 
          SPACE  4,8
**        SENDMSG 
*         SEND A MESSAGE TO THE DAYFILE 
* 
 
SENDMSG   EQ     *+1S17 
          SX7    0
          SA7    MSGBUFR+8
          MESSAGE MSGBUFR,0,R 
          EQ     SENDMSG
          SPACE  4,8
**        ABTRUN
*         ABORT THE NAMI PROGRAM (ABNORMAL TERMINATION) 
* 
 
ABTRUN    EQ     *+1S17       ENTRY - NO EXIT 
          ABORT 
          EQ     ABTRUN 
          SPACE  4,10 
**        CHEKORG 
*         CHECK ORIGIN OF CALLER
* 
 CHEKORG  EQ     *+1S17      ENTRY/EXIT 
          GETSPS             ABORT IF NOT SYOT OR CSOJ IN DEBUG 
          EQ     CHEKORG
          SPACE  4,10 
**        CFOWAIT 
*         WAIT FOR OPERATOR TO ENTER A CFO COMMAND
* 
 
CFOWAIT   EQ     *+1S17       ENTRY/EXIT
 
          SX6    20000
          SA6    CFOLCNT
CFO1      RECALL               WAIT A MOMENT
          SA1    RA+0         WAIT UNTIL CLEARED
          MX0    59 
          LX1    60-CFOBIT
          BX3    -X0*X1 
          ZR     X3,CFOWAIT 
          SA3    CFOLCNT
          SX4    1
          IX6    X3-X4
          SA6    CFOLCNT
          NZ     X6,CFO1
          ZR     X6,CFO1            (REMOVE IF WAIT LIMIT DESIRED)
          RJ     CFOBCLR
          EQ     CFOWAIT
 
 
CFOBSET   EQ     *+1S17       ENTRY/EXIT
          MESSAGE ENTCFO,3,RECALL 
          SA1    RA+0         GET CFO FLAG WORD 
          MX0    59 
          LX1    60-CFOBIT
          BX6    X0*X1
          BX6    -X0+X6 
          LX6    CFOBIT 
          SA6    A1           RESTORE NEW VALUE 
          EQ     CFOBSET
 
ENTCFO    DIS    ,*ENTER CFO COMMAND* 
 
 
CFOBCLR   EQ     *+1S17       ENTRY/EXIT
          SA1    RA+0         GET CFO FLAG WORD 
          MX0    59 
          LX1    60-CFOBIT
          BX6    X0*X1        CLEAR BIT 
          LX6    CFOBIT 
          SA6    A1 
          EQ     CFOBCLR
 
 
CFOLCNT   BSS    1
          SPACE  4,10 
**        SETNUN
*         SET NAMI USER NUMBER
* 
 JOBORG   BSS    1
 
 SETNUN   EQ     *+1S17      ENTRY/EXIT 
          GETJO  JOBORG 
          SA1    JOBORG 
          MX2    54 
          BX1    -X2*X1 
          ZR     X1,SETIT 
          EQ     SETNUN 
 
 SETIT    SETPFP SETNUND     SET UI / UN TO SYSTEMX 
          EQ     SETNUN 
 
 
 SETNUND  VFD    42/0,14/0,4/3
          VFD    42/0,18/0
          VFD    42/0LSYSTEMX,18/377777B
          SPACE  4,8
          END