Trailing-Edge
-
PDP-10 Archives
-
bb-lw55a-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, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH QSRMAC,GLXMAC ;PARAMETER FILE
PROLOGUE(QSRADM) ;GENERATE NECESSARY SYMBOLS
SEARCH ORNMAC ;NEED ORION INTERFACE
ADMMAN==:0 ;Maintenance edit number
ADMDEV==:42 ;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. Revision history . . . . . . . . . . . . . . . . . . . 4
; 2. Module Storage and Constants . . . . . . . . . . . . . 5
; 3. OBJECT TABLE AND MISC STORAGE . . . . . . . . . . . . 6
; 4. Operator Messages . . . . . . . . . . . . . . . . . . 7
; 5. Initialization Entry . . . . . . . . . . . . . . . . . 8
; 6. A$NPID - Obtain NEBULA's PID . . . . . . . . . . . . . 9
; 7. Administrative Message Handlers . . . . . . . . . . . 10
; 8. HELLO
; 8.1 Function 1 . . . . . . . . . . . . . . . . . . 11
; 9. COUNT
; 9.1 Function 20 . . . . . . . . . . . . . . . . . 13
; 10. A$AGE
; 10.1 Routine to compare two times in internal forma 14
; 11. A$AFT
; 11.1 Routine to modify an internal time . . . . . . 15
; 12. I$WHEEL
; 12.1 Determine whether sender of current message is 16
; 13. A$OSTA / A$ISTA
; 13.1 Startup an object . . . . . . . . . . . . . . 17
; 14. A$STND - START NODE MESSAGE PROCESSOR . . . . . . . . 18
; 15. A$OSHT
; 15.1 Shutdown an object . . . . . . . . . . . . . . 19
; 16. SHUTNODE - ROUTINE TO SHUTDOWN AN ENTIRE NODE . . . . 20
; 17. A$OSET
; 17.1 Set parameters for an object . . . . . . . . . 21
; 18. GETNOB
; 18.1 Get NOB entry in the SNA workstation object li 23
; 19. NETSET - 'SET NODE' PROCESSING ROUTINE . . . . . . . . 24
; 20. A$MODIFY - ROUTINE TO SET THE JOBS PRIORTY . . . . . . 26
; 21. A$ENABLE - ROUTINE TO ENABLE QUEUE ENTRY CREATE'S . . 27
; 22. A$ELPR - Enable Specific LPT objects to process LOG/SP 28
; 23. A$ELPT - Enable a specific LPT object to process LOG/S 29
; 24. A$EUNP - ENABLE UNPRIV'D USERS REMOTE INFO OUTPUT DISP 30
; 25. A$OREQ - Operator REQUEUE Request . . . . . . . . . . 31
; 26. COMMMM - OPERATOR REQUEST COMMON PROCESSING ROUTINE. . 32
; 27. OPERATOR COMMAND PROCESSING ROUTINES. . . . . . . . . 33
; 28. A$OSTO - STOP OPERATOR MESSAGE PROCESSOR . . . . . . . 34
; 29. A$OREL, A$OHLD - RELEASE/HOLD OPERATOR MESSAGES. . . . 35
; 30. A$ODEL - ROUTINE TO REMOVE JOBS FROM THE SYSTEM QUEUES 36
; 31. A$ORTE - ROUTINE TO PROCESS OPERATOR ROUTE COMMAND. . 37
; 32. A$DEFINE - Routine to process the 'DEFINE' network com 38
; 33. A$DN60 - ROUTINE TO SEND A OPERATOR RESPONSE TO LPTSPL 41
; 34. A$NEXT - NEXT COMMAND PROCESSOR . . . . . . . . . . . 42
; 35. SNDOAC
; 35.1 Send an Operator Action Message . . . . . . . 43
; 36. Global Routines . . . . . . . . . . . . . . . . . . . 44
Subttl Table of Contents (page 2)
; Table of Contents for QSRADM
;
; Section Page
;
;
; 37. A$KLPD
; 37.1 Routine to kill a PSB given its PID . . . . . 45
; 38. A$FPSB
; 38.1 Subroutine to find a PSB . . . . . . . . . . . 46
; 39. A$GPSB - ROUTINE TO FIND A PSB IN THE PSB CHAIN . . . 47
; 40. A$FRMC - Send a forms change request . . . . . . . . . 48
; 41. A$CPOB
; 41.1 Copy an object block . . . . . . . . . . . . . 49
; 42. A$CNAM - COPY OVER A LPT NAME . . . . . . . . . . . . 50
; 43. A$FREQ - ROUTINE TO FIND A REQUEST IN ANY QUEUE VIA RE 51
; 44. A$OB2Q
; 44.1 Convert object type to queue header . . . . . 52
; 45. A$OBST
; 45.1 Update Object Status . . . . . . . . . . . . . 53
; 46. A$STATUS - UPDATE THE DEVICE STATUS . . . . . . . . . 54
; 47. A$GBLK - ROUTINE TO BREAK DOWN IPCF MESSAGES . . . . . 55
; 48. Utility Routines . . . . . . . . . . . . . . . . . . . 56
; 49. GETPSB
; 49.1 Routine to get a PSB . . . . . . . . . . . . . 57
; 50. KILPSB
; 50.1 Routine to kill a PSB given its address . . . 58
; 51. GETOBJ
; 51.1 Find or create an OBJ queue entry . . . . . . 60
; 52. CMPNOD - COMPARE TWO OBJECT NODES . . . . . . . . . . 62
; 53. CMPNAM - COMPARE TWO NAMES OF LPT OBJECTS . . . . . . 63
; 54. CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCK REQUESTS. . 64
; 55. A$FOBJ
; 55.1 Find an entry in the object queue . . . . . . 65
; 56. CHRNME
; 56.1 Compare two names . . . . . . . . . . . . . . 66
; 57. FNDDEV - CHECK FOR ANY DEVICE STARTED FOR THE SPECIFIE 67
; 58. CHLPTY - CHECK FOR A REMOTE PRINTER TYPE . . . . . . . 68
; 59. A$FNDB - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE 69
; 60. GENRDB - ROUTINE TO CREATE AN RDB FOR HOLD/RELEASE/SET 70
; 61. PRMTAB - OBJECT INITIAL PARAMETERS TABLE. . . . . . . 71
; 62. ORANGE
; 62.1 Handle a range of objects . . . . . . . . . . 72
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.
***** Release 5 -- begin maintenance edits *****
20 Increment maintenance edit level for GALAXY 5.
21 Do not update the status of an object after a SET command has been
processed.
***** Release 6.0 -- begin development edits *****
30 6.1026 19-Oct-87
Add support to the ABORT, CONTINUE, REQUEUE, SET PRINTER and START
commands for remote printers.
31 6.1042 29-Oct-87
Add support for the NEXT command for remote printers. Correct all
calls to A$FOBJ.
32 6.1072 16-Nov-87
Unpon receiving the START command, check for the
TERMINAL-CHARACTERISTIC name and store it in OBJTCR.
33 6.1072 18-Nov-87
In routine OSTA.0, if there is no device switch go check for TTY
CHARACTERISTIC switch.
34 6.1097 22-Nov-87
Use the $QACK and $QWTO macros for sending .OMACK and .OMWTO messages.
35 6.1175 7-Feb-88
Add routine A$NPID to obtain NEBULA's PID for suport of INFORMATION
OUTPUT/DESTINATION and CANCEL PRINT /DESTINATION.
36 6.1176 8-Feb-88
When starting a TTY printer on TTYx:, make sure TTYx: is not already
started for another unit.
37 6.1177 11-Feb-88
Add support for specifying that batch log files and spooled files
be scheduled on specified local printers.
40 6.1182 16-Feb-88
Add routines A$EUNP and A$DUNP in support of the ENABLE/DISABLE
UNPRIVILEGED-USER-ENTIRE-REMOTE-OUTPUT-DISPLAY commands.
41 6.1188 19-Feb-88
If a SHUTDOWN message specifies a node not known to QUASAR, cause
routine A$OSHT to send to ORION the "device unknown" message rather than
the "ORION error" message.
42 6.1211 3-Mar-88
Check for LAT printers, in addition to local printers, when processing
a SET FORMS message.
43 6.1225 8-Mar-88
Update copyright notice.
\ ;End of Revision History
SUBTTL Module Storage and Constants
INTERNAL CHRNME,CHLPTY ;[30]
EXTERNAL G$REMN,G$NEBF ;[34]
;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: $QACK (Orion Message Error,Invalid Object Block Specified,,.MSCOD(M))
$RETF
DEVUNK: $QACK (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 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$OSTO ;[30]STOP AN OBJECT
INTERN A$OCON ;CONTINUE AN OBJECT
INTERN A$OSHC ;SHOW CONTROL FILE (EXAMINE)
INTERN A$OREQ ;REQUEUE A JOB
INTERN A$OABT ;[30]ABORT 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$ELPR ;[37]ENABLE SPECIFIC LOG/SPOOL LPT MSG
INTERN A$DLPR ;[37]DISABLE SPECIFIC LOG/SPOOL LPT MSG
INTERN A$ELPT ;[37]ENABLE A LPT FOR LOG/SPOOL MSG
INTERN A$DLPT ;[37]DISABLE A LPT FOR LOG/SPOOL MSG
INTERN A$EUNP ;[40]ENA UNPRIV USERS REMOTE INFO OUT
INTERN A$DUNP ;[40]DIS UNPRIV USERS REMOTE INFO OUT
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 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 A$NPID - Obtain NEBULA's PID
A$NPID: MOVEI S1,SP.NEB ;[35]PICK UP NEBULA'S IPCF INDEX
$CALL C%RPRM ;[35]PICK UP NEBULA'S PID
$RETIF ;[35]INDICATE IF NEBULA IS NOT RUNNING
MOVEM S1,G$NEBP## ;[35]SAVE NEBULA'S PID
$RET ;[35]RETURN TO THE CALLER
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 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.
; P2 is used to contain the /DEVICE: name, so be careful in using ACs.
A$OSTA: $SAVE <P1,P2> ;[36] Save P1, and P2
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
;[36]Check to see if the object has a/DEVICE:x (Physical Device Name)
SETZ P2, ;[36] Clear device name
MOVX S1,.CMDEV ;[36] Want a device block
PUSHJ P,A$FNDB ;[36] See if there is one
JUMPF OSTA.0 ;[36] No
HRLI S1,(POINT 7,0) ;[36] Byte pointer to the ASCIZ string
PUSHJ P,S%SIXB ;[36] Convert it to SIXBIT
PUSHJ P,A$FTTY ;[36] See if device name already exists
JUMPF OSTA.5 ;[36] Yes, we have an error
MOVEM S2,P2 ;[36] Save device name
OSTA.0: MOVE S1,OBJ.TY(P1) ;[36]PICK UP THE LPT TYPE WORD
$CALL CHLPTY ;[30]CHECK FOR A REMOTE PRINTER
MOVE S1,P1 ;[30]PICK UP THE OBJECT BLOCK ADDRESS
JUMPF A$OSS1 ;[30]NOT A REMOTE PRINTER
MOVE S2,P1 ;[30]PICK UP THE OBJECT BLOCK ADDRESS
ADDI S2,OBJ.SZ ;[30]POINT TO THE NAME BLOCK
JRST A$OSS2 ;[30]JOIN THE COMMON CODE
A$ISTA: $SAVE P1
A$OSS1: SETZ S2, ;[30]INDICATE NO NAME BLOCK
A$OSS2: PUSHJ P,GETOBJ ;[30]GET THE OBJECT EQ OR CREATE ONE
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
SKIPN P2 ;[36] Do we have a device name?
JRST OSTA.4 ;[36]No, skip /DEVICE:x stuff
MOVEM P2,OBJPRM+.OOTAP(P1) ;[36] SAVE THE DEVICE NAME FOR LATER
MOVX S1,OBSSPL ;[36] Get spool to tape function
IORM S1,OBJSCH(P1) ;[36] Lite it in the scheduling vector
OSTA.4: $QACK (Startup Scheduled,,OBJTYP(P1),.MSCOD(M)) ;[36]
MOVE S1,P1 ;GET THE OBJECT ADDRESS BACK
PUSHJ P,A$OBST ;SETUP THE OBJECT STATUS.
DOSCHD ;FORCE A SCHEDULING PASS
MOVEI S1,.OTLPT ;[37]PICK UP THE LPT OBJECT TYPE
CAME S1,OBJTYP(P1) ;[37]IS THIS A LOCAL LPT?
JRST OSTA4A ;[37]NO, PREPARE TO CHECK FOR TTY: LPT
MOVEI S1,OBJTYP(P1) ;[37]PICK UP OBJECT DESCRIPTOR ADDRESS
$CALL FNDRTE## ;[37]CHECK FOR A ROUTE TABLE ENTRY
JUMPF OSTA4A ;[37]IF NONE, CHECK FOR A TTY: LPT
LOAD S1,RLSFG1(S1),OB2LOG ;[37]PICK UP LOG/SPOOL BIT VALUE
STORE S1,OBJSC2(P1),OB2LOG ;[37]SAVE IN THE LPT OBJECT
OSTA4A: LOAD S1,OBJTYP(P1),RHMASK ;[37]GET THE OBJECT TYPE
CAIE S1,.OTLPT ;IS IT THE LINE PRINTER ???
$RETT ;[36] No,,just return
;Check to see if Printer has a terminal characteristic
MOVX S1,.ORTCR ;[36] Want TTY CHARACT
PUSHJ P,A$FNDB ;SEE IF THERE IS ONE
JUMPF .RETT ;[32]NOT YET
MOVE S2,(S1) ;[32]GET THE TTY CHARACT
MOVEM S2,OBJTCR(P1) ;[32]SAVE IT
$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
$QACK (Pending shutdown cancelled,,OBJTYP(P1),.MSCOD(M))
$RETT ;RETURN
OSTA.2: $QACK (Already Started,,OBJTYP(P1),.MSCOD(M))
$RETT
OSTA.3: $QACK (<Illegal to start a specific object for IBM node ^N/OBJ.ND(P1)/>,<Use START NODE command>,,.MSCOD(M))
$RETT
;[36] Only place were OSTA.5 is called after is when A$FTTY returns FALSE
;P1 contains the address of the object block we are trying to start
;S1 contains contains the object queue entry that has the same TTY:.
;S2 contains the TTYxxx:
OSTA.5: $QACK (<^W/S2/: is already started as printer ^D/OBJUNI(S1)/>,,0(P1),.MSCOD(M))
$RETT
;Check whether the printer that is being started has the same TTY number as
;an existing printer object.
;
;Accepts S2/TTYxxx
;Returns S2/TTYxxx S1/object entry address
; true if no object found
; false if there is already an existing printer object with same TTY
;(note:preserves S2)
A$FTTY: LOAD S1,HDROBJ##+.QHLNK,QH.PTF ;[36] Get the first object entry
SKIPA ;[36] Skip the first time through
FTTY.1: LOAD S1,.QELNK(S1),QE.PTN ;[36] Get the next object entry address
JUMPE S1,.RETT ;[36] If no entries or end, return true
CAME S2,OBJPRM+.OOTAP(S1) ;[36] Do TTY match?
JRST FTTY.1 ;[36] No,,try next object
$RETF ;[36] Found one, false return
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
$QACK (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
$QACK (<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 DEVUNK ;[41]If not there, then unknown device
LOAD S1,NETSTS(S2),NETIBM ;Get the IBM status
SKIPE S1 ;Is it IBM object?
JRST A$SH.3 ;Yes, not allowed
MOVE S1,OBJ.TY(P1) ;[30]PICK UP THE LPT TYPE WORD
$CALL CHLPTY ;[30]CHECK IF OBJECT IS A REMOTE LPT
SETZ S2, ;[30]ASSUME NO NAME BLOCK
SKIPF ;[30]SKIP IF NOT A REMOTE LPT
MOVEI S2,OBJ.SZ(P1) ;[30]PICK UP NAME BLOCK ADDRESS
A$OSH1: MOVE S1,P1 ;[30]PICK UP OBJECT 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.
$QACK (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: $QACK (<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 ???
$QACK (<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: $QACK (<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
MOVE S1,OBJ.TY(P1) ;[30]PICK UP THE OBJECT TYPE
$CALL CHLPTY ;[30]CHECK FOR A REMOTE LPT
JUMPF OSET.3 ;[30]IF NOT, DON'T PICK UP NAME ADR
MOVE S2,P1 ;[30]PICK UP OBJECT BLOCK ADDRESS
ADDI S2,OBJ.SZ ;[30]POINT TO THE NAME BLOCK
SKIPA ;[30]DON'T RESET ADDRESS
OSET.3: SETZ S2, ;[30]INDICATE NO NAME BLOCK
MOVE S1,P1 ;[30]PICK UP THE OBJECT BLOCK 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) ;[42]PICK UP THE OBJECT TYPE
CAMN S2,[.OTLPT] ;[42]A LOCAL PRINTER?
SKIPA ;[42]YES, SET FORMS CHANGE STATUS
CAMN S2,[.LALPT!.OTLPT] ;[42]A LAT PRINTER?
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: $QACK (Set Accepted,,OBJTYP(P1),.MSCOD(M))
;**;[21]Delete 2 lines at SETMSG:+1L JCR 5/8/86
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: $QACK (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: $QACK (<Set ignored>,<Object already started>,OBJTYP(P1),.MSCOD(M))
$RETF
SETE.2: $QACK (<Set ignored>,<Node must be an SNA Workstation>,OBJTYP(P1),.MSCOD(M))
$RETF
SETE.3: $QACK (<Set ignored>,<Could not create object block>,OBJTYP(P1),.MSCOD(M))
$RETF
SETE.4: $QACK (<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.
$QACK (<Set for Node ^T/NETASC(P1)/ Accepted>,,,.MSCOD(M))
$RETT ;RETURN
NETS.2: $QACK(<Set for Node ^N/S1/ Ignored>,<It is Not Defined as an IBM Remote>,,.MSCOD(M))
$RETT
NETS.3: $QACK (<Set for Node ^T/NETASC(S2)/ Ignored>,<^I/0(S1)/>,,.MSCOD(M))
$RETT
NETS.4: $QACK (<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
$QACK (<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 ???
$QACK (<No Requests Modified>,,,.MSCOD(M))
CAIN S1,1 ;JUST 1 JOB ???
$QACK (<1 Request Modified>,,,.MSCOD(M))
CAILE S1,1 ;MORE THEN 1 JOB ???
$QACK (<^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$ELPR - Enable Specific LPT objects to process LOG/SPOOL req
A$ELPR: SETOM G$LOGF## ;[37]INDICATE SPECIFIC LOG/SPOOL ENA
DOSCHD ;[37]FORCE A SCHEDULING PASS
$ACK (Specific printers for log/spool files enabled,,,.MSCOD(M))
$RETT ;[37]RETURN TO THE CALLER
A$DLPR: SETZM G$LOGF## ;[37]]]INDICATE SPECIFIC LOG/SPOOL DIS
DOSCHD ;[37]FORCE A SCHEDULING PASS
$ACK (Specific printers for log/spool files disabled,,,.MSCOD(M))
$RETT ;[37]RETURN TO THE CALLER
SUBTTL A$ELPT - Enable a specific LPT object to process LOG/SPOOL
A$ELPT: SETOM G$EDFG## ;[37]]INDICATE ENABLE
SKIPA ;[37]DON'T RESET THE FLAG
A$DLPT: SETZM G$EDFG## ;[37]INDICATE DISABLE
SKIPE G$LOGF## ;[37]SPECIFIC LOG/SPOOL ENABLED?
JRST AELP.1 ;[37]YES, PROCEED PROCESSING
$ACK (Specific printers for log/spool files not enabled - command ignored,,,.MSCOD(M))
$RETT ;[37]RETURN TO THE CALLER
AELP.1: $SAVE <P1,P2> ;[37]SAVE THESE AC
SETZ P2, ;[37]INDICATE NO OBJECT, ROUTE TABLE
MOVEI S1,.OROBJ ;[37]WANT TO FIND THE OBJECT BLOCK
$CALL A$FNDB ;[37]FIND THE OBJECT BLOCK
JUMPF BADMSG ;[37]QUIT IF CAN'T FIND IT
$CALL ORANGE ;[37]CHECK FOR A RANGE
MOVE P1,S1 ;[37]SAVE THE OBJECT BLOCK DATA FIELD
SETZ S2, ;[37]INDICATE NO LPT NAME BLOCK
$CALL A$FOBJ ;[37]FIND THE LPT OBJECT QUEUE ENTRY
JUMPF AELP.2 ;[37]NO LPT OBJECT, CHECK ROUTE TABLE
MOVE P2,S1 ;[37]INDICATE LPT OBJECT FOUND
MOVE S2,G$EDFG## ;[37]PICK UP THE ENA/DIS FLAG VALUE
STORE S2,OBJSC2(S1),OB2LOG ;[37]SAVE IN THE LPT OBJECT ENTRY
AELP.2: MOVEI S1,OBJ.TY(P1) ;[37]PICK UP OBJECT BLOCK ADDRESS
$CALL FNDRTE## ;[37]CHECK IF IT IS IN THE ROUTE TBL
JUMPF AELP.3 ;[37]IF NOT, SEND A RESPONSE TO ORION
MOVE S2,G$EDFG## ;[37]PICK UP THE ENA/DIS FLAG VALUE
MOVEM S2,RLSFG1(S1) ;[37]SAVE IN THE ROUTE TABLE ENTRY
MOVE P2,S1 ;[37]INDICATE ROUTE TABLE ENTRY FOUND
AELP.3: SKIPE P2 ;[37]OBJECT/ROUTE ENTRY FOUND?
JRST AELP.4 ;[37]YES, INFORM THE OPERATOR
$ACK (Printer not known,,OBJ.TY(P1),.MSCOD(M)) ;[37]
$RETT ;[37]RETURN TO THE CALLER
AELP.4: MOVE S1,G$EDFG## ;[37]PICK UP ENABLE/DISABLE FLAG
JUMPE S1,AELP.5 ;[37]IF DISABLE, INDICATE SO
$ACK (Enabled for log/spool files,,OBJ.TY(P1),.MSCOD(M))
DOSCHD ;[37]YES, FORCE A SCHEDULING PASS
$RETT ;[37]RETURN TO THE CALLER
AELP.5: $ACK (Disabled for log/spool files,,OBJ.TY(P1),.MSCOD(M))
$RETT ;[37]RETURN TO THE CALLER
SUBTTL A$EUNP - ENABLE UNPRIV'D USERS REMOTE INFO OUTPUT DISPLAY
A$EUNP: SETOM G$RPRV## ;[40]ENA UNPRIV USER REMOTE INFO OUT
$ACK (Unpriv'd users enabled to see entire remote output queues,,,.MSCOD(M))
$RETT ;[40]RETURN
SUBTTL A$DUNP - DISABLE UNPRIV'D USERS REMOTE INFO OUTPUT DISPLAY
A$DUNP: SETZM G$RPRV## ;[40]DIS UNPRIV USER REMOTE INFO OUT
$ACK (Unpriv'd users disabled from seeing entire remote output queues,,,.MSCOD(M))
$RETT ;[40]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
MOVE S1,OBJ.TY(P1) ;[30]PICK UP THE OBJECT TYPE WORD
$CALL CHLPTY ;[30]CHECK FOR A REMOTE PRINTER
SETZ S2, ;[30]ASSUME NOT A REMOTE PRINTER
SKIPF ;[30]SKIP IF NOT A REMOTE PRINTER
MOVEI S2,OBJ.SZ(P1) ;[30]PICK UP THE NAME BLOCK ADDRESS
A$RQ.1: MOVE S1,P1 ;[31]PICK UP THE OBJECT BLOCK ADDRESS
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: $QACK (Not Active,,OBJTYP(P1),.MSCOD(M))
$RETT
A$RQ.3: $QACK (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
MOVE S1,OBJ.TY(P1) ;[30]PICK UP THE LPT TYPE WORD
$CALL CHLPTY ;[30]CHECK FOR A REMOTE PRINTER
SETZ S2, ;[30]ASSUME NOT A REMOTE PRINTER
SKIPF ;[30]SKIP IF NOT A REMOTE PRINTER
MOVEI S2,OBJ.SZ(P1) ;[30]PICK UP THE OBJECT BLOCK ADDRESS
A$CO.1: MOVE S1,P1 ;[31]PICK UP THE OBJECT BLOCK ADDRESS
PUSHJ P,A$FOBJ ;[30]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
$QACK (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: $QACK (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$OABT: PJRST A$OREQ ;[30]PROCESS THE ABORT 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
SETZ S2, ;[31]THERE IS NO NAME BLOCK
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 !!
$QACK (<Not Active>,,OBJTYP(S1),.MSCOD(M))
$RETT ;JUST RETURN
A$OSHC: PJRST A$COMM ;PROCESS THE SHOW CONTROL FILE COMMAND.
SUBTTL A$OSTO - STOP OPERATOR MESSAGE PROCESSOR
A$OSTO: 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
MOVE S1,OBJ.TY(P1) ;[30]PICK UP THE LPT TYPE WORD
$CALL CHLPTY ;[30]CHECK FOR A REMOTE PRINTER
SETZ S2, ;[30]ASSUME NOT A REMOTE PRINTER
SKIPF ;[30]SKIP IF NOT A REMOTE PRINTER
MOVEI S2,OBJ.SZ(P1) ;[30]PICK UP THE OBJECT BLOCK ADDRESS
A$OS.1: MOVE S1,P1 ;[31]PICK UP THE OBJECT BLOCK ADDRESS
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 OSTO.1 ;NO,,SKIP THIS
LOAD S1,OBJSCH(P1),OBSBUS ;IS THE DEVICE ACTIVE ???
JUMPE S1,OSTO.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
OSTO.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 ???
OSTO.2: MOVEI S2,[ASCIZ/Stopped/] ;NO,,JUST SAY STOPPED
$QACK (^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 ???
$QACK (<No jobs^T/0(S2)/>,,,.MSCOD(M))
CAIN S1,1 ;IS THERE ONLY 1 JOB ???
$QACK (<1 Job^T/0(S2)/>,,,.MSCOD(M))
CAILE S1,1 ;MORE THEN 1 JOB ???
$QACK (<^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 !!!
$QACK (<No Jobs Canceled>,,,.MSCOD(M))
CAIN S1,1 ;1 JOB KILLED !!!
$QACK (<1 Job Canceled>,,,.MSCOD(M))
CAILE S1,1 ;MORE THE 1 JOB !!!
$QACK (<^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
$QACK (< ^T/DEFTAB(P4)/efine for node ^T/NETASC(P2)/ accepted >,,,.MSCOD(M))
$RETT ;AND RETURN
DEFBD1: $QACK(< 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: $QACK (< 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
SETZ S2, ;[31]NO NAME 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: $QWTO(<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
MOVE S1,OBJ.TY(S1) ;[31] PICK UP THE OBJECT TYPE
$CALL CHLPTY ;[31] IS IT A REMOTE LPT?
SETZ S2, ;[31] ASSUME THERE IS NO NAME BLOCK
SKIPF ;[31] SKIP IF THERE IS NOT ONE
MOVEI S2,OBJ.SZ(P1) ;[31] PICK UP THE NAME BLOCK
MOVE S1,P1 ;[31] PICK UP 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] DO THE OBJECTS MATCH?
JRST NEXT.3 ;[31] NO, CHECK FOR A LPT OBJECT
PUSHJ P,Q$CDEP## ;[NXT] MAKE SURE NO DEPENDIENCIES
JUMPF NEXT.5 ;[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
$QACK (<NEXT request #^D/S1/ scheduled>,,OBJTYP(P1),.MSCOD(M))
$RETT ;[NXT] RETURN
NEXT.2: $QACK (<NEXT request #^D/AP/ does not exist>,,,.MSCOD(M))
$RETT ;[NXT] RETURN
NEXT.3: LOAD S2,OBJTYP(P1),AR.TYP ;[31] PICK UP THE OBJECT'S OBJECT TYPE
CAIE S2,.OTLPT ;[31] IS IT A LPT OBJECT?
JRST NEXT.4 ;[31] NO, INDICATE ILLEGAL DEVICE
TXNE S1,.UNLPT ;[31] UNKNOWN LPT TYPE QE?
JRST NEXT.5 ;[31] YES, INDICATE NOT SCHEDULABLE
NEXT.4: $QACK (<Illegal device specified for NEXT request #^D/.QERID(AP)/>,,,.MSCOD(M))
$RETT ;[NXT] RETURN
NEXT.5: $QACK (<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$CNAM ;[30]COPY OVER A LPT NAME
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
INTERN A$NPID ;[35]PICK UP NEBULA'S PID
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
HRRZS S1 ;[31]ISOLATE THE OBJECT TYPE CODE
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$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$CNAM - COPY OVER A LPT NAME
;**;[30]A$CNAM IS PART OF THIS EDIT
;A$CNAM is called to copy a LPT name from one location to another
;
;Call is: S1/Source LPT name block
; S2/Destination LPT name block
A$CNAM: MOVSS S1 ;SOURCE,,0
HRR S1,S2 ;SOURCE,,DESTINATION
ADDI S2,LPTNLN ;[31]ADD IN THE LENGTH OF THE BLOCK
BLT S1,-1(S2) ;[31]COPY IT OVER
$RET ;RETURN TO THE CALLER
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
$CALL .SAVE1 ;[31]SAVE THIS AC
SETZ S2, ;[31]ASSUME NO NAME BLOCK
MOVE P1,OBJ.TY(S1) ;[31]PICK UP THE OBJECT TYPE WORD
TXNE P1,.DQLPT!.LALPT ;[31]IS THIS A REMOTE LPT?
MOVEI S2,STU.RB+OBJ.SZ(M) ;[31]YES, PICK UP THE NAME BLOCK ADR
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 ;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),AR.TYP ;[31]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/ ADDRESS TO AN OBJECT BLOCK
; S2/ ADDRESS OF REMOTE LPT NAME BLOCK OR 0
;T RET: S1/ ADDRESS TO AN OBJ QUEUE ENTRY
GETOBJ: $SAVE <P1,P2,P3> ;[30]SAVE THESE AC
MOVE P1,S1 ;SAVE THE ARGUMENT
MOVE P3,S2 ;[30]SAVE NAME BLOCK ADDRESS
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
MOVE S2,P3 ;[30]PICK UP NAME BLOCK ADDRESS
PUSHJ P,A$FOBJ ;FIND THE OBJECT QUEUE ENTRY
JUMPT .POPJ ;[30]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
$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,OBJ.TY(P1) ;[30]PICK UP LPT TYPE WORD
$CALL CHLPTY ;[30]CHECK FOR A REMOTE PRINTER
JUMPF GETO.0 ;[30]SKIP THE FOLLOWING IF NOT REMOTE
MOVEI S1,OBJ.SZ(P1) ;[30]ADDRESS OF THE NAME BLOCK
MOVEI S2,OBJNAM(AP) ;[30]WHERE TO MOVE NAME BLOCK TO
$CALL A$CNAM ;[30]COPY OVER THE NAME BLOCK
GETO.0: LOAD S1,OBJTYP(AP),AR.TYP ;[31]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
LOAD S2,OBJTYP(AP),RHMASK ;[30]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
LOAD P1,OBJTYP(AP),RHMASK ;[30]PICK UP THE OBJECT TYPE
GETO.1: JUMPE E,GETO11 ;[30]LINK AT END IF NONE LEFT
LOAD S1,OBJTYP(E),RHMASK ;[30]GET OBJECT TYPE OF NEW ONE
CAMN P1,S1 ;[30]ARE THEY THE SAME?
JRST GETO.2 ;[30]YES, CONTINUE ON
LOAD E,.QELNK(E),QE.PTN ;;[30]GET THE NEXT OBJECT QE
JRST GETO.1 ;AND LOOP
GETO.2: CAIE S1,.OTLPT ;[30]IS THIS A LPT OBJECT
JRST GETO.9 ;[30]NO, CHECK FOR THE SAME NODE
HLLZ P2,OBJTYP(AP) ;[30]PICK UP THE TYPE OF LPT
ROT P2,PRIVAL ;[30]TRANSLATE TO PRIORITY VALUE
GETO.3: HLLZ P3,OBJTYP(E) ;[30]PICK UP THE TYPE OF LPT
ROT P3,PRIVAL ;[30]TRANSLATE TO PRIORITY VALUE
CAMGE P2,P3 ;[30]IS NEW OBJECT OF HIGHER PRIORITY?
JRST GETO11 ;[30]YES, GO LINK IN HERE
CAMG P2,P3 ;[30]IS NEW OBJECT OF HIGHER PRIORITY?
JRST GETO.4 ;[30]LPT OBJECTS OF SAME PRIORITY
LOAD E,.QELNK(E),QE.PTN ;[30]PICK UP THE NEXT OBJECT
JUMPE E,GETO11 ;[30]IS NO MORE, THEN LINK IN
LOAD P3,OBJTYP(E),RHMASK ;[30]PICK UP THIS OBJECT'S TYPE
CAME S1,P3 ;[30]STILL A LPT OBJECT?
JRST GETO11 ;[30]NO, GO LINK IN HERE
JRST GETO.3 ;[30]CHECK THE TYPE OF LPT
;THE OBJECTS ARE BOTH LPTS OF THE SAME TYPE
GETO.4: SKIPN P2 ;[30]IS THIS A LOCAL LPT?
JRST GETO.9 ;[30]YES, TREAT AS OTHER OBJECTS
CAIN P2,.CLPRI ;[30]IS THIS A CLUSTER LPT?
JRST GETO.9 ;[30]YES, TREAT AS OTHER OBJECTS
CAIE P2,.DQPRI ;[30]IS THIS A DQS LPT?
JRST GETO.5 ;[30]NO, CHECK FOR A LAT LPT
;BOTH ARE DQS LPTS. IF THE NODE NAMES ARE THE SAME, THEN CHECK ON VMS
;QUEUE NAMES
$CALL CMPNOD ;[30]CHECK OUT THE NODE NAMES
JUMPF GETO11 ;[30]LINK IN IF NODE NAME HIGHEST
MOVE S1,OBJNOD(AP) ;[30]PICK UP NEW OBJECT'S NODE NAME
CAME S1,OBJNOD(E) ;[30]ARE THEY THE SAME?
JRST GETO11 ;[30]NO, LINK IN HERE
$CALL CMPNAM ;[30]SEARCH FOR SMALLEST Q.N.
JRST GETO11 ;[30]GO LINK IN HERE
;BOTH ARE LAT LPTS. IF THE NODE NAMES ARE THE SAME, THEN CHECK IF BOTH
;ARE PORTS OR SERVICES
GETO.5: CAIN P2,.LAPRI ;[30]IS THIS A LAT LPT?
JRST GETO.6 ;[30]YES, GO CHECK NODE NAME
$QACK (<Invalid printer type specified>,,OBJTYP(AP),.MSCOD(M))
$RETF ;[30]INDICATE ERROR
GETO.6: LOAD S1,OBJNAM(AP),AR.TYP ;[30]PICK UP THE NAME TYPE
LOAD S2,OBJNAM(E),AR.TYP ;[30]PICK UP THE NAME TYPE
CAMN S1,S2 ;[30]ARE THEY THE SAME?
JRST GETO.7 ;[30]YES, CHECK THE NODE NAMES
CAIN S1,.KYPOR ;[30]PORT NAME SPECIFIED?
JRST GETO11 ;[30]YES, GO LINK IN HERE
MOVE S1,OBJTYP(AP) ;[30]PICK UP OBJECT TYPE
GETO6A: LOAD E,.QELNK(E),QE.PTN ;[30]PICK UP THE NEXT OBJECT
JUMPE E,GETO11 ;[30]LINK IN HERE IF NO MORE QE
CAME S1,OBJTYP(E) ;[30]STILL SAME TYPE?
JRST GETO11 ;[30]LINK IN HERE
LOAD S2,OBJNAM(E),AR.TYP ;[30]PICK UP THE NAME TYPE
CAIE S2,.KYSER ;[30]A SERVER NAME?
JRST GETO6A ;[30]NO, PICK UP THE NEXT ENTRY
GETO.7: $CALL CMPNOD ;[30]CHECK OUT THE NODE NAMES
JUMPF GETO11 ;[30]LINK IN IF NODE NAME HIGHEST
CAME S1,OBJNOD(E) ;[30]ARE THEY THE SAME?
JRST GETO11 ;[30]NO, LINK IN HERE
;LAT PRINTERS WITH SAME TYPE (PORT AND PORT, OR SERVICE AND SERVICE)
GETO.8: $CALL CMPNAM ;[30]COMPARE THE NAMES
JRST GETO11 ;[30]GO LINK IN HERE
;A NON-LPT OBJECT OR A LOCAL OR CLUSTER LPTSPL
GETO.9: $CALL CMPNOD ;[30]CHECK THE NODE NAMES
JUMPF GETO11 ;[30]IF GREATEST, LINK IN HERE
GETO10: MOVE S1,OBJNOD(AP) ;GET NODE OF NEW ONE
CAME S1,OBJNOD(E) ;SAME AS ENTRY IN LIST?
JRST GETO11 ;[30]NO, JUST LINK IT IN
MOVE S1,OBJUNI(AP) ;GET THE UNIT NUMBER
CAMG S1,OBJUNI(E) ;SEARCH FOR A BIGGER ONE
JRST GETO11 ;[30]GOT IT, LINK IT
LOAD E,.QELNK(E),QE.PTN ;GET NEXT
JUMPE E,GETO11 ;[30]END, LINK IT IN
MOVE S1,OBJTYP(AP) ;GET THE OBJECT TYPE
CAMN S1,OBJTYP(E) ;STILL THE SAME?
JRST GETO10 ;[30]YES, LOOP
GETO11: PUSHJ P,M$LINK## ;[30]LINK IN THE ENTRY
MOVE S1,AP ;POINT THE ANSWER TO IT
$RETT ;AND RETURN
SUBTTL CMPNOD - COMPARE TWO OBJECT NODES
;**;[30]CMPNOD IS A PART OF THIS EDIT
;CMPNOD is called as part of linking in a new object into the object queue.
;
;Call is: AP/ Address of the object to be linked in
; E/ Address of current object in object queue being looked at
;Returns true: S1/Node name of object to be linked in
; The object to be linked in has a node name less or equal to
; last object compared in the object queue
;Returns false: The object has the largest node name and should be linked
; in at the current location in the object queue
CMPNOD: MOVE S1,OBJNOD(AP) ;PICK UP NODE NAME OF NEW OBJECT
CAMG S1,OBJNOD(E) ;GREATER THAN THE CURRENT NODE NAME?
$RETT ;NO, RETURN NOW
LOAD E,.QELNK(E),QE.PTN ;GET THE NEXT OJBECT
JUMPE E,.RETF ;NO MORE, INDICATE LINK IN HERE
MOVE S1,OBJTYP(AP) ;PICK UP THE OBJECT TYPE
CAME S1,OBJTYP(E) ;STILL THE SAME OBJECT TYPE?
$RETF ;NO, INDICATE LINK IN HERE
JRST CMPNOD ;CHECK THIS ENTRY
SUBTTL CMPNAM - COMPARE TWO NAMES OF LPT OBJECTS
;**;[30]CMPNAM IS A PART OF THIS EDIT
;CMPNAM is called as part of linking in a new DQS or LAT object into the
;object queue. It determines where the object is to be linked in.
;
;Call is: AP/ Address of the object to be linked in
; E/ Address of current object in object queue being looked at
;Returns: The location in the object queue where the object is to be
; linked in at.
CMPNAM: MOVEI S1,OBJNAM(AP) ;PICK UP NAME BLOCK ADDRESS
MOVEI S2,OBJNAM(E) ;PICK UP NAME BLOCK ADDRESS
$CALL CHRNME ;COMPARE THE NAMES
TXNN S1,SC%GTR ;NAME GREATER?
$RET ;NO, GO LINK IN HERE
LOAD E,.QELNK(E),QE.PTN ;PICK UP THE NEXT OBJECT
JUMPE E,.POPJ ;LINK IN HERE IF NO MORE QE
MOVE S1,OBJTYP(AP) ;PICK UP THE OBJECT TYPE
CAMN S1,OBJTYP(E) ;STILL THE SAME TYPE?
JRST CMPNAM ;YES, CHECK THIS OBJECT
$RET ;LINK IN HERE
SUBTTL CHKOBJ - ROUTINE TO VALIDATE OBJECT BLOCK REQUESTS.
CHKOBJ: LOAD S1,OBJ.TY(P1),RHMASK ;[30]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.
$QACK (<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
$QACK (<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.
$QACK (<Batch stream maximum exceeded>,,0(P1),.MSCOD(M)) ;TELL OPR
SETZM G$NBAT## ;RESET THE COUNT TO 0.
$RETF ;RETURN.
CHKO.3: $QACK (<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
$QACK (<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.
$QACK (<Ignored>,<Invalid unit for SNA-Workstation>,0(P1),.MSCOD(M)) ;TELL OPR
$RETF ;RETURN FALSE.
SUBTTL A$FOBJ -- Find an entry in the object queue
;CALL: S1/ An Object Block Address
; S2/ Address of the name block if doing remote printing processing
; S2/ 0 if not doing remote printing processing
;
;RET: S1/ The address of the object queue entry or false
A$FOBJ: $SAVE <T1,T2,T3,T4,P1> ;[30]SAVE THESE AC
MOVE P1,S2 ;[30]SAVE THE POSSIBLE NAME ADDRESS
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
SKIPG P1 ;[30]A REMOTE PRINTER BLOCK?
JRST FOBJ.2 ;[30]NO, SO HAVE THE OBJECT QE
MOVEI S1,0(P1) ;[30]PICK UP NAME BLOCK ADDRESS
MOVEI S2,OBJNAM(T4) ;[30]PICK UP NAME BLOCK ADDRESS
$CALL CHRNME ;[30]COMPARE THE NAMES
JUMPF FOBJ.1 ;[30]IF THE SAME, CHECK NEXT OBJECT
FOBJ.2: MOVE S1,T4 ;[30]GET THE OBJECT QE ADDRESS
$RETT ;AND RETURN
SUBTTL CHRNME -- Compare two names
;**;[30]Routine CHRNME is a part of this edit.
;CHRNME is called to compare DQS VMS queue names, LAT PORT names, LAT SERVICE
;names, or LAT SERVER names.
;
;Call is: S1/Address of name block to compare
; S2/Address of name block to compare
;Returns true: The names are the same and of the same type
;Returns false: The names are different or not of the same type
;In both cases: S1/Flags from the compare
CHRNME: $SAVE <P1,P2> ;SAVE THESE AC
DMOVE P1,S1 ;SAVE THE ADDRESSES
LOAD S1,ARG.HD(P1),AR.TYP ;PICK UP THE NAME TYPE
LOAD S2,ARG.HD(P2),AR.TYP ;PICK UP THE NAME TYPE
CAME S1,S2 ;ARE THEY THE SAME?
$RETF ;NO, INDICATE TO THE CALLER
HRROI S1,ARG.DA(P1) ;POINT TO THE NAME
HRROI S2,ARG.DA(P2) ;POINT TO THE NAME
$CALL S%SCMP ;COMPARE THE NAMES
TXNE S1,SC%LSS!SC%SUB!SC%GTR ;ARE THEY THE SAME?
$RETF ;NO, INDICATE TO THE CALLER
$RETT ;YES, INDICATE TO THE CALLER
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 CHLPTY - CHECK FOR A REMOTE PRINTER TYPE
;**;[30]CHKLPTY IS A PART OF THIS EDIT
;CHLPTY is called to determine if an object is a remote printer object
;
;Call is: S1/OBJECT type word
;Returns true: The object is a remote printer
;Returns false: The object is not a remote printer
;(Note: S1 is preserved)
CHLPTY: TXNN S1,.DQLPT ;IS THIS A DQS PRINTER?
TXNE S1,.LALPT ;NO, IS IT A LAT PRINTER?
$RETT ;INDICATE OBJECT IS A REMOTE PRINTER
$RETF ;INDICATE OBJECT IS NOT A REM PRINTER
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