.TITLE *** SYSTEM TASK DISPATCHER ***
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
	.TITLE *** EDIT LEGEND ***
/ 001	18-MAR-76 (RCHM)	MOVE THE CPB FROM THE UCA INTO	/(001)
/				INTO CALBLK FOR EXECUTION.	/(001)
/ 002	19-MAR-76 (RCHM)	MAKE SURE ONLY BATCH CAN ISSUE	/(002)
/				REQUESTS FOR JOB... AND END...	/(002)
/ 003	22-MAR-76 (RCHM)	GENERATE CODE FOR TIME LOST IN	/(003)
/				WAIT QUE.			/(003)
/ 004	22-MAR-76 (RCHM)	COUNT JOBS REQUESTED.		/(004)
/ 005	27-MAR-76 (RCHM)	USE STANDARD I/O FROM OVERLAY	/(005)
/				MECHANISM. USE CAL INDEXED TO	/(005)
/				REQUEST TASK. PLUS OTHER MISC	/(005)
/				CHANGES TO MAKE THIS CODE MATCH	/(005)
/				THE FUNCTIONAL SPECIFICATIONS.	/(005)
/ 006	15-APR-76 (RCHM)	FIX THE NAMED PARTITION CODE.	/(006)
/ 007	20-APR-76 (RCHM)	FIX SEVERAL THINGS.		/(007)
/				1. INCORRECT CHECK FOR BATCH	/(007)
/				   DEVICE.			/(007)
/				2. ENABLE REM... IF REM DESIRED	/(007)
/				3. REMOVE TDV@@@ EXCLUSION CODE	/(007)
/				   FROM FIT ROUTINE.		/(007)
/ 008	25-APR-76 (RCHM)	IF A PARTITION FIT ERROR OCCURS	/(008)
/				RESET THE PARTITION SELECTION	/(008)
/				CRITERIA.			/(008)
/ 009	27-APR-76 (RCHM)	REQUEST ODT AT PRIORITY 269	/(009)
/ 010	18-MAY-76 (RCHM)	CHECK FOR EXEC MODE TADK FIXED	/(010)
/				IN CORE BEFORE GIVING ERROR	/(010)
/				MESSAGE.			/(010)
/ 011	15-JUL-76 (RCHM)	MAKE -1 DEFAULT VALUE FOR U.SSM	/(011)
/								/(012)
/ 012	30-JUL-76 (EAG)		INSERT FLAG BIT SO THAT BATCH	/(012)
/				WILL IGNORE PARTITION(S) BUSY	/(012)
/				MESSAGE.			/(012)
/								/(013)
/ 013	12-AUG-76 (EAG)		INSERT CODE TO REMOVE TRAILING	/(013)
/				BLANKS FROM THE INPUT LINE.	/(013)
/				ALSO, DELETE EDIT #002, AS	/(013)
/				THERE IS NO NEED TO PREVENT	/(013)
/				USERS FROM INVOKING JOB...	/(013)
/				OR END...			/(013)
/
/
	.TITLE *** MACROS FOR SYSTEM DISPATCHER ***
 
	.GLOBL MA.NJB	/ COUNTER FOR TOTAL NUMBER OF JOBS.	/(004)
	.GLOBL TS.CTR	/ POINTER TO TASK COUNTING ROUTINE.
	.GLOBL TDVTYP	/ POINTER TO THE OVERLAY TERMINAL I/O	/(005)
			/ PROCESSOR.				/(005)
 
	.DEFIN TEXT,STR
P.ERC=0
	.DEFIN TEXT,A,?B
P.ERC=P.ERC-1
	B-.*400&777000+2
	P.ERC
	.ASCII :A:<15>
B=.
	.ENDM
	TEXT <STR>
	.ENDM
 
/ MACRO TO RETURN INCREMENTAL RETURN CODE. IF THE RETURN IS AN ERROR
/ THEN THE ARGUMENT TO THE MACRO MUST BE A "-" OTHERWISE IT MUST
/ BE A "+". THIS MACRO MUST BE READ AT BOTH PASS1 AND PASS2 TO WORK
/ PROPERLY.
 
	.DEFIN POSTEV,A
RT.CTR=0
	.DEFIN POSTEV,AA
RT.CTR=RT.CTR+1		/ INCREMENT RETURN COUNTER.
	LAC (AA@RT.CTR)	/ FETCH + OR - RETURN CODE.
	DAC U.OEV,X	/ POST OVERLAY EVENT VARIABLE.
	.ENDM
	POSTEV A
	.ENDM
/
/ MACRO TO DEFINE OFFSETS INTO THE USER CONTEXT AREA.
/
	.DEFIN UCAOFF
U.JSW=0				/OFFSET TO JOB STATUS WORD.
U.MAEV=1			/OFFSET TO EVENT VARIABLE
U.MAMTE=2			/OFFSET TO MARK TIME EVENT VARIABLE.
U.OEV=3				/OFFSET TO OVERLAY EVENT VARIABLE.
U.DSK=4				/OFFSET TO DISK NAME
U.DUN=5				/OFFSET TO DISK UNIT NUMBER
U.UFD=6				/OFFSET TO UFD NAME.
U.CTSK=7			/OFFSET TO CURRENT TASK NAME
U.PSC=11			/OFFSET TO PARTITION SELECTION CRITERIA.
U.ULOF=14			/OFFSET TO USER NUMBER AND LUN OFFSET.
U.TTYN=15			/OFFSET TO USER TERMINAL NUMBER.
U.TB=16				/OFFSET TO USER TERMINAL BUFFER.
U.CPB=62			/OFFSET TO MULTI-ACCESS CPB.
U.SSM=74			/SECONDS SINCE MIDNIGHT INTO STATE 11
				/ OR 12 (HUNG ON PARTITION)
U.TW=75				/TOTAL TIME IN SECONDS SPENT IN STATE 11
				/ OR 12.
U.OVID=76			/OVERLAY IDENTIFIER (LAST OVERLAY CALLED)
U.CKS=77			/CHECKSUM OF INPUT BUFFER FOR TIMED READ.
U.LEN=100			/LENGTH OF UCA.
	.DEFIN UCAOFF
	.ENDM
	.ENDM
/
/ MACRO WHICH DEFINES SYSTEM TASK LIST ENTRIES
/ THIS ALSO DEFINES ALL BITS FOR EACH FLAG WORD.
/
	.DEFIN STLOFF
S.FP=0			/FORWARD LINKAGE.
S.BP=1				/BACKWARD LINKAGE.
S.N1=2				/TASK NAME
S.N2=3				/TASK NAME
S.DP=4				/FLAGS AND DEFAULT PRIORITY.
S.PB=5				/PARTITION BLOCK ADDRESS
S.DA=6				/DISK ADDRESS AND UNIT.
S.DB=7				/RESIDENT CODE LENGTH (DISK TRANSFER)
S.TS=10				/TASK SIZE.
S.EP=11				/TASK ENTRY POINT.
/
/ DEFINE S.DP BIT EXTRACTION MASKS.
/
S.ETA=400000			/EXTRACT TASK ACTIVE
S.EROX=200000			/EXTRACT REMOVE ON EXIT.
S.ETDI=100000			/EXTRACT TASK DISABLED.
S.EFIX=40000			/EXTRACT TASK FIXED IN CORE.
S.EPLC=20000			/EXTRACT PARTITION LOST IN RECONFIG.
S.ERCP=10000			/EXTRACT RECONFIGURATION IN PROGRESS.
S.ETEX=4000			/EXTRACT TASK HAS EXITTED.
S.EDP=1777			/EXTRACT DEFAULT PRIORITY.
/
/ DEFINE S.TS BIT EXTRACTION MASKS.
/
S.ETS=777400			/EXTRACT TASK SIZE.
S.ERD=200			/EXTRACT RELOCATE DISABLE.
S.EXM=140			/EXTRACT XVM MODE.
S.EIOT=20			/EXTRACT IOT PERMISSION.
/
/ DEFINE S.EP BIT EXTRACTION MASKS.
/
S.ELC=400000			/EXTRACT LINK CONTENTS.
S.EPB=200000			/EXTRACT PAGE/BANK INDICATOR.
S.EEN=100000			/EXTRACT EXEC/NORMAL MODE.
S.EEP=77777			/EXTRACT ENTRY POINT ADDRESS.
	.DEFIN STLOFF
	.ENDM
	.ENDM
	.TITLE *** EQUATES FOR SYSTEM DISPATCHER ***
 
P.TDV=240426
P.NAME=2
P.MINS=1
	STLOFF
	UCAOFF
P.N1=2
P.N2=3
P.SZ=5
P.FW=10
P.TC=47
X10=10
X11=11
SSM=160			/ OFFSET TO SECONDS SINCE MIDNIGHT.	/(003)
P.PBDL=250
RPL=705512
.INH=705522
.ENB=705521
ECLA=641000
CALX=010000		/ INDEXED CAL TO AVOID MACR15 PROBLEMS.	/(005)
P.ERIP=4
P.LVL5=400004
SNAM=123
NADD=107
NDEL=112
PENP=115
POOL=240
STKL=242
R1=101
R2=102
OVID=233104
USR=252322
...=565656
REM=220515		/ "REM" IN SIXBIT.			/(007)
ODT=170424		/ "ODT" IN SIXBIT.			/(009)
	.TITLE *** VARIABLES AND STORAGE FOR PARTITION FITTING ***
 
P.POOL	.BLOCK 2*22	/ 18 (10) MAXIMUM PARTITONS ASSUMED.
P.TMP1	0
P.TMP2	0
P.TMP3	0
P.TMP4	0
P.TSKS	0		/ TASK SIZE (2'S COMPLEMENT)
P.ADJ	0
P.XUCA	0
P.AUCA	0
P.STL	0
SY.NSTL	0		/ POINTER TO NEW STL NODE.
SY.OSTL	0		/ POINTER TO OLD STL NODE.
SY.ERR	0		/ ERROR CODE FOR HANDLING EXEC LATER.
TTYN	0		/ TTY NUMBER IN CASE OF MESSAGE PRING.	/(005)
DIS1	21		/ DISABLE ...REM
	0
	.SIXBT "...REM"
 
DIS2	21		/ DISABLE REM...
	0
	.SIXBT "REM..."
 
ENA1	22		/ ENABLE ...REM
	0
	.SIXBT "...REM"
 
ENA2	22		/ ENABLE REM...
	0
	.SIXBT "REM..."
 
P.ER10	TEXT <CAN'T RUN -- EXEC MODE TASK IS ALREADY ACTIVE>
P.ER20	TEXT <CAN'T RUN -- TASK DISABLED>
P.ER30	TEXT <CAN'T RUN -- EXEC MODE TASK'S PARTITION :
	.ASCII :LOST IN RECONFIGURATION>
P.ER40	TEXT <CAN'T RUN -- EXEC MODE PARTITIONS UNDERGOING RECONFIGURATION>
P.ER50	TEXT <CAN'T RUN -- PARTITION IS TOO SMALL>		/(005)
P.ER60	TEXT <CAN'T RUN -- PARTITION IS NO LONGER IN SYSTEM>	/(005)
P.ER70	TEXT <CAN'T RUN -- NO PARTITION IS BIG ENOUGH FOR TASK>
P.ER80	TEXT <CAN'T RUN -- EXEC MODE TASK'S PARTITION IS BUSY>
MESS1	TEXT <TDV BAD FUNCTION>
MESS2	MS2END-.*400&377000+400002	/ THIS MESSAGE IGNORED	/(012)
	0				/ BY BATCH.		/(012)
	.ASCII :PARTITION(S) BUSY:<015>				/(012)
MS2END=.							/(012)
								/(012)
	.GLOBL SYDISP	/ ENTRY POINT TO SYSTEM TASK DISPATCHER.
	.TITLE *** CODE OF SYSTEM TASK DISPATCHER ***
 
SYDISP	XX		/ ENTRY POINT.
	DAC P.AUCA	/ SAVE THE ABSOLUTE ADDRESS OF THE UCA.
	CAL DIS1	/ DISABLE ...REM
	CAL DIS2	/ DISABLE REM...
	LAC (.)		/ CALCULATE THE
	AND (70000)	/ INDEX MODE
	CMA!IAC		/ FUDGE FACTOR
	DAC P.ADJ	/ AND SAVE IT.
	TAD P.AUCA	/ CALCULATE THE INDEXING FACTOR TO THE UCA.
	DAC P.XUCA	/ SAVE THE UCA INDEXING VALUE.
	PAX		/ SET UP TO INDEX INTO THE UCA.
	LAC (OVID)	/ FETCH OVERLAY ID.
	DAC U.OVID,X	/ IDENTIFY THE OVERLAY IN THE UCA.
	LAC (...)	/ FETCH "..." IN SIXBIT.
	DAC U.CTSK+1,X	/ SET UP TASK NAME FOR SNAM.
	LAC U.TTYN,X	/ FETCH TERMINAL NUMBER FOR CALL TO 	/(005)
	DAC TTYN	/ TDVTYP.				/(005)
	LAC (ODT)	/ CHECK IF TASK IS ODT.			/(013)
	SAD U.CTSK,X	/ SKIP IF IT ISN'T.			/(013)
	AAC -1		/ SET PRIORITY TO 279 FOR ODT,		/(013)
	.DEC		/ OR TO 280 FOR ALL OTHER TASKS.	/(013)
	TAD (280-ODT)						/(013)
	.OCT							/(013)
	DAC U.CPB+5,X	/ PRIORITY WORD OF REQ MAPPED CPB.	/(009)
	LAC U.CTSK,X	/ REFETCH TASK NAME.			/(013)
	SAD (REM)	/ REMOVE (REM...) DESIRED?		/(007)
	CAL ENA2	/ YES, ENABLE REMOVE FOR FIT LOGIC.	/(007)
	JMS RMVBLK	/ REMOVE ANY TRAILING BLANKS FROM THE	/(013)
			/ INPUT LINE.				/(013)
	LAC P.AUCA	/ FETCH ABSOLUTE BEGINNING OF UCA.	/(009)
	AAC U.CTSK	/ FIGURE OUT WHER NAME DOUBLE WORD SITS.
	DAC* (R2)	/ SET UP FOR SNAM ON NAME.
	LAC (STKL)	/ FETCH LIST HEAD ADDRESS.
	DAC* (R1)	/ SET UP FOR SNAM ON NAME.
	JMS* (SNAM)	/ SCAN STL FOR SPECIFIED NAME.
	JMP SY.060	/ TASK NAMED IS NOT IN STL.
 
/ A TASK OF THE NAME "???..." HAS BEEN LOCATED AND IT'S NODE ADDRESS
/ IS IN THE AC. PREPARE A COPY OF THE STL NODE FOR ADDITION TO THE
/ STL.
 
	DAC SY.OSTL	/ SAVE ORIGIONAL NODE ADDRESS
	SKP		/ AVOID WAIT FOR SIGNIFICANT EVENT.
SY.001	CAL (5)		/ WAIT FOR SIGNIFICANT EVENT IN CASE POOL IS
	JMS* (PENP)	/ EMPTY. PICK A NODE FROM THE FREE LIST.
	JMP SY.001	/ ANY NODES? IF NOT WAIT A BIT AND TRY AGAIN.
 
/ WE HAVE A NODE ADDRESS IN THE AC. COPY THE OLD NODE TO THE NEW NODE.
 
	DAC SY.NSTL	/ SAVE NEW NODE ADDRESS FOR LOTS OF PEOPLE.
	IAC		/ SET UP POINTER TO RECEIVE OLD DATA.
	DAC* (X11)	/ AR11 WILL FILL NODE.
	LAC SY.OSTL	/ FETCH OLD STL NODE ADDRESS.
	IAC		/ SET UP SOURCE POINTER.
	DAC* (X10)	/ X10 WILL FETCH THE OLD DATA.
	LAW -10		/ TRANSFER ONLY 10 (8) WORDS.
	DAC P.TMP1	/ USE P.FIT TEMPORARY, HE WON'T MIND.
SY.002	LAC* X10	/ FETCH SOURCE AND
	DAC* X11	/ STORE IN DESTINATION
	ISZ P.TMP1	/ DONE WITH LOOP YET?
	JMP SY.0020	/ NO.
 
/ WE NOW HAVE A COPY OF THE ORIGIONAL STL NODE IN THE NEW NODE WE
/ GOT FROM THE POOL. WE WILL NOW PERFORM A PARTITION FIT ON THE NEW
/ NODE.
 
	ISZ SY.ERR	/ SET ERROR CODE NON ZERO (NO ERROR)
	JMS P.FIT	/ CALL PARTITION FITTING ROUTINE.
	LAC SY.NSTL	/ PASS P.FIT THE STL ADDRESS.
	JMP SY.003	//NORMAL EXIT AT API LEVEL 5.
	DAC SY.ERR	/ SAVE ERROR CODE IN CASE IT'S 0.
	SMA!CLL		/ TERMINAL ERROR? SET UP NORMAL MODE TASK INDICATOR IN LINK
	JMP SY.003	/ NO.
	LAC (POOL)	/ RETURN
	DAC* (R1)	/ THE NODE
	LAC SY.NSTL	/ TO THE
	DAC* (R2)	/ POOL.
	JMS* (NADD)	/ NODE IS NOW ON FREE LIST.
	CAL ENA1	/ ENABLE ...REM
	CAL ENA2	/ ENABLE REM...
	LAC P.XUCA	/ FETCH INDEXING TO UCA.
	PAX		/ SET UP TO ACCESS UCA.
	LAC (6)		/ SET UP A NEW READ ON RETURN TO POLLER.
	DAC U.JSW,X	/ UCA HAS NEW STATUS CODE.
	POSTEV -	/ RETURN NEGATIVE OVERLAY EVENT VARIABLE.
								/(008)
	LAC U.PSC,X	/ RESET THE PARTITION SELECTION STURR?	/(008)
	SPA		/ AC >=0 IF YES.			/(008)
	JMP* SYDISP	/ NO, RETURN TO CALLER.			/(008)
	DZM U.PSC,X	/ YES, SET PSC TO SYSTEM DEFAULT.	/(008)
	LAC (1400)	/ DEFAULT DELTA.			/(008)
	DAC U.PSC+1,X						/(008)
	JMP* SYDISP	/ RETURN TO POLLER.
 
/ EITHER A PARTITION WAS FOUND WHICH IS IDLE AND CAN RUN THE TASK
/ OR NO IDLE PARTITION WAS AVAILABLE. SY.ERR DEFINES THE CASE. BUILD
/ A MAPPED REQUEST FOR THE TASK AND EXECUTE IT IF POSSIBLE.
 
SY.003	LAC P.XUCA	//SET UP TO ACCESS THE UCA.
	PAX		//
	LAC SY.NSTL	//PREPARE TO MODIFY THE NAME OF THE TASK
	IAC		//
	DAC* (X11)	//SET UP OUTPUT AR.
	LAC U.CTSK,X	//FETCH TASK NAME.
	SNL		//IS THIS AN EXEC MODE TASK?
	LAC (USR)	//NO, FETCH THE NAME "USR"
	DAC* X11	//ALTER PART 1 OF THE TASK NAME IN THE STL NODE.
	DAC U.CPB+3,X	//STORE PART 1 OF THE NAME IN THE REQUEST CPB.
	LAC (10)	//FETCH EXECUTING EXEC MODE TASK JOB STATUS.
	SNL!CLL		//IS THIS AN EXEC MODE TASK?
	AAC -3		//NO, SET TO EXECUTING A SYSTEM TASK.
	DAC U.JSW,X	//JOB STATUS NOW SET UP PROPERLY.
 
/ CONSTRUCT .NN FOR THE SECOND PART OF THE USER TASK NAME WHERE NN IS
/ THE 6 BIT EQUIVALENT OF THE USER TERMINAL NUMBER.
 
	LAC U.TTYN,X	//FETCH TERMINAL NUMBER.
	LRS 3		//SHIFT TERMINAL NUMBER INTO MQ.
	ALS 3		//MAKE ROOM FOR DIGIT MASK.
	LLS 3		//SHIFT OUT LOW DIGIT OF TTYN.
	XOR (566060)	//SET UP . AND DIGIT MASKS FOR LAST HALF OF NAME
	DAC* X11	//SET UP STL NODE WITH LAST HALF OF NAME.
	DAC U.CPB+4,X	//SET UP LAST HALF OF NAME IN REQUEST CPB.
 
/ THE STL NODE IS NOW ALL SET UP WITH THE NEW NAME UNDER WHICH THE
/ USER'S TASK WILL EXECUTE. STICK THE NEW STL NODE ONTO THE STL.
 
	LAC SY.NSTL	//FETCH STL NODE ADDRESS.
	DAC* (R2)	//SET UP R2 FOR NADD.
	DAC U.CPB,X	//SET UP STL NODE ADDRESS IN CASE OF ERROR.
	LAC (STKL)	//FETCH STL LIST HEAD ADDRESS.
	DAC* (R1)	//SET UP R1 FOR NADD
	JMS* (NADD)	//ADD NEW STL NODE TO STL.
 
/ BUILD THE REST OF THE MAPPED REQUEST CAL AND ISSUE IT IF POSSIBLE.
 
	LAC P.XUCA	//FETCH INDEXING POINTER TO THE UCA.
	PAX		//
	LAC (36)	//FETCH MAPPED REQUEST CAL CODE.
	DAC U.CPB+1,X	//STORE IT IN THE UCA.
	LAC P.AUCA	//CALCULATE AN EVENT VARIABLE ADDRESS.
	AAC U.MAEV	//USE THE UCA USER'S EVENT VARIABLE.
	DAC U.CPB+2,X	//STORE EV ADDRESS IN CPB.
	LAC U.ULOF,X	//FETCH LUN OFFSET AND USER NUMBER.
	DAC U.CPB+6,X	//LAST WORD IN CPB NOW SET UP.
 
/ THE MAPPED REQUEST CAL PARAMETER BLOCK IS SET UP, THE NEW STL
/ NODE IS ON THE STL. THE ONLY THING PREVENTING US FROM DOING ANYTHING
/ IS THE POSSIBILITY OF NO FREE PARTITIONS.
 
	LAC SY.ERR	//ARE THERE ANY FREE PARTITIONS?
	SNA!CLA!CMA	//YES, GO ISSUE REQUEST.		/(011)
	JMP SY.004	//NO, RESET JOB STATUS AND CONTINUE.
	DAC U.SSM,X	//CLEAR SECONDS SINCE MIDNIGHT CTR.	/(011)
	DBK		//LOWER TO TASK LEVEL.
	CALX U.CPB+1	///EXECUTE CONSTRUCTED CAL.		/(005)
	ISZ* MA.NJB	/ COUNT JOB JUST REQUESTED.		/(004)
	CAL ENA1	/ ENABLE REM...
	CAL ENA2	/ ENABLE ...REM
	LAC P.XUCA	/ NOW WE CHECK THAT THE CAL GOT ISSUED PROPERLY.
	PAX		/ SET UP FOR UCA ACCESS.
	LAC U.MAEV,X	/ IS EVERYTHING OK?
	SMA		/ AC < 0 IF NOT.
	JMP SY.005	/ TAKE NORMAL RETURN.
	JMS T.TERR	/ PRINT ERROR MESSAGE.
	LAC P.XUCA
	PAX
	LAC (6)		/ SET UP A READ FOR THIS UCA.
	DAC U.JSW,X	/ SET JOB STATUS.
	POSTEV -
	LAC SY.NSTL	/ FETCH NODE ADDRESS.
	DAC* (R1)	/ SET UP FOR NDEL.
	JMS* (NDEL)	/ DELETE NODE FROM STL.
	LAC SY.NSTL	/ FETCH NODE ADDRESS.
	DAC* (R2)	/ AND SET UP FOR
	LAC (POOL)	/ RETURNING THE NODE TO THE
	DAC* (R1)	/ FREE LIST.
	JMS* (NADD)	/ ADD NODE TO FREE NODES.
	JMP* SYDISP	/ RETURN TO POLLER.
SY.005	POSTEV +	/ NORMAL RETURN.
	JMP* SYDISP	/ RETURN TO POLLER.
SY.004	LAC* (SSM)	//FETCH SECONDS SINCE MIDNIGHT CTR.	/(003)
	DAC U.SSM,X	//STORE THE START OF WAITING IN UCA.	/(003)
	DBK		//					/(003)
	LAC (11)	/ WAIT FOR PARTITION TO FREE UP.
	DAC U.JSW,X	/ SET JOB STATE IN JSW.
	POSTEV +	/ NORMAL COMPLETEION.
	JMS* TDVTYP	/ PTINT THE MESSAGE.			/(005)
	LAC TTYN	/ FETCH TERMINAL NUMBER.		/(005)
	LAC (MESS2)	/ FETCH MESSAGE ADDRESS.		/(005)
	LAC (2)		/ FETCH THE MODE.			/(005)
	JMP* SYDISP	/ RETURN TO POLLER.
 
/ THE USER HAS REQUESTED A NON EXISTENT TDV FUNCTION, COMPLAIN TO
/ HIM AND RETURN TO THE POLLER IN JOB STATE 6.
 
SY.060	LAC P.XUCA	/ SET UP THE XR.
	PAX
	LAC (6)		/ SET UP FOR NEXT READ IN TDV.
	DAC U.JSW,X	/ SET UP JOB STATUS WORD.
	POSTEV -	/ INDICATE FAILURE OF OVERLAY.
	JMS* TDVTYP	/ PRINT A MESSAGE.			/(005)
	LAC TTYN	/ FETCH TERMINAL NUMBER.		/(005)
	LAC (MESS1)	/ FETCH MESSAGE ADDRESS.		/(005)
	LAC (2)		/ FETCH THE MODE.			/(005)
	JMP* SYDISP	/ RETURN TO CALLER.
	.TITLE *** PARTITION FITTING ROUTINE ***
 
/ THIS ROUTINE IS CALLED IN ORDER TO FIND A PARTITION FOR A MULTIACCESS
/ JOB TO RUN IN. THE PARTITION FIT ROUTINE HAS TWO INPUT ARGUMENTS:
/
/ 1. THE ADDRESS OF THE UCA.
/ 2. THE ADDRESS OF THE ALIAS STL NODE WITH THE INFORMATION (INCLUDING
/    THE PARTITION NAME) WHICH WAS COPIED FROM THE ORIGIONAL STL NODE.
/
/ THE CALLING FORMAT IS AS FOLLOWS:
/
/	JMS P.FIT
/	LAC UCAADR
/	LAC STLADR
/	...			/ ERROR FREE RETURN.
/				/ THE ERROR FREE RETURN WILL ALWAYS BE
/				/ TAKE AT API LEVEL 5. THE CALLER MUST
/				/ PERFORM A DEBREAK PRIOR TO CALLING
/				/ THE EXECUTIVE.
/	...			/ ERROR RETURN, AC=RETURN CODE.
/
/ THE RETURN VALUES ARE:
/
/ LINK = 0 IF THE TASK IS NORMAL MODE, 1 IF EXEC MODE.
/ STL NODE CONTAINS PBDL ADDRESS.
/ AC = 0
/ API LEVEL = 5.
/
/ ERROR RETURN:
/
/ AC < 0 IF A TERMINAL ERROR WAS DETECTED. AC = 0 IF THE CALLER SHOULD
/ SET UP JOB STATE 11.
/
/
/
/
/ THERE WILL BE A LIMITATION ON THE MAXIMUM NUMBER OF PARTITIONS WHICH
/ CAN BELONG TO THE "TDV PARTITION POOL" OF 18. THIS NUMBER MAY BE
/ CHANGED BY ALTERING THE NUMBER OF ENTRIES IN THE TABLE "P.POOL"
 
P.FIT	XX		/ ROUTINE ENTRY POINT.
 
/ COPY THE INPUT PARAMETERS FROM THE CALLER.
 
	XCT* P.FIT	/ FETCH THE STL NODE ADDRESS.
	TAD P.ADJ	/ FUDGE THE STL NODE ADDRESS FOR INDEXING.
	DAC P.STL
	ISZ P.FIT	/ POINT TO THE RETURN ADDRESS.
 
/ FIRST CHECK TO SEE IF THE TASK TO BE EXECUTED IS AN EXEC MODE
/ TASK.
 
	LAC P.STL	/ FETCH STL NODE ADDRESS.
	PAX		/ SET UP INDEXING.
	LAC S.EP,X	/ FETCH NORMAL/EXEC MODE INDICATOR.
	RTL		/ MOVE INDICATOR INTO SIGN BIT OF AC.
	SPA		/ EXEC MODE?
	JMP P.NORM	/ NO, NORMAL MODE.
	LAC (P.LVL5)	/ RAISE TO API LEVEL 5.
	ISA
	LAC S.DP,X	/ FETCH THE FLAGS WORD FROM THE STL.
.X=S.ETA!S.ETDI!S.EPLC!S.ERCP
 
/ CHECK TO SEE IF ANY OF THE FOLLOWING CONDITIONS ARE TRUE:
/ 1. IS THE TASK CURRENTLY ACTIVE.
/ 2. IS THE TASK DISABLED.
/ 3. IS THE TASKS PARTITION LOST.
/ 4. IS THE TASKS PARTITION UNDERGOING RECONFIGURATION.
/
/ IF ANY OF THESE ARE TRUE, DO NOT ALLOW THE RUNNING OF AN EXEC MODE
/ TASK.
 
	AND (.X)	/ EXTRACT ERROR BITS.
	SZA!STL		/ ANY OF THEM SET? (LINK SET TO INDICATE EXEC)
	JMP P.0005	/ YES, GO PRINT ERROR MESSAGE.
								/(010)
	LAC S.DP,X	/ IF THIS TASK IS FIXED IN CORE		/(010)
	AND (S.EFIX)	/ DO NOT BOTHER CHECKING THE PARTITION	/(010)
	SZA!STL		/ FIXED?				/(010)
	JMP* P.FIT	/ YES, RETURN TO CALLER.		/(010)
								/(010)
	LAC S.PB,X	//FETCH PDBL NODE ADDRESS.
	TAD P.ADJ	//SET UP TO ACCESS PBDL.
	PAX
	LAC P.TC,X	//FETCH USE COUNT.
	SNA!STL		//SET LINK FOR EXEC MODE EXIT.
	JMP* P.FIT	//TAKE NORMAL EXIT.
	JMS P.TERR	//PRINT ERROR MESSAGE.
	P.ER80		//ERROR MESSAGE ADDRESS.
 
/ ONE OF THE ABOVE ERROR CONDITIONS APPLIES. TELL THE USER AND RETURN
/ AN ERROR CODE IN THE AC.
 
P.0005	SMA!RTL		/ IS THE TASK ACTIVE?
	JMP P.0010	/ NO, TRY NEXT ONE.
	JMS P.TERR	/ GENERATE TERMINAL ERROR.
	P.ER10		/ ERROR MESSAGE ADDRESS.
P.0010	SMA!RTL		/ IS THE TASK DISABLED?
	JMP P.0020	/ NO, TRY NEXT ONE.
P.0015	JMS P.TERR	/ GENERATE ERROR MESSAGE.
	P.ER20		/ ERROR MESSAGE ADDRESS.
P.0020	SMA!RAL		/ WAS IT'S PARTITION LOST DUE TO RECONFIG.?
	JMP P.0030	/ NO, GO GENERATE LAST ERROR.
	JMS P.TERR	/ GENERATE ERROR MESSAGE.
	P.ER30		/ ERROR MESSAGE ADDRESS.
P.0030	JMS P.TERR	/ MUST BE RECONFIGURATION IN PROGRESS.
	P.ER40		/ ERROR MESSAGE ADDRESS.
 
/ A NORMAL MODE TASK IS TO BE EXECUTED. THIS SECTION OF THE CODE WILL
/ BE RUN MOSTLY AT LEVEL 5 IN ORDER TO LOCK OUT SIGNIFICANT EVENT
/ RECOGNITION AND SWAPPING DURING THE FIT ALGORITHM.
 
P.NORM	LAC S.DP,X	/ FETCH FLAG WORDS.
	AND (S.ETDI)	/ CHECK FOR TASK DISABLED.
	SZA		/ AC = 0 MEANS NOT DISABLED.
	JMP P.0015	/ TASK DISABLED, DO NOT RUN.
	LAC S.TS,X	/ FETCH TASK SIZE.
	AND (S.ETS)	/ EXTRACT TASK SIZE.
	DAC P.TSKS	/ SAVE TASK SIZE FOR LATER.
	LAC P.XUCA	/ FETCH UCA POINTER.
	PAX		/ SET UP INDEXING.
	LAC U.PSC,X	/ FETCH PARTITION SELECTION CRITERIA.
	AND (377777)	/ REMOVE GLOBAL BIT.
	SAD (P.NAME)	/ THE PARTITION IS NAMED.
	SKP		/ YES.
	JMP P.0050	/ NO
	LAC (P.PBDL)	/ FETCH DEQ HEAD.
	DAC* (R1)	/ SET UP FOR SNAM.
	LAC P.AUCA	/ FETCH ABSOLUTE ADDRESS OF UCA.
	AAC U.PSC+1	/ POINT TO ADDRESS OF NAME.
	DAC* (R2)	/ SNAM NOW COMPLETELY SET UP.
	JMS* (SNAM)	/ PARTITION HAD BETTER BE FOUND.	/(006)
	JMP P.0049	/ ERROR, PARTITION HAS GONE AWAY.
	DAC P.TMP1	/ SAVE PBDL NODE ADDRESS.
	TAD P.ADJ	/ SET UP ADJUST FOR INDEXING.
	PAX		/ XR NOW POINTS TO PBDL.
	LAC P.SZ,X	/ FETCH PARTITION SIZE.
	CMA!IAC		/ MAKE NEGATIVE.
	TAD P.TSKS	/ ADD IN TASK TO BE RUN SIZE.
	SMA!SZA		/ CHECK TASK SIZE. IS PARTITION BIG ENOUGH.
	JMP P.0048	/ PARTITION TOO SMALL.
	LAC (P.LVL5)	/ RAISE TO LEVEL 5.
	ISA
	LAC P.TC,X	//FETCH TASK CCOUNT FROM PBDL.		/(005)
	SZA		//IST THE PARTITION BUSY?>		/(005)
	JMP P.0113	//YES, RETURN.				/(005)
P.0047	LAC P.STL	//FETCH STL NODE ADDRESS.
	PAX		//SET UP FOR INDEXING.
	LAC P.TMP1	//FETCH PBDL NODE ADDRESS.
	.INH
	DAC S.PB,X	///ALL DONE, NODE SET UP.
	LAC S.DP,X	///FETCH FLAGS WORD.
	AND (S.EDP)	///CLEAR ALL FLAGS.
	.ENB		///ENABLE
	DAC S.DP,X	///RESTORE FLAG WORDS.
	LAC P.TSKS	//COUNT THE TASK ABOUT TO BE REQUESTED.
	CMA!IAC		//MAKE THE TASK SIZE POSITIVE.		/(005)
	JMS* TS.CTR	//CALL RESIDENT ROUTINE.
	CLL!CLA		/ CLEAR THE LINK AND THE AC.
	JMP* P.FIT	/ RETURN TO THE CALLER, EVERYTHING IS OK.
P.0048	JMS P.TERR	/ PARTITION TOO SMALL, PRINT ERROR.
	P.ER50		/ ERROR MESSAGE ADDRESS.
P.0049	JMS P.TERR	/ PARTITION HAS GONE AWAY.
	P.ER60		/ ERROR MESSAGE ADDRESS.
 
/ THE PARTITION SELECTION CRITERIA WAS NOT A SPECIFIC PARTITION NAME.
/ FIGURE OUT WHETHER OR NOT IT IS A "MINIMUM SIZE" SELECTION.
 
P.0050	SAD (P.MINS)	/ IS THE SELECTION BASED ON A MINIMUM SIZE?
	SKP		/ YES.
	JMP P.0060	/ NO, MUST BE INCREMENT.
 
/ FIGURE OUT WHICH IS LARGER, TASK SIZE OR MINIMUM PARTITION SIZE.
 
	LAC U.PSC+1,X	/ FETCH PARTITION MINIMUM SIZE.
	CMA!IAC!CLL	/ MAKE IT NEGATIVE AND CLEAR THE LINK FOR LATER.
	TAD P.TSKS	/ ADD IN THE CURRENT SIZE.
	LAC P.TSKS	/ WHICH ONE SHOULD I USE?
	SNL		/ LINK = 1 => OVERFLOW TASK SIZE IS LARGER.
	LAC U.PSC+1,X	/ FETCH CURRENT SIZE.
	JMP P.0070	/ GO JOIN COMMON CODE.
 
/ LAST OPTION IS TASK SIZE PLUS DELTA.
 
P.0060	LAC P.TSKS	/ FETCH TASK SIZE.
	TAD U.PSC+1,X	/ ADD IN DELTA.
P.0070	CMA!IAC		/ MAKE TASK SIZE NEGATIVE.
	DAC P.TSKS	/ STORE NEW TASK SIZE FOR FIT ALGORITHM.
 
/ PERFORM SET UP FOR PARTITION FITTING ALGORITHM.
 
	LAC (P.POOL-1)	/ SET UP X10 FOR FILLING POOL TABLE.
	DAC* (X10)
	LAC (P.PBDL)	/ FETCH LIST HEAD POINTER.
	DAC P.TMP1	/ START COUNTER.
	LAC (377777)	/ FETCH BEST DELTA PARTITION SIZE.
	DAC P.TMP3	/ INITIAL DELTA WILL ALWAYS KICK OUT.
	DAC P.TMP4	/ INITIAL TASK USE COUNT WILL ALSO KICK OUT.
	CLLR		/ CLEAR THE LIMIT REGISTER.
	LAC (P.LVL5)
	ISA		/ RAIS TO LEVEL 5 FOR SCAN.
 
/ PERFORM PARTITION FIT. UPON EXIT THE LR WILL CONTAIN 0 IF THERE
/ WAS NO PARTITION LARGE ENOUGH TO RUN THE TASK. OTHERWISE THE LR WILL
/ CONTAIN THE BEST FITTING PARTITION BLOCK ADDRESS. IN THE CASE OF
/ MORE THAN ONE PARTITION OF THE SAME SIZE THE LR WILL CONTAIN THE
/ PARTITION BLOCK WITH THE LOWEST USE COUNT. THIS IMPLIES THAT THE
/ LOAD WILL BE LEVELED ACROSS PARTITIONS IF THEY ARE ALL BUSY.
/
/ P.TMP4 WILL CONTAIN THE USE COUNT FOR THE BEST FITTING PARTITION.
/ X10 WILL POINT TO THE LAST USED WORD IN THE POOL TABLE.
 
P.0080	LAC* P.TMP1	//GET NEXT PDBL NODE TO PROCESS.
	SAD (P.PBDL)	//DONE WITH THE LIST?
	JMP P.0100	//YES, GO SET UP PARTITION.
	DAC P.TMP1	//SAVE FOR NEXT ITERATION OF LOOP.
	TAD P.ADJ	//SET UP FOR INDEXING.
	PAX		//SET UP XR.
	LAC P.N1,X	//FETCH PARTITION NAME (3CHAR)
	SAD (P.TDV)	//FIRST THREE CHARACTERS TDV?
	SKP		//YES.				/(007)
	JMP P.0080	//NO, DON'T LOOK AT THIS PARTITION.
 
/ A PARTITION OF THE FORM TDV??? HAS BEEN FOUND SINCE ALL PARTITIONS
/ OF THIS FORM ARE PART OF THE POOL CHECK FOR SIZE CONSTRAINTS.
 
	LAC P.SZ,X	//FETCH PARTITION SIZE.
	TAD P.TSKS	//CALCULATE PARTITION DELTA.
	SPA		//AC >= 0 IF TASK WILL FIT.
	JMP P.0080	//TASK WON'T FIT, RUN SOMEWHERE ELSE.
	DAC P.TMP2	//SAVE DELTA FOR DELTA COMPARISON LATER.
	LAC P.TC,X	//FETCH PARTITION USE COUNT.
	SZA		//IS IT IDLE?
	JMP P.0090	//NO, GO DO BEST FIT CHECK.
 
/ AN IDLE PARTITION WHICH WILL RUN THE TASK HAS BEEN LOCATED, MAKE
/ AND ENTRY IN THE POOL TABLE FOR THIS PARTITION.
 
	LAC P.TMP2	//FETCH DELTA.
	DAC* X10	//DELTA INTO POOL TABLE.
	LAC P.TMP1	//FETCH PBDL NODE ADDRESS.
	DAC* X10	//PBDL NODE ADDRESS INTO POOL TABLE.
 
/ CHECK THE PARTITION TO SEE IF IT FITS ANY BETTER THAN THE LAST
/ FITTING PARTITION.
 
P.0090	LAC P.TMP2	//FETCH CURRENT DELTA.
	CMA!IAC		//MAKE IT NEGATIVE.
	TAD P.TMP3	//ADD IN LAST BEST DELTA.
	SPA		//IS IT AT LEAST AS GOOD?
	JMP P.0080	//NO, GO TRY NEXT PARTITION.
 
/ THE CURRENT PARTITION IS AT LEAST THE SAME SIZE AS THE PREVIOUS
/ BEST FITTING PARTITION. CHECK TO SEE IF IT IS ANY BETTER.
 
	SZA		//IS IT ANY BETTER?
	JMP P.0095	//YES, GO UPDATE BEST FITTING CELLS.
 
/ THE PARTITION LOCATED IS THE SAME SIZE AS THE PREVIOUS PARTITION.
/ SELECT THE ONE WITH THE LOWEST USE COUNT. IF THEY HAVE THE SAME
/ USE COUNT, USE THE CURRENT PARTITION.
 
	LAC P.TC,X	//FETCH USE COUNT FOR THE PARTITION.
	CMA!IAC		//MAKE IT NEGATIVE.
	TAD P.TMP4	//ADD IN THE PREVIOUS PARTITIONS USE COUNT.
	SPA		//IS IT AT LEAST AS GOOD?
	JMP P.0080	//NO, KEEP THE CURRENT BEST FITTING PARTITION.
 
/ UPDATE ALL THE BEST FITTING CELLS TO INDICATE A NEW BEST FITTING
/ PARTITION.
 
P.0095	LAC P.TC,X	//FETCH TASK USE COUNT FROM PBDL.
	DAC P.TMP4	//UPDATE TASK COUNT.
	LAC P.TMP1	//FETCH PBDL NODE ADDRESS.
	PAL		//LR HAS NEW BEST FITTING NODE ADDRESS.
	LAC P.TMP2	//FETCH NEW PARTITIONS DELTA SIZE.
	DAC P.TMP3	//UPDATE OLD PARTITIONS DELTA SIZE.
	JMP P.0080	//GO CHECK THE NEXT PARTITIONS.
 
/ PARTITION FITTING IS OVER, SELECT A PARTITION TO USE.
 
P.0100	PLA		//FETCH PBDL NODE.
	SZA		//ANY PARTITIONS LARGE ENOUGH?
	JMP P.0110	//YES.
	JMS P.TERR	//NO, PRINT NO PARTITION LARGE ENOUGH.
	P.ER70		//ERROR MESSAGE ADDRESS.
 
/ AT LEAST ONE PARTITION WILL RUN THE JOB. CHECK TO SEE IF THE BEST
/ FITTING ONE IS IDLE.
 
P.0110	DAC P.TMP1	//SAVE PBDL NODE ADDRESS FOR COMMON CODE.
	LAC P.TMP4	//FETCH USE COUNT FOR BEST FITTING PARTITION.
	SNA		//IS IT IDLE?
	JMP P.0047	//YES, GO SET UP STL.
 
/ THE BEST PARTITION IS BUSY. SEE IF ANY PARTITION IS FREE.
 
	LAC* (X10)	//FETCH UPDATED POOL TABLE POINTER.
	SAD (P.POOL-1)	//ARE THERE ENTRIES IN THE TABLE?
	SKP		//NO, TAKE ERROR RETURN WITH 0 AC.
	JMP P.0115	//YES, TRY ONE OF THE IDLE ONES.
P.0113	DBK		//RETURN TO API LEVEL 7.		/(005)
	CLA!CLL		//INDICATE NON TERMINAL ERROR AND NORMAL MODE.
	ISZ P.FIT	/ POINT TO ERROR RETURN
	JMP* P.FIT	/ RETURN TO CALLER.			/(005)
 
/ AT LEAST ONE OTHER PARTITION IS IDLE. SCAN THE IDLE LIST FOR THE
/ BEST AVAILABLE PARTITION AND SET UP A REQUEST FOR THAT ONE.
 
P.0115	LAC (P.POOL)	//FETCH POOL BEGINNING.
	TAD P.ADJ	//SET UP INDEXING.
	PAX
	LAC* (X10)	//FETCH POINTER TO LAST USED WORD IN TABLE.
	TAD P.ADJ	//SET UP LIMIT.
	PAL
	LAC (377777)	//FETCH INITIAL DELTA.
	DAC P.TMP1
P.0120	LAC 0,X		//FETCH DELTA FROM POOL TABLE.
	CMA!IAC		//MAKE IT NEGATIVE.
	TAD P.TMP1	//ADD IN CURRENT DELTA.
	SPA		//IS THE NEW DELTA SMALLER?
	JMP P.0130	//NO, ADVANCE TO NEXT TABLE ENTRY.
	LAC 0,X		//FETCH NEW DELTA.
	DAC P.TMP1	//UPDATE OLD DELTA.
	PXA		//FETCH INDEXING CONSTANT.
	DAC P.TMP2	//SAVE IT.
P.0130	AXS 2		//GO TO NEXT POOL TABLE ENTRY.
	JMP P.0120	//LOOP NOT OVER YET.
 
/ A NEW BEST FITTING ALTERNATIVE HAS NOW BEEN CHOSEN. FETCH THE
/ NODE ADDRESS FROM THE POOL TABLE AND GO JOIN COMMON CODE.
 
	LAC P.TMP2	//FETCH POINTER TO POOL TABLE ENTRY.
	PAX		//SET UP INDEXING FOR IT.
	LAC 1,X		//FETCH PBDL NODE ADDRESS.
	DAC P.TMP1	//SET UP COMMON CODE.
	JMP P.0047	//GO JOIN COMMON CODE.
	.TITLE *** SUBROUTINE FOR PARTITION FITTING ROUTINE ***
 
P.TERR	XX
	RPL		//READ PRIORITY LEVELS.
	AND (P.LVL5\400000) //EXTRACT LEVEL 5 BIT.
	SZA		//ENTERED AT LEVEL 5?
	DBK		//YES.
	ISZ P.FIT	/ SET UP NORMAL ERROR RETURN ADDRESS.	/(005)
	JMS* TDVTYP	/ CALL TYPE ROUTINE TO PRINT THE MESSAGE/(005)
	LAC TTYN	/ FETCH THE TERMINAL NUMBER.		/(005)
	LAC* P.TERR	/ FETCH THE MESSAGE ADDRESS.		/(005)
	LAC (2)		/ SET UP IOPS ASCII MODE.		/(005)
	LAC* P.TERR	/ FETCH MESSAGE ADDRESS.		/(005)
	DAC* (X10)	/ SET UP TO FETCH ERROR RETURN CODE.	/(005)
	LAC* X10	/ FETCH ERROR RETURN CODE.		/(005)
	JMP* P.FIT	/ RETURN WITH ERROR CODE IN AC.
	.TITLE *** ERROR PRINTING ROUTINE FOR FAILED REQUEST ***
 
/ ERROR CODE IN AC. ASSUMES THAT SAV.XL HAS BEEN CALLED.	
 
T.TERR	XX							
	CMA!IAC		/ CONVERT EV TO POSITIVE NUMBER.	/(005)
	LRSS!CLQ 6						/(005)
	ALS 4							
	LLS 3							/(005)
	ALS 4							
	XOR (301406)	/ MAGIC NUMBER TO CONVERT TO 5/7.	/(005)
	DAC EBUF	/ SAVE FIRST 2 4/7 CHARACCTERS.		
	LACQ		/ FETCH 3/7 CHARACTER.			
	XOR (6400)	/ SET UP CR.				
	DAC EBUF+1	/ COMPLETE MESSAGE. NOW SEND IT.	
	JMS* TDVTYP	/ PINT ERROR MESSAGE.			/(005)
	LAC TTYN	/ FETCH TERMINAL NUMBER.		/(005)
	LAC (TWRIT)	/ FETCH MESSAGE ADDRESS.		/(005)
	LAC (2)		/ FETCH MODE.				/(005)
	JMP* T.TERR	/ RETURN TO CALLER.			
 
TWRIT	EBUF+2-.*400&777000+2					/(005)
	0
	.ASCII "REQUEST ERROR -- EV = -"			/(005)
EBUF	0							
	0							
	.TITLE RMVBLK -- SUBROUTINE TO DELETE TRAILING BLANKS
 
 
 
 
/
/ WRITTEN 12-AUG-76 BY EAG
/
/ THIS SUBROUTINE DELETES TRAILING BLANKS FROM THE INPUT LINE
/ (LOCATED IN THE TERMINAL BUFFER IN THE UCA).
/
/ ADDITIONALLY, THE LINE TERMINATOR IS CHANGED TO AN ALT MODE,
/ REGARDLESS OF WHAT THE LINE TERMINATOR IS CURRENTLY.
/
/ NOTE, HOWEVER, THAT IF ANY DATA VALIDITY BITS ARE SET
/ (CHECKSUM ERRORS, ETC.) NOTHING WHATSOEVER IS DONE TO THE
/ INPUT LINE, SO THAT IT IS LEFT UNCHANGED.
/
/ CALLING SEQUENCE:
/	JMS RMVBLK
/
/ REGISTERS ALTERED:
/	AC, LINK, XR, LR, MQ, SC
/
/ VALUES RETURNED:
/	MODIFIED INPUT LINE
/
 
 
RMVBLK	0
	LAC P.XUCA		/ POINT XR TO UCA.
	PAX
/
	LAC U.TB,X		/ CHECK FOR VALIDITY BITS SET.
	AND (775)
	SZA			/ SKIP IF NONE SET.
	JMP RMVB.F		/ JMP IF VALIDITY BIT SET.
/
	LAW 777000		/ EXTRACT WORD PAIR COUNT,
	AND U.TB,X		/ AND CONVERT TO WORD COUNT.
	CLL!RAL
	SWHA
/
	TAD P.XUCA		/ SET UP XR TO ACCESS LAST
	AXR +2			/ WORD PAIR OF LINE AND LR
	PXL			/ TO PREVENT SCANING HEADER.
	PAX
/
	LAC (RMVB.H)		/ INDICATE A NON-BLANK CHAR
	DAC RMVB.0		/ HASN'T BEEN SEEN YET.
/
/ COME HERE TO SCAN PREVIOUS WORD PAIR.  NOTE THAT WE SCAN
/ THE FIRST WORD PAIR LAST AND THE LAST WORD PAIR FIRST.
/
RMVB.A	AXS -2			/ BACKUP XR AND CHECK FOR
				/ HEADER WORD PAIR.
	JMP RMVB.D		/ JMP IF HEADER WORD PAIR.
	LAC (RMVB.G-1)		/ SET UP POINTER TO SHIFT
	DAC* (X10)		/ TABLE FOR UNPACKING.
/
/ COME HERE TO SCAN NEXT CHARACTER.
/
RMVB.B	LAC U.TB+1,X		/ LOAD WORD PAIR INTO AC, MQ.
	LMQ
	LAC U.TB,X
	XCT* X10		/ SHIFT CHAR. INTO POSITION.
	AND (177)		/ MASK OUT OTHER KRUFT.
	SAD (40)		/ IS IT A SPACE?
	JMP RMVB.B		/ YES -- KEEP SCANNING.
	SAD (15)		/ IS IT A CARRAIGE RETURN?
	JMP RMVB.C		/ YES -- END OF WORD PAIR.
	SAD (175)		/ IS IT AN ALT MODE?
	JMP RMVB.C		/ YES -- END OF WORD PAIR.
/ COME HERE IF NON-BLANK CHARACTER IS FOUND.
	LAC* (X10)		/ REMEMBER CHARACTER POSITION.
	AAC RMVB.I-RMVB.G	/ AS A POINTER INTO SHIFT
	DAC RMVB.0		/ TABLE.
	JMP RMVB.B		/ KEEP SCANNING.
 
 
/ COME HERE AT THE END OF EACH WORD PAIR.
 
RMVB.C	LAW 777600		/ FETCH MASK.
	XCT* RMVB.0		/ SHIFT INTO POSITION OR JMP
				/ TO RMVB.D OR JMP TO RMVB.A
	AND U.TB,X		/ MASK NON-BLANK CHARACTERS.
	DAC U.TB,X
	LACQ
	AND U.TB+1,X
	DAC U.TB+1,X
	LAC (175)		/ FETCH ALT MODE.
	XCT* RMVB.0		/ SHIFT INTO POSITION.
	XOR U.TB,X		/ MERGE WITH NON-BLANK
	DAC U.TB,X		/ CHARACTERS.
	LACQ
	XOR U.TB+1,X
	DAC U.TB+1,X
	JMP RMVB.E		/ GO ADJUST WORD PAIR COUNT.
 
 
/ COME HERE IF LAST NON-BLANK WAS FIFTH CHAR. IN WORD PAIR OR
/ IF LINE IS ENTIRELY BLANK.
 
RMVB.D	AXR 2			/ ADJUST XR TO WORD PAIR WHICH
				/ WILL RECEIVE ALT MODE.
	LAW 175*200*20		/ PICK UP ALT MODE.
	DAC U.TB,X		/ STORE IT AWAY.
/
/ COME HERE, AFTER ALT MODE HAS BEEN STORED, TO ADJUST
/ THE HEADER WORD PAIR COUNT.
/
RMVB.E	PXA			/ SAVE WORD PAIR ADDRESS.
	DAC RMVB.0
	LAC P.XUCA		/ POINT XR TO UCA.
	PAX
	TCA			/ CALCULATE REVISED LINE
	TAD RMVB.0		/ LENGTH MINUS TWO.
	CLL!RAR			/ FORM WORD PAIR COUNT AND
	SWHA			/ FORMAT HEADER WORD.
	TAD (1002)
	DAC U.TB,X		/ STORE REVISED HEADER WORD.
/
/ COME HERE TO RETURN TO CALLER.
/
RMVB.F	JMP* RMVBLK
 
 
/
/ SHIFT TABLE TO UNPACK CHARACTERS.  THIS TABLE IS
/ REFERENCED VIA X10.
/
 
RMVB.G	LRS+13			/ CHARACTER # 1
	LRS+4			/ CHARACTER # 2
	LLS+3			/ CHARACTER # 3
	LLS+12			/ CHARACTER # 4
	LLS+21			/ CHARACTER # 5
	JMP RMVB.C		/ END OF WORD PAIR
 
 
/
/ INSTRUCTION WHICH RMVB.0 POINTS TO WHEN WE HAVE NOT YET
/ SEEN A NON-BLANK CHARACTER.
/
 
RMVB.H	JMP RMVB.A		/ GO SCAN ANOTHER WORD PAIR.
 
 
/
/ TABLE OF SHIFT INSTRUCTIONS WHICH RMVB.0 POINTS TO WHEN
/ A NON-BLANK CHARACTER HAS BEEN SEEN.  THESE SHIFT
/ INSTRUCTIONS SHIFT THE ALT MODE INTO THE CORRECT
/ POSITION.
/
 
RMVB.I	CLQ!LLSS+4		/ STORE ALT MODE AS CHAR. # 2
	CLQ!LRSS+3		/ STORE ALT MODE AS CHAR. # 3
	CLQ!LRSS+12		/ STORE ALT MODE AS CHAR. # 4
	CLQ!LRSS+21		/ STORE ALT MODE AS CHAR. # 5
	JMP RMVB.D		/ STORE ALT MODE AS FIRST CHAR
				/ OF NEXT WORD PAIR.
 
 
 
RMVB.0	0			/ TEMPORARY.
 
 
 
	.END