.TITLE *** SAVE MCR 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 #31
/
/
/ MCR FUNCTION -- SAVE        4 APR 72        H .KREJCI, R. MCLEAN,C. PROTEAU
/						D. MCMILLEN
/				30 JAN 73	D. VELTEN
/				25 JAN 74	M. HEBENSTREIT
/				27 JAN 75	M. HEBENSTREIT
/				3 JUNE 75	M. HEBENSTREIT
/
/ TASK NAME: "...SAV" TO SAVE THE IMAGE OF CORE IN THE 
/ SAVE AREA ON DISK UNIT ZERO.
/
/ THE FIRST LINE OF COMMAND INPUT FOR ANY MCR FUNCTION IS 
/ READ BY THE RESIDENT MCR TASK ("...MCR").  FOR THE "SAVE"
/ FUNCTION, THERE IS ONLY ONE LINE OF COMMAND INPUT, AND ITS
/ SYNTAX IS AS FOLLOWS:
/
/	SYNTAX = "SAV"$<NTC> <CR>/<AM>
/	    <NTC> = NON TERMINAL CHARACTERS
/	    <CR> = CAR RTN
/	    <AM> = ALTMODE
/	    $ -- "ANY NUMBER OF, INCLUDING ZERO"
/
/ THE RESIDENT MCR READS A LINE, FETCHES THE FIRST THREE CHARACTERS
/ TO FORM THE MCR FUNCTION TASK NAME ("...SAV"), FLUSHES CHARACTERS
/ THRU THE FIRST BREAK OR TERMINAL CHARACTER, REQUESTS "...SAV"
/ AND EXITS.
/
/ THE TASK "...SAV" SETS A RESTORE ENTRY POINT ADDRESS IN 'R1', TURNS
/ THE CLOCK & INTERRUPT SYSTEM OFF, RECORDS THE IMAGE OF CORE ON DISK
/ ZERO.
/
/ THE SYSTEM MAY BE RESTARTED BY USING A "WARM START BOOTSTRAP" WHICH
/ LOADS CORE FROM THE DISK, AND TRANSFERS CONTROL BACK TO THIS
/ TASK, WHICH TURNS THE CLOCK & INTERRUPT SYSTEM BACK ON, THUS RESTORING
/ THE SAVED ENVIRONMENT, AND EXITS.
/
/ A QUIESCENT SYSTEM IS ASSUMED WHENEVER THE "SAVE" MCR FUNCTION
/ IS USED.
/
/ THIS VERSION IS ADAPTED FOR USE WITH THE RP02, RK05, OR RF15.
/
////////////////////////////////////////////////////////////////////////
/
/CONDITIONAL ASSEMBLY:
/
/
/ DEFINING %RF15 PRODUCES A VERSION FOR THE RF15 SYSTEM
/ DEFINING %RK05 PRODUCES A VERSION FOR THE RK05 SYSTEM
/ DEFINING %RP02 PRODUCES A VERSION FOR THE RP02 SYSTEM
	.IFUND %RF15
	.IFUND %RK05
	.IFUND %RP02
	.END -- NO ASSEMBLY PARAMETERS SPECIFIED
	.ENDC
	.ENDC
	.ENDC
/ 
/\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
/
 .TITLE *** MCR FUNCTION 'SAVE'
/
WC=36
CA=37
CLKQ1=246
CLKQ2=247
PDVL=252
ATL=244
R3=103
SIOA=706001
LIOR=706006
DLAL=707024
DLAH=707064
DSCF=707041
DSFX=707042
DSCN=707044
DSCD=707242
DSRS=707262
DSSF=707001
DPCA=706344
DPCS=706324	/CLEAR STATUS
DPLA=706304	/LOAD CYLINDER,HEAD,SECTOR ADDRESS
DPLF=706464	/EXECUTE
DPRSB=706332	/READ STATUS REG B
DPSE=706361	/SKIP ON ERROR
DPSJ=706341	/SKIP ON DONE
DPWC=706364	/LOAD WORD COUNT
DSCC=707021
CLON=700044
CLOF=700004
.ENB=705521
.INH=705522
WARMFL=207
ITVTB=256
FPHDWE=236
PRHDWE=235
MPEU=701742
X10=10
LVL5=41
KRS=700332
FPT=710314	/SKIP IF FLOATING POINT HARDWARE
MCRRI=171
CSIZE=136
RFACTB=210
RKACT0=414
RPACT0=364
DSAFLG=310
REMBLK=311
IDX=ISZ
ECLA=641000
SNAM=123
NDEL=112
NADD=107
POOL=240
PDVL=252
STL=242
R1=101
R2=102
/
SINOD=1	/SYNC INTERVAL FOR NODCNT
SUNOD=3	/SYNC UNIT FOR NODCNT
RINOD=2	/RE-SYNC INTERVAL FOR NODCNT
RUNOD=3	/RE-SYNC UNIT FOR NODCNT
SIPOL=113
SUPOL=2
RIPOL=1
RUPOL=3
SIAUT=132
SUAUT=2
RIAUT=5
RUAUT=3
/
	.EJECT
	.IFDEF %RP02
SAVE	LAC	(011000		/SET UP THE FUNCTION CODE
	.ENDC
	.IFDEF %RF15
SAVE	LAC	(2
	.ENDC
	.IFDEF %RK05
SAVE	LAC	(4
	.ENDC
	DAC	FUNCT		/FOR A READ
	.INH
	LAC	(SAVE
	AND	(70000
	TCA
	DAC	XADJ
	CAL	QCAN3	/CANCEL THE TASK 'AUTORM'
	CAL	QCAN2	/CANCEL THE TASK 'POLLER'
	CAL	QCAN	/CANCEL THE TASK 'NODCNT'
	CAL	QWAIT
	LAC	(CLKQ1	/SCAN THE CLOCK QUEUE TO SEE THAT NO ENTRIES
	JMS	SETXR	/ARE OUTSTANDING
QLOC1	LAC	0,X	/END OF CLOCK QUEUE?
	SAD	(CLKQ1
	JMP	QLOC2	/YES
	JMS	SETXR	/NO -- PREPARE TO ACCESS NEXT NODE
	LAC	2,X
	SAD	(6
	JMP	QLOC1	/THIS IS A NULLIFIED ENTRY SO ITS OK
	LAC	(QMES1	/OUTSTANDING ENTRY -- ERROR
	DAC	QPRINT+4
	JMP	QERR
QLOC2	LAC	(ATL	/CHECK THE ATL FOR ACTIVE TASKS
	JMS	SETXR
QLOC3	LAC	0,X
	SAD	(ATL	/END OF ATL?
	JMP	QLOC4	/YES
	JMS	SETXR	/SET XR TO ACCESS NEXT NODE IN ATL
	LAC	2,X	/CHECK 1ST HALF OF NAME
	SAD	(042301	/DSA?
	JMP	IO1
	SAD	(042313	/DSK?
	JMP	IO1
	SAD	(565656	/MCR FUNCTION?
	JMP	MCR
	SAD	(240426	/TDV?
	JMP	TDV
	SAD	(242431	/TTY?
	JMP	IO1
	SAD	(111722	/IORD?
	JMP	IORD
	AND	(77
	SAD	(56	/IO HANDLER?
	SKP
	JMP	QERR	/NO -- ERROR
	LAC	3,X	/CHECK 2ND HALF OF IO HANDLER NAME
	SAD	(565656
	JMP	IO2
	JMP	QERR	/ERROR -- NOT AN IO HANDLER
IO1	LAC	3,X	/2ND HALF OF DSA OR DSK?
	SZA
	JMP	QERR	/NO -- ERROR
IO2	LAC	7,X	/STATUS OF IO HANDLERS MUST BE 3
	AND	(7
	SAD	(3
	JMP	QLOC3	/OK -- PROCESS NEXT NODE IN ATL
	JMP	QERR	/NO GOOD -- HANDLER ACTIVE
MCR	LAC	3,X	/PROCESS 2ND HALF OF NAME OF MCR FUNCT.
	SAD	(150322	/...MCR?
	JMP	QLOC3	/YES -- OK
	SAD	(230126	/...SAV?
	JMP	QLOC3	/YES -- OK
	JMP	QERR	/NO -- ERROR
TDV	LAC	3,X	/IS NODE FOR TDV...    ?
	SAD	(565656
	JMP	QLOC3	/YES -- OK
	JMP	QERR	/NO -- ERROR
IORD	LAC	3,X	/2ND HALF OF NAME D@@?
	SAD	(040000
	JMP	IO2
	JMP	QERR
QLOC4	LAC	(PDVL	/PREPARE TO SCAN PDVL FOR I/O REQUESTS
	JMS	SETXR
QLOC5	LAC	0,X
	SAD	(PDVL	/IS THIS THE END OF THE PDVL?
	JMP	QLOC6	/YES -- FINISH QUIES. CHECK
	LMQ		/NO -- GET ADDRESS OF WD. 6 BUT SAVE WD. 0 IN MQ
	AAC	6
	DAC	QTEMP	/SAVE ADDR. OF WD. 6
	LACQ		/RESTORE AC WITH ADDR. OF WD. 0
	JMS	SETXR
	LAC	6,X	/EXAMINE WD. 6
	SAD	QTEMP	/WD. 6 SHOULD BE EQUAL TO ADDR. OF WD. 6!
	JMP	QLOC5	/CONTENTS=ADDRESS SO NO NODES IN QUEUE
	LAC	(QMES2	/THERE IS A NODE QUEUED -- ERROR
	DAC	QPRINT+4
	JMP	QERR
SETXR	0	/SUBROUTINE TO ADJUST THE XR
	TAD	XADJ
	PAX
	JMP*	SETXR
QERR	.ENB
	CAL	QPRINT
	CAL	QWAIT
	JMP	ENDIT
QCAN	4	/CANCEL CPB FOR 'NODCNT'
	QEV
	.SIXBT "NOD"
	.SIXBT "CNT"
QCAN2	4
	0
	.SIXBT "POL"
	.SIXBT "LER"
QCAN3	4
	0
	.SIXBT "AUT"
	.SIXBT "ORM"
QPRINT	2700
	QEV
	3
	2
	QMES
QWAIT	20
	QEV
QMES	QMES1-QMES/2*1000
	0
	.ASCII "TASKS ACTIVE -- SAVE ERROR"<15>
QMES1	QMES2-QMES1/2*1000
	0
	.ASCII "CLOCK QUEUE NOT EMPTY -- SAVE ERROR"<15>
QMES2	QEV-QMES2/2*1000
	0
	.ASCII "I/O REQUESTS PENDING -- SAVE ERROR"<15>
QEV	0
QTEMP	0
QLOC6	.ENB	/EXIT FROM QUIESENCE CHECK
	LAC	(3		/SET UP TO READ FIRST
	DAC	NUMWDS		/3 WORDS OF MFD
	LAC	(BUFF
	DAC	BUFADR
	.IFDEF %RP02
	LAC	(47040		/MFD FIXED BLOCK #
	.ENDC
	.IFUND %RP02
	LAC	(1777
	.ENDC
	DAC	BLOCK
	JMS	GETIN		/READ MFD
	LAC	BUFF+2		/POINTS TO SYSBLK
	DAC	BLOCK
	IAC
	SNA			/-1 INDICATES NO SYSBLK
	JMP	NOSAV
	LAC	(1000
	DAC	NUMWDS
	JMS	GETIN		/READ SYSBLK
	LAC	(SAVE
	AND	(70000
	TCA
	TAD	(BUFF
	PAX			/SET UP XR FOR SEARCH OF SYSBLK
				/FOR SAVE AREA
	TAD	BUFF		/FIRST WORD OF SYBLK CONTAINS ITS LENGTH+1
	AAC	-1
	PAL
NEXTIN	LAC	1,X		/GET FIRST HALF OF NAME
	SAD	RSXSAV
	SKP
	JMP	NOMTCH		/NO MATCH
	LAC	2,X		/TEST 2ND HALF
	SAD	RSXSAV+1
	JMP	GOTBLK
NOMTCH	AXS	7		/TEST WHETHER END OF SYSBLK REACHED
	JMP	NEXTIN		/NO,GET NEXT ENTRY
	JMP	NOSAV		/SAVE AREA NOT FOUND
GOTBLK	LAC	3,X		/BLOCK OF SAVE AREA IN THIRD WORD OF ENTRY
	DAC	BLOCK		/SAVE IT
	LAC*	(RFACTB)	/DOES RF HANDLER HAVE ALLOCATED
	SNA			/BLOCKS?
	JMP	RK		/NO.
	CAL	RFDEAL		/YES.  DEALLOCATE THEM.
	CAL	WFEV		/WAITFOR COMPLETION.
	DZM*	(RFACTB)	/ZERO OUT NUMBER OF WORDS ALLOCATED.
RK	LAC	(24		/DEAL ALL BLKS FOR RK AND RP HANDLERS
	LMQ
	LAC	(RKACT0
	JMS	DEAL
	LAC	(3
	LMQ
	LAC	(RPACT0
	JMS	DEAL
	LAC*	(REMBLK	/IS A BLOCK ALLOCATED FOR REMOVE?
	SNA
	JMP	AERR	/NO -- ERROR
ALLDON	LMQ		/YES -- PREPARE TO ZERO IT 
	LLSS!ECLA 10
	DAC	REMCTA
	LACQ
	DAC	REMCTA+1
	CAL	GET	/GET THE BLOCK
	CAL	WFEV
	LAC	EV	/WERE THERE ANY ERRORS?
	SPA
	JMP	GERR	/YES
	LAC	(BUFF-1	/NO -- ZERO ALL BUT THE LAST WORD OF THE BLOCK
	DAC*	(X10
	DZM*	X10
	LAC*	(X10
	SAD	(BUFF+376	/END OF BLOCK?
	SKP
	JMP	.-4	/NO
	CAL	PUT	/YES -- WRITE OUT THE ZEROD BLOCK
	CAL	WFEV
	LAC	EV	/WERE THERE ANY ERRORS?
	SPA
	JMP	PERR	/YES
	LAC	BUFF+377	/NO -- IS THIS THE LAST BLOCK IN CHAIN?
	SAD	(-1
	SKP
	JMP	ALLDON	/NO -- PREPARE TO ZERO THE NEXT BLOCK
	JMP	PUTDON	/YES -- ALL SET.
AERR	LAC	(AMES
	SKP
GERR	LAC	(GMES
	SKP
PERR	LAC	(PMES
	DAC	QPRINT+4
	JMP	QERR
AMES	PMES-AMES/2*1000
	0
	.ASCII "NO REMOVE AREA ALLOCATED"<15>
PMES	GMES-PMES/2*1000
	0
	.ASCII "SAVE DISK PUT ERROR"<15>
GMES	PUT-GMES/2*1000
	0
	.ASCII "SAVE DISK GET ERROR"<15>
PUT	3100
	EV
	1
	REMCTA
GET	3000
	EV
	1
	REMCTA
REMCTA	0
	0
	BUFF
	400
PUTDON	LAC*	(DSAFLG		/SET FLAG IN DSA TO -1 INDICATING THAT
	DAC	TEMP		/NO BIT MAPS ARE IN CORE.
	LAW	-1
	DAC*	TEMP
SAVE1	.INH			/INHIBIT INTERRUPTS
	DZM*	(MCRRI)		/CLEAR ^C MCR REQUEST INHIBIT FLAG
	LAC	(WSEP)		/SET RESTORE ENTRY IN R1 (FOR BOOTSTRAP)
	DAC*	(R1)
/
	LAC*	(001)		/SAVE LOC 001 IN R2
	DAC*	(R2)
	LAC*	(21)		/SAVE LOC 21 IN R3
	DAC*	(R3)
/
DKW	LAC*	(CSIZE)		/SETUP WORD-COUNT
	AAC	-27
	TCA
	DAC*	(WC)
	AAC	1		/SET UP MAGTAPE
	DAC*	(30)
	AAC	2
	DAC*	(32)		/SET UP DECTAPE
/
	LAC	(27)		/SETUP CURRENT ADDRESS REGISTER
	DAC*	(CA)
	AAC	2		/SET UP DECTAPE
	DAC*	(31)
	AAC	2
	DAC*	(33)		/SET UP MAGTAPE
	CLA!CMA
	DAC*	(WARMFL)	/SET UP WARMSTART FLAG
/
	LAC*	(CSIZE		/GET CORE SIZE
	AAC	-30		/LESS 30 SINCE READ STARTS AT LOC 30
	DAC	NUMWDS
	LAC	(30
	DAC	BUFADR
	LAC	WRITE
	DAC	FUNCT		/CHANGE FUNCTION TO WRITE
	JMS	GETIN		/WRITE CORE OUT IN SAVE AREA
/
/ WARM START ENTRY POINT -- CONTROL IS TRANSFERRED HERE BY THE
/ WARM START BOOTSTRAP AFTER THE CORE IMAGE IS RESTORED.
/
/
/ TEST FOR RE-ENTRANT PACKAGE
/ ABORT IF REQUIRED ECO'S ARE MISSING.
/
WSEP	.INH			/INHIBIT INTERRUPTS
	LAC*	(R3)		/RESTORE LOC 21
	DAC*	(21)
	LAC*	(R2)		/RESTORE LOC 001
	DAC*	(001)
	LAC*	(ITVTB+1)	/SAVE INTERRUPT INSTRUCTION
	DAC	ITVTBS
	LAC	(TRAPV)		/SET TRAP ADDRESS
	DAC*	(ITVTB+1)	/IN LOC (41)
	LAC*	(LVL5)		/SAVE PREVIOUS CONTENTS OF TRANSFER VECTOR
	DAC	LVL5SV
	LAC	(JMP*	ITVTB+1)	/SET TO INTERRUPT TO TRANSFER VECTOR TABLE
	DAC*	(LVL5)		/PUT IN LVL5 ADDRESS (41)
	LAC	(402000)	/REQUEST LVL5 INTERRUPT
	ISA
	CLA			/GIVE MACHINE TIME TO INTERRUPT
	CMA
	LAC	(RETOK)		/SET UP TO TEST FOR FREE
	.ENB			/INSTRUCTION AFTER JMS
	JMS	FREE
FREE	0
	DAC*	(ITVTB+1)	/CHANGE LVL5 TRAP ADDRESS AND VERIFY FREE INSTRUCTION
RETOK	DBK			/DEBREAK FROM LEVL 5
	LAC	ITVTBS		/RESTORE INTERRUPT ADDRESS AND TRANSFER VECTOR'S
	DAC*	(ITVTB+1)
	LAC	LVL5SV		/RESTORE PREVIOUS TRANSFER VECTOR
	DAC*	(LVL5)
	JMP	ECOOK		/ECO'S ARE OK START RSX
/
/ TRAPV	ECO'S NOT INSTALLED ERROR
/
TRAPV	CAF			/INITIATE RSX TO PRINT
	ION			/ERROR MESSAGE
	LAC	(400000)	/TURN ON API AND PI BUT NOT CLOCK
	ISA
	CAL	TYPERR	/PRINT ERROR MESSAGE
	CAL	WFEV	/WAIT FOR ERROR MESSAGE TO FINISH
	HLT
	JMP	TRAPV	/LOOP ON MESSAGE YOU CAN'T RUN RSX!!!!!
/
/
ECOOK	CAF	
	XCT*	(FPHDWE)	/FP HARDWARE REQUIRED?
	JMP	NOFLOT	/NO MUST BE OK
	FPT		/YES CHECK FOR IT
	JMP	NOFLER	/ERROR NO FLOATING HARDWARE
NOFLOT	XCT*	(PRHDWE)	/PROTECTION AVAILABLE?
	JMP	NOPRHD	/NO DON'T CHECK FOR IT
	LAC	(401000)	/DECLARE SIGNIFIGANT EVENT TO SET UP
	ISA		/RELOCATION AND BOUNDARY REGISTERS
	NOP
	.INH
	IOF		/TURN OFF INTERRUPTS
	CAF		/CLEAR FLAGS AND TURN OFF API
	LAC*	(21)
	DAC	LVL5SV	/SAVE LOCATION 21
	LAC	(JMP*	10)	/SET UP RETURN
	DAC*	(21)
	LAC	(PRTN-1)
	DAC*	(X10)
	MPEU		/ENTER USER MODE
	NOP
LASTI	LAS		/VIOLATE USER MODE
	JMP	NOPROT	/NO PROTECTION FOUND
PRTN	LAC	LVL5SV	/RESTORE 21
	DAC*	(21)
	LAC*	(20
	AND	(77777
	SAD	(LASTI+1)
	JMP	NOREL
	CAF		/CLEAR ALL FLAGS
	.ENB		/ENABLE INTERRUPTS
NOPRHD	LAC	(400000)	/SET UP TO TURN API ON
	ION			/TURN PI ON
	ISA			/TURN API ON
	LAW	-1
	DAC*	(7)	/TURN CLOCK ON
	CLON
	KRS		/SELECT FULL DUPLEX
/
	LAC*	(REMBLK	/IS THERE A REMOVE AREA?
	SNA
	JMP	AERR	/NO -- ERROR
FIND1	LMQ
	LLSS!ECLA 10
	DAC	REMCTA
	LACQ
	DAC	REMCTA+1
	CAL	GET	/GET THE BLOCK
	CAL	WFEV
	LAC	EV	/WERE THERE ANY ERRORS?
	SPA
	JMP	GERR	/YES
	LAC	BUFF+376	/NO -- START REMOVING BAD STL NODES
	SNA		/IS ZERO NAMES IN THIS BLOCK FORGET IT
	JMP	FIND2
	LAC	(BUFF
	DAC	TEMP
FINDNO	LAC	(STL
	DAC*	(R1
	LAC	TEMP
	DAC*	(R2
	JMS*	(SNAM
	JMP	CONTIN	/RETURN HERE IF TASK ISN'T IN STL
	DAC*	(R1	/RETURN HERE IF TASK IS IN STL -- DELET NODE
	DAC	TEMP1
	JMS*	(NDEL
	LAC	TEMP1	/RETURN THE NODE TO THE POOL
	DAC*	(R2
	LAC	(POOL
	DAC*	(R1
	JMS*	(NADD
CONTIN	LAC	TEMP	/INCREMENT TEMP
	AAC	2
	DAC	TEMP
	LAC	BUFF+376	/END OF THIS BLOCK?
	TAD	(BUFF
	SAD	TEMP
	SKP		/YES
	JMP	FINDNO	/NO -- LOOK AT NEXT TASK NAME
FIND2	LAC	BUFF+377	/IS THIS THE LAST BLOCK?
	SAD	(-1
	JMP	ENDIT	/YES
	JMP	FIND1	/NO -- GO GET THE NEXT BLOCK
ENDIT	CAL	SYNC	/SYNC 'NODCNT'
	CAL	SYNC2	/SYNC 'POLLER'
	CAL	SYNC3	/SYNC 'AUTORM'
	CAL	QWAIT
	CAL	REQCPB	/REQUEST ...MCR
	CAL	(10)
/
NOSAV	CAL	NOAREA	/WRITE ERROR MESSAGE, NO SAVE AREA
	CAL	WFEV
	CAL	SYNC	/SYNC 'NODCNT'
	CAL	SYNC2	/SYNC 'POLLER'
	CAL	SYNC3	/SYNC 'AUTORM'
	CAL	QWAIT
	CAL	REQCPB	/REQUEST ...MCR
	CAL	(10	/EXIT
NOAREA	2700
	EV
	3		/LUN
	2		/DATA MODE
	NOAR		/BUFFER ADDRESS
NOAR	NOARE-NOAR/2*1000+2
	0
	.ASCII 'NO SAVE AREA ON SYSTEM DISK'
NOARE=.
NOREL	CAF		/CLEAR ALL FLAGS
	LAC	(400000)	/SET UP API AND PI
	ISA
	ION
	CAL	NORELH	/PRINT ERROR MESSAGE
	CAL	WFEV	/WAIT FOR MESSAGE
	HLT
	JMP	.-3	/TYPE IT AGAIN
/
NOPROT	LAC	LVL5SV	/RESTORE 21
	DAC*	(21)
	LAC	(400000)	/SET UP API
	ISA
	ION
	CAL	NOPROA	/NO PROTECTION HARDWARE
	CAL	WFEV
	HLT
	JMP	.-3
/
/BEFORE CALLING THIS I/O SUBROUTINE, LOAD AS FOLLOWS:
/ NUMWDS CONTAINS NUMBER OF WORDS TO TRANSFER
/ BUFADR CONTAINS BUFFER ADDRESS
/ BLOCK CONTAINS BLOCK NUMBER
/ FUNCT CONTAINS READ OR WRITE
/
GETIN	0
	LAW	-10	/SET ERROR COUNTER
	DAC	ERRCNT
	.IFDEF %RP02
	LAC	BLOCK	/CALCULATE CYLINDER,HEAD,SECTOR FROM BLOCK NO.
	LMQ
	CLA!CLL
	DIV
	310
	DAC	HEDAD
	LACQ
	ALS	12
	DAC	CYLAD
	LAC	HEDAD
	LMQ
	CLA!CLL
	DIV
	12
	DAC	SECTOR
	LACQ
	ALS	5
	DAC	HEDAD
	AND	(001740
	XOR	CYLAD
	XOR	SECTOR
	DAC	PAKAD	/WORD SET FOR DP 
TOP	LAC	(040000		/START A SEEK ACTION
	DPLF
	DPRSB		/THIS PROVIDES  A DELAY
	DPRSB		/AFTER WHICH THE SEEK PROCEEDS
	CLA		/EVEN THO UNIT IS DESELECTED.
	DPLF
	LAC	PAKAD
	DPLA		/LOAD BLOCK ADDRESS
	LAC	NUMWDS
	TCA
	DPWC		/LOAD WORD COUNT
	LAC	BUFADR
	DPCA
	DPRSB
	RAR		/TEST FOR DP NOT READY
	SZL
	JMP	TOP	/TRY AGAIN
	DPCS
	LAC	FUNCT
	DPLF		/WRITE OR READ FUNCTION
	DPRSB
	DPRSB
	DPSE		/ERROR?
	SKP
	JMP	TOP1	/YES, TRY AGAIN
	DPSJ		/DONE?
	JMP	.-4	/NO, TRY AGAIN
	JMP*	GETIN	/DONE
HEDAD	0	/HEAD ADDRESS
CYLAD	0	/CYLINDER ADDRESS
	.ENDC
	.IFDEF %RF15
TOP	DSCD
	CLL
	LAC	BLOCK
	LRS	12
	DLAH
	LAC	BLOCK
	AND	(1777
	ALS	10
	DLAL
	CLC
	TAD	BUFADR
	DAC*	(37
	LAC	NUMWDS
	TCA
	DAC*	(36
	LAC	FUNCT
	IOF
	.INH
	DSCF!DSFX!DSCN
	DSSF
	JMP	.-1
	.ENB
	ION
	DSRS
	SPA
	JMP	TOP1
	JMP*	GETIN
	.ENDC
	.IFDEF %RK05
TOP	LAC	(23402
	DAC	TCB
	LAC	(602
	DAC	TCB+1
	DZM	RKEV
	LAC	BLOCK
	DAC	TCB+3
	LAC	NUMWDS		/IF TRANSFER >64K
	AND	(600000		/SET BIT IN WORD 4
	SZA
	LAC	(4
	DAC	TCB+4
	LAC	BUFADR
	DAC	TCB+5
	LAC	NUMWDS
	TCA
	DAC	TCB+6
	LAC	FUNCT
	DAC	TCB+7
	DZM	TCB+10
	DZM	TCB+11
	DZM	TCB+12
	LAC	(TCB
	SIOA
	JMP	.-1
	LIOR
	LAC	RKEV
	SNA!RTL
	JMP	.-2
	SPA
	JMP	TOP1
	JMP*	GETIN
TCB	0
	402
RKEV	0
	0
	0
	0
	0
	0
	0
	0
	0
	.ENDC
TOP1	ISZ	ERRCNT
	JMP	TOP
	JMP	DSKERR
BLOCK	0
NUMWDS	0
BUFADR	0
SECTOR	0
PAKAD	0	/HOLDS ADDRESS ON DP
TEMP	0
TEMP1	0
ERRCNT	0
DEAL	0
	DAC	TEMP
	LACQ
	DAC	DEVICE
	LAW	-10
	DAC	TEMP1
DEAL2	LAC	TEMP
	DAC	RFDEAL+3
	LAC*	TEMP
	SNA
	JMP	DEAL1
	CAL	RFDEAL
	CAL	WFEV
	DZM*	TEMP
DEAL1	LAC	TEMP
	AAC	3
	DAC	TEMP
	ISZ	TEMP1
	JMP	DEAL2
	JMP*	DEAL
RSXSAV	.SIXBT 'RSXIMG'	/NAME OF SAVE AREA
BUFF	.BLOCK 1000	/BUFFER
FUNCT	010000	/START WITH READ
	.IFDEF %RP02
WRITE	021000	/WRITE FUNCTION FOR SAVING
	.ENDC
	.IFDEF %RF15
WRITE	4
	.ENDC
	.IFDEF %RK05
WRITE	2
	.ENDC
NOPROA	2700	/NO PROTECTION HARDWARE AVAILABLE
	EV
	3
	2
	NOPTM
NOPTM	NOPTE-NOPTM/2*1000+2
	0
	.ASCII	'RELOCATION NECESSARY'<15>
NOPTE=.
NORELH	2700
	EV
	3
	2
	NOREM
NOREM	NOREE-NOREM/2*1000+2
	0
	.ASCII	'PROTECT-RELOCATE SWITCH MUST BE IN RELOCATE POSITION'<15>
NOREE=.
/
NOFLER	CAF		/PRINT ERROR MESSAGE
	LAC	(NOP)	/FORCE NO FP OPTION
	DAC*	(FPHDWE)
	ION		/ENABLE INTERRUPTS TO PRINT THE MESSAGE
	LAC	(400000)
	ISA
	CAL	TYPFPE	/TYPE FLOATING POINT ERROR
	CAL	WFEV	/WAIT FIR IT
	HLT
	JMP	NOFLER	/PRINT IT AGAIN
/
/
TYPERR	2700	/TYPE ERROR MESSAGE
	EV
	3
	2
	ERRMSG-2
TYPDSK  2700
        EV
        3
        2
        DSKMSG
DSKMSG  DSKMGE-DSKMSG/2*1000+2
        0
        .ASCII "SAV - DISK ERROR"<15>
DSKMGE=.
DSKERR  CAL     TYPDSK
        CAL     WFEV
	CAL	REQCPB
        CAL     (10)
/
TYPFPE	2700	/TYPE FP ERROR
	EV
	3
	2
	FPERMS
/
FPERMS	FPERME-FPERMS/2*1000+2
	0
	.ASCII	/FLOATING POINT UNIT NECESSARY/<15>
FPERME=.
/
WFEV	20	/WAIT FOR EVENT
	EV
/
EV	0	/ EVENT VARIABLE
XADJ	0
LVL5SV	0	/LOCATION 41 SAVE AREA
ITVTBS	0	/TRANSFER VECTOR SAVE AREA
/
ERRMSG	.ASCII	'RE-ENTRANT ECO PACKAGE NECESSARY TO RUN RSX'<15>
/
REQCPB	1
	0
	.SIXBT	"...MCR"
	0
/
RFDEAL	11600		/DEALLOCATE.
	EV
	1		/LUN 1 FOR DISK DRIVER.
	RFACTB		/CONTROL TABLE ADDRESS.
DEVICE	2
/
SYNC	14	/SYNC CPB FOR 'NODCNT'
	QEV
	.SIXBT "NOD"
	.SIXBT "CNT"
	3	/SYNC UNIT -- MIN.
	SINOD	/SCHEDULE INTERVAL
	SUNOD	/SCHEDULE UNIT -- MIN.
	RINOD	/RESCHEDULE INTERVAL
	RUNOD	/RESCHEDULE UNIT -- MIN
	0	/PRIORITY
/
SYNC2	14
	0
	.SIXBT "POL"
	.SIXBT "LER"
	3
	SIPOL
	SUPOL
	RIPOL
	RUPOL
	0
/
SYNC3	14
	0
	.SIXBT "AUT"
	.SIXBT "ORM"
	3
	SIAUT
	SUAUT
	RIAUT
	RUAUT
	0
/
	.END