
	.TITLE *** REMOVE TDV FUNCTION ***

/

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

/

	.EJECT

/ EDIT #15

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

/ EDIT #26 MAY-12-76 (SCR) COMPARE ON DISK ADDR, NOT NAME FOR SRI
/ EDIT #27 MAY-13-76 (SCR) FURTHER CLEANUP
/ EDIT #28 MAY-17-76 (SCR) MISMATCHED JMP*
/  EDIT #29 MAY-17-76 (SCR) FIX STLNOD FLAG HANDLING
/ EDIT #30 MAY-17-76 (SCR) LOST LINK IN SLEIGHT OF HAND
/ EDIT #32 MAY-18-76 (SCR) # TO MATCH REM;CHECK ALIAS
/ EDIT #33 MAY-18-76 (SCR) ALIAS; DON'T FIND SELF
/ EDIT #34 MAY-18-76 (SCR) INIT PROBLEM
/

/

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

/	MODIFIED FOR BLOCK DIRECTED SYSTEM 6/3/72  DAVE MCMILLEN

/       MODIFIED FOR BATCH 3/1/73  MARK HEBENSTREIT

/	XVM VERSION 6/3/75 MARK HEBENSTREIT

/

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

/

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

/

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

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

/	EXITS.

/

 .TITLE *** TDV FUNCTION 'REMOVE'

/

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 DON'T HAVE A NODE

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

	DAC	CNT	/SIX CHARACTERS (ZERO RIGHT FILL) 
	LAC*	(REMCTA+3	/IS A REM BLK ALLOCATED?

	SAD	(400

	JMP	.+3

	LAC	(MES7	/NO -- ERROR

	JMP	DSKERR+1

/

        CAL     RDTDV   /READ FROM TDV

        LAC     EV

        SPA

        JMP     ERR2
        LAC     (REMNAM+1)
        DAC*    (X10
	AND	(70000	/(032) MAKE XR ADJUST
	CMA!IAC
	DAC	XADJ	/(032)
REMN5   JMS     FAC     /CHECK FOR FIRST SPACE OR CR AM

        SAD     (40

        JMP     REMN1

        SAD     (15

        JMP     ERR1

        SAD     (175

        JMP     ERR1

        JMP     REMN5

/

/

REMN1   JMS     FAC     /FETCH A CHAR.

        SAD     (54     /COMMA?

        JMP     ERR1    /YES -- ERROR

        SAD     (40    /SPACE?

        JMP     ERR1     /YES -- ERROR

        SAD     (15     /CR?

        JMP     ENDCRA   /YES -- END OF LINE

        SAD     (175    /ALTMODE?

        JMP     ENDCRA   /YES -- END OF LINE

        DAC*    X10     /NO -- STORE CHAR

        ISZ     CNT      /LAST CHAR OF TASK NAME?

        JMP     REMN1     /NO -- GET NEXT CHAR

ERR1    LAC     (MES2    /SYNTAX ERROR

        JMP     ERRTY

/

ERR2    LAC     (MES5

        DAC     TYPCPB+4

        JMP     ERRTY

/

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) SYSTEM TASK LIST HEADER
FINDS	JMS	SETXR	/(033) SET UP THE XR FOR N,X ADDRESS
FINDL	LAC	0,X	/(032) FORWARD POINTER
	SAD	(STKL	/(032)WRAPPED AROUND?
	JMP	NOFIND	/(032)NO ALIAS NODE FOUND
	SAD	STLNOD	/(033) OUR OWN NODE?
	JMP	FINDS	/(033) YES, MISS COMPARE
	JMS	SETXR	/(032) CHECK OUT NEXT NODE
	LAC	S.DA,X	/(032) DISK ADDRESS FROM STL NODE
	SAD*	CNT	/(032) SAME AS OURS
	JMP	ERRALS	/(032) ALIAS ERROR, DON'T REMOV
	JMP	FINDL	/(032) NEXT NODE
/
NOFIND	LAC*	FLAGS	/(032) CHECK OUT FIXED IIN 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 SOME DATA IN BLOCK
	JMP	REM1J	/(034) NONE, 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) REMOVE DISK ADDR

	SAD	BUFF+5,X /(026) CHECK AGAINST INSTALL ENTRY DISK ADDR

	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	/(027) DISK ADDR

	DAC	BUFF+1,X

	JMS	PUTBLK	/REWRITE THE UPDATED BLOCK

	JMP	REMNOD	/THAT'S ALL

/

GETSOM	LAC	BUFF+376 /COMPLEMENT POINTER (TO +)

	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	/(027) PUT LOBCK WITH + POINTER

	LAC	CURBLK	/(027) RESTORE AC FOR GET

	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 ONTO NEW BLOCK. IF ERROR, PREVIOUS

/  BLOCK WILL NOT POINT TO BAD BLOCK.

/

	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		/(027) STOPPER FOR NEW BLOCK

	DAC	BUFF+377	/(027)

	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) COULD BE 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 /(030) ADJUST LENGTH; NEXT INST. SETS LINK.
	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

/

/

/ 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		/(028) RETURN

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)

REMNOD=.

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

	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	/(027) SO IT'S NOW THE BREAK

	JMP	EXT1A	/(027) NEED TO GIVE BACK NODE

/

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) WE HAVEN'T PULLED NODE
	DBK			/(032) BACK TO 7
	LAC	(MES7		/(032) ADDR OF MESSAGE
	JMP	ERRTY		/(032) JOIN FOR MESSAGE PRINT
EXT1A=.
	LAC	STLNOD	/ADD NODE TO EMPTY POOL

	SNA		/(027) SKIP IF REALLY ONE

	JMP	EXT1B	/(027) NOPE

	DAC*	(R2)

	LAC	(POOL)

	DAC*	(R1)

	JMS*	(NADD)	/ADD NODE TO EMPTY POOL

EXT1B	LAC	SVBKCH

	SAD	(15

	CAL	REQTDV
	CAL	(10)	/RETURN
/
/  SETXR
/
SETXR	0
	TAD	XADJ
	PAX
	JMP*	SETXR
/
XADJ	0
/
/
REQTDV	1		/CALL TDV DIRECTIVE

	0

	.SIXBT	"TDV"

	.SIXBT	"..."

	0

/  

/   FAC -- SUBROUTINE TO FETCH A CHAR FROM 5/7 ASCII LINE BUFFER

/   FACLB.  CHARS ARE NOT FETCHED BEYOND TERMINATOR.

/

FAC     0

        LAC*    FACCBX    /FETCH NEXT UNPACKED CHAR FROM FACCB

        SMA             /WAS BUFFER EMPTY?

        JMP     FAC2    /NO -- TEST FOR TERMINATOR

        LAC     (FACCB-1   /YES -- REFILL FACCB

        DAC     FACCBX

        LAC*    FACLBX   /1ST HALF OF WORD PAIR

        ISZ     FACLBX

        LMQ

        CLA!CLL

        JMS     FACUPS   /1ST CHAR

        JMS     FACUPS   /2ND CHAR

        JMS     FACUPS   /START OF 3RD CHAR

        LAC*    FACLBX

        ISZ     FACLBX

        LRS     17

        XOR*    FACCBX

        DAC*    FACCBX

        CLA

        JMS     FACUPS   /4TH CHAR

        JMS     FACUPS   /5TH CHAR

        LAC     (FACCB   /RESET CHAR BUFF INDEX

        DAC     FACCBX

        LAC*    FACCBX   /GET 1ST CHAR FROM BUFFER

FAC2    SAD     (15    /TEST FOR CR OR ALT.

        JMP*    FAC

        SAD     (175

        JMP*    FAC

/

        ISZ     FACCBX

        JMP*    FAC

/  

FACUPS  0         /UNPACKING S.R.    AC AND LINK MUST BE

        LLS     7   /CLEARED, NEXT CHAR MUST BE IN HIGH ORDER 

        ISZ     FACCBX  /MQ, FACCBX MUST POINT TO WORD PRECEEDING

        DAC*    FACCBX  /CHAR TO BE STORED.

        CLA

        JMP*    FACUPS

FACLBX  FACLB+2

FACCBX  FACCB+5

FACCB   .BLOCK   5

        -1

/

FACLB   .BLOCK   22

        .ASCII <15>

/

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

	15

	2

	MES3

EV	0

RDTDV   37       /READ TDV BUFFER

        EV

        FACLB

        22

/

/

WAITEV	20	/WAIT FOR

	EV	/EVENT VARIABLE ADDRESS

/

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	MES5-MES4/2*1000+2

	0

	.ASCII	'REM-DISK ERR'<15>

MES5    MES6-MES5/2*1000+2

        0

        .ASCII "REM-TDV ERROR"<15>

MES6	MES7-MES6/2*1000

	0

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

CNT	0

TEMP	0

BUFF	.BLOCK 1000

	.END	REM
