Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50501/qpack.mac
There are no other files named qpack.mac in the archive.
UNIVERSAL QPACK BYTE PROCESSING IN QUEUE STRUCTURES WITH LUUO'S
SUBTTL ERNIE PETRIDES, WESLEYAN UNIVERSITY, AUGUST, 1978
COMMENT \
FORWARD
LUUO'S (LOCAL UNIMPLEMENTED USER OPERATIONS) PROVIDE THE PROGRAMMER
WITH A MEANS OF CALLING SPECIAL SUBROUTINES WHILE TAKING ADVANTAGE OF THE
ACCUMULATOR ASSIGNMENT AND THE COMPLETE EFFECTIVE ADDRESS CALCULATION (DONE
AUTOMATICALLY BY THE CENTRAL PROCESSOR) TO USE AS SUBROUTINE ARGUMENTS. THE
LUUO CAN BEHAVE MUCH THE SAME WAY AS A NORMAL INSTRUCTION, WITH A DATA FETCH
FROM THE EFFECTIVE ADDRESS AND AN ACTION DONE TO THE SPECIFIED AC, BUT IT IS
A SOFTWARE ROUTINE AS OPPOSED TO A HARDWARE ROUTINE. THE OPERATION CODES OF
OCTAL 1-37 CAUSE THE INSTRUCTION IN THE USER'S LOCATION .JB41 (SEE JOB DATA
AREA) TO BE EXECUTED OUT OF SEQUENCE AFTER THE OP-CODE, AC, AND E FIELDS ARE
LOADED INTO USER'S LOCATION .JBUUO. SINCE THE INSTRUCTION IN .JB41 CAN DO A
STANDARD SUBROUTINE CALL (PUSHJ, JSR, ETC.; MUST SAVE PC) TO A ROUTINE THAT
DISPATCHES ACCORDING TO THE LUUO EXECUTED (OP-FIELD), THE NORMAL BURDENS OF
A SUBROUTINE CALL ARE ALREADY ACCOUNTED FOR WITHOUT TYING UP THE AC OR E
FIELDS OF THE ORIGINAL INTRUCTION. AND SINCE AN LUUO IS A SINGLE INSTRUCTION
(AS OPPOSED TO A MACRO CALL), IT CAN BE EASILY SKIPPED OVER, JUMPED AROUND,
STORED IN LITERALS, AND XCT'ED.
\
SUBTTL DECLARATIONS AND DEFINITIONS
SALL ;EVERYONE LIKES CLEAN LISTINGS!
IFNDEF .FTQSL,<.FTQSL==0> ;ZERO (DEFAULT) FOR NO SEGMENT LIMITATIONS
;NEGATIVE FOR ONLY LOW SEGMENT QUEUES
;POSITIVE FOR ONLY HIGH SEGMENT QUEUES
;JOBDAT LOCATIONS:
.JBUUO==40 ;WHERE PROCESSOR DUMPS LUUO INSTRUCTION
.JB41==41 ;CONTAINS INSTRUCTION XCT'ED ON AN LUUO
.JBREL==44 ;HIGHEST RELATIVE CORE LOCATION FOR USER
.JBHRL==115 ;LENGTH OF,,HIGHEST ADDRESS IN HISEG
.JBFF==121 ;FIRST FREE LOCATION AFTER LOWSEG
.JBDA==140 ;WHERE START OF LOWSEG IS LOADED
.JBHGH==400000 ;HIGH SEGMENT RELOCATION FACTOR
.JBHDA==10 ;WHERE START OF HISEG IS LOADED
;SYMBOLS RELEVANT TO MONITOR UUO'S:
.GTSGN==14 ;GETTAB TABLE NUMBER OF HIGH SEGMENTS FOR $QMAIN
SN%UWP==1B2 ;GETTAB BIT SET IF USER WRITE-PROTECT IS OFF FOR HISEG
JB.UJA==1B0 ;JOBSTS UUO BIT FOR USER JOB ASSIGNED
JB.ULI==1B1 ;JOBSTS UUO BIT FOR USER LOGGED IN
JB.UML==1B2 ;JOBSTS UUO BIT FOR USER AT MONITOR LEVEL
;SYMBOLS PROVIDED FOR USER:
INTERN .QZOCT,.QZFIV,.QZSXB,.QZASC,.QZXWD,.QZWRD ;BYTE SIZES
INTERN QS.SLP,QS.INI,QS.FRZ,QS.SEN,QS.REN,QS.WEN ;STATUS BITS
;THE USER'S ACCUMULATORS ARE BLOCK-TRANSFERRED TO ACSAVE ON EVERY QUEUE
; INSTRUCTION AND ARE THEN RESTORED WITH ANY POSSIBLE MODIFICATIONS.
; AC 0 IS NOT USED BY QPACK, SO IN EVENT OF A PROBLEM, ITS CONTENTS
; (USUALLY PROGRAM STATUS FLAGS) CAN BE USED FOR RECOVERY IN CONJUNCTION
; WITH ACTIONS OF THE QON AND QOFF OPDEFS, WHICH MAY BE ASSEMBLED BY THE
; USER. THE ASSIGNMENTS ARE RELEVANT ONLY TO QUEUE INSTRUCTIONS.
;
;ACCUMULATOR DEFINITIONS:
F==0 ;PRESERVED AT ALL TIMES, NOT USED BY ANY INSTRUCTIONS
T1==1 ;SIX CONSECUTIVE TEMPS
T2==2 ; "
T3==3 ; "
T4==4 ; "
T5==5 ; "
T6==6 ; "
BT==7 ;BYTE TO LOAD/UNLOAD INTO/FROM QUEUE
JN==10 ;OUR JOB NUMBER
HA==11 ;QUEUE HEADER ADDRESS
CA==12 ;CONTENTS OF AC OF INSTRUCTION
EC==13 ;ERROR CODE OF THE FORM 'QXX',,N
OP==14 ;OP-CODE OFFSET FROM THE QINIT INSTRUCTION
AC==15 ;AC SPECIFIED BY QUEUE INSTRUCTION
EF==16 ;EFFECTIVE ADDRESS OF QUEUE INSTRUCTION
R==17 ;SUBROUTINE RETURN ACCUMULATOR (FOR JSP'S AND JSA'S)
;SYMBOL NAMING CONVENTION:
; $XXXXX --LABEL OF ROUTINE (OR TABLE) XXXXX
; QE$XXX --LABEL OF BRANCH TO HANDLE ERROR XXX
; LUO.XX --LOCATION OF BYTE POINTER FOR LUUO BYTE XX
; QS.XXX --MASK FOR QUEUE STATUS BIT XXX
; Q.XXXX --LOCATION OF BYTE POINTER FOR HEADER BYTE XXXX
; .QXYYY --NUMBER FOR VALUE YYY ABOUT SUBJECT X
;PARAMETERS:
.QPDQS==40 ;THE DEFAULT QUEUE SIZE USED IF "MAKEQ" IS GIVEN ZERO
.QPRBB==10 ;RETRIES (SECONDS) BEFORE BREAKING INTERLOCK ON QSAVE
;LENGTHS:
.QLHDR==4 ;LENGTH OF QUEUE HEADER IN WORDS
.QLIPT==0 ;LATER SET TO LENGTH OF INSTRUCTION PRIVILEGE TABLE
.QLBPT==0 ;LATER SET TO LENGTH OF HEADER BYTE POINTER TABLE
;STANDARD BYTE SIZES IN APPROPRIATE FIELD:
.QZOCT==3B23 ;FOR OCTAL CHARACTERS (DUMPS)
.QZFIV==5B23 ;FOR LIMITED CHARACTER SETS
.QZSXB==6B23 ;FOR SIXBIT CHARACTERS
.QZASC==7B23 ;FOR ASCII CHARACTERS
.QZXWD==^D18B23 ;FOR HALF-WORD BYTES
.QZWRD==^D36B23 ;FOR WHOLE WORDS
;QUEUE STATUS BITS:
QS.SLP==1B0 ;SLEEP A JIFFY BEFORE RETRYING INTERLOCK
QS.INI==1B1 ;QUEUE HAS BEEN INITIALIZED (CURRENTLY OWNED)
QS.FRZ==1B2 ;QUEUE IS FROZEN (MOST INSTRUCTIONS WON'T WORK)
QS.SEN==1B3 ;NON-OWNERS MAY CHECK STATUS/POSITION OF QUEUE
QS.REN==1B4 ;QUEUE IS READ-ENABLED FOR NON-OWNERS
QS.WEN==1B5 ;QUEUE IS WRITE-ENABLED FOR NON-OWNERS
QS.OWN==QS.SLP ;USED IN PLACE OF QS.SLP IN PRIVILEGE TABLE TO MARK AN
;INSTRUCTION AS OWNER-PRIVILEGED (NOT IN QUEUE HEADER)
;MACRO TO GENERATE A QUEUE HEADER (AND TO RESERVE QUEUE AREA IF IN HISEG)
DEFINE MAKEQ (N)
<IFG N,<SIZE=N>
IFLE N,<SIZE=.QPDQS>
IFL .-.JBHGH,<IFG .FTQSL,<%FATAL <ONLY HIGH SEGMENT QUEUES ALLOWED>>
EXP -1,SIZE,0,0>
IFGE .-.JBHGH,<IFL .FTQSL,<%FATAL <ONLY LOW SEGMENT QUEUES ALLOWED>>
EXP -1,SIZE,0
XWD .+1,0
BLOCK SIZE>
PURGE SIZE>
SUBTTL TABLES AND SUCH
;QUEUE INSTRUCTION SET GENERATOR. APPROPRIATE INFORMATION IS EXTRACTED BY
; DEFINING THE ITEM MACRO AND THEN CALLING QISGEN. INFORMATION IS AS
; FOLLOWS:
; ITEM 1 INSTRUCTION NAME
; ITEM 2 ADDRESS OF INSTRUCTION PROCESSOR
; ITEM 3 CONDITIONS THAT MUST BE TRUE FOR OWNER
; ITEM 4 CONDITIONS THAT MUST BE FALSE FOR OWNER
; ITEM 5 CONDITIONS THAT MUST BE TRUE FOR OTHERS
; ITEM 6 CONDITIONS THAT MUST BE FALSE FOR OTHERS
DEFINE QISGEN
<ITEM QINIT,$QINIT,0,QS.INI!QS.FRZ,0,QS.INI!QS.FRZ
ITEM QKILL,$QKILL,QS.INI,0,QS.OWN,0
ITEM QRSET,$QRSET,QS.INI,QS.FRZ,QS.OWN,0
ITEM QFRZE,$QFRZE,QS.INI,0,QS.OWN,0
ITEM QGIVE,$QGIVE,QS.INI,QS.FRZ,QS.OWN,0
ITEM QOTHR,$QOTHR,QS.INI,QS.FRZ,QS.OWN,0
ITEM QRTYL,$QRTYL,QS.INI,QS.FRZ,QS.OWN,0
ITEM QREIN,$QINIT,QS.FRZ,QS.INI,QS.OWN,0
ITEM QSAVE,$QSAVE,QS.INI,0,QS.INI,0
ITEM QSTAT,$QSTAT,QS.INI,QS.FRZ,QS.INI!QS.SEN,QS.FRZ
ITEM QWHRE,$QWHRE,QS.INI,QS.FRZ,QS.INI!QS.SEN,QS.FRZ
ITEM QREAD,$QREAD,QS.INI,QS.FRZ,QS.INI!QS.REN,QS.FRZ
ITEM QPULL,$QPULL,QS.INI,QS.FRZ,QS.INI!QS.WEN,QS.FRZ
ITEM QPUSH,$QPUSH,QS.INI,QS.FRZ,QS.INI!QS.WEN,QS.FRZ
ITEM QPUSHI,$QPUSH+1,QS.INI,QS.FRZ,QS.INI!QS.WEN,QS.FRZ>
;MACRO TO ADD AN ENTRY TO THE LUUO DISPATCH TABLE AND ASSIGN ITS OPDEF.
DEFINE LUONAM (NAME,WHERE)
<IF1,<
IFDEF MAXLUO,<IFE MAXLUO-37,<%FATAL <TOO MANY LUUOS>>
MAXLUO==MAXLUO+1>
IFNDEF MAXLUO,<MAXLUO==1>
IFNB <NAME>,<OPDEF NAME [BYTE (9)MAXLUO]
INTERN NAME>>
EXP WHERE>
;MACRO TO GIVE ERROR MESSAGE AND TERMINATE ASSEMBLY.
DEFINE %FATAL (TEXT)
<PRINTX
PRINTX ?ASSEMBLY ERROR: TEXT
PRINTX ?TERMINATING ASSEMBLY
PASS2
LOC 137
EXIT
END 137>
;GENERATION OF THE LUUO DISPATCH TABLE. (INDIRECTLY ADDRESSED!)
DEFINE ITEM (A,B,C,D,E,F) <LUONAM A,B>
LUOTAB: LUONAM PULL,$PULL ;A CROSS BETWEEN A PUSH AND A POP
LUONAM PUSHI,$PUSHI ;PUSHES THE WORD 0,,E
QISGEN ;AND THE REST OF THE QPACK
;GENERATION OF THE QUEUE INSTRUCTION PRIVILEGE TABLE. FOR EACH QUEUE
; INSTRUCTION GENERATE A WORD WITH THE FOLLOWING FORMAT:
; WHERE A, B, C, AND D ARE SIX-BIT BYTES EACH WITH A
; CORRESPONDENCE TO THE STATUS BYTE OF THE QUEUE HEADER, BUT
; WITH THE SUBSTITUTION OF QS.OWN FOR QS.SLP, AND WHERE
; BYTE A CONTAINS THE BITS THAT MUST MATCH FOR THE OWNER,
; BYTE B CONTAINS THE BITS THAT MUST BE ON FOR THE OWNER,
; BYTE C CONTAINS THE BITS THAT MUST MATCH FOR NON-OWNERS,
; BYTE D CONTAINS THE BITS THAT MUST BE ON FOR NON-OWNERS:
; BYTE (6) A,B,0,C,D,0
;
;BY REQUIRING THE QS.OWN BIT TO BE ON FOR NON-OWNERS, THE PROGRAMMER CAN
; MAKE CERTAIN INSTRUCTIONS OWNER-PRIVILEGED. AN "XOR" WITH THE
; STATUS BYTE (WITH QS.OWN SET IF THE PJOB UUO RETURNS THE SAME JOB
; AS IN THE Q.OWNR BYTE) AND BYTE B OR D IS THEN "AND"'ED WITH BYTE
; A OR C. IF ALL BITS ARE CLEAR, THE INSTRUCTION IS ALLOWED. OTHER-
; WISE, THE JFFO BRANCHES TO THE 'QNP' ERROR, AND AN ERROR CODE
; CORRESPONDING TO THE ILLEGAL BIT IS RETURNED (1 FOR BIT0). SEE
; CODE AT $GOTIT THROUGH $GOTIT+13.
;
DEFINE ITEM (NAME,WH,A,B,C,D)
<IFN <<<A>&<B>>!<<C>&<D>>>,
<%FATAL <BAD PRIVILEGES FOR NAME INSTRUCTION>>
%%TMP1=<<<<A>!<B>>_-^D30>B23> ! <<<A>_-^D30>B29>
%%TMP2=<<<<C>!<D>>_-^D30>B23> ! <<<C>_-^D30>B29>
XWD %%TMP1,%%TMP2
PURGE %%TMP1,%%TMP2>
$QPTAB: QISGEN
.QLIPT==.-$QPTAB ;LENGTH OF PRIVILEGE TABLE
;FOLLOWING IS A PICTURE OF A QUEUE HEADER:
;
; -------------------------------------------------
;QNAME: ! I N T E R L O C K !
; -------------------------------------------------
; ! STATS ! OWNER !RETRIES! BSIZE ! QUEUE SIZE !
; -------------------------------------------------
; ! LAST BYTE PULLED (BT) ! LAST BYTE PUSHED (TP) !
; -------------------------------------------------
; ! DATA AREA ADDRESS ! QUEUE BYTE CAPACITY !
; -------------------------------------------------
;
;QUEUE HEADER BYTE POINTERS:
$QBTAB: BLOCK 0 ;THIS LIST FORMS A TABLE NEEDED BY "QSTAT"
Q.INTL: POINT 36,(HA),35 ;QUEUE INTERLOCK WORD
Q.STAT: POINT 6,1(HA),5 ;QUEUE STATUS BYTE
Q.OWNR: POINT 6,1(HA),11 ;QUEUE OWNER (INITIALIZER)
Q.RTRS: POINT 6,1(HA),17 ;NUMBER OF TIMES TO RETRY INTERLOCK
Q.BSIZ: POINT 6,1(HA),23 ;CURRENT BYTE SIZE (IN BITS; BETWEEN 1 AND 36)
Q.QSIZ: POINT 12,1(HA),35 ;LENGTH OF DATA AREA IN WORDS
Q.BPOS: POINT 18,2(HA),17 ;POSITION OF LAST BYTE PULLED (INIT'ED AT 0)
Q.TPOS: POINT 18,2(HA),35 ;POSITION OF LAST BYTE PUSHED (INIT'ED AT 0)
Q.QADR: POINT 18,3(HA),17 ;ADDRESS OF DATA AREA (.QLHDR(HA) IF IN HISEG)
Q.QCAP: POINT 18,3(HA),35 ;CAPACITY OF QUEUE IN BYTES (OF CURRENT SIZE)
.QLBPT==.-$QBTAB ;LENGTH OF ABOVE TABLE
;INSTRUCTION BYTE POINTERS FOR ANALYZING LUUO:
LUO.OP: POINT 9,.JBUUO,8 ;OP-CODE FIELD
LUO.AC: POINT 4,.JBUUO,12 ;AC FIELD
LUO.EF: POINT 18,.JBUUO,35 ;E FIELD AFTER EFFECTIVE ADDRESS CALCULATION
SUBTTL LUUO DISPATCHER
LOC .JB41 ;ON OP-CODES 1-37,
JSR LUODSP ; HERE'S HOW TO GET TO LUODSP
RELOC
;THIS IS THE CENTRAL DISPATCHER FOR ALL LUUO'S.
;
LUODSP: Z ;GETS RETURN PC AND STATUS
MOVEM T1,ACSAVE+1 ;SAVE A TEMP FOR WORKING SPACE
LDB T1,LUO.OP ;LOAD IN THE LUUO OP-CODE
CAILE T1,MAXLUO ;IF IT'S NOT WITHIN RANGE,
JRST LUOERR ; THEN DO ERROR ROUTINE
HRLI T1,ACSAVE+1 ;LOAD LOCATION OF SAVED AC FOR JRA
JRA T1,@LUOTAB-1(T1) ;RESTORE TEMP AND DISPATCH!
;HERE ON ILLEGAL LUUO OP-CODES
LUOERR: MOVEM T2,ACSAVE+2 ;SAVE A SECOND TEMP
OUTSTR LUOMSG ;TELL USER WHAT HAPPENED
SKIPA T1,.+1 ;LOAD (AND SKIP) THE FOLLOWING
POINT 3,LUODSP,17 ; BYTE POINTER TO RETURN ADDRESS
SOSA LUODSP ;BUT MAKE IT ADDRESS OF CULPRIT
OUTCHR T2 ;TYPE OUT PC DIGIT AFTER A LOAD
ILDB T2,T1 ;LOAD NEXT PC DIGIT FROM RETURN
MOVEI T2,60(T2) ;CONVERT IT TO ASCII
JUMPGE T1,.-3 ;TYPE IT IF NOT IN NEXT WORD (TRICKY)
OUTSTR LUOMSG-1 ;FINISH LINE WHEN DONE
AOS LUODSP ;REPAIR THE RETURN ADDRESS
MOVE T1,ACSAVE+1 ;RESTORE A TEMP
MOVE T2,ACSAVE+2 ;OR TWO
EXIT 1, ;AND KILL OURSELVES
JRSTF @LUODSP ;BUT LET USER CONTINUE ANYWAY
BYTE (7)15,12,12 ;SUPER CRILIF
LUOMSG: ASCIZ/?
?illegal LUUO at user PC / ;ILL. LUUO MESSAGE (UPPER/LOWER CASE!)
SUBTTL PULL AND PUSHI LUUO'S
X=0 ;SYMBOLIC FOR AC USED IN LUUO INSTRUCTION
;THE PULL LUUO IS THE COMPLEMENT OF PUSH IN A FIRST-IN/FIRST-OUT STACK. PULL
; HAS THE SAME EFFECT ON THE POINTER IN AC, BUT LOADS E WITH THE WORD
; POINTED TO BY AC(R). SINCE THE PULL PROCESS IS SIMULATED WITH A
; PUSH INSTRUCTION, NORMAL OVERFLOW CHECKING IS DONE BY THE PROCESSOR
; (IF LEFT OF AC REACHES ZERO). THE PULL POINTER POINTS TO THE LAST
; LOCATION PULLED, SO IT SHOULD BE SET UP JUST LIKE A PUSH POINTER WITH
; THE STANDARD "MOVE AC,[IOWD LENGTH,STACK]". NOTE THAT A "PULL X,X"
; WILL RESTORE THE POINTER AFTER HAVING LOADED IT WITH STACK DATA AND
; THAT ILL MEM REF'S WON'T SHOW THE STACK POINTER IN AC.
;
$PULL: JSA T1,PULPSH ;SAVE TEMP AND USE SAME ROUTINE AS PUSHI
;FOLLOWING IS THE PULL SEQUENCE (USER AC IS SUBSTITUTED FOR X):
MOVEM X,ACSAVE ;SAVE THE INITIAL POINTER
AOJ X, ;INCREMENT THE RIGHT HALF
TLZ X,777777 ;THEN ZERO THE LEFT HALF
MOVE X,@X ;LOAD STACK ITEM TO BE PULLED
MOVEM X,@.JBUUO ;PUT INTO REQUESTED MEM. LOC.
EXCH X,ACSAVE ;RELOAD STACK POINTER
PUSH X,ACSAVE ;CHECK FOR PDL OVERFLOW
;THE PUSHI LUUO DOES A PUSH OF THE WORD 0,,E JUST LIKE THE STANDARD
; IMMEDIATE FORMS OF MOST OTHER MACRO INSTRUCTIONS. (WHY DID
; THEY FORGET THIS ONE?)
;
$PUSHI: JSA T1,PULPSH ;SAVE TEMP AND USE SAME ROUTINE AS PULL
;FOLLOWING IS THE PUSHI SEQUENCE (USER AC IS SUBSTITUTED FOR X):
HRRZS .JBUUO ;ZERO DISTRACTING INFORMATION
PUSH X,.JBUUO ;PUSH EFFECTIVE ADDRESS OF LUUO
IF2,<PURGE X> ;GET RID OF UNNECESSARY SYMBOL
;THIS IS THE ROUTINE TO CARRY OUT PULL AND PUSHI LUUO'S. THE IDEA IS TO
; BUILD THE INSTRUCTION SEQUENCE IN THE ACSAVE BLOCK AND THEN "XCT"
; IT. NOTE THAT THE JSA AC IS ONLY USED AS THE ADDRESS OF THE
; SEQUENCE SKELETON AND THAT THE TWO SEQUENCES ARE DISTINGUISHED
; BY THE SIGN BIT OF THE FIRST INSTRUCTION (PULL LUUO USES A MOVEM,
; OP-CODE 202; PUSHI LUUO USES A HRRZS, OP-CODE 553). NOT EXACTLY
; ELEGANT, BUT IT LEAVES OTHER METHODS IN THE DUST.
;
PULPSH: Z ;GETS SAVED T1 WHICH NOW HAS SEQ. ADR.
HRLZI T1,(T1) ;PUT SOURCE IN LEFT HALF
HRRI T1,ACSAVE+1 ;LOAD DESTINATION IN RIGHT
BLT T1,ACSAVE+7 ;TRANSFER TO ACSAVE BLOCK
LDB T1,LUO.AC ;NOW GET USER'S AC NUMBER
SKIPL ACSAVE+1 ;IF NOT WORKING ON A PUSHI,
IORM T1,ACSAVE+4 ; PUT AC IN ADDRESS FIELD OF #4
LSH T1,^D23 ;SHIFT AC INTO ACCUMULATOR FIELD
IORM T1,ACSAVE+2 ;PUT AC INTO SECOND INSTRUCTION
SKIPGE ACSAVE+1 ;IF NOT WORKING ON A PULL,
JRST .+7 ; JUMP OVER THIS STUFF
IORM T1,ACSAVE+1 ;PUT AC IN PULL #1
IORM T1,ACSAVE+3 ;PUT AC IN PULL #3
IORM T1,ACSAVE+4 ;PUT AC IN PULL #4
IORM T1,ACSAVE+5 ;PUT AC IN PULL #5
IORM T1,ACSAVE+6 ;PUT AC IN PULL #6
IORM T1,ACSAVE+7 ;PUT AC IN PULL #7
MOVE T1,PULPSH ;RESTORE THE TEMP
XCT ACSAVE+1 ;FIRE 1
XCT ACSAVE+2 ;FIRE 2
SKIPGE ACSAVE+1 ;IF NOT WORKING ON A PULL,
JRSTF @LUODSP ; THEN RETURN TO USER NOW
XCT ACSAVE+3 ;OTHERWISE, FIRE 3
XCT ACSAVE+4 ;FIRE 4
XCT ACSAVE+5 ;FIRE 5
XCT ACSAVE+6 ;FIRE 6
XCT ACSAVE+7 ;FIRE 7
JRSTF @LUODSP ;AND RETURN TO USER
SUBTTL CENTRAL QUEUE INSTRUCTION PROCESSOR --- SETUP
;ALL QUEUE INSTRUCTIONS COME HERE. THE FIRST INSTRUCTION OF EACH
; INDIVIDUAL QUEUE INSTRUCTION ROUTINE IS DEFINED BY "QSETUP".
; HERE, THE USER'S ACCUMULATORS ARE SAVED IN THE ACSAVE BLOCK
; AND THEN LOADED WITH ALL THE STANDARD INFORMATION NEEDED FOR
; QUEUE INSTRUCTION PROCESSING. AFTER THE QUEUE IS INTERLOCKED
; AND THE INSTRUCTION IS APPROVED FOR THIS USER'S PRIVILEGES, A
; RETURN IS MADE BACK TO THE CALLING ROUTINE.
OPDEF QSETUP [JSA R,$QMAIN-1] ;SAVE AC 17 IN ACSAVE BLOCK & DO QMAIN
ACSAVE: BLOCK 20 ;WHERE TO STORE USER'S AC'S DURING QUEUE INSTRUCTIONS
;FIRST LET'S SAVE USER'S AC'S AND SET THEM UP FOR US.
$QMAIN: IFDEF QON,<QON> ;SIGNAL START OF QUEUE INSTRUCTION
MOVEM 16,ACSAVE+16 ;SAVE AC 16 CAUSE 17 HAS RETURN
MOVEI 16,ACSAVE ;USE IT FOR SAVING ALL AC'S
BLT 16,ACSAVE+15 ;SAVE THEM IN THE ACSAVE BLOCK
LDB EF,LUO.EF ;LOAD EFFECTIVE ADDRESS OF INSTRUCTION
LDB AC,LUO.AC ;LOAD ACCUMULATOR OF INSTRUCTION
LDB OP,LUO.OP ;LOAD OP-CODE OF INSTRUCTION
SUBI OP,<QINIT>_-^D27 ;GET OFFSET FROM LOWEST INSTRUCTION
SETZB EC,BT ;CLEAR ERROR CODES AND BYTE AC
MOVE CA,ACSAVE(AC) ;LOAD CONTENTS OF INSTRUCTION AC
CAIGE OP,<<QREAD>-<QINIT>>_-^D27;WHERE IS THE HEADER ADDRESS?
SKIPA HA,EF ;INSTRUCTION E FIELD FOR MOST
HLRZ HA,CA ;LEFT HALF OF AC FOR READ,PULL,PUSH
PJOB JN, ;GET OUR JOB NUMBER (WE NEED IT A LOT)
;NOW BEFORE MONKEYING AROUND, MAKE SURE OUR QUEUE HEADER ADDRESS IS OKAY.
MOVE T1,.JBREL ;LOAD HIGHEST WE CAN USE IN LOWSEG
CAIG HA,-.QLHDR(T1) ;IF NO ROOM FOR HEADER AT THE TOP,
CAIGE HA,.JBDA ;OR IT'S NOT HIGHER THAN JOB DATA,
CAIA ; THEN IT'S NOT LEGIT FOR LOWSEG--SKIP
IFG .FTQSL,<JRST QE$QSL> ;OKAY--BUT ERROR IF NOT ALLOW LOWSEG
IFLE .FTQSL,<JRST $GRABQ> ;OKAY--INTERLOCK QUEUE IF ALLOW LOWSEG
SKIPN T1,.JBHRL ;IF WE DON'T HAVE A HIGH SEGMENT,
JRST QE$IHA ; THEN IT'S AN ILLEGAL HEADER ADDR.
CAIG HA,.QLHDR(T1) ;IF NO ROOM FOR HEADER AT HISEG TOP,
CAIGE HA,.JBHGH+.JBHDA ;OR IT'S NOT ABOVE VESTIGIAL JOB DATA,
JRST QE$IHA ; THEN IT REALLY IS ILLEGAL
IFL .FTQSL,<JRST QE$QSL> ;OKAY--BUT ERROR IF NOT ALLOW HISEG
IFGE .FTQSL,<HRROI T1,.GTSGN ;OKAY--LOOK IN TABLE FOR OUR JOB
GETTAB T1, ;WE WANT OUR HIGH SEGMENT INFO
CAIA ; TOO BAD IF CAN'T GET IT
TLNN T1,(SN%UWP) ;MAKE SURE HISEG IS WRITE-ENABLED
JRST QE$HWP> ; ERROR IF NOT OR NO TABLE
;AFTER HEADER ADDRESS IS OKAYED, IT'S TIME TO INTERLOCK THE QUEUE.
$GRABQ: LDB T1,Q.RTRS ;LOAD NUMBER OF RETRIES WE MUST MAKE
AOSN (HA) ;TRY THE INTERLOCK
JRST $GOTIT ;IT'S OURS--GO TEST FOR PRIV'S
SOJL T1,$INTFL ;FAILED--GO SULK IF NO MORE RETRIES
SKIPGE 1(HA) ;TRY AGAIN, BUT SLEEP FIRST?
SLEEP EC, ;YES--ZZZ A JIFFY (EC STILL HAS 0)
JRST $GRABQ+1 ;LOOP BACK TO RETRY INTERLOCK
;AFTER INTERLOCKING QUEUE, CHECK OUT USER'S PRIVILEGES FOR INSTRUCTION.
$GOTIT: MOVSI T1,370000 ;MASK FOR STATUS BYTE LESS QS.SLP
AND T1,1(HA) ;GET THE QUEUE STATUS BITS IN T1
LDB T2,Q.OWNR ;LOAD THE OWNER OF THIS QUEUE
MOVE T3,$QPTAB(OP) ;LOAD PRIVILEGE WORD FOR THIS INSTR.
CAME T2,JN ;ARE WE THE QUEUE OWNER?
SKIPN T2 ;OR IS THERE NO OWNER?
TLOA T1,(QS.OWN) ;YES--SET THE BIT AND SKIP
MOVSS T3 ;NO--DON'T SET BIT AND SWAP PRIV WORD
HLLZS T3 ;ZERO HALF OF PRIV WORD WE DON'T NEED
LSHC T2,6 ;SHIFT "MUST-BE-ON" BITS IN PLACE
LSH T2,^D30 ;SHIFT "MUST-MATCH" BITS IN PLACE
XOR T3,T1 ;MARK ALL BITS THAT DON'T MATCH
AND T2,T3 ;AND ZERO BITS THAT DON'T MATTER
JFFO T2,QE$NPR ;ERROR IF THERE'S ONE OUT OF PLACE
JRST (R) ;OTHERWISE, WE'RE OKAY--RETURN
SUBTTL CENTRAL QUEUE INSTRUCTION PROCESSOR --- EXIT
;ALL INDIVIDUAL QUEUE INSTRUCTION ROUTINES EXIT THROUGH THE FOLLOWING
; CODE. ROUTINES THAT FIND ERRORS BRANCH TO A LABEL OF THE FORM
; QE$XXX, WHERE XXX IS THE ERROR NAME. THESE ERRORS LOAD A SIXBIT
; ERROR CODE OF THE FORM 'QXX' IN THE LEFT HALF OF EC AND THE CODE
; NUMBER IN THE RIGHT HALF. ERRORS DUE TO FULL OR EMPTY QUEUES (OR
; EMPTY READ POSITION) GO DIRECTLY TO $QFAIL, AND THUS LEAVE A ZERO
; IN EC. ALL ERROR RETURNS EXIT THROUGH $QFAIL. SUCCESSFUL RETURNS
; EXIT THROUGH $QGOOD. IN EITHER CASE, THE EXIT PROCEDURE IS TO SETUP
; THE APPROPRIATE RETURN ADDRESS, LOAD THE LUUO AC IN THE ACSAVE BLOCK,
; RELEASE THE QUEUE INTERLOCK, RESTORE THE USER'S ACCUMULATORS, AND
; POSSIBLY UNLOAD A BYTE (ON A QREAD OR QPULL). THE SEQUENCE OF
; EVENTS IN THIS EXIT ROUTINE IS CRUCIAL!
;
QE$NPR: MOVSI EC,'QNP' ;HERE ON NO PRIVILEGES FOR INSTRUCTION
HRRI EC,1(T3) ;LOAD POSITION OF ILLEGAL BIT + 1
JRST $QFAIL ;AND DO ERROR EXIT
IFN .FTQSL,< ;THIS ERROR ONLY IF WE COMPILED LIMITATIONS (MUST BE ON TOP)
QE$QSL: MOVSI EC,'QSL' ;HERE ON SEGMENT LIMITATIONS (ALL)
AOSA EC> ;DROP INTO ERROR COUNT CHAIN
QE$WSQ: MOVSI EC,'QWS' ;HERE ON WRONG SEGMENT QUEUE (QINIT,SPECIALS)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
QE$IRP: MOVSI EC,'QRP' ;HERE ON ILLEGAL READ POSITION (QREAD)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
QE$CSQ: MOVSI EC,'QCS' ;HERE ON CAN'T STEAL QUEUE (QSAVE)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
QE$BJN: MOVSI EC,'QBJ' ;HERE ON BAD JOB NUMBER (QINIT,QREIN,QGIVE)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
QE$CEC: MOVSI EC,'QCE' ;HERE ON CAN'T EXPAND CORE (QINIT,QREIN)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
QE$AOR: MOVSI EC,'QAR' ;HERE ON ARGUMENT OUT OF RANGE (ALMOST ALL)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
;THESE ERRORS MUST NOT ATTEMPT TO CLEAR INTERLOCK!
QE$QIF: MOVSI EC,'QIF' ;HERE ON QUEUE INTERLOCK FAILURE (ALL)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
QE$HWP: MOVSI EC,'QWP' ;HERE ON HIGH SEGMENT WRITE-PROTECTED (ALL)
AOSA EC ;DROP THROUGH ERROR COUNT CHAIN
QE$IHA: MOVSI EC,'QHA' ;HERE ON ILLEGAL HEADER ADDRESS (ALL)
ADDI EC,7 ;START WITH ERROR CODE 7 AFTER NPR'S
$QFAIL: SKIPA CA,EC ;ALL ERRORS--LOAD ERROR INTO USER AC AND SKIP
$QGOOD: AOSA LUODSP ;CAUSE SUCCESSFUL RETURN AND SKIP
JRST .+4 ;DON'T UNLOAD BYTE IF AN ERROR
CAIE OP,<<QREAD>-<QINIT>>_-^D27;IF THIS WAS A "QREAD" INSTRUCTION,
CAIN OP,<<QPULL>-<QINIT>>_-^D27;OR IT WAS A "QPULL" INSTRUCTION,
SKIPA 17,BT ; THEN LOAD BYTE AND USE ADR. @.JBUUO,
SETZM .JBUUO ; ELSE, CLEAR IT OUT TO CANCEL UNLOAD
HRRZS .JBUUO ;ZERO LEFT SO CAN'T BOMB AC 0
MOVEM CA,ACSAVE(AC) ;LOAD UP USER'S LUUO ACCUMULATOR
HRRZS EC ;GET ERROR CODE NUMBER ALONE
IFN .FTQSL,<CAIE EC,20> ;DON'T LET 'QSL' CLEAR INTERLOCK
CAIG EC,11 ;IF ANY ERROR IS ABOVE 'QIF',
CAIGE EC,7 ;OR LOWER THAN 'QHA' (OR NO ERROR),
SETOM (HA) ; THEN IT'S OKAY TO CLEAR INTERLOCK
EXCH 17,ACSAVE+17 ;SAVE BYTE AND RESTORE USER'S AC 17
MOVSI 16,ACSAVE ;TRANSFERRING FROM ACSAVE BLOCK
BLT 16,16 ;RESTORE REST OF USER'S AC'S
IFDEF QOFF,<QOFF> ;SIGNAL THAT WE'RE DONE WITH QUEUE
SKIPN .JBUUO ;IF THERE IS NO BYTE TO BE UNLOADED,
JRSTF @LUODSP ; RETURN TO USER'S PROGRAM NOW
MOVEM F,@.JBUUO ;CHECK FOR ILL.MEM.REF.'S AND SAVE 0
MOVE F,ACSAVE+17 ;LOAD BYTE (SO I LIED--
;THIS IS THE ONLY POINT AT WHICH AC 0 DOES NOT
;CONTAIN ITS ORIGINAL CONTENTS. IT IS RESTORED
;WITH THE NEXT INSTRUCTION. SORRY, FOLKS!)
EXCH F,@.JBUUO ;RESTORE 0 AND UNLOAD THE BYTE
JRSTF @LUODSP ;AND RETURN TO USER'S PROGRAM
SUBTTL QUEUE INSTRUCTION ROUTINES --- QINIT,QREIN,QRSET
;HERE TO INITIALIZE A QUEUE AND ITS HEADER
$QINIT: QSETUP ;DO THE STANDARD SETUP
MOVSI T6,(POINT 6,,11) ;POINTER TO OWNER BYTE
HRRI T6,CA ;BUT IN USER'S AC CONTENTS
LDB T1,T6 ;LOAD OWNER AND SAVE BYTE POINTER
SKIPN T1 ;DID USER GIVE A SPEC?
SKIPA T1,JN ;NO--SET OUR OWN JOB UP
CAMN T1,JN ;DOES USER WANT TO INIT FOR ELSE?
JRST $QINI1 ;NO--JUMP AHEAD
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;IS HEADER ADDRESS IN HIGH SEGMENT?
IFLE .FTQSL,<JRST QE$WSQ> ;NO--CAN'T GIVE AWAY QUEUE
IFGE .FTQSL,<JSP R,$OKJOB ;YES--CHECK OUT REQUESTED JOB
JRST QE$BJN> ;ERROR IF NOT LEGIT
$QINI1: MOVEI T2,7777 ;LOAD MASK FOR QUEUE SIZE
AND T2,CA ;GET REQUESTED QUEUE SIZE
LDB T3,Q.QSIZ ;LOAD DEFAULT/ACTUAL SIZE
SKIPN T2 ;IF REQUESTED SIZE NOT SPECIFIED,
MOVE T2,T3 ; USE DEFAULT/ONLY SIZE FROM HEADER
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;IS THIS TO BE A HISEG QUEUE?
IFLE .FTQSL,<JRST $QINI2> ;NO--PROCEED AHEAD FOR LOWSEG QUEUES
IFGE .FTQSL,<CAME T2,T3 ;YES--CHECK USER'S REQUESTED SIZE
JRST QE$WSQ ;ILLEGAL IF SPECIFIED DIFFERENT SIZE
JRST $HIGHQ> ;OKAY IF SAME OR NOT SPECIFIED
IFLE .FTQSL,< ;NEW QUEUE AND OLD QUEUE CODE ONLY IF LOWSEGS ALLOWED
$QINI2: LDB T4,Q.QADR ;LOAD DATA AREA ADDRESS (ZERO IF NONE)
MOVE T5,.JBFF ;FIND FIRST FREE LOCATION IN LOWSEG
SKIPN T4 ;IF WE DON'T HAVE A DATA AREA ADDRESS,
JRST $NEWQ ; THEN WE'VE GOT TO GET ONE
CAMG T2,T3 ;IF USER DOESN'T WANT A BIGGER QUEUE,
JRST $OLDQ ; THEN USE OLD ONE (WITH NEW SIZE)
ADD T4,T3 ;FIND WHAT .JBFF WAS WHEN QUEUE INIT'ED
CAME T4,T5 ;IS IT STILL THE SAME?
JRST $NEWQ ;NO--CAN'T RECLAIM AREA SO GET ANOTHER
SUB T5,T3 ;YES--PRETEND WE NEVER USED THIS AREA
;(STILL UNDER IFLE .FTQSL CONDITIONAL)
;(STILL UNDER IFLE .FTQSL CONDITIONAL)
$NEWQ: MOVEM T5,T3 ;HERE FOR NEW QUEUE--COPY .JBFF BEFORE
ADD T5,T2 ;ADD IN THE NEW/OLD QUEUE SIZE
MOVEM T5,T4 ;MAKE COPY OF THE NEW (HOPEFUL) .JBFF
CAMG T5,.JBREL ;DO WE NEED MORE CORE?
JRST .+3 ;NO--SKIP IT
CORE T5, ;YES--DO IT
JRST QE$CEC ;ERROR IF CAN'T EXPAND CORE
MOVEM T4,.JBFF ;AND UPDATE THE FIRST FREE POINTER
DPB T3,Q.QADR ;ASSIGN THE NEW DATA AREA ADDRESS
$OLDQ: DPB T2,Q.QSIZ ;USE THIS NEW/OLD QUEUE SIZE
>;END OF IFLE .FTQSL CONDITIONAL
$HIGHQ: DPB T1,T6 ;NOW SET UP THE OWNER BYTE
MOVEI T1,770000 ;SET MASK FOR BYTE SIZE BYTE
AND T1,CA ;LOAD REQUESTED BYTE SIZE
CAIG T1,.QZWRD ;IF USER SAID BIGGER THAN 36,
CAIGE T1,10000 ;OR SMALLER THAN 1 (I.E. ZERO),
MOVEI T1,.QZWRD ; THEN SET US UP FOR FULL WORDS
HLLZ T2,CA ;SAVE LEFT HALF OF USER'S AC
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;IF HEADER ADDRESS IS IN LOWSEG,
IFLE .FTQSL,<TLZ T2,470077> ; CLEAR RETRIES AND IRRELEVANT BITS
LDB CA,Q.QSIZ ;SET AC TO THE QSIZE ALREADY LOADED
HLLM T2,CA ;RESTORE THE LEFT HALF SPECS
IORM T1,CA ;AND DON'T FORGET THE BYTE SIZE BYTE
TLO CA,(QS.INI) ;THIS IS WHAT WE'RE DOING (INI'ING)
MOVEM CA,1(HA) ;NOW PUT ALL THIS IN THE HEADER
CAIA ;AND SKIP CLEVER SUB-ENTRY TO CONTINUE
$QRSET: QSETUP ;HERE ON QRSET--DO SETUP & REST OF INIT
SETZM 2(HA) ;START BYTE POSITIONS FROM GROUND ZERO
LDB T1,Q.BSIZ ;LOAD THE CURRENT SIZE OF BYTES
MOVEI T2,^D36 ;NUMBER OF BITS IN A WORD
IDIV T2,T1 ;FIND NO. OF BYTES PER WORD
LDB T1,Q.QSIZ ;LOAD QUEUE SIZE IN WORDS
IMUL T2,T1 ;CALCULATE THE BYTE CAPACITY OF QUEUE
DPB T2,Q.QCAP ;AND STASH INFO IN QUEUE HEADER
HRLZI CA,(HA) ;LOAD HEADER ADDRESS IN USER AC
JRST $QGOOD ;AND DO THE EXIT ROUTINE
SUBTTL QUEUE INSTRUCTION ROUTINES --- QKILL,QFRZE
;HERE TO TERMINATE USE OF QUEUE (WHETHER RELEASED OR PRESERVED)
$QKILL: QSETUP ;DO OUR SETUP
SETZB T1,2(HA) ;ZERO QUEUE BYTE POSITIONS (AND A TEMP)
DPB T1,Q.QCAP ;ZERO QUEUE CAPACITY INFO
LDB T1,Q.QSIZ ;PRESERVE THE QUEUE SIZE
MOVEM T1,1(HA) ;BUT ZERO REST OF HEADER WORD
AOJN CA,.+4 ;IS THIS A PRESERVED KILL?
DPB JN,Q.OWNR ;YES--RESTORE OUR JOB NUMBER
MOVSI T1,(QS.FRZ) ; --LOAD A FREEZE STATUS BIT
IORM T1,1(HA) ; --AND SET IT IN HEADER
SETZ CA, ;CLEAR USER'S AC
JRST $QGOOD ;DO THE EXIT ROUTINE
;HERE TO FREEZE/UNFREEZE QUEUE
$QFRZE: QSETUP ;DO THE SETUP
MOVE T1,1(HA) ;LOAD SECOND WORD OF HEADER
SKIPN CA ;WHICH ACTION ARE WE DOING?
TLZA T1,(QS.FRZ) ;UNFREEZE--TURN OFF FREEZE BIT
TLOA T1,(QS.FRZ) ;FREEZE--TURN ON FREEZE BIT
SKIPA CA,2(HA) ;UNFREEZE--LOAD TOP BYTE POS. IN RIGHT
TDZA CA,CA ;FREEZE--ZERO USER'S ACCUMULATOR
HRLI CA,(HA) ;UNFREEZE--LOAD HEADER ADR. IN LEFT
MOVEM T1,1(HA) ;RESTORE SECOND HEADER WORD
JRST $QGOOD ;AND OFF TO EXIT ROUTINE
SUBTTL QUEUE INSTRUCTION ROUTINES --- QGIVE (AND $OKJOB)
;HERE TO PASS ON OWNERSHIP OF QUEUE TO ANOTHER JOB
$QGIVE: QSETUP ;FIRST DO SETUP
SKIPE T1,CA ;NEW OWNER SPECIFIED? (LOAD IT)
CAMN T1,JN ;YES--BUT IS IT SOMEONE ELSE?
SKIPA CA,1(HA) ;NO--SET UP TOP BYTE POS. IN RIGHT
JRST .+3 ;JUMP AHEAD TO HANDLE A REAL GIVE
HRLI CA,(HA) ;NO--LOAD HEADER ADDRESS IN LEFT
JRST $QGOOD ;EXIT HERE IF DIDN'T WANT TO GIVE
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;IF HEADER ISN'T IN HISEG,
IFLE .FTQSL,<JRST QE$WSQ> ; THEN DON'T ALLOW GIVE-AWAYS
IFGE .FTQSL,<JUMPL T1,QE$AOR ;IF NEGATIVE JOB, BAD ARG ERROR
JSP R,$OKJOB ;CHECK OUT THE JOB NUMBER
JRST QE$BJN ;ERROR IF SOMETHING WRONG
DPB T1,Q.OWNR ;PUT NEW OWNER SPEC IN HEADER
SETZ CA, ;ZERO USER'S AC
JRST $QGOOD> ;THEN DO EXIT ROUTINE
IFGE .FTQSL,< ;THE FOLLOWING ROUTINE ONLY NEEDED FOR HISEG QUEUES
;SUBROTINE TO CHECK OUT JOB NUMBER IN T1 (RIGHT HALF OF T1 PRESERVED)
$OKJOB: MOVNS T1 ;MAKE JOB NUMBER NEGATIVE
JOBSTS T1, ;GET JOB STATUS WITH JOB IN RIGHT
JRST (R) ;BAD JOB IF ERROR RETURN
TLCE T1,(JB.UJA!JB.ULI) ;WANT TO KNOW IF ASSIGNED & LOGGED IN
TLNN T1,(JB.UML) ;BUT JOB MUST NOT BE AT MONITOR LEVEL
TLCE T1,(JB.UJA!JB.ULI) ;DOES JOB MEET WITH OUR APPROVAL?
JRST (R) ;NO--RETURN BAD JOB
HRLZ T2,T1 ;YES--COPY THE JOB IN LEFT OF T2
HRRI T2,.GTSGN ;PUT SEGMENT TABLE NUMBER IN RIGHT
GETTAB T2, ;GET SEGMENT INFO FOR THE JOB
JRST (R) ;ERROR IF CAN'T (JOB OUT OF RANGE)
JUMPLE T2,(R) ;ERROR IF NO TABLE OR SPYING
HRROI T3,.GTSGN ;THIS TIME FOR OUR JOB
GETTAB T3, ;GET OUR HISEG INFO
JRST (R) ;ERROR IF CAN'T (???)
JUMPLE T3,(R) ;ERROR IF NO TABLE OR SPYING
HRRZS T3 ;GET THE HIGH SEGMENT INDEX ALONE
CAIE T3,(T2) ;DO THE HIGH SEGMENT INDEXES MATCH?
JRST (R) ;NO--BAD JOB IF CAN'T SHARE QUEUE
JRST 1(R) ;YES--THE REQUESTED JOB IS LEGIT
>;END OF IFGE .FTQSL CONDITIONAL
SUBTTL QUEUE INSTRUCTION ROUTINES --- QOTHR,QRTYL
;HERE TO SET PRIVILEGES FOR NON-OWNERS
$QOTHR: QSETUP ;DO THE SETUP STUFF
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;IF HEADER ADDRESS IS IN LOW SEGMENT,
IFLE .FTQSL,<JRST QE$WSQ> ; THEN THIS INSTRUCTION IS ILLEGAL
IFGE .FTQSL,< ;ASSEMBLE THE REAL QOTHR ONLY IF HISEG QUEUES ALLOWED
SKIPL T1,CA ;IF USER SPECIFIED NEGATIVE LEVEL,
CAILE T1,3 ;OR SPECIFIED LEVEL HIGHER THAN THREE,
JRST QE$AOR ; THEN IT'S OUT OF RANGE
MOVE T2,1(HA) ;LOAD SECOND HEADER WORD
SETZ CA, ;ZERO USER'S AC
TLZE T2,(QS.SEN) ;IF QUEUE STATUS-ENABLED FOR OTHERS,
MOVEI CA,1 ; INDICATE PREVIOUS LEVEL WAS 1
TLZE T2,(QS.REN) ;IF QUEUE READ-ENABLED FOR OTHERS,
MOVEI CA,2 ; UP INDICATION TO 2
TLZE T2,(QS.WEN) ;IF QUEUE WRITE-ENABLED FOR OTHERS,
MOVEI CA,3 ; SET IT TO 3
CAIL T1,3 ;IF USER WANTS IT SET WRITE-ENABLED,
TLOA T2,(QS.WEN) ; SET THIS BIT AND THE REST
CAIL T1,2 ;IF USER JUST WANTS IT READ-ENABLED,
TLOA T2,(QS.REN) ; SET READ BIT AND NEXT ONE
CAIL T1,1 ;IF USER ONLY WANTS IT STATUS-ENABLED,
TLO T2,(QS.SEN) ; SET HARMLESS PRIVILEGE ON
MOVEM T2,1(HA) ;RESTORE WORD WITH MODIFIED STATUS
JRST $QGOOD ;AND DO THE EXIT ROUTINE
>;END OF IFGE .FTQSL CONDITIONAL
;HERE TO SET RETRY INFORMATION FOR SHARABLE QUEUES
$QRTYL: QSETUP ;DO THE OL' SETUP
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;IF HEADER ADDRESS IS IN LOWSEG,
IFLE .FTQSL,<JRST QE$WSQ> ; THEN THIS INSTRUCTION HAS NO VALUE
IFGE .FTQSL,< ;DO THE FOLLOWING ROUTINE ONLY FOR HISEG QUEUES
TRNE CA,777700 ;MAKE SURE VALUE FITS IN 6 BITS
JRST QE$AOR ;ERROR IF OUT OF RANGE
LDB T1,Q.RTRS ;LOAD THE CURRENT NUMBER OF RETRIES
DPB CA,Q.RTRS ;SET REQUESTED NUMBER OF RETRIES
MOVE T2,1(HA) ;LOAD THE WHOLE HEADER WORD
TLZE T2,(QS.SLP) ;IF SLEEP-BEFORE-RETRIES BIT SET,
TLO T1,(QS.SLP) ; THEN SHOW IT IN OUR REPLY
TLNE CA,(QS.SLP) ;IF USER WANTS IT ON NOW,
TLO T2,(QS.SLP) ; THEN SET IT IN HEADER WORD
MOVEM T2,1(HA) ;PUT THE WORD BACK IN HEADER
MOVEM T1,CA ;STASH PREVIOUS INFO FOR USER
JRST $QGOOD ;AND DO THE EXIT ROUTINE
>;END OF IFGE .FTQSL CONDITIONAL
SUBTTL QUEUE INSTRUCTION ROUTINES --- QSAVE (AND $INTFL)
;HERE TO SAVE A SEEMINGLY DEAD QUEUE
$QSAVE: QSETUP ;DO SETUP BUT MAY NEVER RETURN
AOJE CA,$QGOOD ;IF JUST TO BREAK INTERLOCK, GO DO IT
SOJN CA,QE$AOR ;BUT IF NOT 0 OR -1, THEN ILLEGAL ARG
LDB T1,Q.OWNR ;WANTS TO STEAL QUEUE--WHO'S GOT IT?
CAMN T1,JN ;IF WE DO,
JRST $QGOOD ; THEN BIG DEAL, LEAVE CA AT ZERO
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;IF HEADER IS NOT SHARABLE,
IFLE .FTQSL,<JRST $STEAL> ; THEN ALWAYS LET US STEAL IT
IFGE .FTQSL,<JSP R,$OKJOB ;OTHERWISE, CHECK OUT SUPPOSED OWNER
JRST $STEAL ;NO GO--LET US TAKE IT AWAY
JRST QE$CSQ> ;HE'S OKAY--LET HIM KEEP IT
$STEAL: LDB CA,Q.OWNR ;HERE TO STEAL QUEUE--LOAD PREV. OWNER
DPB JN,Q.OWNR ;PUT OUR JOB IN PLACE OF OLD OWNER
JRST $QGOOD ;AND DO SUCCESSFUL EXIT ROUTINE
;HERE ON INTERLOCK FAILURES FROM $QMAIN
$INTFL: CAIE OP,<<QSAVE>-<QINIT>>_-^D27;IS THIS A QSAVE INSTRUCTION?
JRST QE$QIF ;NO--INTERLOCK FAILURE IS A FAILURE
AOSE T1,CA ;YES--BUT WAS INT. BREAK REQUESTED?
SOJA CA,QE$QIF ;NO--REPAIR CA AND BRANCH TO ERROR
IFE .FTQSL,<CAIGE HA,.JBHGH+.JBHDA> ;YES--BUT IS QUEUE SHARABLE?
IFLE .FTQSL,<JRST $QGOOD> ;NO--SO ALWAYS BREAK INTERLOCK NOW
IFGE .FTQSL,<MOVEI T2,1 ;YES--RETRY BETWEEN 1-SEC. INTERVALS
MOVEI T3,.QPRBB ;NUMBER OF RETRIES BEFORE BREAKING
$AGAIN: SLEEP T2, ;TAKE A NAP BEFORE TESTING INTERLOCK
AOSN T4,(HA) ;TRY INTERLOCK WHILE LOADING IT IN T4
JRST $QGOOD ;WE MADE IT! DO EXIT STUFF
CAMG T4,T1 ;HAS IT BEEN RESET IN MEANTIME?
SOJA CA,QE$QIF ;YES--RESTORE CA AND DO THE ERROR
MOVEM T4,T1 ;NO--STORE NEW INTERLOCK LEVEL
SOJG T3,$AGAIN ;COUNT AND TRY AGAIN IF NOT DONE
JRST $QGOOD> ;HERE IF TRIED ENOUGH TIMES,
; BREAK INTERLOCK IN EXIT ROUTINE
SUBTTL QUEUE INSTRUCTION ROUTINES --- QSTAT,QWHRE
;HERE TO CHECK ANY INFORMATION CONTAINED IN HEADER
$QSTAT: QSETUP ;DO THE NORMAL SETUP
JUMPG CA,$STATB ;GO LOAD POSITIVE BYTE NUMBER
JUMPL CA,$STATW ;GO LOAD NEGATIVE WORD NUMBER
LDB CA,Q.TPOS ;PUT TOP BYTE POSITION IN USER'S AC
LDB T1,Q.BPOS ;LOAD BOTTOM BYTE POSITION
SUBM T1,CA ;FIND NUMBER OF BYTES USED IN QUEUE
JUMPGE CA,$QGOOD ;DONE IF THEY'RE NOT BACKWARDS
LDB T1,Q.QCAP ;OTHERWISE, THERE IS A WRAP-AROUND
ADDM T1,CA ;SO ADD IN THE QUEUE BYTE CAPACITY
JRST $QGOOD ;AND DO EXIT ROUTINE
$STATB: CAILE CA,.QLBPT ;HERE TO LOAD A HEADER BYTE
JRST QE$AOR ;ERROR IF WE DON'T HAVE SO MANY
LDB CA,$QBTAB-1(CA) ;LOAD IN THE REQUESTED BYTE
JRST $QGOOD ;AND OFF TO EXIT ROUTINE
$STATW: SETCM T1,CA ;HERE TO LOAD A HEADER WORD
CAIL T1,.QLHDR ;TEST WORD OFFSET FROM TOP OF HDR.
JRST QE$AOR ;ERROR IF HEADER DOESN'T HAVE SO MANY
ADDI T1,(HA) ;FIND ADDRESS OF REQUESTED WORD
MOVE CA,(T1) ;LOAD IN THE REQUESTED WORD
JRST $QGOOD ;AND DO THE EXIT ROUTINE
;HERE TO SET UP AC WITH HEADER ADDRESS AND BYTE POSITION
$QWHRE: QSETUP ;DO THE SETUP ROUTINE
SKIPE CA ;DOES USER WANT TOP OR BOTTOM?
SKIPA CA,2(HA) ;TOP--LOAD BYTE POS. WORD AND SKIP
LDB CA,Q.BPOS ;BOTTOM--LOAD BOTTOM BYTE POSITION
HRLI CA,(HA) ;PUT HEADER ADDRESS IN LEFT HALF
JRST $QGOOD ;AND GO DO EXIT ROUTINE
SUBTTL QUEUE INSTRUCTION ROUTINES --- QREAD (AND $POINT)
;HERE TO READ QUEUE WITHOUT PULLING OUT BYTES
$QREAD: QSETUP ;DO THE SETTING UP
HRRZ T1,CA ;LOAD USER'S LAST-BYTE-POSITION
LDB T2,Q.QCAP ;LOAD THE QUEUE BYTE CAPACITY
CAMLE T1,T2 ;IF USER'S IS TOO BIG,
JRST QE$IRP ; THEN LET HIM KNOW
LDB T3,Q.TPOS ;LOAD FRONT BYTE POSITION
LDB T4,Q.BPOS ;LOAD BACK BYTE POSITION
CAML T3,T4 ;IF NO WRAP-AROUND,
JRST .+6 ; JUST CHECK IN NORMAL RANGE
CAML T1,T4 ;OTHERWISE, WHERE DOES USER FIT IN?
JRST .+3 ;HE'S OVER THE BOTTOM--JUMP AHEAD
SUB T4,T2 ;HE'S UNDER--SHIFT DOWN TO CIRCLE HIM
JRST .+2 ;AND SKIP THE OTHER SHIFT
ADD T3,T2 ;HE'S OVER--SHIFT UP TO CIRCLE HIM
CAMGE T1,T3 ;IF USER IS NOT BEHIND FRONT POS.,
CAMGE T1,T4 ;OF IF HE'S IN BACK OF BACK POS.,
JRST $QFAIL ; THEN HE'S NOT WHERE THERE'S DATA
AOS T1 ;INCREMENT USER'S READ POSITION
CAMLE T1,T2 ;IF WE PUT IT OVER THE TOP,
MOVEI T1,1 ; THEN GET IT AT THE BOTTOM
JSP R,$POINT ;MAKE BYTE POINTER IN T3 (UPDATE CA)
LDB BT,T3 ;LOAD A QUEUE BYTE FOR EXIT ROUTINE
JRST $QGOOD ;AND DO IT
;SUBROUTINE TO MAKE A BYTE POINTER IN T3 FOR THE Q.B.POS. IN T1 (NOT PRESERVED)
$POINT: HRRM T1,CA ;FIRST PUT NEW POSITION IN USER'S AC
LDB T3,Q.BSIZ ;LOAD THE QUEUE BYTE SIZE
MOVEI T4,^D36 ;LOAD NUMBER OF BITS PER WORD
IDIV T4,T3 ;FIND BYTES PER WORD (BOMB T5)
SOS T1 ;DECREMENT SO LAST BYTE STAYS IN WORD
IDIV T1,T4 ;WORD OFFSET IN T1 & BYTE POS. IN T2
AOS T2 ;ADJUST FOR PROPER POSITION IN WORD
IMUL T2,T3 ;FIND POS. IN BITS FROM LEFT END
MOVNS T2 ;SUBTRACT FROM 36 TO FIND THE
ADDI T2,^D36 ; POS. IN BITS REMAINING AT RIGHT
LSH T3,^D30 ;SHIFT SIZE INTO BITS 0-5
LSHC T2,-6 ;SHIFT POS./SIZE INTO BITS 0-11 OF T3
LDB T4,Q.QADR ;PICK UP ADDRESS OF QUEUE DATA AREA
ADD T4,T1 ;ADD IN OFFSET FROM THE DIVISION
HRR T3,T4 ;PUT ADDRESS IN BYTE POINTER
JRST (R) ;AND RETURN
SUBTTL QUEUE INSTRUCTION ROUTINES --- QPULL,QPUSH,QPUSHI
;HERE TO PULL A BYTE OFF BOTTOM OF QUEUE
$QPULL: QSETUP ;DO THE SETUP ROUTINE
LDB T1,Q.BPOS ;LOAD BOTTOM BYTE POSITION
LDB T2,Q.TPOS ;LOAD TOP BYTE POSITION
CAMN T1,T2 ;IF POSITIONS ARE EQUAL,
JRST $QFAIL ; THEN THE QUEUE IS EMPTY
LDB T3,Q.QCAP ;LOAD THE QUEUE BYTE CAPACITY
AOS T1 ;INCREMENT THE BOTTOM POSITION
CAMLE T1,T3 ;BUT IF WE PUT IT OVER,
MOVEI T1,1 ; WRAP AROUND TO THE BOTTOM
DPB T1,Q.BPOS ;PUT NEW POSITION IN HEADER
JSP R,$POINT ;MAKE BYTE POINTER IN T3 (UPDATE CA)
LDB BT,T3 ;USE IT TO LOAD THE PULLED BYTE
JRST $QGOOD ;AND LET THE EXIT ROUTINE DO REST
;HERE TO PUSH A BYTE ON TOP OF QUEUE
$QPUSH: CAM @.JBUUO ;"QPUSH" ENTRY--CHECK FOR ILL.MEM.REF.'S NOW
QSETUP ;"QPUSHI" ENTRY--JUST DO THE SETUP ROUTINE
MOVEI BT,(EF) ;PICK UP LOCATION OF BYTE TO PUSH
CAIN OP,<<QPUSHI>-<QINIT>>_-^D27;IS THIS A PUSH-IMMEDIATE INSTR.?
JRST .+4 ;YES--THEN WE JUST WANT THE WORD 0,,E
CAIGE EF,20 ;NO--DOES USER WANT WHAT'S IN AN AC?
SKIPA BT,ACSAVE(BT) ;YES--LOAD THE WORD FROM ACSAVE BLOCK
MOVE BT,(BT) ;NO--JUST GET A WORD FROM ANYWHERE
LDB T1,Q.TPOS ;LOAD THE TOP BYTE POSITION
LDB T2,Q.QCAP ;LOAD THE QUEUE BYTE CAPACITY
LDB T3,Q.BPOS ;LOAD THE BOTTOM BYTE POSITION
AOS T1 ;GET NEXT PUSH POSITION
CAMG T1,T2 ;DID WE GO OFF THE TOP?
JRST .+3 ;NO--JUST CHECK AGAINST PULL POS.
JUMPE T3,$QFAIL ;YES--QUEUE FULL IF HAVEN'T PULLED
MOVEI T1,1 ;AND WRAP AROUND TO THE BOTTOM
CAMN T1,T3 ;IF WE JUST SET TO LAST BYTE PULLED,
JRST $QFAIL ; THEN QUEUE IS FULL--ERROR
DPB T1,Q.TPOS ;PUT NEW POSITION IN HEADER
JSP R,$POINT ;MAKE BYTE POINTER IN T3 (UPDATE CA)
DPB BT,T3 ;PUT THE NEW BYTE IN QUEUE
JRST $QGOOD ;AND, FINALLY, DO THE OL' EXIT ROUTINE
XPUNGE ;SO UNIVERSAL FILE ISN'T CLUTTERED
END