Trailing-Edge
-
PDP-10 Archives
-
bb-d868b-bm_tops20_v3a_2020_dist
-
3a-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 STREAM
INTERN I$UQCH ;COMPARE STREAM FOR UNIQNESS
SUBTTL I$UQST -- Set Directory for a Stream
;ROUTINE TO SET THE DIRECTORY FOR A STREAM FROM THE BATCH QUEUE ENTRY
;
;CALL:
; MOVEI S1,<STREAM NUMBER>
; MOVE AP,<BATCH QUEUE ENTRY (QE)>
; PUSHJ P,I$UQST
; ALWAYS RETURN HERE
I$UQST: IMULI S1,12 ;GET INDEX INTO UNIDIR
ADDI S1,UNIDIR ;GET DESTINATION ADDRESS
HRLI S1,.QECON(AP) ;GET SOURCE ADDRESS
HRRZ S2,S1 ;SETUP AC FOR END OF BLT
BLT S1,11(S2) ;STORE THE DIRECTORY
POPJ P, ;AND RETURN
SUBTTL I$UQCL -- Clear the directory for a stream
;ROUTINE TO CLEAR OUT THE DIRECTORY FOR A STREAM
;
;CALL:
; MOVEI S1,<STREAM NUMBER>
; PUSHJ P,I$UQCL
; ALWAYS RETURN HERE
I$UQCL: IMULI S1,12 ;MULTIPLY BY THE SIZE
ZERO UNIDIR(S1) ;CLEAR THE FIRST WORD
POPJ P, ;AND RETURN
SUBTTL I$UQCH -- Check for directory match
;ROUTINE TO WHETHER A BATCH QUEUE REQUEST IS FOR THE SAME DIRECTORY
; AS A PARTICULAR STREAM.
;CALL:
; MOVEI S1,<STREAM NUMBER>
; MOVE AP,<BATCH QUEUE ENTRY (QE)>
; PUSHJ P,I$UQCH
; ALWAYS RETURN HERE WITH .TRUE. ON MATCH
I$UQCH: PUSHJ P,.SAVE1## ;SAVE P1
IMULI S1,12 ;MULITPLY BY THE ENTRY SIZE
ADDI S1,UNIDIR ;POINT TO FIRST WORD
HRLI S1,-12 ;MAKE IT AN AOBJN POINTER ALSO
MOVEI S2,.QECON(AP) ;POINT TO FIRST WORD IN QE
UQCH.1: MOVE P1,0(S1) ;GET A WORD
CAME P1,0(S2) ;LOOK FOR A MATCH
PJRST .FALSE## ;NO MATCH JUST RETURN
AOJ S2, ;ELSE INCREMENT POINTER 2
AOBJN S1,UQCH.1 ;INCREMNT PTR 1 AND LOOP
PJRST .TRUE## ;MATCH!!
SUBTTL Failsoft System Interface
;ENTRY POINTS
INTERN I$WRIT ;WRITE SOMETHING INTO THE MASTER
INTERN I$READ ;READ SOMETHING FROM THE MASTER
INTERN I$CRIP ;CREATE AN INDEX PAGE
INTERN I$OQUE ;OPEN MASTER QUEUE FILES
SUBTTL I$WRIT -- Write something into master queue file
;ROUTINE TO WRITE SOMETHING INTO THE MASTER QUEUE FILES. CALL WITH S1
; CONTAINING THE BLOCK NUMBER TO WRITE, AND S2 CONTAINING AN
; IO-POINTER OF THE FORM:
;
; XWD LENGTH,ADDRESS
;
; WHERE 'LENGTH' IS THE NUMBER OF WORDS TO WRITE, AND 'ADDRESS'
; IS THE PLACE TO START WRITING FROM.
I$WRIT: PUSHJ P,.SAVET## ;SAVE T1-T4
MOVE T1,S1 ;GET BLOCK NUMBER
IDIVI T1,FSSBPS ;DIVIDE BY BLOCKS/SECTION
CAIN T2,FSSFIB ;IS IT AN INDEX BLOCK?
JRST WRIT.1 ;YES, DO SOMETHING SPECIAL
DMOVEM S1,WRIT.A ;STORE INPUT ARGUMENTS
HRR T3,FSADDR ;ADDRESS OF SCRATCH PAGE
HRL T3,WRIT.A+1 ;GET SOURCE,,DEST IN T3
HLRZ T4,WRIT.A+1 ;GET LENGTH OF DATA
ADDI T4,-1(T3) ;ADD IN BASE ADR-1
BLT T3,(T4) ;AND BLT THE DATA
MOVE S1,FSPAGN ;GET 0,,SOURCE-PAGE
HRLI S1,.FHSLF ;<FORK-HANDLE>,,<SOURCE-PAGE>
MOVE S2,WRIT.A ;GET 0,,<DEST-PAGE>
HRL S2,FILJFN ;GET <JFN>,,<DEST-PAGE>
MOVX T1,PM%RD!PM%WT ;READ AND WRITE ACCESS
PMAP ;AND MAP THE PAGE OUT
HRL S1,FILJFN ;GET <JFN>,,0
HRR S1,WRIT.A ;GET <JFN>,,<FILE-PAGE>
MOVEI S2,1 ;AND A REPEAT COUNT
UFPGS ;UPDATE THE DISK
STOPCD(CUF,FATAL) ;++CANT UPDATE FILE
MOVE T1,WRIT.A ;GET FILE PAGE NUMBER
CAMG T1,G$NBW## ;HIGHEST PAGE YET
POPJ P, ;NO, RE-USING SOME SPACE
MOVEM T1,G$NBW## ;YES, SAVE NEW FILE SIZE
MOVSI S1,.FBUSW ;FILL IN USER-SPECIFIED-WORD
HRR S1,FILJFN ;FOR MASTER FILE
SETO S2, ;FILL ENTIRE WORD WITH T1
CHFDB ;CHANGE THE FILE BLOCK
POPJ P, ;AND RETURN
;HERE IF WRITING AN INDEX PAGE
WRIT.1: HRL S1,FILJFN ;GET <JFN>,,<PAGE-NUMBER>
MOVEI S2,1 ;AND A REPEAT COUNT
UFPGS ;AND UPDATE THE INDEX
STOPCD(CUI,FATAL) ;++CANT UPDATE INDEX
POPJ P, ;RETURN
WRIT.A: BLOCK 2 ;INPUT ARGUMENTS
SUBTTL I$READ -- Read something from master queue file
;ROUTINE TO READ SOMETHING FROM THE MASTER QUEUE FILE. CALL WITH S1
; CONTAINING A BLOCK TO START THE READ AT AND S2 CONTAINING AN
; IO-POINTER OF THE FORM:
;
; XWD LENGTH,ADDRESS
;
; WHERE 'LENGTH' IS THE NUMBER OF WORDS TO READ, AND 'ADDRESS'
; IS THE PLACE TO START READING THEM INTO.
I$READ: PUSHJ P,.SAVET## ;SAVE T1-T4
MOVE T1,S1 ;GET BLOCK NUMBER
IDIVI T1,FSSBPS ;DIVIDE BY BLOCKS/SECTION
CAIN T2,FSSFIB ;IS IT AN INDEX BLOCK?
JRST READ.1 ;YES, GO MAP IT IN
DMOVE T1,S1 ;COPY ARGS FROM S TO T
MOVE S1,T1 ;GET 0,,<SOURCE-PAGE>
HRL S1,FILJFN ;GET <JFN>,,<SOURCE-PAGE>
MOVE S2,FSPAGN ;GET 0,,<DEST-PAGE>
HRLI S2,.FHSLF ;<FORK-HANDLE>,,<DEST-PAGE>
MOVX T1,PM%RD ;AND READ ACCESS
PMAP ;AND MAP IN THE PAGE
HRL T1,FSADDR ;GET <SOURCE-ADR>,,0
HRR T1,T2 ;GET <SOURCE-ADR>,,<DEST-ADR>
HLRZ T3,T2 ;GET LENGTH OF DATA
ADDI T3,-1(T2) ;ADD IN BASE ADR -1
BLT T1,(T3) ;AND BLT TO REQUESTORS PAGE
SETO S1, ;NOW SETUP TO RELEASE THE
HRRZ S2,FSPAGN ; MAPPED SCRATCH PAGE FROM
HRLI S2,.FHSLF ; OUR ADDRESS SPACE
SETZ T1, ;FLAGS ARE MEANINGLESS
PMAP ;DO IT!!
POPJ P, ;AND RETURN
;HERE TO MAP IN AN INDEX PAGE
READ.1: HRL S1,FILJFN ;GET JFN,,SOURCE-PAGE
TLZ S2,-1 ;GET 0,,<DEST-ADR>
ADR2PG S2 ;GET 0,,<DEST-PAGE>
HRLI S2,.FHSLF ;<FORK-HANDLE>,,<DEST-PAGE>
MOVX T1,PM%RWX ;READ/WRITE/EXECUTE
PMAP ;MAP IT!
POPJ P, ;AND RETURN
SUBTTL I$CRIP -- Create an index page in master file
;I$CRIP IS CALLED WHEN THE FAILSOFT SYSTEM DECIDES TO START A NEW FILE
; SECTION (INCLUDING THE VERY FIRST) TO WRITE OUT THE NEW INDEX
; PAGE INTO THE FILE. CALL WITH S1 CONTAINING THE BLOCK NUMBER OF
; THE PAGE, AND S2 CONTAINING THE ADDRESS OF THE PAGE.
I$CRIP: HRLI S2,FSSWPI ;NUMBER OF WORDS TO WRITE
PUSHJ P,.SAVET## ;SAVE T REGS
DMOVE T3,S1 ;SAVE ARGS IN T3 AND T4
HRRZ S1,S2 ;GET 0,,<SOURCE-ADR>
ADR2PG S1 ;GET 0,,<SOURCE-PAGE>
HRLI S1,.FHSLF ;GET <FHANDLE>,,<SOURCE-PAGE>
HRRZ S2,T3 ;GET 0,,<DEST-PAGE>
HRL S2,FILJFN ;GET <JFN>,,<DEST-PAGE>
MOVX T1,PM%WR ;SET WRITE ACCESS FLAG
PMAP ;MAP THE PAGE OUT
DMOVE S1,T3 ;RECOVER THE ARGS
PUSHJ P,I$READ ;MAP THE PAGE IN
DMOVE S1,T3 ;RECOVER THE ARGS AGAIN
PJRST I$WRIT ;UPDATE THE WORLD AND RETURN
SUBTTL I$OQUE -- Open master queue files
;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
; THE MASTER QUEUE FILE.
I$OQUE: ZERO OQUE.A ;FIRST TIME THRU
OQUE.1: MOVX S1,<GJ%SHT!GJ%OLD> ;DO A SHORT GTJFN, OLD FILE ONLY
HRROI S2,[MQFNAM] ;POINT TO MASTER QUEUE NAME
GTJFN ;GO GET IT
JRST OQUE.2 ;NOT THERE, CREATE IT
HRRZM S1,FILJFN ;SAVE THE JFN
HRRZS S1 ;AND ZERO THE LEFT HALF OUT
PUSH P,T1 ;SAVE T1
MOVX S2,<1,,.FBUSW> ;READ USER SUPPLIED ARGUMENT
MOVEI T1,OQUE.B ;INTO LOCAL STORAGE
GTFDB ;READ FILE BLOCK INFORMATION
MOVE T1,OQUE.B ;WE FILL IN HIGHEST PAGE NUMBER
MOVEM T1,G$NBW## ;SAVE THE FILE SIZE
POP P,T1 ;AND RESTORE T1
MOVE S1,FILJFN ;GET THE JFN
MOVX S2,<OF%RD+OF%WR+OF%NWT> ;GET OPENF BITS
OPENF ;OPEN THE FILE
PUSHJ P,OQUE.4 ;LOSE!!
SAVE AP ;SAVE AP FOR A MINUTE
PUSHJ P,M$ACQP## ;GET A PAGE FOR I$READ/I$WRITE
MOVEM AP,FSPAGN ;FOR THEIR SCRATCH USE
PG2ADR AP ;CONVERT TO ADDRESS ALSO
MOVEM AP,FSADDR ;FOR EASIER USE
POPJ P, ;AND RETURN
OQUE.2: SKIPE OQUE.A ;FIRST TIME THRU?
PUSHJ P,OQUE.3 ;NO, GIVE A STOPCD
MOVX S1,<GJ%NEW!GJ%SHT!GJ%FOU> ;NEW FILE, OUTPUT, SHORT GTJFN
HRROI S2,[MQFNAM] ;POINT TO MASTER QUEUE NAME
GTJFN ;GET IT
PUSHJ P,OQUE.3 ;LOSE?
MOVX S2,OF%WR ;WRITE
HRRZS S1 ;CLEAR LH
PUSH P,S1 ;AND SAVE JFN
OPENF ;OPEN THE FILE
PUSHJ P,OQUE.3 ;CAN'T?
POP P,S1 ;RESTORE THE JFN
CLOSF ;CLOSE THE FILE
JFCL ;REALLY SHOULDN'T HAPPEN
SETOM OQUE.A ;WE'VE BEEN HERE ONCE ALREADY
JRST OQUE.1 ;AND TRY AGAIN
OQUE.3: STOPCD (COP,FATAL) ;++CANT OPEN PRIME QUEUE
OQUE.4: CAIE S1,OPNX9 ;IS IT ILLEGAL SIMUL ACCESS?
JRST OQUE.3 ;NO
STOPCD (PQI,FATAL) ;++PRIME QUEUE INTERLOCKED
OQUE.A: BLOCK 1 ;LOCAL STORAGE
OQUE.B: BLOCK 1 ;LOCAL STORAGE
SUBTTL FBREAK -- Find a break character
;FBREAK IS USED TO SEPARATE PIECES OUT OF CHARACTER STRINGS. IT WILL
;ALSO DO A FIXED OFFSET CONVERSION OF THE CHARACTERS
;IT IS CALLED WITH:
; T1 = BYTE POINTER TO SOURCE STRING
; T2 = BYTE POINTER TO DESTINATION STRING
; T3 = CHARACTER TO STOP ON,,CONVERSION OFFSET (SUBTRACTED FROM SOURCE CHARACTER
; T4 = COUNT OF CHARACTERS TO STORE (OTHERS TO BREAK ARE SKIPPED)
;IT RETURNS:
; T1 = BYTE POINTER TO FIRST CHARACTER AFTER BREAK IN SOURCE
; S1 = TERMINATION CHARACTER (EITHER BREAK AS SPECIFIED IN T3 OR NULL
; S2,T2-T3 UNDEFINED
FBREAK: HLRZ S2,T3 ;GET CHARACTER TO STOP ON
HRRES T3 ;AND MAKE T3 CONVERSION OFFSET
FBRE.1: ILDB S1,T1 ;GET A CHARACTER FROM THE SOURCE
JUMPE S1,.POPJ## ;ALWAYS STOP ON NULL
CAMN S1,S2 ;IS IT THE BREAK CHARACTER
POPJ P, ;YES, RETURN
SUB S1,T3 ;DO THE CONVERSION
SOSL T4 ;DECREMENT NUMBER OF CHARACTERS TO STORE
IDPB S1,T2 ;STORE IT
JRST FBRE.1 ;AND LOOP BACK FOR MORE
SUBTTL STGWLD -- Match a "wild" string
;STGWLD IS CALLED WITH S1 CONTAINING A POINTER TO A "BASE" STRING
; LIKE A JOBNAME OR FILENAME AND S2 CONTAINING A POINTER TO
; A STRING WITH POSSIBLE WILDCARD CHARACTERS * AND % IN IT.
; IT THE BASE STRING MATCHES THE WILD STRING, TRUE IS RETURNED
; OTHERWISE FALSE.
STGWLD: PUSHJ P,.SAVET## ;SAVE T REGS
STGW.1: ZERO T1 ;CLEAR * FLAG
STGW.2: ILDB T4,S2 ;GET A CHARACTER FROM "WILD"
STGW.3: CAIL T4,"A"+40 ;CHECK FOR LOWER CASE
CAILE T4,"Z"+40 ; "
SKIPA ;ITS NOT LC
SUBI T4,40 ;IT IS, MAKE IT UPPER CASE
STGW.4: ILDB T3,S1 ;GET A CHARACTER FROM "BASE"
CAIL T3,"A"+40 ;CHECK IT FOR LOWER CASE
CAILE T3,"Z"+40
SKIPA ;ITS NOT LOWER
SUBI T3,40 ;IT IS, MAKE IT UC
CAME T3,T4 ;MATCH?
JRST STGW.5 ;NO, THAT WOULD BE TOO SIMPLE
PJUMPE T3,.TRUE## ;YES, RETURN IF END OF STRINGS
JRST STGW.1 ;ELSE JUST LOOP
STGW.5: CAIN T4,"*" ;IS "WILD" A *?
PJUMPE T3,.TRUE## ;YES, WIN IF END OF STRING
JUMPN T1,STGW.4 ;IF LAST "WILD" WAS *, KEEP GOING
PJUMPE T3,.FALSE## ;IF NOT END-OF-STRING DOES NOT MATCH
CAIN T4,"%" ;IS "WILD" A %
JRST STGW.7 ;YES, MATCH AND GO AROUND AGAIN
CAIE T4,"*" ;NO, IS IT A *
PJRST .FALSE## ;NO, LOSE
STGW.6: AOSA T1 ;YES, SET * FLAG
STGW.7: ZERO T1 ;CLEAR * FLAG
STGW.8: ILDB T4,S2 ;GET NEXT "WILD" CHARACTER
CAIN T4,"*" ;IS IT A *?
JRST STGW.6 ;YES, "**"="*"
CAIE T4,"%" ;NO, A % ?
JRST STGW.3 ;NO, PLAIN OLD ALPHANUMERIC
JRST STGW.8 ;YES, "*%" = "*"
SUBTTL I$STCD -- STOPCODE Routine
INTERN I$STCD
;I$STCD IS CALLED WHEN A STOPCD MACRO IS EXECUTED, THE MAIN MODULE
; CALLS I$STCD AFTER PRESERVING ALL ACCUMULATORS.
;CALL: S1 = THE TYPE OF STOPCD
; S2 = THE STOPCD NAME
;I$STCD TYPES THE APPROPRIATE MESSAGE AND IF THE STOPCD TYPE INDICATES
; A FATAL ERROR, STORES CRASH INFORMATION THEN RETURNS TO MONITOR LEVEL.
I$STCD: PUSHJ P,.SAVE4## ;SAVE ALL P REGS
DMOVE P1,S1 ;COPY THE ARGUMENTS
HRLZM P2,G$CRAC##+23 ;AND STORE STOPCD NAME AWAY
HRROI S1,[ASCIZ /QUASAR STOP CODE - /]
CAIE P1,.SCFAT ;FATAL??
HRROI S1,[ASCIZ /QUASAR TRACE:/]
PSOUT ;OUTPUT THE MESSAGE
MOVE P3,[POINT 6,P2,17] ;POINT TO THE CODE
MOVSI P4,-3 ;LOAD AN AOBJN POINTER
STCD.1: ILDB S1,P3 ;GET A CHARACTER
ADDI S1,"A"-'A' ;CONVERT TO ASCII
PBOUT ;OUTPUT THE ASCII CHARACTER
AOBJN P4,STCD.1 ;AND LOOP
HRROI S1,[BYTE (7) .CHCRT,.CHLFD,0] ;CHARRIAGE RETURN-LINE FEED PAIR
PSOUT ;OUTPUT CR-LF
CAIE P1,.SCFAT ;FATAL??
POPJ P, ;NO, RETURN TO LUUO HANDLER
MOVEI S1,PAGTBL## ;GET ADDRESS OF PAGE TABLE
MOVEM S1,G$CRAC##+20 ;AND STORE IT AWAY
MOVEI S1,TBLHDR## ;ADDRESS OF QUEUE HEADERS
HRLI S1,NQUEUE## ;GET NUMBER OF QUEUES
MOVEM S1,G$CRAC##+21 ;STORE IT AWAY
MOVEI S1,PDL## ;ADDRESS OF PDL
MOVEM S1,G$CRAC##+22 ;AND STORE IT AWAY
MOVEI S1,G$CRAC## ;GET ADDRESS OF ACS
MOVEM S1,DEBUGW ;SAVE IT WHERE WE'LL FIND IT
HALTF ;EXIT TO THE MONITOR
JRST .-1 ;WITH NO CONTINUE
;NOTES ON DEBUGGING QUASAR CRASHES:
;
;ON ALL FATAL STOPCODES, THE G$CRAC BLOCK IN QUASAR IS FILLED WITH
; INFORMATION WHICH MIGHT PROVE USEFUL WHEN LOOKING AT A CRASH
; OF QUASAR.
; THE FOLLOWING INFORMATION MAY BE FOUND THERE:
;
;G$CRAC+
; 0-17 ;ACCUMULATORS AT EXECUTION OF THE STOPCD
; 20 ;ADDRESS OF QUASAR'S INTERNAL PAGE TABLE
; 21 ;# OF QUEUES,,ADDRESS OF "TBLHDR", THE LIST OF Q HDRS
; 22 ;THE ADRESS OF THE BOTTOM OF THE PUSHDOWN STACK
; 23 ;THE STOP-CODE IN LEFT-JUSTIFIED SIXBIT
;
;THE ADDRESS OF THE G$CRAC BLOCK IS STORED IN DEBUGW (135) SO IT
; CAN BE FOUND.
;
;IF AN INSTALLATION WANTS TO ADD MORE ITEMS TO BE STORED, IT IS
; RECOMMENDED THAT ANOTHER BLOCK BE ALLOCATED (E.G. STCD.A)
; AND ITS ADDRESS STORED IN LOCATION 136.
CRASH: HRROI 1,[ASCIZ /Crash ACs Copied
Going to DDT
/]
PSOUT ;TELL HIM
MOVSI 17,G$CRAC## ;SETUP A BLT POINTER
BLT 17,17 ;RESTORE THE CRASH ACS
JRST 770000 ;AND GO BACK TO DDT
END