Trailing-Edge
-
PDP-10 Archives
-
BB-H138E-BM
-
galaxy-sources/qsradm.mac
There are 45 other files named qsradm.mac in the archive. Click here to see a list.
TITLE QSRADM -- System Administrative and Operator Functions
SUBTTL Preliminaries
;
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
; 1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
; 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
ADMMAN==:2 ;Maintenance edit number
ADMDEV==:16 ;Development edit number
VERSIN (ADM) ;Generate edit number
QSRED1==:GMCEDT+OMCEDT+QMCEDT+ADMEDT ;Sub total versions due to macro
SUBTTL Table of Contents
; Table of Contents for QSRADM
;
;
; Section Page
; 1. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision history . . . . . . . . . . . . . . . . . . . 3
; 4. Module Storage and Constants . . . . . . . . . . . . . 4
; 5. OBJECT TABLE AND MISC STORAGE. . . . . . . . . . . . . 5
; 6. Initialization Entry . . . . . . . . . . . . . . . . . 6
; 7. Administrative Message Handlers. . . . . . . . . . . . 7
; 8. HELLO
; 8.1. Function 1. . . . . . . . . . . . . . . . . . 8
; 9. COUNT
; 9.1. Function 20 . . . . . . . . . . . . . . . . . 10
; 10. Operator Messages. . . . . . . . . . . . . . . . . . . 11
; 11. A$AGE
; 11.1. Routine to compare two times in internal format 12
; 12. A$AFT
; 12.1. Routine to modify an internal time. . . . . . 13
; 13. I$WHEEL
; 13.1. Determine whether sender of current message is privileged 14
; 14. A$OSTA / A$ISTA
; 14.1. Startup an object . . . . . . . . . . . . . . 15
; 15. A$STND - START NODE MESSAGE PROCESSOR. . . . . . . . . 16
; 16. A$OSHT
; 16.1. Shutdown an object. . . . . . . . . . . . . . 17
; 17. SHUTNODE - ROUTINE TO SHUTDOWN AN ENTIRE NODE. . . . . 18
; 18. A$OSET
; 18.1. Set parameters for an object. . . . . . . . . 19
; 19. NETSET - 'SET NODE' PROCESSING ROUTINE . . . . . . . . 21
; 20. A$MODIFY - ROUTINE TO SET THE JOBS PRIORTY . . . . . . 22
; 21. A$ENABLE - ROUTINE TO ENABLE QUEUE ENTRY CREATE'S. . . 23
; 22. A$DISABLE - ROUTINE TO DISABLE QUEUE ENTRY CREATE'S. . 23
; 23. A$OREQ - Operator REQUEUE Request. . . . . . . . . . . 24
; 24. COMMMM - OPERATOR REQUEST COMMON PROCESSING ROUTINE. . 25
; 25. OPERATOR COMMAND PROCESSING ROUTINES.. . . . . . . . . 26
; 26. A$OPAU - STOP OPERATOR MESSAGE PROCESSOR . . . . . . . 27
; 27. A$OREL, A$OHLD - RELEASE/HOLD OPERATOR MESSAGES. . . . 28
; 28. A$ODEL - ROUTINE TO REMOVE JOBS FROM THE SYSTEM QUEUES 29
; 29. A$ORTE - ROUTINE TO PROCESS OPERATOR ROUTE COMMAND.. . 30
; 30. A$DEFINE - Routine to process the 'DEFINE' network command 31
; 31. A$DN60 - ROUTINE TO SEND A OPERATOR RESPONSE TO LPTSPL 32
; 32. A$NEXT - NEXT COMMAND PROCESSOR. . . . . . . . . . . . 33
; 33. SNDOAC
; 33.1. Send an Operator Action Message. . . . . . . 34
; 34. Global Routines. . . . . . . . . . . . . . . . . . . . 35
; 35. A$KLPD
; 35.1. Routine to kill a PSB given its PID . . . . . 36
; 36. A$FPSB
; 36.1. Subroutine to find a PSB. . . . . . . . . . . 37
; 37. A$GPSB - ROUTINE TO FIND A PSB IN THE PSB CHAIN. . . . 38
; 38. A$FRMC - Send a forms change request . . . . . . . . . 39
; 39. A$FOBJ
; 39.1. Find an entry in the object queue . . . . . . 40
; 40. A$CPOB
; 40.1. Copy an object block. . . . . . . . . . . . . 41
; 41. A$FREQ - ROUTINE TO FIND A REQUEST IN ANY QUEUE VIA REQUEST ID 42
; 42. A$OB2Q
; 42.1. Convert object type to queue header . . . . . 43
; 43. A$OBST
; 43.1. Update Object Status. . . . . . . . . . . . . 44
; 44. A$STATUS - UPDATE THE DEVICE STATUS. . . . . . . . . . 45
; 45. A$GBLK - ROUTINE TO BREAK DOWN IPCF MESSAGES . . . . . 46
; 46. Utility Routines . . . . . . . . . . . . . . . . . . . 47
; 47. GETPSB
; 47.1. Routine to get a PSB. . . . . . . . . . . . . 48
; 48. KILPSB
; 48.1. Routine to kill a PSB given its address . . . 49
; 49. GETOBJ
; 49.1. Find or create an OBJ queue entry . . . . . . 51
; 50. CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCK REQUESTS.. . 53
; 51. FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIED NODE 54
; 52. A$FNDB - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE. 55
; 53. GENRDB - ROUTINE TO CREATE AN RDB FOR HOLD/RELEASE/SET JOB PRIO 56
; 54. PRMTAB - OBJECT INITIAL PARAMETERS TABLE.. . . . . . . 57
; 55. ORANGE
; 55.1. Handle a range of objects . . . . . . . . . . 58
SUBTTL Revision history
COMMENT \
***** Release 4.2 -- begin maintenance edits *****
2 4.2.1613 17-Apr-85
Lite the OBSIBM bit in the scheduling word of an object if the object
is part of an IBM node.
***** Release 5.0 -- begin development edits *****
10 5.1003 7-Jan-83
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
11 5.1001 25-Feb-83
Set S1 to a legit value before jumping to SNDOPR in A$DN60.
12 5.1137 20-Apr-84
Subtotal QUASAR edit number as QSRED1.
13 5.1162 21-Sep-84
Add support for SNA Workstations.
14 5.1160 26-Sept-84
In routine CHKO.1, change the CAIGE to CAIG so that it will check the
highest number of batch stream on a system.
15 5.1172 22-Oct-84
When a node is defined, always call N$NNET to purge any existing entry.
16 5.1182 30-Nov-84
In A$HELLO first determine if a PSB is restarting before checking if it
is MOUNTR. Also, upon MOUNTR restart delete only tape mount requests, keep the
structure mount requests.
\ ;End of Revision History
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.
BADMSG: $ACK (Orion Message Error,Invalid Object Block Specified,,.MSCOD(M))
$RETF
DEVUNK: $ACK (Device Unknown,,0(P1),.MSCOD(M))
$RETT
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
INIT.1: MOVX S1,SP.OPR ;GET ORION'S PID INDEX
PUSHJ P,C%RPRM ;GET ORION'S PID
JUMPF [MOVEI S1,1 ;NOT THERE YET,,THEN
PUSHJ P,I%SLP ; SLEEP 1 SECOND AND
JRST INIT.1 ] ; TRY AGAIN
MOVEM S1,G$OPR## ;SAVE IT FOR FUTURE REFERENCE
MOVE S1,G$LNAM## ;GET THE HOST NODE ID.
MOVEM S1,COMSTA+.OHDRS+ARG.DA+OBJ.ND ;SAVE IT IN THE MESSAGE
MOVEI S1,.OTBIN ;GET THE CORRECT OBJECT TYPE
STORE S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE IT IN THE MESSAGE
MOVEI M,COMSTA ;STARTUP MESSAGE FOR BIN QUEUE
PUSHJ P,A$OSTA ;SETUP THE OBJECT BLOCK
MOVX S1,.OTDBM ;GET THE DBMS OBJECT TYPE
STORE S1,COMSTA+.OHDRS+ARG.DA+OBJ.TY ;SAVE FOR DBMS STARTUP
MOVEI M,COMSTA ;GET START MESSAGE ADDRESS
PUSHJ P,A$OSTA ;STARTUP THE DBMS PROCESSOR
$RETT ;AND RETURN
SUBTTL Administrative Message Handlers
;THE MESSAGE HANDLERS ARE TOP LEVEL ROUTINES WHICH PROCESS THE
; VARIOUS MESSAGES THAT ARE SENT TO QUASAR. THEY ARE
; CALLED DIRECTLY OUT OF THE MAIN PROCESSING LOOP WITH
; ACCUMULATOR "M" POINTING TO THE FIRST WORD OF THE MESSAGE.
; THE MESSAGE HANDLERS HAVE FULL USE OF ALL ACCUMULATORS
; EXCEPTING "M" AND THE "P" REGS.
INTERN A$HELLO ;FUNCTION 1 -- HELLO
INTERN A$COUNT ;FUNCTION 20 -- COUNT
SUBTTL HELLO -- Function 1
;THE HELLO MESSAGE IS SENT TO QUASAR BY ONE OF THE KNOWN SYSTEM
; COMPONENTS UNDER TWO CIRCUMSTANCES, THE FIRST BEING PROGRAM
; STARTUP, THE SECOND, PROGRAM SHUTDOWN.
A$HELLO:
DOSCHD ;FORCE A SCHEDULING PASS
PUSHJ P,.SAVE1 ;SAVE P1
LOAD S1,.MSTYP(M),MS.CNT ;GET THE MESSAGE SIZE
CAIGE S1,HEL.OB ;AT LEAST BIG ENOUGH?
PJRST E$MTS## ;NO, INDICATE MESSAGE TOO SHORT
PUSHJ P,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
MOVE S1,G$SND## ;GET PID OF CURRENT SENDER
PUSHJ P,GETPSB ;FIND HIS PSB
MOVE P1,S1 ;STORE ADDRESS OF PSB IN P1
SKIPE PSBPID(P1) ;IS IT A NEW ONE?
JRST HELL.2 ;NO, MUST BE RESTARTING
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 SENDER'S PID
MOVEM S1,PSBPID(P1) ;AND STORE IT IN THE PSB
LOAD S1,HEL.NM(M) ;GET PROGRAM NAME
STORE S1,PSBNAM(P1) ;STORE IN THE PSB
LOAD S1,HEL.NO(M),HENMAX ;GET MAXIMUM NUMBER OF JOBS
STORE S1,PSBLIM(P1),PSLMAX ;AND STORE IT
LOAD S1,HEL.NO(M),HENNOT ;LOAD NUMBER OF OBJECT TYPES
STORE S1,PSBFLG(P1),PSFNOT ;AND STORE IT
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)>)
MOVE S1,PSBOBJ(P1) ;GET THE OBJECT TYPE
CAMN S1,[%GENRC,,.OTBAT] ;IS THIS THE BATCH PROCESSOR??
PUSHJ P,D$PMDR## ;GO PROCESS ALLOCATIONS
;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
LOAD P1,HDRPSB##+.QHLNK,QH.PTF ;GET THE FIRST PROCESSOR BLOCK
HELL.A: JUMPE P1,.RETT ;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
;HERE WHEN WE RECEIVE A GOOD-BYE MESSAGE
HELL.1: MOVE S1,G$SND## ;GET SENDERS PID
PUSHJ P,A$FPSB ;FIND THE PSB
JUMPE S1,E$NKC## ;LOSE
PJRST KILPSB ;ELSE, KILL THE PSB
;HERE WHEN WE RECEIVE A HELLO FROM A KNOWN PROGRAM. WE ASSUME THE
; PROGRAM ABENDED AND HAS BEEN RESTARTED, SO WE FORCE A
; GOODBYE FOLLOWED BY A NEW HELLO.
HELL.2: PUSHJ P,KILPSB ;BYE....
MOVE S1,HEL.OB(M) ;Get the object type
CAIN S1,.OTMNT ;For mountable devices?
PUSHJ P,I$MID## ;Yes, delete the tape requests
JRST A$HELLO ;HI.....
SUBTTL COUNT -- Function 20
;COUNT MESSAGE IS SENT TO QUASAR BY A WHEEL TO REQUEST A COUNT-ANSWER
; CONTAINING ALL OF QUASAR'S INTERESTING COUNTERS.
A$COUNT:
PUSHJ P,A$WHEEL ;IS USER A WHEEL?
JUMPF E$IPE## ;NO, INSUFFICIENT PRIVS
LOAD S1,G$NOW## ;GET NOW
STORE S1,G$ITEM##+$$NOW ;SAVE IT
$COUNT (MCAN) ;NUMBER OF COUNTANSWER MESSAGES
PUSHJ P,M%ACQP ;GET A PAGE
PG2ADR S1 ;MAKE AN ADDRESS
MOVEM S1,G$SAB##+SAB.MS ;SAVE IT IN THE SAB
MOVSI S2,CAN.SZ ;GET LEN,,0
HRRI S2,.QOCAN ;GET LEN,,FUNCTION
STORE S2,.MSTYP(S1) ;STORE IT IN THE MESSAGE
MOVSI S2,G$ITEM## ;GET START ADDRESS
HRRI S2,CAN.BL(S1) ;GET DEST ADDRESS
BLT S2,CAN.BL+NITEMS(S1) ;BLT THE MESSAGE
MOVEI S1,PAGSIZ ;PUT IN PAGE LENGTH
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 Operator Messages
;The following messages are received from ORION:
INTERN A$OSTA ;STARTUP AN OBJECT
INTERN A$OSHT ;SHUTDOWN AN OBJECT
INTERN A$OSET ;SET PARAMETERS FOR AN OBJECT
INTERN A$OPAU ;PAUSE AN OBJECT
INTERN A$OCON ;CONTINUE AN OBJECT
INTERN A$OSHC ;SHOW CONTROL FILE (EXAMINE)
INTERN A$OREQ ;REQUEUE A JOB
INTERN A$OCAN ;CANCEL A JOB
INTERN A$OFWS ;FORWARD SPACE
INTERN A$OBKS ;BACK SPACE
INTERN A$OALI ;ALIGN FORMS ON PRINTER
INTERN A$OSUP ;SUPPRESS CARRIAGE CONTROL
INTERN A$OSND ;SEND MESSAGE TO LOG FILE
INTERN A$OREL ;RELEASE MESSAGE.
INTERN A$OHLD ;HOLD MESSAGE
INTERN A$ORTE ;ROUTE MESSAGE.
INTERN A$ODEL ;DELETE QUEUES MSG
INTERN A$ENABLE ;ENABLE MESSAGE
INTERN A$DISABLE ;DISABLE MESSAGE
INTERN A$MODIFY ;MODIFY QUEUE ENTRY MESSAGE
INTERN A$DEFINE ;DEFINE NODE COMMAND PROCESSOR
INTERN A$DN60 ;DN60 OPERATOR MSG PROCESSOR
INTERN A$STND ;START NODE PROCESSOR
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:: $SAVE <T1> ;SAVE T1
CAMGE S1,S2 ;ORDERING CHECK
EXCH S1,S2 ;WANT THE LARGEST IN S1
SUB S1,S2 ;SUBTRACT THEM
HLRZ T1,S1 ; Get the days difference
HRRZS S1 ; Seperate the difference in fraction
IMULX S1,<^D1000.> ; Shift it over for greater accuracy
IDIVX S1,<^D3034.> ; Divide by the magic factor
IMULX T1,<^D<24*3600>> ; Calculate the seconds between the days
ADD S1,T1 ; Calculate the total number of seconds
$RET ; 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.3 ;Yes, error, go tell the operator
MOVE S1,P1 ;Get object block back
SKIPA ;Don't want to save P1 again
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.1 ;YES,,LET'EM KNOW ...
IORM S1,OBJSCH(P1) ;NO,,SET IT
$ACK (Startup Scheduled,,OBJTYP(P1),.MSCOD(M))
MOVE S1,P1 ;GET THE OBJECT ADDRESS BACK
PUSHJ P,A$OBST ;SETUP THE OBJECT STATUS.
DOSCHD ;FORCE A SCHEDULING PASS
MOVE S1,OBJTYP(P1) ;GET THE OBJECT TYPE
CAIE S1,.OTLPT ;IS IT THE LINE PRINTER ???
$RETT ;NO,,JUST RETURN
;Check to see if Printer has a Physical Device Name
OSTA.0: MOVX S1,.CMDEV ;WANT A DEVICE BLOCK
PUSHJ P,A$FNDB ;SEE IF THERE IS ONE
JUMPF .RETT ;NO,,JUST RETURN
HRLI S1,(POINT 7,0) ;BYTE POINTER TO THE ASCIZ STRING
PUSHJ P,S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,OBJPRM+.OOTAP(P1) ;SAVE THE DEVICE NAME FOR LATER
MOVX S1,OBSSPL ;GET SPOOL TO TAPE FUNCTION
IORM S1,OBJSCH(P1) ;LITE IT IN THE SCHEDULING VECTOR
$RETT ;AND RETURN
OSTA.1: MOVX S1,OBSSEJ ;GET 'SHUTDOWN AT EOJ'
TDNN S1,OBJSCH(P1) ;WAS SHUTDOWN PENDING ???
JRST OSTA.2 ;NO,,SAY ALREADY STARTED
ANDCAM S1,OBJSCH(P1) ;CLEAR PENDING SHUTDOWN
$ACK (Pending shutdown cancelled,,OBJTYP(P1),.MSCOD(M))
$RETT ;RETURN
OSTA.2: $ACK (Already Started,,OBJTYP(P1),.MSCOD(M))
$RETT
OSTA.3: $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: $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.
LOAD S1,NETSTS(S2),NETSNA ;Is it an SNA Node
JUMPN S1,STND.2 ; Yes, go start it up
LOAD S1,NETSTS(S2),NETIBM ;GET IBM STATUS
LOAD S2,NETSTS(S2),NT.MOD ;GET THE MODE
JUMPE S1,STND.A ;IS IT AN IBM REMOTE
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
; node this way
STND.A: PUSH P,S1 ;Save S1 for a min.
MOVX S1,.OTRDR ;GET CARD READER OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE IT IN THE OBJECT BLOCK
MOVEI S1,.OHDRS+ARG.DA(M) ;Get the start of the object block
PUSHJ P,A$ISTA ;START A CARD READER FOR THE NODE
POP P,S1 ;Get back IBMness
SKIPE S1 ;Is it?
JRST STND.0 ;Yes, do not start up a printer
MOVX S1,.OTLPT ;GET LINE PRINTER OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS NEW OBJECT TYPE
MOVEI S1,.OHDRS+ARG.DA(M) ;Get the start of the object block
PUSHJ P,A$ISTA ;AND START THE LINE PRINTER
STND.0: SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
STND.1: MOVX S1,.OTBAT ;GET BATCH STREAM OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
MOVEI S1,.OHDRS+ARG.DA(M) ;Get the start of the object block
PUSHJ P,A$ISTA ;START A BATCH STREAM FOR THE NODE
SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
; Here to start up an SNA type node, S2 contains pointer to node entry
;
STND.2: MOVE P1,S2 ;Save pointer to node entry
MOVX S1,.OTBAT ;GET BATCH STREAM OBJECT TYPE
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
MOVEI S1,1 ; Unit 1 is main batch stream
MOVEM S1,.OHDRS+ARG.DA+OBJ.UN(M) ;SAVE AS THE OBJECT Unit
MOVEI S1,.OHDRS+ARG.DA(M) ;Get the start of the object block
PUSHJ P,A$OSTA ;START A BATCH STREAM FOR THE NODE
MOVE S1,NETNOB(P1) ; Link List Index for Objects
$CALL L%FIRST ; Get first object
SKIPA
STND.3: $CALL L%NEXT ; Get next object
JUMPF STND.4 ; All done
MOVE S1,NOBTYP(S2) ; Get type
MOVEM S1,.OHDRS+ARG.DA+OBJ.TY(M) ;SAVE AS THE OBJECT TYPE
MOVE S1,NOBUNI(S2) ; Get Unit
MOVEM S1,.OHDRS+ARG.DA+OBJ.UN(M) ;SAVE AS THE OBJECT Unit
PUSHJ P,A$OSTA ; Start the object
MOVE S1,NETNOB(P1) ; Link List Index for Objects
JRST STND.3 ; Loop for all objects
STND.4: SETOM .MSCOD(M) ;CLEAR COMMON ACK CODE
$RETT ;AND RETURN
STAERR: MOVE TF,NETCOL(S1) ;GET THE NODE NAME
LOAD S2,NETPTL(S1),NT.PRT ;GET THE PORT NUMBER
LOAD S1,NETPTL(S1),NT.LIN ;GET THE LINE NUMBER
$ACK (Illegal Start Command,<Port ^O/S2//Line ^O/S1/ already started as node ^N/TF/>,,.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
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))
TXNE S1,OBSFRR ;IS THIS A FREE RUNNING DEVICE ??
TXZ S1,OBSBUS ;YES,,CLEAR THE BUSY BIT
MOVEM S1,OBJSCH(P1) ;SAVE THE SCHEDULING BITS
DOSCHD ;FORCE A SCHEDULING PASS
$RETT ;AND RETURN
A$SH.0: MOVE S1,P1 ;GET THE OBJECT ADDRESS
PUSHJ P,S$SHUT## ;SHUT 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.A: PUSHJ P,N$GNOD## ;FIND IT IN OUR DATA BASE
DMOVE P1,S1 ;COPY NODE NAME & ADDRESS
JUMPF SHUT.5 ;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
CAME P1,NETLOC(P2) ;Skip this if proto is same as actual
CAIE S1,DF.PRO ;Is it proto mode?
JRST SHUT.0 ;No, continue on
LOAD S1,NETSTS(P2),NETPRO ;Get proto online flag
SKIPN S1 ;Is it online prototype?
JRST SHUT.0 ;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.A ;Go shut the actual node
SHUT.0: SETZM .OARGC(M) ;INDICATE NO OBJECT SHUTDOWN YET !!!
MOVX S1,NETSHT ;GET THE NETWORK SHUTDOWN BIT
IORM S1,NETSTS(P2) ;LITE IT FOR THIS NODE
MOVEI H,HDROBJ## ;GET THE OBJECT HEADER ADDRESS
LOAD P2,.QHLNK(H),QH.PTF ;GET THE FIRST OBJECT
SHUT.1: JUMPE P2,SHUT.4 ;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.2 ;INVISIBLE OR WRONG NODE,,TRY NEXT
TXNN S1,OBSSUP ;IS THE OBJECT SETUP ???
JRST SHUT.3 ;NO,,JUST SHUT IT DOWN
TXO S1,OBSSEJ ;LITE SHUT DOWN AT EOJ BIT
TXNE S1,OBSBUS ;IS THE OBJECT BUSY ???
$ACK (<Shutdown at EOJ Scheduled>,,OBJTYP(P2),.MSCOD(M));YES !!
TXNE S1,OBSFRR ;IS THIS A FREE RUNNING OBJECT ???
TXZ S1,OBSBUS ;YES,,TURN OFF THE 'BUSY' BITS
STORE S1,OBJSCH(P2) ;RESTORE THE SCHEDULING BITS
DOSCHD ;FORCE A SCHEDULING PASS
AOS .OARGC(M) ;BUMP SHUTDOWN COUNT BY 1
SHUT.2: LOAD P2,.QELNK(P2),QE.PTN ;GET THE NEXT OBJECT ADDRESS
JRST SHUT.1 ;AND CONTINUE
SHUT.3: MOVE S1,P2 ;GET THE 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.1 ;AND CONTINUE
SHUT.4: SKIPN .OARGC(M) ;DID WE SHUTDOWN ANY OBJECTS ???
SHUT.5: $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.
SETOIA: SKIPA S1,[.OPINY] ;GET OPR INTERVN ALLOWED CODE
SETNOI: MOVE S1,[.OPINN] ;GET NO OPR INTERVN ALLOWED CODE
STORE S1,OBJPRM+.OBFLG(P1),.OPRIN ;SAVE IT
JRST SETMSG ;SEND AN ACK AND RETURN
SETLEA: LOAD S1,0(P3) ;GET THE ACTION CODE
STORE S1,OBJPRM+.OOFLG(P1),.OFLEA ;SAVE IT IN THE OBJECT BLOCK
JRST SETMSG ;SEND THE ACK
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
SETMMX: ADDI S1,OBJPRM(P1) ;CALC QUEUE PARAMETER ADDRESS.
LOAD S2,0(P3) ;PICK UP MIN VALUE.
STORE S2,0(S1),OBPMIN ;SAVE THE MIN VALUE.
LOAD S2,1(P3) ;PICK UP MAX VALUE.
STORE S2,0(S1),OBPMAX ;SAVE THE MAX VALUE.
SETMSG: $ACK (Set Accepted,,OBJTYP(P1),.MSCOD(M))
MOVE S1,P1 ;GET OBJECT ADDRESS IN S1
PUSHJ P,A$OBST ;UPDATE THE OBJECT STATUS
DOSCHD ;FORCE A SCHEDULING PASS
$RETT ;RETURN.
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
SETDST: $SAVE <P2> ; Save P2
MOVE S1,OBJNOD(P1) ; Get node name
$CALL N$NODE## ; Get the node DB entry
MOVE P2,S2 ; Keep it
LOAD S1,NETSTS(P2),NETSNA ; Is this an SNA Workstation?
JUMPE S1,SETE.2 ; No, return error
LOAD S1,OBJSCH(P1) ; Get scheduler flags
TXNE S1,OBSSUP!OBSSIP ; Error if setup started
JRST SETE.1
MOVE S1,NETNOB(P2) ; Get list index
$CALL GETNOB ; Get NOB entry for this object
JUMPF SETE.3 ; Return failure
MOVE S2,NETNOB(P2) ; Get list index, again
MOVE P2,S1 ; P2 points to NOB
MOVE T1,P3 ; Address of destination string
HRLI T1,(POINT 7) ; Make a pointer
SETD.1: ILDB T2,T1 ; Get a char
JUMPE T2,[MOVE S1,S2 ; If null,
$CALL L%DENT ; delete this entry
JRST SETMSG] ; Finish up
CAIN T2," " ; If blank,
JRST SETD.1 ; keep looking
MOVEI S1,DSTSIZ ; Size of "destination field"
MOVEI S2,NOBDST(P2) ; Its address
$CALL .ZCHNK ; Clear it
LOAD S1,ARG.HD-ARG.DA(P3),AR.LEN ; Get length
CAILE S1,DSTSIZ ; Make sure
JRST SETE.4 ; we have enough room
HRLZ S2,P3 ; Source
HRRI S2,NOBDST(P2) ; source,,destination
ADDI S1,NOBDST-2(P2) ; Last address
BLT S2,(S1) ; Move it
SETD.2: PUSHJ P,A$GBLK ; Get next message block
JUMPF SETMSG ; None, all done
MOVEI S1,1 ; Get a 1
CAIN T1,.STSPL ; /SPOOL ?
JRST [STORE S1,NOBFLG(P2),NOBSPL ; Yes, set the flag
JRST SETD.2]
CAIE T1,.STNTL ; /NOTRANSLATE ?
JRST BADMSG ; No, error
STORE S1,NOBFLG(P2),NOBNTL ; Set the flag
JRST SETD.2
SETE.1: $ACK (<Set ignored>,<Object already started>,OBJTYP(P1),.MSCOD(M))
$RETF
SETE.2: $ACK (<Set ignored>,<Node must be an SNA Workstation>,OBJTYP(P1),.MSCOD(M))
$RETF
SETE.3: $ACK (<Set ignored>,<Could not create object block>,OBJTYP(P1),.MSCOD(M))
$RETF
SETE.4: $ACK (<Set ignored>,<Destination string too long>,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
.STDST,,SETDST ;SET DESTINATION
NSETS==.-SETTBL
SUBTTL GETNOB -- Get NOB entry in the SNA workstation object list
;CALL: S1/ NOB List Index
; P1/ The address of object queue entry for object
;
;RET: S1/ The address of the NOB entry or false
FNDNOB::
SKIPA S2,[1] ;INDICATE "FIND"
GETNOB: SETZ S2, ;INDICATE "GET"
PUSHJ P,.SAVET ;SAVE THE 'T' ACS
PUSH P,S1 ;KEEP INDEX
PUSH P,S2 ;KEEP ENTRY FLAG
MOVE T1,OBJTYP(P1) ;GET THE MODEL OBJECT TYPE
MOVE T2,OBJUNI(P1) ;GET THE MODEL OBJECT UNIT
MOVE T3,OBJNOD(P1) ;GET THE MODEL OBJECT NODE
$CALL L%FIRST ;GET FIRST ENTRY
SKIPA
GETN.1: $CALL L%NEXT ;GET NEXT ENTRY
JUMPF GETN.2 ;NO MORE ENTRIES
MOVE T4,S2 ;ADDRESS OF NOB
CAMN T1,NOBTYP(T4) ;DO OBJECT TYPES MATCH ???
CAME T2,NOBUNI(T4) ;DO OBJECT UNITS MATCH ???
JRST GETN.1 ;NO TO EITHER,,TRY NEXT OBJECT
MOVE S1,T3 ;GET THE MODEL OBJECT NODE NAME/NUMBER
MOVE S2,NOBNOD(T4) ;GET THE SOURCE OBJECT NODE NAME/NUMBER
PUSHJ P,N$MTCH## ;DO THEY MATCH ???
JUMPF GETN.1 ;NO,,TRY NEXT OBJECT IN THE QUEUE
ADJSP P,-2 ;ADJUST STACK
MOVE S1,T4 ;GET THE NOB ENTRY ADDRESS
$RETT ;AND RETURN
;
; Could not find the entry so here to create a new entry
;
GETN.2: POP P,S2 ;ENTRY FLAG
POP P,S1 ;LIST INDEX
JUMPN S2,.RETF ;QUIT NOW, IF ONLY LOOKING
MOVEI S2,NOBSIZ ;ENTRY SIZE
$CALL L%CENT ;CREATE AN ENTRY
JUMPF .RETF ;PASS ON FAILURE
MOVEM T1,NOBTYP(S2) ;SAVE TYPE
MOVEM T2,NOBUNI(S2) ;SAVE UNIT
MOVEM T3,NOBNOD(S2) ;SAVE NODE
MOVE S1,S2 ;GET THE NOB ENTRY ADDRESS
$RETT ;AND RETURN
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
SETZ S2, ;Say we want online check
$CALL N$CKND## ;Check out the node
JUMPF NETS.3 ;Failed, online
JUMPE S2,NETS.2 ;Not found, not defined
MOVE P1,S2 ;SAVE THE DATA BASE ENTRY ADDRESS
LOAD S2,NETSTS(P1),NETSNA ; Is this an SNA node
JUMPN S2,NETS.5 ; Yes, go do it
SETO S2, ;Say we want online check
$CALL N$CKND## ;Check out the node
JUMPF NETS.3 ;Failed, either online or
; objects started
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
MOVSI S1,-NETS ; Get negative # of SET commands.
NETS.0: HLRZ S2,NETTBL(S1) ; Pick up a SET command type.
CAMN S2,T1 ; Do we match ???
JRST [MOVEI S1,[ITEXT(Parameter invalid for IBM remote)] ; Yes
MOVE S2,P1 ; Get address of node database
JRST NETS.3] ; Go report error
AOBJN S1,NETS.0 ; Bump to next tbl entry and continue.
$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
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
NETS.5: ; Here to set SNA attributes
PUSHJ P,A$GBLK ; Go get a block
JUMPF BADMSG ; No more, return through 'BADMSG'
CAIN T1,.ORNOD ; Is this the node block (already done)
JRST NETS.5 ; Yes, try the next one
MOVSI S1,-NETS ; Get negative # of SET commands.
NETS.6: HLRZ S2,NETTBL(S1) ; Pick up a SET command type.
CAMN S2,T1 ; Do we match ???
JRST NETS.7 ; Yes, Go process it
AOBJN S1,NETS.6 ; Bump to next tbl entry and continue.
MOVEI S1,[ITEXT(Parameter invalid for SNA-Workstation)] ; No match
MOVE S2,P1 ;Get address of node database
JRST NETS.3 ; Go report error
NETS.7: HRRZ S2,NETTBL(S1) ; Get the NAB offset
LOAD S1,NETNAB(P1),NA.ADR ; Get address of Node Attribute Block
ADD S1,S2 ; Add in appropriate offset
HRL S1,T3 ; Get source address
ADDI T2,-2(S1) ; Determine last destination address
BLT S1,(T2) ; Move value to Node Attribute Block
$ACK (<Set for Node ^T/NETASC(P1)/ Accepted>,,,.MSCOD(M))
$RETT ;RETURN
NETTBL: .STDAT,,NABDAT ; LOGON DATA
.STLOM,,NABLOM ; LOGON MODE
.STPLU,,NABPLU ; APPLICATION
.STCIR,,NABCIR ; CIRCUIT
.STCHS,,NABCHS ; CHARACTER SET TRANSLATION FILE
NETS==.-NETTBL
>
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 Requests Modified>,,,.MSCOD(M))
CAIN S1,1 ;JUST 1 JOB ???
$ACK (<1 Request Modified>,,,.MSCOD(M))
CAILE S1,1 ;MORE THEN 1 JOB ???
$ACK (<^D/S1/ Requests Modified>,,,.MSCOD(M))
$RETT ;AND RETURN
SUBTTL A$ENABLE - ROUTINE TO ENABLE QUEUE ENTRY CREATE'S
A$ENABLE: SETZM G$QUEUE## ;ENABLE PROCESSING FOR CREATE MESSAGES
$ACK (System Queue's Entry Processing Enabled,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL A$DISABLE - ROUTINE TO DISABLE QUEUE ENTRY CREATE'S
A$DISABLE: SETOM G$QUEUE## ;DISABLE PROCESSING FOR CREATE MESSAGES
$ACK (System Queue's Entry Processing Disabled,,,.MSCOD(M))
$RETT ;RETURN
SUBTTL A$OREQ - Operator REQUEUE Request
A$OREQ: PUSHJ P,.SAVE1 ;SAVE P1
MOVX S1,.OROBJ ;GET OBJECT BLOCK TYPE CODE
PUSHJ P,A$FNDB ;GO FIND IT IN THE MESSAGE
JUMPF BADMSG ;NOT THERE,,RETURN WITH AN ERROR
PUSHJ P,ORANGE ;CHECK FOR A RANGE
MOVE P1,S1 ;SAVE THE OBJECT BLOCK ADDRESS
MOVE S2,OBJ.UN(P1) ;GET THE UNIT NUMBER
MOVEM S2,.OHDRS+ARG.DA+OBJ.UN(M) ;SAVE IT IN THE MESSAGE
PUSHJ P,A$FOBJ ;FIND THE OBJ ENTRY
JUMPF 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
TXNE S1,OBSSNA ;IS THIS AN SNA WORKSTATION DEVICE ???
JRST OREQ.3 ;YES,,JUST SEND THE MESSAGE
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
$STOP(RJM,Requeue job missing)
MOVE AP,S1 ;SAVE THE QE ADDRESS
OREQ.1: PUSHJ P,A$GBLK ;GET FIRST/NEXT MESSAGE BLOCK
JUMPF OREQ.3 ;NO MORE,,SEND THE MSG.
CAIE T1,.ORREQ ;IS THIS THE REQUEST ID BLOCK
JRST OREQ.1 ;NO,,TRY THE NEXT ONE
LOAD S1,.QERID(AP) ;GET THE REQUEST ID
CAME S1,0(T3) ;DO WE MATCH ???
JRST A$RQ.3 ;NO,,TOUGH BREAKEEEE
JRST OREQ.1 ;YES,,CONTINUE
OREQ.3: MOVE S1,P1 ;LOAD S1 WITH OBJECT BLOCK ADDR.
PJRST SNDOAC ;GO SEND THE MSG.
A$RQ.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 ;PICK UP BUSY 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
TXNE S2,NETSNA ; Is this node an SNA Workstation?
JRST OSND.1 ; Yes, go take care of it
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 !!!
OSND.1: 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
MOVE S1,P1 ;GET THE OBJECT ADDRESS IN S1
PUSHJ P,A$OBST ;UPDATE THE STATUS
$RETT ;AND RETURN
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
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 S2,[ASCIZ/ Held/] ;ASSUME HOLD MESSAGE.
SKIPE P1 ;CHECK FLAGS,,IF 0 WE WERE RIGHT
MOVEI S2,[ASCIZ/ Released/] ;ELSE MAKE IT RELEASE.
SKIPG S1 ;MORE THEN 0 JOBS ???
$ACK (<No jobs^T/0(S2)/>,,,.MSCOD(M))
CAIN S1,1 ;IS THERE ONLY 1 JOB ???
$ACK (<1 Job^T/0(S2)/>,,,.MSCOD(M))
CAILE S1,1 ;MORE THEN 1 JOB ???
$ACK (<^D/S1/ Jobs^T/0(S2)/>,,,.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 Jobs Canceled>,,,.MSCOD(M))
CAIN S1,1 ;1 JOB KILLED !!!
$ACK (<1 Job Canceled>,,,.MSCOD(M))
CAILE S1,1 ;MORE THE 1 JOB !!!
$ACK (<^D/S1/ Jobs 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:
IFN FTDN60,<
$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
; Add the node to the data base, purging any existing entry
MOVE S1,P1 ;Get the node name
PUSHJ P,N$NNET## ;Add the node
MOVE P2,S2 ;Remember the entry
; 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
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
DEFI.1: 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
MOVEI S1,DEFD60 ;Try for DN60 type node
CAXN S2,DF.SNA ;Is it SNA workstation
MOVEI S1,DEFSNA ;Yes, set for that
$CALL (S1) ;Go do right kind of initialization
$ACK (< ^T/DEFTAB(P4)/efine for node ^T/NETASC(P2)/ accepted >,,,.MSCOD(M))
$RETT ;AND RETURN
DEFBD1: $ACK(< Define for node ^N/P1/ ignored >,<^I/0(S1)/>,,.MSCOD(M))
$RETT
DEFD60: ; Here for DN60 type initialization
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
$RET
DEFSNA: ; Here for SNA type initialization
MOVEI S1,1 ; Get a 1
STORE S1,NETSTS(P2),NETSNA ; Lite the SNA node bit
LOAD S1,DEF.GW(P3) ; Get the Gateway Name
STORE S1,NETGWY(P2) ; Store in Node database
HRLI S1,DEF.AN(P3) ; Get start of access name
HRRI S1,NETACC(P2) ; and destination
BLT S1,NETACC+2(P2) ; Copy to Node database
MOVEI S1,NABSIZ ; Get size of Node Attribute Block
PUSHJ P,M%GMEM ; Go get the memory
JUMPF [MOVEI S1,[ITEXT(<No memory to create Node Attribute Block>)]
JRST DEFBD1] ; Fail
STORE S1,NETNAB(P2),NA.LEN ; Save length
STORE S2,NETNAB(P2),NA.ADR ; and address
PUSHJ P,L%CLST ; Create a linked list for objects
MOVEM S1,NETNOB(P2) ; Save index
$RET
>
IFE FTDN60,<
NODN60: $ACK (< DN60 remotes are not supported >,,,.MSCOD(M))
$RETT
>
SUBTTL A$DN60 - ROUTINE TO SEND A OPERATOR RESPONSE TO LPTSPL
;CALL: M/ The Operator response message address
;
;RET: True Always
A$DN60:
IFN FTDN60,<
PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVX S1,.OTLPT ;GET PRINTER OBJECT TYPE
MOVEM S1,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 ;Get the obj. blk. address for coverage
; Not actually used in SNDOPR but
; this prevents ILM
PJRST SNDOPR ;RETURN THE MSG TO ORION AND RETURN
>
IFE FTDN60,<JRST NODN60 > ;SHOULD NOT HAPPEN
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,A$FOBJ ;[NXT] FIND THE OBJECT BLOCK
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 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$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 ; ""
PUSHJ P,A$FPSB ;FIND THE PSB GIVEN THE PID
JUMPE S1,.RETT ;RETURN IF NOT THERE
PJRST KILPSB ;KILL THE PSB ENTRY AND RETURN
SUBTTL A$FPSB -- Subroutine to find a PSB
;A$FPSB IS CALLED WITH A PID IN S1. IT SCANS THE PSB LIST
; LOOKING FOR A MATCH. IF ONE IS FOUND, THE ADDRESS
; OF THE PSB IS RETURNED IN S1, ELSE S1 IS RETURNED
; CONTAINING 0.
A$FPSB: MOVEI H,HDRPSB## ;ADDRESS OF PSB QUEUE HEADER
MOVE S2,S1 ;COPY ARGUMENT TO S2
LOAD S1,.QHLNK(H),QH.PTF ;GET ADDRESS OF FIRST
FPSB.1: JUMPE S1,.RETF ;RETURN IF LAST ONE (OR NONE)
CAMN S2,PSBPID(S1) ;MATCH?
$RETT ;YES, RETURN WITH ADDRESS IN S1
LOAD S1,.QELNK(S1),QE.PTN ;GET POINTER TO NEXT
JRST FPSB.1 ;AND LOOP
SUBTTL A$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),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$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,OBSSTP ;Get the stopped 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$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
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,OBSIGN ;ARE WE IGNORING THE OBJECT ???
MOVX S1,%NAVAL ;YES,,GET 'NOT AVAILABLE' CODE
TXNN S2,OBSHUT ;IS IT IN 'INTERNAL SHUTDOWN' STATE ???
TXNE S2,OBSFRR ;OR IS IT A FREE RUNNING DEVICE ???
MOVX S1,%IDLE ;YES,,ITS IDLE !!!!
TXNE S2,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
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,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 !!
PUSHJ P,.SAVE1 ;SO FAR, SO GOOD, SO SAVE P1
MOVE P1,S1 ;PUT THE OBJ ADDRESS INTO P1
MOVE S1,OBJPID(P1) ;GET THE CONTROLLING PID
CAME S1,G$SND## ;IS IT THE SAME GUY ???
JRST E$SNY## ;NO,,BETTER LUCK NEXT TIME !!
MOVE S1,STU.CD(M) ;GET THE DEVICE STATUS CODE
JUMPLE S1,E$SNY## ;MUST BE GREATER THEN 0
CAILE S1,%STMAX ;MUST ALSO BE LESS THEN MAX STATUS CODE
JRST E$SNY## ;ELSE HE LOSES !!
HRRZ S2,OBJCDS(S1) ;PICK UP THE OBJ TYPE LIST ADDRESS
JUMPE S2,STAT.2 ;IF 0,,THEN THIS CODE IS GOOD FOR ALL
HLRZ T1,OBJCDS(S1) ;GET THE # OF DEVICES SPECIFIED
MOVE T2,STU.RB+OBJ.TY(M) ;GET THE MESSAGE OBJECT TYPE
STAT.1: CAMN T2,0(S2) ;DOES MSG DEVICE MATCH DEVICE LIST ??
JRST STAT.2 ;YES,,THEN HE WINS AT LAST !!
AOS S2 ;BUMP TO NEXT ENTRY IN DEVICE LIST
SOJG T1,STAT.1 ;KEEP TRYING WHILE WE CAN
JRST E$SNY## ;NOT A VALID DEVICE,,BUMP HIM !!
STAT.2: EXCH P1,S1 ;SWAP OBJ ADDRESS AND OBJ STATUS CODE
CAIN P1,%RESET ;IS IT 'RESET' ???
PJRST [DOSCHD ;FORCE A SCHEDULING PASS
MOVX S2,OBSSTP ;YES,,GET 'STOPPED' STATUS
ANDCAM S2,OBJSCH(S1) ;CLEAR IT
PJRST A$OBST ] ;GO UPDATE THE STATUS
STORE P1,OBJSTS(S1) ;NO,,SAVE THE NEW DEVICE STATUS
$RETT ;AND RETURN
SUBTTL A$GBLK - ROUTINE TO BREAK DOWN IPCF MESSAGES
;CALL: M/ THE MESSAGE ADDRESS
;
;RET: T1/ THE BLOCK TYPE
; T2/ THE BLOCK LENGTH
; T3/ THE BLOCK DATA ADDRESS
; FALSE IF NO MORE BLOCKS
A$GBLK: SKIPE S1,G$BLKA## ;GET THE BLOCK ADDRESS IF THERE IS ONE
JRST .+4 ;NOT FIRST TIME THROUGH,,SO SKIP INITLZN
MOVE S1,.OARGC(M) ;GET THE MESSAGE BLOCK COUNT
MOVEM S1,BLKCNT ;AND SAVE IT
MOVEI S1,.OHDRS+ARG.HD(M) ;IF NOT,,GET THE FIRST ONE
SOSGE BLKCNT ;CHECK THE BLOCK COUNT
$RETF ;NO MORE,,JUST RETURN
LOAD 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 IS CALLED WITH A PID IN S1. IT CALLS A$FPSB TO SEE IF
; THE PID IS ALREADY KNOWN, AND IF SO IT RETURNS ITS ADDRESS
; IN S1. IF NOT, A NEW PSB IS GOTTEN AND ZEROED AND ITS
; ADDRESS IS RETURNED IN S1.
;
GETPSB: PUSHJ P,A$FPSB ;FIND KNOWN PID
JUMPN S1,.RETT ;FOUND IT
GETP.1: MOVEI H,HDRPSB ;LOAD ADR OF PSB HEADER
PUSHJ P,M$GFRE## ;GET A FREE CELL
PUSHJ P,M$ELNK## ;LINK IN THE PSB
MOVE S1,AP ;RETURN ANSWER IN S1
$RETT ;AND RETURN
SUBTTL KILPSB -- Routine to kill a PSB given its address
;KILPSB is called to clean-up after known components which seem to have
; disappeared behind QUASAR's back. It releases any job interlocks
; held by that program and deletes the PSB entry.
;
;Call: S1/ address of PSB
KILPSB: $SAVE H ;SAVE H
$SAVE AP ;AND AP
PUSHJ P,.SAVE3 ;SAVE P1 AND P2 AND P3
DOSCHD ;FORCE ANOTHER SCHEDULING PASS
MOVE P2,S1 ;COPY THE ARG OVER TO P2
LOAD P1,HDROBJ##+.QHLNK,QH.PTF ;POINT TO THE FIRST OBJ
KILP.1: JUMPE P1,KILP.6 ;NO MORE OBJECTS, WE ARE DONE
MOVE S1,PSBPID(P2) ;GET THE PID
CAME S1,OBJPID(P1) ;OBJECT HELD BY PSB IN QUESTION?
JRST KILP.5 ;NO, LOOP FOR NEXT OBJECT
ZERO OBJPID(P1) ;YES, CLEAR THE INTERLOCK WORD
MOVX S1,%GENRC ;GET GENERIC ATTRIBUTES
MOVE S2,OBJSCH(P1) ;GET THE SCHEDULER FLAG BITS
TXZE S2,OBSATR ;WERE ATTRIBUTES SET BY THE PROCESSOR ?
STORE S1,OBJDAT(P1),RO.ATR ;YES,,RESET THEM
MOVEM S2,OBJSCH(P1) ; AND SAVE THE FLAG BITS
TXZN S2,OBSSIP+OBSIGN ;SETUP-IN-PROGRESS OR IGNORE SET ??
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?
$STOP(IJM,Interlocked Job Missing)
CAMN P1,.QEOBJ(AP) ;IS THIS THE JOB?
JRST KILP.4 ;YES, GO FREE IT UP
LOAD AP,.QELNK(AP),QE.PTN ;NO, GET POINTER TO NEXT
JRST KILP.3 ;AND LOOP
KILP.4: MOVE S1,OBJITN(P1) ;GET OBJECT ITN
CAME S1,.QEITN(AP) ;CONSISTENCY CHECK
$STOP(IJW,Interlocked Job Wrong)
LOAD S1,.QEROB+.ROBTY(AP) ;GET REQUESTED OBJECT TYPE
PUSHJ P,A$OB2Q ;GET THE QUEUE HEADER ADDRES
PUSH P,S1 ;SAVE QUEUE HEADER ADDRESS
LOAD S1,.QHPAG(S1),QH.SCH ;GET ADR OF SCHED VECTOR
PUSHJ P,SCHRJI(S1) ;RELEASE THE INTERLOCK
POP P,S1 ;GET QUEUE HEADER ADR BACK
PUSHJ P,M$MOVE## ;MOVE IT
KILP.5: LOAD P1,.QELNK(P1),QE.PTN ;POINT TO NEXT OBJECT
JRST KILP.1 ;AND LOOP
KILP.6: $LOG(<Process ^W/PSBNAM(P2)/ Deleted From QUASAR>,<Process PID is ^O/PSBPID(P2)/, Process Object Type is ^O/PSBOBJ(P2),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 GETOBJ -- Find or create an OBJ queue entry
;GETOBJ WILL LOOK FOR THE SPECIFIED OBJECT AND IF NOT FOUND, IT
; WILL CREATE THE OBJ ENTRY AND FILL IN THE OBJECT BLOCK IN
; IT
;
;CALL: S1/ POINTER TO AN OBJECT BLOCK
;
;T RET: S1/ POINTER TO AN OBJ QUEUE ENTRY
GETOBJ: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVE P1,S1 ;SAVE THE ARGUMENT
MOVE S1,OBJ.ND(P1) ;GET THE NODE NAME/NUMBER
PUSHJ P,N$NODE## ;PUT IT INTO OUR DATA BASE
MOVEM S1,OBJ.ND(P1) ;SYSTEM'IZE IT (NBR ON -10, NAME ON -20)
MOVE P2,S2 ;SAVE THE NODE DATA BASE ENTRY ADDRESS
MOVE S1,P1 ;GET THE OBJECT ADDRESS IN S1
PUSHJ P,A$FOBJ ;FIND THE OBJECT
JUMPT .RETT ;RETURN IF YOU DID
PUSHJ P,CHKOBJ ;GO VALIDATE THE OBJ BLK.
JUMPF .RETF ;NO GOOD,,JUST RETURN
;HERE IF WE HAVE TO CREATE AN OBJECT QUEUE ENTRY
GETO.0: $SAVE H ;SAVE AC H
$SAVE AP ;AND AP
MOVX S1,NETSHT ;GET THE NETWORK SHUTDOWN BIT
ANDCAM S1,NETSTS(P2) ;AND CLEAR IT (JUST IN CASE IT WAS ON)
MOVEI H,HDROBJ## ;LOAD ADR OF OBJ HEADER
PUSHJ P,M$GFRE## ;GET A FREE CELL
MOVE S1,P1 ;POINT TO SOURCE OBJECT
MOVEI S2,OBJTYP(AP) ;POINT TO DESTINATION OBJECT
PUSHJ P,A$CPOB ;COPY THE OBJECT BLOCK
MOVE S1,OBJTYP(AP) ;GET THE OBJECT TYPE
PUSHJ P,A$OB2Q ;CONVERT IT TO A QUEUE HEADER
JUMPF BADMSG ;NOT THERE,,ORION ERROR !!!
STORE S1,OBJSCH(AP),OBSQUH ;STORE QUEUE HEADER ADDRESS
LOAD S1,.QHTYP(S1) ;GET THE QUEUE TYPE.
TXC S1,.QHFRR ;COMPILMENT FREE RUNNING BITS
MOVX S2,OBSFRR ;GET SCHEDULING FREE RUNNING BITS
TXNN S1,QH.TYP ;IS THIS A FREE RUNNING OBJECT ???
IORM S2,OBJSCH(AP) ;YES,,LITE FREE RUNNING BIT
MOVX S2,OBSINV ;GET INVISIBLE BIT
TXNE S1,QH.INV ;IS THIS OBJECT INVISIBLE ???
IORM S2,OBJSCH(AP) ;YES,,LITE THE INVISIBLE BIT
MOVX S2,OBSIBM ;Get the IBM object bit
LOAD S1,NETSTS(P2),NETIBM ;Get the IBM node bit
SKIPE S1 ;Is this an IBM node
IORM S2,OBJSCH(AP) ;Yes, lite the IBM object bit
JUMPE S1,GETO.A ;Continue if an IBM object
MOVX S2,OBSSNA ;GET SNA BIT
LOAD S1,NETSTS(P2),NETSNA ;IS THIS SNA WORKSTATION
JUMPN S1,[MOVE S1,OBJTYP(AP) ;YES, GET OBJECT TYPE
CAIE S1,.OTBAT ;IS IT BATCH
IORM S2,OBJSCH(AP) ;NO,,LITE THE SNA BIT
JRST .+1] ;CONTINUE ON
;CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
GETO.A: 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
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
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),NETSNA ;IS THIS AN SNA-WORKSTATION?
JUMPN S2,CHKO.4 ;YES, GO PROCESS IT
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.
LOAD S1,OBJ.UN(P1) ;GET THE UNIT NUMBER.
CAIGE S1,SPLMAX ;TOO MANY UNITS?
$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.
CAIG 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
CHKO.4: CAIE S1,.OTBAT ;IS IT BATCH OBJECT
CAIN S1,.OTLPT ;OR PRINTER
JRST CHKO.5 ; YES
CAIE S1,.OTCDP ;OR CARD-PUNCH
CAIN S1,.OTRDR ;OR READER
JRST CHKO.5 ; YES
$ACK (<Ignored>,<Device invalid for SNA-Workstation>,0(P1),.MSCOD(M))
$RETF
CHKO.5: LOAD S1,OBJ.UN(P1) ;GET THE UNIT NUMBER.
CAIL S1,1
CAILE S1,7 ;UNIT IN RANGE?
SKIPA
$RETT ;NO,,THEN RETURN TRUE.
$ACK (<Ignored>,<Invalid unit for SNA-Workstation>,0(P1),.MSCOD(M)) ;TELL OPR
$RETF ;RETURN FALSE.
SUBTTL FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIED NODE
;CALL: S1/ The Node DB Entry Address for the Node we are looking for
;
;RET: True - If we find a device started for the specified node
; False - If there are no devices started for the node
FNDDEV: PUSHJ P,.SAVE1 ;SAVE P1 FOR A MINUTE
MOVE P1,S1 ;SAVE THE NETWORK NODE DB ADDRESS IN P1
LOAD S2,HDROBJ+.QHLNK,QH.PTF ;GET PTR TO FIRST OBJ QUEUE ENTRY
SKIPA ;SKIP FIRST TIME THROUGH
FNDD.0: LOAD S2,.QELNK(S2),QE.PTN ;GET THE NEXT OBJ ENTRY ADDRESS
JUMPE S2,.RETF ;NO MORE,,RETURN FALSE
MOVE S1,OBJNOD(S2) ;GET THE OBJECTS NODE NAME
CAME S1,NETNAM(P1) ;DO
CAMN S1,NETNBR(P1) ; WE
$RETT ; MATCH ??? YES - RETURN TRUE
JRST FNDD.0 ;NO,,CHECK NEXT OBJECT
SUBTTL A$FNDB - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE
;CALL: M/ THE MESSAGE ADDRESS
; S1/ THE TYPE OF BLOCK WE WANT
;
;RET: S1/ THE BLOCK ADDRESS (OR FALSE IF NOT FOUND)
INTERN A$FNDB ;MAKE IT GLOBAL
A$FNDB: PUSHJ P,.SAVE2 ;SAVE P1
LOAD P1,.OARGC(M) ;GET THE MESSAGE ARGUMENT COUNT
MOVE P2,S1 ;SAVE THE BLOCK TYPE
MOVEI S1,.OHDRS(M) ;POINT TO THE FIRST BLOCK
LOAD TF,.MSTYP(M),MS.CNT ;GET THE MESSAGE LENGTH
CAXLE TF,PAGSIZ ;CAN'T BE GREATER THEN A PAGE
$RETF ;ELSE THATS AN ERROR
ADD TF,M ;POINT TO THE END OF THE MESSAGE
FNDB.1: LOAD S2,ARG.HD(S1),AR.TYP ;GET THIS BLOCK TYPE
CAMN S2,P2 ;IS IT THE BLOCK HE WANTS ???
JRST FNDB.2 ;YES,,HE WINS BIG !!!
LOAD S2,ARG.HD(S1),AR.LEN ;NO,,GET THIS BLOCKS LENGTH
ADD S1,S2 ;POINT TO THE NEXT BLOCK
CAIG TF,0(S1) ;ARE WE STILL IN THE MESSAGE ???
$retf ;NO,,RETURN BLOCK NOT FOUND
SOJG P1,FNDB.1 ;CONTINUE TILL DONE
$RETF ;NOT FOUND
FNDB.2: MOVEI S1,ARG.DA(S1) ;POINT TO THE OBJECT BLOCK
$RETT ;AND RETURN
SUBTTL GENRDB - ROUTINE TO CREATE AN RDB FOR HOLD/RELEASE/SET JOB PRIO
;CALL: M/ HOLD/RELEASE/SET JOB PRIO MESSAGE ADDRESS
; S1/ OUTPUT RDB ADDRESS
;
;RET: ALWAYS TRUE
GENRDB: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;SAVE THE 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