Trailing-Edge
-
PDP-10 Archives
-
tops10_703a_sys_atpch16_bb-fr67f-bb
-
qsrinf.x16
There are 2 other files named qsrinf.x16 in the archive. Click here to see a list.
TITLE QSRINF -- [SYSTEM]INFO For GALAXY-10 Systems
SUBTTL Chuck O'Toole/CDO/RCB 15 Aug 84
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1987.
;ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;GLXLIB SYMOLS
SEARCH QSRMAC ;SEARCH QUASAR SYMBOLS
PROLOGUE(QSRINF) ;GENERATE THE NECESSARY SYMBOLS
.DIRECTIVE FLBLST ;FOR CLEANER LISTINGS
IFE FTINFO,< ;IF ANSWERED 'NO' TO GALGEN
PASS2 ;GIVE UP NOW
END ;SAVE COMPUTES AND A TREE
> ;END OF IFE FTINFO
;ALL ENTRIES THAT PROCESS MESSAGES ARE CALLED WITH
; P1 = THE MESSAGE TYPE
; M = THE MESSAGE PROPER
; T1 = PACKET FLAGS
;ALL HAVE FULL USE OF THE ACCUMULATORS
SUBTTL Table of contents
; TABLE OF CONTENTS FOR QSRINF
;
;
; SECTION PAGE
; 1. Table of contents......................................... 2
; 2. Preamble.................................................. 3
; 3. Explanations.............................................. 4
; 4. Module storage............................................ 6
; 5. P$INIT -- [SYSTEM]INFO Initialization................... 7
; 6. Error Handling............................................ 8
; 7. The system PID list....................................... 9
; 8. Process a message to [SYSTEM]INFO......................... 10
; 9. Process IPCFM. UUO request from [SYSTEM]GOPHER............ 11
; 10. Common message dispatching................................ 12
; 11. Dispatch table for messages to [SYSTEM]INFO from users.... 14
; 12. Find PID for name -- Function 1......................... 15
; 13. Find name for PID -- Function 2......................... 16
; 14. Assign PIDs -- Functions 3 and 4........................ 17
; 15. Drop specific PID -- Function 5......................... 19
; 16. Drop PIDs -- Functions 6 and 7.......................... 20
; 17. Tell others when a PID is dropped -- Function 10........ 21
; 18. Routine to allocate a system pid for P$PCPD............... 22
; 19. IPCC Request to drop PIDs -- Function 15................ 23
; 20. P$KLPD -- Kill a PID if couldn't send to it............. 24
; 21. Privilege checking routines............................... 25
; 22. DROPIT -- Drop a PID.................................... 26
; 23. VALPID -- Validate a PID.................................. 27
; 24. VALNAM -- Validate the contents of the name............. 28
; 25. String conversion routines for VALNAM..................... 30
; 26. FNDNAM -- Find the name sent in the PID queue........... 35
; 27. Some utility routines..................................... 36
; 28. IPCREQ -- IPCFM. dialog with [SYSTEM]IPCC................. 37
; 29. Common message blocks (pre-formatted)..................... 38
; 30. INFDMP - Dump [SYSTEM]INFO database (for debugging)....... 39
SUBTTL Preamble
; Entry points found in QSRINF
ENTRY P$INIT ;Initialization Entry Point
ENTRY P$INFO ;User request received for [SYSTEM]INFO
ENTRY P$IGFR ;IPCFM. UUO request (Send by GOPHER)
ENTRY P$PCSS ;[SYSTEM]INFO notification of RESET or LOGOUT
ENTRY P$KLPD ;PID in S1 is no longer valid ( Parallel to A$KLPD )
ENTRY INFDMP ;Debugging database dump
; There are no stopcodes in QSRINF
SUBTTL Explanations
COMMENT \
When using either function 3 or 4 to assign a PID to the name
provided, there is only one error code defined, IPCBN% (77). This may be a
good idea since the malicious user does not know exactly what he did wrong,
only that it is wrong. This same reasoning is used by LOGIN and SPRINT-10
when either the P,Pn is invalid or the Password specified is wrong.
However, it is useful to know exactly what could generate IPCBN%. The
following is a list of reasons why QSRINF generates IPCBN%.
1.0 INVALID CHARACTERS
1. Control Characters (<40 octal) may not appear anywhere in the name
(except Horizontal Tab (11 octal).
2. Exceeding the maximum number of characters in the name (including
the null at the end of the ASCIZ string). The number is:
5 * MIN(number of data words sent - 2 , %IPCML - 2)
2.0 IF THE OPTIONAL SQUARE BRACKETS ARE USED
1. More than one open square bracket.
2. More than one close square bracket.
3. Not one of each or they're in the wrong order.
4. Bracketed text is not first or last in the string.
5. The only forms legal within the square brackets are:
1. [Project,Programmer]
2. [Project,*]
3. [*,Programmer]
4. [*,*]
5. [SYSTEM]
The strings 'ANY' or ANY may be used in place of the *. Only
alphanumerics are valid here (blanks and tabs are illegal) and if
both (or either) Project and Programmer are specified, only octal
numbers are valid and the requestor must match the result (after
wild carding). A request to use the name [SYSTEM] requires that
the requestor be a privileged job (JACCT), be an operator ([1,2]),
or have the IPCF privilege.
IPCBN% may also be returned when using function 1 to find the PID for
a name. however, it can only occur if the maximum number of characters is
exceeded (i.e. the null character was not found). If the name is invalid
for one of the other reasons, a name search is done anyway and error IPCNN%
(Unknown Name) will probably be returned. This is to reduce the
restriction on the contents of square brackets.
Additional error codes returned by QSRINF and their meanings are:
IPCNL% 3 Callers data block is < 3 words
IPCTL% 5 Asked for the name of a PID but answer doesn't fit in the data
block sent
IPCPI% 15 Request to Drop PIDs not belonging to the job and IP.CFP is not
set or caller doesn't have the privilege to set IP.CFP
IPCUF% 16 Requested function code not in the range of 1 - 10
IPCBJ% 17 Argument to functions 6 or 7 is not a valid job number or JCH
IPCPF% 20 [SYSTEM]IPCC's PID table has no more free slots
IPCCF% 71 [SYSTEM]IPCC did not honor a request to Create or Drop a PID
IPCQP% 73 Job's PID quota exceeded
IPCBP% 74 PID is truely unknown or Function 5 argument was not a PID
IPCDN% 75 Name requested is already in use by another job or context (if
it belongs to the requesting context, the old PID will be returned
as a normal answer).
IPCNN% 76 Name has no corresponding PID if function 1, PID requested has a
null name if function 2
IPCBN% 77 Described above
\
SUBTTL Module storage
THSMAX: BLOCK 1 ;MAXIMUM NAME LENGTH FOR THIS MESSAGE
PRIVRQ: BLOCK 1 ;STATE OF IP.CFP IN RECEIVED PACKET
SNDJCH: BLOCK 1 ;SENDER'S JCH
GFRMSG: BLOCK 1 ;FLAG MESSAGE FROM GOPHER, NOT USER
CCPID: BLOCK 1 ;PID FOR DUPLICATE ANSWER
PAKLEN: BLOCK 1 ;SPACE AVAILABLE IN USER'S PACKET
RSPLEN: BLOCK 1 ;SPACE FOR LENGTH OF RESPONSE MESSAGE
DEFER: BLOCK 1 ;FLAG TO DEFER RESPONSE FOR .IPCIN
;DEBUGGING STORAGE
NAMBUF: BLOCK 12 ;SPACE FOR COMPONENT NAMES
;Space for copying user strings
USRSIZ: BLOCK 1 ;CURRENT SIZE OF USER BLOCK
USRBUF: BLOCK 1 ;ADDRESS OF BUFFER FOR COPYING
USRCNT: BLOCK 1 ;COUNTDOWN OF BUFFER SIZE
SUBTTL P$INIT -- [SYSTEM]INFO Initialization
;P$INIT IS CALLED FOR ONCE ONLY START-UP OF [SYSTEM]INFO
P$INIT:
IFN FTFLBK,<
MOVE S1,[%CNDAE] ;MONITOR VERSION GETTAB
GETTAB S1, ;GET IT
$RETF ;CAN'T INIT IF NOT THERE
HRRZS S1 ;ISOLATE BINARY VERSION
CAIGE S1,703 ;DOES THIS MONITOR HAVE IPCFM.?
$RETF ;NO, DON'T BECOME [SYSTEM]INFO
> ;END OF IFN FTFLBK
MOVE S1,G$MPS## ;MAXIMUM PACKET SIZE
$CALL M%GMEM ;GET SOME SPACE
DMOVEM S1,USRSIZ ;SAVE THE SIZE AND ADDRESS FOR LATER
MOVEI S1,PB.MXS ;SIZE OF PIB
MOVEI S2,G$IPIB## ;POINT TO OUR PIB
$CALL C%CPID ;TRY TO GET OUR PID
$RETIF ;GIVE UP IF CAN'T
MOVE S1,G$IPIB##+PB.PID ;YES, GET RETURNED PID
MOVEM S1,G$IPID## ;STORE SO WE GET OUR MESSAGES
$RETT ;RETURN GOODNESS
SUBTTL Error Handling
;DEFINE [SYSTEM]INFO ERROR MESSAGES
DEFINE INFERS(A),<
XLIST
IRP A,<
E$'A'%: PUSHJ P,INFERR
EXP IPC'A'%
>
LIST
SALL
> ;END OF DEFINE INFERS
INFERS<UF,NL,PI,BP,TL,QP,NN,BN,DN,PF,CF,BJ,IS>
;HERE WHEN SOMEONE CALLS (OR EXITS THROUGH) ANY OF THE E$xx% ERROR CODES
; STORES THE CORRESPONDING IPCxx% ERROR NUMBER INTO G$ERR
INFERR: EXCH T1,(P) ;SAVE T1, GET ADDRESS OF ERROR CODE
MOVE T1,(T1) ;GET ERROR PROPER
HRRZM T1,G$ERR## ;SAVE GLOBAL ERROR INDICATOR
POP P,T1 ;RESTORE T1
POPJ P, ;AND RETURN
SUBTTL The system PID list
;SYSTAB IS USED BY FNDNAM AND P$PCIG FOR PREDEFINED NAMES
DEFINE .SPID(IDX,T10,T20,NAME),<
NAM.LN==8 ;;"[SYSTEM]" TAKES UP 8 CHARS
IRPC (NAME),<NAM.LN==NAM.LN+1> ;;COUNT UP LENGTH OF NAME
IFL MX.NLN-NAM.LN,<MX.NLN==NAM.LN> ;;KEEP TRACK OF LARGEST
BYTE (9) IDX, NAM.LN (18) [ASCIZ |[SYSTEM]'NAME'|]
> ;END OF DEFINE .SPID
MX.NLN==0 ;START WITH SMALL NAME
SYSTAB: SPIDS ;EXPAND THE NORMAL NAMES
.SPID SP.IPC,,,IPCF ;ADD IN THIS TRADITIONAL ONE
SYSTBL==.-SYSTAB ;LENGTH OF THE TABLE
MX.NLN==MX.NLN ;SHOW THE MAX NAME LENGTH
;DEFINE MASKS TO EXTRACT THE ABOVE
SPD.ID==777B8 ;THE SYSTEM PID INDEX
SPD.LN==777B17 ;THE LENGTH OF THE PID'S NAME
SPD.NM==0,,-1 ;ADDRESS OF THE NAME STRING
SUBTTL Process a message to [SYSTEM]INFO
;CALL IS FROM TOP LEVEL
; P1 = MESSAGE TYPE (FUNCTION CODE)
; M = THE MESSAGE PROPER
; T1 = THE PACKET FLAGS
P$INFO: LOAD S1,G$PRVS##,MD.PJH ;GET SENDER'S JCH
MOVEM S1,SNDJCH ;SAVE TO LOOK AT LATER
MOVE S1,G$ENT## ;GET MDB
LOAD S2,MDB.MS(S1),MD.CNT ;GET RECEIVED LENGTH
SETZM GFRMSG ;NOT FROM [SYSTEM]GOPHER
PUSHJ P,P$MSG ;DO THE FUNCTION DISPATCH (AND CC SEND)
MOVE S1,G$SND## ;GET SENDER
MOVEM S1,G$SAB##+SAB.PD ;SAVE AS OUR TARGET
SKIPE DEFER ;WANT TO DEFER RESPONSE?
JRST INFO.1 ;YES, DO SO
MOVE S1,RSPLEN ;NO, GET RESPONSE SIZE
CAIE S1,PAGSIZ ;SENDING A PAGE BACK?
PJRST SENDIT ;NO, JUST RESPOND AND RETURN
MOVE S1,G$ENT## ;YES, GET MDB ADDRESS AGAIN
MOVEI S2,1 ;SINCE C%REL WILL TRY TO GIVE AWAY
STORE S2,MDB.MS(S1),MD.CNT ;OUR PAGE, FAKE IT OUT
PJRST SENDIT ;NOW SEND RESPONSE AND RETURN
;Here to give a deferred response. This is an answer to .IPCIN, and
;the PID queue entry to be watched is in AP.
INFO.1: MOVEI H,PIDLNK-.QHLNK(AP) ;FAKE QUEUE HEADER FOR M$ELNK
MOVEI P1,G$SAB## ;THE SAB WE WANT TO COPY
PUSHJ P,C$GET## ;GET A COPY IN AP (PRESERVES H)
PUSHJ P,LINKNT ;APPEND IT TO THE NOTIFY LIST AND RETURN
SETZM G$SAB##+SAB.FL ;CLEAR THE ERROR INDICATOR AGAIN
POPJ P, ;RETURN
SUBTTL Process IPCFM. UUO request from [SYSTEM]GOPHER
P$IGFR: SETOM GFRMSG ;THIS MESSAGE IS FROM THE GOPHER
MOVE S1,.OHDRS+ARG.DA(M) ;GET IYB WORD
MOVEM S1,G$SND## ;SAVE IN OURS
$CALL C%PIDH ;GET ITS OWNING JCH
SKIPT ;IS IT STILL THERE?
HRRZ S1,G$MCOD## ;NO, USE INVOKING JCH
MOVEM S1,SNDJCH ;SAVE FOR PRIV CHECKERS
LOAD S2,.OHDRS(M),AR.LEN ;GET SIZE OF INFO BLOCK SENT
SOJ S2, ;ACCOUNT FOR IYB WORD
STORE S2,.OHDRS(M),AR.LEN ;PUT BACK TO USER'S VALUE
MOVEI M,.OHDRS+ARG.DA(M) ;POINT M TO REAL INFO MESSAGE
MOVE S1,-1(M) ;GET LEN,,FUNCTION
MOVEM S1,(M) ;PUT WHERE AN ANSWER SHOULD HAVE IT
HRRZ P1,S1 ;COPY FUNCTION CODE TO CORRECT AC
PUSHJ P,P$MSG ;DISPATCH THE FUNCTION REQUESTED
MOVE S1,RSPLEN ;GET RESPONSE SIZE
STORE S1,(M),AR.LEN ;SET AS SUB-BLOCK LENGTH FOR GOPHER
SUBI M,.OHDRS ;MAKE ROOM FOR GALAXY HEADER
MOVEM M,G$SAB##+SAB.MS ;SAVE AS PACKET ADDRESS
ADDI S1,.OHDRS ;ACCOUNT FOR OVERHEAD
MOVEM S1,G$SAB##+SAB.LN ;SAVE PACKET SIZE
STORE S1,.MSTYP(M),MS.CNT ;SET MESSAGE SIZE IN HEADER
MOVEI S1,MT.TXT ;GOPHER ACK TYPE
STORE S1,.MSTYP(M),MS.TYP ;SET AS TYPE OF RESPONSE
MOVE S1,G$MCOD## ;GOPHER'S ACK CODE
MOVEM S1,.MSCOD(M) ;GIVE IT BACK TO HIM
SETZM .MSFLG(M) ;NO FLAGS DESIRED
SETZM .OFLAG(M) ;ALSO NOT HERE
MOVEI S1,1 ;ONE SUB-BLOCK
MOVEM S1,.OARGC(M) ;SET FOR CONSISTENCY
MOVE S1,G$GPID## ;PICK UP GOPHER'S PID
MOVEM S1,G$SAB##+SAB.PD ;THAT'S OUR TARGET
MOVEI S1,IPCNL% ;NOT LONG ENOUGH ERROR
MOVE S2,G$ERR## ;GET THE ERROR TO RETURN
CAIN S2,IPCTL% ;DATA TOO LONG FOR USER'S BUFFER?
STORE S1,G$SAB##+SAB.FL,SF.ECD ;YES, CHANGE TO USER'S BUFFER TOO SHORT
SKIPN DEFER ;WANT TO DEFER THIS SEND?
PJRST SENDIT ;NO, JUST SEND IT OFF
PJRST INFO.1 ;YES, DO SO
SUBTTL Common message dispatching
P$MSG: MOVEM S2,PAKLEN ;SAVE MESSAGE SIZE
MOVEM S2,RSPLEN ;ALSO DEFAULT RESPONSE LENGTH
MOVEM M,G$SAB##+SAB.MS ;SAVE ADDRESS FOR RESPONSE MESSAGE
MOVEI S2,G$IPIB## ;POINT TO MY PIB
MOVEM S2,G$SAB##+SAB.PB ;AS THE SENDER
SETZM G$SAB##+SAB.SI ;CLEAR SPECIAL INDEX STUFF
SETZM G$SAB##+SAB.FL ;CLEAR FLAGS
MOVE S1,1(M) ;GET PID FOR COPY
MOVEM S1,CCPID ;SAVE FOR RESPONSE TIME
SETZM 1(M) ;WE NEVER RETURN THE CC PID
TXNN T1,IP.CFP ;PRIVILEGED SEND?
TDZA S1,S1 ;NO, LOAD ZERO
MOVEI S1,1 ;YES, LOAD ONE
MOVEM S1,PRIVRQ ;REMEMBER STATE OF IP.CFP
SETZM DEFER ;NOT YET TRYING TO DEFER RESPONSE
;Done with the setup, now check and dispatch the function itself.
;P1, T1, and M still set up.
CAXL P1,FNCMIN ;IN CUSTOMER RANGE?
CAILE P1,FNCMAX ;TYPE IN RANGE
ZERO P1 ;NO, MAKE IT LOOK INVALID
MOVE S1,PAKLEN ;GET THE COUNT SENT
CAIGE S1,3 ;MINIMUM SIZE FOR ALL MESSAGES
MOVEI P1,FNCMAX+1 ;SET TO SAY TOO SHORT
MOVE S1,FNCTAB(P1) ;GET DISPATCH ADDRESS FOR THIS FUNCTION
PUSHJ P,(S1) ;DISPATCH
;P$MSG CONTINUED ON NEXT PAGE
;P$MSG CONTINUED FROM PREVIOUS PAGE
;Here after calling the function processor
SKIPE S1,G$ERR## ;GET ERROR CODE
SETZM CCPID ;NO DUPLICATES IF ERRORS
STORE S1,G$SAB+SAB.FL,SF.ECD ;STORE IN SEND ARGUMENT BLOCK
MOVE S1,RSPLEN ;GET RESPONSE MESSAGE SIZE
MOVEM S1,G$SAB##+SAB.LN ;SET FOR ANSWER
SKIPN P1,CCPID ;WANT TO SEND A DUPLICATE?
JRST MSG.3 ;NO, SO DON'T
PUSHJ P,ISPID ;IS NUMBER IN P1 A PID?
JUMPF MSG.3 ;NO, SO DON'T SEND TO IT
MOVE S1,P1 ;YES, COPY IT
$CALL C%SIDX ;IS IT ONE OF THE SYSTEM PIDS?
JUMPT MSG.3 ;YES, DON'T SEND TO IT
MOVEM P1,G$SAB##+SAB.PD ;NO, SET AS TARGET
PUSH P,AP ;SAVE AP IN CASE WANT TO DEFER
MOVEI P1,G$SAB## ;SAB TO REPLICATE
PUSHJ P,C$GET## ;MAKE A COPY
SKIPE DEFER ;WANT TO DEFER?
JRST MSG.1 ;YES, DO SO
PUSHJ P,C$LINK## ;NO, JUST PUT IN RESEND QUEUE
JRST MSG.2 ;MERGE WITH CLEANUP
MSG.1: MOVE H,(P) ;GET OLD AP AGAIN
MOVEI H,PIDLNK-.QHLNK(H) ;BUILD FAKE QUEUE HEADER
PUSHJ P,LINKNT ;PUT ON END OF QUEUE FOR THIS PID
MSG.2: POP P,AP ;RESTORE AP
MSG.3: MOVE S1,PRIVRQ ;PROPAGATE SENDER'S PRIVILEGE BIT
STORE S1,G$SAB##+SAB.FL,IP.CFP ;INTO RESPONSE TO HIM (BUT NOT CC PID)
POPJ P, ;RETURN TO P$INFO OR P$IGFR
SUBTTL Dispatch table for messages to [SYSTEM]INFO from users
CSTTAB:
; ADD INSTALLATION-SPECIFIC FUNCTIONS HERE
FNCTAB: EXP E$UF% ; 0 = UNKNOWN FUNCTION
EXP P$PCIW ; 1 = .IPCIW = FIND PID FOR SPECIFIED NAME
EXP P$PCIG ; 2 = .IPCIG = FIND NAME FOR SPECIFIED PID
EXP P$PCII ; 3 = .IPCII = PID TO NAME UNTIL RESET
EXP P$PCIJ ; 4 = .IPCIJ = PID TO NAME UNTIL LOGOUT
EXP P$PCID ; 5 = .IPCID = DROP A PID
EXP P$PCIR ; 6 = .IPCIR = PRETEND JOB DID A RESET
EXP P$PCLQ ; 7 = .IPCIL = PRETEND JOB DID A LOGOUT
EXP P$PCPD ; 10 = .IPCIN = NOTIFY WHEN A PID IS DROPPED
FNCMIN==<CSTTAB-FNCTAB> ;MINIMUM LEGAL MESSAGE TO [SYSTEM]INFO
FNCMAX==<.-FNCTAB>-1 ;HIGHEST LEGAL MESSAGE FROM USERS TO INFO
EXP E$NL% ;HIGHEST + 1 = NOT LONG ENOUGH
SUBTTL Find PID for name -- Function 1
P$PCIW: PUSHJ P,VALNAM ;VALIDATE NAME, GET LENGTH
SKIPN S1 ;WAS NAME BAD
JUMPE S2,E$BN% ;YES, NO LENGTH = NO TERMINATOR FOUND
PUSHJ P,FNDNAM ;FIND NAME IN TABLES (COULD BE NO PRIVS)
JUMPE AP,E$NN% ;UNKNOWN NAME
JUMPL AP,PCIW.1 ;SYSTEM PIDS ARE DIFFERENT
MOVE S1,PIDPID(AP) ;GET THE PID WHO HAS THAT NAME
PUSHJ P,VALPID ;SANITY CHECK
JRST E$NN% ;UNKNOWN NAME IF INVALID PID
STORE S2,PIDJOB(AP),PID.JC ;SAVE JCH FOR LATER SANITY CHECKS
MOVEM S1,1(M) ;PUT PID INTO ANSWER FIELD
POPJ P, ;RETURN TO GIVE ANSWER
PCIW.1: LOAD S1,SYSTAB(AP),SPD.ID ;GET SYSTEM INDEX
$CALL C%RPRM ;GET THE CORRESPONDING PID
JUMPF E$NN% ;NOT ASSIGNED
PUSHJ P,VALPID ;SEE IF STILL VALID
JRST E$NN% ;UNASSIGNED
MOVEM S1,1(M) ;VALID, STORE INTO ANSWER FIELD
POPJ P, ;RETURN TO GIVE ANSWER
SUBTTL Find name for PID -- Function 2
P$PCIG: MOVE S1,2(M) ;GET PID REQUESTED
PUSHJ P,VALPID ;SANITY CHECK
JRST E$BP% ;UNKNOWN PID
LOAD AP,HDRPID##+.QHLNK,QH.PTF ;SEARCH THE PID QUEUE
PCIG.1: JUMPE AP,PCIG.4 ;UNKNOWN VALID PID, CHECK IF SYSTEM
CAME S1,PIDPID(AP) ;THIS IT
JRST PCIG.3 ;NO, TRY THE NEXT
LOAD T2,PIDJOB(AP),PID.LN ;NUMBER OF CHARS IN PID'S NAME
JUMPE T2,E$NN% ; NULL NAME GETS 'UNKNOWN NAME'
MOVSI T1,PIDNAM(AP) ;GET ADDRESS OF NAME
PCIG.2: HRR T1,PAKLEN ;INCLUDE CALLER'S PACKET LENGTH
INCR T2 ;ACCOUNT FOR THE NULL
ADDI T2,^D4 ;NOW ROUND UP TO A FULL WORD
IDIVI T2,^D5 ;CONVERT TO FULL WORDS
CAILE T2,-2(T1) ;CALLER HAVE ENOUGH ROOM
PJRST E$TL% ;NO, TOO LONG FOR USERS BUFFER
HRRI T1,2(M) ;INTO ANSWER
ADDI T2,-1(T1) ;END OF THE BLT
BLT T1,(T2) ;MOVE THE DATA INTO ANSWER BLOCK
MOVEM S1,1(M) ;RETURN PID ASKED ABOUT AS WELL
POPJ P, ;AND RETURN
PCIG.3: LOAD AP,.QELNK(AP),QE.PTN ;FIND NEXT IN QUEUE
JRST PCIG.1 ;AND SEE IF THATS IT
PCIG.4: $CALL C%SIDX ;IS THIS A SYSTEM PID?
JUMPF E$NN% ;NO, UNKNOWN NAME
MOVSI AP,-SYSTBL ;AOBJN INDEX FOR SYSTAB
PCIG.5: LOAD S2,SYSTAB(AP),SPD.ID ;GET THE INDEX FOR THIS ENTRY
CAME S1,S2 ;DO THEY MATCH?
AOBJN AP,PCIG.5 ;NO, KEEP LOOKING
JUMPGE AP,E$NN% ;NO NAME IF CAN'T FIND IT
MOVE S1,2(M) ;RESTORE PID
LOAD T1,SYSTAB(AP),SPD.NM ;GET ADDRESS OF NAME
MOVSS T1 ;WHERE WE WANT IT
LOAD T2,SYSTAB(AP),SPD.LN ;LOAD NAME LENGTH
JRST PCIG.2 ;SET UP ANSWER AND RETURN IT
SUBTTL Assign PIDs -- Functions 3 and 4
P$PCIJ: TDZA S1,S1 ;INDICATE JOB WIDE PID
P$PCII: MOVX S1,1B0 ;INDICATE KEEP IT UNTIL RESET
IOR S1,SNDJCH ;MAKE ARGUMENT TO .IPCSC
MOVEM S1,PCII.A ;SAVE THE EVENTUAL ARGUMENT
PUSHJ P,VALNAM ;VALIDATE THE NAME
JUMPF E$BN% ;NAME HAS ILLEGAL CHARACTERS
MOVEM S2,PCII.B ;SAVE LENGTH OF NAME
PUSHJ P,FNDNAM ;SEE IF NAME ALREADY EXISTS
JUMPE AP,PCII.2 ;NOT FOUND, OK SO FAR
MOVE S1,PIDPID(AP) ;GET PID OR INDEX
JUMPL AP,PCII.4 ;TEST SYSTEM NAME DIFFERENTLY
PUSHJ P,VALPID ;SEE IF STILL VALID
JRST PCII.2 ;NO, TRY TO ASSIGN IT ANEW
;Here if name already exists with a valid PID
PCII.1: CAME S2,SNDJCH ;ASKING FOR SAME NAME AGAIN
PJRST E$DN% ;NO, DUPLICATE NAME
MOVEM S1,1(M) ;YES, PUT SAME PID INTO ANSWER
POPJ P, ;AND GIVE IT BACK TO CALLER
;Here if name does not exist yet (or now)
PCII.2: MOVE S1,PCII.A ;GET BACK THE JCH + FLAG
MOVEI AP,CREBLK ;BLOCK FOR IPCC
ZERO CREANS ;CLEAR ANY JUNK
PUSHJ P,IPCREQ ;ASK TO CREATE A PID FOR THE JOB
JUMPT PCII.3 ;ANALYZE FAILURES
CAIN S2,IPCPF% ;PID TABLE FULL
PJRST E$PF% ;YES, GIVE USER SAME ERROR
CAIN S2,IPCQP% ;PID QUOTA EXCEEDED?
PJRST E$QP% ;YES, GIVE USER SAME ERROR
JRST E$CF% ;ANY OTHERS, GIVE IPCC REQUEST FAILED
;P$PCII CONTINUED ON NEXT PAGE
;P$PCII CONTINUED FROM PREVIOUS PAGE
PCII.3: MOVE P1,CREANS ;GET PID CREATED
MOVEM P1,1(M) ;STORE CREATED PID IN ANSWER
MOVEM P1,G$SND## ;NEW PID GETS THE ANSWER
MOVEI H,HDRPID## ;POINT TO PID QUEUE
SKIPN S1,PCII.B ;GET NAME LENGTH AGAIN
POPJ P, ;SAVE SPACE, DON'T STORE NULL NAMES
IDIVI S1,5 ;MAKE WORD COUNT
AOS AP,S1 ;ROUND UP, LEAVING ROOM FOR NULL
PUSHJ P,M$GFRE## ;GET A CELL
MOVEM P1,PIDPID(AP) ;STORE PID
MOVE S1,PCII.A ;GET JCH AGAIN
STORE S1,PIDJOB(AP),PID.JC ;STORE OWNER
MOVE S1,PCII.B ;GET THE LENGTH OF THE NAME
STORE S1,PIDJOB(AP),PID.LN ;AS NAME LENGTH
HRL S2,USRBUF ;WHERE THE NAME IS
HRRI S2,PIDNAM(AP) ;THE NAME IN THE QUEUE ENTRY
LOAD S1,.QEVSZ(AP),QE.VSZ ;NUMBER OF WORDS TO MOVE
ADDI S1,PIDNAM(AP) ;FIND END OF TRANSFER
BLT S2,-1(S1) ;MOVE NAME INTO QUEUE ENTRY
PJRST M$ELNK## ;ADD TO END OF PID QUEUE
PCII.4: LOAD S1,SYSTAB(AP),SPD.ID ;GET THE SYSTEM INDEX
$CALL C%RPRM ;FIND ITS VALUE
JUMPF PCII.5 ;OK IF NOT FOUND
PUSHJ P,VALPID ;SEE IF STILL A VALID PID
JRST PCII.5 ;PRETEND WE DIDN'T FIND IT
JRST PCII.1 ;CHECK OWNERSHIP, ETC.
PCII.5: PUSH P,AP ;SAVE INDEX INTO SYSTAB
PUSHJ P,PCII.2 ;ASSIGN A NEW PID
POP P,AP ;RESTORE SYSTAB INDEX
SKIPE G$ERR## ;IF FAILED,
POPJ P, ;PROPAGATE
MOVE S1,1(M) ;OK SO FAR, GET THE PID
MOVEM S1,SETPID ;STORE IN .IPCWP BLOCK
LOAD S1,SYSTAB(AP),SPD.ID ;GET INDEX AGAIN
MOVEI AP,SETBLK ;POINT TO REQUEST BLOCK
PUSHJ P,IPCREQ ;TRY TO SET THE PID FOR THE USER
$RETIT ;IF SUCCEEDS, WE'RE GOLDEN
PUSH P,S2 ;SAVE ERROR CODE
MOVE S1,1(M) ;GET PID BACK AGAIN
SETZM 1(M) ;NOT GOING TO GIVE IT TO THE USER
SETOM PRIVRQ ;WE WANT OUR PRIVS NOW
PUSHJ P,DROPIT ;DELETE THE PID
PUSHJ P,G$SFAL## ;DELETE CORE EVEN IF CAN'T ZAP PID
POP P,G$ERR## ;RESTORE OUR ERROR CODE
POPJ P, ;AND RETURN TO P$MSG
PCII.A: BLOCK 1 ;JCH DURING CREATE OPERATION
PCII.B: BLOCK 1 ;NUMBER OF CHARACTERS IN NAME REQUESTED
SUBTTL Drop specific PID -- Function 5
P$PCID: MOVE P1,2(M) ;THE PID TO DROP
PUSHJ P,ISPID ;IS P1 A PID ( BY FORMAT )
JUMPF E$BP% ;NO, JOB NUMBERS ARE ILLEGAL HERE
MOVE S1,2(M) ;THE PID TO DROP
PUSHJ P,DROPIT ;DO SO
POPJ P, ;RETURN ERROR
POPJ P, ;AND SUCCESS
SUBTTL Drop PIDs -- Functions 6 and 7
P$PCLQ: TDOA P2,[-1] ;MASK FOR ALL PIDS
P$PCIR: MOVX P2,1B0 ;MASK FOR RESET'ABLE PIDS
SETZM SHWANS ;CLEAR STARTING PID ARGUMENT
MOVE P1,SNDJCH ;GET SENDER'S JCH
CAMN P1,2(M) ;GETTING OWN JOB
JRST PCIR.2 ;YES, OK SO FAR
PUSHJ P,CHKENB ;NO, CHECK CALLERS ENABLED PRIVS
JUMPT PCIR.1 ;SUFFICIENT, JUST DO IT
TRZ P1,IP.SCN ;CLEAR CONTEXT NUMBER FROM SENDER
CAME P1,2(M) ;DOES IT MATCH NOW?
JRST E$PI% ;NO, PRIVILEGES INSUFFICIENT
MOVE P1,SNDJCH ;YES, PRETEND GAVE FULL CURRENT JCH
JRST PCIR.2 ;JOIN MAIN LINE
PCIR.1: MOVE P1,2(M) ;YES, GET JCH AGAIN
PUSHJ P,ISPID ;IS P1 A PID
JUMPT E$BJ% ;YES, AND WE WANT JCHS HERE
PCIR.2: MOVE S1,P1 ;COPY JCH TO LIST
MOVEI AP,SHWBLK ;IPCFM BLOCK
PUSHJ P,IPCREQ ;LIST THE PIDS
JUMPF E$CF% ;[SYSTEM]IPCC REQUEST FAILED
MOVSI P3,-SHWLN2 ;MAKE AOBJN FOR PID LIST
PCIR.3: SKIPN S1,SHWANS(P3) ;THROUGH THE PIDS YET?
POPJ P, ;YES, RETURN TO P$MSG
TDNN S1,P2 ;NO, SHOULD WE DROP THIS ONE?
JRST [MOVEM S1,SHWANS ;NO, SAVE AS START OF NEXT LIST
JRST PCIR.4] ;LOOK FOR MORE TO DROP
SETZM SHWANS(P3) ;REMEMBER THAT WE'RE DROPPING THIS ONE
PUSHJ P,DROPIT ;YES, DROP IT
JRST PCIR.5 ;SEE IF A SYSTEM PID
PCIR.4: AOBJN P3,PCIR.3 ;LOOP OVER ALL PIDS IN LIST
JRST PCIR.2 ;GET NEXT LIST FOR JCH
PCIR.5: CAIE S2,IPCPI% ;PRIV ERROR?
POPJ P, ;NO, JUST GIVE UP
$CALL C%SIDX ;YES, SEE IF A SYSTEM PID
$RETIF ;NO, GIVE UP
MOVE S2,SNDJCH ;YES, GET SENDER'S JCH
TRNN P1,IP.SCN ;DOING A JCH?
TRZ S2,IP.SCN ;NO, KEEP ONLY JOB NUMBER
CAME S2,P1 ;USER DOING HIS OWN JOB?
POPJ P, ;NO, GIVE UP
SETZM SETPID ;YES, SET TO CLEAR THE VALUE
MOVEI AP,SETBLK ;BLOCK TO MAKE THE ATTEMPT
PUSHJ P,IPCREQ ;TRY TO CLEAR THE SYSTEM INDEX
$RETIF ;GIVE UP IF CAN'T
MOVE S1,PIDPID(P3) ;YES, GET PID BACK AGAIN
PUSHJ P,DROPIT ;NOW TRY TO DELETE IT
POPJ P, ;GIVE UP IF STILL CAN'T
JRST PCIR.4 ;WORKED, TRY NEXT
SUBTTL Tell others when a PID is dropped -- Function 10
P$PCPD: MOVE P1,G$SND## ;SENDER GET ANSWER LATER
PUSHJ P,ISPID ;IS P1 A PID
JUMPF E$BP% ;NO, CALLER MUST HAVE A PID
MOVE S1,2(M) ;GET PID REQUESTED
PUSHJ P,VALPID ;SEE IF LEGAL
JRST E$BJ% ;NO, PROPAGATE ERROR BACK
LOAD AP,HDRPID##+.QHLNK,QH.PTF ;YES, LOOK FOR THAT PID
PCPD.1: JUMPE AP,PCPD.2 ;TEST FURTHER IF WE DON'T KNOW IT
CAMN S1,PIDPID(AP) ;THIS IT
JRST PCPD.5 ;YES, GO APPEND TO ITS NOTIFY LIST
LOAD AP,.QELNK(AP),QE.PTN ;NO, FIND THE NEXT IN THE QUEUE
JRST PCPD.1 ;AND CONTINUE LOOKING
;Here to make a new PID queue entry for a null name (and valid PID)
PCPD.2: DMOVE P1,S1 ;SAVE PID AND OWNING JCH
MOVEI H,HDRPID## ;QUEUE TO ADJUST
$CALL C%SIDX ;SEE IF IT'S A SYSTEM PID
JUMPF PCPD.3 ;NO, ALLOCATE A ZERO-LENGTH NAME
PUSHJ P,SYSPID ;YES, ALLOCATE A SYSTEM NAME ENTRY
JRST PCPD.4 ;NOW APPEND TO THE NOTIFY LIST
$FALL PCPD.3 ;USE ZERO-LENGTH NAME IF NO SYSTEM NAME
PCPD.3: PUSHJ P,M$GFRE## ;GET A BLOCK FOR THIS PID
PCPD.4: MOVEM P1,PIDPID(AP) ;SAVE THE PID
STORE P2,PIDJOB(AP),PID.JC ;AND ITS OWNER
PUSHJ P,M$ELNK## ;LINK INTO THE PID QUEUE
PCPD.5: SETOM DEFER ;REMEMBER TO DEFER THIS RESPONSE
MOVEI S1,3 ;WE ONLY NEED THREE WORDS FOR THE ANSWER
MOVEM S1,RSPLEN ;SO DON'T KEEP ANY MORE AROUND IN CORE
POPJ P, ;RETURN THE DEFERRED RESPONSE
SUBTTL Routine to allocate a system pid for P$PCPD
SYSPID: MOVSI AP,-SYSTBL ;AOBJN INDEX TO SYSTAB
SYSP.1: LOAD S2,SYSTAB(AP),SPD.ID ;GET INDEX FROM TABLE
CAME S1,S2 ;MATCH INDEX REQUESTED?
AOBJN AP,SYSP.1 ;NO, KEEP LOOKING
JUMPGE AP,.POPJ1 ;GIVE CONTINUE RETURN IF NO MATCH
MOVE E,AP ;SAVE SYSTAB INDEX
LOAD S1,SYSTAB(AP),SPD.LN ;GET LENGTH OF THE NAME
MOVE P3,S1 ;SAVE A COPY
IDIVI S1,5 ;MAKE WORD COUNT
AOS AP,S1 ;ROUNDED UP
PUSHJ P,M$GFRE## ;GRAB SOME CORE
LOAD S1,.QEVSZ(AP),QE.VSZ ;GET SIZE IN WORDS
HRLZ S2,SYSTAB(E) ;GET BLT SOURCE
HRRI S2,PIDNAM(AP) ;AND DESTINATION
ADDI S1,PIDNAM(AP) ;AND END OF BLOCK
BLT S2,-1(S1) ;TRANSFER THE NAME
STORE P3,PIDJOB(AP),PID.LN ;SAVE LENGTH AWAY
POPJ P, ;RETURN TO UPDATE PID & JCH
SUBTTL IPCC Request to drop PIDs -- Function 15
;FUNCTION 15 IS SENT BY [SYSTEM]IPCC WHEN A JOB WHICH OWNS A
; PID DOES A RESET OR LOGOUT, WITH THE PIDS ALREADY DROPPED.
IP.DPL==1B3 ;FLAG FROM THE JOB'S PROCESS DATA BLOCK (PDB)
; WHICH INDICATES AT LEAST 1 PID TO DROP ON LOGOUT
P$PCSS: MOVE P1,1(M) ;GET FLAG AND JCH
MOVX P2,1B0 ;ALWAYS WANT THIS BIT
MOVEI P3,IP.SJC ;KEEP FULL JCH FOR COMPARES
TXNE P1,IP.DPL ;JOB LOGGING OUT
JRST [SETO P2, ;YES, MASK FOR ALL PIDS
MOVEI P3,IP.SJN ;KEEP ONLY JOB NUMBER FOR COMPARES
JRST .+1] ;MERGE BACK INLINE
ANDI P1,(P3) ;ISOLATE THE JCH OR JOBNO
MOVEI H,HDRPID## ;GET RIGHT QUEUE HEADER
LOAD P4,.QHLNK(H),QH.PTF ;BEGIN SEARCH FOR THE JCH
PCSS.1: JUMPE P4,.POPJ ;DONE IF AT END OF QUEUE
LOAD T1,PIDJOB(P4),PID.JC ;GET THE OWNER OF THIS PID
ANDI T1,(P3) ;KEEP ONLY WHAT WE WANT
MOVE S1,PIDPID(P4) ;GET THE PID
CAMN T1,P1 ;SAME JOB
TDNN P2,S1 ;YES, SHOULD WE DROP IT
JRST PCSS.2 ;DON'T DROP THIS PID
MOVE AP,P4 ;SAVE POINTER TO CURRENT JUST IN CASE
LOAD P4,.QELNK(P4),QE.PTN ;FIND NEXT PID FIRST
$CALL C%PIDH ;SEE IF IT HAS AN OWNING JCH
JUMPT [STORE S1,PIDJOB(AP),PID.JC ;YES, UPDATE IT
JRST PCSS.1] ;LOOK FOR NEXT TO TRY
PUSHJ P,TELALL ;NO, NOTIFY THE WAITERS
PUSHJ P,M$RFRE## ;RELEASE THE STORAGE
JRST PCSS.1 ;AND DROP ANY OTHERS
PCSS.2: LOAD P4,.QELNK(P4),QE.PTN ;FIND THE NEXT
JRST PCSS.1 ;AND DROP ANY OTHERS
SUBTTL P$KLPD -- Kill a PID if couldn't send to it
;CALLED BY QUASAR TO NOTIFY THAT A SEND HAS FAILED (OR A RETURNED MESSAGE)
; S1 = THE PID
;PRESERVES S1
P$KLPD: $SAVE <H,AP> ;SAVE CALLER'S H AND AP
PUSHJ P,.SAVE1## ;AND CALLERS P1
MOVE P1,S1 ;COPY THE PID
MOVEI H,HDRPID## ;POINT TO THE PID QUEUE
LOAD AP,.QHLNK(H),QH.PTF ;FIND THE FIRST
KLPD.1: JUMPE AP,.POPJ ;DONE IF OUT OF PIDS
CAME P1,PIDPID(AP) ;THIS THE ONE
JRST KLPD.2 ;NO, TRY ANOTHER
PUSHJ P,TELALL ;TELL ALL WHO HAVE ASKED
PUSHJ P,M$RFRE## ;REMOVE THE CELL
MOVE S1,P1 ;RESTORE S1
$RETT ;DONE
KLPD.2: LOAD AP,.QELNK(AP),QE.PTN ;FIND THE NEXT
JRST KLPD.1 ;AND KEEP LOOKING
SUBTTL Privilege checking routines
;CHKENB CHECKS IF THE CALLER HAS ASKED TO ENABLE PRIVILEGES AND
; INDEED HAS THEM TO ENABLE. THIS IS NORMALLY CALLED WHEN
; ASKED TO DROP PID FOR A JOB AND THE CALLER .NE. THE JOB REQUESTED
;RETURNS .TRUE. IF ENABLED
; .FALSE. IF NOT
CHKENB: SKIPE PRIVRQ ;PRIVILEGE FLAG ON IN REQUEST?
$RETT ;YES, IPCC CHECKED JP.IPC FOR US
$FALL CHKPRV ;MAYBE, CHECK PRIV BITS
;CHKPRV CHECKS IF THE CALLER HAS SUFFICIENT PRIVS TO USE THE NAME [SYSTEM]
;RETURNS .TRUE. IF CALLER DOES
; .FALSE. IF NOT
CHKPRV: MOVX S1,MD.PWH!MD.POP!MD.PIP ;JACCT, OPERATOR, OR IPCF PRIVS.
SKIPN GFRMSG ;CAN'T TRUST PRIV BITS IN GOPHER MESSAGE
TDNN S1,G$PRVS## ;CHECK CALLERS PRIVS
$RETF ;NO CAN DO
$RETT ;CALLER IS ENABLED
SUBTTL DROPIT -- Drop a PID
;SUBROUTINE TO DROP A SPECIFIC PID
;CALL S1 = THE PID TO DROP
;
;RETURN SKIP IF SUCCESS,
; NON-SKIP WITH ERROR IN G$ERR IF FAILED
;TAKES CARE OF UPDATING G$SND AND CCPID FOR RESPONSES
DROPIT: PUSHJ P,VALPID ;IS IT STILL AROUND?
JRST .POPJ1 ;NO, SAY WE DELETED IT
DMOVEM S1,DROP.A ;SAVE PID AND OWNING JCH
MOVEI AP,DRPBLK ;IPCFM BLOCK TO DROP A PID
PUSHJ P,IPCREQ ;DO IT
JUMPF DROP.2 ;ANALYZE FAILURE
DMOVE S1,DROP.A ;GET PID AND JCH AGAIN
CAMN S1,G$SND## ;ZAPPING SENDER'S PID?
MOVEM S2,G$SND## ;YES, SEND TO THE JCH INSTEAD
CAMN S1,CCPID ;ZAPPED CC PID?
SETZM CCPID ;YES, DON'T SEND DUPLICATE
DROP.1: AOS (P) ;SET TO GIVE SKIP RETURN
PJRST G$SFAL## ;EXIT, DELETING CORE VIA P$KLPD
DROP.2: CAIN S2,IPCBJ% ;UNKNOWN TO IPCC?
JRST DROP.1 ;YES, ANNOUNCE ITS DEATH AND RETURN GOOD
CAIN S2,IPCPI% ;NO PRIVS?
JRST E$PI% ;YES, GIVE USER SAME ERROR
JRST E$CF% ;NO, USE GENERIC IPCC FAILURE
;STORAGE USED
DROP.A: BLOCK 2 ;SAVE PID & JCH HERE
SUBTTL VALPID -- Validate a PID
;SUBROUTINE TO VALIDATE A PID SUPPLIED TO [SYSTEM]INFO
;CALL S1 = THE PID IN QUESTION
; PUSHJ P,VALPID
;RETURNS NON-SKIP IF THE PID IS BAD, AFTER CALLING G$SFAL
; SKIP WITH PID STILL IN S1 AND OWNING JCH IN S2 IF VALID
VALPID: PUSH P,S1 ;NEED TO KEEP THIS AROUND
$CALL C%PIDH ;CHECK VALIDITY/GET OWNER
JUMPF VALP.1 ;INVALID, GO NOTIFY
POP P,S2 ;RETRIEVE PID
EXCH S1,S2 ;RETURN VALUES IN CORRECT ORDER
JRST .POPJ1 ;GIVE SKIP RETURN
VALP.1: POP P,S1 ;RESTORE PID
PJRST G$SFAL## ;NOTIFY ALL WHO CARE OF PID LOSS
SUBTTL VALNAM -- Validate the contents of the name
;SUBROUTINE TO VALIDATE THE CONTENTS OF THE NAME SENT TO [SYSTEM]INFO
;CALL M = THE MESSAGE SENT
; PUSHJ P,VALNAM
;RETURNS .TRUE. IF NAME IS OK
; .FALSE. IF CONTAINS ILLEGAL SYNTAX, CHARS, OR [xxx]
; S2 = THE NUMBER OF CHARACTERS IN THE NAME (NOT COUNTING THE NULL)
; IF .FALSE. & S2 = 0, NO TERMINATOR WAS FOUND
VALNAM: $SAVE <P1,P2> ;SAVE P1 & P2
PUSHJ P,FNDMAX ;CALCULATE THSMAX
PUSHJ P,CHKUSR ;COPY STRING WITH PRELIM. CHECKS
$RETIF ;RETURN (WITH 0 IN S2) IF BAD
PUSHJ P,VALN.1 ;CHECK DIRECTORY STRING
MOVE S2,P1 ;RETURN COUNT IN S2
POPJ P, ;AND RETURN TO CALLER
;STORAGE FOR VALNAM
VPOS.A: BLOCK 1 ;BYTE POINTER FOR OPENING
VPOS.B: BLOCK 1 ;BYTE POINTER FOR CLOSURE
VCNT.A: BLOCK 1 ;CHARACTER NUMBER OF OPENING
VCNT.B: BLOCK 1 ;CHARACTER NUMBER OF CLOSURE
;HERE AFTER THE STRING HAS BEEN SWEPT FOR ILLEGAL CHARACTERS
VALN.1: SKIPN VPOS.A ;FIND AN OPENING
$RETT ;NO, NAME IS OK
SKIPN VPOS.B ;YES, FIND A MATCHING CLOSURE
JRST VALN.3 ;NO, ILLEGAL SYNTAX
CAMN P1,VCNT.B ;WAS CLOSURE THE LAST CHARACTER
JRST VALN.2 ;YES, CHECK ITS CONTENTS
MOVE S1,VCNT.A ;NO, WHERE WAS THE OPENING
CAIE S1,1 ;MUST BE THE FIRST CHARACTER
JRST VALN.3 ;CAN'T HAVE CHARACTER AROUND BRACKETS
VALN.2: MOVE S2,VPOS.A ;GET BYTE POINTER FOR OPENING
PUSHJ P,GETSIX ;GET SIXBIT STRING
JUMPF .RETF ;INVALID CHARACTERS IN BRACKETS
CAIN T4,"," ;ENCOUNTER A COMMA
JRST VALN.4 ;YES, SPLIT HALVES NOW
CAMN S1,[SIXBIT/SYSTEM/] ;ONLY OTHER POSSIBILITY
PJRST CHKENB ;SEE IF PRIVILEGED ENOUGH TO USE IT
VALN.3: SETZ P1, ;BAD SYNTAX IN NAME AFTER ALL
$RETF ;RETURN FAILURE
VALN.4: ZERO P2 ;FOR P,PN ASSEMBLY
CAME S1,[SIXBIT/'ANY'/] ;WILD CARD NAME
CAMN S1,[SIXBIT/ANY/] ;ALLOW IT WITHOUT THE QUOTES
HLL P2,G$SID## ;YES, GET PROJECT OF SENDER
CAMN S1,[SIXBIT/*/] ;ALLOW TRADITIONAL WILD CARD
HLL P2,G$SID## ;THAT IS OK TOO
TLNE P2,-1 ;GET ONE OF THE WILD CARDS
JRST VALN.5 ;YES, GO GET PROGRAMMER NUMBER
PUSH P,S2 ;SAVE BYTE POINTER
PUSHJ P,CNVOCT ;CONVERT S1 TO OCTAL
POP P,S2 ;RESTORE POINTER
JUMPF VALN.3 ;ILLEGAL OCTAL DIGITS
HRL P2,S1 ;GET REQUESTED PROJECT NUMBER
VALN.5: PUSHJ P,GETSIX ;GET RIGHT HALF NOW
JUMPF VALN.3 ;ILLEGAL CHARACTERS
CAIE T4,"]" ;BETTER BE TRUE
JRST VALN.3 ;ILLEGALLY FORMATTED
CAME S1,[SIXBIT/'ANY'/] ;WILD CARD NAME
CAMN S1,[SIXBIT/ANY/] ;ALLOW IT WITHOUT THE QUOTES
HRR P2,G$SID## ;YES, GET PROGRAMMER OF SENDER
CAMN S1,[SIXBIT/*/] ;ALLOW TRADITIONAL WILD CARD
HRR P2,G$SID## ;THAT IS OK TOO
TRNE P2,-1 ;GET ONE OF THE WILD CARDS
JRST VALN.6 ;YES, NOW CHECK VALIDITY
PUSHJ P,CNVOCT ;CONVERT S1 TO OCTAL
JUMPE S1,VALN.3 ;PROGRAMMER NUMBER IS BAD
HRR P2,S1 ;NOW HAVE FULL P,PN
VALN.6: CAME P2,G$SID## ;NOW THE ACID TEST
$RETF ;OH WELL, IT WAS A NICE TRY
$RETT ;GIVE CALLER THE NAME
SUBTTL String conversion routines for VALNAM
;GETSIX IS CALLED WITH S2 = THE BYTE POINTER READY FOR ILDB
;RETURNS S1 = A SIXBIT STRING OR .FALSE. IF ILLEGAL CHARS OR TERMINATOR
; S2 = UPDATED BYTE POINTER
; T4 = THE TERMINATOR
GETSIX: ZERO GETS.A ;WHERE STRING WILL BE BUILT
MOVE S1,[POINT 6,GETS.A] ;BYTE POINTER FOR THE STRING
GETS.1: ILDB T4,S2 ;GET A CHARACTER
CAIE T4,"," ;HIT A COMMA
CAIN T4,"]" ;OR THE END OF THE FIELD
JRST GETS.3 ;YES, GET ANSWER
TLNN S1,770000 ;ROOM IN THE WORD
$RETF ;NO, TOO MANY CHARACTERS
CAIE T4,"'" ;ALLOWABLE CHARACTERS
CAIN T4,"*" ;FOR 'ANY' OR * WILD CARDS
JRST GETS.2 ;YES, INCLUDE IT
CAIG T4,"9" ;ALLOW ALL NUMBERS HERE
CAIGE T4,"0" ;A DIGIT
SKIPA ;NO, TRY ANOTHER
JRST GETS.2 ;YES, TAKE IT
CAIG T4,172 ;LOWER CASE Z
CAIGE T4,141 ;A LOWER CASE LETTER
SKIPA ;NO, TRY ANOTHER
SUBI T4," " ;YES, MAKE IT UPPER CASE
CAIG T4,"Z" ;REGULAR LETTER CHECK
CAIGE T4,"A" ;IS IT AN UPPER CASE LETTER
$RETF ;BAD NAME
GETS.2: SUBI T4," " ;CONVERT TO SIXBIT
IDPB T4,S1 ;STORE THE CHARACTER
JRST GETS.1 ;GET ANOTHER
GETS.3: MOVE S1,GETS.A ;GET THE SIXBIT VALUE
POPJ P, ;AND RETURN
GETS.A: BLOCK 1 ;ANSWER FROM GETSIX
;CNVOCT IS CALLED WITH S1 = POSSIBLE OCTAL NUMBER IN SIXBIT (OUTPUT FROM GETSIX)
;RETURNS S1 = THE BINARY VALUE OF THE STRING OR .FALSE. IF ILLEGAL CHARS
CNVOCT: MOVEM S1,CNVO.A ;SAVE THE STRING
ZERO S1 ;THE ANSWER TO BE RETURNED
MOVE S2,[POINT 6,CNVO.A] ;POINTER TO THE STRING
CNVO.1: ILDB T4,S2 ;GET A CHARACTER
JUMPE T4,.POPJ ;DONE IF OUT OF CHARACTERS
CAIG T4,'7' ;VALID OCTAL DIGIT
CAIGE T4,'0' ;P,PN'S ARE OCTAL
$RETF ;ILLEGAL CHARACTERS
ANDI T4,7 ;WANT ONLY THE DIGIT PART
LSH S1,3 ;MAKE ROOM FOR IT
ADD S1,T4 ;INCLUDE THE DIGIT
TLNE S2,770000 ;END OF THE STRING
JRST CNVO.1 ;NO, GET ANOTHER
POPJ P, ;YES, RETURN
CNVO.A: BLOCK 1 ;INPUT TO CNVOCT
;FNDMAX IS CALLED TO CALCULATE THSMAX
FNDMAX: $CALL C%MAXP ;GET MAXIMUM SHORT PACKET SIZE AGAIN
MOVEM S1,G$MPS## ;UPDATE ALL OF QUASAR (IN CASE OF POKE)
CAMLE S1,PAKLEN ;IS USER'S PACKET SHORTER?
MOVE S1,PAKLEN ;NO, GET THAT LIMIT INSTEAD
SUBI S1,2 ;ACCOUNT FOR OVERHEAD WORDS
IMULI S1,5 ;5 CHARS PER WORD (INCLUDING NUL)
CAILE S1,SZ.INF+1 ;FIT IN GALGEN LIMIT?
MOVEI S1,SZ.INF+1 ;NO, USE THAT SIZE
MOVEM S1,THSMAX ;SET THSMAX
POPJ P, ;RETURN TO VALNAM
;CHKUSR IS CALLED TO MAKE A CLEAN COPY OF THE USER'S NAME STRING
;ON TRUE RETURN, P1 HAS THE LENGTH OF THE STRING
; VPOS.A HAS B.P. TO "[" IF PRESENT
; VCNT.A HAS STRING POSITION (1-N) OF "["
; VPOS.B & VCNT.B ARE SIMILAR FOR "]"
;ON FALSE RETURN, S2 IS ZERO (NAME HAS ILLEGAL SYNTAX)
CHKUSR: MOVE S1,G$MPS## ;GET MAXIMUM PACKET LENGTH
CAMG S1,USRSIZ ;ARE WE SURE WE'LL FIT?
JRST CHKU.1 ;YES, DON'T CHANGE THE BUFFER
$CALL M%GMEM ;NO, GET NEW BUFFER
EXCH S1,USRSIZ ;UPDATE SIZE
EXCH S2,USRBUF ;AND ADDRESS
$CALL M%RMEM ;RETURN THE OLD ONE
JRST CHKU.2 ;SKIP REDUNDANT ZEROING
CHKU.1: DMOVE S1,USRSIZ ;GET SIZE AND ADDRESS
$CALL .ZCHNK ;ZERO OUT THE BUFFER
CHKU.2: ZERO P1 ;WILL COUNT THE CHARACTERS
ZERO VPOS.A ;CLEAR POINTER TO OPENING
ZERO VPOS.B ;AND POINTER TO CLOSURE
MOVE S1,THSMAX ;GET NAME SIZE
MOVEM S1,USRCNT ;SAVE AS COPY LIMIT
MOVE S1,USRBUF ;GET BUFFER ADDRESS
MOVEI S2,2(M) ;AND USER'S BUFFER
HRLI S1,(POINT 7) ;MAKE BYTE POINTER
HRLI S2,(POINT 7) ;LIKEWISE
CHKU.3: ILDB TF,S2 ;GET NEXT CHAR FROM USER
JUMPE TF,.RETT ;DONE IF A NUL
INCR P1 ;INCREMENT LENGTH COUNT
IDPB TF,S1 ;STORE IN CANONICAL BUFFER
SOSLE USRCNT ;SEE IF THERE'S STILL ROOM
PUSHJ P,CHKCHR ;AND IF THE CHARACTER'S GOOD
JRST CHKU.4 ;NO, FAIL
JRST CHKU.3 ;YES, LOOP OVER ALL CHARACTERS
CHKU.4: SETZ S2, ;THE NAME IS BAD
$RETF ;SO SAY SO
;CHKCHR is called by CHKUSR to see if the current character is valid
;Return non-skip if something's wrong,
;Return skip if valid
CHKCHR: CAIL TF,40 ;IS IT IN THE RANGE FROM 40
CAILE TF,176 ;THROUGH 176?
CAIN TF,.CHTAB ;OR IS IT A TAB?
TRNA ;YES, IT'S LEGAL SO FAR
POPJ P, ;NO, GIVE UP
CAIE TF,"[" ;IS IT AN OPEN BRACKET?
JRST CHKC.1 ;NO, TRY CLOSE
SKIPE VPOS.A ;YES, IS IT THE FIRST?
POPJ P, ;NO, FAIL
MOVEM P1,VCNT.A ;YES, STORE POSITION
MOVEM S1,VPOS.A ;AND POINTER
JRST .POPJ1 ;GIVE SKIP RETURN
CHKC.1: CAIE TF,"]" ;IS IT A CLOSE BRACKET?
JRST .POPJ1 ;NO, ASSUME IT'S OK
SKIPN VPOS.B ;IS IT THE FIRST?
SKIPN VPOS.A ;AND IS THERE A MATCHING OPEN?
POPJ P, ;NO TO EITHER, GIVE UP
MOVEM P1,VCNT.B ;OK, STORE POSITION OF CLOSE
MOVEM S1,VPOS.B ;AND POINTER
JRST .POPJ1 ;RETURN GOODNESS
SUBTTL FNDNAM -- Find the name sent in the PID queue
;SUBROUTINE TO FIND THE NAME SENT TO [SYSTEM]INFO IN THE PID QUEUE
;CALL S2 = LENGTH OF NAME (OUTPUT FROM VALNAM)
; PUSHJ P,FNDNAM
;RETURNS AP = THE PID QUEUE ENTRY OR ZERO IF NOT FOUND, OR -VE IF SYSTEM
FNDNAM: JUMPE S2,[SETZ AP, ;CAN NEVER FIND THE NULL NAME
POPJ P,] ;SO JUST RETURN
$SAVE <P1,P2,P3> ;SAVE A FEW REGS
MOVE P1,S2 ;SAVE THE LENGTH OF THE NAME
MOVNI P2,4(P1) ;GET -VE NAME LENGTH (ROUNDED UP)
IDIVI P2,5 ;MAKE -VE WORD COUNT
LOAD AP,HDRPID##+.QHLNK,QH.PTF ;FIND THE FIRST IN THE QUEUE
FNDN.1: JUMPE AP,FNDN.3 ;RAN OUT, TRY SYSTEM LIST
LOAD S2,PIDJOB(AP),PID.LN ;LENGTH OF THIS ONES NAME
MOVEI S1,PIDNAM(AP) ;THE NAME OF THIS PID
PUSHJ P,CHKNAM ;SEE IF NAMES MATCH
POPJ P, ;YES, SO RETURN
FNDN.2: LOAD AP,.QELNK(AP),QE.PTN ;NO, GET NEXT ENTRY IN PID QUEUE
JRST FNDN.1 ;SEE IF THEY MATCH
;Here to test for system PID
FNDN.3: MOVSI AP,-SYSTBL ;AOBJN INDEX FOR SYSTAB
FNDN.4: LOAD S2,SYSTAB(AP),SPD.LN ;GET LENGTH OF NAME
LOAD S1,SYSTAB(AP),SPD.NM ;AND ADDRESS OF NAME
PUSHJ P,CHKNAM ;SEE IF NAMES MATCH
POPJ P, ;YES, RETURN THIS ONE
AOBJN AP,FNDN.4 ;NO, KEEP LOOKING
SETZ AP, ;NOT THERE EITHER, ZERO AP
POPJ P, ;GIVE NOT FOUND RETURN
;Helper routine to test for name equality
CHKNAM: CAIE S2,(P1) ;DO NAME LENGTHS MATCH?
JRST .POPJ1 ;NO, GIVE CONTINUE RETURN
HRLI S1,(P2) ;AOBJN POINTER
MOVE S2,USRBUF ;NAME SENT TO [SYSTEM]INFO
CHKN.1: MOVE P3,(S2) ;GET NEXT WORD FROM NAME RECEIVED
CAME P3,(S1) ;MATCH THIS NAME?
JRST .POPJ1 ;NO, TRY ANOTHER ENTRY
AOBJP S1,.POPJ ;IF BOTH NAMES ENDED, THIS IS IT
AOJA S2,CHKN.1 ;NO, KEEP LOOKING AT THIS NAME FOR MATCH
SUBTTL Some utility routines
;SUBROUTINE TO DETERMINE IF THE NUMBER IN P1 IS IN CORRECT FORMAT FOR A PID
;CALL P1 = POSSIBLE PID
; PUSHJ P,ISPID
;RETURNS S1 = .TRUE. IS IN FORMAT FOR A PID
; = .FALSE. IF A JCH
ISPID: TLNE P1,377777 ;PIDS (IN 7.03) HAVE NON-ZERO LH
$RETT ;YES, GOOD PID FORMAT
$RETF ;THIS IS A JCH
;SUBROUTINE TO TELL ALL WHO HAVE ISSUED .IPCIN FOR A PID THAT IS BEING DROPPED
;CALL AP = THE CELL BEING REMOVED
TELALL: $SAVE <H,AP> ;SAVE CALLER'S H AND AP
$SAVE <P1> ;SAVE P1
MOVEI H,PIDLNK-.QHLNK(AP) ;POINT TO FAKE QUEUE HEADER
TELA.1: LOAD AP,.QHLNK(H),QH.PTF ;LOAD UP THE FIRST
JUMPE AP,.POPJ ;DONE
PUSHJ P,M$DLNK## ;REMOVE FROM NOTIFY LIST
PUSHJ P,C$LINK## ;PUT INTO RESEND QUEUE
JRST TELA.1 ;CONTINUE PURGE
;SUBROUTINE TO INSERT IN A NOTIFY QUEUE
;CALL AP = THE CELL TO ADD
; H = HEADER FOR A PID'S NOTIFY QUEUE
LINKNT: $SAVE <P1,P2> ;SAVE OUR REGISTERS
MOVE P1,RS.SAB+SAB.PD(AP) ;GET PID WE'RE ENTERING
LOAD P2,.QHLNK(H),QH.PTF ;GET FIRST QUEUE ENTRY
LINK.1: JUMPE P2,M$ELNK## ;LINK AT END IF NOT ALREADY IN QUEUE
CAMN P1,RS.SAB+SAB.PD(P2) ;IS IT ALREADY IN THE QUEUE?
PJRST C$PUT## ;YES, DELETE THE BLOCK, DON'T DUPLICATE
LOAD P2,.QELNK(P2),QE.PTN ;NO, GET POINTER TO NEXT
JRST LINK.1 ;LOOP OVER THE NOTIFY LIST
;SUBROUTINE TO SEND A RESPONSE
SENDIT: PUSHJ P,C$SNDA## ;SEND FROM AUX PIB
SETZM G$SAB##+SAB.FL ;DON'T LEAVE THE ERRORS AROUND
$RETT ;AND RETURN SUCCESS
SUBTTL IPCREQ -- IPCFM. dialog with [SYSTEM]IPCC
;CALL WITH:
; AP = START OF PRE-BUILT IPCFM. BLOCK
; S1 = ARGUMENT FOR .IPCS1 WORD OF BUFFER
;RETURN TRUE IF NO ERRORS
; FALSE WITH IPCFM. ERROR IN S2 IF FAILS
IPCREQ: MOVE S2,.IPCMP(AP) ;GET BUFFER POINTER
MOVEM S1,.IPCS1(S2) ;SAVE ARGUMENT TO FUNCTION
MOVE S2,PRIVRQ ;GET PRIVILEGES REQUESTED FLAG
STORE S2,.IPCMF(AP),IP.CMP ;PROPAGATE TO IPCFM. PRIVILEGE FLAG
XMOVEI S2,(AP) ;POINT TO UUO BLOCK
IPCFM. S2, ;ATTEMPT THE FUNCTION
$RETF ;PROPAGATE FAILURE
$RETT ;AND SUCCESS
SUBTTL Common message blocks (pre-formatted)
;BLOCK USED FOR CREATION OF PID'S FOR JCH (MUST BE FILLED IN)
CREBLK: EXP IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
IFIW CREFNC ;BUFFER POINTER
IFIW G$SND## ;WHERE TO PICK UP PID
CREFNC: XWD CRELEN,.IPCSC ;LENGTH,,CREATE A PID FOR A JOB
CREJCH: EXP 0 ;JCH FILLED IN
CREANS: EXP 0 ;PID RETURNED
CRELEN==.-CREFNC ;LENGTH OF MESSAGE
;BLOCK USED TO ASK [SYSTEM]IPCC TO DROP A PID (MUST BE FILLED IN)
DRPBLK: EXP IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
IFIW DRPFNC ;BUFFER POINTER
IFIW G$SND## ;WHERE TO PICK UP PID
DRPFNC: XWD DRPLEN,.IPCSZ ;LENGTH,,DROP A PID
DRPPID: EXP 0 ;PID TO DROP
DRPLEN==.-DRPFNC ;LENGTH OF MESSAGE
;BLOCK USED TO ASK [SYSTEM]IPCC TO LIST PIDS FOR A JOB OR JCH (MUST FILL IN)
SHWBLK: EXP IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
IFIW SHWFNC ;BUFFER POINTER
IFIW G$SND## ;WHERE TO PICK UP PID
SHWFNC: XWD SHWLEN,.IPCSP ;LENGTH,,PID LIST
SHWWHO: BLOCK 1 ;JOB OR JCH TO LIST
SHWANS: BLOCK 10 ;SPACE FOR SOME PIDS IN ANSWER
SHWLN2==.-SHWANS ;MAX. NUMBER OF PIDS RETURNED AT ONCE
SHWLEN==.-SHWFNC ;LENGTH OF MESSAGE
;BLOCK USED TO ASK [SYSTEM]IPCC TO SET A SYSTEM PID (MUST BE FILLED IN)
SETBLK: EXP IP.CMP!IP.CMI!<.IPCCC,,3> ;INVOKING PRIVS, INDIRECT PID
IFIW SETFNC ;BUFFER POINTER
IFIW G$SND## ;WHERE TO PICK UP PID
SETFNC: XWD SETLEN,.IPCWP ;LENGTH,,WRITE PID TABLE
BLOCK 1 ;INDEX GOES HERE
SETPID: BLOCK 1 ;PID TO WRITE GOES HERE
SETLEN==.-SETFNC ;LENGTH OF MESSAGE
SUBTTL INFDMP - Dump [SYSTEM]INFO database (for debugging)
;Can only be called by PUSHJ P,INFDMP<ESC>X while debugging.
;Preserves all ACs it touches.
;Used to dump out the [SYSTEM]INFO database.
INFDMP: $SAVE <S1,S2,E,AP,P1,P2> ;PRESERVE WHAT WE USE
$TEXT (,<
PID OWNER NAME
------------ ----- --------------------------------------->)
;TYPE HEADING
LOAD E,HDRPID##+.QHLNK,QH.PTF ;GET FIRST PID IN QUEUE
DUMP.1: JUMPE E,DUMP.2 ;QUIT WHEN WE FIND THE END
LOAD S1,PIDJOB(E),PID.CX ;GET CONTEXT NUMBER
LOAD S2,PIDJOB(E),PID.JB ;AND JOB NUMBER
MOVEI P1,PIDNAM(E) ;POINT TO NAME
LOAD P2,PIDJOB(E),PID.LN ;GET NAME LENGTH
SKIPN P2 ;HAVE A NAME?
MOVEI P1,[ASCIZ |[NONAME]|] ;NO, USE THIS
$TEXT (,<^M^J^O12R /PIDPID(E)/ ^D3R /S2/.^D/S1/ ^T/(P1)/>)
;TYPE OUT PID, OWNING JCH, AND NAME
PUSHJ P,DUMP.4 ;LIST THE NOTIFY CHAIN
LOAD E,.QELNK(E),QE.PTN ;GET POINTER TO NEXT
JRST DUMP.1 ;LOOP OVER ENTIRE QUEUE
DUMP.2: $TEXT (,<^M^J^M^JSystem PID List
--------------------------------------->) ;MORE HEADER
MOVSI AP,-SYSTBL ;AOBJN INDEX FOR SYSTAB
DUMP.3: HRRZ S1,SYSTAB(AP) ;GET THE NAME ADDRESS
$TEXT (,<^T/(S1)/>) ;TYPE THE NAME
AOBJN AP,DUMP.3 ;LOOP OVER ALL SYSTEM PIDS
$TEXT (,<^M^J>) ;DOUBLE CRLF
POPJ P, ;RETURN TO DDT
DUMP.4: SKIPN PIDLNK(E) ;IS THERE A NOTIFY LIST?
POPJ P, ;NO, RETURN NOW
$TEXT (,< Notify: ^A>) ;NOTE WHAT WE'RE TYPING
LOAD AP,PIDLNK(E),QH.PTF ;POINT TO FIRST TO NOTIFY
SETZ P1, ;CLEAR COUNT (THIS LINE)
DUMP.5: TRZE P1,4 ;FOUR ALREADY THIS LINE?
$TEXT (,<^M^J ^A>) ;YES, CRLF TAB TAB
AOJ P1, ;BUMP COUNT
$TEXT (,<^O16R /RS.SAB+SAB.PD(AP)/^A>) ;TYPE THIS PID
LOAD AP,.QELNK(AP),QE.PTN ;POINT TO NEXT
JUMPN AP,DUMP.5 ;LOOP UNTIL END OF LIST
$TEXT (,<>) ;TYPE A CRLF
POPJ P, ;RETURN TO OUTER LOOP
END