Trailing-Edge
-
PDP-10 Archives
-
AP-4178E-RM
-
swskit-sources/qsrt20.mac
There are 36 other files named qsrt20.mac in the archive. Click here to see a list.
TITLE QSRT20 -- Operating System Interface for QUASAR-20
SUBTTL Larry Samberg Chuck O'Toole /CER 13 Nov 77
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1975, 1976, 1977, 1978 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH QSRMAC ;PARAMETER FILE
PROLOGUE(QSRT20) ;GENERATE THE NECESSARY SYMBOLS
;
;NOTES:
;
;ALL GLOBAL ROUTINES IN THIS MODULE USE "ONLY" ACS S1 AND S2.
; CALLERS ARE GUARANTEED THAT ALL OTHER ACS WILL BE
; RETURNED INTACT.
;THE LAST PAGE IN THIS MODULE (I$STCD ROUTINE) CONTAINS INFORMATION
; ON QUASAR DEBUGGING AIDS.
COMMENT\
STOPCDs found in QSRT20
BSD BAD SPOOL DATA
CAP CANNOT ACQUIRE A PID
CDD CANT DEFAULT DIRECTORY
CDU CANT DEFAULT USER
CGJ CAN'T GET JOB NUMBER
CGP CAN'T GET PACKET SIZE
CGU CANT GET USER
COP CANT OPEN PRIME QUEUE
CSQ CANNOT SET IPCF QUOTAS
CUF CANT UPDATE FILE
CUI CANT UPDATE INDEX
DIF DEBRK OF INTERRUPT FAILED
FSP FAILURE TO SET SYSTEM PID TABLE
MRF MESSAGE RECEIVE FAILURE
NSD NO SPOOLING DIRECTORY
NXU NON-EXISTANT USER
ODE OWNER DOESNT EXIST
PIC PID TO INTERRUPT FAILED
PQI PRIME QUEUE INTERLOCKED
\
COMMENT \
TOPS20 Field Interpretation
1) External Owner ID is a User Name
2) Owner ID (Internal) is a User Number
\
SUBTTL Module Storage
SLPVAL: EXP ^D60000 ;SLEEP INTERVAL
CENSTA: EXP 0 ;STATION # OF CENTRAL SITE
MEMFLG: EXP 0 ;ZERO = ALLOW IPCF INTERRUPTS
AWOKEN: EXP 0 ;INTERRUPTED OUT OF DISMS IF SET
BLOKED: EXP 0 ;WE HAVE DONE A DISMS
IPCPC: BLOCK 1 ;PC AT IPCF INTERRUPT
FILJFN: BLOCK 1 ;JFN OF MASTER QUEUE FILE
FSPAGN: BLOCK 1 ;SCRATCH PAGE FOR I$READ/I$WRIT
FSADDR: BLOCK 1 ; SAME AS FSPAGN BUT AS AN ADDRESS
UNIDIR: BLOCK INPNUM*12 ;BLOCK FOR STORING CONNECTED
; DIRECTORY FOR /UNIQUE CHECK
;LEVTAB AND CHNTAB MUST BE CONTIGUOUS AND IN THE FOLLOWING ORDER
; THEY ARE CLEARED BY A SINGLE BLT
LEVTAB: BLOCK 3 ;OLD PC ADDRESS POINTERS
CHNTAB: BLOCK ^D36 ;INTERRUPT DISPATCH ADDRESS
SUBTTL Initialization Routine
;ROUTINE TO INITIALIZE THE WORLD. I$INIT INITIALIZES THE I/O
; SYSTEM, AND ENABLES THE INTERRUPT SYSTEM.
;
I$INIT:: RESET ;RESET THE WORLD
CIS ;CLEAR THE INTERRUPT SYSTEM
PUSHJ P,.SAVET## ;SAVE T REGS
MOVE S1,[LEVTAB,,LEVTAB+1] ;SETUPT BLT POINTER
ZERO LEVTAB ;CLEAR FIRST WORD
BLT S1,CHNTAB+^D35 ;BLT LEVEL AND CHANNEL TABLES TO ZERO
MOVE S1,[INT.PL,,C$INT##] ;LEVEL,,ADR OF IPCF INT RTN
MOVEM S1,CHNTAB+INT.PI ;AND STORE IT
MOVEI S1,IPCPC ;WHERE TO STORE INTERRUPT PC
MOVEM S1,LEVTAB+INT.PL-1 ;STORE IN LEVTAB (NO ZERO'TH ENTRY)
MOVX S1,.FHSLF ;MY RELATIVE FORK HANDLE
MOVE S2,[LEVTAB,,CHNTAB] ;SET UP ADDRESS WORDS
SIR ;TO SETUP INTERRUPT SYSTEM
MOVX S1,.FHSLF ;SETUP MY FORK HANDLE
MOVX S2,1B<INT.PI> ;SETUP A MASK
AIC ;ACTIVATE THE CHANNEL
MOVEI S1,.MUMPS ;FUNCTION FOR MAX PACKET SIZE
MOVEM S1,INIT.B ;STORE AWAY
ZERO INIT.B+1 ;CLEAR SECOND WORD
MOVEI S1,2 ;GET BLOCK SIZE
MOVEI S2,INIT.B ;AND ADDRESS OF BLOCK
MUTIL ;GET THE INFO
STOPCD(CGP,FATAL) ;++CAN'T GET PACKET SIZE
MOVE S1,INIT.B+1 ;GET THE ANSWER
MOVEM S1,G$MPS## ;SAVE IT
MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,[ASCIZ /PS:<SPOOL>/] ;DIRECTORY OF SPOOL
RCDIR ;RECOGNIZE IT
TXNE S1,RC%NOM ;MATCH?
STOPCD (NSD,FATAL) ;++NO SPOOLING DIRECTORY
MOVE S1,T1 ;COPY DIR NUMBER INTO S1
MOVEI S2,INIT.C ;LOAD ADDR OF BLOCK
ZERO T1 ;DON'T WANT THE PASSWORD
GTDIR ;GET DIRECTORY INFO
HRRZ S1,INIT.C+7 ;GET DEFAULT PROTECTION
MOVEM S1,G$SPRT## ;AND STORE IT
ZERO G$MCOR## ;THERE IS NO SYSTEM MINIMUM
SETO S1, ;-1 = MY JOB
HRROI S2,T2 ;POINT TO ARG BLOCK
SETZ T1, ;WORD 0
GETJI ;GET MY JOB NUMBER
STOPCD(CGJ,FATAL) ;++CANT GET JOB NUMBER
$SITEM T2,QJOB ;AND STORE IT
PJRST I$ION ;ENABLE INTERRUPTS AND RETURN
INIT.B: BLOCK 2 ;MUTIL BLOCK
INIT.C: BLOCK ^D14 ;GTDIR BLOCK
SUBTTL Information
;ENTRY POINTS
INTERN I$WHEEL ;CHECK IF CURRENT SENDER IS SOME FLAVOR OF OPERATOR
INTERN I$KSYS ;RETURN SECONDS UNTIL SYSTEM SHUTDOWN
INTERN I$NOW ;RETURN CURRENT DATE/TIME IN INTERNAL FORMAT
INTERN I$AGE ;COMPUTE AGE USING INTERNAL FORMAT DATE/TIME
INTERN I$AFT ;MODIFY AN INTERNAL TIME BY ADDITION
INTERN I$CHAC ;CHECK ACCESS
INTERN I$MIDS ;MAKE AN INTERNAL DEVICE SPECIFIER
INTERN I$MSDN ;MAKE A SIXBIT DEVICE NAME
INTERN I$LOGN ;CHECK IF OPERATOR ALLOWS LOGINS
INTERN I$OPER ;CHECK IF AN OPERATOR IS ON DUTY
INTERN I$VSTR ;VERIFY THAT A FILE STRUCTURE IS ONLINE
SUBTTL I$WHEEL -- Determine of the caller is an Operator
;ROUTINE CALLED TO CHECK IF THE CURRENT SENDER IS AN OPERATOR PERSON.
; USED TO PREVENT UNAUTHORIZED PERSONS FROM BECOMING
; KNONW COMPONENTS OR CREATE REQUESTS FOR ANOTHER DIRECTORY.
;CALL PUSHJ P,I$WHEEL
; ALWAYS RETURNS HERE WITH S1 = .FALSE. IF NOT AN OPERATOR
; S1 = .TRUE. IF ONE
;DESTROYS S1, S2
I$WHEEL: MOVE S1,G$PRVS## ;GET ENABLED CAPABILITIES WORD
TXNE S1,SC%WHL!SC%OPR ;IS HE A WHEEL OR AN OPR?
PJRST .TRUE## ;YES!!
PJRST .FALSE## ;NO, HE LOSES
SUBTTL I$KSYS -- Routine to get KSYS time
;ROUTINE TO RETURN THE NUMBER OF SECONDS UNTIL SYSTEM SHUTDOWN
;CALL:
; PUSHJ P,I$KSYS
; RETURN HERE WITH RESULT IN S1
;
;S1 = +NN SECONDS TO KSYS
; 00 NO KSYS
; -1 TIMESHARING IS OVER
;THE TIME RETURNED IS ACTUALLY BACKED OFF BY 1 MINUTE FOR NOTHING IS
; SAFE FROM THE "CEASE" COMMAND
I$KSYS: MOVE S1,[SIXBIT/DWNTIM/] ;THE SYSTEM TABLE NAME
SYSGT ;GET THE TABLE NUMBER AND ENTRY 0
JUMPL S2,KSYS.1 ;JUMP IF THE TABLE EXISTS
ZERO S1 ;ELSE RETURN A ZERO
KSYS.1: PJUMPE S1,.POPJ## ;EXIT IF NONE PENDING
PUSH P,S1 ;SAVE TIME FOR NOW
MOVEI S1,1 ;FIND NOW PLUS 1 MINUTE
PUSHJ P,I$AFT ;COMPUTE IT
POP P,S2 ;NOW GET WHEN SCHEDULED
CAMLE S2,S1 ;IS SCHEDULED SHUTDOWN PAST
PJRST I$AGE ;NO, COMPUTE DIFFERENCE AND RETURN
SETO S1, ;YES, RETURN -1
POPJ P, ;RETURN IT
SUBTTL I$NOW -- Routine to return time in internal format
;ROUTINE TO RETURN THE CURRENT DATE/TIME IN INTERNAL FORMAT
;CALL:
; PUSHJ P,I$NOW
; RETURN HERE WITH S1 = DATE/TIME IN INTERNAL FORMAT
;
;GLOBAL LOCATION G$NOW IS ALSO FILLED IN.
I$NOW: GTAD ;GET THE TIME AND DATE
MOVEM S1,G$NOW## ;STORE IN GLOBAL LOCATION
POPJ P, ;RETURN
SUBTTL I$AGE -- Routine to compare two times in internal format
;ROUTINE TO COMPUTE THE AGE IN SECONDS BASED ON THE INTERNAL DATE/TIME FORMAT
;
;CALL:
; S1 AND S2 ARE THE TIMES TO COMPUTE AGES
; PUSHJ P,I$AGE
; RETURNS HERE WITH AGE IN SECONDS IN S1
;DESTROYS S1,S2,TEMP IN THE PROCESS
I$AGE: CAMGE S1,S2 ;ORDERING CHECK
EXCH S1,S2 ;WANT THE LARGEST IN S1
SUB S1,S2 ;SUBTRACT THEM
IDIVI S1,3 ;RESOLUTION IS APPROX. 1/3 SEC
POPJ P, ;AND RETURN
SUBTTL I$AFT -- Routine to modify an internal time
;ROUTINE TO RETURN G$NOW + A SPECIFIED INTERVAL.
;
;CALL:
; S1 CONTAINS INTERVAL IN MINUTES
; PUSHJ P,I$AFT
; RETURN HERE WITH S1=G$NOW+SPECIFIED INTERVAL
I$AFT: ZERO S2 ;ZERO FOR A SHIFT
ASHC S1,-^D17 ;GENERATE DOUBLE CONSTANT
; = ARG*2^18
DIVI S1,^D1440 ;DIVIDE BY MIN/DAY
ADD S1,G$NOW## ;ADD IN NOWTIM
POPJ P, ;AND RETURN
SUBTTL I$CHAC -- Routine to Check File Access
;ROUTINE TO CHECK FILE AND QUEUE REQUEST ACCESS
;
;CALL:
; MOVE S1,[ACCESS CODE,,PROTECTION]
; MOVE S2,DIRECTORY OF FILE OR REQUEST
; PUSHJ P,I$CHAC
; RETURN HERE ALWAYS
;
;CHECK IS MADE AGAINST SENDER OF CURRENT REQUEST
;RETURN S1 = .TRUE. = ACCESS ALLOWED
; S1 = .FALSE. = ACCESS NOT ALLOWED
I$CHAC: LOAD S1,G$SID## ;GET SENDER'S ID
CAME S1,S2 ;IS HE THE OWNER
PJRST I$WHEEL ;NO, WIN ONLY IF WHEEL
PJRST .TRUE## ;YES, LET HIM DO IT
SUBTTL I$MIDS -- Routine to generate an IDS
;CALL WITH S1 CONTAINING A SIXBIT DEVICE NAME, AND S2 CONTAINING
; THE DEFAULT STATION NUMBER. RETURN WITH S1 CONTAINING
; THE IDS FOR THE SPECIFIED DEVICE. IF THE ORIGINAL DEVICE
; SPECIFICATION IS ILLEGAL, S1 IS RETURNED 0.
I$MIDS: TLNN S1,007777 ;MUST BE AT LEAST 2 CHARACTERS
PJRST .FALSE## ;ISN'T, GIVE BAD RETURN
PUSHJ P,.SAVE3## ;SAVE P1 - P3
MOVE P1,S1 ;COPY THE ARGUMENT
MOVEI P2,6 ;LOOP COUNTER
MIDS.0: LSH P1,6 ;NOW CHECK FOR IMBEDDED NULLS
TLNE P1,770000 ;NULL CHARACTER AT THE TOP
SOJG P2,MIDS.0 ;NO, KEEP GOING
PJUMPN P1,.FALSE## ;YES, GIVE ERROR IF MORE REMAINS
LOAD P1,S1,DV.GDN ;GET THE DEVICE REQUESTED
TRZ P1,77 ;CLEAR THE 3RD CHARACTER
CAIN P1,'LU ' ;REQUEST FOR UPPER CASE ONLY PRINTER
JRST MIDS.7 ;YES, GO PROCESS THAT
CAIN P1,'LL ' ;OR FOR LOWER CASE ONLY
JRST MIDS.8 ;THEY NEED SOME SPECIAL PROCESSING
LDB P3,[POINT 6,S1,35] ;SPLIT THE CHARACTERS FOR EASIER CHECKS
LDB P2,[POINT 6,S1,29] ; ...
LDB P1,[POINT 6,S1,23] ; ...
ZERO S1,DV.DMD ;CLEAR RESULTANT DEVICE MODIFIERS
MIDS.1: CAIE P1,'S' ;REQUEST FOR 'DEVSnn'
JRST MIDS.4 ;NO, LOOK FOR OTHER FORMS
JUMPN P3,MIDS.2 ;YES, JUMP IF TWO DIGITS
MOVEI P1,'0' ;CONVERT TO STANDARD NAMES
JRST MIDS.3 ; P2 IS ALREADY CORRECT
MIDS.2: MOVE P1,P2 ;'SHIFT' OUT THE 'S'
MOVE P2,P3 ;EVERYTHING UP ONE DIGIT
MIDS.3: ZERO P3 ;NOW IS STATION GENERIC
MIDS.4: JUMPN P2,MIDS.5 ;NOW DETERMINE IF UNIT AT DEFAULT STATION
JUMPN P3,MIDS.5 ;IS THAT IF BOTH WERE NULL
MOVE P3,P1 ;GET UNIT NUMBER (MAY ALSO BE NULL)
LDB P1,[POINT 3,S2,32] ;FIRST DIGIT OF DEFAULT STATION
TRO P1,'0' ;MAKE IT SIXBIT TOO
LDB P2,[POINT 3,S2,35] ;GET THE SECOND DIGIT
TRO P2,'0' ;AGAIN, TO SIXBIT
; FALL INTO FINAL ASSEMBLY STAGE (ON THE NEXT PAGE)
; I$MIDS IS CONTINUED ON THE NEXT PAGE
; HERE TO ASSEMBLE THE STATION AND UNIT FROM THE CHARACTERS IN P1,P2, AND P3
MIDS.5: SKIPN P3 ;GENERIC STATION
TXO S1,DV.NUL ;YES, SET 'UNIT WAS NULL'
CAIG P1,'7' ;STATION NUMBERS ARE OCTAL
CAIGE P1,'0' ;SO NOW LOOK FOR BAD DIGITS
PJRST .FALSE## ;GIVE BAD RETURN
CAIG P2,'7' ;SAME CHECK FOR THE OTHERS
CAIGE P2,'0' ; THIS PREVENTS 'LPTFOO'
PJRST .FALSE## ;WHICH WILL BE THE FIRST TEST OF THIS
LSH P1,3 ;MAKE ROOM FOR THE OTHER DIGIT
ADDI P1,-'0'(P2) ;ADD THEM TOGETHER FOR BINARY STATION NUMBER
ANDI P1,77 ;IGNORE SIXBIT OVERFLOW
JUMPE P3,MIDS.6 ;SKIP THIS IF UNIT NOT SPECIFIED
CAIG P3,'7' ;ANOTHER SET OF CHECKS FOR THAT DIGIT
CAIGE P3,'0' ;SINCE UNIT NUMBERS ARE OCTAL AS WELL
PJRST .FALSE## ;ILLEGALLY FORMATTED DEVICE SPEC
STORE P3,S1,DV.UTN ;STORE THE UNIT NUMBER
MIDS.6: TLNN S1,000077 ;END UP LESS THAN 3 CHARACTERS
PJRST .FALSE## ;YES, CAN DETECT ILLEGALITY NOW
STORE P1,S1,DV.STN ;STORE FULL STATION NUMBER
JUMPN P1,.POPJ## ;ALL DONE IF IT WAS A NUMBER
LOAD P1,CENSTA ;DIDN'T, GET THE CENTRAL SITE
STORE P1,S1,DV.STN ;STORE THAT INSTEAD
POPJ P, ;AND RETURN
; HERE TO PARSE THE ALLOWABLE FORMS FOR LL: AND LU:
MIDS.7: PUSHJ P,MIDS.9 ;PREPARE THE FIELDS
PJUMPE S1,.POPJ## ;ILLEGAL SPEC
TXO S1,DV.LUP!DV.NUL ;BITS FOR LU:
JRST MIDS.1 ;AND ENTER COMMON CODE
MIDS.8: PUSHJ P,MIDS.9 ;PREPARE/VALIDATE
PJUMPE S1,.POPJ## ;ILLEGAL
TXO S1,DV.LLP!DV.NUL ;INDICATE LL:
JRST MIDS.1 ;AND RESUME
MIDS.9: TRNE S1,000077 ;SPECIFY FULL 6 CHARACTERS
PJRST .FALSE## ;YES, ILLEGAL TO DO SO
TLNE S1,000077 ;ONLY 2 CHARACTERS
TRNE S1,777777 ;NO, BUT WAS IT ONLY 3 CHARACTERS
SKIPA ;ALL IS OK SO FAR
PJRST .FALSE## ;BAD SPEC IF EXACTLY 3 CHARACTERS
LDB P1,[POINT 6,S1,17] ;LOAD UP CHARACTERS 3,4 AND 5
LDB P2,[POINT 6,S1,23] ;FOR THE COMMON CODE
LDB P3,[POINT 6,S1,29] ; ...
MOVSI S1,'LPT' ;TURN LL/LU INTO LPT:
PJUMPE P3,.POPJ## ;RETURN IF NOT 5 CHARACTERS
CAIE P1,'S' ;IF 5, THEN MUST BE 'Snn'
PJRST .FALSE## ;BAD SPEC IF NOT
POPJ P, ;RETURN TO BUILD FULL IDS
SUBTTL I$MSDN -- Convert an IDS into a device name
;CALL WITH S1 CONTAINING THE IDS FOR A DEVICE, RETURN WITH S1 CONTAINING
; THE DEVICE NAME IN SIXBIT.
I$MSDN: PUSHJ P,.SAVET## ;SAVE T1-T4
MOVE T1,S1 ;COPY THE ARGUMENT
TRZ S1,-1 ;CLEAR THE RH OF THE ANSWER
TXNN T1,DV.STN ;NULL STATION?
JRST MSDN.1 ;YES, MAKE DEVICE MORE READABLE
LOAD T2,T1,DV.STN!DV.UTN ;GET DEVICE AND UNIT FIELDS
IDIVI T2,100 ;SPLIT OFF THE FIRST DIGIT
IDIVI T3,10 ;SPLIT OFF THE SECOND DIGIT
LSH T2,14 ;SHIFT FIRST DIGIT OVER
LSH T3,6 ;SHIFT SECOND DIGIT OVER
TRO T2,'000'(T3) ;MAKE FIRST TWO DIGITS
TRO T2,(T4) ;ADD IN THE THIRD DIGIT
HRR S1,T2 ;AND COPY RESULT TO THE ANSWER
TXNE T1,DV.NUL ;NULL UNIT?
TRZ S1,77 ;YES, MAKE IT SO
TXNE T1,DV.LLP ;LOWER CASE LPT?
HRLI S1,'LL@' ;YES, MAKE IT
TXNE T1,DV.LUP ;UPPER CASE LPT?
HRLI S1,'LU@' ;YUP!
POPJ P, ;RETURN
MSDN.1: LOAD T2,T1,DV.UTN ;GET THE UNIT NUMBER
LSH T2,^D12 ;SHIFT OVER TO 4TH CHARACTER
TXNN T1,DV.NUL ;NULL UNIT?
TRO T2,'0 ' ;NO, MAKE IT SIXBIT
HRR S1,T2 ;PUT NAME TOGETHER
TXNE T1,DV.LLP ;WAS IT REALLY LL?
MOVSI S1,'LL ' ;YUP
TXNE T1,DV.LUP ;OR LU?
MOVSI S1,'LU ' ;YES
POPJ P, ;ALL DONE, RETURN
SUBTTL I$LOGN & I$OPER -- Check for operator settings and attendence
;CALL PUSHJ P,I$LOGN OR I$OPER
;
; RETURNS HERE WITH S1 = .TRUE. IF BATCH LOGINS ARE PERMITTED
; IF OPERATOR IS ON DUTY
; .FALSE.IF NOT
I$OPER: SKIPA S1,[.SFOPR] ;CHECK IF OPERATOR ON DUTY
I$LOGN: MOVX S1,.SFPTY ;CHECK IF PTY LOGINS ARE ALLOWED
TMON ;GET STATUS OF THE SYSTEM
PJUMPE S2,.FALSE## ;RETURN FALSE IF NOT SET
PJRST .TRUE## ;TRUE IF CONDITIONS ARE MET
SUBTTL I$VSTR -- Verify That A File Structure Is On-Line
;ROUTINE TO VERIFY THAT A STRUCTURE IS ON-LINE FOR THE SCHEDULER
;CALL S1 = THE STRUCTURE IN SIXBIT
; PUSHJ P,I$VSTR
;
;
;RETURNS S1 = .TRUE. IF STRUCTURE IS THERE
; = .FALSE. IF OFF-LINE OR NOT A DISK
; S2 = STRUCTURE NAME
I$VSTR: PUSHJ P,.SAVET## ;SAVE T1 THRU T4
MOVEM S1,VSTR.C ;SAVE ARG FOR THE RETURN
MOVE T1,[POINT 6,S1] ;POINTER TO SIXBIT STR NAME
MOVE T2,[POINT 7,VSTR.B] ;POINT TO STORE IN ASCII
VSTR.1: ILDB S2,T1 ;GET A CHARACTER
JUMPE S2,VSTR.2 ;DONE
ADDI S2,"A"-'A' ;CONVERT TO ASCII
IDPB S2,T2 ;AND DEPOSIT IT
TLNE T1,770000 ;GET 6 CHARACTERS?
JRST VSTR.1 ;NO, LOOP
VSTR.2: MOVEI S2,0 ;LOAD A NULL
IDPB S2,T2 ;DEPOSIT IT
HRROI S1,VSTR.B ;POINTER TO STRUCTURE NAME
MOVEM S1,VSTR.A ;SAVE THE ARGUMENT FOR MSTR
MOVE S1,[5,,.MSGSS] ;GET STRUCTURE STATUS
MOVEI S2,VSTR.A ;ARG BLOCK ADR
MSTR ;GET THE INFO
ERJMP VSTR.3 ;LOSE, MUST NOT BE THERE
MOVE S2,VSTR.C ;LOAD THE STR NAME
MOVX S1,MS%DIS ;GET "DISMOUNT IN PROGRESS" BIT
TDNE S1,VSTR.A+1 ;IS IT SET?
PJRST .FALSE## ;YES, RETURN "OFF-LINE"
PJRST .TRUE## ;NO, RETURN TRUE
VSTR.3: MOVE S2,VSTR.C ;LOAD THE STRUCTURE NAME
PJRST .FALSE## ;AND LOSE
VSTR.A: BLOCK 5 ;ARG BLOCK FOR MSTR JSYS
VSTR.B: BLOCK 2 ;STRUCTURE NAME IN ASCII
VSTR.C: BLOCK 1 ;STRUCTURE NAME IN 6BIT
SUBTTL Utilities
;ENTRY POINTS
INTERN I$SLP ;Suspend Job (SLEEP)
INTERN I$IOFF ;Turn off interrupt system
INTERN I$ION ;Turn on interrupt system
INTERN I$DBRK ;Dismiss Current Interrupt
INTERN I$POST ;Post a "wakeup" at interrupt level
INTERN I$SVAL ;Set SLEEP interval for subsequent call to I$SLP
SUBTTL I$SLP -- Routine to SLEEP for a given time
;ROUTINE TO SUSPEND THE JOB FOR A GIVEN LENGTH OF TIME.
;CALL:
; PUSHJ P,I$SLP
; RETURN HERE UPON WAKING
;
;USES THE VALUE IN SLPVAL FROM CALLS TO I$SVAL AND RESETS IT
; TO AN INFINITE WAIT
I$SLP: SETOM BLOKED ;SET THE BLOCKED FLAG
SKIPE AWOKEN ;HAS SOMETHING INTERESTING HAPPENED
JRST SLP.1 ;YES, DON'T BOTHER WAITING
ZERO S1 ;SET INFINITE
EXCH S1,SLPVAL ;FOR THE NEXT TIME
SKIPN S1 ;SLEEP FOREVER (UNTIL INTERRUPT)
WAIT ;YES, WAIT FOR NEXT INTERRUPT TO HAPPEN
DISMS ;NO, WAIT FOR INTERRUPT OR TIMER
JFCL ;THIS NO-OP IS NEEDED FOR "PC" ALIGNMENT
SLP.1: ZERO AWOKEN ;CLEAR THE AWOKEN FLAG
ZERO BLOKED ;CLEAR THE BLOCKED FLAG
PJRST I$NOW ;AND RETURN VIA I$NOW
SUBTTL I$POST -- Post a wakeup at interrupt level
;I$POST IS CALLED BY THE INTERRUPT LEVEL ROUTINE TO RESET
; THE PC AND THE AWOKEN AND BLOCKED FLAGS CORRECTLY
I$POST: MOVEI S1,SLP.1 ;GET RETURN ADDRESS FOR INTERRUPT
SETOM AWOKEN ;FLAG THAT THE DISMS WAS INTERRUPTED
SKIPE BLOKED ;WERE WE BLOCKED?
MOVEM S1,IPCPC ;YES, RESET THE INTERRUPTED PC
SETZM BLOKED ;CLEAR THE BLOCKED FLAG
POPJ P, ;AND RETURN
SUBTTL I$SVAL -- Set up a SLEEP interval
;CALL S1 = THE NUMBER OF SECONDS REQUESTED
; PUSHJ P,I$SVAL
; ALWAYS RETURNS HERE
;A SUBSEQUENT CALL TO I$SLP WILL USE THE VALUE SAVED IN SLPVAL
; WHICH IS THE SMALLEST OF THE REQUESTED TIMES
I$SVAL: SKIPG S1 ;CHECK FOR BAD DATA
MOVEI S1,1 ;ASSUME 1 SECOND IF BAD
CAILE S1,^D60 ;MORE THAN 1 MINUTE
MOVEI S1,^D60 ;YES, THAT IS THE MAXIMUM
IMULI S1,^D1000 ;CONVERT TO MILLI-SECONDS
SKIPE SLPVAL ;FIRST TIME THIS PASS
CAMGE S1,SLPVAL ;NO, THE SMALLEST YET
MOVEM S1,SLPVAL ;YES, SAVE IT
POPJ P, ;AND RETURN
SUBTTL I$IOFF -- Routine to disable the interrupt system
;ROUTINE TO DISABLE THE INTERUPT SYSTEM
I$IOFF: MOVX S1,.FHSLF ;MY RELATIVE FORK HANDLE
DIR ;DISABLE INTERRUPTS
POPJ P, ;AND RETURN
SUBTTL I$ION -- Routine to enable the interrupt system
;ROUTINE TO TURN ON THE INTERRUPT SYSTEM
I$ION: MOVX S1,.FHSLF ;MY RELATIVE FORK HANDLE
EIR ;ENABLE INTERRUPTS
POPJ P, ;AND RETURN
SUBTTL I$DBRK -- Routine to Dismiss the Current Interrupt
;I$DBRK IS CALLED (VIA JRST) TO RETURN FROM INTERRUPT LEVEL
I$DBRK: DEBRK ;DONE WITH THE INTERRUPT
JFCL ;FALL INTO THE STOPCD
STOPCD(DIF,FATAL) ;++DEBRK OF INTERRUPT FAILED
SUBTTL Memory Manager Interface Routines
;ENTRY POINTS
INTERN I$MFFP ;FIND FIRST FREE PAGE
SUBTTL I$MFFP -- Find First Free Page
;I$MFFP IS CALLED TO FIND THE FIRST FREE PAGE IN QUASAR'S ADDRESS SPACE.
; THE PAGE NUMBER IS RETURNED IN S1.
I$MFFP: MOVSI S1,.FHSLF ;LOAD MY FORK HANDLE
MFFP.1: RPACS ;READ PAGE ACCESSABILITY
TXNE S2,PA%PEX ;DOES PAGE EXIST?
AOJA S1,MFFP.1 ;YES, KEEP LOOPING
HRRZ S1,S1 ;NO, GOT IT!!
POPJ P, ;RETURN
SUBTTL IPCF Interace
;ENTRY POINTS
INTERN I$IPS ;IPCF SEND
INTERN I$IPR ;IPCF RECEIVE
INTERN I$IPQ ;IPCF QUERY
INTERN I$GMIS ;GET MESSAGE INTERRUPT STATUS
INTERN I$OKIN ;CHECK IF OK TO PROCESS IPCF INTERRUPT
INTERN I$NOIN ;SET NOT OK TO PROCESS IPCF INTERRUPTS
INTERN I$EPID ;IPCF INIT ROUTINE TO ESTABLISH PIDS ETC.
SUBTTL I$IPS -- Send an IPCF Message
;ROUTINE TO SEND AN IPCF MESSAGE.
;CALL:
; MOVE S1,PDB SIZE
; MOVE S2,ADDRESS OF PDB
; PUSHJ P,I$IPS
; RETURN HERE ALWAYS, S2=0 ON SUCCESS
; S2=-1 ON FAILURE (ERROR CODE IN S1)
I$IPS: MSEND ;SEND THE MESSAGE
SKIPA ;ERROR RETURN
TDZA S2,S2 ;WIN, SET S2=0 AND SKIP
SETO S2, ;LOSE, SET S2=-1
POPJ P, ;AND RETURN
SUBTTL I$IPR -- Receive an IPCF Message
;ROUTINE TO RECEIVE AN IPCF MESSAGE.
;CALL:
; MOVE S1,PDB SIZE
; MOVE S2,PDB ADDRESS
; PUSHJ P,I$IPR
; RETURN HERE ALWAYS, S1 = ASSOCIATED VARIABLE
I$IPR: MRECV ;RECEIVE THE PACKET
STOPCD(MRF,FATAL) ;++MESSAGE RECEIVE FAILURE
POPJ P, ;AND RETURN
SUBTTL I$IPQ -- Query QUASAR's IPCF Queue
;ROUTINE TO RETURN INFORMATION ABOUT THE NEXT THING IN QUASAR'S
; IPCF RECIEVE QUEUE.
;CALL:
; PUSHJ P,I$IPQ
; ALWAYS RETURN HERE, S1 = ASSOCIATED VARIABLE FOR RECEIVE (COULD BE ZERO)
I$IPQ: MOVE S1,[IPQ.A,,IPQ.A+1] ;SETUP A BLT POINTER
CLEARM IPQ.A ;CLEAR THE FIRST WORD
BLT S1,IPQ.A+5 ;CLEAR THE REST
MOVEI S1,.MUQRY ;GET MUTIL FNC CODE FOR QUERY
MOVEM S1,IPQ.A ;AND SAVE IT
MOVE S1,G$QPID## ;GET QUASAR'S PID
MOVEM S1,IPQ.A+1 ;AND SAVE AS MUTIL ARG
MOVEI S1,5 ;GET LENGTH
MOVEI S2,IPQ.A ;AND ADDRESS
MUTIL ;AND DO THE QUERY
PJRST .FALSE## ;FAILED, RETURN 0
HRRZ S1,IPQ.A+.IPCFL+1 ;GET RIGHT HALF OF FLAGS
HLL S1,IPQ.A+.IPCFP+1 ;GET LENGTH
POPJ P, ;AND RETURN
IPQ.A: BLOCK 6 ;LOCAL STORAGE
SUBTTL I$GMIS -- Get Message Interrupt Status
;ROUTINE TO RETURN THE ASSOCIATED VARIABLE OF THE PACKET TO BE
; RECEIVED ON AN INTERRUPT.
;CALL:
; PUSHJ P,I$GMIS
; ALWAYS RETURN HERE, S1=ASSOCIATED VARIABLE (COULD BE ZERO)
;
;**WARNING**
; THIS ROUTINE IS CALLED AT INTERRUPT LEVEL, SO ANY ROUTINES
; CALLED BY IT MUST ALSO RECOGNIZE THIS FACT.
I$GMIS: MOVEI S1,.MUQRY ;MUTIL FUNCTION FOR QUERY
MOVEM S1,GMIS.A ;SAVE IT
MOVE S1,G$QPID## ;GET QUASAR'S PID
MOVEM S1,GMIS.A+1 ;AND SAVE IT
MOVEI S1,5 ;BLOCK LENGTH
MOVEI S2,GMIS.A ;ADDRESS
MUTIL ;DO IT!!
PJRST .FALSE## ;RETURN FALSE
HRRZ S1,GMIS.A+.IPCFL+1 ;GET FLAGS (RH)
HLL S1,GMIS.A+.IPCFP+1 ;AND LENGTH
POPJ P, ;AND RETURN
GMIS.A: BLOCK 6 ;LOCAL STORAGE
SUBTTL I$OKIN & I$NOIN -- IPCF & QSRMEM interface
;I$OKIN RETURNS .TRUE. IF IT IS OK TO PROCESS THIS IPCF INTERRUPT
; .FALSE. IF IT IS INCONVENIENT (QSRMEM IS CHANGING THE FREE LISTS)
I$OKIN: SKIPN MEMFLG ;DID QSRMEM TELL US NOT TO ALLOW THEM
PJRST .TRUE## ;NO, OK TO PROCESS
PJRST .FALSE## ;CANNOT DO IT NOW, TRY LATER
;I$NOIN IS CALLED BY QSRMEM WHEN IT DETERMINES THAT IT IS CHANGING THINGS THAT
; COULD BE USED AT INTERRUPT LEVEL. THIS ACTS AS A CO-ROUTINE TO
; CLEAR THE STATE WHEN QSRMEM POPJ'S
I$NOIN: SKIPE MEMFLG ;RE-CURSIVE CALL
POPJ P, ;YES, WAIT FOR THE TOP CALLER TO RETURN
POP P,MEMFLG ;REMOVE CALL, SET FLAG NON-ZERO
PUSHJ P,@MEMFLG ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS (P) ;PROPOGATE THE SKIP RETURN
SETZM MEMFLG ;ALLOW INTERRUPTS NON
POPJ P, ;AND RETURN TO SOMEBODY
SUBTTL I$EPID -- Get A PID for [SYSTEM]xxxxxx
;I$EPID IS CALLED WITH S1 CONTAINING THE INDEX INTO THE SYSTEM PID TABLE FOR THE
; ENTRY TO SET. ESTABLISHES THAT ENTRY AND RETURNS S1 = THE PID ACQUIRED
I$EPID: PUSHJ P,.SAVET## ;SAVE T REGS
MOVEM S1,EPID.A ;SAVE TABLE INDEX
MOVEI S1,3 ;THREE WORDS
MOVEI S2,T1 ;INTO T1
MOVEI T1,.MURSP ;FUNCTION READ SYSTEM PID TABLE
MOVE T2,EPID.A ;ENTRY REQUESTED
MUTIL ;EXECUTE THE UTILITY
ZERO T3 ;FAILED, DOES NOT CONTAIN A VALID PID
MOVEM T3,EPID.B ;ASSUME IT IS MY PID
JUMPN T3,EPID.1 ;CONNECT IT IF THERE WAS ONE
MOVEI S1,3 ;THREE WORDS
MOVEI S2,T1 ;INTO T1
MOVEI T1,.MUCRE ;CREATE A PID
MOVX T2,IP%JWP!.FHSLF ;JOB WIDE FOR THIS FORK
MUTIL ;GET THE PID PLEASE
STOPCD(CAP,FATAL) ;++CANNOT ACQUIRE A PID
MOVEM T3,EPID.B ;STORE MY PID
MOVEI S1,3 ;NUMBER OF WORDS
MOVEI S2,T1 ;THEY'RE IN T1
MOVEI T1,.MUSSP ;SET SYSTEM PID TABLE
MOVE T2,EPID.A ;THE ENTRY
MOVE T3,EPID.B ;THE PID I JUST GOT
MUTIL ;ESTABLISH THE SYSTEM COMPONENT
STOPCD(FSP,FATAL) ;++FAILURE TO SET SYSTEM PID TABLE
MOVEI S1,3 ;THREE WORDS
MOVEI S2,T1 ;THEY'RE IN T1
MOVEI T1,.MUSSQ ;FUNCTION SET QUOTAS
MOVE T2,EPID.B ;FOR THE PID I JUST GOT
MOVEI T3,777777 ;MAKE THE QUOTAS LARGE
MUTIL ;ASK THE EXEC
STOPCD(CSQ,FATAL) ;++CANNOT SET IPCF QUOTAS
EPID.1: MOVEI S1,3 ;THREE WORDS
MOVEI S2,T1 ;FROM T1
MOVEI T1,.MUPIC ;FUNCTION PLACE PID ON INTERRUPT
MOVE T2,EPID.B ;PID TO ENABLE
MOVX T3,INT.PI ;CHANNEL NUMBER FOR INTERRUPTS
MUTIL ;ESTABLISH INTERRUPT CORRESPONDENCE
STOPCD(PIC,FATAL) ;++PID TO INTERRUPT FAILED
MOVE S1,EPID.B ;THE PID ACQUIRED THROUGH THIS SEQUENCE
POPJ P, ;AND RETURN
EPID.A: BLOCK 1 ;SYSTEM PID TABLE INDEX
EPID.B: BLOCK 1 ;PID ACQUIRED DURING I$EPID
SUBTTL FD Manipulation Routines
INTERN I$CSM ;Create a Canonical SPOOL Message
INTERN I$CLM ;Create a Canonical LOGOUT Message
INTERN I$FSTR ;Extract STRUCTURE from an FD
INTERN I$FMCH ;Determine if 2 FD's match with masks
SUBTTL I$CSM -- Create a Canonical SPOOL Message
;CALL I$CSM TO CONVERT A SPOOL MESSAGE RECEIVED FROM THE OPERATING SYSTEM
; INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL: MOVE S1,[ADR OF SPOOL MESSAGE FROM OPERATING SYSTEM]
; PUSHJ P,I$CSM
; RETURN HERE WITH S1 CONTAINING THE ADR OF THE CSM
I$CSM: PUSHJ P,.SAVET## ;SAVE T1-T4 FOR USE HERE
MOVEM S1,CSM.B ;REMEMBER ADDRESS OF SPOOL MESSAGE FOR LATER
MOVE T1,[CSM.A,,CSM.A+1] ;SET UP TO ZERO CSM AREA
ZERO CSM.A ;ZERO FIRST WORD
BLT T1,CSM.A+CSMSIZ-1 ;AND ALL THE REST
LOAD T1,SPL.JB(S1),SP.JOB ;GET THE JOB NUMBER
STORE T1,CSM.A+CSM.JB,CS.JOB ;AND SAVE IT IN CSM
LOAD T1,SPL.FL(S1),SP.DFR ;GET THE DEFER BIT
STORE T1,CSM.A+CSM.JB,CS.DFR ;AND SAVE IT@IN SPOOL MESSAGE
LOAD T1,SPL.FL(S1),SP.LOC ;GET THE STATION NUMBER
STORE T1,CSM.A+CSM.JB,CS.LOC ;AND SAVE IT IN CSM
LOAD T1,G$SID## ;GET THE USERS ID
STORE T1,CSM.A+CSM.OI ;STORE IT IN CSM
LOAD T1,SPL.BV(S1),SP.SIZ ;GET THE FILE SIZE IN PAGES
STORE T1,CSM.A+CSM.FS ;SAVE IT IN CSM
MOVE T1,CSM.F ;GET THE STANDARD FLAGS FOR SPOOLING
STORE T1,CSM.A+CSM.FP ;INTO THE CSM
MOVEI S1,SPL.FD(S1) ;GET THE ADDRESS OF THE FD
MOVE T1,S1 ;PUT IN T1 ALSO
STORE S1,CSM.A+CSM.FD,CS.FDA ;AND SAVE IT AS THE ADDRESS OF THE CSM FD
PUSHJ P,I$FSTR ;EXTRACT THE STRUCTURE
MOVEM S1,CSM.A+CSM.ST ;AND SAVE IT
HRLI T1,(POINT 7,0) ;MAKE T1 A BYTE POINTER TO THE FD
ZERO T2 ;BUT DON'T STORE THIS
MOVX T3,<76,,0> ;TERMINATE ON RIGHT ANGLE BRACKET
ZERO T4 ;NO COUNT
PUSHJ P,FBREAK ;SKIP TO END OF DIRECTORY
JUMPE S1,CSM.2 ;IF WE ENDED ON NUL, LOSE
MOVE T2,[POINT 6,CSM.A+CSM.DV] ;STORE NEXT STUFF AS DEVICE
MOVEI T4,6 ;ONLY 6 CAHRACTERS
MOVE T3,["-",,"A"-'A'] ;STOP ON -, CONVERT TO SIXBIT
PUSHJ P,FBREAK ;PICK UP DEVICE NAME
JUMPE S1,CSM.2 ;IF NUL TERMINATES, LOSE
ZERO T2 ;DON'T STORE ANYTHING
ZERO T4 ;NO COUNT
MOVSI T3,"-" ;STOP ON MINUS
PUSHJ P,FBREAK ;SKIP THE STATION NUMBER
JUMPE S1,CSM.2 ;OOPS
ZERO T4 ;NO COUNT
ZERO T2 ;NO DESTINATION
MOVSI T3,"-" ;STOP ON MINUS
PUSHJ P,FBREAK ;AND THE DIRECTORY NUMBER
JUMPE S1,CSM.2 ;OOPS
;"I$CSM" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM THE PREVIOUS PAGE
MOVE T2,[POINT 6,CSM.A+CSM.EN] ;SET UP TO STORE THE ENTERED NAME
MOVEI T4,6 ;ONLY 6 CHARACTERS
MOVE T3,[".",,"A"-'A'] ;ENDED WITH ., CONVERTED TO SIXBIT
PUSHJ P,FBREAK ;PICK UP THE ENTERED NAME
JUMPE S1,CSM.2 ;NOT ENOUGH FD IN SPOOL MESSAGE
MOVE S2,CSM.B ;GET THE ADDRESS OF THE SPOOL MESSAGE
SKIPN S1,CSM.A+CSM.EN ;GET ENTERED NAME INTO S1
LOAD S1,SPL.PG(S2) ;IF NO ENTERED NAME,USE PROGRAM NAME
STORE S1,CSM.A+CSM.EN ;SAVE AS ENTERED NAME
CSM.1: ILDB T2,T1 ;PICK UP NEXT CHARACTER
JUMPN T2,CSM.1 ;LOOP UNTIL A NUL
TLZ T1,-1 ;CONVERT BYTE POINTER TO ADDRESS
SUBI T1,SPL.FD-1(S2) ;AND MAKE INTO LENGTH OF FD
STORE T1,CSM.A+CSM.FD,CS.FDL ;SAVE THAT IN CSM
MOVEI S1,CSM.A ;PUT ADDRESS OF CSM IN S1 FOR CALLER
POPJ P, ;AND RETURN
CSM.2: STOPCD (BSD,FATAL) ;++BAD SPOOL DATA
CSM.A: BLOCK CSMSIZ ;PLACE FOR CSM
CSM.B: BLOCK 1 ;WORD TO SAVE SPOOL MESSAGE ADDRESS
CSM.F: INSVL.(.FPFAS,FP.FFF)!INSVL.(1,FP.FSP)!FP.DEL!FP.SPL!INSVL.(1,FP.FCY)
SUBTTL I$CLM -- Create a Canonical LOGOUT Message
;CALL I$CLM TO CONVERT A LOGOUT MESSAGE RECEIVED FROM THE OPERATING SYSTEM
; INTO A CANONICAL FORM WHICH EVERYONE CAN USE.
;CALL:
; MOVE S1,[ADR OF LOGOUT MESSAGE FROM OPERATING SYSTEM]
; PUSHJ P,I$CLM
; RETURN HERE WITH S1 CONTAINING THE ADR OF THE CLM
I$CLM: MOVX S2,.IPCSL ;GET FUNCTION CODE
STORE S2,<CLM.A+CLM.FC> ;STORE THE FUNCTION
LOAD S2,LGO.JB(S1),LG.JOB ;GET JOB NUMBER
STORE S2,<CLM.A+CLM.JB>,CL.JOB ;STORE IT
LOAD S2,LGO.FL(S1),LG.BAT ;GET THE BATCH BIT
STORE S2,<CLM.A+CLM.JB>,CL.BAT ;STORE IT
MOVEI S1,CLM.A ;LOAD ADR OF THE CLM
POPJ P, ;AND RETURN
CLM.A: BLOCK CLMSIZ ;BLOCK TO RETURN CLM
SUBTTL I$FSTR -- Routine to extract the STRUCTURE from an FD
;CALL I$FSTR WITH THE ADDRESS OF AN FD AREA AND RETURN WITH THE STRUCTURE NAME.
;
;CALL:
; MOVE S1,[ADR OF FD AREA]
; PUSHJ P,I$FSTR
; RETURN HERE WITH STRUCTURE NAME IN S1
I$FSTR: PUSHJ P,.SAVET## ;SAVE T1 THRU T4
SETZM FSTR.A ;CLEAR OUT THE ANSWER WORD
MOVEI T4,^D6 ;LOAD A CHARACTER COUNT
MOVE T3,[":",,"A"-'A'] ;LOAD BREAK,,OFFSET
MOVE T2,[POINT 6,FSTR.A] ;LOAD DESTINATION POINTER
MOVSI T1,(POINT 7,0) ;START MAKING SOURCE POINTER
HRR T1,S1 ;FINISH MAKING SOURCE POINTER
PUSHJ P,FBREAK ;GET THE STRUCTURE
CAIN S1,":" ;BREAK ON COLON?
SKIPA S1,FSTR.A ;YES, LOAD THE ANSWER AND SKIP
MOVSI S1,'PS ' ;NO, USE "PS"
POPJ P, ;AND RETURN
FSTR.A: BLOCK 1 ;PLACE TO STORE STRUCTURE NAME
SUBTTL I$FMCH -- Match 2 FD areas with masks and length
;I$FMCH IS USED BY FILE SPECIFIC MODIFY TO MATCH SPECIFIED FILE WITH THE ORIGINAL
; REQUEST ACCOUNTING FOR WILD CARDS.
;CALL: MOVEI S1,[ADDRESS OF ARGUMENT BLOCK]
; MOVEI S2,LENGTH OF FD TO COMPARE
; PUSHJ P,I$FMCH
;RETURNS S1 = .TRUE. IF THEY MATCH
; S1 = .FALSE. IF THEY DON'T
;THE CALLERS MUST DETERMINE IF ALL FD'S ARE THE SAME LENGTH
;ARGUMENT BLOCK CONTAINS:
; +0 ADDRESS OF THE 1ST FD
; +1 ADDRESS OF THE 2ND FD
; +2 ADDRESS OF THE MASKS
I$FMCH==.FALSE## ;UNTIL PARSER IS WRITTEN
SUBTTL Routines to handle system dependent fields
INTERN I$EQQE ;Move fields from EQ to QE
INTERN I$QELA ;Move fields from QE to Listanswer
INTERN I$SMEQ ;Move fields from CSM to EQ
INTERN I$RMCH ;Match a request and an RDB
INTERN I$DFEQ ;Default and check an EQ
SUBTTL I$EQQE - Move fields from EQ to QE
;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE EXTERNAL
; QUEUE REQUEST (EQ) TO THE INTERNAL QUEUE ENTRY (QE).
;
;CALL:
; MOVE S1,<ADDRESS OF EQ>
; MOVE AP,<ADDRESS OF QE>
; PUSHJ P,I$EQQE
; ALWAYS RETURN HERE
I$EQQE: PUSHJ P,.SAVET## ;SAVE T1 THRU T4
MOVSI S2,.EQOWN(S1) ;SETUP TO BLT THE OWNER'S NAME
HRRI S2,.QEOWN(AP) ;FORM EQ TO QE
BLT S2,.QEOWN+7(AP) ;ZAP!!
MOVSI S2,.EQCON(S1) ;POINT TO CONNCECTED DIRECTORY
HRRI S2,.QECON(AP) ;PLACE TO BLT TO
BLT S2,.QECON+11(AP) ;AND BLT IT
HRROI S2,.EQOWN(S1) ;POINT TO EXTERNAL OWNER FIELD
MOVX S1,RC%EMO ;EXACT MATCH ONLY
RCUSR ;RECOGNIZE USER
TXNE S1,RC%NOM ;NO MATCH?
STOPCD (NXU,FATAL) ;++NON-EXISTANT USER
STORE T1,.QEOID(AP) ;STORE THE OWNER ID
POPJ P, ;AND RETURN
SUBTTL I$QELA - Move fields from QE to Listanswer
;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE INTERNAL
; QUEUE REQUEST (QE) TO THE LISTANSWER MESSAGE.
;
;CALL:
; MOVE S1,<ADDRESS OF QE>
; MOVE AP,<ADDRESS OF LISTANSWER MESSAGE>
; PUSHJ P,I$QELA##
; ALWAYS RETURN HERE
I$QELA: POPJ P, ;AND RETURN
SUBTTL I$SMEQ -- Move fields from CSM to EQ
;ROUTINE TO MOVE OPERATING SYSTEM DEPENDENT FIELDS FROM THE CANONICAL
; SPOOL MESSAGE (CSM) TO THE EXTERNAL QUEUE REQUEST (EQ).
;
;CALL:
; MOVE S1,<ADDRESS OF CSM>
; MOVE AP,<ADDRESS OF EQ>
; PUSHJ P,I$SMEQ
; ALWAYS RETURN HERE
I$SMEQ: LOAD S2,CSM.OI(S1) ;GET THE OWNER ID
HRROI S1,.EQOWN(AP) ;POINT TO EQ
DIRST ;CONVERT TO STRING
STOPCD(ODE,FATAL) ;++OWNER DOESNT EXIST
POPJ P, ;RETURN
SUBTTL I$RMCH -- Match a request and an RDB
;ROUTINE TO DETERMINE WHETHER OR NOT A PARTICULAR QUEUE ENTRY MATCHES
; THE REQUEST DESCRIPTION IN A PARTICULAR REQUEST DESCRIPTION
; BLOCK (RDB)
;
;CALL:
; MOVE S1,<ADDRESS OF RDB>
; MOVE AP,<ADDRESS OF QE>
; PUSHJ P,I$RMCH
; ALWAYS RETURN HERE
I$RMCH: PUSHJ P,.SAVE1## ;SAVE P1
SKIPN P1,.RDBES(S1) ;LOAD EXTERNAL SEQ #
JRST RMCH.1 ;ZERO ASSUME A MATCH
LOAD S2,.QESEQ(AP),QE.SEQ ;GET SEQUENCE NUMBER FROM THE QE
CAME S2,P1 ;DO THEY MATCH?
PJRST .FALSE## ;NO, STOP NOW
RMCH.1: LOAD S2,.QEJOB(AP) ;GET JOBNAME FROM QE
XOR S2,.RDBJB(S1) ;FIND WHATS DIFFERENT
AND S2,.RDBJM(S1) ;MASK OUT INSIGNIFICANT PARTS
PJUMPN S2,.FALSE## ;AND RETURN IF NO MATCH
SKIPE .RDBOW(S1) ;IS THERE AN OWNER?
JRST RMCH.2 ;YES, GO ON
PUSH P,S1 ;NO, LETS DEFAULT IT
HRROI S1,.RDBOW(S1) ;POINT TO THE BLOCK
LOAD S2,G$SID## ;USER SENDER'S ID
DIRST ;AND GET THE STRING
ERJMP RMCH.3 ;FAILED?
POP P,S1 ;RESTORE S1
RMCH.2: MOVEI S2,.RDBOW(S1) ;GET THE ADDRESS
HRLI S2,(POINT 7,0) ;AND MAKE A BYTE POINTER
MOVX S1,<POINT 7,.QEOWN(AP)> ;POINT TO REQUEST OID
PJRST STGWLD ;MATCH AND PROPAGATE TRUE OR FALSE
RMCH.3: STOPCD (CGU,FATAL) ;++CANT GET USER
SUBTTL I$DFEQ -- Default and check the EQ
;ROUTINE TO DEFAULT AND CHECK THE OPERATING SYSTEM DEPENDENT VALUES
; IN THE EXTERNAL QUEUE REQUEST (EQ).
;
;CALL:
; MOVE S1,<ADDRESS OF EQ>
; PUSHJ P,I$DFEQ
; ALWAYS RETURN HERE WITH T/F INDICATION
I$DFEQ: PUSHJ P,.SAVET## ;SAVE T REGS
MOVE T2,S1 ;COPY EQ ADR INTO T2
SETZB T3,T4 ;CLEAR SOME FLAGS
SKIPE .EQOWN(S1) ;IS OWNER SET?
JRST DFEQ.1 ;YES, CONTINUE
SETOM T3 ;FLAG DEFAULT ON .EQOWN
HRROI S1,.EQOWN(T2) ;NO, POINT TO LOCATION
LOAD S2,G$SID## ;GET DEFAULT
DIRST ;AND GET DEFAULT ONWER STRING
ERJMP DFEQ.4 ;JUMP IF LOSSAGE
DFEQ.1: SKIPE .EQCON(T2) ;IS CON DIR SET?
JRST DFEQ.2 ;YES, DONT DEFAULT IT
SETOM T4 ;FLAG DEFAULTED .EQCON
HRROI S1,.EQCON(T2) ;POINT TO BLOCK
LOAD S2,G$CDI## ;GET THE DEFAULT
DIRST ;GET THE CONNECTED DIRECTORY
ERJMP DFEQ.5 ;JUMP IF WE LOSE
DFEQ.2: JUMPL T3,DFEQ.3 ;DON'T CHECK IF EQOWN WAS DEFAULT
MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,.EQOWN(T2) ;POINT TO THE OWNER BLOCK
RCUSR ;GET THE NUMBER
TXNE S1,RC%NOM ;NO MATCH?
PJRST .FALSE## ;YES, NO MATCH
CAME T1,G$SID## ;MATCH, IS IT OK?
PJRST I$WHEEL ;NO, WIN ONLY IF HE'S A WHEEL
DFEQ.3: PJUMPL T4,.TRUE## ;JUST RETURN IF CON DIR WAS DEFAULTED
MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,.EQCON(T2) ;NOW CHECK CONNECTED
RCDIR ;CHECK IT
TXNE S1,RC%NOM ;MATCH?
PJRST .FALSE## ;NO, LOSE
CAME T1,G$CDI## ;IS IT OK?
PJRST I$WHEEL ;NO, WIN ONLY IF HE'S A WHEEL
PJRST .TRUE## ;YES, WIN
DFEQ.4: STOPCD (CDU,FATAL) ;++CANT DEFAULT USER
DFEQ.5: STOPCD (CDD,FATAL) ;++CANT DEFAULT DIRECTORY
SUBTTL Batch Stream Unique Directory Routines
INTERN I$UQST ;SET DIRECTORY FOR A STREAM
INTERN I$UQCL ;CLEAR DIRECTORY FOR A STREA