
	.TITLE *** REMOVE MCR FUNCTION ***

/

/ COPYRIGHT (C) 1976

/ 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.

/

	.EJECT

/ EDIT #15

/ EDIT #25	MAY-11-76 (SCR)	ATTEMPT SAVE-REMOVE-INSTALL FIX

/ EDIT #26	MAY-12-76 (SCR) COMPARE ON DISK ADDR, NOT NAME

/ EDIT #27	MAY-13-76 (SCR) FURTHER CLEANUP
/ EDIT #28	MAY-14-76 (SCR) LOST AN INSTUCTION
/ EDIT #29	MAY-17-76 (SCR) MISMATCHED JMP*
/ EDIT #30	MAY-17-76 (SCR) FIX STLNOD FLAG HANDLING
/ EDIT #31	MAY-17-76 (SCR) LOST LINK IN SLEIGHT OF HAND
/ EDIT #32	MAY-18-76 (SCR) ALIAS CHECK
/ EDIT #33	MAY-18-76 (SCR) ALIAS; DON'T FIND SELF.
/ EDIT #34	MAY-18-76 (SCR) INIT PROBLEM
/

/

/ MCR FUNCTION -- REMOVE	26 SEP 71	R. MCLEAN

/					6/3/72	D. MCMILLAN

/					4/5/73	M. HEBENSTREIT

/					6/3/75	M. HEBENSTREIT

/ EDIT #15	(SAVE REM INSTALL)	4/6/76	M. HEBENSTREIT

/

/ TASK NAME  "...REM"   TO REMOVE A TASK FROM THE SYSTEM TASK LIST.

/

/ THE FIRST LINE OF THE COMMAND INPUT FOR ANY MCR

/ FUNCTION IS READ BY THE RESIDENT MCR TASK ("...MCR").

/ FOR THE "REMOVE" FUNCTION, THERE IS ONLY ONE LINE OF

/ COMMAND INPUT, AND IT'S SYNTAX IS AS FOLLOWS:

/

/	SYNTAX = 'REM'$<NBC><BREAK CHARACTER><TASK NAME>

/		(<CR>/<AM>)

/	<BREAK CHAR> = " "/","

/	<TASK NAME> = 1-6 ALPHANUMERIC CHARACTERS

/	<CR> = CAR RTN

/	<AM> = ALTMODE

/	<NBC> = NON BREAK CHARACTER

/	$ -- " ANY NUMBER OF "INCLUDING ZERO "

/

/	THE RESIDENT MCR READS A LINE, FETCHES THE

/	FIRST THREE CHARACTERS TO FORM THE MCR FUNCTION TASK

/	NAME ("...REM"), FLUSHES CHARACTERS THRU THE FIRST

/	BREAK CHARACTER, REQUESTS "...REM", AND EXITS

/	THE TASK "...REM " PROCESSES THE REMAINDER OF THE LINE

/	AND IF THE REQUEST IS VALID, ISSUES AN APPROPRIATE "REMOVE"

/	DIRECTIVE.

/

/	IF THE COMMAND INPUT LINE IS TERMINATED BY A CAR RTN,

/	THE RESIDENT MCR TASK IS REQUESTED, AND THE FUNCTION TASK

/	EXITS.

/

/	IF THE COMMAND INPUT LINE IS TERMINATED BY AN ALTMODE, THE

/	FUNCTION TASK EXITS WITHOUT REQUESTING "...MCR". A ^C TYPEIN

/	IS THEN NECESSARY TO RE-ESTABLISH MCR DIALOGUE.

 .TITLE *** MCR FUNCTION 'REMOVE'

/

MCRRI=171

FAC=174

SNAM=123

.ENB=705521

.INH=705522

POOL=240

NADD=107

NDEL=112

R1=101

R2=102
STKL=242
S.DA=6
X10=10

P.TC=47

REMBLK=311

IDX=ISZ

ECLA=641000

/

REM	DZM	STLNOD	/(027) DEFAULT, WE'RE NOT HOLDING A NODE

	LAW	-7	/SET UP TO FETCH TASK NAME AND STORE

	DAC	CNT	/SIX CHARACTERS (ZERO RIGHT FILL) 
	LAC	(REMNAM+1)
	DAC*	(X10)
	AND	(70000	/(032) SET UP XR ADJ
	CMA!IAC
	DAC	XADJ	/(032)
/
REMN1	JMS*	(FAC)	/FETCH A CHARACTER

	SAD	(054)	/ IS IT A COMMA?

	JMP	ERR1	/YES -- ERROR IN SYNTAX

	SAD	(040)	/NO -- BLANK?

	JMP	ERR1	/YES -- ERROR IN SYNTAX

	SAD	(015)	/NO -- CAR RTN?

	JMP	ENDCRA	/YES-- END OF REQUEST

	SAD	(175)	/NO -- ALTMODE?

	JMP	ENDCRA	/YES-- END OF REQUEST
	DAC*	X10	/NO -- STORE CHARACTER

	ISZ	CNT	/LAST CHARACTER OF TASK NAME?

	JMP	REMN1	/NO -- GET NEXT CHARACTER

ERR1	LAC	(MES2)	/GET MESSAGE ADDRESS SYNTAX ERROR

	JMP	ERRTY	/REQUEST MCR AND RETURN

/

ENDCRA	DAC	SVBKCH	/SAVE CAR RTN OR ALTMODE

REMN2	DZM*	X10	/FILL REMAINING CHARACTERS WITH ZERO

	ISZ	CNT

	JMP	REMN2

/

	LAC	REMNAM+4	/FORM FIRST HALF OF TASK NAME

	LRS	6

	LAC	REMNAM+3

	LRS	6

	LAC	REMNAM+2

	SNA		/IS THIS A NULL NAME?

	JMP	ERR1	/YES EXIT WITH ERROR

	LLS	14

	DAC	REMNAM+2	/STORE FIRST HALF OF WORD IN REMNAM

	LAC	REMNAM+7	/FORM SECOND HALF OF TASK NAME

	LRS	6

	LAC	REMNAM+6

	LRS	6

	LAC	REMNAM+5

	LLS	14

	DAC	REMNAM+3

	LAC	(REMNAM+2)	/PICK UP POINTER TO TASK NAME

	DAC*	(R2)	/SAVE IT IN R2 FOR SNAM
	LAC	(STKL)	/PICK UP POINTER TO SYSTEM TASK LIST HEAD
	DAC*	(R1)	/SAVE IT ALSO

	JMS*	(SNAM)	/LOOK FOR PROGRAM IN SYSTEM TASK LIST

	JMP	ERTTYA	/TASK NOT IN SYSTEM ERROR
	DAC	STLNOD	/SAVE STKL NODE ADDRESS
	AAC	4	/ADD 4 TO PICK UP FLAGS

	DAC	FLAGS	/SAVE POINTER TO FLAGS

	IAC

	DAC	PARBA	/PARTITION BLOCK ADDRESS

	IAC

	DAC	CNT	/SAVE DISK ADDRESS POINTER

	LAC	(400002)	/RAISE TO LEVEL 6 TO PREVENT EXIT

	ISA		/DURING CANCEL

	.INH		/INHIBIT INTERRUPTS WHILE MODIFYING FLAGS

	LAC*	FLAGS	/PICK UP FLAGS

////////////////////////////////////////////////////////////////

//

//  DELETE ON EXIT NOT IMPLEMENTED SO EXIT WITH ERROR

//    IF TASK ACTIVE

//

////////////////////////////////////////////////////////////////

	SPA

	JMP	ACTIVE

	AND	(577777)	/MASK OFF DISARM AND REMOVE ON EXIT BITS

	XOR	(200000)	/YES SET REMOVE ON EXIT FLAGS

	.ENB		/ENABLE INTERRUPTS
	DAC*	FLAGS	/RESTORE FLAGS
	LAC	(STKL	/(032)SCAN STL FOR ALIAS
FINDS	JMS	SETXR	/(033) N,X ADDRESSING
FINDL	LAC	0,X	/(032) CHECK FORWARD POINTER
	SAD	(STKL	/(032) DONE
	JMP	NOFIND	/(032) NO ALIAS FOUND
	SAD	STLNOD	/(033) OUR OWN NODE?
	JMP	FINDS	/(033) YES, MISS COMPARE
	JMS	SETXR	/(032)LOOK AT NODE
	LAC	S.DA,X	/(032)ITS DISK ADDR
	SAD*	CNT	/(032) SAME AS OURS
	JMP	ERRALS	/(032) YES, ALIAS, DON'T REMOV.
	JMP	FINDL	/(032) KEEP CHECKING
/
NOFIND	LAC*	FLAGS	/(032)CHECK IN CORE BIT
	AND	(040000)	/MASK OFF FIXED IN CORE BITS

	SNA		/IS IT FIXED IN CORE?

	JMP	NOTFIX	/NO DON'T FREE PARTITION

	LAC*	PARBA	/PICK UP THE PARTITION BLOCK POINTER

	AAC	P.TC	/MOVE POINTER TO THE PARTITION BUSY FLAG

	DAC	PARBA

	LAC*	PARBA	/PICK UP THE FLAGS WORD

	AAC	-1	/FREE PARTITION

	DAC*	PARBA

NOTFIX	CAL	REMNAM	/ISSUE CANCEL DIRECTIVE

	LAC	STLNOD	/NO -- DELETE NODE FROM STKL

	DAC*	(R1)

	JMS*	(NDEL)	/DELETE NODE

	LAC*	FLAGS	/IS TASK BUFY

	DBK

/////////

//    CHECK FOR TASK ACTIVE GOES HERE

/////////

	LAC*	CNT	/PICK UP DISK ADDRESS

	ADD	(400\777777)	/SUBTRACT 400 IN ONE'S COMP. ARITHMETIC

	AND	(000377)	/MASK OFF UNIT NUMBER

	DAC	CNTRLU	/SAVE IT IN CPB

	LAC*	CNT	/PICK UP DISK ADDRESS AGAIN

	ADD	(400\777777)	/SUBTRACT AGAIN

	AND	(777400)	/MASK OFF ADDRESS

	DAC	CNTRLA	/SAVE IT IN CPB FOR DEALLOCATE

	CAL	GETSIZ	/PICK UP THE SIZE OF THE STORAGE

	CAL	WAITEV

	LAC	EV	/CHECK TO SEE IF OK

	SPA

	JMP	DSKERR	/NOT OK DISK ERROR

	CAL	DEALOC	/DEALLOCATE DISK SPACE

	CAL	WAITEV	/WAIT FOR DEALLOCATE TO COMPLETE

	LAC	EV	/CHECK TO SEE IF OK

	SPA

	JMP	DSKERR	/NO OK DISK ERRROR

	.TITLE	SAVE-REMOVE-INSTALL BLOCK CHAIN UPDATE

/

/  (THE CODE BETWEEN THE ****'S IS EDIT #25, MODIFIED FROM 

/  EDIT #15)

/ *********************

/

/

/ THE FOLLOWING CODE IS USED TO UPDATE THE INSTALL/REMOVE

/ CHAIN OF BLOCKS IN ORDER TO FIX THE SAVE-REMOVE-INSTALL

/ GLITCH. THE IDEA IS THAT EACH TIME THE STL IN CORE IS CHANGED,

/ THIS CHAIN OF DISK BLOCKS MUST ALSO CHANGE. WHENEVER A TASK IS

/ REMOVED, THE TASKS NAME IS ENTERED INTO THE CHAIN. WHENEVER A

/ TASK IS INSTALLED,  A COPY OF ITS STL NODE (LESS POINTERS) IS

/ ENTERED INTO THE CHAIN ALONG WITH THE TASKS PBDL DATA.

/ WHEN THE SYSTEM IS BOOTSTAPPED THE COPY OF SAVE WHICH IS

/ IN CORE READS THE CHAIN OF BLOCKS AND RECONSTRUCTS THE

/ STL FROM THE DATA FOUND IN THE BLOCKS.

/ WHENEVER A SAVE IS DONE (STL IN CORE MATCHES STL ON DISK)

/ THIS CHAIN OF BLOCKS IS PURGED.

/

/ THE STRUCTURE OF EACH BLOCK IS:

/

/	WORDS 0-375 USED FOR DATA ENTRIES

/	WORD 376 IS A POINTER TO 1ST FREE WORD IN BLOCK

/	WORD 376 IS COMPLEMENTED TO SHOW LOGICAL EOF

/	WORD 377 IS A POINTER TO NEXT BLOCK OR -1

/

/ THE STRUCTURE OF A REMOVE ENTRY IS:

/

/	NTRY+0 -1 (FLAG SAYING THIS ENTRY IS A REMOVE)

/	NTRY+1 DISK ADDRESS FROM STL

/

/ THE STRUCTURE OF AN INSTALL ENTRY IS:

/

/	NTRY+0 +1 (FLAG SAYING THIS ENTRY IS AN INSTALL)

/	NTRY+1 TASK NAME IN SIXBT 1ST HALF

/	NTRY+2 TASK NAME IN SIXBT 2ND HALF

/	NTRY+3 STL NODE WORD 4

/	NTRY+4 STL NODE WORD 5

/	NTRY+5 STL NODE WORD 6

/	NTRY+6 STL NODE WORD 7

/	NTRY+7 STL NODE WORD 10

/	NTRY+10 STL NODE WORD 11

/	NTRY+11 PARTITION NAME IN SIXBT 1ST HALF

/	NTRY+12 PARTITION NAME IN SIXBT 2ND HALF

/	NTRY+13 PARTITION BASE ADDRESS

/

/ NOTE THAT IT IS EXTREMELY IMPORTANT TO FILL UP DATA

/ ENTRIES IN THE REMOVE CHAIN IN THE ORDER THAT EACH

/ STL MODIFICATION WAS MADE.

/

/ NOTE ALSO THAT ALL TASKS WHICH ACCESS THIS CHAIN OF 

/ BLOCKS MUST RESIDE IN THE SAME PARTITION.

/ THOSE TASKS ARE: SAVE,TDV REM, MCR REM, TDV INS, MCR INS,

/ FININS, AND AUTORM.

/

/  THE REMOVE CODE CHECKS FOR A MATCHING INSTALL.

/  IFPRESENT, THE INSTALL IS REMOVED, THE REMOVE IS NEVER

/  PLACED, AND THE DATA IS MOVED UP IN THE DISK

/  BLOCKS TO MINIMIZE THE SPACE USED.

/

	.EJECT

/

/ START TO PROCESS THE REMOVE CHAIN OF BLOCKS

/

INSSZ=14				/SIZE OF AN INSTALL ENTRY

REMSZ=2					/SIZE OF A REMOVE ENTRY

/
BEGIN	LAC	(BUFF	/READ TO FIRST BUFFER FIRST
	DAC	REMCTA+2
	LAC*	(REMBLK /SCAN BLOCK LIST
	SKP
REM0	LAC	BUFF+377 /FETCH NEXT BLOCK
	DAC	CURBLK	/CURRECT BLOCK IN ACTION
	JMS	GETBLK	/FETCH BLOCK WHOSE # IN AC
/
REM1	LAC	BUFF+376 /FREE LENGTH POINTER
	SPA		/DOUBLES ASLOGICAL EOF
	CMA		/IS LAST ACTIVE BLOCK, MAKE +
	PAL		/LOOP CONTROL
	CLX		/START AT BUFF
	SNA		/(034) SKIP IF BLOCK HAS SOME DATA
	JMP	REM1J	/(034) DOESN'T, CHECK LOGICAL EOF
REM11	LAC	BUFF,X	/SCAN FOR MATCHING INSTALL
	SPA		/SKIP IF INSTALL ENTRY

	JMP	REM1R	/IS REMOVE ENTRY GO TO NEXT

	LAC*	CNT	/(026)DISK ADDR

	SAD	BUFF+5,X /(028)SAME AS INSTALL ENTRY?

	JMP	SQUNCH	/SAME, GO GARBAGE COLLECT

REM1I	AXS	INSSZ	/THRU WITH THIS BLOCK?

	JMP	REM11	/NOPE

	JMP	REM1J	/YUP, JOIN UP WITH OTHER AXS

/

REM1R	AXS	REMSZ	/MOVE TO NEXT ENTRY

	JMP	REM11	/MORE TO DO IN BLOCK

/

REM1J	LAC	BUFF+376 /IS THIS THE LAST BLOCK WITH ENTRIES

	SMA		/SKIP IF LOGICAL END

	JMP	REM0	/GO GET THE NEXT BLOCK

REM1K	AAC	377-REMSZ /CAN IT FIT

	SPA		/SKIP IF YES

	JMP	GETSOM	/NO, EITHER MT BLOCK AT CHAIN END, OR GET NEW ONE
	AAC	-377	/MAKE NEW POINTER

	DAC	BUFF+376

	LAW	-1	/REMOVE ENTRY ON LIST END

	DAC	BUFF,X

	LAC*	CNT	/(026) DISK ADDR

	DAC	BUFF+1,X

	JMS	PUTBLK	/REWRITE THE UPDATED BLOCK

	JMP	REMNOD	/THAT'S ALL

/

GETSOM	LAC	BUFF+376 /COMPLEMENT POINTER

	CMA		/AS THIS IS NO LONGER THE LAST ACTIVE BLOCK

	DAC	BUFF+376

	LAC	BUFF+377 /IS THERE ALREADY A NEXT BLOCK

	SAD	(-1	/IF NOT, THIS IS -1

	JMP	NEWGET	/ALLOCATE A NEW BLOCK

	DAC	CURBLK	/READ EMPTY BLOCK FROM END

	JMS	PUTBLK	/(026) PLACE COPY OF PRESENT

	LAC	CURBLK	/(026) RESTORE AC

	JMS	GETBLK	/THERE IS, FETCH IT

REM1L	LAW	-1	/JOIN UP MAIN CODE TO PLACE ENTRY

	CLX		/0 RELATIVE POSITION

	JMP	REM1K

/

/ ALLOCATE A NEW BLOCK FOR THE REM CHAIN

/

NEWGET	CAL	ALLO		/ALLOCATE A BLOCK

	CAL	WAITEV

	LAC	EV		/ANY ERRORS?

	SPA

	JMP	FILERR		/YES

	LAC	ALLCTA+2	/NO -- GET THE BLK NUMBER

	LMQ			/CONVERT PLATTER AND ADDR

	LAC	ALLCTA+1	/TO A DISK BLOCK NUMBER

	AND	(7777

	LRSS	10

	LACQ

	DAC	NEWBLK		/SAVE THE BLK NUMBER

/

/  TRY TO WRITE ON NEW BLOCK. IF ERROR, OLD BLOCK

/  DOES NOT YET POINT AT NEW ONE.

/

	JMS	CONVRT		/NEW BLOCK FOR CAL

	JMS	PUTBLK		/WRITE OUT THE NEW BLOCK

/

/ OK, SO WRITE OUT THE CURRENT DISK BLOCK

/

	LAC	CURBLK		/GET CURRENT BLOCK NUMBER

	JMS	CONVRT		/PREPARE TO WRITE IT OUT

	LAC	NEWBLK		/SET UP BLK FORWARD PTR

	DAC	BUFF+377

	JMS	PUTBLK		/WRITE OUT THE OLD BLOCK

/

/ INIT THE NEW DATA BLOCK BUFFER

/

	LAC	NEWBLK		/SET NEWLY ALLO'D BLK TO CURRENT BLK

	DAC	CURBLK

	JMS	CONVRT		/PREP TO WRITE OUT THIS BLOCK

	LAW	-1		/(026) STOPPER FOR NEW BLOCK

	DAC	BUFF+377	/(026)

	JMP	REM1L		/JOIN UP TO PLACE ENTRY

/

SQUNCH	PXA		/MOVE DOWN ENTRIES IN PRESENT BLOCK

	TAD	(BUFF-1

	DAC*	(X10	/AUTO INCR FOR PLACEMENT

	AXS	INSSZ	/MOVE XR FOR FETCH, SKIP IF IT WAS

	SKP		/NOT LAST ENTRY

	JMP	SQ01	/THE LAST ENTRY, DON'T MOVE ANYTHING NOW

SQ0	LAC	BUFF,X	/IF ALREADY DONE, ONE PLACE TO SELF, OK.

	DAC*	X10

	AXS	1

	JMP	SQ0	/KEEP GOING

/

SQ01	LAC	BUFF+376 /IS THIS THE LAST BLOCK ALREADY?
SQ1	SPA		/SKIP IF NOT

	JMP	SQ8

	JMS	SAVE	/SAVE XR,LR X10

	LAC	(BUFF+400

	DAC	REMCTA+2 /SET TO READ TO SECOND BUFF

	LAC	BUFF+377 /NEXT BLOCK #

	DAC	NEWBLK

	JMS	GETBLK

	JMS	RESTOR

	LAC	BUFF+776 /END POINTER FOR NEW BLOCK

	SPA

	CMA

	PAL
	CLX
	JMP	SQ31	/(032)ALREADY EMPTY?

/

/  FILL UP, IF POSSIBLE, HOLE AT END OF LAST BLOCK

/
SQ2	LAC	BUFF+400,X /-1 OR +1 FOR TYPE
	SPA!CLL		/SKIP IF INS ENTRY
	LAW	-INSSZ+REMSZ+1 /(031) ADJUST LENGTH; LINK SET NEXT INST.
	TAD*	(X10	/THE WHERE ARE WE NOW POINTER
	CMA!IAC
	TAD	(BUFF+376-INSSZ /ROOM, FLIPS LINK IF YES!
	SPA		/SKIP IF YES
	JMP	SQ4	/NOPE, NEED ANOTHER BLOCK
	LAW	-REMSZ	/LOOP CONTROL FOR ENTRY MOVE
	SZL		/SKIP IF REM, ALL SET
	LAW	-INSSZ	/INS, SET IT UP

	DAC	COUNT

SQ3	LAC	BUFF+400,X

	DAC*	X10

	AXR	1	/KEEP UP WITH XR

	ISZ	COUNT	/DONE

	JMP	SQ3
SQ31	AXS	0	/(032)OUT OF ENTRIES IN NEW BLOCK
	JMP	SQ2	/NOPE, TRY ANOTHQR MOVE

	LAC	BUFF+776 /HAVE WE MOVD ALL

	SMA		/SKIP IF YES

	JMP	SQ4	/THIS IS A FUNNY, BUT POSSIBL CASE

/

/  THE AMOUNT TO BE MOVED UP TO THE PREVIOUS DISK BLOCK

/  HAS GROWN TO A WHOLE BLOCK. JUST MOVE UP THE WHOLE BLOCK

/  DON'T RY TO COMPRESS ANY FURTHER.

/

SQ8	CLL!CML		/MAKE UP BUFF+376 POINTER AS EOF

	JMS	SQ376	/FROM POSITION OF X10

	LAC	(BUFF	/WRITE OUT FROM BUFF #1

	DAC	REMCTA+2

	LAC	CURBLK	/WRITE THE CURRENT BLOCK

	JMS	CONVRT

	JMS	PUTBLK

	JMP	REMNOD	/THAT'S ALL  WHEW!

/

SQ4	JMS	SAVE

	CLL

	JMS	SQ376	/ESTABLISH (+) LENGTH POINTER IN BUFF

	LAC	(BUFF

	DAC	REMCTA+2 /SET TO WRITE OLD BLOCK

	LAC	CURBLK

	JMS	CONVRT

	JMS	PUTBLK

	JMS	RESTOR

	LAC	(BUFF-1 /X10 TO PUSH #2 DOWN TO #1

	DAC*	(X10

	AXS	0	/SKIP IF NONE TO MOVE DOWN

	SKP		/SOME TO MOVE

	JMP	SQ6	/NO DATA TO MOVE, BUT MOVE POINTERS

SQ5	LAC	BUFF+400,X

	DAC*	X10

	AXS	1	/REMEMBER LR LIMIT ON #2

	JMP	SQ5

SQ6	LAC	NEWBLK	/UPDATE POINTERS

	DAC	CURBLK

	LAC	BUFF+777 /MOVE DOWN END OF BUFFER DATA

	DAC	BUFF+377

	LAC	BUFF+776

	DAC	BUFF+376

	JMP	SQ1	/UP TO TOP OF LOOP

/

SAVE	0

	LAC*	(X10

	DAC	SAV10

	PXA

	DAC	SAVX	

	PLA

	DAC	SAVL

	JMP*	SAVE

/

RESTOR	0

	LAC	SAV10

	DAC*	(X10

	LAC	SAVX

	PAX

	LAC	SAVL

	PAL

	JMP*	RESTOR

/

SAV10	0

SAVX	0

SAVL	0

COUNT	0

/

GETBLK	0

	JMS	CONVRT	/CALL WITH AC HAVING #, SET UP CAL

	CAL	GETREM	/FETCH DISK BLOCK

	CAL	WAITEV	/WAIT

	LAC	EV	/OK

	SPA

	JMP	DSKERR

	JMP*	GETBLK

/

/

/  SUBROUTINE  SQ376

/

/  MAKE UP FREE CORE POINTER FROM CONTENTS OF X10

/  WHICH HAS BEEN USED TO PLACED DATA IN BUFF #1

/

/  CALL WITH LINK =0 IF POINTER TO BE POSITIVE

/  CALL WITH LINK =1 IF POINTER TO BE COMPLEMENTED,

/  TO SHOW EOF

/

SQ376	0

	LAC	(BUFF-1 /X10 VALUE IF NOTHING PLACED

	CMA!IAC

	TAD*	(X10	/COMPLEMENT LINK, MAKE POINTER

	SNL		/SKIP TO KEEP POINTER POSITIVE

	CMA

	DAC	BUFF+376 /PLACE THE POINTER

	JMP*	SQ376

/

REMNOD=.

/ ********************

	.EJECT

	JMP	EXT1A	/EXIT

ERTTYA	LAC	(MES3)

ERRTY	DAC	TYPCPB+4	/PRINT TASK NOT IN SYSTEM ERROR

	CAL	TYPCPB	/MAKE TYPE CPB REQUEST

	CAL	WAITEV	/WAIT FOR ERROR MESSAGE TO BE PRINTED

	LAC	(15	/(027) MESSAGE MADE CR

	DAC	SVBKCH

	JMP	EXT1A

/

DSKERR	LAC	(MES4)

	JMP	ERRTY	/AND TYPE  MESSAGE

/

FILERR	LAC	(MES6

	JMP	ERRTY

/ 

///////
ACTIVE	.ENB		/ENABLE INTERRUPTS
	DZM	STLNOD	/(030) WE DON'T REALLY HAVE A NODE PULLED!
	DBK		/DEBREAK FROM LEVEL 6
	LAC	(MES1)
	JMP	ERRTY
/////////
/
ERRALS	DZM	STLNOD	/(032) NO NODE HAS BEEN PULLED!
	DBK		/(032) BACK TO LEVEL 7
	LAC	(MES7	/(032) ALIAS ERR MESSAGE
	JMP	ERRTY	/(032) JOIN ERROR TYPOUTS
EXT1A	LAC	STLNOD	/ADD NODE TO EMPTY POOL

	SNA		/(027) SKIP IF ONE

	JMP	EXT1B	/(027) NOPE, DON'T GIVE BACK

	DAC*	(R2

	LAC	(POOL

	DAC*	(R1

	JMS*	(NADD

EXT1B	LAC	SVBKCH	/GET TERMINATION CHARACTER

	SAD	(15)	/SKIP IF ALTMODE

	CAL	REQMCR	/REQUEST MCR TASK

	SAD	(175)	/IF ALTMODE DON'T CLEAR MCRRI

	DZM*	(MCRRI)	/CLEAR ^C SWITCH
	CAL	(10)	/RETURN
/
/ SETXR
/
SETXR	0
	TAD	XADJ
	PAX
	JMP*	SETXR
/
XADJ	0
/

/

REQMCR	1		/CALL MCR DIRECTIVE

	0

	.SIXBT	"..."

	.SIXBT	"MCR"

	0

REMNAM	4	/CANCEL DIRECTIVE

	EV	/EVENT VARIABLE ADDRESS

	0	/TASK NAME (FIRST HALF)

	0	/TASK NAME (SECOND HALF)

	.BLOCK	3

FLAGS	0

PARBA	0

STLNOD	0

/

DEALOC	1600	/DEALLOCATE CPB

	EV	/EVENT VARIABLE ADDRESS

	1	/LOGICAL UNIT NUMBER

	CNTRLT	/CONTROL TABLE ADDRESS

/

GETSIZ	3000	/GET A WORD FROM THE DISK

	EV	/EVENT VARIABLE ADDRESS

	1	/LUN NUMBER

	CNTRLU	/CONTROL TABLE ADDRESS

/

GETREM	3000

	EV

	1

	REMCTA

/ 

PUTREM	3100

	EV

	1

	REMCTA

/ 

REMCTA	0

	0

	BUFF

	400

/

ALLO	1500

	EV

	1

	ALLCTA

/

ALLCTA	400

	0

	0

/

CNTRLT	0	/NUMBER OF WORDS TO BE DELETED

CNTRLU	0	/UNIT NUMBER

CNTRLA	0	/DISK ADDRESS

CNTCD	CNTRLT	/CORE ADDRESS FOR GET

	1	/WORD COUNT FOR GET

/

TYPCPB	2700

	EV

	3

	2

	MES3

EV	0

/

WAITEV	20	/WAIT FOR

	EV	/EVENT VARIABLE ADDRESS

/

	.EJECT

/

/ SUBROUTINE CONVRT -- CHANGE BLK NUMBER IN AC TO

/	PLATTER AND ADDRESS AND ENTER INTO GET/PUT CTA

/

CONVRT	0					/(MJH-15)

	LMQ					/(MJH-15)

	LLSS!ECLA 10				/(MJH-15)

	DAC	REMCTA				/(MJH-15)

	LACQ					/(MJH-15)

	DAC	REMCTA+1			/(MJH-15)

	JMP*	CONVRT				/(MJH-15)

/

/ SUBROUTINE PUTBLK -- WRITE OUT A DISK BLOCK

/
PUTBLK	0					/(MJH-15)

	CAL	PUTREM		/ISSUE PUT	/(MJH-15)

	CAL	WAITEV		/WAIT FOR COMPLETE/(MJH-15)

	LAC	EV		/ANY ERRORS?	/(MJH-15)

	SPA					/(MJH-15)

	JMP	DSKERR		/YES		/(MJH-15)
	JMP*	PUTBLK		/(029) RETURN
	.EJECT

MES1	MES2-MES1/2*1000+2

	0

	.ASCII	"REM-TASK ACTIVE"<15>

MES2	MES3-MES2/2*1000+2

	0

	.ASCII	"REM-SYNTAX ERR"<15>

MES3	MES4-MES3/2*1000+2

	0

	.ASCII	"REM-TASK NOT IN SYSTEM"<15>

MES4	MES6-MES4/2*1000+2

	0

	.ASCII	'REM-DISK ERR'<15>
MES6	MES7-MES6/2*1000

	0

	.ASCII "REM-ALLOCATE ERROR"<15>
MES7	MES8-MES7/2*1000+2
	0
	.ASCII	"REM-TASK ALIAS PRESENT"<15>
MES8=.
/

/

/

SVBKCH	0

CNT	0

TEMP	0

CURBLK	0		/CURRENT BLK NO. FOR SRI CHAIN 	(MJH-15)

NEWBLK	0		/NEWLY ALLO'D BLK IN CHAIN	(MJH-15)

OLDPTR	0		/OLD BLKS FREE WD PTR		(MJH-15)

BUFF	.BLOCK 1000

	.END	REM
