Trailing-Edge
-
PDP-10 Archives
-
AP-D483B-SB_1978
-
qsrt10.mac
There are 8 other files named qsrt10.mac in the archive. Click here to see a list.
TITLE QSRT10 -- Operating System Interface for QUASAR-10
SUBTTL Larry Samberg Chuck O'Toole /CER 6 Jan 77
;***Copyright (C) 1974, 1975, 1976, 1977, Digital Equipment Corp., Maynard, MA.***
SEARCH QSRMAC ;PARAMETER FILE
PROLOGUE(QSRT10) ;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 QSRT10
CAP CANNOT ACQUIRE A PID
CCI CANNOT CONNECT INTERRUPT SYSTEM
COF CANNOT TURN OFF INTERRUPT SYSTEM
CON CANNOT TURN ON INTERRUPT SYSTEM
COP CANT OPEN PRIME QUEUE
COR CANT OPEN REDUNDANT QUEUE
CSQ CANNOT SET IPCF QUOTAS
DIF DEBRK OF INTERRUPT FAILED
EEP ERROR EXPANDING PRIME QUEUE
EER ERROR EXPANDING REDUNDANT QUEUE
FSP FAILURE TO SET SYSTEM PID TABLE
HUF HIBERNATE UUO FAILED
ICF IPCF CONNECT FAILURE
LMI LOST MESSAGE FROM [SYSTEM]IPCC
MRF MESSAGE RECEIVE FAILURE
NGF NECESSARY GETTAB FAILED
NGS NO GALAXY-10 SUPPORT
PQI PRIME QUEUE INTERLOCKED
PWE PRIME WRITE ERROR
REF READING END OF FILE
RIE READ I/O ERROR
RWE REDUNDANT WRITE ERROR
WBL WRITING BAD LENGTH
\
COMMENT \
TOPS10 Interpretation of Fields
1) External Owner ID is a PPN
2) Onwer ID (Internal) is a PPN
\
SUBTTL Module Storage
SLPVAL: EXP ^D60000 ;SLEEP INTERVAL
MEMFLG: EXP 0 ;ZERO = IPCF INTERRUPTS ALLOWED
CENSTA: BLOCK 1 ;STATION # OF CENTRAL SITE
IPCPID: BLOCK 1 ;PID OF [SYSTEM]IPCC
SPLDIR: BLOCK 1 ;SPOOLING DIRECTORY
FFAPPN: BLOCK 1 ;FULL FILE ACCESS PPN [OPR]
PRMDIR: BLOCK 1 ;DIRECTORY FOR PRIME QUEUE
UNIDIR: BLOCK INPNUM ;UNIQUE DIRECTORY TABLE
IFN FTRQUE,<
REDDIR: BLOCK 1 ;DIRECTORY FOR REDUNDANT QUEUE
> ;END IFN FTRQUE
;INTERRUPT CONTROL CELLS MUST BE IN THE FOLLOWING ORDER
; THEY ARE REFERENCED BY THE OFFSET FROM THE BASE
INTBLK: BLOCK 0 ;BASE ADDRESS OF INTERRUPT VECTOR
IPCBLK::BLOCK 4 ;IPC INTERRUPT BLOCK
INTEND==.-1 ;END OF INTERRUPT VECTOR
SUBTTL Initialization Routine
;ROUTINE TO INITIALIZE THE WORLD. I$INIT INITIALIZES THE I/O
; SYSTEM, AND ENABLES THE INTERRUPT SYSTEM.
;
I$INIT:: RESET ;RESET ALL I/O
MOVX S1,%CNST2 ;GET SECOND STATES WORD
PUSHJ P,DOGTAB ;FOR SUPPORTED FEATURES
TXNN S1,ST%GAL ;THIS MONITOR SUPPORT GALAXY-10
STOPCD(NGS,FATAL) ;++NO GALAXY-10 SUPPORT
MOVEI S1,INTBLK ;BASE ADDRESS OF INTERRUPT VECTOR
PIINI. S1, ;AND INITIALIZE PSI SYSTEM
STOPCD(CCI,FATAL) ;++CANNOT CONNECT INTERRUPT SYSTEM
MOVE S1,[INTBLK,,INTBLK+1]
ZERO INTBLK ;PREPARE TO CLEAR INTERRUPT VECTOR
BLT S1,INTEND ;ZAP!!
MOVEI S1,C$INT## ;ADDRESS OF IPCF INTERRUPT ROUTINE
MOVEM S1,IPCBLK ;SAVE IT
MOVE S1,[PS.FAC+IPCSET]
PISYS. S1, ;ENABLE IPCF INTERRUPTS
STOPCD(ICF,FATAL) ;++IPCF CONNECT FAILURE
MOVX S1,%LDSPP ;GETTAB TO SPOOLED FILE PROTECTION
PUSHJ P,DOGTAB ;GET IT
LSH S1,-^D27 ;RIGHT-JUSTIFY IT
MOVEM S1,G$SPRT## ;AND STORE AWAY
MOVX S1,%LDQUE ;GETTAB TO SPOOLING DIRECTORY
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,SPLDIR ;AND STORE IT AWAY
MOVX S1,%LDFFA ;FULL FILE ACCESS PERSON
PUSHJ P,DOGTAB ;GETTAB IT
MOVEM S1,FFAPPN ;SAVE FOR I$WHEEL CHECKS
MOVX S1,%LDSYS ;GETTAB FOR "SYS"
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,PRMDIR ;AND SAVE THE DIRECTORY
IFN FTRQUE,<
MOVX S1,%LDQUE ;GETTAB FOR "QUE"
PUSHJ P,DOGTAB ;GET IT
MOVEM S1,REDDIR ;AND SAVE IT
> ;END IFN FTRQUE
;I$INIT IS CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVX S1,%IPCML ;GETTAB FOR MAX PACKET SIZE
PUSHJ P,DOGTAB ;GET IT
CAIGE S1,SPL.SZ ;IS IT BIGGER THAN A SPOOL MESSAGE?
MOVE S1,SPL.SZ ;NO, LOAD SIZE OF SPOOL MESSAGE
MOVEM S1,G$MPS## ;AND STORE IT
MOVEI S1,.GTLOC ;GETTAB FOR CENTRAL SITE
GETTAB S1, ;GET IT
MOVEI S1,0 ;DEFAULT TO 0
MOVEM S1,CENSTA ;AND STORE IT
MOVX S1,%SIIPC ;FIND PID OF [SYSTEM]IPCC
PUSHJ P,DOGTAB ;FROM THE GETTAB'ABLE PID TABLE
MOVEM S1,IPCPID ;SAVE FOR I$SIPC
MOVX S1,%CNMMX ;GET SMALLEST LEGAL CORMAX
PUSHJ P,DOGTAB ;FROM THE CONFIG TABLE
ADR2PG S1 ;CONVERT WORDS TO PAGES
MOVEM S1,G$MCOR## ;SAVE FOR THE SCHEDULER
PJOB S1, ;GET JOB NUMBER
$SITEM S1,QJOB ;AND SET THE ITEM
PJRST I$ION ;ENABLE INTERRUPTS AND RETURN
IPCSET: EXP .PCIPC ;ENABLE FOR IPCF INTERRUPTS
IPCBLK-INTBLK,,0 ;VECTOR OFFSET,,I/O REASON
EXP 0 ;RESERVED
SUBTTL Information
;ENTRY POINTS
INTERN I$WHEEL ;CHECK IF G$DIR 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 (G$DIR) 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$SID## ;GET CURRENT SENDERS PPN
MOVE S2,FFAPPN ;AND FULL FILE ACCESS PERSON
CAMN S1,S2 ;SAME DIRECTORY
PJRST .TRUE## ;YES, CAN DO ANYTHING
HRRZS S1 ;ISOLATE PROGRAMMER NUMBER
CAIE S1,(S2) ;SAME PROGRAMMER
PJRST .FALSE## ;NO, RETURN FALSE
MOVE S1,G$PRVS## ;GET CURRENT ENABLED CAPABILITIES
TXNN S1,IP.JAC ;IS JACCT SET
PJRST .FALSE## ;NO, NOT AN OPERATOR
PJRST .TRUE## ;SON(DAUGHTER) - OF - OPR WITH JACCT
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
I$KSYS: MOVX S1,%NSKTM ;GET THE GETTAB
GETTAB S1, ;GET THE DATA
ZERO S1 ;ASSUME NO KSYS
JUMPLE S1,.POPJ## ;RETURN IF NONE OR OVER
IMULI S1,^D60 ;CONVERT MINUTES TO SECONDS
POPJ P, ;AND RETURN
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: MOVX S1,%CNDTM ;UNIVERSAL DATE/TIME
PUSHJ P,DOGTAB ;GET THE DATA
MOVEM S1,G$NOW## ;STORE IN GLOBAL LOCATION
POPJ P, ;AND 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: MOVEM S1,CHAC.A ;SAVE CODE AND PROTECTION
MOVEM S2,CHAC.A+1 ;ALSO SAVE OWNER OF FILE
MOVE S1,G$SID## ;CURRENT SENDER (KILL, MODIFY)
MOVEM S1,CHAC.A+2 ;SET UP CHKACC UUO BLOCK
MOVEI S1,CHAC.A ;POINT TO IT
CHKACC S1, ;ASK THE FILE SERVICE
PJRST .FALSE## ;RETURN FALSE
SETCA S1, ;FLIP TOPS10 RETURN
POPJ P, ;RETURN
CHAC.A: BLOCK 3 ;LOCAL STORAGE
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 S2,[ST%NOP] ;NO OPERATOR BIT IN STATES WORD
I$LOGN: MOVX S2,ST%NRL!ST%NLG ;BITS THAT PROHIBIT LOGINS
MOVX S1,%CNSTS ;GET THE STATES BITS
PUSHJ P,DOGTAB ;GET THE DATA
TDNN S1,S2 ;CHECK FOR "DON'T ALLOW" BITS
PJRST .TRUE## ;RETURN TRUE IF ALL OFF
PJRST .FALSE## ;OTHERWISE, SAY PROHIBITTED
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
; PUSHJ P,I$VSTR
;
;
;RETURNS S1 = .TRUE. IF STRUCTURE IS THERE
; = .FALSE. IF OFF-LINE OR NOT A DISK
; S2 = STRUCTURE NAME
I$VSTR: MOVEM S1,VSTR.A ;SAVE NAME AS ARG TO DSKCHR
MOVE S1,[5,,VSTR.A] ;SETUP ARG POINTER
DSKCHR S1,UU.PHY ;DO THE DSKCHR
PJRST VSTR.1 ;STRANGE?
LDB S2,[POINTR(S1,DC.TYP)] ;GET ARG TYPE
CAIE S2,.DCTFS ;IS IT A FILE-STRUCTURE?
PJRST VSTR.1 ;NO, SO ITS NOT ON-LINE
MOVE S2,VSTR.A+.DCSNM ;GET THE STRUCTURE NAME
TXNE S1,DC.OFL!DC.SAF!DC.NNA
;CHECK FOR "NOT":
; OFF-LINE, SINGLE-ACCESS
; NO-NEW-ACCESSES
PJRST .FALSE## ;RETURN FALSE IF ANY OF THEM
PJRST .TRUE## ;WIN!!
VSTR.1: MOVE S2,VSTR.A+.DCNAM ;GET ORIG ARG
PJRST .FALSE## ;AND LOSE
VSTR.A: BLOCK 5 ;ARG BLOCK FOR DSKCHR UUO
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
REMARK DOGTAB ;Do necessary GETTABs
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: ZERO S1 ;SET INFINITE
EXCH S1,SLPVAL ;GET THIS INTERVAL, SET UP FOR NEXT TIME
TXO S1,HB.IPC ;WAKE ON IPC RECEIVES
HIBER S1, ;SLEEP!
STOPCD(HUF,FATAL) ;++HIBERNATE UUO FAILED
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==.POPJ## ;NO-OP ON TOPS10
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,PS.FOF ;TURN OFF THE INTERUPTS SYSTEM
PISYS. S1, ;OFF!!
STOPCD(COF,FATAL) ;++CANNOT TURN OFF INTERRUPT SYSTEM
POPJ P, ;RETURN
SUBTTL I$ION -- Routine to enable the interrupt system
;ROUTINE TO TURN ON THE INTERRUPT SYSTEM
I$ION: MOVX S1,PS.FON ;TURN IT ON
PISYS. S1, ;ON!!
STOPCD(CON,FATAL) ;++CANNOT TURN ON INTERRUPT SYSTEM
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 DOGTAB -- Routine to do necessary gettabs
;CALL DOGTAB TO DO ANY GETTABS WHICH ARE REQUIRED TO SUCCEED. IF THE
; GETTAB FAILS, A NGF STOPCD IS GIVEN.
;
;CALL WITH S1 CONTAINING THE GETTAB TO BE DONE.
DOGTAB: GETTAB S1, ;DO THE GETTAB
STOPCD(NGF,FATAL) ;++NECESSARY GETTAB FAILED
POPJ P, ;SUCCEED
SUBTTL Memory Manager Interface Routines
;ENTRY POINTS
INTERN I$MFFP ;FIND FIRST FREE PAGE
SUBTTL I$MFFP -- Find First Free Page
;ROUTINE TO FIND THE FIRST FREE PAGE IN QUASAR'S ADDRESS SPACE.
; RETURNS THE PAGE NUMBER IS S1.
I$MFFP: HLRZ S1,.JBSA ;GET JOBFF
ADDI S1,777 ;ROUND UP TO A PAGE
ADR2PG S1 ;CONVERT TO A PAGE NUMBER
POPJ P, ;AND 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 ESTABLISHES PIDS
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: MOVSS S1 ;GET LENGTH,,0
HRR S1,S2 ;GET LENGTH,,ADDRESS
ZERO S2 ;ASSUME SUCCESS
IPCFS. S1, ;SEND THE MESSAGE
SETO S2, ;SET THE ERROR FLAG
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: MOVSS S1 ;GET LENGTH,,0
HRR S1,S2 ;GET LENGTH,,ADDRESS
MOVEM S1,IPR.A ;SAVE IN CASE OF FAILURE
IPR.1: IPCFR. S1, ;RECEIVE THE MESSAGE
SKIPA ;FAILED, SEE WHY
POPJ P, ;AND RETURN
CAIE S1,IPCUP% ;WAS FAILURE BECAUSE OF SPACE
STOPCD(MRF,FATAL) ;++MESSAGE RECEIVE FAILURE
PUSHJ P,M$IPRM## ;HAVE QSRMEM MAKE SOME ROOM FOR IT
MOVE S1,IPR.A ;GET IPCF PARAMETERS AGAIN
JRST IPR.1 ;TRY IT NOW
IPR.A: BLOCK 1 ;HOLDS IPCF POINTERS
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
MOVE S1,[4,,IPQ.A] ;UUO ARG
IPCFQ. S1, ;QUERY
PJRST .FALSE## ;FAILED, RETURN 0
HRRZ S1,IPQ.A+.IPCFL ;GET RIGHT HALF OF FLAGS
HLL S1,IPQ.A+.IPCFP ;AND 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: MOVE S1,IPCBLK+.PSVIS ;GET INTERRUPT STATUS
POPJ P, ;AND RETURN
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
SAVE AP ;SAVE AP
SAVE H ;SAVE H
MOVEM S1,SYSENT ;STORE TABLE INDEX INTO SET FUNCTION
MOVSI S1,(S1) ;PUT INDEX INTO LH
HRRI S1,.GTSID ;USE SYSTEM PID TABLE GETTAB
PUSHJ P,DOGTAB ;GO GET IT
JUMPN S1,.POPJ## ;IF ALREADY EXISTS, ASSUME IT IS US
PJOB S1, ;GET MY JOB NUMBER
MOVEM S1,PIDMJB ;JOB TO CREATE A PID FOR
MOVEI AP,PIDBLK ;NO PID EXISTS, CREATE ONE
PUSHJ P,SNDIPC ;SEND AND GET THE RESPONSE
SKIPE S2 ;DID AN ERROR OCCUR
STOPCD(CAP,FATAL) ;++CANNOT ACQUIRE A PID
MOVE S1,PIDANS-PIDFNC(S1) ;GET THE RETURNED PID
MOVEM S1,EPID.A ;THAT IS THE PID TO BE RETURNED
MOVEM S1,SYSIDN ;STORE FOR WRITE SYSTEM PID TABLE
MOVEM S1,QTAIDN ;AND FOR QUOTA SET
PUSHJ P,C$PUT## ;RETURN THE ANSWER
MOVEI AP,SYSPID ;NOW, ESTABLISH THE SYSTEM COMPONENT
PUSHJ P,SNDIPC ;SEND AND GET THE RESPONSE
SKIPE S2 ;DID AN ERROR OCCUR
STOPCD(FSP,FATAL) ;++FAILURE TO SET SYSTEM PID TABLE
SKIPN QTAQTA ;ALREADY SET THE QUOTAS
JRST EPID.1 ;YES, CAN STOP NOW
PUSHJ P,C$PUT## ;NO, FIRST RETURN THE CELL
MOVEI AP,QTASET ;SET THE SEND/RECEIVE QUOTAS
PUSHJ P,SNDIPC ;SEND AND GET THE RESPONSE
SKIPE S2 ;ALL DONE IF THAT WORKED
STOPCD(CSQ,FATAL) ;++CANNOT SET IPCF QUOTAS
ZERO QTAQTA ;DON'T NEED TO SET QUOTAS AGAIN
EPID.1: PUSHJ P,C$PUT## ;RETURN LAST ANSWER
MOVE S1,EPID.A ;PID ACQUIRED THROUGH THIS SEQUENCE
POPJ P, ;RETURN
EPID.A: BLOCK 1 ;PID CREATED/READ DURING I$EPID
;THE MESSAGE BLOCKS ARE ON THE NEXT PAGE
;MESSAGES BLOCKS SEND DURING I$EPID SEQUENCE
PIDBLK: EXP IP.CFP,0,0 ;INVOKING PRIVS, MY PID, [SYSTEM]IPCC FILLED IN
XWD PIDLEN,PIDFNC ;LENGTH,,ADDR
PIDFNC: XWD PIDFNC,.IPCSC ;CODE,,CREATE A PID FOR A JOB
PIDMJB: EXP 0 ;MY JOB NUMBER FILLED IN
PIDANS: EXP 0 ;PID RETURNED
PIDLEN==.-PIDFNC ;LENGTH OF MESSAGE
SYSPID: EXP IP.CFP,0,0 ;INVOKING PRIVS, MY PID, [SYSTEM]IPCC FILLED IN
XWD SYSLEN,SYSFNC ;LENGTH,,ADDR
SYSFNC: XWD SYSFNC,.IPCWP ;WRITE SYSTEM PID TABLE
SYSENT: EXP 0 ;ENTRY FILLED IN
SYSIDN: EXP 0 ;TO MY PID (FILLED IN)
SYSLEN==.-SYSFNC ;LENGTH OF MESSAGE
QTASET: EXP IP.CFP,0,0 ;INVOKING PRIVS, MY PID, [SYSTEM]IPCC FILLED IN
XWD QTALEN,QTAFNC ;LENGTH,ADDR
QTAFNC: XWD QTAFNC,.IPCSQ ;CODE,,SET QUOTA FUNCTION
QTAIDN: EXP 0 ;MY PID (FILLED IN)
QTAQTA: EXP 777777 ;SEND = RECEIVE = INFINITY
QTALEN==.-QTAFNC ;LENGTH OF THE SET QUOTA MESSAGE
SUBTTL SNDIPC -- Send/Receive a message from [SYSTEM]IPCC
;CALLED WITH AP POINTING TO A PACKET DESCRIPTOR BLOCK FOR C$SEND
;RETURNS WITH
; AP = THE PACKET ADDRESS (FOR CALL TO C$PUT)
; S1 = THE ADDRESS OF THE MESSAGE PROPER
; S2 = THE ERROR BITS FROM .IPCFL
;THIS ROUTINE IS CALLED BY I$EPID DURING INITIALIZATION OF OTHER MODULES
SNDIPC: MOVE S1,IPCPID ;EXTERNAL VALUE OF [SYSTEM]IPCC
MOVEM S1,.IPCFR(AP) ;AS RECEIVER OF THIS SEND
LOAD S1,.IPCFP(AP),IPM.AD ;GET ADDRESS OF MESSAGE
MOVE S1,(S1) ;GET CODED RESPONSE
MOVEM S1,SNDI.A ;SAVE CODE RESPONSE
PUSHJ P,C$SEND## ;SEND THE MESSAGE TO [SYSTEM]IPCC
PUSHJ P,C$RAPK## ;RECEIVE ALL OUTSTAND PACKETS
LOAD AP,<HDRIPC##+.QHLNK>,QH.PTL ;SEARCH FOR IT BACKWARDS
SNDI.1: SKIPN AP ;OFF THE END
STOPCD(LMI,FATAL) ;++LOST MESSAGE FROM [SYSTEM]IPCC
LOAD S1,IPCFLG(AP),IP.CFC ;GET SENDER CODE
CAIE S1,.IPCCC ;FROM [SYSTEM]IPCC
JRST SNDI.2 ;NO, TRY ANOTHER
LOAD S1,IPCMES(AP),IPM.AD ;GET ADDRESS OF MESSAGE (NEVER PAGED)
MOVE S2,0(S1) ;FIRST WORD OF RESPONSE
CAME S2,SNDI.A ;ONE WE ARE LOOKING FOR
JRST SNDI.2 ;NO, TRY ANOTHER
MOVEI H,HDRIPC## ;POINT TO THE QUEUE
PUSHJ P,M$DLNK## ;REMOVE THE MESSAGE
LOAD S1,IPCMES(AP),IPM.AD ;POINT TO IT AGAIN
LOAD S2,IPCFLG(AP),IP.CFE ;GET THE ERROR BITS
POPJ P, ;RETURN TO CALLER
SNDI.2: LOAD AP,.QELNK(AP),QE.PTP ;GO BACKWARDS
JRST SNDI.1 ;LOOK AT THIS ONE
SNDI.A: BLOCK 1 ;SAVED CODE FOR RESPONSE
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,.SAVE2## ;SAVE P1-P2
MOVEI S2,CSM.A ;LOAD ADR OF BLOCK FOR CONVENIENCE
LOAD P1,SPL.JB(S1),SP.JOB ;GET THE JOB NUMBER
STORE P1,CSM.JB(S2),CS.JOB ;AND STORE IT
LOAD P1,SPL.JB(S1),SP.LOC ;GET DEFAULT LOCATION
STORE P1,CSM.JB(S2),CS.LOC
LOAD P1,SPL.JB(S1),SP.DFR ;GET DEFER'ED SPOOLING BIT
STORE P1,CSM.JB(S2),CS.DFR ;AND STORE IT
DMOVE P1,SPL.US(S1) ;GET THE USER NAME
DMOVEM P1,CSM.US(S2) ;AND STORE IT
LOAD P1,G$SID## ;GET USER'S DIRECTORY
STORE P1,CSM.OI(S2) ;AND STORE IT
LOAD P1,SPL.DV(S1) ;GET OPEN'ED DEVICE
STORE P1,CSM.DV(S2) ;AND STORE IT
LOAD P1,SPL.ST(S1) ;GET THE FILESTRUCTURE
STORE P1,CSM.ST(S2) ;STORE IN CSM
STORE P1,CSM.B+.FDSTR ;AND STORE IN THE FD AREA
LOAD P1,SPL.EN(S1) ;GET THE ENTER'ED FILENAME
STORE P1,CSM.EN(S2) ;AND STORE IT
LOAD P1,SPL.FS(S1) ;GET THE FILE SIZE
STORE P1,CSM.FS(S2) ;STORE IT AWAY
MOVEI P1,FDMSIZ ;LENGTH OF FD
STORE P1,CSM.FD(S2),CS.FDL ;STORE THE LENGTH
MOVE P1,CSM.F ;STANDARD FLAGS FOR SPOOLED FILES
STORE P1,CSM.FP(S2) ;SAVE FOR Q$INCL
MOVEI P1,CSM.B ;WHERE WE BUILD THE FD
STORE P1,CSM.FD(S2),CS.FDA ;STORE IT
;NOW FINISH MOVING THE FD AREA
LOAD P1,SPL.FN(S1) ;GET THE FILE NAME
STORE P1,CSM.B+.FDNAM ;STORE IT
LOAD P1,SPLDIR ;GET SPOOLING DIRECTORY
LOAD P2,SPL.JB(S1),SP.IUD ;GET IN-USER-DIRECTORY BIT
SKIPE P2 ;IS IT SET?
LOAD P1,G$SID## ;YES, USE HIS DIR
STORE P1,CSM.B+.FDPPN ;STORE IT
LOAD S2,SPL.JB(S1),SP.LOC ;GET DEFAULT LOCATION
LOAD S1,SPL.DV(S1) ;LOAD DEVICE SPECIFIED
PUSHJ P,I$MIDS ;MAKE AN IDS
HLLZM S1,CSM.B+.FDEXT ;AND STORE GENERIC DEV AS EXTENSION
MOVEI S1,CSM.A ;LOAD THE ANSWER
POPJ P, ;AND RETURN
CSM.A: BLOCK CSMSIZ ;THE CSM TO RETURN
CSM.B: BLOCK FDMSIZ ;THE FD AREA
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.JB(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
;
;CALLS I$VSTR FOR PROPER CONVERSION
I$FSTR: MOVE S1,.FDSTR(S1) ;GET THE STRUCTURE NAME
PUSHJ P,I$VSTR ;CONVERT TO A STRNAME
MOVE S1,S2 ;RETURN IT IN S1
POPJ P, ;RETURN
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: PUSHJ P,.SAVE3## ;SAVE P1 - P3 FIRST
MOVE P1,0(S1) ;GET FIRST FD ADDRESS
MOVE P2,1(S1) ;AND THE SECOND
MOVE P3,2(S1) ;AND THE MASKS
FMCH.1: MOVE S1,0(P1) ;GET A WORD
XOR S1,0(P2) ;SEE IF THEY MATCH
AND S1,0(P3) ;TO THE NUMBER OF CHARACTERS SPECIFIED
PJUMPN S1,.FALSE## ;STOP NOW IF NOT A MATCH
INCR P1 ;TO NEXT ITEMS TO COMPARE
INCR P2 ;...
INCR P3 ;...
SOJG S2,FMCH.1 ;TRY ALL WORDS
PJRST .TRUE## ;RETURN ON A COMPLETE MATCH
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 ;Make request and RDB
INTERN I$DFEQ ;Default and check the 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: LOAD S2,.EQOWN(S1) ;GET OWNER'S PPN
STORE S2,.QEOID(AP) ;STORE IT IN THE QE AS OWNER ID
DMOVE S1,.EQUSR(S1) ;GET USER NAME
DMOVEM S1,.QEUSR(AP) ;SAVE IT
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: DMOVE S1,.QEUSR(S1) ;GET THE USER NAME
DMOVEM S1,LST.US(AP) ;SAVE IT
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 OWNER ID
STORE S2,.EQOWN(AP) ;SAVE IT IN THE EQ
DMOVE S1,CSM.US(S1) ;GET USER NAME
DMOVEM S1,.EQUSR(AP) ;SAVE IN THE EQ
POPJ P, ;AND 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
LOAD S2,.QEOID(AP) ;GET OWNER ID
SKIPN P1,.RDBOI(S1) ;LOAD SPECIFIED OID
MOVE P1,G$SID## ;USE THE DEFAULT IF 0
XOR S2,P1 ;FIND OUT WHATS DIFFERENT
AND S2,.RDBOM(S1) ;MASK OUT INSIGNIFICANT PARTS
PJUMPN S2,.FALSE## ;NO MATCH IF NOT 0
PJRST .TRUE## ;WIN!!
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: LOAD S2,.EQOWN(S1) ;GET OWNER
CAME S2,G$SID## ;SAME AS SENDER?
PJUMPN S2,I$WHEEL ;IF NOT, AND IF NOT 0, RETURN THRU WHEEL
LOAD S2,G$SID## ;LOAD CURRENT SENDER
STORE S2,.EQOWN(S1) ;STORE IT
PJRST .TRUE## ;AND WIN
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: MOVE S2,.QEOID(AP) ;GET THE PPN
MOVEM S2,UNIDIR(S1) ;SAVE IT
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: ZERO UNIDIR(S1) ;CLEAR THE 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: MOVE S2,.QEOID(AP) ;GET THE DIRECTORY
CAME S2,UNIDIR(S1) ;MATCH?
PJRST .FALSE## ;NO.
PJRST .TRUE## ;YES!!
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.
;
;NOTE: WRITES "BOTH" MASTERS.
I$WRIT: MOVEM S1,WRIT.A ;SAVE BLOCK NUMBER
MOVEM S2,WRIT.B ;SAVE POINTER WORD
HLRZ S1,S2 ;GET THE LENGTH
SKIPLE S1 ;LE 0
CAILE S1,1000 ;OR GREATER THAN A PAGE?
STOPCD (WBL,FATAL) ;++WRITING BAD LENGTH
MOVNS S1 ;NEGATE IT
HRLZS S1 ;GET -LEN,,0
SUBI S2,1 ;MAKE ADR-1
HRR S1,S2 ;AND MAKE AN IOWD
MOVEM S1,WRIT.C ;SAVE IT
CLEARM WRIT.C+1 ;SET END OF LIST
WRIT.1: MOVE S1,WRIT.A ;GET BLOCK NUMBER BACK
USETO CMQ1,(S1) ;SET IT
OUT CMQ1,WRIT.C ;AND WRITE FILE 1
JRST WRIT.2 ;WIN!! GO ON
GETSTS CMQ1,S1 ;GET I/O STATUS
TXZN S1,IO.BKT ;RUN OUT OF ROOM?
STOPCD (PWE,FATAL) ;++PRIME WRITE ERROR
SETSTS CMQ1,(S1) ;YES, CLEAR INDICATOR
MOVEI S1,12 ;LOOP 10 SECS
SLEEP S1, ;SLEEP SOME
JRST WRIT.1 ;AND TRY AGAIN
WRIT.2:
IFN FTRQUE,<
MOVE S1,WRIT.A ;GET BLOCK NUMBER BACK
USETO CMQ2,(S1) ;SET IT
OUT CMQ2,WRIT.C ;WRITE FILE 2
JRST WRIT.3 ;WIN! GO ON
GETSTS CMQ2,S1 ;GET I/O STATUS
TXZN S1,IO.BKT ;RUN OUT OF ROOM?
STOPCD (RWE,FATAL) ;++REDUNDANT WRITE ERROR
SETSTS CMQ2,(S1) ;YES, CLEAR INDICATOR
MOVEI S1,12 ;LOOP 10 SECS
SLEEP S1, ;SLEEP SOME
JRST WRIT.2 ;AND TRY AGAIN
> ;END IFN FTRQUE
;"I$WRIT" IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
WRIT.3: HLRZ S1,WRIT.B ;GET NUMBER OF WORDS
SUBI S1,1 ;ROUND DOWN
IDIVI S1,FSSBKS ;AND GET NUMBER OF BLOCKS
ADD S1,WRIT.A ;ADD IN DPA OF FIRST BLOCK
CAMG S1,G$NBW## ;GREATER THAN PREVIOUS LAST BLOCK?
POPJ P, ;NO, RETURN
MOVEM S1,G$NBW## ;YES, SAVE AS GREATEST
MOVX S1,<FO.PRV!<CMQ1>B17!.FOURB>
MOVE S2,[1,,S1] ;LOAD ARGBLOCK
FILOP. S2, ;UPDATE THE RIB FOR THE FIRST ONE
STOPCD(EEP,FATAL) ;++ERROR EXPANDING PRIME QUEUE
IFN FTRQUE,<
MOVX S1,<FO.PRV!<CMQ2>B17!.FOURB>
MOVE S2,[1,,S1] ;LOAD THE ARGBLOCK
FILOP. S2, ;UPDATE THE RIB FOR THE SECOND ONE
STOPCD(EER,FATAL) ;++ERROR EXPANDING REDUNDANT QUEUE
> ;END IFN FTRQUE
POPJ P, ;AND RETURN
WRIT.A: BLOCK 1 ;LOCAL STORAGE
WRIT.B: BLOCK 1 ;LOCAL STORAGE
WRIT.C: BLOCK 2 ;LOCAL STORAGE
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: MOVEM S1,READ.A ;SAVE BLOCK NUMBER
MOVEM S2,READ.B ;SAVE IO-POINTER
USETI CMQ1,(S1) ;SET THE INPUT BLOCK
HLRZ S1,S2 ;GET THE LENGTH
MOVNS S1 ;NEGATE IT
HRLZS S1 ;GET -LEN,,0
SUBI S2,1 ;MAKE ADR-1
HRR S1,S2 ;MAKE AN IOWD
MOVEM S1,READ.C ;SAVE IT
CLEARM READ.C+1 ;SET END-OF-LIST
IN CMQ1,READ.C ;READ THE BLOCK
POPJ P, ;NO ERROR, RETURN
GETSTS CMQ1,S1 ;I/O ERROR, GET THE STATUS
TXNE S1,IO.EOF ;WAS IT AN EOF?
STOPCD (REF,FATAL) ;++READING END OF FILE
STOPCD (RIE,FATAL) ;++READ I/O ERROR
READ.A: BLOCK 1 ;LOCAL STORAGE
READ.B: BLOCK 1 ;LOCAL STORAGE
READ.C: BLOCK 2 ;LOCAL STORAGE
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 ;GET LENGTH TO WRITE
PJRST I$WRIT ;AND WRITE IT OUT
SUBTTL I$OQUE -- Open master queue files
;ROUTINE CALLED DURING FAILSOFT SYSTEM INITIALIZATION TO OPEN
; THE MASTER QUEUE FILE(S). OPENS ONE FILE IF FTRQUE IS
; OFF AND TWO IF FTRQUE IS ONE
I$OQUE: PUSHJ P,.SAVE1## ;SAVE P1
PUSHJ P,SETOQF ;SETUP CONSTANT PARAMETERS
MOVE P1,[MQFNM1] ;GET NAME OF PRIME QUEUE
MOVEM P1,.RBNAM(S2) ;STORE IT
MOVE P1,PRMDIR ;GET DIRECTORY OF PRIME QUEUE
MOVEM P1,.RBPPN(S2) ;STORE IT
MOVSI P1,CMQ1 ;GET CHANNEL FOR PRIME QUEUE
IORM P1,.FOFNC(S1) ;STORE IT
HRLI S1,6 ;GET LEN,,ADR
FILOP. S1, ;AND OPEN THE PRIME QUEUE!
JRST OQUE.1 ;DO SOME EVALUATION
MOVE S1,.RBSIZ(S2) ;GET THE SIZE OF FILE (WRITTEN)
ADDI S1,FSSBKS-1 ;ROUND UP
IDIVI S1,FSSBKS ;AND CONVERT TO BLOCKS
MOVEM S1,G$NBW## ;AND SAVE AS NUMBER OF BLOCKS WRITTEN
IFN FTRQUE,<
PUSHJ P,SETOQF ;SETUP CONSTANT PARAMETERS
MOVE P1,[MQFNM2] ;GET NAME OF REDUNDANT QUEUE
MOVEM P1,.RBNAM(S2) ;STORE IT
MOVE P1,REDDIR ;GET DIRECTORY OF REDUNDANT QUEUE
MOVEM P1,.RBPPN(S2) ;STORE IT
MOVSI P1,CMQ2 ;GET THE CHANNEL NUMBER
IORM P1,.FOFNC(S1) ;STORE IT
HRLI S1,6 ;GET LEN,,ADR
FILOP. S1, ;OPEN THE REDUNDANT QUEUE!!
STOPCD(COR,FATAL) ;++CANT OPEN REDUNDANT QUEUE
> ;END IFN FTRQUE
POPJ P, ;RETURN
;HERE ON A FILOP. FAILURE FOR THE PRIME QUEUE
OQUE.1: CAIN S1,ERFBM% ;SPECIAL CASE: FILE BEING MODIFIED
STOPCD (PQI,FATAL) ;++PRIME QUEUE INTERLOCKED
STOPCD (COP,FATAL) ;++CANT OPEN PRIME QUEUE
SUBTTL SETOQF -- Setup to OPEN master queue files
;SETOQF IS CALLED BY I$OQUE TO SETUP THE INVARIANT PART OF THE FILOP AND
; LOOKUP UUO BLOCKS. INTO THE LOOKUP BLOCK IT FILLS IN:
; BLOCK LENGTH
; FILE-NAME EXTENSION
; PROTECTION
; ESTIMATED LENGTH
; FILE STATUS BITS
;INTO THE FILOP BLOCK IT PUTS
; FILOP FUNCTION
; I/O STATUS
; FILE-STRUCTURE NAME
; ADDRESS OF LOOKUP BLOCK
;RETURN WITH S1 CONTAINING ADDRESS OF FILOP BLOCK AND S2 CONTAINING THE
; ADDRESS OF THE LOOKUP BLOCK
SETOQF: CLEARM SETO.A ;CLEAR FIRST WORD OF LOOKUP BLOCK
MOVE S1,[SETO.A,,SETO.A+1]
BLT S1,SETO.A+.RBSTS ;AND CLEAR THE REST
CLEARM SETO.B ;CLEAR THE FIRST WORD OF FILOP BLOCK
MOVE S1,[SETO.B,,SETO.B+1]
BLT S1,SETO.B+5 ;AND CLEAR THE REST
MOVEI S1,.RBSTS ;GET LENGTH OF LKP BLOCK
MOVEM S1,SETO.A+.RBCNT ;SAVE IT
MOVSI S1,'QSR' ;GET THE EXTENSION
MOVEM S1,SETO.A+.RBEXT ;SAVE IT
MOVSI S1,FSSPRT_9 ;GET FILE PROTECTION
MOVEM S1,SETO.A+.RBPRV ;STORE IT AWAY
MOVEI S1,1000 ;ESTIMATE 1 FILE SECTION
MOVEM S1,SETO.A+.RBEST ;SAVE IT
MOVX S1,RP.ABC ;ALWAYS BAD CHECKSUM
MOVEM S1,SETO.A+.RBSTS ;AND SAVE IT
MOVX S1,<FO.PRV+.FOSAU> ;SINGLE ACCESS UPDATE
MOVEM S1,SETO.B+.FOFNC ;SAVE FUNCTION WORD
MOVX S1,<UU.PHS+.IODMP> ;PHONLY DUMP MODE
MOVEM S1,SETO.B+.FOIOS ;SAVE STATUS
MOVX S1,FSSSTR ;GET THE STR NAME
MOVEM S1,SETO.B+.FODEV ;SAVE IT
MOVEI S2,SETO.A ;GET ADDRESS OF LKP BLOCK
MOVEM S2,SETO.B+.FOLEB ;SAVE IT
MOVEI S1,SETO.B ;LOAD ADR OF FILOP BLOCK
POPJ P, ;AND RETURN
SETO.A: BLOCK .RBSTS+1 ;THE LOOKUP BLOCK
SETO.B: BLOCK 6 ;THE FILOP BLOCK
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
MOVEI S1,[ASCIZ /QUASAR STOP CODE - /]
CAIE P1,.SCFAT ;FATAL??
MOVEI S1,[ASCIZ /QUASAR TRACE:/]
OUTSTR (S1) ;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
OUTCHR S1 ;OUTPUT THE ASCII CHARACTER
AOBJN P4,STCD.1 ;AND LOOP
OUTSTR [BYTE (7) .CHCRT,.CHLFD,0] ;CHARRIAGE RETURN-LINE FEED PAIR
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
MONRT. ;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: HRRZ 0,.JBDDT ;GET DDT START ADDRESS
MOVEM 0,CRAS.A ;SAVE IT
MOVSI 17,G$CRAC## ;SETUP A BLT POINTER
BLT 17,17 ;AND RESTORE CRASH ACS
OUTSTR [ASCIZ /Crash ACs Copied
Going to DDT
/]
JRST @CRAS.A ;AND GO AHEAD
CRAS.A: BLOCK 1 ;SAVE DDT START ADDRESS
END