Trailing-Edge
-
PDP-10 Archives
-
BB-KL11L-BM_1990
-
galsrc/quasar.mac
There are 41 other files named quasar.mac in the archive. Click here to see a list.
TITLE QUASAR -- QUASAR Controller
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH QSRMAC,GLXMAC ;PARAMETER FILE
PROLOGUE(QUASAR) ;GENERATE THE NECESSARY SYMBOLS
SEARCH ORNMAC ;NEED ORION SYMBOLS
SEARCH NEBMAC ;[6002]NEED NEBULA SYMBOLS
FTLOG==:0 ;No more logging
DEFINE LOGING <IFN FTLOG,>
;Macro to turn off/on logging
DEFINE X(A),<ASCIZ/A/> ;[6001]MAKE LOGICAL NAME ASCIZ
DIRNAM:: L$DIRN ;[6001]LOGICAL NAME OF SHARED DIRECTORY
SUBTTL Edit vector and Version numbers
QSRVEC: BLDVEC (GLXMAC,GMC,L)
BLDVEC (ORNMAC,OMC,L)
BLDVEC (QSRMAC,QMC,L)
BLDVEC (QUASAR,QSR,L)
BLDVEC (QSRADM,ADM)
BLDVEC (QSRDSP,DSP)
BLDVEC (QSRFSS,FSS)
BLDVEC (QSRIPC,IPC)
BLDVEC (QSRMDA,MDA)
BLDVEC (QSRMEM,MEM)
BLDVEC (QSRNET,NET)
BLDVEC (QSRQUE,QUE)
BLDVEC (QSRSCH,SCH)
BLDVEC (QSRT20,T20)
QSRMAN==:6016 ;Maintenance edit number
QSRDEV==:6014 ;Development edit number
VERSIN (QSR) ;Generate edit number
QSRWHO==0
QSRVER==6
QSRMIN==0
EXTERNAL ADMEDT,DSPEDT,FSSEDT,IPCEDT,MDAEDT,MEMEDT,NETEDT,
QUEEDT,SCHEDT,T20EDT
EXTERNAL QSRED1,QSRED2,QSRED3
QSRVRS==<VRSN.(QSR)>+QSRED1+QSRED2+QSRED3
LOC 137 ;INSTALL OUR VERSION NUMBER
EXP QSRVRS
RELOC ;BACK TO RELOCATABLE CODE
Subttl Table of Contents
; Table of Contents for QUASAR
;
; Section Page
;
;
; 1. Edit vector and Version numbers . . . . . . . . . . . 2
; 2. Revision history . . . . . . . . . . . . . . . . . . . 4
; 3. Global Variables . . . . . . . . . . . . . . . . . . . 5
; 4. Initialization . . . . . . . . . . . . . . . . . . . . 7
; 5. SYSTEM QUASAR . . . . . . . . . . . . . . . . . . . . 8
; 6. Main Processing Loop . . . . . . . . . . . . . . . . . 9
; 7. Message Dispatch Handlers . . . . . . . . . . . . . . 11
; 8. GOPHER - Routine to process QUEUE messages . . . . . . 13
; 9. QSRMSG - ROUTINE TO PROCESS MESSAGES TO QUASAR . . . . 14
; 10. Message Dispatch Tables . . . . . . . . . . . . . . . 15
; 11. Operator Message Dispatch . . . . . . . . . . . . . . 16
; 12. Tables for Error Codes Reported . . . . . . . . . . . 17
; 13. Message Formatting Utilities for TEXT Message . . . . 18
; 14. G$SFAL - Notify all Processors of Unknown PID . . . . 20
; 15. $TEXT Utilities . . . . . . . . . . . . . . . . . . . 21
; 16. G$LOG - ROUTINE FOR FIELD TEST ONLY (WILL BE REMOVED) 22
; 17. IBMSTS - Routine to update counters for IBMCOM . . . . 24
SUBTTL Revision history
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
2 4.2.1591 13-Sep-84
Add symbol G$CRS for use with GTFN errors to prevent CRS crashes.
3 4.2.1597 7-Nov-84
Do not send an ACK to a user for tape attributes request since this
is sent from QSRT20.
***** Release 5.0 -- begin development edits *****
10 5.1003 7-Jan-83
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
11 5.1046 21-Oct-83
Change version number from 4 to 5.
12 5.1070 3-Jan-84
Modify QUASAR to handle the QUEUE% JSYS.
13 5.1092 13-Feb-84
Make QUASAR system process by setting IB.SYS in IB.
14 5.1137 20-Apr-84
Sum subtotals to get edit version number due to MACRO restriction.
15 5.1138 24-Apr-84
Change name of version vector from ORNVEC to QSRVEC.
16 5.1160 26-Sept-84
Hardcode the maximum number of batch streams on the system to be ^D20.
17 5.1183 30-Nov-84
Don't check for network changes (i.e., don't call N$NTR anymore).
20 5.1197 5-Feb-85
Set QUASAR as a system process or not as determined by GALGEN.
21 5.1200 6-Feb-85
Turn bit IB.NAC to restrict access to JFNs.
***** Release 5 -- begin maintenance edits *****
30 Increment maintenance edit level for GALAXY 5.
***** Release 6.0 -- begin development edits *****
6000 6.1024 19-Oct-87
Move QUASAR to new development area, update TOC and rename routines
A$OPAU and A$OCAN to be A$OSTO and A$OABT.
6001 6.1067 9-Nov-87
Change QUASAR to send RELEASE messages that are the result of remote
print requests to LISSPL. Also, define the logical name of the shared
directory for cluster printing.
6002 6.1097 22-Nov-87
Check if a message originated from a remote node in the cluster. If
it has, then indicate in word G$NEBF and store the node name of the node
where the message orginated from in word G$REMN. Also, use the macros $QACK
and $QWTO instead of $QCK and $WTO when sending .OMACK and .OMWTO messages.
6003 6.1123 6-Dec-87
Define word G$DEFL to indicate whether a CREATE message included a
node name or not.
6004 6.1135 9-Dec-87
Correctly store the node name of messages that originated on a remote
node in the cluster.
6005 6.1175 7-Feb-88
Define global words G$NEBP and G$RPRV and modify routine G$MSND
in support of the EXEC commands INFORMATION OUTPUT/ DESTINATION and CANCEL
PRINT /DESTINATION.
6006 6.1177 11-Feb-88
Add support for specifying that batch log files and spooled files
be scheduled on specified local printers.
6007 6.1179 12-Feb-88
Add word G$OBJA in support of remote printing /NOTIFY:YES messages.
6010 6.1182 16-Feb-88
Add A$EUNP## and A$DUNP## to OPRTAB in support of the ENABLE/DISABLE
UNPRIVILEGED-USER-ENTIRE-REMOTE-OUTPUT-DISPLAY commands.
6011 6.1184 16-Feb-88
If a message indicates that it has a .NDENM but doesn't, then check
if the sender is ORION or not before sending a response.
6012 6.1195 25-Feb-88
Clear word G$REMN when an IPCF message is received.
6013 6.1225 8-Mar-88
Update copyright notice.
6014 6.1243 29-Apr-88
Restore the receive block address if the message originated remotely.
***** Release 6 -- begin maintenance edits *****
6015 6.1289 29-Nov-89
Define locations G$NULA and G$REXE. G$NULA is used by the Q$xxx
macros. G$REXE is used by routine Q$KILL to indicate if a cancel request
is from a remote user or not.
6016 6.1318 3-Jun-90
Add support for alias printers.
\ ;End of Revision History
SUBTTL Global Variables
MSGLN==:^D200 ;MESSAGE BUFFER LENGTH
G$BEG: ;BEGINNING OF GLOBAL VARIABLES
G$ENT:: BLOCK 1 ;ADDRESS OF CURRENT IPC ENTRY
G$SND:: BLOCK 1 ;SENDER OF CURRENT REQUEST (PID)
G$RCVR:: BLOCK 1 ;RECEIVERS PID
G$SID:: BLOCK 1 ;OWNER ID OF CURRENT SENDER
G$CDI:: BLOCK 1 ;CONNECTED DIRECTORY OF SENDER
G$MCOD:: BLOCK 1 ;TURN-AROUND CODE OF CURRENT MESSAGE
G$IDX:: BLOCK 1 ;SENDER'S SPECIAL INDEX
G$NOW:: BLOCK 1 ;"NOW" IN INTERNAL DATE-TIME FORMAT
G$ERR:: BLOCK 1 ;ERROR CODE FOR ACK'ING THIS REQUEST
G$SPLD:: BLOCK 1 ;QUEUE PPN OR SPOOLED DIRECTORY NUMBER
G$QPID:: BLOCK 1 ;QUASAR'S PID
G$MPID:: BLOCK 1 ;MDA'S PID (-10 ONLY)
G$OPR:: BLOCK 1 ;ORION'S PID
G$NBW:: BLOCK 1 ;NUMBER OF BLKS WRITTEN IN MASTER QUEUES
G$SPRT:: BLOCK 1 ;PROTECTION OF SPOOLED FILES
G$PRVS:: BLOCK 1 ;ENABLED PRIVS OF CURRENT SENDER
G$QUEU:: BLOCK 1 ;CREATE GENERATION FLAG 0=CREATE, -1=NO CREATES
G$ACK:: BLOCK 1 ;NON-ZERO IF CALLER WANTS A RESPONSE
G$MPS:: BLOCK 1 ;MAX IPCF PACKET SIZE
G$MCOR:: BLOCK 1 ;MINIMUM VALUE OF /CORE
G$XCOR:: BLOCK 1 ;MAXIMUM VALUE OF /CORE
G$KSYS:: BLOCK 1 ;NUMBER OF SECS TO KSYS
;0=NO KSYS SET, -1=T/S IS OVER
G$LOGN:: BLOCK 1 ;BATCH LOGIN FLAG. 0=NO. -1=YES.
G$OPRA:: BLOCK 1 ;OPERATOR AVAILABLE FLAG. 0=NO, -1=YES
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
G$ITEM:: BLOCK NITEMS ;COUNTER ITEMS
G$WTIM:: BLOCK 1 ;TIME TO WAKEUP
G$TXBP:: BLOCK 1 ;BYTE POINTER FOR G$TEXT
G$SCHD:: BLOCK 1 ;FLAG FOR DOSCHD MACRO
G$LNAM:: BLOCK 1 ;LOCAL NODE NAME (IN SIXBIT)
G$LNBR:: BLOCK 1 ;LOCAL NODE NUMBER
G$QOPR:: BLOCK 1 ;OPERATOR QUEUE SEARCH FLAG.
G$NBAT:: BLOCK 1 ;MAX NUMBER OF BATCH STREAMS WHICH CAN BE STARTED.
G$ACTV:: BLOCK 1 ;ACCOUNT VALIDATION FLAG 0=NO, -1=YES
G$MDA:: BLOCK 1 ;MDA SUPPORT FLAG 0=NO, -1=YES
G$ACTS:: BLOCK 10 ;ACCOUNT STRING BUFFER FOR IPCF MESSAGES
G$LOCN:: BLOCK 2 ;NODE FROM WHICH THE MESSAGE CAME
G$RMTE:: BLOCK 1 ;NODE FOR WHICH OPERATOR Q SEARCHS ARE MADE
G$NTFY:: BLOCK 1 ;FILE ARCHIVING NOTIFICATION FLAG (0=NO,-1=YES)
G$BLKA:: BLOCK 1 ;IPCF MESSAGE BLOCK ADDRESS
G$PLSR:: BLOCK 1 ;PULSAR'S PID
G$EVENT:: BLOCK 1 ;EVENT QUEUE ID
G$MAXJ:: BLOCK 1 ;MAX NUMBER OF JOBS SUPPORTED IN THIS MONITOR
G$SAB:: BLOCK SAB.SZ ;AN SAB FOR SENDING IPCF MESSAGES
G$ACKB:: BLOCK 1 ;BUFFER ADDRESS FOR ERROR MESSAGES
G$MSG:: BLOCK MSGLN ;BUFFER FOR BUILDING MESSAGES
G$DEAD:: BLOCK 1 ;DEADLOCK AVOIDANCE FLAG
G$PERM:: BLOCK 1 ;PERMANENT STRUCTURE FLAG
G$CRS:: BLOCK 1 ;GTJFN failed in D$ESTR
G$REM:: BLOCK 1 ;[6001]RELEASE MESSAGE TO BE SENT REMOTELY
G$NEBF:: BLOCK 1 ;[6002]REMOTE MESSAGE FLAG
G$REMN:: BLOCK 1 ;[6002]REMOTE NODE NAME WHERE MSG CAME FROM
G$DEFL:: BLOCK 1 ;[6003]LOCAL NAME USED AS DEFAULT NAME
G$NEBP:: BLOCK 1 ;[6005]NEBULA'S PID
G$RPRV:: BLOCK 1 ;[6005]UNPRIVILEGED USER CAN OBTAIN COMPLETE
;[6005]REMOTE OUTPUT QUEUE LISTINGS
G$LOGF:: BLOCK 1 ;[6006]ENA/DIS LOG/SPOOL SPECIFIC LPT OBJECTS
G$EDFG:: BLOCK 1 ;[6006]LOG/SPOOL REQUESTS FOR A SPECIFIC LPT
G$OBJA:: BLOCK 1 ;[6007]FORMER OBJECT ADR OF JUST RELEASED QE
;**;[6015]At G$OBA::+1L add 3 lines JCR 11/29/89
G$NULA:: BLOCK 1 ;[6015]Require by the $Qxxx macros
G$REXE:: BLOCK 1 ;[6015]Remote EXEC canceled request
G$END==.-1 ;END OF GLOBAL VARIABLES
STFLAG: EXP -1 ;FLAG TO MAKE SURE WE AREN'T RESTARTED
PDL:: BLOCK ^D200 ;PUSHDOWN LIST
SUBTTL Initialization
; Initialization Block
IB:: $BUILD(IB.SZ) ;
$SET(IB.PRG,,%%.MOD) ;PROGRAM NAME
$SET(IB.INT,,INTBLK##) ;SET UP INTERRUPT VECTOR ADDRESS
$SET(IB.PIB,,G$PIB) ;SET UP PIB ADDRESS
$SET(IB.FLG,IP.STP,1) ;STOPCODES TO ORION
$SET(IB.FLG,IB.SYS,QSR.JP) ;Define type of process (system or not)
$SET(IB.FLG,IB.NAC,1) ;Restricted access to JFNs
$EOB ;
G$PIB:: $BUILD(PB.MXS) ;
$SET(PB.HDR,PB.LEN,PB.MXS) ;BLOCK LENGTH
$SET(PB.FLG,,IP.PSI!IP.JWP!IP.SPB!IP.RSE) ;LITE LOTS OF BITS
$SET(PB.INT,IP.SPI,SP.QSR) ;MAKE US [SYSTEM]QUASAR
$SET(PB.INT,IP.CHN,INT.PI) ;INTERRUPT CHANNEL
$SET(PB.SYS,IP.MNP,5) ;NEED AT LEAST 5 PIDS
$SET(PB.SYS,IP.BQT,-1) ;MAX SEND/RECIEVE IPCF QUOTA'S
$SET(PB.ACT,,<-1,,G$ACTS>) ;ACCOUNT STRING ADDRESS
$SET(PB.LOC,,<-1,,G$LOCN>) ;IPCF MSG LOCATION ADDRESS
$EOB ;
;DEFINE MESSAGE TYPES THAT ARE SYSTEM DEPENDENT
SYSPRM %IPCSR,0,.IPCSR ;FILE ARCHIVING MESSAGE (TOPS20)
SYSPRM %IPCCG,.IPCCG,.IPCCG ;[SYSTEM]GOPHER
SYSPRM %IPCDE,.IPCDE,0 ;DEVICE DEASSIGN MSG (TOPS10)
SYSPRM %IPCUO,.IPCUO,0 ;DEVICE ONLINE MESSAGE (TOPS10)
SYSPRM %IPATT,.IPCAT,0 ;MONITOR ATTACH MESSAGE (TOPS10)
SYSPRM %IPDET,.IPCDT,0 ;MONITOR DETACH MESSAGE (TOPS10)
SYSPRM %IPMTA,.IPCMT,0 ;MONITOR MAGTAPE ACCESSIBLE (TOPS10)
SYSPRM %IPRMS,.IPCRM,0 ;MONITOR STR REMOVE MSG (TOPS10)
SYSPRM %IPXCH,.IPCXC,0 ;MONITOR EXCHANGE MSG (TOPS10)
SYSPRM %IPCLC,.IPCLC,0 ;SEARCH LIST CHANGE MSG (TOPS10)
SYSPRM %IPCON,.IPCLI,.IPCLI ;MONITOR LOGIN MESSAGES (TOPS10)
SYSPRM %IPCRS,.IPCRS,0 ;MONITOR RESET ON LOCK MSG (TOPS10)
TOPS10<
SYSPRM %IPCAC,SP.ACT,-1 ;ACTDAE SPECIAL PID INDEX (TOPS10)
> ; End of TOPS10
;DEFINE MESSAGE ENTRY POINTS THAT ARE SYSTEM DEPENDENT
SYSPRM X$MTR,E$IMT,I$MTR## ;MOUNT REQUEST RELEASE MSG (TOPS20)
SYSPRM X$CHKP,E$IMT,I$CHKP## ;TAPE MOUNT CHECKPOINT MSG (TOPS20)
SYSPRM X$MATR,E$IMT,I$MATR## ;TAPE MOUNT ATTRIBUTE MSG (TOPS20)
SYSPRM X$ARCH,E$IMT,I$ARCHIVE## ;FILE ARCHIVING MSG (TOPS20)
SYSPRM X$DEAS,D$DEAS##,E$IMT ;TAPE DEASSIGN MESSAGE (TOPS10)
SYSPRM X$DEVS,D$DEVS##,E$IMT ;TAPE STATUS MESSAGE (TOPS10)
SYSPRM X$AVR,D$AVR##,E$IMT ;AVR MESSAGE (TOPS10)
SYSPRM X$VSR,D$VSR##,E$IMT ;VOLUME SWITCH REQUEST (TOPS10)
SYSPRM X$VACT,I$VACT##,E$IMT ;ACCOUNT VALIDATION MSG (TOPS10)
SYSPRM X$RCAT,D$RCAT##,E$IMT ;RESPONSE TO CATLG REQUEST (TOPS10)
SYSPRM X$ACK,D$ACK##,E$IMT ;MDA ACK RESPONSE (TOPS10)
SYSPRM X$DVS,D$DVS##,E$IMT ;MDA DELETE/DEALLOCATE MSG (TOPS10)
SYSPRM X$GOFR,I$GOFR##,E$IMT ;IPCF MESSAGE FROM [SYSTEM]GOPHER
SYSPRM X$DTCH,I$DTCH##,E$IMT ;MONITOR DETACH MESSAGE (TOPS10)
SYSPRM X$ATCH,I$ATCH##,E$IMT ;MONITOR ATTACH MESSAGE (TOPS10)
SYSPRM X$SLCM,I$SLCM##,E$IMT ;MON SRCH LIST CHNG MSG (TOPS10)
SYSPRM X$RMS,D$RMS##,E$IMT ;MON STR REMOVED MSG (TOPS10)
SYSPRM X$XCH,D$XCH##,E$IMT ;MON EXCHANGE MESSAGE (TOPS10)
SYSPRM X$MTAC,I$MTAC##,E$IMT ;MON MAGTAPE UNIT ACCESSIBLE (TOPS10)
SYSPRM X$LCKM,D$LCKM##,E$IMT ;MON RESET ON LOCK MSG (TOPS10)
SYSPRM X$UMDR,I$UMDR##,E$IMT ;ALLOC MDR UPDATE MSG (TOPS10)
SYSPRM X$INID,D$INID##,E$IMT ;TAPE INITIALIZATION DONE (TOPS10)
SUBTTL SYSTEM QUASAR
;WARNING THE ORDERING OF THE FOLLOWING CALLS TO THE VARIOUS
; INITIALIZATION ROUTINES IS FIXED, AND SHOULD NOT BE
; CHANGED UNDER ANY CIRCUMSTANCES.
QUASAR: RESET ;RESET THE WORLD
MOVE P,[IOWD ^D200,PDL] ;GET A PUSHDOWN LIST
AOSE STFLAG ;MAKE SURE WE AREN'T RESTARTED
$STOP(QNR,QUASAR Not restartable) ;WE WERE,,THIS JUST CAN'T HAPPEN
MOVEI S1,IB.SZ ;GET THE IB SIZE
MOVEI S2,IB ;AND THE IB ADDRESS
PUSHJ P,I%INIT ;INITIALIZE THE OTS
MOVE S1,G$PIB+PB.PID ;GET THE PID ASSIGNED TO US
MOVEM S1,G$QPID ;STORE FOR LATER
LOGING< PUSHJ P,LOGINI> ;JUST FOR FIELD TEST...
MOVEI S1,^D20 ;Get the default max # of batch streams
MOVEM S1,G$NBAT ; AND SAVE IT.
PUSHJ P,C$INIT## ;INITIALIZE IPCF INTERFACE
PUSHJ P,N$INIT## ;SETUP THE NETWORK DATA BASE
PUSHJ P,I$INIT## ;INITIALIZE THE SYSTEM INTERFACE
PUSHJ P,S$INIT## ;THE TASK SCHEDULER
PUSHJ P,D$INIT## ;THE MOUNTABLE DEVICE ALLOCATOR
PUSHJ P,A$INIT## ;ADMINISTRATIVE FUNCTIONS
PUSHJ P,Q$INIT## ;THE QUEUE DATABASE MANAGER
PUSHJ P,F$INIT## ;THE FAILSOFT SYSTEM!!
MOVEI S1,E$XXX+1 ;GET THE GENERIC ERROR TEXT PROCESSOR
SUBI S1,ERRTBL ;CALC THE ERROR CODE
MOVE S1,TXTTBL(S1) ;GET THE GENERIC ERROR BUFFER ADDRESS
MOVEM S1,G$ACKB ;AND SAVE IT
SUBTTL Main Processing Loop
MAIN: PUSHJ P,I%NOW ;GET TIME AND DATE
MOVEM S1,G$NOW ;STORE FOR ANYONE WHO WANTS IT
PUSHJ P,C%RECV ;GET A MESSAGE IF ONE IS IN QUEUE
JUMPT MAIN.1 ;FOUND ONE,,GO PROCESS IT
PUSHJ P,Q$DLFL## ;DELETE A FILE IF NECESSARY
PUSHJ P,C$RSND## ;RESEND MESSAGES
PUSHJ P,S$SCHD## ;TRY A SCHEDULING PASSS
SKIPE G$NTFY ;IS IT TIME TO SEND NOTIFICATIONS
PUSHJ P,I$NTFY## ;FOR FILE ARCHIVING ?? YES,,DO IT.
SKIPN S1,G$WTIM ;CHECK AND LOAD WAKEUP TIME
JRST [MOVEI S1,^D60 ;THERE IS NONE,,LOAD UP 1 MINUTE
PUSHJ P,I%SLP ;WAIT
JRST MAIN ] ;BACK TO SCHEDULER
SETZM G$WTIM ;CLEAR WAKEUP TIME
MOVE S2,G$NOW ;GET NOW
CAML S2,S1 ;CURRENT TIME .GT. WAKEUP TIME ???
JRST MAIN ;YES,,THE EVENT HAS PASSED,,TRY AGAIN
PUSHJ P,A$AGE## ;ELSE, GET THE DIFFERENCE
CAIG S1,^D60 ;WITHIN THE RANGE OF
CAIG S1,0 ; 1 TO 60 MINUTES?
MOVEI S1,^D60 ;NO - MAKE IT A MINUTE
PUSHJ P,I%SLP ;AND SLEEP
JRST MAIN ;AND LOOP
MAIN.1: MOVEM S1,G$ENT ;SAVE ADDRESS OF THE ENTRY
ZERO G$ERR ;CLEAR PREVIOUS ERROR INDICATOR
ZERO G$BLKA ;CLEAR THE MESSAGE BLOCK ADDRESS
ZERO G$REMN ;[6012]CLEAR THE REMOTE ORIGINS FLAG
AOS G$ITEM+$$RIPC ;BUMP MESSAGE RECEIVED COUNTER
MOVE T1,MDB.SP(S1) ;GET THE SENDERS PID
MOVEM T1,G$SND ;AND SAVE IT
MOVE T1,MDB.RP(S1) ;GET THE RECEIVERS PID
MOVEM T1,G$RCVR ;SAVE IT
MOVE T1,MDB.SD(S1) ;GET THE SENDERS ID
MOVEM T1,G$SID ;AND SAVE IT
MOVE T1,MDB.CD(S1) ;GET THE SENDERS CONNECTED DIRECTORY
MOVEM T1,G$CDI ;SAVE IT
MOVE T1,MDB.PV(S1) ;GET SENDERS CAPABILITIES
MOVEM T1,G$PRVS ;SAVE THAT AS WELL
MOVE T1,MDB.SI(S1) ;GET THE SENDERS SPECIAL PID INDEX
MOVEM T1,G$IDX ;STORE IT
LOAD M,MDB.MS(S1),MD.ADR ;GET THE MESSAGE ADDRESS
MOVE T1,.MSCOD(M) ;GET THE MESSAGE ACK CODE
MOVEM T1,G$MCOD ;AND SAVE IT
LOAD T1,.MSFLG(M),MF.ACK ;GET THE ACK CODE BIT
MOVEM T1,G$ACK ;AND SAVE IT
LOAD S2,.MSFLG(M),MF.NEB ;[6002]GET THE REMOTE MESSAGE BIT
MOVEM S2,G$NEBF ;[6002]AND SAVE IT
MOVE T1,MDB.FG(S1) ;[6002]GET THE FLAG WORD
JUMPE S2,MAIN.2 ;[6002]IF MSG LOCAL SKIP THE NEXT
MOVEI S1,.NDENM ;[6002]PICK UP REMOTE NODE BLOCK CODE
$CALL A$FNDB## ;[6002]FIND NODE BLOCK IN THE MESSAGE
JUMPF INVMSG ;[6002]ACK ORION ON AN INVALID MESSAGE
MOVE S1,0(S1) ;[6004]PICK UP NODE MESSAGE CAME FROM
MOVEM S1,G$REMN ;[6002]SAVE FOR ANY .OMACK or .OMACS
MOVE S1,G$ENT ;[6014]PICK UP THE RECEIVE BLOCK ADR
MAIN.2: MOVE T1,MDB.FG(S1) ;[6002]GET THE FLAG WORD
TXNN T1,IP.CFV ;A PAGE MODE MESSAGE ?
SKIPA T3,G$MPS ;IPCF SHORT MESSAGE SIZE
MOVEI T3,PAGSIZ ;PAGE MODE LENGTH
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
LOAD P1,.MSTYP(M),MS.TYP ;GET MESSAGE TYPE
TXNE T1,IP.CFM ;A RETURNED MESSAGE
JRST RTNMSG ;YES, PROCESS IT OVER THERE
TXNE T1,IP.CFC ;A SYSTEM MESSAGE
JRST SYSMSG ;YES, DISPATCH THEM DIFFERENTLY
TOPS10<
LOAD S1,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAXN S1,%IPCAC ;IS IT THE ACTDAE ???
JRST ACTMSG ;YES,,DISPATCH IT
> ; End of TOPS10
MOVE S1,G$RCVR ;GET THE RECEIVERS PID
CAME S1,G$MPID ;TO SYSTEM[MDA] ???
CAMN S1,G$QPID ;OR TO [SYSTEM]QUASAR ???
JRST QSRMSG ;YES, DISPATCH IT
INVMSG: MOVE S1,G$SND ;[6011]PICK UP THE SENDER'S PID
CAIE S1,G$OPR ;[6011]IS IT FROM ORION?
JRST INVM.1 ;[6011]NO, SEND A DIFFERENT RESPONSE
$QACK (Orion Message Error,Remote name block missing,,.MSCOD(M)) ;[6011]
JRST RELMSG ;[6011]AND RELEASE THE MESSAGE
INVM.1: SKIPN G$ACK ;[6011]USER WANT AN ACK?
JRST RELMSG ;[6011]NO, RELEASE THE MESSAGE
$CALL E$ILF ;[6011]SET UP G$ERR
$CALL STGSND ;[6011]BUILD THE ANSWER AND SEND IT
JRST RELMSG ;[6011]AND RELEASE THE MESSAGE
;HERE TO RETURN A PROCESSED MESSAGE
RELMSG: PUSHJ P,C%REL ;RELEASE THE CURRENT MESSAGE
JRST MAIN ;AND LOOP
SUBTTL Message Dispatch Handlers
;HERE UPON RECEIPT OF AN UNDELIVERABLE PACKET
; T1 = PACKET FLAGS
RTNMSG: TXNE T1,IP.CFP ;REQUESTING PRIVILEGES
JRST RELMSG ;YES, IGNORE THEM
MOVE S1,G$SND ;PID THAT WENT AWAY
PUSHJ P,G$SFAL ;TELL ALL CONCERNED
JRST RELMSG ;AND RELEASE THE MESSAGE
;HERE TO DISPATCH SYSTEM MESSAGES.
; P1 = THE MESSAGE TYPE
; T1 = THE PACKET FLAGS
SYSMSG: TXNE T1,IP.CFP ;REQUESTING PRIVILEGES
JRST RELMSG ;YES, IGNORE IT
LOAD S2,T1,IP.CFC ;GET THE SENDERS ID
CAIN S2,%IPCCG ;WAS IT [SYSTEM]GOPHER ???
JRST [$CALL GOPHER ;Yes, go process it
JRST RELMSG]
MOVE S2,[-TBLLEN,,SYSTBL] ;GET AOBJN SEARCH AC
SYSM.1: HLRZ S1,0(S2) ;GET A MSG TYPE
CAME P1,S1 ;DO WE MATCH ???
AOBJN S2,SYSM.1 ;NO,,TRY NEXT
SKIPL S2 ;FOUND A MATCH
JRST [$CALL E$IMT ;INVALID MESSAGE
JRST RELMSG] ;RELEASE MESSAGE
HRRZ S1,0(S2) ;YES,,GET THE PROCESSOR ADDRESS
PUSHJ P,0(S1) ;CALL THE MESSAGE PROCESSOR
JRST RELMSG ;GO RELEASE THE MESSAGE
SYSTBL: .IPCSU,,Q$SPOOL## ;SPOOLING MESSAGE
.IPCSL,,Q$LOGOUT## ;LOGOUT MESSAGE
%IPCON,,I$LOGN## ;LOGIN MESSAGE
%IPCSR,,X$ARCHIVE ;ARCHIVE MESSAGE
TOPS10<
%IPCDE,,X$DEASSIGN ;DEASSIGN MESSAGE
%IPCRS,,X$LCKM ;RESET ON LOCK MESSAGE
%IPCUO,,X$AVR ;UNIT ON-LINE MESSAGE
%IPATT,,X$ATCH ;ATTACH MESSAGE
%IPDET,,X$DTCH ;DETACH MESSAGE
%IPCLC,,X$SLCM ;SEARCH LIST CHANGE MSG
%IPRMS,,X$RMS ;STRUCTURE REMOVED MSG
%IPXCH,,X$XCH ;EXCHANGE MESSAGE
%IPMTA,,X$MTAC ;MAGTAPE UNIT ACCESSIBLE
> ; End of TOPS10
TBLLEN==.-SYSTBL ;TABLE LENGTH
;HERE FOR ACCOUNTING MESSAGES
TOPS10<
ACTMSG: PUSHJ P,X$VACT ;PROCESS THE MESSAGE
JRST RELMSG ;AND RETURN
> ; End of TOPS10
SUBTTL GOPHER - Routine to process QUEUE messages
; Here when it is believed that a message has been received from the
; monitor that was initiated as a QUEUE% JSYS request.
GOPHER: LOAD S1,.MSFLG(M),MF.ACK ;Get the user acknowledgment bit
MOVEM S1,G$ACK ;And save it
MOVSI S1,-GOPLEN ;Number of entries to check
LOAD T1,.MSTYP(M),MS.TYP ;Get the function code
GOPFND: HLRZ S2,GOPTAB(S1) ;Get the next table entry
CAIE T1,(S2) ;Is this the function?
AOBJN S1,GOPFND ;No, try the next entry
JUMPGE S1,GOPERR ;Error, function type not found
HRRZ T1,GOPTAB(S1) ;Pick up the converted function type
STORE T1,.MSTYP(M),MS.TYP ;Store converted type in message
PUSHJ P,Q$CRQE## ;Process short create message
SKIPN G$ERR ;Was there an error?
$RETT
SKIPA ;Yes, don't set code but process error
GOPERR: PUSHJ P,E$IFC ;Set invalid function code
PUSHJ P,G$STGS ;Generate the ACK and send it
$RETT
GOPTAB: .QUPRT,,.OTLPT ;Queue printer function
.QUCDP,,.OTCDP ;Queue card punch function
.QUPTP,,.OTPTP ;Queue paper tape punch
.QUPLT,,.OTPLT ;Queue plot function
.QUBAT,,.OTBAT ;Queue batch function
GOPLEN==.-GOPTAB ;Current table length
SUBTTL QSRMSG - ROUTINE TO PROCESS MESSAGES TO QUASAR
;HERE WHEN A MESSAGE IS DIRECTED AT [SYSTEM]QUASAR
; P1 = THE MESSAGE TYPE
; M = THE MESSAGE PROPER
; T3 = THE MAXIMUM MESSAGE SIZE POSSIBLE ( 1000 OR G$MPS )
; T1 = PACKET FLAGS
QSRMSG: TXNE T1,IP.CFP ;REQUESTING PRIVILEGES
JRST RELMSG ;YES, IGNORE THEM
LOAD T4,.MSTYP(M),MS.CNT ;GET THE LENGTH FROM THE USER
SKIPE T4 ;IS THE MESSAGE LENGTH 0 ???
CAILE T4,(T3) ; OR GREATER THEN MAXIMUM ALLOWED ???
SETZM P1 ;YES,,THEN ITS INVALID !!!
CAXL P1,.OMOFF ;IS THIS AN ORION MESSAGE?
JRST OPRMSG ;YES, HANDLE IT DIFFERENTLY
CAXLE P1,QSRLEN ;NO,,IS IT A VALID MESSAGE TYPE ???
SETZM P1 ;NO,,THEN ITS INVALID !!!
MOVE S1,QSRTAB(P1) ;ADDRESS OF PROCESSING ROUTINE
PUSHJ P,(S1) ;AND CALL THE ROUTINE
SKIPE G$REM ;[6001]A REMOTE RELEASE MESSAGE?
JRST QSRM.1 ;[6001]YES, HANDLE DIFFERENTLY
SKIPE G$ERR ;ANY ERRORS ???
SKIPL QSRTAB(P1) ;YES, A KNOWN COMPONENT TYPE CALL
SKIPE G$ACK ;NO, DOES USER WANT A RETURN MESSAGE
JRST [ CAIE P1,.QOMAT ;Tape attributes request?
PUSHJ P,STGSND ;No, build answer and send
JRST .+1 ] ;Continue
JRST RELMSG ;AND DISMISS THE MESSAGE
QSRM.1: SETZM G$REM ;[6001]RESET THE REMOTE RELEASE MSG FLAG
JRST MAIN ;[6001]CHECK FOR THE NEXT MESSAGE
SUBTTL Message Dispatch Tables
;THE DISPATCH TABLE IS ORDERED BY MESSAGE TYPE AND CONTAINS THE ADDRESS OF THE
; CORRECT PROCESSING ROUTINE FOR THAT MESSAGE.
;BY DEFINITION, ANY ROUTINE CALLED THROUGH THIS DISPATCH IS A TOP LEVEL ROUTINE
;THE SIGN BIT (1B0) IS USED TO INDICATE THOSE MESSAGES THAT PROBABLY CAME FROM
; A KNOWN COMPONENT (OR SOMEONE TRYING TO BECOME ONE) AND IS USED TO
; DETERMINE IF A RESPONSE IS TO BE SENT ON ERRORS (EVEN IF DIDN'T ASK FOR THEM)
QSRTAB: 0,,E$IMT ;FUNCTION 0 INVALID MESSAGE
400000,,A$HELLO## ;FUNCTION 1 HELLO
400000,,Q$RELEA## ;FUNCTION 2 RELEASE
400000,,Q$CHECK## ;FUNCTION 3 CHECKPOINT
400000,,Q$REQUE## ;FUNCTION 4 REQUEUE
0,,Q$RNXT## ;[6001]FUNCTION 5 NEXTJOB (CHECK FOR REMOTE)
0,,E$IMT ;FUNCTION 6 ABORT (SENT BY QUASAR)
0,,Q$CREATE## ;FUNCTION 7 CREATE
0,,D$LIST## ;FUNCTION 10 LIST
0,,Q$MODIFY## ;FUNCTION 11 MODIFY
0,,Q$KILL## ;FUNCTION 12 KILL
0,,E$IMT ;FUNCTION 13 LISTANSWER (SENT BY QUASAR)
0,,E$IMT ;FUNCTION 14 (OBSOLETED)
0,,E$IMT ;FUNCTION 15 REQUEST FOR CHECKPOINT (SENT BY QUASAR)
0,,Q$DEFER## ;FUNCTION 16 DEFER
0,,E$IMT ;FUNCTION 17 OLD A$ROUTE MESSAGE.
0,,A$COUNT## ;FUNCTION 20 COUNT
0,,E$IMT ;FUNCTION 21 COUNTANSWER (SENT BY QUASAR)
0,,E$IMT ;FUNCTION 22 SETUP (SENT BY QUASAR)
400000,,S$RSETUP## ;FUCNTION 23 RESPONSE-TO-SETUP
0,,E$IMT ;FUNCTION 24 OPERATOR-ACTION (SENT BY QUASAR)
0,,Q$HOLD## ;FUNCTION 25 HOLD/RELEASE MESSAGE
0,,E$IMT ;FUNCTION 26 MONITOR SPOOL MESSAGE
0,,E$IMT ;FUNCTION 27 MONITOR LOGOUT MESSAGE
0,,D$MOUNT## ;FUNCTION 30 USER TAPE MOUNT REQUEST
400000,,A$STATUS## ;FUNCTION 31 DEVICE STATUS UPDATE MSG
400000,,X$MTR ;FUNCTION 32 RELEASE MESSAGE FROM MTCON
400000,,X$CHKP ;FUNCTION 33 TAPE MOUNT CHECKPOINT MESSAGE
0,,E$IMT ;FUNCTION 34 TAPE/DISK MNT ABORT MSG
400000,,X$MATR ;FUNCTION 35 MNT ATTRIBUTE MSG REQUEST
0,,E$IMT ;FUNCTION 36 NODE WENT AWAY MSG (SEND BY QUASAR)
0,,Q$CRQE## ;FUNCTION 37 SHORT CREATE MESSAGE
0,,E$IMT ;FUNCTION 40 RECOGNOZE MESSAGE (QUASAR->PULASR)
0,,X$DEVSTA ;FUNCTION 41 TAPE/DISK DEVICE STATUS MESSAGE
0,,E$IMT ;FUNCTION 42 TAPE UNLOAD MSG (QUASAR TO PULSAR)
0,,E$IMT ;FUNCTION 42 TAPE VOLUME IN USE (QUA TO PLR)
0,,E$IMT ;FUNCTION 44 TAPE VOL WAS DEASSIGNED (QUA 2 PLR)
0,,X$VSR ;FUNCTION 45 VOLUME SWITCH REQUEST (PLR 2 QUA)
0,,E$IMT ;FUNCTION 46 VOLUME SWITCH DIRECTIVE (QUA 2 PLR)
0,,E$IMT ;FUNCTION 47 TAPE REWIND MSG (QUASAR 2 PULSAR)
0,,E$IMT ;FUNCTION 50 ASK FOR CATALOG INFO (QUA 2 PLR)
0,,X$RCAT ;FUNCTION 51 CATALOG RESPONSE (PLR TO QUA)
0,,E$IMT ;FUNCTION 52 BUILD STRUCTURE MSG (QUA 2 PLR)
0,,E$IMT ;FUNCTION 53 DISMOUNT STRUCTURE MSG (QUA 2 PLR)
0,,X$ACK ;FUNCTION 54 MDA ACK MESSAGE (PLR TO QUA)
0,,E$IMT ;FUNCTION 55 MDA ADD STRUCTURE TO SEARCH LIST
0,,X$DVS ;FUNCTION 56 MDA DISMOUNT/DEALLOCATE MSG
0,,D$LALC## ;FUNCTION 57 SHOW ALLOCATION MSG
0,,E$IMT ;FUNCTION 60 ALLOC SCAN REQUEST (QSR TO BATCON)
0,,X$UMDR ;FUNCTION 61 ALLOC SCAN ANSWER (BATCON TO QSR)
0,,X$INID ;FUNCTION 62 TAPE INITIALIZE DONE (PULSAR 2 QSR)
0,,E$IMT ;FUNCTION 63 FORMS CHANGE MESSAGE TO LPTSPL
0,,IBMSTS ;FUNCTION 64 IBMCOM STATISTICS UPDATE MESSAGE
QSRLEN==<.-QSRTAB>-1 ;HIGHEST LEGAL MESSAGE FROM USER TO QUASAR
SUBTTL Operator Message Dispatch
;HERE UPON RECEIPT OF A MESSAGE WHICH IS SENT TO [SYSTEM]QUASAR AND
; HAS A MESSAGE CODE WHICH INDICATES THAT IS IS FROM ORION.
; P1 = MESSAGE TYPE
; M = THE MESSAGE PROPER
; T3 = THE MAXIMUM MESSAGE SIZE POSSIBLE (PAGSIZ OR G$MPS)
; T1 = FLAGS
; T4 = ACTUAL SIZE OF MESSAGE
OPRMSG: MOVE S1,G$IDX ;GET SPECIAL INDEX WORD
TXZE S1,SI.FLG ;IS IT IN USE?
CAXE S1,SP.OPR ;AND IS MESSAGE FROM ORION?
JRST RELMSG ;NO, FORGET ABOUT IT
CAIN P1,MT.TXT ;IS IT AN ACK TXT MESSAGE ???
JRST RELMSG ;YES,,PITCH IT !!!
CAIL P1,.ODMES ;IS THIS A OPR MOUNT REQUEST ???
JRST OPRM.2 ;YES,,GO PROCESS IT
MOVSI S1,-OPRLEN ;GET LENGTH OF DISPATCH TABLE
OPRM.1: HLRZ S2,OPRTAB(S1) ;GET CODE FOR ENTRY
CAME P1,S2 ;DOES THIS MATCH AN ENTRY IN THE TABLE?
AOBJN S1,OPRM.1 ;NO, LOOP FOR NEXT ENTRY
HRRZ S1,OPRTAB(S1) ;GET PROCESSOR FOR THIS ENTRY
PUSHJ P,0(S1) ;CALL PROPER ROUTINE
SKIPE S1,G$ERR ;ANY ERRORS ???
$QACK (<^T/@TXTTBL(S1)/>,,,.MSCOD(M)) ;[6002]YES,,TELL OPERATOR
PJRST RELMSG ;NO,,RELEASE MESSAGE AND RETURN
OPRM.2: PUSHJ P,I$OMNT## ;GO PROCESS THE MESSAGE
PJRST RELMSG ;RELEASE MESSAGE AND RETURN
; TABLE OF LEGAL ORION TO QUASAR MESSAGES
OPRTAB: .OMSTA,,A$OSTA## ;STARTUP MESSAGE
.OMSHT,,A$OSHT## ;SHUTDOWN MESSAGE
.OMSET,,A$OSET## ;SET MESSAGE
.OMPAU,,A$OSTO## ;[6000]STOP MESSAGE
.OMCON,,A$OCON## ;CONTINUE
.OMSHS,,D$SHST## ;SHOW STATUS MESSAGE.
.OMSHC,,A$OSHC## ;SHOW COMMAND FILE (EXAMINE)
.OMSHP,,D$SHPR## ;SHOW PARAMETERS.
.OMSHQ,,D$SHQS## ;SHOW QUEUES MESSAGE.
.OMSHR,,D$SHRT## ;SHOW ROUTE TABLE
.OMREQ,,A$OREQ## ;REQUEUE
.OMCAN,,A$OABT## ;[6000]ABORT MESSAGE
.OMFWS,,A$OFWS## ;FORWARD SPACE MSG.
.OMALI,,A$OALI## ;ALIGN PRINTER
.OMSUP,,A$OSUP## ;SUPPRESS CARRAIGE CONTROL
.OMSND,,A$OSND## ;SEND COMMAND
.OMBKS,,A$OBKS## ;BACK SPACE COMMAND
.OMHLD,,A$OHLD## ;OPERATOR HOLD COMMAND.
.OMREL,,A$OREL## ;OPERATOR RELEASE COMMAND.
.OMRTE,,A$ORTE## ;OPERATOR ROUTE COMMAND.
.OMRTD,,N$NRTE## ;DEVICE ROUTE COMMAND
.OMDEL,,A$ODEL## ;DELETE JOBS FROM SYSTEM QUEUES
.OMMOD,,A$MODIFY## ;MODIFY QUEUE ENTRY PROCESSOR
.OMENA,,A$ENABLE## ;ENABLE MESSAGE PROCESSOR
.OMDIS,,A$DISABLE## ;DISABLE MESSAGE PROCESSOR
.OMDEF,,A$DEFINE## ;NETWORK DEFINE COMMAND
.OMDSP,,A$DN60## ;DN60 OPR MESSAGE PROCESSOR
.OMSPN,,D$NPRM## ;NETWORK (IBM) SHOW PARAMETERS
.OMSSN,,D$NSTS## ;NETWORK SHOW STATUS
.OMNXT,,A$NEXT## ;[NXT] NEXT COMMAND
.OMELP,,A$ELPR## ;[6006]ENA LOG/SPOOL LPT OBJECTS
.OMDLP,,A$DLPR## ;[6006]DIS LOG/SPOOL LPT OBJECTS
.OMELT,,A$ELPT## ;[6006]ENA A SPECIFIC LPT LOG/SPOOL
.OMDLT,,A$DLPT## ;[6006]DIS A SPECIFIC LPT LOG/SPOOL
.OMEUP,,A$EUNP## ;[6010]ENA UNPRIV USER REMOTE I/O
.OMDUP,,A$DUNP## ;[6010]DIS UNPRIV USER REMOTE I/O
;**;[6016]At OPRTAB:+35L add 2 lines PMM 6/3/90
.OMNEW,,A$ONEW## ;[6016]NEW ALIAS command
.OMHEL,,A$RHEL## ;[6016]ORION HELLO message
OPRLEN==.-OPRTAB ;LENGTH OF TABLE
E$IMT ;PROCESSOR IF NONE FOUND IN TABLE
SUBTTL Tables for Error Codes Reported
DEFINE X(SUFFIX,TEXT,ERRLVL),<
E$'SUFFIX:: PUSHJ P,RPTERR ;DISPATCH TO ERROR HANDLER
> ;END OF DEFINE X
ERRTBL: ERRCDS ;EXPAND THE DISPATCH TABLE
DEFINE X(SUFFIX,TEXT,ERRLVL),<
EXP [ASCIZ\TEXT\] ;TABLE OF MESSAGES
> ;END OF DEFINE X
TXTTBL::EXP [BYTE (7)0] ;0 IS NOT REALLY AN ERROR
ERRCDS ;DEFINE THE REST OF THEM
DEFINE X(SUFFIX,TEXT,ERRLVL),<
ERRLVL!INSVL.(<SIXBIT\ SUFFIX\>,MF.SUF)
> ;END OF DEFINE X
STSTBL: MF.NOM ;0 HAS NO TEXT ASSOCIATED
ERRCDS ;EXPAND THE REST NOW
;HERE WHEN SOMEONE CALLS (OR EXITS THROUGH) ANY OF THE E$xxx ERROR CODES
; THIS STORES THE RELATIVE ERROR NUMBER INTO G$ERR
RPTERR: EXCH T1,0(P) ;SAVE T1, GET ERROR DISPATCH
SUBI T1,ERRTBL ;CONVERT TO ERROR INDEX
HRRZM T1,G$ERR ;SET GLOBAL ERROR INDICATOR
POP P,T1 ;RESTORE T1
$RETF ;RETURN FALSE
SUBTTL Message Formatting Utilities for TEXT Message
;SUBROUTINE TO INSERT A SINGLE ASCII CHARACTER INTO THE CURRENT TEXT MESSAGE
;CALL WITH S1 CONTAINING THE CHARACTER RIGHT JUSTIFIED
;TRUE RETURN: ALWAYS
INTERN G$CCHR
G$CCHR: SKIPE STGBPT ;STRING STARTED YET
JRST CCHR.1 ;YES, JUST INSERT ONE
MOVE S2,[POINT 7,G$MSG+.OHDRS+ARG.DA] ;INIT THE BYTE POINTER
MOVEM S2,STGBPT ;TUCK IT AWAY
CCHR.1: SKIPN G$MSG+MSGLN-1 ;ARE WE AT THE END OF THE BUFFER
IDPB S1,STGBPT ;NO,,INCLUDE THIS CHARACTER
$RETT ;RETURN FOR THE NEXT ONE
STGBPT: BLOCK 1 ;POINTER TO CURRENT STRING (0 IF NONE)
;ROUTINE TO STORE THE CURRENT ERROR CODE INTO THE TEXT MESSAGE
G$STGS:: ;GLOBAL ENTRY POINT
STGSND: MOVE S1,G$ERR ;GET THE ERROR CODE (EVEN IF ZERO)
$TEXT(G$CCHR,<^T/@TXTTBL(S1)/^A>);STORE THE MESSAGE
MOVE S1,STSTBL(S1) ;GET THE FLAGS AND PREFIX
;FALL INTO THE GLOBAL ROUTINE TO SEND THE MESSAGE TO THE USER
;SUBROUTINE TO SEND THE CURRENT STRING TO THE USER (G$SND)
;CALL WITH S1 CONTAINING THE FLAGS AND PREFIX TO STORE INTO FLAG WORD
;DESTROYS S1 AND S2
INTERN G$MSND
G$MSND: TXNN S1,MF.MOR ;GOING TO GENERATE ANOTHER AFTER THIS
SETZM G$ACK ;NO, CLEAR ACK REQUEST
MOVE S2,G$MCOD ;GET TURN-AROUND CODE
MOVEM S2,G$MSG+.MSCOD ;STORE INTO THE PROPER PLACE
TXNN S1,MF.MOR ;IF NO CONTINUATION,
SETZM G$MCOD ;CLEAR THE CODE OUT
MOVEM S1,G$MSG+.MSFLG ;STORE REQUESTED INFORMATION
SETZM G$MSG+.OARGC ;CLEAR THE ARGUMENT COUNT
SKIPN S1,STGBPT ;HAVE WE INSERTED ANYTHING YET ???
JRST [MOVX S2,MF.NOM ;NO,,A NULL ACK SO GET 'NO MESSAGE'
MOVEM S2,G$MSG+.MSFLG ;AND SET THE FLAG BITS
JRST MSND.0 ] ;SEND THE MESSAGE OFF
MOVEI S1,0 ;APPEND A NULL BYTE
PUSHJ P,G$CCHR ; TO THE END OF THE MESSAGE
HRRZ S1,STGBPT ;NOW COMPUTE THE BLOCK LENGTH BY
SUBI S1,G$MSG+.OHDRS+ARG.DA-2 ; SUBTRACTING THE STARTING ADDRESS-2
STORE S1,G$MSG+.OHDRS+ARG.HD,AR.LEN ;SAVE THE BLOCK SIZE
MOVX S2,.CMTXT ;GET THE BLOCK TYPE
STORE S2,G$MSG+.OHDRS+ARG.HD,AR.TYP ;SAVE THE BLOCK TYPE
AOS G$MSG+.OARGC ;BUMP THE ARGUMENT COUNT BY 1
MSND.0: ADDI S1,.OHDRS ;ADD THE HEADER LENGTH
STORE S1,G$MSG+.MSTYP,MS.CNT ;SAVE THE MESSAGE LENGTH
MOVEM S1,G$SAB+SAB.LN ;SAVE THE MESSAGE LENGTH IN SAB
MOVX S2,.OMTXT ;GET THE MESSAGE TYPE
MOVE S1,G$MSG+.MSFLG ;[6005]PICK UP THE FLAG WORD
TXNE S1,MF.NEB ;[6005]AN IN BEHALF OF REQUEST?
MOVEI S2,.NMTXT ;[6005]YES, GET THE MESSAGE TYPE
STORE S2,G$MSG+.MSTYP,MS.TYP ;SAVE THE MESSAGE TYPE
MOVEI S2,G$MSG ;POINT AT THE MESSAGE
MOVEM S2,G$SAB+SAB.MS ;SAVE THE MESSAGE ADDRESS
MOVE S2,G$SND ;GET CURRENT SENDER
MOVEM S2,G$SAB+SAB.PD ;SAVE RECEIVERS PID
SETZM STGBPT ;CLEAR THE MSG BYTE POINTER
PJRST C$SEND## ;SEND THE MESSAGE AND RETURN
SUBTTL G$SFAL - Notify all Processors of Unknown PID
;CALLED WITH S1 = THE NOW INVALID PID
;THIS IN TURN, CALLS ANYONE WHO WORRYS ABOUT THAT SITUATION
INTERN G$SFAL
G$SFAL: PJRST A$KLPD## ;TELL QUASAR - QUEUE MANIPULATOR AND RETURN
SUBTTL $TEXT Utilities
;G$STTX - ROUTINE TO SETUP A BYTE-POINTER FOR G$TEXT.
;
;CALL: S1/ ADDRESS OF THE BLOCK OF STORAGE TO POINT TO
G$STTX:: HRLI S1,(POINT 7,0) ;MAKE A BYTE POINTER
MOVEM S1,G$TXBP ;STORE IT
$RETT ;AND RETURN
;G$TEXT - $TEXT SUBROUTINE TO DEPOSIT A BYTE ACCORDING TO THE BYTE
; POINTER SETUP IN G$TXBP.
G$TEXT:: IDPB S1,G$TXBP ;DEPOSIT THE BYTE
$RETT ;AND RETURN
SUBTTL G$LOG - ROUTINE FOR FIELD TEST ONLY (WILL BE REMOVED)
;This routine records statistics about the performance of
;GALAXY 4.1. It writes out to a disk file various counters
;which measure how much activity GALAXY is getting over time.
LOGING < ;Only during field test
LOGINI: SETOM S1 ;WANT INFO FOR THIS JOB
MOVX S2,JI.JNO ;LETS GET JOB NUMBER
PUSHJ P,I%JINF ;GET IT
MOVEM S2,G$ITEM+$$QJOB ;SAVE IT
PUSHJ P,I%NOW ;GET CURRENT TIME
MOVEM S1,G$ITEM+$$STAR ;SAVE AS QUASAR'S START TIME
MOVEI S1,NITEMS ;get the number of items in record
MOVEM S1,G$ITEM+$$ICNT ;save it in the record
TOPS10< MOVX S1,%CNSUP ;WANT SYSTEM UPTIME IN CLOCK TICKS
GETTAB S1, ;GET IT
MOVX S1,.INFIN ;SHOULD NOT HAPPEN
MOVX S2,%CNTIC ;WANT CLOCK TICKS PER SECOND
GETTAB S2, ;GET IT
MOVX S2,^D60 ;SHOULD NOT HAPPEN
> ;END TOPS10 CONDITIONAL
TOPS20< TIME > ;GET SYSTEM UPTIME IN MILLISECONDS
IDIV S1,S2 ;CALC # SECONDS OF UPTIME
IDIVI S1,^D60 ;CALC # MINUTES OF UPTIME
CAILE S1,^D10 ;STARTING AFTER 10 MINUTE WINDOW ?
SETOM G$ITEM+$$IPCI ;NO,,INDICATE QUASAR RESTARTED
G$LOG: SKIPE DEBUGW ;DEBUGGING ???
$RETT ;YES,,RETURN
PUSHJ P,I%NOW ;GET CURRENT TIME
MOVEM S1,G$ITEM+$$NOW ;SAVE IT
SKIPE S1,LOGIFN ;FILE OPEN YET ???
JRST LOG.1 ;YES,,CONTINUE
LOG.0: MOVEI S1,2 ;GET FOB LENGTH
MOVEI S2,LOGFOB ;GET FOB ADDRESS
PUSHJ P,F%AOPN ;OPEN STATISTICS FILE
JUMPF .RETT ;CAN'T,,JUST RETURN
MOVEM S1,LOGIFN ;OK,,SAVE IFN
LOG.1: MOVX S2,FI.CRE ;GET THE FILE CREATION DATE
PUSHJ P,F%INFO ;ASK FOR IT
MOVE S2,G$ITEM+$$NOW ;GET THE CURRENT TIME
SUB S2,S1 ;CALC CREATION LENGTH IN JIFFIES
CAXL S2,3*^D60*^D60*^D24*7 ;LESS THEN 1 WEEK OLD ???
JRST LOG.3 ;NO,,RENAME OLD LOG AND START A NEW ONE
MOVE S1,LOGIFN ;GET THE IFN BACK
HRLI S2,NITEMS ;GET NUMBER OF ITEMS
HRRI S2,G$ITEM ;GET THEIR ADDRESS
PUSHJ P,F%OBUF ;SAVE THEM
JUMPF .RETT ;LOSE,,RETURN
MOVE S1,LOGIFN ;GET THE IFN BACK
PUSHJ P,F%CHKP ;WRITE TO DISK
JUMPF .RETT ;LOSE,,RETURN
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
LOG.2: MOVEI S1,NITEMS-3 ;GET THE BLOCK LENGTH
MOVEI S2,G$ITEM+$$IPCI ;AND ITS ADDRESS
PUSHJ P,.ZCHNK ;ZERO THE BLOCK
MOVEI S1,4 ;GET TIMER REQUEST BLK LENGTH
MOVEI S2,TIMREQ ;GET ITS ADDRESS
PUSHJ P,I%TIMR ;SCHEDULE G$LOG AGAIN IN 1 HOUR
$RETT ;RETURN
LOG.3: MOVE S1,LOGIFN ;GET THE LOG FILE IFN
PUSHJ P,F%REL ;CLOSE THE LOG
TOPS10< MOVE S1,[POINT 6,NEWFD+2] > ;GET OUTPUT BYTE POINTER
TOPS20< MOVE S1,[POINT 7,NEWFD+1] > ;GET OUTPUT BYTE POINTER
MOVEM S1,BYTPTR ;SAVE IT
TOPS10< $TEXT (OUTBYT,<G^H6/G$ITEM+$$NOW/^0>) >
TOPS20< $TEXT (OUTBYT,<^T/AREA/GALAXY-^H9/[-1]/.LOG^0>) >
MOVEI S1,2 ;GET RENAME BLOCK LENGTH
MOVEI S2,RENAME ;GET RENAME BLOCK ADDRESS
PUSHJ P,F%REN ;RENAME THE FILE
JRST LOG.0 ;AND OPEN A NEW LOG
RENAME: LOGFD
NEWFD
TOPS10<
OUTBYT: JUMPE S1,.RETT ;NULL,,RETURN
CAIN S1,"-" ;IS IT A '-' ??
$RETT ;YES,,IGNORE IT
CAIN S1," " ;IS IT A SPACE ???
MOVEI S1,"0" ;YES,,MAKE IT A 0
SUBI S1,40 ;CONVERT TO SIXBIT ON TOPS10
CAIL S1,"A" ;STILL ALPHA ???
SUBI S1,40 ;YES,,MAKE SIXBIT
IDPB S1,BYTPTR ;SAVE IT
$RETT ;RETURN
>
TOPS20<
OUTBYT: CAIN S1," " ;IS IT A SPACE ???
MOVEI S1,"-" ;YES,,MAKE IT A DASH
CAIN S1,"*" ;SPECIAL CHARACTER ???
MOVEI S1,":" ;CONVERT TO :
IDPB S1,BYTPTR ;SAVE THE BYTE
$RETT ;RETURN
>
TIMREQ: .TIMEL
^D60*^D60*^D1000
0,,0
G$LOG
LOGIFN: 0,,0
BYTPTR: 0,,0
LOGFOB: LOGFD
^D36
TOPS10<
LOGFD: 5,,0
SIXBIT/STD/
SIXBIT/GALAXY/
SIXBIT/LOG/
0,,0
NEWFD: 5,,0
SIXBIT/STD/
0,,0
SIXBIT/LOG/
0,,0
>
TOPS20<
AREA: ASCIZ/PS*<SPOOL>/
LOGFD: LGLEN,,0
ASCIZ/PS:<SPOOL>GALAXY.LOG/
LGLEN==.-LOGFD
NEWFD: 15,,0
BLOCK 15
>
> ;End of LOGING
SUBTTL IBMSTS - Routine to update counters for IBMCOM
;CALL: M/ The update message address
;
;RET: True always
IBMSTS: PUSHJ P,A$WHEEL## ;Is sender a wheel ???
JUMPF .RETT ;No,,ignore it
MOVE S1,3(M) ;Get the function code
CAXN S1,%TOUT ;Termination printer request ???
$COUNT (TOUT) ;Yes,,account for it
CAXN S1,%TINP ;Termination batch request ???
$COUNT (TINP) ;Yes,,account for it
CAXN S1,%TCNI ;Termination console input ???
$COUNT (TCNI) ;Yes,,account for it
CAXN S1,%TCNO ;Termination console output ??
$COUNT (TCNO) ;Yes,,account for it
CAXN S1,%EOUT ;Emulation printer request ???
$COUNT (EOUT) ;Yes,,account for it
CAXN S1,%EINP ;Emulation batch request ???
$COUNT (EINP) ;Yes,,account for it
CAXN S1,%ECNI ;Emulation console input ???
$COUNT (ECNI) ;Yes,,account for it
CAXN S1,%ECNO ;Emulation console output ??
$COUNT (ECNO) ;Yes,,account for it
$RETT ;Return
END QUASAR