Trailing-Edge
-
PDP-10 Archives
-
BB-D868D-BM
-
language-sources/qsradm.mac
There are 45 other files named qsradm.mac in the archive. Click here to see a list.
TITLE QSRADM -- System Administrative and Operator Functions
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979
; DIGITAL EQUIPMENT CORPORATION
;
; 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 WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC ;PARAMETER FILE
PROLOGUE(QSRADM) ;GENERATE NECESSARY SYMBOLS
SEARCH ORNMAC ;NEED ORION INTERFACE
SUBTTL Module Storage and Constants
MSGPDB: BLOCK IPCHSZ ;PDB FOR SENDING MESSAGES
MSGBLK: BLOCK MOD.SZ+5 ;HOLD/RELEASE/MODIFY MSG BLOCK
;Dummy STARTUP message for VARIOUS PROCESSORS
COMSTA:: $BUILD .ARGLN+OBJ.SZ
$SET(.MSTYP,MS.CNT,.ARGLN+OBJ.SZ)
$SET(.MSTYP,MS.TYP,.OMSTA)
$SET(.MSCOD,,-1)
$SET(.OARGC,,1)
$SET(.OHDRS+ARG.HD,AR.LEN,OBJ.SZ+1)
$SET(.OHDRS+ARG.HD,AR.TYP,.OROBJ)
$SET(.OHDRS+ARG.DA+OBJ.TY,,0)
$SET(.OHDRS+ARG.DA+OBJ.ND,,0)
$EOB
DEFINE VDFALT(AC,LOCN,FIELD,DEFALT,%DUMMY),<
SKIPA
XLIST
JRST %DUMMY
LOAD (AC,LOCN,FIELD)
JUMPN AC,%DUMMY
MOVX AC,DEFALT
STORE (AC,LOCN,FIELD)
%DUMMY:
LIST >
SUBTTL OBJECT TABLE AND MISC STORAGE
;Table of OBJECT types
DEFINE X(OBJ,QUE,PARM),<
EXP .OT'OBJ
> ;END DEFINE X
OBJTAB: MAPOBJ ;GENERATE THE TABLE
NOBJS==.-OBJTAB ;NUMBER OF OBJECTS
BLKADR: BLOCK 1 ;IPCF MSG BLOCK ADDRESS.
BADMSG: $ACK (Orion Message Error,Invalid Object Block Specified,,.MSCOD(M))
$RETF
DEFINE X(A,B,C),<
XXXX==0
IRP C,<
IFE <C>,<STOPI>
IFN <C>,<XXXX==XXXX+1>
>
IFE <XXXX>,<EXP 0>
IFG <XXXX>,<XWD XXXX,[EXP C]>
>
;DEFINE THE OBJECT STATUS CODE LIMITS AND DEVICE TYPES
; 0 = DEVICE STATUS GOOD FOR ALL DEVICES
; COUNT,,ADDRESS = # OF DEVICE TYPES LOCATED AT ADDRESS
; THESE ARE THE ONLY DEVICES FOR WHICH THE STATUS CODE IS VALID
OBJCDS: STATUS ;LETERRIP
SUBTTL Initialization Entry
;CALLED DURING QUASAR INITIALIZATION TO INITIALIZE THE ADMINISTRATIVE
; DATABASE.
A$INIT::PUSHJ P,I%NOW ;GET NOW!!
MOVEM S1,G$ITEM+$$STAR ;SAVE IT
MOVX S1,SP.OPR ;GET ORION'S PID INDEX
PUSHJ P,C%RPRM ;GET ORION'S PID
MOVEM S1,G$OPR## ;SAVE IT FOR FUTURE REFERENCE
MOVE S1,G$LNAM## ;GET THE HOST NODE ID.
MOVEM S1,COMSTA+.OHDRS+ARG.DA+OBJ.ND ;SAVE IT IN THE MESSAGE
MOVEI S1,.OTBIN ;GET THE CORRECT OBJECT TYPE
STORE S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT IN THE MESSAGE
MOVEI M,COMSTA ;STARTUP MESSAGE FOR BIN QUEUE
PUSHJ P,A$OSTA ;SETUP THE OBJECT BLOCK
MOVX S1,.OTDBM ;GET THE DBMS OBJECT TYPE
STORE S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE FOR DBMS STARTUP
MOVEI M,COMSTA ;GET START MESSAGE ADDRESS
PUSHJ P,A$OSTA ;STARTUP THE DBMS PROCESSOR
$RETT ;AND RETURN
SUBTTL Administrative Message Handlers
;THE MESSAGE HANDLERS ARE TOP LEVEL ROUTINES WHICH PROCESS THE
; VARIOUS MESSAGES THAT ARE SENT TO QUASAR. THEY ARE
; CALLED DIRECTLY OUT OF THE MAIN PROCESSING LOOP WITH
; ACCUMULATOR "M" POINTING TO THE FIRST WORD OF THE MESSAGE.
; THE MESSAGE HANDLERS HAVE FULL USE OF ALL ACCUMULATORS
; EXCEPTING "M" AND THE "P" REGS.
INTERN A$HELLO ;FUNCTION 1 -- HELLO
INTERN A$COUNT ;FUNCTION 20 -- COUNT
SUBTTL HELLO -- Function 1
;THE HELLO MESSAGE IS SENT TO QUASAR BY ONE OF THE KNOWN SYSTEM
; COMPONENTS UNDER TWO CIRCUMSTANCES, THE FIRST BEING PROGRAM
; STARTUP, THE SECOND, PROGRAM SHUTDOWN.
A$HELLO:
DOSCHD ;FORCE A SCHEDULING PASS
PUSHJ P,.SAVE1 ;SAVE P1
LOAD S1,.MSTYP(M),MS.CNT ;GET THE MESSAGE SIZE
CAIGE S1,HEL.OB ;AT LEAST BIG ENOUGH?
PJRST E$MTS## ;NO, INDICATE MESSAGE TOO SHORT
PUSHJ P,I$WHEEL## ;SEE IF CALLER IS AN OPERATOR
JUMPF E$IPE## ;ISN'T, CANNOT BECOME A KNOWN COMPONENT
LOAD S1,HEL.FL(M),HEFVER ;GET PROGRAMS VERSION OF QSRMAC
CAXE S1,%%.QSR ;BETTER BE THE SAME AS MINE
PJRST E$WVN## ;ISN'T, GIVE WRONG VERSION ERROR
LOAD S1,HEL.FL(M),HEFBYE ;SAYING GOODBYE?
JUMPN S1,HELL.1 ;YUP, BYE!!
LOAD S1,HEL.NO(M),HENNOT ;GET THE NUMBER OF OBJECT TYPES
JUMPE S1,E$MTS## ;AND GIVE AN ERROR IF ZERO
MOVE S1,HEL.OB(M) ;GET THE FIRST OBJECT TYPE
CAIN S1,.OTMNT ;IS IT FOR TAPE/DISK MOUNTS ???
PUSHJ P,I$MINI## ;YES,,GO CLEAN UP THE MOUNT QUEUE
MOVE S1,G$SND## ;GET PID OF CURRENT SENDER
PUSHJ P,GETPSB ;FIND HIS PSB
MOVE P1,S1 ;STORE ADDRESS OF PSB IN P1
SKIPE PSBPID(P1) ;IS IT A NEW ONE?
JRST HELL.2 ;NO, MUST BE RESTARTING
MOVE S1,G$SND## ;GET SENDER'S PID
MOVEM S1,PSBPID(P1) ;AND STORE IT IN THE PSB
LOAD S1,HEL.NM(M) ;GET PROGRAM NAME
STORE S1,PSBNAM(P1) ;STORE IN THE PSB
LOAD S1,HEL.NO(M),HENMAX ;GET MAXIMUM NUMBER OF JOBS
STORE S1,PSBLIM(P1),PSLMAX ;AND STORE IT
LOAD S1,HEL.NO(M),HENNOT ;LOAD NUMBER OF OBJECT TYPES
STORE S1,PSBFLG(P1),PSFNOT ;AND STORE IT
MOVSI S2,HEL.OB(M) ;GET SOURCE FOR A BLT
HRRI S2,PSBOBJ(P1) ;AND THE DESTINATION
ADDI S1,PSBOBJ-1(P1) ;GET THE END ADDRESS
BLT S2,0(S1) ;AND BLT THE OBJECT TYPES
$LOG(<Process ^W/PSBNAM(P1)/ signon to QUASAR>,<Process PID is ^O/PSBPID(P1)/, Process Object Type is ^O/PSBOBJ(P1)/>,,<$WTFLG(WT.SJI)>)
$RETT ;AND RETURN
;HERE WHEN WE RECEIVE A GOOD-BYE MESSAGE
HELL.1: MOVE S1,G$SND## ;GET SENDERS PID
PUSHJ P,A$FPSB ;FIND THE PSB
JUMPE S1,E$NKC## ;LOSE
PJRST KILPSB ;ELSE, KILL THE PSB
;HERE WHEN WE RECEIVE A HELLO FROM A KNOWN PROGRAM. WE ASSUME THE
; PROGRAM ABENDED AND HAS BEEN RESTARTED, SO WE FORCE A
; GOODBYE FOLLOWED BY A NEW HELLO.
HELL.2: PUSHJ P,KILPSB ;BYE....
JRST A$HELLO ;HI.....
SUBTTL COUNT -- Function 20
;COUNT MESSAGE IS SENT TO QUASAR BY A WHEEL TO REQUEST A COUNT-ANSWER
; CONTAINING ALL OF QUASAR'S INTERESTING COUNTERS.
A$COUNT:
PUSHJ P,I$WHEEL ;IS USER A WHEEL?
JUMPF E$IPE## ;NO, INSUFFICIENT PRIVS
LOAD S1,G$NOW## ;GET NOW
STORE S1,G$ITEM##+$$NOW ;SAVE IT
$COUNT (MCAN) ;NUMBER OF COUNTANSWER MESSAGES
PUSHJ P,M%ACQP ;GET A PAGE
HRRM S1,MSGPDB+.IPCFP ;STORE FOR SEND
PG2ADR S1 ;MAKE AN ADDRESS
MOVSI S2,CAN.SZ ;GET LEN,,0
HRRI S2,.QOCAN ;GET LEN,,FUNCTION
STORE S2,.MSTYP(S1) ;STORE IT IN THE MESSAGE
MOVSI S2,G$ITEM## ;GET START ADDRESS
HRRI S2,CAN.BL(S1) ;GET DEST ADDRESS
BLT S2,CAN.BL+NITEMS(S1) ;BLT THE MESSAGE
MOVEI S1,PAGSIZ ;PUT IN PAGE LENGTH
HRLM S1,MSGPDB+.IPCFP ;STORE IN THE PDB
MOVEI AP,MSGPDB ;POINT TO THE PDB
MOVX S1,IP.CFV ;GET PAGE MODE BIT
MOVEM S1,.IPCFL(AP) ;STORE IN PDB
MOVE S1,G$SND## ;GET PID OF SENDER
MOVEM S1,.IPCFR(AP) ;SAVE AS RECEVIER
PJRST C$SEND## ;SEND IT
SUBTTL Operator Messages
;The following messages are received from ORION:
INTERN A$OSTA ;STARTUP AN OBJECT
INTERN A$OSHT ;SHUTDOWN AN OBJECT
INTERN A$OSET ;SET PARAMETERS FOR AN OBJECT
INTERN A$OPAU ;PAUSE AN OBJECT
INTERN A$OCON ;CONTINUE AN OBJECT
INTERN A$OSHC ;SHOW CONTROL FILE (EXAMINE)
INTERN A$OREQ ;REQUEUE A JOB
INTERN A$OCAN ;CANCEL A JOB
INTERN A$OFWS ;FORWARD SPACE
INTERN A$OBKS ;BACK SPACE
INTERN A$OALI ;ALIGN FORMS ON PRINTER
INTERN A$OSUP ;SUPPRESS CARRIAGE CONTROL
INTERN A$OSND ;SEND MESSAGE TO LOG FILE
INTERN A$OREL ;RELEASE MESSAGE.
INTERN A$OHLD ;HOLD MESSAGE
INTERN A$ORTE ;ROUTE MESSAGE.
INTERN A$ODEL ;DELETE QUEUES MSG
INTERN A$ENABLE ;ENABLE MESSAGE
INTERN A$DISABLE ;DISABLE MESSAGE
INTERN A$MODIFY ;MODIFY QUEUE ENTRY MESSAGE
INTERN A$DEFINE ;DEFINE NODE COMMAND PROCESSOR
INTERN A$DN60 ;DN60 OPERATOR MSG PROCESSOR
INTERN A$STND ;START NODE PROCESSOR
SUBTTL A$OSTA -- Startup an object
A$OSTA: MOVEI S1,.OROBJ ;GET THE OBJECC BLOCK TYPE
PUSHJ P,A$FNDB ;FIND THE OBJECT BLOCK IN THE MESSAGE
JUMPF A$STND ;NO,,MIGHT BE START NODE SO CHECK IT OUT
PUSHJ P,ORANGE ;CHECK FOR A RANGE
PUSHJ P,GETOBJ ;GET THE OBJECT
JUMPF .RETT ;NO GOOD,,RETURN.
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S1 ;SAVE THE OBJECT ADDRESS
MOVX S1,OBSSTA ;GET STARTED BIT...
TDNE S1,OBJSCH(P1) ;ARE WE ALREADY STARTED ?
JRST OSTA.1 ;YES,,LET'EM KNOW ...
IORM S1,OBJSCH(P1) ;NO,,SET IT
$ACK (Startup Scheduled,,OBJTYP(P1),.MSCOD(M))
MOVE S1,P1 ;GET THE OBJECT ADDRESS BACK
PUSHJ P,A$OBST ;SETUP THE OBJECT STATUS.
DOSCHD ;FORCE A SCHEDULING PASS
MOVE S1,OBJTYP(P1) ;GET THE OBJECT TYPE
CAIE S1,.OTLPT ;IS IT THE LINE PRINTER ???
$RETT ;NO,,JUST RETURN
;Check to see if Printer has a Physical Device Name
OSTA.0: MOVX S1,.CMDEV ;WANT A DEVICE BLOCK
PUSHJ P,A$FNDB ;SEE IF THERE IS ONE
JUMPF .RETT ;NO,,JUST RETURN
HRLI S1,(POINT 7,0) ;BYTE POINTER TO THE ASCIZ STRING
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,OBJPRM+.OOTAP(P1) ;SAVE THE DEVICE NAME FOR LATER
MOVX S1,OBSSPL ;GET SPOOL TO TAPE FUNCTION
IORM S1,OBJSCH(P1) ;LITE IT IN THE SCHEDULING VECTOR
$RETT ;AND RETURN
OSTA.1: $ACK (Already Started,,OBJTYP(P1),.MSCOD(M))
$RETT
SUBTTL A$STND - START NODE MESSAGE PROCESSOR
A$STND: $SAVE <M> ;SAVE THE ORIGIONAL MESSAGE ADDRESS
MOVX S1,.ORNOD ;GET NODE BLOCK TYPE
PUSHJ P,A$FNDB ;FIND IT IN THE MESSAGE
JUMPF BADMSG ;NOT THERE,,THATS AN ERROR
MOVE S1,0(S1) ;GET THE NODE NAME
MOVE S2,.MSCOD(M) ;GET THE ACK CODE
MOVEI M,COMSTA ;POINT TO THE COMMON START MESSAGE
MOVEM S1,.OHDRS+ARG.DA+OBJ.ND(M) ;SAVE IN OUR OBJECT BLOCK
MOVEM S2,.MSCOD(M) ;SAVE THE ACK CODE IN THE MESSAGE
SETZM .OHDRS+ARG.DA+OBJ.UN(M) ;WANT UNIT 0
PUSHJ P,N$NODE ;FIND THE NODE IN OUR DATA BASE
LOAD S1,NETSTS(S2),NETIBM ;GET IBM STATUS
LOAD S2,NETSTS(S2),NT.MOD ;GET THE MODE
SKIPE S1 ;IS IT AN IBM REMOTE
CAXE S2,DF.EMU ;IN EMULATION MODE ???
SKIPA ;NO,,START PRINTER AND READER
JRST STND.1 ;YES,,START A BATCH STREAM
MOVX S1,.OTLPT ;GET LINE PRINTER OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE IT IN THE OBJECT BLOCK
PUSHJ P,A$OSTA ;AND START THE LINE PRINTER
MOVX S1,.OTRDR ;GET CARD READER OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS NEW OBJECT TYPE
PUSHJ P,A$OSTA ;START A CARD READER FOR THE NODE
SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
STND.1: MOVX S1,.OTBAT ;GET BATCH STREAM OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
PUSHJ P,A$OSTA ;START A BATCH STREAM FOR THE NODE
SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
SUBTTL A$OSHT -- Shutdown an object
A$OSHT: PUSHJ P,.SAVE2 ;SAVE P1 AND P2 FOR A MINUTE
MOVX S1,.OROBJ ;GET THE OBJECT BLOCK TYPE
PUSHJ P,A$FNDB ;FIND THE OBJECT BLOCK IN THE MESSAGE
JUMPF SHUTNODE ;NO OBJECT BLK,,TRY SHUTDOWN NODE
PUSHJ P,ORANGE ;BREAK UP A RANGE
MOVE P1,S1 ;SAVE THE OBJECT BLOCK ADDRESS
PUSHJ P,A$FOBJ ;FIND IT IN OUR DATA BASE
JUMPF A$SH.1 ;CANT FIND IT,,RETURN.
MOVE P1,S1 ;SAVE THE OBJECT QUEUE ENTRY ADDRESS
LOAD S1,OBJSCH(P1) ;GET OBJ SCHEDULING BITS
TXNN S1,OBSSUP ;IS IT SETUP
JRST A$SH.0 ;NO,,JUST SHUT IT DOWN.
TXO S1,OBSSEJ ;LITE SHUTDOWN AT END OF JOB BIT
TXNE S1,OBSBUS ;IS IT BUSY ??? IF SO,SEND THE ACK.
$ACK (Shutdown at EOJ Scheduled,,OBJTYP(P1),.MSCOD(M))
TXNE S1,OBSFRR ;IS THIS A FREE RUNNING DEVICE ??
TXZ S1,OBSBUS ;YES,,CLEAR THE BUSY BIT
MOVEM S1,OBJSCH(P1) ;SAVE THE SCHEDULING BITS
DOSCHD ;FORCE A SCHEDULING PASS
$RETT ;AND RETURN
A$SH.0: MOVE S1,P1 ;GET THE OBJECT ADDRESS
PUSHJ P,S$SHUT## ;SHUT THE OBJECT DOWN
$RETT ;AND RETURN
A$SH.1: $ACK (Device Unknown,,0(P1),.MSCOD(M))
$RETT
SUBTTL SHUTNODE - ROUTINE TO SHUTDOWN AN ENTIRE NODE
SHUTNO: MOVX S1,.ORNOD ;GET THE NODE BLOCK TYPE
PUSHJ P,A$FNDB ;GO FIND IT IN THE MESSAGE
JUMPF BADMSG ;NOT THERE,,THATS ALL SHE WROTE !!
MOVE S1,0(S1) ;GET THE NODE NAME/NUMBER
PUSHJ P,N$NODE## ;FIND IT IN OUR DATA BASE
DMOVE P1,S1 ;GET NODE NAME (P1), ADDRESS (P2)
PUSHJ P,N$LOCL## ;IS THIS THE CENTRAL SITE ???
JUMPT SHUT.4 ;YES,,CANT DO IT !!!
SETZM .OARGC(M) ;INDICATE NO OBJECT SHUTDOWN YET !!!
MOVX S1,NETSHT ;GET THE NETWORK SHUTDOWN BIT
IORM S1,NETSTS(P2) ;LITE IT FOR THIS NODE
MOVEI H,HDROBJ## ;GET THE OBJECT HEADER ADDRESS
LOAD P2,.QHLNK(H),QH.PTF ;GET THE FIRST OBJECT
SHUT.1: JUMPE P2,SHUT.5 ;NO MORE,,WE ARE DONE
CAME P1,OBJNOD(P2) ;ARE WE SHUTING DOWN THIS OBJECT ???
JRST SHUT.2 ;NO,,TRY THE NEXT ONE
LOAD S1,OBJSCH(P2) ;GET THE SCHEDULING BITS
TXNN S1,OBSSUP ;IS THE OBJECT SETUP ???
JRST SHUT.3 ;NO,,JUST SHUT IT DOWN
TXO S1,OBSSEJ ;LITE SHUT DOWN AT EOJ BIT
TXNE S1,OBSBUS ;IS THE OBJECT BUSY ???
$ACK (<Shutdown at EOJ Scheduled>,,OBJTYP(P2),.MSCOD(M));YES !!
TXNE S1,OBSFRR ;IS THIS A FREE RUNNING OBJECT ???
TXZ S1,OBSBUS ;YES,,TURN OFF THE 'BUSY' BITS
STORE S1,OBJSCH(P2) ;RESTORE THE SCHEDULING BITS
DOSCHD ;FORCE A SCHEDULING PASS
AOS .OARGC(M) ;BUMP SHUTDOWN COUNT BY 1
SHUT.2: LOAD P2,.QELNK(P2),QE.PTN ;GET THE NEXT OBJECT ADDRESS
JRST SHUT.1 ;AND CONTINUE
SHUT.3: MOVE S1,P2 ;GET THE CURRENT OBJECT ADDRESS
LOAD P2,.QELNK(P2),QE.PTN ;GET NEXT OBJ ADDR,,THIS ONE IS LEAVING
PUSHJ P,S$SHUT## ;SHUT IT DOWN
AOS .OARGC(M) ;BUMP SHUTDOWN COUNT BY 1
JRST SHUT.1 ;AND CONTINUE
SHUT.4: $ACK (<Host Node Shutdown is Illegal>,,,.MSCOD(M))
$RETT ;RETURN
SHUT.5: SKIPN .OARGC(M) ;DID WE SHUTDOWN ANY OBJECTS ???
$ACK (<Nothing Started for Node ^N/P1/>,,,.MSCOD(M)) ;NO !!
$RETT ;RETURN
SUBTTL A$OSET -- Set parameters for an object
A$OSET: PUSHJ P,.SAVE3 ;SAVE P1 & P2 FOR A MINUTE
MOVEI S1,.OROBJ ;GET THE OBJECT BLOCK TYPE
PUSHJ P,A$FNDB ;FIND THE OBJECT BLOCK IN THE MESSAGE
JUMPF NETSET ;NOT THERE,,TRY NETWORK SET
MOVE P1,S1 ;SAVE THE OBJ BLK ADDRESS FOR A MINUTE
OSET.0: PUSHJ P,A$GBLK ;GET FIRST/NEXT MESSAGE BLOCK
JUMPF BADMSG ;NO MORE,,RETURN THROUGH 'BADMSG'
MOVSI S1,-NSETS ;GET NEGATIVE # OS SET COMMANDS.
OSET.1: HLRZ S2,SETTBL(S1) ;PICK UP A SET COMMAND TYPE.
CAMN S2,T1 ;DO WE MATCH ???
JRST OSET.2 ;YES,,GO PROCESS IT
AOBJN S1,OSET.1 ;BUMP TO NEXT TBL ENTRY AND CONTINUE.
JRST OSET.0 ;NO MATCH,,TRY NEXT
OSET.2: HRRZ P2,SETTBL(S1) ;GET THE PROCESSING ROUTINE ADDRESS
MOVE P3,T3 ;SAVE THE 'SET' DATA ADDRESS
MOVE S1,P1 ;GET THE OBJ BLK ADDRESS
PUSHJ P,ORANGE ;BREAK UP THE RANGE
MOVE P1,S1 ;SAVE THE OBJ BLK ADDRESS
PUSHJ P,GETOBJ ;FIND/CREATE THE OBJ BLK.
JUMPF .RETT ;NO GOOD,,RETURN
MOVE P1,S1 ;SAVE THE OBJECT QUEUE ADDRESS
PJRST 0(P2) ;GO PROCESS IT (ADDRESS FROM OSET.2)
SETPGL: MOVEI S1,.OOLIM ;GET PAGE LIMIT OFFSET.
PJRST SETMMX ;GO SET MIN/MAX.
SETFRM: LOAD S1,0(P3) ;GET FORMS TYPE.
STORE S1,OBJPRM+.OOFRM(P1) ;AND SAVE IT IN QUEUE.
JRST SETMSG ;GO SAY ITS OK...
SETMEM: MOVEI S1,.OBCOR ;GET CORE LIMIT OFFSET.
PJRST SETMMX ;GO SET MIN/MAX.
SETTIM: MOVEI S1,.OBTIM ;GET TIME LIMIT OFFSET.
PJRST SETMMX ;GO SET MIN/MAX.
SETPRI: MOVEI S1,.OOPRI ;GET PRIORTY LIMIT OFFSET.
PJRST SETMMX ;GO SET MIN/MAX.
SETOIA: SKIPA S1,[.OPINY] ;GET OPR INTERVN ALLOWED CODE
SETNOI: MOVE S1,[.OPINN] ;GET NO OPR INTERVN ALLOWED CODE
STORE S1,OBJPRM+.OBFLG(P1),.OPRIN ;SAVE IT
JRST SETMSG ;SEND AN ACK AND RETURN
SETLEA: LOAD S1,0(P3) ;GET THE ACTION CODE
STORE S1,OBJPRM+.OOFLG(P1),.OFLEA ;SAVE IT IN THE OBJECT BLOCK
JRST SETMSG ;SEND THE ACK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SETMMX: ADDI S1,OBJPRM(P1) ;CALC QUEUE PARAMETER ADDRESS.
LOAD S2,0(P3) ;PICK UP MIN VALUE.
STORE S2,0(S1),OBPMIN ;SAVE THE MIN VALUE.
LOAD S2,1(P3) ;PICK UP MAX VALUE.
STORE S2,0(S1),OBPMAX ;SAVE THE MAX VALUE.
SETMSG: $ACK (Set Accepted,,OBJTYP(P1),.MSCOD(M))
MOVE S1,P1 ;GET OBJECT ADDRESS IN S1
PUSHJ P,A$OBST ;UPDATE THE OBJECT STATUS
DOSCHD ;FORCE A SCHEDULING PASS
$RETT ;RETURN.
SETTBL: .STPGL,,SETPGL ;PAGE LIMIT
.STFRM,,SETFRM ;FORMS TYPE
.STMEM,,SETMEM ;CORE LIMIT
.STTIM,,SETTIM ;TIME LIMIT
.STPRI,,SETPRI ;PRIORTY LIMIT
.STOIA,,SETOIA ;OPR INTERVENTION ACTION
.STNOI,,SETNOI ;NO OPR INTERVENTION ACTION.
.STLEA,,SETLEA ;LIMIT EXCEEDED ACTION
NSETS==.-SETTBL
SUBTTL NETSET - 'SET NODE' PROCESSING ROUTINE
NETSET:
IFN FTDN60,<
MOVX S1,.ORNOD ;GET THE NODE BLOCK TYPE
PUSHJ P,A$FNDB ;SEE IF ITS THERE
JUMPF BADMSG ;THAT WAS HIS LAST CHANCE
MOVE S1,0(S1) ;GET THE NODE NAME/NUMBER
PUSHJ P,N$NODE## ;FIND/ADD IT TO OUR DATA BASE
MOVE P1,S2 ;SAVE THE DATA BASE ENTRY ADDRESS
;A Little Preliminary Checking is in Order !!!
LOAD S1,NETSTS(P1),NETIBM ;GET THE IBM REMOTE STATUS BITS
JUMPE S1,NETS.2 ;NOT IBM,,CAN'T DO THIS !!!
LOAD S1,NETSTS(P1),NETONL ;GET THE NODE ONLINE BIT
JUMPN S1,NETS.3 ;CAN'T SET PARMS FOR ONLINE NODES
MOVE S1,P1 ;PASS THE NODE DB ADDRESS IN S1
PUSHJ P,FNDDEV ;CHECK FOR DEVS STARTED FOR THIS NODE
JUMPT NETS.4 ;FOUND ONE,,THATS AN ERROR
NETS.1: PUSHJ P,A$GBLK ;GO GET A BLOCK
CAIN T1,.ORNOD ;IS THIS THE NODE BLOCK (ALREADY DONE) ?
JRST NETS.1 ;YES,,TRY THE NEXT ONE
MOVE T3,0(T3) ;GET THE ARGUMENT DATA
CAIN T1,.STCSD ;IS IT THE CLEAR TO SEND DELAY VALUE
STORE T3,NETCSD(P1) ;YES,,SAVE IT
CAIN T1,.STDTR ;IS IT THE DATA TERMINAL READY VALUE ???
STORE T3,NETSTS(P1),NT.DTR ;YES,,SAVE IT
CAIN T1,.STRPM ;IS IT THE RECORDS PER MESSAGE VALUE ???
STORE T3,NETRPM(P1) ;YES,,SAVE IT
CAIN T1,.STSWL ;IS IT THE SILO WARNING LEVEL VALUE ???
STORE T3,NETSWL(P1) ;YES,,SAVE IT
CAIN T1,.STTOU ;IS IT THE TIMEOUT CATAGORY ???
STORE T3,NETSTS(P1),NT.TOU ;YES,,SAVE IT
CAIN T1,.STTRA ;IS IT THE TRANSPARENCY VALUE ???
STORE T3,NETSTS(P1),NT.TRA ;YES,,SAVE IT
CAIN T1,.STBPM ;IS IT BYTES PER MESSAGE ???
STORE T3,NETBPM(P1) ;YES,,SAVE IT
MOVX S1,NETSGN ;GET NODE SIGNON REQUIRED BIT
CAIN T1,.STSON ;IS SIGNON REQUIRED ???
IORM S1,NETSTS(P1) ;YES,,LIGHT THE BIT
CAIN T1,.STNSN ;IS SIGNON OPTIONAL ???
ANDCAM S1,NETSTS(P1) ;YES,,CLEAR THE BIT
$ACK (<Set for Node ^T/NETASC(P1)/ Accepted>,,,.MSCOD(M))
$RETT ;RETURN
NETS.2: $ACK(<Set for Node ^T/NETASC(P1)/ Ignored>,<Node ^T/NETASC(P1)/ is Not Defined as an IBM Remote>,,.MSCOD(M))
$RETT
NETS.3: SKIPA S1,[EXP [ASCIZ/Can't SET a Node Which is Online/] ]
NETS.4: MOVEI S1,[ASCIZ/Can't SET a Node Which Has Devices Started/]
$ACK (<Set for Node ^T/NETASC(P1)/ Ignored>,<^T/0(S1)/>,,.MSCOD(M))
$RETT
>
IFE FTDN60,<JRST NODN60 > ;JUST ACK AND RETURN
SUBTTL A$MODIFY - ROUTINE TO SET THE JOBS PRIORTY
A$MODIFY:
MOVX S1,.MOPRI ;GET THE PRIORITY BLOCK TYPE
PUSHJ P,A$FNDB ;GO FIND THE PRIORITY BLOCK
JUMPF BADMSG ;IF NOT FOUND,,THATS AN ERROR
PUSH P,0(S1) ;SAVE THE NEW PRIORITY
MODI.2: MOVEI S1,MSGBLK+MOD.RQ ;GET THE MESSAGE RDB ADDRESS
PUSHJ P,GENRDB ;GO GENERATE IT
POP P,MSGBLK+MOD.SZ+2 ;STORE PRTY IN THE MESSAGE
MOVX S1,MOD.SZ+3 ;GET THE MESSAGE LENGTH
STORE S1,MSGBLK+.MSTYP,MS.CNT ;AND SAVE IT
MOVX S1,.QOMOD ;GET THE MESSAGE TYPE
STORE S1,MSGBLK+.MSTYP,MS.TYP ;AND SAVE IT
SETOM MSGBLK+MOD.SZ+1 ;NO /AFTER PARAMETER
MOVEI S1,3 ;GET THE MAJOR BLOCK LENGTH
MOVEM S1,MSGBLK+MOD.SZ ;AND SAVE IT
SETZM G$ACK## ;WE DONT WANT AN ACK.
SETOM G$QOPR## ;THIS IS AN OPERATOR REQUEST
PUSH P,M ;SAVE THE OLD MESSAGE ADDRESS
MOVEI M,MSGBLK ;GET THE NEW MESSAGE ADDRESS
PUSHJ P,Q$MODIFY## ;GO MODIFY THE JOB PRIORTY
MOVE T1,S1 ;GET THE NUMBER OF JOB AFFECTED
POP P,M ;RESTORE THE OLD MESSAGE ADDRESS
SETZM G$QOPR## ;RESET THE OPERATOR INDICATOR
SETZM G$RMTE## ;ZERO THE NODE WE USED (SET BY GENRDB)
SKIPG T1 ;MORE THEN 0 JOBS ???
$ACK (<No Requests Modified>,,,.MSCOD(M))
CAIN T1,1 ;JUST 1 JOB ???
$ACK (<1 Request Modified>,,,.MSCOD(M))
CAILE T1,1 ;MORE THEN 1 JOB ???
$ACK (<^D/T1/ Requests Modified>,,,.MSCOD(M))
$RETT ;AND RETURN
SUBTTL A$ENABLE - ROUTINE TO ENABLE QUEUE ENTRY CREATE'S
A$ENABLE: SETZM G$QUEUE## ;ENABLE PROCESSING FOR CREATE MESSAGES
$ACK (System Queue's Entry Processing Enabled,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL A$DISABLE - ROUTINE TO DISABLE QUEUE ENTRY CREATE'S
A$DISABLE: SETOM G$QUEUE## ;DISABLE PROCESSING FOR CREATE MESSAGES
$ACK (System Queue's Entry Processing Disabled,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL A$OREQ - Operator REQUEUE Request
A$OREQ: PUSHJ P,.SAVE1 ;SAVE P1
MOVX S1,.OROBJ ;GET OBJECT BLOCK TYPE CODE
PUSHJ P,A$FNDB ;GO FIND IT IN THE MESSAGE
JUMPF BADMSG ;NOT THERE,,RETURN WITH AN ERROR
PUSHJ P,ORANGE ;CHECK FOR A RANGE
MOVE P1,S1 ;SAVE THE OBJECT BLOCK ADDRESS
MOVE S2,OBJ.UN(P1) ;GET THE UNIT NUMBER
MOVEM S2,.OHDRS+ARG.DA+OBJ.UN(M) ;SAVE IT IN THE MESSAGE
PUSHJ P,A$FOBJ ;FIND THE OBJ ENTRY
JUMPF A$RQ.1 ;DONE IF NOT THERE
MOVE P1,S1 ;SAVE THE OBJECT QUEUE ENTRY ADDRESS
MOVE S1,OBJSCH(P1) ;GET THE SCHEDULING BITS
TXNN S1,OBSBUS ;IS THE OBJECT BUSY ???
JRST A$RQ.2 ;NO,,LET'EM KNOW AND RETURN.
TXNE S1,OBSFRR ;IS THIS A FREE RUNNING DEVICE ???
JRST OREQ.3 ;YES,,JUST SEND THE MESSAGE
LOAD S1,OBJITN(P1) ;GET THE ITN
PUSHJ P,Q$SUSE## ;FIND IT IN THE USE QUEUE
SKIPT ;SKIP IF WE WON
$STOP(RJM,Requeue job missing)
MOVE AP,S1 ;SAVE THE QE ADDRESS
OREQ.1: PUSHJ P,A$GBLK ;GET FIRST/NEXT MESSAGE BLOCK
JUMPF OREQ.3 ;NO MORE,,SEND THE MSG.
CAIE T1,.ORREQ ;IS THIS THE REQUEST ID BLOCK
JRST OREQ.1 ;NO,,TRY THE NEXT ONE
LOAD S1,.QERID(AP) ;GET THE REQUEST ID
CAME S1,0(T3) ;DO WE MATCH ???
JRST A$RQ.3 ;NO,,TOUGH BREAKEEEE
JRST OREQ.1 ;YES,,CONTINUE
OREQ.3: MOVE S1,P1 ;LOAD S1 WITH OBJECT BLOCK ADDR.
PJRST SNDOAC ;GO SEND THE MSG.
A$RQ.1: $ACK (Device Unknown,,0(P1),.MSCOD(M))
$RETT
A$RQ.2: $ACK (Not Active,,OBJTYP(P1),.MSCOD(M))
$RETT
A$RQ.3: $ACK (Request Id Invalid,,OBJTYP(P1),.MSCOD(M))
$RETT
SUBTTL A$COMM - OPERATOR REQUEST COMMON PROCESSING ROUTINE.
A$COMM: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVX S1,.OROBJ ;GET THE OBJECT BLOCK TYPE CODE
PUSHJ P,A$FNDB ;FIND THE OBJECT BLOCK IN THE MESSAGE
JUMPF BADMSG ;NOT THERE,,TOO BAD !!!
PUSHJ P,ORANGE ;DETERMINE OBJECT RANGE.
MOVE P1,S1 ;SAVE THE OBJECT BLOCK ADDRESS
MOVE S2,OBJ.UN(P1) ;GET THE UNIT NUMBER
MOVEM S2,.OHDRS+ARG.DA+OBJ.UN(M) ;SAVE IT IN THE MESSAGE
PUSHJ P,A$FOBJ ;FIND THE OBJECT BLOCK.
JUMPF A$CO.1 ;NOT THERE,,RETURN.
MOVE P1,S1 ;SAVE THE OBJECT QUEUE ENTRY ADDRESS
MOVX S1,OBSBUS ;PICK UP BUSY BIT.
TDNN S1,OBJSCH(P1) ;IS THE DEVICE BUSY ???.
JRST A$CO.2 ;IF NOT,, RETURN.
MOVE S1,P1 ;GET THE OBJECT ADDRESS
PUSHJ P,SNDOAC ;GO SEND THE MSG.
MOVE S1,P1 ;GET THE OBJECT ADDRESS
PUSHJ P,A$OBST ;RESET THE OBJECT STATUS.
$RETT ;RETURN...
A$CO.1: $ACK (Device Unknown,,0(P1),.MSCOD(M))
$RETT
A$CO.2: MOVX S1,OBSSTP ;GET THE 'STOPPED BY OPERATOR' BIT
LOAD S2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
CAIE S2,.OMPAU ;IS IT 'STOP'
JRST A$CO.3 ;NO,,TRY 'CONTINUE'
IORM S1,OBJSCH(P1) ;YES,,TURN ON STOP BIT
$ACK (Stopped,,OBJTYP(P1),.MSCOD(M)) ;TELL THE OPERATOR
MOVE S1,P1 ;GET THE OBJECT ADDRESS
PUSHJ P,A$OBST ;UPDATE THE OBJECT STATUS
$RETT ;AND RETURN
A$CO.3: CAIE S2,.OMCON ;IS THE MESSAGE 'CONTINUE' ???
JRST A$CO.4 ;NO,,JUST ACK AND LEAVE
ANDCAM S1,OBJSCH(P1) ;TURN OFF THE 'STOP' BIT
$ACK (Continued,,OBJTYP(P1),.MSCOD(M)) ;TELL THE OPERATOR
MOVE S1,P1 ;GET THE OBJECT ADDRESS
PUSHJ P,A$OBST ;UPDATE THE OBJECT STATUS
DOSCHD ;FORCE A SCHEDULING PASS
$RETT ;AND RETURN
A$CO.4: $ACK (Not Active,,OBJTYP(P1),.MSCOD(M))
$RETT
SUBTTL OPERATOR COMMAND PROCESSING ROUTINES.
A$OPAU: PJRST A$COMM ;PROCESS THE STOP COMMAND.
A$OCON: PJRST A$COMM ;PROCESS THE CONTINUE COMMAND.
A$OALI: PJRST A$COMM ;PROCESS THE ALIGN COMMAND.
A$OCAN: PJRST A$OREQ ;PROCESS THE CANCEL COMMAND.
A$OFWS: PJRST A$COMM ;PROCESS THE FORWARD SPACE COMMAND.
A$OBKS: PJRST A$COMM ;PROCESS THE BACK SPACE COMMAND.
A$OSUP: PJRST A$COMM ;PROCESS THE SUPPRESS COMMAND.
A$OSND: STKVAR <OBJADR> ;ALLOCATE SOME SPACE ON THE STACK
MOVX S1,.OROBJ ;GET THE OBJECT BLOCK TYPE
PUSHJ P,A$FNDB ;FIND THE OBJECT BLOCK IN THE MESSAGE
JUMPF BADMSG ;NOT THERE,,THATS AN ERROR
MOVEM S1,OBJADR ;SAVE THE ADDRESS FOR A MINUTE
PUSHJ P,A$FOBJ ;FIND THE OBJECT IN OUR OBJECT QUEUE
JUMPF OSND.1 ;NOT,THERE,,JUST RETURN
MOVEM S1,OBJADR ;SAVE THE ADDRESS FOR A MINUTE
MOVE S1,OBJNOD(S1) ;GET THE NODE FOR THIS OBJECT
PUSHJ P,N$NODE## ;FIND IT IN OUT DATA BASE
MOVE S1,OBJADR ;RESTORE THE OBJECT ADDRESS TO S1
LOAD S2,NETSTS(S2) ;GET THE NODE STATUS BITS IN S2
TXNN S2,NETIBM ;IS THIS NODE SOME FLAVOR OF DN60 ???
JRST A$COMM ;NO,,ALL THIS FOR NOTHING !!!
LOAD S2,S2,NT.MOD ;GET THIS NODES MODE OF OPERATION
CAXE S2,DF.EMU ;IS IT EMULATION ???
JRST A$COMM ;NO,,WELL WE STILL LOSE !!!
LOAD S2,OBJSCH(S1) ;SO FAR, SO GOOD - GET SCHEDULING BITS
TXNE S2,OBSSUP ;OBJECT MUST BE SETUP.IF SO HE WINS
JRST SNDOAC ;ALL THIS FOR DN60! ITS NOT WORTH IT !!
$ACK (<Not Active>,,OBJTYP(S1),.MSCOD(M))
$RETT ;JUST RETURN
OSND.1: MOVE S1,OBJADR ;GET THE OBJECT ADDRESS IN S1
$ACK (<Device Unknown>,,0(S1),.MSCOD(M)) ;ACK THE OPR
$RETT ;ANOTHER ERROR,,JUST RETURN
A$OSHC: PJRST A$COMM ;PROCESS THE SHOW CONTROL FILE COMMAND.
SUBTTL A$OREL, A$OHLD - RELEASE/HOLD OPERATOR MESSAGES.
A$OREL: TXOA S1,HB.FRL ;INDICATE RELEASE ENTRY POINT.
A$OHLD: SETZ S1, ;INDICATE HOLD ENTRY POINT.
PUSH P,S1 ;SAVE THE ENTRY TYPE
MOVEI S1,MSGBLK+HBO.RQ ;GET THE MESSAGE RDB ADDRESS
PUSHJ P,GENRDB ;GO CREATE THE MESSAGE RDB
POP P,MSGBLK+HBO.FL ;SAVE THE TYPE FLAGS (GENERATED ABOVE)
MOVX S1,HBO.SZ ;GET THE MESSAGE LENGTH
STORE S1,MSGBLK+.MSTYP,MS.CNT ;AND SAVE IT
MOVX S1,.QOHBO ;GET THE MESSAGE TYPE
STORE S1,MSGBLK+.MSTYP,MS.TYP ;AND SAVE IT
SETZM G$ACK## ;INDICATE NO ACK.
SETOM G$QOPR## ;SHOW THAT MSG IS FROM THE OPERATOR.
PUSH P,M ;SAVE M (OLD MSG ADDRESS)
MOVEI M,MSGBLK ;POINT TO OUR NEW MESSAGE
PUSHJ P,Q$HOLD## ;PERFORM HOLD/RELEASE
MOVE T1,S1 ;GET THE # OF JOBS AFFECTED
POP P,M ;RESTORE M (OLD MSG ADDRESS)
SETZM G$QOPR## ;TURN OFF THE QUEUE SEARCH FLAG.
SETZM G$RMTE## ;ZERO THE NODE WE USED (SET BY GENRDB)
MOVEI S1,[ASCIZ/ Held/] ;ASSUME HOLD MESSAGE.
SKIPE MSGBLK+HBO.FL ;CHECK MSG FLAGS,,IF 0 WE WERE RIGHT.
MOVEI S1,[ASCIZ/ Released/] ;ELSE MAKE IT RELEASE.
SKIPG T1 ;MORE THEN 0 JOBS ???
$ACK (<No jobs^T/0(S1)/>,,,.MSCOD(M))
CAIN T1,1 ;IS THERE ONLY 1 JOB ???
$ACK (<1 Job^T/0(S1)/>,,,.MSCOD(M))
CAILE T1,1 ;MORE THEN 1 JOB ???
$ACK (<^D/T1/ Jobs^T/0(S1)/>,,,.MSCOD(M))
SKIPE MSGBLK+HBO.FL ;IS THIS A RELEASE MESSAGE ???
DOSCHD ;YES,,FORCE A SCHEDULING PASS
$RETT ;AND RETURN.
SUBTTL A$ODEL - ROUTINE TO REMOVE JOBS FROM THE SYSTEM QUEUES
A$ODEL: MOVEI S1,MSGBLK+KIL.RQ ;NO,,GET THE FAKE KILL MSG RDB ADDR
PUSHJ P,GENRDB ;GO CREATE THE RDB FOR THE MSG
MOVX S1,KIL.SZ ;GET THE MESSAGE SIZE
STORE S1,MSGBLK+.MSTYP,MS.CNT ;SAVE IT
MOVX S1,.QOKIL ;GET THE MESSAGE TYPE
STORE S1,MSGBLK+.MSTYP,MS.TYP ;SAVE IT
SETZM MSGBLK+.MSFLG ;NO FLAGS
SETZM MSGBLK+.MSCOD ;NO ACK CODE
SETZM G$ACK## ;NO ACK (PERIOD)
SETOM G$QOPR## ;THIS IS AN OPERATOR REQUEST
PUSH P,M ;SAVE THE OPR MSG ADDRESS
MOVEI M,MSGBLK ;GET OUT FAKE KILL MSG ADDRESS
PUSHJ P,Q$KILL## ;GO DO IT !!!
MOVE T1,S1 ;GET # OF JOBS AFFECTED
POP P,M ;RESTORE OLD MSG ADDRESS
SETZM G$QOPR## ;CLEAR OPR FLAG
SETZM G$RMTE## ;ZERO THE NODE WE USED (SET BY GENRDB)
SKIPG T1 ;NO JOBS KILLED !!!
$ACK (<No Jobs Canceled>,,,.MSCOD(M))
CAIN T1,1 ;1 JOB KILLED !!!
$ACK (<1 Job Canceled>,,,.MSCOD(M))
CAILE T1,1 ;MORE THE 1 JOB !!!
$ACK (<^D/T1/ Jobs Canceled>,,,.MSCOD(M))
$RETT ;RETURN,,WE'RE DONE
SUBTTL A$ORTE - ROUTINE TO PROCESS OPERATOR ROUTE COMMAND.
A$ORTE: PUSHJ P,I$WHEEL## ;IS THIS GUY A WHEEL ???
JUMPF E$IPE## ;NO,,A FRAUD !!
MOVX S1,.ORRTN ;GET THE ROUTE BLOCK TYPE
PUSHJ P,A$FNDB ;FIND THE BLOCK IN THE MESSAGE
JUMPF BADMSG ;NOT THERE,,RETURN AN ERROR
LOAD S2,.DNODE-1(S1) ;GET THE DESTINATION NODE NBR.
LOAD S1,.SNODE-1(S1) ;GET THE SOURCE NODE NUMBER.
PUSHJ P,N$NRTE## ;GO ROUTE THE NODE
DOSCHD ;FORCE A SCHEDULING PASS
$RETT ;AND RETURN
SUBTTL A$DEFINE - ROUTINE TO PROCESS THE 'DEFINE' NETWORK COMMAND
;CALL: M/ The message address
;
;RET: TRUE ALWAYS
A$DEFINE:
IFN FTDN60,<
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVX S1,.ORNOD ;GET THE NODE NAME BLOCK TYPE
PUSHJ P,A$FNDB ;GO FIND IT
JUMPF BADMSG ;NOT THERE,,ORION BUG !!!
MOVE S1,0(S1) ;GET THE NODE NAME
PUSHJ P,N$NODE## ;FIND/ADD IT TO OUR DATA BASE
MOVE P1,S2 ;SAVE THE DATA BASE ENTRY ADDRESS
LOAD S1,NETSTS(P1),NETONL ;GET THE NODE ONLINE BIT
JUMPN S1,DEFI.2 ;IF ONLINE,,CAN'T DEFINE THE NODE
;Check to make sure there are no devices started for the node to be
;defined
MOVE S1,P1 ;PASS THE NODE DB ADDRESS IN S1
PUSHJ P,FNDDEV ;CHECK FOR DEVS STARTED FOR THIS NODE
JUMPT DEFI.3 ;FOUND ONE,,THATS AN ERROR
;Here if All's OK, Find the DEFINE Msg Block
DEFI.1: MOVX S1,.DFBLK ;GET THE DEFINE BLOCK TYPE
PUSHJ P,A$FNDB ;GO FIND IT
JUMPF BADMSG ;NOT THERE,,ORION ERROR
MOVEI S1,-1(S1) ;MAKE SURE WE ARE POINTING AT BLK HEADER
MOVE S2,DEF.TY(S1) ;GET THE TYPE OF NODE
STORE S2,NETSTS(P1),NT.TYP ;SAVE IT IN OUR DATA BASE
MOVE S2,DEF.MD(S1) ;GET THE NODE MODE
STORE S2,NETSTS(P1),NT.MOD ;SAVE IT IN OUR DATA BASE
MOVE S2,DEF.PT(S1) ;GET THE PORT NUMBER
STORE S2,NETPTL(P1),NT.PRT ;SAVE THE PORT NUMBER
MOVE S2,DEF.LN(S1) ;GET THE LINE NUMBER
STORE S2,NETPTL(P1),NT.LIN ;SAVE THE LINE NUMBER
LOAD S2,NETSTS(P1),NT.TYP ;GET THE REMOTE TYPE
CAXN S2,DF.378 ;IS IT 3780 ???
VDFALT S1,NETBPM(P1),FWMASK,^D512 ;YES,,DEFAULT BYTES-PER-MSG TO 512
CAXE S2,DF.378 ;IS IT 2780 OR HASP ???
VDFALT S1,NETBPM(P1),FWMASK,^D400 ;YES,,DEFAULT BYTES-PER-MSG TO 400
CAXN S2,DF.278 ;IS IT 2780 ???
VDFALT S1,NETRPM(P1),FWMASK,7 ;YES,,DEFAULT RCRDS-PER-MSG TO 7
LOAD S2,NETSTS(P1),NT.MOD ;GET THE REMOTE MODE
CAXN S2,DF.TRM ;IS IT TERMINATION MODE ???
VDFALT S1,NETSTS(P1),NT.TOU,ST.PRI ;YES,,DEFAULT PROTOCOL TO PRIMARY
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
CAXN S2,DF.EMU ;IS IT EMULATION MODE ???
VDFALT S1,NETSTS(P1),NT.TOU,ST.SEC ;YES,,DEFAULT PROTOCOL TO SECONDARY
VDFALT S1,NETSTS(P1),NT.DTR,ST.ON ;DEFAULT DTR IS ON
VDFALT S1,NETSTS(P1),NT.TRA,ST.OFF ;DEFAULT TRANSPARENCY IS OFF
VDFALT S1,NETCSD(P1),FWMASK,3 ;DEFAULT CLEAR-TO-SEND DELAY TO 3
VDFALT S1,NETSWL(P1),FWMASK,^D64 ;DEFAULT SILO WARNING LEVEL TO 64
MOVE S1,G$NOW## ;GET THE UDT FOR PORT/LINE HANDLE
MOVEM S1,NETIDN(P1) ;SAVE IT IN THE DATA BASE
MOVEI S1,1 ;GET A 1
STORE S1,NETSTS(P1),NETIBM ;LITE THE IBM NODE BIT
STORE S1,NETSTS(P1),NETSGN ;ALSO LITE 'SIGNON REQUIRED' BIT
$ACK (<Define for Node ^T/NETASC(P1)/ Accepted>,,,.MSCOD(M))
$RETT ;AND RETURN
DEFI.2: SKIPA S1,[EXP [ASCIZ/Can't DEFINE a Node Which is Online/] ]
DEFI.3: MOVEI S1,[ASCIZ/Can't DEFINE a Node Which Has Devices Started/]
$ACK(<Define for Node ^T/NETASC(P1)/ Ignored>,<^T/0(S1)/>,,.MSCOD(M))
$RETT
>
IFE FTDN60,<
NODN60: $ACK (<DN60 Remotes are not Supported>,,,.MSCOD(M))
$RETT
>
SUBTTL A$DN60 - ROUTINE TO SEND A OPERATOR RESPONSE TO LPTSPL
;CALL: M/ The Operator response message address
;
;RET: True Always
A$DN60:
IFN FTDN60,<
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVX S1,.OTLPT ;GET PRINTER OBJECT TYPE
MOVEM S1,MSGBLK+OBJ.TY ;SAVE IT IN OBJECT BLOCK
SETZM MSGBLK+OBJ.UN ;WANT UNIT 0
MOVE S1,.MSCOD(M) ;GET THE NODE NAME
MOVEM S1,MSGBLK+OBJ.ND ;SAVE IT IN OBJECT BLOCK
MOVEI S1,MSGBLK ;POINT TO OUR OBJECT BLOCK
PUSHJ P,A$FOBJ ;FIND IT IN THE OBJECT QUEUE
JUMPF DN60.1 ;NOT THERE,,TELL OPERATOR AND RETURN
MOVE P1,S1 ;SAVE THE OBJECT ADDRESS
LOAD S1,OBJSCH(P1) ;GET THE OBJECT SCHEDULING BITS
TXNN S1,OBSSUP+OBSSIP ;OBJ MUST BE SETUP OR SETUP-IN-PROGRESS
JRST DN60.1 ;NO,,TELL OPERATOR AND RETURN
LOAD S1,OBJNOD(P1) ;GET THIS OBJECTS NODE NAME
PUSHJ P,N$NODE## ;FIND IT IN OUR DATA BASE
LOAD S1,NETSTS(S2),NETIBM ;GET THE DN60 FLAG BIT
JUMPE S1,DN60.1 ;NOT DN60,,TELL OPR AND RETURN
MOVE S1,P1 ;GET THE OBJECT ADDRESS
PJRST SNDOAC ;AND SEND THE MESSAGE OFF TO LPTSPL
DN60.1: $WTO(<No Operator Console for IBM Remote '^W/.MSCOD(M)/'>,,,<$WTFLG(WT.SJI)>)
PJRST SNDOPR ;RETURN THE MSG TO ORION AND RETURN
>
IFE FTDN60,<JRST NODN60 > ;SHOULD NOT HAPPEN
SUBTTL SNDOAC -- Send an Operator Action Message
;CALL: S1/ADDR OF OBJECT BLOCK
; M/ADDR OF MSG TO BE SENT
SNDOPR: TDZA S2,S2 ;INDICATE SEND ORION ENTRY POINT
SNDOAC: SETOM S2 ;INDICATE SEND PROCESSOR ENTRY POINT
$SAVE <AP,T2,T3> ;SAVE AP, T2 AND T3
DMOVE T2,S1 ;SAVE OBJ BLK ADDR AND ENTRY POINT FLAG
PUSHJ P,M%ACQP ;GET A PAGE.
PG2ADR S1 ;CONVERT TO AN ADDRESS.
PUSH P,S1 ;SAVE THE ADDRESS.
LOAD T1,.MSTYP(M),MS.CNT ;GET THE MSG LENGTH.
ADD T1,S1 ;CALC BLT END ADDRESS.
HRL S1,M ;GEN BLT AC.
BLT S1,-1(T1) ;COPY MSG OVER.
POP P,S1 ;RESTORE S1.
MOVEI AP,MSGPDB ;LOAD PDB ADDRESS
ADR2PG S1 ;GET PAGE NUMBER
HRLI S1,PAGSIZ ;GET PAGE SIZE
MOVEM S1,.IPCFP(AP) ;STORE IT
MOVX S1,IP.CFV ;PAGE MODE BIT
MOVEM S1,.IPCFL(AP) ;STORE IT
MOVE S1,OBJPID(T2) ;GET THE PID
SKIPN T3 ;IS THIS A SEND TO OPR
MOVE S1,G$OPR## ;YES,,GET ORIONS PID
MOVEM S1,.IPCFR(AP) ;SET RECEIVERS PID
PJRST C$SEND## ;SEND THE MESSAGE
SUBTTL Global Routines
;THE FOLLOW ARE ADDITIONAL GLOBAL ROUTINES FOUND IN THIS MODULE
; OTHER THAN THE TOP-LEVEL MESSAGE HANDLERS.
INTERN A$KLPD ;KILL OFF A PSB GIVEN ITS PID
INTERN A$FPSB ;FIND A PSB GIVEN A PID
INTERN A$FOBJ ;FIND AN OBJECT
INTERN A$CPOB ;COPY OVER AN OBJECT BLOCK
INTERN A$OB2Q ;CONVERT OBJECT TYPE TO QUE HEADER
INTERN A$OBST ;UPDATE OBJECT STATUS
INTERN A$GBLK ;BREAK DOWN BLOCK TYPE IPCF MESSAGES
SUBTTL A$KLPD -- Routine to kill a PSB given its PID
;A$KLPD IS CALLED TO "KILL" A PSB ENTRY. A$KLPD IS CALLED
; WITH THE PID OF THE PSB TO BE KILLED (E.G. WHEN A SEND TO
; A KNOWN COMPONENT FAILS WITH "UNKNOWN PID").
;
;CALL WITH ARGUMENT IN S1
A$KLPD: $SAVE AP ;SAVE CALLERS REGISTERS
$SAVE H ; ""
PUSHJ P,A$FPSB ;FIND THE PSB GIVEN THE PID
JUMPE S1,.RETT ;RETURN IF NOT THERE
PJRST KILPSB ;KILL THE PSB ENTRY AND RETURN
SUBTTL A$FPSB -- Subroutine to find a PSB
;A$FPSB IS CALLED WITH A PID IN S1. IT SCANS THE PSB LIST
; LOOKING FOR A MATCH. IF ONE IS FOUND, THE ADDRESS
; OF THE PSB IS RETURNED IN S1, ELSE S1 IS RETURNED
; CONTAINING 0.
A$FPSB: MOVEI H,HDRPSB## ;ADDRESS OF PSB QUEUE HEADER
MOVE S2,S1 ;COPY ARGUMENT TO S2
LOAD S1,.QHLNK(H),QH.PTF ;GET ADDRESS OF FIRST
FPSB.1: JUMPE S1,.RETF ;RETURN IF LAST ONE (OR NONE)
CAMN S2,PSBPID(S1) ;MATCH?
$RETT ;YES, RETURN WITH ADDRESS IN S1
LOAD S1,.QELNK(S1),QE.PTN ;GET POINTER TO NEXT
JRST FPSB.1 ;AND LOOP
SUBTTL A$FOBJ -- Find an entry in the object queue
;WITH S1 POINTING TO AN OJBECT BLOCK, FIND A MATCHING ENTRY IN THE
; OBJECT QUEUE.
;
A$FOBJ: MOVE T1,S1 ;SAVE POSITION OF BLOCK
MOVEI S1,HDROBJ## ;GET HEAD OF THE QUEUE
LOAD S1,.QHLNK(S1),QH.PTF ;GET POINTER TO FIRST
FOBJ.1: JUMPE S1,.RETF ;IF NO ENTRIES OR END, RETURN
MOVE T2,S1 ;GET POSITION INTO PLACE
MOVE T3,T1 ;GET START OF MODEL
MOVEI T4,OBJNOD-OBJTYP+1 ;GET NUMBER OF WORDS TO CHECK
FOBJ.2: MOVE S2,0(T3) ;GET A MODEL WORD
CAME S2,OBJTYP(T2) ;A MATCH?
JRST [ LOAD S1,.QELNK(S1),QE.PTN ;NO GET POINTER TO NEXT CELL
JRST FOBJ.1 ] ;AND STEP TO IT
SOJE T4,.RETT ;IF ALL WORDS CHECKED, WE FOUND IT
ADDI T3,1 ;UPDATE MODEL POINTER
AOJA T2,FOBJ.2 ;AND CHECK NEXT WORD PAIR
SUBTTL A$CPOB -- Copy an object block
;A$CPOB IS CALLED TO COPY AN OBJECT BLOCK OVER TO A NEW BLOCK
;
;CALL: S1/ ADDRESS OF SOURCE OBJECT BLOCK
; S2/ ADDRESS OF DESTINATION OBJECT BLOCK
A$CPOB: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,OBJ.TY(S1) ;GET OBJECT TYPE
MOVEM P1,OBJ.TY(S2) ;STORE IT
MOVE P1,OBJ.UN(S1) ;GET UNIT NUMBER
MOVEM P1,OBJ.UN(S2) ;STORE IT
MOVE P1,OBJ.ND(S1) ;GET NODE NAME
MOVEM P1,OBJ.ND(S2) ;STORE IT
$RETT ;AND RETURN
SUBTTL A$OB2Q -- Convert object type to queue header
;A$OB2Q IS CALLED TO CONVERT AN OBJECT TYPE INTO THE ADDRESS OF THE
; QUEUE HEADER FOR THAT OBJECT.
;
;CALL: S1/ OBJECT TYPE
;
;T RET: S1/ ADDRESS OF QUEUE HEADER (HDRXXX)
;
;F RET: NO SUCH OBJECT
A$OB2Q: PUSHJ P,.SAVE1 ;SAVE P1
HRLZI P1,-NOBJS ;MAKE AOBJN POINTER TO TABLE
MOVE S2,S1 ;PUT OBJECT TYPE INTO S2
OB2Q.1: CAMN S2,OBJTAB(P1) ;IS THIS OBJECT A MATCH?
JRST OB2Q.2 ;WIN!!!!
AOBJN P1,OB2Q.1 ;LOOP
$RETF ;NOT FOUND, RETURN FAILURE
OB2Q.2: LOAD S1,OB2Q.3(P1) ;GET THE QUEUE HEADER ADDRESS
$RETT ;AND RETURN
;NOW GENERATE THE TABLE OF QUEUE HEADER ADDRESSES PARALLEL TO OBJTAB
DEFINE X(OBJ,QUE,PARM),<
EXP HDR'QUE'##
> ;END DEFINE X
OB2Q.3: MAPOBJ
SUBTTL A$OBST -- Update Object Status
;A$OBST should be called whenever the status of an object changes so that
; the operator status changes.
;
;Call: S1/ address of OBJ entry
;
;T Ret: always
A$OBST: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;GET THE OBJECT ADDRESS
MOVX S1,%IDLE ;DEFAULT TO 'IDLE'
MOVE S2,OBJSCH(P1) ;GET THE SCHEDULING BITS
TXNN S2,OBSSTA ;IS THE OBJECT STARTED ???
MOVX S1,%NSTRT ;NO,,GET THE 'NOT STARTED' CODE
TXNE S2,OBSBUS ;IS THE OBJECT BUSY ???
MOVX S1,%ACTIV ;YES,,GET THE 'ACTIVE' CODE
TXNE S2,OBSSTP ;IS THE DEVICE STOPPED ???
MOVX S1,%STOPD ;YES,,GET THE 'STOPPED' CODE
TXNE S2,OBSIGN ;ARE WE IGNORING THE OBJECT ???
MOVX S1,%NAVAL ;YES,,GET 'NOT AVAILABLE' CODE
TXNN S2,OBSHUT ;IS IT IN 'INTERNAL SHUTDOWN' STATE ???
TXNE S2,OBSFRR ;OR IS IT A FREE RUNNING DEVICE ???
MOVX S1,%IDLE ;YES,,ITS IDLE !!!!
TXNE S2,OBSSEJ ;IS IT SHUT DOWN AT END OF JOB ???
MOVX S1,%SHUTD ;YES,,GET 'SHUTTING DOWN' CODE
MOVEM S1,OBJSTS(P1) ;SAVE THE DEVICE STATUS
$RETT ;AND RETURN
SUBTTL A$STATUS - UPDATE THE DEVICE STATUS
;CALL: M/STATUS UPDATE MESSAGE ADDRESS
;
;RET: TRUE ALWAYS
;
;ERRORS: E$SNY FOR ANY VALIDATION ERRORS
A$STATUS:: PUSHJ P,I$WHEEL## ;MAKE SURE MSG HAS PRIVS
JUMPF E$SNY## ;NO,,TOUGH BREAKEEE
MOVEI S1,STU.RB(M) ;GET THE OBJECT BLOCK ADDRESS
PUSHJ P,A$FOBJ ;GO FIND THE OBJECT
JUMPF E$SNY## ;NOT THERE,,THATS NO GOOD !!
PUSHJ P,.SAVE1 ;SO FAR, SO GOOD, SO SAVE P1
MOVE P1,S1 ;PUT THE OBJ ADDRESS INTO P1
MOVE S1,OBJPID(P1) ;GET THE CONTROLLING PID
CAME S1,G$SND## ;IS IT THE SAME GUY ???
JRST E$SNY## ;NO,,BETTER LUCK NEXT TIME !!
MOVE S1,STU.CD(M) ;GET THE DEVICE STATUS CODE
JUMPLE S1,E$SNY## ;MUST BE GREATER THEN 0
CAILE S1,%STMAX ;MUST ALSO BE LESS THEN MAX STATUS CODE
JRST E$SNY## ;ELSE HE LOSES !!
HRRZ S2,OBJCDS(S1) ;PICK UP THE OBJ TYPE LIST ADDRESS
JUMPE S2,STAT.2 ;IF 0,,THEN THIS CODE IS GOOD FOR ALL
HLRZ T1,OBJCDS(S1) ;GET THE # OF DEVICES SPECIFIED
MOVE T2,STU.RB+OBJ.TY(M) ;GET THE MESSAGE OBJECT TYPE
STAT.1: CAMN T2,0(S2) ;DOES MSG DEVICE MATCH DEVICE LIST ??
JRST STAT.2 ;YES,,THEN HE WINS AT LAST !!
AOS S2 ;BUMP TO NEXT ENTRY IN DEVICE LIST
SOJG T1,STAT.1 ;KEEP TRYING WHILE WE CAN
JRST E$SNY## ;NOT A VALID DEVICE,,BUMP HIM !!
STAT.2: EXCH P1,S1 ;SWAP OBJ ADDRESS AND OBJ STATUS CODE
CAIN P1,%RESET ;IS IT 'RESET' ???
PJRST A$OBST ;YES,,SET IT VIA A$OBST AND RETURN
STORE P1,OBJSTS(S1) ;HE WINS,,SAVE THE NEW DEVICE STATUS
$RETT ;AND RETURN
SUBTTL A$GBLK - ROUTINE TO BREAK DOWN IPCF MESSAGES
;CALL: M/ THE MESSAGE ADDRESS
;
;RET: T1/ THE BLOCK TYPE
; T2/ THE BLOCK LENGTH
; T3/ THE BLOCK DATA ADDRESS
; FALSE IF NO MORE BLOCKS
A$GBLK: SKIPE S1,G$BLKA## ;GET THE BLOCK ADDRESS IF THERE IS ONE
JRST .+4 ;NOT FIRST TIME THROUGH,,SO SKIP INITLZN
MOVE S1,.OARGC(M) ;GET THE MESSAGE BLOCK COUNT
MOVEM S1,BLKCNT ;AND SAVE IT
MOVEI S1,.OHDRS+ARG.HD(M) ;IF NOT,,GET THE FIRST ONE
SOSGE BLKCNT ;CHECK THE BLOCK COUNT
$RETF ;NO MORE,,JUST RETURN
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;POINT TO THE ACTUAL DATA
ADD S1,T2 ;POINT TO THE NEXT BLOCK
MOVEM S1,G$BLKA## ;SAVE IT FOR THE NEXT TIME AROUND
$RETT ;AND RETURN
BLKCNT: BLOCK 1 ;MESSAGE BLOCK COUNT
SUBTTL Utility Routines
; GETPSB -- FIND OR CREATE A PSB GIVEN A PID
; KILPSB -- KILL A SPECIFIED PSB
; GETOBJ -- FIND OR CREATE AN OBJ ENTRY
; ORANGE -- HANDLE A RANGE OF OBJECTS
SUBTTL GETPSB -- Routine to get a PSB
;GETPSB IS CALLED WITH A PID IN S1. IT CALLS A$FPSB TO SEE IF
; THE PID IS ALREADY KNOWN, AND IF SO IT RETURNS ITS ADDRESS
; IN S1. IF NOT, A NEW PSB IS GOTTEN AND ZEROED AND ITS
; ADDRESS IS RETURNED IN S1.
;
GETPSB: PUSHJ P,A$FPSB ;FIND KNOWN PID
JUMPN S1,.RETT ;FOUND IT
GETP.1: MOVEI H,HDRPSB ;LOAD ADR OF PSB HEADER
PUSHJ P,M$GFRE## ;GET A FREE CELL
PUSHJ P,M$ELNK## ;LINK IN THE PSB
MOVE S1,AP ;RETURN ANSWER IN S1
$RETT ;AND RETURN
SUBTTL KILPSB -- Routine to kill a PSB given its address
;KILPSB is called to clean-up after known components which seem to have
; disappeared behind QUASAR's back. It releases any job interlocks
; held by that program and deletes the PSB entry.
;
;Call: S1/ address of PSB
KILPSB: $SAVE H ;SAVE H
$SAVE AP ;AND AP
PUSHJ P,.SAVE3 ;SAVE P1 AND P2 AND P3
DOSCHD ;FORCE ANOTHER SCHEDULING PASS
MOVE P2,S1 ;COPY THE ARG OVER TO P2
LOAD P1,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJ
KILP.1: JUMPE P1,KILP.6 ;NO MORE OBJECTS, WE ARE DONE
MOVE S1,PSBPID(P2) ;GET THE PID
CAME S1,OBJPID(P1) ;OBJECT HELD BY PSB IN QUESTION?
JRST KILP.5 ;NO, LOOP FOR NEXT OBJECT
ZERO OBJPID(P1) ;YES, CLEAR THE INTERLOCK WORD
ZERO OBJTIM(P1) ;AND CLEAR TIMER WORD
LOAD S1,OBJSCH(P1),OBSSIP ;GET SETUP-IN-PROGRESS BIT
SKIPN S1 ;IF SET,,SKIP NEXT LOAD.
LOAD S1,OBJSCH(P1),OBSIGN ;GET THE IGNORE BIT.
JUMPE S1,KILP.2 ;JUMP IF NOT SIP OR IGNORE
MOVX S1,OBSSIP+OBSIGN ;GET SIP AND IGNORE BITS.
ANDCAM S1,OBJSCH(P1) ;TURN THEM OFF.
JRST KILP.5 ;AND LOOP FOR NEXT OBJECT
KILP.2: LOAD S1,OBJSCH(P1),OBSSUP ;GET OBJECT-SETUP BIT
JUMPE S1,KILP.5 ;NO,,GET NEXT OBJECT.
ZERO OBJSCH(P1),OBSSUP ;CLEAR THE FLAG
;Here check to see if it was an IBM remote
MOVE S1,OBJNOD(P1) ;GET THIS OBJECTS NODE
PUSHJ P,N$NODE## ;GET ITS DATA BASE ENTRY
LOAD TF,NETSTS(S2),NETIBM ;IS THIS AN IBM REMOTE STATION ???
JUMPE TF,KIL.2A ;NO,,SKIP THIS
MOVE S1,S2 ;PASS THE NODE DB ADDRESS IN S1
MOVE S2,P1 ;PASS THE OBJECT ADDRESS IN S2
PUSHJ P,N$NOFF## ;PERFORM NODE OFFLINE PROCESSING
KIL.2A: LOAD S1,OBJSCH(P1),OBSBUS ;IS IT BUSY?
JUMPE S1,KILP.5 ;NO, ON TO THE NEXT OBJECT
LOAD S1,OBJSCH(P1),OBSFRR ;GET THE FREE RUNNING BIT.
JUMPN S1,KILP.7 ;IF OBJ IS FREE RUNNING,,RLSE INT-LCKS
MOVEI H,HDRUSE## ;LOAD USE QUEUE HEADER
LOAD AP,.QHLNK(H),QH.PTF ;POINT TO FIRST ENTRY
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
KILP.3: SKIPN AP ;ANY LEFT?
$STOP(IJM,Interlocked Job Missing)
CAMN P1,.QEOBJ(AP) ;IS THIS THE JOB?
JRST KILP.4 ;YES, GO FREE IT UP
LOAD AP,.QELNK(AP),QE.PTN ;NO, GET POINTER TO NEXT
JRST KILP.3 ;AND LOOP
KILP.4: MOVE S1,OBJITN(P1) ;GET OBJECT ITN
CAME S1,.QEITN(AP) ;CONSISTENCY CHECK
$STOP(IJW,Interlocked Job Wrong)
LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
PUSHJ P,A$OB2Q ;GET THE QUEUE HEADER ADDRES
PUSH P,S1 ;SAVE QUEUE HEADER ADDRESS
LOAD S1,.QHPAG(S1),QH.SCH ;GET ADR OF SCHED VECTOR
PUSHJ P,SCHRJI(S1) ;RELEASE THE INTERLOCK
POP P,S1 ;GET QUEUE HEADER ADR BACK
PUSHJ P,M$MOVE## ;MOVE IT
KILP.5: LOAD P1,.QELNK(P1),QE.PTN ;POINT TO NEXT OBJECT
JRST KILP.1 ;AND LOOP
KILP.6: $LOG(<Process ^W/PSBNAM(P2)/ Deleted From QUASAR>,<Process PID is ^O/PSBPID(P2)/, Process Object Type is ^O/PSBOBJ(P2)/>,,<$WTFLG(WT.SJI)>)
MOVEI H,HDRPSB## ;POINT TO PSB QUEUE HEADER
MOVE AP,P2 ;GET ADDRESS OF PSB
PJRST M$RFRE## ;AND RETURN TO FREE SPACE
KILP.7: LOAD S2,OBJSCH(P1),OBSQUH ;GET THE QUEUE HEADER ADDRESS
LOAD S2,.QHPAG(S2),QH.SCH ;GET THE ADDR OF SCHED VECTOR
MOVE S1,P1 ;PUT THE OBJ ADDRESS INTO S1.
PUSHJ P,SCHRJI(S2) ;RELEASE DEVICE INTERLOCKS
JRST KILP.5 ;GO GET THE NEXT OBJ.
SUBTTL GETOBJ -- Find or create an OBJ queue entry
;GETOBJ WILL LOOK FOR THE SPECIFIED OBJECT AND IF NOT FOUND, IT
; WILL CREATE THE OBJ ENTRY AND FILL IN THE OBJECT BLOCK IN
; IT
;
;CALL: S1/ POINTER TO AN OBJECT BLOCK
;
;T RET: S1/ POINTER TO AN OBJ QUEUE ENTRY
GETOBJ: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,S1 ;SAVE THE ARGUMENT
MOVE S1,OBJ.ND(P1) ;GET THE NODE NAME/NUMBER
PUSHJ P,N$NODE## ;PUT IT INTO OUR DATA BASE
MOVEM S1,OBJ.ND(P1) ;SYSTEM'IZE IT (NBR ON -10, NAME ON -20)
MOVE P2,S2 ;SAVE THE NODE DATA BASE ENTRY ADDRESS
MOVE S1,P1 ;GET THE OBJECT ADDRESS IN S1
PUSHJ P,A$FOBJ ;FIND THE OBJECT
JUMPT .RETT ;RETURN IF YOU DID
PUSHJ P,CHKOBJ ;GO VALIDATE THE OBJ BLK.
JUMPF .RETF ;NO GOOD,,JUST RETURN
;HERE IF WE HAVE TO CREATE AN OBJECT QUEUE ENTRY
GETO.0: $SAVE H ;SAVE AC H
$SAVE AP ;AND AP
MOVX S1,NETSHT ;GET THE NETWORK SHUTDOWN BIT
ANDCAM S1,NETSTS(P2) ;AND CLEAR IT (JUST IN CASE IT WAS ON)
MOVEI H,HDROBJ## ;LOAD ADR OF OBJ HEADER
PUSHJ P,M$GFRE## ;GET A FREE CELL
MOVE S1,P1 ;POINT TO SOURCE OBJECT
MOVEI S2,OBJTYP(AP) ;POINT TO DESTINATION OBJECT
PUSHJ P,A$CPOB ;COPY THE OBJECT BLOCK
MOVE S1,OBJTYP(AP) ;GET THE OBJECT TYPE
PUSHJ P,A$OB2Q ;CONVERT IT TO A QUEUE HEADER
JUMPF BADMSG ;NOT THERE,,ORION ERROR !!!
STORE S1,OBJSCH(AP),OBSQUH ;STORE QUEUE HEADER ADDRESS
LOAD S1,.QHTYP(S1) ;GET THE QUEUE TYPE.
TXC S1,.QHFRR ;COMPILMENT FREE RUNNING BITS
MOVX S2,OBSFRR ;GET SCHEDULING FREE RUNNING BITS
TXNN S1,QH.TYP ;IS THIS A FREE RUNNING OBJECT ???
IORM S2,OBJSCH(AP) ;YES,,LITE FREE RUNNING BIT
MOVX S2,OBSINV ;GET INVISIBLE BIT
TXNE S1,QH.INV ;IS THIS OBJECT INVISIBLE ???
IORM S2,OBJSCH(AP) ;YES,,LITE THE INVISIBLE BIT
MOVSI S1,-NOBJS ;AOBJN PTR TO OBJTAB
MOVE S2,OBJTYP(AP) ;AND THE OBJECT TYPE
CAME S2,OBJTAB(S1) ;FIND THE OBJECT
AOBJN S1,.-1 ;THIS MUST WORK SINCE A$OB2Q DID
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
HRRZS S1 ;GET OBJECT NUMBER
IMULI S1,OBPRSZ ;MULTIPLY BY PARAMS/OBJ
ADDI S1,PRMTAB ;POINT TO INITIAL PARAMETERS
MOVSS S1 ;PUT SOURCE IN LEFT HALF
HRRI S1,OBJPRM(AP) ;PLACE TO BLT THEM
BLT S1,OBJPRM+OBPRSZ-1(AP) ;AND MOVE THEM
LOAD E,.QHLNK(H),QH.PTF ;GET POINTER TO FIRST OBJECT
GETO.1: JUMPE E,GETO.4 ;LINK AT END IF NONE LEFT
MOVE S1,OBJTYP(AP) ;GET OBJECT TYPE OF NEW ONE?
CAMN S1,OBJTYP(E) ;SAME?
JRST GETO.2 ;YUP, CONTINUE ON
LOAD E,.QELNK(E),QE.PTN ;GET NEXT
JRST GETO.1 ;AND LOOP
GETO.2: MOVE S1,OBJNOD(AP) ;GET THE NODE
CAMG S1,OBJNOD(E) ;SEARCH FOR FIRST ONE BIGGER
JRST GETO.3 ;GOT IT
LOAD E,.QELNK(E),QE.PTN ;GET POINTER TO NEXT
JUMPE E,GETO.4 ;END, JUST LINK IT IN
MOVE S1,OBJTYP(AP) ;GET THE OBJECT TYPE
CAME S1,OBJTYP(E) ;STILL IN THE SAME TYPE?
JRST GETO.4 ;NO, JUST LINK IT
JRST GETO.2 ;YES, KEEP LOOKING
GETO.3: MOVE S1,OBJNOD(AP) ;GET NODE OF NEW ONE
CAME S1,OBJNOD(E) ;SAME AS ENTRY IN LIST?
JRST GETO.4 ;NO, JUST LINK IT IN
MOVE S1,OBJUNI(AP) ;GET THE UNIT NUMBER
CAMG S1,OBJUNI(E) ;SEARCH FOR A BIGGER ONE
JRST GETO.4 ;GOT IT, LINK IT
LOAD E,.QELNK(E),QE.PTN ;GET NEXT
JUMPE E,GETO.4 ;END, LINK IT IN
MOVE S1,OBJTYP(AP) ;GET THE OBJECT TYPE
CAMN S1,OBJTYP(E) ;STILL THE SAME?
JRST GETO.3 ;NO, LOOP
GETO.4: PUSHJ P,M$LINK## ;LINK IN THE ENTRY
MOVE S1,AP ;POINT THE ANSWER TO IT
$RETT ;AND RETURN
SUBTTL CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCK REQUESTS.
CHKOBJ: LOAD S1,OBJ.TY(P1) ;GET THE OBJECT TYPE.
LOAD S2,NETSTS(P2),NT.MOD ;GET THE MODE OF THE NODE
CAXN S2,DF.EMU ;IS IT EMULATION ???
CAXN S1,.OTBAT ;AND IS THE OBJECT TYPE BATCH ???
SKIPA ;NOT EMULATION or EMULATION+BATCH !!!
JRST CHKO.2 ;EMULATION BUT NOT BATCH,,ERROR
JUMPLE S1,.RETT ;FUNNY OBJ,, RETURN OK.
CAIN S1,.OTBAT ;IS IT A BATCH OBJECT BLOCK ???
JRST CHKO.1 ;YES,,GO PROCESS IT.
LOAD S1,OBJ.UN(P1) ;GET THE UNIT NUMBER.
CAIGE S1,10 ;MORE THEN 7 UNITS ???
$RETT ;NO,,THEN RETURN TRUE.
$ACK (Invalid Unit Number Specified,,0(P1),.MSCOD(M)) ;TELL THE OPR
$RETF ;RETURN FALSE.
CHKO.1: SOSL G$NBAT## ;SUBTRACT 1 FROM MAX BATCH COUNT.
$RETT ;OK,,RETURN.
$ACK (Batch Stream Maximum Exceeded,,0(P1),.MSCOD(M))
SETZM G$NBAT## ;RESET THE COUNT TO 0.
$RETF ;RETURN.
CHKO.2: $ACK (Device Invalid for Emulation,,0(P1),.MSCOD(M))
$RETF
SUBTTL FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIED NODE
;CALL: S1/ The Node DB Entry Address for the Node we are looking for
;
;RET: True - If we find a device started for the specified node
; False - If there are no devices started for the node
FNDDEV: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S1 ;SAVE THE NETWORK NODE DB ADDRESS IN P1
LOAD S2,HDROBJ+.QHLNK,QH.PTF ;GET PTR TO FIRST OBJ QUEUE ENTRY
SKIPA ;SKIP FIRST TIME THROUGH
FNDD.0: LOAD S2,.QELNK(S2),QE.PTN ;GET THE NEXT OBJ ENTRY ADDRESS
JUMPE S2,.RETF ;NO MORE,,RETURN FALSE
MOVE S1,OBJNOD(S2) ;GET THE OBJECTS NODE NAME
CAME S1,NETNAM(P1) ;DO
CAMN S1,NETNBR(P1) ; WE
$RETT ; MATCH ??? YES - RETURN TRUE
JRST FNDD.0 ;NO,,CHECK NEXT OBJECT
SUBTTL A$FNDB - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE
;CALL: M/ THE MESSAGE ADDRESS
; S1/ THE TYPE OF BLOCK WE WANT
;
;RET: S1/ THE BLOCK ADDRESS (OR FALSE IF NOT FOUND)
INTERN A$FNDB ;MAKE IT GLOBAL
A$FNDB: PUSHJ P,.SAVE2 ;SAVE P1
LOAD P1,.OARGC(M) ;GET THE MESSAGE ARGUMENT COUNT
MOVE P2,S1 ;SAVE THE BLOCK TYPE
MOVEI S1,.OHDRS(M) ;POINT TO THE FIRST BLOCK
LOAD TF,.MSTYP(M),MS.CNT ;GET THE MESSAGE LENGTH
CAXLE TF,PAGSIZ ;CAN'T BE GREATER THEN A PAGE
$RETF ;ELSE THATS AN ERROR
ADD TF,M ;POINT TO THE END OF THE MESSAGE
FNDB.1: LOAD S2,ARG.HD(S1),AR.TYP ;GET THIS BLOCK TYPE
CAMN S2,P2 ;IS IT THE BLOCK HE WANTS ???
JRST FNDB.2 ;YES,,HE WINS BIG !!!
LOAD S2,ARG.HD(S1),AR.LEN ;NO,,GET THIS BLOCKS LENGTH
ADD S1,S2 ;POINT TO THE NEXT BLOCK
CAIG TF,0(S1) ;ARE WE STILL IN THE MESSAGE ???
$retf ;NO,,RETURN BLOCK NOT FOUND
SOJG P1,FNDB.1 ;CONTINUE TILL DONE
$RETF ;NOT FOUND
FNDB.2: MOVEI S1,ARG.DA(S1) ;POINT TO THE OBJECT BLOCK
$RETT ;AND RETURN
SUBTTL GENRDB - ROUTINE TO CREATE AN RDB FOR HOLD/RELEASE/SET JOB PRIO
;CALL: M/ HOLD/RELEASE/SET JOB PRIO MESSAGE ADDRESS
; S1/ OUTPUT RDB ADDRESS
;
;RET: ALWAYS TRUE
GENRDB: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE THE OUTPUT ADDRESS
SETZM MSGBLK ;ZERO THE FIRST MESSAGE BLOCK WORD
MOVE S1,[MSGBLK,,MSGBLK+1] ;CREATE BLT AC
BLT S1,MSGBLK+MOD.SZ+3 ;ZERO THE REST OF THE MESSAGE BLOCK
MOVEI S1,NBLKS-1 ;GET THE BLOCK COUNT
SETZM RDBPRM(S1) ;ZERO THE RDB PARM BLOCK
SOJGE S1,.-1 ;CONTINUE TILL DONE
GENR.1: PUSHJ P,A$GBLK ;GET THE FIRST/NEXT MESSAGE BLOCK
JUMPF GENR.3 ;NO MORE,,BUILD THE RDB
MOVSI S1,-NBLKS ;CREATE AOBJN AC
LOAD S2,0(T3) ;GET THE MESSAGE ARGUMENT
CAIN T1,.CMUSR ;IS THIS THE USER ENTRY ???
MOVE S2,T3 ;YES,,GET ITS ADDRESS
GENR.2: CAME T1,DSPRDB(S1) ;DO BLOCK TYPES MATCH ???
AOBJN S1,GENR.2 ;NO,,IGNORE IT AND LOOP BACK
STORE S2,RDBPRM(S1) ;YES,,SAVE THE ARGUMENT
JRST GENR.1 ;AND GO PROCESS ANOTHER BLOCK
GENR.3: LOAD S1,RDBPRM ;GET THE QUEUE TYPE
STORE S1,MSGBLK+MSHSIZ ;SAVE IT IN THE MESSAGE BLOCK
LOAD S1,RDBPRM+2 ;GET THE USERS ENTRY ADDRESS
LOAD S2,P1 ;GET THE OUTPUT ADDRESS
PUSHJ P,I$MUSR## ;MOVE THE USER INFO
MOVE S1,RDBPRM+1 ;GET THE REQUEST ID NUMBER
MOVEM S1,.RDBRQ(P1) ;SAVE IT
MOVE S1,RDBPRM+3 ;GET THE .ORNOD BLOCK NODE SPECIFICATION
MOVEM S1,G$RMTE## ;SAVE IT FOR THE QUEUE SEARCH
$RETT ;RETURN
DSPRDB: 0,,.ORTYP
0,,.ORREQ
0,,.CMUSR
0,,.ORNOD
NBLKS==.-DSPRDB
RDBPRM: BLOCK NBLKS+1 ;SAVE AREA FOR MSG RDB PARAMETERS
SUBTTL PRMTAB - OBJECT INITIAL PARAMETERS TABLE.
DEFINE X(OBJ,QUE,PARM),<
ZZZ==0 ;;INITIAL PARAMETER COUNTER
IRP PARM,<
EXP PARM ;;GENERATE A WORD
ZZZ==ZZZ+1 ;;COUNT ANOTHER WORD
IFE ZZZ-OBPRSZ,<STOPI> ;;STOP IF WE'VE GOT ENOUGH
> ;;END IRP PARM
BLOCK OBPRSZ-ZZZ ;;EXTEND BLOCK TO FULL SIZE
> ;END DEFINE X
PRMTAB: MAPOBJ ;GENERATE THE TABLE
SUBTTL ORANGE -- Handle a range of objects
;ORANGE IS CALLED AT THE START OF PROCESSING A COMMAND FROM ORION
; WHICH MIGHT CONTAIN A RANGE OF OBJECTS. ORANGE ACTS AS A
; CO-ROUTINE SO THAT EACH OBJECT IN THE RANGE WILL CAUSE
; CONTROL TO BE TRANSFERED TO THE LOCATION AFTER THE CALL
; TO ORANGE. THE FLOW OF THE CALLING ROUTINE IS AS FOLLOWS:
;MESSAGE-FROM-ORION:
; LOAD S1 WITH ADR OF OBJECT BLOCK IN MESSAGE
; CALL ORANGE
;
; ALL CODE FROM HERE TO THE RETURN IS EXECUTED ONCE FOR EACH
; OBJECT SPECIFIED IN THE RANGE.
;END-OF-ROUTINE
;CALL: S1/ ADDRESS OF OBJECT BLOCK (MAY OR MAY NOT CONTAIN RANGE)
;
;T RET: S1/ ADDRESS OF OBJECT BLOCK FOR A SINGLE OBJECT
ORANGE: HLRZ S2,OBJ.UN(S1) ;GET THE UPPER LIMIT
JUMPE S2,.RETT ;NO RANGE, JUST RETURN
MOVEM S2,ORAN.B ;STORE UPPER LIMIT
HRRZ S2,OBJ.UN(S1) ;GET LOWER LIMIT
MOVEM S2,ORAN.A ;STORE IT AWAY
MOVE S2,OBJ.TY(S1) ;GET OBJECT TYPE
MOVEM S2,ORAN.C ;STORE IT
MOVE S2,OBJ.ND(S1) ;GET NODE
MOVEM S2,ORAN.D ;STORE IT
POP P,ORAN.E ;GET CALLING ADDRESS
ORAN.1: MOVEI S1,ORAN.F ;GET ADDRESS OF RETURN BLOCK
MOVE S2,ORAN.C ;GET OBJECT TYPE
MOVEM S2,OBJ.TY(S1) ;STORE IT
MOVE S2,ORAN.D ;GET NODE
MOVEM S2,OBJ.ND(S1) ;STORE IT
MOVE S2,ORAN.A ;GET NEXT UNIT NUMBER
MOVEM S2,OBJ.UN(S1) ;STORE IT
PUSHJ P,@ORAN.E ;CALL THE CALLER
AOS S1,ORAN.A ;INCREMENT FOR NEXT ONE
CAMG S1,ORAN.B ;ALL DONE?
JRST ORAN.1 ;NO, LOOP
$RETT ;YES, RETURN
ORAN.A: BLOCK 1 ;LOWER LIMIT (INCREMENTED)
ORAN.B: BLOCK 1 ;UPPER LIMIT
ORAN.C: BLOCK 1 ;OBJECT TYPE
ORAN.D: BLOCK 1 ;NODE NAME
ORAN.E: BLOCK 1 ;CALLERS LOCATION
ORAN.F: BLOCK 3 ;OBJECT BLOCK TO RETURN TO USER
END