Trailing-Edge
-
PDP-10 Archives
-
bb-jr93g-bb
-
7,6/ap020/qsradm.x20
There are 4 other files named qsradm.x20 in the archive. Click here to see a list.
TITLE QSRADM -- System Administrative and Operator Functions
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,
;1979,1980,1981,1982,1983,1984,1985,1986,1987. 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 WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH QSRMAC,GLXMAC ;PARAMETER FILE
PROLOGUE(QSRADM) ;GENERATE NECESSARY SYMBOLS
SEARCH ORNMAC ;NEED ORION INTERFACE
QSRVRS==:QSRVRS ;REFERENCE QUASAR'S VERSION
%%.QSR==:%%.QSR ;AND QSRMAC'S
SUBTTL Module Storage and Constants
;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
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.
ILLMSG: $ACK (<ORION error>,<Illegally formatted message>,,.MSCOD(M))
$RETF
BADMSG: $ACK (Orion Message Error,Invalid Object Block Specified,,.MSCOD(M))
$RETF
DEVUNK: $ACK (Device Unknown,,0(P1),.MSCOD(M))
$RETT
DASMSG: $ACK (<Cannot set unit type>,<Device started>,OBJTYP(P1),.MSCOD(M))
$RETF
NOOMSG: $ACK (<Not an output object>,,OBJTYP(P1),,.MSCOD(M))
$RETF
TMPMSG: BLOCK MOD.SZ+3 ;SPACE FOR TEMP OPR MSG
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
; Display table to give meaningful node definition messages
DEFTAB: ASCIZ/Red/
ASCIZ/D/
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
MOVE S1,G$LNAM## ;GET THE HOST NODE ID.
MOVEM S1,COMSTA+.OHDRS+ARG.DA+OBJ.ND ;SAVE IT IN THE MESSAGE
MOVX S1,.OTEVT ;GET THE EVENT OBJECT TYPE
STORE S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT
MOVEI M,COMSTA ;GET START MESSAGE ADDRESS
PUSHJ P,A$OSTA ;STARTUP THE EVENT PROCESSOR
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$HELL::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,A$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
TOPS20< MOVE S2,HEL.OB(M) ;GET THE FIRST OBJECT TYPE
CAIN S2,.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
LOAD S2,HEL.NM(M) ;GET PROGRAM NAME OF 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
SKIPE PSBNAM(P1) ;MAYBE, NAME THERE?
JRST HELL.C ;YES, WE WERE PROBABLY WAITING
LOAD S1,HEL.NM(M) ;GET PROGRAM NAME
STORE S1,PSBNAM(P1) ;STORE IN THE PSB
HELL.C: MOVE S1,G$SND## ;GET SENDER'S PID
MOVEM S1,PSBPID(P1) ;AND STORE IT 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
MOVE S2,M ;GET THE MSG ADDRESS IN S2
HELL.0: LOAD TF,HEL.OB(S2),HELATR ;GET THE OBJECT ATTRIBUTES
JUMPN TF,.+3 ;IF SET,,SKIP THIS
MOVX TF,%GENRC ;NO,,GET 'GENERIC' ATTRIBUTES
STORE TF,HEL.OB(S2),HELATR ;AND SET THEM FOR THIS OBJECT
AOS S2 ;BUMP TO NEXT OBJECT
SOJG S1,HELL.0 ;CONTINUE FOR ALL OBJECTS
LOAD S1,HEL.NO(M),HENNOT ;LOAD NUMBER OF OBJECT TYPES
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
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
$LOG(<Process ^W/PSBNAM(P1)/ signon to QUASAR>,<Process PID is ^O/PSBPID(P1)/, Process Object Type is ^O/PSBOBJ(P1),HELOBJ/(^1/PSBOBJ(P1),HELOBJ/)>,,<$WTFLG(WT.SJI)>)
MOVX S1,PS.RUN ;GET RUNNING STATUS
LOAD S2,PSBFLG(P1),PSFSTS ;GET STATUS
STORE S1,PSBFLG(P1),PSFSTS ;SET RUNNING STATUS IN PSB
MOVE S1,P1 ;GET PSB ADDRESS IN S1
CAXN S2,PS.KSY ;BATCON KSYS MSG NEEDED?
PUSHJ P,I$SKSM## ;YES, GO SEND IT
MOVE S1,PSBOBJ(P1) ;GET THE OBJECT TYPE
CAMN S1,[%GENRC,,.OTBAT] ;IS THIS THE BATCH PROCESSOR??
PUSHJ P,D$PMDR## ;GO PROCESS ALLOCATIONS
MOVE S1,P1 ;GET PSB ADDRESS
PUSHJ P,HELL.3 ;SEND ODB MESSAGE IF NEEDED
;Each time we get a HELLO message, poll the processors and see
; if any have died
$SAVE <G$ACK##,G$MCOD##,G$ERR##,G$SND##> ;SAVE LOTS OF VARIABLES
SETZM G$ACK## ;ZAP THE ACK FLAG
SETZM G$ERR## ;ZAP THE ERROR CODE
SETZM G$MCOD## ;ZAP THE ACK CODE
PUSH P,P1 ;SAVE PSB
LOAD P1,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST PROCESSOR BLOCK
HELL.A: JUMPE P1,HELL.B ;NONE,,THATS WIERD !!!
MOVE S1,PSBPID(P1) ;GET ITS PID
MOVEM S1,G$SND## ;MAKE BELIEVE HE SENT US A MSG
LOAD P1,.QELNK(P1),QE.PTN ;GET NEXT PSB,,THIS ONE MAY GO AWAY
PUSHJ P,G$MSND## ;SEND A NULL ACK
JRST HELL.A ;AND GO SEND ANOTHER
HELL.B: POP P,P1 ;GET PSB BACK
MOVE S1,P1 ;COPY
PUSHJ P,HELSTA ;START OBJECTS IF NECESSARY
$RETT ;AND RETURN
;HERE WHEN WE RECEIVE A GOOD-BYE MESSAGE
HELL.1: MOVE S1,G$SND## ;GET SENDERS PID
SETZM S2 ;DON'T USE PROCESSOR NAME
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.....
;HERE TO SEND AN ODB MESSAGE(S) TO PROCESSOR IF NEEDED.
;S1/PSB ADDRESS
HELL.3: PUSHJ P,.SAVET ;SAVE T1 - T4
MOVE T1,S1 ;SAVE PSB ADDRESS
LOAD T2,PSBFLG(T1),PSFNOT ;GET NUMBER OF OBJECTS SUPPORTED
JUMPE T2,.RETF ;IF NONE, RETURN FALSE
MOVNS T2 ;MAKE AOBJN POINTER
HRLZS T2
HRRI T2,PSBOBJ(T1)
HELL.4: LOAD S1,(T2),HELOBJ ;GET OBJECT TYPE
LOAD T4,HDRODB##+.QHLNK,QH.PTF ;GET THE FIRST ODB BLOCK
HELL.5: JUMPE T4,HELL.8 ;IF NONE, LOOP
CAMN S1,ODB.OT(T4) ;OBJECT TYPES MATCH?
JRST HELL.7 ;YES, GO SEND ODB MESSAGE
HELL.6: LOAD T4,.QELNK(T4),QE.PTN ;NO, GET POINTER TO NEXT ODB
JRST HELL.5 ;LOOP
HELL.7: MOVE S2,PSBPID(T1) ;GET PROCESSOR PID FROM PSB
PUSH P,S1 ;SAVE OBJECT TYPE
MOVE S1,T4 ;GET ODB ADDRESS
PUSHJ P,SNDODB ;GET SEND ODB MESSAGE
POP P,S1 ;GET OBJECT TYPE BACK
JRST HELL.6 ;LOOP FOR NEXT ODB
HELL.8: AOBJN T2,HELL.4 ;LOOP FOR ALL OBJECTS SUPPORTED
POPJ P,
; Here to restart any objects not owned by a spooler
; Call: MOVE S1, PSB address
; PUSHJ P,HELSTA
HELSTA: $SAVE <M> ;SAVE M
PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE P1,S1 ;COPY PSB ADDRESS
LOAD P2,PSBFLG(P1),PSFNOT ;GET THE OBJECT COUNT
MOVNS P2 ;NEGATE
MOVSS P2 ;PUT IN LH
HRRI P2,PSBOBJ(P1) ;MAKE AN AOBJN POINTER
LOAD P3,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJ
HELS.1: JUMPE P3,.RETT ;RETURN IF NO MORE OBJECTS
SKIPE OBJPID(P3) ;OBJECT OWNED?
JRST HELS.2 ;YES--TRY ANOTHER
MOVE S1,P2 ;GET POINTER TO OBJECTS
HRRZ S2,(S1) ;GET AN OBJECT TYPE
CAME S2,OBJTYP(P3) ;SAME?
AOBJN S1,.-1 ;CHECK MORE
JUMPGE S1,HELS.2 ;JUMP IF NO MORE OBJECTS
MOVX S1,OBSSTA!OBSSUP!OBSDAA ;STARTED+SETUP+DEVICE ATTRIBUTES
TDNN S1,OBJSCH(P3) ;ANY OF THESE BITS SET?
JRST HELS.2 ;NO, WELL IT NEVER WAS STARTED.
ANDCAM S1,OBJSCH(P3) ;CLEAR FOR RESTART
MOVEI M,COMSTA ;POINT TO INTERNAL START MESSAGE
SETOM .MSCOD(M) ;ACK ALL OPERATORS
MOVE S1,OBJTYP(P3) ;OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M)
MOVE S1,OBJNOD(P3) ;NODE NAME/NUMBER
MOVEM S1,.OHDRS+ARG.DA+OBJ.ND(M)
MOVE S1,OBJUNI(P3) ;UNIT NUMBER
MOVEM S1,.OHDRS+ARG.DA+OBJ.UN(M)
LOAD S1,OBJDAT(P3),RO.ATR ;GET ATTRIBUTES
PUSH P,S1 ;SAVE
MOVEI S1,%GENRC ;TO ALLOW STARTUP
CAIE S2,.OTNQC ;DON'T SCREW UP NQC
CAIN S2,.OTBAT ;[1466] OR GIVE BATCON A BUM MSG
TRNA ;[1466]
STORE S1,OBJDAT(P3),RO.ATR ;SO THAT WE MAY DETERMINE ATTRIBUTES
MOVEI S1,.OHDRS+ARG.DA(M) ;PONT TO THE OBJECT BLOCK
PUSHJ P,A$ISTA ;START THE OBJECT
POP P,S1 ;GET ORIGINAL ATTRIBUTES BACK
STORE S1,OBJDAT(P3),RO.ATR ;RESTORE
HELS.2: LOAD P3,.QELNK(P3),QE.PTN ;POINT TO NEXT OBJECT
JRST HELS.1 ;AND LOOP
SUBTTL COUNT -- Function 20
;COUNT MESSAGE IS SENT TO QUASAR BY A USER TO REQUEST A COUNT-ANSWER
; CONTAINING ALL OF QUASAR'S INTERESTING COUNTERS.
A$COUNT:
MOVE S1,G$NOW## ;GET NOW
$SITEM S1,NOW ;SAVE IT
$COUNT (MCAN) ;NUMBER OF COUNTANSWER MESSAGES
$CALL M%GPAG ;GET A PAGE
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT IN THE SAB
MOVE S2,[CAN.SZ,,.QOCAN] ;GET LEN,,FUNCTION
MOVEM 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.SZ-1(S1) ;BLT THE MESSAGE
MOVEI S1,PAGSIZ ;PUT IN PAGE LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT IN THE SAB
MOVE S1,G$SND## ;GET PID OF SENDER
MOVEM S1,G$SAB##+SAB.PD ;SAVE IT IN THE SAB
PJRST C$SEND## ;SEND IT
SUBTTL Auto-file request -- Function 67
; Here to request auto-file processing from ORION.
; Call: MOVE S1, FD address
; PUSHJ P,A$AUTO
A$AUTO::$SAVE <M> ;SAVE M
PUSH P,S1 ;SAVE FD ADDRESS
$CALL M%GPAG ;GET A PAGE
MOVE M,S1 ;COPY ADDRESS
MOVEI S1,.QOATO ;FUNCTION CODE
STORE S1,.MSTYP(M),MS.TYP ;SAVE
MOVEI S1,.OHDRS+FDXSIZ ;LENGTH
STORE S1,.MSTYP(M),MS.CNT ;SAVE
MOVEI S1,1 ;ARGUMENT COUNT
MOVEM S1,.OARGC(M) ;SAVE
GETLIM S1,.QELIM(AP),SWIT ;GET THE ACK CODE
MOVEM S1,.OFLAGS(M) ;AND STORE IT
POP P,S1 ;GET FD ADDRESS BACK
HRLZS S1 ;PUT IN LH
HRRI S1,.OHDRS(M) ;WHERE TO PUT FD
MOVEI S2,.OHDRS+FDXSIZ(M) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY FD
MOVEM M,G$SAB##+SAB.MS ;SAVE MESSAGE ADDRESS IN THE SAB
LOAD S1,.MSTYP(M),MS.CNT ;GET LENGTH OF MESSAGE
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT IN THE SAB
MOVE S1,G$OPR## ;GET ORION'S PID
MOVEM S1,G$SAB##+SAB.PD ;SAVE IT IN THE SAB
PJRST C$SEND## ;SEND THE MESSAGE
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$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
INTERN A$ISTA ;INTERNAL STARTUP OF AN OBJECT
SUBTTL A$AGE -- Routine to compare two times in internal format
; Compute age in seconds based on the universal date/time format
; Call: S1 and S2 contain the UDTs to compare
; PUSHJ P,A$AGE
;
; On return S1:= age in seconds. AC usage: S1 and S2
;
A$AGE:: PUSH P,T1 ;SAVE T1
CAMGE S1,S2 ;ORDERING CHECK
EXCH S1,S2 ;WANT THE LARGEST IN S1
ADDI S1,1 ;ROUND UP
SUB S1,S2 ;SUBTRACT THEM
HLRZ T1,S1 ;GET DIFFERENCE IN DAYS
IMULI T1,^D24*^D60*^D60 ;CONVERT TO SECONDS
HRRZS S1 ;ISOLATE FRACTIONAL PORTION OF DAY
MULI S1,^D24*^D60*^D60 ;CONVERT TO SECONDS
ASHC S1,21 ;POSITION RESULT
ADD S1,T1 ;ADD IN DIFFERENCE IN DAYS
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL A$AFT -- Routine to modify an internal time
; Compute C(G$NOW) + a specified interval
; Call: S1/ interval in minutes
; PUSHJ P,A$AFT
;
; On return, S1:= new time. AC usage: S1 and S2.
;
A$AFT:: ZERO S2 ;ZERO FOR A SHIFT
ASHC S1,-^D17 ;GENERATE DOUBLE CONSTANT
; = ARG*2^18
DIVI S1,^D1440 ;DIVIDE BY MIN/DAY
ADD S1,G$NOW## ;ADD IN NOWTIM
$RETT ;AND RETURN
SUBTTL I$WHEEL -- Determine whether sender of current message is privileged
; Determine whether the send of the current IPCF message has lots of privs
; Call: No arguments
; PUSHJ P,A$WHEEL
; TRUE return: caller is a wheel (or operator)
; FALSE return: caller has no special privs
;
A$WHEEL::
MOVE S1,G$PRVS## ;GET PRIVS WORD
SKIPN DEBUGW ;IF DEBUGGING, ALWAYS SUCCEED
TXNE S1,MD.PWH!MD.POP ;WHEEL OR OPERATOR?
$RETT ;YES, RETURN TRUE
$RETF ;NOW RETURN FALSE
SUBTTL A$OSTA / A$ISTA -- Startup an object
; The A$OSTA entry to this routine is the normal entry for a normal startup
; command. It can include a range for the object.
; The A$ISTA entry to this routine is to startup an object as part of
; start node processing. S1 must contain a pointer to an object block.
; A range is not allowed. In addition, use of this entry point causes
; the check for starting individual objects on an IBM node to be skipped.
A$OSTA: $SAVE P1
MOVEI S1,.OROBJ ;GET THE OBJECT 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
MOVE P1,S1 ;Save S1 for a min.
MOVE S1,OBJ.ND(S1) ;Get the node name
PUSHJ P,N$NODE## ;Get the node entry
; Since we are not part of a start node, want to check if this is the
; start of an IBM object, since that is illegal in this case.
LOAD S1,NETSTS(S2),NETIBM ;Get IBM status
SKIPE S1 ;Is it IBM object?
JRST OSTA.5 ;Yes, error, go tell the operator
SKIPA S1,P1 ;Get object block back
A$ISTA: $SAVE P1
PUSHJ P,GETOBJ ;GET THE OBJECT
JUMPF .RETT ;NO GOOD,,RETURN.
MOVE P1,S1 ;SAVE THE OBJECT ADDRESS
MOVX S1,OBSSTA ;GET STARTED BIT...
TDNE S1,OBJSCH(P1) ;ARE WE ALREADY STARTED ?
JRST OSTA.3 ;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
MOVX S2,OBSSUP!OBSFRR!OBSINV ;SETUP + FREE RUNNING + INVISIVBLE
CAIN S1,.OTEVT ;EVENT OBJECT?
IORM S2,OBJSCH(P1) ;YES--LITE LOTS OF BITS
;Check to see if object has a Physical Device Name
OSTA.1: MOVX S1,.CMDEV ;WANT A DEVICE BLOCK
PUSHJ P,A$FNDB ;SEE IF THERE IS ONE
JUMPF OSTA.2 ;NO
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
OSTA.2: MOVE S1,OBJTYP(P1) ;GET OBJECT TYPE
LOAD S2,OBJDAT(P1),RO.ATR ;GET ATTRIBUTES
PUSHJ P,I$GOPD## ;GET OBJECT PROCESSOR TYPE
JUMPF .RETT ;SOMEBODY IS CONFUSED IF NOT THERE
SKIPN DEBUGW ;DEBUGGING?
CAXN S2,%STCMD ;FIRE UP ON START COMMAND?
TRNA ;YES TO EITHER
$RETT ;NO, WAIT FOR A JOB
MOVE S1,P1 ;COPY OBJECT BLOCK
PUSHJ P,S$FPSB## ;FIND THE PROCESSOR STATUS BLOCK
JUMPF .RETT ;DONE IF NO PROCESSOR
PUSHJ P,S$SETU## ;SEND SETUP MESSAGE TO PROCESSOR
$RETT ;AND RETURN
OSTA.3: MOVX S1,OBSSEJ ;GET 'SHUTDOWN AT EOJ'
TDNN S1,OBJSCH(P1) ;WAS SHUTDOWN PENDING ???
JRST OSTA.4 ;NO,,SAY ALREADY STARTED
ANDCAM S1,OBJSCH(P1) ;CLEAR PENDING SHUTDOWN
$ACK (Pending shutdown cancelled,,OBJTYP(P1),.MSCOD(M))
$RETT ;RETURN
OSTA.4: $ACK (Already Started,,OBJTYP(P1),.MSCOD(M))
$RETT
OSTA.5: $ACK (<Illegal to start a specific object for IBM node ^N/OBJ.ND(P1)/>,<Use START NODE command>,,.MSCOD(M))
$RETT
SUBTTL A$STND - START NODE MESSAGE PROCESSOR
A$STND: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
$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$PORT## ;LOOK FOR OTHER DEVICES STARTED ON
JUMPT STAERR ; THE SAME PORT/LINE (IBM ONLY)
; S2 now contains the pointer to the node entry, check out the IBM status.
MOVE P1,S2 ;SAVE NET QUEUE ADDRESS
LOAD S1,NETSTS(P1),NETIBM ;GET IBM STATUS
LOAD S2,NETSTS(P1),NT.MOD ;GET THE MODE
JUMPE S1,STND.2 ;JUMP IF NOT IBM
CAXN S2,DF.EMU ;IN EMULATION MODE ???
JRST STND.1 ;YES,,START A BATCH STREAM
CAXE S2,DF.PRO ;Is it prototype mode?
JRST STAE.2 ;No, can't start an actual termination
PUSH P,S1 ;Save S1 for a min.
MOVX S1,.OTRDR ;GET CARD READER OBJECT TYPE
PUSHJ P,STND.X ;START A CDR
POP P,S1 ;GET BACK IBMNESS
JUMPN S1,.RETT ;DONE IF IBM
MOVX S1,.OTLPT ;GET LINE PRINTER OBJECT TYPE
PUSHJ P,STND.X ;START A LPT
SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
STND.1: MOVX S1,.OTBAT ;GET BATCH STREAM OBJECT TYPE
PUSHJ P,STND.X ;START A BATCH STREAM
SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
; HERE TO START ALL DEVICES ON A REMOTE STATION
STND.2: SKIPE S1,NETCOL(P1) ;GET SYSTEM DEPENDANT IDENTIFIER
MOVEM S1,.OHDRS+ARG.DA+OBJ.ND(M) ;UPDATE INCASE OTHER NOTATION USED
PUSH P,[EXP 0] ;INIT COUNTER
MOVEI P2,NETOBJ(P1) ;POINT TO DEVICE WORDS
HRLI P2,-NETOBL ;MAKE AN AOBJN POINTER
STND.3: HLRZ S1,(P2) ;GET A DEVICE COUNT
JUMPE S1,STND.5 ;CONTINUE IF NONE
PUSH P,S1 ;SAVE COUNT
SETOM .OHDRS+ARG.DA+OBJ.UN(M) ;INIT UNIT NUMBER
STND.4: AOS .OHDRS+ARG.DA+OBJ.UN(M) ;ADVANCE UNIT NUMBER
HRRZ S1,(P2) ;GET AN OBJECT TYPE
PUSHJ P,STND.X ;START DEVIVE
AOS -1(P) ;COUNT THE DEVICE STARTED
SOSLE (P) ;COUNT DOWN
JRST STND.4 ;LOOP
POP P,(P) ;TRIM STACK
STND.5: AOBJN P2,STND.3 ;LOOP FOR ALL DEVICES
POP P,S1 ;GET DEVICE STARTED COUNTER BACK
JUMPN S1,STND.6 ;CONTINUE IF DEVICES STARTED
MOVE S1,NETCOL(P1) ;GET NODE NAME/NUMBER
PUSHJ P,N$NODE## ;SEE IF ONLINE
SKIPN S1,NETCOL(P1) ;GET NODE NAME/NUMBER BACK
MOVE S1,NETLOC(P1) ;MUST BE NON-ZERO
MOVEI S2,[ASCIZ /has no devices/]
SKIPT ;SKIP IF ONLINE
MOVEI S2,[ASCIZ /is offline/]
$ACK (<No devices started>,<Node ^N/S1/ ^T/(S2)/>,,.MSCOD(M))
STND.6: SETZM .OHDRS+ARG.DA+OBJ.UN(M) ;RESET UNIT NUMBER FOR NEXT CALLER
SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
; START A DEVICE
; CALL: MOVE S1, OBJECT TYPE
; PUSHJ P,STND.X
STND.X: MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
MOVEI S1,.OHDRS+ARG.DA(M) ;Get the start of the object block
PUSHJ P,A$ISTA ;START A BATCH STREAM FOR THE NODE
$RETT ;AND RETURN
STAERR: PUSHJ P,DN60ID ;GENERATE DN60 IDENTIFIER
$ACK (<Illegal start command>,<^T/(S2)/ already started>,,.MSCOD(M))
$RETT ;RETURN
STAE.2: MOVE S1,.OHDRS+ARG.DA+OBJ.ND(M) ;Get the node name back
$ACK (<Illegal to start termination node ^N/S1/>,<Only defined prototype nodes may be started>,,.MSCOD(M))
$RETT
DN60ID: PUSHJ P,.SAVET ;SAVE SOME ACS
LOAD T4,NETPTL(S1),NT.PRT ;GET THE PORT DATA
HRLZS T4 ;CAL11. STYLE
LOAD T1,T4,C1.1CN ;CPU NUMBER
LOAD T2,T4,C1.1TY ;PORT TYPE
MOVE T2,PORTAB(T2) ;CONVERT TO TEXT
LOAD T3,T4,C1.1PN ;PORT NUMBER
LOAD T4,NETPTL(S1),NT.LIN ;LINE NUMBER
MOVE S2,NETCOL(S1) ;GET NODE NUMBER
$TEXT (<-1,,DN60TX>,<^I/DN60IT/^0>)
MOVEI S2,DN60TX ;POINT TO TEXT
POPJ P, ;RETURN
DN60IT: ITEXT (<Station ^N/S2/ CPU^D/T1/ ^T/(T2)/ port ^O/T3/ line ^O/T4/>)
DN60TX: BLOCK 25
PORTAB: [ASCIZ /DL10/]
[ASCIZ /DTE/]
[ASCIZ /KMC/]
[ASCIZ /DMR/]
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
; Need to make certain it is not a shutdown for an IBM node device
MOVE S1,OBJ.ND(S1) ;Get the node name
PUSHJ P,N$GNOD## ;Get the node entry
JUMPF BADMSG ;It must be there!
LOAD S1,NETSTS(S2),NETIBM ;Get the IBM status
SKIPE S1 ;Is it IBM object?
JRST A$SH.3 ;Yes, not allowed
MOVE S1,P1 ;Get back the object block address
PUSHJ P,A$FOBJ ;FIND IT IN OUR DATA BASE
JUMPF DEVUNK ;NOT THERE,,ACK THE OPR AND 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))
MOVE S2,OBJTYP(P1) ;GET OBJECT TYPE
TXNE S1,OBSFRR ;IS THIS A FREE RUNNING DEVICE ??
CAIN S2,.OTFAL ;YES, BUT IS IT FAL?
TRNA ;NOT FREE RUNNING OR FREE RUNNING AND FAL
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 IT DOWN
$RETT ;AND RETURN
A$SH.3: $ACK (<Illegal to shutdown a specific object for IBM node ^N/OBJ.ND(P1)/>,<Use SHUTDOWN NODE command>,,.MSCOD(M))
$RETT ;Tell the operator and quit
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
SHUT.1: PUSHJ P,N$GNOD## ;FIND IT IN OUR DATA BASE
DMOVE P1,S1 ;COPY NODE NAME & ADDRESS
JUMPF SHUT.8 ;If not found, just return an error
; Check to see if we are shutting down an online proto. If so, mark the
; proto node and then go for the devices on the actual node
LOAD S1,NETSTS(P2),NT.MOD ;Get the mode
JUMPE S1,SHUT.2 ;CONTINUE IF NON-DN60 NODE
CAME P1,NETLOC(P2) ;Skip this if proto is same as actual
CAIE S1,DF.PRO ;Is it proto mode?
JRST SHUT.3 ;No, continue on
LOAD S1,NETSTS(P2),NETPRO ;Get proto online flag
SKIPN S1 ;Is it online prototype?
JRST SHUT.3 ;No, just shutdown the proto
MOVX S1,NETSHT ;Get the network shutdown bit
IORM S1,NETSTS(P2) ;Set it in the proto node
MOVE S1,NETLOC(P2) ;Get the actual node name
JRST SHUT.1 ;Go shut the actual node
SHUT.2: SKIPN P1,NETCOL(P2) ;GET SYSTEM DEPENDENT IDENTIFIER
MOVE P1,NETLOC(P2) ;ELSE USE ALTERNATE
SHUT.3: 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.4: JUMPE P2,SHUT.7 ;NO MORE,,WE ARE DONE
MOVE S1,OBJSCH(P2) ;GET THE SCHEDULING BITS
TXNN S1,OBSINV ;IS IT INVISIBLE ???
CAME P1,OBJNOD(P2) ;ARE WE SHUTING DOWN THIS OBJECT ???
JRST SHUT.5 ;INVISIBLE OR WRONG NODE,,TRY NEXT
TXNN S1,OBSSUP ;IS THE OBJECT SETUP ???
JRST SHUT.6 ;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 !!
MOVE S2,OBJTYP(P2) ;GET OBJECT TYPE
TXNE S1,OBSFRR ;IS THIS A FREE RUNNING DEVICE ??
CAIN S2,.OTFAL ;YES, BUT IS IT FAL?
TRNA ;NOT FREE RUNNING OR FREE RUNNING AND FAL
TXZ S1,OBSBUS ;YES,,CLEAR THE BUSY BIT
STORE S1,OBJSCH(P2) ;RESTORE THE SCHEDULING BITS
DOSCHD ;FORCE A SCHEDULING PASS
AOS .OARGC(M) ;BUMP SHUTDOWN COUNT BY 1
SHUT.5: LOAD P2,.QELNK(P2),QE.PTN ;GET THE NEXT OBJECT ADDRESS
JRST SHUT.4 ;AND CONTINUE
SHUT.6: MOVE S1,P2 ;GET THE OBJECT ADDRESS
LOAD P2,.QELNK(P2),QE.PTN ;GET NEXT OBJ ADDR,,THIS ONE IS LEAVING
PUSHJ P,S$SHUT## ;SHUT THE OBJECT DOWN
AOS .OARGC(M) ;BUMP SHUTDOWN COUNT BY 1
JRST SHUT.4 ;AND CONTINUE
SHUT.7: SKIPN .OARGC(M) ;DID WE SHUTDOWN ANY OBJECTS ???
SHUT.8: $ACK (<No devices started on 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.
MOVX S1,OBSFRM ;GET 'SET FORMS TYPE' STATUS
MOVE S2,OBJTYP(P1) ;GET THE OBJECT TYPE
CAXN S2,.OTLPT ;PRINTER 'SET' ???
IORM S1,OBJSCH(P1) ;YES,,SET FORMS CHANGE STATUS
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.
SETSOI: MOVEI S1,.OPINS ;GET SYSTEM INTERVENTION CODE
JRST SETOIX ;CONTINUE
SETOIA: SKIPA S1,[.OPINY] ;GET OPR INTERVN ALLOWED CODE
SETNOI: MOVE S1,[.OPINN] ;GET NO OPR INTERVN ALLOWED CODE
SETOIX: 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
SETLP2: MOVE S1,(P3) ;GET THE ACTION CODE
STORE S1,OBJPRM+.OOFLG(P1),OF.LP2 ;SAVE 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.
SETUTY: PUSHJ P,UTYCHK ;CHECK FOR ALREADY SETUP, OUTPUT
$RETIF ;GIVE UP IF ERROR ALREADY ACKED
MOVE S1,(P3) ;GET UNIT TYPE
MOVEM S1,OBJPRM+.OOUNT(P1) ;SAVE SIXBIT QUANTITY
PJRST SETMSG ;GO ACK
SETNTY: MOVE S1,(P3) ;GET NETWORK-TYPE
CAIE S1,ST.ANF ;ANF-10?
CAIN S1,ST.DCN ;DECNET?
TRNA ;YES, TO ONE OF THEM
JRST SETA.2 ;NO, TO BOTH
MOVEM S1,OBJPRM+.OBNTY(P1) ;NO, STORE IN OBJECT BLOCK
PJRST SETMSG ;ACK OPR AND RETURN
SETATR: LOAD S1,OBJDAT(P1),RO.ATR ;GET ATTRIBUTES
CAMN S1,0(P3) ;NEED TO BE CHANGED?
PJRST SETMSG ;NO,,JUST RETURN
LOAD S1,OBJSCH(P1) ;GET SCHEDULER FLAGS
TXNE S1,OBSSUP!OBSSIP ;ERROR IF SETUP STARTED
JRST SETA.1
MOVE S1,0(P3) ;GET THE NEW ATTRIBUTES
STORE S1,OBJDAT(P1),RO.ATR ;STORE THEM
PJRST SETMSG ;RETURN
SETA.1: $ACK (Attribute may not be changed,,OBJTYP(P1),.MSCOD(M))
$RETF
SETA.2: $ACK (Invalid attribute specified,,OBJTYP(P1),.MSCOD(M))
$RETF
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
.STATR,,SETATR ;SET ATTIBUTES
.STNTY,,SETNTY ;FAL-STREAM NETWORK-TYPE (ATTRIBUTE)
.STMTA,,SETMTA ;SET MAGTAPE SPOOLING PARAMETERS
.STUTY,,SETUTY ;SET PRINTER UNIT-TYPE
.STLP2,,SETLP2 ;SET LP20 SIMULATION
.STSOI,,SETSOI ;SET SYSTEM-OPR-INTERVENTION
NSETS==.-SETTBL
;CHECK FOR ALREADY SETUP AND OUTPUT OBJECT
UTYCHK: MOVX S1,OBSSTA!OBSSUP!OBSSIP ;VARIOUS SETUP BITS
TDNE S1,OBJSCH(P1) ;ALREADY SETUP?
PJRST DASMSG ;DEVICE ALREADY STARTED
MOVE S1,OBJTYP(P1) ;GET THE OBJECT TYPE
PUSHJ P,A$OB2Q ;CONVERT TO QUEUE HEADER
JUMPF BADMSG ;BAD ORION MESSAGE
LOAD S1,.QHTYP(S1),QH.TYP ;GET QUEUE TYPE
CAIE S1,.QHTOU ;OUTPUT?
JRST BADMSG ;ORION BUILT A BAD MESSAGE
$RETT ;RETURN GOODNESS
;SET MAGTAPE SPOOLING PARAMETERS
SETMTA: PUSHJ P,UTYCHK ;ALREADY SETUP, OUTPUT?
$RETIF ;ERROR ACK SENT
MOVE S1,OBJPRM+.OOUNT(P1) ;GET CURRENT (MAYBE ZERO) UNIT TYPE
MOVEM S1,OLDUTY ;SAVE INCASE OF ERROR
MOVE S1,OBJPRM+.OOMTA(P1) ;GET CURRENT MTA PARAMETERS
MOVEM S1,OLDMTA ;SAVE INCASE OF ERROR
MOVSI S1,OBJPRM+.OOVSN(P1) ;POINT TO CURRENT VSN
HRRI S1,OLDVSN ;MAKE A BLT POINTER
BLT S1,OLDVSN+VSNLEN-1 ;COPY AWAY INCASE OF ERROR
SKIPN S1,OBJPRM+.OOUNT(P1) ;GET UNIT TYPE
MOVE S1,MTAUTT ;DEFAULT
MOVSI S2,-MTAUTL ;AOBJN POINTER
CAME S1,MTAUTT(S2) ;VALID UNIT TYPE?
AOBJN S2,.-1 ;LOOP THROUGH TABLE
JUMPGE S2,SETMT5 ;NO
MOVEM S1,OBJPRM+.OOUNT(P1) ;POSSIBLY UPDATE IT
SETMT1: PUSHJ P,A$GBLK ;GET FIRST/NEXT BLOCK
JUMPF SETMT4 ;BAD MESSAGE
MOVSI S1,-MTALEN ;AOBJN POINTER
SETMT2: HLRZ S2,MTATAB(S1) ;GET SWITCH BLOCK TYPE
CAIN T1,(S2) ;MATCH?
JRST SETMT3 ;YES
AOBJN S1,SETMT2 ;LOOP THROUGH TABLE
JRST SETMT4 ;BAD MESSAGE
SETMT3: HRRZ S2,MTATAB(S1) ;GET DISPATCH ADDRESS
PUSHJ P,(S2) ;PROCESS SWITCH
JUMPF SETMT6 ;CHECK FOR ERROR
ADDI T3,-ARG.DA(T2) ;OFFSET TO NEXT POSSIBLE BLOCK
SKIPE (T3) ;END?
JRST SETMT1 ;LOOP BACK FOR ANOTHER
PUSHJ P,MDACHK ;DO MDA RESOURCE CHECKING
JUMPT SETMSG ;GO ACK IF OK
JRST SETMT6 ;ELSE RESET THINGS
SETMT4: SKIPA S1,[[ITEXT (<Unknown magtape parameter ^O/T1/>)]]
SETMT5: MOVEI S1,[ITEXT (<Unit type is not MAGTAP>)]
$ACK (<ORION message error>,<^I/(S1)/>,OBJTYP(P1),.MSCOD(M))
SETMT6: MOVE S1,OLDUTY ;GET PREVIOUS UNIT TYPE
MOVEM S1,OBJPRM+.OOUNT(P1) ;REPLACE
MOVE S1,OLDMTA ;GET PREVIOUS PARAMETERS
MOVEM S1,OBJPRM+.OOMTA(P1) ;REPLACE
MOVSI S1,OLDVSN ;POINT TO PREVIOUS VSN
HRRI S1,OBJPRM+.OOVSN(P1) ;AND TO STORAGE
BLT S1,OBJPRM+.OOVSN+VSNLEN-1(P1) ;REPLACE
$RETF
MTATAB: .SWMDN,,MTAMDN ;/DENSITY
.SWMDI,,MTAMDI ;/DIRECTORY-FILE
.SWMLT,,MTAMLT ;/LABEL-TYPE
.SWMRL,,MTAMRL ;/MULTI-REEL
.SWMPR,,MTAMPR ;/PARITY
.SWMTK,,MTAMTK ;/TRACKS
.SWMVS,,MTAMVS ;/VOLUME-SET
MTALEN==.-MTATAB ;LENGTH OF TABLE
MTAUTT: SIXBIT /MAGTAP/ ;DEFAULT UNIT TYPE (MUST BE FIRST)
MTAUTL==.-MTAUTT ;LENGTH OF TABLE
OLDUTY: BLOCK 1 ;OLD UNIT TYPE
OLDMTA: BLOCK 1 ;OLD MAGTAPE PARAMETERS
OLDVSN: BLOCK VSNLEN ;OLD VOLUME-SET NAME
;DENSITY
MTAMDN: MOVE S1,(T3) ;GET DENSITY ACTION
STORE S1,OBJPRM+.OOMTA(P1),OB.MDN ;SET DENSITY
$RETT ;RETURN
;DIRECTORY-FILE
MTAMDI: MOVE S1,(T3) ;GET YES/NO ACTION
STORE S1,OBJPRM+.OOMTA(P1),OB.MDI ;SET MAGTAPE DIRECTORY
$RETT ;RETURN
;LABEL TYPE
MTAMLT: MOVX S1,OB.MLV!OB.MLT ;AND LABEL TYPE AND VALID BITS
ANDCAM S1,OBJPRM+.OOMTA(P1) ;INITIALLY CLEAR THEM
MOVE S1,(T3) ;GET LABEL TYPE ACTION
CAIN S1,-1 ;DEFAULT?
$RETT ;YES--USE SPOOLER DEFAULT
STORE S1,OBJPRM+.OOMTA(P1),OB.MLT ;SET LABEL TYPE
MOVX S1,OB.MLV ;ONE MORE BIT
IORM S1,OBJPRM+.OOMTA(P1) ;INDICATE LABEL TYPE IS VALID
$RETT ;RETURN
;MULTI-REEL
MTAMRL: MOVE S1,(T3) ;GET YES/NO ACTION
STORE S1,OBJPRM+.OOMTA(P1),OB.MRL ;SET MULTI-REEL VOLUME-SET
$RETT ;RETURN
;PARITY
MTAMPR: MOVE S1,(T3) ;GET ODD/EVEN/DEFAULT ACTION
STORE S1,OBJPRM+.OOMTA(P1),OB.MPR ;SET PARITY
$RETT ;RETURN
;TRACKS
MTAMTK: MOVE S1,(T3) ;GET 7/9/DEFAULT ACTION
STORE S1,OBJPRM+.OOMTA(P1),OB.MTK ;SET TRACK TYPE
$RETT ;RETURN
;VOLUME-SET NAME
MTAMVS: MOVSI S1,OBJPRM+.OOVSN(P1) ;VOLUME-SET DESTINATION
HRRI S1,OBJPRM+.OOVSN+1(P1) ;MAKE A BLT POINTER
SETZM OBJPRM+.OOVSN(P1) ;CLEAR FIRST WORD
BLT S1,OBJPRM+.OOVSN+VSNLEN-1(P1); CLEAR STORAGE
MOVSI S1,(T3) ;POINT TO VOLUME-SET NAME
HRRI S1,OBJPRM+.OOVSN(P1) ;MAKE A BLT POINTER
LOAD S2,-ARG.DA(T3),AR.LEN ;GET LENGTH OF VSN STRING
CAILE S2,VSNLEN ;REASONABLE?
MOVEI S2,VSNLEN ;TRUNCATE
ADDI S2,OBJPRM+.OOVSN(P1) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY VSN
$RETT ;RETURN
;HERE FOR MDA RESOURCE CHECK WITH DENSITY IN S1 AND TRACKS IN S2
MDACHK: SKIPN G$MDA## ;MDA SUPPORT?
$RETT ;NO
LOAD S1,OBJPRM+.OOMTA(P1),OB.MDN ;GET DENSITY
CAIN S1,.TFD00 ;DEFAULT DENSITY?
JRST MDACH1 ;YES
MOVNI S2,-1(S1) ;NEGATE DENSITY INDEX FOR LSH
MOVX S1,UC.200 ;STARTING DENSITY BIT
LSH S1,(S2) ;SELECT PROPER BIT
JRST MDACH2 ;ONWARD
MDACH1: MOVE S1,[UC.200+UC.556+UC.800+UC.1600+UC.6250]
MDACH2: LOAD S2,OBJPRM+.OOMTA(P1),OB.MTK ;GET TRACKS
JUMPN S2,MDACH3 ;PROCEED IF TRACK TYPE KNOWN
PUSH P,S1 ;SAVE DENSITY BIT(S)
MOVEI S2,%TRK9 ;FIRST TRY 9-TRACK
PUSHJ P,D$TRSN## ;...
POP P,S1 ;GET DENSITY BIT(S) BACK
JUMPT .RETT ;RETURN IF RESOURCE FOUND
MOVEI S2,%TRK7 ;NOW TRY 7-TRACK
MDACH3: PUSHJ P,D$TRSN## ;FIND A MATCHING RESOURCE
JUMPT .RETT ;RETURN IF A RESOURCE EXISTS
$ACK (<No units with desired density and tracks>,,OBJTYP(P1),.MSCOD(M))
$RETF ;RETURN
SUBTTL A$ETSR - ENABLE TIMESHARING
TOPS10 <
A$ETSR::PUSHJ P,A$WHEEL ;MAKE SURE SENDER IS PRIV'ED
JUMPF E$IPE## ;NO PRIVS
PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZB P1,P2 ;CLEAR JOB AND REQUEST-ID
SKIPGE S1,G$KSYS## ;KSYS TIMED OUT?
JRST ETSR.3 ;YES
JUMPE S1,ETSR.4 ;ERROR IF NOT PENDING
MOVEI H,HDREVT## ;POINT TO EVENT QUEUE HEADER
LOAD AP,.QHLNK(H),QH.PTF ;POINT TO THE FIRST ENTRY
ETSR.1: JUMPE AP,ETSR.3 ;RETURN IF NO MORE ENTRIES
GETLIM S1,.QELIM(AP),TYPE ;GET EVENT CODE
CAIE S1,.EVKSY ;KSYS?
TDZA S1,S1 ;NO
GETLIM S1,.QELIM(AP),ACTV ;GET ACTIVE BIT
JUMPN S1,ETSR.2 ;ONLY VALID IF ACTIVE
LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST ETSR.1 ;AND LOOP
ETSR.2: MOVE P1,.QEJOB(AP) ;SAVE JOB NAME
MOVE P2,.QERID(AP) ;AND REQUEST-ID
PUSHJ P,Q$KPRO## ;KILL OFF THIS REQUEST
ETSR.3: MOVE S1,[.STKSY,,0] ;FUNCTION,,CLEAR TIMER
SKIPN DEBUGW ;DEBUGGING?
SETUUO S1, ;SET KSYS
JFCL ;SHOULDN'T FAIL
MOVEI S2,ETSR.K ;POINT TO KILL TEXT
SKIPN P2 ;HAVE A REQUEST-ID?
MOVEI S2,ETSR.N ;NO--POINT TO NULL TEXT
MOVEI S1,ETSR.A ;POINT TO NORMAL ACK TEXT
JRST ETSR.5 ;FINISH UP
ETSR.4: MOVEI S1,ETSR.E ;POINT TO ERROR ACK TEXT
MOVEI S2,ETSR.N ;POINT TO NULL TEXT
ETSR.5: $ACK (<^T/(S1)/>,<^I/(S2)/>,,.MSCOD(M))
POPJ P, ;RETURN
ETSR.A: ASCIZ /Timesharing enabled/
ETSR.E: ASCIZ /No KSYS pending/
ETSR.N: ITEXT (<>)
ETSR.K: ITEXT (<Event ^W/P1/ request #^D/P2/ cancelled>)
> ;END TOPS-10 CONDITIONAL
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
SETO S2, ;Say we want online check
$CALL N$CKND## ;Check out the node
JUMPF NETS.3 ;Failed, either online or
; objects started
JUMPE S2,NETS.2 ;Not found, not defined
MOVE P1,S2 ;SAVE THE DATA BASE ENTRY ADDRESS
LOAD S2,NETSTS(P1),NT.MOD ;GET THE IBM REMOTE STATUS BITS
JUMPE S2,NETS.2 ;NOT IBM,,CAN'T DO THIS !!!
CAIN S2,DF.TRM ;Is it an actual termination node?
JRST NETS.4 ;Yes, can't do set
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 ^N/S1/ Ignored>,<It is Not Defined as an IBM Remote>,,.MSCOD(M))
$RETT
NETS.3: $ACK (<Set for Node ^T/NETASC(S2)/ Ignored>,<^I/0(S1)/>,,.MSCOD(M))
$RETT
NETS.4: $ACK (<Set for Node ^T/NETASC(P1)/ Ignored>,<It is a termination but not a prototype node>,,.MSCOD(M))
$RETT
>
IFE FTDN60,<JRST NODN60 > ;JUST ACK AND RETURN
SUBTTL A$MODIFY - ROUTINE TO SET THE JOBS PRIORTY
A$MODIFY: $SAVE <M,P1> ;SAVE 'M' & P1 FOR A SECOND
MOVEI S1,TMPMSG+MOD.RQ ;GET THE RDB BLOCK ADDRESS
PUSHJ P,GENRDB ;GO GENERATE THE RDB
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
MOVE S1,0(S1) ;GET THE NEW PRIORITY
MOVEI M,TMPMSG ;POINT 'M' AT THE NEW MSG
MOVEM S1,MOD.SZ+2(M) ;SAVE THE NEW PRIORITY
MOVE S1,[MOD.SZ+3,,.QOMOD] ;GET THE MSG LENGTH AND TYPE
MOVEM S1,.MSTYP(M) ;SAVE IT
SETOM MOD.SZ+1(M) ;NO/AFTER PARAMETER
MOVEI S1,3 ;GET THE MAJOR BLOCK LENGTH
MOVEM S1,MOD.SZ(M) ;AND SAVE IT
SETZM G$ACK## ;WE DONT WANT AN ACK.
SETOM G$QOPR## ;THIS IS AN OPERATOR REQUEST
PUSHJ P,Q$MODIFY## ;GO MODIFY THE JOB PRIORTY
SETZM G$QOPR## ;RESET THE OPERATOR INDICATOR
SETZM G$RMTE## ;ZERO THE NODE WE USED (SET BY GENRDB)
SKIPG S1 ;MORE THEN 0 JOBS ???
$ACK (<No ^T/(S2)/s modified>,,,.MSCOD(M))
CAIN S1,1 ;JUST 1 JOB ???
$ACK (<1 ^T/(S2)/ modified>,,,.MSCOD(M))
CAILE S1,1 ;MORE THEN 1 JOB ???
$ACK (<^D/S1/ ^T/(S2)/s modified>,,,.MSCOD(M))
$RETT ;AND RETURN
SUBTTL A$QUEU - ENABLE/DISABLE SPECIFIC QUEUES
A$QUEU::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,S2 ;GET THE CODE (.OMDIS/.OMENA)
MOVEI S1,.EDQUE ;GET THE MESSAGE TYPE
PUSHJ P,A$FNDB ;FIND THE BLOCK
JUMPF ILLMSG ;CAN'T FIND IT
MOVE S1,(S1) ;GET THE OBJECT TYPE
CAMN S1,[EXP -1] ;ALL QUEUES?
SKIPA S1,[-NQUEUE##,,TBLHDR##];AOBJN POINTER TO QUEUE HEADERS
PUSHJ P,A$OB2Q ;CONVERT TO QUEUE HEADER
JUMPF ILLMSG ;UNKNOWN QUEUE
PUSH P,H ;SAVE H
MOVE H,S1 ;COPY QUEUE HEADER ADDRESS
MOVX S1,QH.DIS ;GET DISABLED BIT
CAIE P1,.OMENA ;WHICH ONE?
SKIPA P2,[IORM S1,.QHTYP(H)] ;DISABLE
SKIPA P2,[ANDCAM S1,.QHTYP(H)] ;ENABLE
SKIPA P1,[[ASCIZ /disabled/]] ;DISABLE
MOVEI P1,[ASCIZ /enabled/] ;ENABLE
QUEU.1: LOAD S2,.QHTYP(H),QH.TYP ;GET QUEUE TYPE
CAIE S2,.QHTOU ;OUTPUT?
CAIN S2,.QHTIP ;INPUT?
XCT P2 ;TOGGLE BIT
JUMPG H,QUEU.2 ;DONE IF ONLY A SINGLE QUEUE
ADDI H,QHSIZE-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN H,QUEU.1 ;LOOP THROUGH ALL THE HEADERS
MOVEI S1,[ASCIZ .All input/output.]
MOVEI S2,[ASCIZ /queues are/]
JRST QUEU.3 ;GO ACK
QUEU.2: MOVE S1,.QHLQN(H) ;GET QUEUE LISTING NAME
MOVEI S2,[ASCIZ /queue is/] ;ASSUME A SINGLE QUEUE
QUEU.3: POP P,H ;RESTORE H
$ACK (<^T/(S1)/ ^T/(S2)/ ^T/(P1)/>,,,.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 DEVUNK ;NOT THERE,,ACK THE OPR AND RETURN
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.
SETZM OBJRID(P1) ;Prevent further NEXT processing
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
STOPCD (RJM,HALT,,<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.2: $ACK (Not Active,,OBJTYP(P1),.MSCOD(M))
$RETT
A$RQ.3: $ACK (Request Id Invalid,,OBJTYP(P1),.MSCOD(M))
$RETT
SUBTTL COMMMM - OPERATOR REQUEST COMMON PROCESSING ROUTINE.
A$COMM: PUSHJ P,.SAVE1 ;SAVE P1 AND P2 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 DEVUNK ;NOT THERE,,ACK THE OPR AND RETURN
MOVE P1,S1 ;SAVE THE OBJECT QUEUE ENTRY ADDRESS
MOVX S1,OBSSTP ;GET THE 'STOPPED' STATUS BIT
LOAD S2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
CAXN S2,.OMCON ;IS THE MESSAGE 'CONTINUE' ???
ANDCAM S1,OBJSCH(P1) ;YES,,TURN OFF THE 'STOP' BIT
MOVX S1,OBSBUS!OBSFCH ;[1163] PICK UP BUSY BIT AND FORMS CHANGE BIT
TDNN S1,OBJSCH(P1) ;IS THE DEVICE BUSY ???.
JRST COMM.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 ;UPDATE THE OBJECT STATUS
$RETT ;RETURN...
COMM.2: LOAD S2,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
CAXE S2,.OMCON ;IS THE MESSAGE 'CONTINUE' ???
JRST COMM.4 ;NO,,JUST ACK AND LEAVE
$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
COMM.4: $ACK (Not Active,,OBJTYP(P1),.MSCOD(M))
$RETT
SUBTTL OPERATOR COMMAND PROCESSING ROUTINES.
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: PUSHJ P,.SAVE1 ;SAVE P1
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
MOVE P1,S1 ;SAVE THE ADDRESS FOR A MINUTE
PUSHJ P,A$FOBJ ;FIND THE OBJECT IN OUR OBJECT QUEUE
JUMPF DEVUNK ;NOT THERE,,ACK THE OPR AND RETURN
MOVE P1,S1 ;SAVE THE OBJECT ADDRESS
MOVE S1,OBJNOD(P1) ;GET THE NODE FOR THIS OBJECT
PUSHJ P,N$NODE## ;FIND IT IN OUT DATA BASE
MOVE S1,P1 ;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
A$OSHC: PJRST A$COMM ;PROCESS THE SHOW CONTROL FILE COMMAND.
SUBTTL A$OPAU - STOP OPERATOR MESSAGE PROCESSOR
A$OPAU: PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
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 DEVUNK ;NOT THERE,,ACK THE OPR AND RETURN
MOVE P1,S1 ;SAVE THE OBJECT QUEUE ENTRY ADDRESS
MOVE S1,.OFLAGS(M) ;GET THE MESSAGE FLAG BITS
TXNE S1,ST.ACR+ST.AER ;IS THIS AN 'IMMEDIATE' STOP ???
JRST OPAU.1 ;NO,,SKIP THIS
LOAD S1,OBJSCH(P1),OBSBUS ;IS THE DEVICE ACTIVE ???
JUMPE S1,OPAU.2 ;NO,,JUST ACK AND RETURN
MOVE S1,P1 ;GET THE OBJECT ADDRESS IN S1
PUSHJ P,SNDOAC ;SEND THE REQUEST OFF
JRST OPAU.3 ;[1202] GO SET 'STOPPED' AND UPDATE
OPAU.1: MOVX S2,OBSSER ;GET THE 'STOP AFTER EVERY REQUEST' BIT
TXNE S1,ST.AER ;DOES HE WANT EACH REQUEST STOPPED ???
IORM S2,OBJSCH(P1) ;YES,,SET THE STATUS BIT
MOVEI S2,[ASCIZ/Stop is Pending/] ;GET THE ACK TEXT
MOVX S1,OBSBUS ;GET THE ACTIVE STATUS
TDNN S1,OBJSCH(P1) ;ARE WE ACTIVE NOW ???
OPAU.2: MOVEI S2,[ASCIZ/Stopped/] ;NO,,JUST SAY STOPPED
$ACK (^T/0(S2)/,,OBJTYP(P1),.MSCOD(M)) ;ACK THE OPR
OPAU.3: MOVX S1,OBSSTP ;GET THE 'STOPPED' STATUS BIT
IORM S1,OBJSCH(P1) ;AND SET IT
MOVE S1,P1 ;GET THE OBJECT ADDRESS IN S1
PUSHJ P,A$OBST ;UPDATE THE STATUS
$RETT ;RETURN
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.
$SAVE <M,P1> ;SAVE 'M' AND P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE ENTRY TYPE
MOVEI S1,TMPMSG+HBO.RQ ;GET THE RDB BLOCK ADDRESS
PUSHJ P,GENRDB ;GO CREATE THE MESSAGE RDB
MOVEI M,TMPMSG ;GET THE MSG ADDRESS IN 'M'
MOVEM P1,HBO.FL(M) ;SAVE THE TYPE FLAGS
MOVE S1,[HBO.SZ,,.QOHBO] ;GET THE MSG LENGTH,,TYPE
MOVEM S1,.MSTYP(M) ;SAVE IT
SETZM G$ACK## ;INDICATE NO ACK.
SETOM G$QOPR## ;SHOW THAT MSG IS FROM THE OPERATOR.
PUSHJ P,Q$HOLD## ;PERFORM HOLD/RELEASE
SETZM G$QOPR## ;TURN OFF THE QUEUE SEARCH FLAG.
SETZM G$RMTE## ;ZERO THE NODE WE USED (SET BY GENRDB)
MOVEI TF,[ASCIZ/held/] ;ASSUME HOLD MESSAGE.
SKIPE P1 ;CHECK FLAGS,,IF 0 WE WERE RIGHT
MOVEI TF,[ASCIZ/released/] ;ELSE MAKE IT RELEASE.
SKIPG S1 ;MORE THEN 0 JOBS ???
$ACK (<No ^T/(S2)/s ^T/@TF/>,,,.MSCOD(M))
CAIN S1,1 ;IS THERE ONLY 1 JOB ???
$ACK (<1 ^T/(S2)/ ^T/@TF/>,,,.MSCOD(M))
CAILE S1,1 ;MORE THEN 1 JOB ???
$ACK (<^D/S1/ ^T/(S2)/s ^T/@TF/>,,,.MSCOD(M))
SKIPE P1 ;IS THIS A RELEASE MSG ???
DOSCHD ;YES,,FORCE A SCHEDULING PASS
$RETT ;AND RETURN.
SUBTTL A$ODEL - ROUTINE TO REMOVE JOBS FROM THE SYSTEM QUEUES
;CALL: M/ The Operator CANCEL msg address
;
;RET: True Always
A$ODEL: $SAVE <M> ;SAVE THE INCOMMING MSG ADDRESS
MOVEI S1,TMPMSG+KIL.RQ ;GET THE RDB BLOCK ADDRESS
PUSHJ P,GENRDB ;GO CREATE THE RDB FOR THE MSG
MOVEI M,TMPMSG ;GET THE MSG ADDRESS IN 'M'
MOVE S1,[KIL.SZ,,.QOKIL] ;GET THE MSG LENGTH,,TYPE
MOVEM S1,.MSTYP(M) ;SAVE IT
SETZM G$ACK## ;NO ACK (PERIOD)
SETOM G$QOPR## ;THIS IS AN OPERATOR REQUEST
PUSHJ P,Q$KILL## ;GO DO IT !!!
SETZM G$QOPR## ;CLEAR OPR FLAG
SETZM G$RMTE## ;ZERO THE NODE WE USED (SET BY GENRDB)
SKIPG S1 ;NO JOBS KILLED !!!
$ACK (<No ^T/(S2)/s canceled>,,,.MSCOD(M))
CAIN S1,1 ;1 JOB KILLED !!!
$ACK (<1 ^T/(S2)/ canceled>,,,.MSCOD(M))
CAILE S1,1 ;MORE THE 1 JOB !!!
$ACK (<^D/S1/ ^T/(S2)/s canceled>,,,.MSCOD(M))
$RETT ;RETURN,,WE'RE DONE
SUBTTL A$ORTE - ROUTINE TO PROCESS OPERATOR ROUTE COMMAND.
A$ORTE: PUSHJ P,A$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
PUSHJ P,.SAVE1 ;SAVE P1 FOR A SECOND
MOVE P1,S1 ;SAVE THE DATA ADDRESS
MOVSI S1,RTELEN+.OHDRS ;GET THE MSG LENGTH
MOVEM S1,.MSTYP(M) ;SAVE IT IN THE MESSAGE
MOVEI S1,2 ;GET 2 BLOCKS
MOVEM S1,.OARGC(M) ;SAVE IT IN THE MESSAGE
MOVEI S2,.OHDRS(M) ;POINT TO THE FIRST BLOCK
MOVE S1,[4,,.RTEFM] ;GET THE FIRST BLOCK HEADER
MOVEM S1,ARG.HD(S2) ;SAVE IT
SETOM ARG.DA+OBJ.TY(S2) ;ALL DEVICES
SETOM ARG.DA+OBJ.UN(S2) ;ALL UNITS
LOAD S1,.SNODE-1(P1) ;GET THE SOURCE NODE NAME/NUMBER
MOVEM S1,ARG.DA+OBJ.ND(S2) ;SAVE IT
MOVEI S2,OBJ.SZ+1(S2) ;POINT TO THE NEXT BLOCK
MOVE S1,[4,,.RTETO] ;GET THE SECOND BLOCK HEADER
MOVEM S1,ARG.HD(S2) ;SAVE IT
SETOM ARG.DA+OBJ.TY(S2) ;ALL DEVICES
SETOM ARG.DA+OBJ.UN(S2) ;ALL UNITS
LOAD S1,.DNODE-1(P1) ;GET THE DESTINATION NODE NBR.
MOVEM S1,ARG.DA+OBJ.ND(S2) ;SAVE IT
PJRST N$NRTE## ;GO PERFORM THE ROUTING & RETURN
SUBTTL A$DEFINE - Routine to process the 'DEFINE' network command
;Call: M/ The message address
;Ret: TRUE always
; The purpose of this routine is to add a prototype node to the node data base.
; The current characteristics are:
; 1. If the node already exists, verify its current state. If it already
; has objects started, is online, or has devices started on the
; same port/line, thats an error.
; 2. If 1 passed, add the node to the node database.
; 3. If the node is termination, and signon is required, find the signon
; file and validate all of the actual nodes as specified in
; step 1. Also add the node to the data base as an IBM term.
; node (unless it has objects started on it, in which case
; the operator is notified of the error.)
; 4. Notify the operator of the completion of the definition.
A$DEFINE:
$SAVE <P1,P2,P3,P4> ;Save P1,P2,P3,P4 for a minute
;P1 is used for node name
;P2 is used for node entry address
;P3 is used for block header
;P4 is used for display
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
SETO S2, ;Say we want online check
MOVE P1,S1 ;Save the node name
$CALL N$CKND## ;Check out the node
JUMPF DEFBD1 ;Failed, either online or
; objects started
MOVE P2,S2 ;Remember the results of N$CKND
SETZ P4, ;Say this is a definition
SKIPN P2 ;Is it?
AOJ P4, ;No, say redefinition
; Find the DEFINE Msg Block
MOVX S1,.DFBLK ;GET THE DEFINE BLOCK TYPE
PUSHJ P,A$FNDB ;GO FIND IT
JUMPF BADMSG ;NOT THERE,,ORION ERROR
MOVEI P3,-1(S1) ;MAKE SURE WE ARE POINTING AT BLK HEADER
LOAD S1,DEF.TY(P3),DF.TPP ;Get the type
CAXN S1,DF.LAT ;Is it a LAT server?
JRST DEFLAT ;Yes, special handling
IFN FTDQS,<
CAXN S1,DF.SRV ;SERVER?
JRST DEFSRV ;YES
>; END IFN FTDQS
IFE FTDN60,<
NODN60: $ACK (< DN60 remotes are not supported >,,,.MSCOD(M))
$RETT
>
IFN FTDN60,<
MOVE S1,P1 ;Get back the node name
MOVE S2,DEF.MD(P3) ;GET THE NODE MODE
CAXE S2,DF.TRM ;Is it termination?
JRST DEFI.1 ;No, skip this
LOAD S2,DEF.TY(P3),DF.FLG ;Get the signon flag
CAIN S2,DF.NSN ;Is no signon required?
JRST DEFI.1 ;No signon required, skip this
; Check out the prototype termination signon file
MOVE S2,P2 ;Give what we know of node address
PUSHJ P,N$SACT## ;Go check out signon file and nodes
JUMPF DEFBD1 ;Failed, tell the operator about it
MOVE P2,S2 ;Remember the entry
; Add the node to the data base if needed
DEFI.1: JUMPN P2,DEFI.2 ;Skip this if node already defined
PUSHJ P,N$NNET## ;Add the node
MOVE P2,S2 ;Remember the entry
DEFI.2: MOVE S2,DEF.MD(P3) ;Get the node mode
CAXN S2,DF.TRM ;Is it termination
MOVX S2,DF.PRO ;Yes, make it a prototype
STORE S2,NETSTS(P2),NT.MOD ;SAVE IT IN OUR DATA BASE
LOAD S2,DEF.TY(P3),DF.TPP ;Get the type of node
STORE S2,NETSTS(P2),NT.TYP ;SAVE IT IN OUR DATA BASE
MOVE S2,DEF.PT(P3) ;GET THE PORT NUMBER
STORE S2,NETPTL(P2),NT.PRT ;SAVE THE PORT NUMBER
MOVE S2,DEF.LN(P3) ;GET THE LINE NUMBER
STORE S2,NETPTL(P2),NT.LIN ;SAVE THE LINE NUMBER
; Setting defaults
; BPM--If 3780 then 512 else 400
MOVEI S1,^D400 ;Get most likely
LOAD S2,NETSTS(P2),NT.TYP ;GET THE REMOTE TYPE
CAXN S2,DF.378 ;IS IT 3780 ???
MOVEI S1,^D512 ;Yes, set it different
STORE S1,NETBPM(P2),FWMASK ;And set it
; CSD--Is always set to 3
MOVEI S1,3 ;Get the normal value
STORE S1,NETCSD(P2),FWMASK ;And set it
; RPM--If 2780 then 7 else 0
SETZ S1, ;Get most likely
CAXN S2,DF.278 ;Is it 2780 ???
MOVEI S1,7 ;Yes, set it different
STORE S1,NETRPM(P2),FWMASK ;And set it
; Timeout cat.--If proto termination, then primary else secondary
MOVEI S1,ST.SEC ;Must start somewhere
LOAD S2,NETSTS(P2),NT.MOD ;GET THE REMOTE MODE
CAXN S2,DF.PRO ;IS IT PROTO TERMINATION MODE ???
MOVEI S1,ST.PRI ;Yes, say primary
STORE S1,NETSTS(P2),NT.TOU ;And set it
; Transparancy--Always off
MOVEI S1,ST.OFF ;Set it off
STORE S1,NETSTS(P2),NT.TRA ;And set it
; Set port/line handle
MOVE S1,G$NOW## ;GET THE UDT FOR PORT/LINE HANDLE
MOVEM S1,NETIDN(P2) ;SAVE IT IN THE DATA BASE
; Say we are IBM node
MOVEI S1,1 ;GET A 1
STORE S1,NETSTS(P2),NETIBM ;LITE THE IBM NODE BIT
; Set the signon according to the define
LOAD S2,DEF.TY(P3),DF.FLG ;Get the signon flag
CAIN S2,DF.NSN ;Is signon required?
SETZ S1, ;Want to clear the bit
STORE S1,NETSTS(P2),NETSGN ;SET 'SIGNON REQUIRED' BIT
>; END IFN FTDN60
DEFGOD: $ACK (< ^T/DEFTAB(P4)/efine for node ^T/NETASC(P2)/ accepted >,,,.MSCOD(M))
$RETT ;AND RETURN
DEFLAT: JUMPN P2,DEFL.1 ;Already defined: not again
MOVE S1,P1 ;Restore the node name
PUSHJ P,N$NNET## ;Add this node
MOVE P2,S2 ;Remember the entry
DEFL.1: LOAD S2,DEF.TY(P3),DF.TPP ;Save the type of node
STORE S2,NETSTS(P2),NT.TYP ;
MOVEI S1,1 ;
STORE S1,NETSTS(P2),NETLAT ;Set the LAT server bit
HRLI S1,DEF.LA(P3) ;Source,,0
HRRI S1,NETLNM(P2) ;Source,,destination
BLT S1,NETLNM+LPTNLN-1(P2) ;Copy LAT server/service/port
JRST DEFGOD ;Send the ACK
IFN FTDQS,<
DEFSRV: MOVE S1,P1 ;GET BACK THE NODE NAME
PUSHJ P,N$NNET## ;ADD THE NODE
MOVE P2,S2 ;REMEMBER THE ENTRY
MOVEI S1,1 ;GET A 1
STORE S1,NETSTS(P2),NETSRV ;LITE THE SERVER NODE BIT
MOVE S1,[1,,.OTLPT] ;ONE LPT
MOVEM S1,NETLPT(S2) ;SAVE
JRST DEFGOD ;GO ACK THEM
>; END IFN FTDQS
DEFBD1: $ACK(< Define for node ^N/P1/ ignored >,<^I/0(S1)/>,,.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,G$MSG##+OBJ.TY ;SAVE IT IN OBJECT BLOCK
SETZM G$MSG##+OBJ.UN ;WANT UNIT 0
MOVE S1,.MSCOD(M) ;GET THE NODE NAME
MOVEM S1,G$MSG##+OBJ.ND ;SAVE IT IN OBJECT BLOCK
MOVEI S1,G$MSG## ;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 ^N/.MSCOD(M)/>,,,<$WTFLG(WT.SJI)>)
MOVEI S1,G$MSG## ;[1206] GET MESSAGE BUFFER ADDR
PJRST SNDOPR ;RETURN THE MSG TO ORION AND RETURN
>
IFE FTDN60,<JRST NODN60 > ;SHOULD NOT HAPPEN
SUBTTL A$DQNM - Define a Queue Name
A$DQNM::$SAVE <AP,H,E,P1,P2> ;SAVE THE AC'S
MOVX S1,.DFQNM ;GET THE BLOCK TYPE
PUSHJ P,A$FNDB ;FIND IT IN THE MESSAGE
JUMPF BADMSG ;SHOULD BE THERE
MOVEI P1,-1(S1) ;POINT AT THE BLOCK HEADER
MOVEI S1,DFQ.QN(P1) ;POINT AT THE QUEUE NAME
HRLI S1,(POINT 8) ;WE STORE THE NAME IN 8-BIT ASCII
PUSHJ P,ASCUPR ;MAKE SURE IT'S UPPER CASE
MOVEI H,HDRQNM## ;POINT AT THE QUEUE HEADER
SETZB P2,E ;ASSUME A REDEFINITION
LOAD AP,.QHLNK(H),QH.PTF ;GET POINTER TO FIRST ENTRY IN QUEUE
DQNM.1: JUMPE AP,DQNM.3 ;IF NOTHING THERE, GO CREATE AN ENTRY
MOVEI S1,DFQ.QN(P1) ;TEST STRING
MOVEI S2,QNM.QN(AP) ;BASE STRING
HRLI S1,(POINT 8) ;BOTH 8-BIT ASCII STRINGS
HRLI S2,(POINT 8)
PUSHJ P,S%SCMP ;COMPARE THE STRINGS
SKIPF ;DID IT MATCH?
JUMPE S1,DQNM.4 ;YES, IF EXACT MATCH, TAKE IT
JUMPG E,DQNM.2 ;CONTINUE IF POSITION FOUND
TXNN S1,SC%GTR ;NEW NAME GREATER THAN OLD?
MOVE E,AP ;REMEMBER POSITION IN QUEUE
DQNM.2: LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST DQNM.1 ;CHECK FOR THAT
DQNM.3: SKIPN DFQ.OT(P1) ;CREATING AND DELETING?
JRST DQNM.6 ;TELL FOOL TO GET STUFFED
PUSHJ P,M$GFRE## ;GET A FREE CELL
SKIPGE E ;KNOW WHERE TO PUT NEW ENTRY?
LOAD E,.QHLNK(H),QH.PTF ;STICK AT FRONT OF QUEUE
PUSHJ P,M$LINK## ;LINK IT IN
MOVEI P2,1 ;THIS IS A DEFINITION
DQNM.4: MOVSI S1,DFQ.QN(P1) ;SOURCE
HRRI S1,QNM.QN(AP) ;DESTINATION
BLT S1,QNM.QN+QNMLEN-1(AP) ;GET IT ALL
MOVE S1,DFQ.TY(P1) ;GET THE QUEUE TYPE
CAXE S1,.KYLCL ;LOCAL QUEUE?
TDZA S1,S1 ;NO, GET A ZERO
MOVX S1,QN.LCL ;YES, GET THE FLAG
MOVEM S1,QNM.FL(AP) ;STUFF FLAGS
MOVE S1,DFQ.ND(P1) ;GET THE NODE NAME
MOVEM S1,QNM.RO+.ROBND(AP) ;STUFF IT
MOVE S1,DFQ.OT(P1) ;GET THE OBJECT TYPE
MOVEM S1,QNM.RO+.ROBTY(AP) ;STUFF IT
MOVE S1,DFQ.UN(P1) ;GET THE UNIT NUMBER
MOVEI S2,%PHYCL ;ASSUME PHYSICAL
CAME S1,[EXP -1] ;ANY UNIT?
SKIPE DFQ.UT(P1) ;OR A UNIT TYPE?
MOVEI S2,%GENRC ;CALL IT GENERIC
STORE S1,QNM.RO+.ROBAT(AP),RO.UNI ;STUFF IT
STORE S2,QNM.RO+.ROBAT(AP),RO.ATR ;STUFF IT
MOVE S1,DFQ.UT(P1) ;GET THE UNIT TYPE
MOVEM S1,QNM.RO+.ROBUT(AP) ;STUFF IT
MOVE S1,QNM.RO+.ROBND(AP) ;NODE
SETZ S2, ;NO NUMBER
PUSHJ P,N$NNET## ;ADD REMOTE NODE
MOVX S1,NETNQC ;MAGICAL BIT
IORM S1,NETSTS(S2) ;MAKE UNREAL NODE
SKIPN QNM.RO+.ROBTY(AP) ;OBJECT TYPE?
JRST DQNM.5 ;DELETING QUEUE NAME
$ACK (<^T/DEFTAB(P2)/efine for network queue ^Q/QUEQUE/ accepted>,,,.MSCOD(M))
$RETT ;ALL SET
DQNM.5: $ACK (<Network queue ^Q/QUEQUE/ deleted>,,,.MSCOD(M))
PUSHJ P,M$RFRE## ;DEALLOCATE, RETURN CORE
$RETT ;RETURN
DQNM.6: $ACK (<Network queue ^Q/QUEMSG/ does not exist>,,,.MSCOD(M))
$RETT ;RETURN
QUEQUE: POINT 8,QNM.QN(AP) ;POINTER TO NAME IN QUEUE
QUEMSG: POINT 8,DFQ.QN(P1) ;POINTER TO NAME IN MSG
;ROUTINE TO CONVERT A STRING TO UPPER-CASE ASCII. CALL WITH THE
;BYTE POINTER TO THE STRING IN S1.
ASCUPR::ILDB S2,S1 ;GET A BYTE
JUMPE S2,.RETT ;DONE WHEN A NULL IS ENCOUNTERED
CAIL S2,"a" ;LOWER CASE ASCII?
CAILE S2,"z" ;...
JRST ASCUPR ;NOPE, NO SWEAT
SUBI S2,"a"-"A" ;CONVERT TO UPPER CASE
DPB S2,S1 ;STORE IT BACK
JRST ASCUPR ;LOOP
SUBTTL A$NEXT - NEXT COMMAND PROCESSOR
A$NEXT:: MOVX S1,.OROBJ ;[NXT] GET THE OBJECT BLOCK TYPE
PUSHJ P,A$FNDB ;[NXT] FIND THE OBJECT BLOCK IN THE MSG
JUMPF BADMSG ;[NXT] NOT THERE,,TOO BAD !!!
$SAVE <P1,AP> ;[NXT] SAVE P1 AND AP
MOVE P1,S1 ;[NXT] SAVE THE OBJECT BLOCK ADDRESS
PUSHJ P,GETOBJ ;[1167] [NXT] FIND OR CREATE OBJ ENTRY
JUMPF DEVUNK ;[NXT] NOT THERE,,ACK THE OPR AND RETURN
MOVE P1,S1 ;[NXT] SAVE THE OBJECT ADDRESS
MOVX S1,.ORREQ ;[NXT] GET THE REQUEST ID BLOCK
PUSHJ P,A$FNDB ;[NXT] LOCATE IT IN THE MESSAGE
JUMPF BADMSG ;[NXT] NOT THERE,,THAS AN ERROR
MOVE S1,0(S1) ;[NXT] GET THE REQUEST ID
MOVE AP,S1 ;[NXT] SAVE IT HERE FOR A SECOND
PUSHJ P,A$FREQ ;[NXT] LOCATE THE REQUEST
JUMPF NEXT.2 ;[NXT] NOT THERE,,OH WELL...
MOVE AP,S1 ;[NXT] SAVE THE QE ADDRESS
MOVE S1,.QEROB+.ROBTY(AP) ;[NXT] GET THE REQUEST DEVICE TYPE
CAME S1,OBJTYP(P1) ;[NXT] THESE MUST MATCH !!!
JRST NEXT.3 ;[NXT] NO,,THATS AN ERROR
PUSHJ P,Q$CDEP## ;[NXT] MAKE SURE NO DEPENDIENCIES
JUMPF NEXT.4 ;[NXT] OH WELL,,WE TRIED !!!
MOVE S1,.QERID(AP) ;[NXT] GET THE REQUEST ID BACK
MOVEM S1,OBJRID(P1) ;[NXT] SAVE IT FOR THE SCHEDULER
DOSCHD ;[NXT] FORCE A SCHEDULING PASS
$ACK (<NEXT request #^D/S1/ scheduled>,,OBJTYP(P1),.MSCOD(M))
$RETT ;[NXT] RETURN
NEXT.2: $ACK (<NEXT request #^D/AP/ does not exist>,,,.MSCOD(M))
$RETT ;[NXT] RETURN
NEXT.3: $ACK (<Illegal device specified for NEXT request #^D/.QERID(AP)/>,,,.MSCOD(M))
$RETT ;[NXT] RETURN
NEXT.4: $ACK (<NEXT request #^D/.QERID(AP)/ is not schedulable>,,,.MSCOD(M))
$RETT ;[NXT] RETURN
SUBTTL A$OODB - Process a Object Type Data Message
;Call: M/Addr of message from ORION
A$OODB::LOAD S1,.MSTYP(M),MS.CNT ;GET MESSAGE SIZE
CAILE S1,.OHDRS ;IF TOO SMALL
CAILE S1,PAGSIZ ;OR TOO BIG
JRST BADMSG ;FORGET IT
ADD S1,M ;POINT TO END OF MESSAGE
PUSHJ P,.SAVE4 ;SAVE PRESERVED ACS
SETZB P3,AP ;P3 WILL GET OBJECT TYPE
;AP WILL GET SIZE OF DATA FOR ODB
MOVE P2,S1 ;SAVE END OF MESSAGE ADDR
MOVE P1,.OARGC(M) ;GET NUMBER OF ARG BLOCKS
CAIE P1,2 ;NEED 2, 1 FOR OBJ TYP, 1 FOR DATA
JRST BADMSG ;NOT ENOUGH
$CALL M%GPAG ;GET A SCRATCH PAGE
JUMPF BADMSG ;IF NO MEMORY, FORGET IT
MOVEI S2,.OHDRS(M) ;POINT TO FIRST BLOCK
$SAVE <H,AP> ;SAVE THESE TOO
SETZ H, ;ODB ARG COUNTER
;Loop thru message copying arg blocks to go into variable length ODB.
;S1 = address where to put data in scratch page, S2 = pointer into message
OODB.1: LOAD TF,ARG.HD(S2),AR.TYP ;GET ARG BLOCK TYPE
CAIE TF,.ORTYP ;OBJECT BLOCK TYPE?
JRST OODB.2 ;NO, GO COPY ARG BLOCK
;Process Object type arg block - save object type in P3
JUMPN P3,ODBERR ;ERROR IF OBJECT TYPE ALREADY FOUND
MOVE TF,ARG.DA(S2) ;GET OBJECT TYPE
CAILE TF,0 ;WITHIN RANGE?
CAILE TF,.OTMAX
JRST ODBERR ;NO, GO FREE MEMORY AND RETURN
MOVE P3,TF ;SAVE OBJECT TYPE
LOAD P4,ARG.HD(S2),AR.LEN ;GET LENGTH OF .ORTYP BLOCK
JRST OODB.3 ;GO LOOK FOR NEXT ARG BLOCK
;Process any other arg block - copy to scratch page
OODB.2: LOAD TF,ARG.HD(S2),AR.LEN ;GET ARGUMENT LENGTH
MOVE P4,TF ;SAVE IT
ADD TF,S2 ;COMPUTE END OF BLOCK
CAILE TF,(P2) ;WITHIN MESSAGE STILL?
JRST ODBERR ;NO, QUIT NOW
HRL TF,S2 ;GET SOURCE ADDRESS FOR BLT
HRR TF,S1 ;GET DESTINATION ADDRESS FOR BLT
ADD S1,P4 ;GET ENDING ADDRESS + 1 (NEXT FREE)
BLT TF,-1(S1) ;COPY ARG BLOCK
ADD AP,P4 ;COUNT UP WORDS NEEDED IN ODB
AOS H ;COUNT NUMBER OF ARGS COPIED
OODB.3: ADD S2,P4 ;POINT TO NEXT ARG BLOCK
SOJG P1,OODB.1 ;LOOP FOR ALL ARG BLOCKS
;Here when ready to copy scratch page data and object type into ODB.
JUMPE P3,ODBERR ;CAN'T DO ANYTHING WITHOUT OBJ TYPE
MOVE P1,S1 ;GET SCRATCH PAGE ADDR IN P1
TRZ P1,777 ;POINT TO START OF PAGE
MOVE P2,AP ;SAVE DATA SIZE
MOVE P4,H ;SAVE COUNT OF ARGS COPIED
MOVEI H,HDRODB## ;GET QUEUE HEADER ADDR, AP IS ALL SET
PUSHJ P,M$GFRE## ;GET ENTRY, SIZE IS ODBSIZ + (AP)
MOVEM P3,ODB.OT(AP) ;STORE OBJECT TYPE IN ODB
MOVEM P4,ODB.AC(AP) ;STORE ARG COUNT
HRL S1,P1 ;GET SOURCE ADDRESS FOR BLT
HRRI S1,ODB.DA(AP) ;GET DESTINATION ADDRESS FOR BLT
ADDI P2,ODB.DA-1(AP) ;COMPUTE ENDING ADDRESS FOR BLT
BLT S1,(P2) ;COPY DATA FROM SCRATCH PAGE TO ODB
MOVE S1,P3 ;GET OBJECT TYPE IN S1
LOAD S2,ODB.DA+ARG.HD(AP),AR.TYP ;GET ARG TYPE
PUSHJ P,FNDOAR ;SEE IF ODB EXISTS WITH SAME ARG TYPE
JUMPF OODB.4 ;IF ODB DOESN'T EXIST, SKIP OVER
PUSH P,AP ;SAVE AP
MOVE AP,S1 ;GET ODB ADDRESS
PUSHJ P,M$RFRE## ;DELINK AND RETURN MEMORY
POP P,AP ;GET POINTER TO NEW ODB BACK
OODB.4: PUSHJ P,M$ELNK## ;LINK ODB INTO QUEUE
MOVE S1,P1 ;GET SCRATCH PAGE ADDRESS
$CALL M%RPAG ;GIVE IT BACK TO GLXMEM
MOVE S1,P3 ;GET THE OBJECT TYPE
PUSHJ P,OBJNAM ;GET THE NAME STRING ASSOCIATED
PUSH P,S1 ;SAVE STRING ADDRESS
LOAD S1,ODB.DA+ARG.HD(AP),AR.TYP ;GET ARG TYPE
PUSHJ P,ARGNAM ;GET ARG NAME STRING ADDRESS
POP P,S2 ;GET OBJECT NAME STRING ADDR BACK
$ACK (<^T/(S1)/ defined for all ^T/(S2)/s>,,,.MSCOD(M))
;Look in PSB queue for processors that handle object type in P3.
$CALL M%GPAG ;GET A PAGE FOR PID STACK
PUSH P,S1 ;SAVE PAGE ADDRESS
ADD S1,[-100,,-1] ;SHOULD BE BIG ENOUGH STACK
PUSH S1,[-1] ;END OF STACK MARKER
MOVE S2,P3 ;GET OBJECT TYPE
PUSHJ P,STKPSB ;GET PIDS ON STACK FROM PSB QUEUE
;Send ODB messages to processors whose PIDs are on stack pointed to by S1.
MOVE P1,S1 ;GET STACK POINTER IN SAFE AC
OODB.5: POP P1,S2 ;GET POTENTIAL PID
CAMN S2,[-1] ;END OF STACK MARKER?
JRST OODB.6 ;YES, GO CLEAN UP
MOVE S1,AP ;GET ODB POINTER
PUSHJ P,SNDODB ;GO SEND MESSAGE TO PROCESSOR
JRST OODB.5 ;LOOP FOR NEXT PSB
OODB.6: POP P,S1 ;GET STACK PAGE ADDRESS BACK
$CALL M%RPAG ;LET IT GO
$RETT ;RETURN
ODBERR: TRZ S1,777 ;GET PAGE ADDRESS AGAIN
$CALL M%RPAG ;RETURN IT
JRST BADMSG ;COMPLAIN
SUBTTL OBJNAM - Find Object Name
;Call: S1/ object type (.OTxxx)
;
;Ret: S1/ address of ASCIZ object name
OBJNAM::CAILE S1,0 ;IN RANGE?
CAILE S1,.OTMAX
$RETF ;NO
PUSHJ P,.SAVE1 ;SAVE P1
MOVSI P1,-.OTMAX ;MAKE AOBJN POINTER
HRRI P1,ONMTAB ;GET OBJECT NAME TABLE
OBJN.1: MOVE S2,(P1) ;GET TABLE ENTRY
CAIE S1,(S2) ;OBJECT TYPES MATCH?
AOBJN P1,OBJN.1 ;NO, GOT TO BE THERE
HLRZ S1,S2 ;YES, GET ADDRESS OF ASCIZ STRING
$RETT ;RETURN
DEFINE X (TYP,TXT) <
XWD [ASCIZ\'TXT\],TYP
>
ONMTAB:: OBJCTS ;GENERATE TABLE (OBJCTS IN GLXMAC)
;ARGNAM - Find argument name string for ODB message ACKs.
;
;Call: S1/ arg type (.ORxxx) (must be in ARGTAB below.)
;Ret: TRUE S1/ string address or address of "Unknown"
ARGNAM: PUSHJ P,.SAVE1 ;SAVE P1
MOVEI P1,ARGTAB ;GET TABLE ADDRESS
ARGN.1: SKIPN S2,(P1) ;ANYTHING THERE
JRST ARGN.2 ;NO, NO MATCH FOUND
CAIE S1,(S2) ;ARG TYPES MATCH?
AOJA P1,ARGN.1 ;NO, LOOP
HLRZ S1,S2 ;YES, GET ARG NAME STRING ADDRESS
$RETT
ARGN.2: MOVEI S1,[ASCIZ\Unknown argument\] ;GET 'DUNNO' STRING
$RETT
ARGTAB: [ASCIZ\Default network PPN\],,.ORDPP
[ASCIZ\Rejection list\],,.ORREJ
0
SUBTTL FNDODB & FNDOAR & SNDODB
;FNDODB - Look for ODB for a specified object type
;
;Call: S1/ object type
;Ret: TRUE S1/ entry addr
; FALSE means none found
;
;NXTODB - Get next ODB in queue for a specified object type
;
;Call: S1/Address of current ODB
; S2/Object type
;Ret: TRUE S1/Address of next ODB with specified object type
; FALSE no more
FNDODB: $SAVE <H> ;SAVE H
MOVEI H,HDRODB## ;GET QUEUE HEADER FOR ODB
MOVE S2,S1 ;GET OBJECT TYPE IN S2
LOAD S1,.QHLNK(H),QH.PTF ;GET 1ST ENTRY ADDRESS
FNDO.1: JUMPE S1,.RETF ;IF EMPTY, NOT THERE
CAMN S2,ODB.OT(S1) ;OBJECT TYPES MATCH?
$RETT ;YES, RETURN TRUE
NXTODB: LOAD S1,.QELNK(S1),QE.PTN ;GET POINTER TO NEXT ODB
JRST FNDO.1 ;LOOP
;FNDOAR - Find ODB for a specified object type and arg type
;
;Call: S1/ abject type
; S2/ arg type
;Ret: TRUE S1/ODB address
; FALSE None found
FNDOAR: $SAVE <T1,T2> ;SAVE T1 & T2
DMOVE T1,S1 ;SAVE OBJECT AND ARG TYPES
PUSHJ P,FNDODB ;GET 1ST ODB FOR OBJECT TYPE
$RETIF ;RETURN IF NONE FOUND
FNDA.1: LOAD TF,ODB.DA+ARG.HD(S1),AR.TYP ;FOUND ODB, GET ARG TYPE
CAIN TF,(T2) ;ONE WE WANT?
$RETT ;RETURN WITH S1 POINTING TO ODB
MOVE S2,T1 ;GET OBJECT TYPE IN S2, S1 IS SETUP
PUSHJ P,NXTODB ;LOOK FOR NEXT ODB FOR OBJECT TYPE
JUMPT FNDA.1 ;CHECK ARG TYPES IF ODB FOUND
$RETF ;RETURN FALSE IF NONE FOUND
;SNDODB - Send ODB message to processor
;
;Call: S1/ ODB address
; S2/ processor PID
;Ret: TRUE always
SNDODB: $SAVE <P1> ;SAVE P1
MOVE P1,S1 ;COPY ODB ADDRESS
MOVEM S2,G$SAB##+SAB.PD ;PUT PID IN SAB
$CALL M%GPAG ;GET A PAGE OF FOR MESSAGE
MOVEM S1,G$SAB##+SAB.MS ;SAVE ADDRESS ON SAB
LOAD S2,.QEVSZ(P1),QE.VSZ ;GET SIZE OF DATA BLOCK IN ODB
ADDI S2,.OHDRS+ARG.SZ ;ADD IN HEADER PLUS 1 ARG BLOCK
STORE S2,.MSTYP(S1),MS.CNT ;SAVE IN MESSAGE
MOVEM S2,G$SAB##+SAB.LN ;IN SAB TOO
MOVX S2,.QOODB ;GET MESSAGE TYPE
STORE S2,.MSTYP(S1),MS.TYP ;SAVE IN MESSAGE
MOVE S2,ODB.AC(P1) ;GET ARG COUNT IN DATA
MOVEI S2,1(S2) ;ADD ONE FOR ARG BLOCK TO BUILD
MOVEM S2,.OARGC(S1) ;PUT IN MESSAGE HEADER
SETZM .MSFLG(S1) ;NO FLAGS
SETZM .OFLAG(S1)
MOVE S2,.MSCOD(M) ;GET AN OPR'S ACK CODE
MOVEM S2,.MSCOD(S1) ;LET SPOOLER TALK TO SOMEONE
MOVE S2,[2,,.ORTYP] ;OBJECT TYPE ARG BLOCK HEADER WORD
MOVEM S2,.OHDRS+ARG.HD(S1) ;STORE ARE 1ST ARG BLOCK HEADER
MOVE S2,ODB.OT(P1) ;GET OBJECT TYPE
MOVEM S2,.OHDRS+ARG.DA(S1) ;PUT OBJECT TYPE IN ARG BLOCK
HRLI TF,ODB.DA(P1) ;GET START OF DATA TO COPY
HRRI TF,.OHDRS+ARG.SZ(S1) ;GET WHERE TO COPY IT
LOAD S2,.MSTYP(S1),MS.CNT ;GET MESSAGE LENGTH
ADD S2,S1 ;POINT TO END+1
BLT TF,-1(S2) ;COPY TO END OF MESSAGE
SETZM G$SAB##+SAB.SI ;NO SPECIAL PID INDEX
MOVE P1,S1 ;SAVE PAGE ADDRESS
PUSHJ P,C$SEND## ;SEND IT OFF
MOVE S1,P1 ;GET IT BACK
$CALL M%RPAG ;GIVE PAGE BACK
$RETT
SUBTTL STKPSB - Stack PIDs of Processors for an Object
;STKPSB - Routine to stack the PIDs of processors that can handle
; a specfied object type.
;
;Call: S1/ stack pointer to PID stack
; S2/ object type
;
;Ret: TRUE always
STKPSB: $SAVE <P1,P2,P3> ;SAVE SOME ACS
LOAD P1,HDRPSB##+.QHLNK,QH.PTF ;GET 1ST PSB ADDRESS
STKP.1: JUMPE P1,.RETT ;RETURN WHEN NO MORE
LOAD P2,PSBFLG(P1),PSFNOT ;GET NUMBER OF OBJECTS PROCESSOR HANDLES
JUMPE P2,STKP.3 ;PARANOIA CHECK
MOVNS P2
HRLZS P2
HRRI P2,PSBOBJ(P1) ;BUILD AOBJN POINTER
STKP.2: LOAD P3,(P2),HELOBJ ;GET OBJECT TYPE
CAIN S2,(P3) ;OBJECT TYPES MATCH?
PUSH S1,PSBPID(P1) ;YES, PUT PID ON STACK
AOBJN P2,STKP.2 ;LOOP FOR ALL OBJECTS SUPPORTED
STKP.3: LOAD P1,.QELNK(P1),QE.PTN ;GET POINTER TO NEXT PSB
JRST STKP.1 ;CONTINUE
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.
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT IN THE SAB
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.
MOVX S1,PAGSIZ ;GET THE PAGE LENGTH
MOVEM S1,G$SAB##+SAB.LN ;SAVE IT IN THE SAB
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,G$SAB##+SAB.PD ;SAVE IT IN THE SAB
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$GPSB ;FIND A GENERIC PSB IN THE PSB CHAIN
INTERN A$LPSB ; " " " " " " " " "
INTERN A$FQNM ;FIND A QUEUE NAME ENTRY
INTERN A$FOBJ ;FIND AN OBJECT
INTERN A$CPOB ;COPY OVER AN OBJECT BLOCK
INTERN A$FREQ ;FIND A REQUEST VIA REQUEST ID
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 ; ""
SETZM S2 ;DON'T USE NAME
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 - Find a PSB given a PID or a processor name
;
; Call: S1/ PID or 0 or -1
; S2/ processor name or 0
; S1 can't be 0 or -1 when S2 is 0
;
; When S2 contains a name, S1 = 0 means find PSB that matches
; name and when S1 = -1, find PSB that matches name regardless
; of PID.
;
; Return TRUE S1/ PSB address
; FALSE S1/ 0
A$FPSB: $SAVE <T1> ;NEED AN AC
CAME S1,[EXP -1] ;CHECK ARGS
SKIPN S1
JUMPE S2,.RETF ;BAD ARGS, A LOSER
MOVE T1,S1 ;COPY PID ARG
MOVEI H,HDRPSB## ;ADDRESS OF PSB QUEUE HEADER
LOAD S1,.QHLNK(H),QH.PTF ;GET ADDRESS OF FIRST
FPSB.1: JUMPE S1,.RETF ;RETURN IF LAST ONE (OR NONE)
CAME T1,[EXP -1]
SKIPN T1
JRST FPSB.2 ;IF NO PID, CHECK NAME
CAMN T1,PSBPID(S1) ;PID MATCH?
$RETT ;YES, RETURN PSB ADDRESS IN S1
JRST FPSB.3 ;NO, GO TRY NEXT PSB
FPSB.2: CAME S2,PSBNAM(S1) ;NAME MATCH?
JRST FPSB.3 ;NO, GET NEXT PSB
JUMPL T1,.RETT ;YES, RETURN IF DON'T CARE ABOUT PID
SKIPN PSBPID(S1) ;WE DO CARE. PID THERE?
$RETT ;NO, RETURN WITH ADDRESS IN S1
FPSB.3: LOAD S1,.QELNK(S1),QE.PTN ;GET POINTER TO NEXT
JRST FPSB.1 ;AND LOOP
SUBTTL A$GPSB - ROUTINE TO FIND A PSB IN THE PSB CHAIN
; A$LPSB - " " " " " " " " " "
;CALL: S1/ The Object Type
; S2/ The Attributes
;
;RET: S1/ The PSB Address
A$LPSB: TDZA TF,TF ;FLAG 'LPSB' ENTRY POINT
A$GPSB: SETOM TF ;FLAG 'GPSB' ENTRY POINT
PUSHJ P,.SAVE3 ;SAVE P1 - P3
DMOVE P1,S1 ;SAVE THE OBJECT TYPE AND ATTRIBUTES
MOVE P3,TF ;SAVE THE ENTRY POINT INDICATOR
LOAD S1,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY
SKIPA ;SKIP OVER THE LOAD NEXT PSB
GPSB.1: LOAD S1,.QELNK(S1),QE.PTN ;GET THE NEXT PSB IN THE CHAIN
JUMPE S1,.RETF ;NOT FOUND,,RETURN
LOAD S2,PSBFLG(S1),PSFSTS ;GET PSB STATUS
CAXE S2,PS.RUN ;PROCESSOR "RUNNING"?
JRST GPSB.1 ;NO, TRY NEXT
LOAD S2,PSBFLG(S1),PSFNOT ;GET THE OBJECT COUNT
MOVNS S2 ;NEGATE IT
MOVSS S2 ;MOVE RIGHT TO LEFT
HRRI S2,PSBOBJ(S1) ;CREATE OBJECT SEARCH AC
LOAD TF,0(S2),HELOBJ ;GET THE OBJECT TYPE
CAME TF,P1 ;DO WE MATCH ???
GPSB.2: AOBJN S2,.-2 ;NO,,TRY NEXT
JUMPGE S2,GPSB.1 ;NO MATCH,,TRY NEXT PSB
LOAD TF,0(S2),HELATR ;GET THE OBJECT ATTRIBUTES
CAME TF,P2 ;DO THEY MATCH ???
JRST GPSB.2 ;NO,,TRY NEXT OBJECT
JUMPE P3,.RETT ;NO SETUP CHECK,,RETURN
LOAD TF,PSBLIM(S1),PSLCUR ;GET THE CURRENT SETUP COUNT
LOAD S2,PSBLIM(S1),PSLMAX ;GET THE MAX SETUP COUNT
CAML TF,S2 ;ALL USED UP ???
JRST GPSB.1 ;YES,,TRY NEXT PSB
$RETT ;NO,,RETURN THIS PSB
SUBTTL A$WPSB - Find/Create a "waiting" PSB for an object
;A$WPSB - This routine will find a PSB in the PSB queue that is already
; "waiting" for the object processor to be "fired up" or say "hello".
; If a PSB is not found, one is created with a PS.FIR (to be
; "fired up") status.
;
; Call: S1/ address of object's CJB
;
; Return: TRUE "waiting" PSB was found
; FALSE to be "fired up" PSB was created
;
; Either return:
; S1/ address of CJB passed in call
; S2/ address of PSB
A$WPSB::LOAD S2,HDRPSB##+.QHLNK,QH.PTF ;GET ADDRESS OF FIRST PSB
WPSB.1: JUMPE S2,WPSB.3 ;IF NONE, GO START ONE
MOVE TF,CJB.NM(S1) ;GET PROCESSOR NAME
CAME TF,PSBNAM(S2) ;NAMES MATCH?
JRST WPSB.2 ;NO, GO LOOK AT NEXT PSB
LOAD TF,PSBFLG(S2),PSFSTS ;YES, GET PROCESSOR'S STATUS
CAXE TF,PS.WAT ;FIRE UP IN PROGRESS?
CAXN TF,PS.KSY ;OR WAITING FOR BATCON AT KSYS?
$RETT ;YES, GOT WHAT WE WANT
CAXN TF,PS.FIR ;NEEDS TO BE "FIRED UP"?
$RETT ;YES, ANOTHER WINNER
WPSB.2: LOAD S2,.QELNK(S2),QE.PTN ;MUST BE RUNNING
JRST WPSB.1 ;LOOP
;Here to create a PSB and set it up so processor is fired up
WPSB.3: PUSH P,S1 ;SAVE CJB ADDRESS
SETZB S1,S2 ;CLEAR S1 AND S2
PUSHJ P,GETPSB ;GET A NEW PSB FOR US
MOVE S2,S1 ;GET PSB ADDRESS IN S2
POP P,S1 ;GET CJB ADDRESS BACK IN S1
MOVE TF,CJB.NM(S1) ;GET PROCESSOR NAME
MOVEM TF,PSBNAM(S2) ;PUT PROCESSOR NAME IN PSB
MOVX TF,PS.FIR ;SET NEEDS TO BE FIRED UP STATUS
STORE TF,PSBFLG(S2),PSFSTS
$RETF ;DONE
SUBTTL A$APSB - Adjust PSB Object/Attribute parameters
; Call: MOVE S1, [attrributes,,object-type]
; MOVE S2, PSB address
; PUSHJ P,A$APSB
A$APSB::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;COPY ARGUMENTS
LOAD S1,PSBFLG(P2),PSFNOT ;GET THE OBJECT COUNT
MOVNS S1 ;NEGATE
MOVSS S1 ;PUT IN LH
HRRI S1,PSBOBJ(P3) ;MAKE AN AOBJN POINTER
CAME P1,(S1) ;MATCH?
AOBJN S1,.-1 ;NO--TRY THE NEXT
JUMPL S1,.RETT ;RETURN IF FOUND
LOAD S2,PSBFLG(P2),PSFNOT ;GET OBJECT COUNT AGAIN
ADDI S2,1 ;GOING TO ADD ANOTHER OBJECT/ATTRIB
CAIL S2,OBPRSZ ;TOO MANY?
JRST APSB.1 ;YES
STORE S2,PSBFLG(P2),PSFNOT ;UPDATE COUNT
MOVEM P1,(S1) ;SAVE NEW OBJECT/ATTRIBUTE COMBINATION
$RETT ;AND RETURN
APSB.1: $WTO (<Object/Attribute count exceeded>,<^I/APSB.2/>,OBJTYP(P1))
$RETF ;RETURN
APSB.2: ITEXT (<Program: ^W6L /PSBNAM(P1)/ PID: ^12R0/PSBPID(P1)/>)
SUBTTL A$FRMC - Send a forms change request
;CALL: S1/ The object block address
A$FRMC:: PUSHJ P,.SAVE1 ;Save p1
MOVE P1,S1 ;Save the object address
SKIPN S1,OBJPID(P1) ;Get the processors pid
$RETT ;None,,return
MOVEM S1,G$SAB##+SAB.PD ;Save it
MOVX S1,.OHDRS+OBJ.SZ+1 ;Get the message length
MOVEM S1,G$SAB##+SAB.LN ;Save it
STORE S1,G$MSG##+.MSTYP,MS.CNT ;Here also
MOVX S1,.QOFCH ;Get the message type
STORE S1,G$MSG##+.MSTYP,MS.TYP ;Save it
SETZM G$MSG##+.MSCOD ;No ack code
SETZM G$MSG##+.MSFLG ;No flags yet
MOVEI S1,1 ;Get 1 block count
MOVEM S1,G$MSG##+.OARGC ;Save it
MOVE S1,OBJPRM+.OOFRM(P1) ;Get the forms type
MOVEM S1,G$MSG##+.OFLAG ;Save it
MOVE S1,[OBJ.SZ,,.OROBJ] ;Get the object block header
MOVEM S1,G$MSG##+.OHDRS+ARG.HD ;Save it
MOVEI S1,G$MSG##+.OHDRS+ARG.DA ;Get object block data address
HRLI S1,OBJTYP(P1) ;Get source obj blk address
BLT S1,G$MSG##+.OHDRS+ARG.DA+OBJ.SZ-1 ;Copy the obj blk over
MOVEI S1,G$MSG## ;Get the message address
MOVEM S1,G$SAB##+SAB.MS ;Save it
SETZM G$SAB##+SAB.SI ;No special pid index
PUSHJ P,C$SEND## ;Send the message off
JUMPF .RETT ;Failed,,return
MOVX S1,OBSFCH ;[1163] Get the 'forms change' bit
IORM S1,OBJSCH(P1) ;lite it
MOVX S1,OBSFRM ;Get forms change flag
ANDCAM S1,OBJSCH(P1) ;Clear them
MOVE S1,P1 ;Get the object address
PUSHJ P,A$OBST ;Update the status
$RETT ;Return
SUBTTL A$FOBJ -- Find an entry in the object queue
;CALL: S1/ An Object Block Address
;
;RET: S1/ The address that object queue entry or false
A$FOBJ: PUSHJ P,.SAVET ;SAVE THE 'T' ACS
MOVE T1,OBJ.TY(S1) ;GET THE MODEL OBJECT TYPE
MOVE T2,OBJ.UN(S1) ;GET THE MODEL OBJECT UNIT
MOVE T3,OBJ.ND(S1) ;GET THE MODEL OBJECT NODE
LOAD T4,HDROBJ##+.QHLNK,QH.PTF ;GET THE FIRST OBJECT ENTRY
SKIPA ;SKIP THE FIRST TIME THROUGH
FOBJ.1: LOAD T4,.QELNK(T4),QE.PTN ;GET THE NEXT OBJECT ENTRY ADDRESS
JUMPE T4,.RETF ;IF NO ENTRIES OR END, RETURN
CAMN T1,OBJTYP(T4) ;DO OBJECT TYPES MATCH ???
CAME T2,OBJUNI(T4) ;DO OBJECT UNITS MATCH ???
JRST FOBJ.1 ;NO TO EITHER,,TRY NEXT OBJECT
MOVE S1,T3 ;GET THE MODEL OBJECT NODE NAME/NUMBER
MOVE S2,OBJNOD(T4) ;GET THE SOURCE OBJECT NODE NAME/NUMBER
PUSHJ P,N$MTCH## ;DO THEY MATCH ???
JUMPF FOBJ.1 ;NO,,TRY NEXT OBJECT IN THE QUEUE
MOVE S1,T4 ;GET THE OBJECT QUEUE ENTRY ADDRESS
$RETT ;AND RETURN
SUBTTL A$FQNM -- Find a queue name entry
;CALL: S1/ Pointer to a queue name
;
;RET: S1/ The entry address if found, false otherwise
A$FQNM: $SAVE <AP,P1> ;GRAB A FEW FREE AC'S
HRLI S1,(POINT 8) ;SET BYTE POINTER FOR 8-BIT ASCII
MOVE P1,S1 ;COPY THE NAME POINTER
LOAD AP,HDRQNM##+.QHLNK,QH.PTF ;GET POINTER TO FIRST QUE NAME ENTRY
FQNM.1: JUMPE AP,.RETF ;RETURN FALSE IF END OF NAMES
MOVE S1,P1 ;GET POINTER TO BASE STRING
MOVEI S2,QNM.QN(AP) ;GET ADDRESS OF TEST STRING
HRLI S2,(POINT 8) ;IT'S 8-BIT ASCII
PUSHJ P,S%SCMP ;COMPARE THE STRINGS
JUMPN S1,FQNM.2 ;ONLY ACCEPT EXACT MATCH
MOVE S1,AP ;COPY THE ENTRY ADDRESS
$RETT ;TRUE RETURN
FQNM.2: LOAD AP,.QELNK(AP),QE.PTN ;GET POINTER TO NEXT ENTRY
JRST FQNM.1 ;LOOP
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
HRLZ P1,S1 ;GET THE SOURCE OBJECT BLOCK ADDRESS
HRR P1,S2 ;GET THE DESTINATION OBJECT BLOCK ADD.
BLT P1,OBJ.SZ-1(S2) ;MOVE THE OBJECT BLOCK
$RETT ;AND RETURN
SUBTTL A$FREQ - ROUTINE TO FIND A REQUEST IN ANY QUEUE VIA REQUEST ID
;CALL: S1/ The Request ID
;
;RET: S1/ The .QE Address if Found, False Otherwise
A$FREQ: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,S1 ;SAVE THE REQUEST ID
HRLZI P2,-NOBJS ;CREATE AOBJN SEARCH AC
FREQ.1: MOVE S1,PROQUE(P2) ;GET A PROCESSING QUEUE HDR ADDRESS
LOAD S1,.QHLNK(S1),QH.PTF ;GET THE FIRST QUEUE ENTRY
FREQ.2: JUMPE S1,FREQ.3 ;NO MORE,,TRY NEXT QUEUE
CAMN P1,.QERID(S1) ;IS THIS THE REQUEST WE WANT ???
$RETT ;YES,,RETURN
LOAD S1,.QELNK(S1),QE.PTN ;GET THE NEXT QUEUE ENTRY
JUMPN S1,FREQ.2 ;AND GO CHECK IT OUT
FREQ.3: AOBJN P2,FREQ.1 ;NOT IN THIS QUEUE,,TRY NEXT
$RETF ;REQUEST IS NOT IN THE SYSTEM !!!
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,PROQUE(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
PROQUE: 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
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 !!!!
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
TXC S2,OBSBUS+OBSSTP ;ARE WE ACTIVE & STOPPED ???
TXNN S2,OBSBUS+OBSSTP ;LETS CHECK !!!
MOVX S1,%STPPN ;YES,,THEN STOPPED PENDING
TXNE S2,OBSSEJ ;IS IT SHUT DOWN AT END OF JOB ???
MOVX S1,%SHUTD ;YES,,GET 'SHUTTING DOWN' CODE
TXNE S2,OBSFCH ;[1166] CHANGING FORMS?
MOVX S1,%FRMCH ;[1163] YES,,GET 'CHANGING FORMS' STATUS
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,.SAVE2 ;SAVE P1 & P2
LOAD P2,.MSTYP(M),MS.CNT ;GET MESSAGE SIZE
CAIGE P2,STU.SZ ;AT LEAST MINIMUM LENGTH?
PJRST E$MTS## ;NO
PUSHJ P,A$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 !!
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 [DOSCHD ;FORCE A SCHEDULING PASS
MOVX S2,OBSSTP!OBSFCH;[1163] YES,,GET 'STOPPED' AND 'CHANGING FORMS' STATUS
ANDCAM S2,OBJSCH(S1) ;CLEAR THEM
PJRST A$OBST ] ;GO UPDATE THE STATUS
STORE P1,OBJSTS(S1) ;NO,,SAVE THE NEW DEVICE STATUS
CAIG P2,STU.SZ ;DOES MESSAGE INCLUDE OPTIONAL DATA?
$RETT ;NO, ALL DONE
MOVE S2,OBJSCH(S1) ;GET SCHEDULING BITS
CAIN P1,%IDLE ;IDLE?
TXZA S2,OBSBUS ;YES, CLEAR BUSY
TXO S2,OBSBUS ;NO, SET BUSY
MOVEM S2,OBJSCH(S1) ;PUT BITS BACK
HRLI S2,STU.PR(M) ;COPY PARM WORDS
HRRI S2,OBJPRM(S1) ;FROM MESSAGE TO OBJ BLOCK
BLT S2,OBJPRM+OBPRSZ-1(S1)
HRLI S2,STU.ST(M) ;COPY STATUS STRING FROM MESSAGE
HRRI S2,OBJST1(S1) ;TO OBJ BLOCK
BLT S2,OBJST1+STSSIZ-1(S1)
$RETT ;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 TF,.MSTYP(M),MS.CNT ;GET THE MSG LENGTH
ADD TF,M ;GET END ADDRESS
CAMLE S1,TF ;VALIDATE THE ENTRY ADDRESS
$RETF ;NO GOOD...
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
JUMPE T2,.RETF ;VALIDATE THE ENTRY 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 - Find a PSB using PID or processor name
;
;This routine will first search by PID. If PSB found, its address
;is returned. If S1 zero or PID not found, a search is done using name
;in S2 if nonzero. If still not found or both S1 and S2 are zero,
;a PSB is created and address is returned in S1. A PSB address is
;always returned. A$FPSB does the searching.
;
; Call: S1/ PID or zero
; S2/ Processor name or zero
; Return: TRUE S1/ PSB address
; FALSE never
GETPSB::JUMPE S1,GETP.0 ;JUMP IF NO PID
PUSH P,S2 ;SAVE POSSIBLE NAME
SETZM S2 ;USE PID
PUSHJ P,A$FPSB ;FIND KNOWN PID
POP P,S2 ;GET POSSIBLE NAME BACK
JUMPN S1,.RETT ;FOUND IT
GETP.0: JUMPE S2,GETP.1 ;JUMP IF NOT FOUND AND NO NAME
;OR JUST WANT A PSB
PUSHJ P,A$FPSB ;FIND PSB USING NAME
JUMPN S1,.RETT ;JUMP IF FOUND, ELSE...
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
MOVE S2,OBJSCH(P1) ;GET THE SCHEDULER FLAG BITS
TXZ S2,OBSDAA ;FOGET WE KNOW ATTRIBUTES
MOVE TF,OBJTYP(P1) ;GET OBJECT TYPE
CAXN TF,.OTNQC ;DON'T FOOL WITH NEBULA'S OBJ ATTRIBS
JRST KILP1A
LOAD S1,OBJDAT(P1),RO.ATR ;GET ATTRIBUTES
HRL S1,TF ;GET OBJECT TYPE
CAMN S1,[.OTBAT,,%IBMBT] ;IBMSPL STREAM OBJECT BLOCK?
JRST KILP1A ;YES, DO NOT RESET THE ATTRIBUTE
MOVX S1,%GENRC ;GET GENERIC ATTRIBUTES
STORE S1,OBJDAT(P1),RO.ATR ;YES,,RESET THEM
TXZ S2,OBSATR ;REMEMBER THE FACT
KILP1A: MOVEM S2,OBJSCH(P1) ; AND SAVE THE FLAG BITS
TXZN S2,OBSSIP ;SETUP-IN-PROGRESS?
JRST KILP.2 ;NO,,TRY SOMETHING ELSE
MOVEM S2,OBJSCH(P1) ;SAVE THE FLAG BITS
JRST KILP.5 ;AND LOOP FOR NEXT OBJECT
KILP.2: TXZN S2,OBSSUP ;WAS OBJECT SETUP ???
JRST KILP.5 ;NO,,GET NEXT OBJECT
MOVEM S2,OBJSCH(P1) ;SAVE THE NEW FLAG BITS
;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),OBSFRR ;GET THE FREE RUNNING BIT.
JUMPN S1,KILP.7 ;IF OBJ IS FREE RUNNING,,RLSE INT-LCKS
LOAD S1,OBJSCH(P1),OBSBUS ;IS IT BUSY?
JUMPE S1,KILP.5 ;NO, ON TO THE NEXT OBJECT
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVEI H,HDRUSE## ;LOAD USE QUEUE HEADER
LOAD AP,.QHLNK(H),QH.PTF ;POINT TO FIRST ENTRY
KILP.3: SKIPN AP ;ANY LEFT?
STOPCD (IJM,HALT,,<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
STOPCD (IJW,HALT,,<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),HELOBJ/(^1/PSBOBJ(P2),HELOBJ/)>,,<$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
;Here for 'Free Running' Processors
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 A$PSBC - Check on "waiting" PSBs
;A$PSBC - Look in PSB queue and check on "waiting" PSBs. If PS.FIR
; set, try to "fire it up". Check PSBUDT if PS.WAT set. Issue
; WTO if we're finally giving up on an object processor.
;
; Call: No args.
; Return: True always
A$PSBC::SKIPE DEBUGW ;DEBUGGING?
$RETT ;YES, SAVE SOME TIME
$SAVE <H,AP,P1> ;USE THESE IN CASE M$RFRE CALLED
MOVE P1,[EXP 377777777777] ;GET BIG UDT
LOAD AP,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST ENTRY
TRNA
PSBC.1: LOAD AP,.QELNK(AP),QE.PTN ;GET THE NEXT PSB IN THE CHAIN
JUMPE AP,PSBC.6 ;NOT FOUND, GO CHECK UDT
LOAD S1,PSBFLG(AP),PSFSTS ;GET PSB STATUS
CAXN S1,PS.RUN ;"RUNNING"?
JRST PSBC.1 ;YES, LOOP FOR MORE
CAXN S1,PS.FIR ;NO, NEED TO BE "FIRED"?
JRST PSBC.3 ;YES, GO DO IT
CAXE S1,PS.WAT ;"WAITING"
CAXN S1,PS.KSY ;OR SPECIAL BATCON "WAITING"
TRNA ;"WAITING" EITHER WAY
JRST PSBC.1 ;NO, LOOK AT NEXT PSB
;Here when PSB is "waiting" check UDT and see if we need to try and
;"fire" it again.
MOVE S1,PSBUDT(AP) ;GET UDT WE WAIT UNTIL
CAMGE S1,G$NOW## ;EXPIRED?
JRST PSBC.2 ;YES, GO COMPLAIN
CAMGE S1,P1 ;NO, NEXT IN LINE TO EXPIRE?
MOVE P1,S1 ;YES, SAVE THE UDT
JRST PSBC.1 ;LOOK AT NEXT PSB
PSBC.2: $WTO (<^W/PSBNAM(AP)/ failed to startup>,,,$WTFLG(WT.SJI))
LOAD S1,PSBFLG(AP),PSFSTS ;GET STATUS AGAIN
CAXN S1,PS.KSY ;WAITING FOR A KSYS BATCON?
$WTO (<Use OPSER for KSYS logouts since BATCON didn't start>,,,$WTFLG(WT.SJI))
JRST PSBC.5 ;GO GET RID OF THE PSB
;Here to "fire up" an object processor
PSBC.3: MOVE S1,PSBNAM(AP) ;GET PROCESSOR NAME
PUSHJ P,I$FCJB## ;GO FIND CJB FOR PROCESSOR
JUMPF PSBC.5 ;IF NOT THERE, RELEASE PSB ????
HRLS S1 ;COPY PROCESSOR'S CJB TO OURS
HRRI S1,QSRCJB##
BLT S1,QSRCJB##+CJB.SZ-1
MOVEI S1,QSRCJB## ;GET CJB ADDRESS IN S1 FOR I%CJOB CALL
MOVEI S2,^D60 ;WAIT 1 MINUTE FOR FRCLIN IF NEEDED
STORE S2,CJB.TP(S1),CJ.TIM ;STORE IN CJB
$CALL I%CJOB ;"FIRE" AWAY
JUMPF PSBC.4 ;JUMP IF MISFIRE
MOVX S1,PS.WAT ;GET "WAITING" STATUS
STORE S1,PSBFLG(AP),PSFSTS ;SET IN PSB
$CALL I%NOW ;GET UDT
ADD S1,[EXP ^D60*^D3] ;MAKE ONE MINUTE FROM NOW
MOVEM S1,PSBUDT(AP) ;STORE IN PSB
CAMGE S1,P1 ;NEXT IN LINE TO EXPIRE?
MOVE P1,S1 ;YES, SAVE THE UDT
JRST PSBC.1 ;GET NEXT PSB
;Here to check retry count on "misfire". S1 = error from I%CJOB
PSBC.4: LOAD S2,PSBFLG(AP),PSFCNT ;GET "FILE UP" TRY MAXIMUM
SOJG S2,[STORE S2,PSBFLG(AP),PSFCNT ;SAVE NEW COUNT
JRST PSBC.1] ;LOOP FOR MORE PSB'S
$WTO (<Retry count exhausted trying to start ^W/PSBNAM(AP)/>,<Last error: ^E/S1/>,,$WTFLG(WT.SJI))
;Here to release the PSB from PSB queue
PSBC.5: MOVEI H,HDRPSB## ;GET QUEUE HEADER ADDRESS
PUSHJ P,M$RFRE## ;AND RETURN PSB TO FREE SPACE
JRST PSBC.1 ;LOOK AT NEXT PSB
;Here to set next wake up time
PSBC.6: AOJL P1,.RETT ;IF NO UDT FROM HERE, RETURN
SKIPN S1,G$WTIM## ;GET NEXT WAKEUP TIME
JRST [MOVEM P1,G$WTIM## ;NONE, SET IT
$RETT] ;RETURN
CAMGE P1,S1 ;OUR TIME EARLIER?
MOVEM P1,G$WTIM## ;YES, OVERRIDE PREVIOUS TIME
$RETT ;ALL DONE
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
SKIPE S1 ;DON'T STORE A ZERO
MOVEM S1,OBJ.ND(P1) ;STORE NODE NUMBER
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
TXNE S1,QH.OAV ;OBJECT ALWAYS VISIBLE?
ANDCAM S2,OBJSCH(AP) ;THEN IGNORE QH.INV SETTING
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
MOVX S1,%GENRC ;GET 'GENRIC' ATTRIBUTES
MOVE TF,OBJTYP(AP) ;[1466] GET OBJECT TYPE
LOAD S2,NETSTS(P2),NT.MOD ;[1466] GET THE MODE OF THE NODE
CAXN S2,DF.EMU ;[1466] IS IT EMULATION ???
CAXE TF,.OTBAT ;[1466] AND IS THE OBJECT TYPE BATCH ???
TRNA ;[1466] NOT EMULATION or NOT EMULATION+BATCH !!!
MOVX S1,%IBMBT ;[1466] GET IBM BATCH ATTRIBUTE
STORE S1,OBJDAT(AP),RO.ATR ;AND STORE THEM
MOVX S1,%NSTRT ;GET 'NOT STARTED'
MOVEM S1,OBJSTS(AP) ;SET IT
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.3 ;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.
MOVEI S2,10 ;ASSUME NORMAL DEVICE LIMITATIONS
CAIN S1,.OTNQC ;NET QUE CTL?
MOVEI S2,1000 ;DIFFERENT LIMIT
LOAD S1,OBJ.UN(P1) ;GET THE UNIT NUMBER
CAIGE S1,(S2) ;MORE THAN MAX?
$RETT ;NO,,THEN RETURN TRUE.
$ACK (<Invalid unit number specified>,,0(P1),.MSCOD(M)) ;TELL OPR
$RETF ;RETURN FALSE.
CHKO.1: LOAD S1,OBJ.UN(P1) ;GET THE UNIT NUMBER.
CAIGE S1,INPMAX ;MORE THAN INPMAX STREAMS?
JRST CHKO.2 ;NO
$ACK (<Invalid stream number specified>,,0(P1),.MSCOD(M)) ;TELL OPR
$RETF ;AND RETURN
CHKO.2: SOSL G$NBAT## ;SUBTRACT 1 FROM MAX BATCH COUNT.
$RETT ;OK,,RETURN.
$ACK (<Batch stream maximum exceeded>,,0(P1),.MSCOD(M)) ;TELL OPR
SETZM G$NBAT## ;RESET THE COUNT TO 0.
$RETF ;RETURN.
CHKO.3: $ACK (<Device invalid for Emulation>,,0(P1),.MSCOD(M)) ;TELL OPR
$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
CAMLE TF,S1 ;ARE WE STILL IN THE MESSAGE ???
SOJG P1,FNDB.1 ;CONTINUE TILL DONE
$RETF ;BLOCK 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 RDB ADDRESS
SETZM TMPMSG ;ZAP THE FIRST WORD
MOVE S1,[TMPMSG,,TMPMSG+1] ;GET SOURCE,,DESTINATION
BLT S1,TMPMSG+MOD.SZ+3-1 ;ZERO THE TEMP OPR MSG
MOVE S1,.MSCOD(M) ;GET THE OPR ACK CODE
MOVEM S1,TMPMSG+.MSCOD ;SAVE IT IN THE TEMP MSG
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
MOVEM S1,TMPMSG+MSHSIZ ;SAVE IT IN THE MSG
MOVE S1,RDBPRM+2 ;GET THE USERS ENTRY ADDRESS
MOVE 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