Trailing-Edge
-
PDP-10 Archives
-
bb-jr93e-bb
-
7,6/ap016/catlog.x16
There are 2 other files named catlog.x16 in the archive. Click here to see a list.
TITLE CATLOG - DECsystem10 Mountable Device Catalog Daemon
SUBTTL D. Mastrovito /DPM 26-Nov-85
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1986. ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE INCLUSION
;OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER COPIES THEREOF
;MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO
;TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH CATPRM ;CATALOG DEFINITIONS
CATDEF (CATLOG) ;DEFINE COMMON PARAMETERS
LOC <.JBVER==:137>
EXP %%CAT ;VERSION NUMBER
RELOC 0
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983,1986. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
; GLXLIB Initialization Block
IB: $BUILD (IB.SZ) ;SIZE OF BLOCK
$SET (IB.PRG,FWMASK,%%.MOD) ;PROGRAM NAME
$SET (IB.FLG,IP.STP,1) ;SEND STOPCODES TO ORION
$SET (IB.PIB,FWMASK,PIB) ;ADDRESS OF PIB
$SET (IB.INT,FWMASK,VECTOR) ;ADDRESS OF PSI VECTORS
$EOB ;END OF BLOCK
; PID Initialization Block
PIB: $BUILD (PB.MNS) ;SIZE OF BLOCK
$SET (PB.HDR,PB.LEN,PB.MNS) ;LENGTH OF THIS BLOCK
$SET (PB.FLG,IP.PSI,1) ;USE PSI FOR IPCF
$SET (PB.FLG,IP.RSE,1) ;RETURN ON SEND FAILURES
; $SET (PB.FLG,IP.JWP,1) ;USE A JOB-WIDE PID
$SET (PB.FLG,IP.SPF,1) ;CREATE A SYSTEM PID
$SET (PB.INT,IP.CHN,IPCOFS) ;OFFSET TO IPCF INTRUPT BLOCK
$SET (PB.INT,IP.SPI,SP.CAT) ;PID IS FOR [SYSTEM]CATALOG
$SET (PB.SYS,IP.SQT,^D511) ;INFINITE SEND QUOTA
$SET (PB.SYS,IP.RQT,^D511) ;INFINITE RECEIVE QUOTA
$EOB
G$PDL:: BLOCK PDLSIZ ;PUSH DOWN LIST
G$UDT:: BLOCK 1 ;CURRENT DATE/TIME
G$SAB:: BLOCK SAB.SZ ;IPCF SEND ARGUMENT BLOCK
G$MSG:: BLOCK PAGSIZ+1 ;IPCF MESSAGE STORAGE
G$SND:: BLOCK 1 ;SENDER'S PID
G$SID:: BLOCK 1 ;SENDER'S ID
G$PRV:: BLOCK 1 ;SENDER'S PRIVS
G$FLG:: BLOCK 1 ;IPCF RECEIVE FLAGS
G$IDX:: BLOCK 1 ;SENDER'S SPECIAL PID INDEX
G$ACK:: BLOCK 1 ;NON-ZERO IF SENDER WANTS AN ACK
G$COD:: BLOCK 1 ;ACK CODE
G$QSTR::BLOCK 1 ;QUEUE STRUCTURE
G$SPPN::BLOCK 1 ;SYSTEM FILE PPN
G$SPRT::BLOCK 1 ;SYSTEM FILE PROTECTION
G$GLXN: BLOCK 1 ;GALAXY WORLD NAME
G$APLT::BLOCK 1 ;APPLICATION NAME
G$APLV::BLOCK 1 ;APPLICATION NAME AND VERSION
IPCQUE: BLOCK 1 ;IPCF RESEND QUEUE LINKED LIST
OPRPID: BLOCK 1 ;[SYSTEM]OPERATOR PID
MDAPID: BLOCK 1 ;[SYSTEM]MDA PID
RSENDC: BLOCK 1 ;COUNT OF RESENDS NEEDED
ERRPTR: BLOCK 1 ;ERROR BUFFER BYTE POINTER
ERRCNT: BLOCK 1 ;ERROR COUNTER
ERRFLG: BLOCK 1 ;ERROR FLAGS, CLASS, AND CODE
ERRTXT: BLOCK 1 ;ERROR ITEXT BLOCK ADDRESS
ERRBUF: BLOCK ERRLEN ;ERROR BUFFER
MSGLEN: BLOCK 1 ;REQUESTED MESSAGE LENGTH
MSGBLK: BLOCK 1 ;ADDRESS OF CURRENT BLOCK IN MESSAGE
MSGCNT: BLOCK 1 ;COUNT OF MESSAGE BLOCKS TO PROCESS
APLPPN: BLOCK 1 ;OUR PPN
APLCOD: BLOCK 1 ;APPLICATION CODE
ENTBLK::BLOCK PAGSIZ ;FILE ENTRY
CNVBLK::BLOCK PAGSIZ ;CONVERSION FILE ENTRY
VECTOR:! ;PSI VECTORS
VECIPC: BLOCK 4 ;IPCF VECTOR
IPCOFS==<VECIPC-VECTOR> ;IPCF VECTOR OFFSET
.LNKEN 1,C$DSP ;START OF DISPATCH VECTOR CHAIN
C$DSP:: BLOCK 1 ;FILLED IN BY LINK
CATLOG: JFCL ;NO CCL ENTRY
MOVE P,[IOWD PDLSIZ,G$PDL] ;SET UP STACK
MOVEI S1,IPCINT ;IPCF INTERRUPT ROUTINE ADDRESS
MOVEM S1,VECIPC+.PSVNP ;SAVE IN VECTOR
MOVEI S1,IB.SZ ;IB LENGTH
MOVEI S2,IB ;IB ADDRESS
PUSHJ P,I%INIT## ;FIRE UP GLXLIB
$CALL I%ION ;TURN ON THE PSI SYSTEM
PUSHJ P,INITIA ;INITIALIZE
MAIN: SKIPE RSENDC ;MEESAGES TO RESEND?
PUSHJ P,RESEND ;TRY TO DO THEM NOW
PUSHJ P,IPCF ;TRY TO PROCESS IPCF MESSAGES
MOVEI S1,ZZTIME ;TIME TO SNOOZE
$CALL I%SLP ;ZZZZZZ
PUSHJ P,PIDCHK ;CHECK THE PIDS
JRST MAIN ;BACK TO TOP LEVEL
SUBTTL Initialization
INITIA: MOVEI S1,GLXNM1 ;ASSUME NORMAL PRODUCTION MODE
SKIPE DEBUGW ;DEBUGGING?
MOVEI S1,GLXNM2 ;YES
MOVEM S1,G$GLXN ;SAVE
$CALL L%CLST ;CREATE A NEW ONE
MOVEM S1,IPCQUE ;SAVE HANDLE
PUSHJ P,OPRINI ;INIT [SYSTEM]OPERATOR INTERFACE
PUSHJ P,MDAINI ;INIT [SYSTEM]MDA INTERFACE
POPJ P, ;RETURN
GLXNM1: ITEXT (<[SYSTEM]>)
GLXNM2: ITEXT (<^U/DEBUGW/>)
SUBTTL Initialization -- [SYSTEM]OPERATOR interface
OPRINI: MOVEI S1,SP.OPR ;GET [SYSTEM]OPERATOR PID INDEX
$CALL C%RPRM ;ASK FOR THE PID
JUMPT OPRI.1 ;JUMP IF WE HAVE IT
MOVEI S1,1 ;TIME TO WASTE
$CALL I%SLP ;ZZZZZZ
JRST OPRINI ;TRY AGAIN
OPRI.1: MOVEM S1,OPRPID ;SAVE FOR POSTERITY
MOVEI M,AHLMSG ;POINT TO APPLICATION HELLO MSG
PUSHJ P,C$SOPR ;SEND TO ORION
SETZM APLCOD ;NO APPLICATION CODE YET
MOVNI S1,1 ;-1 FOR OUR JOB
MOVEI S2,JI.USR ;NEED OUR PPN
$CALL I%JINF ;ASK FOR IT
MOVEM S2,APLPPN ;SAVE IT AWAY
MOVEI S1,APLTX1 ;ASSUME [SYSTEM]CATALOG
SKIPE DEBUGW ;DEBUGGING?
MOVEI S1,APLTX2 ;YES--THEN IT'S A PRIVATE ONE
MOVEM S1,G$APLT ;SAVE
MOVEI S1,APLTX3 ;ASSUME [SYSTEM]CATALOG %XXX
SKIPE DEBUGW ;DEBUGGING?
MOVEI S1,APLTX4 ;YES--THEN IT'S A PRIVATE ONE
MOVEM S1,G$APLV ;SAVE
POPJ P, ;RETURN
; Application HELLO message
AHLMSG: $BUILD (.OHDRS) ;SIZE OF BLOCK
$SET (.MSTYP,MS.TYP,.OMAHL) ;APPLICATION HELLO CODE
$SET (.MSTYP,MS.CNT,AHLLEN) ;LENGTH
$SET (.OARGC,,1) ;1 ARGUMENT BLOCK
$EOB ;END OF BLOCK
$BUILD (ARG.DA) ;SIZE OF BLOCK
$SET (ARG.HD,AR.TYP,.AHNAM) ;BLOCK TYPE
$SET (ARG.HD,AR.LEN,AHNLEN) ;LENGTH OF NAME
$EOB
ASCIZ |CATALOG| ;APPLICATION NAME
AHNLEN==.-AHLMSG-.OHDRS ;APPLICATION NAME LENGTH
AHLLEN==.-AHLMSG ;MESSAGE LENGTH
APLTX1: ITEXT (<[SYSTEM]CATALOG>)
APLTX2: ITEXT (<^U/APLPPN/CATALOG>)
APLTX3: ITEXT (<[SYSTEM]CATALOG %^V/.JBVER/>)
APLTX4: ITEXT (<^U/APLPPN/CATALOG %^V/.JBVER/>)
SUBTTL Initialization -- [SYSTEM]MDA interface
MDAINI: MOVEI S1,SP.MDA ;GET PID INDEX FOR [SYSTEM]MDA
$CALL C%RPRM ;ASK FOR THE PID
JUMPF MDAI.1 ;OK IF NOT THERE
PUSHJ P,RQST ;REQUEST QUEUE STRUCTURE
MDAI.1: MOVE S1,[%LDSYS] ;NEED THE SYSTEM FILE PPN
GETTAB S1, ;ASK MONITOR
MOVE S1,[1,,4] ;DEFAULT TO [1,4]
SKIPE DEBUGW ;DEBUGGING?
MOVEI S1,0 ;YES--USE OUR PPN
MOVEM S1,G$SPPN ;SAVE
MOVE S1,[%LDSSP] ;NEED THE .SYS FILE PROTECTION
GETTAB S1, ;ASK MONITOR
MOVSI S1,(<157>B8) ;DEFAULT TO <157>
MOVEM S1,G$SPRT ;SAVE
MOVE S1,C$DSP ;POINT TO FIRST DISPATCH VECTOR
MDAI.2: MOVE C,.CVDAT(S1) ;POINT TO DATA BASE
MOVEI S2,.CWDNI ;GET WAIT STATE CODE
MOVEM S2,.CDWSC(C) ;MARK DATA BASE NOT INITIALIZED
SKIPE S1,.CVLNK(S1) ;POINT TO NEXT DEVICE DISPATCH
JRST MDAI.2 ;LOOP
POPJ P, ;RETURN
SUBTTL Initialization -- Device catalogs
DEVINI: $SAVE <P1,P2,P3> ;SAVE SOME ACS
MOVE P1,C$DSP ;POINT TO FIRST DISPATCH VECTOR
SETZ P3, ;DON'T KNOWN ACTUAL STR NAME YET
DEVI.1: PUSHJ P,DEVI.2 ;FIRE UP THIS DEVICE
PUSHJ P,IPCERR ;COMPLAIN ABOUT ERRORS
SKIPE P1,.CVLNK(P1) ;POINT TO NEXT DEVICE DISPATCH
JRST DEVI.1 ;AND GO INITIALIZE
POPJ P, ;RETURN
DEVI.2: MOVE C,.CVDAT(P1) ;POINT TO DATA BASE
SKIPE S1,.CDPIF(C) ;GET PRIMARY FILE IFN
$CALL F%RREL ;RELEASE IT
SKIPE S1,.CDPML(C) ;GET PENDING IPCF MESSAGE LIST
$CALL L%DLST ;DELETE IT
SKIPE S1,.CDCOR(C) ;GET CORE ALLOCATION LIST
$CALL L%DLST ;DELETE IT
MOVSI S1,(C) ;FIRST CLEAR OUT
HRRI S1,1(C) ;DATA BASE
SETZM (C) ;CLEAR FIRST WORD
BLT S1,.CDLEN-1(C) ;CLEAR ENTIRE BLOCK OUT
MOVSI S1,(P1) ;POINT TO A DISPATCH VECTOR
HRRI S1,(C) ;MAKE A BLT POINTER
BLT S1,.CVLEN-1(C) ;LOAD DISPATCH VECTOR
$CALL L%CLST ;CREATE LINKED LIST HANDLE FOR
MOVEM S1,.CDPML(C) ; PENDING IPCF MESSAGES
$CALL L%CLST ;CREATE LINKED LIST FOR CORE ALLOCATION
MOVEM S1,.CDCOR(C) ;SAVE HANDLE
MOVEI S1,.CWDNI ;GET WAIT STATE CODE
MOVEM S1,.CDWSC(C) ;MARK DATA BASE NOT INITIALIZED
MOVE S1,.CVFMT(C) ;GET CURRENT FILE FORMAT NUMBER
MOVEM S1,.CDFMT(C) ;SAVE
PUSHJ P,C$TBLC ;CREATE INITIAL TABLE
POPJ P, ;PROPAGATE ERROR BACK
DEVI.3: PUSHJ P,C$PFIL ;SET UP PRIMARY DATA FILE
PUSHJ P,C$IOPN ;OPEN FOR INPUT
JRST DEVI.7 ;FAILED
JUMPN P3,DEVI.4 ;JUMP IF WE KNOW THE ACTUAL STR NAME
MOVE S1,.CDPFD+.FDSTR(C) ;GET ACTUAL STRUCTURE NAME
MOVEM S1,G$QSTR ;NO--DO IT NOW
AOS P3 ;DO THIS ONLY ONCE
DEVI.4: PUSHJ P,C$PRFM ;READ FILE FORMAT NUMBER
JRST DEVI.7 ;I/O ERROR
CAMN S1,.CVFMT(C) ;CURRENT FORMAT?
JRST DEVI.5 ;YES
PUSHJ P,@.CVCVT(C) ;ELSE CONVERT TO CURRENT
POPJ P, ;PROPAGATE ERROR BACK
PUSHJ P,E$CVT ;GENERATE CONVERSION MESSAGE
PUSHJ P,IPCERR ;TELL THE WORLD
JRST DEVI.3 ;AND RESTART
DEVI.5: MOVE P2,.CDPFP(C) ;GET CURRENT POSITION
MOVEI E,ENTBLK ;POINT TO STORAGE
PUSHJ P,C$PREN ;READ THE ENTRY
JRST DEVI.6 ;DONE
PUSHJ P,C$AVSN ;ALLOCATE VSN STORAGE
POPJ P, ;PROPAGATE ERROR BACK
HRR S2,P2 ;GET POSITION IN FILE
PUSHJ P,C$TBLA ;ADD TO TABLE
POPJ P, ;PROPAGATE ERROR BACK
JRST DEVI.5 ;LOOP FOR ALL ENTRIES
DEVI.6: MOVE S1,.CDTAB(C) ;POINT TO TABLE
HLRZ S1,(S1) ;GET NUMBER OF ENTRIES
PUSHJ P,@.CVINI(C) ;DO SPECIAL INITIALIZATION
POPJ P, ;FAILED
MOVEI S1,.CWRUN ;GET WAIT STATE CODE
MOVEM S1,.CDWSC(C) ;MARK DATA BASE VALID AND USABLE
AOS .CDUPD(C) ;INDICATE UPDATES ARE ALLOWED
JRST .POPJ1 ;RETURN
DEVI.7: MOVE S2,.CVFMT(C) ;GET FORMAT FROM DISPATCH VECTOR
MOVEM S2,.CDPFM(C) ;SAVE FOR PRIMARY FILE IF OPENED LATER
POPJ P, ;RETURN WITH FILE ERROR IN S1
SUBTTL Initialization -- QSTCHK - Check for queue structure
; Here when [SYSTEM]MDA hasn't told us what the queue structure is
; and we've received a request for catalog information (probably
; from [SYSTEM]OPERATOR. This special code is needed incase a site
; is setting up their catalog for the first time and a full blown
; GALAXY system isn't running (runnable?) yet. This routine is also
; useful for debugging CATLOG.
; Call: MOVE C, dispatch
; PUSHJ P,QSTCHK
; <RETURN>
QSTCHK: SKIPE G$QSTR ;HAVE A QUEUE STRUCTURE?
POPJ P, ;YES
MOVSI S1,'SSL' ;ASSUME STANDARD DEFAULT
MOVEM S1,G$QSTR ;SAVE
PUSHJ P,DEVINI ;TRY TO INITIALIZE DATA BASES
POPJ P, ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- IPCF interrupt processing
IPCINT: $BGINT (1) ;SWITCH TO INTERRUPT CONTEXT
$CALL C%INTR ;TELL LIBRARY WE HAVE A MESSAGE
$DEBRK ;DISMISS INTERRUPT
SUBTTL IPCF/Operator/QUASAR interface -- IPCF message processing
IPCF: $CALL C%RECV ;TRY TO RECEIVE A MESSAGE
JUMPF .POPJ ;NONE THERE--RETURN
PUSHJ P,IPCSET ;SET UP ALL SORTS OF VARIABLES
JRST IPCF.X ;ERROR OF SOME SORT
LOAD S1,.MSTYP(M),MS.TYP ;GET MESSAGE TYPE
PUSH P,S1 ;SAVE IT
$CALL I%NOW ;GET CURRENT DATE/TIME
MOVEM S1,G$UDT ;SAVE FOR TIMESTAMPING
MOVE S1,MSGPTR ;GET POINTER TO MESSAGE TABLE
IPCF.1: HLRZ S2,(S1) ;GET TYPE FROM TABLE
CAME S2,(P) ;A MATCH?
AOBJN S1,IPCF.1 ;KEEP SEARCHING
SKIPL S1 ;POINTER POSITIVE IF NO MATCH
MOVEI S1,MSGTAB ;UNKNOWN MESSAGE TYPE
POP P,(P) ;TRIM STACK
HRRZ S1,(S1) ;GET PROCESSOR ADDRESS
PUSHJ P,(S1) ;DISPATCH
SKIPE ERRFLG ;NEED TO ERROR ACK?
PUSHJ P,IPCERR ;YES
IPCF.X: $CALL C%REL ;RELEASE MESSAGE
JRST IPCF ;TRY FOR ANOTHER PACKET
; Message dispatch table
MSGTAB: XWD 000000,UNKMSG ;?????? UNKNOWN MESSAGES
XWD .CFRCT,RCAT ;CATLOG REQUEST FOR CATALOG INFO
XWD .CFAQS,AQST ;CATLOG ANSWER TO REQUEST FOR QUEUE STR
XWD .CFINS,INSERT ;CATALOG INSERT BY MDA
XWD .CFMOD,MODIFY ;CATALOG MODIFY BY MDA
XWD .OMHAC,AACK ;ORION APPLICATION ACK
XWD .OMCMD,OPRCMD ;ORION OPERATOR COMMAND MESSAGE
XWD MT.TXT,ACK ;ACKS
NUMMSG==.-MSGTAB
MSGPTR: -NUMMSG,,MSGTAB ;AOBJN POINTER TO MESSAGE TABLE
; Routine to set up for IPCF message processing
IPCSET: SETZB C,ERRFLG ;ZAP DATA BASE POINTER AND ERROR CODE
SETZM G$ACK ;ASSUME NO ACK WANTED
MOVE S2,MDB.SP(S1) ;GET THE SENDERS PID
MOVEM S2,G$SND ;AND SAVE IT
MOVE S2,MDB.SD(S1) ;GET THE SENDERS ID
MOVEM S2,G$SID ;AND SAVE IT
MOVE S2,MDB.PV(S1) ;GET SENDERS CAPABILITIES
MOVEM S2,G$PRV ;SAVE THAT AS WELL
MOVE S2,MDB.SI(S1) ;GET THE SENDERS SPECIAL PID INDEX
MOVEM S2,G$IDX ;STORE IT
MOVE S2,MDB.FG(S1) ;GET FLAG WORD
MOVEM S2,G$FLG ;SAVE
LOAD M,MDB.MS(S1),MD.ADR ;POINT M AT INCOMMING PACKET
MOVE S1,.MSCOD(M) ;GET THE MESSAGE ACK CODE
MOVEM S1,G$COD ;AND SAVE IT
MOVEI S1,.OHDRS+ARG.HD(M) ;POINT TO FIRST BLOCK IN MESSAGE
MOVEM S1,MSGBLK ;SAVE
MOVE S1,.OARGC(M) ;GET ARGUMENT BLOCK COUNT
MOVEM S1,MSGCNT ;SAVE
SETZM G$ACK ;ASSUME NO ACK WANTED
MOVX S1,MF.ACK ;GET ACK BIT
TDNE S1,.MSFLG(M) ;IS IT SET?
SETOM G$ACK ;SENDER WANTS AN ACK
LOAD S1,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
JUMPE S1,.POPJ1 ;RETURN IF SENDER IS NO ONE SPECIAL
LOAD S2,.MSTYP(M),MS.TYP ;GET MESSAGE TYPE
CAIN S1,SP.GFR ;THE GOPHER?
CAIE S2,.IPCQU ;QUEUE. UUO?
JRST .POPJ1 ;NO
PUSHJ P,QUEUUO ;TRANSLATE QUEUE. UUO INTO IPCF MSG
JRST E$QFE ;QUEUE. UUO FORMAT ERROR
MOVEI S1,.OHDRS+ARG.HD(M) ;POINT TO FIRST BLOCK IN MESSAGE
MOVEM S1,MSGBLK ;SAVE
MOVE S1,.OARGC(M) ;GET ARGUMENT BLOCK COUNT
MOVEM S1,MSGCNT ;SAVE
JRST .POPJ1 ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- Resend messages
RESEND: $SAVE <P1,P2> ;SAVE P1 AND P2
SETZB P1,P2 ;CLEAR PREVIOUS PID AND INDEX
MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
$CALL L%FIRS ;POSITION TO FIRST ENTRY
JRST RESE.2 ;ENTER LOOP
RESE.1: MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
$CALL L%NEXT ;POSITION TO NEXT ENTRY
RESE.2: JUMPF .POPJ ;RETURN IF END OF LIST
MOVSI S1,(S2) ;POINT TO SAVED SAB
HRRI S1,G$SAB ;AND WORKING COPY
BLT S1,G$SAB+SAB.SZ-1 ;RETRIEVE FROM LIST
MOVE M,G$SAB+SAB.MS ;POINT TO THE MESSAGE
MOVE S1,G$SAB+SAB.LN ;GET MESSAGE LENGTH
TRNN M,PAGSIZ-1 ;ON A PAGE BOUNDRY?
CAIE S1,PAGSIZ ;AND A PAGE IN LENGTH?
MOVEI M,SAB.SZ(S2) ;NO--POINT TO SAVED MESSAGE
MOVEM M,G$SAB+SAB.MS ;UPDATE
CAMN P1,G$SAB+SAB.PD ;THIS PID SAME AS LAST ONE?
CAME P2,G$SAB+SAB.SI ;INDEX THE SAME TOO?
JRST RESE.1 ;YES--IGNORE SINCE LAST SEND FAILED
MOVEI S1,SAB.SZ ;SAB LENGTH
MOVEI S2,G$SAB ;SAB ADDRESS
$CALL C%SEND ;SEND MESSAGE
JUMPT RESE.3 ;DELETE FROM QUEUE IF SUCESSFUL
CAIE S1,ERNSP$ ;NO SUCH PID?
CAIN S1,ERPWA$ ;PID WENT AWAY?
JRST RESE.3 ;JUST REMOVE FROM QUEUE
MOVE P1,G$SAB+SAB.PD ;COPY PID
MOVE P2,G$SAB+SAB.SI ;AND INDEX
JRST RESE.1 ;TRY ANOTHER TO RESEND TO ANOTHER PID
RESE.3: SETZB P1,P2 ;CLEAR PREVIOUS PID AND INDEX
MOVE S1,IPCQUE ;ELSE MUST DELETE
$CALL L%DENT ;THE QUEUE ENTRY
SOSE RSENDC ;COUNT DOWN
JRST RESE.1 ;GO TRY ANOTHER RESEND
POPJ P, ;QUEUE IS EMPTY
SUBTTL IPCF/Operator/QUASAR interface -- Wait for a system PID to restart
; Here to wait for the system PID
PIDWAI: $SAVE <P1> ;SAVE P1
SKIPA P1,S1 ;COPY PID INDEX
PIDW.1: MOVE S1,P1 ;GET THE PID INDEX
$CALL C%RPRM ;ASK FOR THE PID
JUMPT PIDW.2 ;GOT IT
MOVEI S1,1 ;TIME TO WASTE
$CALL I%SLP ;ZZZZZZ
JRST PIDW.1 ;TRY AGAIN
PIDW.2: CAIE P1,SP.OPR ;[SYSTEM]OPERATOR?
JRST PIDW.3 ;NO
PUSHJ P,OPRINI ;RESTART COMMUMICATIONS
SETOM APLCOD ;FLAG RESTART
PUSHJ P,E$ROP ;GENERATE RESTART TEXT
PJRST IPCERR ;SEND MESSAGE AND RETURN
PIDW.3: CAIE P1,SP.QSR ;QUASAR?
CAIN P1,SP.MDA ;MDA?
SKIPA ;YES
JRST PIDW.5 ;NO
PUSH P,G$QSTR ;SAVE CURRENT QUEUE STRUCTURE
PUSHJ P,MDAINI ;GET NEW QUESTR FROM MDA
POP P,S1 ;RETRIEVE OLD ONE
CAME S1,G$QSTR ;QUESTR CHANGE?
JRST PIDW.4 ;NO
PUSHJ P,E$RMI ;BUILD RE-INIT MESSAGE
PUSHJ P,IPCERR ;SEND IT OFF
PUSHJ P,DEVINI ;RE-INIT DEVICE CATALOGS
PIDW.4: PUSHJ P,E$RMN ;BUILD RESTART MESSAGE
PUSHJ P,IPCERR ;SEND IT OFF
PIDW.5: POPJ P, ;DONE
SUBTTL IPCF/Operator/QUASAR interface -- PID checking
PIDCHK: MOVEI S1,SP.OPR ;GET THE PID INDEX FOR [SYSTEM]OPERATOR
$CALL C%RPRM ;ASK FOR THE PID
JUMPF PIDC.1 ;SHOULDN'T FAIL
CAMN S1,OPRPID ;SAME AS BEFORE?
JRST PIDC.1 ;YES
PUSHJ P,OPRINI ;RESTART COMMUMICATIONS
SETOM APLCOD ;FLAG RESTART
PUSHJ P,E$ROP ;GENERATE RESTART TEXT
PUSHJ P,IPCERR ;SEND IT OFF
PIDC.1: MOVEI S1,SP.MDA ;GET THE PID INDEX FOR [SYSTEM]MDA
$CALL C%RPRM ;ASK FOR THE PID
JUMPF .POPJ ;SHOULDN'T FAIL
EXCH S1,MDAPID ;SWAP
CAME S1,MDAPID ;SAME AS BEFORE?
PUSHJ P,RQST ;NO--REQUEST QUEUE STRUCTURE INFO
POPJ P, ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- Error ACK generation
IPCERR: $SAVE <P1> ;SAVE P1
PUSHJ P,C$SETM ;SET UP MESSAGE
MOVE P1,ERRFLG ;GET THE ERROR FLAGS+CLASS AND CODE
TLZE P1,AM.ACK ;ACK?
MOVEI S1,.OMACK ;YES
TLZE P1,AM.LOG ;LOG?
MOVEI S1,.OMLOG ;YES
TLZE P1,AM.WTO ;WTO?
MOVEI S1,.OMWTO ;YES
LOAD S2,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAIN S2,SP.GFR ;THE GOPHER ONLY REALLY
MOVEI S1,MT.TXT ; UNDERSTANDS "TEXT" ACKS
STORE S1,.MSTYP(M),MS.TYP ;SET MESSAGE TYPE
MOVEM P1,ERRFLG ;UPDATE FLAGS
MOVE S1,G$COD ;GET ACK CODE
MOVEM S1,.MSCOD(M) ;SAVE
MOVX S1,WT.SJI ;SUPPRESS JOB INFO
MOVEM S1,.OFLAG(M) ;SAVE
MOVEI P1,.OHDRS(M) ;POINT TO FIRST DATA WORD
HLRZ S1,ERRFLG ;GET CLASS
CAIN S2,SP.GFR ;GOPHER?
JRST IPCE.2 ;YES
CAIN S1,.AMTXT ;SIMPLE ACK?
JRST IPCE.3 ;YES
IPCE.1: MOVEI S2,.WTTYP ;BLOCK TYPE
STORE S2,ARG.HD(P1),AR.TYP ;SAVE
HLRZ S2,ERRTYP(S1) ;GET MESSAGE PREFIX
STORE S2,.MSFLG(M),MF.SUF ;SAVE
HRRZ S2,ERRTYP(S1) ;GET TYPE TEXT
$TEXT (<-1,,ARG.DA(P1)>,<^I/(S2)/^0>) ;GENERATE TYPE TEXT
PUSHJ P,IPCE.L ;COMPUTE AND STORE BLOCK LENGTH
MOVEI S1,.WTTXT ;NEXT BLOCK TYPE
JRST IPCE.4 ;ONWARD
IPCE.2: MOVX S2,MF.FAT ;GET THE FATAL BIT
IORM S2,.MSFLG(M) ;SET FOR IPCSER
HLRZ S2,ERRTYP(S1) ;GET PREFIX
STORE S2,.MSFLG(M),MF.SUF ;SAVE
SKIPA S1,[.CMTXT] ;GOPHER ONLY UNDERSTANDS "TEXT" ACKS
IPCE.3: MOVEI S1,.WTTYP ;BLOCK TYPE
IPCE.4: STORE S1,ARG.HD(P1),AR.TYP ;SAVE
$TEXT (<-1,,ARG.DA(P1)>,<^T/ERRBUF/^0>) ;GENERATE MESSAGE TEXT
PUSHJ P,IPCE.L ;COMPUTE AND STORE BLOCK LENGTH
SUBI P1,(M) ;COMPUTE TOTAL MESSAGE LENGTH
STORE P1,.MSTYP(M),MS.CNT ;SAVE
LOAD S1,G$IDX,SI.IDX ;GET SENDERS PID INDEX
CAIE S1,SP.GFR ;GOPHER?
PJRST C$SOPR ;SEND TO [SYSTEM]OPERATOR
PJRST C$SGFR ;SEND TO [SYSTEM]GOPHER
; Compute and store length of current text block
IPCE.L: MOVEI S1,ARG.DA(P1) ;INIT ADDRESS
SKIPE (S1) ;END OF TEXT?
AOJA S1,.-1 ;LOOP
SUBI S1,ARG.HD-ARG.DA(P1) ;COMPUTE WORDS ADDED
STORE S1,ARG.HD(P1),AR.LEN ;SAVE
AOS .OARGC(M) ;COUNT THE BLOCK
ADDI P1,(S1) ;ADVANCE TO NEXT FREE BLOCK
POPJ P, ;AND RETURN
SUBTTL IPCF/Operator/QUASAR interface -- Message block processing
; Get the next block of a message
; Call: PUSHJ P,C$GBLK
; <NON-SKIP> ;END OF MESSAGE
; <SKIP> ;NEXT BLOCK FOUND
;
; On error return, T1, T2 and T3 left unchanged
; On sucessful return, T1= type, T2= length, T3= data address
;
; AC usage: Destroys S1
;
C$GBLK::SOSGE MSGCNT ;SUBTRACT 1 FROM THE BLOCK COUNT
POPJ P, ;ERROR RETURN IF NO MORE
MOVE S1,MSGBLK ;GET THE PREVIOUS BLOCK ADDRESS
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;GET THE BLOCK DATA ADDRESS
ADD S1,T2 ;POINT TO THE NEXT MESSAGE BLOCK
MOVEM S1,MSGBLK ;SAVE IT FOR THE NEXT CALL
JRST .POPJ1 ;RETURN SUCESSFUL
; Set up the catalog data base from the OPR command message
C$DATA::TDZA S1,S1 ;NORMAL ENTRY POINT
C$DATX::MOVEI S1,1 ;HERE REGARDLESS OF WAIT STATE
$SAVE <P1> ;SAVE P1
MOVE P1,S1 ;SAVE FLAG
PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMKEY ;A KEYWORD?
JRST E$OPR ;OPR CMD ERROR
MOVE S1,C$DSP ;POINT TO START OF DISPATCH TABLES
DATA.1: MOVE S2,.CVTYP(S1) ;GET CATALOG DEVICE TYPE
CAMN S2,(T3) ;A MATCH?
JRST DATA.2 ;YES
SKIPE S1,.CVLNK(S1) ;POINT TO NEXT
JRST DATA.1 ;TRY AGAIN
JRST E$OPR ;OPR CMD ERROR
DATA.2: MOVE C,.CVDAT(S1) ;POINT TO DATA STORAGE
JUMPN P1,.POPJ1 ;RETURN IF LEGAL IN ANY WAIT STATE
MOVEI S1,.CWDNI ;WAIT STATE TO CHECK
CAMN S1,.CDWSC(C) ;DATA BASE INITIALIZED?
JRST E$CNA ;NO--CATALOG NOT AVAILABLE
JRST .POPJ1 ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- Send setup
; Setup a message
; Call: PUSHJ P,C$SETM
;
; On return, M= message address
;
C$SETM::MOVEI S1,PAGSIZ ;LENGTH
MOVEM S1,MSGLEN ;SAVE REQUESTED LENGTH
MOVEI M,G$MSG ;POINT TO MESSAGE STORAGE
TRNN M,PAGSIZ-1 ;ON A PAGE BOUNDRY?
ADDI M,1 ;YES--DON'T WANT TO IPCF IT AWAY
MOVSI S1,(M) ;START ADDRESS
HRRI S1,1(M) ;MAKE A BLT POINTER
SETZM (M) ;CLEAR FIRST WORD
BLT S1,PAGSIZ-1(M) ;CLEAR MESSAGE STORAGE
MOVE S1,G$COD ;GET ACK CODE
MOVEM S1,.MSCOD(M) ;SAVE
POPJ P, ;DONE
SUBTTL IPCF/Operator/QUASAR interface -- Unknown message
UNKMSG: JRST E$UIM ;UNKNOWN IPCF MESSAGE
UNKTXT: ITEXT (< Unknown IPCF message
Sender: ^O12R0/G$SND/, ^U/G$SID/
Header: ^O12R0/.MSTYP(M)/, ^O12R0/.MSFLG(M)/, ^O12R0/.MSCOD(M)/>)
SUBTTL IPCF/Operator/QUASAR interface -- GOPHER message #000040 (QUEUE. UUO)
QUEUUO: $SAVE <P1,P2> ;SAVE P1 AND P2
$CALL M%GPAG ;GET A PAGE
MOVE P1,S1 ;COPY ADDRESS
MOVE S1,[.CTVSL+.OHDRS,,.CFRCT] ;LENGTH,,FUNCTION CODE
MOVEM S1,.MSTYP(P1) ;SAVE
MOVE S1,G$COD ;GET ACK CODE
MOVEM S1,.MSCOD(P1) ;SAVE
AOS .OARGC(P1) ;ONLY ONE BLOCK ALLOWED
MOVEI P2,.OHDRS(P1) ;POINT TO START OF BLOCK DESCRIPTOR
MOVE S1,[.CTVSL,,.CTVSN] ;LENGTH,,BLOCK TYPE
MOVEM S1,ARG.HD(P2) ;SAVE
ADDI P2,ARG.DA ;ADVANCE TO START OF DATA
QUEU.1: PUSHJ P,C$GBLK ;FIND A BLOCK
JRST QUEU.3 ;END OF MESSAGE
MOVE S1,QUEPTR ;AOBJN POINTER
QUEU.2: HLRZ S2,(S1) ;GET A BLOCK TYPE
CAIE S2,(T1) ;A MATCH?
AOBJN S1,QUEU.2 ;LOOP
JUMPGE S1,.POPJ ;CHECK FOR ERRORS
HRRZ S2,(S1) ;GET PROCESSOR ADDRESS
PUSHJ P,(S2) ;DISPATCH
POPJ P, ;ERROR
JRST QUEU.1 ;LOOP THROUGH THE MESSAGE
QUEU.3: MOVSI S1,(P1) ;POINT TO NEW MESSAGE
HRRI S1,(M) ;AND TO THE OLD ONE
BLT S1,PAGSIZ-1(M) ;OVERWRITE QUEUE. UUO WITH IPCF MSG
MOVE S1,P1 ;GET SCRATCH PAGE ADDRESS BACK
$CALL M%RPAG ;RELEASE IT
JRST .POPJ1 ;RETURN
QUETAB: XWD .QBACT,.POPJ1 ;ACCOUNT STRING (NOOP)
XWD .QBFNC,.POPJ1 ;FUNCTION WORD (NOOP)
XWD .QBNOD,.POPJ1 ;NODE (NOOP)
XWD .QBNAM,.POPJ1 ;NAME (NOOP)
XWD .QBVSN,QBVSN ;VOLUME-SET NAME
XWD .QBMFG,QBMFG ;FLAGS
QUETLN==.-QUETAB ;LENGTH OF TABLE
QUEPTR: -QUETLN,,QUETAB ;POINTER TO QUEUE. UUO TABLE
; VOLUME-SET NAME
QBVSN: MOVSI S1,(T3) ;POINT TO VSN
HRRI S1,.CTVSN(P2) ;DESTINATION
MOVEI S2,-1(T2) ;GET SPECIFIED LENGTH
ADDI S2,.CTVSN(P2) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY VOLUME-SET NAME
JRST .POPJ1 ;RETURN
; FLAGS
QBMFG: CAIE T2,2 ;MUST BE A SINGLE WORD (+OVERHEAD)
POPJ P, ;IT ISN'T
SETZ S1, ;CLEAR RESULT
MOVE S2,(T3) ;GET FLAGS
TXNE S2,-1-QB.DTA!QB.TAP!QB.DSK ;CHECK FOR JUNK FLAGS
POPJ P, ;NO GOOD
TXNE S2,QB.DTA ;DECTAPE?
MOVEI S1,.CTDTA ;YES
TXNE S2,QB.TAP ;MAGTAPE?
MOVEI S1,.CTMTA ;YES
TXNE S2,QB.DSK ;STRUCTURE?
MOVEI S1,.CTSTR ;YES
STORE S1,.CTVFL(P2),CT.TYP ;SAVE CATALOG TYPE
JRST .POPJ1 ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- CATALOG message #100001 (REQ INFO)
RCAT: $SAVE <P1,P2> ;SAVE P1 AND P2
MOVEI E,ENTBLK ;REMIND E WHERE ENTRY BLOCK IS
PUSHJ P,QSTCHK ;DEFAULT QUEUE STRUCTURE IF NECESSARY
PUSHJ P,C$MVSN ;FIND THE REQUESTED VSN
JRST RCAT.4 ;FAILED
PUSHJ P,C$SETM ;SET UP SEND
PUSHJ P,C$PRIV ;DO PRIV CHECKING
JRST E$VNF ;REQUESTOR IS NOBODY SPECIAL
MOVEI E,ENTBLK ;MAKE SURE E DIDN'T GET STOMPED ON
MOVEI S1,.CFACT ;MESSAGE TYPE
STORE S1,.MSTYP(M),MS.TYP ;SAVE
MOVEI P1,.OHDRS(M) ;POINT TO FIRST FREE WORD
LOAD S1,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAIN S1,SP.GFR ;RESPONDING TO [SYSTEM]GOPHER?
ADDI P1,ARG.DA ;YES--RESERVE ROOM FOR .CMTXT HEADER
MOVEI S1,.CTVSB ;VOLUME-SET BLOCK TYPE
STORE S1,ARG.HD(P1),AR.TYP ;SAVE
MOVEI S1,.CTVSL ;BLOCK LENGTH
STORE S1,ARG.HD(P1),AR.LEN ;SAVE
MOVSI S1,.CTVFL(E) ;SET UP TO COPY
HRRI S1,ARG.DA(P1) ; THE VOLUME-SET DATA
BLT S1,ARG.DA+.CTVSL-1(P1) ;COPY
ADDI P1,.CTVSL ;ADVANCE POINTER TO NEXT FREE WORD
AOS .OARGC(M) ;COUNT THE BLOCK
LOAD S1,.CTVFL(E),CT.NVL ;GET NUMBER OF VOLUMES IN VOLUME-SET
JUMPE S1,RCAT.3 ;FINISH UP IF NO VOLUMES
MOVNS S1 ;NEGATE
HRLZ P2,S1 ;GET -COUNT
HRRI P2,.CTVSL(E) ;POINT TO FIRST VOLUME
RCAT.2: MOVEI S1,.CTVLB ;VOLUME BLOCK TYPE
STORE S1,ARG.HD(P1),AR.TYP ;SAVE
MOVE S1,.CVWVS(C) ;GET WORDS PER VOLUME STORAGE
ADDI S1,ARG.DA ;PLUS MESSAGE OVERHEAD
STORE S1,ARG.HD(P1),AR.LEN ;SAVE
MOVSI S1,(P2) ;POINT TO VOLUME STORAGE
HRRI S1,ARG.DA(P1) ;WHERE TO STORE IN MESSAGE
MOVEI S2,ARG.DA(P1) ;START ADDRESS
ADD S2,.CVWVS(C) ;COMPUTE END BLT ADDRESS
BLT S1,-1(S2) ;COPY
LOAD S1,ARG.HD(P1),AR.LEN ;GET TOTAL MESSAGE BLOCK LENGTH BACK
ADDI P1,(S1) ;ADVANCE POINTER
AOS .OARGC(M) ;COUNT THE BLOCK
ADD P2,.CVWVS(C) ;ADVANCE VOLUME BLOCK POINTER
SUBI P2,1 ;ACCOUNT FOR NEXT INSTRUCTION
AOBJN P2,RCAT.2 ;LOOP THROUGH VOLUMES
RCAT.3: SUBI P1,(M) ;COMPUTE MESSAGE LENGTH
STORE P1,.MSTYP(M),MS.CNT ;SAVE
LOAD S1,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAIE S1,SP.GFR ;GOPHER?
PJRST C$SMDA ;SEND MESSAGE TO [SYSTEM]MDA
MOVEI S1,MT.TXT ;THE GOPHER ONLY REALLY
STORE S1,.MSTYP(M),MS.TYP ; UNDERSTANDS "TEXT" ACKS
HLLZ S1,.OHDRS+ARG.DA(M) ;MUST ENCAPSULATE THE ENTIRE RESPONSE
ADD S1,[ARG.DA,,.CMTXT] ; IN A .CMTXT BLOCK SO THE CALLER
MOVEM S1,.OHDRS+ARG.HD(M) ; GETS HIS RESPONSE BLOCK FILLED IN
PJRST C$SGFR ;SEND MESSAGE TO [SYSTEM]GOPHER
RCAT.4: LOAD S2,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAIN S2,SP.GFR ;GOPHER?
POPJ P, ;YES--ACK VIA ERROR HANDLING CODE
CAIE S2,SP.QSR ;QUASAR?
CAIN S2,SP.MDA ;MDA?
SKIPA ;YES
POPJ P, ;ACK WITH ERROR TEXT
SETZM ERRFLG ;DON'T SEND TEXT ACK
PUSHJ P,C$SETM ;SET UP SEND
MOVEI S1,.CFACT ;MESSAGE TYPE
STORE S1,.MSTYP(M),MS.TYP ;SAVE
MOVEI S1,.OHDRS ;LENGTH
STORE S1,.MSTYP(M),MS.CNT ;SAVE
MOVX S1,MF.FAT ;FLAG FATAL ERROR
MOVEM S1,.MSFLG(M) ;SAVE
PJRST C$SMDA ;SEND MESSAGE TO [SYSTEM]MDA
SUBTTL IPCF/Operator/QUASAR interface -- CATALOG message #100003 (REQ QUESTR)
RQST: PUSHJ P,C$SETM ;SET UP SEND
MOVE S1,G$QSTR ;GET OLD QUEUE STRUCTURE
MOVEM S1,.MSCOD(M) ;MAKE THAT OUR ACK CODE
MOVEI S1,.CFRQS ;MESSAGE TYPE
STORE S1,.MSTYP(M),MS.TYP ;SAVE
MOVEI S1,.OHDRS ;LENGTH
STORE S1,.MSTYP(M),MS.CNT ;SAVE
PUSHJ P,C$SMDA ;SEND TO MDA
POPJ P, ;AND RETURN
SUBTTL IPCF/Operator/QUASAR interface -- CATALOG message #100004 (ANS QUESTR)
AQST: MOVE S1,.OHDRS(M) ;GET QUEUE STRUCTURE NAME
SKIPE DEBUGW ;DEBUGGING?
MOVSI S1,'DSK' ;YES
JUMPE S1,.POPJ ;NO NAME IS NO GOOD
EXCH S1,G$QSTR ;SWAP WITH OLD
JUMPE S1,AQST.1 ;FIRST TIME THROUGH?
CAMN S1,G$QSTR ;DID QUEUE STRUCTURE CHANGE?
JRST AQST.2 ;NO
PUSHJ P,E$RMI ;BUILD RE-INIT MESSAGE
PUSHJ P,IPCERR ;SEND IT OFF
AQST.1: PUSHJ P,DEVINI ;INIT DEVICE CATALOGS
POPJ P, ;AND RETURN
AQST.2: SKIPN .MSCOD(M) ;UNSOLICITED ANSWER?
POPJ P, ;NO--STARTUP SEQUENCE OUT OF SYNCH
PUSHJ P,E$RMN ;BUILD RESTART MESSAGE
PUSHJ P,IPCERR ;SEND IT OFF
POPJ P, ;DONE
SUBTTL IPCF/Operator/QUASAR interface -- CATALOG message #100006 (DISABLE)
SUBTTL IPCF/Operator/QUASAR interface -- CATALOG message #100007 (ENABLE)
DISENA: PUSHJ P,C$SETM ;SET UP SEND
MOVEI S1,.CFDIS ;ASSUME DISABLE
SKIPE .CDUPD(C) ;ENABLES ALLOWED?
MOVEI S1,.CFENA ;YES
STORE S1,.MSTYP(M),MS.TYP ;SAVE MESSAGE TYPE
SETZM .MSCOD(M) ;NO ACK CODE
MOVE S1,.CVTYP(C) ;GET THIS CATALOG DEVICE TYPE
MOVEM S1,.OFLAGS(M) ;SAVE
MOVEI S1,.OHDRS ;LENGTH OF MESSAGE
STORE S1,.MSTYP(M),MS.CNT ;SAVE
PUSHJ P,C$SMDA ;SEND MESSAGE TO MDA
POPJ P, ;RETURN
SUBTTL IPCF/Operator/QUASAR interface -- CATALOG message #1000010 (INSERT)
INSERT: PUSHJ P,QSTCHK ;DEFAULT QUEUE STRUCTURE IF NECESSARY
PJRST .INSER ;JOIN COMMON OPR PARSING CODE
SUBTTL IPCF/Operator/QUASAR interface -- CATALOG message #1000011 (MODIFY)
MODIFY: PUSHJ P,QSTCHK ;DEFAULT QUEUE STRUCTURE IF NECESSARY
PJRST .MODIF ;JOIN COMMON OPR PARSING CODE
SUBTTL IPCF/Operator/QUASAR interface -- ORION message #200020 (APL ACK)
AACK: PUSHJ P,C$GBLK ;GET ARGUMENT BLOCK
JRST E$APL ;BAD APPLICATION MESSAGE
CAIN T1,.AHTYP ;APPLICATION CODE?
CAIE T2,2 ;TWO WORDS?
JRST E$APL ;BAD APPLICATION MESSAGE
MOVE S1,(T3) ;GET CODE
EXCH S1,APLCOD ;SAVE FOR LATER REFERENCE
CAME S1,[EXP -1] ;RESTART?
JRST E$STR ;GENERATE STARTING MESSAGE AND RETURN
JRST E$RST ;ELSE IT'S A RESTART MESSAGE
AACKT1: ITEXT (<Application code = ^O/APLCOD/>)
SUBTTL IPCF/Operator/QUASAR interface -- ORION message #200050 (OPR CMD)
OPRCMD: PUSHJ P,QSTCHK ;DEFAULT QUEUE STRUCTURE IF NECESSARY
MOVE S1,MSGBLK ;GET CURRENT BLOCK ADDRESS
MOVE T1,MSGCNT ;GET COUNT OF BLOCKS
MOVE T2,0(S1) ;GET APPLICATION CODE
MOVE T3,1(S1) ;GET NODE (INCASE OF ERROR)
SKIPLE T1 ;CHECK BLOCK COUNT
CAME T2,APLCOD ;MATCHING APPLICATION CODE
JRST E$APL ;APPLICATION MESSAGE SCREWUP
ADDI S1,(T1) ;OFFSET TO ARG BLOCK COUNT
MOVE S2,(S1) ;GET COUNT
MOVEM S2,MSGCNT ;SAVE
ADDI S1,1 ;ADVANCE TO FIRST APPLICATION ARG
MOVEM S1,MSGBLK ;UPDATE
PUSHJ P,C$GBLK ;GET INITIAL BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMKEY ;MUST START WITHA KEYWORD
JRST E$OPR ;OPR CMD ERROR
MOVSI S1,-CMDMAX ;SET COUNTER
OPRC.1: HLRZ S2,CMDTAB(S1) ;GET OPERATOR COMMAND CODE
CAME S2,(T3) ;A MATCH?
AOBJN S1,OPRC.1 ;KEEP SEARCHING
JUMPGE S1,E$OPR ;OPR CMD ERROR
HRRZ S2,CMDTAB(S1) ;GET PROCESSOR ADDRESS
JRST (S2) ;DISPATCH
CMDTAB: XWD .CTDEL,.DELET ;DELETE
XWD .CTDIS,.DISAB ;DISABLE
XWD .CTENA,.ENABL ;ENABLE
XWD .CTHLP,E$OPR ;HELP
XWD .CTINS,.INSER ;INSERT
XWD .CTLIS,.LIST ;LIST
XWD .CTMOD,.MODIF ;MODIFY
XWD .CTSHO,.SHOW ;SHOW
CMDMAX==.-CMDTAB ;LENGTH OF TABLE
SUBTTL IPCF/Operator/QUASAR interface -- ACK message #700000
ACK: $SAVE <P1> ;SAVE P1
MOVE P1,C$DSP ;POINT TO FIRST DISPATCH VECTOR
MOVX S2,MF.NOM ;GET THE 'NO MESSAGE' BIT
SKIPE S1,.MSCOD(M) ;GET ACK CODE (IF ANY)
TDNN S2,.MSFLG(M) ;ALL GOOD ACKS HAVE THIS BIT SET
JRST ACK.3 ;MUST BE SOME JUNK TEXT ACK
ACK.1: MOVE C,.CVDAT(P1) ;POINT TO DATA BASE
CAMN S1,.CDACK(C) ;A MATCH?
JRST ACK.2 ;YES
SKIPE P1,.CVLNK(P1) ;POINT TO NEXT
JRST ACK.1 ;LOOP
JRST E$UPA ;UNEXPECTED PROCESS ACK
ACK.2: SETZM .CDACK(C) ;CLEAR FOR NEXT TIME
POPJ P, ;RETURN FOR NOW
ACK.3: SKIPN .OARGC(M) ;QUASAR SNIFFING AROUND?
POPJ P, ;YES--JUST RETURN
LOAD S1,.MSFLG(M),MF.SUF ;GET SUFFIX
CAIE S1,'ODE' ;OPR DOES NOT EXIST?
JRST E$UTA ;NO--UNEXPECTED TEXT ACK
POPJ P, ;RETURN
C$SGFR::MOVE S2,[SI.FLG+SP.GFR] ;SEND TO [SYSTEM]GOPHER
MOVEI S1,0 ;DON'T USE A REAL PID
JRST C$SEND ;GO SEND MESSAGE
C$SMDA::SKIPA S2,[SI.FLG+SP.MDA] ;SEND TO [SYSTEM]MDA
C$SOPR::MOVE S2,[SI.FLG+SP.OPR] ;SEND TO [SYSTEM]OPERATOR
MOVEI S1,0 ;DON'T USE A REAL PID
C$SEND::MOVEM S1,G$SAB+SAB.PD ;SAVE PID
MOVEM S2,G$SAB+SAB.SI ;SAVE SPECIAL PID INDEX WORD
LOAD S1,.MSTYP(M),MS.CNT ;GET LENGTH
MOVEM S1,G$SAB+SAB.LN ;SAVE
MOVEM M,G$SAB+SAB.MS ;SAVE MESSAGE ADDRESS
PUSHJ P,FNDPID ;FIND THE PID IN THE RESEND QUEUE
JRST SEND.1 ;ALREADY THERE
MOVEI S1,SAB.SZ ;SAB LENGTH
MOVEI S2,G$SAB ;SAB ADDRESS
$CALL C%SEND ;SEND MESSAGE
JUMPT .POPJ ;RETURN IF NO ERRORS
CAIE S1,ERNSP$ ;NO SUCH PID?
CAIN S1,ERPWA$ ;PID WENT AWAY?
POPJ P, ;JUST GIVE UP
SEND.1: $SAVE <P1> ;SAVE P1
MOVE S1,IPCQUE ;GET RESEND QUEUE HANDLE
$CALL L%LAST ;POSITION TO END OF LIST
MOVE S2,G$SAB+SAB.LN ;GET MESSAGE LENGTH
TRNN M,PAGSIZ-1 ;MESSAGE ON A PAGE BOUNDRY?
CAIE S2,PAGSIZ ;AND A PAGE IN LENGTH?
JRST SEND.2 ;NO--RANDOM PACKET
SETZ S2, ;ONLY SAVE THE SAB
SEND.2: ADDI S2,SAB.SZ ;PLUS THE SAB
MOVE P1,S2 ;SAVE ENTRY SIZE
MOVE S1,IPCQUE ;GET LINKED LIST HANDLE AGAIN
$CALL L%CENT ;CREATE LIST ENTRY
MOVSI S1,G$SAB ;POINT TO THE SAB
HRRI S1,(S2) ;AND TO THE LINKED LIST STORAGE
BLT S1,SAB.SZ-1(S2) ;COPY SAB
CAIG P1,SAB.SZ ;SAVING JUST THE SAB (PAGE MODE)?
JRST SEND.3 ;YES
MOVSI S1,(M) ;POINT TO MESSAGE
HRRI S1,SAB.SZ(S2) ;POINT PAST THE SAB STORAGE
ADD S2,G$SAB+SAB.LN ;COMPUTE END BLT ADDRESS
BLT S1,SAB.SZ-1(S2) ;COPY MESSAGE INTO LIST
SEND.3: AOS RSENDC ;COUNT THE RESEND NEEDED LATER
POPJ P, ;RETURN
FNDPID: $SAVE <P1,P2> ;SAVE SOME ACS
MOVE P1,G$SAB+SAB.PD ;GET PID
MOVE P2,G$SAB+SAB.SI ;GET SPECIAL INDEX WORD
MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
$CALL L%FIRS ;POSITION TO FIRST ENTRY
JRST FNDP.2 ;ENTER LOOP
FNDP.1: MOVE S1,IPCQUE ;GET LINKED LIST FOR RESENDS
$CALL L%NEXT ;POSITION TO NEXT ENTRY
FNDP.2: JUMPF .POPJ1 ;RETURN IF END OF LIST
CAMN P1,SAB.PD(S2) ;BOTH THE PID
CAME P2,SAB.SI(S2) ;AND THE INDEX MUST MATCH
JRST FNDP.1 ;KEEP SEARCHING
POPJ P, ;RETURN
SUBTTL Command processing -- DELETE
.DELET: PUSHJ P,C$DATA ;FIND THE CATALOG DATA BASE
POPJ P, ;FAILED
PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMFLD ;A FIELD?
JRST E$OPR ;OPR CMD ERROR
PUSHJ P,C$CVSN ;CONVERT VSN TO UPPER CASE
PUSHJ P,C$TBLS ;SEARCH FOR A MATCH
POPJ P, ;NOT FOUND
TXNE S2,TL%ABR ;UNIQUE ABBREVIATION?
JRST E$ANL ;NOT LEGAL IN THIS CASE
MOVE T1,S1 ;COPY TABLE ENTRY ADDRESS
PUSHJ P,C$PRIV ;CALLER PRIV'ED?
JRST E$NPV ;NO
MOVE S2,T1 ;COPY TABLE ENTRY ADDRESS
PUSHJ P,C$TBLD ;DELETE THE TABLE ENTRY
JFCL ;NOT FOUND? (DIDN'T WANT IT ANYWAY)
PUSHJ P,C$FILW ;RE-WRITE THE FILE
POPJ P, ;PROPAGATE ERROR BACK
JRST E$DEL ;GENERATE DELETE ACK AND RETURN
SUBTTL Command processing -- DISABLE/ENABLE
.DISAB: TDZA S1,S1 ;DISABLE ENTRY POINT
.ENABL: MOVEI S1,1 ;ENABLE ENTRY POINT
$SAVE <P1> ;SAVE P1
MOVE P1,S1 ;COPY FLAG
SETZ E, ;NO VOLUME-SET ENTRY
PUSHJ P,C$PRIV ;CALLER PRIV'ED?
JRST E$NPV ;NO
PUSHJ P,C$DATX ;FIND THE CATALOG DATA BASE
POPJ P, ;FAILED
MOVEM P1,.CDUPD(C) ;SAVE UPDATE FLAG
PUSHJ P,DISENA ;SEND ENABLE/DISABLE TO QUASAR
JRST @[E$DIS ;DISABLE ACK
E$ENA](P1) ;ENABLE ACK
SUBTTL Command processing -- INSERT
.INSER: SETZ E, ;NO VOLUME-SET ENTRY
PUSHJ P,C$PRIV ;IS CALLER PRIV'ED?
JRST E$NPV ;NO
TDZA S1,S1 ;INSERT
.MODIF: MOVEI S1,1 ;MODIFY
MOVE E,S1 ;SAVE TEMPORARILY
PUSHJ P,C$DATX ;FIND THE CATALOG DATA BASE
POPJ P, ;FAILED
SKIPE .CDUPD(C) ;UPDATES ALLOWED?
JRST INSE.1 ;YES--NO CHECKING NEEDED
LOAD S1,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAIE S1,SP.QSR ;QUASAR?
CAIN S1,SP.MDA ;MDA?
JRST E$CUD ;YES--CATALOG UPDATES ARE DISABLED
INSE.1: MOVEM E,.CDMOD(C) ;SAVE POSSIBLE MODIFY FLAG
SETZB A,.CDNVA(C) ;NO NEW VSN YET
MOVEI E,CNVBLK ;POINT TO ALTERNATE ENTRY BLOCK
PUSHJ P,C$CLEN ;CLEAR IT OUT
INSE.2: PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMFLD ;A FIELD?
JRST E$OPR ;OPR CMD ERROR
SKIPN (T3) ;NULL?
JRST E$NVN ;NO VSN GIVEN
PUSHJ P,C$CVSN ;CONVERT VSN TO UPPER CASE
SKIPN .CDMOD(C) ;MODIFY?
JRST INSE.3 ;NO
PUSHJ P,C$TBLS ;SEARCH THE TABLE FOR EXISTING ENTRY
POPJ P, ;NOT FOUND
TXNE S2,TL%ABR ;UNIQUE ABBREVIATION?
JRST E$ANL ;NOT LEGAL IN THIS CASE
MOVEM S1,.CDMOD(C) ;SAVE ADDR FOR LATER REFERENCE
HRRZ S2,(S1) ;GET FILE POSITION
MOVEM S2,.CDPFP(C) ;SET FOR I/O
PUSHJ P,C$PREN ;READ ENTRY INTO CORE
POPJ P, ;FAILED
PUSHJ P,C$PRIV ;IS CALLER PRIV'ED?
JRST E$NPV ;NO
JRST INSE.4 ;GO CHECK FOR SWITCHES
INSE.3: MOVSI S1,(T3) ;PREPARE TO COPY
HRRI S1,.CTVSN(E) ;THE VSN INTO THE
MOVEI S2,.CTVSN(E) ;GET STORAGE ADDRESS
ADDI S2,(T2) ;COMPUTE END BLT ADDRESS
BLT S1,-1(S2) ;COPY THE VSN
MOVE T4,T3 ;COPY VSN ADDRESS
HRLI T4,-1(T2) ;AND LENGTH IN WORDS
PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMTOK ;A TOKEN?
JRST INSE.5 ;NO
MOVE S1,(T3) ;GET IT
CAME S1,[ASCIZ /=/] ;INSERT FOO=BAR?
JRST E$OPR ;OPR CMD ERROR
MOVEM T4,.CDNVA(C) ;SAVE NEW VSN ADDRESS
PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMFLD ;FIELD?
JRST E$OPR ;OPR CMD ERROR
PUSHJ P,C$CVSN ;CONVERT VSN TO UPPER CASE
PUSHJ P,C$TBLS ;SEARCH TABLE FOR VSN MATCH
POPJ P, ;NOT FOUND
HRRZ S2,(S1) ;GET FILE POSITION
MOVEM S2,.CDPFP(C) ;SET FOR I/O
PUSHJ P,C$PREN ;READ ENTRY INTO CORE
POPJ P, ;FAILED
MOVSI S1,.CTVSN(E) ;NOW CLEAR OUT
HRRI S1,.CTVSN+1(E) ; THE EXISTING VSN
SETZM .CTVSN(E) ; STORAGE AREA
BLT S1,.CTVSN+VSNSIZ-1(E) ;CLEAR ENTIRE VSN BLOCK
HRLZ S1,.CDNVA(C) ;POINT TO NEW VSN
HRRI S1,.CTVSN(E) ;WHERE IT IS NOW
HLRZ S2,.CDNVA(C) ;GET LENGTH
ADDI S2,.CTVSN(E) ;COMPUTE END BLT ADDRESS
BLT S1,-1(S2) ;COPY NEW VSN OVER OLD ONE
INSE.4: PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
INSE.5: CAIE T1,.CMSWI ;SWITCH?
JRST INSE.6 ;NO
MOVE T1,(T3) ;GET VALUE
MOVSI S1,-SWTMAX ;-COUNT
CAME T1,SWTTAB(S1) ;A MATCH?
AOBJN S1,.-1 ;KEEP LOOKING
JUMPGE S1,E$OPR ;OPR CMD ERROR
HRRZM S1,.CDMST(C) ;SAVE INDEX IN MESSAGE TEMP WORD
PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
MOVE S1,.CDMST(C) ;GET INDEX BACK
SKIPL SWTVAL(S1) ;IF NEGATIVE, DON'T CHECK .CMXXX TYPES
CAMN T1,SWTVAL(S1) ;ARG TYPES MATCH?
PUSHJ P,@SWTDSP(S1) ;PROCESS SWITCH
POPJ P, ;FAILED FOR SOME REASON
JRST INSE.4 ;LOOP BACK FOR ANOTHER SWITCH
INSE.6: MOVE S1,.CVTYP(C) ;GET DEVICE TYPE
STORE S1,.CTVFL(E),CT.TYP ;SAVE
CAIN T1,.CMCFM ;CONFIRMATION?
PUSHJ P,@.CVINS(C) ;NOW PROCESS SPECIAL STUFF
JRST E$OPR ;OPR CMD ERROR
PUSHJ P,@.CVCHK(C) ;CHECK FOR LEGAL ENTRY
POPJ P, ;PROPAGATE ERROR BACK
SKIPN S1,.CDMOD(C) ;MODIFY
JRST INSE.7 ;NO
HLLZS (S1) ;YES--CLEAR OLD FILE POSITION
JRST INSE.8 ;NO TO EITHER
INSE.7: PUSHJ P,C$AVSN ;ALLOCATE VSN STORAGE
POPJ P, ;PROPAGATE ERROR BACK
PUSHJ P,C$TBLA ;ADD NEW ONE TO THE TABLE
POPJ P, ;PROPAGATE ERROR BACK
INSE.8: MOVE A,E ;SAVE ENTRY ADDRESS AWAY
PUSHJ P,C$FILW ;WRITE IT OUT TO THE FILE
POPJ P, ;PROPAGATE ERROR BACK
SKIPN .CDMOD(C) ;MODIFY?
JRST E$INS ;GENERATE INSERT ACK
JRST E$MOD ;GENERATE MODIFY ACK
DEFINE SWTCHS,<
X (.CTDEN,.CMKEY,DENSWT) ;/DENSITY
X (.CTEXP,-1,EXPSWT) ;/EXPIRATION
X (.CTLAB,.CMKEY,LABSWT) ;/LABEL-TYPE
X (.CTLOC,-1,LOCSWT) ;/LOCATION
X (.CTNAM,-1,NAMSWT) ;/NAME
X (.CTTRK,.CMKEY,TRKSWT) ;/TRACKS
X (.CTRID,.CMFLD,RIDSWT) ;/REELID
X (.CTUSR,.CMUSR,USRSWT) ;/USER
>
DEFINE X (NAME,CMND,DISP),<EXP NAME>
SWTTAB: SWTCHS
SWTMAX==.-SWTTAB ;LENGTH OF TABLE
DEFINE X (NAME,CMND,DISP),<EXP CMND>
SWTVAL: SWTCHS
DEFINE X (NAME,CMND,DISP),<EXP DISP>
SWTDSP: SWTCHS
; DENSITY
DENSWT: MOVE S1,(T3) ;GET DENSITY INDEX
CAILE S1,0 ;RANGE
CAILE S1,.CTDMX ; CHECK
JRST E$OPR ;OPR CMD ERROR
STORE S1,.CTVSC(E),CT.DEN ;SAVE MAGTAPE DENSITY
JRST .POPJ1 ;RETURN
; EXPIRATION DATE
EXPSWT: CAIE T1,.CMTAD ;DATE?
CAIN T1,.CMKEY ;OR KEYWORD?
SKIPA S1,(T3) ;GET EXPIRATION DATE OR ZERO (NONE)
POPJ P, ;GIVE UP
HLLZM S1,.CTVED(E) ;SAVE
JRST .POPJ1 ;RETURN
; LABEL-TYPE
LABSWT: MOVE S1,(T3) ;PICK UP KEYWORD
CAIE S1,-1 ;DEFAULT?
JRST LABSW1 ;NO
MOVX S1,CT.LTS!CT.LAB ;BITS TO CLEAR
ANDCAM S1,.CTVSC(E) ;NO LABEL TYPE IS STORED
JRST .POPJ1 ;RETURN
LABSW1: CAIL S1,0 ;RANGE
CAILE S1,.TFLNV ; CHECK
JRST E$OPR ;OPR CMD ERROR
STORE S1,.CTVSC(E),CT.LAB ;SAVE MAGTAPE LABEL TYPE
MOVX S1,CT.LTS ;BIT TO SET
IORM S1,.CTVSC(E) ;REMEMBER LABEL TYPE WAS SET
JRST .POPJ1 ;RETURN
; LOCATION
LOCSWT: CAIE T1,.CMQST ;QUOTED STRING?
CAIN T1,.CMFLD ;OR UNQUOTED TEXT?
SKIPA ;YES
POPJ P, ;GIVE UP
MOVSI S1,.CTVLO(E) ;FIRST
HRRI S1,.CTVLO+1(E) ; CLEAR
SETZM .CTVLO(E) ; OUT THE
BLT S1,.CTVLO+LOCSIZ-1(E) ; NAME BLOCK
MOVSI S1,(T3) ;POINT TO MESSAGE
HRRI S1,.CTVLO(E) ;WHERE TO PUT THE STRING
MOVEI S2,-1(T2) ;GET BLOCK LENGTH
ADDI S2,.CTVLO(E) ;COMPUTE END BLT ADDRESS
BLT S1,-1(S2) ;COPY
JRST .POPJ1 ;RETURN
; NAME
NAMSWT: CAIE T1,.CMQST ;QUOTED STRING?
CAIN T1,.CMFLD ;OR UNQUOTED TEXT?
SKIPA ;YES
POPJ P, ;GIVE UP
MOVSI S1,.CTVNM(E) ;FIRST
HRRI S1,.CTVNM+1(E) ; CLEAR
SETZM .CTVNM(E) ; OUT THE
BLT S1,.CTVNM+NAMSIZ-1(E) ; NAME BLOCK
MOVSI S1,(T3) ;POINT TO MESSAGE
HRRI S1,.CTVNM(E) ;WHERE TO PUT THE STRING
MOVEI S2,-1(T2) ;GET BLOCK LENGTH
ADDI S2,.CTVNM(E) ;COMPUTE END BLT ADDRESS
BLT S1,-1(S2) ;COPY
JRST .POPJ1 ;RETURN
; REELID
RIDSWT: PUSHJ P,@.CVRSW(C) ;PROCESS /REELID
JRST E$OPR ;OPR CMD ERROR
JRST .POPJ1 ;RETURN
; TRACKS
TRKSWT: MOVE S1,(T3) ;GET TRACK INDEX
CAIE S1,.CT7TK ;7-TRACK?
CAIN S1,.CT9TK ;9-TRACK?
SKIPA ;YES
JRST E$OPR ;OPR CMD ERROR
STORE S1,.CTVSC(E),CT.TRK ;SAVE MAGTAPE TRACK INDEX
JRST .POPJ1 ;RETURN
; User name
USRSWT: CAIN T2,3 ;BLOCK CONTAIN A WILDCARD MASK?
JRST USRSW1 ;YES--HANDLE DIFFERENTLY
MOVE S1,(T3) ;GET PPN
MOVEM S1,.CTVUS(E) ;SAVE
JRST .POPJ1 ;RETURN
USRSW1: HLRZ S1,0(T3) ;GET PROJECT NUMBER
HLRZ S2,1(T3) ; AND THE MASK
PUSHJ P,USRSW2 ;CHECK IT OUT
JRST E$PWI ;PARTIAL WILDCARDING IS ILLEGAL
HRLZM S1,.CTVUS(E) ;SAVE
HRRZ S1,0(T3) ;GET PROGRAMMER NUMBER
HRRZ S2,1(T3) ; AND THE MASK
PUSHJ P,USRSW2 ;CHECK IT OUT TOO
JRST E$PWI ;PARTIAL WILDCARDING IS ILLEGAL
HRRM S1,.CTVUS(E) ;SAVE
JRST .POPJ1 ;ALL DONE
USRSW2: CAIN S2,-1 ;NOT WILD?
AOSA (P) ;NOTHING TO DO
CAIE S1,0 ;FULL HALF-WORD WILDCARD?
POPJ P, ;NO--THAT'S ILLEGAL
MOVEI S1,-1 ;SET HALF-WORD WILD
JRST .POPJ1 ;AND RETURN
SUBTTL Command processing -- LIST
.LIST: SETZ E, ;NO VOLUME-SET ENTRY
PUSHJ P,C$PRIV ;IS CALLER PRIV'ED?
JRST E$NPV ;NO
PUSHJ P,C$DATA ;FIND THE CATALOG DATA BASE
POPJ P, ;FAILED
PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMOFI ;OUTPUT FILESPEC?
JRST E$OPR ;OPR CMD ERROR
PUSHJ P,C$LFIL ;SET UP LISTING FILE
PUSH P,S1 ;SAVE MAGIC INDEX
MOVSI S1,-1(T3) ;WHERE THE FD IS NOW
HRRI S1,.CDLFD(C) ;WHERE TO PUT IT
BLT S1,.CDLFD+FDXSIZ-1(C) ;COPY IT
MOVEI S1,.FDNAT ;NATIVE MODE FILE
STORE S1,.CDLFD+.FDLEN(C),FD.TYP ;SAVE
POP P,S1 ;RETRIEVE INDEX
PUSHJ P,C$OOPN ;OPEN FILE FOR OUTPUT
POPJ P, ;FAILED
MOVE S1,.CDTAB(C) ;POINT TO TABLE
SETOM .CDTXF(C) ;FLAG LISTING TO A FILE
SETZM .CDLPN(C) ;SET PAGE COUNTER TO ZERO
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;POINT TO START OF DATA
JUMPGE P1,LIST.2 ;JUMP IF NO ENTRIES IN FILE
LIST.1: HRRZ S1,(P1) ;GET FILE POSITION
MOVEM S1,.CDPFP(C) ;SAVE
MOVEI E,ENTBLK ;POINT TO ENTRY STORAGE
PUSHJ P,C$PREN ;READ FROM FILE
POPJ P, ;RETURN
MOVEI S1,(P1) ;POINT TO CURRENT ENTRY
SUB S1,.CDTAB(C) ;COMPUTE TABLE INDEX
MOVEM S1,.CDLDN(C) ;SAVE AS LISTING DATA ITEM NUMBER
PUSHJ P,@.CVLST(C) ;LIST THE ENTRY
AOBJN P1,LIST.1 ;LOOP THROUGH TABLE
LIST.2: PUSHJ P,LISTSM ;SUMMARIZE
MOVE S1,.CDLIF(C) ;GET IFN
$CALL F%REL ;CLOSE AND RELEASE THE IFN
SETZM .CDTXF(C) ;NO LONGER LISTING TO A FILE
JRST E$LIS ;GENERATE LIST ACK AND RETURN
LISTHD: $TEXT (C$TXTC,<^I/LISTHT/^T/@.CVLHD(C)/^A>)
POPJ P,
LISTSM: MOVE S1,.CDTAB(C) ;GET TABLE ADDRESS
HLRZ S1,(S1) ;GET NUMBER OF ENTRIES
MOVEI S2,"s" ;ASSUME MORE THAN ONE
CAIN S1,1 ;JUST ONE?
MOVEI S2," " ;YES
$TEXT (C$TXTC,<^I/LISTST/>) ;LIST SUMMARY TEXT
POPJ P, ;AND RETURN
LISTHT: ITEXT (<^M^T/@.CVTXT(C)/ listing by ^I/@G$APLT/ %^V/[%%CAT]/ on ^H9L/G$UDT/ at ^C/G$UDT/ Page ^D/.CDLPN(C)/
File: ^F/.CDPFD(C)/ File format: ^D/.CDPFM(C)/
>)
LISTST: ITEXT (<
A total of ^D/S1/ ^T/@.CVTXT(C)/^7/S2/
>)
SUBTTL Command processing -- SHOW
.SHOW: PUSHJ P,C$DATA ;FIND THE CATALOG DATA BASE
POPJ P, ;FAILED
PUSHJ P,C$GBLK ;GET NEXT ARG BLOCK
JRST E$OPR ;OPR CMD ERROR
CAIE T1,.CMFLD ;A FIELD?
JRST E$OPR ;OPR CMD ERROR
PUSHJ P,C$CVSN ;CONVERT VSN TO UPPER CASE
PUSHJ P,C$TBLS ;SEARCH THE APPROPRIATE TABLE
POPJ P, ;NOT FOUND
HRRZ S2,(S1) ;GET FILE POSITION
MOVEM S2,.CDPFP(C) ;SAVE
MOVEI E,ENTBLK ;POINT TO ENTRY STORAGE
PUSHJ P,C$PREN ;READ FROM FILE
POPJ P, ;FAILED
PUSHJ P,C$SETM ;SET UP FOR SEND
PUSHJ P,C$PRIV ;IS CALLER PRIV'ED?
JRST E$NPV ;NO
MOVEI S1,[ITEXT (< ^T/@.CVTXT(C)/ catalog >)] ;DISPLAY HEADER
PUSHJ P,TXTACK ;SET UP ACK MESSAGE
$TEXT (C$TXTC,< ^T/@.CVTXT(C)/ ^T/.CTVSN(E)/^A>)
MOVEI S1,.CTVLO(E) ;POINT TO LOCATION TEXT
HRLI S1,(POINT 8,) ;MAKE A BYTE POINTER
SKIPE (S1) ;HAVE ONE?
$TEXT (C$TXTC,<^M^J Location: ^Q/S1/^A>)
SKIPE S1,.CTVED(E) ;HAVE A VOLUME-SET EXPIRATION DATE?
$TEXT (C$TXTC,<^M^J Expiration date: ^H9L/S1/^A>)
PUSHJ P,C$SOWN ;SHOW OWNER PPN AND NAME
PUSHJ P,@.CVSHW(C) ;GENERATE "SHOW" LISTING
PUSHJ P,TXTDON ;FINISH UP TEXT STUFF
PUSHJ P,C$SOPR ;SEND TO OPR
POPJ P, ;AND RETURN
C$LPPN::SKIPN .CTVUS(E) ;HAVE AN OWNER PPN?
JRST LPPN.1
HLRE TF,.CTVUS(E) ;GET PROJECT NUMBER
MOVEI S1,[ITEXT (<^O6R /.CTVUS(E),LHMASK/>)] ;OCTAL PROJECT #
CAMN TF,[EXP -1] ;WILD?
MOVEI S1,[ITEXT (< *>)] ;YES
HRRE TF,.CTVUS(E) ;GET PROGRAMMER NUMBER
MOVEI S2,[ITEXT (<^O6L /.CTVUS(E),RHMASK/>)] ;OCTAL PROGRAMMER #
CAMN TF,[EXP -1] ;WILD?
MOVEI S2,[ITEXT (<* >)] ;YES
$TEXT (C$TXTC,<^I/(S1)/,^I/(S2)/^A>)
POPJ P, ;RETURN
LPPN.1: $TEXT (C$TXTC,< ^A>) ;FILL COLUMNS
POPJ P, ;AND RETURN
C$SOWN::MOVEI S1,[ASCIZ |Owned by no one|]
SKIPE .CTVUS(E) ;HAVE AN OWNER?
MOVEI S1,[ASCIZ |Owned by |] ;YES
$TEXT (C$TXTC,<^M^J ^T/(S1)/^A>)
SKIPN .CTVUS(E) ;HAVE AN OWNER?
JRST LNAM.1 ;NO--LOOK FOR A NAME
HLRE TF,.CTVUS(E) ;GET PROJECT NUMBER
MOVEI S1,[ITEXT (<^O/.CTVUS(E),LHMASK/>)] ;OCTAL PROJECT #
CAMN TF,[-1] ;WILD?
MOVEI S1,[ITEXT (<*>)] ;YES
HRRE TF,.CTVUS(E) ;GET PROGRAMMER NUMBER
MOVEI S2,[ITEXT (<^O/.CTVUS(E),RHMASK/>)] ;OCTAL PROGRAMMER #
CAMN TF,[-1] ;WILD?
MOVEI S2,[ITEXT(<*>)] ;YES
$TEXT (C$TXTC,<[^I/(S1)/,^I/(S2)/]^A>)
C$LNAM::MOVEI S1," " ;START OFF
PUSHJ P,C$TXTC ; WITH A
MOVEI S1," " ; COUPLE
PUSHJ P,C$TXTC ; OF SPACES
LNAM.1: MOVEI S1,.CTVNM(E) ;POINT TO NAME STORAGE
PJRST C$ASC8 ;TYPE AND RETURN
SUBTTL C$PRIV - Check privileges
; Perform priviledge checking on the requestor
; Call: MOVE E, volume-set entry address or zero
; PUSHJ P,C$PRIV
; <NON-SKIP> ;NOT PRIVILEGED
; <SKIP> ;NOT PRIVILEGED OR NOT VOL-SET OWNER
C$PRIV::LOAD S1,G$IDX,SI.IDX ;GET THE SENDERS SPECIAL PID INDEX
CAIE S1,SP.QSR ;QUASAR?
CAIN S1,SP.MDA ;MDA?
JRST .POPJ1 ;HE CAN DO ANYTHING
CAIE S1,SP.OPR ;ORION?
JRST PRIV.1 ;NO
MOVE S1,G$COD ;GET ACK CODE (OPR'S PID)
$CALL C%PIDJ ;FIND OUT WHAT JOB SENT THIS
JUMPF .POPJ ;ABORT NOW IF PID WENT AWAY
MOVEI S2,JI.USR ;GET LOGGED-IN DIRECTORY
$CALL I%JINF ; ...
JUMPF .POPJ ;JOB WENT AWAY?
JRST PRIV.2 ;ENTER COMMON CODE
PRIV.1: MOVE S1,G$PRV ;GET REQUESTOR'S PRIVS
TXNE S1,MD.PWH ;JACCT?
JRST .POPJ1 ;YES--LET HIM THROUGH
LOAD S1,S1,MD.PJB ;GET REQUESTOR'S JOB NUMBER
MOVE S2,G$SID ;GET REQUESTOR'S PPN
JRST PRIV.2 ;ONWARD
PRIV.2: HRLZS S1 ;MAKE AN INDEX
HRRI S1,.GTPRV ;FORM GETTAB ARGUMENT
GETTAB S1, ;READ PRIV WORD
SETZ S1, ;???
TXNE S1,JP.ADM ;ADMINISTRATIVE PRIVS?
JRST .POPJ1 ;YES
PRIV.3: JUMPE E,.POPJ ;RETURN IF NO VOLUME-SET ENTRY
MOVE S1,.CTVUS(E) ;GET VOLUME-SET OWNER
TLC S1,-1 ;WILDCARDED
TLCN S1,-1 ; PROJECT NUMBER?
TLO S2,-1 ;YES
TRC S1,-1 ;WILDCARDED
TRCN S1,-1 ; PROGRAMMER NUMBER?
TRO S2,-1 ;YES
XOR S2,S1 ;COMPARE
JUMPN S2,.POPJ ;DIFFERENT--SAY VOLUME-SET NOT FOUND
JRST .POPJ1 ;RETURN GOODNESS
SUBTTL Common subroutines -- C$TBLA - Add entry to table
C$TBLA::$SAVE <P1,P2> ;SAVE P1 AND P2
HLRZ P1,S2 ;PUT NAME ADDR IN RH INCASE OF ERROR
SKIPA P2,S2 ;COPY ARGUMENT
TBLA.1: MOVE S2,P2 ;GET ARGUMENT
MOVE S1,.CDTAB(C) ;POINT TO TABLE
$CALL S%TBAD ;ADD ENTRY TO TABLE
JUMPT .POPJ1 ;RETURN
CAIN S1,EREIT$ ;ALREADY IN TABLE?
JRST E$AIC ;YES
CAIE S1,ERTBF$ ;TABLE FULL?
JRST E$TSE ;TABLE SEARCH ERROR
PUSHJ P,C$TBLI ;INCREATE SIZE OF TABLE
POPJ P, ;PROPAGATE ERROR BACK
JRST TBLA.1 ;AND TRY AGAIN
SUBTTL Common subroutines -- C$TBLD - Delete entry from a table
C$TBLD::MOVE S1,.CDTAB(C) ;POINT TO TABLE
$CALL S%TBDL ;DELETE ENTRY FROM TABLE
JUMPT .POPJ1 ;RETURN
MOVEI S1,TBLD.1 ;POINT TO ERROR ITEXT BLOCK
POPJ P, ;AND RETURN
TBLD.1: ITEXT (<^T/@.CVTXT(C)/ "^T/(S2)/" not found>)
SUBTTL Common subroutines -- C$TBLC - Create a table
C$TBLC::MOVE S1,.CDCOR(C) ;GET LINKED LIST HANDLE FOR CORE
SKIPN S2,.CDTAB(C) ;GET TABLE ADDRESS
JRST TBLC.1 ;DOESN'T EXIST YET
$CALL L%APOS ;POSITION
JUMPF TBLC.1 ;???
$CALL L%DENT ;RETURN CORE
TBLC.1: MOVE S1,.CDCOR(C) ;GET HANDLE INCASE OF ERROR
MOVEI S2,TBLLEN ;GET INITIAL LENGTH
$CALL L%CENT ;GET CORE
JUMPF E$COR ;CHECK FOR ERRORS
MOVEI S1,TBLLEN ;GET SIZE AGAIN
MOVEM S1,.CDTLN(C) ;SAVE
MOVEM S2,.CDTAB(C) ;SAVE ADDRESS
SUBI S1,1 ;ACCOUNT FOR OVERHEAD WORD
MOVEM S1,(S2) ;SET UP MAXIMUM LENGTH IN TABLE
JRST .POPJ1 ;AND RETURN
SUBTTL Common subroutines -- C$TBLI - Increase table length
C$TBLI::$SAVE <P1,P2> ;SAVE P1 AND P2
MOVE P1,.CDTLN(C) ;GET OLD LENGTH
MOVE P2,.CDTAB(C) ;GET OLD ADDRESS
MOVE S1,.CDCOR(C) ;GET LINKED LIST HANDLE FOR CORE
MOVEI S2,<TBLLEN/2>(P1) ;INCREATE BY HALF AS MUCH
$CALL L%CENT ;GET CORE
JUMPF E$COR ;CHECK FOR ERRORS
MOVEI S1,<TBLLEN/2>(P1) ;GET LENGTH BACK
MOVEM S1,.CDTLN(C) ;SAVE LENGTH
MOVEM S2,.CDTAB(C) ;SAVE ADDRESS
SUBI S1,1 ;ACCOUNT FOR OVERHEAD WORD
HRRM S1,(P2) ;SET NEW MAXIMUM LENGTH
HRLZ S1,P2 ;OLD TABLE ADDR
HRR S1,S2 ;NEW TABLE ADDR
ADDI S2,(P1) ;COMPUTE END OF BLT
BLT S1,-1(S2) ;COPY NEW TO OLD
MOVE S1,.CDCOR(C) ;GET LINKED LIST HANDLE FOR CORE
MOVE S2,P2 ;AND OLD TABLE ADDRESS
$CALL L%APOS ;POSITION LIST
JUMPF .POPJ1 ;???
$CALL L%DENT ;DELETE LIST ENTRY
JRST .POPJ1 ;AND RETURN
SUBTTL Common subroutines -- C$TBLS - Table search
C$TBLS::SKIPN (T3) ;HAVE A NAME?
JRST E$NVN ;NULL VSN
MOVE S1,.CDTAB(C) ;POINT TO TABLE HEADER
MOVEI S2,(T3) ;POINT TO STRING ADDRESS
$CALL S%TBLK ;FIND THE NAME
JUMPF E$UNK ;CHECK FOR ERRORS
TXNE S2,TL%EXM!TL%ABR ;EXACT MATCH OR UNIQUE ABBREVIATION?
JRST .POPJ1 ;YES
TXNE S2,TL%NOM ;NO MATCH?
JRST E$UNK ;YES
TXNE S2,TL%AMB ;AMBIGUOUS?
JRST E$AMB ;YES
MOVEI S2,(T3) ;POINT TO NAME
POPJ P, ;AND GIVE UP
SUBTTL Common subroutines -- C$ASC8 - Type an 8-bit ASCIZ string
C$ASC8::MOVE S2,S1 ;COPY STRING ADDRESS
HRLI S2,(POINT 8,) ;MAKE A BYTE POINTER
ASC8.1: ILDB S1,S2 ;GET A CHARACTER
JUMPE S1,.POPJ ;RETURN ON A NULL
PUSHJ P,C$TXTC ;PUT A CHARACTER
JRST ASC8.1 ;LOOP
SUBTTL Text routines -- C$TYPT - Table driven typeout
; Routine to type text based on the contents of a translation table
; Call: MOVE S1, table-address
; PUSHJ P,C$TYPT
C$TYPT::$SAVE <P1> ;SAVE P1
MOVE P1,S1 ;GET AOBJN POINTER TO TABLE
TYPT.1: MOVE S1,0(P1) ;GET CHARACTERS TO OUTPUT
MOVEI S2,@1(P1) ;ADDRESS OF STRING
HLL S2,1(P1) ;MAKE A BYTE POINTER
PUSHJ P,TYPX.1 ;TYPE QUANTITY
ADDI P1,1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P1,TYPT.1 ;AND LOOP
POPJ P, ;RETURN
SUBTTL Text routines -- C$TYPx - Type 6, 7, or 8-bit text
C$TYP6: HRLI S2,(POINT 6,) ;SIXBIT
JRST TYPX.1 ;ENTER COMMON CODE
C$TYP7::HRLI S2,(POINT 7,) ;7-BIT ASCII
JRST TYPX.1 ;ENTER COMMON CODE
C$TYP8::HRLI S2,(POINT 8,) ;8-BIT ASCII
TYPX.1: PUSH P,S1 ;SAVE BYTE COUNT
TYPX.2: ILDB S1,S2 ;GET A CHARACTER
JUMPE S1,TYPX.3 ;JUMPF IF END OF STRING
TYPX.A: PUSHJ P,C$TXTC ;PUT A CHARACTER
SKIPL (P) ;-1 MEANS TYPE ANY LENGTH
SOSGE (P) ;COUNT DOWN
JRST TYPX.2 ;LOOP
TYPX.3: SKIPG (P) ;MORE TO TYPE?
JRST TYPX.5 ;NO
TYPX.4: MOVEI S1," " ;GET A SPACE
PUSHJ P,C$TXTC ;OUTPUT
SOSGE (P) ;COUNT DOWN
JRST TYPX.3 ;LOOP
TYPX.5: POP P,(P) ;PRUNE STACK
POPJ P, ;AND RETURN
SUBTTL File I/O -- C$xFIL - Set up for I/O
; Routine to set up the FOB, FAB, and FD blocks for primary
; data file, alternate data file, or listing files.
; Call: PUSHJ P,C$xFIL
;
; On return, S1 and S2 will be set up ready to call a F%xOPN.
;
; AC usage: All preserved.
C$PFIL::TDZA S1,S1 ;PRIMARY DATA FILE ENTRY POINT
C$AFIL::MOVEI S1,1 ;ALTERNATE DATA FILE ENTRY POINT
JRST FILE.1 ;ENTER COMMON CODE
C$LFIL::MOVEI S1,2 ;LISTING FILE ENTRY POINT
; Set the entry point index
FILE.1: $SAVE <P1,P2,P3,P4> ;SAVE SOME ACS
MOVE P1,S1 ;COPY INDEX
MOVEI P2,@FOBTAB(P1) ;POINT TO CORRECT FOB
MOVEI P3,@FABTAB(P1) ;POINT TO CORRECT FAB
MOVEI P4,@FDTAB(P1) ;POINT TO CORRECT FD
SETZM @POSTAB(P1) ;ZAP CURRENT FILE POSITION
; Set up the FOB
FILE.2: MOVEM P4,FOB.FD(P2) ;SAVE FD ADDRESS
MOVE S1,BSZTAB(P1) ;GET DESIRED BYTE SIZE
TXO S1,FB.PHY ;DOING PHYSICAL I/O
MOVEM S1,FOB.CW(P2) ;SAVE CONTROL WORD
SETZM FOB.US(P2) ;NO IN-YOUR-BEHALF PPN
SETZM FOB.CD(P2) ;NO CONNECTED DIRECTORY STUFF
MOVEM P3,FOB.AB(P2) ;SAVE ATTRIBUTE BLOCK ADDRESS
; Set up the FAB
FILE.3: MOVE S1,[FI.IMM!<2,,.FIPRO>] ;IMMEDIATE 2-WORD PROTECTION CODE ARG
MOVEM S1,0(P3) ;SAVE
MOVE S1,G$SPRT ;GET .SYS FILE PROTECTION CODE
MOVEM S1,1(P3) ;SAVE
; Set up the FD
FILE.4: MOVSI S1,(P4) ;START ADDRESS
HRRI S1,1(P4) ;MAKE A BLT POINTER
SETZM (P4) ;CLEAR FIRST WORD
BLT S1,FDXSIZ-1(P4) ;CLEAR ENTIRE FD
MOVEI S1,FDXSIZ ;FD LENGTH
STORE S1,.FDLEN(P4),FD.LEN ;SAVE
MOVEI S1,.FDNAT ;NATIVE MODE FILE
STORE S1,.FDLEN(P4),FD.TYP ;SAVE
MOVE S1,G$QSTR ;GET QUEUE STRUCTURE
MOVEM S1,.FDSTR(P4) ;SAVE
MOVE S1,.CVFIL(C) ;GET FILE NAME
MOVEM S1,.FDNAM(P4) ;SAVE
MOVSI S1,'SYS' ;GET EXTENSION
MOVEM S1,.FDEXT(P4) ;SAVE
SKIPN DEBUGW ;DEBUGGING?
SKIPA S1,G$SPPN ;NO--USE SYSTEM FILE UFD
MOVEI S1,0 ;ELSE DEFAULT TO CURRENT PATH
MOVEM S1,.FDPPN(P4) ;SAVE
MOVE S1,P1 ;RETURN MAGIC INDEX
POPJ P, ;RETURN
; FOB offsets
FOBTAB: Z .CDPFB(C) ;PRIMARY DATA FILE
Z .CDAFB(C) ;ALTERNATE DATA FILE
Z .CDLFB(C) ;LISTING FILE
; FAB offsets
FABTAB: Z .CDPFA(C) ;PRIMARY DATA FILE
Z .CDAFA(C) ;ALTERNATE DATA FILE
Z .CDLFA(C) ;LISTING FILE
; FD offsets
FDTAB: Z .CDPFD(C) ;PRIMARY DATA FILE
Z .CDAFD(C) ;ALTERNATE DATA FILE
Z .CDLFD(C) ;LISTING FILE
; IFN offsets
IFNTAB: Z .CDPIF(C) ;PRIMARY DATA FILE
Z .CDAIF(C) ;ALTERNATE DATA FILE
Z .CDLIF(C) ;LISTING FILE
; Byte sizes
BSZTAB: EXP 44 ;PRIMARY DATA FILE
EXP 44 ;ALTERNATE DATA FILE
EXP 7 ;LISTING DATA FILE
; File format number offsets
FMTTAB: Z .CDPFM(C) ;PRIMARY DATA FILE
Z .CDAFM(C) ;ALTERNATE DATA FILE
; File position offset
POSTAB: Z .CDPFP(C) ;PRIMARY DATA FILE
Z .CDAFP(C) ;ALTERNATE DATA FILE
OPETAB: EXP E$POP,E$AOP,E$LOP ;OPEN ERRORS
PSETAB: EXP E$PPS,E$APS ;POSITIONING ERROR
PEFTAB: EXP E$PEF,E$AEF ;PREMATURE EOF
IERTAB: EXP E$PIE,E$AIE ;INPUT ERRORS
OERTAB: EXP E$POE,E$AOE,E$LOE ;OUTPUT ERRORS
SUBTTL File I/O -- C$xOPN - Open a file for I/O
C$IOPN::TDZA S2,S2 ;INPUT
C$OOPN::MOVEI S2,1 ;OUTPUT
$SAVE <P1,P2> ;SAVE P1 AND P2
MOVE P1,S1 ;COPY MAGIC INDEX
MOVE P2,S2 ;SAVE I/O FLAG
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,@FOBTAB(P1) ;POINT TO FOB
XCT [$CALL F%IOPN ;OPEN FOR INPUT
$CALL F%OOPN](P2) ;OPEN FOR OUTPUT
JUMPF @OPETAB(P1) ;RETURN APPROPRIATE ERROR MESSAGE
MOVEM S1,@IFNTAB(P1) ;SAVE IFN
MOVNI S2,1 ;WANT EXACT FILESPEC
$CALL F%FD ;ASK GLXFIL
MOVSI S2,(S1) ;POINT TO RETURNED FD
HRRI S2,@FDTAB(P1) ;MAKE A BLT POINTER
LOAD S1,.FDLEN(S1),FD.LEN ;GET RETURNED LENGTH
ADDI S1,@FDTAB(P1) ;COMPUTE END BLT ADDRESS
BLT S2,-1(S1) ;COPY THE FD
MOVE S1,.CDWSC(C) ;GET WAIT STATE CODE
CAIN S1,.CWDNI ;DATA BASE NOT INITED (NEW FILE)?
MOVEI S1,.CWRUN ;YES--MAKE RUNNABLE NOW
MOVEM S1,.CDWSC(C) ;UPDATE
JRST .POPJ1 ;AND RETURN
SUBTTL File I/O -- C$FILW - Write a file
C$FILW::$SAVE <P1> ;SAVE P1
PUSHJ P,C$AFIL ;SET UP ALTERNATE DATA FILE BLOCKS
PUSHJ P,C$OOPN ;AND OPEN FOR OUTPUT
POPJ P, ;FAILED
MOVE S1,.CVFMT(C) ;GET CURRENT FILE FORMAT NUMBER
MOVEM S1,.CDAFM(C) ;UPDATE
PUSHJ P,C$AWFM ;WRITE FILE FORMAT
POPJ P, ;FAILED
MOVE S1,.CDTAB(C) ;GET TABLE ADDRESS
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;POINT TO FIRST DATA WORD
JUMPGE P1,FILW.4 ;JUMP IF NO ENTRIES IN FILE
FILW.1: HRRZ S1,(P1) ;GET FILE POSITION NUMBER
JUMPE S1,FILW.2 ;JUMP IF ENTRY DOESN'T EXIST YET
MOVEM S1,.CDPFP(C) ;SAVE
MOVEI E,ENTBLK ;SET ENTRY BLOCK ADDRESS
PUSHJ P,C$PREN ;READ THE ENTRY
POPJ P, ;FAILED
JRST FILW.3 ;SKIP NEW ENTRY STUFF
FILW.2: MOVE E,A ;COPY NEW ENTRY ADDRESS TO BE ADDED
FILW.3: MOVE S1,.CDAIF(C) ;GET OUTPUT IFN
LOAD S2,.CTVFL(E),CT.FEL ;GET FILE ENTRY LENGTH
HRLZS S2 ;PUT IN LH
HRRI S2,(E) ;AND ENTRY BLOCK ADDRESS
$CALL F%OBUF ;OUTPUT THE ENTRY
JUMPF FILW.5 ;CHECK FOR ERRORS
MOVE S1,.CDAFP(C) ;GET CURRENT POSITION
HRRM S1,(P1) ;SET IN TABLE
LOAD S2,.CTVFL(E),CT.FEL ;GET FILE ENTRY LENGTH
ADDI S1,(S2) ;PLUS WORDS IN THIS ENTRY
MOVEM S1,.CDAFP(C) ;ADJUST FILE POSITION
FILW.4: AOBJN P1,FILW.1 ;LOOP FOR ALL ENTRIES
MOVE S1,.CDAIF(C) ;GET IFN
$CALL F%REL ;CLOSE AND RELEASE THE IFN
SKIPE S1,.CDPIF(C) ;GET PRIMARY IFN
$CALL F%REL ;RELEASE IT
PUSHJ P,C$PFIL ;NOW MUST RE-OPEN THE FILE
PUSHJ P,C$IOPN ;DO IT
POPJ P, ;FAILED
JRST .POPJ1 ;AND RETURN
FILW.5: PUSH P,S1 ;SAVE ERROR CODE
SKIPE S1,.CDAIF(C) ;GET IFN
$CALL F%RREL ;RELEASE AND FLUSH IFN
POP P,S1 ;GET ERROR CODE BACK
JRST E$AOE ;OUTPUT ERROR OF SOME SORT
SUBTTL File I/O -- C$CLEN - Clear entry
C$CLEN::MOVSI S1,0(E) ;START ADDRESS
HRRI S1,1(E) ;MAKE A BLT POINTER
SETZM (E) ;CLEAR FIRST WORD
BLT S1,PAGSIZ-1(E) ;CLEAR ENTIRE BLOCK
MOVEI S1,.CTVSL ;GET MINIMUM LENGTH WORD COUNT
STORE S1,.CTVFL(E),CT.FEL ;SAVE FILE ENTRY LENGTH
POPJ P, ;RETURN
SUBTTL File I/O -- C$xRFM - Read file format
C$PRFM::TDZA S1,S1 ;PRIMARY DATA FILE
C$ARFM::MOVEI S1,1 ;ALTERNATE DATA FILE
XRFM: $SAVE <P1> ;SAVE P1
MOVE P1,S1 ;COPY INDEX
MOVE S1,@IFNTAB(P1) ;GET IFN
$CALL F%IBYT ;READ A WORD
JUMPF @IERTAB(P1) ;CHECK FOR ERRORS
MOVEM S2,@FMTTAB(P1) ;SAVE FILE FORMAT NUMBER
MOVE S1,S2 ;PUT IN BETTER PLACE
AOS @POSTAB(P1) ;ADVANCE POSITION
JRST .POPJ1 ;AND RETURN
SUBTTL File I/O -- C$xWFM - Write file format
C$PWFM::TDZA S1,S1 ;PRIMARY DATA FILE
C$AWFM::MOVEI S1,1 ;ALTERNATE DATA FILE
XWFM: $SAVE <P1> ;SAVE P1
MOVE P1,S1 ;COPY INDEX
MOVE S1,@IFNTAB(P1) ;GET IFN
MOVE S2,@FMTTAB(P1) ;GET FILE FORMAT NUMBER
$CALL F%OBYT ;WRITE A WORD
JUMPF @OERTAB(P1) ;CHECK FOR ERRORS
AOS @POSTAB(P1) ;ADVANCE POSITION
JRST .POPJ1 ;AND RETURN
SUBTTL File I/O -- C$xREN - Read entry
C$PREN::TDZA S1,S1 ;PRIMARY DATA FILE
C$AREN::MOVEI S1,1 ;ALTERNATE DATA FILE
XREN: $SAVE <P1,P2> ;SAVE P1 AND P2
MOVE P1,S1 ;SAVE FLAG
PUSHJ P,C$CLEN ;CLEAR OUT ENTRY STORAGE
MOVE S1,@IFNTAB(P1) ;GET IFN
MOVE S2,@POSTAB(P1) ;AND DESIRED POSITION
$CALL F%POS ;POSITION FOR INPUT
JUMPF XREN.5 ;CHECK FOR ERRORS
PUSHJ P,XREN.3 ;GET A WORD
POPJ P, ;PROPAGATE ERROR BACK
MOVEM S1,(E) ;SAVE
LOAD S1,S1,CT.FEL ;GET FILE ENTRY LENGTH
MOVN P2,S1 ;NEGATE
HRLZS P2 ;PUT IN LH
HRRI P2,(E) ;MAKE AN AOBJN POINTER
MOVE S1,@FMTTAB(P1) ;GET FILE FORMAT NUMBER
CAIN S1,0 ;OLD STYLE?
ADDI P2,1 ;YES
CAMN S1,.CDFMT(C) ;CURRENT?
AOBJN P2,.+1 ;INCREMENT FOR FIRST STORE
XREN.1: PUSHJ P,XREN.3 ;GET A WORD
JRST XREN.2 ;INCOMPLETE ENTRY
MOVEM S1,(P2) ;PUT A WORD
AOBJN P2,XREN.1 ;LOOP
MOVE S1,@IFNTAB(P1) ;GET IFN
$CALL F%CHKP ;CHECKPOINT
MOVEM S1,@POSTAB(P1) ;SAVE CURRENT POSITION
JRST .POPJ1 ;AND RETURN
XREN.2: CAIN S1,EREOF$ ;PREMATURE EOF?
JRST @PEFTAB(P1) ;YES
JRST @PSETAB(P1) ;POSITIONING ERROR
XREN.3: MOVE S1,@IFNTAB(P1) ;GET IFN
$CALL F%IBYT ;GET A WORD
JUMPF XREN.4 ;FAILED
MOVE S1,S2 ;COPY IT
AOS @POSTAB(P1) ;ADVANCE POSITION
AOSA (P) ;SKIP
XREN.4: CAIN S1,EREOF$ ;EOF?
POPJ P, ;YES
PJRST @IERTAB(P1) ;NO--INPUT ERROR
XREN.5: CAIE S1,EREOF$ ;END OF FILE?
CAIN S1,ERIFP$ ;ILLEGAL FILE POSITION?
POPJ P, ;YES--DONE
JRST @PSETAB(P1) ;ELSE PROCESS ERRORS
SUBTTL Volume-set processing -- C$AVSN - Allocate VSN storage
C$AVSN::MOVEI S1,0 ;INIT COUNTER
MOVEI S2,.CTVSN(E) ;POINT TO START OF STRING
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
AVSN.1: ILDB TF,S2 ;GET A CHARACTER
SKIPE TF ;END OF STRING?
AOJA S1,AVSN.1 ;LOOP
ADDI S1,5 ;ROUND UP TO A FULL WORD
IDIVI S1,5 ;GET WORDS NEEDED FOR THIS STRING
PUSH P,S1 ;SAVE WORD COUNT
MOVE S2,S1 ;GET WORD COUNT
MOVE S1,.CDCOR(C) ;GET LINKED LIST HANDLE FOR CORE
$CALL L%CENT ;CREATE ENTRY
POP P,S1 ;RESTORE WORD COUNT
JUMPF E$COR ;CHECK FOR ERRORS
MOVSI TF,.CTVSN(E) ;WHERE STRING RESIDES
HRRI TF,(S2) ;WHERE TO COPY IT
ADDI S1,(S2) ;COMPUTE END OF BLT
BLT TF,-1(S1) ;COPY STRING
HRLZS S2 ;FOR S%TBLK
JRST .POPJ1 ;RETURN WITH STRING ADDR IN S2
SUBTTL Volume-set processing -- C$CVSN - Convert VSN to upper case
C$CVSN::MOVEI S1,(T3) ;POINT TO START OF STRING
HRLI S1,(POINT 7,) ;MAKE A BYTE POINTER
CVSN.1: ILDB S2,S1 ;GET A CHARACTER
JUMPE S2,.POPJ ;RETURN IF END OF VSN
CAIL S2,"A"+40 ;LOWER
CAILE S2,"Z"+40 ; CASE?
SKIPA ;NO
TRZ S2,40 ;CONVERT TO UPPER CASE
DPB S2,S1 ;UPDATE
JRST CVSN.1 ;LOOP THROUGH STRING
SUBTTL Volume-set processing -- C$MVSN - Find a VSN in a message
C$MVSN::MOVE P1,C$DSP ;POINT TO START OF DISPATCH VECTORS
MOVE S1,.OARGC(M) ;GET COUND OF ARGUMENTS IN MESSAGE
CAIN S1,1 ;CAN ONLY BE ONE
PUSHJ P,C$GBLK ;GET ARGUMENT BLOCK
JRST E$MDA ;ILLEGALY FORMATTED MDA MESSAGE
CAIE T1,.CTVSB ;VOLUME-SET BLOCK?
JRST E$MDA ;ILLEGALY FORMATTED MDA MESSAGE
ADDI T3,.CTVSN ;POINT TO THE VSN
LOAD S1,.CTVFL-.CTVSN(T3),CT.TYP ;GET REQUESTED CATALOG TYPE
JUMPE S1,MVSN.3 ;MUST SEARCH ALL CATALOGS
MVSN.1: CAMN S1,.CVTYP(P1) ;A MATCH?
JUMPN MVSN.2 ;GOT IT
SKIPE P1,.CVLNK(P1) ;NO--POINT TO NEXT VECTOR
JRST MVSN.1 ;SEARCH FOR STR VECTOR
MVSN.2: MOVE C,.CVDAT(P1) ;POINT TO A DATA BASE
TDZA P1,P1 ;CLEAR FOR NEXT TIME THOUGH
MVSN.3: MOVE C,.CVDAT(P1) ;POINT TO A DATA BASE
MOVEI S1,.CWDNI ;WAIT STATE TO CHECK
CAMN S1,.CDWSC(C) ;DATA BASE INITIALIZED?
JRST MVSN.4 ;NOT AVAILABLE
PUSHJ P,C$TBLS ;SEARCH FOR THE VSN
JRST MVSN.5 ;VOLUME SET NOT FOUND
TXNN S2,TL%EXM ;ONLY ALLOW AN EXACT MATCH HERE
JRST MVSN.5 ;ABBREVIATIONS ARE ILLEGAL FROM RCAT
HRRZ S2,(S1) ;GET FILE POSITION
MOVEM S2,.CDPFP(C) ;SAVE
MOVEI E,ENTBLK ;RESET ENTRY BLOCK ADDRESS
PUSHJ P,C$PREN ;READ IN FROM DISK
POPJ P, ;PROPAGATE ERRORS BACK
JRST .POPJ1 ;RETURN
MVSN.4: SKIPA S1,[E$CNA] ;CATALOG NOT AVAILABLE
MVSN.5: MOVEI S1,E$VNF ;VOLUME-SET NOT FOUND
SKIPE P1 ;END OF CHAIN
SKIPN P1,.CVLNK(P1) ;POINT TO NEXT
SKIPA S2,[SI.FLG] ;ELSE THAT'S AN ERROR
JRST MVSN.3 ;TRY AGAIN
TDNN S2,G$IDX ;SENDER USE A SPECIAL INDEX?
JRST (S1) ;ACK WITH ERROR TEXT IF NO ONE SPECIAL
POPJ P, ;ELSE JUST RETURN
SUBTTL Error processing
DEFINE X (ABV,FLG,CLS,TXT),<E$'ABV::! JSP TF,ERROR>
C$ERR:: ACKTXT
DEFINE X (ABV,FLG,CLS,TXT),<XWD AM.'FLG+.AM'CLS,[ITEXT (<TXT>)]>
ERRTAB: ACKTXT
DEFINE X (NAM,TXT),<XWD ''NAM'',[ITEXT (<TXT>)]>
ERRTYP: EXP 0
ACKCLS
ERROR: HRRZS TF ;KEEP ONLY ADDRESS
SUBI TF,C$ERR ;CONVERT TO ERROR INDEX
MOVEM TF,ERRFLG ;SAVE ERROR CODE
ADDI TF,ERRTAB-1 ;INDEX INTO ERROR TEXT TABLE
MOVE TF,@TF ;GET FLAGS+CLASS,,ITEXT BLOCK ADDRESS
HLLM TF,ERRFLG ;SAVE FLAGS+CLASS
HRRZM TF,ERRTXT ;SAVE
MOVEI TF,<ERRLEN*5>-1 ;GET MAX CHARACTER COUNT
MOVEM TF,ERRCNT ;SAVE
MOVE TF,[POINT 7,ERRBUF] ;BYTE POINTER TO STORAGE
MOVEM TF,ERRPTR ;SAVE
MOVE TF,[ERRBUF,,ERRBUF+1] ;SET UP BLT
SETZM ERRBUF ;CLEAR FIRST WORD
BLT TF,ERRBUF+ERRLEN-1 ;CLEAR ENTIRE BUFFER
$TEXT (<ERRCHR>,<^I/@ERRTXT/^0>) ;BUILD TEXT
HRRZ TF,ERRPTR ;GET FINAL ADDRESS FROM BYTE POINTER
SUBI TF,ERRBUF-1 ;COMPUTE WORD COUNT (ALLOW EXTRA NULL)
MOVEM TF,ERRCNT ;UPDATE NOW AS A WORD COUNT
POPJ P, ;AND RETURN
ERRCHR: SOSLE ERRCNT ;COUNT DOWN
IDPB S1,ERRPTR ;STORE CHARACTER
$RETT ;RETURN
TXTACK::PUSH P,S1 ;SAVE DISPLAY HEADER ITEXT BLOCK
MOVEI S1,.OMACS ;OPERATOR ACK
STORE S1,.MSTYP(M),MS.TYP ;SET MESSAGE TYPE
SETZM .MSFLG(M) ;NO SPECIAL FLAGS
MOVE S1,G$COD ;GET ACK CODE
MOVEM S1,.MSCOD(M) ;SAVE
MOVX S1,WT.SJI!WT.NFO ;NO JOB INFO, NO TEXT RE-FORMATTING
MOVEM S1,.OFLAG(P2) ;SAVE WTO FLAGS
; ADD DISPLAY HEADER BLOCK
AOS .OARGC(M) ;COUNT THE NEW BLOCK
MOVEI S1,.ORDSP ;BLOCK TYPE
MOVEM S1,.OHDRS(M) ;SAVE
MOVEI S1,.OHDRS(M) ;START ADDR OF TEXT BLOCK
MOVEM S1,.CDTXB(C) ;SAVE
PUSH P,S1 ;SAVE
$CALL I%NOW ;GET CURRENT DATE/TIME
POP P,S2 ;GET ADDRESS BACK
MOVEM S1,ARG.DA(S2) ;SAVE
ADDI S2,ARG.DA+1 ;TEXT BEGINS HERE
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
MOVEM S2,.CDTXP(C) ;SAVE
HRRZS S1 ;KEEP JUST THE ADDRESS
MOVE S2,MSGLEN ;GET REQUESTED MESSAGE LENGTH
SUBI S2,.OHDRS+ARG.DA+1 ;ACCOUNT FOR OVERHEAD WORDS +1
IMULI S2,5 ;COMPUTE CHARACTER COUNT
MOVEM S2,.CDTXC(C) ;SAVE
POP P,S1 ;GET ITEXT BLOCK BACK
$TEXT (C$TXTC,<^I/(S1)/^0>) ;STORE
AOS S1,.CDTXP(C) ;GET FINAL ADDRESS
SUBI S1,.OHDRS(M) ;COMPUTE WORD COUNT
STORE S1,.OHDRS+ARG.HD(M),AR.LEN ;SAVE
; ADD THE TEXT BLOCK
AOS .OARGC(M) ;COUNT THE NEW BLOCK
HRRZ S1,.CDTXP(C) ;NEXT BLOCK GOES HERE
MOVEM S1,.CDTXB(C) ;SAVE
MOVEI S2,.CMTXT ;BLOCK TYPE
MOVEM S2,ARG.HD(S1) ;SAVE
MOVEI S2,ARG.DA(S1) ;WHERE THE TEXT WILL BEGIN
HRLI S2,(POINT 7,) ;MAKE A BYTE POINTER
MOVEM S2,.CDTXP(C) ;SAVE
HRRZS S1 ;KEEP JUST THE ADDRESS
SUBI S1,(M) ;COMPUTE WORDS USED SO FAR
MOVE S2,MSGLEN ;GET REQUESTED MESSAGE LENGTH
SUBI S2,(S1) ;GET WORDS REMAINING
IMULI S2,5 ;COMPUTE CHARACTER COUNT
MOVEM S2,.CDTXC(C) ;SAVE
POPJ P, ;RETURN
C$CRLF::MOVEI S1,.CHCRT ;CARRIAGE RETURN
PUSHJ P,C$TXTC ;OUTPUT
MOVEI S1,.CHLFD ;LINE FEED
C$TXTC::SKIPE .CDTXF(C) ;DOING A LISTING?
JRST TXTLST ;YES
SOSLE .CDTXC(C) ;COUNT DOWN
IDPB S1,.CDTXP(C) ;STORE CHARACTER
$RETT ;RETURN
TXTLST: PUSH P,S2 ;SAVE S2
MOVE S2,S1 ;GET CHARACTER
SKIPG .CDLPN(C) ;INITIALIZED YET?
JRST TXTLS1 ;DO IT NOW
CAIN S2,.CHLFD ;LINE FEED?
AOS .CDLLN(C) ;YES--INCREMENT LINE NUMBER
MOVE S1,.CDLLN(C) ;GET LINE NUMBER
CAIE S1,LINPPG ;PAGE FULL?
JRST TXTLS2 ;NOT YET
TXTLS1: PUSH P,S2 ;SAVE CHARACTER TO OUTPUT
MOVEI S2,.CHFFD ;GET A FORM FEED
PUSHJ P,TXTLSX ;OUTPUT IT
JRST [POP P,S2 ;RESTORE SAVED CHARACTER FROM STACK
POPJ P,] ;PROPAGATE ERROR BACK
MOVEI S2,1 ;FIRST LINE
MOVEM S2,.CDLLN(C) ;RESET LINE COUNTER
AOS .CDLPN(C) ;INCREMENT PAGE NUMBER
PUSHJ P,LISTHD ;OUTPUT LISTING HEADER
POP P,S2 ;RESTORE CHARACTER
CAIN S2,.CHLFD ;LINE FEED CAUSE NEW PAGE?
JRST TXTLS3 ;YES--ALREADY HAVE A NEW LINE
TXTLS2: MOVE S1,.CDLIF(C) ;GET IFN
$CALL F%OBYT ;OUTPUT
JUMPF [HALT .]
TXTLS3: POP P,S2 ;RESTORE S2
$RETT ;AND RETURN
TXTLSX: MOVE S1,.CDLIF(C) ;GET IFN
$CALL F%OBYT ;OUTPUT CHARACTER
JUMPF E$LOE ;LISTING OUTPUT ERROR
JRST .POPJ1 ;RETURN
TXTDON: MOVEI S1,.CHNUL ;GET A NUL
PUSHJ P,C$TXTC ;STORE
MOVE S1,.CDTXB(C) ;STARTING ADDRESS OF TEXT BLOCK
AOS S2,.CDTXP(C) ;GET FINAL ADDRESS
HRRZS S2 ;STRIP OFF JUNK
SUB S2,S1 ;COMPUTE WORDS USED
STORE S2,ARG.HD(S1),AR.LEN ;SAVE LENGTH
HRRZ S1,.CDTXP(C) ;GET FINAL ADDRESS AGAIN
SUBI S1,(M) ;COMPUTE TOTAL WORDS IN MESSAGE
STORE S1,.MSTYP(M),MS.CNT ;SAVE
POPJ P, ;RETURN
SUBTTL End
END CATLOG