	.TITLE CONSTRUCT TASK (...CON)
/
/  24 OCT 77 (013) CHANGE INPUP LUN FROM 5 TO 18
/
/ 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 #12	MJH	MAKING BCON AND CON AGREE ON CHECKS
/  
/
/
/ THIS TASK CONSTRUCTS A TASK IMAGE IN AN RSX CREATED FILE RATHER
/ THAN IN ALLOCATED SPACE ON THE SYSTEM DISK. THE STL IS NOT MODIFIED
/ BY THIS TASK. BECAUSE OF THE CREATE A LUN NUMBER MUST BE GIVEN IN
/ THE COMMAND STRING. THIS TASK IS NEEDED TO IMPLEMENT THE 'EXECUTE'
/ FEATURE.
/ 
/ THE COMMAND STRING IS AS FOLLOWS:
/ 
/	MCR>CON(STRUCT) TSKNAM LUN$
/ 
/ NOTE : THIS TASK WAS EDITTED FROM INS.05 SRC
/
	.DEC							/(013)
ILUN=18								/(013)
	.OCT							/(013)
X10=10
X11=11
X15=15
MCRRI=171	/MCR REQUEST INHIBIT FLAG
IFAC=172	/INITIALIZE 'FAC'
FAC=174		/FETCH A CHARACTER (FROM THE COMMAND LINE)
IDX=ISZ
/
INSTAL=.	/BEGINNING OF INSTALL ROUTINE
I.BLOK=.	/(MJH-11) WARNING 1ST 400(8) LOCATIONS OVERLAYED ***
/STANDARD INSTALL TASK - A LINE MUST BE DECODED
	LAW	-2	/SET UP THE COMMA COUNT
	DAC	I.BCNT	/FOR PARTITION NAME SCAN
	JMS	I.GTNM	/CREATE A SIXBIT NAME BLOCK FROM THE LINE
	I.TSKN		/PLACE IT HERE
	JMP	I.ER01	/GO HERE ON AN ERROR
	JMS	I.TER	/WAS THE DELIMITING CHARACTER A DELIMITER?
	JMP	I.ER01	/YES -- NOT LUN GIVEN, ERROR
	JMS	NUMBER	/GET A LUN NUMBER
	JMP	I.ER01	/RETRUN HERE ON AN ERROR
	DAC	I.TEMP	/SAVE THE BREAK CHAR
	LACQ		/GET THE NUMBER
	SAD	(1	/IF IT'S ONE THAT'S AN ERR
	JMP	I.ER01
	DAC	LUN	/SAVE THE LUN
	DAC	I.DLET+2
	DAC	CREATE+2
	LAC	I.TEMP	/GET THE BREAK CHAR AGAIN
	JMS	I.TER	/IS IT A TERM?
	SKP
	JMP	I.ER01	/NO -- ERROR
	DAC	TERM	/SAVE THE LINE TERM
	JMP	I.INST	/NOW GO PREINSTALL THE TASK
I.ER01	LAC	(I.ME01	/ERROR IN SYNTAX, SHOW IT
	JMP	I.ERRR	/
/
/ROUTINE TO CREATE A NAME. THE TERMINATING CHARACTER IS LEFT IN THE
/AC UPON EXIT. IT CAN ONLY BE A TERMINATOR, SPACE, OR A COMMA.
/
I.GTNM	XX		/ENTRY/ARG/ERROR EXIT/NORMAL EXIT
	LAW	-2	/ALLOWED TWO TRIES FOR TWO WORDS
	DAC	I.ACNT	/SET THE COUNT
	LAC*	I.GTNM	/PICK UP THE ADDRESS OF THE BLOCK
	DAC	I.WRK	/SAVE IT
	ISZ	I.GTNM	/UP TO NORMAL RETURN
I.GTLP	DZM*	I.WRK	/CLEAR THE CHARACTER WORD
	JMS	I.GTC6	/GET A SIXBIT CHARACTER
	ALSS	14	/PUT IT IN IT'S PROPER PLACE
	DAC*	I.WRK
	JMS	I.GTC6	/SECOND
	ALSS	6	/PUT IT WHERE IT BELONGS
	XOR*	I.WRK
	DAC*	I.WRK
	JMS	I.GTC6	/LAST CHAR
	XOR*	I.WRK
	DAC*	I.WRK	/SIXBIT IS BUILT UP
	ISZ	I.WRK	/UP TO NEXT WORD
	ISZ	I.ACNT	/IF ALLOWED TO GO FOR MORE
	JMP	I.GTLP	/YES, CONTINUE
	JMS	I.GTFC	/NO, DONE, GET NEXT CHARACTER
	ISZ	I.GTNM	/TERMINATOR, LEAVE WITH IT IN THE AC AND A SKIP RETURN
	JMP*	I.GTNM	/RETURN TO INDICATE DONE
I.GTFC	XX	/SUB TO FETCH A CHARACTER AND SKIP IF ","," ", OR TERM
	JMS*	(FAC)	/PICKUP CHAR
	SAD	(40)	/TERMINATOR CHAR?
	JMP*	I.GTFC	/YES
	SAD	(54)	/?
	JMP*	I.GTFC	/YES
	JMS	I.TER	/?
	JMP*	I.GTFC	/YES
	ISZ	I.GTFC	/NO, SKIP RETURN
	JMP*	I.GTFC
I.GTC6	XX	/SUB TO GET THE NEXT CHARACTER AND RETURN IT AS SIXBIT
	JMS	I.GTFC	/FETCH CHARACTER, SKIP IF NORMAL
	JMP	I.GTQQ	/NOT NORMAL CHAR, WHAT IS HAPPENING?
	LMQ		/SAVE THE CHARACTER
	AAC	-40	/IS IT IN THE SIXBIT SET?
	SPA		/SKIP IF POSSIBLY
	JMP	I.GTCE	/NO, ERROR
	AAC	-100	/STILL IN THERE?
	SMA!SZA		/SKIP IF SO
	JMP	I.GTCE	/NO, ERROR
	SAD	(-40)	/WAS IT THE CHARACTER "@"?
	JMP	I.GTCE	/YES, ERROR
	LACQ		/SEEMS TO BE OK
	AND	(77)	/TRIM IT DOWN
	JMP*	I.GTC6	/AND LEAVE
I.GTCE	LACQ		/ERROR
	JMP*	I.GTNM	/LEAVE WITH TERMINAL CHARACTER IN AC AT ERROR EXIT
I.GTQQ	LMQ		/SAVE TERMINAL CHARACTER
	LAC*	I.WRK	/IS THIS THE FIRST OF THE THREE?
	SNA		/SKIP IF NOT
	JMP	I.GTQR	/YES, SEE IF THIS IS THE FIRST OF ALL
I.GTOK	LACQ		/ALL IS WELL, RETURN THE TERMINATING CHARACTER IN
	ISZ	I.GTNM	/IN THE AC WITH A SKIP RETURN
	ISZ	I.WRK	/SET UP FOR POSSIBLE CLEARING OF SECOND WORD
	ISZ	I.ACNT	/SKIP IF NOW WORKING ON SECOND WORD
	DZM*	I.WRK	/CLEAR SECOND WORD IF IT HASN'T BEEN CLEARED
	JMP*	I.GTNM
I.GTQR	LAW	-2	/CHECK TO SEE
	SAD	I.ACNT	/IF THE COUNT IS AT -2
	SKP		/IT IS, CHECK THE CHARACTER
	JMP	I.GTOK	/IT IS NOT, LEAVE WITH TERMINATING CHARACTER IN AC
	LACQ		/IS THIS CHARACTER A SPACE?
	SAD	(40)	/SKIP IF NOT
	JMP	I.GTC6+1	/IT IS, IGNORE LEADING SPACES
	JMP*	I.GTNM	/IT IS NOT, ERROR EXIT WITH CHAR IN AC
/
I.TER	XX	/ROUTINE TO SKIP IF NOT CR OR ALTMODE
	SAD	(15)	/CR?
	JMP*	I.TER	/YES
	SAD	(175)	/ALTMODE?
	JMP*	I.TER	/YES
	ISZ	I.TER	/NEITHER,
	JMP*	I.TER	/SKIP RETURN
/
I.INST=.	/REAL WORK STARTS HERE
/
/CODE TO DO THE INSTALL WORK:
/
/NOTE: ALL DISK ADDRESS CARRIED AROUND DURING PROCESSING, AND PASSED ON
/TO THE RSX EXECUTE PROGRAM VIA THE LINK TABLE ARE OF THE FORM
/ BLOCK NUMBER * 400 + UNIT NUMBER. THE 'ADD' INSTRUCTION INSTEAD OF THE
/'TAD' INSTRUCTION IS USED TO CALCULATE DISK ADDRESSES, AS THIS WILL
/INCREMENT THE UNIT NUMBER IF AN OVERFLOW OCCURS.
/
/
	CAL	ATTACH	/ATTACH THE LUN 'ILUN' DEVICE		/(013)
	CAL	I.WAIT	/WAIT FOR THE EV
	LAC	I.EV	/ALL OK?
	SMA		/SKIP IF NOT
	JMP	I.OVRY	/YES, CONTINUE
	SAD	(-6)	/NO ATTACH ALLOWED?
	SKP		/TRUE, SO CONTINUE
	JMP	I.ER13	/TREAT THIS AS A FILE NOT FOUND SITUATION
I.OVRY=.
/
	JMS	SEEK	/SEEK THE FILE
	LAC	(377777)	/FIND LINK #377777 FOR INFO
	DAC	I.LKNM	/
	DZM	I.ACNT	/COUNTING THE LINKS ON THE WAY
	JMS	I.FLNK	/GO DO IT
	LAC	INBUF+4	/BASE OF BLANK COMMON
	DAC	I.BCBS	/SAVED FOR PATCHING
/
	LAC	I.ACNT	/THE COUNT OF EXTERNAL LINKS+1 FOR THE ALLOCATION
	ALSS	10	/MULTIPLY BY 400
	TAD	INBUF+5	/NOW WE HAVE THE NUMBER OF BLOCKS *400
	AAC	377	/NEEDED TO HOLD THE IMAGE
	AND	(-400)	/ON THE DISK, WITH EACH OVERLAY
	DAC	I.ALSZ	/STARTING ON A BLOCK BOUNDARY
	CLL		/SET THE CREATE CTA WITH THE NO. OF BLOCKS
	LRS	10
	DAC	CRECTA+3
/
	LAC	INBUF+7	/SAVE THE BASE ADDRESS OF THE LINK TABLE
	DAC	I.LTBS
/
	LAC	INBUF+6	/AND THE SIZE OF THE RESIDENT IMAGE
	DAC	I.RISZ
/
	LAC	INBUF+11	/SAVE THE
	DAC I.ENTR	/ TASK ENTRY POINT.			/(012)
	RTL		/ PUT EXEC/NORMAL INDICATOR IN LINK.	/(012)
	SMA		/ NORMAL MODE?				/(012)
	JMP I.EXEC	/ NO, EXEC MODE.			/(012)
	LAC INBUF+15	/ FETCH TASK SIZE.			/(012)
	TAD (400)	/ AND MAKE SURE ANOTHER BOUARRY BIT IS	/(012)
			/ USED.					/(012)
	AND (777400)						/(012)
	DAC I.MXTR	/ SAVE FOR SETTING M-BOX BITS.		/(012)
	LAC INBUF+16	/ FETCH XVM AND IOT BITS.		/(012)
	DZM INBUF+16	/ CLEAR INDICATORS IN BUFFER.		/(012)
	RTR		/ PUT MBOX BIT IN SIGN, IOT BIT IN LINK	/(012)
	SPA!CLA		/ WIDE ADDRESSING ON?			/(012)
	AAC 140		/ YES.					/(012)
	SZL		/ IOT MODE ON?				/(012)
	AAC 20		/ YES.					/(012)
	XOR I.MXTR	/ MERGE BITS WITH TASK SIZE.		/(012)
	JMP I.0010	/ GO JOIN COMMON CODE.			/(012)
								/(012)
I.EXEC	LAC INBUF+14	/ FETCH PARTITION BASE.			/(012)
	TCA		/ SET UP TO SUBTRACT FROM HIGHEST USED	/(012)
	TAD INBUF+15	/ REGISTER.				/(012)
	IAC		/ AC= TASK SIZE.			/(012)
								/(012)
I.0010	DAC I.MXTR	/ TASK SIZE AND CONTROL BITS SET UP.	/(012)
								/(012)
	LAC	INBUF+12	/MOVE THE PARTITION NAME IN
	DAC	I.PTNM
	LAC	INBUF+13
	DAC	I.PTNM+1
/
	LAC	INBUF+14	/SAVE THE BASE
	DAC	I.CORB	/ADDRESS OF THE PARTITION ACCORDING TO TKB
	DAC	I.LCOR	/SAVE THIS FOR LINK TABLE EXPANSION (&LINK #0)
/
I.RELM	LAC	INBUF+10	/GET PRIO GIVEN TO TKB
	DAC	I.DFPR	/YES, SAVE THIS
/
I.ALLD	CAL	I.HINF	/DO A HINF TO GET DEVICE AND UNIT
	CAL	I.WAIT
	LAC	I.EV	/WERE THERE ANY ERRORS?
	SPA
	JMP	I.ER06	/YES
	AND	(77	/NO -- GET THE DEVICE CODE
	DAC	I.GETC+4
	DAC	I.PUTC+4
	LAC	I.EV	/GET THE UNIT NO.
	AND	(700
	CLL
	ALS	11
	DAC	I.UNIT	/SAVE THE UNIT NO.
	LAC	I.TSKN	/ENTER TASK NAME INTO CPB'S AS NEEDED
	DAC	CRECTA
	DAC	I.DLET+3
	LAC	I.TSKN+1
	DAC	CRECTA+1
	DAC	I.DLET+4
	CAL	I.DLET	/DELETE CREATED FILE IF IT EXISTS	/(012)
	CAL	CREATE	/DO THE CREATE
	CAL	I.WAIT
	LAC	I.EV	/WERE THERE ANY ERRORS?
	SPA
	JMP	I.ER06
	LAC	CRECTA+7
	AND	(377
	DAC	I.ALSZ+1	/SAVE THE PLATTER NO.
	LAC	CRECTA+10
	DAC	I.ALSZ+2
	ISZ	I.DSKA	/YES, SHOW THAT WE HAVE ALLOCATED DISK SPACE
/
/THE DISK SPACE HAS BEEN ALOCATED. NOW TO
/BRING THE CODE IN.
/
	LAC	I.ALSZ	/PICK UP THE SIZE OF THE ALLOCATION
	DAC	I.BLOK	/SET THIS IN AS WORD ZERO OF THE BLOCK
/
/  EDIT #3 CHANGE
/
	LAC	I.PTNM	/NAME
	DAC	I.BLOK+1
	LAC	I.PTNM+1
	DAC	I.BLOK+2
	LAC	I.CORB	/BASE
	DAC	I.BLOK+3
/
/  END EDIT #3 CHANGE
/
	LAC	I.ALSZ+2	/SET UP THE DISK GET/PUT CONTROL TABLE
	DAC	I.PCPB+1	/SO THE FIRST WRITE WILL SEND OUT
	LAC	I.ALSZ+1	/THE BLOCK WITH THE ALLOCATION SIZE IN IT
	DAC	I.PCPB
	XOR	I.ALSZ+2	/SET THIS BLOCK (IN CORE) AS BEING THE
	DAC	I.THIS	/FIRST ONE
	ADD	(400)	/NOW UP TO THE BLOCKS TO BE USED
	DAC	I.DSKB	/SAVE AS BASE OF LINK ZERO
	DAC	I.LBSE	/SET THIS ALSO AS THE BASE FOR THE FIRST LINK
	LAW	-1	/SHOW THAT CURRENT BLOCK HAS BEEN MODIFIED
	DAC	I.WRIT	/SO IT WILL BE WRITTEN OUT
	LAC	(I.BLOK+3	/SET UP TO PUT STL DATA INTO HEADR BLK
	DAC*	(X11
	LAC	(I.TSKN-1
	DAC*	(X10
	LAW	-10
	DAC	I.TEMP
	LAC*	X10
	DAC*	X11
	ISZ	I.TEMP
	JMP	.-3
	LAC	I.ACNT	/SAVE THE NO. OF EXTERNAL LINKS PLUS ONE
	DAC	I.BLOK+14
	LAC	I.LTBS	/SAVE THE BASE OF THE LINK TABLE
	DAC	I.BLOK+15
/
/EXPAND THE LINK TABLE IF IT EXISTS
/
	JMS	I.EXPL	/DO IT
	CAL	CLOSE	/CLOSE THE FILE
	JMS	SEEK	/RE-SEEK THE FILE
	DZM	I.LKNM	/FIND LINK #0
	JMS	I.FLNK	/
I.LOOP	JMS	I.EXPL	/EXPAND THIS LINK
	LAC	I.MXDK	/PICK UP THE MAXIMUM DISK BLOCK USED
	SZA
	JMP	.+3
	LAC	I.THIS
	DAC	I.MXDK
	ADD	(400)	/UP TO THE NEXT ONE
	DAC	I.WRK	/SAVE THIS AS THE BASE FOR THE NEXT LINK
	LAC	INBUF+3	/LAST LINK?
	SAD	(377777)	/SKIP IF NOT
	JMP	I.DEXP	/YES, DONE EXPANDING THE TSK FILE
	JMS	I.LKTB	/NO, SET UP THE LINK TABLE FOR THE NEXT LINK
	JMP	I.LOOP	/ AND GO FOR MORE
/
/SUBROUTINE TO READ THROUGH UNTIL A CERTAIN LINK IS FOUND
/
I.FLNK	XX		/LINK NUMBER IS IN I.LKNM
	JMS	READ	/READ A RECORD
	LAC	INBUF+2	/IS THIS A TYPE ONE RECORD?
	AND	(IOT)
	SAD	(JMS)	/SKIP IF NOT
	JMP	I.OVRP	/IT IS, IS IT THE ONE WE WANT?
	SNA		/IT ISN'T - ERROR VIA TYPE 0 RECORD?
	JMP	I.ER10	/YES, LEAVE
	JMP	I.FLNK+1	/CYCLE ON FOR MORE
I.OVRP	LAC	INBUF+3	/TYPE ONE RECORD FOUND, IS IT THE ONE WE WANT?
	SAD	I.LKNM	/SKIP IF NOT
	JMP*	I.FLNK	/IT IS, LEAVE
	ISZ	I.ACNT	/IT IS NOT, COUNT THE LINKS FOUND
	NOP		/ANYWAY
	JMP	I.FLNK+1	/AND GO FOR MORE
/
/
/SUBROUTINE TO EXPAND A LINK. THE TYPE ONE RECORD HAS BEEN READ. UPON
/EXIT, A TYPE ONE RECORD WILL BE IN 'INBUF'.
/
I.EXPL	XX
	DZM	I.MXDK	/CLEAR OUT THE HIGHEST DISK ADDRESS USED
/
/I.LBSE SHOULD CONTAIN THE BASE DISK ADDRESS FOR THIS LINK
/I.LCOR SHOULD CONTAIN THE BASE CORE ADDRESS THAT CORESPONDS TO I.LBSE
/
I.EXLP	LAC	(INBUF+2)
	DAC	I.PNTR	/SET UP FOR 'GETW' ROUTINE
	JMS	READ	/READ A RECORD
	LAC	INBUF+2	/IS IT A TYPE TWO RECORD?
	AND	(IOT)
	SAD	(LAC)	/SKIP IF NOT
	JMP	I.TYP2	/IT IS, PROCESS IT
	SAD	(ADD)	/TYPE THREE?
	JMP	I.TYP3	/YES, PROCESS IT
	SAD	(JMS)	/TYPE ONE?
	JMP*	I.EXPL	/YES, LEAVE
	LAC	INBUF+2	/IS THIS THE EOF ON LINK EXPANSION?
	SZA		/MAYBE
	JMP	I.ER10	/NO, READ ERROR
	LAC	I.LKNM	/CHECK TO SEE IF THIS IS LINK 377777
	SAD	(377777)	/SKIP IF NOT
	JMP*	I.EXPL	/IT IS, LEAVE
	JMP	I.ER10	/IT ISN'T - READ ERROR
I.TYP2	JMS	I.GETW	/PICK UP THE COUNT
	SAD	(-1)	/SKIP IF NOT THE END OF THE RECORD
	JMP	I.EXLP	/IT IS, GO FOR MORE RECORDS
	AND	(077777)	/SINGLE IT OUT
	TCA		/NEGATE IT
	DAC	I.ACNT	/SAVE IT
	JMS	I.GETW
	JMS	I.GETA	/PICK UP AN ADDRESS AND READ THAT BLOCK INTO CORE
I.T2LP	JMS	I.GETW	/PICK UP A WORD
	JMS	I.PUTW	/SET IT DOWN
	ISZ	I.ACNT	/SKIP WHEN DONE
	JMP	I.T2LP	/UNTIL THEN
	JMP	I.TYP2	/GO UNTIL DONE
/
/SUBROUTINE TO PICK UP ONE WORD FROM THE BUFFER
/
I.GETW	XX
	LAC*	I.PNTR	/PICK IT UP
	ISZ	I.PNTR	/INCREMENT IT
	JMP*	I.GETW	/AND LEAVE
/
/SUBROUTINE TO PUT ONE WORD INTO THE DISK BLOCK
/(A CALL TO I.GETA SHOULD BE DONE FIRST TO SET UP THE PARAMETERS)
/
I.PUTW	XX
	DAC*	I.DPNT	/SET IT IN
	LAW	-1	/SHOW THAT THE BLOCK
	DAC	I.WRIT	/HAS BEEN MODIFIED
	ISZ	I.DPNT	/INCREMENT THE POINTER
	ISZ	I.BCNT	/SEE IF THE END OF THE BLOCK HAS BEEN REACHED
	JMP*	I.PUTW	/IT HASN'T, LEAVE
	LAC	I.THIS	/GO TO THE NEXT BLOCK
	ADD	(400)	/FOR THE CONTINUATION OF THIS ESCAPADE
	JMS	I.XDSK	/PICK UP THE BLOCK 
	LAC	(I.BLOK)	/AND RESET THE
	DAC	I.DPNT	/POINTERS
	LAW	-400	/TO THE DISK
	DAC	I.BCNT	/BLOCK
	JMP*	I.PUTW	/LEAVE
/
/SUBROUTINE TO SEE THAT THE DISK BLOCK THAT WILL CONTAIN A CERTAIN ADDRESS
/IS IN CORE, AND TO SET UP POINTERS FOR I.PUTW
/CALL WITH THE DESIRED CORE ADDRESS IN THE AC - IT WON'T BE THERE ON RETURN
/
I.GETA	XX
	AND	(77777)
	TCA	/NEGATE
	TAD	I.LCOR	/ADD IN THE BASE
	TCA		/POP BACK TO POSITIVE
	DAC	I.DPNT	/SAVE
	AND	(-400)	/FIND OUT WHICH RELATIVE BLOCK
	ADD	I.LBSE	/FIND OUT WHICH ACTUAL BLOCK
	JMS	I.XDSK	/BRING THAT ONE INTO CORE
	LAC	(377)	/NOW WE PICK UP
	AND	I.DPNT	/THE OFFSET INTO THE DISK BLOCK
	AAC	-400	/CREAT THE NUMBER OF WORDS LEFT IN THE BLOCK
	DAC	I.BCNT	/SAVE THIS AS A COUNTER FOR I.PUTW
	TAD	(I.BLOK+400)	/UP TO THE CORE ADDRESS IN REAL CORE
	DAC	I.DPNT	/WHERE THE WORD IS
	JMP*	I.GETA	/LEAVE
/
/SUBROUTINE TO MAKE CERTAIN THAT THE CORRECT BLOCK IS IN CORE. THE
/ONE CURRENTLY IN CORE IS WRITTEN OUT, IF IT HAS BEEN MODIFIED (I.WRIT=-1)
/
I.XDSK	XX		/ENTRY
	DAC	I.BCNT	/SAVE THIS
	XOR	I.THIS	/IS THE BLOCK THE ONE THAT IS IN CORE?
	SNA		/SKIP IF NOT
	JMP*	I.XDSK	/IT IS, LEAVE
	XOR	I.THIS	/RESORE THE ORIGINAL AC CONTENTS
	LMQ		/FIND OUT IF THE BLOCK JUST ABOUT TO BE READ IN
	LLS	12	/IS HIGHER NUMBERED THAN THE ONE SHOWN IN I.MXDK
	DAC	I.GETW	/SAVE THIS
	LAC	I.MXDK	/PICK UP THE CURRENT MAXIMUM
	LMQ
	LLS	12	/CREATE A PROPER COMPARISON NUMBER
	TCA		/NEGATE
	TAD	I.GETW	/ADD IN THE ONE WE ARE ABOUT TO GET
	RAL		/SAVE THE SIGN
	LAC	I.BCNT	/PICK UP THE ONE WE WANT
	SNL		/SKIP IF IT IS LOWER
	DAC	I.MXDK	/IF HIGHER OR EQUAL, RESET I.MXDK
	ISZ	I.WRIT	/HAS THE CURRENT RECORD BEEN MODIFIED?
	JMP	.+5	/NO, SO JUST READ THE NEW ONE IN
	JMS	I.EUN
	CAL	I.PUTC	/PUT OUT THE CURRENT BLOCK
	JMS	I.WFEV	/WAIT UNTIL DONE
	JMS	I.RUN
	DZM	I.WRIT	/CLEAR THE 'THE BLOCK HAS BEEN MODIFIED' FLAG
	LAW	777400	/PICK UP THE
	AND	I.BCNT	/BLOCK NUMBER
	DAC	I.PCPB+1	/AND SET IT IN THE DISK CONTROL TABLE
	XOR	I.BCNT	/PICK UP THE UNIT NUMBER
	DAC	I.PCPB	/AND SET IT IN ALSO
	XOR	I.PCPB+1	/NOW SET THE CURRENT BLOCK POINTER
	DAC	I.THIS	/TO POINT TO WHERE WE ARE NOW
	JMS	I.EUN
	CAL	I.GETC	/GET THE NEW BLOCK
	JMS	I.WFEV	/WAIT
	JMS	I.RUN
	JMP*	I.XDSK	/AND LEAVE
/
/
I.TYP3	XOR	INBUF+2	/PICK UP THE TOTAL NUMBER OF PATCHES
	SPA!SNA		/SKIP IF THERE ARE ANY
	JMP	I.EXLP	/NO, LOOK FOR SOMETHING ELSE TO DO
	DAC	I.TOTP	/SAVE THIS
I.T3LP	ISZ	I.PNTR	/FIND OUT HOW MANY
	JMS	I.GETW	/PATCHES ON THIS RECORD
	SPA!SNA!TCA	/SKIP IF THERE ARE ANY
	JMP	I.EXLP	/NO, CARRY ON WITH THE NEXT RECORD
	DAC	I.CCNT	/YES, SAVE THE COUNT
	TAD	I.TOTP	/AND SUBTRACT THIS FROM THE TOTAL
	DAC	I.TOTP
I.T3LQ	LAC*	I.PNTR	/PICK UP THE ADDRESS
	AND	(077777)	/WHERE THE PATCH GOES
	JMS	I.GETA	/MAKE SURE THAT IT IS IN CORE
	JMS	I.GETW	/FIND OUT WHAT THE FUNCTION IS
	AND	(IOT)
	SAD	(JMS)	/IS IT ADDRESS FIELD MODIFICATION?
	JMP	I.T3AD	/YES, DO IT
	SAD	(LAC)	/IS IT BLANK COMMON OFFSET?
	JMP	I.T3CO	/YES
	SZA		/IS IT SIMPLE REPLACEMENT?
	JMP	I.ER10	/NO, MUST BE A READ ERROR
	JMS	I.GETW	/PICK UP THE WORD
I.T3BK	DAC*	I.DPNT	/SET IT IN THE DISK BLOCK
	LAW	-1	/SET THE 'MODIFIED BLOCK' FLAG
	DAC	I.WRIT	/TO SHOW THAT WE CHANGED THE BLOCK
	ISZ	I.CCNT	/COUNT THE PATCHES
	JMP	I.T3LQ	/NOT YET DONE, GO FOR MORE
	LAC	I.TOTP	/ARE WE COMPLETELY DONE?
	SPA!SNA		/SKIP IF NOT
	JMP	I.EXLP	/YES, READ A TYPE ONE RECORD
	JMS	READ	/NO, RESET FOR THE NEXT PATCH RECORD
	LAC	(INBUF+2)
	DAC	I.PNTR	/SET UP FOR 'GETW'
	LAC	INBUF+2	/MAKE CERTAIN THAT THIS IS
	AND	(IOT)	/A TYPE THREE RECORD
	SAD	(ADD)	/SKIP IF NOT
	JMP	I.T3LP	/IT IS, FINISH UP
	JMP	I.EXLP+3	/IT ISN'T, WHAT HAPPENED???
I.T3AD	LAC	I.ENTR	/PICK UP THE TASK ENTRY POINT
	RAL		/BANK/PAGE BIT TO AC0
	SMA!CLA
	LAC	(010000)	/PAGE MODE, MUST KEEP THE INDEX BIT
	XOR	(760000)	/CREATE A MASK
	PAL		/SAVE THIS
	AND*	I.DPNT	/PICK UP THE INSTRUCTION FIELD ONLY
	LMQ		/SAVE THIS
	PLA		/BRING THE MASK BACK
	CMA		/FLIP IT OVER
	AND*	I.PNTR	/BRING IN THE NEW ADDRESS FIELD
	OMQ		/AND BRING THE INSTRUCTION OUT
	ISZ	I.PNTR	/UP THE POINTER
	JMP	I.T3BK	/AND PUT THIS AWAY
I.T3CO	JMS	I.GETW	/PICK UP THE WORD
	TAD	I.BCBS	/ADD IN THE BASE OF BLANK COMMON
	JMP	I.T3BK	/AND PUT THE WORD AWAY
/
/
/SUBROUTINE TO SET UP THE LINK TABLE FOR THE LINK ABOUT TO BE PROCESSED
/
I.LKTB	XX
	LAC	I.CORB	/SET UP TO ACCESS ON LINK 0 LEVEL
	DAC	I.LCOR	/AS THIS IS LINK TABLE MODIFICATION
	LAC	I.DSKB
	DAC	I.LBSE
	LAC	I.LTBS	/PICK UP THE BASE ADDRESS OF THE LINK TABLE
	IAC		/PLUS ONE
I.LKLP	DAC	I.PNTR	/SAVE THIS
	JMS	I.GETA	/BRING THIS INTO CORE
	LAC*	I.DPNT	/IS THIS THE END OF THE LINK TABLE?
	SAD	I.LTBS	/SKIP IF NOT
	JMP	I.LKUP	/IT IS, SET UP FOR THE NEXT LINK
	LAC	I.PNTR	/PICK UP THE
	AAC	7	/LINK NUMBER WORD
	JMS	I.GETA	/
	LAC*	I.DPNT	/IS THIS THE LINK WE ARE WORKING ON NOW?
	SAD	INBUF+3	/SKIP IF NOT
	JMP	I.LKBS	/IT IS, SET UP THE DISK ADDRESS ON THIS ONE
I.LKMR	LAC	I.PNTR	/IT ISN'T, UP TO THE NEXT ONE
	AAC	13	/IN THE TABLE
	JMP	I.LKLP
/
/NOTE: EARLIER VERSIONS USED THE MINIMUM ADDRESS WORD TO FLAG THE LINKS
/THAT HAD BEEN UPDATED. HOWEVER, WITH THE LOW END OF THE DISK ALLOCATED
/TO THE SYSTEM IMAGE, IT IS VERY UNLIKELY THAT THE LINK NUMBERS WILL
/REACH THE SAME MAGNITUDE AS THE DISK ADDRESS THAT REPLACES IT.
/THEREFORE, THE SAD SHOULD BE ENOUGH.
/
I.LKBS	LAC	I.WRK	/SET THE BASE ADDRESS OF THIS LINK
	JMS	I.PUTW	/IN THE LINK TABLE
	LAC*	I.DPNT	/AND SET THE MINIMUM ADDRESS OF THE LINK
	DAC	I.TMP	/IN A SAFE PLACE FOR SETTIN I.LCOR WHEN DONE
	JMP	I.LKMR	/NOW LOOK AT THE NEXT LINK
/
I.LKUP	LAC	I.TMP	/SET THE CORE BASE ADDRESS FOR THIS LINK
	DAC	I.LCOR	/IN FOR DISK ADDRESS ADJUSTING
	LAC	I.WRK	/SET THE DISK BASE ADDRESS CORRESPONDING TO
	DAC	I.LBSE	/I.LCOR IN ALSO
	JMP*	I.LKTB	/AND LEAVE
/
/
/THE WHOLE THING IS DONE, NOW TO MAKE THE STL ENTRY FOR THIS TASK
/AND LEAVE THIS BLOODY MESS.
/
I.DEXP=.
	CAL	CLOSE	/CLOSE THE FILE
	CAL	DETACH	/AND DETACH THE DEVICE
	CAL	I.WAIT
	ISZ	I.WRIT	/DOES THE DISK BLOCK NEED RE-WRITING?
	JMP	I.DOVR	/NO, GO CLEAN UP
	JMS	I.EUN
	CAL	I.PUTC	/YES, WRITE IT OUT
	JMS	I.WFEV	/AND WAIT FOR IT
	JMS	I.RUN
I.DOVR	CAL	DETACH	/DETACH DEVICE ON LUN 'ILUN'		/(013)
	CAL	I.WAIT
	LAC	TERM	/PICK UP THE TERMINATING CHARACTER AGAIN
	SAD	(175
	JMP	.+3
LEAVE	CAL	REQMCR	/YES, REQUEST THE MCR ROUTINE
	CAL	(10)	/AND EXIT
	DZM*	(MCRRI
	CAL	(10
/
REQMCR	1	/CPB TO REQUEST '...MCR' KEYBOARD LISTENER
	0	/NO EV
	.SIXBT	'...MCR'
	0	/DEFAULT PRIORITY
/
/
/SEEK SUBORUTINE
/
SEEK	XX
	LAC	I.TSKN	/PICK UP THE
	DAC	DTSEEK+3
	LAC	I.TSKN+1
	DAC	DTSEEK+4	/TASK NAME AND PUT IT IN THE CPB
	CAL	DTSEEK	/SEEK THE FILE
	CAL	I.WAIT	/WAIT FOR THE EV
	LAC	I.EV	/WAS THIS ALL OK?
	SMA		/SKIP IF NOT
	JMP*	SEEK
	SAD	(-6)	/ONLY THAT THE FUNCTION IS NOT HONOURED?
	JMP*	SEEK	/YES
I.ER13	LAC	(I.ME13)	/NO, FILE NOT FOUND
	JMP	I.ERRR	/SHOW IT
/
/READ SUBROUTINE
/
READ	XX
	CAL	DTREAD	/READ A LINE
	CAL	I.WAIT	/WAIT FOR IT
	LAC	I.EV	/WHAT DOES THE ALL-KNOWING EV HAVE TO SAY?
	SPA		/SKIP IF IT SAYS ALL OK
	JMP	I.ER10	/JUMP FOR ERROR IF NOT
	LAC	INBUF	/SO FAR SO GOOD - NOW WHAT DOES THE HEADER SAY?
	AND	(77)	/SINGLE OUT THE GOODIE BITS
	SNA		/UH-OH - WE ARE SKIPPING IF SOME BITS ARE ON
	JMP*	READ	/NO SKIP - ALL OK
	ALS	14	/BRING THE CHECKSUM BIT TO AC0
	SPA!RAL		/SKIP IF NOT CHECKSUM
	JMP	I.ER10	/IT IS A CHECKSUM ERROR
	SPA		/SKIP IF NOT PARITY ERROR
	JMP	I.ER10	/PARITY ERROR, SHOW IT
	DZM	INBUF+2	/CLEAR THE RECORD TYPE, JUST IN CASE
	LAC	INBUF
	SAD	(1005)	/EOF?
	JMP*	READ	/YES, QUIT
	SAD	(1006)	/EOM?
	JMP*	READ	/YES, FORGET IT
I.ER10	LAC	(I.ME10)	/DECTAPE ERROR - (EOF OR EOM?) SAY SOMETHING
	JMP	I.ERRR
/
/ SUBROUTINE I.EUN -- ADD UNIT NUMBER TO GET OR PUT CTA
/ 
I.EUN	0
	LAC	I.PCPB
	XOR	I.UNIT
	DAC	I.PCPB
	JMP*	I.EUN
/
/ SUBROUTINE I.RUN -- REMOVE UNIT NUMBER
/
I.RUN	0
	LAC	I.PCPB
	AND	(777
	DAC	I.PCPB
	JMP*	I.RUN
/
/ SUBROUTINE NUMBER -- READ A DECIMAL NUMBER OF UP TO 3 DIGITS
/			OFF THE MCR TTY.
/ 
/ ALTERED REGISTERS: AC AND MQ
/ 
/ CALLING SEQUENCE:
/		JMS	NUMBER
/		JMP	???	/RETURN HERE IF 1ST CHARACTER
/				/AFTER A BUNCH OF SPACES IS NOT
/				/A DECIMAL DIGIT WITH THE CHARACTER
/				/IN THE AC.
/		???	???	/RETURN HERE IF 1ST CHARACTER
/				/AFTER A BUNCH OF SPACES IS A DECIMAL
/				/DIGIT WITH THE BREAK CHARACTER IN THE
/				/AC AND THE NUMBER IN THE MQ.
/ 
NUMBER	0
	LAW	-3		/SET DIGIT COUNTER
	DAC	COUNT
	DZM	NUM		/ZERO PREVIOUS RESULTS
	CLC			/SET A FLAG TO INDICATE THAT SPACES
	DAC	NUMFLG		/ARE NOT BREAK CHARACTERS YET.
NUM1	JMS*	(FAC		/GET A CHARACTER
	SAD	(40		/WAS THE CHARACTER A SPACE?
	JMP	NUMSPC		/YES
	DZM	NUMFLG		/NO -- CLEAR FLAG TO INDICATE THAT ANY
				/SPACES ENCOUNTERED SHOULD BE USED AS
				/BREAK CHARACTERS.
	DAC	NUMT		/SAVE IT TEMPORARILY
	AAC	-60		/IS IT A DIGIT?
	SPA
	JMP	NUM2		/NO -- EITHER A BREAK OR AN ERROR
	DAC	CHAR		/SAVE THE POTENTIAL DIGIT
	AAC	-12
	SMA
	JMP	NUM2		/NO -- EITHER A BREAK OR AN ERROR
	LAC	NUM		/YES -- PICK UP THE REAL NUMBER
				/THAT HAS ALREADY BEEN CONSTRUCTED
	CLL
	MUL			/MULTIPLY IT BY 10 DECIMAL
	12
	LACQ			/GET RESULT INTO AC
	TAD	CHAR		/ADD THE DIGIT JUST READ
	DAC	NUM		/SAVE THE RESULTING DECIMAL NUMBER
	ISZ	COUNT		/HAVE 3 DIGITS BEEN READ?
	JMP	NUM1		/NO -- READ SOME MORE
	JMS*	(FAC		/YES -- READ A BREAK CHARACTER
NUM3	DAC	CHAR		/SAVE THE CHARACTER TEMPORARILY
	IDX	NUMBER		/PREPARE TO RETURN AT JMS+2
	LAC	NUM		/PICK UP THE DECIMAL NUMBER
	LMQ			/STORE IT IN THE MQ
	LAC	CHAR		/GET THE BREAK CHAR INTO THE AC
	JMP*	NUMBER		/RETURN AT JMS+2
NUM2	LAW	-3		/CHARACTER IS EITHER A BREAK OR ERROR
	SAD	COUNT		/IF THIS WAS THE 1ST CHARACTER READ
				/ITS AN ERROR. OTHERWIZE ITS A BREAK.
	JMP	NUMERR		/ERROR
	LAC	NUMT		/BREAK -- GET THE CHARACTER INTO AC
	JMP	NUM3
NUMERR	LAC	NUMT		/ERROR SO GET CHARACTER INTO AC
	JMP*	NUMBER		/AND RETURN AT JMS+1
NUMSPC	LAC	NUMFLG		/CHAR. WAS A SPACE -- IS IT A BREAK CHAR.?
	SZA
	JMP	NUM1		/NO -- THE SPACE SHOULD BE IGNORED
	LAC	(40		/YES -- TREAT THE SPACE AS A BREAK CHAR.
	DAC	NUMT
	JMP	NUM2
/
	.EJECT
/
/CPBS FOR MCR FUNCTION
/
ATTACH	2400		/ ATTACH LUN 'ILUN'			/(013)
	I.EV	/FOR INPUT
	ILUN							/(013)
/
DTSEEK	3200	/SEEK THE FILE
	I.EV
	ILUN							/(013)
	.SIXBT	'@@@@@@TSK'
/
DTREAD	2600	/READ A LINE
	I.EV
	ILUN							/(013)
	0	/IN IOPS BINARY
	INBUF
	42
/
CLOSE	3400	/CLOSE THE FILE
	0
	ILUN							/(013)
/
DETACH	2500		/ DETACH LUN 'ILUN'			/(013)
	I.EV
	ILUN							/(013)
/
TTMESG	2700	/WRITE AN ERROR MESSAGE TO THE MCR OPERATOR
	I.EV
	3
	2
TTMESA	XX
	42
/
I.ERRR	DAC	TTMESA
	CAL	TTMESG	/WRITE THE MESSAGE
	CAL	I.WAIT	/WAIT FOR THE EV
	LAC	I.EV	/PICK IT UP
	SMA		/SKIP IF ERROR
	JMP	ERRXIT	/DE-ALLOCATE THE DISK SPACE AND LEAVE
	SAD	(-777)	/OUT OF POOL?
	JMP	.-5	/YES, TRY UNTIL WE CAN DO IT
ERRXIT	LAC	I.DSKA	/HAS DISK SPACE BEEN ALLOCATED?
	SZA		/SKIP IF NOT				/(012)
	CAL	I.DLET	/DELETE THE FILE SINCE WE REALLY DID A CREATE
	CAL	DETACH	/DETACH LUN 'ILUN' - IT CAN'T HURT (CAN IT?)
	CAL	I.WAIT
	JMP	LEAVE	/REQUEST THE MCR LISTENER AND LEAVE
/
	.DEFIN	ABUF,TEXT,?B
	B-./2*1000+2 ; 0
	.ASCII	"TEXT"<15>
B=.
	.ENDM
I.ER06	LAC	(I.ME06
	JMP	I.ERRR
/
/ ERROR MESSAGES
/
I.ME01	ABUF	<SYNTAX ERROR>
I.ME06	ABUF	<CREATE ERR>
I.ME10	ABUF	<READ ERR>
I.ME11	ABUF	<DISK ERR>
I.ME13	ABUF	<FILE NOT FOUND>
/
/SUBROUTINE TO WAIT FOR I.EV AND ANNOUNCE A DISK ERROR IF NEGATIVE WHEN
/COMPLETE.
/
I.WFEV	XX
	CAL	I.WAIT	/WAIT
	LAC	I.EV
	SMA		/ERRORS?
	JMP*	I.WFEV	/NO, LEAVE
I.ER11	LAC	(I.ME11)	/DISK ERROR
	JMP	I.ERRR	/ANNOUNCE IT AND CLEAN UP
/
/
/VARIABLES, CONSTANTS, AND CPBS WITH BUFFERS AS A SIDELINE
/
I.ACNT	0	/SCRATCH LOCATIONS
I.TMP	0
I.BCNT	0
I.CCNT	0
I.WRK	0
TERM	0
NUMT	0
NUM	0
CHAR	0
NUMFLG	0
COUNT	0
I.TEMP	0
I.UNIT	0
I.DPNT	0	/POINTER USED PRIMARILY BY I.PUTW
I.MXDK	0	/MAXIMUM DISK BLOCK USED BY THE CURRENT LINK
I.THIS	0	/DISK ADDRESS OF CURRENT BLOCK IN CORE
I.WRIT	0	/-1 WHEN CURRENT BLOCK HAS BEEN MODIFIED, 0 IF NOT
I.DSKA	0	/INDICATOR THAT THE DISK AREA HAS BEEN ALLOCATED (0 IF NOT)
I.LBSE	0	/DISK BASE ADDRESS FOR CURRENT LINK
I.LCOR	0	/CORE ADDRESS CORRESPONDING TO I.LBSE
I.LKNM	0	/NUMBER OF LINK BEING SOUGHT BY I.FLNK
I.PTNM	0 ; 0   /PARTITION NAME
I.TOTP	0	/COUNTER FOR PATCH RECORDS
I.LTBS	0	/LINK TABLE BASE ADDRESS
/THE FOLLOWING ARE NEEDED FOR STL NODE BUILDING:
I.TSKN	0 ; 0   /NAME OF TASK
I.DFPR	0	/PRIORITY OF TASK
I.PBAD	0	/PARTITION DESCRIPTOR BLOCK ADDRESS
I.DSKB	0	/DISK BASE ADDRESS
I.RISZ	0	/RESIDENT IMAGE SIZE
I.MXTR	0	/MAXIMUM TASK REGISTER (CHANGED TO SIZE FOR STL NODE)
I.ENTR	0	/TASK ENTRY PC (WITH BANK/PAGE AND EXEC/NORM MODE BITS)
/
I.BCBS	0	/BASE OF BLANK COMMON FOR PATCHING
I.PNTR	0	/POINTER USED BY I.GETW
I.CORB	0	/CORE BASE ADDRESS (CORRESPONDING TO I.DSKB)
/
I.WAIT	20	/CPB FOR WAITING
	I.EV		/FOR THE EV
/
I.EV	0	/GENERAL PURPOSE EV
/
I.DLET	3500	/DELETE CPB
	0
	0
	0
	0
	.SIXBT "IMG"
/
I.HINF	3600	/HINF CPB
	I.EV
LUN	0
/
CREATE	1600	/CREATE CPB
	I.EV
	0
	CRECTA
/
CRECTA	0	/CREATE CTA
	0
	.SIXBT "IMG"
	0
	0
	0
	0
	XX
	XX
/
I.ALSZ	0	/ALLOCATE/DEALLOCATE CONTROL TABLE
	0 ; 0
/
I.GETC	13000	/GET (DISK) CPB
	I.EV
	1
	I.PCPB	/GET/PUT CONTROL TABLE
	0
/
I.PUTC	13100	/PUT (DISK) CPB
	I.EV
	1
	I.PCPB	/SAME AS I.GETC
	0
/
I.PCPB	0	/GET/PUT CONTROL TABLE
	0	/DISK ADDRESS IS PUT HERE
	I.BLOK	/ALL I/O TO/FROM DISK IS DONE THROUGH THE I.BLOK BUFFER
	400	/AND IS EXACTLY ONE BLOCK LONG
/
/
INBUF	.BLOCK	42	/INPUT BUFFER
	.END	INSTAL
